From fdc1e9792c2b65a1e0850fc8fd3e9bb9aaa30790 Mon Sep 17 00:00:00 2001 From: florian Date: Thu, 5 Aug 1999 14:58:03 +0000 Subject: [PATCH] * some fixes for the floating point registers * more things for the new code generator --- compiler/cg386cnv.pas | 11 +- compiler/cgai386.pas | 10 +- compiler/cobjects.pas | 13 +- compiler/cpubase.pas | 7 +- compiler/new/alpha/cpubase.pas | 7 +- compiler/new/cgbase.pas | 10 +- compiler/new/cgobj.pas | 91 ++++-- compiler/new/nmem.pas | 490 ++++++++++++++++++++++++++++++- compiler/new/nstatmnt.pas | 12 +- compiler/new/pass_2.pas | 50 +++- compiler/new/powerpc/cpubase.pas | 9 +- compiler/new/tree.pas | 119 +++++++- 12 files changed, 769 insertions(+), 60 deletions(-) diff --git a/compiler/cg386cnv.pas b/compiler/cg386cnv.pas index feb31033a4..2a890d6578 100644 --- a/compiler/cg386cnv.pas +++ b/compiler/cg386cnv.pas @@ -762,8 +762,8 @@ implementation exprasmlist^.concat(new(pai386,op_ref(A_FILD,S_IL,r))); exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI))); end; - end; - + end; + inc(fpuvaroffset); clear_location(pto^.location); pto^.location.loc:=LOC_FPU; end; @@ -804,6 +804,7 @@ implementation clear_location(pto^.location); pto^.location.loc:=LOC_REGISTER; pto^.location.register:=rreg; + inc(fpuvaroffset); end; @@ -1468,7 +1469,11 @@ implementation end. { $Log$ - Revision 1.83 1999-08-04 13:45:19 florian + Revision 1.84 1999-08-05 14:58:03 florian + * some fixes for the floating point registers + * more things for the new code generator + + Revision 1.83 1999/08/04 13:45:19 florian + floating point register variables !! * pairegalloc is now generated for register variables diff --git a/compiler/cgai386.pas b/compiler/cgai386.pas index 8f161f6189..55421d83cf 100644 --- a/compiler/cgai386.pas +++ b/compiler/cgai386.pas @@ -1197,10 +1197,12 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister); r^.offset:=para_offset-pushedparasize; end; exprasmlist^.concat(new(pai386,op_ref(op,opsize,r))); + dec(fpuvaroffset); end; LOC_CFPUREGISTER: begin - exprasmlist^.concat(new(pai386,op_reg(A_FLD,S_NO,p^.location.register))); + exprasmlist^.concat(new(pai386,op_reg(A_FLD,S_NO, + correct_fpuregister(p^.location.register,fpuvaroffset)))); size:=align(pfloatdef(p^.resulttype)^.size,alignment); inc(pushedparasize,size); if not inlined then @@ -3161,7 +3163,11 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister); end. { $Log$ - Revision 1.25 1999-08-04 13:45:24 florian + Revision 1.26 1999-08-05 14:58:04 florian + * some fixes for the floating point registers + * more things for the new code generator + + Revision 1.25 1999/08/04 13:45:24 florian + floating point register variables !! * pairegalloc is now generated for register variables diff --git a/compiler/cobjects.pas b/compiler/cobjects.pas index 21f2ab75c7..60fd253247 100644 --- a/compiler/cobjects.pas +++ b/compiler/cobjects.pas @@ -96,6 +96,8 @@ unit cobjects; first,last : plinkedlist_item; constructor init; destructor done; + { destructors the linkedlist without cleaning the items up } + destructor done_noclear; { disposes the items of the list } procedure clear; @@ -922,10 +924,15 @@ end; destructor tlinkedlist.done; + begin clear; end; + destructor tlinkedlist.done_noclear; + + begin + end; procedure tlinkedlist.clear; var @@ -2209,7 +2216,11 @@ end; end. { $Log$ - Revision 1.38 1999-07-18 10:19:46 florian + Revision 1.39 1999-08-05 14:58:07 florian + * some fixes for the floating point registers + * more things for the new code generator + + Revision 1.38 1999/07/18 10:19:46 florian * made it compilable with Dlephi 4 again + fixed problem with large stack allocations on win32 diff --git a/compiler/cpubase.pas b/compiler/cpubase.pas index e6beb2c523..41435df32e 100644 --- a/compiler/cpubase.pas +++ b/compiler/cpubase.pas @@ -716,6 +716,7 @@ const frame_pointer = R_EBP; self_pointer = R_ESI; accumulator = R_EAX; + scratchregister = R_EDI; cpuflags : set of tcpuflags = []; @@ -1010,7 +1011,11 @@ begin end. { $Log$ - Revision 1.2 1999-08-04 13:45:25 florian + Revision 1.3 1999-08-05 14:58:09 florian + * some fixes for the floating point registers + * more things for the new code generator + + Revision 1.2 1999/08/04 13:45:25 florian + floating point register variables !! * pairegalloc is now generated for register variables diff --git a/compiler/new/alpha/cpubase.pas b/compiler/new/alpha/cpubase.pas index 4d018f8893..d40c93aa38 100644 --- a/compiler/new/alpha/cpubase.pas +++ b/compiler/new/alpha/cpubase.pas @@ -101,6 +101,7 @@ Const frame_pointer = R_15; self_pointer = R_16; accumulator = R_0; + scratchregister = R_14; { sizes } pointersize = 8; @@ -231,7 +232,11 @@ end; end. { $Log$ - Revision 1.5 1999-08-03 17:09:48 florian + Revision 1.6 1999-08-05 14:58:17 florian + * some fixes for the floating point registers + * more things for the new code generator + + Revision 1.5 1999/08/03 17:09:48 florian * the alpha compiler can be compiled now Revision 1.4 1999/08/03 15:52:40 michael diff --git a/compiler/new/cgbase.pas b/compiler/new/cgbase.pas index d5c5377bfb..3c3dcd603b 100644 --- a/compiler/new/cgbase.pas +++ b/compiler/new/cgbase.pas @@ -35,6 +35,10 @@ unit cgbase; pi_C_import = $10; { set, if the procedure is an external C function } pi_uses_exceptions = $20;{ set, if the procedure has a try statement => } { no register variables } + pi_is_assembler = $40; { set if the procedure is declared as ASSEMBLER + => don't optimize} + pi_needs_implicit_finally = $80; { set, if the procedure contains data which } + { needs to be finalized } type pprocinfo = ^tprocinfo; @@ -393,7 +397,11 @@ unit cgbase; end. { $Log$ - Revision 1.6 1999-08-04 00:23:51 florian + Revision 1.7 1999-08-05 14:58:10 florian + * some fixes for the floating point registers + * more things for the new code generator + + Revision 1.6 1999/08/04 00:23:51 florian * renamed i386asm and i386base to cpuasm and cpubase Revision 1.5 1999/08/01 18:22:32 florian diff --git a/compiler/new/cgobj.pas b/compiler/new/cgobj.pas index a4b2ad1330..1801cce628 100644 --- a/compiler/new/cgobj.pas +++ b/compiler/new/cgobj.pas @@ -42,14 +42,10 @@ unit cgobj; { code generation for subroutine entry/exit code } { helper routines } - procedure g_initialize_data(p : psym); - procedure g_incr_data(p : psym); - procedure g_finalize_data(p : pnamedindexobject); -{$ifndef VALUEPARA} - procedure g_copyopenarrays(p : pnamedindexobject); -{$else} - procedure g_copyvalueparas(p : pnamedindexobject); -{$endif} + procedure g_initialize_data(list : paasmoutput;p : psym); + procedure g_incr_data(list : paasmoutput;p : psym); + procedure g_finalize_data(list : paasmoutput;p : pnamedindexobject); + procedure g_copyvalueparas(list : paasmoutput;p : pnamedindexobject); procedure g_entrycode(list : paasmoutput; const proc_names : tstringcontainer;make_global : boolean; @@ -75,6 +71,7 @@ unit cgobj; procedure a_load_const32_ref(list : paasmoutput;l : longint;const ref : treference);virtual; procedure a_load_const64_ref(list : paasmoutput;q : qword;const ref : treference);virtual; + procedure a_loadaddress_ref_reg(list : paasmoutput;ref : treference;r : tregister);virtual; procedure g_stackframe_entry(list : paasmoutput;localsize : longint);virtual; procedure g_maybe_loadself(list : paasmoutput);virtual; @@ -99,6 +96,7 @@ unit cgobj; procedure a_param_const16(list : paasmoutput;w : word;nr : longint);virtual; procedure a_param_const32(list : paasmoutput;l : longint;nr : longint);virtual; procedure a_param_const64(list : paasmoutput;q : qword;nr : longint);virtual; + procedure a_param_ref(list : paasmoutput;r : treference;nr : longint);virtual; end; var @@ -170,6 +168,13 @@ unit cgobj; {!!!!!!!! a_push_const64(list,q); } end; + procedure tcg.a_param_ref(list : paasmoutput;r : treference;nr : longint); + + begin + a_loadaddress_ref_reg(list,r,scratchregister); + a_param_reg(list,scratchregister,nr); + end; + procedure tcg.g_stackcheck(list : paasmoutput;stackframesize : longint); begin @@ -225,21 +230,40 @@ unit cgobj; *****************************************************************************} { generates the code for initialisation of local data } - procedure tcg.g_initialize_data(p : psym); + procedure tcg.g_initialize_data(list : paasmoutput;p : psym); begin runerror(255); end; { generates the code for incrementing the reference count of parameters } - procedure tcg.g_incr_data(p : psym); + procedure tcg.g_incr_data(list : paasmoutput;p : psym); + + var + hr : treference; begin - runerror(255); + if (psym(p)^.typ=varsym) and + not((pvarsym(p)^.definition^.deftype=objectdef) and + pobjectdef(pvarsym(p)^.definition)^.is_class) and + pvarsym(p)^.definition^.needs_inittable and + ((pvarsym(p)^.varspez=vs_value)) then + begin + procinfo.flags:=procinfo.flags or pi_needs_implicit_finally; + reset_reference(hr); + hr.symbol:=pvarsym(p)^.definition^.get_inittable_label; + a_param_ref(list,hr,2); + reset_reference(hr); + hr.base:=procinfo.framepointer; + hr.offset:=pvarsym(p)^.address+procinfo.call_offset; + a_param_ref(list,hr,1); + reset_reference(hr); + a_call_name(list,'FPC_ADDREF',0); + end; end; { generates the code for finalisation of local data } - procedure tcg.g_finalize_data(p : pnamedindexobject); + procedure tcg.g_finalize_data(list : paasmoutput;p : pnamedindexobject); begin runerror(255); @@ -247,36 +271,39 @@ unit cgobj; { generates the code to make local copies of the value parameters } - procedure tcg.g_copyopenarrays(p : pnamedindexobject); + procedure tcg.g_copyvalueparas(list : paasmoutput;p : pnamedindexobject); begin runerror(255); end; + var + _list : paasmoutput; + { wrappers for the methods, because TP doesn't know procedures } { of objects } - procedure _copyopenarrays(s : pnamedindexobject);{$ifndef FPC}far;{$endif} + procedure _copyvalueparas(s : pnamedindexobject);{$ifndef FPC}far;{$endif} begin - cg^.g_copyopenarrays(s); + cg^.g_copyvalueparas(_list,s); end; procedure _finalize_data(s : pnamedindexobject);{$ifndef FPC}far;{$endif} begin - cg^.g_finalize_data(s); + cg^.g_finalize_data(_list,s); end; procedure _incr_data(s : pnamedindexobject);{$ifndef FPC}far;{$endif} begin - cg^.g_incr_data(psym(s)); + cg^.g_incr_data(_list,psym(s)); end; procedure _initialize_data(s : pnamedindexobject);{$ifndef FPC}far;{$endif} begin - cg^.g_initialize_data(psym(s)); + cg^.g_initialize_data(_list,psym(s)); end; { generates the entry code for a procedure } @@ -384,8 +411,8 @@ unit cgobj; begin if procinfo._class^.isclass then begin - list^.insert(new(pai386,op_cond_sym(A_Jcc,C_Z,S_NO,quickexitlabel))); - list^.insert(new(pai386,op_sym(A_CALL,S_NO,newasmsymbol('FPC_NEW_CLASS')))); + list^.concat(new(pai386,op_sym(A_CALL,S_NO,newasmsymbol('FPC_NEW_CLASS')))); + list^.concat(new(pai386,op_cond_sym(A_Jcc,C_Z,S_NO,quickexitlabel))); end else begin @@ -414,15 +441,10 @@ unit cgobj; a_load_const32_ref(list,0,hr); end; + _list:=list; { generate copies of call by value parameters } if (po_assembler in aktprocsym^.definition^.procoptions) then - begin - {$ifndef VALUEPARA} - aktprocsym^.definition^.parast^.foreach({$ifdef FPC}@{$endif FPC}_copyopenarrays); - {$else} - aktprocsym^.definition^.parast^.foreach({$ifdef FPC}@{$endif FPC}_copyvalueparas); - {$endif} - end; + aktprocsym^.definition^.parast^.foreach({$ifdef FPC}@{$endif FPC}_copyvalueparas); { initialisizes local data } aktprocsym^.definition^.localst^.foreach({$ifdef FPC}@{$endif FPC}_initialize_data); @@ -484,7 +506,6 @@ unit cgobj; begin {$ifdef dummy} { !!!! insert there automatic destructors } - curlist:=list; if aktexitlabel^.is_used then list^.insert(new(pai_label,init(aktexitlabel))); @@ -505,7 +526,7 @@ unit cgobj; concat_external('FPC_HELP_DESTRUCTOR',EXT_NEAR); end; end; - + _list:=list; { finalize local data } aktprocsym^.definition^.localst^.foreach({$ifdef FPC}@{$endif FPC}finalize_data); @@ -671,10 +692,20 @@ unit cgobj; abstract; end; + procedure tcg.a_loadaddress_ref_reg(list : paasmoutput;ref : treference;r : tregister); + + begin + abstract; + end; + end. { $Log$ - Revision 1.10 1999-08-04 00:23:52 florian + Revision 1.11 1999-08-05 14:58:11 florian + * some fixes for the floating point registers + * more things for the new code generator + + Revision 1.10 1999/08/04 00:23:52 florian * renamed i386asm and i386base to cpuasm and cpubase Revision 1.9 1999/08/02 23:13:21 florian diff --git a/compiler/new/nmem.pas b/compiler/new/nmem.pas index 604c9427e2..a5317df479 100644 --- a/compiler/new/nmem.pas +++ b/compiler/new/nmem.pas @@ -35,7 +35,21 @@ unit nmem; is_absolute,is_first,is_methodpointer : boolean; constructor init(v : pvarsym;st : psymtable); destructor done;virtual; + procedure det_temp;virtual; + procedure det_resulttype;virtual; + procedure secondpass;virtual; + end; + tassigntyp = (at_normal,at_plus,at_minus,at_star,at_slash); + + passignmentnode = ^tassignmentnode; + tassignmentnode = object(tbinarynode) + assigntyp : tassigntyp; + concat_string : boolean; + constructor init(l,r : pnode); + destructor done;virtual; + procedure det_temp;virtual; + procedure det_resulttype;virtual; procedure secondpass;virtual; end; @@ -116,7 +130,7 @@ unit nmem; end {$ifdef i386} - { DLL variable, DLL variables are onyl available on the win32 target } + { DLL variable, DLL variables are only available on the win32 target } { maybe we've to add this later for the alpha WinNT } else if (pvarsym(symtableentry)^.var_options and vo_is_dll_var)<>0 then begin @@ -134,9 +148,17 @@ unit nmem; { in case it is a register variable: } if pvarsym(symtableentry)^.reg<>R_NO then begin - location.loc:=LOC_CREGISTER; + if pvarsym(p^.symtableentry)^.reg in fpureg then + begin + location.loc:=LOC_CFPUREGISTER; + tg.unusedregsfpu:=tg.unusedregsfpu-[pvarsym(symtableentry)^.reg]; + end + else + begin + location.loc:=LOC_CREGISTER; + tg.unusedregsint:=tg.unusedregsint-[pvarsym(symtableentry)^.reg]; + end; location.register:=pvarsym(symtableentry)^.reg; - tg.unusedregsint:=tg.unusedregsint-[pvarsym(symtableentry)^.reg]; end else begin @@ -268,10 +290,470 @@ unit nmem; end; end; +{**************************************************************************** + TASSIGNMENTNODE + ****************************************************************************} + + constructor tassignmentnode.init(l,r : pnode); + + begin + inherited init(l,r); + concat_string:=false; + assigntyp:=at_normal; + end; + + destructor tassignmentnode.done; + + begin + inherited done; + end; + + procedure tassignmentnode.det_temp; + + begin + store_valid:=must_be_valid; + must_be_valid:=false; + + { must be made unique } + set_unique(p^.left); + + firstpass(p^.left); + if codegenerror then + exit; + + { test if we can avoid copying string to temp + as in s:=s+...; (PM) } + must_be_valid:=true; + firstpass(p^.right); + must_be_valid:=store_valid; + if codegenerror then + exit; + + { some string functions don't need conversion, so treat them separatly } + if is_shortstring(p^.left^.resulttype) and (assigned(p^.right^.resulttype)) then + begin + if not (is_shortstring(p^.right^.resulttype) or + is_ansistring(p^.right^.resulttype) or + is_char(p^.right^.resulttype)) then + begin + p^.right:=gentypeconvnode(p^.right,p^.left^.resulttype); + firstpass(p^.right); + if codegenerror then + exit; + end; + { we call STRCOPY } + procinfo.flags:=procinfo.flags or pi_do_call; + hp:=p^.right; + end + else + begin + p^.right:=gentypeconvnode(p^.right,p^.left^.resulttype); + firstpass(p^.right); + if codegenerror then + exit; + end; + + { set assigned flag for varsyms } + if (p^.left^.treetype=loadn) and + (p^.left^.symtableentry^.typ=varsym) and + (pvarsym(p^.left^.symtableentry)^.varstate=vs_declared) then + pvarsym(p^.left^.symtableentry)^.varstate:=vs_assigned; + + p^.registersint:=p^.left^.registersint+p^.right^.registersint; + p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu); + p^.registersmm:=max(p^.left^.registersmm,p^.right^.registersmm); + end; + + procedure tassignmentnode.det_resulttype; + + begin + inherited det_resulttype; + resulttype:=voiddef; + { assignements to open arrays aren't allowed } + if is_open_array(p^.left^.resulttype) then + CGMessage(type_e_mismatch); + end; + + procedure tassignmentnode.secondpass; + + begin + { calculate left sides } + if not(p^.concat_string) then + secondpass(p^.left); + + if codegenerror then + exit; + + case p^.left^.location.loc of + LOC_REFERENCE : begin + { in case left operator uses to register } + { but to few are free then LEA } + if (p^.left^.location.reference.base<>R_NO) and + (p^.left^.location.reference.index<>R_NO) and + (usablereg32objectdef) or + not(pobjectdef(p^.right^.resulttype)^.is_class)) then + begin + { this would be a problem } + if not(p^.left^.resulttype^.needs_inittable) then + internalerror(3457); + + { increment source reference counter } + new(r); + reset_reference(r^); + r^.symbol:=p^.right^.resulttype^.get_inittable_label; + emitpushreferenceaddr(r^); + + emitpushreferenceaddr(p^.right^.location.reference); + exprasmlist^.concat(new(pai386, + op_sym(A_CALL,S_NO,newasmsymbol('FPC_ADDREF')))); + { decrement destination reference counter } + new(r); + reset_reference(r^); + r^.symbol:=p^.left^.resulttype^.get_inittable_label; + emitpushreferenceaddr(r^); + emitpushreferenceaddr(p^.left^.location.reference); + exprasmlist^.concat(new(pai386, + op_sym(A_CALL,S_NO,newasmsymbol('FPC_DECREF')))); + end; + +{$ifdef regallocfix} + concatcopy(p^.right^.location.reference, + p^.left^.location.reference,p^.left^.resulttype^.size,true,false); + ungetiftemp(p^.right^.location.reference); +{$Else regallocfix} + concatcopy(p^.right^.location.reference, + p^.left^.location.reference,p^.left^.resulttype^.size,false,false); + ungetiftemp(p^.right^.location.reference); +{$endif regallocfix} + end; + end; +{$ifdef SUPPORT_MMX} + LOC_CMMXREGISTER, + LOC_MMXREGISTER: + begin + if loc=LOC_CMMXREGISTER then + exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVQ,S_NO, + p^.right^.location.register,p^.left^.location.register))) + else + exprasmlist^.concat(new(pai386,op_reg_ref(A_MOVQ,S_NO, + p^.right^.location.register,newreference(p^.left^.location.reference)))); + end; +{$endif SUPPORT_MMX} + LOC_REGISTER, + LOC_CREGISTER : begin + case p^.right^.resulttype^.size of + 1 : opsize:=S_B; + 2 : opsize:=S_W; + 4 : opsize:=S_L; + 8 : opsize:=S_L; + end; + { simplified with op_reg_loc } + if loc=LOC_CREGISTER then + begin + exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,opsize, + p^.right^.location.register, + p^.left^.location.register))); +{$IfDef regallocfix} + ungetregister(p^.right^.location.register); +{$EndIf regallocfix} + end + else + Begin + exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize, + p^.right^.location.register, + newreference(p^.left^.location.reference)))); +{$IfDef regallocfix} + ungetregister(p^.right^.location.register); + del_reference(p^.left^.location.reference); +{$EndIf regallocfix} + end; + if is_64bitint(p^.right^.resulttype) then + begin + { simplified with op_reg_loc } + if loc=LOC_CREGISTER then + exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,opsize, + p^.right^.location.registerhigh, + p^.left^.location.registerhigh))) + else + begin + r:=newreference(p^.left^.location.reference); + inc(r^.offset,4); + exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize, + p^.right^.location.registerhigh,r))); + end; + end; + {exprasmlist^.concat(new(pai386,op_reg_loc(A_MOV,opsize, + p^.right^.location.register, + p^.left^.location))); } + + end; + LOC_FPU : begin + if (p^.left^.resulttype^.deftype=floatdef) then + fputyp:=pfloatdef(p^.left^.resulttype)^.typ + else + if (p^.right^.resulttype^.deftype=floatdef) then + fputyp:=pfloatdef(p^.right^.resulttype)^.typ + else + if (p^.right^.treetype=typeconvn) and + (p^.right^.left^.resulttype^.deftype=floatdef) then + fputyp:=pfloatdef(p^.right^.left^.resulttype)^.typ + else + fputyp:=s32real; + case loc of + LOC_CFPUREGISTER: + begin + exprasmlist^.concat(new(pai386,op_reg(A_FSTP,S_NO, + correct_fpuregister(p^.left^.location.register,fpuvaroffset)))); + dec(fpuvaroffset); + end; + LOC_REFERENCE: + floatstore(fputyp,p^.left^.location.reference); + else + internalerror(48991); + end; + end; + LOC_CFPUREGISTER: begin + if (p^.left^.resulttype^.deftype=floatdef) then + fputyp:=pfloatdef(p^.left^.resulttype)^.typ + else + if (p^.right^.resulttype^.deftype=floatdef) then + fputyp:=pfloatdef(p^.right^.resulttype)^.typ + else + if (p^.right^.treetype=typeconvn) and + (p^.right^.left^.resulttype^.deftype=floatdef) then + fputyp:=pfloatdef(p^.right^.left^.resulttype)^.typ + else + fputyp:=s32real; + exprasmlist^.concat(new(pai386,op_reg(A_FLD,S_NO, + correct_fpuregister(p^.right^.location.register,fpuvaroffset)))); + inc(fpuvaroffset); + case loc of + LOC_CFPUREGISTER: + begin + exprasmlist^.concat(new(pai386,op_reg(A_FSTP,S_NO, + correct_fpuregister(p^.right^.location.register,fpuvaroffset)))); + dec(fpuvaroffset); + end; + LOC_REFERENCE: + floatstore(fputyp,p^.left^.location.reference); + else + internalerror(48992); + end; + end; + LOC_JUMP : begin + getlabel(hlabel); + emitlab(truelabel); + if loc=LOC_CREGISTER then + exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_B, + 1,p^.left^.location.register))) + else + exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_B, + 1,newreference(p^.left^.location.reference)))); + {exprasmlist^.concat(new(pai386,op_const_loc(A_MOV,S_B, + 1,p^.left^.location)));} + emitjmp(C_None,hlabel); + emitlab(falselabel); + if loc=LOC_CREGISTER then + exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_B, + p^.left^.location.register, + p^.left^.location.register))) + else + begin + exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_B, + 0,newreference(p^.left^.location.reference)))); +{$IfDef regallocfix} + del_reference(p^.left^.location.reference); +{$EndIf regallocfix} + end; + emitlab(hlabel); + end; + LOC_FLAGS : begin + if loc=LOC_CREGISTER then + emit_flag2reg(p^.right^.location.resflags,p^.left^.location.register) + else + begin + ai:=new(pai386,op_ref(A_Setcc,S_B,newreference(p^.left^.location.reference))); + ai^.SetCondition(flag_2_cond[p^.right^.location.resflags]); + exprasmlist^.concat(ai); + end; +{$IfDef regallocfix} + del_reference(p^.left^.location.reference); +{$EndIf regallocfix} + end; + end; + end; + end. { $Log$ - Revision 1.5 1999-08-04 00:23:56 florian + Revision 1.6 1999-08-05 14:58:13 florian + * some fixes for the floating point registers + * more things for the new code generator + + Revision 1.5 1999/08/04 00:23:56 florian * renamed i386asm and i386base to cpuasm and cpubase Revision 1.4 1999/08/03 17:09:45 florian diff --git a/compiler/new/nstatmnt.pas b/compiler/new/nstatmnt.pas index 5c53ff964e..d5befbfb10 100644 --- a/compiler/new/nstatmnt.pas +++ b/compiler/new/nstatmnt.pas @@ -30,9 +30,9 @@ unit nstatmnt; type pblocknode = ^tblocknode; tblocknode = object(tunarynode) - constructor init(l : pnode); - procedure det_temp;virtual; - procedure det_resulttype;virtual; + constructor init(l : pnode); + procedure det_temp;virtual; + procedure det_resulttype;virtual; procedure secondpass;virtual; end; @@ -146,7 +146,11 @@ unit nstatmnt; end. { $Log$ - Revision 1.3 1999-08-02 17:14:09 florian + Revision 1.4 1999-08-05 14:58:14 florian + * some fixes for the floating point registers + * more things for the new code generator + + Revision 1.3 1999/08/02 17:14:09 florian + changed the temp. generator to an object Revision 1.2 1999/08/01 23:36:43 florian diff --git a/compiler/new/pass_2.pas b/compiler/new/pass_2.pas index b811febe1f..2c3720eb0e 100644 --- a/compiler/new/pass_2.pas +++ b/compiler/new/pass_2.pas @@ -132,12 +132,25 @@ implementation cg^.g_maybe_loadself(exprasmlist); end; + function generateexprlist(p : pnode) : plinkedlist; + + var + l : plinkedlist; + + begin + l:=new(plinkedlist,init); + p^.concattolist(l); + generateexprlist:=l; + end; + procedure secondpass(p : pnode); var oldcodegenerror : boolean; oldlocalswitches : tlocalswitches; oldpos : tfileposinfo; + l : plinkedlist; + hp : pnode; begin if not(p^.error) then @@ -149,9 +162,35 @@ implementation aktfilepos:=p^.fileinfo; aktlocalswitches:=p^.localswitches; codegenerror:=false; - p^.secondpass; - p^.error:=codegenerror; + { do we have a list of statements? } + if p^.treetype=statementn then + begin + l:=generateexprlist(p); + { here we should do CSE and node reordering } + hp:=pnode(l^.first); + while assigned(hp) do + begin + if assigned(hp^.parent) then + begin + if nf_needs_truefalselabel in hp^.parent^.flags then + begin + if not(assigned(punarynode(hp^.parent)^.truelabel)) then + getlabel(punarynode(hp^.parent)^.truelabel); + if not(assigned(punarynode(hp^.parent)^.falselabel)) then + getlabel(punarynode(hp^.parent)^.falselabel); + truelabel:=punarynode(hp^.parent)^.truelabel; + falselabel:=punarynode(hp^.parent)^.falselabel; + end; + end; + hp^.secondpass; + hp:=pnode(hp^.next); + end; + end + else + p^.secondpass; + + p^.error:=codegenerror; codegenerror:=codegenerror or oldcodegenerror; aktlocalswitches:=oldlocalswitches; aktfilepos:=oldpos; @@ -409,6 +448,7 @@ implementation if assigned(aktprocsym) and (pocall_inline in aktprocsym^.definition^.proccalloptions) then make_const_global:=true; + do_secondpass(p); if assigned(procinfo.def) then @@ -424,7 +464,11 @@ implementation end. { $Log$ - Revision 1.5 1999-08-04 00:23:58 florian + Revision 1.6 1999-08-05 14:58:15 florian + * some fixes for the floating point registers + * more things for the new code generator + + Revision 1.5 1999/08/04 00:23:58 florian * renamed i386asm and i386base to cpuasm and cpubase Revision 1.4 1999/08/03 17:09:46 florian diff --git a/compiler/new/powerpc/cpubase.pas b/compiler/new/powerpc/cpubase.pas index b9fc5c6e19..2b1955375b 100644 --- a/compiler/new/powerpc/cpubase.pas +++ b/compiler/new/powerpc/cpubase.pas @@ -347,7 +347,7 @@ type tcpuflags = (cf_registers64);} const - availabletempregsint = [R_0,R_11..R_30]; + availabletempregsint = [R_11..R_30]; availabletempregsfpu = [R_F14..R_F31]; availabletempregsmm = [R_M0..R_M31]; @@ -372,6 +372,7 @@ const frame_pointer = R_31; self_pointer = R_9; accumulator = R_3; + scratchregister = R_0; (* cpuflags : set of tcpuflags = []; *) @@ -463,7 +464,11 @@ end; end. { $Log$ - Revision 1.2 1999-08-04 12:59:25 jonas + Revision 1.3 1999-08-05 14:58:18 florian + * some fixes for the floating point registers + * more things for the new code generator + + Revision 1.2 1999/08/04 12:59:25 jonas * all tokes now start with an underscore * PowerPC compiles!! diff --git a/compiler/new/tree.pas b/compiler/new/tree.pas index 49b45f9d97..b75c5221da 100644 --- a/compiler/new/tree.pas +++ b/compiler/new/tree.pas @@ -170,12 +170,20 @@ unit tree; less,greater : pcaserecord; end; + tnodeflags = (nf_needs_truefalselabel,tf_callunique); + + tnodeflagset = set of tnodeflags; + pnode = ^tnode; - tnode = object + tnode = object(tlinkedlist_item) treetype : ttreetyp; { the location of the result of this node } location : tlocation; - + { the parent node of this is node } + { this field is set by concattolist } + parent : pnode; + { there are some properties about the node stored } + flags : tnodeflagset; { the number of registers needed to evalute the node } registersint,registersfpu : longint; { must be longint !!!! } {$ifdef SUPPORT_MMX} @@ -204,6 +212,8 @@ unit tree; { to write a complete tree } procedure dowrite;virtual; {$endif EXTDEBUG} + procedure concattolist(l : plinkedlist);virtual; + function ischild(p : pnode) : boolean;virtual; end; { allows to determine which elementes are to be replaced } @@ -269,21 +279,38 @@ unit tree; arrayconstructn : (cargs,cargswap: boolean); end; + { this node is the anchestor for all classes with at least } + { one child, you have to use it if you want to use } + { true- and falselabel } punarynode = ^tunarynode; tunarynode = object(tnode) left : pnode; + truelabel,falselabel : pasmlabel; {$ifdef extdebug} procedure dowrite;virtual; {$endif extdebug} constructor init(l : pnode); + procedure concattolist(l : plinkedlist);virtual; + function ischild(p : pnode) : boolean;virtual; + procedure det_resulttype;virtual; + procedure det_temp;virtual; end; pbinarynode = ^tbinarynode; tbinarynode = object(tunarynode) right : pnode; constructor init(l,r : pnode); + procedure concattolist(l : plinkedlist);virtual; + function ischild(p : pnode) : boolean;virtual; + procedure det_resulttype;virtual; + procedure det_temp;virtual; end; + pvecnode = ^tvecnode; + tvecnode = object(tbinarynode) + end; + + pbinopnode = ^tbinopnode; tbinopnode = object(tbinarynode) { is true, if the right and left operand are swaped } @@ -379,7 +406,7 @@ unit tree; { sets the callunique flag, if the node is a vecn, } { takes care of type casts etc. } - procedure set_unique(p : ptree); + procedure set_unique(p : pnode); { gibt den ordinalen Werten der Node zurueck oder falls sie } { keinen ordinalen Wert hat, wird ein Fehler erzeugt } @@ -423,6 +450,7 @@ unit tree; constructor tnode.init; begin + inherited init; treetype:=nothingn; { this allows easier error tracing } location.loc:=LOC_INVALID; @@ -435,6 +463,7 @@ unit tree; {$ifdef SUPPORT_MMX} registersmmx:=0; {$endif SUPPORT_MMX} + flags:=[]; end; destructor tnode.done; @@ -477,6 +506,18 @@ unit tree; abstract; end; + procedure tnode.concattolist(l : plinkedlist); + + begin + l^.concat(@self); + end; + + function tnode.ischild(p : pnode) : boolean; + + begin + ischild:=false; + end; + {$ifdef EXTDEBUG} procedure tnode.dowrite; @@ -587,7 +628,33 @@ unit tree; writeln(')'); dec(byte(indention[0]),2); end; -{$endif} +{$endif} + + procedure tunarynode.concattolist(l : plinkedlist); + + begin + left^.parent:=@self; + left^.concattolist(l); + inherited concattolist(l); + end; + + function tunarynode.ischild(p : pnode) : boolean; + + begin + ischild:=p=left; + end; + + procedure tunarynode.det_resulttype; + + begin + left^.det_resulttype; + end; + + procedure tunarynode.det_temp; + + begin + left^.det_temp; + end; {**************************************************************************** TBINARYNODE @@ -600,6 +667,38 @@ unit tree; right:=r end; + procedure tbinarynode.concattolist(l : plinkedlist); + + begin + { we could change that depending on the number of } + { required registers } + left^.parent:=@self; + left^.concattolist(l); + left^.parent:=@self; + left^.concattolist(l); + inherited concattolist(l); + end; + + function tbinarynode.ischild(p : pnode) : boolean; + + begin + ischild:=(p=right) or (p=right); + end; + + procedure tbinarynode.det_resulttype; + + begin + left^.det_resulttype; + right^.det_resulttype; + end; + + procedure tbinarynode.det_temp; + + begin + left^.det_temp; + right^.det_temp; + end; + {**************************************************************************** TBINOPYNODE ****************************************************************************} @@ -1817,16 +1916,16 @@ unit tree; equal_trees:=false; end; - procedure set_unique(p : ptree); + procedure set_unique(p : pnode); begin if assigned(p) then begin case p^.treetype of vecn: - p^.callunique:=true; + include(p^.flags,tf_callunique); typeconvn: - set_unique(p^.left); + set_unique(punarynode(p)^.left); end; end; end; @@ -1900,7 +1999,11 @@ unit tree; end. { $Log$ - Revision 1.11 1999-08-04 00:23:59 florian + Revision 1.12 1999-08-05 14:58:16 florian + * some fixes for the floating point registers + * more things for the new code generator + + Revision 1.11 1999/08/04 00:23:59 florian * renamed i386asm and i386base to cpuasm and cpubase Revision 1.10 1999/08/02 17:14:12 florian