diff --git a/compiler/i386/cga.pas b/compiler/i386/cga.pas index fc46879285..29969756e0 100644 --- a/compiler/i386/cga.pas +++ b/compiler/i386/cga.pas @@ -64,9 +64,6 @@ interface procedure emitcall(const routine:string); - 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_mem_size(const t: treference; size: longint); { remove non regvar registers in loc from regs (in the format } @@ -75,7 +72,6 @@ interface 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:tdef); procedure copyshortstring(const dref,sref : treference;len : byte; loadref, del_sref: boolean); @@ -331,20 +327,6 @@ implementation end; - procedure emit_lea_loc_reg(const t:tlocation;reg:tregister;freetemp:boolean); - begin - case t.loc of - LOC_CREFERENCE, - LOC_REFERENCE : begin - emit_ref_reg(A_LEA,S_L,t.reference,reg); - if freetemp then - tg.ungetiftemp(exprasmlist,t.reference); - end; - else - internalerror(200203211); - end; - end; - procedure remove_non_regvars_from_loc(const t: tlocation; var regs: tregisterset); begin case t.loc of @@ -402,25 +384,6 @@ implementation end; - procedure emit_lea_loc_ref(const t:tlocation;const ref:treference;freetemp:boolean); - begin - case t.loc of - LOC_CREFERENCE, - LOC_REFERENCE : begin - rg.getexplicitregisterint(exprasmlist,R_EDI); - emit_ref_reg(A_LEA,S_L,t.reference,R_EDI); - exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,ref)); - rg.ungetregisterint(exprasmlist,R_EDI); - end; - else - internalerror(200203212); - end; - location_release(exprasmlist,t); - if freetemp then - location_freetemp(exprasmlist,t); - end; - - procedure emit_push_lea_loc(const t:tlocation;freetemp:boolean); begin case t.loc of @@ -463,70 +426,6 @@ implementation end; - procedure emit_to_mem(var t:tlocation;def:tdef); - - var - r : treference; - - begin - case t.loc of - LOC_FPUREGISTER, LOC_CFPUREGISTER : - begin - tg.gettempofsizereference(exprasmlist,10,r); - cg.a_loadfpu_reg_ref(exprasmlist, - def_cgsize(def),t.register,r); - t.reference := r; - end; - LOC_REGISTER: - begin - if is_64bitint(def) then - begin - tg.gettempofsizereference(exprasmlist,8,r); - emit_reg_ref(A_MOV,S_L,t.registerlow,r); - inc(r.offset,4); - emit_reg_ref(A_MOV,S_L,t.registerhigh,r); - dec(r.offset,4); - t.reference:=r; - end - else - internalerror(1405001); - end; - LOC_CREFERENCE, - LOC_REFERENCE : ; - else - internalerror(200203219); - end; - t.loc:=LOC_CREFERENCE; - end; - - - procedure emit_mov_ref_reg64(r : treference;rl,rh : tregister); - - var - hr : treference; - - begin - { if we load a 64 bit reference, we must be careful because } - { we could overwrite the registers of the reference by } - { accident } - rg.getexplicitregisterint(exprasmlist,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,r,rl); - hr:=r; - inc(hr.offset,4); - emit_ref_reg(A_MOV,S_L, hr,rh); - rg.ungetregisterint(exprasmlist,R_EDI); - end; - {***************************************************************************** Emit String Functions *****************************************************************************} @@ -2402,7 +2301,12 @@ implementation end. { $Log$ - Revision 1.23 2002-04-15 19:44:20 peter + Revision 1.24 2002-04-19 15:39:34 peter + * removed some more routines from cga + * moved location_force_reg/mem to ncgutil + * moved arrayconstructnode secondpass to ncgld + + Revision 1.23 2002/04/15 19:44:20 peter * fixed stackcheck that would be called recursively when a stack error was found * generic changeregsize(reg,size) for i386 register resizing diff --git a/compiler/i386/cpunode.pas b/compiler/i386/cpunode.pas index b2c2107179..5672450283 100644 --- a/compiler/i386/cpunode.pas +++ b/compiler/i386/cpunode.pas @@ -29,8 +29,8 @@ unit cpunode; implementation uses - ncgbas,ncgflw,ncgcnv,ncgmem,ncgcon, - n386ld,n386add,n386cal,n386con,n386flw,n386mat,n386mem, + ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon, + n386ld,n386add,n386cal,n386con,n386cnv,n386flw,n386mat,n386mem, n386set,n386inl,n386opt, { this not really a node } n386obj, rgcpu; @@ -38,7 +38,12 @@ unit cpunode; end. { $Log$ - Revision 1.8 2002-03-31 20:26:38 jonas + Revision 1.9 2002-04-19 15:39:35 peter + * removed some more routines from cga + * moved location_force_reg/mem to ncgutil + * moved arrayconstructnode secondpass to ncgld + + Revision 1.8 2002/03/31 20:26:38 jonas + a_loadfpu_* and a_loadmm_* methods in tcg * register allocation is now handled by a class and is mostly processor independent (+rgobj.pas and i386/rgcpu.pas) @@ -94,4 +99,4 @@ end. Revision 1.1 2000/10/14 10:14:47 peter * moehrendorf oct 2000 rewrite -} \ No newline at end of file +} diff --git a/compiler/i386/n386cnv.pas b/compiler/i386/n386cnv.pas index 771ef0078a..7f28aac2d9 100644 --- a/compiler/i386/n386cnv.pas +++ b/compiler/i386/n386cnv.pas @@ -27,12 +27,12 @@ unit n386cnv; interface uses - node,ncnv,ncgcnv,types; + node,ncgcnv,types; type ti386typeconvnode = class(tcgtypeconvnode) protected - procedure second_int_to_int;override; + { procedure second_int_to_int;override; } { procedure second_string_to_string;override; } { procedure second_cstring_to_pchar;override; } { procedure second_string_to_chararray;override; } @@ -51,51 +51,28 @@ interface { procedure second_pchar_to_string;override; } { procedure second_class_to_intf;override; } { procedure second_char_to_char;override; } - procedure pass_2;override; - procedure second_call_helper(c : tconverttype); +{$ifdef TESTOBJEXT2} + procedure checkobject;override; +{$endif TESTOBJEXT2} + procedure second_call_helper(c : tconverttype);override; end; + implementation uses verbose,systems, symconst,symdef,aasm, cginfo,cgbase,pass_2, - ncon,ncal, + ncon,ncal,ncnv, cpubase, - cgobj,cga,tgobj,rgobj,rgcpu,n386util; + cgobj,cga,tgobj,rgobj,rgcpu,ncgutil; {***************************************************************************** SecondTypeConv *****************************************************************************} - procedure ti386typeconvnode.second_int_to_int; - var - newsize : tcgsize; - begin - newsize:=def_cgsize(resulttype.def); - - { insert range check if not explicit conversion } - if not(nf_explizit in flags) then - cg.g_rangecheck(exprasmlist,left,resulttype.def); - - { is the result size smaller ? } - if resulttype.def.size<>left.resulttype.def.size then - begin - { reuse the left location by default } - location_copy(location,left.location); - location_force_reg(location,newsize,false); - end - else - begin - { no special loading is required, reuse current location } - location_copy(location,left.location); - location.size:=newsize; - end; - end; - - procedure ti386typeconvnode.second_int_to_real; var @@ -297,13 +274,42 @@ implementation falselabel:=oldfalselabel; end; +{$ifdef TESTOBJEXT2} + procedure ti386typeconvnode.checkobject; + var + r : preference; + nillabel : plabel; + begin + new(r); + reset_reference(r^); + if p^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then + r^.base:=p^.location.register + else + begin + rg.getexplicitregisterint(exprasmlist,R_EDI); + emit_mov_loc_reg(p^.location,R_EDI); + r^.base:=R_EDI; + end; + { NIL must be accepted !! } + emit_reg_reg(A_OR,S_L,r^.base,r^.base); + rg.ungetregisterint(exprasmlist,R_EDI); + getlabel(nillabel); + emitjmp(C_E,nillabel); + { this is one point where we need vmt_offset (PM) } + r^.offset:= tobjectdef(tpointerdef(p^.resulttype.def).definition).vmt_offset; + rg.getexplicitregisterint(exprasmlist,R_EDI); + emit_ref_reg(A_MOV,S_L,r,R_EDI); + emit_sym(A_PUSH,S_L, + newasmsymbol(tobjectdef(tpointerdef(p^.resulttype.def).definition).vmt_mangledname)); + emit_reg(A_PUSH,S_L,R_EDI); + rg.ungetregister32(exprasmlist,R_EDI); + emitcall('FPC_CHECK_OBJECT_EXT'); + emitlab(nillabel); + end; +{$endif TESTOBJEXT2} -{**************************************************************************** - TI386TYPECONVNODE -****************************************************************************} procedure ti386typeconvnode.second_call_helper(c : tconverttype); - const secondconvert : array[tconverttype] of pointer = ( @second_nothing, {equal} @@ -353,69 +359,17 @@ implementation tprocedureofobject(r){$ifdef FPC}();{$endif FPC} end; - procedure ti386typeconvnode.pass_2; -{$ifdef TESTOBJEXT2} - var - r : preference; - nillabel : plabel; -{$endif TESTOBJEXT2} - begin - { the boolean routines can be called with LOC_JUMP and - call secondpass themselves in the helper } - if not(convtype in [tc_bool_2_int,tc_bool_2_bool,tc_int_2_bool]) then - begin - secondpass(left); - if codegenerror then - exit; - end; - - second_call_helper(convtype); - -{$ifdef TESTOBJEXT2} - { Check explicit conversions to objects pointers !! } - if p^.explizit and - (p^.resulttype.def.deftype=pointerdef) and - (tpointerdef(p^.resulttype.def).definition.deftype=objectdef) and not - (tobjectdef(tpointerdef(p^.resulttype.def).definition).isclass) and - ((tobjectdef(tpointerdef(p^.resulttype.def).definition).options and oo_hasvmt)<>0) and - (cs_check_range in aktlocalswitches) then - begin - new(r); - reset_reference(r^); - if p^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then - r^.base:=p^.location.register - else - begin - rg.getexplicitregisterint(exprasmlist,R_EDI); - emit_mov_loc_reg(p^.location,R_EDI); - r^.base:=R_EDI; - end; - { NIL must be accepted !! } - emit_reg_reg(A_OR,S_L,r^.base,r^.base); - rg.ungetregisterint(exprasmlist,R_EDI); - getlabel(nillabel); - emitjmp(C_E,nillabel); - { this is one point where we need vmt_offset (PM) } - r^.offset:= tobjectdef(tpointerdef(p^.resulttype.def).definition).vmt_offset; - rg.getexplicitregisterint(exprasmlist,R_EDI); - emit_ref_reg(A_MOV,S_L,r,R_EDI); - emit_sym(A_PUSH,S_L, - newasmsymbol(tobjectdef(tpointerdef(p^.resulttype.def).definition).vmt_mangledname)); - emit_reg(A_PUSH,S_L,R_EDI); - rg.ungetregister32(exprasmlist,R_EDI); - emitcall('FPC_CHECK_OBJECT_EXT'); - emitlab(nillabel); - end; -{$endif TESTOBJEXT2} - end; - - begin ctypeconvnode:=ti386typeconvnode; end. { $Log$ - Revision 1.34 2002-04-15 19:44:21 peter + Revision 1.35 2002-04-19 15:39:35 peter + * removed some more routines from cga + * moved location_force_reg/mem to ncgutil + * moved arrayconstructnode secondpass to ncgld + + Revision 1.34 2002/04/15 19:44:21 peter * fixed stackcheck that would be called recursively when a stack error was found * generic changeregsize(reg,size) for i386 register resizing diff --git a/compiler/i386/n386inl.pas b/compiler/i386/n386inl.pas index efff193a33..ff2f687fc4 100644 --- a/compiler/i386/n386inl.pas +++ b/compiler/i386/n386inl.pas @@ -58,8 +58,6 @@ implementation ('S32REAL','S64REAL','S80REAL','S64BIT','F16BIT','F32BIT'); } addsubop:array[in_inc_x..in_dec_x] of TOpCG=(OP_ADD,OP_SUB); var - opsize : topsize; - op, asmop : tasmop; pushed : tpushedsaved; {inc/dec} @@ -593,7 +591,12 @@ begin end. { $Log$ - Revision 1.36 2002-04-15 19:44:21 peter + Revision 1.37 2002-04-19 15:39:35 peter + * removed some more routines from cga + * moved location_force_reg/mem to ncgutil + * moved arrayconstructnode secondpass to ncgld + + Revision 1.36 2002/04/15 19:44:21 peter * fixed stackcheck that would be called recursively when a stack error was found * generic changeregsize(reg,size) for i386 register resizing diff --git a/compiler/i386/n386ld.pas b/compiler/i386/n386ld.pas index 870a45e03e..7c652dfc8b 100644 --- a/compiler/i386/n386ld.pas +++ b/compiler/i386/n386ld.pas @@ -42,9 +42,6 @@ interface procedure pass_2;override; end; - ti386arrayconstructornode = class(tarrayconstructornode) - procedure pass_2;override; - end; implementation @@ -55,7 +52,7 @@ implementation cginfo,cgbase,pass_2, nmem,ncon,ncnv, cpubase,cpuasm, - cga,tgobj,n386cnv,n386util,regvars,cgobj,cg64f32,rgobj,rgcpu; + cga,tgobj,n386util,ncgutil,regvars,cgobj,cg64f32,rgobj,rgcpu; {***************************************************************************** SecondLoad @@ -773,223 +770,19 @@ implementation end; end; - -{***************************************************************************** - SecondArrayConstruct -*****************************************************************************} - - const - vtInteger = 0; - vtBoolean = 1; - vtChar = 2; - vtExtended = 3; - vtString = 4; - vtPointer = 5; - vtPChar = 6; - vtObject = 7; - vtClass = 8; - vtWideChar = 9; - vtPWideChar = 10; - vtAnsiString = 11; - vtCurrency = 12; - vtVariant = 13; - vtInterface = 14; - vtWideString = 15; - vtInt64 = 16; - vtQWord = 17; - - procedure ti386arrayconstructornode.pass_2; - var - hp : tarrayconstructornode; - href : treference; - lt : tdef; - vaddr : boolean; - vtype : longint; - freetemp, - dovariant : boolean; - elesize : longint; - begin - dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant; - if dovariant then - elesize:=8 - else - elesize:=tarraydef(resulttype.def).elesize; - if not(nf_cargs in flags) then - begin - location_reset(location,LOC_REFERENCE,OS_NO); - { Allocate always a temp, also if no elements are required, to - be sure that location is valid (PFV) } - if tarraydef(resulttype.def).highrange=-1 then - tg.gettempofsizereference(exprasmlist,elesize,location.reference) - else - tg.gettempofsizereference(exprasmlist,(tarraydef(resulttype.def).highrange+1)*elesize,location.reference); - href:=location.reference; - end; - hp:=self; - while assigned(hp) do - begin - if assigned(hp.left) then - begin - freetemp:=true; - secondpass(hp.left); - if codegenerror then - exit; - if dovariant then - begin - { find the correct vtype value } - vtype:=$ff; - vaddr:=false; - lt:=hp.left.resulttype.def; - case lt.deftype of - enumdef, - orddef : - begin - if is_64bitint(lt) then - begin - case torddef(lt).typ of - s64bit: - vtype:=vtInt64; - u64bit: - vtype:=vtQWord; - end; - freetemp:=false; - vaddr:=true; - end - else if (lt.deftype=enumdef) or - is_integer(lt) then - vtype:=vtInteger - else - if is_boolean(lt) then - vtype:=vtBoolean - else - if (lt.deftype=orddef) and (torddef(lt).typ=uchar) then - vtype:=vtChar; - end; - floatdef : - begin - vtype:=vtExtended; - vaddr:=true; - freetemp:=false; - end; - procvardef, - pointerdef : - begin - if is_pchar(lt) then - vtype:=vtPChar - else - vtype:=vtPointer; - end; - classrefdef : - vtype:=vtClass; - objectdef : - begin - vtype:=vtObject; - end; - stringdef : - begin - if is_shortstring(lt) then - begin - vtype:=vtString; - vaddr:=true; - freetemp:=false; - end - else - if is_ansistring(lt) then - begin - vtype:=vtAnsiString; - freetemp:=false; - end - else - if is_widestring(lt) then - begin - vtype:=vtWideString; - freetemp:=false; - end; - end; - end; - if vtype=$ff then - internalerror(14357); - { write C style pushes or an pascal array } - if nf_cargs in flags then - begin - if vaddr then - begin - emit_to_mem(hp.left.location,hp.left.resulttype.def); - emit_push_lea_loc(hp.left.location,freetemp); - location_release(exprasmlist,hp.left.location); - end - else - cg.a_param_loc(exprasmlist,hp.left.location,-1); - inc(pushedparasize,4); - end - else - begin - { write changing field update href to the next element } - inc(href.offset,4); - if vaddr then - begin - emit_to_mem(hp.left.location,hp.left.resulttype.def); - emit_lea_loc_ref(hp.left.location,href,freetemp); - end - else - begin - location_release(exprasmlist,left.location); - cg.a_load_loc_ref(exprasmlist,hp.left.location,href); - end; - { update href to the vtype field and write it } - dec(href.offset,4); - emit_const_ref(A_MOV,S_L,vtype,href); - { goto next array element } - inc(href.offset,8); - end; - end - else - { normal array constructor of the same type } - begin - case elesize of - 1,2,4 : - begin - location_release(exprasmlist,left.location); - cg.a_load_loc_ref(exprasmlist,hp.left.location,href); - end; - 8 : - begin - if hp.left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then - begin - emit_reg_ref(A_MOV,S_L,hp.left.location.registerlow,href); - { update href to the high bytes and write it } - inc(href.offset,4); - emit_reg_ref(A_MOV,S_L,hp.left.location.registerhigh,href); - dec(href.offset,4) - end - else - concatcopy(hp.left.location.reference,href,elesize,freetemp,false); - end; - else - begin - { concatcopy only supports reference } - if not(hp.left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then - internalerror(200108012); - concatcopy(hp.left.location.reference,href,elesize,freetemp,false); - end; - end; - inc(href.offset,elesize); - end; - end; - { load next entry } - hp:=tarrayconstructornode(hp.right); - end; - end; - begin cloadnode:=ti386loadnode; cassignmentnode:=ti386assignmentnode; cfuncretnode:=ti386funcretnode; - carrayconstructornode:=ti386arrayconstructornode; end. { $Log$ - Revision 1.35 2002-04-15 19:44:21 peter + Revision 1.36 2002-04-19 15:39:35 peter + * removed some more routines from cga + * moved location_force_reg/mem to ncgutil + * moved arrayconstructnode secondpass to ncgld + + Revision 1.35 2002/04/15 19:44:21 peter * fixed stackcheck that would be called recursively when a stack error was found * generic changeregsize(reg,size) for i386 register resizing diff --git a/compiler/i386/n386mem.pas b/compiler/i386/n386mem.pas index 8ee17c5251..87dee20fd4 100644 --- a/compiler/i386/n386mem.pas +++ b/compiler/i386/n386mem.pas @@ -62,7 +62,7 @@ implementation cginfo,cgbase,pass_2, pass_1,nld,ncon,nadd, cpubase, - cgobj,cga,tgobj,n386util,rgobj; + cgobj,cga,tgobj,rgobj,ncgutil,n386util; {***************************************************************************** TI386NEWNODE @@ -663,7 +663,12 @@ begin end. { $Log$ - Revision 1.25 2002-04-15 19:12:09 carl + Revision 1.26 2002-04-19 15:39:35 peter + * removed some more routines from cga + * moved location_force_reg/mem to ncgutil + * moved arrayconstructnode secondpass to ncgld + + Revision 1.25 2002/04/15 19:12:09 carl + target_info.size_of_pointer -> pointer_size + some cleanup of unused types/variables * move several constants from cpubase to their specific units diff --git a/compiler/i386/n386set.pas b/compiler/i386/n386set.pas index 39af3c2688..f5573a60ee 100644 --- a/compiler/i386/n386set.pas +++ b/compiler/i386/n386set.pas @@ -50,7 +50,7 @@ implementation cginfo,cgbase,pass_2, ncon, cpubase, - cga,cgobj,tgobj,n386util,regvars,rgobj; + cga,cgobj,tgobj,ncgutil,n386util,regvars,rgobj; const bytes2Sxx:array[1..8] of Topsize=(S_B,S_W,S_NO,S_L,S_NO,S_NO,S_NO,S_Q); @@ -898,7 +898,7 @@ implementation { determines the size of the operand } opsize:=bytes2Sxx[left.resulttype.def.size]; { copy the case expression to a register } - location_force_reg(left.location,left.location.size,false); + location_force_reg(left.location,def_cgsize(left.resulttype.def),false); hregister:=left.location.register; if isjump then begin @@ -1030,7 +1030,12 @@ begin end. { $Log$ - Revision 1.22 2002-04-15 19:44:21 peter + Revision 1.23 2002-04-19 15:39:35 peter + * removed some more routines from cga + * moved location_force_reg/mem to ncgutil + * moved arrayconstructnode secondpass to ncgld + + Revision 1.22 2002/04/15 19:44:21 peter * fixed stackcheck that would be called recursively when a stack error was found * generic changeregsize(reg,size) for i386 register resizing diff --git a/compiler/i386/n386util.pas b/compiler/i386/n386util.pas index 8f8306e879..6e4e331376 100644 --- a/compiler/i386/n386util.pas +++ b/compiler/i386/n386util.pas @@ -29,8 +29,6 @@ interface uses symtype,node,cpubase,cginfo; - procedure location_force_reg(var l:tlocation;size:TCGSize;maybeconst:boolean); - function maybe_push(needed : byte;p : tnode;isint64 : boolean) : boolean; function maybe_pushfpu(needed : byte;p : tnode) : boolean; {$ifdef TEMPS_NOT_PUSH} @@ -63,158 +61,12 @@ implementation gdb, {$endif GDB} types, - ncon,nld, + ncgutil,ncon,nld, pass_1,pass_2, cgbase,tgobj, cga,regvars,cgobj,cg64f32,rgobj,rgcpu,cgcpu; - procedure location_force_reg(var l:tlocation;size:TCGSize;maybeconst:boolean); - var - hregister, - hregisterhi : tregister; - hl : tasmlabel; - begin - { release previous location before demanding a new register } - if (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then - begin - location_freetemp(exprasmlist,l); - location_release(exprasmlist,l); - end; - { handle transformations to 64bit separate } - if size in [OS_64,OS_S64] then - begin - if not (l.size in [OS_64,OS_S64]) then - begin - { load a smaller size to OS_64 } - if l.loc=LOC_REGISTER then - hregister:=Changeregsize(l.registerlow,S_L) - else - hregister:=rg.getregisterint(exprasmlist); - { load value in low register } - case l.loc of - LOC_FLAGS : - cg.g_flags2reg(exprasmlist,l.resflags,hregister); - LOC_JUMP : - begin - cg.a_label(exprasmlist,truelabel); - cg.a_load_const_reg(exprasmlist,OS_32,1,hregister); - getlabel(hl); - cg.a_jmp_cond(exprasmlist,OC_NONE,hl); - cg.a_label(exprasmlist,falselabel); - cg.a_load_const_reg(exprasmlist,OS_32,0,hregister); - cg.a_label(exprasmlist,hl); - end; - else - cg.a_load_loc_reg(exprasmlist,l,hregister); - end; - { reset hi part, take care of the signed bit of the current value } - hregisterhi:=rg.getregisterint(exprasmlist); - if (size=OS_S64) and - (l.size in [OS_S8,OS_S16,OS_S32]) then - begin - if l.loc=LOC_CONSTANT then - begin - if (longint(l.value)<0) then - cg.a_load_const_reg(exprasmlist,OS_32,$ffffffff,hregisterhi) - else - cg.a_load_const_reg(exprasmlist,OS_32,0,hregisterhi); - end - else - begin - cg.a_load_reg_reg(exprasmlist,OS_32,hregister,hregisterhi); - cg.a_op_const_reg(exprasmlist,OP_SAR,31,hregisterhi); - end; - end - else - cg.a_load_const_reg(exprasmlist,OS_32,0,hregisterhi); - location_reset(l,LOC_REGISTER,size); - l.registerlow:=hregister; - l.registerhigh:=hregisterhi; - end - else - begin - { 64bit to 64bit } - if (l.loc=LOC_REGISTER) or - ((l.loc=LOC_CREGISTER) and maybeconst) then - begin - hregister:=l.registerlow; - hregisterhi:=l.registerhigh; - end - else - begin - hregister:=rg.getregisterint(exprasmlist); - hregisterhi:=rg.getregisterint(exprasmlist); - end; - { load value in new register } - tcg64f32(cg).a_load64_loc_reg(exprasmlist,l,hregister,hregisterhi); - location_reset(l,LOC_REGISTER,size); - l.registerlow:=hregister; - l.registerhigh:=hregisterhi; - end; - end - else - begin - { transformations to 32bit or smaller } - if l.loc=LOC_REGISTER then - begin - { if the previous was 64bit release the high register } - if l.size in [OS_64,OS_S64] then - begin - rg.ungetregisterint(exprasmlist,l.registerhigh); - l.registerhigh:=R_NO; - end; - hregister:=l.register; - end - else - begin - { get new register } - if (l.loc=LOC_CREGISTER) and - maybeconst and - (TCGSize2Size[size]=TCGSize2Size[l.size]) then - hregister:=l.register - else - hregister:=rg.getregisterint(exprasmlist); - end; -{$ifdef i386} - hregister:=Changeregsize(hregister,TCGSize2Opsize[size]); -{$endif i386} - { load value in new register } - case l.loc of - LOC_FLAGS : - cg.g_flags2reg(exprasmlist,l.resflags,hregister); - LOC_JUMP : - begin - cg.a_label(exprasmlist,truelabel); - cg.a_load_const_reg(exprasmlist,size,1,hregister); - getlabel(hl); - cg.a_jmp_cond(exprasmlist,OC_NONE,hl); - cg.a_label(exprasmlist,falselabel); - cg.a_load_const_reg(exprasmlist,size,0,hregister); - cg.a_label(exprasmlist,hl); - end; - else - begin - { load_loc_reg can only handle size >= l.size, when the - new size is smaller then we need to adjust the size - of the orignal and maybe recalculate l.register for i386 } - if (TCGSize2Size[size]left.resulttype.def.size then + begin + { reuse the left location by default } + location_copy(location,left.location); + location_force_reg(location,newsize,false); + end + else + begin + { no special loading is required, reuse current location } + location_copy(location,left.location); + location.size:=newsize; + end; + end; + + procedure tcgtypeconvnode.second_cstring_to_pchar; var @@ -365,13 +395,51 @@ interface end; +{$ifdef TESTOBJEXT2} + procedure tcgtypeconvnode.checkobject; + begin + { no checking by default } + end; +{$endif TESTOBJEXT2} + + + procedure tcgtypeconvnode.pass_2; + begin + { the boolean routines can be called with LOC_JUMP and + call secondpass themselves in the helper } + if not(convtype in [tc_bool_2_int,tc_bool_2_bool,tc_int_2_bool]) then + begin + secondpass(left); + if codegenerror then + exit; + end; + + second_call_helper(convtype); + +{$ifdef TESTOBJEXT2} + { Check explicit conversions to objects pointers !! } + if p^.explizit and + (p^.resulttype.def.deftype=pointerdef) and + (tpointerdef(p^.resulttype.def).definition.deftype=objectdef) and not + (tobjectdef(tpointerdef(p^.resulttype.def).definition).isclass) and + ((tobjectdef(tpointerdef(p^.resulttype.def).definition).options and oo_hasvmt)<>0) and + (cs_check_range in aktlocalswitches) then + checkobject; +{$endif TESTOBJEXT2} + end; + begin ctypeconvnode := tcgtypeconvnode; end. { $Log$ - Revision 1.9 2002-04-15 19:44:19 peter + Revision 1.10 2002-04-19 15:39:34 peter + * removed some more routines from cga + * moved location_force_reg/mem to ncgutil + * moved arrayconstructnode secondpass to ncgld + + Revision 1.9 2002/04/15 19:44:19 peter * fixed stackcheck that would be called recursively when a stack error was found * generic changeregsize(reg,size) for i386 register resizing diff --git a/compiler/ncgld.pas b/compiler/ncgld.pas new file mode 100644 index 0000000000..f96ac39618 --- /dev/null +++ b/compiler/ncgld.pas @@ -0,0 +1,268 @@ +{ + $Id$ + Copyright (c) 1998-2000 by Florian Klaempfl + + Generate assembler for nodes that handle loads and assignments which + are the same for all (most) processors + + 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 ncgld; + +{$i defines.inc} + +interface + + uses + node,nld; + + type + tcgarrayconstructornode = class(tarrayconstructornode) + procedure pass_2;override; + end; + +implementation + + uses + systems, + verbose,globals, + symconst,symtype,symdef,symsym,symtable,aasm,types, + cginfo,cgbase,pass_2, + cpubase,cpuasm, + cga,tgobj,ncgutil,regvars,cgobj,cg64f32,rgobj,rgcpu; + +{***************************************************************************** + SecondArrayConstruct +*****************************************************************************} + + const + vtInteger = 0; + vtBoolean = 1; + vtChar = 2; + vtExtended = 3; + vtString = 4; + vtPointer = 5; + vtPChar = 6; + vtObject = 7; + vtClass = 8; + vtWideChar = 9; + vtPWideChar = 10; + vtAnsiString = 11; + vtCurrency = 12; + vtVariant = 13; + vtInterface = 14; + vtWideString = 15; + vtInt64 = 16; + vtQWord = 17; + + procedure tcgarrayconstructornode.pass_2; + var + hp : tarrayconstructornode; + href : treference; + lt : tdef; + vaddr : boolean; + vtype : longint; + freetemp, + dovariant : boolean; + elesize : longint; + tmpreg : tregister; + begin + dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant; + if dovariant then + elesize:=8 + else + elesize:=tarraydef(resulttype.def).elesize; + if not(nf_cargs in flags) then + begin + location_reset(location,LOC_REFERENCE,OS_NO); + { Allocate always a temp, also if no elements are required, to + be sure that location is valid (PFV) } + if tarraydef(resulttype.def).highrange=-1 then + tg.gettempofsizereference(exprasmlist,elesize,location.reference) + else + tg.gettempofsizereference(exprasmlist,(tarraydef(resulttype.def).highrange+1)*elesize,location.reference); + href:=location.reference; + end; + hp:=self; + while assigned(hp) do + begin + if assigned(hp.left) then + begin + freetemp:=true; + secondpass(hp.left); + if codegenerror then + exit; + if dovariant then + begin + { find the correct vtype value } + vtype:=$ff; + vaddr:=false; + lt:=hp.left.resulttype.def; + case lt.deftype of + enumdef, + orddef : + begin + if is_64bitint(lt) then + begin + case torddef(lt).typ of + s64bit: + vtype:=vtInt64; + u64bit: + vtype:=vtQWord; + end; + freetemp:=false; + vaddr:=true; + end + else if (lt.deftype=enumdef) or + is_integer(lt) then + vtype:=vtInteger + else + if is_boolean(lt) then + vtype:=vtBoolean + else + if (lt.deftype=orddef) and (torddef(lt).typ=uchar) then + vtype:=vtChar; + end; + floatdef : + begin + vtype:=vtExtended; + vaddr:=true; + freetemp:=false; + end; + procvardef, + pointerdef : + begin + if is_pchar(lt) then + vtype:=vtPChar + else + vtype:=vtPointer; + end; + classrefdef : + vtype:=vtClass; + objectdef : + begin + vtype:=vtObject; + end; + stringdef : + begin + if is_shortstring(lt) then + begin + vtype:=vtString; + vaddr:=true; + freetemp:=false; + end + else + if is_ansistring(lt) then + begin + vtype:=vtAnsiString; + freetemp:=false; + end + else + if is_widestring(lt) then + begin + vtype:=vtWideString; + freetemp:=false; + end; + end; + end; + if vtype=$ff then + internalerror(14357); + { write C style pushes or an pascal array } + if nf_cargs in flags then + begin + if vaddr then + begin + location_force_mem(hp.left.location); + cg.a_paramaddr_ref(exprasmlist,hp.left.location.reference,-1); + location_release(exprasmlist,hp.left.location); + if freetemp then + location_freetemp(exprasmlist,hp.left.location); + end + else + cg.a_param_loc(exprasmlist,hp.left.location,-1); + inc(pushedparasize,4); + end + else + begin + { write changing field update href to the next element } + inc(href.offset,4); + if vaddr then + begin + location_force_mem(hp.left.location); + tmpreg:=cg.get_scratch_reg(exprasmlist); + cg.a_loadaddr_ref_reg(exprasmlist,hp.left.location.reference,tmpreg); + cg.a_load_reg_ref(exprasmlist,cg.reg_cgsize(tmpreg),tmpreg,href); + cg.free_scratch_reg(exprasmlist,tmpreg); + location_release(exprasmlist,hp.left.location); + if freetemp then + location_freetemp(exprasmlist,hp.left.location); + end + else + begin + location_release(exprasmlist,left.location); + cg.a_load_loc_ref(exprasmlist,hp.left.location,href); + end; + { update href to the vtype field and write it } + dec(href.offset,4); + emit_const_ref(A_MOV,S_L,vtype,href); + { goto next array element } + inc(href.offset,8); + end; + end + else + { normal array constructor of the same type } + begin + case elesize of + 1,2,4 : + begin + location_release(exprasmlist,left.location); + cg.a_load_loc_ref(exprasmlist,hp.left.location,href); + end; + 8 : + begin + if hp.left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then + tcg64f32(cg).a_load64_loc_ref(exprasmlist,hp.left.location,href) + else + cg.g_concatcopy(exprasmlist,hp.left.location.reference,href,elesize,freetemp,false); + end; + else + begin + { concatcopy only supports reference } + if not(hp.left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then + internalerror(200108012); + cg.g_concatcopy(exprasmlist,hp.left.location.reference,href,elesize,freetemp,false); + end; + end; + inc(href.offset,elesize); + end; + end; + { load next entry } + hp:=tarrayconstructornode(hp.right); + end; + end; + +begin + carrayconstructornode:=tcgarrayconstructornode; +end. +{ + $Log$ + Revision 1.1 2002-04-19 15:39:34 peter + * removed some more routines from cga + * moved location_force_reg/mem to ncgutil + * moved arrayconstructnode secondpass to ncgld + +} diff --git a/compiler/ncgutil.pas b/compiler/ncgutil.pas index 95b356386b..d6b6d530bd 100644 --- a/compiler/ncgutil.pas +++ b/compiler/ncgutil.pas @@ -27,11 +27,16 @@ unit ncgutil; interface uses - node; + node, + cginfo, + cpubase; type tloadregvars = (lr_dont_load_regvars, lr_load_regvars); + procedure location_force_reg(var l:tlocation;size:TCGSize;maybeconst:boolean); + procedure location_force_mem(var l:tlocation); + {$ifdef TEMPS_NOT_PUSH} function maybe_savetotemp(needed : byte;p : tnode;isint64 : boolean) : boolean; procedure restorefromtemp(p : tnode;isint64 : boolean); @@ -46,9 +51,195 @@ implementation types, aasm,cgbase,regvars, ncon, - cpubase,tgobj,cpuinfo,cginfo,cgobj,cgcpu,rgobj,cg64f32; + tgobj,cpuinfo,cgobj,cgcpu,rgobj,cg64f32; +{***************************************************************************** + TLocation +*****************************************************************************} + + procedure location_force_reg(var l:tlocation;size:TCGSize;maybeconst:boolean); + var + hregister, + hregisterhi : tregister; + hl : tasmlabel; + begin + { release previous location before demanding a new register } + if (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then + begin + location_freetemp(exprasmlist,l); + location_release(exprasmlist,l); + end; + { handle transformations to 64bit separate } + if size in [OS_64,OS_S64] then + begin + if not (l.size in [OS_64,OS_S64]) then + begin + { load a smaller size to OS_64 } + if l.loc=LOC_REGISTER then + hregister:=Changeregsize(l.registerlow,S_L) + else + hregister:=rg.getregisterint(exprasmlist); + { load value in low register } + case l.loc of + LOC_FLAGS : + cg.g_flags2reg(exprasmlist,l.resflags,hregister); + LOC_JUMP : + begin + cg.a_label(exprasmlist,truelabel); + cg.a_load_const_reg(exprasmlist,OS_32,1,hregister); + getlabel(hl); + cg.a_jmp_cond(exprasmlist,OC_NONE,hl); + cg.a_label(exprasmlist,falselabel); + cg.a_load_const_reg(exprasmlist,OS_32,0,hregister); + cg.a_label(exprasmlist,hl); + end; + else + cg.a_load_loc_reg(exprasmlist,l,hregister); + end; + { reset hi part, take care of the signed bit of the current value } + hregisterhi:=rg.getregisterint(exprasmlist); + if (size=OS_S64) and + (l.size in [OS_S8,OS_S16,OS_S32]) then + begin + if l.loc=LOC_CONSTANT then + begin + if (longint(l.value)<0) then + cg.a_load_const_reg(exprasmlist,OS_32,$ffffffff,hregisterhi) + else + cg.a_load_const_reg(exprasmlist,OS_32,0,hregisterhi); + end + else + begin + cg.a_load_reg_reg(exprasmlist,OS_32,hregister,hregisterhi); + cg.a_op_const_reg(exprasmlist,OP_SAR,31,hregisterhi); + end; + end + else + cg.a_load_const_reg(exprasmlist,OS_32,0,hregisterhi); + location_reset(l,LOC_REGISTER,size); + l.registerlow:=hregister; + l.registerhigh:=hregisterhi; + end + else + begin + { 64bit to 64bit } + if (l.loc=LOC_REGISTER) or + ((l.loc=LOC_CREGISTER) and maybeconst) then + begin + hregister:=l.registerlow; + hregisterhi:=l.registerhigh; + end + else + begin + hregister:=rg.getregisterint(exprasmlist); + hregisterhi:=rg.getregisterint(exprasmlist); + end; + { load value in new register } + tcg64f32(cg).a_load64_loc_reg(exprasmlist,l,hregister,hregisterhi); + location_reset(l,LOC_REGISTER,size); + l.registerlow:=hregister; + l.registerhigh:=hregisterhi; + end; + end + else + begin + { transformations to 32bit or smaller } + if l.loc=LOC_REGISTER then + begin + { if the previous was 64bit release the high register } + if l.size in [OS_64,OS_S64] then + begin + rg.ungetregisterint(exprasmlist,l.registerhigh); + l.registerhigh:=R_NO; + end; + hregister:=l.register; + end + else + begin + { get new register } + if (l.loc=LOC_CREGISTER) and + maybeconst and + (TCGSize2Size[size]=TCGSize2Size[l.size]) then + hregister:=l.register + else + hregister:=rg.getregisterint(exprasmlist); + end; +{$ifdef i386} + hregister:=Changeregsize(hregister,TCGSize2Opsize[size]); +{$endif i386} + { load value in new register } + case l.loc of + LOC_FLAGS : + cg.g_flags2reg(exprasmlist,l.resflags,hregister); + LOC_JUMP : + begin + cg.a_label(exprasmlist,truelabel); + cg.a_load_const_reg(exprasmlist,size,1,hregister); + getlabel(hl); + cg.a_jmp_cond(exprasmlist,OC_NONE,hl); + cg.a_label(exprasmlist,falselabel); + cg.a_load_const_reg(exprasmlist,size,0,hregister); + cg.a_label(exprasmlist,hl); + end; + else + begin + { load_loc_reg can only handle size >= l.size, when the + new size is smaller then we need to adjust the size + of the orignal and maybe recalculate l.register for i386 } + if (TCGSize2Size[size] pointer_Size Revision 1.6 2002/04/06 18:10:42 jonas