Browse Source

+ new createinternres() constructor for tcallnode to support setting a
custom resulttype
* compilerproc typeconversions now set the resulttype from the type
conversion for the generated call node, because the resulttype of
of the compilerproc helper isn't always exact (e.g. the ones that
return shortstrings, actually return a shortstring[x], where x is
specified by the typeconversion node)
* ti386callnode.pass_2 now always uses resulttype instead of
procsym.definition.rettype (so the custom resulttype, if any, is
always used). Note that this "rettype" stuff is only for use with
compilerprocs.

Jonas Maebe 24 years ago
parent
commit
105b7ae809
3 changed files with 76 additions and 15 deletions
  1. 17 4
      compiler/i386/n386cal.pas
  2. 39 4
      compiler/ncal.pas
  3. 20 7
      compiler/ncnv.pas

+ 17 - 4
compiler/i386/n386cal.pas

@@ -458,11 +458,11 @@ implementation
                 if inlined then
                 if inlined then
                   begin
                   begin
                      reset_reference(funcretref);
                      reset_reference(funcretref);
-                     funcretref.offset:=gettempofsizepersistant(procdefinition.rettype.def.size);
+                     funcretref.offset:=gettempofsizepersistant(resulttype.def.size);
                      funcretref.base:=procinfo^.framepointer;
                      funcretref.base:=procinfo^.framepointer;
                   end
                   end
                 else
                 else
-                  gettempofsizereference(procdefinition.rettype.def.size,funcretref);
+                  gettempofsizereference(resulttype.def.size,funcretref);
            end;
            end;
          if assigned(params) then
          if assigned(params) then
            begin
            begin
@@ -1088,7 +1088,7 @@ implementation
                        ungetregister32(R_EDI);
                        ungetregister32(R_EDI);
                        exprasmList.concat(Tairegalloc.Alloc(R_ESI));
                        exprasmList.concat(Tairegalloc.Alloc(R_ESI));
                        emit_reg(A_POP,S_L,R_ESI);
                        emit_reg(A_POP,S_L,R_ESI);
-                       exprasmList.concat(Tairegalloc.Alloc(R_ESI));
+                       exprasmList.concat(Tairegalloc.DeAlloc(R_ESI));
                     end
                     end
                 else if pushedparasize<>0 then
                 else if pushedparasize<>0 then
                   emit_const_reg(A_ADD,S_L,pushedparasize,R_ESP);
                   emit_const_reg(A_ADD,S_L,pushedparasize,R_ESP);
@@ -1584,7 +1584,20 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.30  2001-08-26 13:36:56  florian
+  Revision 1.31  2001-08-29 12:18:08  jonas
+    + new createinternres() constructor for tcallnode to support setting a
+      custom resulttype
+    * compilerproc typeconversions now set the resulttype from the type
+      conversion for the generated call node, because the resulttype of
+      of the compilerproc helper isn't always exact (e.g. the ones that
+      return shortstrings, actually return a shortstring[x], where x is
+      specified by the typeconversion node)
+    * ti386callnode.pass_2 now always uses resulttype instead of
+      procsym.definition.rettype (so the custom resulttype, if any, is
+      always used). Note that this "rettype" stuff is only for use with
+      compilerprocs.
+
+  Revision 1.30  2001/08/26 13:36:56  florian
     * some cg reorganisation
     * some cg reorganisation
     * some PPC updates
     * some PPC updates
 
 

+ 39 - 4
compiler/ncal.pas

@@ -29,7 +29,7 @@ interface
 
 
     uses
     uses
        node,
        node,
-       symbase,symsym,symdef,symtable;
+       symbase,symtype,symsym,symdef,symtable;
 
 
     type
     type
        tcallnode = class(tbinarynode)
        tcallnode = class(tbinarynode)
@@ -41,10 +41,16 @@ interface
           { the definition of the procedure to call }
           { the definition of the procedure to call }
           procdefinition : tabstractprocdef;
           procdefinition : tabstractprocdef;
           methodpointer  : tnode;
           methodpointer  : tnode;
