123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815 |
- {
- $Id$
- Copyright (c) 1993-98 by Florian Klaempfl
- Generate m68k 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 cg68kflw;
- interface
- uses
- tree;
- procedure second_while_repeatn(var p : ptree);
- procedure secondifn(var p : ptree);
- procedure secondfor(var p : ptree);
- procedure secondexitn(var p : ptree);
- procedure secondbreakn(var p : ptree);
- procedure secondcontinuen(var p : ptree);
- procedure secondgoto(var p : ptree);
- procedure secondlabel(var p : ptree);
- procedure secondraise(var p : ptree);
- procedure secondtryexcept(var p : ptree);
- procedure secondtryfinally(var p : ptree);
- procedure secondon(var p : ptree);
- procedure secondfail(var p : ptree);
- implementation
- uses
- globtype,systems,
- cobjects,verbose,globals,
- symtable,aasm,types,
- hcodegen,temp_gen,pass_2,
- m68k,cga68k,tgen68k;
- {*****************************************************************************
- Second_While_RepeatN
- *****************************************************************************}
- procedure second_while_repeatn(var p : ptree);
- var
- l1,l2,l3,oldclabel,oldblabel : plabel;
- otlabel,oflabel : plabel;
- begin
- getlabel(l1);
- getlabel(l2);
- { arrange continue and breaklabels: }
- oldclabel:=aktcontinuelabel;
- oldblabel:=aktbreaklabel;
- if p^.treetype=repeatn then
- begin
- emitl(A_LABEL,l1);
- aktcontinuelabel:=l1;
- aktbreaklabel:=l2;
- cleartempgen;
- if assigned(p^.right) then
- secondpass(p^.right);
- otlabel:=truelabel;
- oflabel:=falselabel;
- truelabel:=l2;
- falselabel:=l1;
- cleartempgen;
- secondpass(p^.left);
- maketojumpbool(p^.left);
- emitl(A_LABEL,l2);
- truelabel:=otlabel;
- falselabel:=oflabel;
- end
- else { //// NOT a small set //// }
- begin
- { handling code at the end as it is much more efficient }
- emitl(A_JMP,l2);
- emitl(A_LABEL,l1);
- cleartempgen;
- getlabel(l3);
- aktcontinuelabel:=l2;
- aktbreaklabel:=l3;
- if assigned(p^.right) then
- secondpass(p^.right);
- emitl(A_LABEL,l2);
- otlabel:=truelabel;
- oflabel:=falselabel;
- truelabel:=l1;
- falselabel:=l3;
- cleartempgen;
- secondpass(p^.left);
- maketojumpbool(p^.left);
- emitl(A_LABEL,l3);
- truelabel:=otlabel;
- falselabel:=oflabel;
- end;
- freelabel(l1);
- freelabel(l2);
- aktcontinuelabel:=oldclabel;
- aktbreaklabel:=oldblabel;
- end;
- {*****************************************************************************
- SecondIfN
- *****************************************************************************}
- procedure secondifn(var p : ptree);
- var
- hl,otlabel,oflabel : plabel;
- begin
- otlabel:=truelabel;
- oflabel:=falselabel;
- getlabel(truelabel);
- getlabel(falselabel);
- cleartempgen;
- secondpass(p^.left);
- maketojumpbool(p^.left);
- if assigned(p^.right) then
- begin
- emitl(A_LABEL,truelabel);
- cleartempgen;
- secondpass(p^.right);
- end;
- if assigned(p^.t1) then
- begin
- if assigned(p^.right) then
- begin
- getlabel(hl);
- emitl(A_JMP,hl);
- end;
- emitl(A_LABEL,falselabel);
- cleartempgen;
- secondpass(p^.t1);
- if assigned(p^.right) then
- emitl(A_LABEL,hl);
- end
- else
- emitl(A_LABEL,falselabel);
- if not(assigned(p^.right)) then
- emitl(A_LABEL,truelabel);
- freelabel(truelabel);
- freelabel(falselabel);
- truelabel:=otlabel;
- falselabel:=oflabel;
- end;
- {*****************************************************************************
- SecondFor
- *****************************************************************************}
- procedure secondfor(var p : ptree);
- var
- l1,l3,oldclabel,oldblabel : plabel;
- omitfirstcomp,temptovalue : boolean;
- hs : byte;
- temp1 : treference;
- hop : tasmop;
- 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 p^.right^.treetype=ordconstn then
- if p^.left^.right^.treetype=ordconstn then
- omitfirstcomp:=(p^.backward and (p^.left^.right^.value>=p^.right^.value))
- or (not(p^.backward) and (p^.left^.right^.value<=p^.right^.value));
- { only calculate reference }
- cleartempgen;
- secondpass(p^.t2);
- if not(simple_loadn) then
- CGMessage(cg_e_illegal_count_var);
- { produce start assignment }
- cleartempgen;
- secondpass(p^.left);
- count_var_is_signed:=is_signed(porddef(p^.t2^.resulttype));
- hs:=p^.t2^.resulttype^.size;
- cmp32:=getregister32;
- cmpreg:=cmp32;
- case hs of
- 1 : begin
- opsize:=S_B;
- end;
- 2 : begin
- opsize:=S_W;
- end;
- 4 : begin
- opsize:=S_L;
- end;
- end;
- cleartempgen;
- secondpass(p^.right);
- { calculate pointer value and check if changeable and if so }
- { load into temporary variable }
- if p^.right^.treetype<>ordconstn then
- begin
- temp1.symbol:=nil;
- gettempofsizereference(hs,temp1);
- temptovalue:=true;
- if (p^.right^.location.loc=LOC_REGISTER) or
- (p^.right^.location.loc=LOC_CREGISTER) then
- begin
- exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,opsize,p^.right^.location.register,
- newreference(temp1))));
- end
- else
- concatcopy(p^.right^.location.reference,temp1,hs,false);
- end
- else temptovalue:=false;
- if temptovalue then
- begin
- if p^.t2^.location.loc=LOC_CREGISTER then
- begin
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,opsize,newreference(temp1),
- p^.t2^.location.register)));
- end
- else
- begin
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(p^.t2^.location.reference),
- cmpreg)));
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,opsize,newreference(temp1),
- cmpreg)));
- end;
- end
- else
- begin
- if not(omitfirstcomp) then
- begin
- if p^.t2^.location.loc=LOC_CREGISTER then
- exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^.right^.value,
- p^.t2^.location.register)))
- else
- exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,opsize,p^.right^.value,
- newreference(p^.t2^.location.reference))));
- end;
- end;
- if p^.backward then
- begin
- if count_var_is_signed then
- hop:=A_BLT
- else
- hop:=A_BCS;
- end
- else
- if count_var_is_signed then
- hop:=A_BGT
- else hop:=A_BHI;
- if not(omitfirstcomp) or temptovalue then
- emitl(hop,aktbreaklabel);
- emitl(A_LABEL,l3);
- { help register must not be in instruction block }
- cleartempgen;
- if assigned(p^.t1) then
- secondpass(p^.t1);
- emitl(A_LABEL,aktcontinuelabel);
- { makes no problems there }
- cleartempgen;
- { demand help register again }
- cmp32:=getregister32;
- case hs of
- 1 : begin
- opsize:=S_B;
- end;
- 2 : begin
- opsize:=S_W;
- end;
- 4 : opsize:=S_L;
- end;
- { produce comparison and the corresponding }
- { jump }
- if temptovalue then
- begin
- if p^.t2^.location.loc=LOC_CREGISTER then
- begin
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,opsize,newreference(temp1),
- p^.t2^.location.register)));
- end
- else
- begin
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(p^.t2^.location.reference),
- cmpreg)));
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,opsize,newreference(temp1),
- cmpreg)));
- end;
- end
- else
- begin
- if p^.t2^.location.loc=LOC_CREGISTER then
- exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^.right^.value,
- p^.t2^.location.register)))
- else
- exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,opsize,p^.right^.value,
- newreference(p^.t2^.location.reference))));
- end;
- if p^.backward then
- if count_var_is_signed then
- hop:=A_BLE
- else
- hop :=A_BLS
- else
- if count_var_is_signed then
- hop:=A_BGE
- else
- hop:=A_BCC;
- emitl(hop,aktbreaklabel);
- { according to count direction DEC or INC... }
- { must be after the test because of 0to 255 for bytes !! }
- if p^.backward then
- hop:=A_SUB
- else hop:=A_ADD;
- if p^.t2^.location.loc=LOC_CREGISTER then
- exprasmlist^.concat(new(pai68k,op_const_reg(hop,opsize,1,p^.t2^.location.register)))
- else
- exprasmlist^.concat(new(pai68k,op_const_ref(hop,opsize,1,newreference(p^.t2^.location.reference))));
- emitl(A_JMP,l3);
- { this is the break label: }
- emitl(A_LABEL,aktbreaklabel);
- ungetregister32(cmp32);
- if temptovalue then
- ungetiftemp(temp1);
- freelabel(aktcontinuelabel);
- freelabel(aktbreaklabel);
- freelabel(l3);
- aktcontinuelabel:=oldclabel;
- aktbreaklabel:=oldblabel;
- end;
- {*****************************************************************************
- SecondExitN
- *****************************************************************************}
- procedure secondexitn(var p : ptree);
- var
- is_mem : boolean;
- {op : tasmop;
- s : topsize;}
- otlabel,oflabel : plabel;
- label
- do_jmp;
- begin
- if assigned(p^.left) then
- begin
- otlabel:=truelabel;
- oflabel:=falselabel;
- getlabel(truelabel);
- getlabel(falselabel);
- secondpass(p^.left);
- case p^.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(new(pai68k,op_reg(flag_2_set[p^.right^.location.resflags],S_B,R_D0)));
- exprasmlist^.concat(new(pai68k,op_reg(A_NEG, S_B, R_D0)));
- goto do_jmp;
- end;
- LOC_JUMP : begin
- emitl(A_LABEL,truelabel);
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,1,R_D0)));
- emitl(A_JMP,aktexit2label);
- exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_B,R_D0)));
- goto do_jmp;
- end;
- else internalerror(2001);
- end;
- case procinfo.retdef^.deftype of
- orddef,
- enumdef : begin
- case procinfo.retdef^.size of
- 4 : if is_mem then
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
- newreference(p^.left^.location.reference),R_D0)))
- else
- emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,R_D0);
- 2 : if is_mem then
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
- newreference(p^.left^.location.reference),R_D0)))
- else
- emit_reg_reg(A_MOVE,S_W,p^.left^.location.register,R_D0);
- 1 : if is_mem then
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
- newreference(p^.left^.location.reference),R_D0)))
- else
- emit_reg_reg(A_MOVE,S_B,p^.left^.location.register,R_D0);
- end;
- end;
- pointerdef,
- procvardef : begin
- if is_mem then
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
- newreference(p^.left^.location.reference),R_D0)))
- else
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,p^.left^.location.register,R_D0)));
- end;
- floatdef : begin
- { floating point return values .... }
- { single are returned in d0 }
- if (pfloatdef(procinfo.retdef)^.typ=f32bit) or
- (pfloatdef(procinfo.retdef)^.typ=s32real) then
- begin
- if is_mem then
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
- newreference(p^.left^.location.reference),R_D0)))
- else
- begin
- if pfloatdef(procinfo.retdef)^.typ=f32bit then
- emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,R_D0)
- else
- begin
- { single values are in the floating point registers }
- if cs_fp_emulation in aktmoduleswitches then
- emit_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D0)
- else
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,S_FS,
- p^.left^.location.fpureg,R_D0)));
- end;
- end;
- end
- else
- Begin
- { this is only possible in real non emulation mode }
- { LOC_MEM,LOC_REFERENCE }
- if is_mem then
- begin
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,
- getfloatsize(pfloatdef(procinfo.retdef)^.typ),
- newreference(p^.left^.location.reference),R_FP0)));
- end
- else
- { LOC_FPU }
- begin
- { convert from extended to correct type }
- { when storing }
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,
- getfloatsize(pfloatdef(procinfo.retdef)^.typ),p^.left^.location.fpureg,R_FP0)));
- end;
- end;
- end;
- end;
- do_jmp:
- freelabel(truelabel);
- freelabel(falselabel);
- truelabel:=otlabel;
- falselabel:=oflabel;
- emitl(A_JMP,aktexit2label);
- end
- else
- begin
- emitl(A_JMP,aktexitlabel);
- end;
- end;
- {*****************************************************************************
- SecondBreakN
- *****************************************************************************}
- procedure secondbreakn(var p : ptree);
- begin
- if aktbreaklabel<>nil then
- emitl(A_JMP,aktbreaklabel)
- else
- CGMessage(cg_e_break_not_allowed);
- end;
- {*****************************************************************************
- SecondContinueN
- *****************************************************************************}
- procedure secondcontinuen(var p : ptree);
- begin
- if aktcontinuelabel<>nil then
- emitl(A_JMP,aktcontinuelabel)
- else
- CGMessage(cg_e_continue_not_allowed);
- end;
- {*****************************************************************************
- SecondGoto
- *****************************************************************************}
- procedure secondgoto(var p : ptree);
- begin
- emitl(A_JMP,p^.labelnr);
- end;
- {*****************************************************************************
- SecondLabel
- *****************************************************************************}
- procedure secondlabel(var p : ptree);
- begin
- emitl(A_LABEL,p^.labelnr);
- cleartempgen;
- secondpass(p^.left);
- end;
- {*****************************************************************************
- SecondRaise
- *****************************************************************************}
- { generates the code for a raise statement }
- procedure secondraise(var p : ptree);
- var
- a : plabel;
- begin
- if assigned(p^.left) then
- begin
- { generate the address }
- if assigned(p^.right) then
- begin
- secondpass(p^.right);
- if codegenerror then
- exit;
- end
- else
- begin
- getlabel(a);
- emitl(A_LABEL,a);
- exprasmlist^.concat(new(pai68k,
- op_csymbol_reg(A_MOVE,S_L,newcsymbol(lab2str(a),0),R_SPPUSH)));
- end;
- secondpass(p^.left);
- if codegenerror then
- exit;
- case p^.left^.location.loc of
- LOC_MEM,LOC_REFERENCE : emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
- LOC_CREGISTER,LOC_REGISTER : exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
- p^.left^.location.register,R_SPPUSH)));
- else CGMessage(type_e_mismatch);
- end;
- emitcall('FPC_RAISEEXCEPTION',true);
- end
- else
- emitcall('FPC_RERAISE',true);
- end;
- {*****************************************************************************
- SecondTryExcept
- *****************************************************************************}
- var
- endexceptlabel : plabel;
- procedure secondtryexcept(var p : ptree);
- var
- exceptlabel,doexceptlabel,oldendexceptlabel,
- lastonlabel : plabel;
- begin
- InternalError(3431243);
- (*
- { this can be called recursivly }
- oldendexceptlabel:=endexceptlabel;
- { we modify EAX }
- usedinproc:=usedinproc or ($80 shr byte(R_EAX));
- getlabel(exceptlabel);
- getlabel(doexceptlabel);
- getlabel(endexceptlabel);
- getlabel(lastonlabel);
- push_int (1); { push type of exceptionframe }
- emitcall('FPC_PUSHEXCEPTADDR',true);
- exprasmlist^.concat(new(pai386,
- op_reg(A_PUSH,S_L,R_EAX)));
- emitcall('FPC_SETJMP',true);
- exprasmlist^.concat(new(pai386,
- op_reg(A_PUSH,S_L,R_EAX)));
- exprasmlist^.concat(new(pai386,
- op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
- emitl(A_JNE,exceptlabel);
- { try code }
- secondpass(p^.left);
- if codegenerror then
- exit;
- emitl(A_LABEL,exceptlabel);
- exprasmlist^.concat(new(pai386,
- op_reg(A_POP,S_L,R_EAX)));
- exprasmlist^.concat(new(pai386,
- op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
- emitl(A_JNE,doexceptlabel);
- emitcall('FPC_POPADDRSTACK',true);
- emitl(A_JMP,endexceptlabel);
- emitl(A_LABEL,doexceptlabel);
- if assigned(p^.right) then
- secondpass(p^.right);
- emitl(A_LABEL,lastonlabel);
- { default handling }
- if assigned(p^.t1) then
- begin
- { FPC_CATCHES must be called with
- 'default handler' flag (=-1)
- }
- push_int (-1);
- emitcall('FPC_CATCHES',true);
- secondpass(p^.t1);
- end
- else
- emitcall('FPC_RERAISE',true);
- emitl(A_LABEL,endexceptlabel);
- endexceptlabel:=oldendexceptlabel; *)
- end;
- {*****************************************************************************
- SecondOn
- *****************************************************************************}
- procedure secondon(var p : ptree);
- var
- nextonlabel,myendexceptlabel : plabel;
- ref : treference;
- begin
- { !!!!!!!!!!!!!!! }
- (* getlabel(nextonlabel);
- { push the vmt }
- exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
- newcsymbol(p^.excepttype^.vmt_mangledname,0))));
- maybe_concat_external(p^.excepttype^.owner,
- p^.excepttype^.vmt_mangledname);
- emitcall('FPC_CATCHES',true);
- exprasmlist^.concat(new(pai386,
- op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
- emitl(A_JE,nextonlabel);
- ref.symbol:=nil;
- gettempofsizereference(4,ref);
- { what a hack ! }
- if assigned(p^.exceptsymtable) then
- pvarsym(p^.exceptsymtable^.root)^.address:=ref.offset;
- exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
- R_EAX,newreference(ref))));
- if assigned(p^.right) then
- secondpass(p^.right);
- { clear some stuff }
- ungetiftemp(ref);
- emitl(A_JMP,endexceptlabel);
- emitl(A_LABEL,nextonlabel);
- { next on node }
- if assigned(p^.left) then
- secondpass(p^.left); *)
- end;
- {*****************************************************************************
- SecondTryFinally
- *****************************************************************************}
- procedure secondtryfinally(var p : ptree);
- var
- finallylabel,noreraiselabel,endfinallylabel : plabel;
- begin
- (* { we modify EAX }
- usedinproc:=usedinproc or ($80 shr byte(R_EAX));
- getlabel(finallylabel);
- getlabel(noreraiselabel);
- getlabel(endfinallylabel);
- push_int(1); { Type of stack-frame must be pushed}
- emitcall('FPC_PUSHEXCEPTADDR',true);
- exprasmlist^.concat(new(pai386,
- op_reg(A_PUSH,S_L,R_EAX)));
- emitcall('FPC_SETJMP',true);
- exprasmlist^.concat(new(pai386,
- op_reg(A_PUSH,S_L,R_EAX)));
- exprasmlist^.concat(new(pai386,
- op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
- emitl(A_JNE,finallylabel);
- { try code }
- secondpass(p^.left);
- if codegenerror then
- exit;
- emitl(A_LABEL,finallylabel);
- { finally code }
- secondpass(p^.right);
- if codegenerror then
- exit;
- exprasmlist^.concat(new(pai386,
- op_reg(A_POP,S_L,R_EAX)));
- exprasmlist^.concat(new(pai386,
- op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
- emitl(A_JE,noreraiselabel);
- emitcall('FPC_RERAISE',true);
- emitl(A_LABEL,noreraiselabel);
- emitcall('FPC_POPADDRSTACK',true);
- emitl(A_LABEL,endfinallylabel); *)
- end;
- {*****************************************************************************
- SecondFail
- *****************************************************************************}
- procedure secondfail(var p : ptree);
- var
- hp : preference;
- begin
- exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_L,R_A5)));
- { also reset to zero in the stack }
- new(hp);
- reset_reference(hp^);
- hp^.offset:=procinfo.ESI_offset;
- hp^.base:=procinfo.framepointer;
- exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,R_A5,hp)));
- exprasmlist^.concat(new(pai_labeled,init(A_JMP,quickexitlabel)));
- end;
- end.
- {
- $Log$
- Revision 1.8 1998-12-11 00:03:02 peter
- + globtype,tokens,version unit splitted from globals
- Revision 1.7 1998/10/14 11:28:19 florian
- * emitpushreferenceaddress gets now the asmlist as parameter
- * m68k version compiles with -duseansistrings
- Revision 1.6 1998/10/13 16:50:07 pierre
- * undid some changes of Peter that made the compiler wrong
- for m68k (I had to reinsert some ifdefs)
- * removed several memory leaks under m68k
- * removed the meory leaks for assembler readers
- * cross compiling shoud work again better
- ( crosscompiling sysamiga works
- but as68k still complain about some code !)
- Revision 1.5 1998/09/17 09:42:24 peter
- + pass_2 for cg386
- * Message() -> CGMessage() for pass_1/pass_2
- Revision 1.4 1998/09/14 10:43:58 peter
- * all internal RTL functions start with FPC_
- Revision 1.3 1998/09/04 08:41:47 peter
- * updated some error messages
- Revision 1.2 1998/09/01 12:48:01 peter
- * use pdef^.size instead of orddef^.typ
- Revision 1.1 1998/09/01 09:07:09 peter
- * m68k fixes, splitted cg68k like cgi386
- }
|