fpc/compiler/i386/n386flw.pas
florian 9746f4c2d6 * some cg reorganisation
* some PPC updates
2001-08-26 13:35:06 +00:00

1405 lines
46 KiB
ObjectPascal

{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
Generate i386 assembler for nodes that influence the flow
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
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. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit n386flw;
{$i defines.inc}
interface
uses
node,nflw;
type
ti386whilerepeatnode = class(twhilerepeatnode)
procedure pass_2;override;
end;
ti386ifnode = class(tifnode)
procedure pass_2;override;
end;
ti386fornode = class(tfornode)
procedure pass_2;override;
end;
ti386exitnode = class(texitnode)
procedure pass_2;override;
end;
ti386breaknode = class(tbreaknode)
procedure pass_2;override;
end;
ti386continuenode = class(tcontinuenode)
procedure pass_2;override;
end;
ti386gotonode = class(tgotonode)
procedure pass_2;override;
end;
ti386labelnode = class(tlabelnode)
procedure pass_2;override;
end;
ti386raisenode = class(traisenode)
procedure pass_2;override;
end;
ti386tryexceptnode = class(ttryexceptnode)
procedure pass_2;override;
end;
ti386tryfinallynode = class(ttryfinallynode)
procedure pass_2;override;
end;
ti386onnode = class(tonnode)
procedure pass_2;override;
end;
ti386failnode = class(tfailnode)
procedure pass_2;override;
end;
implementation
uses
verbose,globtype,globals,systems,
symconst,symdef,symsym,aasm,types,
cgbase,temp_gen,pass_2,
cpubase,cpuasm,
pass_1,nld,ncon,
cga,tgcpu,n386util,regvars;
{*****************************************************************************
Second_While_RepeatN
*****************************************************************************}
procedure ti386whilerepeatnode.pass_2;
var
lcont,lbreak,lloop,
oldclabel,oldblabel : tasmlabel;
otlabel,oflabel : tasmlabel;
//start_regvars_loaded,
//then_regvars_loaded: regvar_booleanarray;
begin
getlabel(lloop);
getlabel(lcont);
getlabel(lbreak);
{ arrange continue and breaklabels: }
oldclabel:=aktcontinuelabel;
oldblabel:=aktbreaklabel;
load_all_regvars(exprasmlist);
{ handling code at the end as it is much more efficient, and makes
while equal to repeat loop, only the end true/false is swapped (PFV) }
if nodetype=whilen then
emitjmp(C_None,lcont);
{ align loop target }
exprasmList.concat(Tai_align.Create(aktalignment.loopalign));
emitlab(lloop);
aktcontinuelabel:=lcont;
aktbreaklabel:=lbreak;
cleartempgen;
if assigned(right) then
secondpass(right);
load_all_regvars(exprasmlist);
emitlab(lcont);
otlabel:=truelabel;
oflabel:=falselabel;
if nodetype=whilen then
begin
truelabel:=lloop;
falselabel:=lbreak;
end
{ repeatn }
else
begin
truelabel:=lbreak;
falselabel:=lloop;
end;
cleartempgen;
secondpass(left);
load_all_regvars(exprasmlist);
maketojumpbool(left);
emitlab(lbreak);
truelabel:=otlabel;
falselabel:=oflabel;
aktcontinuelabel:=oldclabel;
aktbreaklabel:=oldblabel;
{ a break/continue in a while/repeat block can't be seen outside }
flowcontrol:=flowcontrol-[fc_break,fc_continue];
end;
{*****************************************************************************
TI386IFNODE
*****************************************************************************}
procedure ti386ifnode.pass_2;
var
hl,otlabel,oflabel : tasmlabel;
begin
otlabel:=truelabel;
oflabel:=falselabel;
getlabel(truelabel);
getlabel(falselabel);
cleartempgen;
secondpass(left);
load_all_regvars(exprasmlist);
maketojumpbool(left);
if assigned(right) then
begin
emitlab(truelabel);
cleartempgen;
secondpass(right);
{ automatically done for blocks, but not for statements (JM) }
load_all_regvars(exprasmlist);
end;
if assigned(t1) then
begin
if assigned(right) then
begin
getlabel(hl);
{ do go back to if line !! }
aktfilepos:=exprasmList.getlasttaifilepos^;
emitjmp(C_None,hl);
end;
emitlab(falselabel);
cleartempgen;
secondpass(t1);
load_all_regvars(exprasmlist);
if assigned(right) then
emitlab(hl);
end
else
begin
emitlab(falselabel);
end;
if not(assigned(right)) then
begin
emitlab(truelabel);
end;
truelabel:=otlabel;
falselabel:=oflabel;
end;
{*****************************************************************************
SecondFor
*****************************************************************************}
procedure ti386fornode.pass_2;
var
l3,oldclabel,oldblabel : tasmlabel;
omitfirstcomp,temptovalue : boolean;
hs : byte;
temp1 : treference;
hop : tasmop;
hcond : tasmcond;
cmpreg,cmp32 : tregister;
opsize : topsize;
count_var_is_signed : boolean;
begin
oldclabel:=aktcontinuelabel;
oldblabel:=aktbreaklabel;
getlabel(aktcontinuelabel);
getlabel(aktbreaklabel);
getlabel(l3);
{ could we spare the first comparison ? }
omitfirstcomp:=false;
if right.nodetype=ordconstn then
if tassignmentnode(left).right.nodetype=ordconstn then
omitfirstcomp:=((nf_backward in flags) and
(tordconstnode(tassignmentnode(left).right).value>=tordconstnode(right).value))
or (not(nf_backward in flags) and
(tordconstnode(tassignmentnode(left).right).value<=tordconstnode(right).value));
{ only calculate reference }
cleartempgen;
secondpass(t2);
hs:=t2.resulttype.def.size;
if t2.location.loc <> LOC_CREGISTER then
cmp32:=getregister32;
case hs of
1 : begin
opsize:=S_B;
if t2.location.loc <> LOC_CREGISTER then
cmpreg:=reg32toreg8(cmp32);
end;
2 : begin
opsize:=S_W;
if t2.location.loc <> LOC_CREGISTER then
cmpreg:=reg32toreg16(cmp32);
end;
4 : begin
opsize:=S_L;
if t2.location.loc <> LOC_CREGISTER then
cmpreg:=cmp32;
end;
end;
{ first set the to value
because the count var can be in the expression !! }
cleartempgen;
secondpass(right);
{ calculate pointer value and check if changeable and if so }
{ load into temporary variable }
if right.nodetype<>ordconstn then
begin
temp1.symbol:=nil;
gettempofsizereference(hs,temp1);
temptovalue:=true;
if (right.location.loc=LOC_REGISTER) or
(right.location.loc=LOC_CREGISTER) then
begin
emit_reg_ref(A_MOV,opsize,right.location.register,
newreference(temp1));
end
else
concatcopy(right.location.reference,temp1,hs,false,false);
end
else
temptovalue:=false;
{ produce start assignment }
cleartempgen;
secondpass(left);
count_var_is_signed:=is_signed(torddef(t2.resulttype.def));
if temptovalue then
begin
if t2.location.loc=LOC_CREGISTER then
begin
emit_ref_reg(A_CMP,opsize,newreference(temp1),
t2.location.register);
end
else
begin
emit_ref_reg(A_MOV,opsize,newreference(t2.location.reference),
cmpreg);
emit_ref_reg(A_CMP,opsize,newreference(temp1),
cmpreg);
{ temp register not necessary anymore currently (JM) }
ungetregister32(cmp32);
end;
end
else
begin
if not(omitfirstcomp) then
begin
if t2.location.loc=LOC_CREGISTER then
emit_const_reg(A_CMP,opsize,tordconstnode(right).value,
t2.location.register)
else
emit_const_ref(A_CMP,opsize,tordconstnode(right).value,
newreference(t2.location.reference));
end;
end;
if nf_backward in flags then
if count_var_is_signed then
hcond:=C_L
else
hcond:=C_B
else
if count_var_is_signed then
hcond:=C_G
else
hcond:=C_A;
load_all_regvars(exprasmlist);
if not(omitfirstcomp) or temptovalue then
emitjmp(hcond,aktbreaklabel);
{ align loop target }
exprasmList.concat(Tai_align.Create(aktalignment.loopalign));
emitlab(l3);
{ help register must not be in instruction block }
cleartempgen;
if assigned(t1) then
begin
secondpass(t1);
load_all_regvars(exprasmlist);
end;
emitlab(aktcontinuelabel);
{ makes no problems there }
cleartempgen;
if (t2.location.loc <> LOC_CREGISTER) then
begin
{ demand help register again }
cmp32:=getregister32;
case hs of
1 : cmpreg:=reg32toreg8(cmp32);
2 : cmpreg:=reg32toreg16(cmp32);
4 : cmpreg:=cmp32;
end;
end;
{ produce comparison and the corresponding }
{ jump }
if temptovalue then
begin
if t2.location.loc=LOC_CREGISTER then
begin
emit_ref_reg(A_CMP,opsize,newreference(temp1),
t2.location.register);
end
else
begin
emit_ref_reg(A_MOV,opsize,newreference(t2.location.reference),
cmpreg);
emit_ref_reg(A_CMP,opsize,newreference(temp1),
cmpreg);
end;
end
else
begin
if t2.location.loc=LOC_CREGISTER then
emit_const_reg(A_CMP,opsize,tordconstnode(right).value,
t2.location.register)
else
emit_const_ref(A_CMP,opsize,tordconstnode(right).value,
newreference(t2.location.reference));
end;
if nf_backward in flags then
if count_var_is_signed then
hcond:=C_LE
else
hcond:=C_BE
else
if count_var_is_signed then
hcond:=C_GE
else
hcond:=C_AE;
load_all_regvars(exprasmlist);
emitjmp(hcond,aktbreaklabel);
{ according to count direction DEC or INC... }
{ must be after the test because of 0 to 255 for bytes !! }
if nf_backward in flags then
hop:=A_DEC
else
hop:=A_INC;
if t2.location.loc=LOC_CREGISTER then
emit_reg(hop,opsize,t2.location.register)
else
emit_ref(hop,opsize,newreference(t2.location.reference));
emitjmp(C_None,l3);
if (t2.location.loc <> LOC_CREGISTER) then
ungetregister32(cmp32);
if temptovalue then
ungetiftemp(temp1);
{ this is the break label: }
emitlab(aktbreaklabel);
aktcontinuelabel:=oldclabel;
aktbreaklabel:=oldblabel;
{ a break/continue in a for block can't be seen outside }
flowcontrol:=flowcontrol-[fc_break,fc_continue];
end;
{*****************************************************************************
SecondExitN
*****************************************************************************}
procedure ti386exitnode.pass_2;
var
{op : tasmop;
s : topsize;}
otlabel,oflabel : tasmlabel;
r : preference;
is_mem,
allocated_eax,
allocated_edx: boolean;
procedure cleanleft;
begin
if is_mem then
begin
del_reference(left.location.reference);
ungetiftemp(left.location.reference);
end
else
begin
ungetregister(left.location.register);
if left.location.registerhigh <> R_NO then
ungetregister(left.location.registerhigh);
end;
end;
label
do_jmp;
begin
load_all_regvars(exprasmlist);
include(flowcontrol,fc_exit);
if assigned(left) then
if left.nodetype=assignn then
begin
{ just do a normal assignment followed by exit }
secondpass(left);
emitjmp(C_None,aktexitlabel);
end
else
begin
allocated_eax := false;
allocated_edx := false;
otlabel:=truelabel;
oflabel:=falselabel;
getlabel(truelabel);
getlabel(falselabel);
secondpass(left);
case left.location.loc of
LOC_FPU : goto do_jmp;
LOC_MEM,
LOC_REFERENCE : is_mem:=true;
LOC_CREGISTER,
LOC_REGISTER : is_mem:=false;
LOC_FLAGS : begin
exprasmlist.concat(tairegalloc.alloc(R_EAX));
allocated_eax := true;
emit_flag2reg(left.location.resflags,R_AL);
goto do_jmp;
end;
LOC_JUMP : begin
exprasmlist.concat(tairegalloc.alloc(R_EAX));
allocated_eax := true;
emitlab(truelabel);
emit_const_reg(A_MOV,S_B,1,R_AL);
emitjmp(C_None,aktexit2label);
emitlab(falselabel);
emit_reg_reg(A_XOR,S_B,R_AL,R_AL);
goto do_jmp;
end;
else
internalerror(2001);
end;
case aktprocsym.definition.rettype.def.deftype of
pointerdef,
procvardef : begin
cleanleft;
exprasmlist.concat(tairegalloc.alloc(R_EAX));
allocated_eax := true;
if is_mem then
emit_ref_reg(A_MOV,S_L,
newreference(left.location.reference),R_EAX)
else
emit_reg_reg(A_MOV,S_L,
left.location.register,R_EAX);
end;
floatdef : begin
cleanleft;
if is_mem then
floatload(tfloatdef(aktprocsym.definition.rettype.def).typ,left.location.reference);
end;
{ orddef,
enumdef : }
else
{ it can be anything shorter than 4 bytes PM
this caused form bug 711 }
begin
cleanleft;
exprasmlist.concat(tairegalloc.alloc(R_EAX));
allocated_eax := true;
case aktprocsym.definition.rettype.def.size of
{ it can be a qword/int64 too ... }
8 : if is_mem then
begin
emit_ref_reg(A_MOV,S_L,
newreference(left.location.reference),R_EAX);
r:=newreference(left.location.reference);
inc(r^.offset,4);
exprasmlist.concat(tairegalloc.alloc(R_EDX));
allocated_edx := true;
emit_ref_reg(A_MOV,S_L,r,R_EDX);
end
else
begin
emit_reg_reg(A_MOV,S_L,left.location.registerlow,R_EAX);
exprasmlist.concat(tairegalloc.alloc(R_EDX));
allocated_edx := true;
emit_reg_reg(A_MOV,S_L,left.location.registerhigh,R_EDX);
end;
{ if its 3 bytes only we can still
copy one of garbage ! PM }
4,3 : if is_mem then
emit_ref_reg(A_MOV,S_L,
newreference(left.location.reference),R_EAX)
else
emit_reg_reg(A_MOV,S_L,left.location.register,R_EAX);
2 : if is_mem then
emit_ref_reg(A_MOV,S_W,
newreference(left.location.reference),R_AX)
else
emit_reg_reg(A_MOV,S_W,makereg16(left.location.register),R_AX);
1 : if is_mem then
emit_ref_reg(A_MOV,S_B,
newreference(left.location.reference),R_AL)
else
emit_reg_reg(A_MOV,S_B,makereg8(left.location.register),R_AL);
else internalerror(605001);
end;
end;
end;
do_jmp:
truelabel:=otlabel;
falselabel:=oflabel;
emitjmp(C_None,aktexit2label);
if allocated_eax then
exprasmlist.concat(tairegalloc.dealloc(R_EAX));
if allocated_edx then
exprasmlist.concat(tairegalloc.dealloc(R_EDX));
end
else
emitjmp(C_None,aktexitlabel);
end;
{*****************************************************************************
SecondBreakN
*****************************************************************************}
procedure ti386breaknode.pass_2;
begin
include(flowcontrol,fc_break);
if aktbreaklabel<>nil then
begin
load_all_regvars(exprasmlist);
emitjmp(C_None,aktbreaklabel)
end
else
CGMessage(cg_e_break_not_allowed);
end;
{*****************************************************************************
SecondContinueN
*****************************************************************************}
procedure ti386continuenode.pass_2;
begin
include(flowcontrol,fc_continue);
if aktcontinuelabel<>nil then
begin
load_all_regvars(exprasmlist);
emitjmp(C_None,aktcontinuelabel)
end
else
CGMessage(cg_e_continue_not_allowed);
end;
{*****************************************************************************
SecondGoto
*****************************************************************************}
procedure ti386gotonode.pass_2;
begin
load_all_regvars(exprasmlist);
emitjmp(C_None,labelnr);
end;
{*****************************************************************************
SecondLabel
*****************************************************************************}
procedure ti386labelnode.pass_2;
begin
load_all_regvars(exprasmlist);
emitlab(labelnr);
cleartempgen;
secondpass(left);
end;
{*****************************************************************************
SecondRaise
*****************************************************************************}
procedure ti386raisenode.pass_2;
var
a : tasmlabel;
begin
if assigned(left) then
begin
{ multiple parameters? }
if assigned(right) then
begin
{ push frame }
if assigned(frametree) then
begin
secondpass(frametree);
if codegenerror then
exit;
emit_push_loc(frametree.location);
end
else
emit_const(A_PUSH,S_L,0);
{ push address }
secondpass(right);
if codegenerror then
exit;
emit_push_loc(right.location);
end
else
begin
getaddrlabel(a);
emitlab(a);
emit_reg(A_PUSH,S_L,R_EBP);
emit_sym(A_PUSH,S_L,a);
end;
{ push object }
secondpass(left);
if codegenerror then
exit;
emit_push_loc(left.location);
emitcall('FPC_RAISEEXCEPTION');
end
else
begin
emitcall('FPC_POPADDRSTACK');
emitcall('FPC_RERAISE');
end;
end;
{*****************************************************************************
SecondTryExcept
*****************************************************************************}
var
endexceptlabel : tasmlabel;
{ does the necessary things to clean up the object stack }
{ in the except block }
procedure cleanupobjectstack;
begin
emitcall('FPC_POPOBJECTSTACK');
exprasmList.concat(Tairegalloc.Alloc(R_EAX));
emit_reg(A_PUSH,S_L,R_EAX);
emitcall('FPC_DESTROYEXCEPTION');
exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
maybe_loadself;
end;
{ pops one element from the exception address stack }
{ and removes the flag }
procedure cleanupaddrstack;
begin
emitcall('FPC_POPADDRSTACK');
{ allocate eax }
exprasmList.concat(Tairegalloc.Alloc(R_EAX));
emit_reg(A_POP,S_L,R_EAX);
{ deallocate eax }
exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
end;
procedure ti386tryexceptnode.pass_2;
var
exceptlabel,doexceptlabel,oldendexceptlabel,
lastonlabel,
exitexceptlabel,
continueexceptlabel,
breakexceptlabel,
exittrylabel,
continuetrylabel,
breaktrylabel,
doobjectdestroy,
doobjectdestroyandreraise,
oldaktexitlabel,
oldaktexit2label,
oldaktcontinuelabel,
oldaktbreaklabel : tasmlabel;
oldflowcontrol,tryflowcontrol,
exceptflowcontrol : tflowcontrol;
tempbuf,tempaddr : treference;
label
errorexit;
begin
oldflowcontrol:=flowcontrol;
flowcontrol:=[];
{ this can be called recursivly }
oldendexceptlabel:=endexceptlabel;
{ we modify EAX }
usedinproc:=usedinproc or ($80 shr byte(R_EAX));
{ save the old labels for control flow statements }
oldaktexitlabel:=aktexitlabel;
oldaktexit2label:=aktexit2label;
if assigned(aktbreaklabel) then
begin
oldaktcontinuelabel:=aktcontinuelabel;
oldaktbreaklabel:=aktbreaklabel;
end;
{ get new labels for the control flow statements }
getlabel(exittrylabel);
getlabel(exitexceptlabel);
if assigned(aktbreaklabel) then
begin
getlabel(breaktrylabel);
getlabel(continuetrylabel);
getlabel(breakexceptlabel);
getlabel(continueexceptlabel);
end;
getlabel(exceptlabel);
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);
emitcall('FPC_SETJMP');
emit_reg(A_PUSH,S_L,R_EAX);
emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
{ deallocate eax }
exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
emitjmp(C_NE,exceptlabel);
{ try block }
{ set control flow labels for the try block }
aktexitlabel:=exittrylabel;
aktexit2label:=exittrylabel;
if assigned(oldaktbreaklabel) then
begin
aktcontinuelabel:=continuetrylabel;
aktbreaklabel:=breaktrylabel;
end;
flowcontrol:=[];
secondpass(left);
tryflowcontrol:=flowcontrol;
if codegenerror then
goto errorexit;
emitlab(exceptlabel);
emitcall('FPC_POPADDRSTACK');
ungetpersistanttempreference(tempaddr);
ungetpersistanttempreference(tempbuf);
exprasmList.concat(Tairegalloc.Alloc(R_EAX));
emit_reg(A_POP,S_L,R_EAX);
emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
emitjmp(C_E,endexceptlabel);
emitlab(doexceptlabel);
{ set control flow labels for the except block }
{ and the on statements }
aktexitlabel:=exitexceptlabel;
aktexit2label:=exitexceptlabel;
if assigned(oldaktbreaklabel) then
begin
aktcontinuelabel:=continueexceptlabel;
aktbreaklabel:=breakexceptlabel;
end;
flowcontrol:=[];
{ on statements }
if assigned(right) then
secondpass(right);
emitlab(lastonlabel);
{ default handling except handling }
if assigned(t1) then
begin
{ FPC_CATCHES must be called with
'default handler' flag (=-1)
}
push_int (-1);
emitcall('FPC_CATCHES');
maybe_loadself;
{ the destruction of the exception object must be also }
{ 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));
emitcall('FPC_SETJMP');
exprasmList.concat(Tairegalloc.Alloc(R_EAX));
exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX));
exprasmList.concat(Taicpu.op_reg_reg(A_TEST,S_L,R_EAX,R_EAX));
exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
emitjmp(C_NE,doobjectdestroyandreraise);
{ here we don't have to reset flowcontrol }
{ the default and on flowcontrols are handled equal }
secondpass(t1);
exceptflowcontrol:=flowcontrol;
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));
exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
emitjmp(C_E,doobjectdestroy);
emitcall('FPC_POPSECONDOBJECTSTACK');
exprasmList.concat(Tairegalloc.Alloc(R_EAX));
emit_reg(A_PUSH,S_L,R_EAX);
emitcall('FPC_DESTROYEXCEPTION');
exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
{ we don't need to restore esi here because reraise never }
{ returns }
emitcall('FPC_RERAISE');
emitlab(doobjectdestroy);
cleanupobjectstack;
emitjmp(C_None,endexceptlabel);
end
else
begin
emitcall('FPC_RERAISE');
exceptflowcontrol:=flowcontrol;
end;
if fc_exit in exceptflowcontrol then
begin
{ do some magic for exit in the try block }
emitlab(exitexceptlabel);
{ we must also destroy the address frame which guards }
{ exception object }
cleanupaddrstack;
cleanupobjectstack;
emitjmp(C_None,oldaktexitlabel);
end;
if fc_break in exceptflowcontrol then
begin
emitlab(breakexceptlabel);
{ we must also destroy the address frame which guards }
{ exception object }
cleanupaddrstack;
cleanupobjectstack;
emitjmp(C_None,oldaktbreaklabel);
end;
if fc_continue in exceptflowcontrol then
begin
emitlab(continueexceptlabel);
{ we must also destroy the address frame which guards }
{ exception object }
cleanupaddrstack;
cleanupobjectstack;
emitjmp(C_None,oldaktcontinuelabel);
end;
if fc_exit in tryflowcontrol then
begin
{ do some magic for exit in the try block }
emitlab(exittrylabel);
cleanupaddrstack;
emitjmp(C_None,oldaktexitlabel);
end;
if fc_break in tryflowcontrol then
begin
emitlab(breaktrylabel);
cleanupaddrstack;
emitjmp(C_None,oldaktbreaklabel);
end;
if fc_continue in tryflowcontrol then
begin
emitlab(continuetrylabel);
cleanupaddrstack;
emitjmp(C_None,oldaktcontinuelabel);
end;
emitlab(endexceptlabel);
errorexit:
{ restore all saved labels }
endexceptlabel:=oldendexceptlabel;
{ restore the control flow labels }
aktexitlabel:=oldaktexitlabel;
aktexit2label:=oldaktexit2label;
if assigned(oldaktbreaklabel) then
begin
aktcontinuelabel:=oldaktcontinuelabel;
aktbreaklabel:=oldaktbreaklabel;
end;
{ return all used control flow statements }
flowcontrol:=oldflowcontrol+exceptflowcontrol+
tryflowcontrol;
end;
procedure ti386onnode.pass_2;
var
nextonlabel,
exitonlabel,
continueonlabel,
breakonlabel,
oldaktexitlabel,
oldaktexit2label,
oldaktcontinuelabel,
doobjectdestroyandreraise,
doobjectdestroy,
oldaktbreaklabel : tasmlabel;
ref : treference;
oldflowcontrol : tflowcontrol;
tempbuf,tempaddr : treference;
begin
oldflowcontrol:=flowcontrol;
flowcontrol:=[];
getlabel(nextonlabel);
{ push the vmt }
emit_sym(A_PUSH,S_L,
newasmsymbol(excepttype.vmt_mangledname));
emitcall('FPC_CATCHES');
{ allocate eax }
exprasmList.concat(Tairegalloc.Alloc(R_EAX));
emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
emitjmp(C_E,nextonlabel);
ref.symbol:=nil;
gettempofsizereference(4,ref);
{ what a hack ! }
if assigned(exceptsymtable) then
tvarsym(exceptsymtable.symindex.first).address:=ref.offset;
emit_reg_ref(A_MOV,S_L,
R_EAX,newreference(ref));
{ deallocate eax }
exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
{ 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));
emitcall('FPC_SETJMP');
exprasmList.concat(Tairegalloc.Alloc(R_EAX));
exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX));
exprasmList.concat(Taicpu.op_reg_reg(A_TEST,S_L,R_EAX,R_EAX));
exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
emitjmp(C_NE,doobjectdestroyandreraise);
if assigned(right) then
begin
oldaktexitlabel:=aktexitlabel;
oldaktexit2label:=aktexit2label;
getlabel(exitonlabel);
aktexitlabel:=exitonlabel;
aktexit2label:=exitonlabel;
if assigned(aktbreaklabel) then
begin
oldaktcontinuelabel:=aktcontinuelabel;
oldaktbreaklabel:=aktbreaklabel;
getlabel(breakonlabel);
getlabel(continueonlabel);
aktcontinuelabel:=continueonlabel;
aktbreaklabel:=breakonlabel;
end;
{ esi is destroyed by FPC_CATCHES }
maybe_loadself;
secondpass(right);
end;
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));
exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
emitjmp(C_E,doobjectdestroy);
emitcall('FPC_POPSECONDOBJECTSTACK');
exprasmList.concat(Tairegalloc.Alloc(R_EAX));
emit_reg(A_PUSH,S_L,R_EAX);
emitcall('FPC_DESTROYEXCEPTION');
exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
{ we don't need to restore esi here because reraise never }
{ returns }
emitcall('FPC_RERAISE');
emitlab(doobjectdestroy);
cleanupobjectstack;
{ clear some stuff }
ungetiftemp(ref);
emitjmp(C_None,endexceptlabel);
if assigned(right) then
begin
{ special handling for control flow instructions }
if fc_exit in flowcontrol then
begin
{ the address and object pop does secondtryexcept }
emitlab(exitonlabel);
emitjmp(C_None,oldaktexitlabel);
end;
if fc_break in flowcontrol then
begin
{ the address and object pop does secondtryexcept }
emitlab(breakonlabel);
emitjmp(C_None,oldaktbreaklabel);
end;
if fc_continue in flowcontrol then
begin
{ the address and object pop does secondtryexcept }
emitlab(continueonlabel);
emitjmp(C_None,oldaktcontinuelabel);
end;
aktexitlabel:=oldaktexitlabel;
aktexit2label:=oldaktexit2label;
if assigned(oldaktbreaklabel) then
begin
aktcontinuelabel:=oldaktcontinuelabel;
aktbreaklabel:=oldaktbreaklabel;
end;
end;
emitlab(nextonlabel);
flowcontrol:=oldflowcontrol+flowcontrol;
{ next on node }
if assigned(left) then
begin
cleartempgen;
secondpass(left);
end;
end;
{*****************************************************************************
SecondTryFinally
*****************************************************************************}
procedure ti386tryfinallynode.pass_2;
var
reraiselabel,
finallylabel,
endfinallylabel,
exitfinallylabel,
continuefinallylabel,
breakfinallylabel,
oldaktexitlabel,
oldaktexit2label,
oldaktcontinuelabel,
oldaktbreaklabel : tasmlabel;
oldflowcontrol,tryflowcontrol : tflowcontrol;
decconst : longint;
tempbuf,tempaddr : treference;
begin
{ check if child nodes do a break/continue/exit }
oldflowcontrol:=flowcontrol;
flowcontrol:=[];
{ we modify EAX }
usedinproc:=usedinproc or ($80 shr byte(R_EAX));
getlabel(finallylabel);
getlabel(endfinallylabel);
getlabel(reraiselabel);
{ the finally block must catch break, continue and exit }
{ statements }
oldaktexitlabel:=aktexitlabel;
oldaktexit2label:=aktexit2label;
getlabel(exitfinallylabel);
aktexitlabel:=exitfinallylabel;
aktexit2label:=exitfinallylabel;
if assigned(aktbreaklabel) then
begin
oldaktcontinuelabel:=aktcontinuelabel;
oldaktbreaklabel:=aktbreaklabel;
getlabel(breakfinallylabel);
getlabel(continuefinallylabel);
aktcontinuelabel:=continuefinallylabel;
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);
emitcall('FPC_SETJMP');
emit_reg(A_PUSH,S_L,R_EAX);
emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
{ deallocate eax }
exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
emitjmp(C_NE,finallylabel);
{ try code }
if assigned(left) then
begin
secondpass(left);
tryflowcontrol:=flowcontrol;
if codegenerror then
exit;
end;
emitlab(finallylabel);
emitcall('FPC_POPADDRSTACK');
ungetpersistanttempreference(tempaddr);
ungetpersistanttempreference(tempbuf);
{ finally code }
flowcontrol:=[];
secondpass(right);
if flowcontrol<>[] then
CGMessage(cg_e_control_flow_outside_finally);
if codegenerror then
exit;
{ allocate eax }
exprasmList.concat(Tairegalloc.Alloc(R_EAX));
emit_reg(A_POP,S_L,R_EAX);
emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
emitjmp(C_E,endfinallylabel);
emit_reg(A_DEC,S_L,R_EAX);
emitjmp(C_Z,reraiselabel);
if fc_exit in tryflowcontrol then
begin
emit_reg(A_DEC,S_L,R_EAX);
emitjmp(C_Z,oldaktexitlabel);
decconst:=1;
end
else
decconst:=2;
if fc_break in tryflowcontrol then
begin
emit_const_reg(A_SUB,S_L,decconst,R_EAX);
emitjmp(C_Z,oldaktbreaklabel);
decconst:=1;
end
else
inc(decconst);
if fc_continue in tryflowcontrol then
begin
emit_const_reg(A_SUB,S_L,decconst,R_EAX);
emitjmp(C_Z,oldaktcontinuelabel);
end;
{ deallocate eax }
exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
emitlab(reraiselabel);
emitcall('FPC_RERAISE');
{ do some magic for exit,break,continue in the try block }
if fc_exit in tryflowcontrol then
begin
emitlab(exitfinallylabel);
{ allocate eax }
exprasmList.concat(Tairegalloc.Alloc(R_EAX));
emit_reg(A_POP,S_L,R_EAX);
exprasmList.concat(Tairegalloc.Alloc(R_EAX));
emit_const(A_PUSH,S_L,2);
emitjmp(C_NONE,finallylabel);
end;
if fc_break in tryflowcontrol then
begin
emitlab(breakfinallylabel);
{ allocate eax }
exprasmList.concat(Tairegalloc.Alloc(R_EAX));
emit_reg(A_POP,S_L,R_EAX);
{ deallocate eax }
exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
emit_const(A_PUSH,S_L,3);
emitjmp(C_NONE,finallylabel);
end;
if fc_continue in tryflowcontrol then
begin
emitlab(continuefinallylabel);
exprasmList.concat(Tairegalloc.Alloc(R_EAX));
emit_reg(A_POP,S_L,R_EAX);
exprasmList.concat(Tairegalloc.Alloc(R_EAX));
emit_const(A_PUSH,S_L,4);
emitjmp(C_NONE,finallylabel);
end;
emitlab(endfinallylabel);
aktexitlabel:=oldaktexitlabel;
aktexit2label:=oldaktexit2label;
if assigned(aktbreaklabel) then
begin
aktcontinuelabel:=oldaktcontinuelabel;
aktbreaklabel:=oldaktbreaklabel;
end;
flowcontrol:=oldflowcontrol+tryflowcontrol;
end;
{*****************************************************************************
SecondFail
*****************************************************************************}
procedure ti386failnode.pass_2;
begin
emitjmp(C_None,faillabel);
end;
begin
cwhilerepeatnode:=ti386whilerepeatnode;
cifnode:=ti386ifnode;
cfornode:=ti386fornode;
cexitnode:=ti386exitnode;
cbreaknode:=ti386breaknode;
ccontinuenode:=ti386continuenode;
cgotonode:=ti386gotonode;
clabelnode:=ti386labelnode;
craisenode:=ti386raisenode;
ctryexceptnode:=ti386tryexceptnode;
ctryfinallynode:=ti386tryfinallynode;
connode:=ti386onnode;
cfailnode:=ti386failnode;
end.
{
$Log$
Revision 1.15 2001-08-26 13:36:58 florian
* some cg reorganisation
* some PPC updates
Revision 1.14 2001/08/06 21:40:50 peter
* funcret moved from tprocinfo to tprocdef
Revision 1.13 2001/07/01 20:16:20 peter
* alignmentinfo record added
* -Oa argument supports more alignment settings that can be specified
per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN
RECORDMAX,LOCALMIN,LOCALMAX. It is possible to set the mimimum
required alignment and the maximum usefull alignment. The final
alignment will be choosen per variable size dependent on these
settings
Revision 1.12 2001/04/15 09:48:31 peter
* fixed crash in labelnode
* easier detection of goto and label in try blocks
Revision 1.11 2001/04/14 14:07:11 peter
* moved more code from pass_1 to det_resulttype
Revision 1.10 2001/04/13 01:22:19 peter
* symtable change to classes
* range check generation and errors fixed, make cycle DEBUG=1 works
* memory leaks fixed
Revision 1.9 2001/04/02 21:20:37 peter
* resulttype rewrite
Revision 1.8 2001/01/27 21:29:35 florian
* behavior -Oa optimized
Revision 1.7 2001/01/06 23:35:05 jonas
* fixed webbug 1323
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)
Revision 1.4 2000/12/05 11:44:33 jonas
+ new integer regvar handling, should be much more efficient
Revision 1.3 2000/11/29 00:30:47 florian
* unused units removed from uses clause
* some changes for widestrings
Revision 1.2 2000/10/31 22:02:56 peter
* symtable splitted, no real code changes
Revision 1.1 2000/10/15 09:33:31 peter
* moved n386*.pas to i386/ cpu_target dir
Revision 1.1 2000/10/14 10:14:48 peter
* moehrendorf oct 2000 rewrite
}