From 9573dc70063275f278583a8a84f3c05edebe1431 Mon Sep 17 00:00:00 2001 From: florian Date: Wed, 1 Mar 2000 15:36:11 +0000 Subject: [PATCH] * some new stuff for the new cg --- compiler/cg386ld.pas | 47 +--- compiler/cgai386.pas | 48 +++- compiler/cpubase.pas | 10 +- compiler/new/README | 39 ++- compiler/new/alpha/cpubase.pas | 11 +- compiler/new/cg64f32.pas | 51 ++++ compiler/new/cgflags.pas | 60 +++++ compiler/new/cgobj.pas | 9 +- compiler/new/i386/tgcpu.pas | 45 +++- compiler/new/nmem.pas | 451 ++++++++++++++++----------------- compiler/pmodules.pas | 16 +- compiler/tree.pas | 9 +- compiler/types.pas | 34 ++- 13 files changed, 522 insertions(+), 308 deletions(-) create mode 100644 compiler/new/cg64f32.pas create mode 100644 compiler/new/cgflags.pas diff --git a/compiler/cg386ld.pas b/compiler/cg386ld.pas index c326e22d0f..63a7c0e5de 100644 --- a/compiler/cg386ld.pas +++ b/compiler/cg386ld.pas @@ -407,46 +407,8 @@ implementation if codegenerror then exit; -{$ifdef dummy} - { we use now the standard mechanism via maybe_push/restore - to do that (FK) - } - case p^.left^.location.loc of - LOC_REFERENCE : begin - { in case left operator uses to register } - { but to few are free then LEA } - if (p^.left^.location.reference.base<>R_NO) and - (p^.left^.location.reference.index<>R_NO) and - (usablereg320 then + if ((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)); @@ -3491,15 +3506,29 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister); { finalize temporary data } finalizetempansistrings; - { finalize local data } - aktprocsym^.definition^.localst^.foreach({$ifndef TP}@{$endif}finalize_data); + { 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}finalize_data); { do we need to handle exceptions because of ansi/widestrings ? } - if (procinfo^.flags and pi_needs_implicit_finally)<>0 then + if ((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; @@ -3782,7 +3811,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister); end. { $Log$ - Revision 1.85 2000-03-01 12:35:44 pierre + Revision 1.86 2000-03-01 15:36:11 florian + * some new stuff for the new cg + + Revision 1.85 2000/03/01 12:35:44 pierre * fix for bug 855 Revision 1.84 2000/03/01 00:03:12 pierre diff --git a/compiler/cpubase.pas b/compiler/cpubase.pas index b22bd4b161..d7df938607 100644 --- a/compiler/cpubase.pas +++ b/compiler/cpubase.pas @@ -509,6 +509,9 @@ const fpuregs = []; mmregs = [R_MM0..R_MM7]; + lvaluelocations = [LOC_REFERENCE,LOC_CFPUREGISTER, + LOC_CREGISTER,LOC_MMXREGISTER,LOC_CMMXREGISTER]; + registers_saved_on_cdecl = [R_ESI,R_EDI,R_EBX]; { generic register names } @@ -901,7 +904,10 @@ end; end. { $Log$ - Revision 1.22 2000-02-09 13:22:51 peter + Revision 1.23 2000-03-01 15:36:11 florian + * some new stuff for the new cg + + Revision 1.22 2000/02/09 13:22:51 peter * log truncated Revision 1.21 2000/01/28 09:41:39 peter @@ -973,4 +979,4 @@ end. + floating point register variables !! * pairegalloc is now generated for register variables -} +} \ No newline at end of file diff --git a/compiler/new/README b/compiler/new/README index 3fc2ea93c5..e1c088b3ec 100644 --- a/compiler/new/README +++ b/compiler/new/README @@ -32,6 +32,8 @@ intregs all!! available integer register fpuregs all!! available fpu register mmregs all!! available multimedia register +lvaluelocations a set of all locations which can be an l-value + Intel specific -------------- unusedregssse @@ -39,9 +41,9 @@ availabletempregssse countusableregssse Jonas Maebe schrieb: -> +> > Hello, -> +> > Is there any difference between the localsize parameter of > g_stackframe_entry and the parasize parameter of g_return_from_proc, or > are they both the same value? @@ -50,7 +52,7 @@ They are different, I think the value of g_return_from_proc doesn't matter for the PowerPC. It's the size of parameters passed on the stack and only important for the i386/m68k probably. -> +> > And for the PowerPC, what will they contain? Just the size of the local > variables and parameters, or also the maximum needed size for parameters > of any procedure called by the current one (the caller must reserve space @@ -67,7 +69,32 @@ I'll commit it soon) will contain all registers which must be saved by the entry and restored by the exit code of a procedure and you have to add extra space to do that. +The code generation +------------------- +The code generation can be seperated into 3 layers: +1. the method secondpass of the tnode childs +2. the procedure variables p2_ +3. the code generator object + +1.: This procedure does very high level stuff, if the code generation +is processor independed, it calls the appropriate procedures of the +code generator object to generate the code, but in most cases, it +calls procedure variables of the second layer + +2. This procedure variables must be initialized to match to the match the +current processor + +The following procedure variables are currently used + + Name Purpose Alternatives +----------------------------------------------------------------------------- +p2_assignment +p2_assignment_int64_reg Do an assignment of a int64 + + +3. The code generator object does very basic operations like generating +move code etc. Alignment --------- @@ -83,7 +110,9 @@ CVS Log ------- $Log$ -Revision 1.4 1999-10-14 14:57:54 florian +Revision 1.5 2000-03-01 15:36:12 florian + * some new stuff for the new cg + +Revision 1.4 1999/10/14 14:57:54 florian - removed the hcodegen use in the new cg, use cgbase instead - diff --git a/compiler/new/alpha/cpubase.pas b/compiler/new/alpha/cpubase.pas index 08375e9ea1..38f7ae96df 100644 --- a/compiler/new/alpha/cpubase.pas +++ b/compiler/new/alpha/cpubase.pas @@ -166,6 +166,10 @@ Type LOC_MEM, LOC_REFERENCE, LOC_JUMP, + { the alpha doesn't have flags, but this } + { avoid some conditional compiling } + { DON'T USE for the alpha } + LOC_FLAGS, LOC_CREGISTER, LOC_CONST); @@ -299,7 +303,10 @@ end; end. { $Log$ - Revision 1.16 2000-01-07 01:14:56 peter + Revision 1.17 2000-03-01 15:36:13 florian + * some new stuff for the new cg + + Revision 1.16 2000/01/07 01:14:56 peter * updated copyright to 2000 Revision 1.15 1999/11/09 22:57:09 peter @@ -354,4 +361,4 @@ end. Revision 1.2 1998/09/09 20:14:00 peter - dup files already used elsewhere -} +} \ No newline at end of file diff --git a/compiler/new/cg64f32.pas b/compiler/new/cg64f32.pas new file mode 100644 index 0000000000..1c0fac7d83 --- /dev/null +++ b/compiler/new/cg64f32.pas @@ -0,0 +1,51 @@ +{ + $Id$ + Copyright (c) 1998-2000 by Florian Klaempfl + Member of the Free Pascal development team + + This unit implements the code generation for 64 bit int + arithmethics on 32 bit 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 cgi64f32; + + interface + + uses + cgobj; + + implementation + + uses + nmem; + + procedure int64f32_assignment_int64_reg(p : passignmentnode); + + begin + end; + +begin + p2_assignment:=@int64f32_assignement_int64; +end. +{ + $Log$ + Revision 1.1 2000-03-01 15:36:13 florian + * some new stuff for the new cg + +} \ No newline at end of file diff --git a/compiler/new/cgflags.pas b/compiler/new/cgflags.pas new file mode 100644 index 0000000000..ca6c5edbed --- /dev/null +++ b/compiler/new/cgflags.pas @@ -0,0 +1,60 @@ +{ + $Id$ + Copyright (c) 1998-2000 by Florian Klaempfl + Member of the Free Pascal development team + + This unit implements the code generation for things regarding + flags, this unit applies of course only for cpus support flags + + 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 cgflags; + + interface + + uses + cgobj; + + implementation + + uses + cgobj,nmem; + + procedure flags_assignment_flags(p : passignmentnode); + + begin + if loc=LOC_CREGISTER then + emit_flag2reg(p^.right^.location.resflags,p^.left^.location.register) + else + begin + ai:=new(paicpu,op_ref(A_Setcc,S_B,newreference(p^.left^.location.reference))); + ai^.SetCondition(flag_2_cond[p^.right^.location.resflags]); + exprasmlist^.concat(ai); + end; + del_reference(p^.left^.location.reference); + end; + +begin + p2_assignment_flags:=@flags_assignment_flags; +end. +{ + $Log$ + Revision 1.1 2000-03-01 15:36:13 florian + * some new stuff for the new cg + +} \ No newline at end of file diff --git a/compiler/new/cgobj.pas b/compiler/new/cgobj.pas index d6ee9da251..1219ded7d2 100644 --- a/compiler/new/cgobj.pas +++ b/compiler/new/cgobj.pas @@ -29,8 +29,6 @@ unit cgobj; cobjects,aasm,symtable,symconst,cpuasm,cpubase,cgbase,cpuinfo,tainst; type - qword = comp; - talignment = (AM_NATURAL,AM_NONE,AM_2BYTE,AM_4BYTE,AM_8BYTE); pcg = ^tcg; @@ -1116,7 +1114,10 @@ unit cgobj; end. { $Log$ - Revision 1.34 2000-02-20 20:49:46 florian + Revision 1.35 2000-03-01 15:36:13 florian + * some new stuff for the new cg + + Revision 1.34 2000/02/20 20:49:46 florian * newcg is compiling * fixed the dup id problem reported by Paul Y. @@ -1228,4 +1229,4 @@ end. Revision 1.1 1998/12/15 16:32:58 florian + first version, derived from old routines -} +} \ No newline at end of file diff --git a/compiler/new/i386/tgcpu.pas b/compiler/new/i386/tgcpu.pas index f57cbe0f3e..da6f586511 100644 --- a/compiler/new/i386/tgcpu.pas +++ b/compiler/new/i386/tgcpu.pas @@ -40,6 +40,12 @@ unit tgcpu; procedure ungetregister(r : tregister);virtual; function istemp(const ref : treference) : boolean;virtual; procedure del_reference(const ref : treference);virtual; + procedure pushusedregisters(var pushed : tpushed;b : byte);virtual; + procedure popusedregisters(const pushed : tpushed);virtual; + procedure saveusedregisters(var saved : tsaved;b : byte);virtual; + procedure restoreusedregisters(const saved : tsaved);virtual; + procedure clearregistercount;virtual; + procedure resetusableregisters;virtual; end; var @@ -47,6 +53,9 @@ unit tgcpu; implementation + +{ !!!!!!!! the following procedures need to be implemented !!!!!!!!!! } + procedure ttgobji386.ungetregister(r : tregister); begin @@ -62,13 +71,45 @@ unit tgcpu; begin end; + procedure ttgobji386.pushusedregisters(var pushed : tpushed;b : byte); + + begin + end; + + procedure ttgobji386.popusedregisters(const pushed : tpushed); + + begin + end; + + procedure ttgobji386.saveusedregisters(var saved : tsaved;b : byte); + + begin + end; + + procedure ttgobji386.restoreusedregisters(const saved : tsaved); + + begin + end; + + procedure ttgobji386.clearregistercount; + + begin + end; + + procedure ttgobji386.resetusableregisters; + + begin + end; begin tg.init; end. { $Log$ - Revision 1.6 2000-01-07 01:14:57 peter + Revision 1.7 2000-03-01 15:36:13 florian + * some new stuff for the new cg + + Revision 1.6 2000/01/07 01:14:57 peter * updated copyright to 2000 Revision 1.5 1999/09/15 20:35:47 florian @@ -90,4 +131,4 @@ end. Revision 1.1 1999/08/02 17:14:14 florian + changed the temp. generator to an object -} +} \ No newline at end of file diff --git a/compiler/new/nmem.pas b/compiler/new/nmem.pas index c54129a375..151374a694 100644 --- a/compiler/new/nmem.pas +++ b/compiler/new/nmem.pas @@ -45,21 +45,22 @@ unit nmem; 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; - procedure loadansistring; - procedure loadshortstring; - procedure loadansi2short(l,r : pnode); end; var { this is necessary for the const section } simple_loadn : boolean; + p2_assignment : procedure(p : passignmentnode); + p2_assignment_flags : procedure(p : passignmentnode); + p2_assignment_string : procedure(p : passignmentnode); + p2_assignment_int64_reg : procedure(p : passignmentnode); + implementation uses @@ -323,80 +324,9 @@ unit nmem; inherited done; end; - procedure tassignmentnode.loadansistring; - - begin - abstract; - end; - - procedure tassignmentnode.loadshortstring; - - begin - abstract; - end; - - procedure tassignmentnode.loadansi2short(l,r : pnode); - - begin - abstract; - end; - procedure tassignmentnode.det_temp; begin -{$ifdef dummy} - 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); -{$endif dummy} end; procedure tassignmentnode.det_resulttype; @@ -409,206 +339,228 @@ unit nmem; CGMessage(type_e_mismatch); end; - procedure tassignmentnode.secondpass; - - var - r : treference; - opsize : tcgsize; + { updated from old cg on 29.2.00 by FK } + procedure generic_p2_stringassignment(p : passignmentnode); begin - if left^.resulttype^.deftype=stringdef then + if is_ansistring(left^.resulttype) then begin - if is_ansistring(left^.resulttype) then - begin - { the source and destinations are released - in loadansistring, because an ansi string can - also be in a register - } - loadansistring; - end - else - if is_shortstring(left^.resulttype) then - begin - if is_ansistring(right^.resulttype) then - begin - if (right^.treetype=stringconstn) and - (pstringconstnode(right)^.length=0) then - begin - cg^.a_load_const_ref(list,OS_8,0,left^.location.reference); - tg.del_reference(left^.location.reference); - end - else - loadansi2short(right,left); - end - else - begin - { we do not need destination anymore } - tg.del_reference(left^.location.reference); - tg.del_reference(right^.location.reference); - loadshortstring; - tg.ungetiftemp(right^.location.reference); - end; - end - else if is_longstring(left^.resulttype) then - begin - abstract; - end - else - begin - { its the only thing we have to do } - tg.del_reference(right^.location.reference); - end + { the source and destinations are released + in loadansistring, because an ansi string can + also be in a register + } + loadansistring; end - else case right^.location.loc of + else + if is_shortstring(left^.resulttype) then + begin + if is_ansistring(right^.resulttype) then + begin + if (right^.treetype=stringconstn) and + (pstringconstnode(right)^.length=0) then + begin + cg^.a_load_const_ref(list,OS_8,0,left^.location.reference); + tg.del_reference(left^.location.reference); + end + else + loadansi2short(right,left); + end + else + begin + { we do not need destination anymore } + tg.del_reference(left^.location.reference); + { tg.del_reference(right^.location.reference); + done in loadshortstring } + loadshortstring; + tg.ungetiftemp(right^.location.reference); + end; + end + else if is_longstring(left^.resulttype) then + begin + abstract; + end + else + begin + { its the only thing we have to do } + tg.del_reference(right^.location.reference); + end + end; + + procedure generic_p2_assignment_int64_reg(p : passignmentnode); + + begin + { we don't know it better here } + generic_p2_assignment(p); + end; + + { updated from old cg on 29.2.00 by FK } + procedure generic_p2_assignment_flags(p : passignmentnode); + + begin + { for example the alpha doesn't have flags } + abstract; + end; + + { updated from old cg on 29.2.00 by FK } + procedure generic_p2_assignment(p : passignmentnode); + + var + opsize : topsize; + otlabel,hlabel,oflabel : pasmlabel; + fputyp : tfloattype; + loc : tloc; + r : preference; + ai : paicpu; + op : tasmop; + + begin + loc:=left^.location.loc; + case right^.location.loc of LOC_REFERENCE, LOC_MEM : begin -{$ifdef dummy} { extra handling for ordinal constants } - if (right^.treetype in [ordconstn,fixconstn]) or + if (p^.right^.treetype in [ordconstn,fixconstn]) or (loc=LOC_CREGISTER) then begin case p^.left^.resulttype^.size of - 1 : opsize:=OS_B; - 2 : opsize:=OS_W; - 4 : opsize:=OS_L; - { S_L is correct, the copy is done } - { with two moves } - 8 : opsize:=OS_L; + 1 : opsize:=OS_8; + 2 : opsize:=OS_16; + 4 : opsize:=OS_32; + 8 : opsize:=OS_64; end; if loc=LOC_CREGISTER then begin - exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOV,opsize, + emit_ref_reg(A_MOV,opsize, newreference(p^.right^.location.reference), - p^.left^.location.register))); + p^.left^.location.register); + + !!!!!!!!!!!! only 32 bit cpus if is_64bitint(p^.right^.resulttype) then begin r:=newreference(p^.right^.location.reference); inc(r^.offset,4); - exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOV,opsize,r, - p^.left^.location.registerhigh))); + emit_ref_reg(A_MOV,opsize,r, + p^.left^.location.registerhigh); end; -{$IfDef regallocfix} - del_reference(p^.right^.location.reference); -{$EndIf regallocfix} + tg.del_reference(right^.location.reference); end else begin - exprasmlist^.concat(new(paicpu,op_const_ref(A_MOV,opsize, + emit_const_ref(A_MOV,opsize, p^.right^.location.reference.offset, - newreference(p^.left^.location.reference)))); + newreference(p^.left^.location.reference)); + + !!!!!!!!!!!! only 32 bit cpus if is_64bitint(p^.right^.resulttype) then begin r:=newreference(p^.left^.location.reference); inc(r^.offset,4); - exprasmlist^.concat(new(paicpu,op_const_ref(A_MOV,opsize, - 0,r))); + emit_const_ref(A_MOV,opsize, + 0,r); end; -{$IfDef regallocfix} - del_reference(p^.left^.location.reference); -{$EndIf regallocfix} - {exprasmlist^.concat(new(paicpu,op_const_loc(A_MOV,opsize, - p^.right^.location.reference.offset, - p^.left^.location)));} + del_reference(left^.location.reference); end; end + + !!!!!!!!!!!! only 386 else if loc=LOC_CFPUREGISTER then begin floatloadops(pfloatdef(p^.right^.resulttype)^.typ,op,opsize); - exprasmlist^.concat(new(paicpu,op_ref(op,opsize, - newreference(p^.right^.location.reference)))); - exprasmlist^.concat(new(paicpu,op_reg(A_FSTP,S_NO, - correct_fpuregister(p^.left^.location.register,fpuvaroffset+1)))); + emit_ref(op,opsize, + newreference(p^.right^.location.reference)); + emit_reg(A_FSTP,S_NO, + correct_fpuregister(p^.left^.location.register,fpuvaroffset+1)); end else -{$endif dummy} begin if (right^.resulttype^.needs_inittable) and - ( (right^.resulttype^.deftype<>objectdef) or + ((right^.resulttype^.deftype<>objectdef) or not(pobjectdef(right^.resulttype)^.is_class)) then begin { this would be a problem } if not(left^.resulttype^.needs_inittable) then - internalerror(3457); + internalerror(292001); { increment source reference counter } - r.symbol:=right^.resulttype^.get_inittable_label; - cg^.a_param_ref_addr(list,r,2); - cg^.a_param_ref_addr(list,right^.location.reference,1); - cg^.a_call_name(list,'FPC_ADDREF',0); - { decrement destination reference counter } - r.symbol:=left^.resulttype^.get_inittable_label; - cg^.a_param_ref_addr(list,r,2); - cg^.a_param_ref_addr(list,left^.location.reference,1); - cg^.a_call_name(list,'FPC_DECREF',0) - end; - cg^.g_concatcopy(list,right^.location.reference, - left^.location.reference,left^.resulttype^.size,false); - tg.ungetiftemp(right^.location.reference); - end; + new(r); + reset_reference(r^); + r^.symbol:=p^.right^.resulttype^.get_inittable_label; + emitpushreferenceaddr(r^); + emitpushreferenceaddr(p^.right^.location.reference); + emitcall('FPC_ADDREF'); + { decrement destination reference counter } + new(r); + reset_reference(r^); + r^.symbol:=p^.left^.resulttype^.get_inittable_label; + emitpushreferenceaddr(r^); + emitpushreferenceaddr(p^.left^.location.reference); + emitcall('FPC_DECREF'); + end; + +{$ifdef regallocfix} + concatcopy(p^.right^.location.reference, + p^.left^.location.reference,p^.left^.resulttype^.size,true,false); + ungetiftemp(p^.right^.location.reference); +{$Else regallocfix} + concatcopy(p^.right^.location.reference, + p^.left^.location.reference,p^.left^.resulttype^.size,false,false); + ungetiftemp(p^.right^.location.reference); +{$endif regallocfix} + end; end; - end; { needs to be removed together with the dummy } -{$ifdef dummy} {$ifdef SUPPORT_MMX} LOC_CMMXREGISTER, LOC_MMXREGISTER: begin if loc=LOC_CMMXREGISTER then - exprasmlist^.concat(new(paicpu,op_reg_reg(A_MOVQ,S_NO, - p^.right^.location.register,p^.left^.location.register))) + emit_reg_reg(A_MOVQ,S_NO, + p^.right^.location.register,p^.left^.location.register) else - exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOVQ,S_NO, - p^.right^.location.register,newreference(p^.left^.location.reference)))); + emit_reg_ref(A_MOVQ,S_NO, + p^.right^.location.register,newreference(p^.left^.location.reference)); end; {$endif SUPPORT_MMX} LOC_REGISTER, LOC_CREGISTER : begin case p^.right^.resulttype^.size of - 1 : opsize:=S_B; - 2 : opsize:=S_W; - 4 : opsize:=S_L; - 8 : opsize:=S_L; + 1 : opsize:=OS_8; + 2 : opsize:=OS_16; + 4 : opsize:=OS_32; + 8 : opsize:=OS_64; end; { simplified with op_reg_loc } if loc=LOC_CREGISTER then begin - exprasmlist^.concat(new(paicpu,op_reg_reg(A_MOV,opsize, + emit_reg_reg(A_MOV,opsize, p^.right^.location.register, - p^.left^.location.register))); -{$IfDef regallocfix} + p^.left^.location.register); ungetregister(p^.right^.location.register); -{$EndIf regallocfix} end else Begin - exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize, + emit_reg_ref(A_MOV,opsize, p^.right^.location.register, - newreference(p^.left^.location.reference)))); -{$IfDef regallocfix} + newreference(p^.left^.location.reference)); 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(paicpu,op_reg_reg(A_MOV,opsize, + emit_reg_reg(A_MOV,opsize, p^.right^.location.registerhigh, - p^.left^.location.registerhigh))) + p^.left^.location.registerhigh) else begin r:=newreference(p^.left^.location.reference); inc(r^.offset,4); - exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize, - p^.right^.location.registerhigh,r))); + emit_reg_ref(A_MOV,opsize, + p^.right^.location.registerhigh,r); end; end; - {exprasmlist^.concat(new(paicpu,op_reg_loc(A_MOV,opsize, - p^.right^.location.register, - p^.left^.location))); } - end; LOC_FPU : begin if (p^.left^.resulttype^.deftype=floatdef) then @@ -625,8 +577,8 @@ unit nmem; case loc of LOC_CFPUREGISTER: begin - exprasmlist^.concat(new(paicpu,op_reg(A_FSTP,S_NO, - correct_fpuregister(p^.left^.location.register,fpuvaroffset)))); + emit_reg(A_FSTP,S_NO, + correct_fpuregister(p^.left^.location.register,fpuvaroffset)); dec(fpuvaroffset); end; LOC_REFERENCE: @@ -635,6 +587,8 @@ unit nmem; internalerror(48991); end; end; + + !!!!!!!!!!!! only 386 LOC_CFPUREGISTER: begin if (p^.left^.resulttype^.deftype=floatdef) then fputyp:=pfloatdef(p^.left^.resulttype)^.typ @@ -647,14 +601,14 @@ unit nmem; fputyp:=pfloatdef(p^.right^.left^.resulttype)^.typ else fputyp:=s32real; - exprasmlist^.concat(new(paicpu,op_reg(A_FLD,S_NO, - correct_fpuregister(p^.right^.location.register,fpuvaroffset)))); + emit_reg(A_FLD,S_NO, + correct_fpuregister(p^.right^.location.register,fpuvaroffset)); inc(fpuvaroffset); case loc of LOC_CFPUREGISTER: begin - exprasmlist^.concat(new(paicpu,op_reg(A_FSTP,S_NO, - correct_fpuregister(p^.right^.location.register,fpuvaroffset)))); + emit_reg(A_FSTP,S_NO, + correct_fpuregister(p^.right^.location.register,fpuvaroffset)); dec(fpuvaroffset); end; LOC_REFERENCE: @@ -664,54 +618,81 @@ unit nmem; end; end; LOC_JUMP : begin + { support every type of boolean here } + case p^.right^.resulttype^.size of + 1 : opsize:=OS_8; + 2 : opsize:=OS_16; + 4 : opsize:=OS_32; + { this leads to an efficiency of 1.5 } + { per cent regarding memory usage .... } + 8 : opsize:=OS_64; + end; getlabel(hlabel); - emitlab(truelabel); + a_label(p^.list,p^.truelabel); if loc=LOC_CREGISTER then - exprasmlist^.concat(new(paicpu,op_const_reg(A_MOV,S_B, - 1,p^.left^.location.register))) + a_load_const_reg(p^.list,opsize,1, + p^.left^.location.register) else - exprasmlist^.concat(new(paicpu,op_const_ref(A_MOV,S_B, - 1,newreference(p^.left^.location.reference)))); - {exprasmlist^.concat(new(paicpu,op_const_loc(A_MOV,S_B, - 1,p^.left^.location)));} - emitjmp(C_None,hlabel); - emitlab(falselabel); + a_load_const_ref(p^.list,opsize,1, + newreference(p^.left^.location.reference)); + a_jmp_cond(p^.list,C_None,hlabel); + a_label(p^.list,p^.falselabel); + if loc=LOC_CREGISTER then - exprasmlist^.concat(new(paicpu,op_reg_reg(A_XOR,S_B, - p^.left^.location.register, - p^.left^.location.register))) + a_load_const_reg(p^.list,opsize,0, + p^.left^.location.register); else begin - exprasmlist^.concat(new(paicpu,op_const_ref(A_MOV,S_B, - 0,newreference(p^.left^.location.reference)))); -{$IfDef regallocfix} - del_reference(p^.left^.location.reference); -{$EndIf regallocfix} + a_load_const_ref(p^.list,opsize,0, + newreference(p^.left^.location.reference)); + tg.del_reference(p^.left^.location.reference); end; - emitlab(hlabel); + a_label(p^.list,hlabel); end; - LOC_FLAGS : begin - if loc=LOC_CREGISTER then - emit_flag2reg(p^.right^.location.resflags,p^.left^.location.register) - else - begin - ai:=new(paicpu,op_ref(A_Setcc,S_B,newreference(p^.left^.location.reference))); - ai^.SetCondition(flag_2_cond[p^.right^.location.resflags]); - exprasmlist^.concat(ai); - end; -{$IfDef regallocfix} - del_reference(p^.left^.location.reference); -{$EndIf regallocfix} - end; - else internalerror(68997); + LOC_FLAGS: + p2_assignment_flags(p); end; -{$endif dummy} end; + + procedure tassignmentnode.secondpass; + + var + r : treference; + opsize : tcgsize; + + begin + if not(left^.location.loc in lvaluelocations) then + begin + CGMessage(cg_e_illegal_expression); + exit; + end; + if left^.resulttype^.deftype=stringdef then + p2_assignment_string(@self); + { if is an int64 which has to do with registers, we + need to call probably a procedure for 32 bit processors + } + else if is_64bitint(left^.resulttype) and + ((left^.location in [LOC_REGISGTER,LOC_CREGISTER) or + (left^.location in [LOC_REGISGTER,LOC_CREGISTER)) then + else + p2_assignment_int64_reg(@self) + else + p2_assignment(@self); + end; + +begin + p2_assignment:=@generic_p2_assignment; + p2_assignment_flags:=p2_assignment_flags; + p2_assignment_string:=@generic_p2_assignment_string; + p2_assignment_int64_reg:=@generic_p2_assignment_int64_reg; end. { $Log$ - Revision 1.16 2000-01-07 01:14:53 peter + Revision 1.17 2000-03-01 15:36:13 florian + * some new stuff for the new cg + + Revision 1.16 2000/01/07 01:14:53 peter * updated copyright to 2000 Revision 1.15 1999/12/06 18:17:10 peter @@ -765,4 +746,4 @@ end. Revision 1.1 1999/01/24 22:32:36 florian * well, more changes, especially parts of secondload ported -} +} \ No newline at end of file diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 4117c48f7e..43e3a4f6c8 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -44,7 +44,7 @@ unit pmodules; globtype,version,systems,tokens, cobjects,comphook,compiler, globals,verbose,files, - symconst,symtable,aasm, + symconst,symtable,aasm,types, {$ifdef newcg} cgbase, {$else newcg} @@ -963,6 +963,8 @@ unit pmodules; store_crc,store_interface_crc : longint; {$endif} s1,s2 : ^string; {Saves stack space} + force_init_final : boolean; + begin consume(_UNIT); if Compile_Level=1 then @@ -1196,6 +1198,11 @@ unit pmodules; { avoid self recursive destructor call !! PM } aktprocsym^.definition^.localst:=nil; + { if the unit contains ansi/widestrings, initialization and + finalization code must be forced } + force_init_final:=needs_init_final(current_module^.globalsymtable) + or needs_init_final(current_module^.localsymtable); + { finalize? } if token=_FINALIZATION then begin @@ -1632,7 +1639,10 @@ unit pmodules; end. { $Log$ - Revision 1.185 2000-02-09 13:22:57 peter + Revision 1.186 2000-03-01 15:36:11 florian + * some new stuff for the new cg + + Revision 1.185 2000/02/09 13:22:57 peter * log truncated Revision 1.184 2000/02/06 17:20:53 peter @@ -1702,4 +1712,4 @@ end. * Pavel's changes for reloc section in executable + warning that -g needs -WN under win32 -} +} \ No newline at end of file diff --git a/compiler/tree.pas b/compiler/tree.pas index c8914eadc3..15a2fb2ecf 100644 --- a/compiler/tree.pas +++ b/compiler/tree.pas @@ -369,7 +369,7 @@ unit tree; {$I innr.inc} {$ifdef newcg} -{$I new/nodeh.inc} +{$I nodeh.inc} {$endif newcg} implementation @@ -2061,12 +2061,15 @@ unit tree; end; {$ifdef newcg} -{$I new/node.inc} +{$I node.inc} {$endif newcg} end. { $Log$ - Revision 1.115 2000-03-01 11:43:55 daniel + Revision 1.116 2000-03-01 15:36:12 florian + * some new stuff for the new cg + + Revision 1.115 2000/03/01 11:43:55 daniel * Some more work on the new symtable. + Symtable stack unit 'symstack' added. diff --git a/compiler/types.pas b/compiler/types.pas index 2909f274dd..ca8012380a 100644 --- a/compiler/types.pas +++ b/compiler/types.pas @@ -175,12 +175,39 @@ interface { returns true, if sym needs an entry in the proplist of a class rtti } function needs_prop_entry(sym : psym) : boolean; + { returns true, if p contains data which needs init/final code } + function needs_init_final(p : psymtable) : boolean; + implementation uses strings,globtype,globals,htypechk, tree,verbose,symconst; + var + b_needs_init_final : boolean; + + procedure _needs_init_final(p : pnamedindexobject);{$ifndef FPC}far;{$endif} + + + begin + if (psym(p)^.typ=varsym) and + assigned(pvarsym(p)^.vartype.def) and + not((pvarsym(p)^.vartype.def^.deftype=objectdef) and + pobjectdef(pvarsym(p)^.vartype.def)^.is_class) and + pvarsym(p)^.vartype.def^.needs_inittable then + b_needs_init_final:=true; + end; + + { returns true, if p contains data which needs init/final code } + function needs_init_final(p : psymtable) : boolean; + + begin + b_needs_init_final:=false; + p^.foreach({$ifndef TP}@{$endif}_needs_init_final); + needs_init_final:=b_needs_init_final; + end; + function needs_prop_entry(sym : psym) : boolean; begin @@ -1014,7 +1041,10 @@ implementation end. { $Log$ - Revision 1.98 2000-02-28 17:23:57 daniel + Revision 1.99 2000-03-01 15:36:12 florian + * some new stuff for the new cg + + Revision 1.98 2000/02/28 17:23:57 daniel * Current work of symtable integration committed. The symtable can be activated by defining 'newst', but doesn't compile yet. Changes in type checking and oop are completed. What is left is to write a new @@ -1099,4 +1129,4 @@ end. * open array checks also for s32bitdef, because u32bit also has a high range of -1 -} +} \ No newline at end of file