PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Trying to solve bad memory accesses

https://www.purebasic.fr/english/viewtopic.php?t=74630

Page 1 of 1

Trying to solve bad memory accesses

Posted: Sat Feb 15, 2020 8:27 pm
by Zapman
Update v0.03
- 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)
The purifier will signal the error (you must not Poke BEFORE the allocated memory area). But if we write:

Code: Select all

*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.

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
And here an example of simple program you can use to try the bulldozer:

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.
After runing it, you'll get a "clone" file named "MemSecured_Demo.pb" in the same folder or the original program:

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.
;
You can now run this "clone" and see the alert messages when a bad access is done.

Re: Trying to solve bad memory accesses

Posted: Sat Feb 15, 2020 9:19 pm
by Paul
Looks cool but...
Add this to the end of your demo program code and see the results after making your clone ;(

Code: Select all

a$="My email address is info@somewhere.com"

Re: Trying to solve bad memory accesses

Posted: Sun Feb 16, 2020 11:10 am
by Zapman
Hi Paul, thanks a lot for testing.
I've fixed this bug and updated the code above.

Re: Trying to solve bad memory accesses

Posted: Sun Feb 16, 2020 3:38 pm
by Paul
ok, since you're fixing bugs... :wink:

This code is converted with the parenthesis in the wrong location

Code: Select all

XIncludeFile "MemCheck.pb"
__GenerateMemSecureSourceScript("mytest.pb") : End

Structure mylist2
  test.s
EndStructure

Structure mylist
  List testlist.mylist2()
EndStructure

t.mylist
AddElement(t\testlist())
t\testlist()\test="Hello There"

ForEach t\testlist()
  Debug PeekS(@t\testlist()\test)  ;<---- view this line after conversion
Next

Re: Trying to solve bad memory accesses

Posted: Sun Feb 16, 2020 4:45 pm
by Zapman
Ha, ha :) This one was quite tricky!
It's fixed and I updated the code above.

Thank you very much again, Paul.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited