* tparaitem removed, use tparavarsym instead

  * parameter order is now calculated from paranr value in tparavarsym

compiler/browcol.pas

@@ -1243,27 +1243,28 @@ end;
   end;
   function GetAbsProcParmDefStr(def: tabstractprocdef): string;
   var Name: string;
-      dc: tparaitem;
+      dc: tparavarsym;
+      i,
       Count: integer;
       CurName: string;
   begin
     Name:='';
-    dc:=tparaitem(def.para.first);
     Count:=0;
-    while assigned(dc) do
+    for i:=0 to def.paras.count-1 do
      begin
-       CurName:='';
-       case dc.paratyp of
+       dc:=tparavarsym(def.paras[i]);
+       if i=0 then
+         CurName:=''
+       else
+         CurName:=', '+CurName;
+       case dc.varspez of
          vs_Value : ;
          vs_Const : CurName:=CurName+'const ';
          vs_Var   : CurName:=CurName+'var ';
        end;
-       if assigned(dc.paratype.def) then
-         CurName:=CurName+GetDefinitionStr(dc.paratype.def);
-       if dc.next<>nil then
-         CurName:=', '+CurName;
+       if assigned(dc.vartype.def) then
+         CurName:=CurName+GetDefinitionStr(dc.vartype.def);
        Name:=CurName+Name;
-       dc:=tparaitem(dc.next);
        Inc(Count);
      end;
     GetAbsProcParmDefStr:=Name;
@@ -2143,7 +2144,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.41  2004-11-09 16:46:05  peter
+  Revision 1.42  2004-11-15 23:35:30  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.41  2004/11/09 16:46:05  peter
     * fixed compile
 
   Revision 1.40  2004/10/14 16:53:26  mazen

compiler/cclasses.pas

@@ -452,9 +452,6 @@ end;
 
 
 procedure TList.SetCapacity(NewCapacity: Integer);
-
-Var NewList,ToFree : PPointerList;
-
 begin
    If (NewCapacity<0) or (NewCapacity>MaxListSize) then
       Error (SListCapacityError,NewCapacity);
@@ -516,15 +513,10 @@ end;
 
 
 Procedure TList.Delete(Index: Integer);
-
-Var
-   OldPointer :Pointer;
-
 begin
    If (Index<0) or (Index>=FCount) then
      Error (SListIndexError,Index);
    FCount:=FCount-1;
-   OldPointer:=Flist^[Index];
    System.Move (FList^[Index+1],FList^[Index],(FCount-Index)*SizeOf(Pointer));
    // Shrink the list if appropiate
    if (FCapacity > 256) and (FCount < FCapacity shr 2) then
@@ -536,12 +528,17 @@ end;
 
 
 class procedure TList.Error(const Msg: string; Data: Integer);
-  var
-   s:string;
-   p:longint;
+{$ifdef EXTDEBUG}
+var
+  s : string;
+{$endif EXTDEBUG}
 begin
-   p:=pos('%d',Msg);
-   writeln(copy(Msg,1,pred(p)),Data,copy(Msg,p+3,255));
+{$ifdef EXTDEBUG}
+  s:=Msg;
+  Replace(s,'%d',ToStr(Data));
+  writeln(s);
+{$endif EXTDEBUG}
+  internalerrorproc(200411151);
 end;
 
 procedure TList.Exchange(Index1, Index2: Integer);
@@ -2348,7 +2345,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.38  2004-10-15 09:14:16  mazen
+  Revision 1.39  2004-11-15 23:35:30  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.38  2004/10/15 09:14:16  mazen
   - remove $IFDEF DELPHI and related code
   - remove $IFDEF FPCPROCVAR and related code
 

compiler/cutils.pas

@@ -39,6 +39,8 @@ interface
        get_var_value_proc=function(const s:string):string of object;
        Tcharset=set of char;
 
+    var
+      internalerrorproc : procedure(i:longint);
 
     {# Returns the minimal value between @var(a) and @var(b) }
     function min(a,b : longint) : longint;{$ifdef USEINLINE}inline;{$endif}
@@ -138,6 +140,7 @@ interface
     function minilzw_encode(const s:string):string;
     function minilzw_decode(const s:string):string;
 
+
 implementation
 
 uses
@@ -938,7 +941,7 @@ uses
                  until s[i]='}';
                  varvalues[varcounter]:=Pstring(varptr);
                  if varptr>@varvaluedata+maxdata then
-                   runerror($8001); {No internalerror available}
+                   internalerrorproc(200411152);
                  Pstring(varptr)^:=get_var_value(varname);
                  inc(len,length(Pstring(varptr)^));
                  inc(varptr,length(Pstring(varptr)^)+1);
@@ -1246,13 +1249,26 @@ uses
         end;
     end;
 
+
+    procedure defaulterror(i:longint);
+      begin
+        writeln('Internal error ',i);
+        runerror(255);
+      end;
+
+
 initialization
+  internalerrorproc:=@defaulterror;
   makecrc32tbl;
   initupperlower;
 end.
 {
   $Log$
-  Revision 1.46  2004-10-15 09:14:16  mazen
+  Revision 1.47  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.46  2004/10/15 09:14:16  mazen
   - remove $IFDEF DELPHI and related code
   - remove $IFDEF FPCPROCVAR and related code
 

compiler/defcmp.pas

@@ -106,7 +106,7 @@ interface
       search for a routine with default parameters, before
       searching for the same definition with no parameters)
     }
-    function compare_paras(paralist1,paralist2 : TLinkedList; acp : tcompare_paras_type; cpoptions: tcompare_paras_options):tequaltype;
+    function compare_paras(para1,para2 : tlist; acp : tcompare_paras_type; cpoptions: tcompare_paras_options):tequaltype;
 
     { True if a function can be assigned to a procvar }
     { changed first argument type to pabstractprocdef so that it can also be }
@@ -1138,53 +1138,59 @@ implementation
       end;
 
 
-    function compare_paras(paralist1,paralist2 : TLinkedList; acp : tcompare_paras_type; cpoptions: tcompare_paras_options):tequaltype;
+    function compare_paras(para1,para2 : tlist; acp : tcompare_paras_type; cpoptions: tcompare_paras_options):tequaltype;
       var
         currpara1,
-        currpara2 : TParaItem;
+        currpara2 : tparavarsym;
         eq,lowesteq : tequaltype;
-        hpd      : tprocdef;
-        convtype : tconverttype;
+        hpd       : tprocdef;
+        convtype  : tconverttype;
         cdoptions : tcompare_defs_options;
+        i1,i2     : byte;
       begin
          compare_paras:=te_incompatible;
          cdoptions:=[cdo_check_operator,cdo_allow_variant];
          { we need to parse the list from left-right so the
            not-default parameters are checked first }
          lowesteq:=high(tequaltype);
-         currpara1:=TParaItem(paralist1.first);
-         currpara2:=TParaItem(paralist2.first);
+         i1:=0;
+         i2:=0;
          if cpo_ignorehidden in cpoptions then
            begin
-             while assigned(currpara1) and currpara1.is_hidden do
-               currpara1:=tparaitem(currpara1.next);
-             while assigned(currpara2) and currpara2.is_hidden do
-               currpara2:=tparaitem(currpara2.next);
+             while (i1<para1.count) and
+                   (vo_is_hidden_para in tparavarsym(para1[i1]).varoptions) do
+               inc(i1);
+             while (i2<para2.count) and
+                   (vo_is_hidden_para in tparavarsym(para2[i2]).varoptions) do
+               inc(i2);
            end;
-         while (assigned(currpara1)) and (assigned(currpara2)) do
+         while (i1<para1.count) and (i2<para2.count) do
            begin
              eq:=te_incompatible;
 
+             currpara1:=tparavarsym(para1[i1]);
+             currpara2:=tparavarsym(para2[i2]);
+
              { Unique types must match exact }
-             if ((df_unique in currpara1.paratype.def.defoptions) or (df_unique in currpara2.paratype.def.defoptions)) and
-                (currpara1.paratype.def<>currpara2.paratype.def) then
+             if ((df_unique in currpara1.vartype.def.defoptions) or (df_unique in currpara2.vartype.def.defoptions)) and
+                (currpara1.vartype.def<>currpara2.vartype.def) then
                exit;
 
              { Handle hidden parameters separately, because self is
                defined as voidpointer for methodpointers }
-             if (currpara1.is_hidden or
-                 currpara2.is_hidden) then
+             if (vo_is_hidden_para in currpara1.varoptions) or
+                (vo_is_hidden_para in currpara2.varoptions) then
               begin
                 { both must be hidden }
-                if currpara1.is_hidden<>currpara2.is_hidden then
+                if (vo_is_hidden_para in currpara1.varoptions)<>(vo_is_hidden_para in currpara2.varoptions) then
                   exit;
                 eq:=te_equal;
-                if not(vo_is_self in tabstractvarsym(currpara1.parasym).varoptions) and
-                   not(vo_is_self in tabstractvarsym(currpara2.parasym).varoptions) then
+                if not(vo_is_self in currpara1.varoptions) and
+                   not(vo_is_self in currpara2.varoptions) then
                  begin
-                   if (currpara1.paratyp<>currpara2.paratyp) then
+                   if (currpara1.varspez<>currpara2.varspez) then
                     exit;
-                   eq:=compare_defs_ext(currpara1.paratype.def,currpara2.paratype.def,nothingn,
+                   eq:=compare_defs_ext(currpara1.vartype.def,currpara2.vartype.def,nothingn,
                                         convtype,hpd,cdoptions);
                  end;
               end
@@ -1194,33 +1200,33 @@ implementation
                   cp_value_equal_const :
                     begin
                        if (
-                           (currpara1.paratyp<>currpara2.paratyp) and
-                           ((currpara1.paratyp in [vs_var,vs_out]) or
-                            (currpara2.paratyp in [vs_var,vs_out]))
+                           (currpara1.varspez<>currpara2.varspez) and
+                           ((currpara1.varspez in [vs_var,vs_out]) or
+                            (currpara2.varspez in [vs_var,vs_out]))
                           ) then
                          exit;
-                       eq:=compare_defs_ext(currpara1.paratype.def,currpara2.paratype.def,nothingn,
+                       eq:=compare_defs_ext(currpara1.vartype.def,currpara2.vartype.def,nothingn,
                                             convtype,hpd,cdoptions);
                     end;
                   cp_all :
                     begin
-                       if (currpara1.paratyp<>currpara2.paratyp) then
+                       if (currpara1.varspez<>currpara2.varspez) then
                          exit;
-                       eq:=compare_defs_ext(currpara1.paratype.def,currpara2.paratype.def,nothingn,
+                       eq:=compare_defs_ext(currpara1.vartype.def,currpara2.vartype.def,nothingn,
                                             convtype,hpd,cdoptions);
                     end;
                   cp_procvar :
                     begin
-                       if (currpara1.paratyp<>currpara2.paratyp) then
+                       if (currpara1.varspez<>currpara2.varspez) then
                          exit;
-                       eq:=compare_defs_ext(currpara1.paratype.def,currpara2.paratype.def,nothingn,
+                       eq:=compare_defs_ext(currpara1.vartype.def,currpara2.vartype.def,nothingn,
                                             convtype,hpd,cdoptions);
                        { Parameters must be at least equal otherwise the are incompatible }
                        if (eq<te_equal) then
                          eq:=te_incompatible;
                     end;
                   else
-                    eq:=compare_defs_ext(currpara1.paratype.def,currpara2.paratype.def,nothingn,
+                    eq:=compare_defs_ext(currpara1.vartype.def,currpara2.vartype.def,nothingn,
                                          convtype,hpd,cdoptions);
                  end;
                end;
@@ -1231,29 +1237,31 @@ implementation
                 lowesteq:=eq;
               { also check default value if both have it declared }
               if (cpo_comparedefaultvalue in cpoptions) and
-                 assigned(currpara1.defaultvalue) and
-                 assigned(currpara2.defaultvalue) then
+                 assigned(currpara1.defaultconstsym) and
+                 assigned(currpara2.defaultconstsym) then
                begin
-                 if not equal_constsym(tconstsym(currpara1.defaultvalue),tconstsym(currpara2.defaultvalue)) then
+                 if not equal_constsym(tconstsym(currpara1.defaultconstsym),tconstsym(currpara2.defaultconstsym)) then
                    exit;
                end;
-              currpara1:=TParaItem(currpara1.next);
-              currpara2:=TParaItem(currpara2.next);
+              inc(i1);
+              inc(i2);
               if cpo_ignorehidden in cpoptions then
                 begin
-                  while assigned(currpara1) and currpara1.is_hidden do
-                    currpara1:=tparaitem(currpara1.next);
-                  while assigned(currpara2) and currpara2.is_hidden do
-                    currpara2:=tparaitem(currpara2.next);
+                  while (i1<para1.count) and
+                        (vo_is_hidden_para in tparavarsym(para1[i1]).varoptions) do
+                    inc(i1);
+                  while (i2<para2.count) and
+                        (vo_is_hidden_para in tparavarsym(para2[i2]).varoptions) do
+                    inc(i2);
                 end;
            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
            value assigned then the parameters are also equal }
-         if ((currpara1=nil) and (currpara2=nil)) or
+         if ((i1>=para1.count) and (i2>=para2.count)) or
             ((cpo_allowdefaults in cpoptions) and
-             ((assigned(currpara1) and assigned(currpara1.defaultvalue)) or
-              (assigned(currpara2) and assigned(currpara2.defaultvalue)))) then
+             (((i1<para1.count) and assigned(tparavarsym(para1[i1]).defaultconstsym)) or
+              ((i2<para2.count) and assigned(tparavarsym(para2[i2]).defaultconstsym)))) then
            compare_paras:=lowesteq;
       end;
 
@@ -1286,7 +1294,7 @@ implementation
             { return equal type based on the parameters, but a proc->procvar
               is never exact, so map an exact match of the parameters to
               te_equal }
-            eq:=compare_paras(def1.para,def2.para,cp_procvar,[]);
+            eq:=compare_paras(def1.paras,def2.paras,cp_procvar,[]);
             if eq=te_exact then
              eq:=te_equal;
             proc_to_procvar_equal:=eq;
@@ -1296,7 +1304,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.58  2004-11-08 22:09:58  peter
+  Revision 1.59  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.58  2004/11/08 22:09:58  peter
     * tvarsym splitted
 
   Revision 1.57  2004/11/01 10:31:48  peter

compiler/htypechk.pas

@@ -40,10 +40,10 @@ interface
 
       pcandidate = ^tcandidate;
       tcandidate = record
-         next        : pcandidate;
-         data        : tprocdef;
-         wrongpara,
-         firstpara   : tparaitem;
+         next         : pcandidate;
+         data         : tprocdef;
+         wrongparaidx,
+         firstparaidx : integer;
          exact_count,
          equal_count,
          cl1_count,
@@ -1360,7 +1360,7 @@ implementation
                                while assigned(hp) do
                                 begin
                                   { Only compare visible parameters for the user }
-                                  if compare_paras(hp^.data.para,pd.para,cp_value_equal_const,[cpo_ignorehidden])>=te_equal then
+                                  if compare_paras(hp^.data.paras,pd.paras,cp_value_equal_const,[cpo_ignorehidden])>=te_equal then
                                    begin
                                      found:=true;
                                      break;
@@ -1440,7 +1440,7 @@ implementation
                             while assigned(hp) do
                               begin
                                 { Only compare visible parameters for the user }
-                                if compare_paras(hp^.data.para,pd.para,cp_value_equal_const,[cpo_ignorehidden])>=te_equal then
+                                if compare_paras(hp^.data.paras,pd.paras,cp_value_equal_const,[cpo_ignorehidden])>=te_equal then
                                   begin
                                     found:=true;
                                     break;
@@ -1475,7 +1475,7 @@ implementation
 
     function tcallcandidates.proc_add(pd:tprocdef):pcandidate;
       var
-        i : integer;
+        defaultparacnt : integer;
       begin
         { generate new candidate entry }
         new(result);
@@ -1486,17 +1486,18 @@ implementation
         inc(FProccnt);
         { Find last parameter, skip all default parameters
           that are not passed. Ignore this skipping for varargs }
-        result^.firstpara:=tparaitem(pd.Para.last);
+        result^.firstparaidx:=pd.paras.count-1;
         if not(po_varargs in pd.procoptions) then
          begin
            { ignore hidden parameters }
-           while assigned(result^.firstpara) and (result^.firstpara.is_hidden) do
-             result^.firstpara:=tparaitem(result^.firstpara.previous);
-           for i:=1 to pd.maxparacount-FParalength do
+           while (result^.firstparaidx>=0) and (vo_is_hidden_para in tparavarsym(pd.paras[result^.firstparaidx]).varoptions) do
+             dec(result^.firstparaidx);
+           defaultparacnt:=pd.maxparacount-FParalength;
+           if defaultparacnt>0 then
              begin
-               if not assigned(result^.firstpara) then
+               if defaultparacnt>result^.firstparaidx then
                  internalerror(200401141);
-               result^.firstpara:=tparaitem(result^.firstPara.previous);
+               dec(result^.firstparaidx,defaultparacnt);
              end;
          end;
       end;
@@ -1534,7 +1535,8 @@ implementation
 
       var
         hp : pcandidate;
-        currpara : tparaitem;
+        i  : integer;
+        currpara : tparavarsym;
       begin
         if not CheckVerbosity(lvl) then
          exit;
@@ -1555,17 +1557,11 @@ implementation
                           ' oper: '+tostr(hp^.coper_count)+
                           ' ord: '+realtostr(hp^.exact_count));
               { Print parameters in left-right order }
-              currpara:=hp^.firstpara;
-              if assigned(currpara) then
-               begin
-                 while assigned(currpara.next) do
-                  currpara:=tparaitem(currpara.next);
-               end;
-              while assigned(currpara) do
+              for i:=0 to hp^.data.paras.count-1 do
                begin
-                 if (not currpara.is_hidden) then
-                   Comment(lvl,'    - '+currpara.paratype.def.typename+' : '+EqualTypeName[currpara.eqval]);
-                 currpara:=tparaitem(currpara.previous);
+                 currpara:=tparavarsym(hp^.data.paras[i]);
+                 if (vo_is_hidden_para in currpara.varoptions) then
+                   Comment(lvl,'    - '+currpara.vartype.def.typename+' : '+EqualTypeName[currpara.eqval]);
                end;
             end;
            hp:=hp^.next;
@@ -1577,7 +1573,8 @@ implementation
     procedure tcallcandidates.get_information;
       var
         hp       : pcandidate;
-        currpara : tparaitem;
+        currpara : tparavarsym;
+        paraidx  : integer;
         currparanr : byte;
         def_from,
         def_to   : tdef;
@@ -1600,12 +1597,13 @@ implementation
              the firstpara is already pointing to the last parameter
              were we need to start comparing }
            currparanr:=FParalength;
-           currpara:=hp^.firstpara;
-           while assigned(currpara) and (currpara.is_hidden) do
-             currpara:=tparaitem(currpara.previous);
+           paraidx:=hp^.firstparaidx;
+           while (paraidx>=0) and (vo_is_hidden_para in tparavarsym(hp^.data.paras[paraidx]).varoptions) do
+             dec(paraidx);
            pt:=tcallparanode(FParaNode);
-           while assigned(pt) and assigned(currpara) do
+           while assigned(pt) and (paraidx>=0) do
             begin
+              currpara:=tparavarsym(hp^.data.paras[paraidx]);
               { currpt can be changed from loadn to calln when a procvar
                 is passed. This is to prevent that the change is permanent }
               currpt:=pt;
@@ -1613,7 +1611,7 @@ implementation
               { retrieve current parameter definitions to compares }
               eq:=te_incompatible;
               def_from:=currpt.resulttype.def;
-              def_to:=currpara.paratype.def;
+              def_to:=currpara.vartype.def;
               if not(assigned(def_from)) then
                internalerror(200212091);
               if not(
@@ -1651,7 +1649,7 @@ implementation
               else
               { for value and const parameters check if a integer is constant or
                 included in other integer -> equal and calc ordinal_distance }
-               if not(currpara.paratyp in [vs_var,vs_out]) and
+               if not(currpara.varspez in [vs_var,vs_out]) and
                   is_integer(def_from) and
                   is_integer(def_to) and
                   is_in_limit(def_from,def_to) then
@@ -1675,14 +1673,14 @@ implementation
                    some special case for parameter passing }
                  if (eq<te_equal) then
                   begin
-                    if currpara.paratyp in [vs_var,vs_out] then
+                    if currpara.varspez in [vs_var,vs_out] then
                       begin
                         { para requires an equal type so the previous found
                           match was not good enough, reset to incompatible }
                         eq:=te_incompatible;
                         { var_para_allowed will return te_equal and te_convert_l1 to
                           make a difference for best matching }
-                        var_para_allowed(eq,currpt.resulttype.def,currpara.paratype.def)
+                        var_para_allowed(eq,currpt.resulttype.def,currpara.vartype.def)
                       end
                     else
                       para_allowed(eq,currpt,def_to);
@@ -1720,7 +1718,7 @@ implementation
                begin
                  { store the current parameter info for
                    a nice error message when no procedure is found }
-                 hp^.wrongpara:=currpara;
+                 hp^.wrongparaidx:=paraidx;
                  hp^.wrongparanr:=currparanr;
                  break;
                end;
@@ -1744,13 +1742,13 @@ implementation
                begin
                  { Ignore vs_hidden parameters }
                  repeat
-                   currpara:=tparaitem(currpara.previous);
-                 until (not assigned(currpara)) or (not currpara.is_hidden);
+                   dec(paraidx);
+                 until (paraidx<0) or not(vo_is_hidden_para in tparavarsym(hp^.data.paras[paraidx]).varoptions);
                end;
               dec(currparanr);
             end;
            if not(hp^.invalid) and
-              (assigned(pt) or assigned(currpara) or (currparanr<>0)) then
+              (assigned(pt) or (paraidx>=0) or (currparanr<>0)) then
              internalerror(200212141);
            { next candidate }
            hp:=hp^.next;
@@ -1895,6 +1893,7 @@ implementation
         currparanr : smallint;
         hp : pcandidate;
         pt : tcallparanode;
+        wrongpara : tparavarsym;
       begin
         { Only process the first overloaded procdef }
         hp:=FProcs;
@@ -1912,28 +1911,33 @@ implementation
           internalerror(200212094);
         { Show error message, when it was a var or out parameter
           guess that it is a missing typeconv }
-        if hp^.wrongpara.paratyp in [vs_var,vs_out] then
+        wrongpara:=tparavarsym(hp^.data.paras[hp^.wrongparaidx]);
+        if wrongpara.varspez in [vs_var,vs_out] then
           begin
             { Maybe passing the correct type but passing a const to var parameter }
-            if (compare_defs(pt.resulttype.def,hp^.wrongpara.paratype.def,pt.nodetype)<>te_incompatible) and
+            if (compare_defs(pt.resulttype.def,wrongpara.vartype.def,pt.nodetype)<>te_incompatible) and
                not valid_for_var(pt.left) then
               CGMessagePos(pt.left.fileinfo,type_e_variable_id_expected)
             else
               CGMessagePos2(pt.left.fileinfo,parser_e_call_by_ref_without_typeconv,
-                FullTypeName(pt.left.resulttype.def,hp^.wrongpara.paratype.def),
-                FullTypeName(hp^.wrongpara.paratype.def,pt.left.resulttype.def))
+                FullTypeName(pt.left.resulttype.def,wrongpara.vartype.def),
+                FullTypeName(wrongpara.vartype.def,pt.left.resulttype.def))
           end
         else
           CGMessagePos3(pt.left.fileinfo,type_e_wrong_parameter_type,tostr(hp^.wrongparanr),
-            FullTypeName(pt.left.resulttype.def,hp^.wrongpara.paratype.def),
-            FullTypeName(hp^.wrongpara.paratype.def,pt.left.resulttype.def));
+            FullTypeName(pt.left.resulttype.def,wrongpara.vartype.def),
+            FullTypeName(wrongpara.vartype.def,pt.left.resulttype.def));
       end;
 
 
 end.
 {
   $Log$
-  Revision 1.103  2004-11-08 22:09:58  peter
+  Revision 1.104  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.103  2004/11/08 22:09:58  peter
     * tvarsym splitted
 
   Revision 1.102  2004/11/01 16:58:57  peter

compiler/i386/cpupara.pas

@@ -29,7 +29,7 @@ unit cpupara;
     uses
        cclasses,globtype,
        aasmtai,cpubase,cgbase,
-       symconst,symtype,symdef,
+       symconst,symtype,symsym,symdef,
        parabase,paramgr;
 
     type
@@ -47,14 +47,12 @@ unit cpupara;
           }
           procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargspara):longint;override;
