mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-07 18:30:32 +02:00
* the info about exception frames is stored now on the stack
instead on the heap
This commit is contained in:
florian
parent
2b61746ae4
commit
00917cb46f
@ -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)
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
}
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
}
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user