* the info about exception frames is stored now on the stack

instead on the heap

compiler/i386/cgai386.pas

@@ -2089,6 +2089,7 @@ implementation
       oldexprasmlist : TAAsmoutput;
       again : pasmlabel;
       i : longint;
+      tempbuf,tempaddr : treference;
 
     begin
        oldexprasmlist:=exprasmlist;
@@ -2319,9 +2320,22 @@ implementation
         begin
             usedinproc:=usedinproc or ($80 shr byte(R_EAX));
 
+            exprasmList.concat(Taicpu.op_const_reg(A_SUB,S_L,36,R_ESP));
+            exprasmList.concat(Taicpu.op_reg_reg(A_MOV,S_L,R_ESP,R_EDI));
+
+            reset_reference(tempaddr);
+            tempaddr.base:=R_EDI;
+            emitpushreferenceaddr(tempaddr);
+
+            reset_reference(tempbuf);
+            tempbuf.base:=R_EDI;
+            tempbuf.offset:=12;
+            emitpushreferenceaddr(tempbuf);
+
             { Type of stack-frame must be pushed}
-            exprasmList.concat(Taicpu.Op_const(A_PUSH,S_L,1));
+            exprasmList.concat(Taicpu.op_const(A_PUSH,S_L,1));
             emitcall('FPC_PUSHEXCEPTADDR');
+
             exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX));
             emitcall('FPC_SETJMP');
             exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX));
@@ -2908,7 +2922,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.16  2000-12-25 00:07:31  peter
+  Revision 1.17  2001-01-05 17:36:58  florian
+  * the info about exception frames is stored now on the stack
+  instead on the heap
+
+  Revision 1.16  2000/12/25 00:07:31  peter
     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
       tlinkedlist objects)
 

compiler/i386/n386flw.pas

@@ -738,6 +738,8 @@ do_jmp:
 
          oldflowcontrol,tryflowcontrol,
          exceptflowcontrol : tflowcontrol;
+         tempbuf,tempaddr : treference;
+
       label
          errorexit;
       begin
@@ -773,8 +775,14 @@ do_jmp:
          getlabel(doexceptlabel);
          getlabel(endexceptlabel);
          getlabel(lastonlabel);
+
+         gettempofsizereferencepersistant(24,tempbuf);
+         gettempofsizereferencepersistant(12,tempaddr);
+         emitpushreferenceaddr(tempaddr);
+         emitpushreferenceaddr(tempbuf);
          push_int (1); { push type of exceptionframe }
          emitcall('FPC_PUSHEXCEPTADDR');
+
          { allocate eax }
          exprasmList.concat(Tairegalloc.Alloc(R_EAX));
          emit_reg(A_PUSH,S_L,R_EAX);
@@ -806,6 +814,8 @@ do_jmp:
 
          emitlab(exceptlabel);
          emitcall('FPC_POPADDRSTACK');
+         ungetpersistanttempreference(tempaddr);
+         ungetpersistanttempreference(tempbuf);
 
          exprasmList.concat(Tairegalloc.Alloc(R_EAX));
          emit_reg(A_POP,S_L,R_EAX);
@@ -850,8 +860,14 @@ do_jmp:
               { guarded by an exception frame                        }
               getlabel(doobjectdestroy);
               getlabel(doobjectdestroyandreraise);
+
+              gettempofsizereferencepersistant(12,tempaddr);
+              gettempofsizereferencepersistant(24,tempbuf);
+              emitpushreferenceaddr(tempaddr);
+              emitpushreferenceaddr(tempbuf);
               exprasmList.concat(Taicpu.Op_const(A_PUSH,S_L,1));
               emitcall('FPC_PUSHEXCEPTADDR');
+
               exprasmList.concat(Tairegalloc.Alloc(R_EAX));
               exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX));
               exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
@@ -872,6 +888,9 @@ do_jmp:
 
               emitlab(doobjectdestroyandreraise);
               emitcall('FPC_POPADDRSTACK');