-          procedure createtempparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var cgpara:TCGPara);override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          procedure createtempparaloc(list: taasmoutput;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);override;
        private
           procedure create_funcret_paraloc_info(p : tabstractprocdef; side: tcallercallee);
-          procedure create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;firstpara:tparaitem;
-                                                var parasize:longint);
-          procedure create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;firstpara:tparaitem;
-                                                 var parareg,parasize:longint);
+          procedure create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tlist;var parasize:longint);
+          procedure create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tlist;var parareg,parasize:longint);
        end;
 
   implementation
@@ -289,10 +287,10 @@ unit cpupara;
       end;
 
 
-    procedure ti386paramanager.create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;firstpara:tparaitem;
-                                                           var parasize:longint);
+    procedure ti386paramanager.create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tlist;var parasize:longint);
       var
-        hp : tparaitem;
+        i  : integer;
+        hp : tparavarsym;
         paraloc : pcgparalocation;
         l,
         varalign,
@@ -314,14 +312,14 @@ unit cpupara;
           That means for pushes the para with the
           highest offset (see para3) needs to be pushed first
         }
-        hp:=firstpara;
-        while assigned(hp) do
+        for i:=0 to paras.count-1 do
           begin
-            if push_addr_param(hp.paratyp,hp.paratype.def,p.proccalloption) then
+            hp:=tparavarsym(paras[i]);
+            if push_addr_param(hp.varspez,hp.vartype.def,p.proccalloption) then
               paracgsize:=OS_ADDR
             else
               begin
-                paracgsize:=def_cgSize(hp.paratype.def);
+                paracgsize:=def_cgSize(hp.vartype.def);
                 if paracgsize=OS_NO then
                   paracgsize:=OS_ADDR;
               end;
@@ -335,19 +333,18 @@ unit cpupara;
               paraloc^.reference.index:=NR_STACK_POINTER_REG
             else
               paraloc^.reference.index:=NR_FRAME_POINTER_REG;
-            l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
+            l:=push_size(hp.varspez,hp.vartype.def,p.proccalloption);
             varalign:=used_align(size_2_align(l),paraalign,paraalign);
             paraloc^.reference.offset:=parasize;
             parasize:=align(parasize+l,varalign);
-            hp:=tparaitem(hp.next);
           end;
         { Adapt offsets for left-to-right calling }
         if p.proccalloption in pushleftright_pocalls then
           begin
-            hp:=tparaitem(p.para.first);
-            while assigned(hp) do
+            for i:=0 to paras.count-1 do
               begin
-                l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
+                hp:=tparavarsym(paras[i]);
+                l:=push_size(hp.varspez,hp.vartype.def,p.proccalloption);
                 varalign:=used_align(size_2_align(l),paraalign,paraalign);
                 l:=align(l,varalign);
                 with hp.paraloc[side].location^ do
@@ -356,7 +353,6 @@ unit cpupara;
                     if side=calleeside then
                       inc(reference.offset,target_info.first_parm_offset);
                   end;
-                hp:=tparaitem(hp.next);
               end;
           end
         else
@@ -365,39 +361,39 @@ unit cpupara;
               standard stackframe size }
             if side=calleeside then
               begin
-                hp:=tparaitem(p.para.first);
-                while assigned(hp) do
+                for i:=0 to paras.count-1 do
                   begin
+                    hp:=tparavarsym(paras[i]);
                     inc(hp.paraloc[side].location^.reference.offset,target_info.first_parm_offset);
-                    hp:=tparaitem(hp.next);
                   end;
                end;
           end;
       end;
 
 
-    procedure ti386paramanager.create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;firstpara:tparaitem;
+    procedure ti386paramanager.create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tlist;
                                                             var parareg,parasize:longint);
       var
-        hp : tparaitem;
+        hp : tparavarsym;
         paraloc : pcgparalocation;
         pushaddr,
         is_64bit : boolean;
         paracgsize : tcgsize;
+        i : integer;
         l,
         varalign,
         paraalign : longint;
       begin
         paraalign:=get_para_align(p.proccalloption);
         { Register parameters are assigned from left to right }
-        hp:=firstpara;
-        while assigned(hp) do
+        for i:=0 to paras.count-1 do
           begin
-            pushaddr:=push_addr_param(hp.paratyp,hp.paratype.def,p.proccalloption);
+            hp:=tparavarsym(paras[i]);
+            pushaddr:=push_addr_param(hp.varspez,hp.vartype.def,p.proccalloption);
             if pushaddr then
               paracgsize:=OS_ADDR
             else
-              paracgsize:=def_cgsize(hp.paratype.def);
+              paracgsize:=def_cgsize(hp.vartype.def);
             is_64bit:=(paracgsize in [OS_64,OS_S64,OS_F64]);
             hp.paraloc[side].reset;
             hp.paraloc[side].size:=paracgsize;
@@ -417,7 +413,7 @@ unit cpupara;
             if (parareg<=high(parasupregs)) and
                not(
                    is_64bit or
-                   ((hp.paratype.def.deftype in [floatdef,recorddef,arraydef]) and
+                   ((hp.vartype.def.deftype in [floatdef,recorddef,arraydef]) and
                     (not pushaddr))
                   ) then
               begin
@@ -432,24 +428,23 @@ unit cpupara;
                   paraloc^.reference.index:=NR_STACK_POINTER_REG
                 else
                   paraloc^.reference.index:=NR_FRAME_POINTER_REG;
-                l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
+                l:=push_size(hp.varspez,hp.vartype.def,p.proccalloption);
                 varalign:=size_2_align(l);
                 paraloc^.reference.offset:=parasize;
                 varalign:=used_align(varalign,paraalign,paraalign);
                 parasize:=align(parasize+l,varalign);
               end;
-            hp:=tparaitem(hp.next);
           end;
         { Register parameters are assigned from left-to-right, adapt offset
           for calleeside to be reversed }
-        hp:=tparaitem(p.para.first);
-        while assigned(hp) do
+        for i:=0 to paras.count-1 do
           begin
+            hp:=tparavarsym(paras[i]);
             with hp.paraloc[side].location^ do
               begin
                 if (loc=LOC_REFERENCE) then
                   begin
-                    l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
+                    l:=push_size(hp.varspez,hp.vartype.def,p.proccalloption);
                     varalign:=used_align(size_2_align(l),paraalign,paraalign);
                     l:=align(l,varalign);
                     reference.offset:=parasize-reference.offset-l;
@@ -457,7 +452,6 @@ unit cpupara;
                       inc(reference.offset,target_info.first_parm_offset);
                   end;
                end;
-            hp:=tparaitem(hp.next);
           end;
       end;
 
@@ -471,50 +465,50 @@ unit cpupara;
         parareg:=0;
         case p.proccalloption of
           pocall_register :
-            create_register_paraloc_info(p,side,tparaitem(p.para.first),parareg,parasize);
+            create_register_paraloc_info(p,side,p.paras,parareg,parasize);
           pocall_inline,
           pocall_compilerproc,
           pocall_internproc :
             begin
               { Use default calling }
               if (pocall_default=pocall_register) then
-                create_register_paraloc_info(p,side,tparaitem(p.para.first),parareg,parasize)
+                create_register_paraloc_info(p,side,p.paras,parareg,parasize)
               else
-                create_stdcall_paraloc_info(p,side,tparaitem(p.para.first),parasize);
+                create_stdcall_paraloc_info(p,side,p.paras,parasize);
             end;
           else
-            create_stdcall_paraloc_info(p,side,tparaitem(p.para.first),parasize);
+            create_stdcall_paraloc_info(p,side,p.paras,parasize);
         end;
         create_funcret_paraloc_info(p,side);
         result:=parasize;
       end;
 
 
-    function ti386paramanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargspara):longint;
+    function ti386paramanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
       var
         parasize : longint;
       begin
         parasize:=0;
         { calculate the registers for the normal parameters }
-        create_stdcall_paraloc_info(p,callerside,tparaitem(p.para.first),parasize);
+        create_stdcall_paraloc_info(p,callerside,p.paras,parasize);
         { append the varargs }
-        create_stdcall_paraloc_info(p,callerside,tparaitem(varargspara.first),parasize);
+        create_stdcall_paraloc_info(p,callerside,varargspara,parasize);
         result:=parasize;
       end;
 
 
-    procedure ti386paramanager.createtempparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var cgpara:TCGPara);
+    procedure ti386paramanager.createtempparaloc(list: taasmoutput;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);
       var
         paraloc : pcgparalocation;
       begin
-        paraloc:=paraitem.paraloc[callerside].location;
+        paraloc:=parasym.paraloc[callerside].location;
         { No need for temps when value is pushed }
         if assigned(paraloc) and
            (paraloc^.loc=LOC_REFERENCE) and
            (paraloc^.reference.index=NR_STACK_POINTER_REG) then
-          duplicateparaloc(list,calloption,paraitem,cgpara)
+          duplicateparaloc(list,calloption,parasym,cgpara)
         else
-          inherited createtempparaloc(list,calloption,paraitem,cgpara);
+          inherited createtempparaloc(list,calloption,parasym,cgpara);
       end;
 
 
@@ -523,7 +517,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.56  2004-10-31 21:45:03  peter
+  Revision 1.57  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.56  2004/10/31 21:45:03  peter
     * generic tlocation
     * move tlocation to cgutils
 

compiler/ncal.pas

@@ -59,7 +59,7 @@ interface
           function  gen_self_tree_methodpointer:tnode;
           function  gen_self_tree:tnode;
           function  gen_vmt_tree:tnode;
-          procedure bind_paraitem;
+          procedure bind_parasym;
 
           { function return node, this is used to pass the data for a
             ret_in_param return value }
@@ -91,8 +91,8 @@ interface
           methodpointer  : tnode;
           { inline function body }
           inlinecode : tnode;
-          { varargs tparaitems }
-          varargsparas : tvarargspara;
+          { varargs parasyms }
+          varargsparas : tvarargsparalist;
           { node that specifies where the result should be put for calls }
           { that return their result in a parameter                      }
           property funcretnode: tnode read _funcretnode write setfuncretnode;
@@ -148,7 +148,7 @@ interface
        tcallparanode = class(tbinarynode)
        public
           callparaflags : tcallparaflags;
-          paraitem : tparaitem;
+          parasym       : tparavarsym;
           used_by_callnode : boolean;
           { only the processor specific nodes need to override this }
           { constructor                                             }
@@ -407,7 +407,7 @@ type
       begin
          n:=tcallparanode(inherited getcopy);
          n.callparaflags:=callparaflags;
-         n.paraitem:=paraitem;
+         n.parasym:=parasym;
          result:=n;
       end;
 
@@ -462,7 +462,7 @@ type
                here to make the change permanent. in the overload
                choosing the changes are only made temporary }
              if (left.resulttype.def.deftype=procvardef) and
-                (paraitem.paratype.def.deftype<>procvardef) then
+                (parasym.vartype.def.deftype<>procvardef) then
                begin
                  if maybe_call_procvar(left,true) then
                    resulttype:=left.resulttype;
@@ -481,12 +481,12 @@ type
                  end;
                  set_varstate(left,vs_used,true);
                  resulttype:=left.resulttype;
-                 { also update paraitem type to get the correct parameter location
+                 { also update parasym type to get the correct parameter location
                    for the new types }
-                 paraitem.paratype:=left.resulttype;
+                 parasym.vartype:=left.resulttype;
                end
              else
-              if (paraitem.is_hidden) then
+              if (vo_is_hidden_para in parasym.varoptions) then
                begin
                  set_varstate(left,vs_used,true);
                  resulttype:=left.resulttype;
@@ -498,13 +498,13 @@ type
                    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);
+                    (parasym.vartype.def.deftype=setdef) then
+                   inserttypeconv(left,parasym.vartype);
 
                  { set some settings needed for arrayconstructor }
                  if is_array_constructor(left.resulttype.def) then
                   begin
-                    if is_array_of_const(paraitem.paratype.def) then
+                    if is_array_of_const(parasym.vartype.def) then
                      begin
                        { force variant array }
                        include(left.flags,nf_forcevaria);
@@ -514,37 +514,37 @@ type
                        include(left.flags,nf_novariaallowed);
                        { now that the resultting type is know we can insert the required
                          typeconvs for the array constructor }
-                       if paraitem.paratype.def.deftype=arraydef then
-                         tarrayconstructornode(left).force_type(tarraydef(paraitem.paratype.def).elementtype);
+                       if parasym.vartype.def.deftype=arraydef then
+                         tarrayconstructornode(left).force_type(tarraydef(parasym.vartype.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);
+                   test_local_to_procvar(tprocvardef(left.resulttype.def),parasym.vartype.def);
 
                  { test conversions }
                  if not(is_shortstring(left.resulttype.def) and
-                        is_shortstring(paraitem.paratype.def)) and
-                    (paraitem.paratype.def.deftype<>formaldef) then
+                        is_shortstring(parasym.vartype.def)) and
+                    (parasym.vartype.def.deftype<>formaldef) then
                    begin
                       { Process open parameters }
-                      if paramanager.push_high_param(paraitem.paratyp,paraitem.paratype.def,aktcallnode.procdefinition.proccalloption) then
+                      if paramanager.push_high_param(parasym.varspez,parasym.vartype.def,aktcallnode.procdefinition.proccalloption) then
                        begin
                          { insert type conv but hold the ranges of the array }
                          oldtype:=left.resulttype;
-                         inserttypeconv(left,paraitem.paratype);
+                         inserttypeconv(left,parasym.vartype);
                          left.resulttype:=oldtype;
                        end
                       else
                        begin
                          { for ordinals, floats and enums, verify if we might cause
                            some range-check errors. }
