From 00917cb46f7351b0cc344fbe8fbf5c6fe0128733 Mon Sep 17 00:00:00 2001 From: florian Date: Fri, 5 Jan 2001 17:35:50 +0000 Subject: [PATCH] * the info about exception frames is stored now on the stack instead on the heap --- compiler/i386/cgai386.pas | 22 ++++- compiler/i386/n386flw.pas | 44 ++++++++- compiler/i386/ra386int.pas | 7 +- compiler/ia64/cpuasm.pas | 183 ++++++++++++++++++++++++++++--------- compiler/ia64/cpubase.pas | 105 ++++++++++++--------- compiler/ia64/cpuinfo.pas | 8 +- compiler/nmat.pas | 9 +- compiler/options.pas | 7 +- compiler/temp_gen.pas | 25 ++++- rtl/inc/except.inc | 28 +++++- rtl/inc/threadh.inc | 10 +- 11 files changed, 345 insertions(+), 103 deletions(-) diff --git a/compiler/i386/cgai386.pas b/compiler/i386/cgai386.pas index 872faaa5a8..bbfdf61e16 100644 --- a/compiler/i386/cgai386.pas +++ b/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) diff --git a/compiler/i386/n386flw.pas b/compiler/i386/n386flw.pas index a97c945500..2be4e555ee 100644 --- a/compiler/i386/n386flw.pas +++ b/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) diff --git a/compiler/i386/ra386int.pas b/compiler/i386/ra386int.pas index 64b630bdad..608cbf0cbf 100644 --- a/compiler/i386/ra386int.pas +++ b/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) diff --git a/compiler/ia64/cpuasm.pas b/compiler/ia64/cpuasm.pas index 1a05cb0dd3..cc6ccb2b7d 100644 --- a/compiler/ia64/cpuasm.pas +++ b/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 } diff --git a/compiler/ia64/cpubase.pas b/compiler/ia64/cpubase.pas index dd2586dafc..eaa495cbc9 100644 --- a/compiler/ia64/cpubase.pas +++ b/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 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 newreference(const r : treference) : preference; + var + p : preference; + begin + new(p); + p^:=r; + newreference:=p; + end; -var - p : preference; -begin - new(p); - p^:=r; - newreference:=p; -end; + procedure disposereference(var r : preference); -procedure disposereference(var r : preference); + begin + dispose(r); + r:=Nil; + end; -begin - dispose(r); - r:=Nil; -end; + procedure set_location(var destloc : tlocation;const sourceloc : tlocation); + + 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 diff --git a/compiler/ia64/cpuinfo.pas b/compiler/ia64/cpuinfo.pas index 26b0bfa93f..faac9a15d3 100644 --- a/compiler/ia64/cpuinfo.pas +++ b/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 } diff --git a/compiler/nmat.pas b/compiler/nmat.pas index d4976f4932..8c2a56e751 100644 --- a/compiler/nmat.pas +++ b/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) diff --git a/compiler/options.pas b/compiler/options.pas index 28d7402c94..6f8e2129d2 100644 --- a/compiler/options.pas +++ b/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) diff --git a/compiler/temp_gen.pas b/compiler/temp_gen.pas index d7bc7b201e..46d94c36b6 100644 --- a/compiler/temp_gen.pas +++ b/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 - } diff --git a/rtl/inc/except.inc b/rtl/inc/except.inc index 4e4e0528df..d5d0db8cbe 100644 --- a/rtl/inc/except.inc +++ b/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 - + } diff --git a/rtl/inc/threadh.inc b/rtl/inc/threadh.inc index 9f72d538b9..3788972338 100644 --- a/rtl/inc/threadh.inc +++ b/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 -} \ No newline at end of file + Revision 1.1 2001/01/01 19:06:59 florian + + initial release +}