* vs_hidden released

compiler/defcmp.pas

@@ -1057,8 +1057,8 @@ implementation
          { we need to parse the list from left-right so the
            not-default parameters are checked first }
          lowesteq:=high(tequaltype);
-         def1:=TParaItem(paralist1.last);
-         def2:=TParaItem(paralist2.last);
+         def1:=TParaItem(paralist1.first);
+         def2:=TParaItem(paralist2.first);
          while (assigned(def1)) and (assigned(def2)) do
            begin
              eq:=te_incompatible;
@@ -1116,8 +1116,8 @@ implementation
                  if not equal_constsym(tconstsym(def1.defaultvalue),tconstsym(def2.defaultvalue)) then
                    exit;
                end;
-              def1:=TParaItem(def1.previous);
-              def2:=TParaItem(def2.previous);
+              def1:=TParaItem(def1.next);
+              def2:=TParaItem(def2.next);
            end;
          { when both lists are empty then the parameters are equal. Also
            when one list is empty and the other has a parameter with default
@@ -1182,7 +1182,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.20  2003-03-20 17:52:18  peter
+  Revision 1.21  2003-04-10 17:57:52  peter
+    * vs_hidden released
+
+  Revision 1.20  2003/03/20 17:52:18  peter
     * fix compare for unique types, they are allowed when they match
       exact
 

compiler/ncal.pas

@@ -65,6 +65,7 @@ interface
 {$ifdef EXTDEBUG}
           procedure candidates_dump_info(lvl:longint;procs:pcandidate);
 {$endif EXTDEBUG}
+          procedure bind_paraitem;
        public
           { the symbol containing the definition of the procedure }
           { to call                                               }
@@ -127,9 +128,6 @@ 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;
@@ -139,9 +137,8 @@ interface
           procedure derefimpl;override;
           function getcopy : tnode;override;
           procedure insertintolist(l : tnodelist);override;
-          procedure gen_high_tree(openstring:boolean);
           procedure get_paratype;
-          procedure insert_typeconv(defcoll : tparaitem;do_count : boolean);
+          procedure insert_typeconv(do_count : boolean);
           procedure det_registers;
           procedure firstcallparan(do_count : boolean);
           procedure secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;
@@ -215,6 +212,71 @@ type
       end;
 
 
+    function gen_high_tree(p:tnode;openstring:boolean):tnode;
+      var
+        temp: tnode;
+        len : integer;
+        loadconst : boolean;
+        hightree : tnode;
+      begin
+        len:=-1;
+        loadconst:=true;
+        hightree:=nil;
+        case p.resulttype.def.deftype of
+          arraydef :
+            begin
+              { handle via a normal inline in_high_x node }
+              loadconst := false;
+              hightree := geninlinenode(in_high_x,false,p.getcopy);
+              { only substract low(array) if it's <> 0 }
+              temp := geninlinenode(in_low_x,false,p.getcopy);
+              resulttypepass(temp);
+              if (temp.nodetype <> ordconstn) or
+                 (tordconstnode(temp).value <> 0) then
+                hightree := caddnode.create(subn,hightree,temp)
+              else
+                temp.free;
+            end;
+          stringdef :
+            begin
+              if openstring then
+               begin
+                 { handle via a normal inline in_high_x node }
+                 loadconst := false;
+                 hightree := geninlinenode(in_high_x,false,p.getcopy);
+               end
+              else
+               begin
+                 { passing a string to an array of char }
+                 if (p.nodetype=stringconstn) then
+                   begin
+                     len:=str_length(p);
+                     if len>0 then
+                      dec(len);
+                   end
+                 else
+                   begin
+                     hightree:=caddnode.create(subn,geninlinenode(in_length_x,false,p.getcopy),
+                                               cordconstnode.create(1,s32bittype,false));
+                     loadconst:=false;
+                   end;
+               end;
+           end;
+        else
+          len:=0;
+        end;
+        if loadconst then
+          hightree:=cordconstnode.create(len,s32bittype,true)
+        else
+          begin
+            if not assigned(hightree) then
+              internalerror(200304071);
+            hightree:=ctypeconvnode.create(hightree,s32bittype);
+          end;
+        result:=hightree;
+      end;
+
+
     procedure search_class_overloads(aprocsym : tprocsym);
     { searches n in symtable of pd and all anchestors }
       var
@@ -463,9 +525,6 @@ type
 
       begin
          inherited create(callparan,expr,next);
-{$ifndef VS_HIDDEN}
-         hightree:=nil;
-{$endif VS_HIDDEN}
          if assigned(expr) then
           expr.set_file_line(self);
          callparaflags:=[];
@@ -474,9 +533,6 @@ type
     destructor tcallparanode.destroy;
 
       begin
-{$ifndef VS_HIDDEN}
-         hightree.free;
-{$endif VS_HIDDEN}
          inherited destroy;
       end;
 
@@ -485,9 +541,6 @@ type
       begin
         inherited ppuload(t,ppufile);
         ppufile.getsmallset(callparaflags);
-{$ifndef VS_HIDDEN}
-        hightree:=ppuloadnode(ppufile);
-{$endif VS_HIDDEN}
       end;
 
 
@@ -495,19 +548,12 @@ type
       begin
         inherited ppuwrite(ppufile);
         ppufile.putsmallset(callparaflags);
-{$ifndef VS_HIDDEN}
-        ppuwritenode(ppufile,hightree);
-{$endif VS_HIDDEN}
       end;
 
 
     procedure tcallparanode.derefimpl;
       begin
         inherited derefimpl;
-{$ifndef VS_HIDDEN}
-        if assigned(hightree) then
-          hightree.derefimpl;
-{$endif VS_HIDDEN}
       end;
 
 
@@ -519,12 +565,6 @@ type
       begin
          n:=tcallparanode(inherited getcopy);
          n.callparaflags:=callparaflags;
-{$ifndef VS_HIDDEN}
-         if assigned(hightree) then
-           n.hightree:=hightree.getcopy
-         else
-           n.hightree:=nil;
-{$endif VS_HIDDEN}
          n.paraitem:=paraitem;
          result:=n;
       end;
@@ -558,7 +598,7 @@ type
       end;
 
 
-    procedure tcallparanode.insert_typeconv(defcoll : tparaitem;do_count : boolean);
+    procedure tcallparanode.insert_typeconv(do_count : boolean);
       var
         oldtype     : ttype;
 {$ifdef extdebug}
@@ -567,8 +607,6 @@ type
       begin
          inc(parsing_para_level);
 
-         paraitem:=defcoll;
-
          if not assigned(paraitem) then
            internalerror(200104261);
 
@@ -603,14 +641,14 @@ type
            end
          else
            begin
-    
+
              { Do we need arrayconstructor -> set conversion, then insert
                it here before the arrayconstructor node breaks the tree
                with its conversions of enum->ord }
              if (left.nodetype=arrayconstructorn) and
                 (paraitem.paratype.def.deftype=setdef) then
                inserttypeconv(left,paraitem.paratype);
-    
+
              { set some settings needed for arrayconstructor }
              if is_array_constructor(left.resulttype.def) then
               begin
@@ -630,15 +668,11 @@ type
                    tarrayconstructornode(left).force_type(tarraydef(paraitem.paratype.def).elementtype);
                  end;
               end;
-    
+
              { check if local proc/func is assigned to procvar }
              if left.resulttype.def.deftype=procvardef then
                test_local_to_procvar(tprocvardef(left.resulttype.def),paraitem.paratype.def);
-    
-             { generate the high() value tree }
-             if paramanager.push_high_param(paraitem.paratype.def,aktcallprocdef.proccalloption) then
-               gen_high_tree(is_open_string(paraitem.paratype.def));
-    
+
              { test conversions }
              if not(is_shortstring(left.resulttype.def) and
                     is_shortstring(paraitem.paratype.def)) and
@@ -675,7 +709,7 @@ type
                        exit;
                     end;
                end;
-    
+
              { check var strings }
              if (cs_strict_var_strings in aktlocalswitches) and
                 is_shortstring(left.resulttype.def) and
@@ -687,7 +721,7 @@ type
                  aktfilepos:=left.fileinfo;
                  CGMessage(type_e_strict_var_string_violation);
                end;
-    
+
              { Handle formal parameters separate }
              if (paraitem.paratype.def.deftype=formaldef) then
                begin
@@ -696,7 +730,7 @@ type
                     (left.nodetype=calln) and
                     (is_void(left.resulttype.def)) then
                    load_procvar_from_calln(left);
-    
+
                  case paraitem.paratyp of
                    vs_var,
                    vs_out :
@@ -717,7 +751,7 @@ type
                  if (paraitem.paratyp in [vs_out,vs_var]) then
                    valid_for_var(left);
                end;
-    
+
              if paraitem.paratyp in [vs_var,vs_const] then
                begin
                   { Causes problems with const ansistrings if also }
@@ -726,12 +760,12 @@ type
                     set_unique(left);
                   make_not_regable(left);
                end;
-    
+
              { ansistrings out paramaters doesn't need to be  }
              { unique, they are finalized                     }
              if paraitem.paratyp=vs_out then
                make_not_regable(left);
-    
+
              if do_count then
               begin
                 { not completly proper, but avoids some warnings }
@@ -743,15 +777,9 @@ type
              resulttype:=paraitem.paratype;
            end;
 
+         { process next node }
          if assigned(right) then
-           begin
-             { if we are a para that belongs to varargs then keep
-               the current paraitem }
-             if (nf_varargs_para in flags) then
-               tcallparanode(right).insert_typeconv(paraitem,do_count)
-             else
-               tcallparanode(right).insert_typeconv(tparaitem(paraitem.next),do_count)
-           end;
+           tcallparanode(right).insert_typeconv(do_count);
 
          dec(parsing_para_level);
 {$ifdef extdebug}
@@ -809,149 +837,16 @@ type
         det_registers;
       end;
 
-{$ifdef VS_HIDDEN}
-    procedure tcallparanode.gen_high_tree(openstring:boolean);
-      var
-        temp: tnode;
-        len : integer;
-        loadconst : boolean;
-        hightree : tnode;
-      begin
-{        if assigned(hightree) then
-          exit;
-}
-        if (nf_hightree_generated in flags) then
-          exit;
-        len:=-1;
-        loadconst:=true;
-        case left.resulttype.def.deftype of
-          arraydef :
-            begin
-              { handle via a normal inline in_high_x node }
-              loadconst := false;
-              hightree := geninlinenode(in_high_x,false,left.getcopy);
-              { only substract low(array) if it's <> 0 }
-              temp := geninlinenode(in_low_x,false,left.getcopy);
-              firstpass(temp);
-              if (temp.nodetype <> ordconstn) or
-                 (tordconstnode(temp).value <> 0) then
-                hightree := caddnode.create(subn,hightree,temp)
-              else
-                temp.free;
-            end;
-          stringdef :
-            begin
-              if openstring then
-               begin
-                 { handle via a normal inline in_high_x node }
-                 loadconst := false;
-                 hightree := geninlinenode(in_high_x,false,left.getcopy);
-               end
-              else
-             { passing a string to an array of char }
-               begin
-                 if (left.nodetype=stringconstn) then
-                   begin
-                     len:=str_length(left);
-                     if len>0 then
-                      dec(len);
-                   end
-                 else
-                   begin
-                     hightree:=caddnode.create(subn,geninlinenode(in_length_x,false,left.getcopy),
-                                               cordconstnode.create(1,s32bittype,false));
-                     loadconst:=false;
-                   end;
-               end;
-           end;
-        else
-          len:=0;
-        end;
-        if loadconst then
-          hightree:=cordconstnode.create(len,s32bittype,true)
-        else
-          hightree:=ctypeconvnode.create(hightree,s32bittype);
-        temp:=ccallparanode.create(hightree,right);
-
-        right:=temp;
-        if (tparaitem(paraitem.next).paratyp <> vs_hidden) then
-          internalerror(200304071);
-
-        include(flags,nf_hightree_generated);
-      end;
-{$else VS_HIDDEN}
-    procedure tcallparanode.gen_high_tree(openstring:boolean);
-      var
-        temp: tnode;
-        len : integer;
-        loadconst : boolean;
-      begin
-        if assigned(hightree) then
-          exit;
-        len:=-1;
-        loadconst:=true;
-        case left.resulttype.def.deftype of
-          arraydef :
-            begin
-              { handle via a normal inline in_high_x node }
-              loadconst := false;
-              hightree := geninlinenode(in_high_x,false,left.getcopy);
-              { only substract low(array) if it's <> 0 }
-              temp := geninlinenode(in_low_x,false,left.getcopy);
-              firstpass(temp);
-              if (temp.nodetype <> ordconstn) or
-                 (tordconstnode(temp).value <> 0) then
-                hightree := caddnode.create(subn,hightree,temp)
-              else
-                temp.free;
-            end;
-          stringdef :
-            begin
-              if openstring then
-               begin
-                 { handle via a normal inline in_high_x node }
-                 loadconst := false;
-                 hightree := geninlinenode(in_high_x,false,left.getcopy);
-               end
-              else
-             { passing a string to an array of char }
-               begin
-                 if (left.nodetype=stringconstn) then
-                   begin
-                     len:=str_length(left);
-                     if len>0 then
-                      dec(len);
-                   end
-                 else
-                   begin
-                     hightree:=caddnode.create(subn,geninlinenode(in_length_x,false,left.getcopy),
-                                               cordconstnode.create(1,s32bittype,false));
-                     loadconst:=false;
-                   end;
-               end;
-           end;
-        else
-          len:=0;
-        end;
-        if loadconst then
-          hightree:=cordconstnode.create(len,s32bittype,true)
-        else
-          hightree:=ctypeconvnode.create(hightree,s32bittype);
-        firstpass(hightree);
-      end;
-{$endif VS_HIDDEN}
 
     function tcallparanode.docompare(p: tnode): boolean;
       begin
         docompare :=
           inherited docompare(p) and
           (callparaflags = tcallparanode(p).callparaflags)
-{$ifndef VS_HIDDEN}
-          and hightree.isequal(tcallparanode(p).hightree)
-{$endif VS_HIDDEN}
           ;
       end;
 
+
 {****************************************************************************
                                  TCALLNODE
  ****************************************************************************}
@@ -998,6 +893,7 @@ type
          self.create(params,tprocsym(srsym),symowner,nil);
        end;
 
+
     constructor tcallnode.createinternres(const name: string; params: tnode; const res: ttype);
       begin
         self.createintern(name,params);
@@ -1224,13 +1120,13 @@ type
           hp^.data:=pd;
           hp^.next:=procs;
           procs:=hp;
-          { Setup first parameter, skip all default parameters
+          { Find last parameter, skip all default parameters
             that are not passed. Ignore this skipping for varargs }
-          hp^.firstpara:=tparaitem(pd.Para.first);
+          hp^.firstpara:=tparaitem(pd.Para.last);
           if not(po_varargs in pd.procoptions) then
            begin
              for i:=1 to pd.maxparacount-paralength do
-              hp^.firstpara:=tparaitem(hp^.firstPara.next);
+              hp^.firstpara:=tparaitem(hp^.firstPara.previous);
            end;
         end;
 
@@ -1429,11 +1325,13 @@ type
         hp:=procs;
         while assigned(hp) do
          begin
-           { Setup first parameter to compare }
+           { We compare parameters in reverse order (right to left),
+             the firstpara is already pointing to the last parameter
+             were we need to start comparing }
            currparanr:=paralength;
            currpara:=hp^.firstpara;
            while assigned(currpara) and (currpara.paratyp=vs_hidden) do
-             currpara:=tparaitem(currpara.next);
+             currpara:=tparaitem(currpara.previous);
            pt:=tcallparanode(left);
            while assigned(pt) and assigned(currpara) do
             begin
@@ -1551,7 +1449,7 @@ type
                begin
                  { Ignore vs_hidden parameters }
                  repeat
-                   currpara:=tparaitem(currpara.next);
+                   currpara:=tparaitem(currpara.previous);
                  until (not assigned(currpara)) or (currpara.paratyp<>vs_hidden);
                end;
               dec(currparanr);
@@ -1653,6 +1551,64 @@ type
       end;
 
 
+
+    procedure tcallnode.bind_paraitem;
+      var
+        i        : integer;
+        pt       : tcallparanode;
+        oldppt   : ^tcallparanode;
+        currpara : tparaitem;
+        hiddentree : tnode;
+      begin
+        pt:=tcallparanode(left);
+        oldppt:=@left;
+
+        { flag all callparanodes that belong to the varargs }
+        if (po_varargs in procdefinition.procoptions) then
+         begin
+           i:=paralength;
+           while (i>procdefinition.maxparacount) do
+            begin
+              include(tcallparanode(pt).flags,nf_varargs_para);
+              oldppt:[email protected];
+              pt:=tcallparanode(pt.right);
+              dec(i);
+            end;
+         end;
+
+        { insert hidden parameters }
+        currpara:=tparaitem(procdefinition.Para.last);
+        while assigned(currpara) do
+         begin
+           if not assigned(pt) then
+             internalerror(200304082);
+           if (currpara.paratyp=vs_hidden) then
+            begin
+              hiddentree:=nil;
+              if assigned(currpara.previous) and
+                 paramanager.push_high_param(tparaitem(currpara.previous).paratype.def,procdefinition.proccalloption) then
+//              if vo_is_high_value in tvarsym(currpara.parasym).varoptions then
+               begin
+                 { we need the information of the next parameter }
+                 hiddentree:=gen_high_tree(pt.left,is_open_string(tparaitem(currpara.previous).paratype.def));
+               end;
+              { add a callparanode for the hidden parameter and
+                let the previous node point to this new node }
+              if not assigned(hiddentree) then
+                internalerror(200304073);
+              pt:=ccallparanode.create(hiddentree,oldppt^);
+              oldppt^:=pt;
+            end;
+           { Bind paraitem to this node }
+           pt.paraitem:=currpara;
+           { Next node and paraitem }
+           oldppt:[email protected];
+           pt:=tcallparanode(pt.right);
+           currpara:=tparaitem(currpara.previous);
+         end;
+      end;
+
+
     function tcallnode.det_resulttype:tnode;
       var
         procs : pcandidate;
@@ -1660,7 +1616,7 @@ type
         hpt : tnode;
         pt : tcallparanode;
         lastpara : longint;
-        pdc : tparaitem;
+        currpara : tparaitem;
         cand_cnt : integer;
         i : longint;
         is_const : boolean;
@@ -1700,26 +1656,26 @@ type
 
               procdefinition:=tabstractprocdef(right.resulttype.def);
 
-              { check the amount of parameters }
-              pdc:=tparaitem(procdefinition.Para.first);
-              while assigned(pdc) and (pdc.paratyp=vs_hidden) do
-                pdc:=tparaitem(pdc.next);
+              { Compare parameters from right to left }
+              currpara:=tparaitem(procdefinition.Para.last);
+              while assigned(currpara) and (currpara.paratyp=vs_hidden) do
+                currpara:=tparaitem(currpara.previous);
               pt:=tcallparanode(left);
               lastpara:=paralength;
-              while assigned(pdc) and assigned(pt) do
+              while assigned(currpara) and assigned(pt) do
                 begin
                   { only goto next para if we're out of the varargs }
                   if not(po_varargs in procdefinition.procoptions) or
                      (lastpara<=procdefinition.maxparacount) then
                    begin
                      repeat
-                       pdc:=tparaitem(pdc.next);
-                     until (not assigned(pdc)) or (pdc.paratyp<>vs_hidden);
+                       currpara:=tparaitem(currpara.previous);
+                     until (not assigned(currpara)) or (currpara.paratyp<>vs_hidden);
                    end;
                   pt:=tcallparanode(pt.right);
                   dec(lastpara);
                 end;
-              if assigned(pt) or assigned(pdc) then
+              if assigned(pt) or assigned(currpara) then
                 begin
                    if assigned(pt) then
                      aktfilepos:=pt.fileinfo;
@@ -1850,15 +1806,15 @@ type
               if assigned(procdefinition) and
                  (paralength<procdefinition.maxparacount) then
                begin
-                 pdc:=tparaitem(procdefinition.Para.last);
+                 currpara:=tparaitem(procdefinition.Para.first);
                  for i:=1 to paralength do
-                   pdc:=tparaitem(pdc.previous);
-                 while assigned(pdc) do
+                   currpara:=tparaitem(currpara.next);
+                 while assigned(currpara) do
                   begin
-                    if not assigned(pdc.defaultvalue) then
+                    if not assigned(currpara.defaultvalue) then
                      internalerror(200212142);
-                    left:=ccallparanode.create(genconstsymtree(tconstsym(pdc.defaultvalue)),left);
-                    pdc:=tparaitem(pdc.previous);
+                    left:=ccallparanode.create(genconstsymtree(tconstsym(currpara.defaultvalue)),left);
+                    currpara:=tparaitem(currpara.next);
                   end;
                end;
            end;
@@ -1922,25 +1878,13 @@ type
                resulttype:=tclassrefdef(methodpointer.resulttype.def).pointertype;
            end;
 
-         { flag all callparanodes that belong to the varargs }
-         if (po_varargs in procdefinition.procoptions) then
-          begin
-            pt:=tcallparanode(left);
-            i:=paralength;
-            while (i>procdefinition.maxparacount) do
-             begin
-               include(tcallparanode(pt).flags,nf_varargs_para);
-               pt:=tcallparanode(pt.right);
-               dec(i);
-             end;
-          end;
+         { bind paraitems to the callparanodes and insert hidden parameters }
+         aktcallprocdef:=procdefinition;
+         bind_paraitem;
 
-         { insert type conversions }
+         { insert type conversions for parameters }
          if assigned(left) then
-          begin
-            aktcallprocdef:=procdefinition;
-            tcallparanode(left).insert_typeconv(tparaitem(procdefinition.Para.first),true);
-          end;
+           tcallparanode(left).insert_typeconv(true);
 
          { direct call to inherited abstract method, then we
            can already give a error in the compiler instead
@@ -2411,7 +2355,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.134  2003-04-07 11:58:22  jonas
+  Revision 1.135  2003-04-10 17:57:52  peter
+    * vs_hidden released
+
+  Revision 1.134  2003/04/07 11:58:22  jonas
     * more vs_invisible fixes
 
   Revision 1.133  2003/04/07 10:40:21  jonas

compiler/ncgcal.pas

@@ -95,31 +95,11 @@ implementation
 *****************************************************************************}
 
     procedure tcgcallparanode.secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;para_alignment,para_offset : longint);
-
-
-{$ifndef VS_HIDDEN}
-      { goes to pass 1 }
-      procedure maybe_push_high;
-        begin
-           { open array ? }
-           { defcoll.data can be nil for read/write }
-           if assigned(paraitem.paratype.def) and
-              assigned(hightree) then
-            begin
-              secondpass(hightree);
-              { this is a longint anyway ! }
-              push_value_para(exprasmlist,hightree,calloption,para_offset,4,paraitem.paraloc);
-            end;
-        end;
-{$endif VS_HIDDEN}
-
       var
          otlabel,oflabel : tasmlabel;
-         { temporary variables: }
          tempdeftype : tdeftype;
          tmpreg : tregister;
          href   : treference;
-
       begin
          { set default para_alignment to target_info.stackalignment }
          if para_alignment=0 then
@@ -214,9 +194,6 @@ implementation
                         (left.nodetype=selfn)) then
                   internalerror(200106041);
                end;
-{$ifndef VS_HIDDEN}
-              maybe_push_high;
-{$endif VS_HIDDEN}
               if (paraitem.paratyp=vs_out) and
                  assigned(paraitem.paratype.def) and
                  not is_class(paraitem.paratype.def) and
@@ -270,9 +247,6 @@ implementation
                        internalerror(200204011);
                     end;
 
-{$ifndef VS_HIDDEN}
-                   maybe_push_high;
-{$endif VS_HIDDEN}
                    inc(pushedparasize,POINTER_SIZE);
                    if calloption=pocall_inline then
                      begin
@@ -1448,7 +1422,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.43  2003-04-06 21:11:23  olle
+  Revision 1.44  2003-04-10 17:57:52  peter
+    * vs_hidden released
+
+  Revision 1.43  2003/04/06 21:11:23  olle
     * changed newasmsymbol to newasmsymboldata for data symbols
 
   Revision 1.42  2003/04/04 15:38:56  peter

compiler/nmem.pas

@@ -425,13 +425,12 @@ implementation
                  if not assigned(tloadnode(left).left) then
                    include(tprocvardef(resulttype.def).procoptions,po_addressonly);
 
-                 { we need to process the parameters reverse so they are inserted
-                   in the correct right2left order (PFV) }
-                 hp2:=TParaItem(hp3.Para.last);
+                 { Add parameters in left to right order }
+                 hp2:=TParaItem(hp3.Para.first);
                  while assigned(hp2) do
                    begin
-                      tprocvardef(resulttype.def).concatpara(hp2.paratype,hp2.parasym,hp2.paratyp,hp2.defaultvalue);
-                      hp2:=TParaItem(hp2.previous);
+                      tprocvardef(resulttype.def).concatpara(nil,hp2.paratype,hp2.parasym,hp2.paratyp,hp2.defaultvalue);
+                      hp2:=TParaItem(hp2.next);
                    end;
               end
             else
@@ -1055,7 +1054,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.46  2003-01-30 21:46:57  peter
+  Revision 1.47  2003-04-10 17:57:52  peter
+    * vs_hidden released
+
+  Revision 1.46  2003/01/30 21:46:57  peter
     * self fixes for static methods (merged)
 
   Revision 1.45  2003/01/09 21:52:37  peter

compiler/node.pas

@@ -226,7 +226,6 @@ interface
 
          { flags used by tcallparanode }
          nf_varargs_para,  { belongs this para to varargs }
-         nf_hightree_generated, { has the hightree for thispara been generated }
 
          { taddrnode }
          nf_procvarload,
@@ -973,7 +972,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.51  2003-03-28 19:16:56  peter
+  Revision 1.52  2003-04-10 17:57:52  peter
+    * vs_hidden released
+
+  Revision 1.51  2003/03/28 19:16:56  peter
     * generic constructor working for i386
     * remove fixed self register
     * esi added as address register for i386

compiler/pdecobj.pas

@@ -201,29 +201,6 @@ implementation
 
         var
            sym : tsym;
-           propertyparas : tparalinkedlist;
-
-        { returns the matching procedure to access a property }
-{        function get_procdef : tprocdef;
-          var
-             p : pprocdeflist;
-          begin
-             get_procdef:=nil;
-             p:=tprocsym(sym).defs;
-             while assigned(p) do
-               begin
-                  if equal_paras(p^.def.para,propertyparas,cp_value_equal_const) or
-                     convertable_paras(p^.def.para,propertyparas,cp_value_equal_const) then
-                    begin
-                      get_procdef:=p^.def;
-                      exit;
-                    end;
-                  p:=p^.next;
-               end;
-          end;}
-
-        var
-           hp2,datacoll : tparaitem;
            p : tpropertysym;
            overriden : tsym;
            hs : string;
@@ -238,6 +215,9 @@ implementation
            dummyst : tparasymtable;
            vs : tvarsym;
            sc : tsinglelist;
+           oldregisterdef : boolean;
+           temppara : tparaitem;
+           propertyprocdef : tprocvardef;
         begin
            { check for a class }
            aktprocsym:=nil;
@@ -246,8 +226,10 @@ implementation
               ((m_delphi in aktmodeswitches) and (is_object(aktclass)))) then
              Message(parser_e_syntax_error);
            consume(_PROPERTY);
-           propertyparas:=TParaLinkedList.Create;
-           datacoll:=nil;
+           oldregisterdef:=registerdef;
+           registerdef:=false;
+           propertyprocdef:=tprocvardef.create;
+           registerdef:=oldregisterdef;
            if token=_ID then
              begin
                 p:=tpropertysym.create(orgpattern);
@@ -259,8 +241,7 @@ implementation
                      if (sp_published in current_object_option) then
                        Message(parser_e_cant_publish_that_property);
 
-                     { create a list of the parameters in propertyparas }
-
+                     { create a list of the parameters }
                      dummyst:=tparasymtable.create;
                      dummyst.next:=symtablestack;
                      symtablestack:=dummyst;
@@ -313,10 +294,7 @@ implementation
                        vs:=tvarsym(sc.first);
                        while assigned(vs) do
                         begin
-                          hp2:=TParaItem.create;
-                          hp2.paratyp:=varspez;
-                          hp2.paratype:=tt;
-                          propertyparas.insert(hp2);
+                          propertyprocdef.concatpara(nil,tt,nil,varspez,nil);
                           vs:=tvarsym(vs.listnext);
                         end;
                      until not try_to_consume(_SEMICOLON);
@@ -330,12 +308,12 @@ implementation
 
                      { the parser need to know if a property has parameters, the
                        index parameter doesn't count (PFV) }
-                     if not(propertyparas.empty) then
+                     if propertyprocdef.minparacount>0 then
                        include(p.propoptions,ppo_hasparameters);
                   end;
                 { overriden property ?                                 }
                 { force property interface, if there is a property parameter }
-                if (token=_COLON) or not(propertyparas.empty) then
+                if (token=_COLON) or (propertyprocdef.minparacount>0) then
                   begin
                      consume(_COLON);
                      single_type(p.proptype,hs,false);
@@ -355,10 +333,7 @@ implementation
                           p.indextype.setdef(pt.resulttype.def);
                           include(p.propoptions,ppo_indexed);
                           { concat a longint to the para template }
-                          hp2:=TParaItem.Create;
-                          hp2.paratyp:=vs_value;
-                          hp2.paratype:=p.indextype;
-                          propertyparas.insert(hp2);
+                          propertyprocdef.concatpara(nil,p.indextype,nil,vs_value,nil);
                           pt.free;
                        end;
                   end
@@ -380,11 +355,6 @@ implementation
                    not(p.proptype.def.is_publishable) then
                   Message(parser_e_cant_publish_that_property);
 
-                { create data defcoll to allow correct parameter checks }
-                datacoll:=TParaItem.Create;
-                datacoll.paratyp:=vs_value;
-                datacoll.paratype:=p.proptype;
-
                 if try_to_consume(_READ) then
                  begin
                    p.readaccess.clear;
@@ -394,7 +364,7 @@ implementation
                       case sym.typ of
                         procsym :
                           begin
-                            pd:=Tprocsym(sym).search_procdef_bypara(propertyparas,true,false);
+                            pd:=Tprocsym(sym).search_procdef_bypara(propertyprocdef.para,true,false);
                             if not(assigned(pd)) or
                                not(equal_defs(pd.rettype.def,p.proptype.def)) then
                               Message(parser_e_ill_property_access_sym);
@@ -430,10 +400,10 @@ implementation
                         procsym :
                           begin
                             { insert data entry to check access method }
-                            propertyparas.insert(datacoll);
-                            pd:=Tprocsym(sym).search_procdef_bypara(propertyparas,true,false);
+                            temppara:=propertyprocdef.concatpara(nil,p.proptype,nil,vs_value,nil);
+                            pd:=Tprocsym(sym).search_procdef_bypara(propertyprocdef.para,true,false);
                             { ... and remove it }
-                            propertyparas.remove(datacoll);
+                            propertyprocdef.removepara(temppara);
                             if not(assigned(pd)) then
                               Message(parser_e_ill_property_access_sym);
                             p.writeaccess.setdef(pd);
@@ -551,21 +521,18 @@ implementation
                      }
                        begin
                           include(p.propoptions,ppo_defaultproperty);
-                          if propertyparas.empty then
+                          if propertyprocdef.maxparacount=0 then
                             message(parser_e_property_need_paras);
                        end;
                      consume(_SEMICOLON);
                   end;
-                { clean up }
-                if assigned(datacoll) then
-                  datacoll.free;
              end
            else
              begin
                 consume(_ID);
                 consume(_SEMICOLON);
              end;
-           propertyparas.free;
+           propertyprocdef.free;
         end;
 
 
@@ -1172,7 +1139,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.58  2003-01-09 21:52:37  peter
+  Revision 1.59  2003-04-10 17:57:52  peter
+    * vs_hidden released
+
+  Revision 1.58  2003/01/09 21:52:37  peter
     * merged some verbosity options.
     * V_LineInfo is a verbosity flag to include line info
 

compiler/pdecsub.pas

@@ -41,6 +41,7 @@ interface
 
     function  is_proc_directive(tok:ttoken):boolean;
 
+    procedure insert_hidden_para(pd:tabstractprocdef);
     procedure check_self_para(aktprocdef:tabstractprocdef);
     procedure parameter_dec(aktprocdef:tabstractprocdef);
 
@@ -87,6 +88,48 @@ implementation
        ;
 
 
+    procedure insert_hidden_para(pd:tabstractprocdef);
+      var
+        currpara : tparaitem;
+        hvs : tvarsym;
+      begin
+        { walk from right to left, so we can insert the
+          high parameters after the current parameter }
+        currpara:=tparaitem(pd.para.last);
+        while assigned(currpara) do
+         begin
+           { need high parameter ? }
+           if paramanager.push_high_param(currpara.paratype.def,pd.proccalloption) then
+            begin
+              if assigned(currpara.parasym) then
+               begin
+                 hvs:=tvarsym.create('$high'+tvarsym(currpara.parasym).name,s32bittype);
+                 hvs.varspez:=vs_const;
+                 include(hvs.varoptions,vo_is_high_value);
+                 tvarsym(currpara.parasym).owner.insert(hvs);
+                 tvarsym(currpara.parasym).highvarsym:=hvs;
+               end
+              else
+               hvs:=nil;
+              pd.concatpara(currpara,s32bittype,hvs,vs_hidden,nil);
+            end
+           else
+            begin
+              { Give a warning that cdecl routines does not include high()
+                support }
+              if (pd.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
+                 paramanager.push_high_param(currpara.paratype.def,pocall_fpccall) then
+               begin
+                 if is_open_string(currpara.paratype.def) then
+                    Message(parser_w_cdecl_no_openstring);
+                 Message(parser_w_cdecl_has_no_high);
+               end;
+            end;
+           currpara:=tparaitem(currpara.previous);
+         end;
+      end;
+
+
     procedure checkvaluepara(p:tnamedindexitem;arg:pointer);
       begin
         if tsym(p).typ<>varsym then
@@ -106,7 +149,7 @@ implementation
       end;
 
 
-    procedure checkparatype(p:tnamedindexitem;arg:pointer);
+    procedure check_c_para(p:tnamedindexitem;arg:pointer);
       begin
         if (tsym(p).typ<>varsym) then
          exit;
@@ -121,35 +164,12 @@ implementation
                     if (varspez<>vs_var) then
                       Message(parser_h_c_arrays_are_references);
                   end;
-                 if is_array_of_const(vartype.def) or
-                    is_open_array(vartype.def) then
-                  begin
-                    if assigned(highvarsym) then
-                     begin
-                       Message(parser_w_cdecl_has_no_high);
-                       { removing it is too complicated, we just hide it PM }
-                       owner.rename(highvarsym.name,'hidden'+copy(highvarsym.name,5,length(highvarsym.name)));
-                     end;
-                  end;
                  if is_array_of_const(vartype.def) and
                     assigned(indexnext) and
                     (tsym(indexnext).typ=varsym) and
                     not(vo_is_high_value in tvarsym(indexnext).varoptions) then
                    Message(parser_e_C_array_of_const_must_be_last);
                end;
-             stringdef :
-               begin
-                 if is_open_string(vartype.def) then
-                  begin
-                    Message(parser_w_cdecl_no_openstring);
-                    if assigned(highvarsym) then
-                     begin
-                       Message(parser_w_cdecl_has_no_high);
-                       { removing it is too complicated, we just hide it PM }
-                       owner.rename(highvarsym.name,'hidden'+copy(highvarsym.name,5,high(name)));
-                     end;
-                  end;
-               end;
             end;
          end;
       end;
@@ -190,13 +210,11 @@ implementation
         sc      : tsinglelist;
         tt      : ttype;
         arrayelementtype : ttype;
-        hvs,
         vs      : tvarsym;
         srsym   : tsym;
         hs1 : string;
         varspez : Tvarspez;
         hpara      : tparaitem;
-        inserthigh : boolean;
         tdefaultvalue : tconstsym;
         defaultrequired : boolean;
         old_object_option : tsymoptions;
@@ -242,151 +260,122 @@ implementation
               end
           else
               varspez:=vs_value;
-          inserthigh:=false;
           tdefaultvalue:=nil;
           tt.reset;
-            begin
-             { read identifiers and insert with error type }
-               sc.reset;
-               repeat
-                 vs:=tvarsym.create(orgpattern,generrortype);
-                 currparast.insert(vs);
-                 if assigned(vs.owner) then
-                  sc.insert(vs)
-                 else
-                  vs.free;
-                 consume(_ID);
-               until not try_to_consume(_COMMA);
-             { read type declaration, force reading for value and const paras }
-               if (token=_COLON) or (varspez=vs_value) then
-                begin
-                  consume(_COLON);
-                { check for an open array }
-                  if token=_ARRAY then
-                   begin
-                     consume(_ARRAY);
-                     consume(_OF);
-                   { define range and type of range }
-                     tt.setdef(tarraydef.create(0,-1,s32bittype));
-                   { array of const ? }
-                     if (token=_CONST) and (m_objpas in aktmodeswitches) then
-                      begin
-                        consume(_CONST);
-                        srsym:=searchsymonlyin(systemunit,'TVARREC');
-                        if not assigned(srsym) then
-                         InternalError(1234124);
-                        tarraydef(tt.def).setelementtype(ttypesym(srsym).restype);
-                        tarraydef(tt.def).IsArrayOfConst:=true;
-                      end
-                     else
-                      begin
-                        { define field type }
-                        single_type(arrayelementtype,hs1,false);
-                        tarraydef(tt.def).setelementtype(arrayelementtype);
-                      end;
-                     inserthigh:=true;
-                   end
-                  else
-                   begin
-                     { open string ? }
-                     if (varspez=vs_var) and
-                             (
-                               (
-                                 ((token=_STRING) or (idtoken=_SHORTSTRING)) and
-                                 (cs_openstring in aktmoduleswitches) and
-                                 not(cs_ansistrings in aktlocalswitches)
-                               ) or
-                             (idtoken=_OPENSTRING)) then
-                      begin
-                        consume(token);
-                        tt:=openshortstringtype;
-                        hs1:='openstring';
-                        inserthigh:=true;
-                      end
-                     else
-                      begin
-                        { everything else }
-                        single_type(tt,hs1,false);
-                      end;
-
-                     { default parameter }
-                     if (m_default_para in aktmodeswitches) then
-                      begin
-                        if try_to_consume(_EQUAL) then
-                         begin
-                           vs:=tvarsym(sc.first);
-                           if assigned(vs.listnext) then
-                             Message(parser_e_default_value_only_one_para);
-                           { prefix 'def' to the parameter name }
-                           tdefaultvalue:=ReadConstant('$def'+vs.name,vs.fileinfo);
-                           if assigned(tdefaultvalue) then
-                            tprocdef(aktprocdef).parast.insert(tdefaultvalue);
-                           defaultrequired:=true;
-                         end
-                        else
-                         begin
-                           if defaultrequired then
-                             Message1(parser_e_default_value_expected_for_para,vs.name);
-                         end;
-                      end;
-                   end;
-                end
-               else
-                begin
+          { read identifiers and insert with error type }
+          sc.reset;
+          repeat
+            vs:=tvarsym.create(orgpattern,generrortype);
+            currparast.insert(vs);
+            if assigned(vs.owner) then
+             sc.insert(vs)
+            else
+             vs.free;
+            consume(_ID);
+          until not try_to_consume(_COMMA);
+          { read type declaration, force reading for value and const paras }
+          if (token=_COLON) or (varspez=vs_value) then
+           begin
+             consume(_COLON);
+             { check for an open array }
+             if token=_ARRAY then
+              begin
+                consume(_ARRAY);
+                consume(_OF);
+                { define range and type of range }
+                tt.setdef(tarraydef.create(0,-1,s32bittype));
+                { array of const ? }
+                if (token=_CONST) and (m_objpas in aktmodeswitches) then
+                 begin
+                   consume(_CONST);
+                   srsym:=searchsymonlyin(systemunit,'TVARREC');
+                   if not assigned(srsym) then
+                    InternalError(1234124);
+                   tarraydef(tt.def).setelementtype(ttypesym(srsym).restype);
+                   tarraydef(tt.def).IsArrayOfConst:=true;
+                 end
+                else
+                 begin
+                   { define field type }
+                   single_type(arrayelementtype,hs1,false);
+                   tarraydef(tt.def).setelementtype(arrayelementtype);
+                 end;
+              end
+             else
+              begin
+                { open string ? }
+                if (varspez=vs_var) and
+                        (
+                          (
+                            ((token=_STRING) or (idtoken=_SHORTSTRING)) and
+                            (cs_openstring in aktmoduleswitches) and
+                            not(cs_ansistrings in aktlocalswitches)
+                          ) or
+                        (idtoken=_OPENSTRING)) then
+                 begin
+                   consume(token);
+                   tt:=openshortstringtype;
+                   hs1:='openstring';
+                 end
+                else
+                 begin
+                   { everything else }
+                   single_type(tt,hs1,false);
+                 end;
+
+                { default parameter }
+                if (m_default_para in aktmodeswitches) then
+                 begin
+                   if try_to_consume(_EQUAL) then
+                    begin
+                      vs:=tvarsym(sc.first);
+                      if assigned(vs.listnext) then
+                        Message(parser_e_default_value_only_one_para);
+                      { prefix 'def' to the parameter name }
+                      tdefaultvalue:=ReadConstant('$def'+vs.name,vs.fileinfo);
+                      if assigned(tdefaultvalue) then
+                       tprocdef(aktprocdef).parast.insert(tdefaultvalue);
+                      defaultrequired:=true;
+                    end
+                   else
+                    begin
+                      if defaultrequired then
+                        Message1(parser_e_default_value_expected_for_para,vs.name);
+                    end;
+                 end;
+              end;
+           end
+          else
+           begin
 {$ifndef UseNiceNames}
-                  hs1:='$$$';
+             hs1:='$$$';
 {$else UseNiceNames}
-                  hs1:='var';
+             hs1:='var';
 {$endif UseNiceNames}
-                  tt:=cformaltype;
-                end;
+             tt:=cformaltype;
+           end;
 
-               { For proc vars we only need the definitions }
-               if not is_procvar then
-                begin
-                  vs:=tvarsym(sc.first);
-                  while assigned(vs) do
-                   begin
-                     { update varsym }
-                     vs.vartype:=tt;
-                     vs.varspez:=varspez;
-                     if (varspez in [vs_var,vs_const,vs_out]) and
-                        paramanager.push_addr_param(tt.def,aktprocdef.proccalloption) then
-                       include(vs.varoptions,vo_regable);
-
-                     { also need to push a high value? }
-                     if inserthigh then
-                      begin
-                        hvs:=tvarsym.create('$high'+vs.name,s32bittype);
-                        hvs.varspez:=vs_const;
-                        include(hvs.varoptions,vo_is_high_value);
-{$ifdef vs_hidden}
-                        aktprocdef.concatpara(s32bittype,hvs,vs_hidden,nil);
-{$endif vs_hidden}
-                        currparast.insert(hvs);
-                        vs.highvarsym:=hvs;
-                      end;
-                     hpara:=aktprocdef.concatpara(tt,vs,varspez,tdefaultvalue);
-                     if vs.name='SELF' then
-                      aktprocdef.selfpara:=hpara;
-                     vs:=tvarsym(vs.listnext);
-                   end;
-                end
-               else
-                begin
-                  vs:=tvarsym(sc.first);
-                  while assigned(vs) do
-                   begin
-                     { don't insert a parasym, the varsyms will be
-                       disposed }
-                     hpara:=aktprocdef.concatpara(tt,nil,varspez,tdefaultvalue);
-                     if vs.name='SELF' then
-                      aktprocdef.selfpara:=hpara;
-                     vs:=tvarsym(vs.listnext);
-                   end;
-                end;
-            end;
-          { set the new mangled name }
+          vs:=tvarsym(sc.first);
+          while assigned(vs) do
+           begin
+             { update varsym }
+             vs.vartype:=tt;
+             vs.varspez:=varspez;
+             { For proc vars we only need the definitions }
+             if not is_procvar then
+              begin
+                if (varspez in [vs_var,vs_const,vs_out]) and
+                   paramanager.push_addr_param(tt.def,aktprocdef.proccalloption) then
+                  include(vs.varoptions,vo_regable);
+                hpara:=aktprocdef.concatpara(nil,tt,vs,varspez,tdefaultvalue);
+              end
+             else
+              hpara:=aktprocdef.concatpara(nil,tt,nil,varspez,tdefaultvalue);
+             { save position of self parameter }
+             if vs.name='SELF' then
+              aktprocdef.selfpara:=hpara;
+             vs:=tvarsym(vs.listnext);
+           end;
         until not try_to_consume(_SEMICOLON);
         { remove parasymtable from stack }
         if is_procvar then
@@ -1594,9 +1583,6 @@ const
         { set the default calling convention }
         if def.proccalloption=pocall_none then
           def.proccalloption:=aktdefproccall;
-        { generate symbol names for local copies }
-        if (def.deftype=procdef) then
-          tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkvaluepara,nil);
         { handle proccall specific settings }
         case def.proccalloption of
           pocall_cdecl :
@@ -1617,7 +1603,7 @@ const
                  if not assigned(tprocdef(def).parast) then
                   internalerror(200110234);
                  { check C cdecl para types }
-                 tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkparatype,nil);
+                 tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_c_para,nil);
                  { Adjust alignment to match cdecl or stdcall }
                  tprocdef(def).parast.dataalignment:=std_param_align;
                end;
@@ -1637,7 +1623,7 @@ const
                  if not assigned(tprocdef(def).parast) then
                   internalerror(200110235);
                  { check C cdecl para types }
-                 tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkparatype,nil);
+                 tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_c_para,nil);
                  { Adjust alignment to match cdecl or stdcall }
                  tprocdef(def).parast.dataalignment:=std_param_align;
                end;
