* firstpass uses expectloc

  * checks if there are differences between the expectloc and
    location.loc from secondpass in EXTDEBUG

compiler/cginfo.pas

@@ -30,6 +30,25 @@ interface
   uses cpuinfo,symconst;
 
     type
+       { Location types where value can be stored }
+       TCGLoc=(
+         LOC_INVALID,      { added for tracking problems}
+         LOC_VOID,         { no value is available }
+         LOC_CONSTANT,     { constant value }
+         LOC_JUMP,         { boolean results only, jump to false or true label }
+         LOC_FLAGS,        { boolean results only, flags are set }
+         LOC_CREFERENCE,   { in memory constant value reference (cannot change) }
+         LOC_REFERENCE,    { in memory value }
+         LOC_REGISTER,     { in a processor register }
+         LOC_CREGISTER,    { Constant register which shouldn't be modified }
+         LOC_FPUREGISTER,  { FPU stack }
+         LOC_CFPUREGISTER, { if it is a FPU register variable on the fpu stack }
+         LOC_MMXREGISTER,  { MMX register }
+         LOC_CMMXREGISTER, { MMX register variable }
+         LOC_SSEREGISTER,
+         LOC_CSSEREGISTER
+       );
+
        {# Generic opcodes, which must be supported by all processors
        }
        topcg =
@@ -107,7 +126,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.18  2003-01-09 22:00:53  florian
+  Revision 1.19  2003-04-22 23:50:22  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.18  2003/01/09 22:00:53  florian
     * fixed some PowerPC issues
 
   Revision 1.17  2003/01/05 13:36:53  florian

compiler/globtype.pas

@@ -144,7 +144,6 @@ interface
        );
        tproccalloptions = set of tproccalloption;
 
