1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324 |
- {
- $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;
- function maybe_pushfpu(needed : byte;p : tnode) : 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 emitoverflowcheck(p:tnode);
- procedure firstcomplex(p : tbinarynode);
- implementation
- uses
- globtype,globals,systems,verbose,
- cutils,
- aasm,cpubase,cpuasm,cpuinfo,
- symconst,symbase,symdef,symsym,symtable,
- {$ifdef GDB}
- gdb,
- {$endif GDB}
- types,
- ncon,nld,
- pass_1,pass_2,
- cgbase,tgcpu,temp_gen,
- cga,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;
- function maybe_pushfpu(needed : byte;p : tnode) : boolean;
- begin
- if needed>=maxfpuregs then
- begin
- if p.location.loc = LOC_FPU then
- begin
- emit_to_mem(p.location,p.resulttype.def);
- maybe_pushfpu:=true;
- end
- else
- maybe_pushfpu:=false;
- end
- else
- maybe_pushfpu:=false;
- 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:=getregisterint;
- {$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:=getregisterint;
- {$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:=getregisterint;
- 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:=getregisterint;
- 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);
- dispose(r);
- 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
- *****************************************************************************}
- { 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;
- { 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.location.loc=LOC_FPU) and
- (p.right.registersfpu > p.left.registersfpu)) or
- ((((p.left.registersfpu = 0) and
- (p.right.registersfpu = 0)) or
- (p.location.loc<>LOC_FPU)) and
- (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.26 2002-03-04 19:10:14 peter
- * removed compiler warnings
- Revision 1.25 2001/12/30 17:24:47 jonas
- * range checking is now processor independent (part in cgobj,
- part in cg64f32) and should work correctly again (it needed
- some changes after the changes of the low and high of
- tordef's to int64)
- * maketojumpbool() is now processor independent (in ncgutil)
- * getregister32 is now called getregisterint
- Revision 1.24 2001/12/03 21:48:43 peter
- * freemem change to value parameter
- * torddef low/high range changed to int64
- Revision 1.23 2001/12/02 16:19:17 jonas
- * less unnecessary regvar loading with if-statements
- Revision 1.22 2001/10/12 13:51:52 jonas
- * fixed internalerror(10) due to previous fpu overflow fixes ("merged")
- * fixed bug in n386add (introduced after compilerproc changes for string
- operations) where calcregisters wasn't called for shortstring addnodes
- * NOTE: from now on, the location of a binary node must now always be set
- before you call calcregisters() for it
- Revision 1.21 2001/09/17 21:29:14 peter
- * merged netbsd, fpu-overflow from fixes branch
- Revision 1.20 2001/08/26 13:37:01 florian
- * some cg reorganisation
- * some PPC updates
- Revision 1.19 2001/08/24 12:22:14 jonas
- * fixed memory leak with coping of array-of-consts as valuepara
- 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
- }
|