;
; Tested in Ascii, UTF8 and Unicode
; PBx64 v5.71 and Spiderbasic 2.30
;
; Based on srod's (nxSoftware) memoryfile.pbi
;
; Please note that most of the credit goes to srod
;
; Kingwolf71 Apr/2020
; V1.00
;
;
; Free for use and distribution under Standard GPL
Code: Select all
; -- Memory File System --
;
; Tested in Ascii, UTF8 and Unicode
; PBx64 v5.71 and Spiderbasic 2.30
;
; Based on srod's (nxSoftware) memoryfile.pbi
;
; Please note that most of the credit goes to srod
;
; Kingwolf71 Apr/2020
; V1.00
;
;
; Free for use and distribution under Standard GPL
DeclareModule MF
; ======================================================================================================
;- Public Constants
; ======================================================================================================
CompilerIf Not Defined( PB_Compiler_Unicode, #PB_Constant )
#PB_Compiler_Unicode = #True
#PB_Compiler_Thread = #True
#SB_Compiler_SpiderBasic = 230
CompilerEndIf
; ======================================================================================================
;- Public Structures
; ======================================================================================================
Structure _membersMemoryFileClass
eof.w
flags.w
*fileBase
fileSize.i
initialSize.i
initialPageSize.i
usedFile.i ;Lof.
filePointer.i ;Loc.
pageSize.l
blnErrorReported.l ;#True or #False. Used when checking for errors after a 'bulk' set of write operations etc.
;as opposed to checking each individual 'write'. A failed 'write' will not cause a crash.
EndStructure
Global Dim *Handle._membersMemoryFileClass(1)
; ======================================================================================================
;- Public Module Macros
; ======================================================================================================
Macro GetFileMemoryBase(myhandle)
MF::*Handle(myhandle)\FileBase
EndMacro
Macro memLoc(myhandle)
MF::*Handle(myhandle)\filePointer
EndMacro
Macro memLof(myhandle)
MF::*Handle(myhandle)\usedFile
EndMacro
Macro memEOF(myhandle)
MF::*Handle(myhandle)\eof
EndMacro
Macro memPageSize(myhandle)
MF::*Handle(myhandle)\pageSize
EndMacro
Macro memSetPageSize(myhandle, newsize)
If newsize > 0
MF::*Handle(myhandle)\pageSize = newsize
EndIf
EndMacro
; File size set to current pointer
Macro memTruncate(myhandle)
memPTR()\usedFile = memPTR()\filePointer
EndMacro
; ======================================================================================================
;- Public Module Functions
; ======================================================================================================
Declare memCreate( initialSize.i = 8192, pageSize.l = 4096 )
Declare memCreateFromPtr( *buffer, bufferSize, pageSize.l = 4096 )
Declare memDestroy( handle )
Declare memReset(handle, newInitialSize=-1)
Declare memFileSeek(handle, newOffset.i)
Declare memWriteByte(handle, byte.b)
Declare memWriteWord(handle, word.w)
Declare memWriteLong(handle, long.l)
Declare memWriteChar(handle, Character.c)
Declare memWriteUni(handle, unicode.u)
Declare memWriteFloat(handle, float.f)
Declare memWriteDouble(handle, double.d)
Declare memWriteString(handle, text$, format = 0)
Declare memWriteString2(handle, text$, format = 0)
Declare memWriteData(handle, memoryBuffer, length)
Declare.c memReadChar(handle)
Declare.u memReadUni(handle)
Declare.l memReadLong(handle)
Declare.f memReadFloat(handle)
Declare.d memReadDouble(handle)
Declare memReadData(handle, memoryBuffer, lengthToRead)
Declare.s memReadString(handle, format=0)
Declare.s memReadString2(handle, format=0)
CompilerIf Not Defined(SB_Compiler_SpiderBasic, #PB_Constant)
Declare memWriteQuad(handle, quad.q)
Declare memWriteInt(handle, Integer.i)
Declare.b memReadByte(handle)
Declare.i memReadInt(handle)
Declare.q memReadQuad(handle)
CompilerElse
CompilerEndIf
EndDeclareModule
Module MF
EnableExplicit
; ======================================================================================================
;- Private Constants
; ======================================================================================================
#MEMORYFILE_NOCLEAR = 1
#MEMORYFILE_DEFAULTSTRSIZE = 260
; ======================================================================================================
;- Private Module Macros
; ======================================================================================================
Macro memPTR()
*Handle(handle)
EndMacro
Macro MakeFuncWrite( funcname, large, small )
Procedure.i funcname(handle, large.small)
Protected result.i, *ptr.large
result = memAllocateExtraBytes(handle, SizeOf(large))
If result
CompilerIf Defined(SB_Compiler_SpiderBasic, #PB_Constant)
poke#small( memPTR()\FileBase, memPTR()\filePointer, large )
CompilerElse
*ptr = memPTR()\FileBase + memPTR()\filePointer
*ptr\small = large
CompilerEndIf
memPTR()\filePointer+SizeOf(large)
If memPTR()\filePointer > memPTR()\usedFile
memPTR()\usedFile = memPTR()\filePointer
EndIf
EndIf
ProcedureReturn result
EndProcedure
EndMacro
Macro MakeFuncRead( funcname, large, small )
Procedure.small funcname(handle)
Protected result.small, *ptr.large
If memPTR()\filePointer <= memPTR()\usedFile - SizeOf(large)
CompilerIf Defined(SB_Compiler_SpiderBasic, #PB_Constant)
result = peek#small(memPTR()\fileBase, memPTR()\filePointer)
CompilerElse
*ptr = memPTR()\FileBase + memPTR()\filePointer
result = *ptr\small
CompilerEndIf
memPTR()\filePointer + SizeOf(large)
EndIf
If memPTR()\filePointer >= memPTR()\usedFile
memPTR()\EOF = #True
EndIf
ProcedureReturn result
EndProcedure
EndMacro
Macro CheckFormat()
If format <> #PB_Ascii And format <> #PB_UTF8 And format <> #PB_Unicode
CompilerIf #PB_Compiler_Unicode
format = #PB_Unicode
CompilerElse
format = #PB_Ascii
CompilerEndIf
EndIf
EndMacro
Macro AddNullSize( varlen )
If format = #PB_Ascii Or format = #PB_UTF8
varlen + 1
Else
varlen + 2
EndIf
EndMacro
CompilerIf Defined(SB_Compiler_SpiderBasic, #PB_Constant)
Procedure MemCpyOff(*dest, destoff, *src, srcoff, n)
EnableJS
destAr = new Uint8Array(p_dest);
srcAr = new Uint8Array(p_src);
destAr.set(srcAr.slice(v_srcoff, v_srcoff + v_n), v_destoff);
DisableJS
EndProcedure
Procedure StringByteLength(String$, Format = #PB_Unicode)
Protected sbl
Select Format
Case #PB_Ascii
sbl = Len(String$)
Case #PB_UTF8
! v_sbl = new Blob([v_string$]).size;
Default
sbl = Len(String$) << 1
EndSelect
ProcedureReturn sbl
EndProcedure
CompilerEndIf
; ======================================================================================================
;- Private Module Globals
; ======================================================================================================
Global gHandle = 1
; ======================================================================================================
;- Private Procedure Definitions
; ======================================================================================================
Declare memAllocateExtraBytes(handle, numBytes.i)
; ======================================================================================================
;- Private Module Function
; ======================================================================================================
EnableExplicit
Procedure.i memCreate( initialSize.i = 8192, pageSize.l = 4096 )
Protected handle
handle = gHandle
gHandle + 1
ReDim *Handle(gHandle)
memPTR() = AllocateStructure(_membersMemoryFileClass)
;Attempt to allocate the initial memory.
memPTR()\FileBase = AllocateMemory(initialSize, #PB_Memory_NoClear)
If memPTR()\FileBase
memPTR()\FileSize = initialSize
memPTR()\initialSize = initialSize
memPTR()\usedFile = 0
memPTR()\FilePointer = 0
memPTR()\pageSize = pageSize
memPTR()\initialPageSize= pageSize
;memPTR()\maxStringBytes = #MEMORYFILE_DEFAULTSTRSIZE
Else
FreeStructure(memPTR())
memPTR() = 0
ProcedureReturn 0
EndIf
ProcedureReturn handle
EndProcedure
Procedure.i memCreateFromPtr( *buffer, bufferSize, pageSize.l = 4096 )
Protected handle
handle = gHandle
gHandle + 1
ReDim *Handle(gHandle)
memPTR() = AllocateStructure(_membersMemoryFileClass)
memPTR()\FileBase = *buffer
memPTR()\FileSize = bufferSize
memPTR()\initialSize = bufferSize
memPTR()\usedFile = bufferSize
memPTR()\pageSize = pageSize
memPTR()\initialPageSize = pageSize
memPTR()\FilePointer = 0
memPTR()\flags = #MEMORYFILE_NOCLEAR
;memPTR()\maxStringBytes = #MEMORYFILE_DEFAULTSTRSIZE
ProcedureReturn handle
EndProcedure
Procedure.i memDestroy(handle)
If ( memPTR()\flags & #MEMORYFILE_NOCLEAR ) = 0
FreeMemory( memPTR()\FileBase)
EndIf
FreeStructure( *Handle(handle) )
*Handle(handle) = 0
EndProcedure
Procedure.i memFileSeek(handle, newOffset.i)
Protected result.i
If newOffset >= 0 And newOffset <= memPTR()\usedFile
memPTR()\filePointer = newOffset
result = 1
If newOffset < memPTR()\usedFile
memPTR()\eof = 0
EndIf
ElseIf newOffset > memPTR()\usedFile ;Here we may have to enlarge the file.
result = memAllocateExtraBytes(handle, newOffset - memPTR()\filePointer )
If result
memPTR()\filePointer = newOffset
memPTR()\usedFile = newOffset
EndIf
memPTR()\eof = 0
EndIf
ProcedureReturn result
EndProcedure
Procedure.i memReset(handle, newInitialSize=-1)
Protected result.i, i.i
If newInitialSize <= 0
newInitialSize = memPTR()\initialSize
EndIf
result = ReAllocateMemory(memPTR()\fileBase, newInitialSize,#PB_Memory_NoClear)
If result
memPTR()\initialSize = newInitialSize
memPTR()\fileBase = result
memPTR()\fileSize = memPTR()\initialSize
memPTR()\pageSize = memPTR()\initialPageSize
memPTR()\usedFile = 0
memPTR()\filePointer = 0
memPTR()\blnErrorReported = 0
memPTR()\eof = 0
;memPTR()\maxStringBytes = #MEMORYFILE_DEFAULTSTRSIZE
EndIf
ProcedureReturn result
EndProcedure
;- Write funcitons
MakeFuncWrite(memWriteByte, byte, b)
MakeFuncWrite(memWriteWord, word, w)
MakeFuncWrite(memWriteLong, long, l)
MakeFuncWrite(memWriteFloat, Float, f)
MakeFuncWrite(memWriteDouble, double, d)
MakeFuncWrite(memWriteChar, Character, c )
MakeFuncWrite(memWriteUni, Unicode, u )
CompilerIf Not Defined(SB_Compiler_SpiderBasic, #PB_Constant)
MakeFuncWrite(memWriteQuad, Quad, q)
MakeFuncWrite(memWriteInt, Integer, i)
CompilerEndIf
;- At the moment this doesn't work with SB
Procedure memWriteString(handle, text$, format = 0)
Protected result.i, ptr.i, byteLength.i, *p
CheckFormat()
byteLength = StringByteLength( text$, format )
AddNullSize( byteLength )
result = memAllocateExtraBytes( handle, byteLength )
If result
CompilerIf Defined(SB_Compiler_SpiderBasic, #PB_Constant)
*p = AllocateMemory( byteLength )
PokeS(*p, 0, text$,byteLength,format)
MemCpyOff(memPTR()\FileBase, memPTR()\filePointer, *p, 0,byteLength)
FreeMemory( *p )
CompilerElse
ptr = memPTR()\FileBase + memPTR()\filePointer
PokeS(ptr, text$, byteLength, format)
CompilerEndIf
memPTR()\filePointer+byteLength
If memPTR()\filePointer > memPTR()\usedFile
memPTR()\usedFile = memPTR()\filePointer
EndIf
EndIf
ProcedureReturn result
EndProcedure
Procedure memWriteString2(handle, text$, format = 0)
Protected result.i, ptr, *p, w.w, *wp.WORD
CheckFormat()
w = StringByteLength( text$, format )
AddNullSize( w )
result = memAllocateExtraBytes( handle, w + SizeOf(word) )
If result
CompilerIf Defined(SB_Compiler_SpiderBasic, #PB_Constant)
PokeW( memPTR()\FileBase, memPTR()\filePointer, w )
*p = AllocateMemory( w, #PB_Memory_NoClear )
PokeS( *p, 0, text$, -1, format )
MemCpyOff( memPTR()\FileBase, memPTR()\filePointer + SizeOf(word), *p, 0, w )
FreeMemory( *p )
CompilerElse
*wp = memPTR()\FileBase + memPTR()\filePointer
*wp\w = w
ptr = memPTR()\FileBase + memPTR()\filePointer + SizeOf( word)
PokeS(ptr, text$, -1, format)
CompilerEndIf
w + SizeOf(word)
memPTR()\filePointer + w
If memPTR()\filePointer > memPTR()\usedFile
memPTR()\usedFile = memPTR()\filePointer
EndIf
EndIf
ProcedureReturn result
EndProcedure
Procedure.i memWriteData(handle, memoryBuffer, length)
Protected result.i, i
result = memAllocateExtraBytes(handle, length)
If result
CompilerIf Defined(SB_Compiler_SpiderBasic, #PB_Constant)
MemCpyOff( memPTR()\FileBase, memPTR()\filePointer, memoryBuffer, 0, length)
CompilerElse
CopyMemory(memoryBuffer, memPTR()\FileBase + memPTR()\filePointer, length)
CompilerEndIf
memPTR()\filePointer+length
If memPTR()\filePointer > memPTR()\usedFile
memPTR()\usedFile = memPTR()\filePointer
EndIf
EndIf
ProcedureReturn result
EndProcedure
;- Read functions
MakeFuncRead( memReadByte,byte, b)
MakeFuncRead( memReadWord,word,w)
MakeFuncRead( memReadLong,long,l)
MakeFuncRead( memReadFloat,float,f)
MakeFuncRead( memReadDouble,double,d)
MakeFuncRead( memReadChar,Character,c)
MakeFuncRead( memReadUni,Unicode,u)
CompilerIf Not Defined(SB_Compiler_SpiderBasic, #PB_Constant)
MakeFuncRead( memReadQuad,quad,q)
MakeFuncRead( memReadInt,Integer,i)
CompilerEndIf
;- At the moment this doesn't work with SB
Procedure.s memReadString(handle, format=0)
Protected result$, byteLength.i, *p, i
CheckFormat()
If memPTR()\filePointer < memPtr()\usedFile
CompilerIf Defined(SB_Compiler_SpiderBasic, #PB_Constant)
result$ = PeekS( memPTR()\FileBase, memPTR()\filePointer, -1, format )
CompilerElse
*p = memPTR()\FileBase + memPTR()\filePointer
result$ = PeekS( *p, -1, format )
CompilerEndIf
byteLength = StringByteLength( result$, format )
AddNullSize( byteLength )
memPtr()\filePointer + byteLength
If memPtr()\filePointer >= memPtr()\usedFile
memPtr()\filePointer = memPtr()\usedFile
memPTR()\EOF = #True
EndIf
EndIf
ProcedureReturn result$
EndProcedure
;Originally needed
;*p = AllocateMemory( w + 2 )
;MemCpyOff( *p, 0, memPTR()\fileBase, memPTR()\filePointer + SizeOf(word), w )
;result$ = PeekS( *p, 0, w, format )
;FreeMemory( *p )
Procedure.s memReadString2(handle, format=0)
Protected result$, *p.Character, i, w.w, *ptr.word
CheckFormat()
If memPTR()\filePointer < memPtr()\usedFile
CompilerIf Defined(SB_Compiler_SpiderBasic, #PB_Constant)
w = PeekW(memPTR()\fileBase, memPTR()\filePointer)
result$ = PeekS( *p, 0, w, format )
CompilerElse
*ptr = memPTR()\FileBase + memPTR()\filePointer
w = *ptr\w
*p = memPTR()\FileBase + memPTR()\filePointer + SizeOf(word)
result$ = PeekS( *p, -1, format )
CompilerEndIf
w + SizeOf(word)
memPtr()\filePointer + w
If memPtr()\filePointer >= memPtr()\usedFile
memPtr()\filePointer = memPtr()\usedFile
memPTR()\EOF = #True
EndIf
EndIf
ProcedureReturn result$
EndProcedure
Procedure.i memReadData(handle, memoryBuffer, lengthToRead)
Protected i
If memoryBuffer And lengthToRead > 0
If memPTR()\filePointer > memPTR()\usedFile - lengthToRead
lengthToRead = memPTR()\usedFile - memPTR()\filePointer
EndIf
If lengthToRead > 0
CompilerIf Defined(SB_Compiler_SpiderBasic, #PB_Constant)
MemCpyOff(memoryBuffer, 0, memPTR()\FileBase, memPTR()\filePointer, lengthToRead)
CompilerElse
CopyMemory(memPTR()\FileBase + memPTR()\filePointer, memoryBuffer, lengthToRead)
CompilerEndIf
memPTR()\filePointer + lengthToRead
If memPtr()\filePointer >= memPtr()\usedFile
memPTR()\EOF = #True
EndIf
EndIf
EndIf
ProcedureReturn lengthToRead
EndProcedure
;///////////////
;-INTERNAL FUNCTIONS.
;/////////////////////////////////////////////////////////////////////////////////
;The following function decides if extra memory is required in order to accommodate the specified additional number of bytes.
;If so, an attempt is made to allocate the extra memory etc.
;Returns zero if an error.
Procedure.i memAllocateExtraBytes(handle, numBytes.i)
Protected result.i = 1
Protected extraPages.i, memBytes.i, mem.i
extraPages = memPTR()\filePointer + numBytes - memPTR()\FileSize
If extraPages > 0
;How many extra pages of memory do we require?
extraPages + memPTR()\pageSize - 1
extraPages / memPTR()\pageSize
;How many bytes is this in total that we need?
memBytes = memPTR()\FileSize + extraPages * memPTR()\pageSize
;Attempt to reallocate the File memory.
result = ReAllocateMemory(memPTR()\FileBase, memBytes)
If result
memPTR()\FileBase = result
memPTR()\FileSize = memBytes
result = 1
Else
memPTR()\blnErrorReported = #True
EndIf
EndIf
ProcedureReturn result
EndProcedure
EndModule
CompilerIf #PB_Compiler_IsMainFile
;-- Module demo 1
UseWrite2 = #False
Debug "Example 1: Started"
Define handle = MF::memCreate()
If handle ;Always check that the object was created successfully.
;Let us write some doubles to the buffer.
For i = 0 To 9
MF::memWriteDouble(handle, i+0.5)
Next
;Take a look how much data has been written (assuming that none of the write operations returned any errors - which we should have checked!)
count = MF::memLof(handle)
Debug "Written " + Str(count) + " bytes in total."
Debug "==================="
;Let us take a look at the data.
MF::memFileSeek(handle,0)
Debug "Doubles written ....."
While MF::memEof(handle) = #False
Debug " " + StrD(MF::memReadDouble(handle))
Wend
Debug "==================="
Debug ""
;Let us append some 'longs'. The file pointer is already at the end of the file.
currentPos = MF::memLoc(handle) ;So that we can return to this point later.
For i = 0 To 9
MF::memWriteLong(handle,i*1000)
Next
;Take a look how much data has been written (assuming that none of the write operations returned any errors - which we should have checked!)
count = MF::memLof(handle)
Debug "Written " + Str(count) + " bytes in total."
Debug "==================="
;Let us take a look at the data.
MF::memFileSeek(handle,currentPos)
Debug "Longs appended ....."
While MF::memEof(handle) = 0
Debug " " + Str(MF::memReadLong(handle))
Wend
Debug "==================="
Debug ""
;We test data read/write
currentPos = MF::memLoc(handle) ;So that we can return to this point later.
*p = AllocateMemory( 100 )
str$ = "half a string , of half a string"
CompilerIf Defined(MF::SB_Compiler_SpiderBasic, #PB_Constant)
len = PokeS( *p, 0, str$, -1, #PB_Unicode ) + 2
CompilerElse
len = PokeS( *p, str$, -1, #PB_Unicode ) + 2
CompilerEndIf
Debug "Saving to memory: " + str$
MF::memWriteData(handle,*p, len)
FreeMemory (*p )
*p = AllocateMemory( 100 )
count = MF::memLof(handle)
Debug "Written " + Str(count) + " bytes in total."
Debug "==================="
MF::memFileSeek(handle,currentPos)
;Read only hald a string
len = len >> 1
MF::memReadData(handle,*p, len)
CompilerIf Defined(MF::SB_Compiler_SpiderBasic, #PB_Constant)
Debug PeekS( *p, 0, -1, #PB_Unicode ) + " (Data Read)"
CompilerElse
Debug PeekS( *p, -1, #PB_Unicode ) + " (Data Read)"
CompilerEndIf
Debug ""
type = #PB_Unicode
MF::memFileSeek(handle,count)
;Let us add a couple of strings in utf-8 format! (These include null terminators!)
currentPos = MF::memLoc(handle) ;So that we can return to this point later.
If UseWrite2 = #False
MF::memWriteString(handle,"Hello my old muse and abuse!", type)
MF::memWriteString(handle,"How about sausages with the soup?",type)
Else
MF::memWriteString2(handle,"Hello my old muse and abuse!", type)
MF::memWriteString2(handle,"How about sausages with the soup?",type)
EndIf
;Take a look how much data has been written (assuming that none of the write operations returned any errors - which we should have checked!)
count = MF::memLof(handle)
Debug "Written " + Str(count) + " bytes in total."
Debug "==================="
;Let us take a look at the data.
MF::memFileSeek(handle,currentPos)
Debug "Strings appended ....."
While MF::memEof(handle) = 0
If UseWrite2 = #False
Debug " " + MF::memReadString(handle, type)
Else
Debug " " + MF::memReadString2(handle, type)
EndIf
Wend
Debug "==================="
currentPos = MF::memLoc(handle)
Debug "Pos=" + Str(currentPos)
MF::memWriteDouble(handle, 22/7 )
MF::memFileSeek(handle,currentPos)
Debug "Final Double: " + StrD( MF::memReadDouble(handle) )
;Destroy the array once it is no longer required.
;By not setting the optional parameter to #False, we are opting to free the memory buffer itself (on top of deleting the object).
FreeMemory( *p )
MF::memDestroy(handle)
Debug "Example 1: done"
;-- Module demo 2
Debug "-----------------------------------"
Debug "Example 2: Start"
Debug "-----------------------------------"
*p = AllocateMemory( 100 )
ptr = *p
CompilerIf Defined(MF::SB_Compiler_SpiderBasic, #PB_Constant)
i = PokeS( *p, 0, "MemoryFileSystem" )
PokeL( *p, i + SizeOf(Character), i )
CompilerElse
i = PokeS( *p, "MemoryFileSystem" )
ptr + i + SizeOf(Character)
PokeL( ptr, i )
CompilerEndIf
i + SizeOf( Character ) + SizeOf( long )
h = MF::memCreateFromPtr( *p, 100 )
MF::memFileSeek(h,i)
MF::memWriteDouble(h, 22/7 )
MF::memFileSeek(h,i)
Debug "Final Double: " + StrD( MF::memReadDouble(h) )
MF::memFileSeek(h,0)
Debug MF::memReadString(h)
Debug MF::memReadLong(h)
MF::memDestroy(h)
Debug "-----------------------------------"
Debug "Example 2: done"
Debug "-----------------------------------"
Else
Debug "Error : There was a memory allocation problem creating the memory buffer object."
EndIf
CompilerEndIf