-
      const
        proccalloptionStr : array[tproccalloption] of string[14]=('',
            'CDecl',
@@ -211,7 +210,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.35  2003-03-08 08:59:07  daniel
+  Revision 1.36  2003-04-22 23:50:22  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.35  2003/03/08 08:59:07  daniel
     + $define newra will enable new register allocator
     + getregisterint will return imaginary registers with $newra
     + -sr switch added, will skip register allocation so you can see

compiler/htypechk.pas

@@ -126,7 +126,7 @@ implementation
        defutil,defcmp,cpubase,
        ncnv,nld,
        nmem,ncal,nmat,
-       cgbase
+       cginfo,cgbase
        ;
 
     type
@@ -503,11 +503,11 @@ implementation
             begin
               { the location must be already filled in because we need it to }
               { calculate the necessary number of registers (JM)             }
-              if p.location.loc = LOC_INVALID then
+              if p.expectloc = LOC_INVALID then
                 internalerror(200110101);
 
               if (abs(p.left.registers32-p.right.registers32)<r32) or
-                 ((p.location.loc = LOC_FPUREGISTER) and
+                 ((p.expectloc = LOC_FPUREGISTER) and
                   (p.right.registersfpu <= p.left.registersfpu) and
                   ((p.right.registersfpu <> 0) or (p.left.registersfpu <> 0)) and
                   (p.left.registers32   < p.right.registers32)) then
@@ -527,8 +527,8 @@ implementation
               if (p.left.registers32=p.right.registers32) and
                  (p.registers32=p.left.registers32) and
                  (p.registers32>0) and
-                (p.left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
-                (p.right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
+                (p.left.expectloc in [LOC_REFERENCE,LOC_CREFERENCE]) and
+                (p.right.expectloc in [LOC_REFERENCE,LOC_CREFERENCE]) then
                 inc(p.registers32);
             end
            else
@@ -627,7 +627,7 @@ implementation
                  if (tloadnode(p).symtableentry.typ=varsym) then
                   begin
                     hsym:=tvarsym(tloadnode(p).symtableentry);
-                    if must_be_valid and (nf_first in p.flags) then
+                    if must_be_valid and (nf_first_use in p.flags) then
                      begin
                        if (hsym.varstate=vs_declared_and_first_found) or
                           (hsym.varstate=vs_set_but_first_not_passed) then
@@ -643,7 +643,7 @@ implementation
                            end;
                         end;
                      end;
-                    if (nf_first in p.flags) then
+                    if (nf_first_use in p.flags) then
                      begin
                        if hsym.varstate=vs_declared_and_first_found then
                         begin
@@ -656,7 +656,7 @@ implementation
                        else
                         if hsym.varstate=vs_set_but_first_not_passed then
                          hsym.varstate:=vs_used;
-                       exclude(p.flags,nf_first);
+                       exclude(p.flags,nf_first_use);
                      end
                     else
                       begin
@@ -678,14 +678,14 @@ implementation
                  if must_be_valid and
                     (lexlevel=tfuncretnode(p).funcretsym.owner.symtablelevel) and
                     ((tfuncretnode(p).funcretsym.funcretstate=vs_declared) or
-                    ((nf_is_first_funcret in p.flags) and
+                    ((nf_first_use in p.flags) and
                      (tfuncretnode(p).funcretsym.funcretstate=vs_declared_and_first_found))) then
                    begin
                      CGMessage(sym_w_function_result_not_set);
                      { avoid multiple warnings }
                      tfuncretnode(p).funcretsym.funcretstate:=vs_assigned;
                    end;
-                 if (nf_is_first_funcret in p.flags) and not must_be_valid then
+                 if (nf_first_use in p.flags) and not must_be_valid then
                    tfuncretnode(p).funcretsym.funcretstate:=vs_assigned;
                  break;
                end;
@@ -741,7 +741,7 @@ implementation
            case p.nodetype of
              funcretn:
                begin
-                 if (nf_is_first_funcret in p.flags) or
+                 if (nf_first_use in p.flags) or
                     (tfuncretnode(p).funcretsym.funcretstate=vs_declared_and_first_found) then
                    tfuncretnode(p).funcretsym.funcretstate:=vs_assigned;
                  break;
@@ -1044,7 +1044,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.58  2003-01-03 17:17:26  peter
+  Revision 1.59  2003-04-22 23:50:22  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.58  2003/01/03 17:17:26  peter
     * use compare_def_ext to test if assignn operator is allowed
 
   Revision 1.57  2003/01/02 22:21:19  peter

compiler/i386/cpubase.pas

@@ -36,7 +36,7 @@ interface
 
 uses
   cutils,cclasses,
-  globals,
+  globtype,globals,
   cpuinfo,
   aasmbase,
   cginfo
@@ -396,32 +396,15 @@ uses
 *****************************************************************************}
 
     type
-      TLoc=(
-        LOC_INVALID,      { added for tracking problems}
-        LOC_CONSTANT,     { constant value }
-        LOC_JUMP,         { boolean results only, jump to false or true label }
-        LOC_FLAGS,        { boolean results only, flags are set }
-        LOC_CREFERENCE,   { in memory constant value reference (cannot change) }
-        LOC_REFERENCE,    { in memory value }
-        LOC_REGISTER,     { in a processor register }
-        LOC_CREGISTER,    { Constant register which shouldn't be modified }
-        LOC_FPUREGISTER,  { FPU stack }
-        LOC_CFPUREGISTER, { if it is a FPU register variable on the fpu stack }
-        LOC_MMXREGISTER,  { MMX register }
-        LOC_CMMXREGISTER, { MMX register variable }
-        LOC_SSEREGISTER,
-        LOC_CSSEREGISTER
-      );
-
       { tparamlocation describes where a parameter for a procedure is stored.
         References are given from the caller's point of view. The usual
         TLocation isn't used, because contains a lot of unnessary fields.
       }
       tparalocation = packed record
          size : TCGSize;
-         loc  : TLoc;
+         loc  : TCGLoc;
          sp_fixup : longint;
-         case TLoc of
+         case TCGLoc of
             LOC_REFERENCE : (reference : tparareference);
             { segment in reference at the same place as in loc_register }
             LOC_REGISTER,LOC_CREGISTER : (
@@ -438,9 +421,9 @@ uses
       end;
 
       tlocation = packed record
-         loc  : TLoc;
+         loc  : TCGLoc;
          size : TCGSize;
-         case TLoc of
+         case TCGLoc of
             LOC_FLAGS : (resflags : tresflags);
             LOC_CONSTANT : (
               case longint of
@@ -815,7 +798,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.48  2003-04-22 14:33:38  peter
+  Revision 1.49  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.48  2003/04/22 14:33:38  peter
     * removed some notes/hints
 
   Revision 1.47  2003/04/22 10:09:35  daniel

compiler/i386/cpupara.pas

@@ -51,9 +51,9 @@ unit cpupara;
   implementation
 
     uses
-       systems,
+       systems,verbose,
        symconst,
-       verbose;
+       cginfo;
 
     function ti386paramanager.ret_in_acc(def : tdef;calloption : tproccalloption) : boolean;
       begin
@@ -133,7 +133,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.9  2003-04-22 14:33:38  peter
+  Revision 1.10  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.9  2003/04/22 14:33:38  peter
     * removed some notes/hints
 
   Revision 1.8  2003/01/08 18:43:57  daniel

compiler/i386/n386add.pas

@@ -324,17 +324,21 @@ interface
         { special cases for shortstrings, handled in pass_2 (JM) }
         { can't handle fpc_shortstr_compare with compilerproc either because it }
         { returns its results in the flags instead of in eax                    }
-        if (((nodetype = addn) and
-             is_shortstring(resulttype.def)) or
-            ((nodetype in [ltn,lten,gtn,gten,equaln,unequaln]) and
-              not(((left.nodetype=stringconstn) and (str_length(left)=0)) or
-                  ((right.nodetype=stringconstn) and (str_length(right)=0))) and
-             is_shortstring(left.resulttype.def))) then
+        if (nodetype = addn) and
+           is_shortstring(resulttype.def) then
+         begin
+           expectloc:=LOC_CREFERENCE;
+           calcregisters(self,0,0,0);
+           result := nil;
+           exit;
+         end
+        else
+         if (nodetype in [ltn,lten,gtn,gten,equaln,unequaln]) and
+            is_shortstring(left.resulttype.def) and
+            not(((left.nodetype=stringconstn) and (str_length(left)=0)) or
+               ((right.nodetype=stringconstn) and (str_length(right)=0))) then
           begin
-            if nodetype = addn then
-              location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def))
-            else
-              location_reset(location,LOC_FLAGS,OS_NO);
+            expectloc:=LOC_FLAGS;
             calcregisters(self,0,0,0);
             result := nil;
             exit;
@@ -403,7 +407,6 @@ interface
                         cg.a_call_name(exprasmlist,'FPC_SHORTSTR_CONCAT');
                         tg.ungetiftemp(exprasmlist,right.location.reference);
                         rg.restoreusedintregisters(exprasmlist,pushed);
-                        location_copy(location,left.location);
                      end;
                    ltn,lten,gtn,gten,equaln,unequaln :
                      begin
@@ -1650,7 +1653,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.62  2003-04-22 10:09:35  daniel
+  Revision 1.63  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.62  2003/04/22 10:09:35  daniel
     + Implemented the actual register allocator
     + Scratch registers unavailable when new register allocator used
     + maybe_save/maybe_restore unavailable when new register allocator used

compiler/i386/n386cnv.pas

@@ -62,7 +62,7 @@ interface
 implementation
 
    uses
-      verbose,systems,
+      verbose,systems,globtype,
       symconst,symdef,aasmbase,aasmtai,aasmcpu,
       cginfo,cgbase,pass_2,
       ncon,ncal,ncnv,
@@ -80,7 +80,7 @@ implementation
         first_int_to_real:=nil;
          if registersfpu<1 then
           registersfpu:=1;
-        location.loc:=LOC_FPUREGISTER;
+        expectloc:=LOC_FPUREGISTER;
       end;
 
 
@@ -242,7 +242,7 @@ implementation
           exit;
          { byte(boolean) or word(wordbool) or longint(longbool) must }
          { be accepted for var parameters                            }
-         if (nf_explizit in flags) and
+         if (nf_explicit in flags) and
             (left.resulttype.def.size=resulttype.def.size) and
             (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
            begin
@@ -453,7 +453,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.58  2003-04-22 10:09:35  daniel
+  Revision 1.59  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.58  2003/04/22 10:09:35  daniel
     + Implemented the actual register allocator
     + Scratch registers unavailable when new register allocator used
     + maybe_save/maybe_restore unavailable when new register allocator used

compiler/i386/n386con.pas

@@ -38,9 +38,9 @@ interface
 implementation
 
     uses
-      systems,
+      systems,globtype,
       cpubase,
-      cga,cgbase,rgobj,rgcpu;
+      cga,cginfo,cgbase,rgobj,rgcpu;
 
 {*****************************************************************************
                            TI386REALCONSTNODE
@@ -51,11 +51,11 @@ implementation
          result:=nil;
          if (value_real=1.0) or (value_real=0.0) then
            begin
-              location.loc:=LOC_FPUREGISTER;
+              expectloc:=LOC_FPUREGISTER;
               registersfpu:=1;
            end
          else
-           location.loc:=LOC_CREFERENCE;
+           expectloc:=LOC_CREFERENCE;
       end;
 
     procedure ti386realconstnode.pass_2;
@@ -85,7 +85,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.18  2003-04-22 09:54:18  peter
+  Revision 1.19  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.18  2003/04/22 09:54:18  peter
     * use location_reset
 
   Revision 1.17  2003/01/08 18:43:57  daniel

compiler/i386/n386inl.pas

@@ -60,7 +60,7 @@ interface
 implementation
 
     uses
-      systems,
+      systems,globtype,
       cutils,verbose,
       aasmtai,
       cginfo,cgbase,pass_2,
@@ -75,7 +75,7 @@ implementation
 
      function ti386inlinenode.first_pi : tnode;
       begin
-        location.loc:=LOC_FPUREGISTER;
+        expectloc:=LOC_FPUREGISTER;
         registersfpu:=1;
         first_pi := nil;
       end;
@@ -83,7 +83,7 @@ implementation
 
      function ti386inlinenode.first_arctan_real : tnode;
       begin
-        location.loc:=LOC_FPUREGISTER;
+        expectloc:=LOC_FPUREGISTER;
         registers32:=left.registers32;
         registersfpu:=max(left.registersfpu,2);
 {$ifdef SUPPORT_MMX}
@@ -94,7 +94,7 @@ implementation
 
      function ti386inlinenode.first_abs_real : tnode;
       begin
-        location.loc:=LOC_FPUREGISTER;
+        expectloc:=LOC_FPUREGISTER;
         registers32:=left.registers32;
         registersfpu:=max(left.registersfpu,1);
 {$ifdef SUPPORT_MMX}
@@ -105,7 +105,7 @@ implementation
 
      function ti386inlinenode.first_sqr_real : tnode;
       begin
-        location.loc:=LOC_FPUREGISTER;
+        expectloc:=LOC_FPUREGISTER;
         registers32:=left.registers32;
         registersfpu:=max(left.registersfpu,1);
 {$ifdef SUPPORT_MMX}
@@ -116,7 +116,7 @@ implementation
 
      function ti386inlinenode.first_sqrt_real : tnode;
       begin
-        location.loc:=LOC_FPUREGISTER;
+        expectloc:=LOC_FPUREGISTER;
         registers32:=left.registers32;
         registersfpu:=max(left.registersfpu,1);
 {$ifdef SUPPORT_MMX}
@@ -127,7 +127,7 @@ implementation
 
      function ti386inlinenode.first_ln_real : tnode;
       begin
-        location.loc:=LOC_FPUREGISTER;
+        expectloc:=LOC_FPUREGISTER;
         registers32:=left.registers32;
         registersfpu:=max(left.registersfpu,2);
 {$ifdef SUPPORT_MMX}
@@ -138,7 +138,7 @@ implementation
 
      function ti386inlinenode.first_cos_real : tnode;
       begin
-        location.loc:=LOC_FPUREGISTER;
+        expectloc:=LOC_FPUREGISTER;
         registers32:=left.registers32;
         registersfpu:=max(left.registersfpu,1);
 {$ifdef SUPPORT_MMX}
@@ -149,7 +149,7 @@ implementation
 
      function ti386inlinenode.first_sin_real : tnode;
       begin
-        location.loc:=LOC_FPUREGISTER;
+        expectloc:=LOC_FPUREGISTER;
         registers32:=left.registers32;
         registersfpu:=max(left.registersfpu,1);
 {$ifdef SUPPORT_MMX}
@@ -346,7 +346,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.58  2003-04-22 14:33:38  peter
+  Revision 1.59  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.58  2003/04/22 14:33:38  peter
     * removed some notes/hints
 
   Revision 1.57  2003/04/22 10:09:35  daniel

compiler/i386/n386mat.pas

@@ -886,7 +886,7 @@ implementation
            begin
              if (registersfpu < 1) then
                registersfpu := 1;
-             location.loc:=LOC_FPUREGISTER;
+             expectloc:=LOC_FPUREGISTER;
            end
 {$ifdef SUPPORT_MMX}
          else if (cs_mmx in aktlocalswitches) and
@@ -902,14 +902,14 @@ implementation
               if (left.location.loc<>LOC_REGISTER) and
                  (registers32<2) then
                 registers32:=2;
-              location.loc:=LOC_REGISTER;
+              expectloc:=LOC_REGISTER;
            end
          else if (left.resulttype.def.deftype=orddef) then
            begin
               if (left.location.loc<>LOC_REGISTER) and
                  (registers32<1) then
                 registers32:=1;
-              location.loc:=LOC_REGISTER;
+              expectloc:=LOC_REGISTER;
            end;
       end;
 
@@ -1071,46 +1071,48 @@ implementation
          if is_boolean(resulttype.def) then
           begin
             opsize:=def_opsize(resulttype.def);
-            { the second pass could change the location of left }
-            { if it is a register variable, so we've to do      }
-            { this before the case statement                    }
-            if left.location.loc<>LOC_JUMP then
-             secondpass(left);
 
-            case left.location.loc of
-              LOC_JUMP :
-                begin
-                  location_reset(location,LOC_JUMP,OS_NO);
-                  hl:=truelabel;
-                  truelabel:=falselabel;
-                  falselabel:=hl;
-                  secondpass(left);
-                  maketojumpbool(exprasmlist,left,lr_load_regvars);
-                  hl:=truelabel;
-                  truelabel:=falselabel;
-                  falselabel:=hl;
-                end;
-              LOC_FLAGS :
-                begin
-                  location_release(exprasmlist,left.location);
-                  location_reset(location,LOC_FLAGS,OS_NO);
-                  location.resflags:=flagsinvers[left.location.resflags];
-                end;
-              LOC_CONSTANT,
-              LOC_REGISTER,
-              LOC_CREGISTER,
-              LOC_REFERENCE,
-              LOC_CREFERENCE :
-                begin
-                  location_force_reg(exprasmlist,left.location,def_cgsize(resulttype.def),true);
-                  emit_reg_reg(A_TEST,opsize,left.location.register,left.location.register);
-                  location_release(exprasmlist,left.location);
-                  location_reset(location,LOC_FLAGS,OS_NO);
-                  location.resflags:=F_E;
-                end;
-             else
-                internalerror(200203224);
-            end;
+            if left.expectloc=LOC_JUMP then
+             begin
+               location_reset(location,LOC_JUMP,OS_NO);
+               hl:=truelabel;
+               truelabel:=falselabel;
+               falselabel:=hl;
+               secondpass(left);
+               maketojumpbool(exprasmlist,left,lr_load_regvars);
+               hl:=truelabel;
+               truelabel:=falselabel;
+               falselabel:=hl;
+             end
+            else
+             begin
+               { the second pass could change the location of left }
+               { if it is a register variable, so we've to do      }
+               { this before the case statement                    }
+               secondpass(left);
+               case left.expectloc of
+                 LOC_FLAGS :
+                   begin
+                     location_release(exprasmlist,left.location);
+                     location_reset(location,LOC_FLAGS,OS_NO);
+                     location.resflags:=flagsinvers[left.location.resflags];
+                   end;
+                 LOC_CONSTANT,
+                 LOC_REGISTER,
+                 LOC_CREGISTER,
+                 LOC_REFERENCE,
+                 LOC_CREFERENCE :
+                   begin
+                     location_force_reg(exprasmlist,left.location,def_cgsize(resulttype.def),true);
+                     emit_reg_reg(A_TEST,opsize,left.location.register,left.location.register);
+                     location_release(exprasmlist,left.location);
+                     location_reset(location,LOC_FLAGS,OS_NO);
+                     location.resflags:=F_E;
+                   end;
+                else
+                   internalerror(200203224);
+               end;
+             end;
           end
 {$ifdef SUPPORT_MMX}
          else
@@ -1181,7 +1183,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.52  2003-04-22 14:33:38  peter
+  Revision 1.53  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.52  2003/04/22 14:33:38  peter
     * removed some notes/hints
 
   Revision 1.51  2003/04/22 10:09:35  daniel

compiler/i386/n386opt.pas

@@ -42,6 +42,7 @@ type
 implementation
 
 uses
+  globtype,
   pass_1,defutil,htypechk,
   symdef,paramgr,
   aasmbase,aasmtai,
@@ -76,7 +77,7 @@ begin
   firstpass(right);
   if codegenerror then
     exit;
-  location.loc := LOC_CREFERENCE;
+  expectloc:=LOC_CREFERENCE;
   if not is_constcharnode(right) then
     { it's not sure we need the register, but we can't know it here yet }
     calcregisters(self,2,0,0)
@@ -249,7 +250,12 @@ end.
 
 {
   $Log$
-  Revision 1.30  2003-04-22 14:33:38  peter
+  Revision 1.31  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.30  2003/04/22 14:33:38  peter
     * removed some notes/hints
 
   Revision 1.29  2003/03/28 19:16:57  peter

compiler/i386/n386set.pas

@@ -65,7 +65,7 @@ implementation
       begin
          result:=nil;
          { this is the only difference from the generic version }
-         location.loc:=LOC_FLAGS;
+         expectloc:=LOC_FLAGS;
 
          firstpass(right);
          firstpass(left);
@@ -443,7 +443,6 @@ implementation
                   end;
                   { simply to indicate EDI is deallocated here too (JM) }
                   rg.ungetregisterint(exprasmlist,hr);
-                  location.loc:=LOC_FLAGS;
                   location.resflags:=F_C;
                 end;
              end
@@ -455,15 +454,10 @@ implementation
                   objectlibrary.getlabel(l);
                   objectlibrary.getlabel(l2);
 
-                  { Is this treated in firstpass ?? }
+                  { load constants to a register }
                   if left.nodetype=ordconstn then
-                    begin
-                      hr:=rg.getregisterint(exprasmlist,OS_INT);
-                      left.location.loc:=LOC_REGISTER;
-                      left.location.register:=hr;
-                      emit_const_reg(A_MOV,S_L,
-                            tordconstnode(left).value,hr);
-                    end;
+                    location_force_reg(exprasmlist,left.location,OS_INT,true);
+
                   case left.location.loc of
                      LOC_REGISTER,
                      LOC_CREGISTER:
@@ -724,7 +718,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.53  2003-04-22 14:33:38  peter
+  Revision 1.54  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.53  2003/04/22 14:33:38  peter
     * removed some notes/hints
 
   Revision 1.52  2003/04/22 10:09:35  daniel

compiler/nadd.pas

@@ -70,7 +70,7 @@ implementation
       globtype,systems,
       cutils,verbose,globals,widestr,
       symconst,symtype,symdef,symsym,symtable,defutil,defcmp,
-      cgbase,
+      cginfo,cgbase,
       htypechk,pass_1,
       nbas,nmat,ncnv,ncon,nset,nopt,ncal,ninl,
       {$ifdef state_tracking}
@@ -165,8 +165,7 @@ implementation
                (right.resulttype.def.deftype=orddef) then
              begin
                { insert explicit typecast to s32bit }
-               left:=ctypeconvnode.create(left,s32bittype);
-               left.toggleflag(nf_explizit);
+               left:=ctypeconvnode.create_explicit(left,s32bittype);
                resulttypepass(left);
              end
             else
@@ -174,8 +173,7 @@ implementation
                 (right.resulttype.def.deftype=enumdef) then
               begin
                 { insert explicit typecast to s32bit }
-                right:=ctypeconvnode.create(right,s32bittype);
-                include(right.flags,nf_explizit);
+                right:=ctypeconvnode.create_explicit(right,s32bittype);
                 resulttypepass(right);
               end;
           end;
@@ -688,16 +686,14 @@ implementation
               begin
                 if torddef(left.resulttype.def).size>torddef(right.resulttype.def).size then
                  begin
-                   right:=ctypeconvnode.create(right,left.resulttype);
+                   right:=ctypeconvnode.create_explicit(right,left.resulttype);
                    ttypeconvnode(right).convtype:=tc_bool_2_int;
-                   right.toggleflag(nf_explizit);
                    resulttypepass(right);
                  end
                 else if torddef(left.resulttype.def).size<torddef(right.resulttype.def).size then
                  begin
-                   left:=ctypeconvnode.create(left,right.resulttype);
+                   left:=ctypeconvnode.create_explicit(left,right.resulttype);
                    ttypeconvnode(left).convtype:=tc_bool_2_int;
-                   left.toggleflag(nf_explizit);
                    resulttypepass(left);
                  end;
                 case nodetype of
@@ -1049,7 +1045,6 @@ implementation
                    inserttypeconv(right,clongstringtype);
                  if not(is_longstring(ld)) then
                    inserttypeconv(left,clongstringtype);
-                 location.loc:=LOC_CREFERENCE;
               end
             else
               begin
@@ -1239,25 +1234,24 @@ implementation
          { when the result is currency we need some extra code for
            multiplication and division. this should not be done when
            the muln or slashn node is created internally }
-         if not(nf_explizit in flags) and
+         if not(nf_is_currency in flags) and
             is_currency(resulttype.def) then
           begin
             case nodetype of
               slashn :
                 begin
                   hp:=caddnode.create(muln,getcopy,crealconstnode.create(10000.0,resultrealtype));
-                  include(hp.flags,nf_explizit);
+                  include(hp.flags,nf_is_currency);
                   result:=hp;
                 end;
               muln :
                 begin
                   hp:=caddnode.create(slashn,getcopy,crealconstnode.create(10000.0,resultrealtype));
-                  include(hp.flags,nf_explizit);
+                  include(hp.flags,nf_is_currency);
                   result:=hp
                 end;
             end;
           end;
-
       end;
 
 
@@ -1282,7 +1276,6 @@ implementation
               { we reused the arguments }
               left := nil;
               right := nil;
-              firstpass(result);
             end;
           ltn,lten,gtn,gten,equaln,unequaln :
             begin
@@ -1308,16 +1301,14 @@ implementation
                       { compare the pointer with nil (for ansistrings etc), }
                       { faster than getting the length (JM)                 }
                       result:= caddnode.create(nodetype,
-                        ctypeconvnode.create(left,voidpointertype),
+                        ctypeconvnode.create_explicit(left,voidpointertype),
                         cpointerconstnode.create(0,voidpointertype));
-                      taddnode(result).left.toggleflag(nf_explizit);
                     end;
                   { left is reused }
                   left := nil;
                   { right isn't }
                   right.free;
                   right := nil;
-                  firstpass(result);
                   exit;
                 end;
               { no string constant -> call compare routine }
@@ -1329,7 +1320,6 @@ implementation
                 cordconstnode.create(0,s32bittype,false));
               left := nil;
               right := nil;
-              firstpass(result);
             end;
         end;
       end;
@@ -1386,8 +1376,7 @@ implementation
                   { type cast the value to pass as argument to a byte, }
                   { since that's what the helper expects               }
                   tsetelementnode(right).left :=
-                    ctypeconvnode.create(tsetelementnode(right).left,u8bittype);
-                  tsetelementnode(right).left.toggleflag(nf_explizit);
+                    ctypeconvnode.create_explicit(tsetelementnode(right).left,u8bittype);
                   { set the resulttype to the actual one (otherwise it's }
                   { "fpc_normal_set")                                    }
                   result := ccallnode.createinternres('fpc_set_create_element',
@@ -1403,22 +1392,19 @@ implementation
                      { convert the arguments to bytes, since that's what }
                      { the helper expects                               }
                      tsetelementnode(right).left :=
-                       ctypeconvnode.create(tsetelementnode(right).left,
+                       ctypeconvnode.create_explicit(tsetelementnode(right).left,
                        u8bittype);
-                     tsetelementnode(right).left.toggleflag(nf_explizit);
 
                      { convert the original set (explicitely) to an   }
                      { fpc_normal_set so we can pass it to the helper }
-                     left := ctypeconvnode.create(left,srsym.restype);
-                     left.toggleflag(nf_explizit);
+                     left := ctypeconvnode.create_explicit(left,srsym.restype);
 
                      { add a range or a single element? }
                      if assigned(tsetelementnode(right).right) then
                        begin
                          tsetelementnode(right).right :=
-                           ctypeconvnode.create(tsetelementnode(right).right,
+                           ctypeconvnode.create_explicit(tsetelementnode(right).right,
                            u8bittype);
-                         tsetelementnode(right).right.toggleflag(nf_explizit);
 
                          { create the call }
                          result := ccallnode.createinternres('fpc_set_set_range',
@@ -1442,13 +1428,11 @@ implementation
                      { add two sets }
 
                      { convert the sets to fpc_normal_set's }
-                     left := ctypeconvnode.create(left,srsym.restype);
-                     left.toggleflag(nf_explizit);
-                     right := ctypeconvnode.create(right,srsym.restype);
-                     right.toggleflag(nf_explizit);
                      result := ccallnode.createinternres('fpc_set_add_sets',
-                       ccallparanode.create(right,
-                       ccallparanode.create(left,nil)),resulttype);
+                       ccallparanode.create(
+                         ctypeconvnode.create_explicit(right,srsym.restype),
+                       ccallparanode.create(
+                         ctypeconvnode.create_explicit(left,srsym.restype),nil)),resulttype);
                      { remove reused parts from original node }
                      left := nil;
                      right := nil;
@@ -1458,12 +1442,8 @@ implementation
           subn,symdifn,muln:
             begin
               { convert the sets to fpc_normal_set's }
-              left := ctypeconvnode.create(left,srsym.restype);
-              left.toggleflag(nf_explizit);
-              right := ctypeconvnode.create(right,srsym.restype);
-              right.toggleflag(nf_explizit);
-              paras := ccallparanode.create(right,
-                ccallparanode.create(left,nil));
+              paras := ccallparanode.create(ctypeconvnode.create_explicit(right,srsym.restype),
+                ccallparanode.create(ctypeconvnode.create_explicit(left,srsym.restype),nil));
               case nodetype of
                 subn:
                   result := ccallnode.createinternres('fpc_set_sub_sets',
@@ -1482,7 +1462,6 @@ implementation
           else
             internalerror(200108311);
         end;
-        firstpass(result);
       end;
 
 
@@ -1515,7 +1494,6 @@ implementation
             left := nil;
             right := nil;
             { return firstpassed new node }
-            firstpass(result);
             exit;
           end;
 
@@ -1530,7 +1508,6 @@ implementation
           procname := 'fpc_mul_qword';
         result := ccallnode.createintern(procname,right);
         right := nil;
-        firstpass(result);
       end;
 
 
@@ -1582,11 +1559,10 @@ implementation
            ccallparanode.create(left,nil)));
         left:=nil;
         right:=nil;
-        
+
         { do we need to reverse the result }
         if notnode then
            result := cnotnode.create(result);
-        firstpass(result);
       end;
 {$endif cpufpemu}
 
@@ -1619,11 +1595,11 @@ implementation
              if assigned(result) then
                exit;
 {$endif cpufpemu}
-             location.loc:=LOC_FPUREGISTER;
+             expectloc:=LOC_FPUREGISTER;
              { maybe we need an integer register to save }
              { a reference                               }
-             if ((left.location.loc<>LOC_FPUREGISTER) or
-                 (right.location.loc<>LOC_FPUREGISTER)) and
+             if ((left.expectloc<>LOC_FPUREGISTER) or
+                 (right.expectloc<>LOC_FPUREGISTER)) and
                 (left.registers32=right.registers32) then
                calcregisters(self,1,1,0)
              else
@@ -1633,8 +1609,8 @@ implementation
               { calcregisters(0,2,0) will overestimate the number of    }
               { necessary registers (it will make it 3 in case one of   }
               { the operands is already in the fpu) (JM)                }
-              if ((left.location.loc <> LOC_FPUREGISTER) or
-                  (right.location.loc <> LOC_FPUREGISTER)) and
+              if ((left.expectloc<>LOC_FPUREGISTER) or
+                  (right.expectloc<>LOC_FPUREGISTER)) and
                  (registersfpu < 2) then
                 inc(registersfpu);
            end
@@ -1648,14 +1624,14 @@ implementation
                 if not(cs_full_boolean_eval in aktlocalswitches) and
                    (nodetype in [andn,orn]) then
                  begin
-                   location.loc:=LOC_JUMP;
+                   expectloc:=LOC_JUMP;
                    calcregisters(self,0,0,0);
                  end
                 else
                  begin
-                   location.loc := LOC_FLAGS;
-                   if (left.location.loc in [LOC_JUMP,LOC_FLAGS]) and
-                      (left.location.loc in [LOC_JUMP,LOC_FLAGS]) then
+                   expectloc:=LOC_FLAGS;
+                   if (left.expectloc in [LOC_JUMP,LOC_FLAGS]) and
+                      (left.expectloc in [LOC_JUMP,LOC_FLAGS]) then
                      calcregisters(self,2,0,0)
                    else
                      calcregisters(self,1,0,0);
@@ -1667,7 +1643,7 @@ implementation
                begin
                  if nodetype=addn then
                   internalerror(200103291);
-                 location.loc := LOC_FLAGS;
+                 expectloc:=LOC_FLAGS;
                  calcregisters(self,1,0,0);
                end
               { is there a 64 bit type ? }
@@ -1677,18 +1653,18 @@ implementation
                  if assigned(result) then
                    exit;
                   if nodetype in [addn,subn,muln,andn,orn,xorn] then
-                    location.loc := LOC_REGISTER
+                    expectloc:=LOC_REGISTER
                   else
-                    location.loc := LOC_JUMP;
+                    expectloc:=LOC_JUMP;
                   calcregisters(self,2,0,0)
                end
              { is there a cardinal? }
              else if (torddef(ld).typ=u32bit) then
                begin
                   if nodetype in [addn,subn,muln,andn,orn,xorn] then
-                    location.loc := LOC_REGISTER
+                    expectloc:=LOC_REGISTER
                   else
-                    location.loc := LOC_FLAGS;
+                    expectloc:=LOC_FLAGS;
                  calcregisters(self,1,0,0);
                  { for unsigned mul we need an extra register }
                  if nodetype=muln then
@@ -1698,9 +1674,9 @@ implementation
              else
                begin
                   if nodetype in [addn,subn,muln,andn,orn,xorn] then
-                    location.loc := LOC_REGISTER
+                    expectloc:=LOC_REGISTER
                   else
-                    location.loc := LOC_FLAGS;
+                    expectloc:=LOC_FLAGS;
                  calcregisters(self,1,0,0);
                end;
            end
@@ -1711,7 +1687,7 @@ implementation
            begin
              if tsetdef(ld).settype=smallset then
               begin
-                 location.loc:=LOC_REGISTER;
+                 expectloc:=LOC_REGISTER;
                  { are we adding set elements ? }
                  if right.nodetype=setelementn then
                    calcregisters(self,2,0,0)
@@ -1723,7 +1699,7 @@ implementation
                  result := first_addset;
                  if assigned(result) then
                    exit;
-                 location.loc:=LOC_CREFERENCE;
+                 expectloc:=LOC_CREFERENCE;
                  calcregisters(self,0,0,0);
                  { here we call SET... }
                  if assigned(procinfo) then
@@ -1734,7 +1710,10 @@ implementation
          { compare pchar by addresses like BP/Delphi }
          else if is_pchar(ld) then
            begin
-             location.loc:=LOC_REGISTER;
+             if nodetype in [addn,subn,muln,andn,orn,xorn] then
+               expectloc:=LOC_REGISTER
+             else
+               expectloc:=LOC_FLAGS;
              calcregisters(self,1,0,0);
            end
 
@@ -1747,7 +1726,7 @@ implementation
                    if assigned(procinfo) then
                      procinfo.no_fast_exit:=true;
                    { this is only for add, the comparisaion is handled later }
-                   location.loc:=LOC_REGISTER;
+                   expectloc:=LOC_REGISTER;
                 end
               else if is_ansistring(ld) then
                 begin
@@ -1755,19 +1734,18 @@ implementation
                    if assigned(procinfo) then
                      procinfo.no_fast_exit:=true;
                    { this is only for add, the comparisaion is handled later }
-                   location.loc:=LOC_REGISTER;
+                   expectloc:=LOC_REGISTER;
                 end
               else if is_longstring(ld) then
                 begin
                    { this is only for add, the comparisaion is handled later }
-                   location.loc:=LOC_CREFERENCE;
+                   expectloc:=LOC_CREFERENCE;
                 end
               else
                 begin
                    if canbeaddsstringcharoptnode(self) then
                      begin
                        hp := genaddsstringcharoptnode(self);
-                       firstpass(hp);
                        pass_1 := hp;
                        exit;
                      end
@@ -1783,7 +1761,6 @@ implementation
                    if canbeaddsstringcsstringoptnode(self) then
                      begin
                        hp := genaddsstringcsstringoptnode(self);
-                       firstpass(hp);
                        pass_1 := hp;
                        exit;
                      end;
@@ -1801,15 +1778,18 @@ implementation
               if assigned(result) then
                 exit;
 {$endif cpufpemu}
-              location.loc:=LOC_FPUREGISTER;
+              if nodetype in [addn,subn,muln,andn,orn,xorn] then
+                expectloc:=LOC_FPUREGISTER
+              else
+                expectloc:=LOC_FLAGS;
               calcregisters(self,0,1,0);
               { an add node always first loads both the left and the    }
               { right in the fpu before doing the calculation. However, }
               { calcregisters(0,2,0) will overestimate the number of    }
               { necessary registers (it will make it 3 in case one of   }
               { the operands is already in the fpu) (JM)                }
-              if ((left.location.loc <> LOC_FPUREGISTER) or
-                  (right.location.loc <> LOC_FPUREGISTER)) and
+              if ((left.expectloc<>LOC_FPUREGISTER) or
+                  (right.expectloc<>LOC_FPUREGISTER)) and
                  (registersfpu < 2) then
                 inc(registersfpu);
             end
@@ -1817,19 +1797,22 @@ implementation
          { pointer comperation and subtraction }
          else if (ld.deftype=pointerdef) then
             begin
-              location.loc:=LOC_REGISTER;
+              if nodetype in [addn,subn,muln,andn,orn,xorn] then
+                expectloc:=LOC_REGISTER
+              else
+                expectloc:=LOC_FLAGS;
               calcregisters(self,1,0,0);
            end
 
          else if is_class_or_interface(ld) then
             begin
-              location.loc:=LOC_REGISTER;
+              expectloc:=LOC_FLAGS;
               calcregisters(self,1,0,0);
             end
 
          else if (ld.deftype=classrefdef) then
             begin
-              location.loc:=LOC_REGISTER;
+              expectloc:=LOC_FLAGS;
               calcregisters(self,1,0,0);
             end
 
@@ -1837,7 +1820,7 @@ implementation
          else if ((ld.deftype=procvardef) and (rt=niln)) or
                  ((rd.deftype=procvardef) and (lt=niln)) then
             begin
-              location.loc:=LOC_REGISTER;
+              expectloc:=LOC_FLAGS;
               calcregisters(self,1,0,0);
             end
 
@@ -1847,14 +1830,14 @@ implementation
          else if (cs_mmx in aktlocalswitches) and is_mmx_able_array(ld) and
                  is_mmx_able_array(rd) then
             begin
-              location.loc:=LOC_MMXREGISTER;
+              expectloc:=LOC_MMXREGISTER;
               calcregisters(self,0,0,1);
             end
 {$endif SUPPORT_MMX}
 
          else if (rd.deftype=pointerdef) or (ld.deftype=pointerdef) then
             begin
-              location.loc:=LOC_REGISTER;
+              expectloc:=LOC_REGISTER;
               calcregisters(self,1,0,0);
             end
 
@@ -1862,13 +1845,13 @@ implementation
                   (ld.deftype=procvardef) and
                   equal_defs(rd,ld) then
            begin
-             location.loc:=LOC_REGISTER;
+             expectloc:=LOC_FLAGS;
              calcregisters(self,1,0,0);
            end
 
          else if (ld.deftype=enumdef) then
            begin
-              location.loc := LOC_FLAGS;
+              expectloc:=LOC_FLAGS;
               calcregisters(self,1,0,0);
            end
 
@@ -1877,7 +1860,7 @@ implementation
                  is_mmx_able_array(ld) and
                  is_mmx_able_array(rd) then
             begin
-              location.loc:=LOC_MMXREGISTER;
+              expectloc:=LOC_MMXREGISTER;
               calcregisters(self,0,0,1);
             end
 {$endif SUPPORT_MMX}
@@ -1885,7 +1868,7 @@ implementation
          { the general solution is to convert to 32 bit int }
          else
            begin
-             location.loc:=LOC_REGISTER;
+             expectloc:=LOC_REGISTER;
              calcregisters(self,1,0,0);
            end;
       end;
@@ -1898,11 +1881,11 @@ implementation
     begin
     track_state_pass:=false;
     if left.track_state_pass(exec_known) then
-        begin
+      begin
         track_state_pass:=true;
         left.resulttype.def:=nil;
         do_resulttypepass(left);
-        end;
+      end;
     factval:=aktstate.find_fact(left);
     if factval<>nil then
         begin
@@ -1931,7 +1914,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.81  2003-02-15 22:20:14  carl
+  Revision 1.82  2003-04-22 23:50:22  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.81  2003/02/15 22:20:14  carl
    * bugfix for generic calls to FPU emulation code
 
   Revision 1.80  2003/02/12 22:10:07  carl

compiler/nbas.pas

@@ -172,7 +172,7 @@ implementation
       verbose,globals,globtype,systems,
       symconst,symdef,symsym,defutil,defcmp,
       pass_1,
-      nld,ncal,nflw,rgobj,cgbase
+      nld,ncal,nflw,rgobj,cginfo,cgbase
       ;
 
 
@@ -203,18 +203,21 @@ implementation
 
     constructor tnothingnode.create;
       begin
-         inherited create(nothingn);
+        inherited create(nothingn);
       end;
 
+
     function tnothingnode.det_resulttype:tnode;
       begin
-         result:=nil;
-         resulttype:=voidtype;
+        result:=nil;
+        resulttype:=voidtype;
       end;
 
+
     function tnothingnode.pass_1 : tnode;
       begin
-         result:=nil;
+        result:=nil;
+        expectloc:=LOC_VOID;
       end;
 
 
@@ -228,6 +231,7 @@ implementation
          inherited create(errorn);
       end;
 
+
     function terrornode.det_resulttype:tnode;
       begin
          result:=nil;
@@ -236,12 +240,15 @@ implementation
          resulttype:=generrortype;
       end;
 
+
     function terrornode.pass_1 : tnode;
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
          codegenerror:=true;
       end;
 
+
     procedure terrornode.mark_write;
       begin
       end;
@@ -282,6 +289,7 @@ implementation
            exit;
       end;
 
+
     function tstatementnode.pass_1 : tnode;
       begin
          result:=nil;
@@ -293,7 +301,7 @@ implementation
          firstpass(left);
          if codegenerror then
            exit;
-         location.loc:=left.location.loc;
+         expectloc:=left.expectloc;
          registers32:=left.registers32;
          registersfpu:=left.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -367,12 +375,14 @@ implementation
            end;
       end;
 
+
     function tblocknode.pass_1 : tnode;
       var
          hp : tstatementnode;
          count : longint;
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
          count:=0;
          hp:=tstatementnode(left);
          while assigned(hp) do
@@ -430,6 +440,7 @@ implementation
                    codegenerror:=false;
                    firstpass(hp.left);
 
+                   hp.expectloc:=hp.left.expectloc;
                    hp.registers32:=hp.left.registers32;
                    hp.registersfpu:=hp.left.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -447,7 +458,7 @@ implementation
               if hp.registersmmx>registersmmx then
                 registersmmx:=hp.registersmmx;
 {$endif}
-              location.loc:=hp.location.loc;
+              expectloc:=hp.expectloc;
               inc(count);
               hp:=tstatementnode(hp.right);
            end;
@@ -557,15 +568,18 @@ implementation
     function tasmnode.pass_1 : tnode;
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
          procinfo.flags:=procinfo.flags or pi_uses_asm;
       end;
 
+
     function tasmnode.docompare(p: tnode): boolean;
       begin
         { comparing of asmlists is not implemented (JM) }
         docompare := false;
       end;
 
+
 {*****************************************************************************
                           TEMPCREATENODE
 *****************************************************************************}
@@ -607,7 +621,8 @@ implementation
 
     function ttempcreatenode.pass_1 : tnode;
       begin
-        result := nil;
+         result := nil;
+         expectloc:=LOC_VOID;
       end;
 
     function ttempcreatenode.det_resulttype: tnode;
@@ -673,7 +688,7 @@ implementation
 
     function ttemprefnode.pass_1 : tnode;
       begin
-        location.loc:=LOC_REFERENCE;
+        expectloc:=LOC_REFERENCE;
         result := nil;
       end;
 
@@ -751,7 +766,8 @@ implementation
 
     function ttempdeletenode.pass_1 : tnode;
       begin
-        result := nil;
+         expectloc:=LOC_VOID;
+         result := nil;
       end;
 
     function ttempdeletenode.det_resulttype: tnode;
@@ -784,7 +800,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.43  2003-04-21 15:00:22  jonas
+  Revision 1.44  2003-04-22 23:50:22  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.43  2003/04/21 15:00:22  jonas
     * fixed tstatementnode.det_resulttype and tststatementnode.pass_1
     * fixed some getcopy issues with ttemp*nodes
 

compiler/ncal.pas

@@ -180,7 +180,7 @@ implementation
       symconst,paramgr,defutil,defcmp,
       htypechk,pass_1,cpubase,
       nbas,ncnv,nld,ninl,nadd,ncon,nmem,
-      rgobj,cgbase
+      rgobj,cginfo,cgbase
       ;
 
 type
@@ -721,6 +721,11 @@ type
                  CGMessage(type_e_strict_var_string_violation);
                end;
 
+             { File types are only allowed for var parameters }
+             if (paraitem.paratype.def.deftype=filedef) and
+                (paraitem.paratyp<>vs_var) then
+               CGMessage(cg_e_file_must_call_by_reference);
+
              { Handle formal parameters separate }
              if (paraitem.paratype.def.deftype=formaldef) then
                begin
@@ -1889,12 +1894,24 @@ type
                while assigned(hpt) and (hpt.nodetype in [subscriptn,vecn]) do
                 hpt:=tunarynode(hpt).left;
 
-               if (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) and
-                  assigned(symtableproc) and (symtableproc.symtabletype=withsymtable) and
-                  not twithsymtable(symtableproc).direct_with then
-                 begin
-                    CGmessage(cg_e_cannot_call_cons_dest_inside_with);
-                 end; { Is accepted by Delphi !! }
+               if (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) then
+                begin
+                  { if an inherited con- or destructor should be  }
+                  { called in a con- or destructor then a warning }
+                  { will be made                                  }
+                  { con- and destructors need a pointer to the vmt }
+                  if is_object(methodpointer.resulttype.def) and
+                     not(aktprocdef.proctypeoption in
+                         [potype_constructor,potype_destructor]) then
+                    CGMessage(cg_w_member_cd_call_from_method);
+
+                  if assigned(symtableproc) and
+                     (symtableproc.symtabletype=withsymtable) and
+                     (not twithsymtable(symtableproc).direct_with) then
+                    begin
+                       CGmessage(cg_e_cannot_call_cons_dest_inside_with);
+                    end; { Is accepted by Delphi !! }
+                end;
 
                { R.Init then R will be initialized by the constructor,
                  Also allow it for simple loads }
@@ -1951,9 +1968,6 @@ type
       label
         errorexit;
       begin
-         { the default is nothing to return }
-         location.loc:=LOC_INVALID;
-
          result:=nil;
          inlined:=false;
          inlinecode := nil;
@@ -2032,19 +2046,19 @@ type
                move them to memory after ... }
              if (resulttype.def.deftype=recorddef) then
               begin
-                location.loc:=LOC_CREFERENCE;
+                expectloc:=LOC_CREFERENCE;
               end
              else
               if paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) then
                begin
-                 location.loc:=LOC_CREFERENCE;
+                 expectloc:=LOC_CREFERENCE;
                end
              else
              { ansi/widestrings must be registered, so we can dispose them }
               if is_ansistring(resulttype.def) or
                  is_widestring(resulttype.def) then
                begin
-                 location.loc:=LOC_CREFERENCE;
+                 expectloc:=LOC_CREFERENCE;
                  registers32:=1;
                end
              else
@@ -2060,15 +2074,15 @@ type
                           if assigned(methodpointer) and
                              (methodpointer.resulttype.def.deftype=classrefdef) then
                            begin
-                             location.loc:=LOC_REGISTER;
+                             expectloc:=LOC_REGISTER;
                              registers32:=1;
                            end
                           else
-                           location.loc:=LOC_FLAGS;
+                           expectloc:=LOC_FLAGS;
                         end
                        else
                         begin
-                          location.loc:=LOC_REGISTER;
+                          expectloc:=LOC_REGISTER;
                           if is_64bitint(resulttype.def) then
                             registers32:=2
                           else
@@ -2077,7 +2091,7 @@ type
                      end;
                    floatdef :
                      begin
-                       location.loc:=LOC_FPUREGISTER;
+                       expectloc:=LOC_FPUREGISTER;
 {$ifdef cpufpemu}
                        if (cs_fp_emulation in aktmoduleswitches) then
                          registers32:=1
@@ -2092,12 +2106,17 @@ type
                      end;
                    else
                      begin
-                       location.loc:=LOC_REGISTER;
+                       expectloc:=LOC_REGISTER;
                        registers32:=1;
                      end;
                  end;
-               end;
-           end;
+               end
+             else
+               expectloc:=LOC_VOID;
+           end
+         else
+           expectloc:=LOC_VOID;
+
 {$ifdef m68k}
          { we need one more address register for virtual calls on m68k }
          if (po_virtualmethod in procdefinition.procoptions) then
@@ -2372,7 +2391,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.138  2003-04-22 09:53:33  peter
+  Revision 1.139  2003-04-22 23:50:22  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.138  2003/04/22 09:53:33  peter
     * fix insert_typeconv to handle new varargs which don't have a
       paraitem set
 

compiler/ncgadd.pas

@@ -180,7 +180,7 @@ interface
       begin
         cmpop := false;
         pass_left_and_right;
-        
+
         { when a setdef is passed, it has to be a smallset }
         if ((left.resulttype.def.deftype=setdef) and
             (tsetdef(left.resulttype.def).settype<>smallset)) or
@@ -201,9 +201,9 @@ interface
 
         clear_left_right(cmpop);
       end;
-      
-      
-     
+
+
+
 
     procedure tcgaddnode.second_addsmallset;
       var
@@ -321,7 +321,7 @@ interface
 *****************************************************************************}
 
     procedure tcgaddnode.second_opboolean;
-      var 
+      var
        cmpop : boolean;
       begin
         cmpop := false;
@@ -454,8 +454,6 @@ interface
                         cg.a_label(exprasmlist,falselabel);
                         falselabel:=ofl;
                      end;
-                   else
-                     CGMessage(type_e_mismatch);
                  end;
                  secondpass(right);
                  maketojumpbool(exprasmlist,right,lr_load_regvars);
@@ -479,7 +477,7 @@ interface
         firstcomplex(self);
 
         pass_left_and_right;
- 
+
         if nodetype in [equaln,unequaln,gtn,gten,ltn,lten] then
           cmpop := true;
 
@@ -516,7 +514,7 @@ interface
                 checkoverflow := true;
              end;
           subn :
-             begin 
+             begin
                 op:=OP_SUB;
                 checkoverflow := true;
              end;
@@ -602,7 +600,7 @@ interface
                 internalerror(2002072803);
             end;
 
-        { emit overflow check if enabled }        
+        { emit overflow check if enabled }
         if checkoverflow then
            cg.g_overflowcheck(exprasmlist,self);
 
@@ -622,7 +620,7 @@ interface
 
     procedure tcgaddnode.second_addordinal;
      var
-      unsigned : boolean; 
+      unsigned : boolean;
       checkoverflow : boolean;
       cgop : topcg;
       tmpreg : tregister;
@@ -660,7 +658,7 @@ interface
            begin
              cgop := OP_OR;
            end;
-         andn: 
+         andn:
            begin
              cgop := OP_AND;
            end;
@@ -676,7 +674,7 @@ interface
            begin
              checkoverflow := true;
              cgop := OP_SUB;
-           end;          
+           end;
        end;
 
       if nodetype <> subn then
@@ -718,10 +716,10 @@ interface
            end;
        end;
 
-       { emit overflow check if required }        
+       { emit overflow check if required }
        if checkoverflow then
         cg.g_overflowcheck(exprasmlist,self);
-     end; 
+     end;
 
 {*****************************************************************************
                                 pass_2
@@ -818,7 +816,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  2003-02-19 22:00:14  daniel
+  Revision 1.7  2003-04-22 23:50:22  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.6  2003/02/19 22:00:14  daniel
     * Code generator converted to new register notation
     - Horribily outdated todo.txt removed
 
@@ -842,4 +845,4 @@ end.
   Revision 1.1  2002/12/07 19:51:35  carl
     + first version (uncompilable!)
 
-}
+}

compiler/ncgbas.pas

@@ -66,7 +66,7 @@ interface
       aasmbase,aasmtai,aasmcpu,symsym,
       cpubase,
       nflw,pass_2,
-      cgbase,cgobj,tgobj,rgobj
+      cgbase,cginfo,cgobj,tgobj,rgobj
       ;
 
 {*****************************************************************************
@@ -75,6 +75,8 @@ interface
 
     procedure tcgnothingnode.pass_2;
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          { avoid an abstract rte }
       end;
 
@@ -85,21 +87,23 @@ interface
 
     procedure tcgstatementnode.pass_2;
       var
-         hp : tnode;
+         hp : tstatementnode;
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          hp:=self;
          while assigned(hp) do
           begin
-            if assigned(tstatementnode(hp).left) then
+            if assigned(hp.left) then
              begin
              {$ifndef newra}
                rg.cleartempgen;
              {$endif newra}
-               secondpass(tstatementnode(hp).left);
+               secondpass(hp.left);
                { Compiler inserted blocks can return values }
-               location_copy(location,tstatementnode(hp).left.location);
+               location_copy(hp.location,hp.left.location);
              end;
-            hp:=tstatementnode(hp).right;
+            hp:=tstatementnode(hp.right);
           end;
       end;
 
@@ -129,6 +133,8 @@ interface
         i : longint;
         skipnode : boolean;
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          if inlining_procedure then
            begin
              objectlibrary.CreateUsedAsmSymbolList;
@@ -219,13 +225,28 @@ interface
 *****************************************************************************}
 
     procedure tcgblocknode.pass_2;
+      var
+        hp : tstatementnode;
       begin
+        location_reset(location,LOC_VOID,OS_NO);
+
         { do second pass on left node }
         if assigned(left) then
          begin
-           secondpass(left);
-           { Compiler inserted blocks can return values }
-           location_copy(location,left.location);
+           hp:=tstatementnode(left);
+           while assigned(hp) do
+            begin
+              if assigned(hp.left) then
+               begin
+               {$ifndef newra}
+                 rg.cleartempgen;
+               {$endif newra}
+                 secondpass(hp.left);
+                 location_copy(hp.location,hp.left.location);
+               end;
+              location_copy(location,hp.location);
+              hp:=tstatementnode(hp.right);
+            end;
          end;
       end;
 
@@ -237,6 +258,8 @@ interface
       var
         temptype : ttemptype;
       begin
+        location_reset(location,LOC_VOID,OS_NO);
+
         { if we're secondpassing the same tcgtempcreatenode twice, we have a bug }
         if tempinfo^.valid then
           internalerror(200108222);
@@ -272,6 +295,8 @@ interface
 
     procedure tcgtempdeletenode.pass_2;
       begin
+        location_reset(location,LOC_VOID,OS_NO);
+
         if release_to_normal then
           tg.ChangeTempType(exprasmlist,tempinfo^.ref,tt_normal)
         else
@@ -290,7 +315,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.30  2003-04-17 07:50:24  daniel
+  Revision 1.31  2003-04-22 23:50:22  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.30  2003/04/17 07:50:24  daniel
     * Some work on interference graph construction
 
   Revision 1.29  2003/03/28 19:16:56  peter

compiler/ncgcal.pas

@@ -164,31 +164,27 @@ implementation
               else
                 begin
                    if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
+                     internalerror(200304235);
+
+                   if calloption=pocall_inline then
                      begin
-                        CGMessage(type_e_mismatch)
+                     {$ifdef newra}
+                       tmpreg:=rg.getaddressregister(exprasmlist);
+                     {$else}
+                       tmpreg:=cg.get_scratch_reg_address(exprasmlist);
+                     {$endif newra}
+                       cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
+                       reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
+                       cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
+                     {$ifdef newra}
+                       rg.ungetregisterint(exprasmlist,tmpreg);
+                     {$else}
+                       cg.free_scratch_reg(exprasmlist,tmpreg);
+                     {$endif}
                      end
                    else
-                     begin
-                       if calloption=pocall_inline then
-                         begin
-                         {$ifdef newra}
-                           tmpreg:=rg.getaddressregister(exprasmlist);
-                         {$else}
-                           tmpreg:=cg.get_scratch_reg_address(exprasmlist);
-                         {$endif newra}
-                           cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
-                           reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
-                           cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
-                         {$ifdef newra}
-                           rg.ungetregisterint(exprasmlist,tmpreg);
-                         {$else}
-                           cg.free_scratch_reg(exprasmlist,tmpreg);
-                         {$endif}
-                         end
-                       else
-                         cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
-                       location_release(exprasmlist,left.location);
-                     end;
+                     cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
+                   location_release(exprasmlist,left.location);
                 end;
            end
          { handle call by reference parameter }
@@ -231,8 +227,6 @@ implementation
          else
            begin
               tempdeftype:=resulttype.def.deftype;
-              if tempdeftype=filedef then
-               CGMessage(cg_e_file_must_call_by_reference);
               { open array must always push the address, this is needed to
                 also push addr of small open arrays and with cdecl functions (PFV) }
               if (
@@ -410,15 +404,6 @@ implementation
                     begin
                       if is_object(methodpointer.resulttype.def) then
                        begin
-                         { object }
-                         { if an inherited con- or destructor should be  }
-                         { called in a con- or destructor then a warning }
-                         { will be made                                  }
-                         { con- and destructors need a pointer to the vmt }
-                         if not(aktprocdef.proctypeoption in
-                                [potype_constructor,potype_destructor]) then
-                           CGMessage(cg_w_member_cd_call_from_method);
-
                          { reset self when calling constructor from destructor }
                          if (procdefinition.proctypeoption=potype_constructor) and
                             assigned(aktprocdef) and
@@ -837,7 +822,9 @@ implementation
                   cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,r,location.register);
                 end;
             end;
-         end;
+         end
+        else
+         location_reset(location,LOC_VOID,OS_NO);
       end;
 
 
@@ -1213,7 +1200,9 @@ implementation
 
          { handle function results }
          if (not is_void(resulttype.def)) then
-          handle_return_value(inlined);
+          handle_return_value(inlined)
+         else
+          location_reset(location,LOC_VOID,OS_NO);
 
          { perhaps i/o check ? }
          if iolabel<>nil then
@@ -1476,7 +1465,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.50  2003-04-22 14:33:38  peter
+  Revision 1.51  2003-04-22 23:50:22  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.50  2003/04/22 14:33:38  peter
     * removed some notes/hints
 
   Revision 1.49  2003/04/22 13:47:08  peter

compiler/ncgcnv.pas

@@ -61,7 +61,7 @@ interface
   implementation
 
     uses
-      cutils,verbose,
+      cutils,verbose,globtype,
       aasmbase,aasmtai,aasmcpu,symconst,symdef,paramgr,
       ncon,ncal,
       cpubase,cpuinfo,cpupara,systems,
@@ -82,7 +82,7 @@ interface
         newsize:=def_cgsize(resulttype.def);
 
         { insert range check if not explicit conversion }
-        if not(nf_explizit in flags) then
+        if not(nf_explicit in flags) then
           cg.g_rangecheck(exprasmlist,left,resulttype.def);
 
         { is the result size smaller? when typecasting from void
@@ -328,7 +328,7 @@ interface
          location_copy(location,left.location);
          { byte(boolean) or word(wordbool) or longint(longbool) must }
          { be accepted for var parameters                            }
-         if not((nf_explizit in flags) and
+         if not((nf_explicit in flags) and
                 (left.resulttype.def.size=resulttype.def.size) and
                 (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER])) then
            location_force_reg(exprasmlist,location,def_cgsize(resulttype.def),false);
@@ -511,7 +511,12 @@ end.
 
 {
   $Log$
-  Revision 1.38  2003-04-06 21:11:23  olle
+  Revision 1.39  2003-04-22 23:50:22  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.38  2003/04/06 21:11:23  olle
     * changed newasmsymbol to newasmsymboldata for data symbols
 
   Revision 1.37  2003/03/28 19:16:56  peter

compiler/ncgflw.pas

@@ -115,6 +115,8 @@ implementation
          otlabel,oflabel : tasmlabel;
 
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          objectlibrary.getlabel(lloop);
          objectlibrary.getlabel(lcont);
          objectlibrary.getlabel(lbreak);
@@ -190,6 +192,8 @@ implementation
          else_list : taasmoutput;
 
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          otlabel:=truelabel;
          oflabel:=falselabel;
          objectlibrary.getlabel(truelabel);
@@ -322,6 +326,8 @@ implementation
          cmp_const:Tconstexprint;
 
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          oldclabel:=aktcontinuelabel;
          oldblabel:=aktbreaklabel;
          objectlibrary.getlabel(aktcontinuelabel);
@@ -341,7 +347,7 @@ implementation
       {$ifndef newra}
          rg.cleartempgen;
       {$endif}
-         
+
          do_loopvar_at_end:=lnf_dont_mind_loopvar_on_exit in loopflags;
 
          secondpass(right);
@@ -679,8 +685,6 @@ implementation
     procedure tcgexitnode.pass_2;
 
       var
-         {op : tasmop;
-         s : topsize;}
          otlabel,oflabel : tasmlabel;
          cgsize : tcgsize;
          r,hreg : tregister;
@@ -689,6 +693,8 @@ implementation
       label
          do_jmp;
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          include(flowcontrol,fc_exit);
          if assigned(left) then
            begin
@@ -829,6 +835,8 @@ implementation
 
     procedure tcgbreaknode.pass_2;
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          include(flowcontrol,fc_break);
          if aktbreaklabel<>nil then
            begin
@@ -846,6 +854,8 @@ implementation
 
     procedure tcgcontinuenode.pass_2;
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          include(flowcontrol,fc_continue);
          if aktcontinuelabel<>nil then
            begin
@@ -864,6 +874,8 @@ implementation
     procedure tcggotonode.pass_2;
 
        begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          load_all_regvars(exprasmlist);
          cg.a_jmp_always(exprasmlist,labsym.lab)
        end;
@@ -875,6 +887,8 @@ implementation
 
     procedure tcglabelnode.pass_2;
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          load_all_regvars(exprasmlist);
          cg.a_label(exprasmlist,labelnr);
       {$ifndef newra}
@@ -890,6 +904,8 @@ implementation
 
     procedure tcgfailnode.pass_2;
       begin
+        location_reset(location,LOC_VOID,OS_NO);
+
         cg.a_jmp_always(exprasmlist,faillabel);
       end;
 
@@ -905,6 +921,8 @@ implementation
          href2: treference;
          r:Tregister;
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          if assigned(left) then
            begin
               { multiple parameters? }
@@ -1024,6 +1042,8 @@ implementation
       label
          errorexit;
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          oldflowcontrol:=flowcontrol;
          flowcontrol:=[];
          { this can be called recursivly }
@@ -1240,6 +1260,8 @@ implementation
          r:Tregister;
 
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          r.enum:=R_INTREGISTER;
          r.number:=NR_ACCUMULATOR;
          oldflowcontrol:=flowcontrol;
@@ -1374,6 +1396,8 @@ implementation
          r:Tregister;
 
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          { check if child nodes do a break/continue/exit }
          oldflowcontrol:=flowcontrol;
          flowcontrol:=[];
@@ -1507,7 +1531,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.54  2003-04-17 07:50:24  daniel
+  Revision 1.55  2003-04-22 23:50:22  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.54  2003/04/17 07:50:24  daniel
     * Some work on interference graph construction
 
   Revision 1.53  2003/04/06 21:11:23  olle

compiler/ncginl.pas

@@ -75,6 +75,8 @@ implementation
        var
          oldpushedparasize : longint;
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          { save & reset pushedparasize }
          oldpushedparasize:=pushedparasize;
          pushedparasize:=0;
@@ -300,25 +302,24 @@ implementation
         href : treference;
       begin
         secondpass(left);
-        { length in ansi strings is at offset -8 }
-        if is_ansistring(left.resulttype.def) or
-           is_widestring(left.resulttype.def) then
-            begin
-              location_force_reg(exprasmlist,left.location,OS_ADDR,false);
-              hregister:=left.location.register;
-              objectlibrary.getlabel(lengthlab);
-              cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,hregister,lengthlab);
-              reference_reset_base(href,hregister,-8);
-              cg.a_load_ref_reg(exprasmlist,OS_32,href,hregister);
-              cg.a_label(exprasmlist,lengthlab);
-              location_reset(location,LOC_REGISTER,OS_32);
-              location.register:=hregister;
-            end
-         else
-            begin
-              location_copy(location,left.location);
-              location.size:=OS_8;
-            end;
+        if is_shortstring(left.resulttype.def) then
+         begin
+           location_copy(location,left.location);
+           location.size:=OS_8;
+         end
+        else
+         begin
+           { length in ansi strings is at offset -8 }
+           location_force_reg(exprasmlist,left.location,OS_ADDR,false);
+           hregister:=left.location.register;
+           objectlibrary.getlabel(lengthlab);
+           cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,hregister,lengthlab);
+           reference_reset_base(href,hregister,-8);
+           cg.a_load_ref_reg(exprasmlist,OS_32,href,hregister);
+           cg.a_label(exprasmlist,lengthlab);
+           location_reset(location,LOC_REGISTER,OS_32);
+           location.register:=hregister;
+         end;
       end;
 
 
@@ -669,7 +670,12 @@ end.
 
 {
   $Log$
-  Revision 1.24  2003-04-22 10:09:35  daniel
+  Revision 1.25  2003-04-22 23:50:22  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.24  2003/04/22 10:09:35  daniel
     + Implemented the actual register allocator
     + Scratch registers unavailable when new register allocator used
     + maybe_save/maybe_restore unavailable when new register allocator used

compiler/ncgld.pas

@@ -107,6 +107,8 @@ implementation
               end;
             varsym :
                begin
+                  if (tvarsym(symtableentry).varspez=vs_const) then
+                    location_reset(location,LOC_CREFERENCE,newsize);
                   symtabletype:=symtable.symtabletype;
                   hregister.enum:=R_NO;
                   { C variable }
@@ -285,7 +287,10 @@ implementation
                            { we need to load only an address }
                            location.size:=OS_ADDR;
                            cg.a_load_loc_reg(exprasmlist,location,hregister);
-                           location_reset(location,LOC_REFERENCE,newsize);
+                           if tvarsym(symtableentry).varspez=vs_const then
+                            location_reset(location,LOC_CREFERENCE,newsize)
+                           else
+                            location_reset(location,LOC_REFERENCE,newsize);
                            location.reference.base:=hregister;
                        end;
                     end;
@@ -312,9 +317,10 @@ implementation
                          LOC_CREGISTER,
                          LOC_REGISTER:
                            begin
-                              hregister:=left.location.register;
+                              { this is not possible for objects }
                               if is_object(left.resulttype.def) then
-                                CGMessage(cg_e_illegal_expression);
+                                internalerror(200304234);
+                              hregister:=left.location.register;
                            end;
                          LOC_CREFERENCE,
                          LOC_REFERENCE:
@@ -407,6 +413,8 @@ implementation
          r:Tregister;
 
       begin
+        location_reset(location,LOC_VOID,OS_NO);
+
         otlabel:=truelabel;
         oflabel:=falselabel;
         objectlibrary.getlabel(truelabel);
@@ -430,8 +438,8 @@ implementation
         }
 
         { Try to determine which side to calculate first,  }
-        if (right.location.loc<>LOC_FLAGS) and
-           ((right.location.loc=LOC_JUMP) or
+        if (right.expectloc<>LOC_FLAGS) and
+           ((right.expectloc=LOC_JUMP) or
             (right.nodetype=calln) or
             (right.registers32>=left.registers32)) then
          begin
@@ -498,14 +506,6 @@ implementation
              exit;
          end;
 
-        if not(left.location.loc in [LOC_REFERENCE,LOC_CFPUREGISTER,
-                                     {$ifdef SUPPORT_MMX}LOC_CMMXREGISTER,{$endif}
-                                     LOC_CREGISTER]) then
-          begin
-             CGMessage(cg_e_illegal_expression);
-             exit;
-          end;
-
         releaseright:=true;
 
         { shortstring assignments are handled separately }
@@ -666,6 +666,7 @@ implementation
                 {$ifndef newra}
                   maybe_save(exprasmlist,left.registers32,right.location,pushedregs);
                 {$endif}
+                  include(left.flags,nf_allow_multi_pass2);
                   secondpass(left);
                 {$ifndef newra}
                   maybe_restore(exprasmlist,right.location,pushedregs);
@@ -794,7 +795,10 @@ implementation
          elesize:=8
         else
          elesize:=tarraydef(resulttype.def).elesize;
-        location_reset(location,LOC_REFERENCE,OS_NO);
+        if nf_cargs in flags then
+         location_reset(location,LOC_VOID,OS_NO)
+        else
+         location_reset(location,LOC_CREFERENCE,OS_NO);
         if not(nf_cargs in flags) then
          begin
            { Allocate always a temp, also if no elements are required, to
@@ -1002,7 +1006,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.48  2003-04-22 10:09:35  daniel
+  Revision 1.49  2003-04-22 23:50:22  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.48  2003/04/22 10:09:35  daniel
     + Implemented the actual register allocator
     + Scratch registers unavailable when new register allocator used
     + maybe_save/maybe_restore unavailable when new register allocator used

compiler/ncgmem.pas

@@ -133,6 +133,7 @@ implementation
 
     procedure tcghnewnode.pass_2;
       begin
+         location_reset(location,LOC_VOID,OS_NO);
          { completely resolved in first pass now }
       end;
 
@@ -381,6 +382,8 @@ implementation
         withlevel : longint = 0;
 {$endif GDB}
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          if assigned(left) then
             begin
                secondpass(left);
@@ -647,10 +650,12 @@ implementation
          pushedregs : tmaybesave;
       begin
          newsize:=def_cgsize(resulttype.def);
-         location_reset(location,LOC_REFERENCE,newsize);
-
          secondpass(left);
-         { we load the array reference to location }
+         if left.location.loc=LOC_CREFERENCE then
+           location_reset(location,LOC_CREFERENCE,newsize)
+         else
+           location_reset(location,LOC_REFERENCE,newsize);
+
 
          { an ansistring needs to be dereferenced }
          if is_ansistring(left.resulttype.def) or
@@ -659,10 +664,7 @@ implementation
               if nf_callunique in flags then
                 begin
                    if left.location.loc<>LOC_REFERENCE then
-                     begin
-                        CGMessage(cg_e_illegal_expression);
-                        exit;
-                     end;
+                     internalerror(200304236);
                    rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
                    cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(1));
                    rg.saveintregvars(exprasmlist,all_intregisters);
@@ -855,8 +857,7 @@ implementation
                 end;
               { calculate from left to right }
               if not(location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
-                { should be internalerror! (JM) }
-                CGMessage(cg_e_illegal_expression);
+                internalerror(200304237);
               isjump:=(right.location.loc=LOC_JUMP);
               if isjump then
                begin
@@ -945,7 +946,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.47  2003-04-22 13:47:08  peter
+  Revision 1.48  2003-04-22 23:50:22  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.47  2003/04/22 13:47:08  peter
     * fixed C style array of const
     * fixed C array passing
     * fixed left to right with high parameters

compiler/ncgset.pas

@@ -924,6 +924,8 @@ implementation
          dist : cardinal;
          hp : tstatementnode;
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          { Relabel for inlining? }
          if inlining_procedure and assigned(nodes) then
           begin
@@ -1113,7 +1115,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.29  2003-04-22 14:33:38  peter
+  Revision 1.30  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.29  2003/04/22 14:33:38  peter
     * removed some notes/hints
 
   Revision 1.28  2003/04/22 12:45:58  florian

compiler/ncnv.pas

@@ -176,7 +176,7 @@ implementation
       cutils,verbose,globals,widestr,
       symconst,symdef,symsym,symtable,
       ncon,ncal,nset,nadd,ninl,nmem,nmat,
-      cgbase,
+      cginfo,cgbase,
       htypechk,pass_1,cpubase,cpuinfo;
 
 
@@ -496,7 +496,7 @@ implementation
 
       begin
          self.create(node,t);
-         toggleflag(nf_explizit);
+         include(flags,nf_explicit);
       end;
 
 
@@ -705,8 +705,7 @@ implementation
              begin
                { create word(byte(char) shl 8 or 1) for litte endian machines }
                { and word(byte(char) or 256) for big endian machines          }
-               left := ctypeconvnode.create(left,u8bittype);
-               left.toggleflag(nf_explizit);
+               left := ctypeconvnode.create_explicit(left,u8bittype);
                if (target_info.endian = endian_little) then
                  left := caddnode.create(orn,
                    cshlshrnode.create(shln,left,cordconstnode.create(8,s32bittype,false)),
@@ -714,8 +713,7 @@ implementation
                else
                  left := caddnode.create(orn,left,
                    cordconstnode.create(1 shl 8,s32bittype,false));
-               left := ctypeconvnode.create(left,u16bittype);
-               left.toggleflag(nf_explizit);
+               left := ctypeconvnode.create_explicit(left,u16bittype);
                resulttypepass(left);
              end;
       end;
@@ -793,7 +791,7 @@ implementation
            if is_currency(resulttype.def) then
             begin
               result:=caddnode.create(muln,getcopy,crealconstnode.create(10000.0,resulttype));
-              include(result.flags,nf_explizit);
+              include(result.flags,nf_is_currency);
             end;
          end;
       end;
@@ -809,14 +807,14 @@ implementation
          if is_currency(left.resulttype.def) and not(is_currency(resulttype.def)) then
            begin
              left:=caddnode.create(slashn,left,crealconstnode.create(10000.0,left.resulttype));
-             include(left.flags,nf_explizit);
+             include(left.flags,nf_is_currency);
              resulttypepass(left);
            end
          else
            if is_currency(resulttype.def) and not(is_currency(left.resulttype.def)) then
              begin
                left:=caddnode.create(muln,left,crealconstnode.create(10000.0,left.resulttype));
-               include(left.flags,nf_explizit);
+               include(left.flags,nf_is_currency);
                resulttypepass(left);
              end;
          if left.nodetype=realconstn then
@@ -892,10 +890,9 @@ implementation
       begin
         { a dynamic array is a pointer to an array, so to convert it to }
         { an open array, we have to dereference it (JM)                 }
-        result := ctypeconvnode.create(left,voidpointertype);
+        result := ctypeconvnode.create_explicit(left,voidpointertype);
         { left is reused }
         left := nil;
-        result.toggleflag(nf_explizit);
         result := cderefnode.create(result);
         result.resulttype := resulttype;
       end;
@@ -1025,7 +1022,7 @@ implementation
          exit;
 
         eq:=compare_defs_ext(left.resulttype.def,resulttype.def,left.nodetype,
-                             nf_explizit in flags,true,convtype,aprocdef);
+                             nf_explicit in flags,true,convtype,aprocdef);
         case eq of
           te_exact,
           te_equal :
@@ -1141,7 +1138,7 @@ implementation
                end;
 
               { Handle explicit type conversions }
-              if nf_explizit in flags then
+              if nf_explicit in flags then
                begin
                  { do common tc_equal cast }
                  convtype:=tc_equal;
@@ -1273,7 +1270,7 @@ implementation
                 begin
                    { replace the resulttype and recheck the range }
                    left.resulttype:=resulttype;
-                   testrange(left.resulttype.def,tordconstnode(left).value,(nf_explizit in flags));
+                   testrange(left.resulttype.def,tordconstnode(left).value,(nf_explicit in flags));
                    result:=left;
                    left:=nil;
                    exit;
@@ -1323,9 +1320,11 @@ implementation
 
       begin
         first_int_to_int:=nil;
-        if (left.location.loc<>LOC_REGISTER) and
+        if (left.expectloc<>LOC_REGISTER) and
            (resulttype.def.size>left.resulttype.def.size) then
-           location.loc:=LOC_REGISTER;
+           expectloc:=LOC_REGISTER
+        else
+           expectloc:=left.expectloc;
         if is_64bitint(resulttype.def) then
           registers32:=max(registers32,2)
         else
@@ -1338,7 +1337,7 @@ implementation
       begin
          first_cstring_to_pchar:=nil;
          registers32:=1;
-         location.loc:=LOC_REGISTER;
+         expectloc:=LOC_REGISTER;
       end;
 
 
@@ -1347,7 +1346,7 @@ implementation
       begin
          first_string_to_chararray:=nil;
          registers32:=1;
-         location.loc:=LOC_REGISTER;
+         expectloc:=LOC_REGISTER;
       end;
 
 
@@ -1355,7 +1354,7 @@ implementation
 
       begin
          first_char_to_string:=nil;
-         location.loc:=LOC_CREFERENCE;
+         expectloc:=LOC_REFERENCE;
       end;
 
 
@@ -1371,7 +1370,7 @@ implementation
          first_array_to_pointer:=nil;
          if registers32<1 then
            registers32:=1;
-         location.loc:=LOC_REGISTER;
+         expectloc:=LOC_REGISTER;
       end;
 
 
@@ -1425,12 +1424,12 @@ implementation
 {$ifdef i386}
          if (tfloatdef(resulttype.def).typ=s64comp) and
             (tfloatdef(left.resulttype.def).typ<>s64comp) and
-            not (nf_explizit in flags) then
+            not (nf_explicit in flags) then
            CGMessage(type_w_convert_real_2_comp);
 {$endif}
          if registersfpu<1 then
            registersfpu:=1;
-         location.loc:=LOC_FPUREGISTER;
+         expectloc:=LOC_FPUREGISTER;
       end;
 
 
@@ -1440,7 +1439,7 @@ implementation
          first_pointer_to_array:=nil;
          if registers32<1 then
            registers32:=1;
-         location.loc:=LOC_REFERENCE;
+         expectloc:=LOC_REFERENCE;
       end;
 
 
@@ -1458,22 +1457,21 @@ implementation
          first_bool_to_int:=nil;
          { byte(boolean) or word(wordbool) or longint(longbool) must
          be accepted for var parameters }
-         if (nf_explizit in flags) and
+         if (nf_explicit in flags) and
             (left.resulttype.def.size=resulttype.def.size) and
-            (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
+            (left.expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
            exit;
          { when converting to 64bit, first convert to a 32bit int and then   }
          { convert to a 64bit int (only necessary for 32bit processors) (JM) }
          if resulttype.def.size > sizeof(aword) then
            begin
-             result := ctypeconvnode.create(left,u32bittype);
-             result.toggleflag(nf_explizit);
+             result := ctypeconvnode.create_explicit(left,u32bittype);
              result := ctypeconvnode.create(result,resulttype);
              left := nil;
              firstpass(result);
              exit;
            end;
-         location.loc:=LOC_REGISTER;
+         expectloc:=LOC_REGISTER;
          if registers32<1 then
            registers32:=1;
       end;
@@ -1485,11 +1483,11 @@ implementation
          first_int_to_bool:=nil;
          { byte(boolean) or word(wordbool) or longint(longbool) must
          be accepted for var parameters }
-         if (nf_explizit in flags) and
+         if (nf_explicit in flags) and
             (left.resulttype.def.size=resulttype.def.size) and
-            (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
+            (left.expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
            exit;
-         location.loc:=LOC_REGISTER;
+         expectloc:=LOC_REGISTER;
          { need if bool to bool !!
            not very nice !!
          insertypeconv(left,s32bittype);
@@ -1503,7 +1501,7 @@ implementation
     function ttypeconvnode.first_bool_to_bool : tnode;
       begin
          first_bool_to_bool:=nil;
-         location.loc:=LOC_REGISTER;
+         expectloc:=LOC_REGISTER;
          if registers32<1 then
            registers32:=1;
       end;
@@ -1512,22 +1510,19 @@ implementation
     function ttypeconvnode.first_char_to_char : tnode;
 
       begin
-         first_char_to_char:=nil;
-         location.loc:=LOC_REGISTER;
-         if registers32<1 then
-           registers32:=1;
+         first_char_to_char:=first_int_to_int;
       end;
 
 
     function ttypeconvnode.first_proc_to_procvar : tnode;
       begin
          first_proc_to_procvar:=nil;
-         if (left.location.loc<>LOC_REFERENCE) then
+         if (left.expectloc<>LOC_REFERENCE) then
            CGMessage(cg_e_illegal_expression);
          registers32:=left.registers32;
          if registers32<1 then
            registers32:=1;
-         location.loc:=LOC_REGISTER;
+         expectloc:=LOC_REGISTER;
       end;
 
 
@@ -1544,8 +1539,7 @@ implementation
         { reused }
         left := nil;
         { convert parameter explicitely to fpc_small_set }
-        p.left := ctypeconvnode.create(p.left,srsym.restype);
-        p.left.toggleflag(nf_explizit);
+        p.left := ctypeconvnode.create_explicit(p.left,srsym.restype);
         { create call, adjust resulttype }
         result :=
           ccallnode.createinternres('fpc_set_load_small',p,resulttype);
@@ -1557,7 +1551,7 @@ implementation
 
       begin
          first_ansistring_to_pchar:=nil;
-         location.loc:=LOC_REGISTER;
+         expectloc:=LOC_REGISTER;
          if registers32<1 then
            registers32:=1;
       end;
@@ -1573,7 +1567,7 @@ implementation
 
       begin
          first_class_to_intf:=nil;
-         location.loc:=LOC_REFERENCE;
+         expectloc:=LOC_REFERENCE;
          if registers32<1 then
            registers32:=1;
       end;
@@ -1746,9 +1740,9 @@ implementation
 {$ifdef SUPPORT_MMX}
         registersmmx:=left.registersmmx;
 {$endif}
-        location.loc:=left.location.loc;
+        expectloc:=left.expectloc;
 
-        if nf_explizit in flags then
+        if nf_explicit in flags then
          begin
            { check if the result could be in a register }
            if not(tstoreddef(resulttype.def).is_intregable) and
@@ -2016,7 +2010,7 @@ implementation
             firstpass(call);
             if codegenerror then
               exit;
-           location.loc:=call.location.loc;
+           expectloc:=call.expectloc;
            registers32:=call.registers32;
            registersfpu:=call.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -2033,7 +2027,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.104  2003-04-22 09:52:30  peter
+  Revision 1.105  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.104  2003/04/22 09:52:30  peter
     * do not convert procvars with void return to callnode
 
   Revision 1.103  2003/03/17 18:54:23  peter

compiler/ncon.pas

@@ -172,7 +172,7 @@ implementation
 
     uses
       cutils,verbose,systems,
-      defutil,cpubase,nld;
+      defutil,cpubase,cginfo,nld;
 
     function genintconstnode(v : TConstExprInt) : tordconstnode;
 
@@ -398,7 +398,7 @@ implementation
     function trealconstnode.pass_1 : tnode;
       begin
          result:=nil;
-         location.loc:=LOC_CREFERENCE;
+         expectloc:=LOC_CREFERENCE;
          { needs to be loaded into an FPU register }
          registersfpu:=1;
       end;
@@ -476,10 +476,7 @@ implementation
     function tordconstnode.pass_1 : tnode;
       begin
          result:=nil;
-         if is_64bitint(resulttype.def) then
-          location.loc:=LOC_CREFERENCE
-         else
-          location.loc:=LOC_CONSTANT;
+         expectloc:=LOC_CONSTANT;
       end;
 
     function tordconstnode.docompare(p: tnode): boolean;
@@ -555,7 +552,7 @@ implementation
     function tpointerconstnode.pass_1 : tnode;
       begin
          result:=nil;
-         location.loc:=LOC_CONSTANT;
+         expectloc:=LOC_CONSTANT;
       end;
 
     function tpointerconstnode.docompare(p: tnode): boolean;
@@ -698,7 +695,11 @@ implementation
     function tstringconstnode.pass_1 : tnode;
       begin
         result:=nil;
-        location.loc:=LOC_CREFERENCE;
+        if (st_type in [st_ansistring,st_widestring]) and
+           (len=0) then
+         expectloc:=LOC_CONSTANT
+        else
+         expectloc:=LOC_CREFERENCE;
       end;
 
     function tstringconstnode.getpcharcopy : pchar;
@@ -803,9 +804,9 @@ implementation
       begin
          result:=nil;
          if tsetdef(resulttype.def).settype=smallset then
-          location.loc:=LOC_CONSTANT
+          expectloc:=LOC_CONSTANT
          else
-          location.loc:=LOC_CREFERENCE;
+          expectloc:=LOC_CREFERENCE;
       end;
 
 {$ifdef oldset}
@@ -854,7 +855,7 @@ implementation
     function tnilnode.pass_1 : tnode;
       begin
         result:=nil;
-        location.loc:=LOC_CONSTANT;
+        expectloc:=LOC_CONSTANT;
       end;
 
 {*****************************************************************************
@@ -902,7 +903,7 @@ implementation
     function tguidconstnode.pass_1 : tnode;
       begin
          result:=nil;
-         location.loc:=LOC_CREFERENCE;
+         expectloc:=LOC_CREFERENCE;
       end;
 
     function tguidconstnode.docompare(p: tnode): boolean;
@@ -924,7 +925,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.45  2002-11-25 17:43:18  peter
+  Revision 1.46  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.45  2002/11/25 17:43:18  peter
     * splitted defbase in defutil,symutil,defcmp
     * merged isconvertable and is_equal into compare_defs(_ext)
     * made operator search faster by walking the list only once

compiler/nflw.pas

@@ -223,7 +223,7 @@ implementation
     {$ifdef state_tracking}
       nstate,
     {$endif}
-      cgbase
+      cginfo,cgbase
       ;
 
     function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode;
@@ -394,6 +394,7 @@ implementation
          old_t_times : longint;
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
          old_t_times:=rg.t_times;
 
          { calc register weight }
@@ -557,6 +558,7 @@ implementation
          hp : tnode;
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
          old_t_times:=rg.t_times;
          rg.cleartempgen;
          firstpass(left);
@@ -760,6 +762,7 @@ implementation
       {$endif loopvar_dont_mind}
      begin
          result:=nil;
+         expectloc:=LOC_VOID;
          { Calc register weight }
          old_t_times:=rg.t_times;
          if not(cs_littlesize in aktglobalswitches) then
@@ -891,6 +894,7 @@ implementation
     function texitnode.pass_1 : tnode;
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
          if assigned(left) then
            begin
               firstpass(left);
@@ -926,6 +930,7 @@ implementation
     function tbreaknode.pass_1 : tnode;
       begin
         result:=nil;
+        expectloc:=LOC_VOID;
       end;
 
 
@@ -949,6 +954,7 @@ implementation
     function tcontinuenode.pass_1 : tnode;
       begin
         result:=nil;
+        expectloc:=LOC_VOID;
       end;
 
 
@@ -997,6 +1003,7 @@ implementation
     function tgotonode.pass_1 : tnode;
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
          { check if }
          if assigned(labsym) and
             assigned(labsym.code) and
@@ -1090,6 +1097,7 @@ implementation
     function tlabelnode.pass_1 : tnode;
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
          if assigned(left) then
           begin
             rg.cleartempgen;
@@ -1205,6 +1213,7 @@ implementation
     function traisenode.pass_1 : tnode;
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
          if assigned(left) then
            begin
               { first para must be a _class_ }
@@ -1256,6 +1265,7 @@ implementation
     function ttryexceptnode.pass_1 : tnode;
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
          rg.cleartempgen;
          firstpass(left);
          { on statements }
@@ -1308,6 +1318,7 @@ implementation
     function ttryfinallynode.pass_1 : tnode;
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
          rg.cleartempgen;
          firstpass(left);
 
@@ -1372,6 +1383,7 @@ implementation
     function tonnode.pass_1 : tnode;
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
          rg.cleartempgen;
          registers32:=0;
          registersfpu:=0;
@@ -1427,7 +1439,8 @@ implementation
 
     function tfailnode.pass_1 : tnode;
       begin
-         result:=nil;
+        result:=nil;
+        expectloc:=LOC_VOID;
       end;
 
 
@@ -1453,7 +1466,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.65  2003-03-20 15:54:46  peter
+  Revision 1.66  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.65  2003/03/20 15:54:46  peter
     * don't allow var and out parameters as for loop counter
 
   Revision 1.64  2003/01/09 21:52:37  peter

compiler/ninl.pas

@@ -75,7 +75,7 @@ implementation
       symbase,symconst,symtype,symdef,symsym,symtable,paramgr,defutil,defcmp,
       pass_1,
       ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,
-      cpubase,tgobj,cgbase
+      cpubase,tgobj,cginfo,cgbase
       ;
 
    function geninlinenode(number : byte;is_const:boolean;l : tnode) : tinlinenode;
@@ -934,11 +934,10 @@ implementation
           { and cardinals are fine. Since the formal code para type is      }
           { longint, insert a typecoversion to longint for cardinal para's  }
           begin
-            codepara.left := ctypeconvnode.create(codepara.left,s32bittype);
+            codepara.left := ctypeconvnode.create_explicit(codepara.left,s32bittype);
             { make it explicit, oterwise you may get a nonsense range }
             { check error if the cardinal already contained a value   }
             { > $7fffffff                                             }
-            codepara.left.toggleflag(nf_explizit);
             codepara.get_paratype;
           end;
 
@@ -1418,26 +1417,23 @@ implementation
                            uchar:
                              begin
                                { change to byte() }
-                               hp:=ctypeconvnode.create(left,u8bittype);
+                               hp:=ctypeconvnode.create_explicit(left,u8bittype);
                                left:=nil;
-                               include(hp.flags,nf_explizit);
                                result:=hp;
                              end;
                            bool16bit,
                            uwidechar :
                              begin
                                { change to word() }
-                               hp:=ctypeconvnode.create(left,u16bittype);
+                               hp:=ctypeconvnode.create_explicit(left,u16bittype);
                                left:=nil;
-                               include(hp.flags,nf_explizit);
                                result:=hp;
                              end;
                            bool32bit :
                              begin
                                { change to dword() }
-                               hp:=ctypeconvnode.create(left,u32bittype);
+                               hp:=ctypeconvnode.create_explicit(left,u32bittype);
                                left:=nil;
-                               include(hp.flags,nf_explizit);
                                result:=hp;
                              end;
                            uvoid :
@@ -1453,9 +1449,8 @@ implementation
                        end;
                      enumdef :
                        begin
-                         hp:=ctypeconvnode.create(left,s32bittype);
+                         hp:=ctypeconvnode.create_explicit(left,s32bittype);
                          left:=nil;
-                         include(hp.flags,nf_explizit);
                          result:=hp;
                        end;
                      else
@@ -1467,8 +1462,7 @@ implementation
                 begin
                    { convert to explicit char() }
                    set_varstate(left,true);
-                   hp:=ctypeconvnode.create(left,cchartype);
-                   include(hp.flags,nf_explizit);
+                   hp:=ctypeconvnode.create_explicit(left,cchartype);
                    left:=nil;
                    result:=hp;
                 end;
@@ -1787,9 +1781,7 @@ implementation
                               begin
                                 { can't use inserttypeconv because we need }
                                 { an explicit type conversion (JM)         }
-                                hp := ctypeconvnode.create(left,voidpointertype);
-                                hp.toggleflag(nf_explizit);
-                                hp := ccallparanode.create(hp,nil);
+                                hp := ccallparanode.create(ctypeconvnode.create_explicit(left,voidpointertype),nil);
                                 result := ccallnode.createintern('fpc_dynarray_high',hp);
                                 { make sure the left node doesn't get disposed, since it's }
                                 { reused in the new node (JM)                              }
@@ -1995,8 +1987,8 @@ implementation
               else
                 firstpass(left);
               left_max;
-              location.loc:=left.location.loc;
            end;
+
          inc(parsing_para_level);
          { intern const should already be handled }
          if nf_inlineconst in flags then
@@ -2019,12 +2011,11 @@ implementation
                   shiftconst := 8;
               end;
               if shiftconst <> 0 then
-                result := ctypeconvnode.create(cshlshrnode.create(shrn,left,
+                result := ctypeconvnode.create_explicit(cshlshrnode.create(shrn,left,
                     cordconstnode.create(shiftconst,u32bittype,false)),resulttype)
               else
-                result := ctypeconvnode.create(left,resulttype);
+                result := ctypeconvnode.create_explicit(left,resulttype);
               left := nil;
-              include(result.flags,nf_explizit);
               firstpass(result);
             end;
 
@@ -2032,40 +2023,32 @@ implementation
             begin
               if registers32<1 then
                  registers32:=1;
-              location.loc:=LOC_REGISTER;
+              expectloc:=LOC_REGISTER;
             end;
 
           in_typeof_x:
             begin
                if registers32<1 then
                  registers32:=1;
-               location.loc:=LOC_REGISTER;
-            end;
-
-          in_ord_x,
-          in_chr_byte:
-            begin
-               { should not happend as it's converted to typeconv }
-               internalerror(200104045);
+               expectloc:=LOC_REGISTER;
             end;
 
-
           in_length_x:
             begin
                if is_shortstring(left.resulttype.def) then
-                location.loc:=LOC_REFERENCE
+                expectloc:=left.expectloc
                else
                 begin
                   { ansi/wide string }
                   if registers32<1 then
                    registers32:=1;
-                  location.loc:=LOC_REGISTER;
+                  expectloc:=LOC_REGISTER;
                 end;
             end;
 
           in_typeinfo_x:
             begin
-               location.loc:=LOC_REGISTER;
+               expectloc:=LOC_REGISTER;
                registers32:=1;
             end;
 
@@ -2075,12 +2058,6 @@ implementation
                internalerror(2002080201);
             end;
 
-          in_ofs_x :
-            internalerror(2000101001);
-
-          in_seg_x :
-            internalerror(200104046);
-
           in_pred_x,
           in_succ_x:
             begin
@@ -2094,20 +2071,24 @@ implementation
                  if (registers32<1) then
                   registers32:=1;
                end;
-              location.loc:=LOC_REGISTER;
+              expectloc:=LOC_REGISTER;
             end;
 
           in_setlength_x:
             begin
+              expectloc:=LOC_VOID;
             end;
 
           in_finalize_x:
             begin
+              expectloc:=LOC_VOID;
             end;
 
           in_inc_x,
           in_dec_x:
             begin
+               expectloc:=LOC_VOID;
+
                { check type }
                if is_64bitint(left.resulttype.def) or
                   { range/overflow checking doesn't work properly }
@@ -2152,7 +2133,7 @@ implementation
                       begin
                          { need we an additional register ? }
                          if not(is_constintnode(tcallparanode(tcallparanode(left).right).left)) and
-                           (tcallparanode(tcallparanode(left).right).left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) and
+                           (tcallparanode(tcallparanode(left).right).left.expectloc in [LOC_CREFERENCE,LOC_REFERENCE]) and
                            (tcallparanode(tcallparanode(left).right).left.registers32<=1) then
                            inc(registers32);
 
@@ -2163,39 +2144,11 @@ implementation
                  end;
             end;
 
-          in_read_x,
-          in_readln_x,
-          in_write_x,
-          in_writeln_x :
-            begin
-               { should be handled by det_resulttype }
-               internalerror(200108234);
-            end;
-         in_settextbuf_file_x :
-           internalerror(200104262);
-
-         in_reset_typedfile,
-         in_rewrite_typedfile :
-           begin
-              { should already be removed in det_resulttype (JM) }
-              internalerror(200108236);
-           end;
-
-         in_str_x_string :
-           begin
-              { should already be removed in det_resulttype (JM) }
-              internalerror(200108235);
-           end;
-
-         in_val_x :
-           begin
-              { should already be removed in det_resulttype (JM) }
-              internalerror(200108242);
-           end;
-
          in_include_x_y,
          in_exclude_x_y:
            begin
+              expectloc:=LOC_VOID;
+
               registers32:=left.registers32;
               registersfpu:=left.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -2203,10 +2156,6 @@ implementation
 {$endif SUPPORT_MMX}
            end;
 
-         in_low_x,
-         in_high_x:
-          internalerror(200104047);
-
          in_cos_extended:
            begin
              result:= first_cos_real;
@@ -2255,6 +2204,7 @@ implementation
 
          in_assert_x_y :
             begin
+              expectloc:=LOC_VOID;
               registers32:=left.registers32;
               registersfpu:=left.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -2262,6 +2212,37 @@ implementation
 {$endif SUPPORT_MMX}
             end;
 
+         in_low_x,
+         in_high_x:
+          internalerror(200104047);
+
+          in_ord_x,
+          in_chr_byte:
+            begin
+               { should not happend as it's converted to typeconv }
+               internalerror(200104045);
+            end;
+
+          in_ofs_x :
+            internalerror(2000101001);
+
+          in_seg_x :
+            internalerror(200104046);
+
+          in_settextbuf_file_x,
+          in_reset_typedfile,
+          in_rewrite_typedfile,
+          in_str_x_string,
+          in_val_x,
+          in_read_x,
+          in_readln_x,
+          in_write_x,
+          in_writeln_x :
+            begin
+              { should be handled by det_resulttype }
+              internalerror(200108234);
+            end;
+
           else
             internalerror(8);
           end;
@@ -2354,7 +2335,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.105  2002-12-30 12:54:45  jonas
+  Revision 1.106  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.105  2002/12/30 12:54:45  jonas
     * don't allow erroneuos read(typedfile,...) statements
 
   Revision 1.104  2002/12/30 12:48:07  jonas

compiler/nld.pas

@@ -401,7 +401,7 @@ implementation
     function tloadnode.pass_1 : tnode;
       begin
          result:=nil;
-         location.loc:=LOC_REFERENCE;
+         expectloc:=LOC_REFERENCE;
          registers32:=0;
          registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -419,7 +419,7 @@ implementation
                       { we use ansistrings so no fast exit here }
                       if assigned(procinfo) then
                         procinfo.no_fast_exit:=true;
-                      location.loc:=LOC_CREFERENCE;
+                      expectloc:=LOC_CREFERENCE;
                    end;
               end;
             varsym :
@@ -438,7 +438,7 @@ implementation
                         end;
                      end;
                    if (tvarsym(symtableentry).varspez=vs_const) then
-                     location.loc:=LOC_CREFERENCE;
+                     expectloc:=LOC_CREFERENCE;
                    { we need a register for call by reference parameters }
                    if (tvarsym(symtableentry).varspez in [vs_var,vs_out]) or
                       ((tvarsym(symtableentry).varspez=vs_const) and
@@ -706,7 +706,7 @@ implementation
         { if its not explicit, and only if the values are       }
         { ordinals, enumdef and floatdef                        }
         if (right.nodetype = typeconvn) and
-           not (nf_explizit in ttypeconvnode(right).flags) then
+           not (nf_explicit in ttypeconvnode(right).flags) then
          begin
             if assigned(left.resulttype.def) and
               (left.resulttype.def.deftype in [enumdef,orddef,floatdef]) then
@@ -745,6 +745,7 @@ implementation
 
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
 
          firstpass(left);
          firstpass(right);
@@ -846,7 +847,7 @@ implementation
     function tfuncretnode.pass_1 : tnode;
       begin
          result:=nil;
-         location.loc:=LOC_REFERENCE;
+         expectloc:=LOC_REFERENCE;
          if paramanager.ret_in_param(resulttype.def,tprocdef(funcretsym.owner.defowner).proccalloption) or
             (lexlevel<>funcretsym.owner.symtablelevel) then
            registers32:=1;
@@ -888,7 +889,7 @@ implementation
       begin
         firstpass(left);
         firstpass(right);
-        location.loc := LOC_CREFERENCE;
+        expectloc:=LOC_CREFERENCE;
         calcregisters(self,0,0,0);
         result:=nil;
       end;
@@ -1079,21 +1080,21 @@ implementation
               chp.flags := chp.flags+orgflags;
               include(chp.flags,nf_cargs);
               include(chp.flags,nf_cargswap);
-              chp.location.loc:=LOC_CREFERENCE;
+              chp.expectloc:=LOC_CREFERENCE;
               calcregisters(chp,0,0,0);
               chp.resulttype:=htype;
               result:=chp;
               exit;
             end;
          end;
+        { C style has pushed everything on the stack, so
+          there is no return value }
+        if (nf_cargs in flags) then
+         expectloc:=LOC_VOID
+        else
+         expectloc:=LOC_CREFERENCE;
         { Calculate registers }
-        location.loc:=LOC_CREFERENCE;
         calcregisters(self,0,0,0);
-        { C Arguments are pushed on the stack and
-          are not accesible after the push. This must be done
-          after calcregisters, because that needs a valid location }
-        if (nf_cargs in flags) then
-          location.loc:=LOC_INVALID;
       end;
 
 
@@ -1152,6 +1153,7 @@ implementation
     function ttypenode.pass_1 : tnode;
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
          { a typenode can't generate code, so we give here
            an error. Else it'll be an abstract error in pass_2.
            Only when the allowed flag is set we don't generate
@@ -1226,7 +1228,7 @@ implementation
     function trttinode.pass_1 : tnode;
       begin
         result:=nil;
-        location.loc:=LOC_CREFERENCE;
+        expectloc:=LOC_CREFERENCE;
       end;
 
 
@@ -1257,7 +1259,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.83  2003-04-11 15:01:23  peter
+  Revision 1.84  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.83  2003/04/11 15:01:23  peter
     * fix bug 2438
 
   Revision 1.82  2003/03/28 19:16:56  peter

compiler/nmat.pas

@@ -85,7 +85,7 @@ implementation
       globtype,
       symconst,symtype,symtable,symdef,defutil,
       htypechk,pass_1,cpubase,
-      cgbase,
+      cginfo,cgbase,
       ncon,ncnv,ncal,nadd;
 
 {****************************************************************************
@@ -301,7 +301,7 @@ implementation
              result := first_moddiv64bitint;
              if assigned(result) then
                exit;
-             location.loc:=LOC_REGISTER;
+             expectloc:=LOC_REGISTER;
              calcregisters(self,2,0,0);
            end
          else
@@ -310,7 +310,7 @@ implementation
              if left.registers32<=right.registers32 then
               inc(registers32);
            end;
-         location.loc:=LOC_REGISTER;
+         expectloc:=LOC_REGISTER;
       end;
 
 
@@ -414,7 +414,7 @@ implementation
 
          if (right.nodetype<>ordconstn) then
           inc(regs);
-         location.loc:=LOC_REGISTER;
+         expectloc:=LOC_REGISTER;
          calcregisters(self,regs,0,0);
       end;
 
@@ -515,33 +515,33 @@ implementation
 
          if (left.resulttype.def.deftype=floatdef) then
            begin
-              if (left.location.loc<>LOC_REGISTER) and
+              if (left.expectloc<>LOC_REGISTER) and
                  (registersfpu<1) then
                 registersfpu:=1;
-              location.loc:=LOC_FPUREGISTER;
+              expectloc:=LOC_FPUREGISTER;
            end
 {$ifdef SUPPORT_MMX}
          else if (cs_mmx in aktlocalswitches) and
            is_mmx_able_array(left.resulttype.def) then
              begin
-               if (left.location.loc<>LOC_MMXREGISTER) and
+               if (left.expectloc<>LOC_MMXREGISTER) and
                   (registersmmx<1) then
                  registersmmx:=1;
              end
 {$endif SUPPORT_MMX}
          else if is_64bitint(left.resulttype.def) then
            begin
-              if (left.location.loc<>LOC_REGISTER) and
+              if (left.expectloc<>LOC_REGISTER) and
                  (registers32<2) then
                 registers32:=2;
-              location.loc:=LOC_REGISTER;
+              expectloc:=LOC_REGISTER;
            end
          else if (left.resulttype.def.deftype=orddef) then
            begin
-              if (left.location.loc<>LOC_REGISTER) and
+              if (left.expectloc<>LOC_REGISTER) and
                  (registers32<1) then
                 registers32:=1;
-              location.loc:=LOC_REGISTER;
+              expectloc:=LOC_REGISTER;
            end;
       end;
 
@@ -678,24 +678,24 @@ implementation
          if codegenerror then
            exit;
 
-         location.loc:=left.location.loc;
+         expectloc:=left.expectloc;
          registers32:=left.registers32;
 {$ifdef SUPPORT_MMX}
          registersmmx:=left.registersmmx;
 {$endif SUPPORT_MMX}
          if is_boolean(resulttype.def) then
            begin
-             if (location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
+             if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
               begin
-                location.loc:=LOC_REGISTER;
+                expectloc:=LOC_REGISTER;
                 if (registers32<1) then
                  registers32:=1;
               end;
             { before loading it into flags we need to load it into
               a register thus 1 register is need PM }
 {$ifdef i386}
-             if left.location.loc<>LOC_JUMP then
-               location.loc:=LOC_FLAGS;
+             if left.expectloc<>LOC_JUMP then
+               expectloc:=LOC_FLAGS;
 {$endif def i386}
            end
          else
@@ -703,7 +703,7 @@ implementation
            if (cs_mmx in aktlocalswitches) and
              is_mmx_able_array(left.resulttype.def) then
              begin
-               if (left.location.loc<>LOC_MMXREGISTER) and
+               if (left.expectloc<>LOC_MMXREGISTER) and
                  (registersmmx<1) then
                  registersmmx:=1;
              end
@@ -711,19 +711,19 @@ implementation
 {$endif SUPPORT_MMX}
            if is_64bitint(left.resulttype.def) then
              begin
-                if (location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
+                if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
                  begin
-                   location.loc:=LOC_REGISTER;
+                   expectloc:=LOC_REGISTER;
                    if (registers32<2) then
                     registers32:=2;
                  end;
              end
          else if is_integer(left.resulttype.def) then
            begin
-              if (left.location.loc<>LOC_REGISTER) and
+              if (left.expectloc<>LOC_REGISTER) and
                  (registers32<1) then
                 registers32:=1;
-              location.loc:=LOC_REGISTER;
+              expectloc:=LOC_REGISTER;
            end
       end;
 
@@ -748,7 +748,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.44  2002-11-25 17:43:20  peter
+  Revision 1.45  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.44  2002/11/25 17:43:20  peter
     * splitted defbase in defutil,symutil,defcmp
     * merged isconvertable and is_equal into compare_defs(_ext)
     * made operator search faster by walking the list only once

compiler/nmem.pas

@@ -152,7 +152,7 @@ implementation
       cutils,verbose,globals,
       symconst,symbase,defutil,defcmp,
       nbas,
-      htypechk,pass_1,ncal,nld,ncon,ncnv,cgbase
+      htypechk,pass_1,ncal,nld,ncon,ncnv,cginfo,cgbase
       ;
 
 {*****************************************************************************
@@ -178,7 +178,7 @@ implementation
       begin
          result:=nil;
          registers32:=1;
-         location.loc:=LOC_REGISTER;
+         expectloc:=LOC_REGISTER;
       end;
 
 {*****************************************************************************
@@ -225,6 +225,7 @@ implementation
     function thnewnode.pass_1 : tnode;
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
       end;
 
 
@@ -264,13 +265,9 @@ implementation
 {$endif SUPPORT_MMX}
          if registers32<1 then
            registers32:=1;
-         {
-         if left.location.loc<>LOC_REFERENCE then
-           CGMessage(cg_e_illegal_expression);
-         }
-         if left.location.loc=LOC_CREGISTER then
+         if left.expectloc=LOC_CREGISTER then
            inc(registers32);
-         location.loc:=LOC_REFERENCE;
+         expectloc:=LOC_REFERENCE;
       end;
 
 
@@ -485,12 +482,12 @@ implementation
 {$endif SUPPORT_MMX}
             if registers32<1 then
              registers32:=1;
-            location.loc:=left.location.loc;
+            expectloc:=left.expectloc;
             exit;
           end;
 
          { we should allow loc_mem for @string }
-         if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
+         if not(left.expectloc in [LOC_CREFERENCE,LOC_REFERENCE]) then
            begin
              aktfilepos:=left.fileinfo;
              CGMessage(cg_e_illegal_expression);
@@ -504,7 +501,7 @@ implementation
          if registers32<1 then
            registers32:=1;
          { is this right for object of methods ?? }
-         location.loc:=LOC_REGISTER;
+         expectloc:=LOC_REGISTER;
       end;
 
 
@@ -544,7 +541,7 @@ implementation
          if codegenerror then
            exit;
 
-         if (left.location.loc<>LOC_REFERENCE) then
+         if (left.expectloc<>LOC_REFERENCE) then
            CGMessage(cg_e_illegal_expression);
 
          registers32:=left.registers32;
@@ -554,7 +551,7 @@ implementation
 {$endif SUPPORT_MMX}
          if registers32<1 then
            registers32:=1;
-         location.loc:=LOC_REGISTER;
+         expectloc:=LOC_REGISTER;
       end;
 
 
@@ -602,7 +599,7 @@ implementation
          registersmmx:=left.registersmmx;
 {$endif SUPPORT_MMX}
 
-         location.loc:=LOC_REFERENCE;
+         expectloc:=LOC_REFERENCE;
       end;
 
 
@@ -681,14 +678,14 @@ implementation
            begin
               if registers32=0 then
                 registers32:=1;
-              location.loc:=LOC_REFERENCE;
+              expectloc:=LOC_REFERENCE;
            end
          else
            begin
-              if (left.location.loc<>LOC_CREFERENCE) and
-                 (left.location.loc<>LOC_REFERENCE) then
+              if (left.expectloc<>LOC_CREFERENCE) and
+                 (left.expectloc<>LOC_REFERENCE) then
                 CGMessage(cg_e_illegal_expression);
-              location.loc:=left.location.loc;
+              expectloc:=left.expectloc;
            end;
       end;
 
@@ -844,7 +841,7 @@ implementation
                 inc(registers32);
 
               { need we an extra register for the index ? }
-              if (right.location.loc<>LOC_REGISTER)
+              if (right.expectloc<>LOC_REGISTER)
               { only if the right node doesn't need a register }
                 and (right.registers32<1) then
                 inc(registers32);
@@ -861,10 +858,10 @@ implementation
 {$ifdef SUPPORT_MMX}
          registersmmx:=max(left.registersmmx,right.registersmmx);
 {$endif SUPPORT_MMX}
-         if left.location.loc in [LOC_CREGISTER,LOC_REFERENCE] then
-           location.loc:=LOC_REFERENCE
+         if left.expectloc=LOC_CREFERENCE then
+           expectloc:=LOC_CREFERENCE
          else
-           location.loc:=LOC_CREFERENCE;
+           expectloc:=LOC_REFERENCE;
       end;
 
 
@@ -912,9 +909,9 @@ implementation
          if (resulttype.def.deftype=classrefdef) or
             is_class(resulttype.def) or
             (po_staticmethod in aktprocdef.procoptions) then
-           location.loc:=LOC_CREGISTER
+           expectloc:=LOC_REGISTER
          else
-           location.loc:=LOC_REFERENCE;
+           expectloc:=LOC_CREFERENCE;
       end;
 
 
@@ -1016,6 +1013,7 @@ implementation
     function twithnode.pass_1 : tnode;
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
          if assigned(left) and assigned(right) then
             begin
                firstpass(left);
@@ -1054,7 +1052,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.47  2003-04-10 17:57:52  peter
+  Revision 1.48  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.47  2003/04/10 17:57:52  peter
     * vs_hidden released
 
   Revision 1.46  2003/01/30 21:46:57  peter

compiler/node.pas

@@ -29,7 +29,7 @@ interface
     uses
        cclasses,
        globtype,globals,
-       cpubase,
+       cpubase,cginfo,
        aasmbase,
        symtype,symppu;
 
@@ -213,15 +213,19 @@ interface
     type
        { all boolean field of ttree are now collected in flags }
        tnodeflags = (
-         nf_needs_truefalselabel,
          nf_swapable,    { tbinop operands can be swaped }
          nf_swaped,      { tbinop operands are swaped    }
          nf_error,
+
+         { general }
          nf_write,       { Node is written to            }
+         nf_first_use,   { First node that uses a variable after declared }
+         nf_varstateset,
+         nf_isproperty,
+         nf_allow_multi_pass2, { allow multiple secondpass }
 
          { flags used by tcallnode }
          nf_return_value_used,
-         nf_static_call,
          nf_anon_inherited,
 
          { flags used by tcallparanode }
@@ -240,32 +244,25 @@ interface
 
          { tloadnode }
          nf_absolute,
-         nf_first,
+
+         { taddnode }
+         nf_is_currency,
 
          { tassignmentnode }
          nf_concat_string,
-
-         { tfuncretnode }
-         nf_is_first_funcret,
+         nf_use_strconcat,
 
          { tarrayconstructnode }
-         nf_cargs,             { 20th }
+         nf_cargs,
          nf_cargswap,
          nf_forcevaria,
          nf_novariaallowed,
 
          { ttypeconvnode }
-         nf_explizit,
+         nf_explicit,
 
          { tinlinenode }
-         nf_inlineconst,
-
-         { general }
-         nf_isproperty,
-         nf_varstateset,
-
-         { taddnode }
-         nf_use_strconcat
+         nf_inlineconst
        );
 
        tnodeflagset = set of tnodeflags;
@@ -273,7 +270,7 @@ interface
     const
        { contains the flags which must be equal for the equality }
        { of nodes                                                }
-       flagsequal : tnodeflagset = [nf_error,nf_static_call];
+       flagsequal : tnodeflagset = [nf_error];
 
     type
        tnodelist = class
@@ -286,7 +283,9 @@ interface
           nodetype : tnodetype;
           { type of the current code block, general/const/type }
           blocktype : tblock_type;
-          { the location of the result of this node }
+          { expected location of the result of this node (pass1) }
+          expectloc : tcgloc;
+          { the location of the result of this node (pass2) }
           location : tlocation;
           { the parent node of this is node    }
           { this field is set by concattolist  }
@@ -511,7 +510,9 @@ implementation
          inherited create;
          nodetype:=t;
          blocktype:=block_type;
-         { this allows easier error tracing }
+         { updated by firstpass }
+         expectloc:=LOC_INVALID;
+         { updated by secondpass }
          location.loc:=LOC_INVALID;
          { save local info }
          fileinfo:=aktfilepos;
@@ -545,6 +546,8 @@ implementation
         ppufile.gettype(resulttype);
         ppufile.getsmallset(flags);
         { updated by firstpass }
+        expectloc:=LOC_INVALID;
+        { updated by secondpass }
         location.loc:=LOC_INVALID;
         registers32:=0;
         registersfpu:=0;
@@ -981,7 +984,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.53  2003-04-22 09:52:00  peter
+  Revision 1.54  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.53  2003/04/22 09:52:00  peter
     * mark_write implemented for default with a warning in EXTDEBUG, this
       is required for error recovery where the left node can be also a non
       writable node

compiler/nopt.pas

@@ -85,7 +85,7 @@ var
 implementation
 
 uses cutils, htypechk, defutil, defcmp, globtype, globals, cpubase, ncnv, ncon,
-     verbose, symdef, cgbase;
+     verbose, symdef, cginfo,cgbase;
 
 
 {*****************************************************************************
@@ -137,7 +137,7 @@ end;
 function taddsstringoptnode.pass_1: tnode;
 begin
   pass_1 := nil;
-  location.loc := LOC_CREFERENCE;
+  expectloc:= LOC_CREFERENCE;
   calcregisters(self,0,0,0);
   { here we call STRCONCAT or STRCMP or STRCOPY }
   procinfo.flags:=procinfo.flags or pi_do_call;
@@ -278,7 +278,12 @@ end.
 
 {
   $Log$
-  Revision 1.12  2002-11-25 17:43:20  peter
+  Revision 1.13  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.12  2002/11/25 17:43:20  peter
     * splitted defbase in defutil,symutil,defcmp
     * merged isconvertable and is_equal into compare_defs(_ext)
     * made operator search faster by walking the list only once

compiler/nset.pas

@@ -118,7 +118,7 @@ implementation
       verbose,
       symconst,symdef,symsym,defutil,defcmp,
       htypechk,pass_1,
-      nbas,ncnv,ncon,cpubase,nld,rgobj,cgbase;
+      nbas,ncnv,ncon,cpubase,nld,rgobj,cginfo,cgbase;
 
     function gencasenode(l,r : tnode;nodes : pcaserecord) : tnode;
 
@@ -165,7 +165,7 @@ implementation
          if codegenerror then
           exit;
 
-         location_copy(location,left.location);
+         expectloc:=left.expectloc;
          calcregisters(self,0,0,0);
       end;
 
@@ -321,7 +321,7 @@ implementation
     function tinnode.pass_1 : tnode;
       begin
          result:=nil;
-         location.loc:=LOC_REGISTER;
+         expectloc:=LOC_REGISTER;
 
          firstpass(right);
          firstpass(left);
@@ -337,7 +337,7 @@ implementation
            begin
               { a smallset needs maybe an misc. register }
               if (left.nodetype<>ordconstn) and
-                not(right.location.loc in [LOC_CREGISTER,LOC_REGISTER]) and
+                not(right.expectloc in [LOC_CREGISTER,LOC_REGISTER]) and
                 (right.registers32<1) then
                 inc(registers32);
            end;
@@ -387,7 +387,7 @@ implementation
          if codegenerror then
            exit;
         left_right_max;
-        location_copy(location,left.location);
+        expectloc:=left.expectloc;
       end;
 
 
@@ -588,6 +588,7 @@ implementation
          hp : tstatementnode;
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
          { evalutes the case expression }
          rg.cleartempgen;
          firstpass(left);
@@ -707,7 +708,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.38  2002-12-07 14:12:56  carl
+  Revision 1.39  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.38  2002/12/07 14:12:56  carl
     - removed unused variable
 
   Revision 1.37  2002/11/27 02:37:14  peter

compiler/pass_1.pas

@@ -46,6 +46,7 @@ implementation
       cutils,globals,
       cgbase,symdef,
 {$ifdef extdebug}
+      cginfo,verbose,
       htypechk,
 {$endif extdebug}
 {$ifdef state_tracking}
@@ -168,7 +169,14 @@ implementation
                     p:=hp;
                   end;
                  if codegenerror then
-                  include(p.flags,nf_error);
+                  include(p.flags,nf_error)
+                 else
+                  begin
+{$ifdef EXTDEBUG}
+                    if (p.expectloc=LOC_INVALID) then
+                      Comment(V_Warning,'Expectloc is not set in firstpass: '+nodetype2str[p.nodetype]);
+{$endif EXTDEBUG}
+                  end;
                end;
               codegenerror:=codegenerror or oldcodegenerror;
               aktlocalswitches:=oldlocalswitches;
@@ -208,7 +216,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.29  2002-12-17 22:19:33  peter
+  Revision 1.30  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.29  2002/12/17 22:19:33  peter
     * fixed pushing of records>8 bytes with stdcall
     * simplified hightree loading
 

compiler/pass_2.pas

@@ -54,7 +54,7 @@ implementation
      cclasses,globals,
      symconst,symbase,symtype,symsym,paramgr,
      aasmbase,aasmtai,
-     pass_1,cpubase,cgbase,
+     pass_1,cpubase,cginfo,cgbase,
 {$ifdef EXTDEBUG}
      cgobj,
 {$endif EXTDEBUG}
@@ -169,7 +169,6 @@ implementation
          prevp : pptree;
 {$endif TEMPREGDEBUG}
 {$ifdef EXTDEBUG}
-         oldloc : tloc;
          i : longint;
 {$endif EXTDEBUG}
       begin
@@ -190,8 +189,11 @@ implementation
             aktlocalswitches:=p.localswitches;
             codegenerror:=false;
 {$ifdef EXTDEBUG}
-            oldloc:=p.location.loc;
-            p.location.loc:=LOC_INVALID;
+            if (p.expectloc=LOC_INVALID) then
+              Comment(V_Warning,'ExpectLoc is not set before secondpass: '+nodetype2str[p.nodetype]);
+            if not(nf_allow_multi_pass2 in p.flags) and
+               (p.location.loc<>LOC_INVALID) then
+              Comment(V_Warning,'Location.Loc is already set before secondpass: '+nodetype2str[p.nodetype]);
             if (cs_asm_nodes in aktglobalswitches) then
               logsecond(p.nodetype,true);
 {$endif EXTDEBUG}
@@ -199,10 +201,13 @@ implementation
 {$ifdef EXTDEBUG}
             if (cs_asm_nodes in aktglobalswitches) then
               logsecond(p.nodetype,false);
-            if (not codegenerror) and
-               (oldloc<>LOC_INVALID) and
-               (p.location.loc=LOC_INVALID) then
-             Comment(V_Fatal,'Location not set in secondpass: '+nodetype2str[p.nodetype]);
+            if (not codegenerror) then
+             begin
+               if (p.location.loc=LOC_INVALID) then
+                 Comment(V_Warning,'Location not set in secondpass: '+nodetype2str[p.nodetype])
+               else if (p.location.loc<>p.expectloc) then
+                 Comment(V_Warning,'Location is different in secondpass: '+nodetype2str[p.nodetype]);
+             end;
 
             { check if all scratch registers are freed }
             for i:=1 to max_scratch_regs do
@@ -345,7 +350,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.44  2003-04-22 12:45:58  florian
+  Revision 1.45  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.44  2003/04/22 12:45:58  florian
     * fixed generic in operator code
     + added debug code to check if all scratch registers are released
 

compiler/pexpr.pas

@@ -1048,7 +1048,7 @@ implementation
                     if tfuncretsym(p.procdef.funcretsym).funcretstate=vs_declared then
                       begin
                         tfuncretsym(p.procdef.funcretsym).funcretstate:=vs_declared_and_first_found;
-                        include(p1.flags,nf_is_first_funcret);
+                        include(p1.flags,nf_first_use);
                       end;
                     exit;
                  end;
@@ -1123,7 +1123,7 @@ implementation
                     p1:=cloadnode.create(srsym,srsymtable);
                     if tvarsym(srsym).varstate=vs_declared then
                      begin
-                       include(p1.flags,nf_first);
+                       include(p1.flags,nf_first_use);
                        { set special between first loaded until checked in resulttypepass }
                        tvarsym(srsym).varstate:=vs_declared_and_first_found;
                      end;
@@ -1153,8 +1153,7 @@ implementation
                           consume(_LKLAMMER);
                           p1:=comp_expr(true);
                           consume(_RKLAMMER);
-                          p1:=ctypeconvnode.create(p1,htype);
-                          include(p1.flags,nf_explizit);
+                          p1:=ctypeconvnode.create_explicit(p1,htype);
                         end
                        else { not LKLAMMER }
                         if (token=_POINT) and
@@ -1935,8 +1934,7 @@ implementation
                   consume(_LKLAMMER);
                   p1:=comp_expr(true);
                   consume(_RKLAMMER);
-                  p1:=ctypeconvnode.create(p1,htype);
-                  include(p1.flags,nf_explizit);
+                  p1:=ctypeconvnode.create_explicit(p1,htype);
                   { handle postfix operators here e.g. string(a)[10] }
                   again:=true;
                   postfixoperators(p1,again);
@@ -1955,8 +1953,7 @@ implementation
                   consume(_LKLAMMER);
                   p1:=comp_expr(true);
                   consume(_RKLAMMER);
-                  p1:=ctypeconvnode.create(p1,htype);
-                  include(p1.flags,nf_explizit);
+                  p1:=ctypeconvnode.create_explicit(p1,htype);
                   { handle postfix operators here e.g. string(a)[10] }
                   again:=true;
                   postfixoperators(p1,again);
@@ -2351,7 +2348,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.107  2003-04-11 15:49:01  peter
+  Revision 1.108  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.107  2003/04/11 15:49:01  peter
     * default property also increased the reference count for the
       property symbol
 

compiler/rgobj.pas

@@ -116,8 +116,8 @@ unit rgobj;
       {In the register allocator we keep track of move instructions.
        These instructions are moved between five linked lists. There
        is also a linked list per register to keep track about the moves
-       it is associated with. Because we need to determine quickly in 
-       which of the five lists it is we add anu enumeradtion to each 
+       it is associated with. Because we need to determine quickly in
+       which of the five lists it is we add anu enumeradtion to each
        move instruction.}
 
       Tmoveset=(ms_coalesced_moves,ms_constrained_moves,ms_frozen_moves,
@@ -412,7 +412,7 @@ unit rgobj;
      function references_equal(sref : treference;dref : treference) : boolean;
 
      { tlocation handling }
-     procedure location_reset(var l : tlocation;lt:TLoc;lsize:TCGSize);
+     procedure location_reset(var l : tlocation;lt:TCGLoc;lsize:TCGSize);
      procedure location_release(list: taasmoutput; const l : tlocation);
      procedure location_freetemp(list: taasmoutput; const l : tlocation);
      procedure location_copy(var destloc,sourceloc : tlocation);
@@ -1429,7 +1429,7 @@ unit rgobj;
     begin
       if movelist[n]<>nil then
         for i:=0 to movelist[n]^.count-1 do
-          begin 
+          begin
             m:=movelist[n]^.data[i];
             if Tmoveins(m).moveset in [ms_worklist_moves,ms_active_moves] then
               begin
@@ -1714,7 +1714,7 @@ unit rgobj;
                 worklist_moves.remove(m);
               Tmoveins(m).moveset:=ms_frozen_moves;
               frozen_moves.insert(m);
-        
+
               if not(move_related(v)) and (degree[v]<cpu_registers) then
                 begin
                   delete(freezeworklist,pos(char(v),freezeworklist),1);
@@ -1900,7 +1900,7 @@ unit rgobj;
                                   TLocation
 ****************************************************************************}
 
-    procedure location_reset(var l : tlocation;lt:TLoc;lsize:TCGSize);
+    procedure location_reset(var l : tlocation;lt:TCGLoc;lsize:TCGSize);
       begin
         FillChar(l,sizeof(tlocation),0);
         l.loc:=lt;
@@ -1969,7 +1969,12 @@ end.
 
 {
   $Log$
-  Revision 1.36  2003-04-22 10:09:35  daniel
+  Revision 1.37  2003-04-22 23:50:23  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.36  2003/04/22 10:09:35  daniel
     + Implemented the actual register allocator
     + Scratch registers unavailable when new register allocator used
     + maybe_save/maybe_restore unavailable when new register allocator used