fork download
copy 
  1. uses heaptrc;
  2.  
  3. type
  4. TMem = Record
  5.  Addr : Pointer;
  6.  Size : PtrUInt;
  7. End;
  8.  
  9. var
  10.  continue : Pointer;
  11.  lastMM : TMemoryManager;
  12.  MM : TMemoryManager;
  13.  list: array of TMem;
  14.  listSize : Integer = 0;
  15.  
  16. procedure exitHandler;
  17. var
  18.  i : integer;
  19. begin
  20.  writeln('exitHandler');
  21.  for i:=0 to listSize-1 do
  22.  begin
  23.   lastMM.FreeMemSize(list[i].Addr, list[i].Size);
  24.  end;
  25.  
  26.  SetMemoryManager(lastMM);
  27.  SetLength(list, 0);
  28.  
  29.  asm
  30.   jmp continue
  31.  end;
  32. end;
  33.  
  34. function myGetmem(Size: PtrUInt):Pointer;
  35. begin
  36.  SetMemoryManager(lastMM);
  37.  SetLength(list, listSize+1);
  38.  SetMemoryManager(MM);
  39.  
  40.  list[listSize].Size := Size;
  41.  list[listSize].Addr := lastMM.Getmem(Size);
  42.  
  43.  myGetmem := list[listSize].Addr;
  44.  
  45.  inc(listSize);
  46. end;
  47.  
  48. procedure sethandler(sp:PtrUInt);
  49. begin
  50.  continue := Pointer(PPtrUInt(@sp)[9]);
  51.  Pointer(PPtrUInt(@sp)[9]) := @exitHandler;
  52. end;
  53.  
  54. Procedure MyProc;
  55. Var Data: PByte;
  56.     I   : uint16;
  57. Begin
  58.  sethandler(0);
  59.  GetMemoryManager(lastMM);
  60.  MM := lastMM;
  61.  MM.Getmem := @myGetmem;
  62.  SetMemoryManager(MM);
  63.  
  64.  Data := AllocMem(10);
  65.  
  66.  For I := 0 To 9 Do
  67.   Data[I] := Random(High(Byte));
  68.  
  69.  For I := 0 To 9 Do
  70.   Write(Data[I], ' ');
  71.  
  72.  Writeln;
  73. End;
  74.  
  75. Begin
  76.  MyProc;
  77.  
  78.  Writeln('-- end --');
  79.  Readln;
  80. End.
stdin
copy 


			

					
			
			

				
	
		
		
	
		
		 stdout
					

				
				 copy
			

			
	

		
139 151 182 215 153 218 138 216 108 159 
exitHandler
-- end --


	

		
	 
	
		
	
		 stderr
					

				
				 copy
			

			

	

        
Heap dump by heaptrc unit
2 memory blocks allocated : 26/32
2 memory blocks freed     : 26/32
0 unfreed memory blocks : 0
True heap size : 32768
True free heap : 32768


    

	
			

					
			
			
			
			
			
			
			
			

			
			
			
		

	
		
		

			

			                        







			
			

				

	
					
					 https://ideone.com/JxXGKK
					
					
					
					
					

												

												
						
						

					

					
					
					

						
language:

						
Pascal (fpc 3.0.4)

					

					

						
created:
								
						
10 years ago

					

					

						
visibility:

						

														 secret																					
							
							

								
							

						

					

										
										

					
					 Share or Embed source code
					
					
					
					

						
						
						
						
						
						
						
					

					
						
	
	
	
	
					
					
					
					
					 
					
					
					
					 
					
					
					
					
					
					

					

					

					
						
					

					


	
Discover > Sphere Engine API

	
The brand new service which powers Ideone!

	
	
Discover > IDE Widget

    
Widget for compiling and running the source code in a web browser!