{ $Id$ Copyright (c) 1993-98 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 cg386ld; interface uses tree; procedure secondload(var p : ptree); procedure secondassignment(var p : ptree); procedure secondfuncret(var p : ptree); procedure secondarrayconstruct(var p : ptree); implementation uses globtype,systems, cobjects,verbose,globals,files, symconst,symtable,aasm,types, hcodegen,temp_gen,pass_2, cpubase,cpuasm, cgai386,tgeni386,cg386cnv,cresstr; {***************************************************************************** SecondLoad *****************************************************************************} procedure secondload(var p : ptree); var hregister : tregister; symtabletype : tsymtabletype; i : longint; hp : preference; s : pasmsymbol; popeax : boolean; pushed : tpushed; hr : treference; begin simple_loadn:=true; reset_reference(p^.location.reference); case p^.symtableentry^.typ of { this is only for toasm and toaddr } absolutesym : begin p^.location.reference.symbol:=nil; if (pabsolutesym(p^.symtableentry)^.abstyp=toaddr) then begin if pabsolutesym(p^.symtableentry)^.absseg then p^.location.reference.segment:=R_FS; p^.location.reference.offset:=pabsolutesym(p^.symtableentry)^.address; end else p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname); end; constsym: begin if pconstsym(p^.symtableentry)^.consttype=constresourcestring then begin pushusedregisters(pushed,$ff); emit_const(A_PUSH,S_L, pconstsym(p^.symtableentry)^.resstrindex); emit_sym(A_PUSH,S_L,newasmsymbol(pconstsym(p^.symtableentry)^.owner^.name^+'_RESOURCESTRINGLIST')); emitcall('FPC_GETRESOURCESTRING'); hregister:=getexplicitregister32(R_EAX); emit_reg_reg(A_MOV,S_L,R_EAX,hregister); gettempansistringreference(hr); decrstringref(p^.resulttype,hr); emit_reg_ref(A_MOV,S_L,hregister, newreference(hr)); ungetregister32(hregister); popusedregisters(pushed); p^.location.loc:=LOC_MEM; p^.location.reference:=hr; end else internalerror(22798); end; varsym : begin hregister:=R_NO; { C variable } if (vo_is_C_var in pvarsym(p^.symtableentry)^.varoptions) then begin p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname); end { DLL variable } else if (vo_is_dll_var in pvarsym(p^.symtableentry)^.varoptions) then begin hregister:=getregister32; p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname); emit_ref_reg(A_MOV,S_L,newreference(p^.location.reference),hregister); p^.location.reference.symbol:=nil; p^.location.reference.base:=hregister; end { external variable } else if (vo_is_external in pvarsym(p^.symtableentry)^.varoptions) then begin p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname); end { thread variable } else if (vo_is_thread_var in pvarsym(p^.symtableentry)^.varoptions) then begin popeax:=not(R_EAX in unused); if popeax then emit_reg(A_PUSH,S_L,R_EAX); p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname); emit_ref(A_PUSH,S_L,newreference(p^.location.reference)); { the called procedure isn't allowed to change } { any register except EAX } emitcall('FPC_RELOCATE_THREADVAR'); reset_reference(p^.location.reference); p^.location.reference.base:=getregister32; emit_reg_reg(A_MOV,S_L,R_EAX,p^.location.reference.base); if popeax then emit_reg(A_POP,S_L,R_EAX); end { normal variable } else begin symtabletype:=p^.symtable^.symtabletype; { in case it is a register variable: } if pvarsym(p^.symtableentry)^.reg<>R_NO then begin if pvarsym(p^.symtableentry)^.reg in [R_ST0..R_ST7] then begin p^.location.loc:=LOC_CFPUREGISTER; p^.location.register:=pvarsym(p^.symtableentry)^.reg; end else begin p^.location.loc:=LOC_CREGISTER; p^.location.register:=pvarsym(p^.symtableentry)^.reg; unused:=unused-[pvarsym(p^.symtableentry)^.reg]; end; end else begin { first handle local and temporary variables } if (symtabletype in [parasymtable,inlinelocalsymtable, inlineparasymtable,localsymtable]) then begin p^.location.reference.base:=procinfo^.framepointer; p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address+p^.symtable^.address_fixup; if (symtabletype in [localsymtable,inlinelocalsymtable]) then begin if use_esp_stackframe then dec(p^.location.reference.offset, pvarsym(p^.symtableentry)^.getsize) else p^.location.reference.offset:=-p^.location.reference.offset; end; if (lexlevel>(p^.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>(p^.symtable^.symtablelevel) do begin { make a reference } hp:=new_reference(hregister,8); emit_ref_reg(A_MOV,S_L,hp,hregister); dec(i); end; p^.location.reference.base:=hregister; end; end else case symtabletype of unitsymtable,globalsymtable, staticsymtable : begin p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname); end; stt_exceptsymtable: begin p^.location.reference.base:=procinfo^.framepointer; p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address; end; objectsymtable: begin if (sp_static in pvarsym(p^.symtableentry)^.symoptions) then begin p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname); end else begin p^.location.reference.base:=R_ESI; p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address; end; end; withsymtable: begin { make a reference } { symtable datasize field contains the offset of the temp stored } { hp:=new_reference(procinfo^.framepointer, p^.symtable^.datasize); emit_ref_reg(A_MOV,S_L,hp,hregister);} if ptree(pwithsymtable(p^.symtable)^.withnode)^.islocal then begin p^.location.reference:=ptree(pwithsymtable(p^.symtable)^.withnode)^.withreference^; end else begin hregister:=getregister32; p^.location.reference.base:=hregister; emit_ref_reg(A_MOV,S_L, newreference(ptree(pwithsymtable(p^.symtable)^.withnode)^.withreference^), hregister); end; inc(p^.location.reference.offset,pvarsym(p^.symtableentry)^.address); end; end; end; { in case call by reference, then calculate. Open array is always an reference! } if (pvarsym(p^.symtableentry)^.varspez=vs_var) or is_open_array(pvarsym(p^.symtableentry)^.definition) or is_array_of_const(pvarsym(p^.symtableentry)^.definition) or ((pvarsym(p^.symtableentry)^.varspez=vs_const) and push_addr_param(pvarsym(p^.symtableentry)^.definition)) then begin simple_loadn:=false; if hregister=R_NO then hregister:=getregister32; if p^.location.loc=LOC_CREGISTER then begin emit_reg_reg(A_MOV,S_L, p^.location.register,hregister); p^.location.loc:=LOC_REFERENCE; end else begin emit_ref_reg(A_MOV,S_L, newreference(p^.location.reference), hregister); end; reset_reference(p^.location.reference); p^.location.reference.base:=hregister; end; end; end; procsym: begin if assigned(p^.left) then begin secondpass(p^.left); p^.location.loc:=LOC_MEM; gettempofsizereference(8,p^.location.reference); { load class instance address } case p^.left^.location.loc of LOC_CREGISTER, LOC_REGISTER: begin hregister:=p^.left^.location.register; ungetregister32(p^.left^.location.register); if not(pobjectdef(p^.left^.resulttype)^.is_class) then CGMessage(cg_e_illegal_expression); end; LOC_MEM, LOC_REFERENCE: begin hregister:=R_EDI; if pobjectdef(p^.left^.resulttype)^.is_class then emit_ref_reg(A_MOV,S_L, newreference(p^.left^.location.reference),R_EDI) else emit_ref_reg(A_LEA,S_L, newreference(p^.left^.location.reference),R_EDI); del_reference(p^.left^.location.reference); ungetiftemp(p^.left^.location.reference); end; else internalerror(26019); end; { store the class instance address } new(hp); hp^:=p^.location.reference; inc(hp^.offset,4); emit_reg_ref(A_MOV,S_L, hregister,hp); { virtual method ? } if (po_virtualmethod in pprocsym(p^.symtableentry)^.definition^.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:=pprocsym(p^.symtableentry)^.definition^._class^.vmtmethodoffset( pprocsym(p^.symtableentry)^.definition^.extnumber); emit_ref_reg(A_MOV,S_L, hp,R_EDI); { ... and store it } emit_reg_ref(A_MOV,S_L, R_EDI,newreference(p^.location.reference)); end else begin s:=newasmsymbol(pprocsym(p^.symtableentry)^.definition^.mangledname); emit_sym_ofs_ref(A_MOV,S_L,s,0, newreference(p^.location.reference)); end; end else begin {!!!!! Be aware, work on virtual methods too } p^.location.reference.symbol:=newasmsymbol(pprocsym(p^.symtableentry)^.definition^.mangledname); end; end; typedconstsym : begin p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname); end; else internalerror(4); end; end; {***************************************************************************** SecondAssignment *****************************************************************************} procedure secondassignment(var p : ptree); var opsize : topsize; otlabel,hlabel,oflabel : pasmlabel; fputyp : tfloattype; loc : tloc; r : preference; ai : paicpu; op : tasmop; pushed : boolean; begin otlabel:=truelabel; oflabel:=falselabel; getlabel(truelabel); getlabel(falselabel); { calculate left sides } if not(p^.concat_string) then secondpass(p^.left); if codegenerror then exit; {$ifdef dummy} { we use now the standard mechanism via maybe_push/restore to do that (FK) } case p^.left^.location.loc of LOC_REFERENCE : begin { in case left operator uses to register } { but to few are free then LEA } if (p^.left^.location.reference.base<>R_NO) and (p^.left^.location.reference.index<>R_NO) and (usablereg32objectdef) or not(pobjectdef(p^.right^.resulttype)^.is_class)) then begin { this would be a problem } if not(p^.left^.resulttype^.needs_inittable) then internalerror(3457); { increment source reference counter } new(r); reset_reference(r^); r^.symbol:=p^.right^.resulttype^.get_inittable_label; emitpushreferenceaddr(r^); emitpushreferenceaddr(p^.right^.location.reference); emitcall('FPC_ADDREF'); { decrement destination reference counter } new(r); reset_reference(r^); r^.symbol:=p^.left^.resulttype^.get_inittable_label; emitpushreferenceaddr(r^); emitpushreferenceaddr(p^.left^.location.reference); emitcall('FPC_DECREF'); end; {$ifdef regallocfix} concatcopy(p^.right^.location.reference, p^.left^.location.reference,p^.left^.resulttype^.size,true,false); ungetiftemp(p^.right^.location.reference); {$Else regallocfix} concatcopy(p^.right^.location.reference, p^.left^.location.reference,p^.left^.resulttype^.size,false,false); ungetiftemp(p^.right^.location.reference); {$endif regallocfix} end; end; {$ifdef SUPPORT_MMX} LOC_CMMXREGISTER, LOC_MMXREGISTER: begin if loc=LOC_CMMXREGISTER then emit_reg_reg(A_MOVQ,S_NO, p^.right^.location.register,p^.left^.location.register) else emit_reg_ref(A_MOVQ,S_NO, p^.right^.location.register,newreference(p^.left^.location.reference)); end; {$endif SUPPORT_MMX} LOC_REGISTER, LOC_CREGISTER : begin case p^.right^.resulttype^.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, p^.right^.location.register, p^.left^.location.register); {$IfDef regallocfix} ungetregister(p^.right^.location.register); {$EndIf regallocfix} end else Begin emit_reg_ref(A_MOV,opsize, p^.right^.location.register, newreference(p^.left^.location.reference)); {$IfDef regallocfix} ungetregister(p^.right^.location.register); del_reference(p^.left^.location.reference); {$EndIf regallocfix} end; if is_64bitint(p^.right^.resulttype) then begin { simplified with op_reg_loc } if loc=LOC_CREGISTER then emit_reg_reg(A_MOV,opsize, p^.right^.location.registerhigh, p^.left^.location.registerhigh) else begin r:=newreference(p^.left^.location.reference); inc(r^.offset,4); emit_reg_ref(A_MOV,opsize, p^.right^.location.registerhigh,r); end; end; {emit_reg_loc(A_MOV,opsize, p^.right^.location.register, p^.left^.location); } end; LOC_FPU : begin if (p^.left^.resulttype^.deftype=floatdef) then fputyp:=pfloatdef(p^.left^.resulttype)^.typ else if (p^.right^.resulttype^.deftype=floatdef) then fputyp:=pfloatdef(p^.right^.resulttype)^.typ else if (p^.right^.treetype=typeconvn) and (p^.right^.left^.resulttype^.deftype=floatdef) then fputyp:=pfloatdef(p^.right^.left^.resulttype)^.typ else fputyp:=s32real; case loc of LOC_CFPUREGISTER: begin emit_reg(A_FSTP,S_NO, correct_fpuregister(p^.left^.location.register,fpuvaroffset)); dec(fpuvaroffset); end; LOC_REFERENCE: floatstore(fputyp,p^.left^.location.reference); else internalerror(48991); end; end; LOC_CFPUREGISTER: begin if (p^.left^.resulttype^.deftype=floatdef) then fputyp:=pfloatdef(p^.left^.resulttype)^.typ else if (p^.right^.resulttype^.deftype=floatdef) then fputyp:=pfloatdef(p^.right^.resulttype)^.typ else if (p^.right^.treetype=typeconvn) and (p^.right^.left^.resulttype^.deftype=floatdef) then fputyp:=pfloatdef(p^.right^.left^.resulttype)^.typ else fputyp:=s32real; emit_reg(A_FLD,S_NO, correct_fpuregister(p^.right^.location.register,fpuvaroffset)); inc(fpuvaroffset); case loc of LOC_CFPUREGISTER: begin emit_reg(A_FSTP,S_NO, correct_fpuregister(p^.right^.location.register,fpuvaroffset)); dec(fpuvaroffset); end; LOC_REFERENCE: floatstore(fputyp,p^.left^.location.reference); else internalerror(48992); end; end; LOC_JUMP : begin getlabel(hlabel); emitlab(truelabel); if loc=LOC_CREGISTER then emit_const_reg(A_MOV,S_B, 1,p^.left^.location.register) else emit_const_ref(A_MOV,S_B, 1,newreference(p^.left^.location.reference)); {emit_const_loc(A_MOV,S_B, 1,p^.left^.location);} emitjmp(C_None,hlabel); emitlab(falselabel); if loc=LOC_CREGISTER then emit_reg_reg(A_XOR,S_B, p^.left^.location.register, p^.left^.location.register) else begin emit_const_ref(A_MOV,S_B, 0,newreference(p^.left^.location.reference)); {$IfDef regallocfix} del_reference(p^.left^.location.reference); {$EndIf regallocfix} end; emitlab(hlabel); end; LOC_FLAGS : begin if loc=LOC_CREGISTER then emit_flag2reg(p^.right^.location.resflags,p^.left^.location.register) else begin ai:=new(paicpu,op_ref(A_Setcc,S_B,newreference(p^.left^.location.reference))); ai^.SetCondition(flag_2_cond[p^.right^.location.resflags]); exprasmlist^.concat(ai); end; {$IfDef regallocfix} del_reference(p^.left^.location.reference); {$EndIf regallocfix} end; end; freelabel(truelabel); freelabel(falselabel); truelabel:=otlabel; falselabel:=oflabel; end; {***************************************************************************** SecondFuncRet *****************************************************************************} procedure secondfuncret(var p : ptree); var hr : tregister; hp : preference; pp : pprocinfo; hr_valid : boolean; begin reset_reference(p^.location.reference); hr_valid:=false; if procinfo<>pprocinfo(p^.funcretprocinfo) then begin hr:=getregister32; hr_valid:=true; hp:=new_reference(procinfo^.framepointer, procinfo^.framepointer_offset); emit_ref_reg(A_MOV,S_L,hp,hr); pp:=procinfo^.parent; { walk up the stack frame } while pp<>pprocinfo(p^.funcretprocinfo) do begin hp:=new_reference(hr, pp^.framepointer_offset); emit_ref_reg(A_MOV,S_L,hp,hr); pp:=pp^.parent; end; p^.location.reference.base:=hr; p^.location.reference.offset:=pp^.retoffset; end else begin p^.location.reference.base:=procinfo^.framepointer; p^.location.reference.offset:=procinfo^.retoffset; end; if ret_in_param(p^.retdef) then begin if not hr_valid then hr:=getregister32; emit_ref_reg(A_MOV,S_L,newreference(p^.location.reference),hr); p^.location.reference.base:=hr; p^.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; procedure secondarrayconstruct(var p : ptree); var hp : ptree; href : treference; lt : pdef; vaddr : boolean; vtype : longint; freetemp, dovariant : boolean; elesize : longint; begin dovariant:=p^.forcevaria or parraydef(p^.resulttype)^.isvariant; if dovariant then elesize:=8 else begin elesize:=parraydef(p^.resulttype)^.elesize; if elesize>4 then internalerror(8765678); end; if not p^.cargs then begin reset_reference(p^.location.reference); { Allocate always a temp, also if no elements are required, to be sure that location is valid (PFV) } if parraydef(p^.resulttype)^.highrange=-1 then gettempofsizereference(elesize,p^.location.reference) else gettempofsizereference((parraydef(p^.resulttype)^.highrange+1)*elesize,p^.location.reference); href:=p^.location.reference; end; hp:=p; 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; case lt^.deftype of enumdef, orddef : begin 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 (porddef(lt)^.typ=uchar) then vtype:=vtChar; end; floatdef : begin vtype:=vtExtended; vaddr:=true; 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 vtype:=vtAnsiString; end; end; if vtype=$ff then internalerror(14357); { write C style pushes or an pascal array } if p^.cargs then begin if vaddr then begin emit_to_mem(hp^.left); emit_push_lea_loc(hp^.left^.location,freetemp); del_reference(hp^.left^.location.reference); end else emit_push_loc(hp^.left^.location); end else begin { update href to the vtype field and write it } emit_const_ref(A_MOV,S_L, vtype,newreference(href)); inc(href.offset,4); { write changing field update href to the next element } if vaddr then begin emit_to_mem(hp^.left); emit_lea_loc_ref(hp^.left^.location,href,freetemp); end else emit_mov_loc_ref(hp^.left^.location,href,S_L); inc(href.offset,4); 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); 2 : emit_mov_loc_ref(hp^.left^.location,href,S_W); 4 : emit_mov_loc_ref(hp^.left^.location,href,S_L); else internalerror(87656781); end; inc(href.offset,elesize); end; end; { load next entry } hp:=hp^.right; end; end; end. { $Log$ Revision 1.90 1999-11-06 14:34:18 peter * truncated log to 20 revs Revision 1.89 1999/10/12 22:35:48 florian * compiler didn't complain about l1+l2:=l1+l2; it gave only an assembler error, fixed Revision 1.88 1999/09/27 23:44:47 peter * procinfo is now a pointer * support for result setting in sub procedure Revision 1.87 1999/09/26 13:26:06 florian * exception patch of Romio nevertheless the excpetion handling needs some corections regarding register saving * gettempansistring is again a procedure Revision 1.86 1999/09/16 07:56:46 pierre * double del_reference removed Revision 1.85 1999/09/12 08:48:03 florian * bugs 593 and 607 fixed * some other potential bugs with array constructors fixed * for classes compiled in $M+ and it's childs, the default access method is now published * fixed copyright message (it is now 1993-99) Revision 1.84 1999/09/11 09:08:31 florian * fixed bug 596 * fixed some problems with procedure variables and procedures of object, especially in TP mode. Procedure of object doesn't apply only to classes, it is also allowed for objects !! Revision 1.83 1999/09/01 09:37:14 peter * removed warning Revision 1.82 1999/09/01 09:26:21 peter * fixed temp allocation for arrayconstructor Revision 1.81 1999/08/28 15:34:17 florian * bug 519 fixed Revision 1.80 1999/08/26 20:24:37 michael + Hopefuly last fixes for resourcestrings Revision 1.79 1999/08/25 16:41:05 peter * resources are working again Revision 1.78 1999/08/25 11:59:43 jonas * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu) Revision 1.77 1999/08/24 22:38:51 michael * more resourcestring changes Revision 1.76 1999/08/23 11:45:39 michael * Hopefully final attempt at resourcestrings Revision 1.75 1999/08/19 13:08:49 pierre * emit_??? used Revision 1.74 1999/08/17 13:26:06 peter * arrayconstructor -> arrayofconst fixed when arraycosntructor was not variant. Revision 1.73 1999/08/13 21:33:09 peter * support for array constructors extended and more error checking Revision 1.72 1999/08/09 22:19:50 peter * classes vmt changed to only positive addresses * sharedlib creation is working Revision 1.71 1999/08/07 14:20:55 florian * some small problems fixed Revision 1.70 1999/08/04 13:45:22 florian + floating point register variables !! * pairegalloc is now generated for register variables }