Selaa lähdekoodia

* tcallnode.paraitem introduced, all references to defcoll removed

florian 22 vuotta sitten
vanhempi
commit
1da30f2610
4 muutettua tiedostoa jossa 127 lisäystä ja 108 poistoa
  1. 30 27
      compiler/i386/n386cal.pas
  2. 56 46
      compiler/ncal.pas
  3. 36 33
      compiler/ncgcal.pas
  4. 5 2
      compiler/ninl.pas

+ 30 - 27
compiler/i386/n386cal.pas

@@ -35,8 +35,7 @@ interface
 
     type
        ti386callparanode = class(tcallparanode)
-          procedure secondcallparan(defcoll : TParaItem;
-                push_from_left_to_right:boolean;calloption:tproccalloption;
+          procedure secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;
                 para_alignment,para_offset : longint);override;
        end;
 
@@ -69,14 +68,13 @@ implementation
                              TI386CALLPARANODE
 *****************************************************************************}
 
-    procedure ti386callparanode.secondcallparan(defcoll : TParaItem;
-                push_from_left_to_right:boolean;calloption:tproccalloption;para_alignment,para_offset : longint);
+    procedure ti386callparanode.secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;para_alignment,para_offset : longint);
 
       procedure maybe_push_high;
         begin
            { open array ? }
-           { defcoll.data can be nil for read/write }
-           if assigned(defcoll.paratype.def) and
+           { paraitem.data can be nil for read/write }
+           if assigned(paraitem.paratype.def) and
               assigned(hightree) then
             begin
               secondpass(hightree);
@@ -101,10 +99,10 @@ implementation
          if push_from_left_to_right and assigned(right) then
           begin
             if (nf_varargs_para in flags) then
