* some fixes for the floating point registers

  * more things for the new code generator

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
 

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
 

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
 

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
 

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

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

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

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
+                                 (usablereg32<p^.right^.registers32) then
+                                begin
+                                   del_reference(p^.left^.location.reference);
+                                   hregister:=getregister32;
+                                   exprasmlist^.concat(new(pai386,op_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;
+         { lets try to optimize this (PM)            }
+         { define a dest_loc that is the location      }
+         { and a ptree to verify that it is the right }
+         { place to insert it                    }
+{$ifdef test_dest_loc}
+         if (aktexprlevel<4) then
+           begin
+              dest_loc_known:=true;
+              dest_loc:=p^.left^.location;
+              dest_loc_tree:=p^.right;
+           end;
+{$endif test_dest_loc}
+
+         secondpass(p^.right);
+         if codegenerror then
+           exit;
+
+{$ifdef test_dest_loc}
+         dest_loc_known:=false;
+         if in_dest_loc then
+           begin
+              truelabel:=otlabel;
+              falselabel:=oflabel;
+              in_dest_loc:=false;
+              exit;
+           end;
+{$endif test_dest_loc}
+         if p^.left^.resulttype^.deftype=stringdef then
+           begin
+              if is_ansistring(p^.left^.resulttype) then
+                begin
+                  { the source and destinations are released
+                    in loadansistring, because an ansi string can
+                    also be in a register
+                  }
+                  loadansistring(p);
+                end
+              else
+              if is_shortstring(p^.left^.resulttype) and
+                not (p^.concat_string) then
+                begin
+                  if is_ansistring(p^.right^.resulttype) then
+                    begin
+                      if (p^.right^.treetype=stringconstn) and
+                         (p^.right^.length=0) then
+                        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
+                      else
+                        loadansi2short(p^.right,p^.left);
+                    end
+                  else
+                    begin
+                       { we do not need destination anymore }
+                       del_reference(p^.left^.location.reference);
+                       del_reference(p^.right^.location.reference);
+                       loadshortstring(p);
+                       ungetiftemp(p^.right^.location.reference);
+                    end;
+                end
+              else if is_longstring(p^.left^.resulttype) then
+                begin
+                end
+              else
+                begin
+                  { its the only thing we have to do }
+                  del_reference(p^.right^.location.reference);
+                end
+           end
+        else case p^.right^.location.loc of
+            LOC_REFERENCE,
+            LOC_MEM : begin
+                         { extra handling for ordinal constants }
+                         if (p^.right^.treetype in [ordconstn,fixconstn]) or
+                            (loc=LOC_CREGISTER) then
+                           begin
+                              case p^.left^.resulttype^.size of
+                                 1 : opsize:=S_B;
+                                 2 : opsize:=S_W;
+                                 4 : opsize:=S_L;
+                                 { S_L is correct, the copy is done }
+                                 { with two moves                   }
+                                 8 : opsize:=S_L;
+                              end;
+                              if loc=LOC_CREGISTER then
+                                begin
+                                  exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
+                                    newreference(p^.right^.location.reference),
+                                    p^.left^.location.register)));
+                                  if is_64bitint(p^.right^.resulttype) then
+                                    begin
+                                       r:=newreference(p^.right^.location.reference);
+                                       inc(r^.offset,4);
+                                       exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,r,
+                                         p^.left^.location.registerhigh)));
+                                    end;
+{$IfDef regallocfix}
+                                  del_reference(p^.right^.location.reference);
+{$EndIf regallocfix}
+                                end
+                              else
+                                begin
+                                  exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,opsize,
+                                    p^.right^.location.reference.offset,
+                                    newreference(p^.left^.location.reference))));
+                                  if is_64bitint(p^.right^.resulttype) then
+                                    begin
+                                       r:=newreference(p^.left^.location.reference);
+                                       inc(r^.offset,4);
+                                       exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,opsize,
+                                         0,r)));
+                                    end;
+{$IfDef regallocfix}
+                                  del_reference(p^.left^.location.reference);
+{$EndIf regallocfix}
+                                {exprasmlist^.concat(new(pai386,op_const_loc(A_MOV,opsize,
+                                    p^.right^.location.reference.offset,
+                                    p^.left^.location)));}
+                                end;
+
+                           end
+                         else if loc=LOC_CFPUREGISTER then
+                           begin
+                              floatloadops(pfloatdef(p^.right^.resulttype)^.typ,op,opsize);
+                              exprasmlist^.concat(new(pai386,op_ref(op,opsize,
+                                newreference(p^.right^.location.reference))));
+                              exprasmlist^.concat(new(pai386,op_reg(A_FSTP,S_NO,
+                                correct_fpuregister(p^.left^.location.register,fpuvaroffset+1))));
+                           end
+                         else
+                           begin
+                              if (p^.right^.resulttype^.needs_inittable) and
+                                ( (p^.right^.resulttype^.deftype<>objectdef) 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

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

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

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!!
 

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