PureBoard

Code: Alles auswählen

; AllocProblem.pb
;

Global NewList all.i()
Global SizeTotal

Define.s msg$
Define   lastDate

Macro dq()
"  
EndMacro

Macro check(_V_)
  If Not _V_
    Debug "MEMORY FULL!"
    Debug "Line:"+#PB_Compiler_Line
    Debug dq()_V_ = dq() + _V_
    End
  EndIf 
EndMacro

Procedure AddAlloc(size)
  Protected buff$,i
  If size>0
    check(AddElement(all()))
    all() = AllocateMemory(size)

 
    check(all()) 
    SizeTotal = SizeTotal + size
    
    
  EndIf 
EndProcedure

Procedure ManyAllocations(max=-1,maxbytes=-1)
  Protected i
  If max<1
    max=1000
  EndIf 
  If maxbytes<1
    maxbytes=30
  EndIf 
  For i=1 To max Step 1
    AddAlloc(Random(maxbytes,2))
    
  Next 
EndProcedure

Procedure FreeAllocations(keep=100)
  If keep<0 : keep = 0 : EndIf 
  While ListSize(all())>keep ; keep 100 random pointers (simulate longer living objects")
    SelectElement(all(),Random(ListSize(all())-1,0))
    If ListIndex(all())>5 Or keep<=6
      SizeTotal = SizeTotal - MemorySize(all())
      FreeMemory(all()) ; free random pointer
      DeleteElement(all())
    EndIf 
  Wend 
EndProcedure



OpenConsole("AllocProblem")
Print("Init...") : 
AddAlloc(1024*1024*1.5) ; 1.5 MB data  img
AddAlloc(1024*200) ; 200k  img
AddAlloc(1024*200) ; 200k  img 

ManyAllocations() : PrintN("ok.")
PrintN("Press ESC to exit")
Repeat 

  ManyAllocations(Random(50000,1000),30)
  FreeAllocations(10)
  
  Delay(0)
   Print(Chr(13))
   lastDate=Date()
   msg$=LSet(FormatDate("%dd/%mm/%yyyy %hh:%ii:%ss ",lastDate)+" elems: "+Str(ListSize(all()))+" size: "+FormatNumber(SizeTotal,0),60)
   Print(msg$)
  
Until Inkey()=Chr(27)

CloseConsole()
End

Code: Alles auswählen

  ; mit dieser Procedure macht der Lua interpreter ALLE allocs / frees
  ;
  ProcedureC.i __allocHandler(*ud, *ptr, osize, nsize)
    Protected res,max
    
    If (nsize = 0) And *ptr
      ;Debug "free "+osize+" *ptr "+*ptr+"  *ud "+*ud 
         FreeMemory(*ptr);
         res = #Null 
       ElseIf nsize<0
         res = #Null
        ;Debug "SHOULD NOT HAPPEN nsize<0"
       Else 
         
         If nsize<2
           nsize=2
         EndIf 
         
         If *ptr=#Null 
            ;Debug "alloc "+osize+" -> "+nsize+" *ptr "+*ptr+"  *ud "+*ud
            res = AllocateMemory(nsize)
          Else 
            ;Debug "realloc "+osize+" -> "+nsize+" *ptr "+*ptr+"  *ud "+*ud
            ; 
            If MemorySize(*ptr)=nsize Or osize=nsize
              res=*ptr
            Else 
             res=ReAllocateMemory(*ptr, nsize)
            EndIf              

         EndIf 
     EndIf 
    ProcedureReturn res
  EndProcedure
  [/quote]

Code: Alles auswählen

EnableExplicit

Procedure.i Dummy()
  Static *mem
  If *mem
    FreeMemory(*mem)
  EndIf
  *mem = AllocateMemory(1073741824)
  ProcedureReturn *mem
EndProcedure

Procedure.i Main()
  If OpenWindow(0,0,0,400,400,#Null$,#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_MinimizeGadget)
    AddWindowTimer(0,0,100)
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_Timer
          SetWindowTitle(0,"0x" + Hex(Dummy()))
        Case #PB_Event_CloseWindow
          Break
      EndSelect
    ForEver
    CloseWindow(0)  
  EndIf  
  ProcedureReturn #Null
EndProcedure

Main()

End

Code: Alles auswählen

EnableExplicit

Global exit.i

Procedure.i Dummy(Parameter.i)
  Protected *mem
  Repeat
    If *mem
      FreeMemory(*mem)
    EndIf
    *mem = AllocateMemory(1073741824)
    Delay(100)  
  Until exit
EndProcedure

Procedure.i Main()
  Protected thread.i
  thread = CreateThread(@Dummy(),#Null)
  If thread
    If OpenWindow(0,0,0,400,400,#Null$,#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_MinimizeGadget)
      Repeat
        Select WaitWindowEvent()
          Case #PB_Event_CloseWindow
            Break
        EndSelect
      ForEver
      CloseWindow(0)
    EndIf
    exit = #True
    WaitThread(thread)
  EndIf  
  ProcedureReturn #Null
EndProcedure

Main()

End

Code: Alles auswählen

 
 ProcedureC.i __allocHandler(*ud, *ptr, osize, nsize)
...
             res=ReAllocateMemory(*ptr, nsize)
...
  EndProcedure