12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178 |
- {
- $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:=getregister32;
- 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:=getregister32;
- 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:=getregister32;
- { 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:=getregister32;
- 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:=getregister32;
- 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(flag_2_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:=getregister32;
- 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:=getregister32;
- 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;
- 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.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
- }
|