浏览代码

* split off the texceptaddr declaration into rtl/inc/excepth.inc, so it can
be included at the start of the implementation of the system unit (before
the rest of except.inc)
* catch declarations in/loading from the system unit of the TExceptAddr type
* use this type instead of hardcoded size constants in the compiler
* in generic code that is active for all targets, puts its use in a virtual
method since it's only valid for targets using setjmp/longjmp-style
exception handling (and the record is not defined at all in the JVM RTL)

git-svn-id: branches/hlcgllvm@28376 -

Jonas Maebe 11 年之前
父节点
当前提交
6e1d370417
共有 9 个文件被更改,包括 112 次插入51 次删除
  1. 1 0
      .gitattributes
  2. 16 0
      compiler/jvm/njvmflw.pas
  3. 2 8
      compiler/ncgutil.pas
  4. 17 2
      compiler/nflw.pas
  5. 15 4
      compiler/pdecl.pas
  6. 19 14
      compiler/symdef.pas
  7. 0 23
      rtl/inc/except.inc
  8. 37 0
      rtl/inc/excepth.inc
  9. 5 0
      rtl/inc/system.inc

+ 1 - 0
.gitattributes

@@ -8228,6 +8228,7 @@ rtl/inc/dynarr.inc svneol=native#text/plain
 rtl/inc/dynarrh.inc svneol=native#text/plain
 rtl/inc/dynarrh.inc svneol=native#text/plain
 rtl/inc/dynlibs.pas svneol=native#text/plain
 rtl/inc/dynlibs.pas svneol=native#text/plain
 rtl/inc/except.inc svneol=native#text/plain
 rtl/inc/except.inc svneol=native#text/plain
+rtl/inc/excepth.inc svneol=native#text/plain
 rtl/inc/exeinfo.pp svneol=native#text/plain
 rtl/inc/exeinfo.pp svneol=native#text/plain
 rtl/inc/extres.inc svneol=native#text/plain
 rtl/inc/extres.inc svneol=native#text/plain
 rtl/inc/fexpand.inc svneol=native#text/plain
 rtl/inc/fexpand.inc svneol=native#text/plain

+ 16 - 0
compiler/jvm/njvmflw.pas

@@ -41,10 +41,14 @@ interface
 
 
        tjvmtryexceptnode = class(ttryexceptnode)
        tjvmtryexceptnode = class(ttryexceptnode)
           procedure pass_generate_code;override;
           procedure pass_generate_code;override;
+         protected
+          procedure adjust_estimated_stack_size; override;
        end;
        end;
 
 
        tjvmtryfinallynode = class(ttryfinallynode)
        tjvmtryfinallynode = class(ttryfinallynode)
           procedure pass_generate_code;override;
           procedure pass_generate_code;override;
+         protected
+          procedure adjust_estimated_stack_size; override;
        end;
        end;
 
 
        tjvmonnode = class(tonnode)
        tjvmonnode = class(tonnode)
@@ -258,6 +262,12 @@ implementation
       end;
       end;
 
 
 
 
+    procedure tjvmtryexceptnode.adjust_estimated_stack_size;
+      begin
+        { do nothing }
+      end;
+
+
     {*****************************************************************************
     {*****************************************************************************
                                    SecondOn
                                    SecondOn
     *****************************************************************************}
     *****************************************************************************}
@@ -492,6 +502,12 @@ implementation
          flowcontrol:=oldflowcontrol+(tryflowcontrol-[fc_inflowcontrol]);
          flowcontrol:=oldflowcontrol+(tryflowcontrol-[fc_inflowcontrol]);
       end;
       end;
 
 
+
+    procedure tjvmtryfinallynode.adjust_estimated_stack_size;
+      begin
+        { do nothing }
+      end;
+
 begin
 begin
    cfornode:=tjvmfornode;
    cfornode:=tjvmfornode;
    craisenode:=tjvmraisenode;
    craisenode:=tjvmraisenode;

+ 2 - 8
compiler/ncgutil.pas

@@ -386,16 +386,10 @@ implementation
 *****************************************************************************}
 *****************************************************************************}
 
 
     procedure get_exception_temps(list:TAsmList;var t:texceptiontemps);
     procedure get_exception_temps(list:TAsmList;var t:texceptiontemps);
-     var
-       except_buf_size: longint;
      begin
      begin
-        { todo: is there a way to retrieve the except_buf_size from the size of
-          the TExceptAddr record from the system unit (like we do for jmp_buf_size),
-          without moving TExceptAddr to the interface part? }
-        except_buf_size:=voidpointertype.size*2+sizeof(pint);
-        tg.GetTemp(list,except_buf_size,sizeof(pint),tt_persistent,t.envbuf);
+        tg.gethltemp(list,rec_exceptaddr,rec_exceptaddr.size,tt_persistent,t.envbuf);
         tg.gethltemp(list,rec_jmp_buf,rec_jmp_buf.size,tt_persistent,t.jmpbuf);
         tg.gethltemp(list,rec_jmp_buf,rec_jmp_buf.size,tt_persistent,t.jmpbuf);
