1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411 |
- {
- $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,
- hcodegen,temp_gen,pass_2,
- cpubase,cpuasm,
- pass_1,nld,ncon,
- cgai386,tgcpu,n386util,regvars;
- {*****************************************************************************
- Second_While_RepeatN
- *****************************************************************************}
- procedure ti386whilerepeatnode.pass_2;
- var
- lcont,lbreak,lloop,
- oldclabel,oldblabel : pasmlabel;
- otlabel,oflabel : pasmlabel;
- //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);
- 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 : pasmlabel;
- 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 : pasmlabel;
- 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^.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(porddef(t2.resulttype));
- 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 }
- if not(cs_littlesize in aktglobalswitches) then
- exprasmList.concat(Tai_align.Create_op(4,$90));
- 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 : pasmlabel;
- 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 procinfo^.returntype.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 pfloatdef(procinfo^.returntype.def)^.typ=f32bit then
- begin
- 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
- else
- if is_mem then
- floatload(pfloatdef(procinfo^.returntype.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 procinfo^.returntype.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);
- { the assigned avoids only crashes if the label isn't defined }
- if assigned(labsym) and
- assigned(labsym^.code) and
- (aktexceptblock<>tlabelnode(labsym^.code).exceptionblock) then
- CGMessage(cg_e_goto_inout_of_exception_block);
- end;
- {*****************************************************************************
- SecondLabel
- *****************************************************************************}
- procedure ti386labelnode.pass_2;
- begin
- load_all_regvars(exprasmlist);
- emitlab(labelnr);
- cleartempgen;
- secondpass(left);
- end;
- {*****************************************************************************
- SecondRaise
- *****************************************************************************}
- procedure ti386raisenode.pass_2;
- var
- a : pasmlabel;
- 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 : pasmlabel;
- { 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_loadesi;
- 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 : pasmlabel;
- oldexceptblock : tnode;
- 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;
- oldexceptblock:=aktexceptblock;
- aktexceptblock:=left;
- flowcontrol:=[];
- secondpass(left);
- tryflowcontrol:=flowcontrol;
- aktexceptblock:=oldexceptblock;
- 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
- begin
- oldexceptblock:=aktexceptblock;
- aktexceptblock:=right;
- secondpass(right);
- aktexceptblock:=oldexceptblock;
- end;
- 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_loadesi;
- { 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);
- oldexceptblock:=aktexceptblock;
- aktexceptblock:=t1;
- { here we don't have to reset flowcontrol }
- { the default and on flowcontrols are handled equal }
- secondpass(t1);
- exceptflowcontrol:=flowcontrol;
- aktexceptblock:=oldexceptblock;
- 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 : pasmlabel;
- ref : treference;
- oldexceptblock : tnode;
- 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
- pvarsym(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_loadesi;
- oldexceptblock:=aktexceptblock;
- aktexceptblock:=right;
- secondpass(right);
- aktexceptblock:=oldexceptblock;
- 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 : pasmlabel;
- oldexceptblock : tnode;
- 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
- oldexceptblock:=aktexceptblock;
- aktexceptblock:=left;
- secondpass(left);
- tryflowcontrol:=flowcontrol;
- if codegenerror then
- exit;
- aktexceptblock:=oldexceptblock;
- end;
- emitlab(finallylabel);
- emitcall('FPC_POPADDRSTACK');
- ungetpersistanttempreference(tempaddr);
- ungetpersistanttempreference(tempbuf);
- { finally code }
- oldexceptblock:=aktexceptblock;
- aktexceptblock:=right;
- flowcontrol:=[];
- secondpass(right);
- if flowcontrol<>[] then
- CGMessage(cg_e_control_flow_outside_finally);
- aktexceptblock:=oldexceptblock;
- 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.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
- }
|