-                         if (paraitem.paratype.def.deftype in [enumdef,orddef,floatdef]) and
+                         if (parasym.vartype.def.deftype in [enumdef,orddef,floatdef]) and
                             (left.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
                             (left.nodetype in [vecn,loadn,calln]) then
                            begin
-                              if (left.resulttype.def.size>paraitem.paratype.def.size) then
+                              if (left.resulttype.def.size>parasym.vartype.def.size) then
                                 begin
                                   if (cs_check_range in aktlocalswitches) then
                                      Message(type_w_smaller_possible_range_check)
@@ -552,7 +552,7 @@ type
                                      Message(type_h_smaller_possible_range_check);
                                 end;
                            end;
-                         inserttypeconv(left,paraitem.paratype);
+                         inserttypeconv(left,parasym.vartype);
                        end;
                       if codegenerror then
                         begin
@@ -564,17 +564,17 @@ type
                  { check var strings }
                  if (cs_strict_var_strings in aktlocalswitches) and
                     is_shortstring(left.resulttype.def) and
-                    is_shortstring(paraitem.paratype.def) and
-                    (paraitem.paratyp in [vs_out,vs_var]) and
-                    not(is_open_string(paraitem.paratype.def)) and
-                    not(equal_defs(left.resulttype.def,paraitem.paratype.def)) then
+                    is_shortstring(parasym.vartype.def) and
+                    (parasym.varspez in [vs_out,vs_var]) and
+                    not(is_open_string(parasym.vartype.def)) and
+                    not(equal_defs(left.resulttype.def,parasym.vartype.def)) then
                    begin
                      aktfilepos:=left.fileinfo;
                      CGMessage(type_e_strict_var_string_violation);
                    end;
 
                  { Handle formal parameters separate }
-                 if (paraitem.paratype.def.deftype=formaldef) then
+                 if (parasym.vartype.def.deftype=formaldef) then
                    begin
                      { load procvar if a procedure is passed }
                      if (m_tp_procvar in aktmodeswitches) and
@@ -582,7 +582,7 @@ type
                         (is_void(left.resulttype.def)) then
                        load_procvar_from_calln(left);
 
-                     case paraitem.paratyp of
+                     case parasym.varspez of
                        vs_var,
                        vs_out :
                          begin
@@ -599,11 +599,11 @@ type
                  else
                    begin
                      { check if the argument is allowed }
-                     if (paraitem.paratyp in [vs_out,vs_var]) then
+                     if (parasym.varspez in [vs_out,vs_var]) then
                        valid_for_var(left);
                    end;
 
-                 if paraitem.paratyp = vs_var then
+                 if parasym.varspez = vs_var then
                    set_unique(left);
 
                  { When the address needs to be pushed then the register is
@@ -611,10 +611,10 @@ type
                    parameter and we can pass the address transparently }
                  if (
                      not(
-                         paraitem.is_hidden and
+                         (vo_is_hidden_para in parasym.varoptions) and
                          (left.resulttype.def.deftype in [pointerdef,classrefdef])
                         ) and
-                     paramanager.push_addr_param(paraitem.paratyp,paraitem.paratype.def,
+                     paramanager.push_addr_param(parasym.varspez,parasym.vartype.def,
                          aktcallnode.procdefinition.proccalloption) and
                      not(
                          (left.nodetype=loadn) and
@@ -625,13 +625,13 @@ type
 
                  if do_count then
                   begin
-                    if paraitem.paratyp in [vs_var,vs_out] then
+                    if parasym.varspez in [vs_var,vs_out] then
                       set_varstate(left,vs_used,false)
                     else
                       set_varstate(left,vs_used,true);
                   end;
                  { must only be done after typeconv PM }
-                 resulttype:=paraitem.paratype;
+                 resulttype:=parasym.vartype;
                end;
             end;
 
@@ -803,8 +803,8 @@ type
             para := tcallparanode(left);
             while assigned(para) do
               begin
-                if para.paraitem.is_hidden and
-                   (vo_is_funcret in tparavarsym(para.paraitem.parasym).varoptions) then
+                if (vo_is_hidden_para in para.parasym.varoptions) and
+                   (vo_is_funcret in tparavarsym(para.parasym).varoptions) then
                  begin
                    para.left.free;
                    para.left := _funcretnode.getcopy;
@@ -885,7 +885,7 @@ type
     procedure tcallnode.derefimpl;
       var
         pt : tcallparanode;
-        currpara : tparaitem;
+        i  : integer;
       begin
         inherited derefimpl;
         symtableprocentry:=tprocsym(symtableprocentryderef.resolve);
@@ -901,21 +901,19 @@ type
           _funcretnode.derefimpl;
         if assigned(inlinecode) then
           inlinecode.derefimpl;
-        { Connect paraitems }
+        { Connect parasyms }
         pt:=tcallparanode(left);
         while assigned(pt) and
               (cpf_varargs_para in pt.callparaflags) do
           pt:=tcallparanode(pt.right);
-        currpara:=tparaitem(procdefinition.Para.last);
-        while assigned(currpara) do
+        for i:=procdefinition.paras.count-1 downto 0 do
           begin
             if not assigned(pt) then
               internalerror(200311077);
-            pt.paraitem:=currpara;
+            pt.parasym:=tparavarsym(procdefinition.paras[i]);
             pt:=tcallparanode(pt.right);
-            currpara:=tparaitem(currpara.previous);
           end;
-        if assigned(currpara) or assigned(pt) then
+        if assigned(pt) then
           internalerror(200311078);
       end;
 
@@ -923,7 +921,8 @@ type
     function tcallnode.getcopy : tnode;
       var
         n : tcallnode;
-        hp : tparaitem;
+        i : integer;
+        hp,hpn : tparavarsym;
         oldleft : tnode;
       begin
         { Need to use a hack here to prevent the parameters from being copied.
@@ -966,13 +965,13 @@ type
          n.inlinecode:=nil;
         if assigned(varargsparas) then
          begin
-           n.varargsparas:=tvarargspara.create;
-           hp:=tparaitem(varargsparas.first);
-           while assigned(hp) do
-            begin
-              n.varargsparas.concat(hp.getcopy);
-              hp:=tparaitem(hp.next);
-            end;
+           n.varargsparas:=tvarargsparalist.create;
+           for i:=0 to varargsparas.count-1 do
+             begin
+               hp:=tparavarsym(varargsparas[i]);
+               hpn:=tparavarsym.create(hp.realname,0,hp.varspez,hp.vartype);
+               n.varargsparas.add(hpn);
+             end;
          end
         else
          n.varargsparas:=nil;
@@ -1016,7 +1015,7 @@ type
               end;
           end;
         { Remove value of old array of const parameter, but keep it
-          in the list because it is required for bind_paraitem.
+          in the list because it is required for bind_parasym.
           Generate a nothign to keep callparanoed.left valid }
         oldleft.left.free;
         oldleft.left:=cnothingnode.create;
@@ -1261,13 +1260,13 @@ type
       end;
 
 
-    procedure tcallnode.bind_paraitem;
+    procedure tcallnode.bind_parasym;
       var
         i        : integer;
         pt       : tcallparanode;
         oldppt   : ^tcallparanode;
         varargspara,
-        currpara : tparaitem;
+        currpara : tparavarsym;
         used_by_callnode : boolean;
         hiddentree : tnode;
         newstatement : tstatementnode;
@@ -1292,15 +1291,15 @@ type
           pt:=tcallparanode(pt.right);
 
         { process normal parameters and insert hidden parameters }
-        currpara:=tparaitem(procdefinition.Para.last);
-        while assigned(currpara) do
+        for i:=procdefinition.paras.count-1 downto 0 do
          begin
-           if currpara.is_hidden then
+           currpara:=tparavarsym(procdefinition.paras[i]);
+           if vo_is_hidden_para in currpara.varoptions then
             begin
               { generate hidden tree }
               used_by_callnode:=false;
               hiddentree:=nil;
-              if (vo_is_funcret in tparavarsym(currpara.parasym).varoptions) then
+              if (vo_is_funcret in currpara.varoptions) then
                begin
                  { Generate funcretnode if not specified }
                  if assigned(funcretnode) then
@@ -1319,15 +1318,16 @@ type
                   end;
                end
               else
-               if vo_is_high_value in tparavarsym(currpara.parasym).varoptions then
+               if vo_is_high_para in currpara.varoptions then
                 begin
-                  if not assigned(pt) then
+                  if not assigned(pt) or
+                     (i=0) then
                     internalerror(200304082);
                   { we need the information of the previous parameter }
-                  hiddentree:=gen_high_tree(pt.left,tparaitem(currpara.previous).paratype.def);
+                  hiddentree:=gen_high_tree(pt.left,tparavarsym(procdefinition.paras[i-1]).vartype.def);
                 end
               else
-               if vo_is_self in tparavarsym(currpara.parasym).varoptions then
+               if vo_is_self in currpara.varoptions then
                  begin
                    if assigned(right) then
                      hiddentree:=gen_self_tree_methodpointer
@@ -1335,27 +1335,25 @@ type
                      hiddentree:=gen_self_tree;
                  end
               else
-               if vo_is_vmt in tparavarsym(currpara.parasym).varoptions then
+               if vo_is_vmt in currpara.varoptions then
                  begin
                    hiddentree:=gen_vmt_tree;
                  end
+{$ifdef powerpc}
               else
-               if vo_is_parentfp in tparavarsym(currpara.parasym).varoptions then
+               if vo_is_syscall_lib in currpara.varoptions then
                  begin
-                   if not(assigned(procdefinition.owner.defowner)) then
-                     internalerror(200309287);
-                   hiddentree:=cloadparentfpnode.create(tprocdef(procdefinition.owner.defowner));
+                   { lib parameter has no special type but proccalloptions must be a syscall }
+                   hiddentree:=cloadnode.create(tprocdef(procdefinition).libsym,tprocdef(procdefinition).libsym.owner);
                  end
-{$ifdef powerpc}
-              else
-                { lib parameter has no special type but proccalloptions must be a syscall }
-                if (target_info.system in [system_powerpc_morphos,system_m68k_amiga]) and
-                  (procdefinition.proccalloption=pocall_syscall) then
-                  begin
-                    hiddentree:=cloadnode.create(tprocdef(procdefinition).libsym,tprocdef(procdefinition).libsym.owner);
-                  end
 {$endif powerpc}
               else
+               if vo_is_parentfp in currpara.varoptions then
+                 begin
+                   if not(assigned(procdefinition.owner.defowner)) then
+                     internalerror(200309287);
+                   hiddentree:=cloadparentfpnode.create(tprocdef(procdefinition.owner.defowner));
+                 end;
               { add the hidden parameter }
               if not assigned(hiddentree) then
                 internalerror(200304073);
@@ -1367,27 +1365,25 @@ type
             end;
            if not assigned(pt) then
              internalerror(200310052);
-           pt.paraitem:=currpara;
+           pt.parasym:=currpara;
            oldppt:[email protected];
            pt:=tcallparanode(pt.right);
-           currpara:=tparaitem(currpara.previous)
          end;
 
-        { Create paraitems for varargs }
+        { Create parasyms for varargs }
         pt:=tcallparanode(left);
+        i:=0;
         while assigned(pt) do
           begin
             if cpf_varargs_para in pt.callparaflags then
               begin
                 if not assigned(varargsparas) then
-                  varargsparas:=tvarargspara.create;
-                varargspara:=tparaitem.create;
-                varargspara.paratyp:=vs_value;
-                varargspara.paratype:=pt.resulttype;
+                  varargsparas:=tvarargsparalist.create;
+                varargspara:=tparavarsym.create('va'+tostr(i),0,vs_value,pt.resulttype);
                 { varargspara is left-right, use insert
                   instead of concat }
-                varargsparas.insert(varargspara);
-                pt.paraitem:=varargspara;
+                varargsparas.add(varargspara);
+                pt.parasym:=varargspara;
               end;
             pt:=tcallparanode(pt.right);
           end;
@@ -1401,7 +1397,8 @@ type
         hpt : tnode;
         pt : tcallparanode;
         lastpara : longint;
-        currpara : tparaitem;
+        currpara : tparavarsym;
+        paraidx,
         cand_cnt : integer;
         i : longint;
         method_must_be_valid,
@@ -1449,45 +1446,45 @@ type
               procdefinition:=tabstractprocdef(right.resulttype.def);
 
               { Compare parameters from right to left }
-              currpara:=tparaitem(procdefinition.Para.last);
+              paraidx:=procdefinition.Paras.count-1;
               { Skip default parameters }
               if not(po_varargs in procdefinition.procoptions) then
                 begin
                   { ignore hidden parameters }
-                  while assigned(currpara) and (currpara.is_hidden) do
-                    currpara:=tparaitem(currpara.previous);
+                  while (paraidx>=0) and (vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) do
+                    dec(paraidx);
                   for i:=1 to procdefinition.maxparacount-paralength do
                     begin
-                      if not assigned(currpara) then
+                      if paraidx<0 then
                         internalerror(200402261);
-                      if not assigned(currpara.defaultvalue) then
+                      if not assigned(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym) then
                         begin
                           CGMessage(parser_e_wrong_parameter_size);
                           goto errorexit;
                         end;
-                      currpara:=tparaitem(currpara.previous);
+                      dec(paraidx);
                     end;
                 end;
-              while assigned(currpara) and (currpara.is_hidden) do
-                currpara:=tparaitem(currpara.previous);
+              while (paraidx>=0) and (vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) do
+                dec(paraidx);
               pt:=tcallparanode(left);
               lastpara:=paralength;
-              while assigned(currpara) and assigned(pt) do
+              while (paraidx>=0) 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
-                       currpara:=tparaitem(currpara.previous);
-                     until (not assigned(currpara)) or (not currpara.is_hidden);
+                       dec(paraidx);
+                     until (paraidx<0) or not(vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions);
                    end;
                   pt:=tcallparanode(pt.right);
                   dec(lastpara);
                 end;
               if assigned(pt) or
-                 (assigned(currpara) and
-                  not assigned(currpara.defaultvalue)) then
+                 ((paraidx>=0) and
+                  not assigned(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym)) then
                 begin
                    if assigned(pt) then
                      aktfilepos:=pt.fileinfo;
@@ -1617,27 +1614,28 @@ type
           if assigned(procdefinition) and
              (paralength<procdefinition.maxparacount) then
            begin
-             currpara:=tparaitem(procdefinition.Para.first);
+             paraidx:=0;
              i:=0;
              while (i<paralength) do
               begin
-                if not assigned(currpara) then
+                if paraidx>=procdefinition.Paras.count then
                   internalerror(200306181);
-                if not currpara.is_hidden then
+                if not(vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) then
                   inc(i);
-                currpara:=tparaitem(currpara.next);
+                inc(paraidx);
               end;
-             while assigned(currpara) and currpara.is_hidden do
-               currpara:=tparaitem(currpara.next);
-             while assigned(currpara) do
+             while (paraidx<procdefinition.paras.count) and (vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) do
+               inc(paraidx);
+             while (paraidx<procdefinition.paras.count) do
               begin
-                if not assigned(currpara.defaultvalue) then
+                if not assigned(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym) then
                  internalerror(200212142);
-                left:=ccallparanode.create(genconstsymtree(tconstsym(currpara.defaultvalue)),left);
+                left:=ccallparanode.create(genconstsymtree(
+                    tconstsym(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym)),left);
                 { Ignore vs_hidden parameters }
                 repeat
-                  currpara:=tparaitem(currpara.next);
-                until (not assigned(currpara)) or (not currpara.is_hidden);
+                  inc(paraidx);
+                until (paraidx>=procdefinition.paras.count) or not(vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions);
               end;
            end;
 
@@ -1764,12 +1762,12 @@ type
 
          { Change loading of array of const to varargs }
          if assigned(left) and
-            is_array_of_const(tparaitem(procdefinition.para.last).paratype.def) and
+            is_array_of_const(tparavarsym(procdefinition.paras[procdefinition.paras.count-1]).vartype.def) and
             (procdefinition.proccalloption in [pocall_cppdecl,pocall_cdecl]) then
            convert_carg_array_of_const;
 
-         { bind paraitems to the callparanodes and insert hidden parameters }
-         bind_paraitem;
+         { bind parasyms to the callparanodes and insert hidden parameters }
+         bind_parasym;
 
          { methodpointer is only needed for virtual calls, and
            it should then be loaded with the VMT }
@@ -1819,7 +1817,7 @@ type
                 3. LOC_REGISTER with most registers
               For the moment we only look at the first parameter field. Combining it
               with multiple parameter fields will make things a lot complexer (PFV) }
-            currloc:=hpcurr.paraitem.paraloc[callerside].location^.loc;
+            currloc:=hpcurr.parasym.paraloc[callerside].location^.loc;
             hpprev:=nil;
             hp:=hpfirst;
             while assigned(hp) do
@@ -1827,7 +1825,7 @@ type
                 case currloc of
                   LOC_REFERENCE :
                     begin
-                      case hp.paraitem.paraloc[callerside].location^.loc of
+                      case hp.parasym.paraloc[callerside].location^.loc of
                         LOC_REFERENCE :
                           begin
                             { Offset is calculated like:
@@ -1841,7 +1839,7 @@ type
                             }
                             if (hpcurr.registersint>hp.registersint)
 {$ifdef x86}
-                               or (hpcurr.paraitem.paraloc[callerside].location^.reference.offset>hp.paraitem.paraloc[callerside].location^.reference.offset)
+                               or (hpcurr.parasym.paraloc[callerside].location^.reference.offset>hp.parasym.paraloc[callerside].location^.reference.offset)
 {$endif x86}
                                then
                               break;
@@ -1854,7 +1852,7 @@ type
                   LOC_FPUREGISTER,
                   LOC_REGISTER :
                     begin
-                      if (hp.paraitem.paraloc[callerside].location^.loc=currloc) and
+                      if (hp.parasym.paraloc[callerside].location^.loc=currloc) and
                          (hpcurr.registersint>hp.registersint) then
                         break;
                     end;
@@ -1885,7 +1883,7 @@ type
           begin
             paras := tcallparanode(left);
             while assigned(paras) and
-                  (paras.paraitem.parasym <> tloadnode(n).symtableentry) do
+                  (paras.parasym <> tloadnode(n).symtableentry) do
               paras := tcallparanode(paras.right);
             if assigned(paras) then
               begin
@@ -1987,23 +1985,23 @@ type
         para := tcallparanode(left);
         while assigned(para) do
           begin
-            if (para.paraitem.parasym.typ = paravarsym) and
+            if (para.parasym.typ = paravarsym) and
                { para.left will already be the same as funcretnode in the following case, so don't change }
-               (not(vo_is_funcret in tparavarsym(para.paraitem.parasym).varoptions) or
+               (not(vo_is_funcret in tparavarsym(para.parasym).varoptions) or
                 (not assigned(funcretnode))) then
               begin
                 { create temps for value parameters, function result and also for    }
                 { const parameters which are passed by value instead of by reference }
-                if (vo_is_funcret in tparavarsym(para.paraitem.parasym).varoptions) or
-                   (para.paraitem.paratyp = vs_value) or
-                   ((para.paraitem.paratyp = vs_const) and
+                if (vo_is_funcret in tparavarsym(para.parasym).varoptions) or
+                   (para.parasym.varspez = vs_value) or
+                   ((para.parasym.varspez = vs_const) and
                     (not paramanager.push_addr_param(vs_const,para.left.resulttype.def,procdefinition.proccalloption) or
                     { the problem is that we can't take the address of a function result :( }
                      (node_complexity(para.left) >= NODE_COMPLEXITY_INF))) then
                   begin
                     if (cs_regvars in aktglobalswitches) and
-                       (tparavarsym(para.paraitem.parasym).varregable<>vr_none) and
-                       (not tparavarsym(para.paraitem.parasym).vartype.def.needs_inittable) then
+                       (tparavarsym(para.parasym).varregable<>vr_none) and
+                       (not tparavarsym(para.parasym).vartype.def.needs_inittable) then
                       tempnode := ctempcreatenode.create_reg(para.left.resulttype,para.left.resulttype.def.size,tt_persistent)
                     else
                       tempnode := ctempcreatenode.create(para.left.resulttype,para.left.resulttype.def.size,tt_persistent);
@@ -2011,7 +2009,7 @@ type
                     { assign the value of the parameter to the temp, except in case of the function result }
                     { (in that case, para.left is a block containing the creation of a new temp, while we  }
                     {  only need a temprefnode, so delete the old stuff)                                   }
-                    if not(vo_is_funcret in tparavarsym(para.paraitem.parasym).varoptions) then
+                    if not(vo_is_funcret in tparavarsym(para.parasym).varoptions) then
                       begin
                         addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
                           para.left));
@@ -2030,7 +2028,7 @@ type
                 else if node_complexity(para.left) > 1 then
                   begin
                     if (cs_regvars in aktglobalswitches) and
-                       not tparavarsym(para.paraitem.parasym).vartype.def.needs_inittable then
+                       not tparavarsym(para.parasym).vartype.def.needs_inittable then
                       tempnode := ctempcreatenode.create_reg(voidpointertype,voidpointertype.def.size,tt_persistent)
                     else
                       tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.def.size,tt_persistent);
@@ -2370,8 +2368,8 @@ type
         ppn:=tcallparanode(left);
         while assigned(ppn) do
           begin
-            if not(assigned(ppn.paraitem) and
-                   ppn.paraitem.is_hidden) then
+            if not(assigned(ppn.parasym) and
+                   (vo_is_hidden_para in ppn.parasym.varoptions)) then
               inc(result);
             ppn:=tcallparanode(ppn.right);
           end;
@@ -2415,7 +2413,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.259  2004-11-09 17:26:47  peter
+  Revision 1.260  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.259  2004/11/09 17:26:47  peter
     * fixed wrong typecasts
 
   Revision 1.258  2004/11/08 22:09:58  peter

compiler/ncgcal.pas

@@ -78,7 +78,7 @@ implementation
     uses
       systems,
       cutils,verbose,globals,
-      symconst,symsym,symtable,defutil,paramgr,
+      symconst,symtable,defutil,paramgr,
 {$ifdef GDB}
       strings,
       gdb,
@@ -292,9 +292,9 @@ implementation
         else
          begin
            { copy the value on the stack or use normal parameter push?
-             Check for varargs first because that has no paraitem }
+             Check for varargs first because that has no parasym }
            if not(cpf_varargs_para in callparaflags) and
-              paramanager.copy_value_on_stack(paraitem.paratyp,left.resulttype.def,
+              paramanager.copy_value_on_stack(parasym.varspez,left.resulttype.def,
                   aktcallnode.procdefinition.proccalloption) then
             begin
 {$ifdef i386}
@@ -351,10 +351,7 @@ implementation
          oflabel : tasmlabel;
          hp      : tnode;
       begin
-         if not(assigned(paraitem)) or
-            not(assigned(paraitem.paratype.def)) or
-            not(assigned(paraitem.parasym) or
-                (cpf_varargs_para in callparaflags)) then
+         if not(assigned(parasym)) then
            internalerror(200304242);
 
          { Skip nothingn nodes which are used after disabling
@@ -368,11 +365,11 @@ implementation
              secondpass(left);
 
              if not(assigned(aktcallnode.inlinecode)) then
-               paramanager.createtempparaloc(exprasmlist,aktcallnode.procdefinition.proccalloption,paraitem,tempcgpara)
+               paramanager.createtempparaloc(exprasmlist,aktcallnode.procdefinition.proccalloption,parasym,tempcgpara)
              else
-               paramanager.duplicateparaloc(exprasmlist,aktcallnode.procdefinition.proccalloption,paraitem,tempcgpara);
+               paramanager.duplicateparaloc(exprasmlist,aktcallnode.procdefinition.proccalloption,parasym,tempcgpara);
 
-             { handle varargs first, because paraitem.parasym is not valid }
+             { handle varargs first, because parasym is not valid }
              if (cpf_varargs_para in callparaflags) then
                begin
                  if paramanager.push_addr_param(vs_value,left.resulttype.def,
@@ -382,23 +379,23 @@ implementation
                    push_value_para;
                end
              { hidden parameters }
-             else if paraitem.is_hidden then
+             else if (vo_is_hidden_para in parasym.varoptions) then
                begin
                  { don't push a node that already generated a pointer type
                    by address for implicit hidden parameters }
-                 if (vo_is_funcret in tparavarsym(paraitem.parasym).varoptions) or
+                 if (vo_is_funcret in parasym.varoptions) or
                     (not(left.resulttype.def.deftype in [pointerdef,classrefdef]) and
-                     paramanager.push_addr_param(paraitem.paratyp,paraitem.paratype.def,
+                     paramanager.push_addr_param(parasym.varspez,parasym.vartype.def,
                          aktcallnode.procdefinition.proccalloption)) then
                    push_addr_para
                  else
                    push_value_para;
                end
              { formal def }
-             else if (paraitem.paratype.def.deftype=formaldef) then
+             else if (parasym.vartype.def.deftype=formaldef) then
                begin
                   { allow passing of a constant to a const formaldef }
-                  if (tparavarsym(paraitem.parasym).varspez=vs_const) and
+                  if (parasym.varspez=vs_const) and
                      (left.location.loc=LOC_CONSTANT) then
                     location_force_mem(exprasmlist,left.location);
 
@@ -418,10 +415,10 @@ implementation
                  { don't push a node that already generated a pointer type
                    by address for implicit hidden parameters }
                  if (not(
-                         paraitem.is_hidden and
+                         (vo_is_hidden_para in parasym.varoptions) and
                          (left.resulttype.def.deftype in [pointerdef,classrefdef])
                         ) and
-                     paramanager.push_addr_param(paraitem.paratyp,paraitem.paratype.def,
+                     paramanager.push_addr_param(parasym.varspez,parasym.vartype.def,
                          aktcallnode.procdefinition.proccalloption)) then
                    begin
                       { Passing a var parameter to a var parameter, we can
@@ -437,7 +434,7 @@ implementation
                       else
                         begin
                           { Check for passing a constant to var,out parameter }
-                          if (paraitem.paratyp in [vs_var,vs_out]) and
+                          if (parasym.varspez in [vs_var,vs_out]) and
                              (left.location.loc<>LOC_REFERENCE) then
                            begin
                              { passing self to a var parameter is allowed in
@@ -460,8 +457,8 @@ implementation
 
              { update return location in callnode when this is the function
                result }
-             if assigned(paraitem.parasym) and
-                (vo_is_funcret in tparavarsym(paraitem.parasym).varoptions) then
+             if assigned(parasym) and
+                (vo_is_funcret in parasym.varoptions) then
                location_copy(aktcallnode.location,left.location);
            end;
 
@@ -662,8 +659,8 @@ implementation
              if assigned(ppn.left) then
                begin
                  { don't release the funcret temp }
-                 if not(assigned(ppn.paraitem.parasym)) or
-                    not(vo_is_funcret in tparavarsym(ppn.paraitem.parasym).varoptions) then
+                 if not(assigned(ppn.parasym)) or
+                    not(vo_is_funcret in ppn.parasym.varoptions) then
                    location_freetemp(exprasmlist,ppn.left.location);
                  { process also all nodes of an array of const }
                  if ppn.left.nodetype=arrayconstructorn then
@@ -706,7 +703,7 @@ implementation
                  if not assigned(inlinecode) then
                    paramanager.freeparaloc(exprasmlist,ppn.tempcgpara);
                  tmpparaloc:=ppn.tempcgpara.location;
-                 callerparaloc:=ppn.paraitem.paraloc[callerside].location;
+                 callerparaloc:=ppn.parasym.paraloc[callerside].location;
                  while assigned(callerparaloc) do
                    begin
                      { Every paraloc must have a matching tmpparaloc }
@@ -787,8 +784,8 @@ implementation
          while assigned(ppn) do
            begin
              if not assigned(inlinecode) or
-                (ppn.paraitem.paraloc[callerside].location^.loc <> LOC_REFERENCE) then
-               paramanager.freeparaloc(exprasmlist,ppn.paraitem.paraloc[callerside]);
+                (ppn.parasym.paraloc[callerside].location^.loc <> LOC_REFERENCE) then
+               paramanager.freeparaloc(exprasmlist,ppn.parasym.paraloc[callerside]);
              ppn:=tcgcallparanode(ppn.right);
            end;
        end;
@@ -863,7 +860,7 @@ implementation
                  location_force_reg(exprasmlist,methodpointer.location,OS_ADDR,false);
 
                  { virtual methods require an index }
-                 if tprocdef(procdefinition).extnumber=-1 then
+                 if tprocdef(procdefinition).extnumber=$ffff then
                    internalerror(200304021);
                  { VMT should already be loaded in a register }
                  if methodpointer.location.register=NR_NO then
@@ -1253,7 +1250,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.184  2004-11-08 22:09:59  peter
+  Revision 1.185  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.184  2004/11/08 22:09:59  peter
     * tvarsym splitted
 
   Revision 1.183  2004/11/01 17:41:28  florian

compiler/ncgutil.pas

@@ -940,7 +940,6 @@ implementation
       var
         list : TAAsmoutput;
         href : treference;
-        l : tlocation;
       begin
         if not(tsym(p).typ=paravarsym) then
           exit;
@@ -1271,7 +1270,8 @@ implementation
          end;
 
       var
-        hp      : tparaitem;
+        i : integer;
+        currpara : tparavarsym;
         paraloc : pcgparalocation;
 {$ifdef sparc}
         tempref,
@@ -1282,30 +1282,29 @@ implementation
           exit;
 
         { Allocate registers used by parameters }
-        hp:=tparaitem(current_procinfo.procdef.para.first);
-        while assigned(hp) do
+        for i:=0 to current_procinfo.procdef.paras.count-1 do
           begin
-            paraloc:=hp.paraloc[calleeside].location;
+            currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
+            paraloc:=currpara.paraloc[calleeside].location;
             while assigned(paraloc) do
               begin
                 if paraloc^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER] then
                   get_para(paraloc^);
                 paraloc:=paraloc^.next;
               end;
-            hp:=tparaitem(hp.next);
           end;
 
         { Copy parameters to local references/registers }
-        hp:=tparaitem(current_procinfo.procdef.para.first);
-        while assigned(hp) do
+        for i:=0 to current_procinfo.procdef.paras.count-1 do
           begin
-            paraloc:=hp.paraloc[calleeside].location;
+            currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
+            paraloc:=currpara.paraloc[calleeside].location;
             if not assigned(paraloc) then
               internalerror(200408203);
-            case tabstractnormalvarsym(hp.parasym).localloc.loc of
+            case currpara.localloc.loc of
               LOC_REFERENCE :
                 begin
-                  href:=tparavarsym(hp.parasym).localloc.reference;
+                  href:=currpara.localloc.reference;
                   while assigned(paraloc) do
                     begin
                       unget_para(paraloc^);
@@ -1317,28 +1316,28 @@ implementation
               LOC_CREGISTER :
                 begin
 {$ifndef cpu64bit}
-                  if tparavarsym(hp.parasym).localloc.size in [OS_64,OS_S64] then
+                  if currpara.localloc.size in [OS_64,OS_S64] then
                     begin
                       { First 32bits }
                       unget_para(paraloc^);
                       if (target_info.endian=ENDIAN_BIG) then
-                        gen_load_reg(paraloc^,tparavarsym(hp.parasym).localloc.register64.reghi)
+                        gen_load_reg(paraloc^,currpara.localloc.register64.reghi)
                       else
-                        gen_load_reg(paraloc^,tparavarsym(hp.parasym).localloc.register64.reglo);
+                        gen_load_reg(paraloc^,currpara.localloc.register64.reglo);
                       { Second 32bits }
                       if not assigned(paraloc^.next) then
                         internalerror(200410104);
                       unget_para(paraloc^);
                       if (target_info.endian=ENDIAN_BIG) then
-                        gen_load_reg(paraloc^,tparavarsym(hp.parasym).localloc.register64.reglo)
+                        gen_load_reg(paraloc^,currpara.localloc.register64.reglo)
                       else
-                        gen_load_reg(paraloc^,tparavarsym(hp.parasym).localloc.register64.reghi);
+                        gen_load_reg(paraloc^,currpara.localloc.register64.reghi);
                     end
                   else
 {$endif cpu64bit}
                     begin
                       unget_para(paraloc^);
-                      gen_load_reg(paraloc^,tparavarsym(hp.parasym).localloc.register);
+                      gen_load_reg(paraloc^,currpara.localloc.register);
                       if assigned(paraloc^.next) then
                         internalerror(200410105);
                     end;
@@ -1348,7 +1347,7 @@ implementation
 {$ifdef sparc}
                   { Sparc passes floats in int registers, when loading to fpu register
                     we need a temp }
-                  tg.GetTemp(list,TCGSize2Size[tparavarsym(hp.parasym).localloc.size],tt_normal,tempref);
+                  tg.GetTemp(list,TCGSize2Size[currpara.localloc.size],tt_normal,tempref);
                   href:=tempref;
                   while assigned(paraloc) do
                     begin
@@ -1357,11 +1356,11 @@ implementation
                       inc(href.offset,TCGSize2Size[paraloc^.size]);
                       paraloc:=paraloc^.next;
                     end;
-                  cg.a_loadfpu_ref_reg(list,tparavarsym(hp.parasym).localloc.size,tempref,tparavarsym(hp.parasym).localloc.register);
+                  cg.a_loadfpu_ref_reg(list,currpara.localloc.size,tempref,currpara.localloc.register);
                   tg.UnGetTemp(list,tempref);
 {$else sparc}
                   unget_para(paraloc^);
-                  gen_load_reg(paraloc^,tparavarsym(hp.parasym).localloc.register);
+                  gen_load_reg(paraloc^,currpara.localloc.register);
                   if assigned(paraloc^.next) then
                     internalerror(200410109);
 {$endif sparc}
@@ -1369,12 +1368,11 @@ implementation
               LOC_CMMREGISTER :
                 begin
                   unget_para(paraloc^);
-                  gen_load_reg(paraloc^,tparavarsym(hp.parasym).localloc.register);
+                  gen_load_reg(paraloc^,currpara.localloc.register);
                   if assigned(paraloc^.next) then
                     internalerror(200410108);
                 end;
             end;
-            hp:=tparaitem(hp.next);
           end;
 
         { generate copies of call by value parameters, must be done before
@@ -1859,7 +1857,7 @@ implementation
                     if (sym.typ=paravarsym) and
                        (po_assembler in current_procinfo.procdef.procoptions) then
                       begin
-                        tparavarsym(sym).paraitem.paraloc[calleeside].get_location(localloc);
+                        tparavarsym(sym).paraloc[calleeside].get_location(localloc);
                       end
                     else
                       begin
@@ -1914,10 +1912,10 @@ implementation
                               parasymtable :
                                 begin
                                   { Reuse the parameter location for values to are at a single location on the stack }
-                                  if (tparavarsym(sym).paraitem.paraloc[calleeside].is_simple_reference) then
+                                  if (tparavarsym(sym).paraloc[calleeside].is_simple_reference) then
                                     begin
-                                      reference_reset_base(localloc.reference,tparavarsym(sym).paraitem.paraloc[calleeside].location^.reference.index,
-                                          tparavarsym(sym).paraitem.paraloc[calleeside].location^.reference.offset);
+                                      reference_reset_base(localloc.reference,tparavarsym(sym).paraloc[calleeside].location^.reference.index,
+                                          tparavarsym(sym).paraloc[calleeside].location^.reference.offset);
                                     end
                                   else
                                     begin
@@ -2025,8 +2023,8 @@ implementation
                     localloc.loc:=LOC_REFERENCE;
                     localloc.size:=int_cgsize(paramanager.push_size(varspez,vartype.def,pocall_inline));
                     tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
-                    calleeparaloc:=paraitem.paraloc[calleeside].location;
-                    callerparaloc:=paraitem.paraloc[callerside].location;
+                    calleeparaloc:=paraloc[calleeside].location;
+                    callerparaloc:=paraloc[callerside].location;
                     while assigned(calleeparaloc) do
                       begin
                         if not assigned(callerparaloc) then
@@ -2212,7 +2210,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.240  2004-11-11 19:31:33  peter
+  Revision 1.241  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.240  2004/11/11 19:31:33  peter
     * fixed compile of powerpc,sparc,arm
 
   Revision 1.239  2004/11/09 17:26:47  peter

compiler/nmem.pas

@@ -28,8 +28,7 @@ interface
 
     uses
        node,
-       symdef,symsym,symtable,symtype,
-       cpubase;
+       symdef,symsym,symtable,symtype;
 
     type
        tloadvmtaddrnode = class(tunarynode)
@@ -128,7 +127,7 @@ implementation
 
     uses
       globtype,systems,
-      cutils,verbose,globals,
+      cutils,cclasses,verbose,globals,
       symconst,symbase,defutil,defcmp,
       nbas,nutils,
       htypechk,pass_1,ncal,nld,ncon,ncnv,cgbase,procinfo
@@ -302,10 +301,29 @@ implementation
       end;
 
 
+    procedure copyparasym(p:TNamedIndexItem;arg:pointer);
+      var
+        newparast : tsymtable absolute arg;
+        vs : tparavarsym;
+      begin
+        if tsym(p).typ<>paravarsym then
+          exit;
+        with tparavarsym(p) do
+          begin
+            vs:=tparavarsym.create(realname,paranr,varspez,vartype);
+            vs.varoptions:=varoptions;
+//            vs.paraloc[callerside]:=paraloc[callerside].getcopy;
+//            vs.paraloc[callerside]:=paraloc[callerside].getcopy;
+            vs.defaultconstsym:=defaultconstsym;
+            newparast.insert(vs);
+          end;
+      end;
+
+
     function taddrnode.det_resulttype:tnode;
       var
          hp  : tnode;
-         hp2 : TParaItem;
+         hp2 : TParavarsym;
          hp3 : tabstractprocdef;
       begin
         result:=nil;
@@ -395,7 +413,6 @@ implementation
                  else
                   hp3:=tabstractprocdef(tprocsym(tloadnode(left).symtableentry).first_procdef);
 
-
                  { create procvardef }
                  resulttype.setdef(tprocvardef.create(hp3.parast.symtablelevel));
                  tprocvardef(resulttype.def).proctypeoption:=hp3.proctypeoption;
@@ -412,14 +429,11 @@ implementation
                  if not assigned(tloadnode(left).left) then
                    include(tprocvardef(resulttype.def).procoptions,po_addressonly);
 
-                 { Add parameters in left to right order }
-                 hp2:=TParaItem(hp3.Para.first);
-                 while assigned(hp2) do
-                   begin
-                      tprocvardef(resulttype.def).concatpara(nil,hp2.paratype,hp2.parasym,
-                          hp2.defaultvalue,hp2.is_hidden);
-                      hp2:=TParaItem(hp2.next);
-                   end;
+                 { Add parameters use only references, we don't need to keep the
+                   parast. We use the parast from the original function to calculate
+                   our parameter data and reset it afterwards }
+                 hp3.parast.foreach_static(@copyparasym,tprocvardef(resulttype.def).parast);
+                 tprocvardef(resulttype.def).calcparas;
               end
             else
               resulttype:=voidpointertype;
@@ -982,7 +996,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.88  2004-11-08 22:09:59  peter
+  Revision 1.89  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.88  2004/11/08 22:09:59  peter
     * tvarsym splitted
 
   Revision 1.87  2004/11/02 12:55:16  peter

compiler/nobj.pas

@@ -649,7 +649,7 @@ implementation
                                 begin
                                   if procdefcoll^.visible and
                                      (not(pdoverload or hasoverloads) or
-                                      (compare_paras(procdefcoll^.data.para,pd.para,cp_all,[])>=te_equal)) then
+                                      (compare_paras(procdefcoll^.data.paras,pd.paras,cp_all,[])>=te_equal)) then
                                    begin
                                      if is_visible then
                                        procdefcoll^.hidden:=true;
@@ -667,7 +667,7 @@ implementation
                                    begin
                                      { we start a new virtual tree, hide the old }
                                      if (not(pdoverload or hasoverloads) or
-                                         (compare_paras(procdefcoll^.data.para,pd.para,cp_all,[])>=te_equal)) and
+                                         (compare_paras(procdefcoll^.data.paras,pd.paras,cp_all,[])>=te_equal)) and
                                         (procdefcoll^.visible) then
                                       begin
                                         if is_visible then
@@ -677,7 +677,7 @@ implementation
                                       end;
                                    end
                                   { same parameters }
-                                  else if (compare_paras(procdefcoll^.data.para,pd.para,cp_all,[])>=te_equal) then
+                                  else if (compare_paras(procdefcoll^.data.paras,pd.paras,cp_all,[])>=te_equal) then
                                    begin
                                      { overload is inherited }
                                      if (po_overload in procdefcoll^.data.procoptions) then
@@ -754,7 +754,7 @@ implementation
                                     if the new defintion has not the overload directive }
                                   if is_visible and
                                      ((not(pdoverload or hasoverloads)) or
-                                      (compare_paras(procdefcoll^.data.para,pd.para,cp_all,[])>=te_equal)) then
+                                      (compare_paras(procdefcoll^.data.paras,pd.paras,cp_all,[])>=te_equal)) then
                                     procdefcoll^.hidden:=true;
                                 end;
                              end
@@ -764,7 +764,7 @@ implementation
                                  has not the overload directive }
                                if is_visible and
                                   ((not pdoverload) or
-                                   (compare_paras(procdefcoll^.data.para,pd.para,cp_all,[])>=te_equal)) then
+                                   (compare_paras(procdefcoll^.data.paras,pd.paras,cp_all,[])>=te_equal)) then
                                  procdefcoll^.hidden:=true;
                              end;
                           end; { not hidden }
@@ -1091,7 +1091,7 @@ implementation
             for i:=1 to tprocsym(sym).procdef_count do
               begin
                 implprocdef:=tprocsym(sym).procdef[i];
-                if (compare_paras(proc.para,implprocdef.para,cp_none,[])>=te_equal) and
+                if (compare_paras(proc.paras,implprocdef.paras,cp_none,[])>=te_equal) and
                    (proc.proccalloption=implprocdef.proccalloption) then
                   begin
                     gintfgetcprocdef:=implprocdef;
@@ -1375,10 +1375,9 @@ implementation
         end;
       hsym:=tsym(procdef.parast.search('self'));
       if not(assigned(hsym) and
-             (hsym.typ=paravarsym) and
-             assigned(tparavarsym(hsym).paraitem)) then
+             (hsym.typ=paravarsym)) then
         internalerror(200305251);
-      paraloc:=tparavarsym(hsym).paraitem.paraloc[callerside].location^;
+      paraloc:=tparavarsym(hsym).paraloc[callerside].location^;
       case paraloc.loc of
         LOC_REGISTER:
           cg.a_op_const_reg(exprasmlist,OP_SUB,paraloc.size,ioffset,paraloc.register);
@@ -1400,7 +1399,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.80  2004-11-08 22:09:59  peter
+  Revision 1.81  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.80  2004/11/08 22:09:59  peter
     * tvarsym splitted
 
   Revision 1.79  2004/10/24 13:35:39  peter

compiler/parabase.pas

@@ -57,6 +57,7 @@ unit parabase;
           constructor init;
           destructor  done;
           procedure   reset;
+          function    getcopy:tcgpara;
           procedure   check_simple_location;
           function    is_simple_reference:boolean;
           function    add_location:pcgparalocation;
@@ -67,7 +68,7 @@ unit parabase;
          va_uses_float_reg
        );
 
-       tvarargspara = class(tlinkedlist)
+       tvarargsparalist = class(tlist)
           varargsinfo : set of tvarargsinfo;
 {$ifdef x86_64}
           { x86_64 requires %al to contain the no. SSE regs passed }
@@ -116,6 +117,23 @@ implementation
       end;
 
 
+    function tcgpara.getcopy:tcgpara;
+      var
+        hlocation : pcgparalocation;
+      begin
+        result.init;
+        while assigned(location) do
+          begin
+            hlocation:=result.add_location;
+            hlocation^:=location^;
+            hlocation^.next:=nil;
+            location:=location^.next;
+          end;
+        result.alignment:=alignment;
+        result.size:=size;
+      end;
+
+
     function tcgpara.add_location:pcgparalocation;
       var
         prevlocation,
@@ -208,7 +226,11 @@ end.
 
 {
    $Log$
-   Revision 1.4  2004-10-31 21:45:03  peter
+   Revision 1.5  2004-11-15 23:35:31  peter
+     * tparaitem removed, use tparavarsym instead
+     * parameter order is now calculated from paranr value in tparavarsym
+
+   Revision 1.4  2004/10/31 21:45:03  peter
      * generic tlocation
      * move tlocation to cgutils
 

compiler/paramgr.pas

@@ -33,7 +33,7 @@ unit paramgr;
        cpubase,cgbase,
        parabase,
        aasmtai,
-       symconst,symtype,symdef;
+       symconst,symtype,symsym,symdef;
 
     type
        {# This class defines some methods to take care of routine
@@ -109,12 +109,12 @@ unit paramgr;
             for the routine that are passed as varargs. It returns
             the size allocated on the stack (including the normal parameters)
           }
-          function  create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargspara):longint;virtual;abstract;
+          function  create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;virtual;abstract;
 
-          procedure createtempparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var cgpara:TCGPara);virtual;
-          procedure duplicateparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var cgpara:TCGPara);
+          procedure createtempparaloc(list: taasmoutput;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);virtual;
+          procedure duplicateparaloc(list: taasmoutput;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);
 
-          function parseparaloc(paraitem : tparaitem;const s : string) : boolean;virtual;abstract;
+          function parseparaloc(parasym : tparavarsym;const s : string) : boolean;virtual;abstract;
        end;
 
 
@@ -366,7 +366,7 @@ implementation
       end;
 
 
-    procedure tparamanager.createtempparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var cgpara:TCGPara);
+    procedure tparamanager.createtempparaloc(list: taasmoutput;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);
       var
         href : treference;
         len  : aint;
@@ -374,13 +374,13 @@ implementation
         newparaloc : pcgparalocation;
       begin
         cgpara.reset;
-        cgpara.size:=paraitem.paraloc[callerside].size;
-        cgpara.alignment:=paraitem.paraloc[callerside].alignment;
-        paraloc:=paraitem.paraloc[callerside].location;
+        cgpara.size:=parasym.paraloc[callerside].size;
+        cgpara.alignment:=parasym.paraloc[callerside].alignment;
+        paraloc:=parasym.paraloc[callerside].location;
         while assigned(paraloc) do
           begin
             if paraloc^.size=OS_NO then
-              len:=push_size(paraitem.paratyp,paraitem.paratype.def,calloption)
+              len:=push_size(parasym.varspez,parasym.vartype.def,calloption)
             else
               len:=tcgsize2size[paraloc^.size];
             newparaloc:=cgpara.add_location;
@@ -412,15 +412,15 @@ implementation
       end;
 
 
-    procedure tparamanager.duplicateparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var cgpara:TCGPara);
+    procedure tparamanager.duplicateparaloc(list: taasmoutput;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);
       var
         paraloc,
         newparaloc : pcgparalocation;
       begin
         cgpara.reset;