-              tcallparanode(right).secondcallparan(defcoll,push_from_left_to_right,
+              tcallparanode(right).secondcallparan(push_from_left_to_right,
                                                    calloption,para_alignment,para_offset)
             else
-              tcallparanode(right).secondcallparan(TParaItem(defcoll.next),push_from_left_to_right,
+              tcallparanode(right).secondcallparan(push_from_left_to_right,
                                                    calloption,para_alignment,para_offset);
           end;
 
@@ -113,7 +111,7 @@ implementation
          objectlibrary.getlabel(truelabel);
          objectlibrary.getlabel(falselabel);
          secondpass(left);
-         { handle varargs first, because defcoll is not valid }
+         { handle varargs first, because paraitem is not valid }
          if (nf_varargs_para in flags) then
            begin
              if paramanager.push_addr_param(left.resulttype.def,calloption) then
@@ -130,12 +128,12 @@ implementation
            begin
              { nothing, everything is already pushed }
            end
-         { in codegen.handleread.. defcoll.data is set to nil }
-         else if assigned(defcoll.paratype.def) and
-                 (defcoll.paratype.def.deftype=formaldef) then
+         { in codegen.handleread.. paraitem.data is set to nil }
+         else if assigned(paraitem.paratype.def) and
+                 (paraitem.paratype.def.deftype=formaldef) then
            begin
               { allow passing of a constant to a const formaldef }
-              if (defcoll.paratyp=vs_const) and
+              if (paraitem.paratyp=vs_const) and
                  (left.location.loc=LOC_CONSTANT) then
                 location_force_mem(exprasmlist,left.location);
 
@@ -174,7 +172,7 @@ implementation
                 end;
            end
          { handle call by reference parameter }
-         else if (defcoll.paratyp in [vs_var,vs_out]) then
+         else if (paraitem.paratyp in [vs_var,vs_out]) then
            begin
               if (left.location.loc<>LOC_REFERENCE) then
                begin
@@ -188,11 +186,11 @@ implementation
               if not push_from_left_to_right then
 {$endif unused}
                 maybe_push_high;
-              if (defcoll.paratyp=vs_out) and
-                 assigned(defcoll.paratype.def) and
-                 not is_class(defcoll.paratype.def) and
-                 defcoll.paratype.def.needs_inittable then
-                cg.g_finalize(exprasmlist,defcoll.paratype.def,left.location.reference,false);
+              if (paraitem.paratyp=vs_out) and
+                 assigned(paraitem.paratype.def) and
+                 not is_class(paraitem.paratype.def) and
+                 paraitem.paratype.def.needs_inittable then
+                cg.g_finalize(exprasmlist,paraitem.paratype.def,left.location.reference,false);
               inc(pushedparasize,4);
               if calloption=pocall_inline then
                 begin
@@ -218,9 +216,9 @@ implementation
               { open array must always push the address, this is needed to
                 also push addr of small open arrays and with cdecl functions (PFV) }
               if (
-                  assigned(defcoll.paratype.def) and
-                  (is_open_array(defcoll.paratype.def) or
-                   is_array_of_const(defcoll.paratype.def))
+                  assigned(paraitem.paratype.def) and
+                  (is_open_array(paraitem.paratype.def) or
+                   is_array_of_const(paraitem.paratype.def))
                  ) or
                  (
                   paramanager.push_addr_param(resulttype.def,calloption)
@@ -275,10 +273,10 @@ implementation
          if not push_from_left_to_right and assigned(right) then
           begin
             if (nf_varargs_para in flags) then
-              tcallparanode(right).secondcallparan(defcoll,push_from_left_to_right,
+              tcallparanode(right).secondcallparan(push_from_left_to_right,
                                                    calloption,para_alignment,para_offset)
             else
-              tcallparanode(right).secondcallparan(TParaItem(defcoll.next),push_from_left_to_right,
+              tcallparanode(right).secondcallparan(push_from_left_to_right,
                                                    calloption,para_alignment,para_offset);
           end;
       end;
@@ -514,11 +512,13 @@ implementation
                 para_offset:=0;
               if not(inlined) and
                  assigned(right) then
-                tcallparanode(params).secondcallparan(TParaItem(tabstractprocdef(right.resulttype.def).Para.first),
+                tcallparanode(params).secondcallparan(
+                { TParaItem(tabstractprocdef(right.resulttype.def).Para.first), }
                   (po_leftright in procdefinition.procoptions),procdefinition.proccalloption,
                   para_alignment,para_offset)
               else
-                tcallparanode(params).secondcallparan(TParaItem(procdefinition.Para.first),
+                tcallparanode(params).secondcallparan(
+                  { TParaItem(procdefinition.Para.first), }
                   (po_leftright in procdefinition.procoptions),procdefinition.proccalloption,
                   para_alignment,para_offset);
            end;
@@ -1250,7 +1250,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.77  2002-11-27 20:05:06  peter
+  Revision 1.78  2002-12-15 21:30:12  florian
+    * tcallnode.paraitem introduced, all references to defcoll removed
+
+  Revision 1.77  2002/11/27 20:05:06  peter
     * cdecl array of const fixes
 
   Revision 1.76  2002/11/25 17:43:26  peter

+ 56 - 46
compiler/ncal.pas

@@ -121,7 +121,10 @@ interface
 
        tcallparanode = class(tbinarynode)
           callparaflags : set of tcallparaflags;
+          paraitem : tparaitem;
+{$ifndef VS_HIDDEN}
           hightree : tnode;
+{$endif VS_HIDDEN}
           { only the processor specific nodes need to override this }
           { constructor                                             }
           constructor create(expr,next : tnode);virtual;
@@ -135,9 +138,8 @@ interface
           procedure get_paratype;
           procedure insert_typeconv(defcoll : tparaitem;do_count : boolean);
           procedure det_registers;
-          procedure firstcallparan(defcoll : tparaitem;do_count : boolean);
-          procedure secondcallparan(defcoll : TParaItem;
-                push_from_left_to_right:boolean;calloption:tproccalloption;
+          procedure firstcallparan(do_count : boolean);
+          procedure secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;
                 para_alignment,para_offset : longint);virtual;abstract;
           function docompare(p: tnode): boolean; override;
        end;
@@ -495,6 +497,7 @@ type
            n.hightree:=hightree.getcopy
          else
            n.hightree:=nil;
+         n.paraitem:=paraitem;
          result:=n;
       end;
 
@@ -536,6 +539,8 @@ type
       begin
          inc(parsing_para_level);
 
+         paraitem:=defcoll;
+
          if not assigned(defcoll) then
            internalerror(200104261);
 
@@ -631,7 +636,7 @@ type
                  if (left.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
                     (left.nodetype in [vecn,loadn,calln]) then
                    begin
-                      if (left.resulttype.def.size > defcoll.paratype.def.size) then
+                      if (left.resulttype.def.size>defcoll.paratype.def.size) then
                         begin
                           if (cs_check_range in aktlocalswitches) then
                              Message(type_w_smaller_possible_range_check)
@@ -756,13 +761,15 @@ type
       end;
 
 
-    procedure tcallparanode.firstcallparan(defcoll : tparaitem;do_count : boolean);
+    procedure tcallparanode.firstcallparan(do_count : boolean);
       begin
         if not assigned(left.resulttype.def) then
          begin
            get_paratype;
+           {
            if assigned(defcoll) then
             insert_typeconv(defcoll,do_count);
+           }
          end;
         det_registers;
       end;
@@ -2107,26 +2114,26 @@ type
         oldprocinfo : tprocinfo;
         oldinlining_procedure : boolean;
       begin
-         result:=nil;
-         oldinlining_procedure:=inlining_procedure;
-         oldprocdef:=aktprocdef;
-         oldprocinfo:=procinfo;
-         { we're inlining a procedure }
-         inlining_procedure:=true;
-         aktprocdef:=inlineprocdef;
-
-         { clone procinfo, but not the asmlists }
-         procinfo:=tprocinfo(cprocinfo.newinstance);
-         move(pointer(oldprocinfo)^,pointer(procinfo)^,cprocinfo.InstanceSize);
-         procinfo.aktentrycode:=nil;
-         procinfo.aktexitcode:=nil;
-         procinfo.aktproccode:=nil;
-         procinfo.aktlocaldata:=nil;
-
-         { set new procinfo }
-         procinfo.return_offset:=retoffset;
-         procinfo.para_offset:=para_offset;
-         procinfo.no_fast_exit:=false;
+        result:=nil;
+        oldinlining_procedure:=inlining_procedure;
+        oldprocdef:=aktprocdef;
+        oldprocinfo:=procinfo;
+        { we're inlining a procedure }
+        inlining_procedure:=true;
+        aktprocdef:=inlineprocdef;
+
+        { clone procinfo, but not the asmlists }
+        procinfo:=tprocinfo(cprocinfo.newinstance);
+        move(pointer(oldprocinfo)^,pointer(procinfo)^,cprocinfo.InstanceSize);
+        procinfo.aktentrycode:=nil;
+        procinfo.aktexitcode:=nil;
+        procinfo.aktproccode:=nil;
+        procinfo.aktlocaldata:=nil;
+
+        { set new procinfo }
+        procinfo.return_offset:=retoffset;
+        procinfo.para_offset:=para_offset;
+        procinfo.no_fast_exit:=false;
 
         { set it to the same lexical level }
         storesymtablelevel:=aktprocdef.localst.symtablelevel;
@@ -2136,27 +2143,27 @@ type
         aktprocdef.localst.symtabletype:=inlinelocalsymtable;
         aktprocdef.parast.symtabletype:=inlineparasymtable;
 
-                                                { pass inlinetree }
-         resulttypepass(inlinetree);
-         resulttype:=inlineprocdef.rettype;
+        { pass inlinetree }
+        resulttypepass(inlinetree);
+        resulttype:=inlineprocdef.rettype;
 
-         { retrieve info from inlineprocdef }
-         retoffset:=-POINTER_SIZE; { less dangerous as zero (PM) }
-         para_offset:=0;
-         para_size:=inlineprocdef.para_size(target_info.alignment.paraalign);
-         if paramanager.ret_in_param(inlineprocdef.rettype.def,inlineprocdef.proccalloption) then
-           inc(para_size,POINTER_SIZE);
-
-         { restore procinfo }
-         procinfo.free;
-         procinfo:=oldprocinfo;
-         { restore symtable }
-         aktprocdef.localst.symtablelevel:=storesymtablelevel;
-         aktprocdef.localst.symtabletype:=storelocalsymtable;
-         aktprocdef.parast.symtabletype:=storeparasymtable;
-         { restore }
-         aktprocdef:=oldprocdef;
-         inlining_procedure:=oldinlining_procedure;
+        { retrieve info from inlineprocdef }
+        retoffset:=-POINTER_SIZE; { less dangerous as zero (PM) }
+        para_offset:=0;
+        para_size:=inlineprocdef.para_size(target_info.alignment.paraalign);
+        if paramanager.ret_in_param(inlineprocdef.rettype.def,inlineprocdef.proccalloption) then
+          inc(para_size,POINTER_SIZE);
+
+        { restore procinfo }
+        procinfo.free;
+        procinfo:=oldprocinfo;
+        { restore symtable }
+        aktprocdef.localst.symtablelevel:=storesymtablelevel;
+        aktprocdef.localst.symtabletype:=storelocalsymtable;
+        aktprocdef.parast.symtabletype:=storeparasymtable;
+        { restore }
+        aktprocdef:=oldprocdef;
+        inlining_procedure:=oldinlining_procedure;
       end;
 
 
@@ -2187,7 +2194,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.119  2002-12-15 20:59:58  peter
+  Revision 1.120  2002-12-15 21:30:12  florian
+    * tcallnode.paraitem introduced, all references to defcoll removed
+
+  Revision 1.119  2002/12/15 20:59:58  peter
     * fix crash with default parameters
 
   Revision 1.118  2002/12/15 11:26:02  peter

+ 36 - 33
compiler/ncgcal.pas

@@ -35,8 +35,7 @@ interface
 
     type
        tcgcallparanode = class(tcallparanode)
-          procedure secondcallparan(defcoll : TParaItem;
-                push_from_left_to_right:boolean;calloption:tproccalloption;
+          procedure secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;
                 para_alignment,para_offset : longint);override;
        end;
 
@@ -82,20 +81,19 @@ implementation
                              TCGCALLPARANODE
 *****************************************************************************}
 
-    procedure tcgcallparanode.secondcallparan(defcoll : TParaItem;
-                push_from_left_to_right:boolean;calloption:tproccalloption;para_alignment,para_offset : longint);
+    procedure tcgcallparanode.secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;para_alignment,para_offset : longint);
 
       { goes to pass 1 }
       procedure maybe_push_high;
         begin
            { open array ? }
            { defcoll.data can be nil for read/write }
-           if assigned(defcoll.paratype.def) and
+           if assigned(paraitem.paratype.def) and
               assigned(hightree) then
             begin
               secondpass(hightree);
               { this is a longint anyway ! }
-              push_value_para(hightree,calloption,para_offset,4,defcoll.paraloc);
+              push_value_para(hightree,calloption,para_offset,4,paraitem.paraloc);
             end;
         end;
 
@@ -112,10 +110,10 @@ implementation
          if push_from_left_to_right and assigned(right) then
           begin
             if (nf_varargs_para in flags) then
-              tcallparanode(right).secondcallparan(defcoll,push_from_left_to_right,
+              tcallparanode(right).secondcallparan(push_from_left_to_right,
                                                    calloption,para_alignment,para_offset)
             else
-              tcallparanode(right).secondcallparan(TParaItem(defcoll.next),push_from_left_to_right,
+              tcallparanode(right).secondcallparan(push_from_left_to_right,
                                                    calloption,para_alignment,para_offset);
           end;
 
@@ -130,23 +128,23 @@ implementation
              if paramanager.push_addr_param(left.resulttype.def,calloption) then
                begin
                  inc(pushedparasize,4);
-                 cg.a_paramaddr_ref(exprasmlist,left.location.reference,defcoll.paraloc);
+                 cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
                  location_release(exprasmlist,left.location);
                end
              else
-               push_value_para(left,calloption,para_offset,para_alignment,defcoll.paraloc);
+               push_value_para(left,calloption,para_offset,para_alignment,paraitem.paraloc);
            end
          { filter array constructor with c styled args }
          else if is_array_constructor(left.resulttype.def) and (nf_cargs in left.flags) then
            begin
              { nothing, everything is already pushed }
            end
-         { in codegen.handleread.. defcoll.data is set to nil }
-         else if assigned(defcoll.paratype.def) and
-                 (defcoll.paratype.def.deftype=formaldef) then
+         { in codegen.handleread.. paraitem.data is set to nil }
+         else if assigned(paraitem.paratype.def) and
+                 (paraitem.paratype.def.deftype=formaldef) then
            begin
               { allow passing of a constant to a const formaldef }
-              if (defcoll.paratyp=vs_const) and
+              if (paraitem.paratyp=vs_const) and
                  (left.location.loc=LOC_CONSTANT) then
                 location_force_mem(exprasmlist,left.location);
 
@@ -161,7 +159,7 @@ implementation
                        cg.a_load_loc_ref(exprasmlist,left.location,href);
                     end
                   else
-                    cg.a_param_loc(exprasmlist,left.location,defcoll.paraloc);
+                    cg.a_param_loc(exprasmlist,left.location,paraitem.paraloc);
                   location_release(exprasmlist,left.location);
                 end
               else
@@ -181,13 +179,13 @@ implementation
                            cg.free_scratch_reg(exprasmlist,tmpreg);
                          end
                        else
-                         cg.a_paramaddr_ref(exprasmlist,left.location.reference,defcoll.paraloc);
+                         cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
                        location_release(exprasmlist,left.location);
                      end;
                 end;
            end
          { handle call by reference parameter }
-         else if (defcoll.paratyp in [vs_var,vs_out]) then
+         else if (paraitem.paratyp in [vs_var,vs_out]) then
            begin
               if (left.location.loc<>LOC_REFERENCE) then
                begin
@@ -201,11 +199,11 @@ implementation
               if not push_from_left_to_right then
 {$endif unused}
                 maybe_push_high;
-              if (defcoll.paratyp=vs_out) and
-                 assigned(defcoll.paratype.def) and
-                 not is_class(defcoll.paratype.def) and
-                 defcoll.paratype.def.needs_inittable then
-                cg.g_finalize(exprasmlist,defcoll.paratype.def,left.location.reference,false);
+              if (paraitem.paratyp=vs_out) and
+                 assigned(paraitem.paratype.def) and
+                 not is_class(paraitem.paratype.def) and
+                 paraitem.paratype.def.needs_inittable then
+                cg.g_finalize(exprasmlist,paraitem.paratype.def,left.location.reference,false);
               inc(pushedparasize,4);
               if calloption=pocall_inline then
                 begin
@@ -216,7 +214,7 @@ implementation
                    cg.free_scratch_reg(exprasmlist,tmpreg);
                 end
               else
-                cg.a_paramaddr_ref(exprasmlist,left.location.reference,defcoll.paraloc);
+                cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
               location_release(exprasmlist,left.location);
 {$ifdef unused}
               if push_from_left_to_right then
@@ -231,9 +229,9 @@ implementation
               { open array must always push the address, this is needed to
                 also push addr of small open arrays and with cdecl functions (PFV) }
               if (
-                  assigned(defcoll.paratype.def) and
-                  (is_open_array(defcoll.paratype.def) or
-                   is_array_of_const(defcoll.paratype.def))
+                  assigned(paraitem.paratype.def) and
+                  (is_open_array(paraitem.paratype.def) or
+                   is_array_of_const(paraitem.paratype.def))
                  ) or
                  (
                   paramanager.push_addr_param(resulttype.def,calloption)
@@ -274,7 +272,7 @@ implementation
                         cg.free_scratch_reg(exprasmlist,tmpreg);
                      end
                    else
-                     cg.a_paramaddr_ref(exprasmlist,left.location.reference,defcoll.paraloc);
+                     cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
                    location_release(exprasmlist,left.location);
 {$ifdef unused}
                    if push_from_left_to_right then
@@ -284,7 +282,7 @@ implementation
               else
                 begin
                    push_value_para(left,calloption,
-                     para_offset,para_alignment,defcoll.paraloc);
+                     para_offset,para_alignment,paraitem.paraloc);
                 end;
            end;
          truelabel:=otlabel;
@@ -293,10 +291,10 @@ implementation
          if not push_from_left_to_right and assigned(right) then
           begin
             if (nf_varargs_para in flags) then
-              tcallparanode(right).secondcallparan(defcoll,push_from_left_to_right,
+              tcallparanode(right).secondcallparan(push_from_left_to_right,
                                                    calloption,para_alignment,para_offset)
             else
-              tcallparanode(right).secondcallparan(TParaItem(defcoll.next),push_from_left_to_right,
+              tcallparanode(right).secondcallparan(push_from_left_to_right,
                                                    calloption,para_alignment,para_offset);
           end;
       end;
@@ -664,11 +662,13 @@ implementation
                 para_offset:=0;
               if not(inlined) and
                  assigned(right) then
-                tcallparanode(params).secondcallparan(TParaItem(tabstractprocdef(right.resulttype.def).Para.first),
+                tcallparanode(params).secondcallparan(
+                 { TParaItem(tabstractprocdef(right.resulttype.def).Para.first), }
                   (po_leftright in procdefinition.procoptions),procdefinition.proccalloption,
                   para_alignment,para_offset)
               else
-                tcallparanode(params).secondcallparan(TParaItem(procdefinition.Para.first),
+                tcallparanode(params).secondcallparan(
+                  { TParaItem(procdefinition.Para.first), }
                   (po_leftright in procdefinition.procoptions),procdefinition.proccalloption,
                   para_alignment,para_offset);
            end;
@@ -1549,7 +1549,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.30  2002-11-27 20:04:39  peter
+  Revision 1.31  2002-12-15 21:30:12  florian
+    * tcallnode.paraitem introduced, all references to defcoll removed
+
+  Revision 1.30  2002/11/27 20:04:39  peter
     * cdecl array of const fixes
 
   Revision 1.29  2002/11/25 17:43:17  peter

+ 5 - 2
compiler/ninl.pas

@@ -1982,7 +1982,7 @@ implementation
          if assigned(left) then
            begin
               if left.nodetype=callparan then
-                tcallparanode(left).firstcallparan(nil,false)
+                tcallparanode(left).firstcallparan(false)
               else
                 firstpass(left);
               left_max;
@@ -2399,7 +2399,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.101  2002-11-27 20:04:39  peter
+  Revision 1.102  2002-12-15 21:30:12  florian
+    * tcallnode.paraitem introduced, all references to defcoll removed
+
+  Revision 1.101  2002/11/27 20:04:39  peter
     * cdecl array of const fixes
 
   Revision 1.100  2002/11/27 15:33:47  peter