123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599 |
- {
- $Id$
- Copyright (c) 1998-2000 by Florian Klaempfl
- Helper routines for the i386 code generator
- 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 n386util;
- {$i defines.inc}
- interface
- uses
- symtype,node;
- function maybe_push(needed : byte;p : tnode;isint64 : boolean) : boolean;
- {$ifdef TEMPS_NOT_PUSH}
- function maybe_savetotemp(needed : byte;p : tnode;isint64 : boolean) : boolean;
- {$endif TEMPS_NOT_PUSH}
- procedure restore(p : tnode;isint64 : boolean);
- {$ifdef TEMPS_NOT_PUSH}
- procedure restorefromtemp(p : tnode;isint64 : boolean);
- {$endif TEMPS_NOT_PUSH}
- procedure pushsetelement(p : tnode);
- procedure push_value_para(p:tnode;inlined,is_cdecl:boolean;
- para_offset:longint;alignment : longint);
- procedure loadshortstring(source,dest : tnode);
- procedure loadlongstring(p:tbinarynode);
- procedure loadansi2short(source,dest : tnode);
- procedure loadwide2short(source,dest : tnode);
- procedure loadinterfacecom(p: tbinarynode);
- procedure maketojumpbool(p : tnode);
- procedure emitoverflowcheck(p:tnode);
- procedure emitrangecheck(p:tnode;todef:tdef);
- procedure firstcomplex(p : tbinarynode);
- implementation
- uses
- globtype,globals,systems,verbose,
- cutils,
- aasm,cpubase,cpuasm,
- symconst,symbase,symdef,symsym,symtable,
- {$ifdef GDB}
- gdb,
- {$endif GDB}
- types,
- ncon,nld,
- pass_1,pass_2,
- hcodegen,tgcpu,temp_gen,
- cgai386,regvars;
- {*****************************************************************************
- Emit Push Functions
- *****************************************************************************}
- function maybe_push(needed : byte;p : tnode;isint64 : boolean) : boolean;
- var
- pushed : boolean;
- {hregister : tregister; }
- {$ifdef TEMPS_NOT_PUSH}
- href : treference;
- {$endif TEMPS_NOT_PUSH}
- begin
- if p.location.loc = LOC_CREGISTER then
- begin
- maybe_push := true;
- exit;
- end;
- if needed>usablereg32 then
- begin
- if (p.location.loc=LOC_REGISTER) then
- begin
- if isint64 then
- begin
- {$ifdef TEMPS_NOT_PUSH}
- gettempofsizereference(href,8);
- p.temp_offset:=href.offset;
- href.offset:=href.offset+4;
- exprasmList.concat(Taicpu.Op_reg(A_MOV,S_L,p.location.registerhigh,href));
- href.offset:=href.offset-4;
- {$else TEMPS_NOT_PUSH}
- exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,p.location.registerhigh));
- {$endif TEMPS_NOT_PUSH}
- ungetregister32(p.location.registerhigh);
- end
- {$ifdef TEMPS_NOT_PUSH}
- else
- begin
- gettempofsizereference(href,4);
- p.temp_offset:=href.offset;
- end
- {$endif TEMPS_NOT_PUSH}
- ;
- pushed:=true;
- {$ifdef TEMPS_NOT_PUSH}
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,p.location.register,href));
- {$else TEMPS_NOT_PUSH}
- exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,p.location.register));
- {$endif TEMPS_NOT_PUSH}
- ungetregister32(p.location.register);
- end
- else if (p.location.loc in [LOC_MEM,LOC_REFERENCE]) and
- ((p.location.reference.base<>R_NO) or
- (p.location.reference.index<>R_NO)
- ) then
- begin
- del_reference(p.location.reference);
- getexplicitregister32(R_EDI);
- emit_ref_reg(A_LEA,S_L,newreference(p.location.reference),R_EDI);
- {$ifdef TEMPS_NOT_PUSH}
- gettempofsizereference(href,4);
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,href));
- p.temp_offset:=href.offset;
- {$else TEMPS_NOT_PUSH}
- exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,R_EDI));
- {$endif TEMPS_NOT_PUSH}
- ungetregister32(R_EDI);
- pushed:=true;
- end
- else pushed:=false;
- end
- else pushed:=false;
- maybe_push:=pushed;
- end;
- {$ifdef TEMPS_NOT_PUSH}
- function maybe_savetotemp(needed : byte;p : tnode;isint64 : boolean) : boolean;
- var
- pushed : boolean;
- href : treference;
- begin
- if needed>usablereg32 then
- begin
- if (p^.location.loc=LOC_REGISTER) then
- begin
- if isint64(p^.resulttype.def) then
- begin
- gettempofsizereference(href,8);
- p^.temp_offset:=href.offset;
- href.offset:=href.offset+4;
- exprasmList.concat(Taicpu.Op_reg(A_MOV,S_L,p^.location.registerhigh,href));
- href.offset:=href.offset-4;
- ungetregister32(p^.location.registerhigh);
- end
- else
- begin
- gettempofsizereference(href,4);
- p^.temp_offset:=href.offset;
- end;
- pushed:=true;
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,p^.location.register,href));
- ungetregister32(p^.location.register);
- end
- else if (p^.location.loc in [LOC_MEM,LOC_REFERENCE]) and
- ((p^.location.reference.base<>R_NO) or
- (p^.location.reference.index<>R_NO)
- ) then
- begin
- del_reference(p^.location.reference);
- getexplicitregister32(R_EDI);
- emit_ref_reg(A_LEA,S_L,newreference(p^.location.reference),
- R_EDI);
- gettempofsizereference(href,4);
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,href));
- ungetregister32(R_EDI);
- p^.temp_offset:=href.offset;
- pushed:=true;
- end
- else pushed:=false;
- end
- else pushed:=false;
- maybe_push:=pushed;
- end;
- {$endif TEMPS_NOT_PUSH}
- procedure restore(p : tnode;isint64 : boolean);
- var
- hregister : tregister;
- {$ifdef TEMPS_NOT_PUSH}
- href : treference;
- {$endif TEMPS_NOT_PUSH}
- begin
- if p.location.loc = LOC_CREGISTER then
- begin
- load_regvar_reg(exprasmlist,p.location.register);
- exit;
- end;
- hregister:=getregister32;
- {$ifdef TEMPS_NOT_PUSH}
- reset_reference(href);
- href.base:=procinfo^.frame_pointer;
- href.offset:=p.temp_offset;
- emit_ref_reg(A_MOV,S_L,href,hregister);
- {$else TEMPS_NOT_PUSH}
- exprasmList.concat(Taicpu.Op_reg(A_POP,S_L,hregister));
- {$endif TEMPS_NOT_PUSH}
- if (p.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
- begin
- p.location.register:=hregister;
- if isint64 then
- begin
- p.location.registerhigh:=getregister32;
- {$ifdef TEMPS_NOT_PUSH}
- href.offset:=p.temp_offset+4;
- emit_ref_reg(A_MOV,S_L,p.location.registerhigh);
- { set correctly for release ! }
- href.offset:=p.temp_offset;
- {$else TEMPS_NOT_PUSH}
- exprasmList.concat(Taicpu.Op_reg(A_POP,S_L,p.location.registerhigh));
- {$endif TEMPS_NOT_PUSH}
- end;
- end
- else
- begin
- reset_reference(p.location.reference);
- { any reasons why this was moved into the index register ? }
- { normally usage of base register is much better (FK) }
- p.location.reference.base:=hregister;
- { Why is this done? We can never be sure about p.left
- because otherwise secondload fails !!!
- set_location(p.left^.location,p.location);}
- end;
- {$ifdef TEMPS_NOT_PUSH}
- ungetiftemp(href);
- {$endif TEMPS_NOT_PUSH}
- end;
- {$ifdef TEMPS_NOT_PUSH}
- procedure restorefromtemp(p : tnode;isint64 : boolean);
- var
- hregister : tregister;
- href : treference;
- begin
- hregister:=getregister32;
- reset_reference(href);
- href.base:=procinfo^.frame_pointer;
- href.offset:=p.temp_offset;
- emit_ref_reg(A_MOV,S_L,href,hregister);
- if (p.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
- begin
- p.location.register:=hregister;
- if isint64 then
- begin
- p.location.registerhigh:=getregister32;
- href.offset:=p.temp_offset+4;
- emit_ref_reg(A_MOV,S_L,p.location.registerhigh);
- { set correctly for release ! }
- href.offset:=p.temp_offset;
- end;
- end
- else
- begin
- reset_reference(p.location.reference);
- p.location.reference.base:=hregister;
- { Why is this done? We can never be sure about p^.left
- because otherwise secondload fails PM
- set_location(p^.left^.location,p^.location);}
- end;
- ungetiftemp(href);
- end;
- {$endif TEMPS_NOT_PUSH}
- procedure pushsetelement(p : tnode);
- var
- hr,hr16,hr32 : tregister;
- begin
- { copy the element on the stack, slightly complicated }
- if p.nodetype=ordconstn then
- begin
- if aktalignment.paraalign=4 then
- exprasmList.concat(Taicpu.Op_const(A_PUSH,S_L,tordconstnode(p).value))
- else
- exprasmList.concat(Taicpu.Op_const(A_PUSH,S_W,tordconstnode(p).value));
- end
- else
- begin
- case p.location.loc of
- LOC_REGISTER,
- LOC_CREGISTER :
- begin
- hr:=p.location.register;
- case hr of
- R_EAX,R_EBX,R_ECX,R_EDX,R_EDI,R_ESI,R_ESP :
- begin
- hr16:=reg32toreg16(hr);
- hr32:=hr;
- end;
- R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP :
- begin
- hr16:=hr;
- hr32:=reg16toreg32(hr);
- end;
- R_AL,R_BL,R_CL,R_DL :
- begin
- hr16:=reg8toreg16(hr);
- hr32:=reg8toreg32(hr);
- end;
- end;
- if aktalignment.paraalign=4 then
- exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,hr32))
- else
- exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_W,hr16));
- ungetregister32(hr32);
- end;
- else
- begin
- { you can't push more bytes than the size of the element, }
- { because this may cross a page boundary and you'll get a }
- { sigsegv (JM) }
- emit_push_mem_size(p.location.reference,1);
- del_reference(p.location.reference);
- end;
- end;
- end;
- end;
- procedure push_value_para(p:tnode;inlined,is_cdecl:boolean;
- para_offset:longint;alignment : longint);
- var
- tempreference : treference;
- r : preference;
- opsize : topsize;
- op : tasmop;
- hreg : tregister;
- size : longint;
- hlabel : tasmlabel;
- begin
- case p.location.loc of
- LOC_REGISTER,
- LOC_CREGISTER:
- begin
- if p.resulttype.def.size=8 then
- begin
- inc(pushedparasize,8);
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmlist.concat(taicpu.op_reg_ref(A_MOV,S_L,p.location.registerlow,r));
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize+4);
- exprasmlist.concat(taicpu.op_reg_ref(A_MOV,S_L,p.location.registerhigh,r));
- end
- else
- begin
- exprasmlist.concat(taicpu.op_reg(A_PUSH,S_L,p.location.registerhigh));
- exprasmlist.concat(taicpu.op_reg(A_PUSH,S_L,p.location.registerlow));
- end;
- ungetregister32(p.location.registerhigh);
- ungetregister32(p.location.registerlow);
- end
- else case p.location.register of
- R_EAX,R_EBX,R_ECX,R_EDX,R_ESI,
- R_EDI,R_ESP,R_EBP :
- begin
- inc(pushedparasize,4);
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,p.location.register,r));
- end
- else
- exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,p.location.register));
- ungetregister32(p.location.register);
- end;
- R_AX,R_BX,R_CX,R_DX,R_SI,R_DI:
- begin
- if alignment=4 then
- begin
- opsize:=S_L;
- hreg:=reg16toreg32(p.location.register);
- inc(pushedparasize,4);
- end
- else
- begin
- opsize:=S_W;
- hreg:=p.location.register;
- inc(pushedparasize,2);
- end;
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,opsize,hreg,r));
- end
- else
- exprasmList.concat(Taicpu.Op_reg(A_PUSH,opsize,hreg));
- ungetregister32(reg16toreg32(p.location.register));
- end;
- R_AL,R_BL,R_CL,R_DL:
- begin
- if alignment=4 then
- begin
- opsize:=S_L;
- hreg:=reg8toreg32(p.location.register);
- inc(pushedparasize,4);
- end
- else
- begin
- opsize:=S_W;
- hreg:=reg8toreg16(p.location.register);
- inc(pushedparasize,2);
- end;
- { we must push always 16 bit }
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,opsize,hreg,r));
- end
- else
- exprasmList.concat(Taicpu.Op_reg(A_PUSH,opsize,hreg));
- ungetregister32(reg8toreg32(p.location.register));
- end;
- else internalerror(1899);
- end;
- end;
- LOC_FPU:
- begin
- size:=align(tfloatdef(p.resulttype.def).size,alignment);
- inc(pushedparasize,size);
- if not inlined then
- emit_const_reg(A_SUB,S_L,size,R_ESP);
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) and
- (exprasmList.first=exprasmList.last) then
- exprasmList.concat(Tai_force_line.Create);
- {$endif GDB}
- r:=new_reference(R_ESP,0);
- floatstoreops(tfloatdef(p.resulttype.def).typ,op,opsize);
- { this is the easiest case for inlined !! }
- if inlined then
- begin
- r^.base:=procinfo^.framepointer;
- r^.offset:=para_offset-pushedparasize;
- end;
- exprasmList.concat(Taicpu.Op_ref(op,opsize,r));
- dec(fpuvaroffset);
- end;
- LOC_CFPUREGISTER:
- begin
- exprasmList.concat(Taicpu.Op_reg(A_FLD,S_NO,
- correct_fpuregister(p.location.register,fpuvaroffset)));
- size:=align(tfloatdef(p.resulttype.def).size,alignment);
- inc(pushedparasize,size);
- if not inlined then
- emit_const_reg(A_SUB,S_L,size,R_ESP);
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) and
- (exprasmList.first=exprasmList.last) then
- exprasmList.concat(Tai_force_line.Create);
- {$endif GDB}
- r:=new_reference(R_ESP,0);
- floatstoreops(tfloatdef(p.resulttype.def).typ,op,opsize);
- { this is the easiest case for inlined !! }
- if inlined then
- begin
- r^.base:=procinfo^.framepointer;
- r^.offset:=para_offset-pushedparasize;
- end;
- exprasmList.concat(Taicpu.Op_ref(op,opsize,r));
- end;
- LOC_REFERENCE,LOC_MEM:
- begin
- tempreference:=p.location.reference;
- del_reference(p.location.reference);
- case p.resulttype.def.deftype of
- enumdef,
- orddef :
- begin
- case p.resulttype.def.size of
- 8 : begin
- inc(pushedparasize,8);
- if inlined then
- begin
- getexplicitregister32(R_EDI);
- emit_ref_reg(A_MOV,S_L,
- newreference(tempreference),R_EDI);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
- ungetregister32(R_EDI);
- getexplicitregister32(R_EDI);
- inc(tempreference.offset,4);
- emit_ref_reg(A_MOV,S_L,
- newreference(tempreference),R_EDI);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize+4);
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
- ungetregister32(R_EDI);
- end
- else
- begin
- inc(tempreference.offset,4);
- emit_push_mem(tempreference);
- dec(tempreference.offset,4);
- emit_push_mem(tempreference);
- end;
- end;
- 4 : begin
- inc(pushedparasize,4);
- if inlined then
- begin
- getexplicitregister32(R_EDI);
- emit_ref_reg(A_MOV,S_L,
- newreference(tempreference),R_EDI);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
- ungetregister32(R_EDI);
- end
- else
- emit_push_mem(tempreference);
- end;
- 1,2 : begin
- if alignment=4 then
- begin
- opsize:=S_L;
- hreg:=R_EDI;
- inc(pushedparasize,4);
- end
- else
- begin
- opsize:=S_W;
- hreg:=R_DI;
- inc(pushedparasize,2);
- end;
- if inlined then
- begin
- getexplicitregister32(R_EDI);
- emit_ref_reg(A_MOV,opsize,
- newreference(tempreference),hreg);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,opsize,hreg,r));
- ungetregister32(R_EDI);
- end
- else
- emit_push_mem_size(tempreference,p.resulttype.def.size);
- end;
- else
- internalerror(234231);
- end;
- end;
- floatdef :
- begin
- case tfloatdef(p.resulttype.def).typ of
- s32real :
- begin
- inc(pushedparasize,4);
- if inlined then
- begin
- getexplicitregister32(R_EDI);
- emit_ref_reg(A_MOV,S_L,
- newreference(tempreference),R_EDI);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
- ungetregister32(R_EDI);
- end
- else
- emit_push_mem(tempreference);
- end;
- s64real,
- s64comp :
- begin
- inc(pushedparasize,4);
- inc(tempreference.offset,4);
- if inlined then
- begin
- getexplicitregister32(R_EDI);
- emit_ref_reg(A_MOV,S_L,
- newreference(tempreference),R_EDI);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
- ungetregister32(R_EDI);
- end
- else
- emit_push_mem(tempreference);
- inc(pushedparasize,4);
- dec(tempreference.offset,4);
- if inlined then
- begin
- getexplicitregister32(R_EDI);
- emit_ref_reg(A_MOV,S_L,
- newreference(tempreference),R_EDI);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
- ungetregister32(R_EDI);
- end
- else
- emit_push_mem(tempreference);
- end;
- s80real :
- begin
- inc(pushedparasize,4);
- if alignment=4 then
- inc(tempreference.offset,8)
- else
- inc(tempreference.offset,6);
- if inlined then
- begin
- getexplicitregister32(R_EDI);
- emit_ref_reg(A_MOV,S_L,
- newreference(tempreference),R_EDI);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
- ungetregister32(R_EDI);
- end
- else
- emit_push_mem(tempreference);
- dec(tempreference.offset,4);
- inc(pushedparasize,4);
- if inlined then
- begin
- getexplicitregister32(R_EDI);
- emit_ref_reg(A_MOV,S_L,
- newreference(tempreference),R_EDI);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
- ungetregister32(R_EDI);
- end
- else
- emit_push_mem(tempreference);
- if alignment=4 then
- begin
- opsize:=S_L;
- hreg:=R_EDI;
- inc(pushedparasize,4);
- dec(tempreference.offset,4);
- end
- else
- begin
- opsize:=S_W;
- hreg:=R_DI;
- inc(pushedparasize,2);
- dec(tempreference.offset,2);
- end;
- if inlined then
- begin
- getexplicitregister32(R_EDI);
- emit_ref_reg(A_MOV,opsize,
- newreference(tempreference),hreg);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,opsize,hreg,r));
- ungetregister32(R_EDI);
- end
- else
- exprasmList.concat(Taicpu.Op_ref(A_PUSH,opsize,
- newreference(tempreference)));
- end;
- end;
- end;
- pointerdef,
- procvardef,
- classrefdef:
- begin
- inc(pushedparasize,4);
- if inlined then
- begin
- getexplicitregister32(R_EDI);
- emit_ref_reg(A_MOV,S_L,
- newreference(tempreference),R_EDI);
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
- ungetregister32(R_EDI);
- end
- else
- emit_push_mem(tempreference);
- end;
- arraydef,
- recorddef,
- stringdef,
- setdef,
- objectdef :
- begin
- { even some structured types are 32 bit }
- if is_widestring(p.resulttype.def) or
- is_ansistring(p.resulttype.def) or
- is_smallset(p.resulttype.def) or
- ((p.resulttype.def.deftype in [recorddef,arraydef]) and
- (
- (p.resulttype.def.deftype<>arraydef) or not
- (tarraydef(p.resulttype.def).IsConstructor or
- tarraydef(p.resulttype.def).isArrayOfConst or
- is_open_array(p.resulttype.def))
- ) and
- (p.resulttype.def.size<=4)
- ) or
- is_class(p.resulttype.def) or
- is_interface(p.resulttype.def) then
- begin
- if (p.resulttype.def.size>2) or
- ((alignment=4) and (p.resulttype.def.size>0)) then
- begin
- inc(pushedparasize,4);
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- concatcopy(tempreference,r^,4,false,false);
- end
- else
- emit_push_mem(tempreference);
- end
- else
- begin
- if p.resulttype.def.size>0 then
- begin
- inc(pushedparasize,2);
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- concatcopy(tempreference,r^,2,false,false);
- end
- else
- exprasmList.concat(Taicpu.Op_ref(A_PUSH,S_W,newreference(tempreference)));
- end;
- end;
- end
- { call by value open array ? }
- else if is_cdecl then
- begin
- { push on stack }
- size:=align(p.resulttype.def.size,alignment);
- inc(pushedparasize,size);
- emit_const_reg(A_SUB,S_L,size,R_ESP);
- r:=new_reference(R_ESP,0);
- concatcopy(tempreference,r^,size,false,false);
- end
- else
- internalerror(8954);
- end;
- else
- CGMessage(cg_e_illegal_expression);
- end;
- end;
- LOC_JUMP:
- begin
- getlabel(hlabel);
- if alignment=4 then
- begin
- opsize:=S_L;
- inc(pushedparasize,4);
- end
- else
- begin
- opsize:=S_W;
- inc(pushedparasize,2);
- end;
- emitlab(truelabel);
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- emit_const_ref(A_MOV,opsize,1,r);
- end
- else
- exprasmList.concat(Taicpu.Op_const(A_PUSH,opsize,1));
- emitjmp(C_None,hlabel);
- emitlab(falselabel);
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- emit_const_ref(A_MOV,opsize,0,r);
- end
- else
- exprasmList.concat(Taicpu.Op_const(A_PUSH,opsize,0));
- emitlab(hlabel);
- end;
- LOC_FLAGS:
- begin
- if not(R_EAX in unused) then
- begin
- getexplicitregister32(R_EDI);
- emit_reg_reg(A_MOV,S_L,R_EAX,R_EDI);
- end;
- emit_flag2reg(p.location.resflags,R_AL);
- emit_reg_reg(A_MOVZX,S_BW,R_AL,R_AX);
- if alignment=4 then
- begin
- opsize:=S_L;
- hreg:=R_EAX;
- inc(pushedparasize,4);
- end
- else
- begin
- opsize:=S_W;
- hreg:=R_AX;
- inc(pushedparasize,2);
- end;
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,opsize,hreg,r));
- end
- else
- exprasmList.concat(Taicpu.Op_reg(A_PUSH,opsize,hreg));
- if not(R_EAX in unused) then
- begin
- emit_reg_reg(A_MOV,S_L,R_EDI,R_EAX);
- ungetregister32(R_EDI);
- end;
- end;
- {$ifdef SUPPORT_MMX}
- LOC_MMXREGISTER,
- LOC_CMMXREGISTER:
- begin
- inc(pushedparasize,8); { was missing !!! (PM) }
- emit_const_reg(
- A_SUB,S_L,8,R_ESP);
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) and
- (exprasmList.first=exprasmList.last) then
- exprasmList.concat(Tai_force_line.Create);
- {$endif GDB}
- if inlined then
- begin
- r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
- exprasmList.concat(Taicpu.Op_reg_ref(A_MOVQ,S_NO,
- p.location.register,r));
- end
- else
- begin
- r:=new_reference(R_ESP,0);
- exprasmList.concat(Taicpu.Op_reg_ref(
- A_MOVQ,S_NO,p.location.register,r));
- end;
- end;
- {$endif SUPPORT_MMX}
- end;
- end;
- {*****************************************************************************
- Emit Functions
- *****************************************************************************}
- procedure maketojumpbool(p : tnode);
- {
- produces jumps to true respectively false labels using boolean expressions
- }
- var
- opsize : topsize;
- storepos : tfileposinfo;
- begin
- if nf_error in p.flags then
- exit;
- storepos:=aktfilepos;
- aktfilepos:=p.fileinfo;
- if is_boolean(p.resulttype.def) then
- begin
- load_all_regvars(exprasmlist);
- if is_constboolnode(p) then
- begin
- if tordconstnode(p).value<>0 then
- emitjmp(C_None,truelabel)
- else
- emitjmp(C_None,falselabel);
- end
- else
- begin
- opsize:=def_opsize(p.resulttype.def);
- case p.location.loc of
- LOC_CREGISTER,LOC_REGISTER : begin
- emit_reg_reg(A_OR,opsize,p.location.register,
- p.location.register);
- ungetregister(p.location.register);
- emitjmp(C_NZ,truelabel);
- emitjmp(C_None,falselabel);
- end;
- LOC_MEM,LOC_REFERENCE : begin
- emit_const_ref(
- A_CMP,opsize,0,newreference(p.location.reference));
- del_reference(p.location.reference);
- emitjmp(C_NZ,truelabel);
- emitjmp(C_None,falselabel);
- end;
- LOC_FLAGS : begin
- emitjmp(flag_2_cond[p.location.resflags],truelabel);
- emitjmp(C_None,falselabel);
- end;
- end;
- end;
- end
- else
- CGMessage(type_e_mismatch);
- aktfilepos:=storepos;
- end;
- { produces if necessary overflowcode }
- procedure emitoverflowcheck(p:tnode);
- var
- hl : tasmlabel;
- begin
- if not(cs_check_overflow in aktlocalswitches) then
- exit;
- getlabel(hl);
- if not ((p.resulttype.def.deftype=pointerdef) or
- ((p.resulttype.def.deftype=orddef) and
- (torddef(p.resulttype.def).typ in [u64bit,u16bit,u32bit,u8bit,uchar,
- bool8bit,bool16bit,bool32bit]))) then
- emitjmp(C_NO,hl)
- else
- emitjmp(C_NB,hl);
- emitcall('FPC_OVERFLOW');
- emitlab(hl);
- end;
- { produces range check code, while one of the operands is a 64 bit
- integer }
- procedure emitrangecheck64(p : tnode;todef : tdef);
- var
- neglabel,
- poslabel,
- endlabel: tasmlabel;
- href : preference;
- hreg : tregister;
- hdef : torddef;
- fromdef : tdef;
- opcode : tasmop;
- opsize : topsize;
- oldregisterdef: boolean;
- from_signed,to_signed: boolean;
- begin
- fromdef:=p.resulttype.def;
- from_signed := is_signed(fromdef);
- to_signed := is_signed(todef);
- if not is_64bitint(todef) then
- begin
- oldregisterdef := registerdef;
- registerdef := false;
- { get the high dword in a register }
- if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
- hreg := p.location.registerhigh
- else
- begin
- hreg := getexplicitregister32(R_EDI);
- href := newreference(p.location.reference);
- inc(href^.offset,4);
- emit_ref_reg(A_MOV,S_L,href,hreg);
- end;
- getlabel(poslabel);
- { check high dword, must be 0 (for positive numbers) }
- emit_reg_reg(A_TEST,S_L,hreg,hreg);
- emitjmp(C_E,poslabel);
- { It can also be $ffffffff, but only for negative numbers }
- if from_signed and to_signed then
- begin
- getlabel(neglabel);
- emit_const_reg(A_CMP,S_L,longint($ffffffff),hreg);
- emitjmp(C_E,neglabel);
- end;
- if hreg = R_EDI then
- ungetregister32(hreg);
- { For all other values we have a range check error }
- emitcall('FPC_RANGEERROR');
- { if the high dword = 0, the low dword can be considered a }
- { simple cardinal }
- emitlab(poslabel);
- hdef:=torddef.create(u32bit,0,longint($ffffffff));
- { the real p.resulttype.def is already saved in fromdef }
- p.resulttype.def := hdef;
- emitrangecheck(p,todef);
- hdef.free;
- { restore original resulttype.def }
- p.resulttype.def := todef;
- if from_signed and to_signed then
- begin
- getlabel(endlabel);
- emitjmp(C_None,endlabel);
- { if the high dword = $ffffffff, then the low dword (when }
- { considered as a longint) must be < 0 }
- emitlab(neglabel);
- if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
- hreg := p.location.registerlow
- else
- begin
- hreg := getexplicitregister32(R_EDI);
- emit_ref_reg(A_MOV,S_L,
- newreference(p.location.reference),hreg);
- end;
- { get a new neglabel (JM) }
- getlabel(neglabel);
- emit_reg_reg(A_TEST,S_L,hreg,hreg);
- if hreg = R_EDI then
- ungetregister32(hreg);
- emitjmp(C_L,neglabel);
- emitcall('FPC_RANGEERROR');
- { if we get here, the 64bit value lies between }
- { longint($80000000) and -1 (JM) }
- emitlab(neglabel);
- hdef:=torddef.create(s32bit,longint($80000000),-1);
- p.resulttype.def := hdef;
- emitrangecheck(p,todef);
- hdef.free;
- emitlab(endlabel);
- end;
- registerdef := oldregisterdef;
- p.resulttype.def := fromdef;
- { restore p's resulttype.def }
- end
- else
- { todef = 64bit int }
- { no 64bit subranges supported, so only a small check is necessary }
- { if both are signed or both are unsigned, no problem! }
- if (from_signed xor to_signed) and
- { also not if the fromdef is unsigned and < 64bit, since that will }
- { always fit in a 64bit int (todef is 64bit) }
- (from_signed or
- (torddef(fromdef).typ = u64bit)) then
- begin
- { in all cases, there is only a problem if the higest bit is set }
- if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
- if is_64bitint(fromdef) then
- hreg := p.location.registerhigh
- else
- hreg := p.location.register
- else
- begin
- hreg := getexplicitregister32(R_EDI);
- case p.resulttype.def.size of
- 1: opsize := S_BL;
- 2: opsize := S_WL;
- 4,8: opsize := S_L;
- end;
- if opsize in [S_BL,S_WL] then
- if from_signed then
- opcode := A_MOVSX
- else opcode := A_MOVZX
- else
- opcode := A_MOV;
- href := newreference(p.location.reference);
- if p.resulttype.def.size = 8 then
- inc(href^.offset,4);
- emit_ref_reg(opcode,opsize,href,hreg);
- end;
- getlabel(poslabel);
- emit_reg_reg(A_TEST,regsize(hreg),hreg,hreg);
- if hreg = R_EDI then
- ungetregister32(hreg);
- emitjmp(C_GE,poslabel);
- emitcall('FPC_RANGEERROR');
- emitlab(poslabel);
- end;
- end;
- { produces if necessary rangecheckcode }
- procedure emitrangecheck(p:tnode;todef:tdef);
- {
- generate range checking code for the value at location t. The
- type used is the checked against todefs ranges. fromdef (p.resulttype.def)
- is the original type used at that location, when both defs are
- equal the check is also insert (needed for succ,pref,inc,dec)
- }
- var
- neglabel : tasmlabel;
- opsize : topsize;
- op : tasmop;
- fromdef : tdef;
- lto,hto,
- lfrom,hfrom : longint;
- is_reg : boolean;
- begin
- { range checking on and range checkable value? }
- if not(cs_check_range in aktlocalswitches) or
- not(todef.deftype in [orddef,enumdef,arraydef]) then
- exit;
- { only check when assigning to scalar, subranges are different,
- when todef=fromdef then the check is always generated }
- fromdef:=p.resulttype.def;
- { no range check if from and to are equal and are both longint/dword or }
- { int64/qword, since such operations can at most cause overflows (JM) }
- if (fromdef = todef) and
- { then fromdef and todef can only be orddefs }
- (((torddef(fromdef).typ = s32bit) and
- (torddef(fromdef).low = longint($80000000)) and
- (torddef(fromdef).high = $7fffffff)) or
- ((torddef(fromdef).typ = u32bit) and
- (torddef(fromdef).low = 0) and
- (torddef(fromdef).high = longint($ffffffff))) or
- is_64bitint(fromdef)) then
- exit;
- if is_64bitint(fromdef) or is_64bitint(todef) then
- begin
- emitrangecheck64(p,todef);
- exit;
- end;
- {we also need lto and hto when checking if we need to use doublebound!
- (JM)}
- getrange(todef,lto,hto);
- if todef<>fromdef then
- begin
- getrange(p.resulttype.def,lfrom,hfrom);
- { first check for not being u32bit, then if the to is bigger than
- from }
- if (lto<hto) and (lfrom<hfrom) and
- (lto<=lfrom) and (hto>=hfrom) then
- exit;
- end;
- { generate the rangecheck code for the def where we are going to
- store the result }
- { get op and opsize }
- opsize:=def2def_opsize(fromdef,u32bittype.def);
- if opsize in [S_B,S_W,S_L] then
- op:=A_MOV
- else
- if is_signed(fromdef) then
- op:=A_MOVSX
- else
- op:=A_MOVZX;
- is_reg:=(p.location.loc in [LOC_REGISTER,LOC_CREGISTER]);
- getexplicitregister32(R_EDI);
- { use the trick that }
- { a <= x <= b <=> 0 <= x-a <= b-a <=> cardinal(x-a) <= cardinal(b-a) }
- { To be able to do that, we have to make sure however that either }
- { fromdef and todef are both signed or unsigned, or that we leave }
- { the parts < 0 and > maxlongint out }
- { is_signed now also works for arrays (it checks the rangetype) (JM) }
- if is_signed(fromdef) xor is_signed(todef) then
- if is_signed(fromdef) then
- { from is signed, to is unsigned }
- begin
- { if high(from) < 0 -> always range error }
- if (hfrom < 0) or
- { if low(to) > maxlongint (== < 0, since we only have }
- { longints here), also range error }
- (lto < 0) then
- begin
- emitcall('FPC_RANGEERROR');
- exit
- end;
- { to is unsigned -> hto < 0 == hto > maxlongint }
- { since from is signed, values > maxlongint are < 0 and must }
- { be rejected }
- if hto < 0 then
- hto := maxlongint;
- end
- else
- { from is unsigned, to is signed }
- begin
- if (lfrom < 0) or
- (hto < 0) then
- begin
- emitcall('FPC_RANGEERROR');
- exit
- end;
- { since from is unsigned, values > maxlongint are < 0 and must }
- { be rejected }
- if lto < 0 then
- lto := 0;
- end;
- if is_reg and
- (opsize = S_L) then
- emit_ref_reg(A_LEA,opsize,new_reference(p.location.register,-lto),
- R_EDI)
- else
- begin
- if is_reg then
- emit_reg_reg(op,opsize,p.location.register,R_EDI)
- else
- emit_ref_reg(op,opsize,newreference(p.location.reference),R_EDI);
- if lto <> 0 then
- emit_const_reg(A_SUB,S_L,lto,R_EDI);
- end;
- emit_const_reg(A_CMP,S_L,hto-lto,R_EDI);
- ungetregister32(R_EDI);
- getlabel(neglabel);
- emitjmp(C_BE,neglabel);
- emitcall('FPC_RANGEERROR');
- emitlab(neglabel);
- end;
- { DO NOT RELY on the fact that the tnode is not yet swaped
- because of inlining code PM }
- procedure firstcomplex(p : tbinarynode);
- var
- hp : tnode;
- begin
- { always calculate boolean AND and OR from left to right }
- if (p.nodetype in [orn,andn]) and
- (p.left.resulttype.def.deftype=orddef) and
- (torddef(p.left.resulttype.def).typ in [bool8bit,bool16bit,bool32bit]) then
- begin
- { p.swaped:=false}
- if nf_swaped in p.flags then
- internalerror(234234);
- end
- else
- if (p.left.registers32<p.right.registers32) and
- { the following check is appropriate, because all }
- { 4 registers are rarely used and it is thereby }
- { achieved that the extra code is being dropped }
- { by exchanging not commutative operators }
- (p.right.registers32<=4) then
- begin
- hp:=p.left;
- p.left:=p.right;
- p.right:=hp;
- if nf_swaped in p.flags then
- exclude(p.flags,nf_swaped)
- else
- include(p.flags,nf_swaped);
- end;
- {else
- p.swaped:=false; do not modify }
- end;
- {*****************************************************************************
- Emit Functions
- *****************************************************************************}
- procedure push_shortstring_length(p:tnode);
- var
- hightree : tnode;
- srsym : tsym;
- begin
- if is_open_string(p.resulttype.def) then
- begin
- srsym:=searchsymonlyin(tloadnode(p).symtable,'high'+tvarsym(tloadnode(p).symtableentry).name);
- hightree:=cloadnode.create(tvarsym(srsym),tloadnode(p).symtable);
- firstpass(hightree);
- secondpass(hightree);
- push_value_para(hightree,false,false,0,4);
- hightree.free;
- hightree:=nil;
- end
- else
- begin
- push_int(tstringdef(p.resulttype.def).len);
- end;
- end;
- {*****************************************************************************
- String functions
- *****************************************************************************}
- procedure loadshortstring(source,dest : tnode);
- {
- Load a string, handles stringdef and orddef (char) types
- }
- var
- href: treference;
- begin
- case source.resulttype.def.deftype of
- stringdef:
- begin
- if (source.nodetype=stringconstn) and
- (str_length(source)=0) then
- emit_const_ref(
- A_MOV,S_B,0,newreference(dest.location.reference))
- else
- begin
- emitpushreferenceaddr(dest.location.reference);
- emitpushreferenceaddr(source.location.reference);
- push_shortstring_length(dest);
- emitcall('FPC_SHORTSTR_COPY');
- maybe_loadself;
- end;
- end;
- orddef:
- begin
- if source.nodetype=ordconstn then
- emit_const_ref(
- A_MOV,S_W,tordconstnode(source).value*256+1,newreference(dest.location.reference))
- else
- begin
- if (source.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
- begin
- href := dest.location.reference;
- emit_const_ref(A_MOV,S_B,1,newreference(href));
- inc(href.offset,1);
- emit_reg_ref(A_MOV,S_B,makereg8(source.location.register),
- newreference(href));
- ungetregister(source.location.register);
- end
- else
- { not so elegant (goes better with extra register }
- begin
- { not "movl", because then we may read past the }
- { end of the heap! "movw" would be ok too, but }
- { I don't think that would be faster (JM) }
- getexplicitregister32(R_EDI);
- emit_ref_reg(A_MOVZX,S_BL,newreference(source.location.reference),R_EDI);
- del_reference(source.location.reference);
- emit_const_reg(A_SHL,S_L,8,R_EDI);
- emit_const_reg(A_OR,S_L,1,R_EDI);
- emit_reg_ref(A_MOV,S_W,R_DI,newreference(dest.location.reference));
- ungetregister32(R_EDI);
- end;
- end;
- end;
- else
- CGMessage(type_e_mismatch);
- end;
- end;
- procedure loadlongstring(p:tbinarynode);
- {
- Load a string, handles stringdef and orddef (char) types
- }
- var
- r : preference;
- begin
- case p.right.resulttype.def.deftype of
- stringdef:
- begin
- if (p.right.nodetype=stringconstn) and
- (str_length(p.right)=0) then
- emit_const_ref(A_MOV,S_L,0,newreference(p.left.location.reference))
- else
- begin
- emitpushreferenceaddr(p.left.location.reference);
- emitpushreferenceaddr(p.right.location.reference);
- push_shortstring_length(p.left);
- emitcall('FPC_LONGSTR_COPY');
- maybe_loadself;
- end;
- end;
- orddef:
- begin
- emit_const_ref(A_MOV,S_L,1,newreference(p.left.location.reference));
- r:=newreference(p.left.location.reference);
- inc(r^.offset,4);
- if p.right.nodetype=ordconstn then
- emit_const_ref(A_MOV,S_B,tordconstnode(p.right).value,r)
- else
- begin
- case p.right.location.loc of
- LOC_REGISTER,LOC_CREGISTER:
- begin
- emit_reg_ref(A_MOV,S_B,p.right.location.register,r);
- ungetregister(p.right.location.register);
- end;
- LOC_MEM,LOC_REFERENCE:
- begin
- if not(R_EAX in unused) then
- emit_reg(A_PUSH,S_L,R_EAX);
- emit_ref_reg(A_MOV,S_B,newreference(p.right.location.reference),R_AL);
- emit_reg_ref(A_MOV,S_B,R_AL,r);
- if not(R_EAX in unused) then
- emit_reg(A_POP,S_L,R_EAX);
- del_reference(p.right.location.reference);
- end
- else
- internalerror(20799);
- end;
- end;
- end;
- else
- CGMessage(type_e_mismatch);
- end;
- end;
- procedure loadansi2short(source,dest : tnode);
- var
- pushed : tpushed;
- regs_to_push: byte;
- begin
- { Find out which registers have to be pushed (JM) }
- regs_to_push := $ff;
- remove_non_regvars_from_loc(source.location,regs_to_push);
- { Push them (JM) }
- pushusedregisters(pushed,regs_to_push);
- case source.location.loc of
- LOC_REFERENCE,LOC_MEM:
- begin
- { Now release the location and registers (see cgai386.pas: }
- { loadansistring for more info on the order) (JM) }
- ungetiftemp(source.location.reference);
- del_reference(source.location.reference);
- emit_push_mem(source.location.reference);
- end;
- LOC_REGISTER,LOC_CREGISTER:
- begin
- emit_reg(A_PUSH,S_L,source.location.register);
- { Now release the register (JM) }
- ungetregister32(source.location.register);
- end;
- end;
- push_shortstring_length(dest);
- emitpushreferenceaddr(dest.location.reference);
- saveregvars($ff);
- emitcall('FPC_ANSISTR_TO_SHORTSTR');
- popusedregisters(pushed);
- maybe_loadself;
- end;
- procedure loadwide2short(source,dest : tnode);
- var
- pushed : tpushed;
- regs_to_push: byte;
- begin
- { Find out which registers have to be pushed (JM) }
- regs_to_push := $ff;
- remove_non_regvars_from_loc(source.location,regs_to_push);
- { Push them (JM) }
- pushusedregisters(pushed,regs_to_push);
- case source.location.loc of
- LOC_REFERENCE,LOC_MEM:
- begin
- { Now release the location and registers (see cgai386.pas: }
- { loadansistring for more info on the order) (JM) }
- ungetiftemp(source.location.reference);
- del_reference(source.location.reference);
- emit_push_mem(source.location.reference);
- end;
- LOC_REGISTER,LOC_CREGISTER:
- begin
- emit_reg(A_PUSH,S_L,source.location.register);
- { Now release the register (JM) }
- ungetregister32(source.location.register);
- end;
- end;
- push_shortstring_length(dest);
- emitpushreferenceaddr(dest.location.reference);
- saveregvars($ff);
- emitcall('FPC_WIDESTR_TO_SHORTSTR');
- popusedregisters(pushed);
- maybe_loadself;
- end;
- procedure loadinterfacecom(p: tbinarynode);
- {
- copies an com interface from n.right to n.left, we
- assume, that both sides are com interface, firstassignement have
- to take care of that, an com interface can't be a register variable
- }
- var
- pushed : tpushed;
- ungettemp : boolean;
- begin
- { before pushing any parameter, we have to save all used }
- { registers, but before that we have to release the }
- { registers of that node to save uneccessary pushed }
- { so be careful, if you think you can optimize that code (FK) }
- { nevertheless, this has to be changed, because otherwise the }
- { register is released before it's contents are pushed -> }
- { problems with the optimizer (JM) }
- del_reference(p.left.location.reference);
- ungettemp:=false;
- case p.right.location.loc of
- LOC_REGISTER,LOC_CREGISTER:
- begin
- pushusedregisters(pushed, $ff xor ($80 shr byte(p.right.location.register)));
- exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,p.right.location.register));
- ungetregister32(p.right.location.register);
- end;
- LOC_REFERENCE,LOC_MEM:
- begin
- pushusedregisters(pushed,$ff
- xor ($80 shr byte(p.right.location.reference.base))
- xor ($80 shr byte(p.right.location.reference.index)));
- emit_push_mem(p.right.location.reference);
- del_reference(p.right.location.reference);
- ungettemp:=true;
- end;
- end;
- emitpushreferenceaddr(p.left.location.reference);
- del_reference(p.left.location.reference);
- saveregvars($ff);
- emitcall('FPC_INTF_ASSIGN');
- maybe_loadself;
- popusedregisters(pushed);
- if ungettemp then
- ungetiftemp(p.right.location.reference);
- end;
- end.
- {
- $Log$
- Revision 1.18 2001-07-08 21:00:18 peter
- * various widestring updates, it works now mostly without charset
- mapping supported
- Revision 1.17 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.16 2001/04/18 22:02:03 peter
- * registration of targets and assemblers
- Revision 1.15 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.14 2001/04/02 21:20:39 peter
- * resulttype rewrite
- Revision 1.13 2001/03/11 22:58:52 peter
- * getsym redesign, removed the globals srsym,srsymtable
- Revision 1.12 2001/03/04 10:26:56 jonas
- * new rangecheck code now handles conversion between signed and cardinal types correctly
- Revision 1.11 2001/03/03 12:41:22 jonas
- * simplified and optimized range checking code, FPC_BOUNDCHECK is no longer necessary
- Revision 1.10 2000/12/31 11:02:12 jonas
- * optimized loadshortstring a bit
- Revision 1.9 2000/12/25 00:07:33 peter
- + new tlinkedlist class (merge of old tstringqueue,tcontainer and
- tlinkedlist objects)
- Revision 1.8 2000/12/11 19:10:19 jonas
- * fixed web bug 1144
- + implemented range checking for 64bit types
- Revision 1.7 2000/12/07 17:19:46 jonas
- * new constant handling: from now on, hex constants >$7fffffff are
- parsed as unsigned constants (otherwise, $80000000 got sign extended
- and became $ffffffff80000000), all constants in the longint range
- become longints, all constants >$7fffffff and <=cardinal($ffffffff)
- are cardinals and the rest are int64's.
- * added lots of longint typecast to prevent range check errors in the
- compiler and rtl
- * type casts of symbolic ordinal constants are now preserved
- * fixed bug where the original resulttype.def wasn't restored correctly
- after doing a 64bit rangecheck
- Revision 1.6 2000/12/05 11:44:34 jonas
- + new integer regvar handling, should be much more efficient
- Revision 1.5 2000/11/29 00:30:49 florian
- * unused units removed from uses clause
- * some changes for widestrings
- Revision 1.4 2000/11/13 14:47:46 jonas
- * support for range checking when converting from 64bit to something
- smaller (32bit, 16bit, 8bit)
- * fixed range checking between longint/cardinal and for array indexing
- with cardinal (values > $7fffffff were considered negative)
- Revision 1.3 2000/11/04 14:25:25 florian
- + merged Attila's changes for interfaces, not tested yet
- Revision 1.2 2000/10/31 22:02:57 peter
- * symtable splitted, no real code changes
- Revision 1.1 2000/10/15 09:33:32 peter
- * moved n386*.pas to i386/ cpu_target dir
- Revision 1.3 2000/10/14 21:52:54 peter
- * fixed memory leaks
- Revision 1.2 2000/10/14 10:14:50 peter
- * moehrendorf oct 2000 rewrite
- Revision 1.1 2000/10/01 19:58:40 peter
- * new file
- }
|