-        cgpara.size:=paraitem.paraloc[callerside].size;
-        cgpara.alignment:=paraitem.paraloc[callerside].alignment;
-        paraloc:=paraitem.paraloc[callerside].location;
+        cgpara.size:=parasym.paraloc[callerside].size;
+        cgpara.alignment:=parasym.paraloc[callerside].alignment;
+        paraloc:=parasym.paraloc[callerside].location;
         while assigned(paraloc) do
           begin
             newparaloc:=cgpara.add_location;
@@ -447,7 +447,11 @@ end.
 
 {
    $Log$
-   Revision 1.80  2004-10-31 21:45:03  peter
+   Revision 1.81  2004-11-15 23:35:31  peter
+     * tparaitem removed, use tparavarsym instead
+     * parameter order is now calculated from paranr value in tparavarsym
+
+   Revision 1.80  2004/10/31 21:45:03  peter
      * generic tlocation
      * move tlocation to cgutils
 

compiler/pdecl.pas

@@ -197,7 +197,7 @@ implementation
                       { support p : procedure;stdcall=nil; }
                       if try_to_consume(_SEMICOLON) then
                        begin
-                         if is_proc_directive(token,true) then
+                         if check_proc_directive(true) then
                           parse_var_proc_directives(sym)
                          else
                           begin
@@ -208,7 +208,7 @@ implementation
                       else
                       { support p : procedure stdcall=nil; }
                        begin
-                         if is_proc_directive(token,true) then
+                         if check_proc_directive(true) then
                           parse_var_proc_directives(sym);
                        end;
                       { add default calling convention }
@@ -484,7 +484,7 @@ implementation
                      consume(_SEMICOLON)
                     else
                      begin
-                       if not is_proc_directive(token,true) then
+                       if not check_proc_directive(true) then
                         consume(_SEMICOLON);
                        parse_var_proc_directives(tsym(newtype));
                        handle_calling_convention(tprocvardef(tt.def));
@@ -653,7 +653,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.90  2004-11-08 22:09:59  peter
+  Revision 1.91  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.90  2004/11/08 22:09:59  peter
     * tvarsym splitted
 
   Revision 1.89  2004/10/15 09:14:17  mazen

compiler/pdecsub.pas

@@ -42,7 +42,7 @@ interface
       );
       tpdflags=set of tpdflag;
 
