Explorar el Código

* ppheap init code can be called before any getmem

pierre hace 26 años
padre
commit
699b53f316
Se han modificado 2 ficheros con 32 adiciones y 2 borrados
  1. 10 1
      compiler/i386.pas
  2. 22 1
      compiler/ppheap.pas

+ 10 - 1
compiler/i386.pas

@@ -1243,6 +1243,9 @@ unit i386;
   implementation
 
     uses
+{$ifdef heaptrc}
+      ppheap,
+{$endif heaptrc}
       strings,globals,verbose;
 
 
@@ -1969,6 +1972,9 @@ end;
 Begin
 {$ifdef ITTABLE}
   { create the itcache and reset to -1 }
+{$ifdef heaptrc}
+  pp_heap_init;
+{$endif heaptrc}
   new(itcache);
   FillChar(ItCache^,sizeof(titcache),$ff);
 {$endif}
@@ -1977,7 +1983,10 @@ Begin
 end.
 {
   $Log$
-  Revision 1.33  1999-01-25 09:29:38  florian
+  Revision 1.34  1999-01-26 11:32:14  pierre
+   * ppheap init code can be called before any getmem
+
+  Revision 1.33  1999/01/25 09:29:38  florian
     * very rare problem with in-operator fixed, mainly it was a problem of
       emit_to_reg32 (typo in case ranges)
 

+ 22 - 1
compiler/ppheap.pas

@@ -26,6 +26,11 @@ unit ppheap;
 
     uses heaptrc;
 
+    { call this function before any memory allocation
+      in a unit initialization code (PM) }
+      
+    procedure pp_heap_init;
+
   implementation
 
     uses
@@ -41,8 +46,24 @@ unit ppheap;
           plongint(cardinal(p)+8)^:=aktfilepos.fileindex
       end;
 
+  const
+     pp_heap_inited : boolean = false;
+     
+  procedure pp_heap_init;
+    begin
+       if not pp_heap_inited then
+         SetExtraInfo(12,ppextra_info);
+       pp_heap_inited:=true;
+    end;
+
   begin
-     SetExtraInfo(12,ppextra_info);
+     pp_heap_init;
   end.
 
+{
+  $Log$
+  Revision 1.5  1999-01-26 11:32:13  pierre
+   * ppheap init code can be called before any getmem
+
+}