12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190 |
- {
- $Id$
- Copyright (c) 1998-2000 by Florian Klaempfl
- Generate i386 assembler for load/assignment nodes
- 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 n386ld;
- {$i defines.inc}
- interface
- uses
- node,nld;
- type
- ti386loadnode = class(tloadnode)
- procedure pass_2;override;
- end;
- ti386assignmentnode = class(tassignmentnode)
- procedure pass_2;override;
- end;
- ti386funcretnode = class(tfuncretnode)
- procedure pass_2;override;
- end;
- ti386arrayconstructornode = class(tarrayconstructornode)
- procedure pass_2;override;
- end;
- implementation
- uses
- systems,
- verbose,globals,
- symconst,symtype,symdef,symsym,symtable,aasm,types,
- cgbase,temp_gen,pass_2,
- nmem,ncon,ncnv,
- cpubase,cpuasm,
- cga,tgcpu,n386cnv,n386util,regvars;
- {*****************************************************************************
- SecondLoad
- *****************************************************************************}
- procedure ti386loadnode.pass_2;
- var
- hregister : tregister;
- symtabletype : tsymtabletype;
- i : longint;
- hp : preference;
- s : tasmsymbol;
- popeax : boolean;
- //pushed : tpushed;
- //hr : treference;
- begin
- simple_loadn:=true;
- reset_reference(location.reference);
- case symtableentry.typ of
- { this is only for toasm and toaddr }
- absolutesym :
- begin
- location.reference.symbol:=nil;
- if (tabsolutesym(symtableentry).abstyp=toaddr) then
- begin
- if tabsolutesym(symtableentry).absseg then
- location.reference.segment:=R_FS;
- location.reference.offset:=tabsolutesym(symtableentry).address;
- end
- else
- location.reference.symbol:=newasmsymbol(tabsolutesym(symtableentry).mangledname);
- end;
- constsym:
- begin
- if tconstsym(symtableentry).consttyp=constresourcestring then
- begin
- location.loc:=LOC_MEM;
- location.reference.symbol:=newasmsymbol(tconstsym(symtableentry).owner.name^+'_RESOURCESTRINGLIST');
- location.reference.offset:=tconstsym(symtableentry).resstrindex*16+8;
- end
- else
- internalerror(22798);
- end;
- varsym :
- begin
- hregister:=R_NO;
- { C variable }
- if (vo_is_C_var in tvarsym(symtableentry).varoptions) then
- begin
- location.reference.symbol:=newasmsymbol(tvarsym(symtableentry).mangledname);
- end
- { DLL variable }
- else if (vo_is_dll_var in tvarsym(symtableentry).varoptions) then
- begin
- hregister:=getregisterint;
- location.reference.symbol:=newasmsymbol(tvarsym(symtableentry).mangledname);
- emit_ref_reg(A_MOV,S_L,newreference(location.reference),hregister);
- location.reference.symbol:=nil;
- location.reference.base:=hregister;
- end
- { external variable }
- else if (vo_is_external in tvarsym(symtableentry).varoptions) then
- begin
- location.reference.symbol:=newasmsymbol(tvarsym(symtableentry).mangledname);
- end
- { thread variable }
- else if (vo_is_thread_var in tvarsym(symtableentry).varoptions) then
- begin
- popeax:=not(R_EAX in unused);
- if popeax then
- emit_reg(A_PUSH,S_L,R_EAX);
- location.reference.symbol:=newasmsymbol(tvarsym(symtableentry).mangledname);
- emit_ref(A_PUSH,S_L,newreference(location.reference));
- { the called procedure isn't allowed to change }
- { any register except EAX }
- emitcall('FPC_RELOCATE_THREADVAR');
- reset_reference(location.reference);
- location.reference.base:=getregisterint;
- emit_reg_reg(A_MOV,S_L,R_EAX,location.reference.base);
- if popeax then
- emit_reg(A_POP,S_L,R_EAX);
- end
- { normal variable }
- else
- begin
- symtabletype:=symtable.symtabletype;
- { in case it is a register variable: }
- if tvarsym(symtableentry).reg<>R_NO then
- begin
- if tvarsym(symtableentry).reg in [R_ST0..R_ST7] then
- begin
- location.loc:=LOC_CFPUREGISTER;
- location.register:=tvarsym(symtableentry).reg;
- end
- else
- if not(makereg32(tvarsym(symtableentry).reg) in [R_EAX..R_EBX]) or
- regvar_loaded[tvarsym(symtableentry).reg] then
- begin
- location.loc:=LOC_CREGISTER;
- location.register:=tvarsym(symtableentry).reg;
- unused:=unused-[tvarsym(symtableentry).reg];
- end
- else
- begin
- load_regvar(exprasmlist,tvarsym(symtableentry));
- location.loc:=LOC_CREGISTER;
- location.register:=tvarsym(symtableentry).reg;
- unused:=unused-[tvarsym(symtableentry).reg];
- end
- end
- else
- begin
- { first handle local and temporary variables }
- if (symtabletype in [parasymtable,inlinelocalsymtable,
- inlineparasymtable,localsymtable]) then
- begin
- location.reference.base:=procinfo^.framepointer;
- if (symtabletype in [inlinelocalsymtable,
- localsymtable]) then
- location.reference.offset:=
- tvarsym(symtableentry).address-symtable.address_fixup
- else
- location.reference.offset:=
- tvarsym(symtableentry).address+symtable.address_fixup;
- if (symtabletype in [localsymtable,inlinelocalsymtable]) then
- begin
- if use_esp_stackframe then
- dec(location.reference.offset,
- tvarsym(symtableentry).getvaluesize)
- else
- location.reference.offset:=-location.reference.offset;
- end;
- if (lexlevel>(symtable.symtablelevel)) then
- begin
- hregister:=getregisterint;
- { make a reference }
- hp:=new_reference(procinfo^.framepointer,
- procinfo^.framepointer_offset);
- emit_ref_reg(A_MOV,S_L,hp,hregister);
- simple_loadn:=false;
- i:=lexlevel-1;
- while i>(symtable.symtablelevel) do
- begin
- { make a reference }
- hp:=new_reference(hregister,8);
- emit_ref_reg(A_MOV,S_L,hp,hregister);
- dec(i);
- end;
- location.reference.base:=hregister;
- end;
- end
- else
- case symtabletype of
- globalsymtable,
- staticsymtable :
- begin
- location.reference.symbol:=newasmsymbol(tvarsym(symtableentry).mangledname);
- end;
- stt_exceptsymtable:
- begin
- location.reference.base:=procinfo^.framepointer;
- location.reference.offset:=tvarsym(symtableentry).address;
- end;
- objectsymtable:
- begin
- getexplicitregister32(R_ESI);
- if (sp_static in tvarsym(symtableentry).symoptions) then
- begin
- location.reference.symbol:=newasmsymbol(tvarsym(symtableentry).mangledname);
- end
- else
- begin
- location.reference.base:=R_ESI;
- location.reference.offset:=tvarsym(symtableentry).address;
- end;
- end;
- withsymtable:
- begin
- { make a reference }
- { symtable datasize field
- contains the offset of the temp
- stored }
- { hp:=new_reference(procinfo^.framepointer,
- symtable.datasize);
- emit_ref_reg(A_MOV,S_L,hp,hregister);}
- if nf_islocal in tnode(twithsymtable(symtable).withnode).flags then
- begin
- location.reference:=twithnode(twithsymtable(symtable).withnode).withreference^;
- end
- else
- begin
- hregister:=getregisterint;
- location.reference.base:=hregister;
- emit_ref_reg(A_MOV,S_L,
- newreference(twithnode(twithsymtable(symtable).withnode).withreference^),
- hregister);
- end;
- inc(location.reference.offset,tvarsym(symtableentry).address);
- end;
- end;
- end;
- { in case call by reference, then calculate. Open array
- is always an reference! }
- if (tvarsym(symtableentry).varspez in [vs_var,vs_out]) or
- is_open_array(tvarsym(symtableentry).vartype.def) or
- is_array_of_const(tvarsym(symtableentry).vartype.def) or
- ((tvarsym(symtableentry).varspez=vs_const) and
- push_addr_param(tvarsym(symtableentry).vartype.def)) then
- begin
- simple_loadn:=false;
- if hregister=R_NO then
- hregister:=getregisterint;
- if location.loc=LOC_CREGISTER then
- begin
- emit_reg_reg(A_MOV,S_L,
- location.register,hregister);
- location.loc:=LOC_REFERENCE;
- end
- else
- begin
- emit_ref_reg(A_MOV,S_L,
- newreference(location.reference),
- hregister);
- end;
- reset_reference(location.reference);
- location.reference.base:=hregister;
- end;
- end;
- end;
- procsym:
- begin
- if assigned(left) then
- begin
- location.loc:=LOC_MEM;
- gettempofsizereference(8,location.reference);
- if left.nodetype=typen then
- begin
- if left.resulttype.def.deftype<>objectdef then
- internalerror(200103261);
- getexplicitregister32(R_EDI);
- hregister:=R_EDI;
- new(hp);
- emit_sym_ofs_reg(A_MOV,S_L,
- newasmsymbol(tobjectdef(left.resulttype.def).vmt_mangledname),0,R_EDI);
- end
- else
- begin
- secondpass(left);
- { load class instance address }
- case left.location.loc of
- LOC_CREGISTER,
- LOC_REGISTER:
- begin
- hregister:=left.location.register;
- ungetregister32(left.location.register);
- if is_object(left.resulttype.def) then
- CGMessage(cg_e_illegal_expression);
- end;
- LOC_MEM,
- LOC_REFERENCE:
- begin
- getexplicitregister32(R_EDI);
- hregister:=R_EDI;
- if is_class_or_interface(left.resulttype.def) then
- emit_ref_reg(A_MOV,S_L,
- newreference(left.location.reference),R_EDI)
- else
- emit_ref_reg(A_LEA,S_L,
- newreference(left.location.reference),R_EDI);
- del_reference(left.location.reference);
- ungetiftemp(left.location.reference);
- end;
- else internalerror(26019);
- end;
- end;
- { store the class instance address }
- new(hp);
- hp^:=location.reference;
- inc(hp^.offset,4);
- emit_reg_ref(A_MOV,S_L,
- hregister,hp);
- { virtual method ? }
- if (po_virtualmethod in tprocdef(resulttype.def).procoptions) then
- begin
- new(hp);
- reset_reference(hp^);
- hp^.base:=hregister;
- { load vmt pointer }
- emit_ref_reg(A_MOV,S_L,
- hp,R_EDI);
- {$IfDef regallocfix}
- del_reference(hp^);
- {$EndIf regallocfix}
- { load method address }
- new(hp);
- reset_reference(hp^);
- hp^.base:=R_EDI;
- hp^.offset:=tprocdef(resulttype.def)._class.vmtmethodoffset(
- tprocdef(resulttype.def).extnumber);
- emit_ref_reg(A_MOV,S_L,
- hp,R_EDI);
- { ... and store it }
- emit_reg_ref(A_MOV,S_L,
- R_EDI,newreference(location.reference));
- ungetregister32(R_EDI);
- end
- else
- begin
- ungetregister32(R_EDI);
- s:=newasmsymbol(tprocdef(resulttype.def).mangledname);
- emit_sym_ofs_ref(A_MOV,S_L,s,0,
- newreference(location.reference));
- end;
- end
- else
- begin
- {!!!!! Be aware, work on virtual methods too }
- location.reference.symbol:=newasmsymbol(tprocdef(resulttype.def).mangledname);
- end;
- end;
- typedconstsym :
- begin
- location.reference.symbol:=newasmsymbol(ttypedconstsym(symtableentry).mangledname);
- end;
- else internalerror(4);
- end;
- end;
- {*****************************************************************************
- SecondAssignment
- *****************************************************************************}
- procedure ti386assignmentnode.pass_2;
- var
- opsize : topsize;
- otlabel,hlabel,oflabel : tasmlabel;
- fputyp : tfloattype;
- loc : tloc;
- r : preference;
- ai : taicpu;
- op : tasmop;
- pushed : boolean;
- regspushed : tpushed;
- regs_to_push: byte;
- ungettemp : boolean;
- begin
- otlabel:=truelabel;
- oflabel:=falselabel;
- getlabel(truelabel);
- getlabel(falselabel);
- { calculate left sides }
- { don't do it yet if it's a crgister (JM) }
- if not(nf_concat_string in flags) then
- secondpass(left);
- if codegenerror then
- exit;
- if not(left.location.loc in [LOC_REFERENCE,LOC_CFPUREGISTER,
- LOC_CREGISTER,LOC_CMMXREGISTER]) then
- begin
- CGMessage(cg_e_illegal_expression);
- exit;
- end;
- loc:=left.location.loc;
- { lets try to optimize this (PM) }
- { define a dest_loc that is the location }
- { and a ptree to verify that it is the right }
- { place to insert it }
- {$ifdef test_dest_loc}
- if (aktexprlevel<4) then
- begin
- dest_loc_known:=true;
- dest_loc:=left.location;
- dest_loc_tree:=right;
- end;
- {$endif test_dest_loc}
- { left can't be never a 64 bit LOC_REGISTER, so the 3. arg }
- { can be false }
- pushed:=maybe_push(right.registers32,left,false);
- secondpass(right);
- { restoring here is nonsense for LOC_JMP !! }
- { This generated code that was after a jmp and before any
- label => unreachable !!
- Could this be tested somehow ?? PM }
- if pushed and (right.location.loc <>LOC_JUMP) then
- restore(left,false);
- if codegenerror then
- exit;
- {$ifdef test_dest_loc}
- dest_loc_known:=false;
- if in_dest_loc then
- begin
- truelabel:=otlabel;
- falselabel:=oflabel;
- in_dest_loc:=false;
- exit;
- end;
- {$endif test_dest_loc}
- if left.resulttype.def.deftype=stringdef then
- begin
- if is_ansistring(left.resulttype.def) or
- is_widestring(left.resulttype.def) then
- 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) }
- ungettemp:=false;
- { Find out which registers have to be pushed (JM) }
- regs_to_push := $ff;
- remove_non_regvars_from_loc(right.location,regs_to_push);
- remove_non_regvars_from_loc(left.location,regs_to_push);
- { And push them (JM) }
- pushusedregisters(regspushed,regs_to_push);
- case right.location.loc of
- LOC_REGISTER,LOC_CREGISTER:
- begin
- exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,right.location.register));
- ungetregister32(right.location.register);
- end;
- LOC_REFERENCE,LOC_MEM:
- begin
- { First release the registers because emit_push_mem may }
- { load the reference in edi before pushing and then the }
- { dealloc is too late (and optimizations are missed (JM) }
- del_reference(right.location.reference);
- { This one doesn't need extra registers (JM) }
- emit_push_mem(right.location.reference);
- ungettemp:=true;
- end;
- end;
- emitpushreferenceaddr(left.location.reference);
- del_reference(left.location.reference);
- saveregvars($ff);
- if is_ansistring(left.resulttype.def) then
- emitcall('FPC_ANSISTR_ASSIGN')
- else
- emitcall('FPC_WIDESTR_ASSIGN');
- maybe_loadself;
- popusedregisters(regspushed);
- if ungettemp then
- ungetiftemp(right.location.reference);
- end
- else
- if is_shortstring(left.resulttype.def) and
- not (nf_concat_string in flags) then
- begin
- if is_ansistring(right.resulttype.def) then
- begin
- if (right.nodetype=stringconstn) and
- (tstringconstnode(right).len=0) then
- begin
- emit_const_ref(A_MOV,S_B,
- 0,newreference(left.location.reference));
- del_reference(left.location.reference);
- end
- else
- loadansi2short(right,left);
- end
- else
- begin
- { we do not need destination anymore }
- del_reference(left.location.reference);
- {del_reference(right.location.reference);
- done in loadshortstring }
- loadshortstring(right,left);
- ungetiftemp(right.location.reference);
- end;
- end
- else if is_longstring(left.resulttype.def) then
- begin
- internalerror(200105261);
- end
- else
- begin
- { its the only thing we have to do }
- del_reference(right.location.reference);
- end
- end
- else if is_interfacecom(left.resulttype.def) then
- begin
- loadinterfacecom(self);
- end
- else case right.location.loc of
- LOC_REFERENCE,
- LOC_MEM : begin
- { extra handling for ordinal constants }
- if (right.nodetype in [ordconstn,pointerconstn,niln]) or
- (loc=LOC_CREGISTER) then
- begin
- case left.resulttype.def.size of
- 1 : opsize:=S_B;
- 2 : opsize:=S_W;
- 4 : opsize:=S_L;
- { S_L is correct, the copy is done }
- { with two moves }
- 8 : opsize:=S_L;
- end;
- if loc=LOC_CREGISTER then
- begin
- emit_ref_reg(A_MOV,opsize,
- newreference(right.location.reference),
- left.location.register);
- if left.resulttype.def.size=8 then
- begin
- r:=newreference(right.location.reference);
- inc(r^.offset,4);
- emit_ref_reg(A_MOV,opsize,r,
- left.location.registerhigh);
- end;
- {$IfDef regallocfix}
- del_reference(right.location.reference);
- {$EndIf regallocfix}
- end
- else
- begin
- if left.resulttype.def.size=8 then
- begin
- emit_const_ref(A_MOV,opsize,
- longint(lo(tordconstnode(right).value)),
- newreference(left.location.reference));
- r:=newreference(left.location.reference);
- inc(r^.offset,4);
- emit_const_ref(A_MOV,opsize,
- longint(hi(tordconstnode(right).value)),r);
- end
- else
- begin
- emit_const_ref(A_MOV,opsize,
- right.location.reference.offset,
- newreference(left.location.reference));
- end;
- {$IfDef regallocfix}
- del_reference(left.location.reference);
- {$EndIf regallocfix}
- {emit_const_loc(A_MOV,opsize,
- right.location.reference.offset,
- left.location);}
- end;
- end
- else if loc=LOC_CFPUREGISTER then
- begin
- floatloadops(tfloatdef(right.resulttype.def).typ,op,opsize);
- emit_ref(op,opsize,
- newreference(right.location.reference));
- emit_reg(A_FSTP,S_NO,
- correct_fpuregister(left.location.register,fpuvaroffset+1));
- end
- else
- begin
- if (right.resulttype.def.needs_inittable) then
- begin
- { this would be a problem }
- if not(left.resulttype.def.needs_inittable) then
- internalerror(3457);
- { increment source reference counter }
- new(r);
- reset_reference(r^);
- r^.symbol:=tstoreddef(right.resulttype.def).get_rtti_label(initrtti);
- emitpushreferenceaddr(r^);
- emitpushreferenceaddr(right.location.reference);
- emitcall('FPC_ADDREF');
- { decrement destination reference counter }
- new(r);
- reset_reference(r^);
- r^.symbol:=tstoreddef(left.resulttype.def).get_rtti_label(initrtti);
- emitpushreferenceaddr(r^);
- emitpushreferenceaddr(left.location.reference);
- emitcall('FPC_DECREF');
- end;
- concatcopy(right.location.reference,
- left.location.reference,left.resulttype.def.size,true,false);
- del_reference(left.location.reference);
- { done by concatcopy
- del_reference(right.location.reference);
- ungetiftemp(right.location.reference); }
- end;
- end;
- {$ifdef SUPPORT_MMX}
- LOC_CMMXREGISTER,
- LOC_MMXREGISTER:
- begin
- if loc=LOC_CMMXREGISTER then
- emit_reg_reg(A_MOVQ,S_NO,
- right.location.register,left.location.register)
- else
- emit_reg_ref(A_MOVQ,S_NO,
- right.location.register,newreference(left.location.reference));
- end;
- {$endif SUPPORT_MMX}
- LOC_REGISTER,
- LOC_CREGISTER : begin
- case right.resulttype.def.size of
- 1 : opsize:=S_B;
- 2 : opsize:=S_W;
- 4 : opsize:=S_L;
- 8 : opsize:=S_L;
- end;
- { simplified with op_reg_loc }
- if loc=LOC_CREGISTER then
- begin
- emit_reg_reg(A_MOV,opsize,
- right.location.register,
- left.location.register);
- ungetregister(right.location.register);
- end
- else
- Begin
- emit_reg_ref(A_MOV,opsize,
- right.location.register,
- newreference(left.location.reference));
- ungetregister(right.location.register);
- {$IfDef regallocfix}
- del_reference(left.location.reference);
- {$EndIf regallocfix}
- end;
- if is_64bitint(right.resulttype.def) then
- begin
- { simplified with op_reg_loc }
- if loc=LOC_CREGISTER then
- emit_reg_reg(A_MOV,opsize,
- right.location.registerhigh,
- left.location.registerhigh)
- else
- begin
- r:=newreference(left.location.reference);
- inc(r^.offset,4);
- emit_reg_ref(A_MOV,opsize,
- right.location.registerhigh,r);
- end;
- end;
- {emit_reg_loc(A_MOV,opsize,
- right.location.register,
- left.location); }
- end;
- LOC_FPU : begin
- if (left.resulttype.def.deftype=floatdef) then
- fputyp:=tfloatdef(left.resulttype.def).typ
- else
- if (right.resulttype.def.deftype=floatdef) then
- fputyp:=tfloatdef(right.resulttype.def).typ
- else
- if (right.nodetype=typeconvn) and
- (ttypeconvnode(right).left.resulttype.def.deftype=floatdef) then
- fputyp:=tfloatdef(ttypeconvnode(right).left.resulttype.def).typ
- else
- fputyp:=s32real;
- case loc of
- LOC_CFPUREGISTER:
- begin
- emit_reg(A_FSTP,S_NO,
- correct_fpuregister(left.location.register,fpuvaroffset));
- dec(fpuvaroffset);
- end;
- LOC_REFERENCE:
- floatstore(fputyp,left.location.reference);
- else
- internalerror(48991);
- end;
- end;
- LOC_CFPUREGISTER: begin
- if (left.resulttype.def.deftype=floatdef) then
- fputyp:=tfloatdef(left.resulttype.def).typ
- else
- if (right.resulttype.def.deftype=floatdef) then
- fputyp:=tfloatdef(right.resulttype.def).typ
- else
- if (right.nodetype=typeconvn) and
- (ttypeconvnode(right).left.resulttype.def.deftype=floatdef) then
- fputyp:=tfloatdef(ttypeconvnode(right).left.resulttype.def).typ
- else
- fputyp:=s32real;
- emit_reg(A_FLD,S_NO,
- correct_fpuregister(right.location.register,fpuvaroffset));
- inc(fpuvaroffset);
- case loc of
- LOC_CFPUREGISTER:
- begin
- emit_reg(A_FSTP,S_NO,
- correct_fpuregister(right.location.register,fpuvaroffset));
- dec(fpuvaroffset);
- end;
- LOC_REFERENCE:
- floatstore(fputyp,left.location.reference);
- else
- internalerror(48992);
- end;
- end;
- LOC_JUMP : begin
- opsize:=def_opsize(left.resulttype.def);
- getlabel(hlabel);
- emitlab(truelabel);
- if pushed then
- restore(left,false);
- if loc=LOC_CREGISTER then
- emit_const_reg(A_MOV,opsize,
- 1,left.location.register)
- else
- emit_const_ref(A_MOV,opsize,
- 1,newreference(left.location.reference));
- emitjmp(C_None,hlabel);
- emitlab(falselabel);
- if pushed then
- restore(left,false);
- if loc=LOC_CREGISTER then
- emit_reg_reg(A_XOR,opsize,
- left.location.register,
- left.location.register)
- else
- begin
- emit_const_ref(A_MOV,opsize,
- 0,newreference(left.location.reference));
- {$IfDef regallocfix}
- del_reference(left.location.reference);
- {$EndIf regallocfix}
- end;
- emitlab(hlabel);
- end;
- LOC_FLAGS : begin
- if loc=LOC_CREGISTER then
- emit_flag2reg(right.location.resflags,left.location.register)
- else
- begin
- ai:=Taicpu.Op_ref(A_Setcc,S_B,newreference(left.location.reference));
- ai.SetCondition(flags_to_cond(right.location.resflags));
- exprasmList.concat(ai);
- end;
- {$IfDef regallocfix}
- del_reference(left.location.reference);
- {$EndIf regallocfix}
- end;
- end;
- truelabel:=otlabel;
- falselabel:=oflabel;
- end;
- {*****************************************************************************
- SecondFuncRet
- *****************************************************************************}
- procedure ti386funcretnode.pass_2;
- var
- hr : tregister;
- hp : preference;
- pp : pprocinfo;
- hr_valid : boolean;
- i : integer;
- begin
- reset_reference(location.reference);
- hr_valid:=false;
- if (not inlining_procedure) and
- (lexlevel<>funcretsym.owner.symtablelevel) then
- begin
- hr:=getregisterint;
- hr_valid:=true;
- hp:=new_reference(procinfo^.framepointer,procinfo^.framepointer_offset);
- emit_ref_reg(A_MOV,S_L,hp,hr);
- { walk up the stack frame }
- pp:=procinfo^.parent;
- i:=lexlevel-1;
- while i>funcretsym.owner.symtablelevel do
- begin
- hp:=new_reference(hr,pp^.framepointer_offset);
- emit_ref_reg(A_MOV,S_L,hp,hr);
- pp:=pp^.parent;
- dec(i);
- end;
- location.reference.base:=hr;
- location.reference.offset:=pp^.return_offset;
- end
- else
- begin
- location.reference.base:=procinfo^.framepointer;
- location.reference.offset:=procinfo^.return_offset;
- end;
- if ret_in_param(resulttype.def) then
- begin
- if not hr_valid then
- hr:=getregisterint;
- emit_ref_reg(A_MOV,S_L,newreference(location.reference),hr);
- location.reference.base:=hr;
- location.reference.offset:=0;
- end;
- end;
- {*****************************************************************************
- SecondArrayConstruct
- *****************************************************************************}
- const
- vtInteger = 0;
- vtBoolean = 1;
- vtChar = 2;
- vtExtended = 3;
- vtString = 4;
- vtPointer = 5;
- vtPChar = 6;
- vtObject = 7;
- vtClass = 8;
- vtWideChar = 9;
- vtPWideChar = 10;
- vtAnsiString = 11;
- vtCurrency = 12;
- vtVariant = 13;
- vtInterface = 14;
- vtWideString = 15;
- vtInt64 = 16;
- vtQWord = 17;
- procedure ti386arrayconstructornode.pass_2;
- var
- hp : tarrayconstructornode;
- href : treference;
- lt : tdef;
- vaddr : boolean;
- vtype : longint;
- freetemp,
- dovariant : boolean;
- elesize : longint;
- begin
- dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
- if dovariant then
- elesize:=8
- else
- elesize:=tarraydef(resulttype.def).elesize;
- if not(nf_cargs in flags) then
- begin
- reset_reference(location.reference);
- { Allocate always a temp, also if no elements are required, to
- be sure that location is valid (PFV) }
- if tarraydef(resulttype.def).highrange=-1 then
- gettempofsizereference(elesize,location.reference)
- else
- gettempofsizereference((tarraydef(resulttype.def).highrange+1)*elesize,location.reference);
- href:=location.reference;
- end;
- hp:=self;
- while assigned(hp) do
- begin
- if assigned(hp.left) then
- begin
- freetemp:=true;
- secondpass(hp.left);
- if codegenerror then
- exit;
- if dovariant then
- begin
- { find the correct vtype value }
- vtype:=$ff;
- vaddr:=false;
- lt:=hp.left.resulttype.def;
- case lt.deftype of
- enumdef,
- orddef :
- begin
- if is_64bitint(lt) then
- begin
- case torddef(lt).typ of
- s64bit:
- vtype:=vtInt64;
- u64bit:
- vtype:=vtQWord;
- end;
- freetemp:=false;
- vaddr:=true;
- end
- else if (lt.deftype=enumdef) or
- is_integer(lt) then
- vtype:=vtInteger
- else
- if is_boolean(lt) then
- vtype:=vtBoolean
- else
- if (lt.deftype=orddef) and (torddef(lt).typ=uchar) then
- vtype:=vtChar;
- end;
- floatdef :
- begin
- vtype:=vtExtended;
- vaddr:=true;
- freetemp:=false;
- end;
- procvardef,
- pointerdef :
- begin
- if is_pchar(lt) then
- vtype:=vtPChar
- else
- vtype:=vtPointer;
- end;
- classrefdef :
- vtype:=vtClass;
- objectdef :
- begin
- vtype:=vtObject;
- end;
- stringdef :
- begin
- if is_shortstring(lt) then
- begin
- vtype:=vtString;
- vaddr:=true;
- freetemp:=false;
- end
- else
- if is_ansistring(lt) then
- begin
- vtype:=vtAnsiString;
- freetemp:=false;
- end
- else
- if is_widestring(lt) then
- begin
- vtype:=vtWideString;
- freetemp:=false;
- end;
- end;
- end;
- if vtype=$ff then
- internalerror(14357);
- { write C style pushes or an pascal array }
- if nf_cargs in flags then
- begin
- if vaddr then
- begin
- emit_to_mem(hp.left.location,hp.left.resulttype.def);
- emit_push_lea_loc(hp.left.location,freetemp);
- del_reference(hp.left.location.reference);
- end
- else
- emit_push_loc(hp.left.location);
- inc(pushedparasize,4);
- end
- else
- begin
- { write changing field update href to the next element }
- inc(href.offset,4);
- if vaddr then
- begin
- emit_to_mem(hp.left.location,hp.left.resulttype.def);
- emit_lea_loc_ref(hp.left.location,href,freetemp);
- end
- else
- begin
- emit_mov_loc_ref(hp.left.location,href,S_L,freetemp);
- end;
- { update href to the vtype field and write it }
- dec(href.offset,4);
- emit_const_ref(A_MOV,S_L,vtype,newreference(href));
- { goto next array element }
- inc(href.offset,8);
- end;
- end
- else
- { normal array constructor of the same type }
- begin
- case elesize of
- 1 :
- emit_mov_loc_ref(hp.left.location,href,S_B,freetemp);
- 2 :
- emit_mov_loc_ref(hp.left.location,href,S_W,freetemp);
- 4 :
- emit_mov_loc_ref(hp.left.location,href,S_L,freetemp);
- 8 :
- begin
- if hp.left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
- begin
- emit_reg_ref(A_MOV,S_L,hp.left.location.registerlow,newreference(href));
- { update href to the high bytes and write it }
- inc(href.offset,4);
- emit_reg_ref(A_MOV,S_L,hp.left.location.registerhigh,newreference(href));
- dec(href.offset,4)
- end
- else
- concatcopy(hp.left.location.reference,href,elesize,freetemp,false);
- end;
- else
- begin
- { concatcopy only supports reference }
- if not(hp.left.location.loc in [LOC_MEM,LOC_REFERENCE]) then
- internalerror(200108012);
- concatcopy(hp.left.location.reference,href,elesize,freetemp,false);
- end;
- end;
- inc(href.offset,elesize);
- end;
- end;
- { load next entry }
- hp:=tarrayconstructornode(hp.right);
- end;
- end;
- begin
- cloadnode:=ti386loadnode;
- cassignmentnode:=ti386assignmentnode;
- cfuncretnode:=ti386funcretnode;
- carrayconstructornode:=ti386arrayconstructornode;
- end.
- {
- $Log$
- Revision 1.28 2001-12-30 17:24:46 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.27 2001/12/17 23:16:05 florian
- * array of const can now take widestring parameters as well
- Revision 1.26 2001/11/02 22:58:11 peter
- * procsym definition rewrite
- Revision 1.25 2001/10/28 17:22:25 peter
- * allow assignment of overloaded procedures to procvars when we know
- which procedure to take
- Revision 1.24 2001/10/14 11:49:51 jonas
- * finetuned register allocation info for assignments
- Revision 1.23 2001/10/04 14:33:28 jonas
- * fixed range check errors
- Revision 1.22 2001/09/09 08:51:09 jonas
- * fixed bug with assigning ansistrings (left^.location was released too
- early, caused bug reported by Aleksey V. Vaneev in mailing list on
- 2001/09/07 regarding 'problems with nested procedures and local vars'
- ("merged" from cga.pas in the fixes branch)
- Revision 1.21 2001/08/30 20:13:57 peter
- * rtti/init table updates
- * rttisym for reusable global rtti/init info
- * support published for interfaces
- Revision 1.20 2001/08/30 11:57:20 michael
- + Patch for wrong paramsize
- Revision 1.19 2001/08/26 13:36:59 florian
- * some cg reorganisation
- * some PPC updates
- Revision 1.18 2001/08/06 21:40:50 peter
- * funcret moved from tprocinfo to tprocdef
- Revision 1.17 2001/08/05 13:19:51 peter
- * partly fix for proc of obj=nil
- Revision 1.15 2001/07/28 15:13:17 peter
- * fixed opsize for assignment with LOC_JUMP
- Revision 1.14 2001/05/27 14:30:56 florian
- + some widestring stuff added
- Revision 1.13 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.12 2001/04/02 21:20:37 peter
- * resulttype rewrite
- Revision 1.11 2000/12/25 00:07:33 peter
- + new tlinkedlist class (merge of old tstringqueue,tcontainer and
- tlinkedlist objects)
- Revision 1.10 2000/12/05 11:44:33 jonas
- + new integer regvar handling, should be much more efficient
- Revision 1.9 2000/11/29 00:30:48 florian
- * unused units removed from uses clause
- * some changes for widestrings
- Revision 1.8 2000/11/13 14:44:36 jonas
- * fixes so no more range errors with improved range checking code
- Revision 1.7 2000/11/12 23:24:15 florian
- * interfaces are basically running
- Revision 1.6 2000/11/11 22:59:20 florian
- * fixed resourcestrings, made a stupid mistake yesterday
- Revision 1.5 2000/11/09 18:52:06 florian
- * resourcestrings doesn't need the helper anymore they
- access the table now direct
- Revision 1.4 2000/11/06 23:15:02 peter
- * added copyvaluepara call again
- Revision 1.3 2000/11/04 14:25:23 florian
- + merged Attila's changes for interfaces, not tested yet
- Revision 1.2 2000/10/31 22:02:56 peter
- * symtable splitted, no real code changes
- Revision 1.1 2000/10/15 09:33:31 peter
- * moved n386*.pas to i386/ cpu_target dir
- Revision 1.1 2000/10/14 10:14:49 peter
- * moehrendorf oct 2000 rewrite
- }
|