Browse Source

+ label faillabel added for _FAIL support

pierre 26 years ago
parent
commit
1c8a7a1924
4 changed files with 71 additions and 18 deletions
  1. 20 10
      compiler/cpubase.pas
  2. 12 3
      compiler/globals.pas
  3. 23 1
      compiler/m68k.pas
  4. 16 4
      compiler/psub.pas

+ 20 - 10
compiler/cpubase.pas

@@ -818,6 +818,13 @@ var
 {$endif NOAG386BIN}
 
 
+{*****************************************************************************
+                                  Init/Done
+*****************************************************************************}
+
+  procedure InitCpu;
+  procedure DoneCpu;
+  
 {*****************************************************************************
                                   Helpers
 *****************************************************************************}
@@ -1038,14 +1045,12 @@ end;
                               Instruction table
 *****************************************************************************}
 
-var
-  saveexit : pointer;
-
-procedure FreeInsTabCache;{$ifndef FPC}far;{$endif}
+procedure DoneCpu;{$ifndef FPC}far;{$endif}
 begin
-  exitproc:=saveexit;
+  {exitproc:=saveexit; }
 {$ifndef NOAG386BIN}
-  dispose(instabcache);
+  if assigned(instabcache) then
+    dispose(instabcache);
 {$endif NOAG386BIN}
 end;
 
@@ -1067,17 +1072,22 @@ begin
      inc(i);
    end;
 {$endif NOAG386BIN}
-  saveexit:=exitproc;
-  exitproc:=@FreeInsTabCache;
 end;
 
+procedure InitCpu;
 
 begin
-  BuildInsTabCache;
+  if not assigned(instabcache) then
+    BuildInsTabCache;
+end;
+
 end.
 {
   $Log$
-  Revision 1.7  1999-08-18 13:26:23  jonas
+  Revision 1.8  1999-08-19 13:02:10  pierre
+    + label faillabel added for _FAIL support
+
+  Revision 1.7  1999/08/18 13:26:23  jonas
     + some constants for the new optimizer
 
   Revision 1.6  1999/08/13 15:36:30  peter

+ 12 - 3
compiler/globals.pas

@@ -158,9 +158,10 @@ unit globals;
 {$Ifdef EXTDEBUG}
        total_of_firstpass,
        firstpass_several : longint;
-{$EndIf EXTDEBUG}
+{$ifdef FPC}
+       EntryMemUsed : longint;
+{$endif FPC}
      { parameter switches }
-{$Ifdef EXTDEBUG}
        debugstop,
        only_one_pass : boolean;
 {$EndIf EXTDEBUG}
@@ -1233,10 +1234,18 @@ unit globals;
 
 begin
   get_exepath;
+{$ifdef EXTDEBUG}
+{$ifdef FPC}
+  EntryMemUsed:=system.HeapSize-MemAvail;
+{$endif FPC}
+{$endif}
 end.
 {
   $Log$
-  Revision 1.19  1999-08-16 15:35:21  pierre
+  Revision 1.20  1999-08-19 13:02:12  pierre
+    + label faillabel added for _FAIL support
+
+  Revision 1.19  1999/08/16 15:35:21  pierre
     * fix for DLL relocation problems
     * external bss vars had wrong stabs for pecoff
     + -WB11000000 to specify default image base, allows to

+ 23 - 1
compiler/m68k.pas

@@ -839,6 +839,13 @@ unit m68k;
        '%sfc','%vbr','%fpsr');
 
 
+{*****************************************************************************
+                                  Init/Done
+*****************************************************************************}
+
+  procedure InitCpu;
+  procedure DoneCpu;
+  
   implementation
 
     uses
@@ -1558,10 +1565,25 @@ unit m68k;
            End;
          inherited done;
       end;
+{*****************************************************************************
+                                  Init/Done
+*****************************************************************************}
+
+  procedure InitCpu;
+    begin
+    end;
+    
+  procedure DoneCpu;
+    begin
+    end;
+  
 end.
 {
   $Log$
-  Revision 1.11  1999-06-22 16:24:42  pierre
+  Revision 1.12  1999-08-19 13:02:08  pierre
+    + label faillabel added for _FAIL support
+
+  Revision 1.11  1999/06/22 16:24:42  pierre
    * local browser stuff corrected
 
   Revision 1.10  1998/10/29 11:35:45  florian

+ 16 - 4
compiler/psub.pas

@@ -1486,7 +1486,8 @@ procedure compile_proc_body(const proc_names:Tstringcontainer;
   Compile the body of a procedure
 }
 var
-   oldexitlabel,oldexit2label,oldquickexitlabel:Pasmlabel;
+   oldexitlabel,oldexit2label : pasmlabel;
+   oldfaillabel,oldquickexitlabel:Pasmlabel;
    _class,hp:Pobjectdef;
    { switches can change inside the procedure }
    entryswitches, exitswitches : tlocalswitches;
@@ -1522,12 +1523,16 @@ begin
    oldexitlabel:=aktexitlabel;
    oldexit2label:=aktexit2label;
    oldquickexitlabel:=quickexitlabel;
+   oldfaillabel:=faillabel;
    { get new labels }
    getlabel(aktexitlabel);
    getlabel(aktexit2label);
    { exit for fail in constructors }
    if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
-     getlabel(quickexitlabel);
+     begin
+       getlabel(faillabel);
+       getlabel(quickexitlabel);
+     end;
    { reset break and continue labels }
    in_except_block:=false;
    aktbreaklabel:=nil;
@@ -1761,11 +1766,15 @@ begin
    freelabel(aktexitlabel);
    freelabel(aktexit2label);
    if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
-    freelabel(quickexitlabel);
+     begin
+       freelabel(faillabel);
+       freelabel(quickexitlabel);
+     end;
    { restore labels }
    aktexitlabel:=oldexitlabel;
    aktexit2label:=oldexit2label;
    quickexitlabel:=oldquickexitlabel;
+   faillabel:=oldfaillabel;
 
    { reset to normal non static function }
    if (lexlevel=normal_function_level) then
@@ -2025,7 +2034,10 @@ end.
 
 {
   $Log$
-  Revision 1.14  1999-08-10 16:24:44  pierre
+  Revision 1.15  1999-08-19 13:02:11  pierre
+    + label faillabel added for _FAIL support
+
+  Revision 1.14  1999/08/10 16:24:44  pierre
    * linking to C code with cdecl;external; was broken
 
   Revision 1.13  1999/08/10 12:37:44  pierre