Bläddra i källkod

* also perform C varargs type conversions for cdecl procedures declared
as "varargs" instead of using an array of const parameter

git-svn-id: trunk@4572 -

Jonas Maebe 19 år sedan
förälder
incheckning
733f559267
5 ändrade filer med 78 tillägg och 78 borttagningar
  1. 1 1
      compiler/ncal.pas
  2. 70 0
      compiler/ncnv.pas
  3. 6 75
      compiler/nld.pas
  4. 0 1
      compiler/node.pas
  5. 1 1
      compiler/ppu.pas

+ 1 - 1
compiler/ncal.pas

@@ -568,6 +568,7 @@ type
                  { the necessary conversions have already been performed in }
                  { the necessary conversions have already been performed in }
                  { tarrayconstructornode.insert_typeconvs                   }
                  { tarrayconstructornode.insert_typeconvs                   }
                  set_varstate(left,vs_read,[vsf_must_be_valid]);
                  set_varstate(left,vs_read,[vsf_must_be_valid]);
+                 insert_varargstypeconv(left,true);
                  resulttype:=left.resulttype;
                  resulttype:=left.resulttype;
                  { also update parasym type to get the correct parameter location
                  { also update parasym type to get the correct parameter location
                    for the new types }
                    for the new types }
@@ -1057,7 +1058,6 @@ type
         include(callnodeflags,cnf_uses_varargs);
         include(callnodeflags,cnf_uses_varargs);
         { Get arrayconstructor node and insert typeconvs }
         { Get arrayconstructor node and insert typeconvs }
         hp:=tarrayconstructornode(oldleft.left);
         hp:=tarrayconstructornode(oldleft.left);
-        hp.insert_typeconvs(true);
         { Add c args parameters }
         { Add c args parameters }
         { It could be an empty set }
         { It could be an empty set }
         if assigned(hp) and
         if assigned(hp) and

+ 70 - 0
compiler/ncnv.pas

@@ -204,6 +204,7 @@ interface
     procedure inserttypeconv(var p:tnode;const t:ttype);
     procedure inserttypeconv(var p:tnode;const t:ttype);
     procedure inserttypeconv_internal(var p:tnode;const t:ttype);
     procedure inserttypeconv_internal(var p:tnode;const t:ttype);
     procedure arrayconstructor_to_set(var p : tnode);
     procedure arrayconstructor_to_set(var p : tnode);
+    procedure insert_varargstypeconv(var p : tnode; iscvarargs: boolean);
 
 
 
 
 implementation
 implementation
@@ -521,6 +522,75 @@ implementation
       end;
       end;
 
 
 
 
+    procedure insert_varargstypeconv(var p : tnode; iscvarargs: boolean);
+      begin
+        if not(iscvarargs) and
+           (p.nodetype=stringconstn) then
+          p:=ctypeconvnode.create_internal(p,cansistringtype)
+        else
+          case p.resulttype.def.deftype of
+            enumdef :
+              p:=ctypeconvnode.create_internal(p,s32inttype);
+            arraydef :
+              begin
+                if is_chararray(p.resulttype.def) then
+                  p:=ctypeconvnode.create_internal(p,charpointertype)
+                else
+                  if is_widechararray(p.resulttype.def) then
+                    p:=ctypeconvnode.create_internal(p,widecharpointertype)
+                else
+                  CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resulttype.def.typename);
+              end;
+            orddef :
+              begin
+                if is_integer(p.resulttype.def) and
+                   not(is_64bitint(p.resulttype.def)) then
+                  p:=ctypeconvnode.create(p,s32inttype)
+                else if is_void(p.resulttype.def) then
+                  CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resulttype.def.typename)
+                else if iscvarargs and
+                        is_currency(p.resulttype.def) then
+                       p:=ctypeconvnode.create(p,s64floattype);
+              end;
+            floatdef :
+              if not(iscvarargs) then
+                begin
+                  if not(is_currency(p.resulttype.def)) then
+                    p:=ctypeconvnode.create(p,pbestrealtype^);
+                end
+              else
+                begin
+                  if is_constrealnode(p) and
+                     not(nf_explicit in p.flags) then
+                    MessagePos(p.fileinfo,type_w_double_c_varargs);
+                  if (tfloatdef(p.resulttype.def).typ in [{$ifndef x86_64}s32real,{$endif}s64currency]) or
+                     (is_constrealnode(p) and
+                      not(nf_explicit in p.flags)) then
+                    p:=ctypeconvnode.create(p,s64floattype);
+                end;
+            procvardef :
+              p:=ctypeconvnode.create(p,voidpointertype);
+            stringdef:
+              if iscvarargs then
+                p:=ctypeconvnode.create(p,charpointertype);
+            variantdef:
+              if iscvarargs then
+                CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resulttype.def.typename);
+            pointerdef:
+              ;
+            classrefdef:
+              if iscvarargs then
+                p:=ctypeconvnode.create(p,voidpointertype);
+            objectdef :
+              if iscvarargs or
+                 is_object(p.resulttype.def) then
+                CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resulttype.def.typename);
+            else
+              CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resulttype.def.typename);
+          end;
+        resulttypepass(p);
+      end;
+
 {*****************************************************************************
 {*****************************************************************************
                            TTYPECONVNODE
                            TTYPECONVNODE
 *****************************************************************************}
 *****************************************************************************}

+ 6 - 75
compiler/nld.pas

@@ -88,7 +88,7 @@ interface
           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);
           procedure force_type(tt:ttype);