-    function is_proc_directive(tok:ttoken;isprocvar:boolean):boolean;
+    function  check_proc_directive(isprocvar:boolean):boolean;
 
     procedure calc_parast(pd:tabstractprocdef);
 
@@ -94,6 +94,7 @@ implementation
       var
         storepos : tfileposinfo;
         vs       : tparavarsym;
+        paranr   : word;
       begin
         if not(pd.proctypeoption in [potype_constructor,potype_destructor]) and
            not is_void(pd.rettype.def) and
@@ -103,15 +104,16 @@ implementation
            if pd.deftype=procdef then
             akttokenpos:=tprocdef(pd).fileinfo;
 
-           { Generate result variable accessing function result }
-           vs:=tparavarsym.create('$result',vs_var,pd.rettype);
-           include(vs.varoptions,vo_is_funcret);
-           pd.parast.insert(vs);
            { For left to right add it at the end to be delphi compatible }
            if pd.proccalloption in pushleftright_pocalls then
-             pd.concatpara(nil,vs.vartype,vs,nil,true)
+             paranr:=paranr_result_leftright
            else
-             pd.insertpara(vs.vartype,vs,nil,true);
+             paranr:=paranr_result;
+           { Generate result variable accessing function result }
+           vs:=tparavarsym.create('$result',paranr,vs_var,pd.rettype);
+           include(vs.varoptions,vo_is_funcret);
+           include(vs.varoptions,vo_is_hidden_para);
+           pd.parast.insert(vs);
            { Store the this symbol as funcretsym for procedures }
            if pd.deftype=procdef then
             tprocdef(pd).funcretsym:=vs;
@@ -135,11 +137,11 @@ implementation
             { Generate result variable accessing function result, it
               can't be put in a register since it must be accessable
               from the framepointer }
-            vs:=tparavarsym.create('$parentfp',vs_var,voidpointertype);
+            vs:=tparavarsym.create('$parentfp',paranr_parentfp,vs_var,voidpointertype);
             include(vs.varoptions,vo_is_parentfp);
+            include(vs.varoptions,vo_is_hidden_para);
             vs.varregable:=vr_none;
             pd.parast.insert(vs);
-            pd.insertpara(vs.vartype,vs,nil,true);
 
             akttokenpos:=storepos;
           end;
@@ -158,11 +160,10 @@ implementation
           begin
             { Generate self variable }
             tt:=voidpointertype;
-            vs:=tparavarsym.create('$self',vs_value,tt);
+            vs:=tparavarsym.create('$self',paranr_self,vs_value,tt);
             include(vs.varoptions,vo_is_self);
-            { Insert as hidden parameter }
+            include(vs.varoptions,vo_is_hidden_para);
             pd.parast.insert(vs);
-            pd.insertpara(vs.vartype,vs,nil,true);
           end
         else
           begin
@@ -179,11 +180,10 @@ implementation
                    { can't use classrefdef as type because inheriting
                      will then always file because of a type mismatch }
                    tt:=voidpointertype;
-                   vs:=tparavarsym.create('$vmt',vs_value,tt);
+                   vs:=tparavarsym.create('$vmt',paranr_vmt,vs_value,tt);
                    include(vs.varoptions,vo_is_vmt);
-                   { Insert as hidden parameter }
+                   include(vs.varoptions,vo_is_hidden_para);
                    pd.parast.insert(vs);
-                   pd.insertpara(vs.vartype,vs,nil,true);
                  end;
 
                 { Generate self variable, for classes we need
@@ -202,11 +202,10 @@ implementation
                       vsp:=vs_var;
                     tt.setdef(tprocdef(pd)._class);
                   end;
-                vs:=tparavarsym.create('$self',vsp,tt);
+                vs:=tparavarsym.create('$self',paranr_self,vsp,tt);
                 include(vs.varoptions,vo_is_self);
-                { Insert as hidden parameter }
+                include(vs.varoptions,vo_is_hidden_para);
                 pd.parast.insert(vs);
-                pd.insertpara(vs.vartype,vs,nil,true);
 
                 akttokenpos:=storepos;
               end;
@@ -269,43 +268,46 @@ implementation
       end;
 
 
-    procedure insert_hidden_para(pd:tabstractprocdef);
+    procedure insert_hidden_para(p:tnamedindexitem;arg:pointer);
       var
-        currpara : tparaitem;
         hvs : tparavarsym;
+        pd  : tabstractprocdef absolute arg;
       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
+        if (tsym(p).typ<>paravarsym) then
+         exit;
+        with tparavarsym(p) do
          begin
+           { We need a local copy for a value parameter when only the
+             address is pushed. Open arrays and Array of Const are
+             an exception because they are allocated at runtime and the
+             address that is pushed is patched }
+           if (varspez=vs_value) and
+              paramanager.push_addr_param(varspez,vartype.def,pd.proccalloption) and
+              not(is_open_array(vartype.def) or
+                  is_array_of_const(vartype.def)) then
+             include(varoptions,vo_has_local_copy);
+
            { needs high parameter ? }
-           if paramanager.push_high_param(currpara.paratyp,currpara.paratype.def,pd.proccalloption) then
-            begin
-              if assigned(currpara.parasym) then
-               begin
-                 hvs:=tparavarsym.create('$high'+tparavarsym(currpara.parasym).name,vs_const,sinttype);
-                 include(hvs.varoptions,vo_is_high_value);
-                 tparavarsym(currpara.parasym).owner.insert(hvs);
-               end
-              else
-               hvs:=nil;
-              pd.concatpara(currpara,sinttype,hvs,nil,true);
-            end
+           if paramanager.push_high_param(varspez,vartype.def,pd.proccalloption) then
+             begin
+               hvs:=tparavarsym.create('$high'+name,paranr+1,vs_const,sinttype);
+               include(hvs.varoptions,vo_is_high_para);
+               include(hvs.varoptions,vo_is_hidden_para);
+               owner.insert(hvs);
+             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.paratyp,currpara.paratype.def,pocall_default) then
+                 paramanager.push_high_param(varspez,vartype.def,pocall_default) then
                begin
-                 if is_open_string(currpara.paratype.def) then
+                 if is_open_string(vartype.def) then
                     Message(parser_w_cdecl_no_openstring);
                  if not (po_external in pd.procoptions) then
                    Message(parser_w_cdecl_has_no_high);
                end;
             end;
-           currpara:=tparaitem(currpara.previous);
          end;
       end;
 
@@ -328,7 +330,7 @@ implementation
                  if is_array_of_const(vartype.def) and
                     assigned(indexnext) and
                     (tsym(indexnext).typ=paravarsym) and
-                    not(vo_is_high_value in tparavarsym(indexnext).varoptions) then
+                    not(vo_is_high_para in tparavarsym(indexnext).varoptions) then
                    Message(parser_e_C_array_of_const_must_be_last);
                end;
             end;
@@ -336,6 +338,31 @@ implementation
       end;
 
 
+    procedure check_inline_para(p:tnamedindexitem;arg:pointer);
+      var
+        pd : tabstractprocdef absolute arg;
+      begin
+        if (pd.proccalloption<>pocall_inline) or
+           (tsym(p).typ<>paravarsym) then
+         exit;
+        with tparavarsym(p) do
+         begin
+           case vartype.def.deftype of
+             arraydef :
+               begin
+                 with tarraydef(vartype.def) do
+                   if IsVariant or IsConstructor then
+                     begin
+                       Message1(parser_w_not_supported_for_inline,'array of const');
+                       Message(parser_w_inlining_disabled);
+                       pd.proccalloption:=pocall_default;
+                     end;
+               end;
+           end;
+         end;
+      end;
+
+
     procedure set_addr_param_regable(p:tnamedindexitem;arg:pointer);
       begin
         if (tsym(p).typ<>paravarsym) then
@@ -367,6 +394,7 @@ implementation
         currparast : tparasymtable;
         explicit_paraloc : boolean;
         locationstr : string;
+        paranr : integer;
       begin
         explicit_paraloc:=false;
         consume(_LKLAMMER);
@@ -380,6 +408,7 @@ implementation
         { reset }
         sc:=tsinglelist.create;
         defaultrequired:=false;
+        paranr:=0;
         { the variables are always public }
         old_object_option:=current_object_option;
         current_object_option:=[sp_public];
@@ -410,7 +439,8 @@ implementation
           { read identifiers and insert with error type }
           sc.reset;
           repeat
-            vs:=tparavarsym.create(orgpattern,varspez,generrortype);
+            inc(paranr);
+            vs:=tparavarsym.create(orgpattern,paranr*10,varspez,generrortype);
             currparast.insert(vs);
             if assigned(vs.owner) then
              sc.insert(vs)
@@ -534,7 +564,7 @@ implementation
            begin
              { update varsym }
              vs.vartype:=tt;
-             pd.concatpara(nil,tt,vs,defaultvalue,false);
+             vs.defaultconstsym:=defaultvalue;
 
              if (target_info.system in [system_powerpc_morphos,system_m68k_amiga]) then
                begin
@@ -542,10 +572,10 @@ implementation
                    begin
                      if assigned(sc.first.listnext) then
                        Message(parser_e_paraloc_only_one_para);
-                     if (pd.para.first<>pd.para.last) and not(explicit_paraloc) then
+                     if (paranr>1) and not(explicit_paraloc) then
                        Message(parser_e_paraloc_all_paras);
                      explicit_paraloc:=true;
-                     if not(paramanager.parseparaloc(tparaitem(pd.para.last),upper(locationstr))) then
+                     if not(paramanager.parseparaloc(vs,upper(locationstr))) then
                        message(parser_e_illegal_explicit_paraloc);
                    end
                  else
@@ -951,7 +981,7 @@ implementation
             end;
         end;
         { support procedure proc stdcall export; }
-        if not(is_proc_directive(token,false)) then
+        if not(check_proc_directive(false)) then
           consume(_SEMICOLON);
         result:=pd;
       end;
@@ -1016,27 +1046,11 @@ begin
   tprocdef(pd).forwarddef:=false;
 end;
 
+
 procedure pd_inline(pd:tabstractprocdef);
-var
-  hp : tparaitem;
 begin
-  { check if there is an array of const }
-  hp:=tparaitem(pd.para.first);
-  while assigned(hp) do
-   begin
-     if assigned(hp.paratype.def) and
-        (hp.paratype.def.deftype=arraydef) then
-      begin
-        with tarraydef(hp.paratype.def) do
-         if IsVariant or IsConstructor {or IsArrayOfConst} then
-          begin
-            Message1(parser_w_not_supported_for_inline,'array of const');
-            Message(parser_w_inlining_disabled);
-            pd.proccalloption:=pocall_default;
-          end;
-      end;
-     hp:=tparaitem(hp.next);
-   end;
+  { Check if there are parameters that can't be inlined }
+  pd.parast.foreach_static(@check_inline_para,pd);
 end;
 
 procedure pd_intern(pd:tabstractprocdef);
@@ -1130,7 +1144,7 @@ begin
   { check parameter type }
   if ((pd.minparacount<>1) or
       (pd.maxparacount<>1) or
-      (TParaItem(pd.Para.first).paratyp<>vs_var)) then
+      (tparavarsym(pd.paras[0]).varspez<>vs_var)) then
     Message(parser_e_ill_msg_param);
   pt:=comp_expr(true);
   if pt.nodetype=stringconstn then
@@ -1162,6 +1176,7 @@ end;
 procedure pd_syscall(pd:tabstractprocdef);
 {$ifdef powerpc}
 var
+  vs  : tparavarsym;
   sym : tsym;
   symtable : tsymtable;
 {$endif powerpc}
@@ -1176,14 +1191,18 @@ begin
       include(pd.procoptions,po_explicitparaloc);
       if consume_sym(sym,symtable) then
         begin
-          if (sym.typ in [localvarsym,paravarsym,globalvarsym]) and
-            ((tabstractvarsym(sym).vartype.def.deftype=pointerdef) or
+          if (sym.typ=globalvarsym) and
+             (
+              (tabstractvarsym(sym).vartype.def.deftype=pointerdef) or
               is_32bitint(tabstractvarsym(sym).vartype.def)
-            ) then
+             ) then
             begin
               tprocdef(pd).libsym:=sym;
-              pd.concatpara(nil,tabstractvarsym(sym).vartype,tabstractvarsym(sym),nil,true);
-              paramanager.parseparaloc(tparaitem(pd.para.last),'A6');
+              vs:=tparavarsym.create('$syscalllib',paranr_syscall,vs_value,tabstractvarsym(sym).vartype);
+              include(vs.varoptions,vo_is_syscall_lib);
+              include(vs.varoptions,vo_is_hidden_para);
+              paramanager.parseparaloc(vs,'A6');
+              pd.parast.insert(vs);
             end
           else
             Message(parser_e_32bitint_or_pointer_variable_expected);
@@ -1615,19 +1634,19 @@ const
    );
 
 
-    function is_proc_directive(tok:ttoken;isprocvar:boolean):boolean;
+    function check_proc_directive(isprocvar:boolean):boolean;
       var
         i : longint;
       begin