+              ungetpersistanttempreference(tempaddr);
+              ungetpersistanttempreference(tempbuf);
+
               exprasmList.concat(Tairegalloc.Alloc(R_EAX));
               exprasmList.concat(Taicpu.op_reg(A_POP,S_L,R_EAX));
               exprasmList.concat(Taicpu.op_reg_reg(A_TEST,S_L,R_EAX,R_EAX));
@@ -984,6 +1003,7 @@ do_jmp:
          ref : treference;
          oldexceptblock : tnode;
          oldflowcontrol : tflowcontrol;
+         tempbuf,tempaddr : treference;
 
       begin
          oldflowcontrol:=flowcontrol;
@@ -1013,8 +1033,14 @@ do_jmp:
          { in the case that another exception is risen }
          { we've to destroy the old one                }
          getlabel(doobjectdestroyandreraise);
+
+         gettempofsizereferencepersistant(12,tempaddr);
+         gettempofsizereferencepersistant(24,tempbuf);
+         emitpushreferenceaddr(tempaddr);
+         emitpushreferenceaddr(tempbuf);
          exprasmList.concat(Taicpu.Op_const(A_PUSH,S_L,1));
          emitcall('FPC_PUSHEXCEPTADDR');
+
          exprasmList.concat(Tairegalloc.Alloc(R_EAX));
          exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX));
          exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
@@ -1052,6 +1078,9 @@ do_jmp:
          getlabel(doobjectdestroy);
          emitlab(doobjectdestroyandreraise);
          emitcall('FPC_POPADDRSTACK');
+         ungetpersistanttempreference(tempaddr);
+         ungetpersistanttempreference(tempbuf);
+
          exprasmList.concat(Tairegalloc.Alloc(R_EAX));
          exprasmList.concat(Taicpu.op_reg(A_POP,S_L,R_EAX));
          exprasmList.concat(Taicpu.op_reg_reg(A_TEST,S_L,R_EAX,R_EAX));
@@ -1134,6 +1163,7 @@ do_jmp:
          oldexceptblock : tnode;
          oldflowcontrol,tryflowcontrol : tflowcontrol;
          decconst : longint;
+         tempbuf,tempaddr : treference;
 
       begin
          { check if child nodes do a break/continue/exit }
@@ -1162,8 +1192,13 @@ do_jmp:
             aktbreaklabel:=breakfinallylabel;
           end;
 
+         gettempofsizereferencepersistant(12,tempaddr);
+         gettempofsizereferencepersistant(24,tempbuf);
+         emitpushreferenceaddr(tempaddr);
+         emitpushreferenceaddr(tempbuf);
          push_int(1); { Type of stack-frame must be pushed}
          emitcall('FPC_PUSHEXCEPTADDR');
+
          { allocate eax }
          exprasmList.concat(Tairegalloc.Alloc(R_EAX));
          emit_reg(A_PUSH,S_L,R_EAX);
@@ -1188,6 +1223,9 @@ do_jmp:
 
          emitlab(finallylabel);
          emitcall('FPC_POPADDRSTACK');
+         ungetpersistanttempreference(tempaddr);
+         ungetpersistanttempreference(tempbuf);
+
          { finally code }
          oldexceptblock:=aktexceptblock;
          aktexceptblock:=right;
@@ -1302,7 +1340,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2000-12-25 00:07:32  peter
+  Revision 1.6  2001-01-05 17:36:58  florian
+  * the info about exception frames is stored now on the stack
+  instead on the heap
+
+  Revision 1.5  2000/12/25 00:07:32  peter
     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
       tlinkedlist objects)
 

compiler/i386/ra386int.pas

@@ -1007,6 +1007,7 @@ type
 
 
 Procedure T386IntelOperand.BuildReference;
+
 var
   k,l : longint;
   tempstr2,
@@ -1920,7 +1921,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  2000-12-25 00:07:34  peter
+  Revision 1.7  2001-01-05 17:36:58  florian
+  * the info about exception frames is stored now on the stack
+  instead on the heap
+
+  Revision 1.6  2000/12/25 00:07:34  peter
     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
       tlinkedlist objects)
 