-          procedure insert_typeconvs(iscvarargs: boolean);
+          procedure insert_typeconvs;
        end;
        end;
        tarrayconstructornodeclass = class of tarrayconstructornode;
        tarrayconstructornodeclass = class of tarrayconstructornode;
 
 
@@ -940,14 +940,12 @@ implementation
       end;
       end;
 
 
 
 
-    procedure tarrayconstructornode.insert_typeconvs(iscvarargs: boolean);
+    procedure tarrayconstructornode.insert_typeconvs;
       var
       var
         hp        : tarrayconstructornode;
         hp        : tarrayconstructornode;
         dovariant : boolean;
         dovariant : boolean;
       begin
       begin
-        if (iscvarargs) then
-          include(flags,nf_cvarargs);
-        dovariant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resulttype.def).arrayoptions) or iscvarargs;
+        dovariant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resulttype.def).arrayoptions);
         { only pass left tree, right tree contains next construct if any }
         { only pass left tree, right tree contains next construct if any }
         if assigned(left) then
         if assigned(left) then
          begin
          begin
@@ -957,73 +955,8 @@ implementation
               resulttypepass(hp.left);
               resulttypepass(hp.left);
               { Insert typeconvs for array of const }
               { Insert typeconvs for array of const }
               if dovariant then
               if dovariant then
-               begin
-                 if not(iscvarargs) and
-                    (hp.left.nodetype=stringconstn) then
-                   hp.left:=ctypeconvnode.create_internal(hp.left,cansistringtype)
-                 else
-                   case hp.left.resulttype.def.deftype of
-                     enumdef :
-                       hp.left:=ctypeconvnode.create_internal(hp.left,s32inttype);
-                     arraydef :
-                       begin
-                         if is_chararray(hp.left.resulttype.def) then
-                           hp.left:=ctypeconvnode.create_internal(hp.left,charpointertype)
-                         else
-                           if is_widechararray(hp.left.resulttype.def) then
-                             hp.left:=ctypeconvnode.create_internal(hp.left,widecharpointertype)
-                         else
-                           CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
-                       end;
-                     orddef :
-                       begin
-                         if is_integer(hp.left.resulttype.def) and
-                            not(is_64bitint(hp.left.resulttype.def)) then
-                           hp.left:=ctypeconvnode.create(hp.left,s32inttype)
-                         else if is_void(hp.left.resulttype.def) then
-                           CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename)
-                         else if iscvarargs and
-                                 is_currency(hp.left.resulttype.def) then
-                                hp.left:=ctypeconvnode.create(hp.left,s64floattype);
-                       end;
-                     floatdef :
-                       if not(iscvarargs) then
-                         begin
-                           if not(is_currency(hp.left.resulttype.def)) then
-                             hp.left:=ctypeconvnode.create(hp.left,pbestrealtype^);
-                         end
-                       else
-                         begin
-                           if is_constrealnode(hp.left) and
-                              not(nf_explicit in hp.left.flags) then
-                             MessagePos(hp.left.fileinfo,type_w_double_c_varargs);
-                           if (tfloatdef(hp.left.resulttype.def).typ in [{$ifndef x86_64}s32real,{$endif}s64currency]) or
-                              (is_constrealnode(hp.left) and
-                               not(nf_explicit in hp.left.flags)) then
-                             hp.left:=ctypeconvnode.create(hp.left,s64floattype);
-                         end;
-                     procvardef :
-                       hp.left:=ctypeconvnode.create(hp.left,voidpointertype);
-                     stringdef:
-                       if iscvarargs then
-                         hp.left:=ctypeconvnode.create(hp.left,charpointertype);
-                     variantdef:
-                       if iscvarargs then
-                         CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
-                     pointerdef:
-                       ;
-                     classrefdef:
-                       if iscvarargs then
-                         hp.left:=ctypeconvnode.create(hp.left,voidpointertype);
-                     objectdef :
-                       if iscvarargs or
-                          is_object(hp.left.resulttype.def) then
-                         CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
-                     else
-                       CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
-                   end;
-               end;
-              resulttypepass(hp.left);
+                { at this time C varargs are no longer an arrayconstructornode }
+                insert_varargstypeconv(hp.left,false);
               hp:=tarrayconstructornode(hp.right);
               hp:=tarrayconstructornode(hp.right);
             end;
             end;
          end;
          end;
@@ -1042,9 +975,7 @@ implementation
           resulttypepassed already }
           resulttypepassed already }
         if assigned(left) then
         if assigned(left) then
           begin
           begin
-            { in case of C varargs, insert_typeconvs has already been called }
-            if not(nf_cvarargs in flags) then
-              insert_typeconvs(false);
+            insert_typeconvs;
             { call firstpass for all nodes }
             { call firstpass for all nodes }
             hp:=self;
             hp:=self;
             while assigned(hp) do
             while assigned(hp) do

+ 0 - 1
compiler/node.pas

@@ -229,7 +229,6 @@ interface
          { tarrayconstructnode }
          { tarrayconstructnode }
          nf_forcevaria,
          nf_forcevaria,
          nf_novariaallowed,
          nf_novariaallowed,
-         nf_cvarargs,
 
 
          { ttypeconvnode, and the first one also treal/ord/pointerconstn }
          { ttypeconvnode, and the first one also treal/ord/pointerconstn }
          nf_explicit,
          nf_explicit,

+ 1 - 1
compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 {$endif Test_Double_checksum}
 
 
 const
 const
-  CurrentPPUVersion=62;
+  CurrentPPUVersion=63;
 
 
 { buffer sizes }
 { buffer sizes }
   maxentrysize = 1024;
   maxentrysize = 1024;