MemPrint and MemInput - SMcNeill - 08-22-2022
So, if there's a few absolute things that I've learned about what folks say about QB64 from over the years, two of the most prevalent have to be:
1) MEM IS HARD!! IT'S NOT FOR BEGINNERS!!
2) Opening files for INPUT and OUTPUT is the most basic of BASIC. *EVERYONE* knows how to do this -- if not, then they'll learn it by the second lesson on learning QB64...
Now, I'm not saying I agree with point 1 -- I truly don't think that mem is all that hard to learn and use, which is why I've made videos and written a bazillion words on how to help folks understand it. BUT, even after all that, the general consensus is "Mem is hard and not for beginners!"
But... What if I told you guys that I was working on a way to bring those two concepts together?? That I was making a means so that one could use _MEM just as easily as they can use LINE INPUT and PRINT??
Don't believe it??
Then let me present.... Dum Dum De Dummmm:
Code: (Select All) Type Mem_File_Type
inUse As Integer
EOF_Marker As _Offset
Current_Pos As _Offset
Content As _MEM
End Type
Dim Shared MemFile(1 To 100) As Mem_File_Type
'BI HEADER INFO BEFORE THIS
handle = MemFileOpen
MemPrint handle, "Hello World", 1
MemPrint handle, "My name is Steve", 1
MemSeek handle, 0
Do Until MemEOF(handle)
MemLineInput handle, temp$
Print temp$
Loop
'BM FOOTER INFO AFTER THIS
Function MemFileOpen
'Error codes for MemFileOpen
'1: No mem files available. (All 100 are in use! Free some to use more!)
For i = 1 To 100
If MemFile(i).inUse = 0 Then Exit For
Next
If i > 100 Then MemFileOpen = 0 'can't open any more memfiles!
MemFileOpen = i
MemFile(i).inUse = -1 'TRUE
MemFile(i).EOF_Marker = 0 'nothing is written in the file to begin with
MemFile(i).Current_Pos = 0 'and we're at the start of our nothing in the file
MemFile(i).Content = _MemNew(1000000) '1mb memfile by default
$Checking:Off
_MemFill MemFile(i).Content, MemFile(i).Content.OFFSET, MemFile(i).Content.SIZE, 0 As _UNSIGNED _BYTE
'make certain to blank the file when opening it for the first time so we don't have unwanted characters in it.
$Checking:On
End Function
Function MemEOF (memfile)
If MemFile(memfile).inUse = 0 Then Error 53: Exit Function 'File Not Found Error message
If MemFile(memfile).Current_Pos >= MemFile(memfile).EOF_Marker Then MemEOF = -1
End Function
Sub MemSeek (memfile, position As _Offset)
If MemFile(memfile).inUse = 0 Then Error 53: Exit Sub 'File Not Found Error message
If position < 0 Then Error 5: Exit Sub 'Invalid Function Call
If position > MemFile(memfile).EOF_Marker Then Error 5: Exit Sub 'Invalid Function Call
MemFile(memfile).Current_Pos = position
End Sub
Sub MemLineInput (memfile, what$)
'only valid line endings here are CHR$(10), chr$(13), and chr$(13) + chr$(10)
If MemFile(memfile).inUse = 0 Then Error 53: Exit Sub 'File Not Found Error message
Dim As _Offset CP, EP, Size, L
Dim tempM As _MEM
tempM = MemFile(memfile).Content 'it's just much shorter to type!
CP = MemFile(memfile).Current_Pos
EP = MemFile(memfile).EOF_Marker
If CP >= EP Then Error 62: Exit Sub 'INPUT PAST END OF FILE error
Size = tempM.SIZE
Do
a$ = _MemGet(tempM, tempM.OFFSET + CP, String * 1)
Select Case a$
Case Chr$(13)
a1$ = _MemGet(tempM, tempM.OFFSET + CP + 1, String * 1)
If al$ = Chr$(10) Then CP = CP + 1 'move the Current Pointer past the 2nd character in a windows CRLF ending
finished = -1
Case Chr$(10)
finished = -1
Case Else
temp$ = temp$ + a$
End Select
CP = CP + 1
If CP >= EP Then finished = -1
Loop Until finished
MemFile(memfile).Current_Pos = CP
what$ = temp$
End Sub
Sub MemPrint (memfile, what$, EOL_Type As Integer)
'memfile is the memfile handle to print to
'what$ is what we want to print
'EOL_Type is the type of line ending we want after this print statement
'1: This is a CHR$(10) line ending (Linux style line ending)
'2: This is a CHR$(13) line ending (Old Mac style line ending)
'3: This is a CHR$(13) + CHR$(10) line ending (Old Windows style line ending)
'4: This is a COMMA line ending. Use this if writing continous CSV fields.
' (Think PRINT #1, stuff$, <-- see the comma there at the end of the print statement??)
If MemFile(memfile).inUse = 0 Then Error 53: Exit Sub 'File Not Found Error message
Dim CRLF As String
Dim As _Offset CP, EP, Size, L
Select Case EOL_Type
Case 1: CRLF = Chr$(10)
Case 2: CRLF = Chr$(13)
Case 3: CRLF = Chr$(13) + Chr$(10)
Case 4: CRLF = ","
End Select
CP = MemFile(memfile).Current_Pos
EP = MemFile(memfile).EOF_Marker
Size = MemFile(memfile).Content.SIZE
L = Len(what$) + Len(CRLF)
If CP + L > Size Then 'we're writing beyond the bounds of our reserved memory!
Dim tempM As _MEM
recheck:
If Size <= 100000000 Then 'resize our memblock (to the limit) to save our data
tempM = _MemNew(Size * 10)
_MemCopy MemFile(memfile).Content, MemFile(memfile).Content.OFFSET, Size To tempM, tempM.OFFSET
_MemFree MemFile(memfile).Content
MemFile(memfile).Content = tempM
Size = Size * 10
GoTo recheck 'just to make certain that our reserved memory is now large enough to hold our data
Else
Error 61 'DISK FULL ERROR MESSAGE
Exit Sub 'I'm coding a hard size limit of 1GB for each memfile opened!
' Anything larger than that, and I'm tossing a Disk Full Error
End If
End If
_MemPut MemFile(memfile).Content, MemFile(memfile).Content.OFFSET + CP, what$ + CRLF
MemFile(memfile).Current_Pos = CP + L
If CP + L > EP Then MemFile(memfile).EOF_Marker = CP + L
End Sub
Here's the main code of relevance for the end user -- see how it'd compare to a normal file being opened in QB64:
Code: (Select All) handle = MemFileOpen
MemPrint handle, "Hello World", 1
MemPrint handle, "My name is Steve", 1
MemSeek handle, 0
Do Until MemEOF(handle)
MemLineInput handle, temp$
Print temp$
Loop
The very first line here is a wee bit odd, but think of it as: handle = FREEFILE It basically gives you a free handle and readies a block of memory for you to make use of.
PRINT #1, "Hello World"
PRINT #1, "My name is Steve"
Hopefully you can see where the next lines would match up to a simple file PRINT statement? That , 1 at the end there is basically the way of telling the program what file ending we want, or if we want to toss a comma at the end of this data, for CSVs. (Think of it as being PRINT #1, "Hello World", <-- do we put that comma there at the end, or not??) ,1 says we're going with a normal CHR$(10) file ending at the end of the data.
The MemSeek is basically the same as the SEEK statement, with the exception that we start at position 0 rather than position 1. (I may adjust this later, if folks feel its necessary.)
DO UNTIL EOF(1)
LINE INPUT #1, temp$
PRINT temp$
LOOP
And the next few lines should definitely be noticeably comparable to the file LINE INPUT method. Right?
It's all in mem... but it's simple PRINT and LINE INPUT style commands...
Is your mind blown yet??
Yet to do:
There needs to be a CLOSE statement to close the files and free the memory for good.
I also want to add 2 quick commands : MemFileSave -- to save the mem block to disk. MemFileLoad -- to load the file back into memory.
And what's the purpose to such a system?? Besides trying to make use of the speed of using mem?
To reduce disk reads and writes as much as possible and save wear and usage of SSDs. Load the whole file at once. Save the whole file at once. Otherwise, just read and write to a mem block exactly as you normally would a file! No need to track offsets. No _memget or _memput.... Just simple PRINT and INPUT file access like folks are used to doing already.
Any and all comments and feedback is appreciated. Post questions and suggestions galore! Honestly, I'd say this is already 90% finished. If anyone has any specific user requests, get them in *now*, before I wrap this up in the next day or so, and move on to something else.
RE: MemPrint and MemInput - OldMoses - 08-22-2022
I've been playing with _MEM commands, off and on, for a little while now. So far I've used it for array manipulation mostly. Copying contents to temporary arrays, picking out UDT fields for sorting, etc. I agree that it isn't really that hard to work with in its simplest forms and often eliminates lots of iteration routines.
I know you can use _MEMIMAGE to point to an image memory block, and I've played around with picking out discreet sections of images and done things like converted to negative and greyscale.
A question (perhaps a stupid one) occurred to me recently. You can point a mem pointer to an image handle, but can you define a _MEMNEW block and, after doing stuff with it, then assign an image handle to that block? or do you have to define a _NEWIMAGE handle first? I assume that height and width would have to be supplied somehow, in order for it to work, which is the reason for _MEMIMAGE in the first place.
RE: MemPrint and MemInput - SMcNeill - 08-22-2022
There's no "reverse" on _MEMNEW. Once you use it, it's manual handling of that block from that point on.
The easiest way to do what you're suggesting is:
handle = _MEMNEW... sizes as needed
DIM tempM AS _mem
tempM = _MEMIMAGE(handle)
then just _MEMCOPY the memnew block to the tempM which points to the image.
Images hold a lot more info than you think. Length, height, bits per pixel, palette, font, blend on/off, print cursor x/y info, current background/foreground colors.... lots of stuff that a memnew block wouldn't track at all.
RE: MemPrint and MemInput - SMcNeill - 08-22-2022
Updated these to help showcase a bit of how useful they can be for us.
Code: (Select All) Type Mem_File_Type
inUse As Integer
EOF_Marker As _Offset
Current_Pos As _Offset
Content As _MEM
End Type
Dim Shared MemFile(1 To 100) As Mem_File_Type
'BI HEADER INFO BEFORE THIS
'first, let's showcase how to print and input some information to and from memory
handle = MemFileOpen ' This is a combination FREEFILE + OPEN statement
MemPrint handle, "Hello World", 1 ' PRINT #filehandle, whatever$ + CRLF
MemPrint handle, "My name is Steve", 1 ' PRINT #filehandle, whatever$ + CRLF
MemSeek handle, 0 ' SEEK #filehandle, byte
Do Until MemEOF(handle) ' DO UNTIL EOF(filehandle)
MemLineInput handle, temp$ ' LINE INPUT #filehandle, temp$
Print temp$ ' PRINT temp$
Loop ' LOOP
MemFileClose handle ' CLOSE filehandle
'I hope the above with the comments help to highlight how exactly similar the two syntaxes are here.
'With these mem routines, we're basically just using mem *exactly* as we'd do basic file access with PRINT and LINE INPUT
'And let's showcase a bit more of how this works, why don't we.
Dim As String wordlist(466544), wordlist2(466544), wordlist3(466544) 'arrays to hold the data
'MEM FILE INPUT
handle = MemFileLoad("466544 Word List.txt", 0) 'load a file directly into memory, and it's not compressed
t## = Timer ' timer to see how long we take loading this data
Do Until MemEOF(handle) ' Hopefully these lines will be intuitive enough.
count = count + 1 ' Especially when compared to the notes above
MemLineInput handle, wordlist(count) ' and the preceeding lines after
Loop
Print count; Using " words loaded into memory from file, in ##.#### seconds."; Timer - t##
MemFileClose handle
'OPEN FILE FOR INPUT
Open "466544 Word List.txt" For Input As #1
t## = Timer
Do Until EOF(1)
count2 = count2 + 1
Line Input #1, wordlist2(count2)
Loop
Print count2; Using " words loaded from file OPEN FOR INPUT, in ##.#### seconds."; Timer - t##
Close handle
'OPEN FILE FOR BINARY
Open "466544 Word List.txt" For Binary As #1
t## = Timer
Do Until EOF(1)
count3 = count3 + 1
Line Input #1, wordlist3(count3)
Loop
Print count3; Using " words loaded from file OPEN FOR BINARY, in ##.#### seconds."; Timer - t##
Close handle
'and let's compare contents to be safe
For i = 1 To count
If wordlist(i) <> wordlist2(i) Then Print "Wordlist does not match Wordlist2": failed = -1
If wordlist(i) <> wordlist3(i) Then Print "Wordlist does not match Wordlist3": failed = -1
Next
If failed Then
Print "Lists do not match"
Else
Print "Lists match each other perfectly"
End If
'BM FOOTER AFTER THIS
Function MemFileLoad (file$, compressed)
'Error codes for MemFileLoad
'1: No mem files available. (All 100 are in use! Free some to use more!)
For i = 1 To 100
If MemFile(i).inUse = 0 Then Exit For
Next
If i > 100 Then MemFileLoad = 0: Exit Function 'can't open any more memfiles!
If _FileExists(file$) = 0 Then Error 53: Exit Function 'file not found
MemFileLoad = i
temphandle = FreeFile
Open file$ For Binary As #temphandle
temp$ = Space$(LOF(temphandle))
Get temphandle, 1, temp$
Close temphandle
If compressed Then temp$ = _Deflate$(temp$)
length = Len(temp$)
MemFile(i).Content = _MemNew(length)
$Checking:Off
_MemPut MemFile(i).Content, MemFile(i).Content.OFFSET, temp$
$Checking:On
MemFile(i).inUse = -1 'TRUE
MemFile(i).EOF_Marker = length - 1 'the end of the file is the length of the file to begin with
MemFile(i).Current_Pos = 0 'and we're at the start of our nothing in the file
End Function
Sub MemFileClose (memfile)
If memfile < 1 Or memfile > 100 Then Error 5: Exit Sub 'ILLEGAL FUNCTION CALL
MemFile(memfile).inUse = 0 'no longer in sue
MemFile(memfile).EOF_Marker = 0 'nothing is written in the file to begin with
MemFile(memfile).Current_Pos = 0 'and we're at the start of our nothing in the file
_MemFree MemFile(memfile).Content 'free the memory we were using
End Sub
Function MemFileOpen
'Error codes for MemFileOpen
'1: No mem files available. (All 100 are in use! Free some to use more!)
For i = 1 To 100
If MemFile(i).inUse = 0 Then Exit For
Next
If i > 100 Then MemFileOpen = 0: Exit Function 'can't open any more memfiles!
MemFileOpen = i
MemFile(i).inUse = -1 'TRUE
MemFile(i).EOF_Marker = 0 'nothing is written in the file to begin with
MemFile(i).Current_Pos = 0 'and we're at the start of our nothing in the file
MemFile(i).Content = _MemNew(1000000) '1mb memfile by default
$Checking:Off
_MemFill MemFile(i).Content, MemFile(i).Content.OFFSET, MemFile(i).Content.SIZE, 0 As _UNSIGNED _BYTE
'make certain to blank the file when opening it for the first time so we don't have unwanted characters in it.
$Checking:On
End Function
Function MemEOF (memfile)
If MemFile(memfile).inUse = 0 Then Error 53: Exit Function 'File Not Found Error message
If MemFile(memfile).Current_Pos >= MemFile(memfile).EOF_Marker Then MemEOF = -1
End Function
Sub MemSeek (memfile, position As _Offset)
If MemFile(memfile).inUse = 0 Then Error 53: Exit Sub 'File Not Found Error message
If position < 0 Then Error 5: Exit Sub 'Invalid Function Call
If position > MemFile(memfile).EOF_Marker Then Error 5: Exit Sub 'Invalid Function Call
MemFile(memfile).Current_Pos = position
End Sub
Sub MemLineInput (memfile, what$)
'only valid line endings here are CHR$(10), chr$(13), and chr$(13) + chr$(10)
If MemFile(memfile).inUse = 0 Then Error 53: Exit Sub 'File Not Found Error message
Dim As _Offset CP, EP, Size, L
Dim tempM As _MEM, a1 As _Unsigned _Byte
tempM = MemFile(memfile).Content 'it's just much shorter to type!
CP = MemFile(memfile).Current_Pos
EP = MemFile(memfile).EOF_Marker
If CP >= EP Then Error 62: Exit Sub 'INPUT PAST END OF FILE error
Size = tempM.SIZE
Do
a$ = _MemGet(tempM, tempM.OFFSET + CP, String * 1)
Select Case a$
Case Chr$(13)
_MemGet tempM, tempM.OFFSET + CP + 1, a1
If a1 = 10 Then CP = CP + 1 'move the Current Pointer past the 2nd character in a windows CRLF ending
finished = -1
Case Chr$(10)
finished = -1
Case Else
temp$ = temp$ + a$
End Select
CP = CP + 1
If CP >= EP Then finished = -1
Loop Until finished
MemFile(memfile).Current_Pos = CP
what$ = temp$
End Sub
Sub MemPrint (memfile, what$, EOL_Type As Integer)
'memfile is the memfile handle to print to
'what$ is what we want to print
'EOL_Type is the type of line ending we want after this print statement
'1: This is a CHR$(10) line ending (Linux style line ending)
'2: This is a CHR$(13) line ending (Old Mac style line ending)
'3: This is a CHR$(13) + CHR$(10) line ending (Old Windows style line ending)
'4: This is a COMMA line ending. Use this if writing continous CSV fields.
' (Think PRINT #1, stuff$, <-- see the comma there at the end of the print statement??)
If MemFile(memfile).inUse = 0 Then Error 53: Exit Sub 'File Not Found Error message
Dim CRLF As String
Dim As _Offset CP, EP, Size, L
Select Case EOL_Type
Case 1: CRLF = Chr$(10)
Case 2: CRLF = Chr$(13)
Case 3: CRLF = Chr$(13) + Chr$(10)
Case 4: CRLF = ","
End Select
CP = MemFile(memfile).Current_Pos
EP = MemFile(memfile).EOF_Marker
Size = MemFile(memfile).Content.SIZE
L = Len(what$) + Len(CRLF)
If CP + L > Size Then 'we're writing beyond the bounds of our reserved memory!
Dim tempM As _MEM
recheck:
If Size <= 100000000 Then 'resize our memblock (to the limit) to save our data
tempM = _MemNew(Size * 10)
_MemCopy MemFile(memfile).Content, MemFile(memfile).Content.OFFSET, Size To tempM, tempM.OFFSET
_MemFree MemFile(memfile).Content
MemFile(memfile).Content = tempM
Size = Size * 10
GoTo recheck 'just to make certain that our reserved memory is now large enough to hold our data
Else
Error 61 'DISK FULL ERROR MESSAGE
Exit Sub 'I'm coding a hard size limit of 1GB for each memfile opened!
' Anything larger than that, and I'm tossing a Disk Full Error
End If
End If
_MemPut MemFile(memfile).Content, MemFile(memfile).Content.OFFSET + CP, what$ + CRLF
MemFile(memfile).Current_Pos = CP + L
If CP + L > EP Then MemFile(memfile).EOF_Marker = CP + L
End Sub
As you can see, we now have a MemFileClose routine which we can use to close and free our old mem blocks and file handles. We also now have a nice little MemFileOpen which we can use to directly load a file into memory so we can work with it with the MemPrint and MemInput functions.
Note that you'll need the word list below so you can run the code and test it. Just download the attached 7z and extract the contents into your QB64 folder (or the folder where you save this BAS file at).
With the image above, you can see where I'm using 3 different methods to load my dictionary from the file and put it into an array so I could use it in a program later. Even without the use of $CHECKING:OFF and such (which I'll add *after* excessive testing and before I finalize this project), you can see which of the three methods is the fastest on my machine.
Not only does making use of MEM reduce the wear and tear on our hard drives, but it's also simply *faster* to boot!
And for those with a discerning eye, you may have noticed that our MemFileOpen holds a parameter for "Compressed"... That's not really useful at the moment, but once I get the MemFileSave routine added which basically dumps the entire file back to disk all at once, just as MemFileOpen loads it all at once, then it should be a nice feature for us. With one flip of that toggle, we'll be able to save compressed files to the disk and then load them back and uncompress them just as easily!
RE: MemPrint and MemInput - justsomeguy - 08-22-2022
Nice work!
I've been playing around _MEM functions as well. My main focus has been around string manipulation, just to see if I can squeeze a little more speed out string commands.
I have also been testing large text files and found that the fastest loading for me was to use the following method. It loads the entire file to a string. You can then follow up with _MEM functions.
Code: (Select All) SUB loadFileFast (file AS STRING, filetext AS STRING)
DIM AS LONG fileHandle, fileSize
IF _FILEEXISTS(file) THEN
fileHandle = FREEFILE
filetext = ""
' Open file just to retrieve its length
OPEN file FOR INPUT AS #fileHandle
fileSize = LOF(fileHandle)
CLOSE #fileHandle
' Now open it for real
OPEN file FOR RANDOM AS #fileHandle LEN = fileSize
FIELD #fileHandle, fileSize AS filetext
GET #fileHandle, 1
CLOSE #fileHandle
ELSE
PRINT "File '"; file; "' does not exist."
END
END IF
END SUB
The whole project seems to be an overall failure as most ideas just ended up being a bit slower, but I learned a lot. If anyone wants to take a look then here is the full listing.
Code: (Select All) '--------------------------------------------------------------
' Experimentation with _MEM commands and Strings
' by justsome guy
' 8/22/22
'-------------------------------------------------------------
OPTION _EXPLICIT
_TITLE "MEM Strings"
'--------------------------------------------------------------
' FPS setup
'--------------------------------------------------------------
DIM SHARED AS LONG fpsCount, fpsCurrent
DIM time AS LONG: time = _FREETIMER
ON TIMER(time, 1) fps
TIMER(time) ON
'--------------------------------------------------------------
' CONSTANTS
'--------------------------------------------------------------
CONST cMAXSTRINGLENGTH = 6000000
CONST cMAXBIGSTRINGLENGTH = 600000
CONST cTRUE = -1
CONST cFALSE = 0
'--------------------------------------------------------------
' ENTRY POINT
'--------------------------------------------------------------
Main
SUB ______Main_LOOP (): END SUB
SUB Main
DIM ti AS STRING * cMAXSTRINGLENGTH
loadFileFast _CWD$ + "/466544 Word List.txt", ti
DIM fpsStr AS STRING * cMAXSTRINGLENGTH
DIM pg AS STRING * cMAXSTRINGLENGTH
DIM ca1 AS STRING * cMAXSTRINGLENGTH
DIM ca2 AS STRING * cMAXSTRINGLENGTH
pg = "_mem console output."
ca1 = STRING$(cMAXSTRINGLENGTH, &H19) ' color and attribute info
ca2 = STRING$(cMAXSTRINGLENGTH, &H1A) ' color and attribute info
DO
' memConsolePrint can only accept fixed length strings, so
' you cannot just use 'memConsolePrint 1, "Hello",""' because
' "Hello" is not a fixed length string.
memConsolePrint 10, pg, ""
fpsStr = "fps:" + STR$(fpsCurrent)
memConsolePrint 60, fpsStr, ca1
memConsolePrint 160, memLeft$(ti, 1860), ca2
fpsCount = fpsCount + 1
LOOP UNTIL _KEYHIT = 27
END SUB
SUB ______CONSOLE_RELATED_SUBS (): END SUB
SUB memConsolePrint (position AS LONG, strng AS STRING * CMAXSTRINGLENGTH, attrib AS STRING * CMAXSTRINGLENGTH)
DIM AS _MEM consoleMem, strngMEM, attribMEM
DIM AS _UNSIGNED _BYTE b
DIM AS _UNSIGNED INTEGER m
' just set the default to white foreground and black back ground
IF attrib = "" THEN attrib = STRING$(cMAXSTRINGLENGTH, &H0F)
consoleMem = _MEMIMAGE
strngMEM = _MEM(strng)
attribMEM = _MEM(attrib)
DIM AS LONG strLen, attribLen, iter
$CHECKING:OFF
strLen = memLENFast(strng)
attribLen = memLENFast(attrib)
position = _SHL(position, 1)
IF position >= 0 AND position <= (consoleMem.SIZE - strLen) THEN
FOR iter = 0 TO strLen - 1
b = _MEMGET(strngMEM, strngMEM.OFFSET + iter, _UNSIGNED _BYTE)
IF b < 32 OR b > 127 THEN b = 32
m = b OR _SHL(_MEMGET(attribMEM, attribMEM.OFFSET + iter, _UNSIGNED _BYTE), 8)
_MEMPUT consoleMem, consoleMem.OFFSET + _SHL((iter), 1) + position, m AS _UNSIGNED INTEGER
NEXT
END IF
$CHECKING:ON
_MEMFREE consoleMem
_MEMFREE strngMEM
END SUB
SUB ______MEM_STRING_RELATED_SUBS (): END SUB
FUNCTION memLEN& (strng AS STRING * CMAXSTRINGLENGTH)
DIM AS _MEM inStringMEM
DIM AS _OFFSET iter, iterEnd
DIM AS LONG length
inStringMEM = _MEM(strng)
iterEnd = inStringMEM.OFFSET
iter = inStringMEM.OFFSET + inStringMEM.SIZE - 1
length = cMAXSTRINGLENGTH
$CHECKING:OFF
DO WHILE (_MEMGET(inStringMEM, iter, _UNSIGNED _BYTE) = 32 OR _MEMGET(inStringMEM, iter, _UNSIGNED _BYTE) = 0) AND iter > iterEnd
iter = iter - 1
length = length - 1
LOOP
$CHECKING:ON
memLEN = length
_MEMFREE inStringMEM
END FUNCTION
FUNCTION memLENFast& (strng AS STRING * CMAXSTRINGLENGTH)
DIM AS _MEM inStringMEM
DIM AS _OFFSET iter, iterEnd
DIM AS LONG length
DIM AS _UNSIGNED _INTEGER64 mem
DIM AS _UNSIGNED _BYTE mm
inStringMEM = _MEM(strng)
iterEnd = inStringMEM.OFFSET
iter = inStringMEM.OFFSET + inStringMEM.SIZE - 1
length = cMAXSTRINGLENGTH
$CHECKING:OFF
' Take off the big chunks
DO
mem = _MEMGET(inStringMEM, iter, _UNSIGNED _INTEGER64)
IF (mem = &H20 OR mem = &H0) AND iter > iterEnd THEN
iter = iter - 8
length = length - 8
ELSE
EXIT DO
END IF
LOOP
' Nibble at the rest
DO
mm = _MEMGET(inStringMEM, iter, _UNSIGNED _BYTE)
IF (mm = &H20 OR mm = &H0) AND iter > iterEnd THEN
iter = iter - 1
length = length - 1
ELSE
EXIT DO
END IF
LOOP
$CHECKING:ON
memLENFast = length
_MEMFREE inStringMEM
END FUNCTION
FUNCTION memConCat$ (strng1 AS STRING * CMAXSTRINGLENGTH, strng2 AS STRING * CMAXSTRINGLENGTH)
DIM AS _MEM inString1MEM, inString2MEM, outstringMEM
DIM AS LONG stringLENGTH1, stringLENGTH2
DIM AS _OFFSET stringSize1, stringSize2
DIM outString AS STRING * cMAXSTRINGLENGTH
inString1MEM = _MEM(strng1)
inString2MEM = _MEM(strng2)
outstringMEM = _MEM(outString)
stringSize1 = inString1MEM.SIZE
stringSize2 = inString2MEM.SIZE
stringLENGTH1 = memLEN(strng1)
stringLENGTH2 = memLEN(strng2)
IF stringLENGTH1 + stringLENGTH2 < cMAXSTRINGLENGTH THEN
_MEMCOPY inString1MEM, inString1MEM.OFFSET, stringLENGTH1 TO outstringMEM, outstringMEM.OFFSET
_MEMCOPY inString2MEM, inString2MEM.OFFSET, stringLENGTH2 TO outstringMEM, outstringMEM.OFFSET + stringLENGTH1
memConCat$ = outString
END IF
_MEMFREE inString1MEM
_MEMFREE inString2MEM
_MEMFREE outstringMEM
END FUNCTION
FUNCTION memMID$ (strng AS STRING * CMAXSTRINGLENGTH, start AS LONG, count AS LONG)
DIM outString AS STRING * cMAXSTRINGLENGTH
DIM AS _MEM inStringMEM, outStringMEM
inStringMEM = _MEM(strng)
outStringMEM = _MEM(outString)
IF start >= 1 AND start <= inStringMEM.SIZE AND count > 0 AND count <= inStringMEM.SIZE THEN
_MEMCOPY inStringMEM, inStringMEM.OFFSET + start - 1, count TO outStringMEM, outStringMEM.OFFSET
END IF
memMID$ = outString
_MEMFREE inStringMEM
_MEMFREE outStringMEM
END FUNCTION
FUNCTION memLeft$ (strng AS STRING * CMAXSTRINGLENGTH, count AS LONG)
memLeft$ = memMID$(strng, 1, count)
END FUNCTION
FUNCTION memRight$ (strng AS STRING * CMAXSTRINGLENGTH, count AS LONG)
DIM AS LONG ln: ln = memLEN(strng)
memRight$ = memMID$(strng, ln - count + 1, count)
END FUNCTION
FUNCTION memInsert$ (mainString AS STRING * CMAXSTRINGLENGTH, substring AS STRING * CMAXSTRINGLENGTH, position AS LONG)
DIM outString AS STRING * cMAXSTRINGLENGTH
DIM AS _MEM outStringMEM
DIM AS LONG ln
outStringMEM = _MEM(outString)
ln = memLEN(mainString)
outString = memConCat(memLeft(mainString, position), substring)
outString = memConCat(outString, memMID(mainString, position + 1, ln))
memInsert = outString
_MEMFREE outStringMEM
END FUNCTION
FUNCTION memInstr (start AS LONG, mainString AS STRING * CMAXSTRINGLENGTH, subString AS STRING * CMAXSTRINGLENGTH)
DIM AS _MEM mainMEM, subMEM
DIM AS LONG mainPos, subPos, mainLEN, subLEN, mainOffset
DIM AS _BYTE passFlag
mainMEM = _MEM(mainString)
subMEM = _MEM(subString)
mainLEN = memLEN(mainString)
subLEN = memLEN(subString)
IF start < 1 THEN start = 1
IF start > mainLEN THEN start = mainLEN
$CHECKING:OFF
FOR mainPos = start TO mainLEN - 1
passFlag = cTRUE
FOR subPos = 0 TO subLEN - 1
mainOffset = mainPos + subPos - 1
IF mainOffset >= mainMEM.SIZE OR subPos >= subMEM.SIZE THEN
passFlag = cFALSE
EXIT FOR
END IF
IF _MEMGET(mainMEM, mainMEM.OFFSET + mainOffset, _UNSIGNED _BYTE) <> _MEMGET(subMEM, subMEM.OFFSET + subPos, _UNSIGNED _BYTE) THEN
passFlag = cFALSE
EXIT FOR
END IF
NEXT
IF passFlag = cTRUE THEN
memInstr = mainPos
EXIT FUNCTION
END IF
NEXT
$CHECKING:ON
memInstr = 0
_MEMFREE mainMEM
_MEMFREE subMEM
END FUNCTION
SUB ______FPS_RELATED_SUBS (): END SUB
SUB fps ()
fpsCurrent = fpsCount
fpsCount = 0
END SUB
SUB ______FILE_RELATED_SUBS (): END SUB
SUB loadFileFast (file AS STRING, filetext AS STRING)
DIM AS LONG fileHandle, fileSize
IF _FILEEXISTS(file) THEN
fileHandle = FREEFILE
filetext = ""
' Open file just to retrieve its length
OPEN file FOR INPUT AS #fileHandle
fileSize = LOF(fileHandle)
CLOSE #fileHandle
' Now open it for real
OPEN file FOR RANDOM AS #fileHandle LEN = fileSize
FIELD #fileHandle, fileSize AS filetext
GET #fileHandle, 1
CLOSE #fileHandle
ELSE
PRINT "File '"; file; "' does not exist."
END
END IF
END SUB
SUB loadFile (file AS STRING, filetext AS STRING * CMAXSTRINGLENGTH)
DIM AS LONG fileHandle, position
DIM AS _MEM filetextMEM
DIM AS _UNSIGNED _BYTE ch
IF _FILEEXISTS(file) THEN
filetextMEM = _MEM(filetext)
fileHandle = FREEFILE
filetext = ""
position = 0
OPEN file FOR BINARY AS #fileHandle
DO UNTIL EOF(fileHandle)
GET #fileHandle, , ch
_MEMPUT filetextMEM, filetextMEM.OFFSET + position, ch
position = position + 1
LOOP
CLOSE #fileHandle
ELSE
PRINT "File or path '"; file; "' does not exist."
END
END IF
_MEMFREE filetextMEM
END SUB
' Do not use.
' Experimental stuff that doesn't quite work
SUB ______Experimental_SUBS (): END SUB
FUNCTION memStringImage (strng AS STRING * CMAXSTRINGLENGTH)
DIM AS _MEM strngMEM, strngIMGMEM
DIM AS LONG strngLEN, strngIMG
strngLEN = memLEN(strng)
strngMEM = _MEM(strng)
strngIMG = _NEWIMAGE(cMAXSTRINGLENGTH - 1, 1, 8)
strngIMGMEM = _MEMIMAGE(strngIMG)
_MEMCOPY strngMEM, strngMEM.OFFSET, strngLEN TO strngIMGMEM, strngIMGMEM.OFFSET
memStringImage = strngIMG
_MEMFREE strngIMGMEM
_MEMFREE strngMEM
END FUNCTION
SUB memPrintEx (position AS LONG, strngImg AS LONG)
DIM AS _MEM consoleMem, strngMEM
consoleMem = _MEMIMAGE(0)
strngMEM = _MEMIMAGE(strngImg)
DIM AS LONG strLen, iter
$CHECKING:OFF
strLen = memLENEX(strngImg)
position = _SHL(position, 1)
IF position >= 0 AND position <= (consoleMem.SIZE - strLen) THEN
FOR iter = 0 TO strLen - 1
_MEMPUT consoleMem, consoleMem.OFFSET + _SHL((iter), 1) + position, _MEMGET(strngMEM, strngMEM.OFFSET + iter, _UNSIGNED _BYTE) AS _UNSIGNED _BYTE
NEXT
END IF
$CHECKING:ON
_MEMFREE consoleMem
_MEMFREE strngMEM
END SUB
FUNCTION memLENEX~& (strng AS LONG)
DIM AS _MEM inStringMEM
DIM AS _OFFSET iter, iterEnd
DIM AS LONG length
inStringMEM = _MEMIMAGE(strng)
iterEnd = inStringMEM.OFFSET
iter = inStringMEM.OFFSET + inStringMEM.SIZE - 1
length = cMAXSTRINGLENGTH
$CHECKING:OFF
DO WHILE (_MEMGET(inStringMEM, iter, _UNSIGNED _BYTE) = 32 OR _MEMGET(inStringMEM, iter, _UNSIGNED _BYTE) = 0) AND iter > iterEnd
iter = iter - 1
length = length - 1
LOOP
PRINT
$CHECKING:ON
memLENEX = length
' PRINT "Length:"; length
_MEMFREE inStringMEM
END FUNCTION
RE: MemPrint and MemInput - SMcNeill - 08-22-2022
@justsomeguy Easiest way to load a whole file at once is this method:
OPEN "desired_file.txt" FOR BINARY AS #1
file_length = LOF(1)
file_contents$ = SPACE$(file_length)
GET #1, 1, file_contents$
CLOSE #1
Open the file
Get the length of file.
Set a string to be that length.
Read the whole file into that string.
Close the file.
RE: MemPrint and MemInput - SMcNeill - 08-22-2022
And we now have a way to easily save our mem file to disk.
Code: (Select All) Type Mem_File_Type
inUse As Integer
EOF_Marker As _Offset
Current_Pos As _Offset
Content As _MEM
End Type
Dim Shared MemFile(1 To 100) As Mem_File_Type
'BI HEADER INFO BEFORE THIS
'first, let's showcase how to print and input some information to and from memory
handle = MemFileOpen ' This is a combination FREEFILE + OPEN statement
MemPrint handle, "Hello World", 1 ' PRINT #filehandle, whatever$ + CRLF
MemPrint handle, "My name is Steve", 1 ' PRINT #filehandle, whatever$ + CRLF
For i = 1 To 10
MemPrint handle, Str$(i) + ") Record #" + _Trim$(Str$(i)), 1
Next
MemSeek handle, 0 ' SEEK #filehandle, byte
Do Until MemEOF(handle) ' DO UNTIL EOF(filehandle)
MemLineInput handle, temp$ ' LINE INPUT #filehandle, temp$
Print temp$ ' PRINT temp$
Loop ' LOOP
'I hope the above with the comments help to highlight how exactly similar the two syntaxes are here.
'With these mem routines, we're basically just using mem *exactly* as we'd do basic file access with PRINT and LINE INPUT
'And here I'll showcase how to save and load your memblock to disk -- both in compressed and uncompressed form
MemFileSave handle, "temp.txt", 0 ' 0 says save it in uncompressed format. You can read the data in any old text editor!
MemFileSave handle, "temp_compressed.txt", -1 ' Anything else says to compress the data before saving it. Not readable untl uncompressed.
Print
Print "Mem saved to disk in both compressed and uncompressed form."
Open "temp.txt" For Input As #1: LOF1 = LOF(1): Close
Open "temp_compressed.txt" For Input As #1: LOF2 = LOF(1): Close
Print "unCompressed file is "; LOF1; "bytes in size."
Print "Compressed file is "; LOF2; "bytes in size."
MemFileClose handle ' CLOSE filehandle
_KeyClear
Print "Now to load back the file with the uncompressed data. Press <ANY KEY>"
Sleep
newhandle = MemFileLoad("temp.txt", 0) 'load the uncompressed data file
Do Until MemEOF(newhandle) ' DO UNTIL EOF(filehandle)
MemLineInput newhandle, temp$ ' LINE INPUT #filehandle, temp$
Print temp$ ' PRINT temp$
Loop ' LOOP
MemFileClose newhandle
_KeyClear
Print "Now to load back the file with the compressed data. Press <ANY KEY>"
Sleep
newhandle = MemFileLoad("temp_compressed.txt", -1) 'load the compressed data file
Do Until MemEOF(newhandle) ' DO UNTIL EOF(filehandle)
MemLineInput newhandle, temp$ ' LINE INPUT #filehandle, temp$
Print temp$ ' PRINT temp$
Loop ' LOOP
MemFileClose newhandle
Print
Print "And remember, the difference of the sizes of the files on disk were:"
Print " compressed:"; LOF2
Print "uncompressed:"; LOF1
Print
Print "Press <ANY KEY> to compare speeds in loading an large file into an array in memory."
_KeyClear
Sleep
'And let's showcase a bit more of how this works, why don't we.
Dim As String wordlist(466544), wordlist2(466544), wordlist3(466544) 'arrays to hold the data
'MEM FILE INPUT
handle = MemFileLoad("466544 Word List.txt", 0) 'load a file directly into memory, and it's not compressed
t## = Timer ' timer to see how long we take loading this data
Do Until MemEOF(handle) ' Hopefully these lines will be intuitive enough.
count = count + 1 ' Especially when compared to the notes above
MemLineInput handle, wordlist(count) ' and the preceeding lines after
Loop
Print count; Using " words loaded into memory from file, in ##.#### seconds."; Timer - t##
MemFileClose handle
'OPEN FILE FOR INPUT
Open "466544 Word List.txt" For Input As #1
t## = Timer
Do Until EOF(1)
count2 = count2 + 1
Line Input #1, wordlist2(count2)
Loop
Print count2; Using " words loaded from file OPEN FOR INPUT, in ##.#### seconds."; Timer - t##
Close handle
'OPEN FILE FOR BINARY
Open "466544 Word List.txt" For Binary As #1
t## = Timer
Do Until EOF(1)
count3 = count3 + 1
Line Input #1, wordlist3(count3)
Loop
Print count3; Using " words loaded from file OPEN FOR BINARY, in ##.#### seconds."; Timer - t##
Close handle
'and let's compare contents to be safe
For i = 1 To count
If wordlist(i) <> wordlist2(i) Then Print "Wordlist does not match Wordlist2": failed = -1
If wordlist(i) <> wordlist3(i) Then Print "Wordlist does not match Wordlist3": failed = -1
Next
If failed Then
Print "Lists do not match"
Else
Print "Lists match each other perfectly"
End If
'BM FOOTER AFTER THIS
Sub MemFileDump (memfile, file$, compressed) 'just one quick call to save to disk and free the memory all at once.
MemFileSave memfile, file$, compressed
MemFileClose memfile
End Sub
Sub MemFileSave (memfile, file$, compressed)
If MemFile(memfile).inUse = 0 Then Error 53: Exit Sub 'File Not Found Error message
temphandle = FreeFile
Dim As _Offset length
length = MemFile(memfile).EOF_Marker + 1
temp$ = Space$(length)
$Checking:Off
_MemGet MemFile(memfile).Content, MemFile(memfile).Content.OFFSET, temp$
$Checking:On
If compressed Then temp1$ = _Deflate$(temp$) Else temp1$ = temp$
Open file$ For Output As temphandle: Close temphandle 'erase any existing file with the same name
Open file$ For Binary As temphandle
Put #temphandle, 1, temp1$
Close
End Sub
Function MemFileLoad (file$, compressed)
'Error codes for MemFileLoad
'1: No mem files available. (All 100 are in use! Free some to use more!)
For i = 1 To 100
If MemFile(i).inUse = 0 Then Exit For
Next
If i > 100 Then MemFileLoad = 0: Exit Function 'can't open any more memfiles!
If _FileExists(file$) = 0 Then Error 53: Exit Function 'file not found
MemFileLoad = i
temphandle = FreeFile
Open file$ For Binary As #temphandle
temp$ = Space$(LOF(temphandle))
Get temphandle, 1, temp$
Close temphandle
If compressed Then temp$ = _Inflate$(temp$)
length = Len(temp$)
MemFile(i).Content = _MemNew(length)
$Checking:Off
_MemPut MemFile(i).Content, MemFile(i).Content.OFFSET, temp$
$Checking:On
MemFile(i).inUse = -1 'TRUE
MemFile(i).EOF_Marker = length - 1 'the end of the file is the length of the file to begin with
MemFile(i).Current_Pos = 0 'and we're at the start of our nothing in the file
End Function
Sub MemFileClose (memfile)
If memfile < 1 Or memfile > 100 Then Error 5: Exit Sub 'ILLEGAL FUNCTION CALL
MemFile(memfile).inUse = 0 'no longer in sue
MemFile(memfile).EOF_Marker = 0 'nothing is written in the file to begin with
MemFile(memfile).Current_Pos = 0 'and we're at the start of our nothing in the file
_MemFree MemFile(memfile).Content 'free the memory we were using
End Sub
Function MemFileOpen
'Error codes for MemFileOpen
'1: No mem files available. (All 100 are in use! Free some to use more!)
For i = 1 To 100
If MemFile(i).inUse = 0 Then Exit For
Next
If i > 100 Then MemFileOpen = 0: Exit Function 'can't open any more memfiles!
MemFileOpen = i
MemFile(i).inUse = -1 'TRUE
MemFile(i).EOF_Marker = 0 'nothing is written in the file to begin with
MemFile(i).Current_Pos = 0 'and we're at the start of our nothing in the file
MemFile(i).Content = _MemNew(1000000) '1mb memfile by default
$Checking:Off
_MemFill MemFile(i).Content, MemFile(i).Content.OFFSET, MemFile(i).Content.SIZE, 0 As _UNSIGNED _BYTE
'make certain to blank the file when opening it for the first time so we don't have unwanted characters in it.
$Checking:On
End Function
Function MemEOF (memfile)
If MemFile(memfile).inUse = 0 Then Error 53: Exit Function 'File Not Found Error message
If MemFile(memfile).Current_Pos >= MemFile(memfile).EOF_Marker Then MemEOF = -1
End Function
Sub MemSeek (memfile, position As _Offset)
If MemFile(memfile).inUse = 0 Then Error 53: Exit Sub 'File Not Found Error message
If position < 0 Then Error 5: Exit Sub 'Invalid Function Call
If position > MemFile(memfile).EOF_Marker Then Error 5: Exit Sub 'Invalid Function Call
MemFile(memfile).Current_Pos = position
End Sub
Sub MemLineInput (memfile, what$)
'only valid line endings here are CHR$(10), chr$(13), and chr$(13) + chr$(10)
If MemFile(memfile).inUse = 0 Then Error 53: Exit Sub 'File Not Found Error message
Dim As _Offset CP, EP, Size, L
Dim tempM As _MEM, a1 As _Unsigned _Byte
tempM = MemFile(memfile).Content 'it's just much shorter to type!
CP = MemFile(memfile).Current_Pos
EP = MemFile(memfile).EOF_Marker
If CP >= EP Then Error 62: Exit Sub 'INPUT PAST END OF FILE error
Size = tempM.SIZE
$Checking:Off
Do
a$ = _MemGet(tempM, tempM.OFFSET + CP, String * 1)
Select Case a$
Case Chr$(13)
_MemGet tempM, tempM.OFFSET + CP + 1, a1
If a1 = 10 Then CP = CP + 1 'move the Current Pointer past the 2nd character in a windows CRLF ending
finished = -1
Case Chr$(10)
finished = -1
Case Else
temp$ = temp$ + a$
End Select
CP = CP + 1
If CP >= EP Then finished = -1
Loop Until finished
$Checking:On
MemFile(memfile).Current_Pos = CP
what$ = temp$
End Sub
Sub MemPrint (memfile, what$, EOL_Type As Integer)
'memfile is the memfile handle to print to
'what$ is what we want to print
'EOL_Type is the type of line ending we want after this print statement
'1: This is a CHR$(10) line ending (Linux style line ending)
'2: This is a CHR$(13) line ending (Old Mac style line ending)
'3: This is a CHR$(13) + CHR$(10) line ending (Old Windows style line ending)
'4: This is a COMMA line ending. Use this if writing continous CSV fields.
' (Think PRINT #1, stuff$, <-- see the comma there at the end of the print statement??)
If MemFile(memfile).inUse = 0 Then Error 53: Exit Sub 'File Not Found Error message
Dim CRLF As String
Dim As _Offset CP, EP, Size, L
Select Case EOL_Type
Case 1: CRLF = Chr$(10)
Case 2: CRLF = Chr$(13)
Case 3: CRLF = Chr$(13) + Chr$(10)
Case 4: CRLF = ","
End Select
CP = MemFile(memfile).Current_Pos
EP = MemFile(memfile).EOF_Marker
Size = MemFile(memfile).Content.SIZE
L = Len(what$) + Len(CRLF)
If CP + L > Size Then 'we're writing beyond the bounds of our reserved memory!
Dim tempM As _MEM
recheck:
If Size <= 100000000 Then 'resize our memblock (to the limit) to save our data
tempM = _MemNew(Size * 10)
_MemCopy MemFile(memfile).Content, MemFile(memfile).Content.OFFSET, Size To tempM, tempM.OFFSET
_MemFree MemFile(memfile).Content
MemFile(memfile).Content = tempM
Size = Size * 10
GoTo recheck 'just to make certain that our reserved memory is now large enough to hold our data
Else
Error 61 'DISK FULL ERROR MESSAGE
Exit Sub 'I'm coding a hard size limit of 1GB for each memfile opened!
' Anything larger than that, and I'm tossing a Disk Full Error
End If
End If
_MemPut MemFile(memfile).Content, MemFile(memfile).Content.OFFSET + CP, what$ + CRLF
MemFile(memfile).Current_Pos = CP + L
If CP + L > EP Then MemFile(memfile).EOF_Marker = CP + L
End Sub
Note, you can now easily specify if you want to compress your data before saving it to disk, and just as easily reload the compressed data back.
Note2: This now makes use of $CHECKING OFF with the mem routines. Times have improved even more, with the MemFileLoad and MemLineInput method only taking 1.7 seconds to complete, compared to before. It's quite a bit of an improvement over the OPEN FOR BINARY and LINE INPUT time of 3.2 seconds -- almost twice as fast!!
RE: MemPrint and MemInput - justsomeguy - 08-22-2022
@SMcNeill
Quote:Open the file
Get the length of file.
Set a string to be that length.
Read the whole file into that string.
Close the file.
LOL! when you put it that way it seems obvious. I guess I just stopped when I finally got something to work.
Thanks
|