-        is_proc_directive:=false;
+        result:=false;
         for i:=1 to num_proc_directives do
          if proc_direcdata[i].idtok=idtoken then
           begin
             if ((not isprocvar) or
                (pd_procvar in proc_direcdata[i].pd_flags)) and
                { don't eat a public directive in classes }
-               not((proc_direcdata[i].idtok=_PUBLIC) and (symtablestack.symtabletype=objectsymtable)) then
-              is_proc_directive:=true;
+               not((idtoken=_PUBLIC) and (symtablestack.symtabletype=objectsymtable)) then
+              result:=true;
             exit;
           end;
       end;
@@ -1876,11 +1895,9 @@ const
 
 
     procedure calc_parast(pd:tabstractprocdef);
-      var
-        currpara : tparaitem;
       begin
         { insert hidden high parameters }
-        insert_hidden_para(pd);
+        pd.parast.foreach_static(@insert_hidden_para,pd);
         { insert hidden self parameter }
         insert_self_and_vmt_para(pd);
         { insert funcret parameter if required }
@@ -1888,27 +1905,8 @@ const
         { insert parentfp parameter if required }
         insert_parentfp_para(pd);
 
-        if not(po_explicitparaloc in pd.procoptions) then
-          begin
-            currpara:=tparaitem(pd.para.first);
-            while assigned(currpara) do
-             begin
-               if not(assigned(currpara.parasym) and (currpara.parasym.typ=paravarsym)) then
-                 internalerror(200304232);
-               { connect parasym to paraitem }
-               tparavarsym(currpara.parasym).paraitem:=currpara;
-               { We need a local copy for a value parameter when only the
-                 address is pushed. Open arrays and Array of Const are
-                 an exception because they are allocated at runtime and the
-                 address that is pushed is patched }
-               if (currpara.paratyp=vs_value) and
-                  paramanager.push_addr_param(currpara.paratyp,currpara.paratype.def,pd.proccalloption) and
-                  not(is_open_array(currpara.paratype.def) or
-                      is_array_of_const(currpara.paratype.def)) then
-                 include(tparavarsym(currpara.parasym).varoptions,vo_has_local_copy);
-               currpara:=tparaitem(currpara.next);
-             end;
-          end;
+        { Calculate parameter tlist }
+        pd.calcparas;
       end;
 
 
@@ -1951,7 +1949,7 @@ const
                  (token=_EQUAL) then
                break;
               { support procedure proc;stdcall export; }
-              if not(is_proc_directive(token,(pd.deftype=procvardef))) then
+              if not(check_proc_directive((pd.deftype=procvardef))) then
                consume(_SEMICOLON);
             end
            else
@@ -2035,7 +2033,7 @@ const
               ) or
               { check arguments }
               (
-               (compare_paras(pd.para,hd.para,cp_none,[cpo_comparedefaultvalue])>=te_equal) and
+               (compare_paras(pd.paras,hd.paras,cp_none,[cpo_comparedefaultvalue])>=te_equal) and
                { for operators equal_paras is not enough !! }
                ((pd.proctypeoption<>potype_operator) or (optoken<>_ASSIGNMENT) or
                 equal_defs(hd.rettype.def,pd.rettype.def))
@@ -2054,7 +2052,7 @@ const
                       (
                        (m_repeat_forward in aktmodeswitches) and
                        (not((pd.maxparacount=0) or
-                            (compare_paras(pd.para,hd.para,cp_all,[cpo_comparedefaultvalue])>=te_equal)))
+                            (compare_paras(pd.paras,hd.paras,cp_all,[cpo_comparedefaultvalue])>=te_equal)))
                       ) or
                       (
                        ((m_repeat_forward in aktmodeswitches) or
@@ -2269,7 +2267,11 @@ const
 end.
 {
   $Log$
-  Revision 1.204  2004-11-14 16:26:29  florian
+  Revision 1.205  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.204  2004/11/14 16:26:29  florian
     * fixed morphos syscall
 
   Revision 1.203  2004/11/11 19:31:33  peter

compiler/pdecvar.pas

@@ -208,6 +208,7 @@ implementation
          pt : tnode;
          propname : stringid;
          sc : tsinglelist;
+         paranr : word;
          oldregisterdef : boolean;
          hreadparavs,
          hparavs      : tparavarsym;
@@ -219,6 +220,7 @@ implementation
            procedures. the readprocdef will store all definitions }
          oldregisterdef:=registerdef;
          registerdef:=false;
+         paranr:=0;
          readprocdef:=tprocvardef.create(normal_function_level);
          writeprocdef:=tprocvardef.create(normal_function_level);
          registerdef:=oldregisterdef;
@@ -275,7 +277,8 @@ implementation
                   varspez:=vs_value;
                 sc.reset;
                 repeat
-                  hreadparavs:=tparavarsym.create(orgpattern,varspez,generrortype);
+                  inc(paranr);
+                  hreadparavs:=tparavarsym.create(orgpattern,10*paranr,varspez,generrortype);
                   readprocdef.parast.insert(hreadparavs);
                   sc.insert(hreadparavs);
                   consume(_ID);
@@ -303,14 +306,13 @@ implementation
                   tt:=cformaltype;
                 hreadparavs:=tparavarsym(sc.first);
                 while assigned(hreadparavs) do
-                 begin
-                   readprocdef.concatpara(nil,tt,hreadparavs,nil,false);
-                   { also update the writeprocdef }
-                   hparavs:=tparavarsym.create(hreadparavs.realname,vs_value,generrortype);
-                   writeprocdef.parast.insert(hparavs);
-                   writeprocdef.concatpara(nil,tt,hparavs,nil,false);
-                   hreadparavs:=tparavarsym(hreadparavs.listnext);
-                 end;
+                  begin
+                    hreadparavs.vartype:=tt;
+                    { also update the writeprocdef }
+                    hparavs:=tparavarsym.create(hreadparavs.realname,hreadparavs.paranr,vs_value,tt);
+                    writeprocdef.parast.insert(hparavs);
+                    hreadparavs:=tparavarsym(hreadparavs.listnext);
+                  end;
               until not try_to_consume(_SEMICOLON);
               sc.free;
               dec(testcurobject);
@@ -318,14 +320,14 @@ implementation
 
               { the parser need to know if a property has parameters, the
                 index parameter doesn't count (PFV) }
-              if readprocdef.minparacount>0 then
+              if paranr>0 then
                 include(p.propoptions,ppo_hasparameters);
            end;
          { overriden property ?                                 }
          { force property interface
              there is a property parameter
              a global property }
-         if (token=_COLON) or (readprocdef.minparacount>0) or (aclass=nil) then
+         if (token=_COLON) or (paranr>0) or (aclass=nil) then
            begin
               consume(_COLON);
               { insert types in global symtable }
@@ -354,12 +356,11 @@ implementation
                    p.indextype.setdef(pt.resulttype.def);
                    include(p.propoptions,ppo_indexed);
                    { concat a longint to the para templates }
-                   hparavs:=tparavarsym.create('$index',vs_value,p.indextype);
+                   inc(paranr);
+                   hparavs:=tparavarsym.create('$index',10*paranr,vs_value,p.indextype);
                    readprocdef.parast.insert(hparavs);
-                   readprocdef.concatpara(nil,p.indextype,hparavs,nil,false);
-                   hparavs:=tparavarsym.create('$index',vs_value,p.indextype);
+                   hparavs:=tparavarsym.create('$index',10*paranr,vs_value,p.indextype);
                    writeprocdef.parast.insert(hparavs);
-                   writeprocdef.concatpara(nil,p.indextype,hparavs,nil,false);
                    pt.free;
                 end;
            end
@@ -399,7 +400,7 @@ implementation
                      { we ignore hidden stuff here because the property access symbol might have
                        non default calling conventions which might change the hidden stuff;
                        see tw3216.pp (FK) }
-                     p.readaccess.procdef:=Tprocsym(sym).search_procdef_bypara(readprocdef.para,p.proptype.def,[cpo_allowdefaults,cpo_ignorehidden,cpo_allowconvert]);
+                     p.readaccess.procdef:=Tprocsym(sym).search_procdef_bypara(readprocdef.paras,p.proptype.def,[cpo_allowdefaults,cpo_ignorehidden,cpo_allowconvert]);
                      if not assigned(p.readaccess.procdef) then
                        Message(parser_e_ill_property_access_sym);
                    end;
@@ -437,14 +438,14 @@ implementation
                      { write is a procedure with an extra value parameter
                        of the of the property }
                      writeprocdef.rettype:=voidtype;
-                     hparavs:=tparavarsym.create('$value',vs_value,p.proptype);
+                     inc(paranr);
+                     hparavs:=tparavarsym.create('$value',10*paranr,vs_value,p.proptype);
                      writeprocdef.parast.insert(hparavs);
-                     writeprocdef.concatpara(nil,p.proptype,hparavs,nil,false);
                      { Insert hidden parameters }
                      handle_calling_convention(writeprocdef);
                      calc_parast(writeprocdef);
                      { search procdefs matching writeprocdef }
-                     p.writeaccess.procdef:=Tprocsym(sym).search_procdef_bypara(writeprocdef.para,writeprocdef.rettype.def,[cpo_allowdefaults,cpo_allowconvert]);
+                     p.writeaccess.procdef:=Tprocsym(sym).search_procdef_bypara(writeprocdef.paras,writeprocdef.rettype.def,[cpo_allowdefaults,cpo_allowconvert]);
                      if not assigned(p.writeaccess.procdef) then
                        Message(parser_e_ill_property_access_sym);
                    end;
@@ -769,7 +770,7 @@ implementation
              { Process procvar directives }
              if (tt.def.deftype=procvardef) and
                 (tt.def.typesym=nil) and
-                is_proc_directive(token,true) then
+                check_proc_directive(true) then
                begin
                   newtype:=ttypesym.create('unnamed',tt);
                   parse_var_proc_directives(tsym(newtype));
@@ -929,7 +930,7 @@ implementation
              { Process procvar directives before = and ; }
              if (tt.def.deftype=procvardef) and
                 (tt.def.typesym=nil) and
-                is_proc_directive(token,true) then
+                check_proc_directive(true) then
                begin
                   newtype:=ttypesym.create('unnamed',tt);
                   parse_var_proc_directives(tsym(newtype));
@@ -978,7 +979,7 @@ implementation
                 (tt.def.typesym=nil) then
                begin
                  { Parse procvar directives after ; }
-                 if is_proc_directive(token,true) then
+                 if check_proc_directive(true) then
                    begin
                      newtype:=ttypesym.create('unnamed',tt);
                      parse_var_proc_directives(tsym(newtype));
@@ -1309,7 +1310,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.83  2004-11-09 22:32:59  peter
+  Revision 1.84  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.83  2004/11/09 22:32:59  peter
     * small m68k updates to bring it up2date
     * give better error for external local variable
 

compiler/pexpr.pas

@@ -815,8 +815,9 @@ implementation
       var
          membercall,
          prevafterassn : boolean;
-         para,p2 : tnode;
-         currpara : tparaitem;
+         i        : integer;
+         para,p2  : tnode;
+         currpara : tparavarsym;
          aprocdef : tprocdef;
       begin
          prevafterassn:=afterassignment;
@@ -878,12 +879,11 @@ implementation
               begin
                 if not assigned(current_procinfo) then
                   internalerror(200305054);
-                currpara:=tparaitem(current_procinfo.procdef.para.first);
-                while assigned(currpara) do
-                 begin
-                   if not currpara.is_hidden then
-                     para:=ccallparanode.create(cloadnode.create(currpara.parasym,currpara.parasym.owner),para);
-                   currpara:=tparaitem(currpara.next);
+                for i:=0 to current_procinfo.procdef.paras.count-1 do
+                  begin
+                    currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
+                    if not(vo_is_hidden_para in currpara.varoptions) then
+                      para:=ccallparanode.create(cloadnode.create(currpara,currpara.owner),para);
                  end;
               end
              else
@@ -1082,7 +1082,7 @@ implementation
            begin
               { pattern is still valid unless
               there is another ID just after the ID of sym }
-              Message1(sym_e_id_no_member,pattern);
+              Message1(sym_e_id_no_member,orgpattern);
               p1.free;
               p1:=cerrornode.create;
               { try to clean up }
@@ -1301,7 +1301,7 @@ implementation
                               srsym:=search_class_member(tobjectdef(htype.def),pattern);
                               check_hints(srsym);
                               if not assigned(srsym) then
-                               Message1(sym_e_id_no_member,pattern)
+                               Message1(sym_e_id_no_member,orgpattern)
                               else if not(getaddr) and not(sp_static in srsym.symoptions) then
                                Message(sym_e_only_static_in_static)
                               else
@@ -1327,7 +1327,7 @@ implementation
                                 srsym:=search_class_member(tobjectdef(htype.def),pattern);
                                 check_hints(srsym);
                                 if not assigned(srsym) then
-                                 Message1(sym_e_id_no_member,pattern)
+                                 Message1(sym_e_id_no_member,orgpattern)
                                 else
                                  begin
                                    consume(_ID);
@@ -1706,7 +1706,7 @@ implementation
                                check_hints(hsym);
                                if hsym=nil then
                                  begin
-                                   Message1(sym_e_id_no_member,pattern);
+                                   Message1(sym_e_id_no_member,orgpattern);
                                    p1.destroy;
                                    p1:=cerrornode.create;
                                    { try to clean up }
@@ -1733,7 +1733,7 @@ implementation
                                allow_only_static:=store_static;
                                if hsym=nil then
                                  begin
-                                    Message1(sym_e_id_no_member,pattern);
+                                    Message1(sym_e_id_no_member,orgpattern);
                                     p1.destroy;
                                     p1:=cerrornode.create;
                                     { try to clean up }
@@ -1821,7 +1821,7 @@ implementation
          pd       : tprocdef;
          classh   : tobjectdef;
          d        : bestreal;
-         hs       : string;
+         hs,hsorg : string;
          htype    : ttype;
          filepos  : tfileposinfo;
 
@@ -1883,6 +1883,7 @@ implementation
                   if token in endtokens then
                    begin
                      hs:=current_procinfo.procdef.procsym.name;
+                     hsorg:=current_procinfo.procdef.procsym.realname;
                      anon_inherited:=true;
                      { For message methods we need to search using the message
                        number or string }
@@ -1898,6 +1899,7 @@ implementation
                   else
                    begin
                      hs:=pattern;
+                     hsorg:=orgpattern;
                      consume(_ID);
                      anon_inherited:=false;
                      sym:=searchsym_in_class(classh,hs);
@@ -1940,7 +1942,7 @@ implementation
                       end
                      else
                       begin
-                        Message1(sym_e_id_no_member,hs);
+                        Message1(sym_e_id_no_member,hsorg);
                         p1:=cerrornode.create;
                       end;
                      again:=false;
@@ -2018,7 +2020,7 @@ implementation
                              begin
                                 consume(_INTCONST);
                                 htype:=u64inttype;
-                                p1:=cordconstnode.create(card,htype,true);
+                                p1:=cordconstnode.create(tconstexprint(qc),htype,true);
                              end;
                          end;
                      end;
@@ -2502,7 +2504,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.171  2004-11-08 22:09:59  peter
+  Revision 1.172  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.171  2004/11/08 22:09:59  peter
     * tvarsym splitted
 
   Revision 1.170  2004/11/04 17:57:58  peter

compiler/pmodules.pas

@@ -38,7 +38,7 @@ implementation
        globals,verbose,fmodule,finput,fppu,
        symconst,symbase,symtype,symdef,symsym,symtable,
        aasmtai,aasmcpu,aasmbase,
-       cgbase,cpuinfo,cgobj,
+       cgbase,cgobj,
        nbas,
        link,assemble,import,export,gendef,ppu,comprsrc,
        cresstr,procinfo,
@@ -46,7 +46,7 @@ implementation
 {$ifdef GDB}
        gdb,
 {$endif GDB}
-       scanner,pbase,pexpr,psystem,psub;
+       scanner,pbase,pexpr,psystem,psub,pdecsub;
 
     procedure fixseg(p:TAAsmoutput; sec:TAsmSectionType; secname: string);
       begin
@@ -167,17 +167,17 @@ implementation
          end;
         { align code segment }
         codeSegment.concat(Tai_align.Create(aktalignment.procalign));
-				{ Insert start and end of sections }
-				fixseg(codesegment,sec_code,'____seg_code');
-				fixseg(datasegment,sec_data,'____seg_data');
-				fixseg(bsssegment,sec_bss,'____seg_bss');
-				{ we should use .rdata section for these two no ?
-					.rdata is a read only data section (PM) }
-				fixseg(rttilist,sec_data,'____seg_rtti');
-				fixseg(consts,sec_data,'____seg_consts');
-				fixseg(picdata,sec_data,'____seg_picdata');
-				if assigned(resourcestringlist) then
-					fixseg(resourcestringlist,sec_data,'____seg_resstrings');
+        { Insert start and end of sections }
+        fixseg(codesegment,sec_code,'____seg_code');
+        fixseg(datasegment,sec_data,'____seg_data');
+        fixseg(bsssegment,sec_bss,'____seg_bss');
+        { we should use .rdata section for these two no ?
+          .rdata is a read only data section (PM) }
+        fixseg(rttilist,sec_data,'____seg_rtti');
+        fixseg(consts,sec_data,'____seg_consts');
+        fixseg(picdata,sec_data,'____seg_picdata');
+        if assigned(resourcestringlist) then
+          fixseg(resourcestringlist,sec_data,'____seg_resstrings');
 {$ifdef GDB}
         if assigned(debuglist) then
           begin
@@ -798,6 +798,7 @@ implementation
         pd.forwarddef:=false;
         pd.setmangledname(target_info.cprefix+name);
         pd.aliasnames.insert(pd.mangledname);
+        calc_parast(pd);
         { We don't need is a local symtable. Change it into the static
           symtable }
         pd.localst.free;
@@ -1520,7 +1521,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.173  2004-11-08 22:09:59  peter
+  Revision 1.174  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.173  2004/11/08 22:09:59  peter
     * tvarsym splitted
 
   Revision 1.172  2004/11/05 20:04:49  florian

compiler/powerpc/aasmcpu.pas

@@ -27,10 +27,9 @@ unit aasmcpu;
 interface
 
 uses
-  cclasses,
-  globtype,globals,verbose,
+  globtype,verbose,
   aasmbase,aasmtai,
-  cpubase,cpuinfo,cgbase,cgutils;
+  cpubase,cgbase,cgutils;
 
     const
       { "mov reg,reg" source operand number }
@@ -101,7 +100,7 @@ uses
 
 implementation
 
-uses cutils,rgobj;
+uses cutils;
 
 {*****************************************************************************
                                  taicpu Constructors
@@ -407,10 +406,18 @@ uses cutils,rgobj;
       begin
       end;
 
+
+begin
+  cai_align:=tai_align;
+  cai_cpu:=taicpu;
 end.
 {
   $Log$
-  Revision 1.28  2004-10-31 21:45:03  peter
+  Revision 1.29  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.28  2004/10/31 21:45:03  peter
     * generic tlocation
     * move tlocation to cgutils
 

compiler/powerpc/cgcpu.pas

@@ -1003,7 +1003,8 @@ const
          parastart : aint;
          l : tasmlabel;
          regcounter2, firstfpureg: Tsuperregister;
-         hp: tparaitem;
+         i : integer;
+         hp: tparavarsym;
          cond : tasmcond;
          instr : taicpu;
          size: tcgsize;
@@ -1171,18 +1172,17 @@ const
             if not (po_assembler in current_procinfo.procdef.procoptions) then
               begin
                 { copy memory parameters to local parast }
-                hp:=tparaitem(current_procinfo.procdef.para.first);
-                while assigned(hp) do
+                for i:=0 to current_procinfo.procdef.paras.count-1 do
                   begin
+                    hp:=tparavarsym(current_procinfo.procdef.paras[i]);
                     if (hp.paraloc[calleeside].location^.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
                       begin
                         if assigned(hp.paraloc[callerside].location^.next) then
                           internalerror(2004091210);
-                        case tabstractnormalvarsym(hp.parasym).localloc.loc of
+                        case hp.localloc.loc of
                           LOC_REFERENCE:
                             begin
-                              reference_reset_base(href,tabstractnormalvarsym(hp.parasym).localloc.reference.base,
-                                  tabstractnormalvarsym(hp.parasym).localloc.reference.offset);
+                              reference_reset_base(href,hp.localloc.reference.base,hp.localloc.reference.offset);
                               reference_reset_base(href2,NR_R12,hp.paraloc[callerside].location^.reference.offset);
                               { we can't use functions here which allocate registers (FK)
                                cg.a_load_ref_ref(list,hp.paraloc[calleeside].size,hp.paraloc[calleeside].size,href2,href);
@@ -1228,7 +1228,6 @@ const
 }
                         end;
                       end;
-                    hp := tparaitem(hp.next);
                   end;
               end;
           end;
@@ -2357,7 +2356,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.185  2004-11-11 19:31:33  peter
+  Revision 1.186  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.185  2004/11/11 19:31:33  peter
     * fixed compile of powerpc,sparc,arm
 
   Revision 1.184  2004/10/31 21:45:03  peter

compiler/powerpc/cpupara.pas

@@ -30,7 +30,7 @@ unit cpupara;
        cclasses,
        aasmtai,
        cpubase,cpuinfo,
-       symconst,symbase,symtype,symdef,
+       symconst,symbase,symtype,symdef,symsym,
        paramgr,parabase,cgbase;
 
     type
@@ -41,14 +41,14 @@ unit cpupara;
 
           procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargspara):longint;override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
 
           procedure create_funcret_paraloc_info(p : tabstractprocdef; side: tcallercallee);
          private
           procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
-          function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; firstpara: tparaitem;
+          function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras:tlist;
               var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
-          function parseparaloc(p : tparaitem;const s : string) : boolean;override;
+          function parseparaloc(p : tparavarsym;const s : string) : boolean;override;
        end;
 
   implementation
@@ -57,7 +57,7 @@ unit cpupara;
        verbose,systems,
        procinfo,
        rgobj,
-       defutil,symsym,cpupi;
+       defutil,cpupi;
 
 
     function tppcparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
@@ -284,21 +284,22 @@ unit cpupara;
       begin
         init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
 
-        result := create_paraloc_info_intern(p,side,tparaitem(p.para.first),curintreg,curfloatreg,curmmreg,cur_stack_offset);
+        result := create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
 
         create_funcret_paraloc_info(p,side);
       end;
 
 
 
-    function tppcparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; firstpara: tparaitem;
+    function tppcparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras:tlist;
                var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
       var
          stack_offset: aword;
          nextintreg,nextfloatreg,nextmmreg, maxfpureg : tsuperregister;
          paradef : tdef;
          paraloc,paraloc2 : pcgparalocation;
-         hp : tparaitem;
+         i  : integer;
+         hp : tparavarsym;
          loc : tcgloc;
          paracgsize: tcgsize;
          is_64bit: boolean;
@@ -342,13 +343,13 @@ unit cpupara;
            else internalerror(2004070912);
          end;
 
-         hp:=firstpara;
-         while assigned(hp) do
-           begin
+          for i:=0 to paras.count-1 do
+            begin
+              hp:=tparavarsym(paras[i]);
               hp.paraloc[side].reset;
               { currently only support C-style array of const }
               if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
-                 is_array_of_const(hp.paratype.def) then
+                 is_array_of_const(hp.vartype.def) then
                 begin
                   paraloc:=hp.paraloc[side].add_location;
                   { hack: the paraloc must be valid, but is not actually used }
@@ -358,7 +359,7 @@ unit cpupara;
                   break;
                 end;
 
-              if (hp.paratyp in [vs_var,vs_out]) then
+              if (hp.varspez in [vs_var,vs_out]) then
                 begin
                   paradef:=voidpointertype.def;
                   loc:=LOC_REGISTER;
@@ -366,7 +367,7 @@ unit cpupara;
                 end
               else
                 begin
-                  paradef := hp.paratype.def;
+                  paradef := hp.vartype.def;
                   loc:=getparaloc(paradef);
                   paracgsize:=def_cgsize(paradef);
                   { for things like formaldef }
@@ -457,7 +458,7 @@ unit cpupara;
                  LOC_REFERENCE:
                    begin
                       paraloc^.size:=OS_ADDR;
-                      if push_addr_param(hp.paratyp,paradef,p.proccalloption) or
+                      if push_addr_param(hp.varspez,paradef,p.proccalloption) or
                         is_open_array(paradef) or
                         is_array_of_const(paradef) then
                         assignintreg
@@ -466,13 +467,12 @@ unit cpupara;
                            paraloc^.loc:=LOC_REFERENCE;
                            paraloc^.reference.index:=NR_STACK_POINTER_REG;
                            paraloc^.reference.offset:=stack_offset;
-                           inc(stack_offset,hp.paratype.def.size);
+                           inc(stack_offset,hp.vartype.def.size);
                         end;
                    end;
                  else
                    internalerror(2002071002);
               end;
-              hp:=tparaitem(hp.next);
            end;
          curintreg:=nextintreg;
          curfloatreg:=nextfloatreg;
@@ -482,36 +482,36 @@ unit cpupara;
       end;
 
 
-    function tppcparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargspara):longint;
+    function tppcparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
       var
         cur_stack_offset: aword;
         parasize, l: longint;
         curintreg, firstfloatreg, curfloatreg, curmmreg: tsuperregister;
-        hp: tparaitem;
+        i : integer;
+        hp: tparavarsym;
         paraloc: pcgparalocation;
       begin
         init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
         firstfloatreg:=curfloatreg;
 
-        result:=create_paraloc_info_intern(p,callerside,tparaitem(p.para.first),curintreg,curfloatreg,curmmreg,cur_stack_offset);
+        result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
         if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
           { just continue loading the parameters in the registers }
-          result:=create_paraloc_info_intern(p,callerside,tparaitem(varargspara.first),curintreg,curfloatreg,curmmreg,cur_stack_offset)
+          result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset)
         else
           begin
-            hp:=tparaitem(varargspara.first);
             parasize:=cur_stack_offset;
-            while assigned(hp) do
+            for i:=0 to varargspara.count-1 do
               begin
+                hp:=tparavarsym(varargspara[i]);
                 hp.paraloc[callerside].alignment:=4;
                 paraloc:=hp.paraloc[callerside].add_location;
                 paraloc^.loc:=LOC_REFERENCE;
-                paraloc^.size:=def_cgsize(hp.paratype.def);
+                paraloc^.size:=def_cgsize(hp.vartype.def);
                 paraloc^.reference.index:=NR_STACK_POINTER_REG;
-                l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
+                l:=push_size(hp.varspez,hp.vartype.def,p.proccalloption);
                 paraloc^.reference.offset:=parasize;
                 parasize:=parasize+l;
-                hp:=tparaitem(hp.next);
               end;
             result:=parasize;
           end;
@@ -520,7 +520,7 @@ unit cpupara;
       end;
 
 
-    function tppcparamanager.parseparaloc(p : tparaitem;const s : string) : boolean;
+    function tppcparamanager.parseparaloc(p : tparavarsym;const s : string) : boolean;
       var
         paraloc : pcgparalocation;
       begin
@@ -529,10 +529,10 @@ unit cpupara;
           system_powerpc_morphos:
             begin
               p.paraloc[callerside].alignment:=4;
-              p.paraloc[callerside].size:=def_cgsize(p.paratype.def);
+              p.paraloc[callerside].size:=def_cgsize(p.vartype.def);
               paraloc:=p.paraloc[callerside].add_location;
               paraloc^.loc:=LOC_REFERENCE;
-              paraloc^.size:=def_cgsize(p.paratype.def);
+              paraloc^.size:=def_cgsize(p.vartype.def);
               paraloc^.reference.index:=newreg(R_INTREGISTER,RS_R2,R_SUBWHOLE);
               { pattern is always uppercase'd }
               if s='D0' then
@@ -589,7 +589,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.70  2004-11-14 16:26:29  florian
+  Revision 1.71  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.70  2004/11/14 16:26:29  florian
     * fixed morphos syscall
 
   Revision 1.69  2004/09/25 20:28:20  florian

compiler/ppu.pas

@@ -44,7 +44,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion=45;
+  CurrentPPUVersion=46;
 
 { buffer sizes }
   maxentrysize = 1024;
@@ -1054,7 +1054,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.58  2004-11-08 22:09:59  peter
+  Revision 1.59  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.58  2004/11/08 22:09:59  peter
     * tvarsym splitted
 
   Revision 1.57  2004/09/21 17:25:12  peter

compiler/psub.pas

@@ -948,24 +948,23 @@ implementation
 
     function checknodeinlining(procdef: tprocdef): boolean;
       var
-        paraitem: tparaitem;
+        i : integer;
+        currpara : tparavarsym;
       begin
         result := false;
         if not assigned(procdef.inlininginfo^.code) or
            (po_assembler in procdef.procoptions) then
           exit;
-        paraitem:=tparaitem(procdef.para.first);
-
-        while assigned(paraitem) do
+        for i:=0 to procdef.paras.count-1 do
           begin
+            currpara:=tparavarsym(procdef.paras[i]);
             { we can't handle formaldefs and special arrays (the latter may need a    }
             { re-basing of the index, i.e. if you pass an array[1..10] as open array, }
             { you have to add 1 to all index operations if you directly inline it     }
-            if ((paraitem.paratyp in [vs_out,vs_var]) and
-                (paraitem.paratype.def.deftype=formaldef)) or
-               is_special_array(paraitem.paratype.def)  then
+            if ((currpara.varspez in [vs_out,vs_var]) and
+                (currpara.vartype.def.deftype=formaldef)) or
+               is_special_array(currpara.vartype.def)  then
               exit;
-            paraitem := tparaitem(paraitem.next);
           end;
         { we currently can't handle exit-statements (would exit the caller) }
         result := not foreachnodestatic(procdef.inlininginfo^.code,@containsforbiddennode,nil);
@@ -1403,7 +1402,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.214  2004-11-08 22:09:59  peter
+  Revision 1.215  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.214  2004/11/08 22:09:59  peter
     * tvarsym splitted
 
   Revision 1.213  2004/11/02 12:55:17  peter

compiler/ptype.pas

@@ -636,7 +636,7 @@ implementation
                 { possible proc directives }
                 if parseprocvardir then
                   begin
-                    if is_proc_directive(token,true) then
+                    if check_proc_directive(true) then
                       begin
                          newtype:=ttypesym.create('unnamed',tt);
                          parse_var_proc_directives(tsym(newtype));
@@ -659,7 +659,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.69  2004-11-01 23:30:11  peter
+  Revision 1.70  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.69  2004/11/01 23:30:11  peter
     * support > 32bit accesses for x86_64
     * rewrote array size checking to support 64bit
 

compiler/sparc/cpupara.pas

@@ -29,7 +29,7 @@ interface
       cclasses,
       aasmtai,
       cpubase,cpuinfo,
-      symconst,symbase,symtype,symdef,paramgr,parabase,cgbase;
+      symconst,symbase,symsym,symtype,symdef,paramgr,parabase,cgbase;
 
     type
       TSparcParaManager=class(TParaManager)
@@ -42,10 +42,10 @@ interface
         @param(nr Parameter number of routine, starting from 1)}
         procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override;
         function  create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
-        function  create_varargs_paraloc_info(p : TAbstractProcDef; varargspara:tvarargspara):longint;override;
+        function  create_varargs_paraloc_info(p : TAbstractProcDef; varargspara:tvarargsparalist):longint;override;
       private
         procedure create_funcret_paraloc_info(p : tabstractprocdef; side: tcallercallee);
-        procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; firstpara: tparaitem;
+        procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tlist;
                                              var intparareg,parasize:longint);
       end;
 
@@ -208,11 +208,12 @@ implementation
       end;
 
 
-    procedure tsparcparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;firstpara:tparaitem;
+    procedure tsparcparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;paras:tlist;
                                                            var intparareg,parasize:longint);
       var
         paraloc      : pcgparalocation;
-        hp           : tparaitem;
+        i            : integer;
+        hp           : tparavarsym;
         paracgsize   : tcgsize;
         hparasupregs : pparasupregs;
         paralen      : longint;
@@ -221,13 +222,13 @@ implementation
           hparasupregs:=@paraoutsupregs
         else
           hparasupregs:=@parainsupregs;
-        hp:=firstpara;
-        while assigned(hp) do
+        for i:=0 to paras.count-1 do
           begin
+            hp:=tparavarsym(paras[i]);
             { currently only support C-style array of const,
               there should be no location assigned to the vararg array itself }
             if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
-               is_array_of_const(hp.paratype.def) then
+               is_array_of_const(hp.vartype.def) then
               begin
                 paraloc:=hp.paraloc[side].add_location;
                 { hack: the paraloc must be valid, but is not actually used }
@@ -237,11 +238,11 @@ implementation
                 break;
               end;
 
-            if push_addr_param(hp.paratyp,hp.paratype.def,p.proccalloption) then
+            if push_addr_param(hp.varspez,hp.vartype.def,p.proccalloption) then
               paracgsize:=OS_ADDR
             else
               begin
-                paracgsize:=def_cgSize(hp.paratype.def);
+                paracgsize:=def_cgSize(hp.vartype.def);
                 if paracgsize=OS_NO then
                   paracgsize:=OS_ADDR;
               end;
@@ -277,12 +278,11 @@ implementation
                   end;
                 dec(paralen,tcgsize2size[paraloc^.size]);
               end;
-            hp:=TParaItem(hp.Next);
           end;
       end;
 
 
-    function TSparcParaManager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargspara):longint;
+    function TSparcParaManager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
       var
         intparareg,
         parasize : longint;
@@ -290,9 +290,9 @@ implementation
         intparareg:=0;
         parasize:=0;
         { calculate the registers for the normal parameters }
-        create_paraloc_info_intern(p,callerside,tparaitem(p.para.first),intparareg,parasize);
+        create_paraloc_info_intern(p,callerside,p.paras,intparareg,parasize);
         { append the varargs }
-        create_paraloc_info_intern(p,callerside,tparaitem(varargspara.first),intparareg,parasize);
+        create_paraloc_info_intern(p,callerside,varargspara,intparareg,parasize);
         result:=parasize;
       end;
 
@@ -305,7 +305,7 @@ implementation
       begin
         intparareg:=0;
         parasize:=0;
-        create_paraloc_info_intern(p,side,tparaitem(p.para.first),intparareg,parasize);
+        create_paraloc_info_intern(p,side,p.paras,intparareg,parasize);
         { Create Function result paraloc }
         create_funcret_paraloc_info(p,side);
         { We need to return the size allocated on the stack }
@@ -318,7 +318,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.46  2004-11-07 00:33:45  florian
+  Revision 1.47  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.46  2004/11/07 00:33:45  florian
     * marked o* registers as volatile
 
   Revision 1.45  2004/10/24 17:32:53  florian

compiler/symconst.pas

@@ -99,6 +99,15 @@ const
   main_program_level    = 1;
   normal_function_level = 2;
 
+  { implicit parameter positions, normal parameters start at 10
+    and will increase with 10 for each parameter. The high parameters
+    will be inserted with n+1 }
+  paranr_parentfp = 1;
+  paranr_result = 2;
+  paranr_self = 3;
+  paranr_vmt = 4;
+  paranr_syscall          = high(word)-2;
+  paranr_result_leftright = high(word)-1;
 
 type
   { Deref entry options }
@@ -284,14 +293,16 @@ type
     vo_has_local_copy,
     vo_is_const,  { variable is declared as const (parameter) and can't be written to }
     vo_is_exported,
-    vo_is_high_value,
+    vo_is_high_para,
     vo_is_funcret,
     vo_is_self,
     vo_is_vmt,
     vo_is_result,  { special result variable }
     vo_is_parentfp,
     vo_is_loop_counter, { used to detect assignments to loop counter }
-    vo_is_hidden
+    vo_is_hidden_para,
+    vo_has_explicit_paraloc,
+    vo_is_syscall_lib
   );
   tvaroptions=set of tvaroption;
 
@@ -412,7 +423,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.92  2004-11-08 22:09:59  peter
+  Revision 1.93  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.92  2004/11/08 22:09:59  peter
     * tvarsym splitted
 
   Revision 1.91  2004/11/01 10:33:01  peter

compiler/symdef.pas

@@ -103,22 +103,6 @@ interface
           savesize  : aint;
        end;
 
-       tparaitem = class(TLinkedListItem)
-          paratype     : ttype; { required for procvar }
-          parasym      : tsym;
-          parasymderef : tderef;
-          defaultvalue : tsym; { tconstsym }
-          defaultvaluederef : tderef;
-          paratyp       : tvarspez; { required for procvar }
-          paraloc       : array[tcallercallee] of TCGPara;
-          is_hidden     : boolean; { is this a hidden (implicit) parameter }
-{$ifdef EXTDEBUG}
-          eqval         : tequaltype;
-{$endif EXTDEBUG}
-          constructor create;
-          destructor destroy;override;
-       end;
-
        tfiletyp = (ft_text,ft_typed,ft_untyped);
 
        tfiledef = class(tstoreddef)
@@ -447,11 +431,12 @@ interface
           { saves a definition to the return type }
           rettype         : ttype;
           parast          : tsymtable;
-          para            : tlinkedlist;
+          paras           : tlist;
           proctypeoption  : tproctypeoption;
           proccalloption  : tproccalloption;
           procoptions     : tprocoptions;
           requiredargarea : aint;
+          { number of user visibile parameters }
           maxparacount,
           minparacount    : byte;
 {$ifdef i386}
@@ -466,9 +451,7 @@ interface
           procedure buildderef;override;
           procedure deref;override;
           procedure releasemem;
-          function  concatpara(afterpara:tparaitem;const tt:ttype;sym : tsym;defval:tsym;vhidden:boolean):tparaitem;
-          function  insertpara(const tt:ttype;sym : tsym;defval:tsym;vhidden:boolean):tparaitem;
-          procedure removepara(currpara:tparaitem);
+          procedure calcparas;
           function  typename_paras(showhidden:boolean): string;
           procedure test_if_fpu_result;
           function  is_methodpointer:boolean;virtual;
@@ -477,6 +460,9 @@ interface
 {$ifdef GDB}
           function  stabstring : pchar;override;
 {$endif GDB}
+       private
+          procedure count_para(p:tnamedindexitem;arg:pointer);
+          procedure insert_para(p:tnamedindexitem;arg:pointer);
        end;
 
        tprocvardef = class(tabstractprocdef)
@@ -812,7 +798,6 @@ interface
        pbestrealtype : ^ttype = @s64floattype;
 {$endif ARM}
 
-    function reverseparaitems(p: tparaitem): tparaitem;
     function make_mangledname(const typeprefix:string;st:tsymtable;const suffix:string):string;
 
     { should be in the types unit, but the types unit uses the node stuff :( }
@@ -850,24 +835,6 @@ implementation
                                   Helpers
 ****************************************************************************}
 
-    function reverseparaitems(p: tparaitem): tparaitem;
-      var
-        hp1, hp2: tparaitem;
-      begin
-        hp1:=nil;
-        while assigned(p) do
-          begin
-             { pull out }
-             hp2:=p;
-             p:=tparaitem(p.next);
-             { pull in }
-             hp2.next:=hp1;
-             hp1:=hp2;
-          end;
-        reverseparaitems:=hp1;
-      end;
-
-
     function make_mangledname(const typeprefix:string;st:tsymtable;const suffix:string):string;
       var
         s,
@@ -926,26 +893,6 @@ implementation
       end;
 
 
-{****************************************************************************
-                           TParaItem
-****************************************************************************}
-
-    constructor tparaitem.create;
-      begin
-        inherited create;
-        paraloc[calleeside].init;
-        paraloc[callerside].init;
-      end;
-
-
-    destructor tparaitem.destroy;
-      begin
-        paraloc[calleeside].done;
-        paraloc[callerside].done;
-        inherited destroy;
-      end;
-
-
 {****************************************************************************
                      TDEF (base class for definitions)
 ****************************************************************************}
@@ -3310,7 +3257,7 @@ implementation
          parast:=tparasymtable.create(level);
          parast.defowner:=self;
          parast.next:=owner;
-         para:=TLinkedList.Create;
+         paras:=nil;
          minparacount:=0;
          maxparacount:=0;
          proctypeoption:=potype_none;
@@ -3330,12 +3277,12 @@ implementation
 
     destructor tabstractprocdef.destroy;
       begin
-         if assigned(para) then
+         if assigned(paras) then
            begin
 {$ifdef MEMDEBUG}
              memprocpara.start;
 {$endif MEMDEBUG}
-             para.free;
+             paras.free;
 {$ifdef MEMDEBUG}
              memprocpara.stop;
 {$endif MEMDEBUG}
@@ -3358,73 +3305,65 @@ implementation
 
     procedure tabstractprocdef.releasemem;
       begin
-        para.free;
-        para:=nil;
+        if assigned(paras) then
+          begin
+            paras.free;
+            paras:=nil;
+          end;
         parast.free;
         parast:=nil;
       end;
 
 
-    function tabstractprocdef.concatpara(afterpara:tparaitem;const tt:ttype;sym : tsym;defval:tsym;vhidden:boolean):tparaitem;
-      var
-        hp : TParaItem;
-      begin
-        hp:=TParaItem.Create;
-        hp.paratyp:=tparavarsym(sym).varspez;
-        hp.parasym:=sym;
-        hp.paratype:=tt;
-        hp.is_hidden:=vhidden;
-        hp.defaultvalue:=defval;
-        { 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 not vhidden then
+    procedure tabstractprocdef.count_para(p:tnamedindexitem;arg:pointer);
+      begin
+        if (tsym(p).typ<>paravarsym) then
+          exit;
+        inc(plongint(arg)^);
+        if not(vo_is_hidden_para in tparavarsym(p).varoptions) then
          begin
-           if not assigned(defval) then
-            inc(minparacount);
+           if not assigned(tparavarsym(p).defaultconstsym) then
+             inc(minparacount);
            inc(maxparacount);
          end;
-        concatpara:=hp;
       end;
 
 
-    function tabstractprocdef.insertpara(const tt:ttype;sym : tsym;defval:tsym;vhidden:boolean):tparaitem;
+    procedure tabstractprocdef.insert_para(p:tnamedindexitem;arg:pointer);
+      begin
+        if (tsym(p).typ<>paravarsym) then
+          exit;
+        paras.add(p);
+      end;
+
+
+    function ParaNrCompare(Item1, Item2: Pointer): Integer;
       var
-        hp : TParaItem;
-      begin
-        hp:=TParaItem.Create;
-        hp.paratyp:=tparavarsym(sym).varspez;
-        hp.parasym:=sym;
-        hp.paratype:=tt;
-        hp.is_hidden:=vhidden;
-        hp.defaultvalue:=defval;
-        { Parameters are stored from left to right }
-        Para.insert(hp);
-        { Don't count hidden parameters }
-        if (not vhidden) then
-         begin
-           if not assigned(defval) then
-            inc(minparacount);
-           inc(maxparacount);
-         end;
-        insertpara:=hp;
+        I1 : tparavarsym absolute Item1;
+        I2 : tparavarsym absolute Item2;
+      begin
+        Result:=I1.paranr-I2.paranr;
       end;
 
 
-    procedure tabstractprocdef.removepara(currpara:tparaitem);
+    procedure tabstractprocdef.calcparas;
+      var
+        paracount : longint;
       begin
-        { Don't count hidden parameters }
-        if (not currpara.is_hidden) then
-         begin
-           if not assigned(currpara.defaultvalue) then
-            dec(minparacount);
-           dec(maxparacount);
-         end;
-        Para.Remove(currpara);
-        currpara.free;
+        { This can already be assigned when
+          we need to reresolve this unit (PFV) }
+        if assigned(paras) then
+          paras.free;
+        paras:=tlist.create;
+        paracount:=0;
+        minparacount:=0;
+        maxparacount:=0;
+        parast.foreach(@count_para,@paracount);
+        paras.capacity:=paracount;
+        { Insert parameters in table }
+        parast.foreach(@insert_para,nil);
+        { Order parameters }
+        paras.sort(@paranrcompare);
       end;
 
 
@@ -3443,8 +3382,6 @@ implementation
 
 
     procedure tabstractprocdef.buildderef;
-      var
-         hp : TParaItem;
       begin
          { released procdef? }
          if not assigned(parast) then
@@ -3453,57 +3390,27 @@ implementation
          rettype.buildderef;
          { parast }
          tparasymtable(parast).buildderef;
-         { paraitems }
-         hp:=TParaItem(Para.first);
-         while assigned(hp) do
-          begin
-            hp.paratype.buildderef;
-            hp.defaultvaluederef.build(hp.defaultvalue);
-            hp.parasymderef.build(hp.parasym);
-            hp:=TParaItem(hp.next);
-          end;
       end;
 
 
     procedure tabstractprocdef.deref;
-      var
-         hp : TParaItem;
       begin
          inherited deref;
          rettype.resolve;
          { parast }
          tparasymtable(parast).deref;
-         { paraitems }
-         minparacount:=0;
-         maxparacount:=0;
-         hp:=TParaItem(Para.first);
-         while assigned(hp) do
-          begin
-            hp.paratype.resolve;
-            hp.defaultvalue:=tsym(hp.defaultvaluederef.resolve);
-            hp.parasym:=tparavarsym(hp.parasymderef.resolve);
-            { connect parasym to paraitem }
-            tparavarsym(hp.parasym).paraitem:=hp;
-            { Don't count hidden parameters }
-            if (not hp.is_hidden) then
-             begin
-               if not assigned(hp.defaultvalue) then
-                 inc(minparacount);
-               inc(maxparacount);
-             end;
-            hp:=TParaItem(hp.next);
-          end;
+         { recalculated parameters }
+         calcparas;
       end;
 
 
     constructor tabstractprocdef.ppuload(ppufile:tcompilerppufile);
       var
-         hp : TParaItem;
-         count,i : word;
+        b : byte;
       begin
          inherited ppuloaddef(ppufile);
          parast:=nil;
-         Para:=TLinkedList.Create;
+         Paras:=nil;
          minparacount:=0;
          maxparacount:=0;
          ppufile.gettype(rettype);
@@ -3516,37 +3423,24 @@ implementation
          proccalloption:=tproccalloption(ppufile.getbyte);
          ppufile.getsmallset(procoptions);
 
+         funcret_paraloc[callerside].init;
+         funcret_paraloc[calleeside].init;
          if po_explicitparaloc in procoptions then
-           ppufile.getdata(funcret_paraloc,sizeof(funcret_paraloc));
+           begin
+             b:=ppufile.getbyte;
+             if b<>sizeof(funcret_paraloc[callerside].location^) then
+               internalerror(200411154);
+             ppufile.getdata(funcret_paraloc[callerside].add_location^,sizeof(funcret_paraloc[callerside].location^));
+             funcret_paraloc[callerside].size:=funcret_paraloc[callerside].location^.size;
+           end;
 
-         { get the number of parameters }
-         count:=ppufile.getbyte;
          savesize:=sizeof(aint);
-         has_paraloc_info:=false;
-         for i:=1 to count do
-          begin
-            hp:=TParaItem.Create;
-            hp.paratyp:=tvarspez(ppufile.getbyte);
-            ppufile.gettype(hp.paratype);
-            ppufile.getderef(hp.defaultvaluederef);
-            hp.defaultvalue:=nil;
-            ppufile.getderef(hp.parasymderef);
-            hp.parasym:=nil;
-            hp.is_hidden:=boolean(ppufile.getbyte);
-            if po_explicitparaloc in procoptions then
-              begin
-                ppufile.getdata(hp.paraloc[callerside].add_location^,sizeof(hp.paraloc[callerside].location^));
-                has_paraloc_info:=true;
-              end;
-            { Parameters are stored left to right in both ppu and memory }
-            Para.concat(hp);
-          end;
+         has_paraloc_info:=(po_explicitparaloc in procoptions);
       end;
 
 
     procedure tabstractprocdef.ppuwrite(ppufile:tcompilerppufile);
       var
-        hp : TParaItem;
         oldintfcrc : boolean;
       begin
          { released procdef? }
@@ -3568,43 +3462,33 @@ implementation
          ppufile.putsmallset(procoptions);
          ppufile.do_interface_crc:=oldintfcrc;
 
-         if po_explicitparaloc in procoptions then
-           ppufile.putdata(funcret_paraloc,sizeof(funcret_paraloc));
-
-         { 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.puttype(hp.paratype);
-            ppufile.putderef(hp.defaultvaluederef);
-            ppufile.putderef(hp.parasymderef);
-            ppufile.putbyte(byte(hp.is_hidden));
-            if po_explicitparaloc in procoptions then
-              begin
-                hp.paraloc[callerside].check_simple_location;
-                ppufile.putdata(hp.paraloc[callerside].location^,sizeof(hp.paraloc[callerside].location^));
-              end;
-            hp:=TParaItem(hp.next);
-          end;
+         if (po_explicitparaloc in procoptions) then
+           begin
+{$warning TODO Hack to make a valid funcret_paraloc for procedures}
+             { Make a 'valid' funcret_paraloc for procedures }
+             if is_void(rettype.def) and not assigned(funcret_paraloc[callerside].location) then
+               funcret_paraloc[callerside].add_location;
+             funcret_paraloc[callerside].check_simple_location;
+             ppufile.putbyte(sizeof(funcret_paraloc[callerside].location^));
+             ppufile.putdata(funcret_paraloc[callerside].location^,sizeof(funcret_paraloc[callerside].location^));
+           end;
       end;
 
 
-
     function tabstractprocdef.typename_paras(showhidden:boolean) : string;
       var
-        hs,s : string;
-        hp : TParaItem;
-        hpc : tconstsym;
+        hs,s  : string;
+        hp    : TParavarsym;
+        hpc   : tconstsym;
         first : boolean;
+        i     : integer;
       begin
-        hp:=TParaItem(Para.first);
         s:='';
         first:=true;
-        while assigned(hp) do
+        for i:=0 to paras.count-1 do
          begin
-           if (not hp.is_hidden) or
+           hp:=tparavarsym(paras[i]);
+           if not(vo_is_hidden_para in hp.varoptions) or
               (showhidden) then
             begin
                if first then
@@ -3614,7 +3498,7 @@ implementation
                 end
                else
                 s:=s+',';
-               case hp.paratyp of
+               case hp.varspez of
                  vs_var :
                    s:=s+'var';
                  vs_const :
@@ -3622,22 +3506,22 @@ implementation
                  vs_out :
                    s:=s+'out';
                end;
-               if assigned(hp.paratype.def.typesym) then
+               if assigned(hp.vartype.def.typesym) then
                  begin
                    if s<>'(' then
                     s:=s+' ';
-                   hs:=hp.paratype.def.typesym.realname;
+                   hs:=hp.vartype.def.typesym.realname;
                    if hs[1]<>'$' then
-                     s:=s+hp.paratype.def.typesym.realname
+                     s:=s+hp.vartype.def.typesym.realname
                    else
-                     s:=s+hp.paratype.def.gettypename;
+                     s:=s+hp.vartype.def.gettypename;
                  end
                else
-                 s:=s+hp.paratype.def.gettypename;
+                 s:=s+hp.vartype.def.gettypename;
                { default value }
-               if assigned(hp.defaultvalue) then
+               if assigned(hp.defaultconstsym) then
                 begin
-                  hpc:=tconstsym(hp.defaultvalue);
+                  hpc:=tconstsym(hp.defaultconstsym);
                   hs:='';
                   case hpc.consttyp of
                     conststring,
@@ -3668,7 +3552,6 @@ implementation
                    s:=s+'="'+hs+'"';
                 end;
              end;
-           hp:=TParaItem(hp.next);
          end;
         if not first then
          s:=s+')';
@@ -4370,9 +4253,10 @@ implementation
 
     function tprocdef.mangledname : string;
       var
-        hp : TParaItem;
+        hp : TParavarsym;
         s : string;
         crc : dword;
+        i   : integer;
       begin
         if assigned(_mangledname) then
          begin
@@ -4389,12 +4273,11 @@ implementation
         if overloadnumber>0 then
          mangledname:=mangledname+'$'+tostr(overloadnumber);
         { add parameter types }
-        hp:=TParaItem(Para.first);
-        while assigned(hp) do
+        for i:=0 to paras.count-1 do
          begin
-           if not hp.is_hidden then
-             mangledname:=mangledname+'$'+hp.paratype.def.mangledparaname;
-           hp:=TParaItem(hp.next);
+           hp:=tparavarsym(paras[i]);
+           if not(vo_is_hidden_para in hp.varoptions) then
+             mangledname:=mangledname+'$'+hp.vartype.def.mangledparaname;
          end;
         { cut off too long strings using a crc }
         if length(result)>200 then
@@ -4440,7 +4323,8 @@ implementation
 
       var
          s,s2 : string;
-         param : TParaItem;
+         hp   : TParavarsym;
+         i    : integer;
 
       begin
          s := procsym.realname;
@@ -4465,16 +4349,17 @@ implementation
          { !!!!! }
 
          { now we handle the parameters }
-         param := TParaItem(Para.first);
-         if assigned(param) then
-           while assigned(param) do
-             begin
-                s2:=getcppparaname(param.paratype.def);
-                if param.paratyp in [vs_var,vs_out] then
-                  s2:='R'+s2;
-                s:=s+s2;
-                param:=TParaItem(param.next);
-             end
+         if maxparacount>0 then
+           begin
+             for i:=0 to paras.count-1 do
+               begin
+                 hp:=tparavarsym(paras[i]);
+                 s2:=getcppparaname(hp.vartype.def);
+                 if hp.varspez in [vs_var,vs_out] then
+                   s2:='R'+s2;
+                 s:=s+s2;
+               end;
+           end
          else
            s:=s+'v';
          cplusplusmangledname:=s;
@@ -4642,7 +4527,7 @@ implementation
             inc(i);
             if param^.paratyp = vs_value then vartyp := '1' else vartyp := '0';
             {Here we have lost the parameter names !!}
-            pst := strpnew('p'+tostr(i)+':'+param^.paratype.def.numberstring+','+vartyp+';');
+            pst := strpnew('p'+tostr(i)+':'+param^.vartype.def.numberstring+','+vartyp+';');
             strcat(nss,pst);
             strdispose(pst);
             param := param^.next;
@@ -4665,9 +4550,34 @@ implementation
 
 
     procedure tprocvardef.write_rtti_data(rt:trttitype);
-      var
-         pdc : TParaItem;
-         methodkind, paraspec : byte;
+
+         procedure write_para(parasym:tparavarsym);
+         var
+           paraspec : byte;
+         begin
+           { only store user visible parameters }
+           if not(vo_is_hidden_para in parasym.varoptions) then
+             begin
+               case parasym.varspez of
+                 vs_value: paraspec := 0;
+                 vs_const: paraspec := pfConst;
+                 vs_var  : paraspec := pfVar;
+                 vs_out  : paraspec := pfOut;
+               end;
+               { write flags for current parameter }
+               rttiList.concat(Tai_const.Create_8bit(paraspec));
+               { write name of current parameter }
+               rttiList.concat(Tai_const.Create_8bit(length(parasym.realname)));
+               rttiList.concat(Tai_string.Create(parasym.realname));
+
+               { write name of type of current parameter }
+               tstoreddef(parasym.vartype.def).write_rtti_name;
+             end;
+         end;
+
+       var
+         methodkind : byte;
+         i : integer;
       begin
         if po_methodpointer in procoptions then
           begin
@@ -4688,38 +4598,14 @@ implementation
              { write parameter info. The parameters must be written in reverse order
                if this method uses right to left parameter pushing! }
              if proccalloption in pushleftright_pocalls then
-              pdc:=TParaItem(Para.first)
+               begin
+                 for i:=0 to paras.count-1 do
+                   write_para(tparavarsym(paras[i]));
+               end
              else
-              pdc:=TParaItem(Para.last);
-             while assigned(pdc) do
                begin
-                 { only store user visible parameters }
-                 if not pdc.is_hidden then
-                   begin
-                     case pdc.paratyp of
-                       vs_value: paraspec := 0;
-                       vs_const: paraspec := pfConst;
-                       vs_var  : paraspec := pfVar;
-                       vs_out  : paraspec := pfOut;
-                     end;
-                     { write flags for current parameter }
-                     rttiList.concat(Tai_const.Create_8bit(paraspec));
-                     { write name of current parameter }
-                     if assigned(pdc.parasym) then
-                       begin
-                         rttiList.concat(Tai_const.Create_8bit(length(pdc.parasym.realname)));
-                         rttiList.concat(Tai_string.Create(pdc.parasym.realname));
-                       end
-                     else
-                       rttiList.concat(Tai_const.Create_8bit(0));
-
-                     { write name of type of current parameter }
-                     tstoreddef(pdc.paratype.def).write_rtti_name;
-                   end;
-                 if proccalloption in pushleftright_pocalls then
-                  pdc:=TParaItem(pdc.next)
-                 else
-                  pdc:=TParaItem(pdc.previous);
+                 for i:=paras.count-1 downto 0 do
+                   write_para(tparavarsym(paras[i]));
                end;
 
              { write name of result type }
@@ -5171,11 +5057,12 @@ implementation
           newrec : pchar;
           pd     : tprocdef;
           lindex : longint;
-          para : TParaItem;
           arglength : byte;
           sp : char;
           state:^Trecord_stabgen_state;
           olds:integer;
+          i : integer;
+          parasym : tparavarsym;
       begin
         state:=arg;
         if tsym(p).typ = procsym then
@@ -5201,12 +5088,12 @@ implementation
 
            { arguments are not listed here }
            {we don't need another definition}
-            para := TParaItem(pd.Para.first);
-            while assigned(para) do
+            for i:=0 to pd.paras.count-1 do
               begin
-                if Para.paratype.def.deftype = formaldef then
+                parasym:=tparavarsym(pd.paras[i]);
+                if Parasym.vartype.def.deftype = formaldef then
                   begin
-                    case Para.paratyp of
+                    case Parasym.varspez of
                       vs_var :
                         argnames := argnames+'3var';
                       vs_const :
@@ -5219,15 +5106,14 @@ implementation
                   begin
                     { if the arg definition is like (v: ^byte;..
                     there is no sym attached to data !!! }
-                    if assigned(Para.paratype.def.typesym) then
+                    if assigned(Parasym.vartype.def.typesym) then
                       begin
-                        arglength := length(Para.paratype.def.typesym.name);
-                        argnames := argnames + tostr(arglength)+Para.paratype.def.typesym.name;
+                        arglength := length(Parasym.vartype.def.typesym.name);
+                        argnames := argnames + tostr(arglength)+Parasym.vartype.def.typesym.name;
                       end
                     else
                       argnames:=argnames+'11unnamedtype';
                   end;
-                para := TParaItem(Para.next);
               end;
            { here 2A must be changed for private and protected }
            { 0 is private 1 protected and 2 public }
@@ -6244,7 +6130,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.270  2004-11-11 19:31:33  peter
+  Revision 1.271  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.270  2004/11/11 19:31:33  peter
     * fixed compile of powerpc,sparc,arm
 
   Revision 1.269  2004/11/08 22:09:59  peter

compiler/symsym.pas

@@ -37,7 +37,7 @@ interface
        cclasses,symnot,
        { aasm }
        aasmbase,aasmtai,
-       cpuinfo,cpubase,cgbase,cgutils
+       cpuinfo,cpubase,cgbase,cgutils,parabase
        ;
 
     type
@@ -121,9 +121,7 @@ interface
           function last_procdef:Tprocdef;
           function search_procdef_nopara_boolret:Tprocdef;
           function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
-          function search_procdef_bypara(params:Tlinkedlist;
-                                         retdef:tdef;
-                                         cpoptions:tcompare_paras_options):Tprocdef;
+          function search_procdef_bypara(para:tlist;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
           function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
           function search_procdef_assignment_operator(fromdef,todef:tdef):Tprocdef;
           function  write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
@@ -206,9 +204,14 @@ interface
       end;
 
       tparavarsym = class(tabstractnormalvarsym)
-          paraitem : tparaitem;
-          constructor create(const n : string;vsp:tvarspez;const tt : ttype);
+          paraloc       : array[tcallercallee] of TCGPara;
+          paranr        : word; { position of this parameter }
+{$ifdef EXTDEBUG}
+          eqval         : tequaltype;
+{$endif EXTDEBUG}
+          constructor create(const n : string;nr:word;vsp:tvarspez;const tt : ttype);
           constructor ppuload(ppufile:tcompilerppufile);
+          destructor destroy;override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
 {$ifdef GDB}
           function stabstring : pchar;override;
@@ -781,8 +784,6 @@ implementation
         pd^.defderef.reset;
         pd^.next:=nil;
         pd^.own:=(pd^.def.procsym=self);
-{        if not pd^.own then
-          internalerror(2222222);}
         { Add at end of list to keep always
           a correct order, also after loading from ppu }
         if assigned(pdlistlast) then
@@ -847,7 +848,7 @@ implementation
         pd:=pdlistfirst;
         while assigned(pd) do
           begin
-            if Aprocsym.search_procdef_bypara(pd^.def.para,nil,cpoptions)=nil then
+            if Aprocsym.search_procdef_bypara(pd^.def.paras,nil,cpoptions)=nil then
               Aprocsym.addprocdef(pd^.def);
             pd:=pd^.next;
           end;
@@ -935,8 +936,7 @@ implementation
       end;
 
 
-    function Tprocsym.search_procdef_bypara(params:Tlinkedlist;
-                                            retdef:tdef;
+    function Tprocsym.search_procdef_bypara(para:tlist;retdef:tdef;
                                             cpoptions:tcompare_paras_options):Tprocdef;
       var
         pd : pprocdeflist;
@@ -953,7 +953,7 @@ implementation
            if (eq>=te_equal) or
               ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
             begin
-              eq:=compare_paras(params,pd^.def.para,cp_value_equal_const,cpoptions);
+              eq:=compare_paras(para,pd^.def.paras,cp_value_equal_const,cpoptions);
               if (eq>=te_equal) or
                  ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
                 begin
@@ -1002,12 +1002,12 @@ implementation
     function Tprocsym.search_procdef_assignment_operator(fromdef,todef:tdef):Tprocdef;
       var
         convtyp : tconverttype;
-        pd : pprocdeflist;
-        bestpd : tprocdef;
+        pd      : pprocdeflist;
+        bestpd  : tprocdef;
         eq,
-        besteq : tequaltype;
-        hpd : tprocdef;
-        currpara : tparaitem;
+        besteq  : tequaltype;
+        hpd     : tprocdef;
+        i       : byte;
       begin
         result:=nil;
         bestpd:=nil;
@@ -1017,13 +1017,14 @@ implementation
           begin
             if equal_defs(todef,pd^.def.rettype.def) then
              begin
-               currpara:=Tparaitem(pd^.def.para.first);
+               i:=0;
                { ignore vs_hidden parameters }
-               while assigned(currpara) and (currpara.is_hidden) do
-                currpara:=tparaitem(currpara.next);
-               if assigned(currpara) then
+               while assigned(pd^.def.paras[i]) and
+                     (vo_is_hidden_para in tparavarsym(pd^.def.paras[i]).varoptions) do
+                 inc(i);
+               if assigned(pd^.def.paras[i]) then
                 begin
-                  eq:=compare_defs_ext(fromdef,currpara.paratype.def,nothingn,convtyp,hpd,[]);
+                  eq:=compare_defs_ext(fromdef,tparavarsym(pd^.def.paras[i]).vartype.def,nothingn,convtyp,hpd,[]);
                   if eq=te_exact then
                    begin
                      result:=pd^.def;
@@ -1717,17 +1718,40 @@ implementation
                               TPARAVARSYM
 ****************************************************************************}
 
-    constructor tparavarsym.create(const n : string;vsp:tvarspez;const tt : ttype);
+    constructor tparavarsym.create(const n : string;nr:word;vsp:tvarspez;const tt : ttype);
       begin
          inherited create(n,vsp,tt);
          typ:=paravarsym;
-         paraitem:=nil;
+         paranr:=nr;
+         paraloc[calleeside].init;
+         paraloc[callerside].init;
+      end;
+
+
+    destructor tparavarsym.destroy;
+      begin
+        paraloc[calleeside].done;
+        paraloc[callerside].done;
+        inherited destroy;
       end;
 
 
     constructor tparavarsym.ppuload(ppufile:tcompilerppufile);
+      var
+        b : byte;
       begin
          inherited ppuload(ppufile);
+         paranr:=ppufile.getword;
+         paraloc[calleeside].init;
+         paraloc[callerside].init;
+         if vo_has_explicit_paraloc in varoptions then
+           begin
+             b:=ppufile.getbyte;
+             if b<>sizeof(paraloc[callerside].location^) then
+               internalerror(200411154);
+             ppufile.getdata(paraloc[callerside].add_location^,sizeof(paraloc[callerside].location^));
+             paraloc[callerside].size:=paraloc[callerside].location^.size;
+           end;
          typ:=paravarsym;
       end;
 
@@ -1735,6 +1759,13 @@ implementation
     procedure tparavarsym.ppuwrite(ppufile:tcompilerppufile);
       begin
          inherited ppuwrite(ppufile);
+         ppufile.putword(paranr);
+         if vo_has_explicit_paraloc in varoptions then
+           begin
+             paraloc[callerside].check_simple_location;
+             ppufile.putbyte(sizeof(paraloc[callerside].location^));
+             ppufile.putdata(paraloc[callerside].location^,sizeof(paraloc[callerside].location^));
+           end;
          ppufile.writeentry(ibparavarsym);
       end;
 
@@ -1874,6 +1905,7 @@ implementation
     procedure tabsolutevarsym.ppuwrite(ppufile:tcompilerppufile);
       begin
          inherited ppuwrite(ppufile);
+         ppufile.putbyte(byte(abstyp));
          case abstyp of
            tovar :
              ppufile.putsymlist(ref);
@@ -1887,7 +1919,7 @@ implementation
 {$endif i386}
              end;
          end;
-        ppufile.writeentry(ibabsolutevarsym);
+         ppufile.writeentry(ibabsolutevarsym);
       end;
 
 
@@ -2509,7 +2541,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.191  2004-11-08 22:09:59  peter
+  Revision 1.192  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.191  2004/11/08 22:09:59  peter
     * tvarsym splitted
 
   Revision 1.190  2004/11/04 17:09:54  peter

compiler/symtable.pas

@@ -729,7 +729,7 @@ implementation
            { also don't count the value parameters which have local copies }
            { also don't claim for high param of open parameters (PM) }
            if (Errorcount<>0) or
-              (vo_is_hidden in tabstractvarsym(p).varoptions) then
+              (vo_is_hidden_para in tabstractvarsym(p).varoptions) then
              exit;
            if (tstoredsym(p).refs=0) then
              begin
@@ -2307,7 +2307,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.163  2004-11-09 23:10:22  peter
+  Revision 1.164  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.163  2004/11/09 23:10:22  peter
     * use helper call to retrieve address of input/output to reduce
       code that is generated in the main program for loading the
       threadvar

compiler/symtype.pas

@@ -114,15 +114,16 @@ interface
          destructor destroy;override;
          function  realname:string;
          procedure buildderef;virtual;
-{         procedure buildderefimpl;virtual;abstract;}
          procedure deref;virtual;
-{         procedure derefimpl;virtual;abstract;}
          function  gettypedef:tdef;virtual;
          procedure load_references(ppufile:tcompilerppufile;locals:boolean);virtual;
          function  write_references(ppufile:tcompilerppufile;locals:boolean):boolean;virtual;
          function is_visible_for_object(currobjdef:Tdef):boolean;virtual;
       end;
 
+      tsymarr = array[0..maxlongint div sizeof(pointer)-1] of tsym;
+      psymarr = ^tsymarr;
+
 {************************************************
                    TDeref
 ************************************************}
@@ -224,8 +225,8 @@ implementation
 
     uses
        verbose,
-       fmodule,
-       symdef
+       fmodule
+//       symdef
 {$ifdef GDB}
        ,gdb
 {$endif GDB}
@@ -491,8 +492,8 @@ implementation
              (owner.defowner.owner.unitid<>0)
             ) and
             not(
-                assigned(currobjdef) and
-                Tobjectdef(currobjdef).is_related(tobjectdef(owner.defowner))
+                assigned(currobjdef) {and
+                Tobjectdef(currobjdef).is_related(tobjectdef(owner.defowner))}
                )
            ) then
           exit;
@@ -1456,7 +1457,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.47  2004-11-08 22:09:59  peter
+  Revision 1.48  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.47  2004/11/08 22:09:59  peter
     * tvarsym splitted
 
   Revision 1.46  2004/11/01 23:30:11  peter

compiler/utils/ppudump.pp

@@ -899,8 +899,8 @@ const
   );
 var
   proctypeoption  : tproctypeoption;
-  i,params : longint;
-  first    : boolean;
+  i     : longint;
+  first : boolean;
 begin
   write(space,'      Return type : ');
   readtype;
@@ -939,20 +939,6 @@ begin
        end;
      writeln;
    end;
-  params:=ppufile.getbyte;
-  writeln(space,' Nr of parameters : ',params);
-  for i:=1 to params do
-   begin
-     writeln(space,' - Parameter ',i);
-     writeln(space,'       Spez : ',Varspez2Str(ppufile.getbyte));
-     write  (space,'       Type : ');
-     readtype;
-     write  (space,'    Default : ');
-     readderef;
-     write  (space,'     Symbol : ');
-     readderef;
-     writeln(space,'  Is Hidden : ',(ppufile.getbyte<>0));
-   end;
 end;
 
 
@@ -966,14 +952,15 @@ type
     vo_has_local_copy,
     vo_is_const,  { variable is declared as const (parameter) and can't be written to }
     vo_is_exported,
-    vo_is_high_value,
+    vo_is_high_para,
     vo_is_funcret,
     vo_is_self,
     vo_is_vmt,
     vo_is_result,  { special result variable }
     vo_is_parentfp,
     vo_is_loop_counter, { used to detect assignments to loop counter }
-    vo_is_hidden
+    vo_is_hidden_para,
+    vo_has_explicit_paraloc
   );
   tvaroptions=set of tvaroption;
   { register variable }
@@ -989,7 +976,7 @@ type
     str  : string[30];
   end;
 const
-  varopts=15;
+  varopts=16;
   varopt : array[1..varopts] of tvaropt=(
      (mask:vo_is_C_var;        str:'CVar'),
      (mask:vo_is_external;     str:'External'),
@@ -998,14 +985,15 @@ const
      (mask:vo_has_local_copy;  str:'HasLocalCopy'),
      (mask:vo_is_const;        str:'Constant'),
      (mask:vo_is_exported;     str:'Exported'),
-     (mask:vo_is_high_value;   str:'HighValue'),
+     (mask:vo_is_high_para;    str:'HighValue'),
      (mask:vo_is_funcret;      str:'Funcret'),
      (mask:vo_is_self;         str:'Self'),
      (mask:vo_is_vmt;          str:'VMT'),
      (mask:vo_is_result;       str:'Result'),
      (mask:vo_is_parentfp;     str:'ParentFP'),
      (mask:vo_is_loop_counter; str:'LoopCounter'),
-     (mask:vo_is_hidden;       str:'Hidden')
+     (mask:vo_is_hidden_para;  str:'Hidden'),
+     (mask:vo_has_explicit_paraloc;str:'ExplicitParaloc')
   );
 var
   i : longint;
@@ -1088,6 +1076,7 @@ var
   symcnt,
   i,j,len : longint;
   guid : tguid;
+  tempbuf : array[0..127] of char;
   varoptions : tvaroptions;
 begin
   symcnt:=1;
@@ -1252,6 +1241,12 @@ begin
              readabstractvarsym('Parameter Variable symbol ',varoptions);
              write  (space,' DefaultConst : ');
              readderef;
+             writeln(space,'       ParaNr : ',getword);
+             if (vo_has_explicit_paraloc in varoptions) then
+	       begin
+	         i:=getbyte;
+		 getdata(tempbuf,i);
+	       end;
            end;
 
          ibenumsym :
@@ -2088,7 +2083,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.58  2004-11-08 22:09:59  peter
+  Revision 1.59  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.58  2004/11/08 22:09:59  peter
     * tvarsym splitted
 
   Revision 1.57  2004/11/02 22:17:25  olle

compiler/verbose.pas

@@ -846,7 +846,9 @@ var
         status.currentsource:='';
         status.currentsourcepath:='';
         status.compiling_current:=false;
-	compiling_module:=nil;
+        compiling_module:=nil;
+        { Register internalerrorproc for cutils/cclasses }
+        internalerrorproc:=@internalerror;
       end;
 
 
@@ -868,7 +870,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.34  2004-10-15 09:14:17  mazen
+  Revision 1.35  2004-11-15 23:35:31  peter
+    * tparaitem removed, use tparavarsym instead
+    * parameter order is now calculated from paranr value in tparavarsym
+
+  Revision 1.34  2004/10/15 09:14:17  mazen
   - remove $IFDEF DELPHI and related code
   - remove $IFDEF FPCPROCVAR and related code