+          { separately specified resulttype for some compilerprocs (e.g. }
+          { you can't have a function with an "array of char" resulttype }
+          { the RTL) (JM)                                                }
+          restype: ttype;
+          restypeset: boolean;
           { only the processor specific nodes need to override this }
           { only the processor specific nodes need to override this }
           { constructor                                             }
           { constructor                                             }
           constructor create(l:tnode; v : tprocsym;st : tsymtable; mp : tnode);virtual;
           constructor create(l:tnode; v : tprocsym;st : tsymtable; mp : tnode);virtual;
           constructor createintern(const name: string; params: tnode);
           constructor createintern(const name: string; params: tnode);
+          constructor createinternres(const name: string; params: tnode; const res: ttype);
           destructor destroy;override;
           destructor destroy;override;
           function  getcopy : tnode;override;
           function  getcopy : tnode;override;
           procedure insertintolist(l : tnodelist);override;
           procedure insertintolist(l : tnodelist);override;
@@ -107,7 +113,7 @@ implementation
     uses
     uses
       cutils,globtype,systems,
       cutils,globtype,systems,
       verbose,globals,
       verbose,globals,
-      symconst,symtype,types,
+      symconst,types,
       htypechk,pass_1,cpubase,
       htypechk,pass_1,cpubase,
       ncnv,nld,ninl,nadd,ncon,
       ncnv,nld,ninl,nadd,ncon,
       tgcpu,cgbase
       tgcpu,cgbase
@@ -558,6 +564,7 @@ implementation
          include(flags,nf_return_value_used);
          include(flags,nf_return_value_used);
          methodpointer:=mp;
          methodpointer:=mp;
          procdefinition:=nil;
          procdefinition:=nil;
+         restypeset := false;
       end;
       end;
 
 
      constructor tcallnode.createintern(const name: string; params: tnode);
      constructor tcallnode.createintern(const name: string; params: tnode);
@@ -585,6 +592,18 @@ implementation
          self.create(params,tprocsym(srsym),symowner,nil);
          self.create(params,tprocsym(srsym),symowner,nil);
        end;
        end;
 
 
+    constructor tcallnode.createinternres(const name: string; params: tnode; const res: ttype);
+      begin
+        self.createintern(name,params);
+        restype := res;
+        restypeset := true;
+        { both the normal and specified resulttype either have to be returned via a }
+        { parameter or not, but no mixing (JM)                                      }
+        if ret_in_param(restype.def) xor ret_in_param(symtableprocentry.definition.rettype.def) then
+          internalerror(200108291);
+      end;
+
+
     destructor tcallnode.destroy;
     destructor tcallnode.destroy;
       begin
       begin
          methodpointer.free;
          methodpointer.free;
@@ -1346,7 +1365,10 @@ implementation
            message(cg_e_cannot_call_message_direct);
            message(cg_e_cannot_call_message_direct);
 
 
          { ensure that the result type is set }
          { ensure that the result type is set }
-         resulttype:=procdefinition.rettype;
+         if not restypeset then
+           resulttype:=procdefinition.rettype
+         else
+           resulttype:=restype;
 
 
          { get a register for the return value }
          { get a register for the return value }
          if (not is_void(resulttype.def)) then
          if (not is_void(resulttype.def)) then
@@ -1716,7 +1738,20 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.46  2001-08-28 13:24:46  jonas
+  Revision 1.47  2001-08-29 12:18:07  jonas
+    + new createinternres() constructor for tcallnode to support setting a
+      custom resulttype
+    * compilerproc typeconversions now set the resulttype from the type
+      conversion for the generated call node, because the resulttype of
+      of the compilerproc helper isn't always exact (e.g. the ones that
+      return shortstrings, actually return a shortstring[x], where x is
+      specified by the typeconversion node)
+    * ti386callnode.pass_2 now always uses resulttype instead of
+      procsym.definition.rettype (so the custom resulttype, if any, is
+      always used). Note that this "rettype" stuff is only for use with
+      compilerprocs.
+
+  Revision 1.46  2001/08/28 13:24:46  jonas
     + compilerproc implementation of most string-related type conversions
     + compilerproc implementation of most string-related type conversions
     - removed all code from the compiler which has been replaced by
     - removed all code from the compiler which has been replaced by
       compilerproc implementations (using {$ifdef hascompilerproc} is not
       compilerproc implementations (using {$ifdef hascompilerproc} is not

+ 20 - 7
compiler/ncnv.pas

@@ -423,9 +423,9 @@ implementation
 
 
     function ttypeconvnode.resulttype_chararray_to_string : tnode;
     function ttypeconvnode.resulttype_chararray_to_string : tnode;
       begin
       begin
-        result := ccallnode.createintern(
+        result := ccallnode.createinternres(
           'fpc_chararray_to_'+lower(tstringdef(resulttype.def).stringtypname),
           'fpc_chararray_to_'+lower(tstringdef(resulttype.def).stringtypname),
-          ccallparanode.create(left,nil));
+          ccallparanode.create(left,nil),resulttype);
         left := nil;
         left := nil;
         resulttypepass(result);
         resulttypepass(result);
       end;
       end;
@@ -485,7 +485,7 @@ implementation
                  in_high_x,false,self.getcopy),nil);
                  in_high_x,false,self.getcopy),nil);
                  
                  
              { and create the callnode }
              { and create the callnode }