-        tg.GetTemp(list,sizeof(pint),sizeof(pint),tt_persistent,t.reasonbuf);
+        tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
       end;
       end;
 
 
 
 

+ 17 - 2
compiler/nflw.pas

@@ -183,6 +183,8 @@ interface
           function pass_typecheck:tnode;override;
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
           function pass_1 : tnode;override;
           function simplify(forinline: boolean): tnode; override;
           function simplify(forinline: boolean): tnode; override;
+         protected
+          procedure adjust_estimated_stack_size; virtual;
        end;
        end;
        ttryexceptnodeclass = class of ttryexceptnode;
        ttryexceptnodeclass = class of ttryexceptnode;
 
 
@@ -195,6 +197,7 @@ interface
           function simplify(forinline:boolean): tnode;override;
           function simplify(forinline:boolean): tnode;override;
        protected
        protected
           function create_finalizer_procdef: tprocdef;
           function create_finalizer_procdef: tprocdef;
+          procedure adjust_estimated_stack_size; virtual;
        end;
        end;
        ttryfinallynodeclass = class of ttryfinallynode;
        ttryfinallynodeclass = class of ttryfinallynode;
 
 
@@ -2068,7 +2071,8 @@ implementation
 
 
         include(current_procinfo.flags,pi_do_call);
         include(current_procinfo.flags,pi_do_call);
         include(current_procinfo.flags,pi_uses_exceptions);
         include(current_procinfo.flags,pi_uses_exceptions);
-        inc(current_procinfo.estimatedtempsize,rec_jmp_buf.size*2);
+
+        adjust_estimated_stack_size;
       end;
       end;
 
 
 
 
@@ -2080,6 +2084,11 @@ implementation
           result:=cnothingnode.create;
           result:=cnothingnode.create;
       end;
       end;
 
 
+    procedure ttryexceptnode.adjust_estimated_stack_size;
+      begin
+        inc(current_procinfo.estimatedtempsize,rec_jmp_buf.size*2);
+      end;
+
 
 
 {*****************************************************************************
 {*****************************************************************************
                            TTRYFINALLYNODE
                            TTRYFINALLYNODE
@@ -2141,7 +2150,7 @@ implementation
         if not(implicitframe) then
         if not(implicitframe) then
           include(current_procinfo.flags,pi_uses_exceptions);
           include(current_procinfo.flags,pi_uses_exceptions);
 
 
-        inc(current_procinfo.estimatedtempsize,rec_jmp_buf.size);
+        adjust_estimated_stack_size;
       end;
       end;
 
 
 
 
@@ -2206,6 +2215,12 @@ implementation
       end;
       end;
 
 
 
 
+    procedure ttryfinallynode.adjust_estimated_stack_size;
+      begin
+        inc(current_procinfo.estimatedtempsize,rec_jmp_buf.size);
+      end;
+
+
 {*****************************************************************************
 {*****************************************************************************
                                 TONNODE
                                 TONNODE
 *****************************************************************************}
 *****************************************************************************}

+ 15 - 4
compiler/pdecl.pas

@@ -706,10 +706,21 @@ implementation
                 ttypesym(sym).typedef:=hdef;
                 ttypesym(sym).typedef:=hdef;
               newtype.typedef:=hdef;
               newtype.typedef:=hdef;
               { KAZ: handle TGUID declaration in system unit }
               { KAZ: handle TGUID declaration in system unit }
-              if (cs_compilesystem in current_settings.moduleswitches) and not assigned(rec_tguid) and
-                 (gentypename='TGUID') and { name: TGUID and size=16 bytes that is 128 bits }
-                 assigned(hdef) and (hdef.typ=recorddef) and (hdef.size=16) then
-                rec_tguid:=trecorddef(hdef);
+              if (cs_compilesystem in current_settings.moduleswitches) and
+                 assigned(hdef) and
+                 (hdef.typ=recorddef) then
+                begin
+                  if not assigned(rec_tguid) and
+                     (gentypename='TGUID') and
+                     (hdef.size=16) then
+                    rec_tguid:=trecorddef(hdef)
+                  else if not assigned(rec_jmp_buf) and
+                     (gentypename='JMP_BUF') then
+                    rec_jmp_buf:=trecorddef(hdef)
+                  else if not assigned(rec_exceptaddr) and
+                     (gentypename='TEXCEPTADDR') then
+                    rec_exceptaddr:=trecorddef(hdef);
+                end;
             end;
             end;
            if assigned(hdef) then
            if assigned(hdef) then
             begin
             begin

+ 19 - 14
compiler/symdef.pas

@@ -1017,9 +1017,12 @@ interface
          of all interfaces         }
          of all interfaces         }
        rec_tguid : trecorddef;
        rec_tguid : trecorddef;
 
 
