FastString - Structured Memory String

[mk-soft]

Memory string management for large strings.
I hope that the string management of Purebasic will be revised soon.

Update v1.07.0
- Added some functions
Update v1.08
- Works now with ASCII and Unicode Mode
Update v1.09.0
- Added InsertStringPB

Code: Select all

;-TOP

; Comment : FastString
; Author  : mk-soft
; Version : v1.09.1
; Create  : 20.07.2020
; Update  : 03.08.2020

; *********************

; Description

; The String is always a Pointer to a Memory.
; 
; Info:
; The function ClearString, AddString, ConcatString and InsertStringFast returns a new pointer 
; to the string and the pointer from the first parameter '*String' is then invalid. 
; The same as with ReAllocateMemory from Purebasic.

CompilerIf Defined(PB_MessageRequester_Error, #PB_Constant) = 0
  #PB_MessageRequester_Error = 0
CompilerEndIf

;EnableExplicit

Structure udtFastString
  Len.i
  Char.c[0]
EndStructure

; ----

Procedure AllocateString(String.s = "") ; Result String Pointer
  Protected len, *String.udtFastString, *pointer
  len = StringByteLength(String)
  *String = AllocateMemory(len + SizeOf(Integer) + SizeOf(Character))
  If *String
    *Pointer = @*String\Char
    CopyMemoryString(@String, @*pointer)
    *String\Len = len
  Else
    MessageRequester("Fatal Error", "Out Of Memory - Stop", #PB_MessageRequester_Error)
    End
  EndIf
  ProcedureReturn *String
EndProcedure

; ----
Macro FreeString(String)
  FreeMemory(String)
EndMacro

Procedure ClearString(*String.udtFastString) ; Result New String Pointer
  *String = ReAllocateMemory(*String, SizeOf(Integer) + SizeOf(Character))
  *String\Len = 0
  *String\Char[0] = 0
  ProcedureReturn *String
EndProcedure

; ----

Procedure LenString(*String.udtFastString)
  ProcedureReturn *String\Len / SizeOf(Character)
EndProcedure

Procedure.s GetString(*String.udtFastString)
  ProcedureReturn PeekS(@*String\Char, *String\Len / SizeOf(Character))
EndProcedure

; ----

Procedure AddString(*String.udtFastString, String.s) ; Result New String Pointer
  Protected len, len_new, *pointer
  len = StringByteLength(String)
  len_new = *String\Len + len
  *String = ReAllocateMemory(*String, len_new + SizeOf(Integer) + SizeOf(Character), #PB_Memory_NoClear)
  If *String
    *pointer = @*String\Char + *String\Len
    CopyMemoryString(@String, @*pointer)
    *String\Len = len_new
  Else
    MessageRequester("Fatal Error", "Out Of Memory - Stop", #PB_MessageRequester_Error)
    End
  EndIf
  ProcedureReturn *String
EndProcedure

Procedure ConcatString(*String.udtFastString, *Add.udtFastString) ; Result New String Pointer
  Protected len_new, *pointer
  len_new = *String\Len + *Add\len
  *String = ReAllocateMemory(*String, len_new + SizeOf(Integer) + SizeOf(Character), #PB_Memory_NoClear)
  If *String
    *pointer = @*String\Char + *String\Len
    CopyMemory(@*Add\Char, *pointer, *Add\len + SizeOf(Character))
    *String\Len = len_new
  Else
    MessageRequester("Fatal Error", "Out Of Memory - Stop", #PB_MessageRequester_Error)
    End
  EndIf
  ProcedureReturn *String
EndProcedure

Procedure InsertStringPB(*String.udtFastString, Insert.s, Position) ; Result New String Pointer
  Protected len_new, *pointer, len
  len = StringByteLength(Insert)
  If Len = 0
    ProcedureReturn *String
  EndIf
  Position - 1
  Position * SizeOf(Character)
  If Position > *String\Len
    Position = *String\Len
  EndIf
  len_new = *String\Len + len
  *String = ReAllocateMemory(*String, len_new + SizeOf(Integer) + SizeOf(Character), #PB_Memory_NoClear)
  If *String
    *pointer = @*String\Char + Position
    MoveMemory(*pointer, *pointer + len, *String\Len - Position + SizeOf(Character))
    CopyMemory(@Insert, *pointer, len)
    *String\Len = len_new
  Else
    MessageRequester("Fatal Error", "Out Of Memory - Stop", #PB_MessageRequester_Error)
    End
  EndIf
  ProcedureReturn *String
EndProcedure

Procedure InsertStringFast(*String.udtFastString, *Insert.udtFastString, Position) ; Result New String Pointer
  Protected len_new, *pointer
  If *Insert\Len = 0
    ProcedureReturn *String
  EndIf
  Position - 1
  Position * SizeOf(Character)
  If Position > *String\Len
    Position = *String\Len
  EndIf
  len_new = *String\Len + *Insert\len
  *String = ReAllocateMemory(*String, len_new + SizeOf(Integer) + SizeOf(Character), #PB_Memory_NoClear)
  If *String
    *pointer = @*String\Char + Position
    MoveMemory(*pointer, *pointer + *Insert\Len, *String\Len - Position + SizeOf(Character))
    CopyMemory(@*Insert\Char, *pointer, *Insert\Len)
    *String\Len = len_new
  Else
    MessageRequester("Fatal Error", "Out Of Memory - Stop", #PB_MessageRequester_Error)
    End
  EndIf
  ProcedureReturn *String
EndProcedure

; ----

Procedure LeftString(*String.udtFastString, Length)
  Protected len, *NewString.udtFastString
  Length * SizeOf(Character)
  If Length <= *String\Len
    len = Length
  Else
    len = *String\Len
  EndIf
  *NewString = AllocateMemory(len + SizeOf(Integer) + SizeOf(Character))
  If *NewString
    CopyMemory(@*String\Char, @*NewString\Char, len)
    *NewString\Len = len
  Else
    MessageRequester("Fatal Error", "Out Of Memory - Stop", #PB_MessageRequester_Error)
    End
  EndIf
  ProcedureReturn *NewString
EndProcedure

Procedure RightString(*String.udtFastString, Length)
  Protected len, *NewString.udtFastString
  Length * SizeOf(Character)
  If Length <= *String\Len
    len = Length
  Else
    len = *String\Len
  EndIf
  *NewString = AllocateMemory(len + SizeOf(Integer) + SizeOf(Character))
  If *NewString
    CopyMemory(@*String\Char + *String\Len - len, @*NewString\Char, len)
    *NewString\Len = len
  Else
    MessageRequester("Fatal Error", "Out Of Memory - Stop", #PB_MessageRequester_Error)
    End
  EndIf
  ProcedureReturn *NewString
EndProcedure

Procedure MidString(*String.udtFastString, Position, Length = #PB_Ignore)
  Protected len, *NewString.udtFastString
  Position - 1
  Position * SizeOf(Character)
  If Position => *String\Len Or Position < 0
    *NewString = AllocateMemory(SizeOf(Integer) + SizeOf(Character))
    If *NewString
      ProcedureReturn *NewString
    Else
      MessageRequester("Fatal Error", "Out Of Memory - Stop", #PB_MessageRequester_Error)
      End
    EndIf
  EndIf
  
  If Length = #PB_Ignore
    Length = *String\Len - Position
  Else
    Length * SizeOf(Character)
  EndIf
  
  If Length + Position <= *String\Len
    len = Length
  Else
    len = *String\Len - Position
  EndIf
  *NewString = AllocateMemory(len + SizeOf(Integer) + SizeOf(Character))
  If *NewString
    CopyMemory(@*String\Char + Position, @*NewString\Char, len)
    *NewString\Len = len
  Else
    MessageRequester("Fatal Error", "Out Of Memory - Stop", #PB_MessageRequester_Error)
    End
  EndIf
  ProcedureReturn *NewString
EndProcedure

; ----

Procedure LSetString(*String.udtFastString, Length, Character = ' ')
  Protected len, cnt, *NewString.udtFastString, *Position
  Length * SizeOf(Character)
  If *String\Len <= Length
    len = *String\Len
  Else
    len = Length
  EndIf
  *NewString = AllocateMemory(Length + SizeOf(Integer) + SizeOf(Character))
  If *NewString
    *Position = @*NewString\Char
    CopyMemory(@*String\Char, *Position, len)
    If len < Length
      *Position + len
      cnt = Length - len
      FillMemory(*Position, cnt, Character, #PB_Character)
    EndIf
    *NewString\Len = Length
  Else
    MessageRequester("Fatal Error", "Out Of Memory - Stop", #PB_MessageRequester_Error)
    End
  EndIf
  ProcedureReturn *NewString
EndProcedure

Procedure RSetString(*String.udtFastString, Length, Character = ' ')
  Protected len, cnt, *NewString.udtFastString, *Position
  Length * SizeOf(Character)
  If *String\Len <= Length
    len = *String\Len
  Else
    len = Length
  EndIf
  *NewString = AllocateMemory(Length + SizeOf(Integer) + SizeOf(Character))
  If *NewString
    *Position = @*NewString\Char
    If len < Length
      cnt = Length - len
      FillMemory(*Position, cnt, Character, #PB_Character)
      *Position + cnt
    EndIf
    CopyMemory(@*String\Char, *Position, len)
    *NewString\Len = Length
  Else
    MessageRequester("Fatal Error", "Out Of Memory - Stop", #PB_MessageRequester_Error)
    End
  EndIf
  ProcedureReturn *NewString
EndProcedure

; ----

Procedure LCaseString(*String.udtFastString, Flags = 0)
  Protected len, index, *NewString.udtFastString
  
  If Flags = #PB_String_InPlace
    *NewString = *String
  Else
    *NewString = AllocateMemory(MemorySize(*String))
    If *NewString
      CopyMemory(*String, *NewString, MemorySize(*String))
    EndIf
  EndIf
  
  If *NewString
    len = *NewString\Len / SizeOf(Character)
    len - 1
    For index = 0 To len
      Select *NewString\Char[index]
        Case 65 To 90
          *NewString\Char[index] = *NewString\Char[index] + 32
        Case 192 To 222
          If *NewString\Char[index] = 208 Or *NewString\Char[index] = 215
            ; Do Nothing
          Else
            *NewString\Char[index] = *NewString\Char[index] + 32
          EndIf
      EndSelect
    Next
  Else
    MessageRequester("Fatal Error", "Out Of Memory - Stop", #PB_MessageRequester_Error)
    End
  EndIf
  ProcedureReturn *NewString
EndProcedure

Procedure UCaseString(*String.udtFastString, Flags = 0)
  Protected len, index, *NewString.udtFastString
  
  If Flags = #PB_String_InPlace
    *NewString = *String
  Else
    *NewString = AllocateMemory(MemorySize(*String))
    If *NewString
      CopyMemory(*String, *NewString, MemorySize(*String))
    EndIf
  EndIf
  
  If *NewString
    len = *NewString\Len / SizeOf(Character)
    len - 1
    For index = 0 To len
      Select *NewString\Char[index]
        Case 97 To 122
          *NewString\Char[index] = *NewString\Char[index] - 32
        Case 224 To 254
          If *String\Char[index] = 240 Or *NewString\Char[index] = 247
            ; Do Nothing
          Else
            *NewString\Char[index] = *NewString\Char[index] - 32
          EndIf
      EndSelect
    Next
  Else
    MessageRequester("Fatal Error", "Out Of Memory - Stop", #PB_MessageRequester_Error)
    End
  EndIf
  ProcedureReturn *NewString
EndProcedure

; ********

;- Examples

CompilerIf #PB_Compiler_IsMainFile
  
  Define *sVal1.udtFastString
  Define *sVal2.udtFastString
  Define *sVal3.udtFastString
  
  Define time, i, r1
  
  *sVal1 = AllocateString("* Hello String *")
  *sVal2 = AllocateString("[ * I like Purebasic * ]")
  
  Debug "ConcatString"
  *sVal1 = ConcatString(*sVal1, *sVal2)
  Debug "StringByteLen = " + *sVal1\len
  Debug GetString(*sVal1)
  Debug ""
  
  Debug "AddString * 100000"
  DisableDebugger
  time = ElapsedMilliseconds()
  For i = 1 To 100000
    *sVal1 = AddString(*sVal1, "x")
  Next
  r1 = ElapsedMilliseconds() -time
  EnableDebugger
  Debug "Time = " + r1 + " ms"
  Debug "Len = " + LenString(*sVal1)
  Debug ""
  
  *sVal1 = AddString(*sVal1, " End")
  
  Debug "InsertStringFast"
  *sVal1 = InsertStringFast(*sVal1, *sVal2, LenString(*sVal1) - 9)
  ;*sVal1 = InsertStringPB(*sVal1, "[ * I like Purebasic * ]", LenString(*sVal1) - 9)
  Debug "Len = " + LenString(*sVal1)
  Debug ""
  
  Debug "LeftString"
  *sVal3 = LeftString(*sVal1, 40)
  Debug GetString(*sVal3)
  Debug "Len = " + LenString(*sVal3)
  FreeString(*sVal3)
  Debug ""
  
  Debug "RightString"
  *sVal3 = RightString(*sVal1, 40)
  Debug GetString(*sVal3)
  Debug "Len = " + LenString(*sVal3)
  FreeString(*sVal3)
  Debug ""
  
  Debug "MidString"
  *sVal3 = MidString(*sVal1, 3, 5)
  Debug GetString(*sVal3)
  Debug "Len = " + LenString(*sVal3)
  FreeString(*sVal3)
  Debug ""
  
  Debug "LCaseString"
  FreeString(*sVal1)
  *sVal1 = AllocateString("Hello ÄÖÜ Á É Ó Ý @ €")
  *sVal3 = LCaseString(*sVal1)
  Debug GetString(*sVal3)
  Debug "UCaseString in Place"
  UCaseString(*sVal3, #PB_String_InPlace)
  Debug GetString(*sVal3)
  FreeString(*sVal3)
  Debug ""
  
  Debug "LSetString"
  FreeString(*sVal1)
  *sVal1 = AllocateString("Hello World!")
  *sVal3 = LSetString(*sVal1, 40, 'x')
  Debug GetString(*sVal3)
  Debug "Len = " + LenString(*sVal3)
  FreeString(*sVal3)
  Debug ""
  
  Debug "RSetString"
  FreeString(*sVal1)
  *sVal1 = AllocateString("Hello World!")
  *sVal3 = RSetString(*sVal1, 40, 'x')
  Debug GetString(*sVal3)
  Debug "Len = " + LenString(*sVal3)
  FreeString(*sVal3)
  Debug ""
  
CompilerEndIf

[Olli]

Humour ?

[mk-soft]

Humour ?

No Humour ...
Link: viewtopic.php?f=13&t=75750
Link: viewtopic.php?f=3&t=75726

[Olli]

Sure ?

Code: Select all

Procedure utf(X$)
   *X = UTF8(X$)
   Debug MemorySize(*X)
   FreeMemory(*X)
EndProcedure

utf("e")
utf("é")
utf("€")

[wilbert]

Sure ?

Code: Select all

Procedure utf(X$)
   *X = UTF8(X$)
   Debug MemorySize(*X)
   FreeMemory(*X)
EndProcedure

utf("e")
utf("é")
utf("€")

What's the problem ?
One byte is for the terminating null.
If you subtract that, it shows the amount of bytes required to represent the character as utf-8.

[mk-soft]

I don't know where you want to go out and what it has to do with UTF8.

Here only ASCII or Unicode is used depending on the compiler.

Result from you with UTF8 is absolutely correct. Memory size of UTF8 characters (1..4 byte) and the null byte.
But it is not used here at all.

[Mijikai]

thx for sharing

[Olli]

Result from you with UTF8 is absolutely correct. Memory size of UTF8 characters (1..4 byte) and the null byte.
But it is not used here at all

You should explain "udt" prefix.
And you should make two codes : one for ASCII, the second one for UNICODE, compiled by a meta CompilerIf and the compiler version which differenciates the two formats (2015).

Maybe see if string length prefix is patented : there are such of surprises...

By making two codes, instead only one, maybe we could store immediate strings in ASM meta 'DB' for ASCII and 'DW' for UNICODE.

Three questions : 1) why a prefix ? (why not indices table ?)
2) Why an integer ?
3) How to integrate short strings and long strings ? (hidden question : is the time to select internal code, the time which seems to miss ?)

[mk-soft]

You should explain "udt" prefix.

It is a special kind of me and many people recognize that the code is from me.
Comes from a work as a programmer with part Siemens controllers.

UDT = User Data Type

And you should make two codes : one for ASCII, the second one for UNICODE, compiled by a meta CompilerIf and the compiler version which differenciates the two formats (2015).

This is not necessary because it always depends on the compiler to be used.

#PB_Processor_X86, integer 4 bytes. #PB_Processor_X64, Integer 8 bytes.

ASCII Compiler: Variable type Charater ASCII 1 byte
Unicode Compiler: Variable type Charater Unicode 2 byte (#PB_Compiler_Unicode)

Therefore you should always work with the compiler directive SizeOf(...).

Maybe see if string length prefix is patented : there are such of surprises...

It is a common method to use length specifications in structures. And that is all areas.
The problem with patents is always a problem in everything we do.
But I don't think you can patent the color blue either. And then something like this happens, one should ask oneself where something is not going wrong.

By making two codes, instead only one, maybe we could store immediate strings in ASM meta 'DB' for ASCII and 'DW' for UNICODE.

I have already thought about writing an extra version for UTF8 to work directly with files.

1) why a prefix ? (why not indices table ?)

Thats not fast

2) Why an integer ?

Because of the optimization a boolean in Windows is not a byte, but always as big as a register

3) How to integrate short strings and long strings ? (hidden question : is the time to select internal code, the time which seems to miss ?)

Added InsertStringPB(...)

Question:
You're new here. How long have you known Purebasic and where with have you programmed before and how long.

[HeX0R]

This seems to be a little over the top, isn't it?
The only bottleneck I usually came accross was, when building-up huge strings, therefore a simple stringbuilder module should be anything you need.
Like this:

Code: Select all

DeclareModule StringBuilder
	
	Declare Init(PacketSize.i = 65536)
	Declare DeInit(*SB)
	Declare Add(*SB, String.s)
	Declare.s GetString(*SB)
	
EndDeclareModule

Module StringBuilder
	
	Structure _SB_
		*Address
		*Pointer
		MemSize.i
		PacketSize.i
		Length.i
	EndStructure
	
	Global NewList SB._SB_()
	
	
	Procedure Init(PacketSize.i = 65536)
		Protected *Buffer, Result
		
		*Buffer = AllocateMemory(PacketSize, #PB_Memory_NoClear)
		If *Buffer
			AddElement(SB())
			SB()\Address    = *Buffer
			SB()\Pointer    = *Buffer
			SB()\PacketSize = PacketSize
			SB()\MemSize    = PacketSize
			Result          = @SB()
		EndIf
		
		ProcedureReturn Result
	EndProcedure
	
	Procedure Add(*SB._SB_, String.s)
		Protected L, *Add, Result = #True
		
		L = StringByteLength(String)
		While L + *SB\Length + 2 > *SB\MemSize
			*SB\MemSize + *SB\PacketSize
			*Add = ReAllocateMemory(*SB\Address, *SB\MemSize, #PB_Memory_NoClear)
			If *Add
				If *Add <> *SB\Address
					*SB\Pointer = *SB\Pointer - *SB\Address + *Add
				EndIf
				*SB\Address = *Add
			Else
				Result = #False
				Break
			EndIf
		Wend
		If Result
			CopyMemoryString(@String, @*SB\Pointer)
			*SB\Length + L
		EndIf
		
		ProcedureReturn Result
	EndProcedure
	
	Procedure.s GetString(*SB._SB_)
		ProcedureReturn PeekS(*SB\Address, *SB\Length)
	EndProcedure
	
	Procedure DeInit(*SB)
		ChangeCurrentElement(SB(), *SB)
		FreeMemory(SB()\Address)
		DeleteElement(SB())
	EndProcedure
	
EndModule

CompilerIf #PB_Compiler_IsMainFile
	
	Define ID, i, a$, b$, s1, s2
	
	ID = StringBuilder::Init()
	a$ = "abcdefghijklmnopqrstuvwxyz" + #CRLF$
	s1  = ElapsedMilliseconds()
	For i = 1 To 10000
		StringBuilder::Add(ID, a$)
	Next i
 	s1 = ElapsedMilliseconds() - s1
	s2  = ElapsedMilliseconds()
	For i = 1 To 10000
		b$ + a$
	Next i
	s2 = ElapsedMilliseconds() - s2
	MessageRequester("Info", ~"Stringbuilder: \t" + Str(s1) + ~"ms\nPB-Way: \t" + Str(s2) + "ms")
	StringBuilder::DeInit(ID)
	
CompilerEndIf

[mk-soft]

@Hexor
You probably have that on the right.
I guess I had too much time.

Both methods are about equally fast.

[skywalk]

Yes, I would love this to be native.
I also use this method only when appending large strings.
I suffer the slower PB strings for simple appends and non-critical gui stuff.

[ChrisR]

Thanks for sharing these nice modules

Since I only need concatenation, I played with HeXOR's module
I noticed a small mistake related to the current element:

Code: Select all

While L + *SB\Length + 2 > SB()\MemSize
Should be: While L + *SB\Length + 2 > *SB\MemSize

And not important, just to make the schmilblick move, GetString can also be done without the need to go through the list:

Code: Select all

Procedure.s GetString(*SB._SB_)
  ProcedureReturn PeekS(*SB\Address, *SB\Length)   ; Or without Length field, PeekS(*SB\Address, *SB\Pointer - *SB\Address)   
EndProcedure

It works fine and fast, it really makes a difference for concatenation

[Rinzwind]

Why a List is used? Could as well be a pointer? There is only one AddElement call?

[HeX0R]

It was more a proof of concept, made in a couple of minutes.
And a ChangeCurrentElement() doesn't run through the list, so it doesn't make much difference to the usage of the pointer directly.
It would help, though, in case you use it from different threads.
I can't remember why I didn't use the pointers directly.

The idea behind the list was, that you can use more than just one stringbuilder at once, and for an easy (not integrated, though) DeInitAll() procedure to clean all-up in the end.

Thanks for the bug hunting Chris! Seems I never saw that (that's because I never used more than one stringbuilder at once)