* made assigned() handling generic

  * add nodes now can also evaluate constant expressions at compile time
    that contain nil nodes

compiler/i386/n386inl.pas

@@ -35,7 +35,6 @@ interface
             so that the code generator will actually generate
             these nodes.
           }
-          function first_assigned: tnode;override;
           function first_pi: tnode ; override;
           function first_arctan_real: tnode; override;
           function first_abs_real: tnode; override;
@@ -45,7 +44,6 @@ interface
           function first_cos_real: tnode; override;
           function first_sin_real: tnode; override;
           { second pass override to generate these nodes }
-          procedure second_assigned;override;
           procedure second_IncludeExclude;override;
           procedure second_pi; override;
           procedure second_arctan_real; override;
@@ -76,12 +74,6 @@ implementation
                               TI386INLINENODE
 *****************************************************************************}
 
-    function ti386inlinenode.first_assigned: tnode;
-     begin
-       location.loc:=LOC_FLAGS;
-       first_assigned := nil;
-     end;
-
      function ti386inlinenode.first_pi : tnode;
       begin
         location.loc:=LOC_FPUREGISTER;
@@ -248,24 +240,6 @@ implementation
          emit_none(A_FSIN,S_NO)
        end;
 
-     procedure ti386inlinenode.second_assigned;
-      begin
-        secondpass(tcallparanode(left).left);
-        location_release(exprasmlist,tcallparanode(left).left.location);
-        if (tcallparanode(left).left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
-           begin
-             emit_reg_reg(A_OR,S_L,
-                tcallparanode(left).left.location.register,
-                tcallparanode(left).left.location.register);
-           end
-         else
-           begin
-             emit_const_ref(A_CMP,S_L,0,tcallparanode(left).left.location.reference);
-           end;
-        location_reset(location,LOC_FLAGS,OS_NO);
-        location.resflags:=F_NE;
-      end;
-       
 {*****************************************************************************
                      INCLUDE/EXCLUDE GENERIC HANDLING
 *****************************************************************************}
@@ -354,7 +328,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.51  2002-07-26 11:16:35  jonas
+  Revision 1.52  2002-08-02 07:44:31  jonas
+    * made assigned() handling generic
+    * add nodes now can also evaluate constant expressions at compile time
+      that contain nil nodes
+
+  Revision 1.51  2002/07/26 11:16:35  jonas
     * fixed (actual and potential) range errors
 
   Revision 1.50  2002/07/25 18:02:33  carl

compiler/i386/n386mat.pas

@@ -755,8 +755,8 @@ implementation
               LOC_CREFERENCE :
                 begin
                   location_force_reg(exprasmlist,left.location,def_cgsize(resulttype.def),true);
-                  location_release(exprasmlist,left.location);
                   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;
@@ -830,7 +830,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.33  2002-07-20 11:58:02  florian
+  Revision 1.34  2002-08-02 07:44:31  jonas
+    * made assigned() handling generic
+    * add nodes now can also evaluate constant expressions at compile time
+      that contain nil nodes
+
+  Revision 1.33  2002/07/20 11:58:02  florian
     * types.pas renamed to defbase.pas because D6 contains a types
       unit so this would conflicts if D6 programms are compiled
     + Willamette/SSE2 instructions to assembler added

compiler/nadd.pas

@@ -197,7 +197,8 @@ implementation
             { support pointer arithmetics on constants (JM) }
             ((lt = pointerconstn) and is_constintnode(right) and
              (nodetype in [addn,subn])) or
-            ((lt = pointerconstn) and (rt = pointerconstn) and
+            (((lt = pointerconstn) or (lt = niln)) and
+             ((rt = pointerconstn) or (rt = niln)) and
              (nodetype in [ltn,lten,gtn,gten,equaln,unequaln,subn])) then
            begin
               { when comparing/substracting  pointers, make sure they are }
@@ -229,14 +230,26 @@ implementation
                 end;
 
               { load values }
-              if (lt = ordconstn) then
-                lv:=tordconstnode(left).value
-              else
-                lv:=tpointerconstnode(left).value;
-              if (rt = ordconstn) then
-                rv:=tordconstnode(right).value
-              else
-                rv:=tpointerconstnode(right).value;
+              case lt of
+                ordconstn:
+                  lv:=tordconstnode(left).value;
+                pointerconstn:
+                  lv:=tpointerconstnode(left).value;
+                niln:
+                  lv:=0;
+                else
+                  internalerror(2002080202);
+              end;
+              case rt of
+                ordconstn:
+                  rv:=tordconstnode(right).value;
+                pointerconstn:
+                  rv:=tpointerconstnode(right).value;
+                niln:
+                  rv:=0;
+                else
+                  internalerror(2002080203);
+              end;
               if (lt = pointerconstn) and
                  (rt <> pointerconstn) then
                 rv := rv * tpointerdef(left.resulttype.def).pointertype.def.size;
@@ -1731,7 +1744,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.58  2002-07-26 11:17:52  jonas
+  Revision 1.59  2002-08-02 07:44:30  jonas
+    * made assigned() handling generic
+    * add nodes now can also evaluate constant expressions at compile time
+      that contain nil nodes
+
+  Revision 1.58  2002/07/26 11:17:52  jonas
     * the optimization of converting a multiplication with a power of two to
       a shl is moved from n386add/secondpass to nadd/resulttypepass
 

compiler/ninl.pas

@@ -39,7 +39,6 @@ interface
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
           function docompare(p: tnode): boolean; override;
-          function first_assigned: tnode; virtual;
           { All the following routines currently
             call compilerproc's, unless they are
             overriden in which case, the code
@@ -1529,25 +1528,21 @@ implementation
 
               in_assigned_x:
                 begin
-                   { assigned(nil) is always false }
-                   if (tcallparanode(left).left.nodetype=niln) then
-                    begin
-                      hp:=cordconstnode.create(0,booltype);
-                      result:=hp;
-                      goto myexit;
-                    end;
-                   { assigned(pointer(n)) is only false when n=0 }
-                   if (tcallparanode(left).left.nodetype=pointerconstn) then
-                    begin
-                      if tpointerconstnode(tcallparanode(left).left).value=0 then
-                       hp:=cordconstnode.create(0,booltype)
-                      else
-                       hp:=cordconstnode.create(1,booltype);
-                      result:=hp;
-                      goto myexit;
-                    end;
-                   set_varstate(left,true);
-                   resulttype:=booltype;
+{
+                   result := caddnode.create(unequaln,
+                     ctypeconvnode.create_explicit(tcallparanode(left).left,
+                     voidpointertype),cnilnode.create);
+}
+                   result := caddnode.create(unequaln,tcallparanode(left).left,
+                     cnilnode.create);
+                   tcallparanode(left).left := nil;
+                   { free left, because otherwise some code at 'myexit' tries  }
+                   { to run get_paratype for it, which crashes since left.left }
+                   { is now nil                                                }
+                   left.free;
+                   left := nil;
+                   resulttypepass(result);
+                   goto myexit;
                 end;
 
               in_ofs_x :
@@ -2032,7 +2027,8 @@ implementation
 
           in_assigned_x:
             begin
-               result := first_assigned;
+               { should be removed in resulttype pass }
+               internalerror(2002080201);
             end;
 
           in_ofs_x :
@@ -2241,12 +2237,6 @@ implementation
 {$maxfpuregisters default}
 {$endif fpc}
 
-    function tinlinenode.first_assigned: tnode;
-     begin
-       location.loc:=LOC_REGISTER;
-       first_assigned := nil;
-     end;
-
     function tinlinenode.docompare(p: tnode): boolean;
       begin
         docompare :=
@@ -2356,7 +2346,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.82  2002-07-29 21:23:43  florian
+  Revision 1.83  2002-08-02 07:44:31  jonas
+    * made assigned() handling generic
+    * add nodes now can also evaluate constant expressions at compile time
+      that contain nil nodes
+
+  Revision 1.82  2002/07/29 21:23:43  florian
     * more fixes for the ppc
     + wrappers for the tcnvnode.first_* stuff introduced