-             result := ccallnode.createintern(procname,stringpara);
+             result := ccallnode.createinternres(procname,stringpara,resulttype);
              resulttypepass(result);
              resulttypepass(result);
            end;
            end;
       end;
       end;
@@ -526,7 +526,7 @@ implementation
                  lower(tstringdef(resulttype.def).stringtypname);
                  lower(tstringdef(resulttype.def).stringtypname);
 
 
                { and finally the call }
                { and finally the call }
-               result := ccallnode.createintern(procname,para);
+               result := ccallnode.createinternres(procname,para,resulttype);
                resulttypepass(result);
                resulttypepass(result);
              end;
              end;
       end;
       end;
@@ -633,9 +633,9 @@ implementation
 
 
     function ttypeconvnode.resulttype_pchar_to_string : tnode;
     function ttypeconvnode.resulttype_pchar_to_string : tnode;
       begin
       begin
-        result := ccallnode.createintern(
+        result := ccallnode.createinternres(
           'fpc_pchar_to_'+lower(tstringdef(resulttype.def).stringtypname),
           'fpc_pchar_to_'+lower(tstringdef(resulttype.def).stringtypname),
-          ccallparanode.create(left,nil));
+          ccallparanode.create(left,nil),resulttype);
         left := nil;
         left := nil;
         resulttypepass(result);
         resulttypepass(result);
       end;
       end;
@@ -1477,7 +1477,20 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.33  2001-08-28 13:24:46  jonas
+  Revision 1.34  2001-08-29 12:18:07  jonas
+    + new createinternres() constructor for tcallnode to support setting a
+      custom resulttype
+    * compilerproc typeconversions now set the resulttype from the type
+      conversion for the generated call node, because the resulttype of
+      of the compilerproc helper isn't always exact (e.g. the ones that
+      return shortstrings, actually return a shortstring[x], where x is
+      specified by the typeconversion node)
+    * ti386callnode.pass_2 now always uses resulttype instead of
+      procsym.definition.rettype (so the custom resulttype, if any, is
+      always used). Note that this "rettype" stuff is only for use with
+      compilerprocs.
+
+  Revision 1.33  2001/08/28 13:24:46  jonas
     + compilerproc implementation of most string-related type conversions
     + compilerproc implementation of most string-related type conversions
     - removed all code from the compiler which has been replaced by
     - removed all code from the compiler which has been replaced by
       compilerproc implementations (using {$ifdef hascompilerproc} is not
       compilerproc implementations (using {$ifdef hascompilerproc} is not