compiler/ia64/cpuasm.pas

@@ -34,7 +34,7 @@ uses
 
 type
   pairegalloc = ^tairegalloc;
-  tairegalloc = object(tai)
+  tairegalloc = class(tai)
      allocation : boolean;
      reg        : tregister;
      constructor alloc(r : tregister);
@@ -42,7 +42,7 @@ type
   end;
 
   { Types of operand }
-  toptype=(top_none,top_reg,top_ref,top_const,top_symbol);
+  toptype=(top_none,top_reg,top_ref,top_const,top_symbol,top_qp);
 
   toper=record
     case typ : toptype of
@@ -55,55 +55,52 @@ type
   end;
 
   paicpu = ^taicpu;
-  taicpu = object(tai)
+  taicpu = class(tai)
      is_jmp    : boolean; { is this instruction a jump? (needed for optimizer) }
      opcode    : tasmop;
-     ops       : longint;
      ops       : array[0..4] of longint;
-     oper
+     oper      : longint;
      qp        : tqp;
+     ldsttype  : tldsttype;
+     hint      : thint;
      { ALU instructions }
      { A1,A9: integer ALU }
      constructor op_reg_reg_reg(op : tasmop;const r1,r2,r3 : tregister);
      { A2,A10: shift left and add }
-     constructor op_reg_reg_const_reg(qp : tqp;op : tasmop;
+     constructor op_reg_reg_const_reg(_qp : tqp;op : tasmop;
        const r1,r2 : tregister;i : byte;const r3 : tregister);
      { A3,A4,A5: integer ALU - imm.,register }
-     constructor op_reg_const_reg(qp : tqp;op : tasmop;
+     constructor op_reg_const_reg(_qp : tqp;op : tasmop;
        const r1 : tregister;i : longint;const r3 : tregister);
      { A6,A7: integer compare - register,register }
-     constructor op_preg_preg_reg_reg(qp : tqp;op : tasmop;
-       cond : tasmcond;p1,p2 : tqp;const r2,r3 : tregister)
+     constructor op_preg_preg_reg_reg(_qp : tqp;op : tasmop;
+       cond : tasmcond;p1,p2 : tqp;const r2,r3 : tregister);
      { A8: integer compare - imm.,register }
-     constructor op_preg_preg_const_reg(qp : tqp;op : tasmop;
+     constructor op_preg_preg_const_reg(_qp : tqp;op : tasmop;
        cond : tasmcond;p1,p2 : tqp;i : longint;const r3 : tregister);
 {!!!!!!!
      { multimedia shift and multiply }
-     constructor op_reg_reg_reg_const(qp : tqp;
+     constructor op_reg_reg_reg_const(_qp : tqp;
      { multimedia mux }
-     constructor op_reg_reg_mbtype(qp : tqp;
+     constructor op_reg_reg_mbtype(_qp : tqp;
      { multimedia shift fixed }
-     constructor op_reg_reg_const(qp : tqp;
+     constructor op_reg_reg_const(_qp : tqp;
      { div. }
-     constructor op_reg_reg(qp : tqp;
+     constructor op_reg_reg(_qp : tqp;
      { mm extract }
-     constructor op_reg_reg_const_const(qp : tqp;
+     constructor op_reg_reg_const_const(_qp : tqp;
      { zero and deposit imm }
-     constructor op_reg_const_const_const(qp : tqp;
+     constructor op_reg_const_const_const(_qp : tqp;
      { deposit imm }
-     constructor op_reg_const_reg_const_const(qp : tqp;
+     constructor op_reg_const_reg_const_const(_qp : tqp;
      { deposit }
-     constructor op_reg_reg_reg_const_const(qp : tqp;
+     constructor op_reg_reg_reg_const_const(_qp : tqp;
      { test bit }
      { !!!! here we need also to take care of the postfix }
-     constructor op_preg_preg_reg_const(qp : tqp;
+     constructor op_preg_preg_reg_const(_qp : tqp;
      { test NaT }
      { !!!! here we need also to take care of the postfix }
-     constructor op_preg_preg_reg(qp : tqp;
-     { break/nop }
-     constructor op_const(qp : tqp;
-     { speculation check }
-     constructor op_reg_const(qp : tqp;
+     constructor op_preg_preg_reg(_qp : tqp;
 
      { -------- here are some missed ----------- }
 }
@@ -112,35 +109,41 @@ type
      { M4: integer store }
      { M6: floating-point load }
      { M9: floating-point store }
-     constructor op_reg_ref(qp : tqp;op : tasmop;postfix : tldsttype;
-       hint : thint;const r1 : tregister;ref : preference);
+     constructor op_reg_ref(_qp : tqp;op : tasmop;postfix : tldsttype;
+       _hint : thint;const r1 : tregister;ref : preference);
 
      { M2: integer load incremented by register }
      { M7: floating-point load incremented by register }
-     constructor op_reg_ref_reg(qp : tqp;op : tasmop;postfix : tldsttype;
-       hint : thint;const r1 : tregister;const ref : treference;
+     constructor op_reg_ref_reg(_qp : tqp;op : tasmop;postfix : tldsttype;
+       _hint : thint;const r1 : tregister;const ref : treference;
        const r2 : tregister);
 
      { M3: integer load increment by imm. }
      { M5: integer store increment by imm. }
      { M8: floating-point load increment by imm. }
      { M10: floating-point store increment by imm. }
-     constructor op_reg_ref_const(qp : tqp;op : tasmop;postfix : tldsttype;
-       hint : thint;const r1 : tregister;ref : preference;i : longint);
+     constructor op_reg_ref_const(_qp : tqp;op : tasmop;postfix : tldsttype;
+       _hint : thint;const r1 : tregister;ref : preference;i : longint);
 
      { M11: floating-point load pair}
-     constructor op_reg_ref(qp : tqp;op : tasmop;postfix : tldsttype;
-       hint : thint;const r1,r2 : tregister;ref : preference);
+     constructor op_reg_ref(_qp : tqp;op : tasmop;postfix : tldsttype;
+       _hint : thint;const r1,r2 : tregister;ref : preference);
 
      { M12: floating-point load pair increment by imm. }
-     constructor op_reg_ref(qp : tqp;op : tasmop;postfix : tldsttype;
-       hint : thint;const r1,r2 : tregister;ref : preference;i : longint);
+     constructor op_reg_ref(_qp : tqp;op : tasmop;postfix : tldsttype;
+       _hint : thint;const r1,r2 : tregister;ref : preference;i : longint);
+
+     { X1: break/nop }
+     constructor op_const62(_qp : tqp;op : tasmop;i : int64);
+     { X2: move imm64 }
+     constructor op_reg_const64(_qp : tqp;op : tasmop;const r1 : tregister;
+       i : int64);
   end;
 
   { the following objects are special for the ia64 }
   { they decribe a stop and the bundles            }
   paistop = ^taistop;
-  taistop = object(tai)
+  taistop = class(tai)
     constructor init;
   end;
 
@@ -154,7 +157,7 @@ type
     but_mfb,but_mfb_);
 
   paibundle = ^taibundle;
-  taibundle = object(tai)
+  taibundle = class(tai)
      template : tbundletemplate;
      instructions : array[0..1] of paicpu;
   end;
@@ -169,7 +172,7 @@ implementation
     constructor taistop.init;
 
       begin
-         inherited init;
+         inherited create;
          typ:=ait_stop;
       end;
 
@@ -180,7 +183,7 @@ implementation
 
     constructor tairegalloc.alloc(r : tregister);
       begin
-        inherited init;
+        inherited create;
         typ:=ait_regalloc;
         allocation:=true;
         reg:=r;
@@ -189,17 +192,115 @@ implementation
 
     constructor tairegalloc.dealloc(r : tregister);
       begin
-        inherited init;
+        inherited create;
         typ:=ait_regalloc;
         allocation:=false;
         reg:=r;
       end;
 
 
+{*****************************************************************************
+                                 Taicpu
+*****************************************************************************}
+
+    { ALU instructions }
+    { A1,A9: integer ALU }
+    constructor taicpu.op_reg_reg_reg(op : tasmop;const r1,r2,r3 : tregister);
+
+      begin
+      end;
+
+    { A2,A10: shift left and add }
+    constructor taicpu.op_reg_reg_const_reg(_qp : tqp;op : tasmop;
+      const r1,r2 : tregister;i : byte;const r3 : tregister);
+
+      begin
+      end;
+
+    { A3,A4,A5: integer ALU - imm.,register }
+    constructor taicpu.op_reg_const_reg(_qp : tqp;op : tasmop;
+      const r1 : tregister;i : longint;const r3 : tregister);
+
+      begin
+      end;
+
+    { A6,A7: integer compare - register,register }
+    constructor taicpu.op_preg_preg_reg_reg(_qp : tqp;op : tasmop;
+      cond : tasmcond;p1,p2 : tqp;const r2,r3 : tregister);
+
+      begin
+      end;
+
+    { A8: integer compare - imm.,register }
+    constructor taicpu.op_preg_preg_const_reg(_qp : tqp;op : tasmop;
+      cond : tasmcond;p1,p2 : tqp;i : longint;const r3 : tregister);
+
+      begin
+      end;
+
+    { M1: integer load }
+    { M4: integer store }
+    { M6: floating-point load }
+    { M9: floating-point store }
+    constructor taicpu.op_reg_ref(_qp : tqp;op : tasmop;postfix : tldsttype;
+      _hint : thint;const r1 : tregister;ref : preference);
+
+      begin
+      end;
+
+    { M2: integer load incremented by register }
+    { M7: floating-point load incremented by register }
+    constructor taicpu.op_reg_ref_reg(_qp : tqp;op : tasmop;postfix : tldsttype;
+      _hint : thint;const r1 : tregister;const ref : treference;
+      const r2 : tregister);
+
+      begin
+      end;
+
+    { M3: integer load increment by imm. }
+    { M5: integer store increment by imm. }
+    { M8: floating-point load increment by imm. }
+    { M10: floating-point store increment by imm. }
+    constructor taicpu.op_reg_ref_const(_qp : tqp;op : tasmop;postfix : tldsttype;
+      _hint : thint;const r1 : tregister;ref : preference;i : longint);
+
+      begin
+      end;
+
+    { M11: floating-point load pair}
+    constructor taicpu.op_reg_ref(_qp : tqp;op : tasmop;postfix : tldsttype;
+      _hint : thint;const r1,r2 : tregister;ref : preference);
+
+      begin
+      end;
+
+    { M12: floating-point load pair increment by imm. }
+    constructor taicpu.op_reg_ref(_qp : tqp;op : tasmop;postfix : tldsttype;
+      _hint : thint;const r1,r2 : tregister;ref : preference;i : longint);
+
+      begin
+      end;
+
+    { X1: break/nop }
+    constructor taicpu.op_const62(_qp : tqp;op : tasmop;i : int64);
+    { X2: move imm64 }
+
+      begin
+      end;
+
+    constructor taicpu.op_reg_const64(_qp : tqp;op : tasmop;const r1 : tregister;
+      i : int64);
+
+      begin
+      end;
+
 end.
 {
   $Log$
-  Revision 1.1  2000-12-31 16:54:19  florian
-    + initial revision
+  Revision 1.2  2001-01-05 17:36:58  florian
+  * the info about exception frames is stored now on the stack
+  instead on the heap
 
+  Revision 1.1  2000/12/31 16:54:19  florian
+    + initial revision
 }

compiler/ia64/cpubase.pas

@@ -55,10 +55,13 @@ Const
   lastop  = high(tasmop);
 
 type
-  TAsmCond =
-   ();
+  TAsmCond = (C_NONE,C_LT,C_LTU,C_EQ,C_LT_UNC,C_LTU_UNC,C_EQ_UNC,
+              C_EQ_AND,C_EQ_OR,C_EQ_OR_ANDCM,C_NE_AND,C_NE_OR);
 
   THint = (H_NONE,H_NT1,H_NT2,H_NTA);
+  TLdStType = (LST_NONE,LST_S,LST_A,LSR_SA,LST_BIAS,LST_ACQ,LST_C_CLR,
+               LST_FILL,LST_C_NC,LST_C_CLR_ACQ,LST_REL,
+               LST_SPILL);
 
 Type
  TRegister = (R_NO,  { R_NO is Mandatory, signifies no register }
@@ -183,14 +186,16 @@ Type
 {$endif}
 
 
-{ resets all values of ref to defaults }
-procedure reset_reference(var ref : treference);
-{ set mostly used values of a new reference }
-function new_reference(base : tregister;offset : longint) : preference;
-function newreference(const r : treference) : preference;
-procedure disposereference(var r : preference);
+  { resets all values of ref to defaults }
+  procedure reset_reference(var ref : treference);
+  { set mostly used values of a new reference }
+  function new_reference(base : tregister;offset : longint) : preference;
+  function newreference(const r : treference) : preference;
+  procedure disposereference(var r : preference);
 
-function reg2str(r : tregister) : string;
+  procedure set_location(var destloc : tlocation;const sourceloc : tlocation);
+
+  function reg2str(r : tregister) : string;
 
 {*****************************************************************************
                                   Init/Done
@@ -201,52 +206,58 @@ function reg2str(r : tregister) : string;
 
 implementation
 
-uses
-   verbose;
+  uses
+     verbose;
+
+  function reg2str(r : tregister) : string;
 
-function reg2str(r : tregister) : string;
+    begin
+       if r in [R_0..R_31] then
+         reg2str:='R'+tostr(longint(r)-longint(R_0))
+       else if r in [R_F0..R_F31] then
+         reg2str:='F'+tostr(longint(r)-longint(R_F0))
+       else internalerror(38991);
+    end;
 
+  procedure reset_reference(var ref : treference);
   begin
-     if r in [R_0..R_31] then
-       reg2str:='R'+tostr(longint(r)-longint(R_0))
-     else if r in [R_F0..R_F31] then
-       reg2str:='F'+tostr(longint(r)-longint(R_F0))
-     else internalerror(38991);
+    FillChar(ref,sizeof(treference),0);
   end;
 
-procedure reset_reference(var ref : treference);
-begin
-  FillChar(ref,sizeof(treference),0);
-end;
 
+  function new_reference(base : tregister;offset : longint) : preference;
+  var
+    r : preference;
+  begin
+    new(r);
+    FillChar(r^,sizeof(treference),0);
+    r^.offset:=offset;
+    r^.alignment:=8;
+    new_reference:=r;
+  end;
+
+  function newreference(const r : treference) : preference;
 
-function new_reference(base : tregister;offset : longint) : preference;
-var
-  r : preference;
-begin
-  new(r);
-  FillChar(r^,sizeof(treference),0);
-  r^.offset:=offset;
-  r^.alignment:=8;
-  new_reference:=r;
-end;
+  var
+     p : preference;
+  begin
+     new(p);
+     p^:=r;
+     newreference:=p;
+  end;
 
-function newreference(const r : treference) : preference;
+  procedure disposereference(var r : preference);
 
-var
-   p : preference;
-begin
-   new(p);
-   p^:=r;
-   newreference:=p;
-end;
+  begin
+    dispose(r);
+    r:=Nil;
+  end;
 
-procedure disposereference(var r : preference);
+  procedure set_location(var destloc : tlocation;const sourceloc : tlocation);
 
-begin
-  dispose(r);
-  r:=Nil;
-end;
+    begin
+       destloc:=sourceloc;
+    end;
 
 {*****************************************************************************
                                   Init/Done
@@ -263,7 +274,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.1  2000-12-31 16:54:19  florian
+  Revision 1.2  2001-01-05 17:36:58  florian
+  * the info about exception frames is stored now on the stack
+  instead on the heap
+
+  Revision 1.1  2000/12/31 16:54:19  florian
     + initial revision
 
   Revision 1.1  2000/07/13 06:30:11  michael

compiler/ia64/cpuinfo.pas

@@ -37,7 +37,7 @@ Type
    { this must be an ordinal type with the same size as a pointer }
    { to allow some dirty type casts for example when using        }
    { tconstsym.value                                              }
-   TPointerOrd = int64;
+   TPointerOrd = longint;
 
 
 Const
@@ -54,7 +54,11 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.1  2000-12-31 16:54:19  florian
+  Revision 1.2  2001-01-05 17:36:58  florian
+  * the info about exception frames is stored now on the stack
+  instead on the heap
+
+  Revision 1.1  2000/12/31 16:54:19  florian
     + initial revision
 
 }

compiler/nmat.pas

@@ -64,9 +64,8 @@ implementation
       htypechk,pass_1,cpubase,cpuinfo,
 {$ifdef newcg}
       cgbase,
-{$else newcg}
-      hcodegen,
 {$endif newcg}
+      hcodegen,
       ncon,ncnv,ncal;
 
 {****************************************************************************
@@ -529,7 +528,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.11  2000-12-25 00:07:26  peter
+  Revision 1.12  2001-01-05 17:36:57  florian
+  * the info about exception frames is stored now on the stack
+  instead on the heap
+
+  Revision 1.11  2000/12/25 00:07:26  peter
     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
       tlinkedlist objects)
 

compiler/options.pas

@@ -1234,6 +1234,7 @@ begin
   def_symbol('INTERNSETLENGTH');
   def_symbol('INT64FUNCRESOK');
   def_symbol('PACKENUMFIXED');
+  def_symbol('HAS_ADDR_STACK_ON_STACK');
 
 { some stuff for TP compatibility }
 {$ifdef i386}
@@ -1509,7 +1510,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.24  2000-12-25 00:07:26  peter
+  Revision 1.25  2001-01-05 17:36:57  florian
+  * the info about exception frames is stored now on the stack
+  instead on the heap
+
+  Revision 1.24  2000/12/25 00:07:26  peter
     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
       tlinkedlist objects)
 

compiler/temp_gen.pas

@@ -73,11 +73,16 @@ interface
     function gettempofsize(size : longint) : longint;
     { special call for inlined procedures }
     function gettempofsizepersistant(size : longint) : longint;
+    procedure gettempofsizereferencepersistant(l : longint;var ref : treference);
+
     { for parameter func returns }
     procedure normaltemptopersistant(pos : longint);
     procedure persistanttemptonormal(pos : longint);
+
     {procedure ungettemp(pos : longint;size : longint);}
     procedure ungetpersistanttemp(pos : longint);
+    procedure ungetpersistanttempreference(const ref : treference);
+
     procedure gettempofsizereference(l : longint;var ref : treference);
     function istemp(const ref : treference) : boolean;
     procedure ungetiftemp(const ref : treference);
@@ -297,6 +302,14 @@ const
          ref.base:=procinfo^.framepointer;
       end;
 
+    procedure gettempofsizereferencepersistant(l : longint;var ref : treference);
+      begin
+         { do a reset, because the reference isn't used }
+         reset_reference(ref);
+         ref.offset:=gettempofsizepersistant(l);
+         ref.base:=procinfo^.framepointer;
+      end;
+
 
     procedure gettemppointerreferencefortype(var ref : treference; const usedtype, freetype: ttemptype);
       var
@@ -537,6 +550,11 @@ const
 {$endif}
       end;
 
+    procedure ungetpersistanttempreference(const ref : treference);
+
+      begin
+         ungetpersistanttemp(ref.offset);
+      end;
 
     procedure ungetiftemp(const ref : treference);
 {$ifdef EXTDEBUG}
@@ -573,7 +591,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  2000-12-31 11:04:43  jonas
+  Revision 1.11  2001-01-05 17:36:58  florian
+  * the info about exception frames is stored now on the stack
+  instead on the heap
+
+  Revision 1.10  2000/12/31 11:04:43  jonas
     + sizeoftemp() function
 
   Revision 1.9  2000/12/25 00:07:30  peter
@@ -602,5 +624,4 @@ end.
 
   Revision 1.2  2000/07/13 11:32:52  michael
   + removed logs
-
 }

rtl/inc/except.inc

@@ -50,8 +50,14 @@ begin
   RaiseList:=ExceptObjectStack;
 end;
 
+{$ifndef HAS_ADDR_STACK_ON_STACK}
 Function PushExceptAddr (Ft: Longint): PJmp_buf ;
   [Public, Alias : 'FPC_PUSHEXCEPTADDR'];saveregisters;
+{$else ADDR_STACK_ON_HEAP}
+Function PushExceptAddr (Ft: Longint;_buf,_newaddr : pointer): PJmp_buf ;
+  [Public, Alias : 'FPC_PUSHEXCEPTADDR'];saveregisters;
+{$endif HAS_ADDR_STACK_ON_STACK}
+
 var
   Buf : PJmp_buf;
   NewAddr : PExceptAddr;
@@ -61,16 +67,28 @@ begin
 {$endif}
   If ExceptAddrstack=Nil then
     begin
+{$ifndef HAS_ADDR_STACK_ON_STACK}
       New(ExceptAddrStack);
+{$else HAS_ADDR_STACK_ON_STACK}
+      ExceptAddrStack:=PExceptAddr(_newaddr);
+{$endif HAS_ADDR_STACK_ON_STACK}
       ExceptAddrStack^.Next:=Nil;
     end
   else
     begin
+{$ifndef HAS_ADDR_STACK_ON_STACK}
       New(NewAddr);
+{$else HAS_ADDR_STACK_ON_STACK}
+      NewAddr:=PExceptAddr(_newaddr);
+{$endif HAS_ADDR_STACK_ON_STACK}
       NewAddr^.Next:=ExceptAddrStack;
       ExceptAddrStack:=NewAddr;
     end;
+{$ifndef HAS_ADDR_STACK_ON_STACK}
   new(buf);
+{$else HAS_ADDR_STACK_ON_STACK}
+  buf:=PJmp_Buf(_buf);
+{$endif HAS_ADDR_STACK_ON_STACK}
   ExceptAddrStack^.Buf:=Buf;
   ExceptAddrStack^.FrameType:=ft;
   PushExceptAddr:=Buf;
@@ -142,8 +160,10 @@ begin
     begin
       hp:=ExceptAddrStack;
       ExceptAddrStack:=ExceptAddrStack^.Next;
+{$ifndef HAS_ADDR_STACK_ON_STACK}
       dispose(hp^.buf);
       dispose(hp);
+{$endif HAS_ADDR_STACK_ON_STACK}
     end;
 end;
 
@@ -246,11 +266,15 @@ begin
 end;
 {
   $Log$
-  Revision 1.3  2000-09-30 07:38:07  sg
+  Revision 1.4  2001-01-05 17:35:50  florian
+  * the info about exception frames is stored now on the stack
+  instead on the heap
+
+  Revision 1.3  2000/09/30 07:38:07  sg
   * Added 'RaiseProc': A user-definable callback procedure which gets
     called whenever an exception is being raised
 
   Revision 1.2  2000/07/13 11:33:42  michael
   + removed logs
- 
+
 }

rtl/inc/threadh.inc

@@ -40,9 +40,13 @@ procedure InitCriticalsection(var cs : tcriticalsection);
 procedure DoneCriticalsection(var cs : tcriticalsection);
 procedure EnterCriticalsection(var cs : tcriticalsection);
 procedure LeaveCriticalsection(var cs : tcriticalsection);
+
 {
   $Log$
-  Revision 1.1  2001-01-01 19:06:59  florian
-    + initial release
+  Revision 1.2  2001-01-05 17:35:50  florian
+  * the info about exception frames is stored now on the stack
+  instead on the heap
 
-}
+  Revision 1.1  2001/01/01 19:06:59  florian
+    + initial release
+}