12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316 |
- {
- $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.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
- }
|