Browse Source

* fixed array constructor passing with type conversions

peter 24 years ago
parent
commit
27c78aa247
2 changed files with 43 additions and 10 deletions
  1. 17 3
      compiler/ncal.pas
  2. 26 7
      compiler/nld.pas

+ 17 - 3
compiler/ncal.pas

@@ -181,6 +181,7 @@ implementation
     procedure tcallparanode.insert_typeconv(defcoll : tparaitem;do_count : boolean);
     procedure tcallparanode.insert_typeconv(defcoll : tparaitem;do_count : boolean);
       var
       var
         oldtype     : ttype;
         oldtype     : ttype;
+        old_array_constructor : boolean;
 {$ifdef extdebug}
 {$ifdef extdebug}
         store_count_ref : boolean;
         store_count_ref : boolean;
 {$endif def extdebug}
 {$endif def extdebug}
@@ -249,7 +250,9 @@ implementation
             else
             else
              begin
              begin
                include(left.flags,nf_novariaallowed);
                include(left.flags,nf_novariaallowed);
-               tarrayconstructornode(left).constructortype:=tarraydef(defcoll.paratype.def).elementtype;
+               { now that the resultting type is know we can insert the required
+                 typeconvs for the array constructor }
+               tarrayconstructornode(left).force_type(tarraydef(defcoll.paratype.def).elementtype);
              end;
              end;
           end;
           end;
 
 
@@ -1485,8 +1488,16 @@ implementation
                      end
                      end
                    else if (resulttype.def.deftype=floatdef) then
                    else if (resulttype.def.deftype=floatdef) then
                      begin
                      begin
-                        location.loc:=LOC_FPU;
+                       location.loc:=LOC_FPU;
+{$ifdef m68k}
+                       if (cs_fp_emulation in aktmoduleswitches) or
+                          (tfloatdef(resulttype.def).typ=s32real) then
+                         registers32:=1
+                       else
+                         registersfpu:=1;
+{$else not m68k}
                         registersfpu:=1;
                         registersfpu:=1;
+{$endif not m68k}
                      end
                      end
                    else
                    else
                      location.loc:=LOC_MEM;
                      location.loc:=LOC_MEM;
@@ -1655,7 +1666,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.37  2001-07-09 21:15:40  peter
+  Revision 1.38  2001-07-30 20:52:25  peter
+    * fixed array constructor passing with type conversions
+
+  Revision 1.37  2001/07/09 21:15:40  peter
     * Length made internal
     * Length made internal
     * Add array support for Length
     * Add array support for Length
 
 

+ 26 - 7
compiler/nld.pas

@@ -70,12 +70,12 @@ interface
        end;
        end;
 
 
        tarrayconstructornode = class(tbinarynode)
        tarrayconstructornode = class(tbinarynode)
-          constructortype : ttype;
           constructor create(l,r : tnode);virtual;
           constructor create(l,r : tnode);virtual;
           function getcopy : tnode;override;
           function getcopy : tnode;override;
           function pass_1 : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
           function det_resulttype:tnode;override;
           function docompare(p: tnode): boolean; override;
           function docompare(p: tnode): boolean; override;
+          procedure force_type(tt:ttype);
        end;
        end;
 
 
        ttypenode = class(tnode)
        ttypenode = class(tnode)
@@ -553,7 +553,6 @@ implementation
     constructor tarrayconstructornode.create(l,r : tnode);
     constructor tarrayconstructornode.create(l,r : tnode);
       begin
       begin
          inherited create(arrayconstructorn,l,r);
          inherited create(arrayconstructorn,l,r);
-         constructortype.reset;
       end;
       end;
 
 
 
 
@@ -562,7 +561,6 @@ implementation
          n : tarrayconstructornode;
          n : tarrayconstructornode;
       begin
       begin
          n:=tarrayconstructornode(inherited getcopy);
          n:=tarrayconstructornode(inherited getcopy);
-         n.constructortype:=constructortype;
          result:=n;
          result:=n;
       end;
       end;
 
 
@@ -587,7 +585,7 @@ implementation
          end;
          end;
 
 
       { only pass left tree, right tree contains next construct if any }
       { only pass left tree, right tree contains next construct if any }
-        htype:=constructortype;
+        htype.reset;
         len:=0;
         len:=0;
         varia:=false;
         varia:=false;
         if assigned(left) then
         if assigned(left) then
@@ -620,6 +618,25 @@ implementation
       end;
       end;
 
 
 
 
+    procedure tarrayconstructornode.force_type(tt:ttype);
+      var
+        hp : tarrayconstructornode;
+      begin
+        tarraydef(resulttype.def).elementtype:=tt;
+        tarraydef(resulttype.def).IsConstructor:=true;
+        tarraydef(resulttype.def).IsVariant:=false;
+        if assigned(left) then
+         begin
+           hp:=self;
+           while assigned(hp) do
+            begin
+              inserttypeconv(hp.left,tt);
+              hp:=tarrayconstructornode(hp.right);
+            end;
+         end;
+      end;
+
+
     function tarrayconstructornode.pass_1 : tnode;
     function tarrayconstructornode.pass_1 : tnode;
       var
       var
         thp,
         thp,
@@ -715,8 +732,7 @@ implementation
     function tarrayconstructornode.docompare(p: tnode): boolean;
     function tarrayconstructornode.docompare(p: tnode): boolean;
       begin
       begin
         docompare :=
         docompare :=
-          inherited docompare(p) and
-          (constructortype.def = tarrayconstructornode(p).constructortype.def);
+          inherited docompare(p);
       end;
       end;
 
 
 
 
@@ -767,7 +783,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.19  2001-06-04 18:07:47  peter
+  Revision 1.20  2001-07-30 20:52:25  peter
+    * fixed array constructor passing with type conversions
+
+  Revision 1.19  2001/06/04 18:07:47  peter
     * remove unused typenode for procvar load. Don't know what happened why
     * remove unused typenode for procvar load. Don't know what happened why
       this code was not there already with revision 1.17.
       this code was not there already with revision 1.17.