{ $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 cgai386; {$i defines.inc} interface uses cobjects, cpubase,cpuasm, symconst,symtype,symdef,aasm; {$define TESTGETTEMP to store const that are written into temps for later release PM } function def_opsize(p1:pdef):topsize; function def2def_opsize(p1,p2:pdef):topsize; function def_getreg(p1:pdef):tregister; function makereg8(r:tregister):tregister; function makereg16(r:tregister):tregister; function makereg32(r:tregister):tregister; procedure locflags2reg(var l:tlocation;opsize:topsize); procedure locjump2reg(var l:tlocation;opsize:topsize; otl, ofl: pasmlabel); procedure emitlab(var l : pasmlabel); procedure emitjmp(c : tasmcond;var l : pasmlabel); procedure emit_flag2reg(flag:tresflags;hregister:tregister); procedure emit_none(i : tasmop;s : topsize); procedure emit_const(i : tasmop;s : topsize;c : longint); procedure emit_reg(i : tasmop;s : topsize;reg : tregister); procedure emit_ref(i : tasmop;s : topsize;ref : preference); procedure emit_const_reg(i : tasmop;s : topsize;c : longint;reg : tregister); procedure emit_const_ref(i : tasmop;s : topsize;c : longint;ref : preference); procedure emit_ref_reg(i : tasmop;s : topsize;ref : preference;reg : tregister); procedure emit_reg_ref(i : tasmop;s : topsize;reg : tregister;ref : preference); procedure emit_reg_reg(i : tasmop;s : topsize;reg1,reg2 : tregister); procedure emit_const_reg_reg(i : tasmop;s : topsize;c : longint;reg1,reg2 : tregister); procedure emit_reg_reg_reg(i : tasmop;s : topsize;reg1,reg2,reg3 : tregister); procedure emit_sym(i : tasmop;s : topsize;op : pasmsymbol); procedure emit_sym_ofs(i : tasmop;s : topsize;op : pasmsymbol;ofs : longint); procedure emit_sym_ofs_reg(i : tasmop;s : topsize;op : pasmsymbol;ofs:longint;reg : tregister); procedure emit_sym_ofs_ref(i : tasmop;s : topsize;op : pasmsymbol;ofs:longint;ref : preference); procedure emitcall(const routine:string); procedure emit_mov_loc_ref(const t:tlocation;const ref:treference;siz:topsize;freetemp:boolean); procedure emit_mov_loc_reg(const t:tlocation;reg:tregister); procedure emit_mov_ref_reg64(r : treference;rl,rh : tregister); procedure emit_lea_loc_ref(const t:tlocation;const ref:treference;freetemp:boolean); procedure emit_lea_loc_reg(const t:tlocation;reg:tregister;freetemp:boolean); procedure emit_push_loc(const t:tlocation); procedure emit_push_mem_size(const t: treference; size: longint); { pushes qword location to the stack } procedure emit_pushq_loc(const t : tlocation); procedure release_qword_loc(const t : tlocation); { remove non regvar registers in loc from regs (in the format } { pushusedregisters uses) } procedure remove_non_regvars_from_loc(const t: tlocation; var regs: byte); { releases the registers of a location } procedure release_loc(const t : tlocation); procedure emit_pushw_loc(const t:tlocation); procedure emit_push_lea_loc(const t:tlocation;freetemp:boolean); procedure emit_to_mem(var t:tlocation;def:pdef); procedure emit_to_reg16(var hr:tregister); procedure emit_to_reg32(var hr:tregister); procedure emit_mov_reg_loc(reg: TRegister; const t:tlocation); procedure emit_movq_reg_loc(reghigh,reglow: TRegister;t:tlocation); procedure copyshortstring(const dref,sref : treference;len : byte; loadref, del_sref: boolean); procedure finalize(t : pdef;const ref : treference;is_already_ref : boolean); procedure incrstringref(t : pdef;const ref : treference); procedure decrstringref(t : pdef;const ref : treference); procedure push_int(l : longint); procedure emit_push_mem(const ref : treference); procedure emitpushreferenceaddr(const ref : treference); procedure incrcomintfref(t: pdef; const ref: treference); procedure decrcomintfref(t: pdef; const ref: treference); procedure floatload(t : tfloattype;const ref : treference); procedure floatstore(t : tfloattype;const ref : treference); procedure floatloadops(t : tfloattype;var op : tasmop;var s : topsize); procedure floatstoreops(t : tfloattype;var op : tasmop;var s : topsize); procedure maybe_loadesi; procedure emitloadord2reg(const location:Tlocation;orddef:Porddef;destreg:Tregister;delloc:boolean); procedure concatcopy(source,dest : treference;size : longint;delsource : boolean;loadref:boolean); procedure genentrycode(alist : TAAsmoutput;make_global:boolean; stackframe:longint; var parasize:longint;var nostackframe:boolean; inlined : boolean); procedure genexitcode(alist : TAAsmoutput;parasize:longint; nostackframe,inlined:boolean); { if a unit doesn't have a explicit init/final code, } { we've to generate one, if the units has ansistrings } { in the interface or implementation } procedure genimplicitunitfinal(alist : TAAsmoutput); procedure genimplicitunitinit(alist : TAAsmoutput); {$ifdef test_dest_loc} const { used to avoid temporary assignments } dest_loc_known : boolean = false; in_dest_loc : boolean = false; dest_loc_tree : ptree = nil; var dest_loc : tlocation; procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister); {$endif test_dest_loc} implementation uses {$ifdef delphi} sysutils, {$else} strings, {$endif} cutils, globtype,systems,globals,verbose, fmodule, symbase,symsym,symtable,types, tgcpu,temp_gen,hcodegen,regvars {$ifdef GDB} ,gdb {$endif} {$ifndef NOTARGETWIN32} ,t_win32 {$endif} ; {***************************************************************************** Helpers *****************************************************************************} function def_opsize(p1:pdef):topsize; begin case p1^.size of 1 : def_opsize:=S_B; 2 : def_opsize:=S_W; 4 : def_opsize:=S_L; else internalerror(130820001); end; end; function def2def_opsize(p1,p2:pdef):topsize; var o1 : topsize; begin case p1^.size of 1 : o1:=S_B; 2 : o1:=S_W; 4 : o1:=S_L; { I don't know if we need it (FK) } 8 : o1:=S_L; else internalerror(130820002); end; if assigned(p2) then begin case p2^.size of 1 : o1:=S_B; 2 : begin if o1=S_B then o1:=S_BW else o1:=S_W; end; 4,8: begin case o1 of S_B : o1:=S_BL; S_W : o1:=S_WL; end; end; end; end; def2def_opsize:=o1; end; function def_getreg(p1:pdef):tregister; begin case p1^.size of 1 : def_getreg:=reg32toreg8(getregister32); 2 : def_getreg:=reg32toreg16(getregister32); 4 : def_getreg:=getregister32; else internalerror(130820003); end; end; function makereg8(r:tregister):tregister; begin case r of R_EAX,R_EBX,R_ECX,R_EDX,R_EDI,R_ESI,R_ESP : makereg8:=reg32toreg8(r); R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP : makereg8:=reg16toreg8(r); R_AL,R_BL,R_CL,R_DL : makereg8:=r; end; end; function makereg16(r:tregister):tregister; begin case r of R_EAX,R_EBX,R_ECX,R_EDX,R_EDI,R_ESI,R_ESP : makereg16:=reg32toreg16(r); R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP : makereg16:=r; R_AL,R_BL,R_CL,R_DL : makereg16:=reg8toreg16(r); end; end; function makereg32(r:tregister):tregister; begin case r of R_EAX,R_EBX,R_ECX,R_EDX,R_EDI,R_ESI,R_ESP : makereg32:=r; R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP : makereg32:=reg16toreg32(r); R_AL,R_BL,R_CL,R_DL : makereg32:=reg8toreg32(r); end; end; procedure locflags2reg(var l:tlocation;opsize:topsize); var hregister : tregister; begin if (l.loc=LOC_FLAGS) then begin hregister:=getregister32; case opsize of S_W : hregister:=reg32toreg16(hregister); S_B : hregister:=reg32toreg8(hregister); end; emit_flag2reg(l.resflags,hregister); l.loc:=LOC_REGISTER; l.register:=hregister; end else internalerror(270720001); end; procedure locjump2reg(var l:tlocation;opsize:topsize; otl, ofl: pasmlabel); var hregister : tregister; hl : pasmlabel; begin if l.loc = LOC_JUMP then begin hregister:=getregister32; case opsize of S_W : hregister:=reg32toreg16(hregister); S_B : hregister:=reg32toreg8(hregister); end; l.loc:=LOC_REGISTER; l.register:=hregister; emitlab(truelabel); truelabel:=otl; emit_const_reg(A_MOV,opsize,1,hregister); getlabel(hl); emitjmp(C_None,hl); emitlab(falselabel); falselabel:=ofl; emit_reg_reg(A_XOR,S_L,makereg32(hregister), makereg32(hregister)); emitlab(hl); end else internalerror(270720002); end; {***************************************************************************** Emit Assembler *****************************************************************************} procedure emitlab(var l : pasmlabel); begin if not l^.is_set then exprasmList.concat(Tai_label.Create(l)) else internalerror(7453984); end; procedure emitjmp(c : tasmcond;var l : pasmlabel); var ai : taicpu; begin if c=C_None then ai := Taicpu.Op_sym(A_JMP,S_NO,l) else begin ai:=Taicpu.Op_sym(A_Jcc,S_NO,l); ai.SetCondition(c); end; ai.is_jmp:=true; exprasmList.concat(ai); end; procedure emit_flag2reg(flag:tresflags;hregister:tregister); var ai : taicpu; hreg : tregister; begin hreg:=makereg8(hregister); ai:=Taicpu.Op_reg(A_Setcc,S_B,hreg); ai.SetCondition(flag_2_cond[flag]); exprasmList.concat(ai); if hreg<>hregister then begin if hregister in regset16bit then emit_to_reg16(hreg) else emit_to_reg32(hreg); end; end; procedure emit_none(i : tasmop;s : topsize); begin exprasmList.concat(Taicpu.Op_none(i,s)); end; procedure emit_reg(i : tasmop;s : topsize;reg : tregister); begin exprasmList.concat(Taicpu.Op_reg(i,s,reg)); end; procedure emit_ref(i : tasmop;s : topsize;ref : preference); begin exprasmList.concat(Taicpu.Op_ref(i,s,ref)); end; procedure emit_const(i : tasmop;s : topsize;c : longint); begin exprasmList.concat(Taicpu.Op_const(i,s,c)); end; procedure emit_const_reg(i : tasmop;s : topsize;c : longint;reg : tregister); begin exprasmList.concat(Taicpu.Op_const_reg(i,s,c,reg)); end; procedure emit_const_ref(i : tasmop;s : topsize;c : longint;ref : preference); begin exprasmList.concat(Taicpu.Op_const_ref(i,s,c,ref)); end; procedure emit_ref_reg(i : tasmop;s : topsize;ref : preference;reg : tregister); begin exprasmList.concat(Taicpu.Op_ref_reg(i,s,ref,reg)); end; procedure emit_reg_ref(i : tasmop;s : topsize;reg : tregister;ref : preference); begin exprasmList.concat(Taicpu.Op_reg_ref(i,s,reg,ref)); end; procedure emit_reg_reg(i : tasmop;s : topsize;reg1,reg2 : tregister); begin if (reg1<>reg2) or (i<>A_MOV) then exprasmList.concat(Taicpu.Op_reg_reg(i,s,reg1,reg2)); end; procedure emit_const_reg_reg(i : tasmop;s : topsize;c : longint;reg1,reg2 : tregister); begin exprasmList.concat(Taicpu.Op_const_reg_reg(i,s,c,reg1,reg2)); end; procedure emit_reg_reg_reg(i : tasmop;s : topsize;reg1,reg2,reg3 : tregister); begin exprasmList.concat(Taicpu.Op_reg_reg_reg(i,s,reg1,reg2,reg3)); end; procedure emit_sym(i : tasmop;s : topsize;op : pasmsymbol); begin exprasmList.concat(Taicpu.Op_sym(i,s,op)); end; procedure emit_sym_ofs(i : tasmop;s : topsize;op : pasmsymbol;ofs : longint); begin exprasmList.concat(Taicpu.Op_sym_ofs(i,s,op,ofs)); end; procedure emit_sym_ofs_reg(i : tasmop;s : topsize;op : pasmsymbol;ofs:longint;reg : tregister); begin exprasmList.concat(Taicpu.Op_sym_ofs_reg(i,s,op,ofs,reg)); end; procedure emit_sym_ofs_ref(i : tasmop;s : topsize;op : pasmsymbol;ofs:longint;ref : preference); begin exprasmList.concat(Taicpu.Op_sym_ofs_ref(i,s,op,ofs,ref)); end; procedure emitcall(const routine:string); begin exprasmList.concat(Taicpu.Op_sym(A_CALL,S_NO,newasmsymbol(routine))); end; { only usefull in startup code } procedure emitinsertcall(const routine:string); begin exprasmList.insert(Taicpu.Op_sym(A_CALL,S_NO,newasmsymbol(routine))); end; procedure emit_mov_loc_ref(const t:tlocation;const ref:treference;siz:topsize;freetemp:boolean); var hreg : tregister; pushedeax : boolean; begin pushedeax:=false; case t.loc of LOC_REGISTER, LOC_CREGISTER : begin exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,siz, t.register,newreference(ref))); ungetregister32(t.register); { the register is not needed anymore } end; LOC_MEM, LOC_REFERENCE : begin if t.reference.is_immediate then emit_const_ref(A_MOV,siz, t.reference.offset,newreference(ref)) else begin case siz of S_B : begin { we can't do a getregister in the code generator } { without problems!!! } if usablereg32>0 then hreg:=reg32toreg8(getregister32) else begin emit_reg(A_PUSH,S_L,R_EAX); pushedeax:=true; hreg:=R_AL; end; end; S_W : hreg:=R_DI; S_L : hreg:=R_EDI; end; if hreg in [R_DI,R_EDI] then getexplicitregister32(R_EDI); emit_ref_reg(A_MOV,siz, newreference(t.reference),hreg); del_reference(t.reference); exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,siz, hreg,newreference(ref))); if siz=S_B then begin if pushedeax then emit_reg(A_POP,S_L,R_EAX) else ungetregister(hreg); end; if hreg in [R_DI,R_EDI] then ungetregister32(R_EDI); { we can release the registers } { but only AFTER the MOV! Important for the optimizer! (JM)} del_reference(ref); end; if freetemp then ungetiftemp(t.reference); end; else internalerror(330); end; end; procedure emit_mov_loc_reg(const t:tlocation;reg:tregister); begin case t.loc of LOC_REGISTER, LOC_CREGISTER : begin emit_reg_reg(A_MOV,S_L,t.register,reg); ungetregister32(t.register); { the register is not needed anymore } end; LOC_MEM, LOC_REFERENCE : begin if t.reference.is_immediate then emit_const_reg(A_MOV,S_L, t.reference.offset,reg) else begin emit_ref_reg(A_MOV,S_L, newreference(t.reference),reg); end; end; else internalerror(330); end; end; procedure emit_mov_reg_loc(reg: TRegister; const t:tlocation); begin case t.loc of LOC_REGISTER, LOC_CREGISTER : begin emit_reg_reg(A_MOV,RegSize(Reg), reg,t.register); end; LOC_MEM, LOC_REFERENCE : begin if t.reference.is_immediate then internalerror(334) else begin exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,RegSize(Reg), Reg,newreference(t.reference))); end; end; else internalerror(330); end; end; procedure emit_lea_loc_reg(const t:tlocation;reg:tregister;freetemp:boolean); begin case t.loc of LOC_MEM, LOC_REFERENCE : begin if t.reference.is_immediate then internalerror(331) else begin emit_ref_reg(A_LEA,S_L, newreference(t.reference),reg); end; if freetemp then ungetiftemp(t.reference); end; else internalerror(332); end; end; procedure emit_movq_reg_loc(reghigh,reglow: TRegister;t:tlocation); begin case t.loc of LOC_REGISTER, LOC_CREGISTER : begin emit_reg_reg(A_MOV,S_L, reglow,t.registerlow); emit_reg_reg(A_MOV,S_L, reghigh,t.registerhigh); end; LOC_MEM, LOC_REFERENCE : begin if t.reference.is_immediate then internalerror(334) else begin exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L, Reglow,newreference(t.reference))); inc(t.reference.offset,4); exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L, Reghigh,newreference(t.reference))); end; end; else internalerror(330); end; end; procedure emit_pushq_loc(const t : tlocation); var hr : preference; begin case t.loc of LOC_REGISTER, LOC_CREGISTER: begin exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L, t.registerhigh)); exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L, t.registerlow)); end; LOC_MEM, LOC_REFERENCE: begin hr:=newreference(t.reference); inc(hr^.offset,4); exprasmList.concat(Taicpu.Op_ref(A_PUSH,S_L, hr)); exprasmList.concat(Taicpu.Op_ref(A_PUSH,S_L, newreference(t.reference))); ungetiftemp(t.reference); end; else internalerror(331); end; end; procedure remove_non_regvars_from_loc(const t: tlocation; var regs: byte); begin case t.loc of LOC_REGISTER: { can't be a regvar, since it would be LOC_CREGISTER then } regs := regs and not($80 shr byte(t.register)); LOC_MEM,LOC_REFERENCE: begin if not(cs_regalloc in aktglobalswitches) or (t.reference.base in usableregs) then regs := regs and not($80 shr byte(t.reference.base)); if not(cs_regalloc in aktglobalswitches) or (t.reference.index in usableregs) then regs := regs and not($80 shr byte(t.reference.index)); end; end; end; procedure release_loc(const t : tlocation); begin case t.loc of LOC_REGISTER, LOC_CREGISTER: begin ungetregister32(t.register); end; LOC_MEM, LOC_REFERENCE: del_reference(t.reference); else internalerror(332); end; end; procedure release_qword_loc(const t : tlocation); begin case t.loc of LOC_REGISTER, LOC_CREGISTER: begin ungetregister32(t.registerhigh); ungetregister32(t.registerlow); end; LOC_MEM, LOC_REFERENCE: del_reference(t.reference); else internalerror(331); end; end; procedure emit_push_loc(const t:tlocation); begin case t.loc of LOC_REGISTER, LOC_CREGISTER : begin exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,makereg32(t.register))); ungetregister(t.register); { the register is not needed anymore } end; LOC_MEM, LOC_REFERENCE : begin if t.reference.is_immediate then exprasmList.concat(Taicpu.Op_const(A_PUSH,S_L,t.reference.offset)) else exprasmList.concat(Taicpu.Op_ref(A_PUSH,S_L,newreference(t.reference))); del_reference(t.reference); ungetiftemp(t.reference); end; else internalerror(330); end; end; procedure emit_pushw_loc(const t:tlocation); var opsize : topsize; begin case t.loc of LOC_REGISTER, LOC_CREGISTER : begin if target_os.stackalignment=4 then exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,makereg32(t.register))) else exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_W,makereg16(t.register))); ungetregister(t.register); { the register is not needed anymore } end; LOC_MEM, LOC_REFERENCE : begin if target_os.stackalignment=4 then opsize:=S_L else opsize:=S_W; if t.reference.is_immediate then exprasmList.concat(Taicpu.Op_const(A_PUSH,opsize,t.reference.offset)) else exprasmList.concat(Taicpu.Op_ref(A_PUSH,opsize,newreference(t.reference))); del_reference(t.reference); ungetiftemp(t.reference); end; else internalerror(330); end; end; procedure emit_lea_loc_ref(const t:tlocation;const ref:treference;freetemp:boolean); begin case t.loc of LOC_MEM, LOC_REFERENCE : begin if t.reference.is_immediate then internalerror(331) else begin getexplicitregister32(R_EDI); emit_ref_reg(A_LEA,S_L, newreference(t.reference),R_EDI); exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L, R_EDI,newreference(ref))); ungetregister32(R_EDI); end; { release the registers } del_reference(t.reference); if freetemp then ungetiftemp(t.reference); end; else internalerror(332); end; end; procedure emit_push_lea_loc(const t:tlocation;freetemp:boolean); begin case t.loc of LOC_MEM, LOC_REFERENCE : begin if t.reference.is_immediate then internalerror(331) else begin getexplicitregister32(R_EDI); emit_ref_reg(A_LEA,S_L, newreference(t.reference),R_EDI); exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,R_EDI)); ungetregister32(R_EDI); end; if freetemp then ungetiftemp(t.reference); end; else internalerror(332); end; end; procedure emit_push_mem_size(const t: treference; size: longint); var s: topsize; begin if t.is_immediate then begin if (size=4) or (target_os.stackalignment=4) then exprasmList.concat(Taicpu.Op_const(A_PUSH,S_L,t.offset)) else exprasmList.concat(Taicpu.Op_const(A_PUSH,S_W,t.offset)); end else if size < 4 then begin getexplicitregister32(R_EDI); case size of 1: s := S_BL; 2: s := S_WL; else internalerror(200008071); end; exprasmList.concat(Taicpu.Op_ref_reg(A_MOVZX,s, newreference(t),R_EDI)); if target_os.stackalignment=4 then exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,R_EDI)) else exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_W,R_DI)); ungetregister32(R_EDI); end else if size = 4 then emit_push_mem(t) else internalerror(200008072); end; procedure emit_to_mem(var t:tlocation;def:pdef); var r : treference; begin case t.loc of LOC_FPU : begin reset_reference(t.reference); gettempofsizereference(10,t.reference); floatstore(pfloatdef(def)^.typ,t.reference); end; LOC_REGISTER: begin if is_64bitint(def) then begin gettempofsizereference(8,r); emit_reg_ref(A_MOV,S_L,t.registerlow,newreference(r)); inc(r.offset,4); emit_reg_ref(A_MOV,S_L,t.registerhigh,newreference(r)); dec(r.offset,4); t.reference:=r; end else internalerror(1405001); end; LOC_MEM, LOC_REFERENCE : ; LOC_CFPUREGISTER : begin emit_reg(A_FLD,S_NO,correct_fpuregister(t.register,fpuvaroffset)); inc(fpuvaroffset); reset_reference(t.reference); gettempofsizereference(10,t.reference); floatstore(pfloatdef(def)^.typ,t.reference); end; else internalerror(333); end; t.loc:=LOC_MEM; end; procedure emit_to_reg16(var hr:tregister); begin { ranges are a little bit bug sensitive ! } case hr of R_EAX,R_EBX,R_ECX,R_EDX,R_EDI,R_ESI,R_ESP,R_EBP: begin hr:=reg32toreg16(hr); end; R_AL,R_BL,R_CL,R_DL: begin hr:=reg8toreg16(hr); emit_const_reg(A_AND,S_W,$ff,hr); end; R_AH,R_BH,R_CH,R_DH: begin hr:=reg8toreg16(hr); emit_const_reg(A_AND,S_W,$ff00,hr); end; end; end; procedure emit_to_reg32(var hr:tregister); begin { ranges are a little bit bug sensitive ! } case hr of R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP,R_BP: begin hr:=reg16toreg32(hr); emit_const_reg(A_AND,S_L,$ffff,hr); end; R_AL,R_BL,R_CL,R_DL: begin hr:=reg8toreg32(hr); emit_const_reg(A_AND,S_L,$ff,hr); end; R_AH,R_BH,R_CH,R_DH: begin hr:=reg8toreg32(hr); emit_const_reg(A_AND,S_L,$ff00,hr); end; end; end; procedure emit_mov_ref_reg64(r : treference;rl,rh : tregister); var hr : preference; begin { if we load a 64 bit reference, we must be careful because } { we could overwrite the registers of the reference by } { accident } getexplicitregister32(R_EDI); if r.base=rl then begin emit_reg_reg(A_MOV,S_L,r.base, R_EDI); r.base:=R_EDI; end else if r.index=rl then begin emit_reg_reg(A_MOV,S_L,r.index, R_EDI); r.index:=R_EDI; end; emit_ref_reg(A_MOV,S_L, newreference(r),rl); hr:=newreference(r); inc(hr^.offset,4); emit_ref_reg(A_MOV,S_L, hr,rh); ungetregister32(R_EDI); end; {***************************************************************************** Emit String Functions *****************************************************************************} procedure incrcomintfref(t: pdef; const ref: treference); var pushedregs : tpushed; begin pushusedregisters(pushedregs,$ff); emit_ref(A_PUSH,S_L,newreference(ref)); saveregvars($ff); if is_interfacecom(t) then emitcall('FPC_INTF_INCR_REF') else internalerror(1859); popusedregisters(pushedregs); end; procedure decrcomintfref(t: pdef; const ref: treference); var pushedregs : tpushed; begin pushusedregisters(pushedregs,$ff); emitpushreferenceaddr(ref); saveregvars($ff); if is_interfacecom(t) then begin emitcall('FPC_INTF_DECR_REF'); end else internalerror(1859); popusedregisters(pushedregs); end; procedure copyshortstring(const dref,sref : treference;len : byte; loadref, del_sref: boolean); begin emitpushreferenceaddr(dref); { if it's deleted right before it's used, the optimizer can move } { the reg deallocations to the right places (JM) } if del_sref then del_reference(sref); if loadref then emit_push_mem(sref) else emitpushreferenceaddr(sref); push_int(len); emitcall('FPC_SHORTSTR_COPY'); maybe_loadesi; end; procedure copylongstring(const dref,sref : treference;len : longint;loadref:boolean); begin emitpushreferenceaddr(dref); if loadref then emit_push_mem(sref) else emitpushreferenceaddr(sref); push_int(len); saveregvars($ff); emitcall('FPC_LONGSTR_COPY'); maybe_loadesi; end; procedure incrstringref(t : pdef;const ref : treference); var pushedregs : tpushed; begin pushusedregisters(pushedregs,$ff); emitpushreferenceaddr(ref); saveregvars($ff); if is_ansistring(t) then begin emitcall('FPC_ANSISTR_INCR_REF'); end else if is_widestring(t) then begin emitcall('FPC_WIDESTR_INCR_REF'); end else internalerror(1859); popusedregisters(pushedregs); end; procedure decrstringref(t : pdef;const ref : treference); var pushedregs : tpushed; begin pushusedregisters(pushedregs,$ff); emitpushreferenceaddr(ref); saveregvars($ff); if is_ansistring(t) then begin emitcall('FPC_ANSISTR_DECR_REF'); end else if is_widestring(t) then begin emitcall('FPC_WIDESTR_DECR_REF'); end else internalerror(1859); popusedregisters(pushedregs); end; {***************************************************************************** Emit Push Functions *****************************************************************************} procedure push_int(l : longint); begin if (l = 0) and not(aktoptprocessor in [Class386, ClassP6]) and not(cs_littlesize in aktglobalswitches) Then begin getexplicitregister32(R_EDI); emit_reg_reg(A_XOR,S_L,R_EDI,R_EDI); exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,R_EDI)); ungetregister32(R_EDI); end else exprasmList.concat(Taicpu.Op_const(A_PUSH,S_L,l)); end; procedure emit_push_mem(const ref : treference); begin if ref.is_immediate then push_int(ref.offset) else begin if not(aktoptprocessor in [Class386, ClassP6]) and not(cs_littlesize in aktglobalswitches) then begin getexplicitregister32(R_EDI); emit_ref_reg(A_MOV,S_L,newreference(ref),R_EDI); exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,R_EDI)); ungetregister32(R_EDI); end else exprasmList.concat(Taicpu.Op_ref(A_PUSH,S_L,newreference(ref))); end; end; procedure emitpushreferenceaddr(const ref : treference); var href : treference; begin { this will fail for references to other segments !!! } if ref.is_immediate then { is this right ? } begin { push_int(ref.offset)} gettempofsizereference(4,href); emit_const_ref(A_MOV,S_L,ref.offset,newreference(href)); emitpushreferenceaddr(href); del_reference(href); end else begin if ref.segment<>R_NO then CGMessage(cg_e_cant_use_far_pointer_there); if (ref.base=R_NO) and (ref.index=R_NO) then exprasmList.concat(Taicpu.Op_sym_ofs(A_PUSH,S_L,ref.symbol,ref.offset)) else if (ref.base=R_NO) and (ref.index<>R_NO) and (ref.offset=0) and (ref.scalefactor=0) and (ref.symbol=nil) then exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,ref.index)) else if (ref.base<>R_NO) and (ref.index=R_NO) and (ref.offset=0) and (ref.symbol=nil) then exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,ref.base)) else begin getexplicitregister32(R_EDI); emit_ref_reg(A_LEA,S_L,newreference(ref),R_EDI); exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,R_EDI)); ungetregister32(R_EDI); end; end; end; {***************************************************************************** Emit Float Functions *****************************************************************************} procedure floatloadops(t : tfloattype;var op : tasmop;var s : topsize); begin case t of s32real : begin op:=A_FLD; s:=S_FS; end; s64real : begin op:=A_FLD; { ???? } s:=S_FL; end; s80real : begin op:=A_FLD; s:=S_FX; end; s64comp : begin op:=A_FILD; s:=S_IQ; end; else internalerror(17); end; end; procedure floatload(t : tfloattype;const ref : treference); var op : tasmop; s : topsize; begin floatloadops(t,op,s); exprasmList.concat(Taicpu.Op_ref(op,s, newreference(ref))); inc(fpuvaroffset); end; procedure floatstoreops(t : tfloattype;var op : tasmop;var s : topsize); begin case t of s32real : begin op:=A_FSTP; s:=S_FS; end; s64real : begin op:=A_FSTP; s:=S_FL; end; s80real : begin op:=A_FSTP; s:=S_FX; end; s64comp : begin op:=A_FISTP; s:=S_IQ; end; else internalerror(17); end; end; procedure floatstore(t : tfloattype;const ref : treference); var op : tasmop; s : topsize; begin floatstoreops(t,op,s); exprasmList.concat(Taicpu.Op_ref(op,s, newreference(ref))); dec(fpuvaroffset); end; {***************************************************************************** Emit Functions *****************************************************************************} procedure concatcopy(source,dest : treference;size : longint;delsource,loadref : boolean); const isizes : array[0..3] of topsize=(S_L,S_B,S_W,S_B); ishr : array[0..3] of byte=(2,0,1,0); var ecxpushed : boolean; helpsize : longint; i : byte; reg8,reg32 : tregister; swap : boolean; procedure maybepushecx; begin if not(R_ECX in unused) then begin exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,R_ECX)); ecxpushed:=true; end else getexplicitregister32(R_ECX); end; begin {$IfNDef regallocfix} If delsource then del_reference(source); {$EndIf regallocfix} if (not loadref) and ((size<=8) or (not(cs_littlesize in aktglobalswitches ) and (size<=12))) then begin helpsize:=size shr 2; getexplicitregister32(R_EDI); for i:=1 to helpsize do begin emit_ref_reg(A_MOV,S_L,newreference(source),R_EDI); {$ifdef regallocfix} If (size = 4) and delsource then del_reference(source); {$endif regallocfix} exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,newreference(dest))); inc(source.offset,4); inc(dest.offset,4); dec(size,4); end; if size>1 then begin emit_ref_reg(A_MOV,S_W,newreference(source),R_DI); {$ifdef regallocfix} If (size = 2) and delsource then del_reference(source); {$endif regallocfix} exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_W,R_DI,newreference(dest))); inc(source.offset,2); inc(dest.offset,2); dec(size,2); end; ungetregister32(R_EDI); if size>0 then begin { and now look for an 8 bit register } swap:=false; if R_EAX in unused then reg8:=reg32toreg8(getexplicitregister32(R_EAX)) else if R_EDX in unused then reg8:=reg32toreg8(getexplicitregister32(R_EDX)) else if R_EBX in unused then reg8:=reg32toreg8(getexplicitregister32(R_EBX)) else if R_ECX in unused then reg8:=reg32toreg8(getexplicitregister32(R_ECX)) else begin swap:=true; { we need only to check 3 registers, because } { one is always not index or base } if (dest.base<>R_EAX) and (dest.index<>R_EAX) then begin reg8:=R_AL; reg32:=R_EAX; end else if (dest.base<>R_EBX) and (dest.index<>R_EBX) then begin reg8:=R_BL; reg32:=R_EBX; end else if (dest.base<>R_ECX) and (dest.index<>R_ECX) then begin reg8:=R_CL; reg32:=R_ECX; end; end; if swap then { was earlier XCHG, of course nonsense } begin getexplicitregister32(R_EDI); emit_reg_reg(A_MOV,S_L,reg32,R_EDI); end; emit_ref_reg(A_MOV,S_B,newreference(source),reg8); {$ifdef regallocfix} If delsource then del_reference(source); {$endif regallocfix} exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_B,reg8,newreference(dest))); if swap then begin emit_reg_reg(A_MOV,S_L,R_EDI,reg32); ungetregister32(R_EDI); end else ungetregister(reg8); end; end else begin getexplicitregister32(R_EDI); emit_ref_reg(A_LEA,S_L,newreference(dest),R_EDI); {$ifdef regallocfix} {is this ok?? (JM)} del_reference(dest); {$endif regallocfix} exprasmList.concat(Tairegalloc.Alloc(R_ESI)); if loadref then emit_ref_reg(A_MOV,S_L,newreference(source),R_ESI) else begin emit_ref_reg(A_LEA,S_L,newreference(source),R_ESI); {$ifdef regallocfix} if delsource then del_reference(source); {$endif regallocfix} end; exprasmList.concat(Taicpu.Op_none(A_CLD,S_NO)); ecxpushed:=false; if cs_littlesize in aktglobalswitches then begin maybepushecx; emit_const_reg(A_MOV,S_L,size,R_ECX); exprasmList.concat(Taicpu.Op_none(A_REP,S_NO)); exprasmList.concat(Taicpu.Op_none(A_MOVSB,S_NO)); end else begin helpsize:=size shr 2; size:=size and 3; if helpsize>1 then begin maybepushecx; emit_const_reg(A_MOV,S_L,helpsize,R_ECX); exprasmList.concat(Taicpu.Op_none(A_REP,S_NO)); end; if helpsize>0 then exprasmList.concat(Taicpu.Op_none(A_MOVSD,S_NO)); if size>1 then begin dec(size,2); exprasmList.concat(Taicpu.Op_none(A_MOVSW,S_NO)); end; if size=1 then exprasmList.concat(Taicpu.Op_none(A_MOVSB,S_NO)); end; ungetregister32(R_EDI); exprasmList.concat(Tairegalloc.DeAlloc(R_ESI)); if ecxpushed then exprasmList.concat(Taicpu.Op_reg(A_POP,S_L,R_ECX)) else ungetregister32(R_ECX); { loading SELF-reference again } maybe_loadesi; end; if delsource then ungetiftemp(source); end; procedure emitloadord2reg(const location:Tlocation;orddef:Porddef; destreg:Tregister;delloc:boolean); {A lot smaller and less bug sensitive than the original unfolded loads.} var tai:Taicpu; r:Preference; begin tai := nil; case location.loc of LOC_REGISTER,LOC_CREGISTER: begin case orddef^.typ of u8bit: tai:=Taicpu.Op_reg_reg(A_MOVZX,S_BL,location.register,destreg); s8bit: tai:=Taicpu.Op_reg_reg(A_MOVSX,S_BL,location.register,destreg); u16bit: tai:=Taicpu.Op_reg_reg(A_MOVZX,S_WL,location.register,destreg); s16bit: tai:=Taicpu.Op_reg_reg(A_MOVSX,S_WL,location.register,destreg); u32bit,s32bit: if location.register <> destreg then tai:=Taicpu.Op_reg_reg(A_MOV,S_L,location.register,destreg); end; if delloc then ungetregister(location.register); end; LOC_MEM, LOC_REFERENCE: begin if location.reference.is_immediate then tai:=Taicpu.Op_const_reg(A_MOV,S_L,location.reference.offset,destreg) else begin r:=newreference(location.reference); case orddef^.typ of u8bit: tai:=Taicpu.Op_ref_reg(A_MOVZX,S_BL,r,destreg); s8bit: tai:=Taicpu.Op_ref_reg(A_MOVSX,S_BL,r,destreg); u16bit: tai:=Taicpu.Op_ref_reg(A_MOVZX,S_WL,r,destreg); s16bit: tai:=Taicpu.Op_ref_reg(A_MOVSX,S_WL,r,destreg); u32bit: tai:=Taicpu.Op_ref_reg(A_MOV,S_L,r,destreg); s32bit: tai:=Taicpu.Op_ref_reg(A_MOV,S_L,r,destreg); end; end; if delloc then del_reference(location.reference); end else internalerror(6); end; if assigned(tai) then exprasmList.concat(tai); end; { if necessary ESI is reloaded after a call} procedure maybe_loadesi; var hp : preference; p : pprocinfo; i : longint; begin if assigned(procinfo^._class) then begin exprasmList.concat(Tairegalloc.Alloc(R_ESI)); if lexlevel>normal_function_level then begin new(hp); reset_reference(hp^); hp^.offset:=procinfo^.framepointer_offset; hp^.base:=procinfo^.framepointer; emit_ref_reg(A_MOV,S_L,hp,R_ESI); p:=procinfo^.parent; for i:=3 to lexlevel-1 do begin new(hp); reset_reference(hp^); hp^.offset:=p^.framepointer_offset; hp^.base:=R_ESI; emit_ref_reg(A_MOV,S_L,hp,R_ESI); p:=p^.parent; end; new(hp); reset_reference(hp^); hp^.offset:=p^.selfpointer_offset; hp^.base:=R_ESI; emit_ref_reg(A_MOV,S_L,hp,R_ESI); end else begin new(hp); reset_reference(hp^); hp^.offset:=procinfo^.selfpointer_offset; hp^.base:=procinfo^.framepointer; emit_ref_reg(A_MOV,S_L,hp,R_ESI); end; end; end; {***************************************************************************** Entry/Exit Code Functions *****************************************************************************} procedure genprofilecode; var pl : pasmlabel; begin if (po_assembler in aktprocsym^.definition^.procoptions) then exit; case target_info.target of target_i386_freebsd, target_i386_linux: begin getaddrlabel(pl); emitinsertcall('mcount'); usedinproc:=usedinproc or ($80 shr byte(R_EDX)); exprasmList.insert(Taicpu.Op_sym_ofs_reg(A_MOV,S_L,pl,0,R_EDX)); exprasmList.insert(Tai_section.Create(sec_code)); exprasmList.insert(Tai_const.Create_32bit(0)); exprasmList.insert(Tai_label.Create(pl)); exprasmList.insert(Tai_align.Create(4)); exprasmList.insert(Tai_section.Create(sec_data)); end; target_i386_go32v2: begin emitinsertcall('MCOUNT'); end; end; end; procedure generate_interrupt_stackframe_entry; begin { save the registers of an interrupt procedure } exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_L,R_EAX)); exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_L,R_EBX)); exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_L,R_ECX)); exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_L,R_EDX)); exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_L,R_ESI)); exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_L,R_EDI)); { .... also the segment registers } exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_W,R_DS)); exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_W,R_ES)); exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_W,R_FS)); exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_W,R_GS)); end; procedure generate_interrupt_stackframe_exit; begin { restore the registers of an interrupt procedure } { this was all with entrycode instead of exitcode !!} procinfo^.aktexitcode.concat(Taicpu.Op_reg(A_POP,S_L,R_EAX)); procinfo^.aktexitcode.concat(Taicpu.Op_reg(A_POP,S_L,R_EBX)); procinfo^.aktexitcode.concat(Taicpu.Op_reg(A_POP,S_L,R_ECX)); procinfo^.aktexitcode.concat(Taicpu.Op_reg(A_POP,S_L,R_EDX)); procinfo^.aktexitcode.concat(Taicpu.Op_reg(A_POP,S_L,R_ESI)); procinfo^.aktexitcode.concat(Taicpu.Op_reg(A_POP,S_L,R_EDI)); { .... also the segment registers } procinfo^.aktexitcode.concat(Taicpu.Op_reg(A_POP,S_W,R_DS)); procinfo^.aktexitcode.concat(Taicpu.Op_reg(A_POP,S_W,R_ES)); procinfo^.aktexitcode.concat(Taicpu.Op_reg(A_POP,S_W,R_FS)); procinfo^.aktexitcode.concat(Taicpu.Op_reg(A_POP,S_W,R_GS)); { this restores the flags } procinfo^.aktexitcode.concat(Taicpu.Op_none(A_IRET,S_NO)); end; { generates the code for threadvar initialisation } procedure initialize_threadvar(p : pnamedindexobject);{$ifndef FPC}far;{$endif} var hr : treference; begin if (psym(p)^.typ=varsym) and (vo_is_thread_var in pvarsym(p)^.varoptions) then begin exprasmList.concat(Taicpu.Op_const(A_PUSH,S_L,pvarsym(p)^.getsize)); reset_reference(hr); hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname); emitpushreferenceaddr(hr); saveregvars($ff); emitcall('FPC_INIT_THREADVAR'); end; end; { initilizes data of type t } { if is_already_ref is true then the routines assumes } { that r points to the data to initialize } procedure initialize(t : pdef;const ref : treference;is_already_ref : boolean); var hr : treference; begin if is_ansistring(t) or is_widestring(t) or is_interfacecom(t) then begin emit_const_ref(A_MOV,S_L,0, newreference(ref)); end else begin reset_reference(hr); hr.symbol:=pstoreddef(t)^.get_inittable_label; emitpushreferenceaddr(hr); if is_already_ref then exprasmList.concat(Taicpu.Op_ref(A_PUSH,S_L, newreference(ref))) else emitpushreferenceaddr(ref); emitcall('FPC_INITIALIZE'); end; end; { finalizes data of type t } { if is_already_ref is true then the routines assumes } { that r points to the data to finalizes } procedure finalize(t : pdef;const ref : treference;is_already_ref : boolean); var r : treference; begin if is_ansistring(t) or is_widestring(t) then begin decrstringref(t,ref); end else if is_interfacecom(t) then begin decrcomintfref(t,ref); end else begin reset_reference(r); r.symbol:=pstoreddef(t)^.get_inittable_label; emitpushreferenceaddr(r); if is_already_ref then exprasmList.concat(Taicpu.Op_ref(A_PUSH,S_L, newreference(ref))) else emitpushreferenceaddr(ref); emitcall('FPC_FINALIZE'); end; end; { generates the code for initialisation of local data } procedure initialize_data(p : pnamedindexobject);{$ifndef FPC}far;{$endif} var hr : treference; begin if (psym(p)^.typ=varsym) and assigned(pvarsym(p)^.vartype.def) and not(is_class(pvarsym(p)^.vartype.def)) and pvarsym(p)^.vartype.def^.needs_inittable then begin if assigned(procinfo) then procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally; reset_reference(hr); if psym(p)^.owner^.symtabletype in [localsymtable,inlinelocalsymtable] then begin hr.base:=procinfo^.framepointer; hr.offset:=-pvarsym(p)^.address+pvarsym(p)^.owner^.address_fixup; end else begin hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname); end; initialize(pvarsym(p)^.vartype.def,hr,false); end; end; { generates the code for incrementing the reference count of parameters and initialize out parameters } procedure init_paras(p : pnamedindexobject);{$ifndef FPC}far;{$endif} var hrv : treference; hr: treference; begin if (psym(p)^.typ=varsym) and not is_class(pvarsym(p)^.vartype.def) and pvarsym(p)^.vartype.def^.needs_inittable then begin if (pvarsym(p)^.varspez=vs_value) then begin procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally; reset_reference(hrv); hrv.base:=procinfo^.framepointer; hrv.offset:=pvarsym(p)^.address+procinfo^.para_offset; if is_ansistring(pvarsym(p)^.vartype.def) or is_widestring(pvarsym(p)^.vartype.def) then begin incrstringref(pvarsym(p)^.vartype.def,hrv) end else if is_interfacecom(pvarsym(p)^.vartype.def) then begin incrcomintfref(pvarsym(p)^.vartype.def,hrv) end else begin reset_reference(hr); hr.symbol:=pstoreddef(pvarsym(p)^.vartype.def)^.get_inittable_label; emitpushreferenceaddr(hr); emitpushreferenceaddr(hrv); emitcall('FPC_ADDREF'); end; end else if (pvarsym(p)^.varspez=vs_out) then begin reset_reference(hrv); hrv.base:=procinfo^.framepointer; hrv.offset:=pvarsym(p)^.address+procinfo^.para_offset; {$ifndef noAllocEdi} getexplicitregister32(R_EDI); {$endif noAllocEdi} exprasmList.concat(Taicpu.Op_ref_reg(A_MOV,S_L,newreference(hrv),R_EDI)); reset_reference(hr); hr.base:=R_EDI; initialize(pvarsym(p)^.vartype.def,hr,false); end; end; end; { generates the code for decrementing the reference count of parameters } procedure final_paras(p : pnamedindexobject);{$ifndef FPC}far;{$endif} var hrv : treference; hr: treference; begin if (psym(p)^.typ=varsym) and not is_class(pvarsym(p)^.vartype.def) and pvarsym(p)^.vartype.def^.needs_inittable then begin if (pvarsym(p)^.varspez=vs_value) then begin procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally; reset_reference(hrv); hrv.base:=procinfo^.framepointer; hrv.offset:=pvarsym(p)^.address+procinfo^.para_offset; if is_ansistring(pvarsym(p)^.vartype.def) or is_widestring(pvarsym(p)^.vartype.def) then begin decrstringref(pvarsym(p)^.vartype.def,hrv) end else if is_interfacecom(pvarsym(p)^.vartype.def) then begin decrcomintfref(pvarsym(p)^.vartype.def,hrv) end else begin reset_reference(hr); hr.symbol:=pstoreddef(pvarsym(p)^.vartype.def)^.get_inittable_label; emitpushreferenceaddr(hr); emitpushreferenceaddr(hrv); emitcall('FPC_DECREF'); end; end; end; end; { generates the code for finalisation of local data } procedure finalize_data(p : pnamedindexobject);{$ifndef FPC}far;{$endif} var hr : treference; begin if (psym(p)^.typ=varsym) and assigned(pvarsym(p)^.vartype.def) and not(is_class(pvarsym(p)^.vartype.def)) and pvarsym(p)^.vartype.def^.needs_inittable then begin if assigned(procinfo) then procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally; reset_reference(hr); case psym(p)^.owner^.symtabletype of localsymtable,inlinelocalsymtable: begin hr.base:=procinfo^.framepointer; hr.offset:=-pvarsym(p)^.address+pvarsym(p)^.owner^.address_fixup; end; else hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname); end; finalize(pvarsym(p)^.vartype.def,hr,false); end; end; { generates the code to make local copies of the value parameters } procedure copyvalueparas(p : pnamedindexobject);{$ifndef fpc}far;{$endif} var href1,href2 : treference; r : preference; power,len : longint; opsize : topsize; again,ok : pasmlabel; begin if (psym(p)^.typ=varsym) and (pvarsym(p)^.varspez=vs_value) and (push_addr_param(pvarsym(p)^.vartype.def)) then begin if is_open_array(pvarsym(p)^.vartype.def) or is_array_of_const(pvarsym(p)^.vartype.def) then begin { get stack space } new(r); reset_reference(r^); r^.base:=procinfo^.framepointer; r^.offset:=pvarsym(p)^.address+4+procinfo^.para_offset; getexplicitregister32(R_EDI); exprasmList.concat(Taicpu.op_ref_reg(A_MOV,S_L,r,R_EDI)); exprasmList.concat(Taicpu.op_reg(A_INC,S_L,R_EDI)); if (parraydef(pvarsym(p)^.vartype.def)^.elesize<>1) then begin if ispowerof2(parraydef(pvarsym(p)^.vartype.def)^.elesize, power) then exprasmList.concat(Taicpu.op_const_reg(A_SHL,S_L,power,R_EDI)) else exprasmList.concat(Taicpu.op_const_reg(A_IMUL,S_L, parraydef(pvarsym(p)^.vartype.def)^.elesize,R_EDI)); end; {$ifndef NOTARGETWIN32} { windows guards only a few pages for stack growing, } { so we have to access every page first } if target_os.id=os_i386_win32 then begin getlabel(again); getlabel(ok); emitlab(again); exprasmList.concat(Taicpu.op_const_reg(A_CMP,S_L,winstackpagesize,R_EDI)); emitjmp(C_C,ok); exprasmList.concat(Taicpu.op_const_reg(A_SUB,S_L,winstackpagesize-4,R_ESP)); exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX)); exprasmList.concat(Taicpu.op_const_reg(A_SUB,S_L,winstackpagesize,R_EDI)); emitjmp(C_None,again); emitlab(ok); exprasmList.concat(Taicpu.op_reg_reg(A_SUB,S_L,R_EDI,R_ESP)); ungetregister32(R_EDI); { now reload EDI } new(r); reset_reference(r^); r^.base:=procinfo^.framepointer; r^.offset:=pvarsym(p)^.address+4+procinfo^.para_offset; getexplicitregister32(R_EDI); exprasmList.concat(Taicpu.op_ref_reg(A_MOV,S_L,r,R_EDI)); exprasmList.concat(Taicpu.op_reg(A_INC,S_L,R_EDI)); if (parraydef(pvarsym(p)^.vartype.def)^.elesize<>1) then begin if ispowerof2(parraydef(pvarsym(p)^.vartype.def)^.elesize, power) then exprasmList.concat(Taicpu.op_const_reg(A_SHL,S_L,power,R_EDI)) else exprasmList.concat(Taicpu.op_const_reg(A_IMUL,S_L, parraydef(pvarsym(p)^.vartype.def)^.elesize,R_EDI)); end; end else {$endif NOTARGETWIN32} exprasmList.concat(Taicpu.op_reg_reg(A_SUB,S_L,R_EDI,R_ESP)); { load destination } exprasmList.concat(Taicpu.op_reg_reg(A_MOV,S_L,R_ESP,R_EDI)); { don't destroy the registers! } exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_ECX)); exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_ESI)); { load count } new(r); reset_reference(r^); r^.base:=procinfo^.framepointer; r^.offset:=pvarsym(p)^.address+4+procinfo^.para_offset; exprasmList.concat(Taicpu.op_ref_reg(A_MOV,S_L,r,R_ECX)); { load source } new(r); reset_reference(r^); r^.base:=procinfo^.framepointer; r^.offset:=pvarsym(p)^.address+procinfo^.para_offset; exprasmList.concat(Taicpu.op_ref_reg(A_MOV,S_L,r,R_ESI)); { scheduled .... } exprasmList.concat(Taicpu.op_reg(A_INC,S_L,R_ECX)); { calculate size } len:=parraydef(pvarsym(p)^.vartype.def)^.elesize; opsize:=S_B; if (len and 3)=0 then begin opsize:=S_L; len:=len shr 2; end else if (len and 1)=0 then begin opsize:=S_W; len:=len shr 1; end; if ispowerof2(len, power) then exprasmList.concat(Taicpu.op_const_reg(A_SHL,S_L,power,R_ECX)) else exprasmList.concat(Taicpu.op_const_reg(A_IMUL,S_L,len,R_ECX)); exprasmList.concat(Taicpu.op_none(A_REP,S_NO)); case opsize of S_B : exprasmList.concat(Taicpu.Op_none(A_MOVSB,S_NO)); S_W : exprasmList.concat(Taicpu.Op_none(A_MOVSW,S_NO)); S_L : exprasmList.concat(Taicpu.Op_none(A_MOVSD,S_NO)); end; ungetregister32(R_EDI); exprasmList.concat(Taicpu.op_reg(A_POP,S_L,R_ESI)); exprasmList.concat(Taicpu.op_reg(A_POP,S_L,R_ECX)); { patch the new address } new(r); reset_reference(r^); r^.base:=procinfo^.framepointer; r^.offset:=pvarsym(p)^.address+procinfo^.para_offset; exprasmList.concat(Taicpu.op_reg_ref(A_MOV,S_L,R_ESP,r)); end else if is_shortstring(pvarsym(p)^.vartype.def) then begin reset_reference(href1); href1.base:=procinfo^.framepointer; href1.offset:=pvarsym(p)^.address+procinfo^.para_offset; reset_reference(href2); href2.base:=procinfo^.framepointer; href2.offset:=-pvarsym(p)^.localvarsym^.address+pvarsym(p)^.localvarsym^.owner^.address_fixup; copyshortstring(href2,href1,pstringdef(pvarsym(p)^.vartype.def)^.len,true,false); end else begin reset_reference(href1); href1.base:=procinfo^.framepointer; href1.offset:=pvarsym(p)^.address+procinfo^.para_offset; reset_reference(href2); href2.base:=procinfo^.framepointer; href2.offset:=-pvarsym(p)^.localvarsym^.address+pvarsym(p)^.localvarsym^.owner^.address_fixup; concatcopy(href1,href2,pvarsym(p)^.vartype.def^.size,true,true); end; end; end; procedure inittempvariables; var hp : ptemprecord; r : preference; begin hp:=templist; while assigned(hp) do begin if hp^.temptype in [tt_ansistring,tt_freeansistring,tt_interfacecom] then begin procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally; new(r); reset_reference(r^); r^.base:=procinfo^.framepointer; r^.offset:=hp^.pos; emit_const_ref(A_MOV,S_L,0,r); end; hp:=hp^.next; end; end; procedure finalizetempvariables; var hp : ptemprecord; hr : treference; begin hp:=templist; while assigned(hp) do begin if hp^.temptype in [tt_ansistring,tt_freeansistring] then begin procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally; reset_reference(hr); hr.base:=procinfo^.framepointer; hr.offset:=hp^.pos; emitpushreferenceaddr(hr); emitcall('FPC_ANSISTR_DECR_REF'); end else if hp^.temptype=tt_interfacecom then begin procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally; reset_reference(hr); hr.base:=procinfo^.framepointer; hr.offset:=hp^.pos; emitpushreferenceaddr(hr); emitcall('FPC_INTF_DECR_REF'); end; hp:=hp^.next; end; end; var ls : longint; procedure largest_size(p : pnamedindexobject);{$ifndef FPC}far;{$endif} begin if (psym(p)^.typ=varsym) and (pvarsym(p)^.getvaluesize>ls) then ls:=pvarsym(p)^.getvaluesize; end; procedure alignstack(alist : TAAsmoutput); begin {$ifdef dummy} if (cs_optimize in aktglobalswitches) and (aktoptprocessor in [classp5,classp6]) then begin ls:=0; aktprocsym^.definition^.localst^.foreach({$ifndef TP}@{$endif}largest_size); if ls>=8 then aList.insert(Taicpu.Op_const_reg(A_AND,S_L,-8,R_ESP)); end; {$endif dummy} end; procedure genentrycode(alist : TAAsmoutput;make_global:boolean; stackframe:longint; var parasize:longint;var nostackframe:boolean; inlined : boolean); { Generates the entry code for a procedure } var hs : string; {$ifdef GDB} stab_function_name : tai_stab_function_name; {$endif GDB} hr : preference; p : psymtable; r : treference; oldlist, oldexprasmlist : TAAsmoutput; again : pasmlabel; i : longint; tempbuf,tempaddr : treference; begin oldexprasmlist:=exprasmlist; exprasmlist:=alist; if (not inlined) and (aktprocsym^.definition^.proctypeoption=potype_proginit) then begin emitinsertcall('FPC_INITIALIZEUNITS'); oldlist:=exprasmlist; exprasmlist:=TAAsmoutput.Create; p:=symtablestack; while assigned(p) do begin p^.foreach({$ifndef TP}@{$endif}initialize_threadvar); p:=p^.next; end; oldList.insertlist(exprasmlist); exprasmlist.free; exprasmlist:=oldlist; end; {$ifdef GDB} if (not inlined) and (cs_debuginfo in aktmoduleswitches) then exprasmList.insert(Tai_force_line.Create); {$endif GDB} { a constructor needs a help procedure } if (aktprocsym^.definition^.proctypeoption=potype_constructor) then begin if is_class(procinfo^._class) then begin procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally; exprasmList.insert(Taicpu.Op_cond_sym(A_Jcc,C_Z,S_NO,faillabel)); emitinsertcall('FPC_NEW_CLASS'); end else if is_object(procinfo^._class) then begin exprasmList.insert(Taicpu.Op_cond_sym(A_Jcc,C_Z,S_NO,faillabel)); emitinsertcall('FPC_HELP_CONSTRUCTOR'); getexplicitregister32(R_EDI); exprasmList.insert(Taicpu.Op_const_reg(A_MOV,S_L,procinfo^._class^.vmt_offset,R_EDI)); end else Internalerror(200006161); end; { don't load ESI, does the caller } { we must do it for local function } { that can be called from a foreach } { of another object than self !! PM } if assigned(procinfo^._class) and { !!!!! shouldn't we load ESI always? } (lexlevel>normal_function_level) then maybe_loadesi; { When message method contains self as a parameter, we must load it into ESI } If (po_containsself in aktprocsym^.definition^.procoptions) then begin new(hr); reset_reference(hr^); hr^.offset:=procinfo^.selfpointer_offset; hr^.base:=procinfo^.framepointer; exprasmList.insert(Taicpu.Op_ref_reg(A_MOV,S_L,hr,R_ESI)); exprasmList.insert(Tairegalloc.Alloc(R_ESI)); end; { should we save edi,esi,ebx like C ? } if (po_savestdregs in aktprocsym^.definition^.procoptions) then begin if (aktprocsym^.definition^.usedregisters and ($80 shr byte(R_EBX)))<>0 then exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_L,R_EBX)); exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_L,R_ESI)); exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_L,R_EDI)); end; { for the save all registers we can simply use a pusha,popa which push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax } if (po_saveregisters in aktprocsym^.definition^.procoptions) then begin exprasmList.insert(Taicpu.Op_none(A_PUSHA,S_L)); end; { omit stack frame ? } if (not inlined) then if (procinfo^.framepointer=stack_pointer) then begin CGMessage(cg_d_stackframe_omited); nostackframe:=true; if (aktprocsym^.definition^.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then parasize:=0 else parasize:=aktprocsym^.definition^.parast^.datasize+procinfo^.para_offset-4; if stackframe<>0 then exprasmList.insert(Taicpu.op_const_reg(A_SUB,S_L,stackframe,R_ESP)); end else begin alignstack(alist); if (aktprocsym^.definition^.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then parasize:=0 else parasize:=aktprocsym^.definition^.parast^.datasize+procinfo^.para_offset-8; nostackframe:=false; if stackframe<>0 then begin {$ifdef unused} if (cs_littlesize in aktglobalswitches) and (stackframe<=65535) then begin if (cs_check_stack in aktlocalswitches) and not(target_info.target in [target_386_freebsd, target_i386_linux,target_i386_win32]) then begin emitinsertcall('FPC_STACKCHECK'); exprasmList.insert(Taicpu.Op_const(A_PUSH,S_L,stackframe)); end; if cs_profile in aktmoduleswitches then genprofilecode; { %edi is already saved when pocdecl is used if ((target_info.target=target_linux) or (target_info.target=target_freebsd)) and ((aktprocsym^.definition^.options and poexports)<>0) then exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_L,R_EDI)); } { ATTENTION: never use ENTER in linux !!! (or freebsd MvdV) the stack page fault does not support it PM } exprasmList.insert(Taicpu.Op_const_const(A_ENTER,S_NO,stackframe,0))) end else {$endif unused} begin { windows guards only a few pages for stack growing, } { so we have to access every page first } if (target_os.id=os_i386_win32) and (stackframe>=winstackpagesize) then begin if stackframe div winstackpagesize<=5 then begin exprasmList.insert(Taicpu.Op_const_reg(A_SUB,S_L,stackframe-4,R_ESP)); for i:=1 to stackframe div winstackpagesize do begin hr:=new_reference(R_ESP,stackframe-i*winstackpagesize); exprasmList.concat(Taicpu.op_const_ref(A_MOV,S_L,0,hr)); end; exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX)); end else begin getlabel(again); getexplicitregister32(R_EDI); exprasmList.concat(Taicpu.op_const_reg(A_MOV,S_L,stackframe div winstackpagesize,R_EDI)); emitlab(again); exprasmList.concat(Taicpu.op_const_reg(A_SUB,S_L,winstackpagesize-4,R_ESP)); exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX)); exprasmList.concat(Taicpu.op_reg(A_DEC,S_L,R_EDI)); emitjmp(C_NZ,again); ungetregister32(R_EDI); exprasmList.concat(Taicpu.op_const_reg(A_SUB,S_L,stackframe mod winstackpagesize,R_ESP)); end end else exprasmList.insert(Taicpu.Op_const_reg(A_SUB,S_L,stackframe,R_ESP)); if (cs_check_stack in aktlocalswitches) and not(target_info.target in [target_i386_freebsd, target_i386_linux,target_i386_win32]) then begin emitinsertcall('FPC_STACKCHECK'); exprasmList.insert(Taicpu.Op_const(A_PUSH,S_L,stackframe)); end; if cs_profile in aktmoduleswitches then genprofilecode; exprasmList.insert(Taicpu.Op_reg_reg(A_MOV,S_L,R_ESP,R_EBP)); exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_L,R_EBP)); end; end { endif stackframe <> 0 } else begin if cs_profile in aktmoduleswitches then genprofilecode; exprasmList.insert(Taicpu.Op_reg_reg(A_MOV,S_L,R_ESP,R_EBP)); exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_L,R_EBP)); end; end; if (po_interrupt in aktprocsym^.definition^.procoptions) then generate_interrupt_stackframe_entry; { initialize return value } if (procinfo^.returntype.def<>pdef(voiddef)) and (procinfo^.returntype.def^.needs_inittable) then begin procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally; reset_reference(r); r.offset:=procinfo^.return_offset; r.base:=procinfo^.framepointer; initialize(procinfo^.returntype.def,r,ret_in_param(procinfo^.returntype.def)); end; { initialisize local data like ansistrings } case aktprocsym^.definition^.proctypeoption of potype_unitinit: begin { using current_module.globalsymtable is hopefully } { more robust than symtablestack and symtablestack^.next } psymtable(current_module.globalsymtable)^.foreach({$ifndef TP}@{$endif}initialize_data); psymtable(current_module.localsymtable)^.foreach({$ifndef TP}@{$endif}initialize_data); end; { units have seperate code for initilization and finalization } potype_unitfinalize: ; else aktprocsym^.definition^.localst^.foreach({$ifndef TP}@{$endif}initialize_data); end; { initialisizes temp. ansi/wide string data } inittempvariables; { generate copies of call by value parameters } if not(po_assembler in aktprocsym^.definition^.procoptions) and (([pocall_cdecl,pocall_cppdecl]*aktprocsym^.definition^.proccalloptions)=[]) then aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}copyvalueparas); if assigned( aktprocsym^.definition^.parast) then aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}init_paras); { do we need an exception frame because of ansi/widestrings/interfaces ? } if not inlined and ((procinfo^.flags and pi_needs_implicit_finally)<>0) and { but it's useless in init/final code of units } not(aktprocsym^.definition^.proctypeoption in [potype_unitfinalize,potype_unitinit]) then begin usedinproc:=usedinproc or ($80 shr byte(R_EAX)); exprasmList.concat(Taicpu.op_const_reg(A_SUB,S_L,36,R_ESP)); exprasmList.concat(Taicpu.op_reg_reg(A_MOV,S_L,R_ESP,R_EDI)); reset_reference(tempaddr); tempaddr.base:=R_EDI; emitpushreferenceaddr(tempaddr); reset_reference(tempbuf); tempbuf.base:=R_EDI; tempbuf.offset:=12; emitpushreferenceaddr(tempbuf); { Type of stack-frame must be pushed} exprasmList.concat(Taicpu.op_const(A_PUSH,S_L,1)); emitcall('FPC_PUSHEXCEPTADDR'); exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX)); emitcall('FPC_SETJMP'); exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX)); exprasmList.concat(Taicpu.op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)); emitjmp(C_NE,aktexitlabel); { probably we've to reload self here } maybe_loadesi; end; if not inlined then begin if (cs_profile in aktmoduleswitches) or (aktprocsym^.definition^.owner^.symtabletype=globalsymtable) or (assigned(procinfo^._class) and (procinfo^._class^.owner^.symtabletype=globalsymtable)) then make_global:=true; hs:=aktprocsym^.definition^.aliasnames.getfirst; {$ifdef GDB} if (cs_debuginfo in aktmoduleswitches) and target_os.use_function_relative_addresses then stab_function_name := Tai_stab_function_name.Create(strpnew(hs)); {$EndIf GDB} while hs<>'' do begin if make_global then exprasmList.insert(Tai_symbol.Createname_global(hs,0)) else exprasmList.insert(Tai_symbol.Createname(hs,0)); {$ifdef GDB} if (cs_debuginfo in aktmoduleswitches) and target_os.use_function_relative_addresses then exprasmList.insert(Tai_stab_function_name.Create(strpnew(hs))); {$endif GDB} hs:=aktprocsym^.definition^.aliasnames.getfirst; end; if make_global or ((procinfo^.flags and pi_is_global) <> 0) then aktprocsym^.is_global := True; {$ifdef GDB} if (cs_debuginfo in aktmoduleswitches) then begin if target_os.use_function_relative_addresses then exprasmList.insert(stab_function_name); exprasmList.insert(Tai_stabs.Create(aktprocsym^.stabstring)); aktprocsym^.isstabwritten:=true; end; {$endif GDB} { Align, gprof uses 16 byte granularity } if (cs_profile in aktmoduleswitches) then exprasmList.insert(Tai_align.Create_op(16,$90)) else if not(cs_littlesize in aktglobalswitches) then exprasmList.insert(Tai_align.Create(16)); end; if inlined then load_regvars(exprasmlist,nil); exprasmlist:=oldexprasmlist; end; procedure handle_return_value(inlined : boolean;var uses_eax,uses_edx : boolean); var hr : preference; op : Tasmop; s : Topsize; begin uses_eax:=false; uses_edx:=false; if procinfo^.returntype.def<>pdef(voiddef) then begin {if ((procinfo^.flags and pi_operator)<>0) and assigned(opsym) then procinfo^.funcret_is_valid:= procinfo^.funcret_is_valid or (opsym^.refs>0);} if (procinfo^.funcret_state<>vs_assigned) and not inlined { and ((procinfo^.flags and pi_uses_asm)=0)} then CGMessage(sym_w_function_result_not_set); hr:=new_reference(procinfo^.framepointer,procinfo^.return_offset); if (procinfo^.returntype.def^.deftype in [orddef,enumdef]) then begin uses_eax:=true; exprasmList.concat(Tairegalloc.Alloc(R_EAX)); case procinfo^.returntype.def^.size of 8: begin emit_ref_reg(A_MOV,S_L,hr,R_EAX); hr:=new_reference(procinfo^.framepointer,procinfo^.return_offset+4); exprasmList.concat(Tairegalloc.Alloc(R_EDX)); emit_ref_reg(A_MOV,S_L,hr,R_EDX); uses_edx:=true; end; 4: emit_ref_reg(A_MOV,S_L,hr,R_EAX); 2: emit_ref_reg(A_MOV,S_W,hr,R_AX); 1: emit_ref_reg(A_MOV,S_B,hr,R_AL); end; end else if ret_in_acc(procinfo^.returntype.def) then begin uses_eax:=true; exprasmList.concat(Tairegalloc.Alloc(R_EAX)); emit_ref_reg(A_MOV,S_L,hr,R_EAX); end else if (procinfo^.returntype.def^.deftype=floatdef) then begin floatloadops(pfloatdef(procinfo^.returntype.def)^.typ,op,s); exprasmList.concat(Taicpu.Op_ref(op,s,hr)); end else dispose(hr); end end; procedure genexitcode(alist : TAAsmoutput;parasize:longint;nostackframe,inlined:boolean); var {$ifdef GDB} mangled_length : longint; p : pchar; st : string[2]; {$endif GDB} nofinal,okexitlabel,noreraiselabel,nodestroycall : pasmlabel; hr : treference; uses_eax,uses_edx,uses_esi : boolean; oldexprasmlist : TAAsmoutput; ai : taicpu; pd : pprocdef; begin oldexprasmlist:=exprasmlist; exprasmlist:=alist; if aktexitlabel^.is_used then exprasmList.insert(Tai_label.Create(aktexitlabel)); { call the destructor help procedure } if (aktprocsym^.definition^.proctypeoption=potype_destructor) and assigned(procinfo^._class) then begin if is_class(procinfo^._class) then begin emitinsertcall('FPC_DISPOSE_CLASS'); end else if is_object(procinfo^._class) then begin emitinsertcall('FPC_HELP_DESTRUCTOR'); getexplicitregister32(R_EDI); exprasmList.insert(Taicpu.Op_const_reg(A_MOV,S_L,procinfo^._class^.vmt_offset,R_EDI)); { must the object be finalized ? } if procinfo^._class^.needs_inittable then begin getlabel(nofinal); exprasmList.insert(Tai_label.Create(nofinal)); emitinsertcall('FPC_FINALIZE'); ungetregister32(R_EDI); exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_L,R_ESI)); exprasmList.insert(Taicpu.Op_sym(A_PUSH,S_L,procinfo^._class^.get_inittable_label)); ai:=Taicpu.Op_sym(A_Jcc,S_NO,nofinal); ai.SetCondition(C_Z); exprasmList.insert(ai); reset_reference(hr); hr.base:=R_EBP; hr.offset:=8; exprasmList.insert(Taicpu.Op_const_ref(A_CMP,S_L,0,newreference(hr))); end; end else begin Internalerror(200006161); end; end; { finalize temporary data } finalizetempvariables; { finalize local data like ansistrings} case aktprocsym^.definition^.proctypeoption of potype_unitfinalize: begin { using current_module.globalsymtable is hopefully } { more robust than symtablestack and symtablestack^.next } psymtable(current_module.globalsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data); psymtable(current_module.localsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data); end; { units have seperate code for initialization and finalization } potype_unitinit: ; else aktprocsym^.definition^.localst^.foreach({$ifndef TP}@{$endif}finalize_data); end; { finalize paras data } if assigned(aktprocsym^.definition^.parast) then aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}final_paras); { do we need to handle exceptions because of ansi/widestrings ? } if not inlined and ((procinfo^.flags and pi_needs_implicit_finally)<>0) and { but it's useless in init/final code of units } not(aktprocsym^.definition^.proctypeoption in [potype_unitfinalize,potype_unitinit]) then begin { the exception helper routines modify all registers } aktprocsym^.definition^.usedregisters:=$ff; getlabel(noreraiselabel); emitcall('FPC_POPADDRSTACK'); exprasmList.concat(Tairegalloc.Alloc(R_EAX)); exprasmList.concat(Taicpu.op_reg(A_POP,S_L,R_EAX)); exprasmList.concat(Taicpu.op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)); ungetregister32(R_EAX); emitjmp(C_E,noreraiselabel); if (aktprocsym^.definition^.proctypeoption=potype_constructor) then begin if assigned(procinfo^._class) then begin pd:=procinfo^._class^.searchdestructor; if assigned(pd) then begin getlabel(nodestroycall); emit_const_ref(A_CMP,S_L,0,new_reference(procinfo^.framepointer, procinfo^.selfpointer_offset)); emitjmp(C_E,nodestroycall); if is_class(procinfo^._class) then begin emit_const(A_PUSH,S_L,1); emit_reg(A_PUSH,S_L,R_ESI); end else if is_object(procinfo^._class) then begin emit_reg(A_PUSH,S_L,R_ESI); emit_sym(A_PUSH,S_L,newasmsymbol(procinfo^._class^.vmt_mangledname)); end else begin Internalerror(200006161); end; if (po_virtualmethod in pd^.procoptions) then begin emit_ref_reg(A_MOV,S_L,new_reference(R_ESI,0),R_EDI); emit_ref(A_CALL,S_NO,new_reference(R_EDI,procinfo^._class^.vmtmethodoffset(pd^.extnumber))); end else emitcall(pd^.mangledname); { not necessary because the result is never assigned in the case of an exception (FK) emit_const_reg(A_MOV,S_L,0,R_ESI); emit_const_ref(A_MOV,S_L,0,new_reference(procinfo^.framepointer,8)); } emitlab(nodestroycall); end; end end else { must be the return value finalized before reraising the exception? } if (procinfo^.returntype.def<>pdef(voiddef)) and (procinfo^.returntype.def^.needs_inittable) and ((procinfo^.returntype.def^.deftype<>objectdef) or not is_class(procinfo^.returntype.def)) then begin reset_reference(hr); hr.offset:=procinfo^.return_offset; hr.base:=procinfo^.framepointer; finalize(procinfo^.returntype.def,hr,ret_in_param(procinfo^.returntype.def)); end; emitcall('FPC_RERAISE'); emitlab(noreraiselabel); end; { call __EXIT for main program } if (not DLLsource) and (not inlined) and (aktprocsym^.definition^.proctypeoption=potype_proginit) then begin emitcall('FPC_DO_EXIT'); end; { handle return value } uses_eax:=false; uses_edx:=false; uses_esi:=false; if not(po_assembler in aktprocsym^.definition^.procoptions) then if (aktprocsym^.definition^.proctypeoption<>potype_constructor) then handle_return_value(inlined,uses_eax,uses_edx) else begin { successful constructor deletes the zero flag } { and returns self in eax } { eax must be set to zero if the allocation failed !!! } getlabel(okexitlabel); emitjmp(C_NONE,okexitlabel); emitlab(faillabel); if is_class(procinfo^._class) then begin emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,8),R_ESI); emitcall('FPC_HELP_FAIL_CLASS'); end else if is_object(procinfo^._class) then begin emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,12),R_ESI); getexplicitregister32(R_EDI); emit_const_reg(A_MOV,S_L,procinfo^._class^.vmt_offset,R_EDI); emitcall('FPC_HELP_FAIL'); ungetregister32(R_EDI); end else Internalerror(200006161); emitlab(okexitlabel); { for classes this is done after the call to } { AfterConstruction } if is_object(procinfo^._class) then begin exprasmList.concat(Tairegalloc.Alloc(R_EAX)); emit_reg_reg(A_MOV,S_L,R_ESI,R_EAX); uses_eax:=true; end; emit_reg_reg(A_TEST,S_L,R_ESI,R_ESI); uses_esi:=true; end; { stabs uses the label also ! } if aktexit2label^.is_used or ((cs_debuginfo in aktmoduleswitches) and not inlined) then emitlab(aktexit2label); { gives problems for long mangled names } {List.concat(Tai_symbol.Create(aktprocsym^.definition^.mangledname+'_end'));} { should we restore edi ? } { for all i386 gcc implementations } if (po_savestdregs in aktprocsym^.definition^.procoptions) then begin if (aktprocsym^.definition^.usedregisters and ($80 shr byte(R_EBX)))<>0 then exprasmList.concat(Taicpu.Op_reg(A_POP,S_L,R_EBX)); exprasmList.concat(Taicpu.Op_reg(A_POP,S_L,R_ESI)); exprasmList.concat(Taicpu.Op_reg(A_POP,S_L,R_EDI)); { here we could reset R_EBX but that is risky because it only works if genexitcode is called after genentrycode so lets skip this for the moment PM aktprocsym^.definition^.usedregisters:= aktprocsym^.definition^.usedregisters or not ($80 shr byte(R_EBX)); } end; { for the save all registers we can simply use a pusha,popa which push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax } if (po_saveregisters in aktprocsym^.definition^.procoptions) then begin if uses_esi then exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_ESI,new_reference(R_ESP,4))); if uses_edx then exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDX,new_reference(R_ESP,20))); if uses_eax then exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EAX,new_reference(R_ESP,28))); exprasmList.concat(Taicpu.Op_none(A_POPA,S_L)); end; if not(nostackframe) then begin if not inlined then exprasmList.concat(Taicpu.Op_none(A_LEAVE,S_NO)); end else begin if (gettempsize<>0) and not inlined then exprasmList.insert(Taicpu.op_const_reg(A_ADD,S_L,gettempsize,R_ESP)); end; { parameters are limited to 65535 bytes because } { ret allows only imm16 } if (parasize>65535) and not(pocall_clearstack in aktprocsym^.definition^.proccalloptions) then CGMessage(cg_e_parasize_too_big); { at last, the return is generated } if not inlined then if (po_interrupt in aktprocsym^.definition^.procoptions) then begin if uses_esi then exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_ESI,new_reference(R_ESP,16))); if uses_edx then begin exprasmList.concat(Tairegalloc.Alloc(R_EAX)); exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDX,new_reference(R_ESP,12))); end; if uses_eax then begin exprasmList.concat(Tairegalloc.Alloc(R_EAX)); exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EAX,new_reference(R_ESP,0))); end; generate_interrupt_stackframe_exit; end else begin {Routines with the poclearstack flag set use only a ret.} { also routines with parasize=0 } if (pocall_clearstack in aktprocsym^.definition^.proccalloptions) then begin {$ifndef OLD_C_STACK} { complex return values are removed from stack in C code PM } if ret_in_param(aktprocsym^.definition^.rettype.def) then exprasmList.concat(Taicpu.Op_const(A_RET,S_NO,4)) else {$endif not OLD_C_STACK} exprasmList.concat(Taicpu.Op_none(A_RET,S_NO)); end else if (parasize=0) then exprasmList.concat(Taicpu.Op_none(A_RET,S_NO)) else exprasmList.concat(Taicpu.Op_const(A_RET,S_NO,parasize)); end; if not inlined then exprasmList.concat(Tai_symbol_end.Createname(aktprocsym^.definition^.mangledname)); {$ifdef GDB} if (cs_debuginfo in aktmoduleswitches) and not inlined then begin aktprocsym^.concatstabto(exprasmlist); if assigned(procinfo^._class) then if (not assigned(procinfo^.parent) or not assigned(procinfo^.parent^._class)) then begin if (po_classmethod in aktprocsym^.definition^.procoptions) or ((po_virtualmethod in aktprocsym^.definition^.procoptions) and (potype_constructor=aktprocsym^.definition^.proctypeoption)) or (po_staticmethod in aktprocsym^.definition^.procoptions) then begin exprasmList.concat(Tai_stabs.Create(strpnew( '"pvmt:p'+pvmtdef^.numberstring+'",'+ tostr(N_PSYM)+',0,0,'+tostr(procinfo^.selfpointer_offset)))); end else begin if not(is_class(procinfo^._class)) then st:='v' else st:='p'; exprasmList.concat(Tai_stabs.Create(strpnew( '"$t:'+st+procinfo^._class^.numberstring+'",'+ tostr(N_PSYM)+',0,0,'+tostr(procinfo^.selfpointer_offset)))); end; end else begin if not is_class(procinfo^._class) then st:='*' else st:=''; exprasmList.concat(Tai_stabs.Create(strpnew( '"$t:r'+st+procinfo^._class^.numberstring+'",'+ tostr(N_RSYM)+',0,0,'+tostr(GDB_i386index[R_ESI])))); end; { define calling EBP as pseudo local var PM } { this enables test if the function is a local one !! } if assigned(procinfo^.parent) and (lexlevel>normal_function_level) then exprasmList.concat(Tai_stabs.Create(strpnew( '"parent_ebp:'+voidpointerdef^.numberstring+'",'+ tostr(N_LSYM)+',0,0,'+tostr(procinfo^.framepointer_offset)))); if (pdef(aktprocsym^.definition^.rettype.def) <> pdef(voiddef)) then begin if ret_in_param(aktprocsym^.definition^.rettype.def) then exprasmList.concat(Tai_stabs.Create(strpnew( '"'+aktprocsym^.name+':X*'+pstoreddef(aktprocsym^.definition^.rettype.def)^.numberstring+'",'+ tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))) else exprasmList.concat(Tai_stabs.Create(strpnew( '"'+aktprocsym^.name+':X'+pstoreddef(aktprocsym^.definition^.rettype.def)^.numberstring+'",'+ tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))); if (m_result in aktmodeswitches) then if ret_in_param(aktprocsym^.definition^.rettype.def) then exprasmList.concat(Tai_stabs.Create(strpnew( '"RESULT:X*'+pstoreddef(aktprocsym^.definition^.rettype.def)^.numberstring+'",'+ tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))) else exprasmList.concat(Tai_stabs.Create(strpnew( '"RESULT:X'+pstoreddef(aktprocsym^.definition^.rettype.def)^.numberstring+'",'+ tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))); end; mangled_length:=length(aktprocsym^.definition^.mangledname); getmem(p,2*mangled_length+50); strpcopy(p,'192,0,0,'); strpcopy(strend(p),aktprocsym^.definition^.mangledname); if (target_os.use_function_relative_addresses) then begin strpcopy(strend(p),'-'); strpcopy(strend(p),aktprocsym^.definition^.mangledname); end; exprasmList.concat(Tai_stabn.Create(strnew(p))); {List.concat(Tai_stabn.Create(strpnew('192,0,0,' +aktprocsym^.definition^.mangledname)))); p[0]:='2';p[1]:='2';p[2]:='4'; strpcopy(strend(p),'_end');} strpcopy(p,'224,0,0,'+aktexit2label^.name); if (target_os.use_function_relative_addresses) then begin strpcopy(strend(p),'-'); strpcopy(strend(p),aktprocsym^.definition^.mangledname); end; exprasmList.concatlist(withdebuglist); exprasmList.concat(Tai_stabn.Create(strnew(p))); { strpnew('224,0,0,' +aktprocsym^.definition^.mangledname+'_end'))));} freemem(p,2*mangled_length+50); end; {$endif GDB} if inlined then cleanup_regvars(exprasmlist); exprasmlist:=oldexprasmlist; end; procedure genimplicitunitfinal(alist : TAAsmoutput); begin { using current_module.globalsymtable is hopefully } { more robust than symtablestack and symtablestack^.next } psymtable(current_module.globalsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data); psymtable(current_module.localsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data); exprasmList.insert(Tai_symbol.Createname_global('FINALIZE$$'+current_module.modulename^,0)); exprasmList.insert(Tai_symbol.Createname_global(target_os.cprefix+current_module.modulename^+'_finalize',0)); {$ifdef GDB} if (cs_debuginfo in aktmoduleswitches) and target_os.use_function_relative_addresses then exprasmList.insert(Tai_stab_function_name.Create(strpnew('FINALIZE$$'+current_module.modulename^))); {$endif GDB} exprasmList.concat(Taicpu.Op_none(A_RET,S_NO)); aList.concatlist(exprasmlist); end; procedure genimplicitunitinit(alist : TAAsmoutput); begin { using current_module.globalsymtable is hopefully } { more robust than symtablestack and symtablestack^.next } psymtable(current_module.globalsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data); psymtable(current_module.localsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data); exprasmList.insert(Tai_symbol.Createname_global('INIT$$'+current_module.modulename^,0)); exprasmList.insert(Tai_symbol.Createname_global(target_os.cprefix+current_module.modulename^+'_init',0)); {$ifdef GDB} if (cs_debuginfo in aktmoduleswitches) and target_os.use_function_relative_addresses then exprasmList.insert(Tai_stab_function_name.Create(strpnew('INIT$$'+current_module.modulename^))); {$endif GDB} exprasmList.concat(Taicpu.Op_none(A_RET,S_NO)); aList.concatlist(exprasmlist); end; {$ifdef test_dest_loc} procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister); begin if (dest_loc.loc=LOC_CREGISTER) or (dest_loc.loc=LOC_REGISTER) then begin emit_reg_reg(A_MOV,s,reg,dest_loc.register); set_location(p^.location,dest_loc); in_dest_loc:=true; end else if (dest_loc.loc=LOC_REFERENCE) or (dest_loc.loc=LOC_MEM) then begin exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,s,reg,newreference(dest_loc.reference))); set_location(p^.location,dest_loc); in_dest_loc:=true; end else internalerror(20080); end; {$endif test_dest_loc} end. { $Log$ Revision 1.17 2001-01-05 17:36:58 florian * the info about exception frames is stored now on the stack instead on the heap Revision 1.16 2000/12/25 00:07:31 peter + new tlinkedlist class (merge of old tstringqueue,tcontainer and tlinkedlist objects) Revision 1.15 2000/12/05 11:44:32 jonas + new integer regvar handling, should be much more efficient Revision 1.14 2000/11/29 00:30:43 florian * unused units removed from uses clause * some changes for widestrings Revision 1.13 2000/11/28 00:28:07 pierre * stabs fixing Revision 1.12 2000/11/22 15:12:06 jonas * fixed inline-related problems (partially "merges") Revision 1.11 2000/11/17 10:30:24 florian * passing interfaces as parameters fixed Revision 1.10 2000/11/07 23:40:48 florian + AfterConstruction and BeforeDestruction impemented Revision 1.9 2000/11/06 23:49:20 florian * fixed init_paras call Revision 1.8 2000/11/06 23:15:01 peter * added copyvaluepara call again Revision 1.7 2000/11/04 14:25:23 florian + merged Attila's changes for interfaces, not tested yet Revision 1.6 2000/10/31 22:02:55 peter * symtable splitted, no real code changes Revision 1.5 2000/10/24 22:23:04 peter * emitcall -> emitinsertcall for profiling (merged) Revision 1.4 2000/10/24 12:47:45 jonas * allocate registers which hold function result Revision 1.3 2000/10/24 08:54:25 michael + Extra patch from peter Revision 1.2 2000/10/24 07:20:03 pierre * fix for bug 1193 (merged) Revision 1.1 2000/10/15 09:47:42 peter * moved to i386/ Revision 1.19 2000/10/14 10:14:46 peter * moehrendorf oct 2000 rewrite Revision 1.18 2000/10/10 14:55:28 jonas * added missing regallocs for edi in emit_mov_ref_reg64 (merged) Revision 1.17 2000/10/01 19:48:23 peter * lot of compile updates for cg11 Revision 1.16 2000/09/30 16:08:45 peter * more cg11 updates Revision 1.15 2000/09/24 15:06:12 peter * use defines.inc Revision 1.14 2000/09/16 12:22:52 peter * freebsd support merged Revision 1.13 2000/08/27 16:11:49 peter * moved some util functions from globals,cobjects to cutils * splitted files into finput,fmodule Revision 1.12 2000/08/24 19:07:54 peter * don't initialize if localvarsym is set because that varsym will already be initialized * first initialize local data before copy of value para's (merged) Revision 1.11 2000/08/19 20:09:33 peter * check size after checking openarray in push_value_para (merged) Revision 1.10 2000/08/16 13:06:06 florian + support of 64 bit integer constants Revision 1.9 2000/08/10 18:42:03 peter * fixed for constants in emit_push_mem_size for go32v2 (merged) Revision 1.8 2000/08/07 11:29:40 jonas + emit_push_mem_size() which pushes a value in memory of a certain size * pushsetelement() and pushvaluepara() use this new procedure, because otherwise they could sometimes try to push data past the end of the heap, causing a crash (merged from fixes branch) Revision 1.7 2000/08/03 13:17:25 jonas + allow regvars to be used inside inlined procs, which required the following changes: + load regvars in genentrycode/free them in genexitcode (cgai386) * moved all regvar related code to new regvars unit + added pregvarinfo type to hcodegen + added regvarinfo field to tprocinfo (symdef/symdefh) * deallocate the regvars of the caller in secondprocinline before inlining the called procedure and reallocate them afterwards Revision 1.6 2000/08/02 08:05:04 jonas * fixed web bug1087 * allocate R_ECX explicitely if it's used (merged from fixes branch) Revision 1.5 2000/07/27 09:25:05 jonas * moved locflags2reg() procedure from cg386add to cgai386 + added locjump2reg() procedure to cgai386 * fixed internalerror(2002) when the result of a case expression has LOC_JUMP (all merged from fixes branch) Revision 1.4 2000/07/21 15:14:02 jonas + added is_addr field for labels, if they are only used for getting the address (e.g. for io checks) and corresponding getaddrlabel() procedure Revision 1.3 2000/07/13 12:08:25 michael + patched to 1.1.0 with former 1.09patch from peter Revision 1.2 2000/07/13 11:32:37 michael + removed logs }