* 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 -

.gitattributes

@@ -8228,6 +8228,7 @@ rtl/inc/dynarr.inc svneol=native#text/plain
 rtl/inc/dynarrh.inc svneol=native#text/plain
 rtl/inc/dynlibs.pas 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/extres.inc svneol=native#text/plain
 rtl/inc/fexpand.inc svneol=native#text/plain

compiler/jvm/njvmflw.pas

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

compiler/ncgutil.pas

@@ -386,16 +386,10 @@ implementation
 *****************************************************************************}
 
     procedure get_exception_temps(list:TAsmList;var t:texceptiontemps);
-     var
-       except_buf_size: longint;
      begin
-        { todo: is there a way to retrieve the except_buf_size from the size of
+        tg.gethltemp(list,rec_exceptaddr,rec_exceptaddr.size,tt_persistent,t.envbuf);
-          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_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;
 
 

compiler/nflw.pas

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

compiler/pdecl.pas

@@ -706,10 +706,21 @@ implementation
                 ttypesym(sym).typedef:=hdef;
               newtype.typedef:=hdef;
               { KAZ: handle TGUID declaration in system unit }
-              if (cs_compilesystem in current_settings.moduleswitches) and not assigned(rec_tguid) and
+              if (cs_compilesystem in current_settings.moduleswitches) and
-                 (gentypename='TGUID') and { name: TGUID and size=16 bytes that is 128 bits }
+                 assigned(hdef) and
-                 assigned(hdef) and (hdef.typ=recorddef) and (hdef.size=16) then
+                 (hdef.typ=recorddef) then
-                rec_tguid:=trecorddef(hdef);
+                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;
            if assigned(hdef) then
             begin

compiler/symdef.pas

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

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}
 ThreadVar
 {$else FPC_HAS_FEATURE_THREADING}

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);
+

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
   type in ObjFpc and Delphi modes). It is defined here for use in the
   implementation part of the System unit. }