* some new stuff for the new cg

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
-                                 (usablereg32<p^.right^.registers32) then
-                                begin
-                                   del_reference(p^.left^.location.reference);
-                                   hregister:=getregister32;
-                                   emit_ref_reg(A_LEA,S_L,newreference(
-                                     p^.left^.location.reference),
-                                     hregister);
-                                   reset_reference(p^.left^.location.reference);
-                                   p^.left^.location.reference.base:=hregister;
-                                   p^.left^.location.reference.index:=R_NO;
-                                end;
-                              loc:=LOC_REFERENCE;
-                           end;
-            LOC_CFPUREGISTER:
-              loc:=LOC_CFPUREGISTER;
-            LOC_CREGISTER:
-              loc:=LOC_CREGISTER;
-            LOC_MMXREGISTER:
-              loc:=LOC_MMXREGISTER;
-            LOC_CMMXREGISTER:
-              loc:=LOC_CMMXREGISTER;
-            else
-               begin
-                  CGMessage(cg_e_illegal_expression);
-                  exit;
-               end;
-         end;
-{$endif dummy}
          if not(p^.left^.location.loc in [LOC_REFERENCE,LOC_CFPUREGISTER,
-           LOC_CREGISTER,LOC_MMXREGISTER,LOC_CMMXREGISTER]) then
+           LOC_CREGISTER,LOC_CMMXREGISTER]) then
            begin
               CGMessage(cg_e_illegal_expression);
               exit;
@@ -513,9 +475,7 @@ implementation
                         begin
                           emit_const_ref(A_MOV,S_B,
                             0,newreference(p^.left^.location.reference));
-{$IfDef regallocfix}
                           del_reference(p^.left^.location.reference);
-{$EndIf regallocfix}
                         end
                       else
                         loadansi2short(p^.right,p^.left);
@@ -1019,7 +979,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.102  2000-03-01 13:20:33  pierre
+  Revision 1.103  2000-03-01 15:36:11  florian
+    * some new stuff for the new cg
+
+  Revision 1.102  2000/03/01 13:20:33  pierre
    * fix for bug 859
 
   Revision 1.101  2000/03/01 00:03:11  pierre

compiler/cgai386.pas

@@ -3298,16 +3298,31 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
       if not(po_assembler in aktprocsym^.definition^.procoptions) then
         aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}copyvalueparas);
 
-      { initialisizes local data }
-      aktprocsym^.definition^.localst^.foreach({$ifndef TP}@{$endif}initialize_data);
+      { initialisize local data like ansistrings }
+      case aktprocsym^.definition^.proctypeoption of
+         potype_unitinit:
+           begin
+              { using current_module^.globalsymtable is hopefully      }
+              { more robust than symtablestack and symtablestack^.next }
+              psymtable(current_module^.globalsymtable)^.foreach({$ifndef TP}@{$endif}initialize_data);
+              psymtable(current_module^.localsymtable)^.foreach({$ifndef TP}@{$endif}initialize_data);
+           end;
+         { units have seperate code for initilization and finalization }
+         potype_unitfinalize: ;
+         else
+           aktprocsym^.definition^.localst^.foreach({$ifndef TP}@{$endif}initialize_data);
+      end;
+
       { add a reference to all call by value/const parameters }
       aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}incr_data);
 
-      { initilisizes temp. ansi/wide string data }
+      { initialisizes temp. ansi/wide string data }
       inittempansistrings;
 
       { do we need an exception frame 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
             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

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
 
-}
+}

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
-  - removed the hcodegen use in the new cg, use cgbase instead
+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
 

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
 
-}
+}

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
+
+}

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
+
+}

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
 
-}
+}

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
-}
+}

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,292 +324,243 @@ unit nmem;
          inherited done;
       end;
 
-    procedure tassignmentnode.loadansistring;
+    procedure tassignmentnode.det_temp;
 
       begin
-         abstract;
       end;
 
-    procedure tassignmentnode.loadshortstring;
+    procedure tassignmentnode.det_resulttype;
 
       begin
-         abstract;
+         inherited det_resulttype;
+         resulttype:=voiddef;
+         { assignements to open arrays aren't allowed }
+         if is_open_array(left^.resulttype) then
+           CGMessage(type_e_mismatch);
       end;
 
-    procedure tassignmentnode.loadansi2short(l,r : pnode);
+    { updated from old cg on 29.2.00 by FK }
+    procedure generic_p2_stringassignment(p : passignmentnode);
 
       begin
-         abstract;
+         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);
+                    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 tassignmentnode.det_temp;
+    procedure generic_p2_assignment_int64_reg(p : passignmentnode);
 
       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}
+         { we don't know it better here }
+         generic_p2_assignment(p);
       end;
 
-    procedure tassignmentnode.det_resulttype;
+    { updated from old cg on 29.2.00 by FK }
+    procedure generic_p2_assignment_flags(p : passignmentnode);
 
       begin
-         inherited det_resulttype;
-         resulttype:=voiddef;
-         { assignements to open arrays aren't allowed }
-         if is_open_array(left^.resulttype) then
-           CGMessage(type_e_mismatch);
+         { for example the alpha doesn't have flags }
+         abstract;
       end;
 
-    procedure tassignmentnode.secondpass;
+    { updated from old cg on 29.2.00 by FK }
+    procedure generic_p2_assignment(p : passignmentnode);
 
       var
-         r : treference;
-         opsize : tcgsize;
+         opsize : topsize;
+         otlabel,hlabel,oflabel : pasmlabel;
+         fputyp : tfloattype;
+         loc : tloc;
+         r : preference;
+         ai : paicpu;
+         op : tasmop;
 
       begin
-         if left^.resulttype^.deftype=stringdef 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
-           end
-        else case right^.location.loc of
+         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);
+                                   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 }
-                                   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)
+                                   new(r);
+                                   reset_reference(r^);
+                                   r^.symbol:=p^.left^.resulttype^.get_inittable_label;
+                                   emitpushreferenceaddr(r^);
+                                   emitpushreferenceaddr(p^.left^.location.reference);
+                                   emitcall('FPC_DECREF');
                                 end;
-                              cg^.g_concatcopy(list,right^.location.reference,
-                                left^.location.reference,left^.resulttype^.size,false);
-                              tg.ungetiftemp(right^.location.reference);
-                           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
-}
+}

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
 
-}
+}

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.
 

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
 
-}
+}