- Fixed bug of @ used in a string.
- Fixed bug of parenthesis used in an adress definition - for example: @MyList()
- Variables types adjusted for use on a x64 machine.
If you oftenly use "Poke", "CopyMemory", "ReallocateMemory", etc., you may have noticed how difficult it is to flush out memory access errors. This is particularly the case when working in multi-thread: a process can put the mess in the memory without this being noticed and we find ourselves two minutes later with an error without having the slightest idea of its origin. And can get a memory error in a thread while the problem is generated by another thread.
When working with a large program that uses direct memory access a lot, it can become a nightmare.
The "Purifier" option of the compiler tries to help this kind of problem by checking the "edges" of the allocated memory areas. If we write, for example:
Code: Select all
*Buffer = AllocateMemory (1000)
PokeL (*Buffer-5, 0)Code: Select all
*Buffer = AllocateMemory (1000)
PokeL (*Buffer-500, 0)After spending an entire week trying unsuccessfully to fix the problems with one of my big programs, I decided to use the bulldozer to fix it once and for all. The bulldozer is the program that will follow.
Its principle consists in creating a "clone" of the program to be checked. This clone will be much slower than the original program, but it will have the advantage of being provided with control procedures which will check all accesses to the memory. Once you have identified the problem, correct the original program and delete the clone.
This idea saved my life. I hope it can help someone else.
Code: Select all
; MEMORY CHECK
; By Zapman
;
; Should work with any version of PureBasic.
;
; If you oftenly use "Poke", "CopyMemory", "ReallocateMemory", etc.,
; you may have noticed how difficult it is to flush out memory access errors.
; This is particularly true when working in multi-task: a process can
; put the mess in the memory without this being noticed and we find ourselves
; two minutes later with an error without having the slightest idea of its origin.
; When working With a large program that uses direct memory access a lot,
; it can become a terrible nightmare.
; The "Purifier" option of the compiler tries To help this kind of problem
; by checking the "edges" of the allocated memory areas. If we write, for example:
; *Buffer = AllocateMemory (1000)
; PokeL (*Buffer-5, 0)
; The purifier will signal the error (we must not Poke BEFORE the allocated
; memory area). But If we write:
; *Buffer = AllocateMemory (1000)
; PokeL (*Buffer-500, 0)
; The purifier will not report anything because the Poke address is too far from
; the correct address and the purifier does not check that far.
; After spending an entire week trying unsuccessfully to fix the problems
; with one of my big programs, I decided to use the bulldozer to fix it once and for all.
; The bulldozer is the program that will follow.
; Its principle consists in creating a "clone" of the program to be checked.
; This clone will be much slower than the original program, but it will have
; the advantage of being provided with control procedures which will check
; all accesses To the memory. Once you have identified the problem,
; correct the original program and delete the clone.
;
; Manual :
;
;--------------- STEP 0 ----------------
; Save the current file in the same folder as the Source File
; you want to check and name it "MemCheck.pb".
;
;--------------- STEP 1 ----------------
; Copy the two uncommented following lines at the beginning
; of YOUR program you want to check:
;
; XIncludeFile "MemCheck.pb"
; __GenerateMemSecureSourceScript("MyProgram.pb") : End
;
; In the second line, replace "MyProgram.pb"
; by the source file name of your program.
;
;--------------- STEP 2 ----------------
; Run YOUR program once. This will generate a new source file
; named something like "MemSecured_MyProgram.pb".
;
;--------------- STEP 3 ----------------
; Open "MemSecured_MyProgram.pb" and run it.
; you will get a message for each suspicious access to memory
; made by your program. Notice each of them.
;
;--------------- STEP 4 ----------------
; Delete "MemSecured_MyProgram.pb" and correct each problem in your source file
; Or add a "OKMEM" comment to the lines that you are sure to be OK
; and you don't want to be checked again.
; Run it again for a second check and then, run again "MemSecured_MyProgram.pb".
;
;--------------- LAST STEP ----------------
; When all is OK, delete again "MemSecured_MyProgram.pb" and delete
; the two lines added to your program (XIncludeFile "MemCheck.pb" and __GenerateMemSecureSourceScript("MyProgram.pb") : End)
; That's all folks!
;
; EnableExplicit
; Define FileBOM.l
;
Procedure PrintError(Message$)
; To simplify messages use.
ProcedureReturn MessageRequester("Error", Message$, #PB_MessageRequester_Ok)
EndProcedure
;
Procedure.s FileToString(FileName$)
Protected *MemoryID,length.l,FileContent$
Shared FileBOM.l
If FileSize(FileName$)>0 And ReadFile(0, FileName$)
FileBOM = ReadStringFormat(0)
length = Lof(0)
FileSeek(0,0)
*MemoryID = AllocateMemory(length)
If *MemoryID And ReadData(0, *MemoryID, length)
FileContent$ = PeekS(*MemoryID,length,FileBOM)
FreeMemory(*MemoryID)
EndIf
CloseFile(0)
EndIf
ProcedureReturn FileContent$
EndProcedure
;
Procedure StringToFile(FileName$,FileContent$)
Shared FileBOM.l
If CreateFile(0, FileName$)
WriteString(0, FileContent$,FileBOM)
CloseFile(0)
EndIf
ProcedureReturn FileSize(FileName$)
EndProcedure
;
;
#MaxExam = 1000
Global Dim MemArea.i(#MaxExam)
Global Dim MemSize.l(#MaxExam)
Global Dim ErasedMemArea.i(#MaxExam)
Global Dim ErasedMemSize.l(#MaxExam)
Global Dim ErasedMemLine.l(#MaxExam)
;
Global MemMutex.l = CreateMutex()
;
Procedure.l __MCFindInTab(NoLine.l,WhatToFind.i,Array AreaSearchTab.i(1),Array AreaSizeTab.l(1),ExactMatch.l=1)
Protected FindPos.l,ct.l,Msg$
FindPos = 0
For ct = 1 To #MaxExam
If ExactMatch
If AreaSearchTab(ct)=WhatToFind
FindPos = ct
ct = #MaxExam
EndIf
Else
If WhatToFind>= AreaSearchTab(ct) And WhatToFind < AreaSearchTab(ct)+AreaSizeTab(ct)
FindPos = ct
ct = #MaxExam
EndIf
EndIf
Next
If WhatToFind = 0 And FindPos = 0
Msg$ = "MemArea array capacity reached!"+Chr(13)+"Line : "+Str(NoLine)
Msg$ + Chr(13)+"You should try to increase the value of #MaxExam in MemCheck.pb."
PrintError(Msg$)
End
EndIf
ProcedureReturn FindPos
EndProcedure
;
Procedure __MCCheck_Memory(NoLine.l,MemArea.i,Msg$,ExactMatch.l = 1)
Protected FindPos.l,FindPosER.l
;
LockMutex(MemMutex)
;
FindPos = __MCFindInTab(NoLine,MemArea,MemArea(),MemSize(),ExactMatch)
If FindPos = 0
If Msg$ = ""
Msg$ = "The memory area tested does'nt appear in the list of created areas."
EndIf
Msg$ + Chr(13)+"Error line : "+Str(NoLine)
Msg$ + Chr(13)+"Faulty address: "+Str(MemArea)
FindPosER = __MCFindInTab(NoLine,MemArea,ErasedMemArea(),ErasedMemSize())
If FindPosER
Msg$ + Chr(13)+"This area has been deleted by line "+Str(ErasedMemLine(FindPosER))
EndIf
PrintError(Msg$)
EndIf
;
UnlockMutex(MemMutex)
ProcedureReturn FindPos
EndProcedure
;
Procedure.i __MCCreateMemAdresse(NoLine.l,MemArea.i,MemSize.l = 4)
Protected PosInTab.l,Res.l
;
LockMutex(MemMutex)
;
If __MCFindInTab(NoLine,MemArea,MemArea(),MemSize()) = 0 ; Check if it yet exists
PosInTab = __MCFindInTab(NoLine,0,MemArea(),MemSize()) ; Find a room to store the new adress
MemArea(PosInTab) = MemArea
MemSize(PosInTab) = MemSize
EndIf
;
UnlockMutex(MemMutex)
ProcedureReturn MemArea
EndProcedure
;
Procedure.i __MCReAllocate_Memory(NoLine.l,MemArea.i,MemSize.l,Option.l = 0)
Protected PosInTab.l,NewEMB.l,Res.l
;
Res = 0
PosInTab = __MCCheck_Memory(NoLine,MemArea,"The memory area whose reallocation is requested does not exist!")
LockMutex(MemMutex)
If PosInTab
Res = ReAllocateMemory(MemArea, MemSize, Option)
If MemArea <> Res ; Register the old area as deleted.
NewEMB = __MCFindInTab(NoLine,0,ErasedMemArea(),ErasedMemSize())
ErasedMemArea(NewEMB) = MemArea(PosInTab)
ErasedMemSize(NewEMB) = MemSize(PosInTab)
ErasedMemLine(NewEMB) = NoLine
EndIf
MemSize(PosInTab) = MemSize
MemArea(PosInTab) = Res
EndIf
;
UnlockMutex(MemMutex)
ProcedureReturn Res
EndProcedure
;
Procedure.i __MCAllocate_Memory(NoLine.l,MemSize.l,Option.l = 0)
Protected Res.l
;
Res = AllocateMemory(MemSize,Option)
If Res = 0
PrintError("AllocateMemory returns a zero value!! Probably a system error.")
Else
__MCCreateMemAdresse(NoLine,Res,MemSize)
EndIf
;
ProcedureReturn Res
EndProcedure
;
Procedure.i __MCReceiveHTTP_Memory(NoLine.l,Uri$)
Protected Res.l
;
Res = ReceiveHTTPMemory(Uri$)
If Res = 0
PrintError("ReceiveHTTPMemory returned a zero value.")
Else
__MCCreateMemAdresse(NoLine,Res,MemorySize(Res))
EndIf
;
ProcedureReturn Res
EndProcedure
;
Procedure.l __MCCopy_Memory(NoLine.l,MemAreaSrce.i,MemAreaDest.i,MemSize.l)
Protected FindPosSrce.l,FindPosDest.l,FindPosER.l,Err.l,Res.l,Msg$
;
LockMutex(MemMutex)
;
FindPosSrce = __MCFindInTab(NoLine,MemAreaSrce,MemArea(),MemSize(),0)
FindPosDest = __MCFindInTab(NoLine,MemAreaDest,MemArea(),MemSize(),0)
Err = 0
Res = 0
If FindPosSrce = 0
Msg$ = "A memory area copy is requested from an inexistant source area!"+Chr(13)+"Line : "+Str(NoLine)
FindPosER = __MCFindInTab(NoLine,MemAreaSrce,ErasedMemArea(),ErasedMemSize())
If FindPosER
Msg$ + Chr(13)+"The source has been deleted by line "+Str(ErasedMemLine(FindPosER))
EndIf
PrintError(Msg$)
Err = 1
ElseIf (MemAreaSrce+MemSize)>(MemArea(FindPosSrce)+MemSize(FindPosSrce))
PrintError("The requested memory copy size exceeds the source size!"+Chr(13)+"Line : "+Str(NoLine))
Err = 1
EndIf
If FindPosDest = 0
Msg$ = "A memory area copy is requested for an inexistant recipient area!"+Chr(13)+"Line : "+Str(NoLine)
FindPosER = __MCFindInTab(NoLine,MemAreaDest,ErasedMemArea(),ErasedMemSize())
If FindPosER
Msg$ + Chr(13)+"The recipient has been deleted by line "+Str(ErasedMemLine(FindPosER))
EndIf
PrintError(Msg$)
ElseIf (MemAreaDest+MemSize)>(MemArea(FindPosDest)+MemSize(FindPosDest))
PrintError("The requested memory copy size exceeds the destination size!"+Chr(13)+"Line : "+Str(NoLine))
Err = 1
EndIf
If Err = 0
Res = CopyMemory(MemAreaSrce,MemAreaDest,MemSize)
EndIf
;
UnlockMutex(MemMutex)
ProcedureReturn Res
EndProcedure
;
Procedure __MCFree_Memory(NoLine,MemArea.i)
Protected PosInTab.l,FindPosER.l,NewEMB,Msg$
;
PosInTab = __MCCheck_Memory(NoLine,MemArea,"The memory area whose release is requested does'nt exist!")
If PosInTab
FreeMemory(MemArea)
LockMutex(MemMutex)
NewEMB = __MCFindInTab(NoLine,0,ErasedMemArea(),ErasedMemSize())
ErasedMemArea(NewEMB) = MemArea(PosInTab)
ErasedMemSize(NewEMB) = MemSize(PosInTab)
ErasedMemLine(NewEMB) = NoLine
MemArea(PosInTab) = 0
MemSize(PosInTab) = 0
UnlockMutex(MemMutex)
EndIf
;
EndProcedure
;
Procedure.l __MCMemory_Size(NoLine,MemArea.i)
Protected PosInTab.l,Res.l
;
Res = 0
PosInTab = __MCCheck_Memory(NoLine,MemArea,"MemorySize is requested for an area which does'nt exist!")
If PosInTab
Res = MemorySize(MemArea)
EndIf
;
ProcedureReturn Res
EndProcedure
;
Procedure __MCPoke(NoLine.l,TypeOfPoke$,MAdr.i)
__MCCheck_Memory(NoLine,MAdr,"Poke"+TypeOfPoke$+" in a memory area which does'nt seem to exist.",0)
EndProcedure
;
Procedure __MCPoke_A(NoLine.l,MAdr.i,Mdata.a)
__MCPoke(NoLine,"A",Madr)
PokeA(MAdr,Mdata)
EndProcedure
;
Procedure __MCPoke_B(NoLine.l,MAdr.i,Mdata.b)
__MCPoke(NoLine,"B",Madr)
PokeB(MAdr,Mdata)
EndProcedure
;
Procedure __MCPoke_C(NoLine.l,MAdr.i,Mdata.b)
__MCPoke(NoLine,"C",Madr)
PokeC(MAdr,Mdata)
EndProcedure
;
Procedure __MCPoke_D(NoLine.l,MAdr.i,Mdata.d)
__MCPoke(NoLine,"D",Madr)
PokeD(MAdr,Mdata)
EndProcedure
;
Procedure __MCPoke_F(NoLine.l,MAdr.i,Mdata.f)
__MCPoke(NoLine,"F",Madr)
PokeF(MAdr,Mdata)
EndProcedure
;
Procedure __MCPoke_I(NoLine.l,MAdr.i,Mdata.i)
__MCPoke(NoLine,"I",Madr)
PokeI(MAdr,Mdata)
EndProcedure
;
Procedure __MCPoke_L(NoLine.l,MAdr.i,Mdata.l)
__MCPoke(NoLine,"L",Madr)
PokeL(MAdr,Mdata)
EndProcedure
;
Procedure __MCPoke_Q(NoLine,MAdr.i,Mdata.q)
__MCPoke(NoLine,"Q",Madr)
PokeQ(MAdr,Mdata)
EndProcedure
;
Procedure __MCPoke_U(NoLine.l,MAdr.i,Mdata.u)
__MCPoke(NoLine,"U",Madr)
PokeU(MAdr,Mdata)
EndProcedure
;
Procedure __MCPoke_S(NoLine.l,MAdr.i,Mdata.s)
__MCPoke(NoLine,"S",Madr)
PokeS(MAdr,Mdata.s)
EndProcedure
;
Procedure __MCPoke_W(NoLine.l,MAdr.i,Mdata.w)
__MCPoke(NoLine,"W",Madr)
PokeW(MAdr,Mdata)
EndProcedure
;
Procedure __GenerateMemSecureSourceScript(FileName$)
Protected ScriptContent$,NScriptContent$
Protected p.l,cpt.l,cptempty.l,nbQuotes.l
Protected ps.l,psf1.l,mpsf1.l,psf2.l
Protected line$,ToInsert$,leftpart$,inter$
Protected ListOfPoke$,TypeOfPoke$
;
ScriptContent$ = FileToString(FileName$)
p = 0
Repeat
p + 1
line$ = StringField(ScriptContent$,p,Chr(13)+Chr(10))
If line$
ps = 0
Repeat
ps = FindString(line$,"@",ps+1)
If ps
leftpart$ = Left(line$,ps-1)
nbQuotes = CountString(leftpart$,Chr(34))
If nbQuotes = nbQuotes/2*2 ; manage the "@" char only if it's not inside quotes
psf1 = FindString(line$,")",ps)
If psf1 ; We'll find were is the real end of the variable definition
Repeat ; If the variable includes a list or a tab, the definition can include parenthesis
mpsf1 = psf1
inter$ = Mid(line$,ps,psf1-ps+1)
If CountString(inter$,"(")>=CountString(inter$,")")
psf1 = FindString(line$,")",psf1+1)
EndIf
Until psf1 = mpsf1
EndIf
If psf1 = 0 : psf1 = Len(line$) + 1 : EndIf
psf2 = FindString(line$," ",ps)
If psf2 And psf2<psf1 : psf1 = psf2 : EndIf
psf2 = FindString(line$,";",ps)
If psf2 And psf2<psf1 : psf1 = psf2 : EndIf
psf2 = FindString(line$,",",ps)
If psf2 And psf2<psf1 : psf1 = psf2 : EndIf
ToInsert$ = "__MCCreateMemAdresse("+Str(p)+","
line$ = leftpart$+ToInsert$+Mid(line$,ps,psf1-ps)+")"+Mid(line$,psf1)
ps + Len(ToInsert$)+Len(")")
EndIf
EndIf
Until ps = 0
;
If FindString(line$,"OKMEM",0)=0 ; Put the mention "OKMEM" into line comment
; if you don't want this line to be checked (only if you are sure it's OK).
line$ = ReplaceString(line$,"ReceiveHTTPMemory(","__MCReceiveHTTP_Memory("+Str(p)+",")
line$ = ReplaceString(line$,"ReceiveHTTPDataMemory(","__MCReceiveHTTPData_Memory("+Str(p)+",")
line$ = ReplaceString(line$,"ReAllocateMemory(","__MCReAllocate_Memory("+Str(p)+",")
line$ = ReplaceString(line$,"AllocateMemory(","__MCAllocate_Memory("+Str(p)+",")
line$ = ReplaceString(line$,"CopyMemory(","__MCCopy_Memory("+Str(p)+",")
line$ = ReplaceString(line$,"FreeMemory(","__MCFree_Memory("+Str(p)+",")
line$ = ReplaceString(line$,"MemorySize(","__MCMemory_Size("+Str(p)+",")
ListOfPoke$ = "ABCDFILQUSW"
For cpt = 1 To Len(ListOfPoke$)
TypeOfPoke$ = Mid(ListOfPoke$,cpt,1)
line$ = ReplaceString(line$,"Poke"+TypeOfPoke$+"(","__MCPoke_"+TypeOfPoke$+"("+Str(p)+",")
Next
EndIf
If FindString(line$,"__GenerateMemSecureSourceScript",0)
Line$ = ";"+Line$
EndIf
;
NScriptContent$ + line$ + Chr(13)+Chr(10)
cptempty = 0
Else
NScriptContent$ + ";" + Chr(13)+Chr(10)
cptempty + 1
EndIf
Until cptempty >10
StringToFile("MemSecured_"+FileName$,NScriptContent$)
PrintError("Secured file generated.")
EndProcedure
Code: Select all
; DEMO PROGRAM FOR MemCheck
;
XIncludeFile "MemCheck.pb"
__GenerateMemSecureSourceScript("Demo.pb") : End
;
Procedure DoubleMyValue(*ValuePtr)
DblV.l = PeekL(*ValuePtr)*2
PokeL(*ValuePtr,DblV) ; This memory adress won't be be signaled because adresses of variables are OK.
EndProcedure
;
;
MyValue.l = 100
DoubleMyValue(@MyValue)
Debug MyValue
;
*Buffer = AllocateMemory(1000)
;
PokeL(*Buffer-100,200) ; This error will be signaled because Poke adress is NOT inside the created memory block.
;
PokeL(*Buffer,200) ; OKMEM
; The line above won't be checked (even if the given adress is wrong) because of the comment "OKMEM"
;
FreeMemory(*Buffer)
;
FreeMemory(*Buffer) ; This error will be signaled because the memory block has yet been erased.
;
PokeL(*Buffer,200) ; This error will be signaled because the memory block has been erased before the poke.
Code: Select all
; DEMO PROGRAM FOR MemCheck
;
XIncludeFile "MemCheck.pb"
;__GenerateMemSecureSourceScript("Demo.pb") : End
;
Procedure DoubleMyValue(*ValuePtr)
DblV.l = PeekL(*ValuePtr)*2
__MCPoke_L(8,*ValuePtr,DblV) ; This memory adress won't be be signaled because adresses of variables are OK.
EndProcedure
;
;
MyValue.l = 100
DoubleMyValue(__MCCreateMemAdresse(13,@MyValue))
Debug MyValue
;
*Buffer = __MCAllocate_Memory(16,1000)
;
__MCPoke_L(18,*Buffer-100,200) ; This error will be signaled because Poke adress is NOT inside the created memory block.
;
PokeL(*Buffer,200) ; OKMEM
; The line above won't be checked (even if the given adress is wrong) because of the comment "OKMEM"
;
__MCFree_Memory(23,*Buffer)
;
__MCFree_Memory(25,*Buffer) ; This error will be signaled because the memory block has yet been erased.
;
__MCPoke_L(27,*Buffer,200) ; This error will be signaled because the memory block has been erased before the poke.
;
This one was quite tricky!