@@ -1709,6 +1695,14 @@ const
             end;
         end;
 
+        { insert hidden high parameters }
+        insert_hidden_para(def);
+
+        { insert local valXXX value parameters }
+        if (def.deftype=procdef) then
+          tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkvaluepara,nil);
+
+
         { add mangledname to external list }
         if (def.deftype=procdef) and
            (po_external in def.procoptions) and
@@ -1733,13 +1727,8 @@ const
               ps:=tsym(st.symindex.first);
               while assigned(ps.indexnext) and (tsym(ps.indexnext)<>lastps) do
                 ps:=tsym(ps.indexnext);
-              if (ps.typ=varsym) and
-                 not(vo_is_high_value in tvarsym(ps).varoptions) then
-               begin
-                 st.insertvardata(ps);
-                 if assigned(tvarsym(ps).highvarsym) then
-                   st.insertvardata(tvarsym(ps).highvarsym);
-               end;
+              if (ps.typ=varsym) then
+                st.insertvardata(ps);
               lastps:=ps;
             end;
          end
@@ -2143,7 +2132,10 @@ const
 end.
 {
   $Log$
-  Revision 1.110  2003-03-28 19:16:56  peter
+  Revision 1.111  2003-04-10 17:57:53  peter
+    * vs_hidden released
+
+  Revision 1.110  2003/03/28 19:16:56  peter
     * generic constructor working for i386
     * remove fixed self register
     * esi added as address register for i386

compiler/ppu.pas

@@ -41,7 +41,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion=31;
+  CurrentPPUVersion=32;
 
 { buffer sizes }
   maxentrysize = 1024;
@@ -985,7 +985,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.30  2003-03-17 15:54:22  peter
+  Revision 1.31  2003-04-10 17:57:53  peter
+    * vs_hidden released
+
+  Revision 1.30  2003/03/17 15:54:22  peter
     * store symoptions also for procdef
     * check symoptions (private,public) when calculating possible
       overload candidates

compiler/symdef.pas

@@ -98,22 +98,16 @@ interface
        end;
 
        tparaitem = class(TLinkedListItem)
-          paratype     : ttype;
+          paratype     : ttype; { required for procvar }
           parasym      : tsym;
           defaultvalue : tsym; { tconstsym }
-          paratyp      : tvarspez;
+          paratyp      : tvarspez; { required for procvar }
           paraloc      : tparalocation;
 {$ifdef EXTDEBUG}
           eqval        : tequaltype;
 {$endif EXTDEBUG}
        end;
 
-       { this is only here to override the count method,
-         which can't be used }
-       tparalinkedlist = class(tlinkedlist)
-          function count:longint;
-       end;
-
        tfiletyp = (ft_text,ft_typed,ft_untyped);
 
        tfiledef = class(tstoreddef)
@@ -419,7 +413,7 @@ interface
        tabstractprocdef = class(tstoreddef)
           { saves a definition to the return type }
           rettype         : ttype;
-          para            : tparalinkedlist;
+          para            : tlinkedlist;
           selfpara        : tparaitem;
           proctypeoption  : tproctypeoption;
           proccalloption  : tproccalloption;
@@ -433,7 +427,8 @@ interface
           destructor destroy;override;
           procedure  ppuwrite(ppufile:tcompilerppufile);override;
           procedure deref;override;
-          function  concatpara(const tt:ttype;sym : tsym;vsp : tvarspez;defval:tsym):tparaitem;
+          function  concatpara(afterpara:tparaitem;const tt:ttype;sym : tsym;vsp : tvarspez;defval:tsym):tparaitem;
+          procedure removepara(currpara:tparaitem);
           function  para_size(alignsize:longint) : longint;
           function  typename_paras : string;
           procedure test_if_fpu_result;
@@ -1190,19 +1185,6 @@ implementation
 
 
 
-{****************************************************************************
-                                TPARALINKEDLIST
-****************************************************************************}
-
-    function tparalinkedlist.count:longint;
-      begin
-        { You must use tabstractprocdef.minparacount and .maxparacount instead }
-        internalerror(432432978);
-        count:=0;
-      end;
-
-
-
 {****************************************************************************
                                Tstringdef
 ****************************************************************************}
@@ -3073,7 +3055,7 @@ implementation
     constructor tabstractprocdef.create;
       begin
          inherited create;
-         para:=TParaLinkedList.Create;
+         para:=TLinkedList.Create;
          selfpara:=nil;
          minparacount:=0;
          maxparacount:=0;
@@ -3094,7 +3076,7 @@ implementation
       end;
 
 
-    function tabstractprocdef.concatpara(const tt:ttype;sym : tsym;vsp : tvarspez;defval:tsym):tparaitem;
+    function tabstractprocdef.concatpara(afterpara:tparaitem;const tt:ttype;sym : tsym;vsp : tvarspez;defval:tsym):tparaitem;
       var
         hp : TParaItem;
       begin
@@ -3103,7 +3085,11 @@ implementation
         hp.parasym:=sym;
         hp.paratype:=tt;
         hp.defaultvalue:=defval;
-        Para.insert(hp);
+        { Parameters are stored from left to right }
+        if assigned(afterpara) then
+          Para.insertafter(hp,afterpara)
+        else
+          Para.concat(hp);
         { Don't count hidden parameters }
         if (vsp<>vs_hidden) then
          begin
@@ -3115,6 +3101,18 @@ implementation
       end;
 
 
+    procedure tabstractprocdef.removepara(currpara:tparaitem);
+      begin
+        { Don't count hidden parameters }
+        if (currpara.paratyp<>vs_hidden) then
+         begin
+           if not assigned(currpara.defaultvalue) then
+            dec(minparacount);
+           dec(maxparacount);
+         end;
+        Para.Remove(currpara);
+        currpara.free;
+      end;
 
 
     { all functions returning in FPU are
@@ -3152,7 +3150,7 @@ implementation
          count,i : word;
       begin
          inherited ppuloaddef(ppufile);
-         Para:=TParaLinkedList.Create;
+         Para:=TLinkedList.Create;
          selfpara:=nil;
          minparacount:=0;
          maxparacount:=0;
@@ -3168,7 +3166,6 @@ implementation
           begin
             hp:=TParaItem.Create;
             hp.paratyp:=tvarspez(ppufile.getbyte);
-            { hp.register:=tregister(ppufile.getbyte); }
             ppufile.gettype(hp.paratype);
             hp.defaultvalue:=tsym(ppufile.getderef);
             hp.parasym:=tsym(ppufile.getderef);
@@ -3181,6 +3178,7 @@ implementation
                 inc(minparacount);
                inc(maxparacount);
              end;
+            { Parameters are stored left to right in both ppu and memory }
             Para.concat(hp);
           end;
       end;
@@ -3202,12 +3200,12 @@ implementation
          ppufile.putbyte(ord(proccalloption));
          ppufile.putsmallset(procoptions);
          ppufile.do_interface_crc:=oldintfcrc;
-         ppufile.putbyte(maxparacount);
+         { we need to store the count including vs_hidden }
+         ppufile.putbyte(para.count);
          hp:=TParaItem(Para.first);
          while assigned(hp) do
           begin
             ppufile.putbyte(byte(hp.paratyp));
-            { ppufile.putbyte(byte(hp.register)); }
             ppufile.puttype(hp.paratype);
             ppufile.putderef(hp.defaultvalue);
             ppufile.putderef(hp.parasym);
@@ -3247,31 +3245,18 @@ implementation
         hp : TParaItem;
         hpc : tconstsym;
       begin
-        { look for a visible parameter }
-        hp:=TParaItem(Para.last);
-        while assigned(hp) do
-          begin
-            if hp.paratyp<>vs_hidden then
-              break;
-            hp:=TParaItem(hp.previous);
-          end;
-        { no visible parameter? }
-        if not(assigned(hp)) then
-          begin
-             typename_paras:='';
-             exit;
-          end;
-
-        hp:=TParaItem(Para.last);
+        hp:=TParaItem(Para.first);
         s:='(';
         while assigned(hp) do
          begin
-           if hp.paratyp=vs_var then
-             s:=s+'var'
-           else if hp.paratyp=vs_const then
-             s:=s+'const'
-           else if hp.paratyp=vs_out then
-             s:=s+'out';
+           case hp.paratyp of
+             vs_var :
+               s:=s+'var';
+             vs_const :
+               s:=s+'const';
+             vs_out :
+               s:=s+'out';
+           end;
            if hp.paratyp<>vs_hidden then
              begin
                if assigned(hp.paratype.def.typesym) then
@@ -3316,15 +3301,18 @@ implementation
                   if hs<>'' then
                    s:=s+'="'+hs+'"';
                 end;
+               if assigned(hp.next) then
+                s:=s+',';
              end;
-           hp:=TParaItem(hp.previous);
-           if assigned(hp) and (hp.paratyp<>vs_hidden) then
-            s:=s+',';
+           hp:=TParaItem(hp.next);
          end;
         s:=s+')';
         if (po_varargs in procoptions) then
          s:=s+';VarArgs';
-        typename_paras:=s;
+        if s='()' then
+         typename_paras:=''
+        else
+         typename_paras:=s;
       end;
 
 
@@ -3992,16 +3980,12 @@ implementation
         if overloadnumber>0 then
          s:=s+'$'+tostr(overloadnumber);
         { add parameter types }
-        hp:=TParaItem(Para.last);
-        if assigned(hp) and (hp.paratyp<>vs_hidden) then
-          s:=s+'$';
+        hp:=TParaItem(Para.first);
         while assigned(hp) do
          begin
            if hp.paratyp<>vs_hidden then
-             s:=s+hp.paratype.def.mangledparaname;
-           hp:=TParaItem(hp.previous);
-           if assigned(hp) and (hp.paratyp<>vs_hidden) then
-             s:=s+'$';
+             s:=s+'$'+hp.paratype.def.mangledparaname;
+           hp:=TParaItem(hp.next);
          end;
         _mangledname:=stringdup(s);
         mangledname:=_mangledname^;
@@ -4213,9 +4197,9 @@ implementation
              { write parameter info. The parameters must be written in reverse order
                if this method uses right to left parameter pushing! }
              if (po_leftright in procoptions) then
-              pdc:=TParaItem(Para.last)
+              pdc:=TParaItem(Para.first)
              else
-              pdc:=TParaItem(Para.first);
+              pdc:=TParaItem(Para.last);
              while assigned(pdc) do
                begin
                  case pdc.paratyp of
@@ -4233,9 +4217,9 @@ implementation
                  tstoreddef(pdc.paratype.def).write_rtti_name;
 
                  if (po_leftright in procoptions) then
-                  pdc:=TParaItem(pdc.previous)
+                  pdc:=TParaItem(pdc.next)
                  else
-                  pdc:=TParaItem(pdc.next);
+                  pdc:=TParaItem(pdc.previous);
                end;
 
              { write name of result type }
@@ -5725,7 +5709,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.132  2003-03-18 16:25:50  peter
+  Revision 1.133  2003-04-10 17:57:53  peter
+    * vs_hidden released
+
+  Revision 1.132  2003/03/18 16:25:50  peter
     * no itnernalerror for errordef.concatstabto()
 
   Revision 1.131  2003/03/17 16:54:41  peter

compiler/symsym.pas

@@ -137,7 +137,7 @@ interface
           function last_procdef:Tprocdef;
           function search_procdef_nopara_boolret:Tprocdef;
           function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
-          function search_procdef_bypara(params:Tparalinkedlist;
+          function search_procdef_bypara(params:Tlinkedlist;
                                          allowconvert,
                                          allowdefault:boolean):Tprocdef;
           function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
@@ -1025,7 +1025,7 @@ implementation
       end;
 
 
-    function Tprocsym.search_procdef_bypara(params:Tparalinkedlist;
+    function Tprocsym.search_procdef_bypara(params:Tlinkedlist;
                                             allowconvert,
                                             allowdefault:boolean):Tprocdef;
       var
@@ -2563,7 +2563,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.94  2003-03-17 15:54:22  peter
+  Revision 1.95  2003-04-10 17:57:53  peter
+    * vs_hidden released
+
+  Revision 1.94  2003/03/17 15:54:22  peter
     * store symoptions also for procdef
     * check symoptions (private,public) when calculating possible
       overload candidates

compiler/utils/ppudump.pp

@@ -160,6 +160,17 @@ begin
 end;
 
 
+Function Varspez2Str(w:longint):string;
+const
+  varspezstr : array[0..4] of string[6]=('Value','Const','Var','Out','Hidden');
+begin
+  if w<=ord(high(varspezstr)) then
+    Varspez2Str:=varspezstr[w]
+  else
+    Varspez2Str:='<Unknown>';
+end;
+
+
 function PPUFlags2Str(flags:longint):string;
 type
   tflagopt=record
@@ -714,7 +725,6 @@ const
      (mask:po_clearstack;      str:'ClearStack'),
      (mask:po_internconst;     str:'InternConst')
   );
-  tvarspez : array[0..3] of string[5]=('Value','Const','Var  ','Out  ');
 var
   proctypeoption  : tproctypeoption;
   proccalloption  : tproccalloption;
@@ -731,7 +741,7 @@ begin
    begin
      write(space,'       TypeOption : ');
      first:=true;
-     for i:=1to proctypeopts do
+     for i:=1 to proctypeopts do
       if (proctypeopt[i].mask=proctypeoption) then
        begin
          if first then
@@ -763,20 +773,19 @@ begin
    end;
   params:=ppufile.getbyte;
   writeln(space,' Nr of parameters : ',params);
-  if params>0 then
+  for i:=1 to params do
    begin
-     repeat
-       write(space,'  - ',tvarspez[ppufile.getbyte],' : ');
-       readtype;
-       write(space,'    Default : ');
-       readsymref;
-       write(space,'    Symbol  : ');
-       readsymref;
-       write(space,'   Location : ');
-       writeln('<not yet implemented>');
-       ppufile.getdata(paraloc,sizeof(paraloc));
-       dec(params);
-     until params=0;
+     writeln(space,' - Parameter ',i);
+     writeln(space,'       Spez : ',Varspez2Str(ppufile.getbyte));
+     write  (space,'       Type : ');
+     readtype;
+     write  (space,'    Default : ');
+     readsymref;
+     write  (space,'     Symbol : ');
+     readsymref;
+     write  (space,'   Location : ');
+     writeln('<not yet implemented>');
+     ppufile.getdata(paraloc,sizeof(paraloc));
    end;
 end;
 
@@ -993,7 +1002,7 @@ begin
          ibvarsym :
            begin
              readcommonsym('Variable symbol ');
-             writeln(space,'        Type: ',getbyte);
+             writeln(space,'        Spez: ',Varspez2Str(getbyte));
              writeln(space,'     Address: ',getlongint);
              write  (space,'    Var Type: ');
              readtype;
@@ -1929,7 +1938,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.37  2003-03-24 19:57:54  hajny
+  Revision 1.38  2003-04-10 17:57:53  peter
+    * vs_hidden released
+
+  Revision 1.37  2003/03/24 19:57:54  hajny
     + emx target added
 
   Revision 1.36  2003/03/17 15:54:22  peter