-       { pointer to jump buffer }
+       { jump buffer type, used by setjmp }
        rec_jmp_buf : trecorddef;
        rec_jmp_buf : trecorddef;
 
 
+       { system.texceptaddr type, used by fpc_pushexceptaddr }
+       rec_exceptaddr: trecorddef;
+
        { Objective-C base types }
        { Objective-C base types }
        objc_metaclasstype,
        objc_metaclasstype,
        objc_superclasstype,
        objc_superclasstype,
@@ -4060,21 +4063,23 @@ implementation
          else
          else
            tstoredsymtable(symtable).deref;
            tstoredsymtable(symtable).deref;
 
 
-         { assign TGUID? load only from system unit }
-         if not(assigned(rec_tguid)) and
-            (upper(typename)='TGUID') and
-            assigned(owner) and
-            assigned(owner.name) and
-            (owner.name^='SYSTEM') then
-           rec_tguid:=self;
-
-         { assign JMP_BUF? load only from system unit }
-         if not(assigned(rec_jmp_buf)) and
-            (upper(typename)='JMP_BUF') and
-            assigned(owner) and
+         { internal types, only load from the system unit }
+         if assigned(owner) and
             assigned(owner.name) and
             assigned(owner.name) and
             (owner.name^='SYSTEM') then
             (owner.name^='SYSTEM') then
-           rec_jmp_buf:=self;
+           begin
+             { TGUID  }
+             if not assigned(rec_tguid) and
+                (upper(typename)='TGUID') then
+               rec_tguid:=self
+             { JMP_BUF }
+             else if not assigned(rec_jmp_buf) and
+                (upper(typename)='JMP_BUF') then
+               rec_jmp_buf:=self
+             else if not assigned(rec_exceptaddr) and
+                (upper(typename)='TEXCEPTADDR') then
+               rec_exceptaddr:=self;
+           end;
       end;
       end;
 
 
 
 

+ 0 - 23
rtl/inc/except.inc

@@ -17,29 +17,6 @@
 ****************************************************************************}
 ****************************************************************************}
 
 
 
 
-Const
-  { Type of exception. Currently only one. }
-  FPC_EXCEPTION   = 1;
-
-  { types of frames for the exception address stack }
-  cExceptionFrame = 1;
-  cFinalizeFrame  = 2;
-
-Type
-  PExceptAddr = ^TExceptAddr;
-  TExceptAddr = record
-    buf       : pjmp_buf;
-    next      : PExceptAddr;
-{$ifdef CPU16}
-    frametype : Smallint;
-{$else CPU16}
-    frametype : Longint;
-{$endif CPU16}
-  end;
-
-Const
-  CatchAllExceptions = PtrInt(-1);
-
 {$ifdef FPC_HAS_FEATURE_THREADING}
 {$ifdef FPC_HAS_FEATURE_THREADING}
 ThreadVar
 ThreadVar
 {$else FPC_HAS_FEATURE_THREADING}
 {$else FPC_HAS_FEATURE_THREADING}

+ 37 - 0
rtl/inc/excepth.inc

@@ -0,0 +1,37 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt
+    member of the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Const
+  { Type of exception. Currently only one. }
+  FPC_EXCEPTION   = 1;
+
+  { types of frames for the exception address stack }
+  cExceptionFrame = 1;
+  cFinalizeFrame  = 2;
+
+Type
+  PExceptAddr = ^TExceptAddr;
+  TExceptAddr = record
+    buf       : pjmp_buf;
+    next      : PExceptAddr;
+{$ifdef CPU16}
+    frametype : Smallint;
+{$else CPU16}
+    frametype : Longint;
+{$endif CPU16}
+  end;
+
+Const
+  CatchAllExceptions = PtrInt(-1);
+

+ 5 - 0
rtl/inc/system.inc

@@ -12,6 +12,11 @@
 
 
  **********************************************************************}
  **********************************************************************}
 
 
+{ contains the definition of the TExceptAddr type, which is required
+  by the compiler to generate code for any routine containing
+  implicit or explicit exceptions }
+{$i excepth.inc}
+
 { ObjpasInt is the integer type, equivalent to Objpas.Integer (the Integer
 { ObjpasInt is the integer type, equivalent to Objpas.Integer (the Integer
   type in ObjFpc and Delphi modes). It is defined here for use in the
   type in ObjFpc and Delphi modes). It is defined here for use in the
   implementation part of the System unit. }
   implementation part of the System unit. }