* const parameter is now checked

  * better and generic check if a node can be used for assigning
  * export fixes
  * procvar equal works now (it never had worked at least from 0.99.8)
  * defcoll changed to linkedlist with pparaitem so it can easily be
    walked both directions

compiler/browcol.pas

@@ -960,13 +960,14 @@ end;
   end;
   function GetAbsProcParmDefStr(def: pabstractprocdef): string;
   var Name: string;
-      dc: pdefcoll;
+      dc: pparaitem;
       Count: integer;
       CurName: string;
   begin
     Name:='';
-    dc:=def^.para1; Count:=0;
-    while dc<>nil do
+    dc:=pparaitem(def^.para^.first);
+    Count:=0;
+    while assigned(dc) do
      begin
        CurName:='';
        case dc^.paratyp of
@@ -979,7 +980,7 @@ end;
        if dc^.next<>nil then
          CurName:=', '+CurName;
        Name:=CurName+Name;
-       dc:=dc^.next; Inc(Count);
+       dc:=pparaitem(dc^.next); Inc(Count);
      end;
     GetAbsProcParmDefStr:=Name;
   end;
@@ -1696,7 +1697,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.24  1999-09-16 07:54:48  pierre
+  Revision 1.25  1999-10-26 12:30:40  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.24  1999/09/16 07:54:48  pierre
    * BuildSourceList allways called for dependency in FP
 
   Revision 1.23  1999/09/07 15:07:49  pierre

compiler/cg386cal.pas

@@ -28,7 +28,7 @@ interface
     uses
       symtable,tree;
 
-    procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
+    procedure secondcallparan(var p : ptree;defcoll : pparaitem;
                 push_from_left_to_right,inlined,dword_align : boolean;para_offset : longint);
     procedure secondcalln(var p : ptree);
     procedure secondprocinline(var p : ptree);
@@ -51,7 +51,7 @@ implementation
                              SecondCallParaN
 *****************************************************************************}
 
-    procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
+    procedure secondcallparan(var p : ptree;defcoll : pparaitem;
                 push_from_left_to_right,inlined,dword_align : boolean;para_offset : longint);
 
       procedure maybe_push_high;
@@ -81,7 +81,7 @@ implementation
       begin
          { push from left to right if specified }
          if push_from_left_to_right and assigned(p^.right) then
-           secondcallparan(p^.right,defcoll^.next,push_from_left_to_right,
+           secondcallparan(p^.right,pparaitem(defcoll^.next),push_from_left_to_right,
              inlined,dword_align,para_offset);
          otlabel:=truelabel;
          oflabel:=falselabel;
@@ -189,7 +189,7 @@ implementation
          falselabel:=oflabel;
          { push from right to left }
          if not push_from_left_to_right and assigned(p^.right) then
-           secondcallparan(p^.right,defcoll^.next,push_from_left_to_right,
+           secondcallparan(p^.right,pparaitem(defcoll^.next),push_from_left_to_right,
              inlined,dword_align,para_offset);
       end;
 
@@ -379,14 +379,14 @@ implementation
               else
                 para_offset:=0;
               if assigned(p^.right) then
-                secondcallparan(p^.left,pabstractprocdef(p^.right^.resulttype)^.para1,
+                secondcallparan(p^.left,pparaitem(pabstractprocdef(p^.right^.resulttype)^.para^.first),
                   (pocall_leftright in p^.procdefinition^.proccalloptions),
                   inlined,
                   (pocall_cdecl in p^.procdefinition^.proccalloptions) or
                    (pocall_stdcall in p^.procdefinition^.proccalloptions),
                   para_offset)
               else
-                secondcallparan(p^.left,p^.procdefinition^.para1,
+                secondcallparan(p^.left,pparaitem(p^.procdefinition^.para^.first),
                   (pocall_leftright in p^.procdefinition^.proccalloptions),
                   inlined,
                   (pocall_cdecl in p^.procdefinition^.proccalloptions) or
@@ -1222,7 +1222,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.107  1999-10-08 15:40:47  pierre
+  Revision 1.108  1999-10-26 12:30:40  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.107  1999/10/08 15:40:47  pierre
    * use and remember that C functions with complex data results use ret $4
 
   Revision 1.106  1999/09/27 23:44:46  peter

compiler/cg386inl.pas

@@ -201,13 +201,14 @@ implementation
            pararesult : pdef;
            orgfloattype : tfloattype;
            has_length : boolean;
-           dummycoll  : tdefcoll;
+           dummycoll  : tparaitem;
            iolabel    : pasmlabel;
            npara      : longint;
            esireloaded : boolean;
 
         begin
            { here we don't use register calling conventions }
+           dummycoll.init;
            dummycoll.register:=R_NO;
            { I/O check }
            if (cs_check_io in aktlocalswitches) and
@@ -514,12 +515,13 @@ implementation
 
         var
            hp,node : ptree;
-           dummycoll : tdefcoll;
+           dummycoll : tparaitem;
            is_real,has_length : boolean;
            realtype : tfloattype;
            procedureprefix : string;
 
           begin
+           dummycoll.init;
            dummycoll.register:=R_NO;
            pushusedregisters(pushed,$ff);
            node:=p^.left;
@@ -646,11 +648,12 @@ implementation
            hdef: POrdDef;
            procedureprefix : string;
            hr, hr2: TReference;
-           dummycoll : tdefcoll;
+           dummycoll : tparaitem;
            has_code, has_32bit_code, oldregisterdef: boolean;
            r : preference;
 
           begin
+           dummycoll.init;
            dummycoll.register:=R_NO;
            node:=p^.left;
            hp:=node;
@@ -1423,7 +1426,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.74  1999-10-21 16:41:38  florian
+  Revision 1.75  1999-10-26 12:30:40  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.74  1999/10/21 16:41:38  florian
     * problems with readln fixed: esi wasn't restored correctly when
       reading ordinal fields of objects futher the register allocation
       didn't take care of the extra register when reading ordinal values

compiler/cobjects.pas

@@ -131,6 +131,9 @@ unit cobjects;
 
           { is the linkedlist empty ? }
           function  empty:boolean;
+
+          { items in the list }
+          function  count:longint;
        end;
 
        { some help data types }
@@ -414,7 +417,7 @@ unit cobjects;
 
     uses
       comphook;
-      
+
 {*****************************************************************************
                                     Memory debug
 *****************************************************************************}
@@ -1128,12 +1131,29 @@ end;
           end;
       end;
 
+
     function tlinkedlist.empty:boolean;
       begin
         empty:=(first=nil);
       end;
 
 
+    function tlinkedlist.count:longint;
+      var
+        i : longint;
+        hp : plinkedlist_item;
+      begin
+        hp:=first;
+        i:=0;
+        while assigned(hp) do
+         begin
+           inc(i);
+           hp:=hp^.next;
+         end;
+        count:=i;
+      end;
+
+
 {****************************************************************************
                                Tnamedindexobject
  ****************************************************************************}
@@ -2257,7 +2277,15 @@ end;
 end.
 {
   $Log$
-  Revision 1.42  1999-09-07 15:08:51  pierre
+  Revision 1.43  1999-10-26 12:30:41  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.42  1999/09/07 15:08:51  pierre
    * runerror => do_internalerror
 
   Revision 1.41  1999/08/24 13:13:57  peter

compiler/errore.msg

@@ -798,6 +798,12 @@ parser_e_proc_directive_expected=E_Procedure directive expected
 %   p : procedure stdcall=nil;
 % \end{verbatim}
 parser_e_invalid_property_index_value=E_The value for a property index must be of an ordinal type
+% The value you use to index a property must be of an ordinal type, for
+% example an integer or enumerated type.
+parser_e_procname_to_short_for_export=E_Procedure name to short to be exported
+% The length of the procedure/function name must be at least 2 characters
+% long. This is because of a bug in dlltool which doesn't parse the .def
+% file correct with a name of length 1.
 % \end{description}
 #
 # Type Checking
@@ -928,6 +934,10 @@ type_e_no_assign_to_addr=E_Can't assign values to an address
 % It's not allowed to assign a value to an address of a variable,constant,
 % procedure or function. You can try compiling with -So if the identifier
 % is a procedure variable.
+type_e_no_assign_to_const=E_Can't assign values to const variable
+% It's not allowed to assign a value to a variable which is declared
+% as a const. This is normally a parameter declared as const, to allow
+% changing make the parameter value or var.
 % \end{description}
 #
 # Symtable

compiler/globals.pas

@@ -1270,7 +1270,7 @@ end;
 
       { Init values }
         initmodeswitches:=fpcmodeswitches;
-        initlocalswitches:=[];
+        initlocalswitches:=[cs_check_io];
         initmoduleswitches:=[cs_extsyntax,cs_browser];
         initglobalswitches:=[cs_check_unit_name,cs_link_static];
 {$ifdef i386}
@@ -1315,7 +1315,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.26  1999-10-21 14:29:34  peter
+  Revision 1.27  1999-10-26 12:30:41  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.26  1999/10/21 14:29:34  peter
     * redesigned linker object
     + library support for linux (only procedures can be exported)
 

compiler/hcgdata.pas

@@ -404,7 +404,7 @@ implementation
                              while assigned(procdefcoll) do
                                begin
                                   { compare parameters }
-                                  if equal_paras(procdefcoll^.data^.para1,hp^.para1,false) and
+                                  if equal_paras(procdefcoll^.data^.para,hp^.para,false) and
                                      (
                                        (po_virtualmethod in procdefcoll^.data^.procoptions) or
                                        (po_virtualmethod in hp^.procoptions)
@@ -614,7 +614,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.17  1999-09-13 16:23:42  peter
+  Revision 1.18  1999-10-26 12:30:41  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.17  1999/09/13 16:23:42  peter
     * remvoed unused var
 
   Revision 1.16  1999/09/12 14:50:50  florian

compiler/htypechk.pas

@@ -52,6 +52,7 @@ interface
     function  is_procsym_call(p:Ptree):boolean;
     function  assignment_overloaded(from_def,to_def : pdef) : pprocdef;
     procedure test_local_to_procvar(from_def:pprocvardef;to_def:pdef);
+    function  valid_for_assign(p:ptree;allowprop:boolean):boolean;
 
 
 implementation
@@ -699,8 +700,8 @@ implementation
           while passproc<>nil do
             begin
               if is_equal(passproc^.retdef,to_def) and
-                 (is_equal(passproc^.para1^.data,from_def) or
-                 (isconvertable(from_def,passproc^.para1^.data,convtyp,ordconstn,false)=1)) then
+                 (is_equal(pparaitem(passproc^.para^.first)^.data,from_def) or
+                 (isconvertable(from_def,pparaitem(passproc^.para^.first)^.data,convtyp,ordconstn,false)=1)) then
                 begin
                    assignment_overloaded:=passproc;
                    break;
@@ -709,6 +710,7 @@ implementation
             end;
        end;
 
+
     { local routines can't be assigned to procvars }
     procedure test_local_to_procvar(from_def:pprocvardef;to_def:pdef);
       begin
@@ -716,10 +718,111 @@ implementation
            CGMessage(type_e_cannot_local_proc_to_procvar);
       end;
 
+
+    function valid_for_assign(p:ptree;allowprop:boolean):boolean;
+      var
+        hp : ptree;
+        gotderef : boolean;
+      begin
+        valid_for_assign:=false;
+        gotderef:=false;
+        hp:=p;
+        while assigned(hp) do
+         begin
+           if (not allowprop) and
+              (hp^.isproperty) then
+            begin
+              CGMessagePos(hp^.fileinfo,type_e_argument_cant_be_assigned);
+              exit;
+            end;
+           case hp^.treetype of
+             derefn :
+               begin
+                 gotderef:=true;
+                 hp:=hp^.left;
+               end;
+             typeconvn,
+             vecn,
+             subscriptn :
+               hp:=hp^.left;
+             subn,
+             addn :
+               begin
+                 { Allow add/sub operators on a pointer }
+                 if (hp^.resulttype^.deftype=pointerdef) then
+                  valid_for_assign:=true
+                 else
+                  CGMessagePos(hp^.fileinfo,type_e_variable_id_expected);
+                 exit;
+               end;
+             addrn :
+               begin
+                 if not(gotderef) and
+                    not(hp^.procvarload) then
+                  CGMessagePos(hp^.fileinfo,type_e_no_assign_to_addr);
+                 exit;
+               end;
+             funcretn :
+               begin
+                 valid_for_assign:=true;
+                 exit;
+               end;
+             loadn :
+               begin
+                 case hp^.symtableentry^.typ of
+                   absolutesym,
+                   varsym :
+                     begin
+                       if (pvarsym(hp^.symtableentry)^.varspez=vs_const) then
+                        begin
+                          CGMessagePos(hp^.fileinfo,type_e_no_assign_to_const);
+                          exit;
+                        end;
+                       { Are we at a with symtable, then we need to process the
+                         withrefnode also to check for maybe a const load }
+                       if (hp^.symtable^.symtabletype=withsymtable) then
+                        begin
+                          { continue with processing the withref node }
+                          hp:=ptree(pwithsymtable(hp^.symtable)^.withrefnode);
+                        end
+                       else
+                        begin
+                          { set the assigned flag for varsyms }
+                          if (pvarsym(hp^.symtableentry)^.varstate=vs_declared) then
+                           pvarsym(hp^.symtableentry)^.varstate:=vs_assigned;
+                          valid_for_assign:=true;
+                          exit;
+                        end;
+                     end;
+                   funcretsym,
+                   typedconstsym :
+                     begin
+                       valid_for_assign:=true;
+                       exit;
+                     end;
+                 end;
+               end;
+             else
+               begin
+                 CGMessagePos(hp^.fileinfo,type_e_variable_id_expected);
+                 exit;
+               end;
+            end;
+         end;
+      end;
+
 end.
 {
   $Log$
-  Revision 1.41  1999-10-14 14:57:52  florian
+  Revision 1.42  1999-10-26 12:30:41  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.41  1999/10/14 14:57:52  florian
     - removed the hcodegen use in the new cg, use cgbase instead
 
   Revision 1.40  1999/09/26 21:30:15  peter

compiler/msgidx.inc

@@ -213,6 +213,7 @@ type tmsgconst=(
   parser_e_only_publishable_classes_can__be_published,
   parser_e_proc_directive_expected,
   parser_e_invalid_property_index_value,
+  parser_e_procname_to_short_for_export,
   type_e_mismatch,
   type_e_incompatible_types,
   type_e_not_equal_types,
@@ -243,6 +244,7 @@ type tmsgconst=(
   type_e_argument_cant_be_assigned,
   type_e_cannot_local_proc_to_procvar,
   type_e_no_assign_to_addr,
+  type_e_no_assign_to_const,
   sym_e_id_not_found,
   sym_f_internal_error_in_symtablestack,
   sym_e_duplicate_id,

compiler/msgtxt.inc

@@ -227,236 +227,238 @@ const msgtxt : array[0..000103,1..240] of char=(
   'E_Only clas','s which are compiled in $M+ mode can be published'#000+
   'E_Procedure directive expected'#000+
   'E_The value for a property index must be of an ordinal type'#000+
+  'E_Procedure name to short to be exported'#000+
   'E_Type mismatch'#000+
-  'E_Incompatible types: got "$1" expected "$2"'#000+
+  'E_Incompatible types: got "$1" expected "$','2"'#000+
   'E_Type mismatch between $1 and $2'#000+
-  'E_Ty','pe identifier expected'#000+
+  'E_Type identifier expected'#000+
   'E_Variable identifier expected'#000+
   'E_Integer expression expected, but got "$1"'#000+
   'E_Boolean expression expected, but got "$1"'#000+
   'E_Ordinal expression expected'#000+
-  'E_pointer type expected, but got "$1"'#000+
-  'E_class type expected, but got',' "$1"'#000+
+  'E_pointer type expected, bu','t got "$1"'#000+
+  'E_class type expected, but got "$1"'#000+
   'E_Variable or type indentifier expected'#000+
   'E_Can'#039't evaluate constant expression'#000+
   'E_Set elements are not compatible'#000+
   'E_Operation not implemented for sets'#000+
-  'W_Automatic type conversion from floating type to COMP which is an int'+
-  'eger type'#000+
-  'H_use ','DIV instead to get an integer result'#000+
+  'W_Automatic type conversion from floating typ','e to COMP which is an i'+
+  'nteger type'#000+
+  'H_use DIV instead to get an integer result'#000+
   'E_string types doesn'#039't match, because of $V+ mode'#000+
   'E_succ or pred on enums with assignments not possible'#000+
   'E_Can'#039't read or write variables of this type'#000+
-  'E_Type conflict between set elements'#000+
-  'W_lo/hi(dword/qwo','rd) returns the upper/lower word/dword'#000+
+  'E_Type confli','ct between set elements'#000+
+  'W_lo/hi(dword/qword) returns the upper/lower word/dword'#000+
   'E_Integer or real expression expected'#000+
   'E_Wrong type $1 in array constructor'#000+
   'E_Incompatible type for arg no. $1: Got $2, expected $3'#000+
-  'E_Method (variable) and Procedure (variable) are not compatible'#000+
-  'E_Ille','gal constant passed to internal math function'#000+
+  'E_Method (variable) and Proce','dure (variable) are not compatible'#000+
+  'E_Illegal constant passed to internal math function'#000+
   'E_Can'#039't get the address of constants'#000+
   'E_Argument can'#039't be assigned to'#000+
   'E_Can'#039't assign local procedure/function to procedure variable'#000+
-  'E_Can'#039't assign values to an address'#000+
+  'E_Can'#039't assign values ','to an address'#000+
+  'E_Can'#039't assign values to const variable'#000+
   'E_Identifier not found $1'#000+
-  'F','_Internal Error in SymTableStack()'#000+
+  'F_Internal Error in SymTableStack()'#000+
   'E_Duplicate identifier $1'#000+
   'H_Identifier already defined in $1 at line $2'#000+
   'E_Unknown identifier $1'#000+
-  'E_Forward declaration not solved $1'#000+
+  'E_Forward declaration not so','lved $1'#000+
   'F_Identifier type already defined as type'#000+
   'E_Error in type definition'#000+
-  'E_Ty','pe identifier not defined'#000+
+  'E_Type identifier not defined'#000+
   'E_Forward type not resolved $1'#000+
   'E_Only static variables can be used in static methods or outside metho'+
   'ds'#000+
-  'E_Invalid call to tvarsym.mangledname()'#000+
+  'E_Invalid call to tvarsym.man','gledname()'#000+
   'F_record or class type expected'#000+
-  'E_Instances of classes or objects with',' an abstract method are not al'+
-  'lowed'#000+
+  'E_Instances of classes or objects with an abstract method are not allo'+
+  'wed'#000+
   'W_Label not defined $1'#000+
   'E_Illegal label declaration'#000+
   'E_GOTO and LABEL are not supported (use switch -Sg)'#000+
   'E_Label not found'#000+
-  'E_identifier isn'#039't a label'#000+
+  'E_','identifier isn'#039't a label'#000+
   'E_label already defined'#000+
-  'E_illegal type declaration of se','t elements'#000+
+  'E_illegal type declaration of set elements'#000+
   'E_Forward class definition not resolved $1'#000+
   'H_Parameter not used $1'#000+
   'N_Local variable not used $1'#000+
   'E_Set type expected'#000+
-  'W_Function result does not seem to be set'#000+
+  'W_Function result does not seem ','to be set'#000+
   'E_Unknown record field identifier $1'#000+
-  'W_Local variable $1 does not seem ','to be initialized'#000+
+  'W_Local variable $1 does not seem to be initialized'#000+
   'W_Variable $1 does not seem to be initialized'#000+
   'E_identifier idents no member $1'#000+
   'B_Found declaration: $1'#000+
   'E_Data segment too large (max. 2GB)'#000+
-  'E_BREAK not allowed'#000+
+  'E_','BREAK not allowed'#000+
   'E_CONTINUE not allowed'#000+
-  'E_Expression too complicated - FPU stack',' overflow'#000+
+  'E_Expression too complicated - FPU stack overflow'#000+
   'E_Illegal expression'#000+
   'E_Invalid integer expression'#000+
   'E_Illegal qualifier'#000+
   'E_High range limit < low range limit'#000+
   'E_Illegal counter variable'#000+
-  'E_Can'#039't determine which overloaded function to call'#000+
+  'E_Can'#039't determi','ne which overloaded function to call'#000+
   'E_Parameter list size exceeds 65535 bytes'#000+
-  'E_','Illegal type conversion'#000+
+  'E_Illegal type conversion'#000+
   'D_Conversion between ordinals and pointers is not portable across plat'+
   'forms'#000+
   'E_File types must be var parameters'#000+
-  'E_The use of a far pointer isn'#039't allowed there'#000+
+  'E_The use of a far poin','ter isn'#039't allowed there'#000+
   'E_illegal call by reference parameters'#000+
-  'E_EXPORT declared ','functions can'#039't be called'#000+
+  'E_EXPORT declared functions can'#039't be called'#000+
   'W_Possible illegal call of constructor or destructor (doesn'#039't matc'+
   'h to this context)'#000+
   'N_Inefficient code'#000+
   'W_unreachable code'#000+
-  'E_procedure call with stackframe ESP/SP'#000+
+  'E_procedur','e call with stackframe ESP/SP'#000+
   'E_Abstract methods can'#039't be called directly'#000+
-  'F_Inter','nal Error in getfloatreg(), allocation failure'#000+
+  'F_Internal Error in getfloatreg(), allocation failure'#000+
   'F_Unknown float type'#000+
   'F_SecondVecn() base defined twice'#000+
   'F_Extended cg68k not supported'#000+
-  'F_32-bit unsigned not supported in MC68000 mode'#000+
+  'F_32-bit unsigned not supp','orted in MC68000 mode'#000+
   'F_Internal Error in secondinline()'#000+
-  'D_Register $1 weight $2 ','$3'#000+
+  'D_Register $1 weight $2 $3'#000+
   'E_Stack limit excedeed in local routine'#000+
   'D_Stack frame is omitted'#000+
   'E_Object or class methods can'#039't be inline.'#000+
   'E_Procvar calls can'#039't be inline.'#000+
-  'E_No code for inline procedure stored'#000+
+  'E_No code for i','nline procedure stored'#000+
   'E_Direct call of interrupt procedure $1 is not possible'#000+
-  'E_','Element zero of an ansi/wide- or longstring can'#039't be accessed,'+
-  ' use (set)length instead'#000+
+  'E_Element zero of an ansi/wide- or longstring can'#039't be accessed, u'+
+  'se (set)length instead'#000+
   'E_Include and exclude not implemented in this case'#000+
-  'E_Constructors or destructors can not be called inside a '#039'with'#039+
+  'E_Constructors or des','tructors can not be called inside a '#039'with'#039+
   ' clause'#000+
-  'E_Cannot call message handler m','ethod directly'#000+
+  'E_Cannot call message handler method directly'#000+
   'D_Starting $1 styled assembler parsing'#000+
   'D_Finished $1 styled assembler parsing'#000+
   'E_Non-label pattern contains @'#000+
   'W_Override operator not supported'#000+
-  'E_Error building record offset'#000+
+  'E','_Error building record offset'#000+
   'E_OFFSET used without identifier'#000+
-  'E_TYPE used withou','t identifier'#000+
+  'E_TYPE used without identifier'#000+
   'E_Cannot use local variable or parameters here'#000+
   'E_need to use OFFSET here'#000+
   'E_Cannot use multiple relocatable symbols'#000+
-  'E_Relocatable symbol can only be added'#000+
+  'E_Relocatable symbol can only b','e added'#000+
   'E_Invalid constant expression'#000+
   'E_Relocatable symbol is not allowed'#000+
-  'E_Inval','id reference syntax'#000+
+  'E_Invalid reference syntax'#000+
   'E_Local symbols/labels aren'#039't allowed as references'#000+
   'E_Invalid base and index register usage'#000+
   'E_Wrong scale factor specified'#000+
-  'E_Multiple index register usage'#000+
+  'E_Multiple index',' register usage'#000+
   'E_Invalid operand type'#000+
   'E_Invalid string as opcode operand: $1'#000+
-  'W_@','CODE and @DATA not supported'#000+
+  'W_@CODE and @DATA not supported'#000+
   'E_Null label references are not allowed'#000+
   'F_Divide by zero in asm evaluator'#000+
   'F_Evaluator stack overflow'#000+
   'F_Evaluator stack underflow'#000+
-  'F_Invalid numeric format in asm evaluator'#000+
+  'F','_Invalid numeric format in asm evaluator'#000+
   'F_Invalid Operator in asm evaluator'#000+
-  'E_es','cape sequence ignored: $1'#000+
+  'E_escape sequence ignored: $1'#000+
   'E_Invalid symbol reference'#000+
   'W_Fwait can cause emulation problems with emu387'#000+
   'W_Calling an overload function in assembler'#000+
-  'E_Unsupported symbol type for operand'#000+
+  'E_Unsupported',' symbol type for operand'#000+
   'E_Constant value out of bounds'#000+
-  'E_Error converting decima','l $1'#000+
+  'E_Error converting decimal $1'#000+
   'E_Error converting octal $1'#000+
   'E_Error converting binary $1'#000+
   'E_Error converting hexadecimal $1'#000+
   'H_$1 translated to $2'#000+
-  'W_$1 is associated to an overloaded function'#000+
+  'W_$1 is associated to an overloaded funct','ion'#000+
   'E_Cannot use SELF outside a method'#000+
-  'E_Cannot use OLDEBP outside a nested proce','dure'#000+
+  'E_Cannot use OLDEBP outside a nested procedure'#000+
   'W_Functions with void return value can'#039't return any value in asm c'+
   'ode'#000+
   'E_SEG not supported'#000+
   'E_Size suffix and destination or source size do not match'#000+
-  'W_Size suffix and destination or source size do not match'#000+
+  'W_Size',' suffix and destination or source size do not match'#000+
   'E_Assembler syntax error'#000+
-  'E_In','valid combination of opcode and operands'#000+
+  'E_Invalid combination of opcode and operands'#000+
   'E_Assemler syntax error in operand'#000+
   'E_Assemler syntax error in constant'#000+
   'E_Invalid String expression'#000+
-  '32bit constant created for address'#000+
+  '32bit constant crea','ted for address'#000+
   'E_Invalid or missing opcode'#000+
-  'E_Invalid combination of prefix and o','pcode: $1'#000+
+  'E_Invalid combination of prefix and opcode: $1'#000+
   'E_Invalid combination of override and opcode: $1'#000+
   'E_Too many operands on line'#000+
   'W_NEAR ignored'#000+
   'W_FAR ignored'#000+
   'E_Duplicate local symbol $1'#000+
-  'E_Undefined local symbol $1'#000+
+  'E_Undefined loc','al symbol $1'#000+
   'E_Unknown label identifier $1'#000+
-  'E_Invalid floating point register name',#000+
+  'E_Invalid floating point register name'#000+
   'E_NOR not supported'#000+
   'W_Modulo not supported'#000+
   'E_Invalid floating point constant $1'#000+
   'E_Invalid floating point expression'#000+
   'E_Wrong symbol type'#000+
-  'E_Cannot index a local var or parameter with a register'#000+
+  'E_Cannot index a local',' var or parameter with a register'#000+
   'E_Invalid segment override expression'#000+
-  'W_Identif','ier $1 supposed external'#000+
+  'W_Identifier $1 supposed external'#000+
   'E_Strings not allowed as constants'#000+
   'No type of variable specified'#000+
   'E_assembler code not returned to text section'#000+
-  'E_Not a directive or local symbol $1'#000+
+  'E_Not a directive or lo','cal symbol $1'#000+
   'E_Using a defined name as a local label'#000+
-  'E_Dollar token is used with','out an identifier'#000+
+  'E_Dollar token is used without an identifier'#000+
   'W_32bit constant created for address'#000+
   'N_.align is target specific, use .balign or .p2align'#000+
   'E_Can'#039't access fields directly for parameters'#000+
-  'E_Can'#039't access fields of objects/classes directly'#000+
+  'E_Can',#039't access fields of objects/classes directly'#000+
   'F_Too many assembler files'#000+
-  'F_Selecte','d assembler output not supported'#000+
+  'F_Selected assembler output not supported'#000+
   'F_Comp not supported'#000+
   'F_Direct not support for binary writers'#000+
   'E_Allocating of data is only allowed in bss section'#000+
-  'F_No binary writer selected'#000+
+  'F_No binary w','riter selected'#000+
   'E_Asm: Opcode $1 not in table'#000+
-  'E_Asm: $1 invalid combination of opc','ode and operands'#000+
+  'E_Asm: $1 invalid combination of opcode and operands'#000+
   'E_Asm: 16 Bit references not supported'#000+
   'E_Asm: Invalid effective address'#000+
   'E_Asm: Immediate or reference expected'#000+
-  'E_Asm: $1 value exceeds bounds $2'#000+
+  'E_Asm: $1 value exceeds bounds ','$2'#000+
   'E_Asm: Short jump is out of range $1'#000+
   'W_Source operating system redefined'#000+
-  'I_Ass','embling (pipe) $1'#000+
+  'I_Assembling (pipe) $1'#000+
   'E_Can'#039't create assember file $1'#000+
   'W_Assembler $1 not found, switching to external assembling'#000+
   'T_Using assembler: $1'#000+
-  'W_Error while assembling exitcode $1'#000+
+  'W_Error while assembling exi','tcode $1'#000+
   'W_Can'#039't call the assembler, error $1 switching to external assembl'+
   'ing'#000+
-  'I_','Assembling $1'#000+
+  'I_Assembling $1'#000+
   'I_Assembling smartlink $1'#000+
   'W_Object $1 not found, Linking may fail !'#000+
   'W_Library $1 not found, Linking may fail !'#000+
   'W_Error while linking'#000+
-  'W_Can'#039't call the linker, switching to external linking'#000+
+  'W_Can'#039't call',' the linker, switching to external linking'#000+
   'I_Linking $1'#000+
-  'W_Util $1 not found, swit','ching to external linking'#000+
+  'W_Util $1 not found, switching to external linking'#000+
   'T_Using util $1'#000+
   'E_Creation of Executables not supported'#000+
   'E_Creation of Dynamic/Shared Libraries not supported'#000+
   'I_Closing script $1'#000+
-  'W_resource compiler not found, switching to external mode'#000+
+  'W_re','source compiler not found, switching to external mode'#000+
   'I_Compiling resource $1'#000+
-  'F_C','an'#039't post process executable $1'#000+
+  'F_Can'#039't post process executable $1'#000+
   'F_Can'#039't open executable $1'#000+
   'X_Size of Code: $1 bytes'#000+
   'X_Size of initialized data: $1 bytes'#000+
-  'X_Size of uninitialized data: $1 bytes'#000+
+  'X_Size of uninitialized data: $1 bytes',#000+
   'X_Stack space reserved: $1 bytes'#000+
   'X_Stack space commited: $1 bytes'#000+
-  'T_Unitsearch: ','$1'#000+
+  'T_Unitsearch: $1'#000+
   'T_PPU Loading $1'#000+
   'U_PPU Name: $1'#000+
   'U_PPU Flags: $1'#000+
@@ -464,212 +466,212 @@ const msgtxt : array[0..000103,1..240] of char=(
   'U_PPU Time: $1'#000+
   'U_PPU File too short'#000+
   'U_PPU Invalid Header (no PPU at the begin)'#000+
-  'U_PPU Invalid Version $1'#000+
+  'U_PPU Invalid V','ersion $1'#000+
   'U_PPU is compiled for an other processor'#000+
-  'U_PPU is compiled for an other',' target'#000+
+  'U_PPU is compiled for an other target'#000+
   'U_PPU Source: $1'#000+
   'U_Writing $1'#000+
   'F_Can'#039't Write PPU-File'#000+
   'F_reading PPU-File'#000+
   'F_unexpected end of PPU-File'#000+
   'F_Invalid PPU-File entry: $1'#000+
-  'F_PPU Dbx count problem'#000+
+  'F_PPU Dbx count probl','em'#000+
   'E_Illegal unit name: $1'#000+
   'F_Too much units'#000+
-  'F_Circular unit reference between $1 ','and $2'#000+
+  'F_Circular unit reference between $1 and $2'#000+
   'F_Can'#039't compile unit $1, no sources available'#000+
   'F_Can'#039't find unit $1'#000+
   'W_Unit $1 was not found but $2 exists'#000+
   'F_Unit $1 searched but $2 found'#000+
-  'W_Compiling the system unit requires the -Us switch'#000+
-  'F_There were $1 errors compiling module, sto','pping'#000+
+  'W_Compiling the',' system unit requires the -Us switch'#000+
+  'F_There were $1 errors compiling module, stopping'#000+
   'U_Load from $1 ($2) unit $3'#000+
   'U_Recompiling $1, checksum changed for $2'#000+
   'U_Recompiling $1, source found only'#000+
-  'U_Recompiling unit, static lib is older than ppufile'#000+
+  'U_Recompiling unit, static lib is older than pp','ufile'#000+
   'U_Recompiling unit, shared lib is older than ppufile'#000+
-  'U_Recompiling unit, ob','j and asm are older than ppufile'#000+
+  'U_Recompiling unit, obj and asm are older than ppufile'#000+
   'U_Recompiling unit, obj is older than asm'#000+
   'U_Parsing interface of $1'#000+
   'U_Parsing implementation of $1'#000+
   'U_Second load for unit $1'#000+
-  'U_PPU Check file $1 time $2'#000+
+  'U','_PPU Check file $1 time $2'#000+
   '$1 [options] <inputfile> [options]'#000+
-  'W_Only one source f','ile supported'#000+
+  'W_Only one source file supported'#000+
   'W_DEF file can be created only for OS/2'#000+
   'E_nested response files are not supported'#000+
   'F_No source file name in command line'#000+
   'E_Illegal parameter: $1'#000+
-  'H_-? writes help pages'#000+
+  'H','_-? writes help pages'#000+
   'F_Too many config files nested'#000+
   'F_Unable to open file $1'#000+
-  'N_R','eading further options from $1'#000+
+  'N_Reading further options from $1'#000+
   'W_Target is already set to: $1'#000+
   'W_Shared libs not supported on DOS platform, reverting to static'#000+
   'F_too many IF(N)DEFs'#000+
-  'F_too many ENDIFs'#000+
+  'F_too many ','ENDIFs'#000+
   'F_open conditional at the end of the file'#000+
-  'W_Debug information generation i','s not supported by this executable'#000+
+  'W_Debug information generation is not supported by this executable'#000+
   'H_Try recompiling with -dGDB'#000+
   'E_You are using the obsolete switch $1'#000+
   'E_You are using the obsolete switch $1, please use $2'#000+
-  'N_Switching assembler to default source writing assembler'#000+
-  'Free Pascal Compiler vers','ion $FPCVER [$FPCDATE] for $FPCTARGET'#000+
+  'N_','Switching assembler to default source writing assembler'#000+
+  'Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#000+
   'Copyright (c) 1993-1999 by Florian Klaempfl'#000+
   'Free Pascal Compiler version $FPCVER'#000+
   #000+
   'Compiler Date  : $FPCDATE'#000+
-  'Compiler Target: $FPCTARGET'#000+
+  'Compiler Targ','et: $FPCTARGET'#000+
   #000+
   'This program comes under the GNU General Public Licence'#000+
-  'For more ','information read COPYING.FPC'#000+
+  'For more information read COPYING.FPC'#000+
   #000+
   'Report bugs,suggestions etc to:'#000+
   '                 [email protected]'#000+
-  '**0*_put + after a boolean switch option to enable it, - to disable it'+
-  #000+
-  '**1a_the compiler doesn'#039't delete the generated assembler',' file'#000+
+  '**0*_put + after a boolean switch option to en','able it, - to disable '+
+  'it'#000+
+  '**1a_the compiler doesn'#039't delete the generated assembler file'#000+
   '**2al_list sourcecode lines in assembler file'#000+
   '**2ar_list register allocation/release info in assembler file'#000+
-  '**2at_list temp allocation/release info in assembler file'#000+
+  '**2at_list temp allocation/release info in as','sembler file'#000+
   '**1b_generate browser info'#000+
   '**2bl_generate local symbol info'#000+
-  '**1B_bui','ld all modules'#000+
+  '**1B_build all modules'#000+
   '**1C<x>_code generation options:'#000+
   '3*2CD_create dynamic library'#000+
   '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#000+
   '**2Ci_IO-checking'#000+
-  '**2Cn_omit linking stage'#000+
+  '**2Cn_omit l','inking stage'#000+
   '**2Co_check overflow of integer operations'#000+
   '**2Cr_range checking'#000+
-  '**2C','s<n>_set stack size to <n>'#000+
+  '**2Cs<n>_set stack size to <n>'#000+
   '**2Ct_stack checking'#000+
   '**2CD_create also dynamic library (* doesn'#039't work yet *)'#000+
   '**2CX_create also smartlinked library'#000+
-  '**1d<x>_defines the symbol <x>'#000+
+  '**1d<x>_defines ','the symbol <x>'#000+
   '*O1D_generate a DEF file'#000+
   '*O2Dd<x>_set description to <x>'#000+
-  '*O2Dw_PM ','application'#000+
+  '*O2Dw_PM application'#000+
   '**1e<x>_set path to executable'#000+
   '**1E_same as -Cn'#000+
   '**1F<x>_set file names and paths:'#000+
-  '**2FD<x>_sets the directory where to search for compiler utilities'#000+
+  '**2FD<x>_sets the directory where to search for compiler utilitie','s'#000+
   '**2Fe<x>_redirect error output to <x>'#000+
-  '**2FE<x>_set exe/unit output path to <x>'#000,
+  '**2FE<x>_set exe/unit output path to <x>'#000+
   '**2Fi<x>_adds <x> to include path'#000+
   '**2Fl<x>_adds <x> to library path'#000+
   '*L2FL<x>_uses <x> as dynamic linker'#000+
   '**2Fo<x>_adds <x> to object path'#000+
-  '**2Fr<x>_load error message file <x>'#000+
+  '**2Fr<x>_load error me','ssage file <x>'#000+
   '**2Fu<x>_adds <x> to unit path'#000+
-  '**2FU<x>_set unit output path to <x','>, overrides -FE'#000+
+  '**2FU<x>_set unit output path to <x>, overrides -FE'#000+
   '*g1g<x>_generate debugger information:'#000+
   '*g2gg_use gsym'#000+
   '*g2gd_use dbx'#000+
   '*g2gh_use heap trace unit'#000+
   '*g2gc_generate checks for pointers'#000+
-  '**1i_information'#000+
+  '**1i_informat','ion'#000+
   '**2iD_return compiler date'#000+
   '**2iV_return compiler version'#000+
-  '**2iSO_return compil','er OS'#000+
+  '**2iSO_return compiler OS'#000+
   '**2iSP_return compiler processor'#000+
   '**2iTO_return target OS'#000+
   '**2iTP_return target processor'#000+
   '**1I<x>_adds <x> to include path'#000+
   '**1k<x>_Pass <x> to the linker'#000+
-  '**1l_write logo'#000+
+  '*','*1l_write logo'#000+
   '**1n_don'#039't read the default config file'#000+
-  '**1o<x>_change the name of',' the executable produced to <x>'#000+
+  '**1o<x>_change the name of the executable produced to <x>'#000+
   '**1pg_generate profile code for gprof (defines FPC_PROFILE)'#000+
   '*L1P_use pipes instead of creating temporary assembler files'#000+
-  '**1S<x>_syntax options:'#000+
+  '**1S<x','>_syntax options:'#000+
   '**2S2_switch some Delphi 2 extensions on'#000+
-  '**2Sc_supports operato','rs like C (*=,+=,/= and -=)'#000+
+  '**2Sc_supports operators like C (*=,+=,/= and -=)'#000+
   '**2Sd_tries to be Delphi compatible'#000+
   '**2Se<x>_compiler stops after the <x> errors (default is 1)'#000+
   '**2Sg_allow LABEL and GOTO'#000+
-  '**2Sh_Use ansistrings'#000+
+  '**2Sh_Us','e ansistrings'#000+
   '**2Si_support C++ styled INLINE'#000+
-  '**2Sm_support macros like C (global',')'#000+
+  '**2Sm_support macros like C (global)'#000+
   '**2So_tries to be TP/BP 7.0 compatible'#000+
   '**2Sp_tries to be gpc compatible'#000+
   '**2Ss_constructor name must be init (destructor must be done)'#000+
-  '**2St_allow static keyword in objects'#000+
+  '**2St_allow static keyw','ord in objects'#000+
   '**1s_don'#039't call assembler and linker (only with -a)'#000+
-  '**1u<x>_undefi','nes the symbol <x>'#000+
+  '**1u<x>_undefines the symbol <x>'#000+
   '**1U_unit options:'#000+
   '**2Un_don'#039't check the unit name'#000+
   '**2Us_compile a system unit'#000+
-  '**1v<x>_Be verbose. <x> is a combination of the following letters:'#000+
+  '**1v<x>_Be verbose. <x> is a combination of the following let','ters:'#000+
   '**2*_e : Show errors (default)       d : Show debug info'#000+
-  '**2*_w : Show warn','ings               u : Show unit info'#000+
+  '**2*_w : Show warnings               u : Show unit info'#000+
   '**2*_n : Show notes                  t : Show tried/used files'#000+
-  '**2*_h : Show hints                  m : Show defined macros'#000+
+  '**2*_h : Show hints                  m : Show defined macr','os'#000+
   '**2*_i : Show general info           p : Show compiled procedures'#000+
-  '**2*_l : Sho','w linenumbers            c : Show conditionals'#000+
+  '**2*_l : Show linenumbers            c : Show conditionals'#000+
   '**2*_a : Show everything             0 : Show nothing (except errors)'#000+
-  '**2*_b : Show all procedure          r : Rhide/GCC compatibility mode'#000+
-  '**2*_    declarations if an error    x : Executable i','nfo (Win32 only'+
-  ')'#000+
+  '**2*_b : Show all procedure          r : R','hide/GCC compatibility mod'+
+  'e'#000+
+  '**2*_    declarations if an error    x : Executable info (Win32 only)'#000+
   '**2*_    occurs'#000+
   '**1X_executable options:'#000+
   '*L2Xc_link with the c library'#000+
   '**2Xs_strip all symbols from executable'#000+
-  '**2XD_try to link dynamic          (defines FPC_LINK_DYNAMIC)'#000+
-  '**2XS_try to link static (default) (defines FPC_LI','NK_STATIC)'#000+
+  '**2XD_try to link dynamic      ','    (defines FPC_LINK_DYNAMIC)'#000+
+  '**2XS_try to link static (default) (defines FPC_LINK_STATIC)'#000+
   '**2XX_try to link smart            (defines FPC_LINK_SMART)'#000+
   '**0*_Processor specific options:'#000+
   '3*1A<x>_output format:'#000+
   '3*2Aas_assemble using GNU AS'#000+
-  '3*2Aasaout_assemble using GNU AS for aout (Go32v1)'#000+
-  '3*2Anasmcoff_coff (Go32v2) file u','sing Nasm'#000+
+  '3*2','Aasaout_assemble using GNU AS for aout (Go32v1)'#000+
+  '3*2Anasmcoff_coff (Go32v2) file using Nasm'#000+
   '3*2Anasmelf_elf32 (Linux) file using Nasm'#000+
   '3*2Anasmobj_obj file using Nasm'#000+
   '3*2Amasm_obj file using Masm (Microsoft)'#000+
-  '3*2Atasm_obj file using Tasm (Borland)'#000+
+  '3*2Atasm_obj file using Tasm (Borl','and)'#000+
   '3*2Acoff_coff (Go32v2) using internal writer'#000+
-  '3*2Apecoff_pecoff (Win32) using',' internal writer'#000+
+  '3*2Apecoff_pecoff (Win32) using internal writer'#000+
   '3*1R<x>_assembler reading style:'#000+
   '3*2Ratt_read AT&T style assembler'#000+
   '3*2Rintel_read Intel style assembler'#000+
-  '3*2Rdirect_copy assembler text directly to assembler file'#000+
+  '3*2Rdirect_copy assembler text directl','y to assembler file'#000+
   '3*1O<x>_optimizations:'#000+
   '3*2Og_generate smaller code'#000+
-  '3*2OG_gene','rate faster code (default)'#000+
+  '3*2OG_generate faster code (default)'#000+
   '3*2Or_keep certain variables in registers (still BUGGY!!!)'#000+
   '3*2Ou_enable uncertain optimizations (see docs)'#000+
-  '3*2O1_level 1 optimizations (quick optimizations)'#000+
-  '3*2O2_level 2 optimizations (-O1 + slower optimizations)',#000+
+  '3*2O1_level 1 optimizatio','ns (quick optimizations)'#000+
+  '3*2O2_level 2 optimizations (-O1 + slower optimizations)'#000+
   '3*2O3_level 3 optimizations (same as -O2u)'#000+
   '3*2Op<x>_target processor:'#000+
   '3*3Op1_set target processor to 386/486'#000+
-  '3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#000+
+  '3*3Op2_set target processor to Pentium/PentiumMMX',' (tm)'#000+
   '3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#000+
-  '3*1T<x>_Target operat','ing system:'#000+
+  '3*1T<x>_Target operating system:'#000+
   '3*2TGO32V1_version 1 of DJ Delorie DOS extender'#000+
   '3*2TGO32V2_version 2 of DJ Delorie DOS extender'#000+
   '3*2TLINUX_Linux'#000+
   '3*2TOS2_OS/2 2.x'#000+
-  '3*2TWin32_Windows 32 Bit'#000+
+  '3*2TWin32_Windows ','32 Bit'#000+
   '6*1A<x>_output format'#000+
   '6*2Aas_Unix o-file using GNU AS'#000+
-  '6*2Agas_GNU Motorola',' assembler'#000+
+  '6*2Agas_GNU Motorola assembler'#000+
   '6*2Amit_MIT Syntax (old GAS)'#000+
   '6*2Amot_Standard Motorola assembler'#000+
   '6*1O_optimizations:'#000+
   '6*2Oa_turn on the optimizer'#000+
   '6*2Og_generate smaller code'#000+
-  '6*2OG_generate faster code (default)'#000+
+  '6*2OG_g','enerate faster code (default)'#000+
   '6*2Ox_optimize maximum (still BUGGY!!!)'#000+
-  '6*2O2_set t','arget processor to a MC68020+'#000+
+  '6*2O2_set target processor to a MC68020+'#000+
   '6*1R<x>_assembler reading style:'#000+
   '6*2RMOT_read motorola style assembler'#000+
   '6*1T<x>_Target operating system:'#000+
-  '6*2TAMIGA_Commodore Amiga'#000+
+  '6*2TAMIGA_Commodore Amiga',#000+
   '6*2TATARI_Atari ST/STe/TT'#000+
   '6*2TMACOS_Macintosh m68k'#000+
   '6*2TLINUX_Linux-68k'#000+
   '**1*_'#000+
-  '**1','?_shows this help'#000+
+  '**1?_shows this help'#000+
   '**1h_shows this help without waiting'#000
 );

compiler/pass_1.pas

@@ -155,13 +155,14 @@ implementation
               if assigned(hp^.right) then
                 begin
                    cleartempgen;
+                   codegenerror:=false;
                    firstpass(hp^.right);
                    if (not (cs_extsyntax in aktmoduleswitches)) and
                       assigned(hp^.right^.resulttype) and
                       (hp^.right^.resulttype<>pdef(voiddef)) then
                      CGMessage(cg_e_illegal_expression);
-                   if codegenerror then
-                     exit;
+                   {if codegenerror then
+                     exit;}
                    hp^.registers32:=hp^.right^.registers32;
                    hp^.registersfpu:=hp^.right^.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -369,7 +370,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.106  1999-09-27 23:44:51  peter
+  Revision 1.107  1999-10-26 12:30:43  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.106  1999/09/27 23:44:51  peter
     * procinfo is now a pointer
     * support for result setting in sub procedure
 

compiler/pdecl.pas

@@ -208,15 +208,12 @@ unit pdecl;
                while not sc^.empty do
                 begin
                   s:=sc^.get_with_tokeninfo(tokenpos);
-                  { For proc vars we only need the definitions }
-                  if is_procvar then
-                   begin
-                     if assigned(readtypesym) then
-                      aktprocdef^.concattypesym(readtypesym,varspez)
-                     else
-                      aktprocdef^.concatdef(p,varspez);
-                   end
+                  if assigned(readtypesym) then
+                   aktprocdef^.concattypesym(readtypesym,varspez)
                   else
+                   aktprocdef^.concatdef(p,varspez);
+                  { For proc vars we only need the definitions }
+                  if not is_procvar then
                    begin
 {$ifndef UseNiceNames}
                      hs2:=hs2+'$'+hs1;
@@ -224,15 +221,9 @@ unit pdecl;
                      hs2:=hs2+tostr(length(hs1))+hs1;
 {$endif UseNiceNames}
                      if assigned(readtypesym) then
-                      begin
-                        aktprocdef^.concattypesym(readtypesym,varspez);
-                        vs:=new(Pvarsym,initsym(s,readtypesym))
-                      end
+                      vs:=new(Pvarsym,initsym(s,readtypesym))
                      else
-                      begin
-                        aktprocdef^.concatdef(p,varspez);
-                        vs:=new(Pvarsym,init(s,p));
-                      end;
+                      vs:=new(Pvarsym,init(s,p));
                      vs^.varspez:=varspez;
                    { we have to add this to avoid var param to be in registers !!!}
                      if (varspez in [vs_var,vs_const]) and push_addr_param(p) then
@@ -1192,7 +1183,15 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.166  1999-10-22 10:39:34  peter
+  Revision 1.167  1999-10-26 12:30:44  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.166  1999/10/22 10:39:34  peter
     * split type reading from pdecl to ptype unit
     * parameter_dec routine is now used for procedure and procvars
 

compiler/pexports.pas

@@ -64,7 +64,10 @@ unit pexports;
                      begin
                         hp^.sym:=srsym;
                         if ((srsym^.typ<>procsym) or
-                            not(po_exports in pprocdef(pprocsym(srsym)^.definition)^.procoptions)) and
+                            ((tf_need_export in target_info.flags) and
+                             not(po_exports in pprocdef(pprocsym(srsym)^.definition)^.procoptions)
+                            )
+                           ) and
                            (srsym^.typ<>varsym) and (srsym^.typ<>typedconstsym) then
                          Message(parser_e_illegal_symbol_exported)
                         else
@@ -72,6 +75,8 @@ unit pexports;
                           ProcName:=hp^.sym^.name;
                           InternalProcName:=hp^.sym^.mangledname;
                           delete(InternalProcName,1,1);
+                          if length(InternalProcName)<2 then
+                           Message(parser_e_procname_to_short_for_export);
                           DefString:=ProcName+'='+InternalProcName;
                          end;
                         if (idtoken=_INDEX) then
@@ -80,15 +85,17 @@ unit pexports;
                              hp^.options:=hp^.options or eo_index;
                              val(pattern,hp^.index,code);
                              consume(_INTCONST);
-                             DefString:=ProcName+'='+InternalProcName;{Index ignored!}
-                             (* DefString:=ProcName+'@'+pattern+'='+InternalProcName;{Index ignored!} *)
+                             DefString:=ProcName+'='+InternalProcName; {Index ignored!}
                           end;
                         if (idtoken=_NAME) then
                           begin
                              consume(_NAME);
                              hp^.name:=stringdup(pattern);
                              hp^.options:=hp^.options or eo_name;
-                             consume(_CSTRING); {Bug fixed?}
+                             if token=_CCHAR then
+                              consume(_CCHAR)
+                             else
+                              consume(_CSTRING);
                              DefString:=hp^.name^+'='+InternalProcName;
                           end;
                         if (idtoken=_RESIDENT) then
@@ -123,7 +130,15 @@ end.
 
 {
   $Log$
-  Revision 1.12  1999-08-10 12:51:19  pierre
+  Revision 1.13  1999-10-26 12:30:44  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.12  1999/08/10 12:51:19  pierre
     * bind_win32_dll removed (Relocsection used instead)
     * now relocsection is true by default ! (needs dlltool
       for DLL generation)

compiler/pexpr.pas

@@ -1517,7 +1517,7 @@ unit pexpr;
                          again:=false
                        else
                          if (token=_LKLAMMER) or
-                            ((pprocvardef(pd)^.para1=nil) and
+                            ((pprocvardef(pd)^.para^.empty) and
                              (not((token in [_ASSIGNMENT,_UNEQUAL,_EQUAL]))) and
                              (not afterassignment) and
                              (not in_args)) then
@@ -2117,7 +2117,15 @@ _LECKKLAMMER : begin
 end.
 {
   $Log$
-  Revision 1.150  1999-10-22 14:37:30  peter
+  Revision 1.151  1999-10-26 12:30:44  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.150  1999/10/22 14:37:30  peter
     * error when properties are passed to var parameters
 
   Revision 1.149  1999/10/22 10:39:34  peter

compiler/psub.pas

@@ -606,8 +606,8 @@ var
 begin
   { check parameter type }
   if not(po_containsself in aktprocsym^.definition^.procoptions) and
-     (assigned(aktprocsym^.definition^.para1^.next) or
-      (aktprocsym^.definition^.para1^.paratyp<>vs_var)) then
+     ((aktprocsym^.definition^.para^.count<>1) or
+      (pparaitem(aktprocsym^.definition^.para^.first)^.paratyp<>vs_var)) then
    Message(parser_e_ill_msg_param);
   pt:=comp_expr(true);
   do_firstpass(pt);
@@ -1162,7 +1162,7 @@ begin
         while (assigned(pd)) and (assigned(pd^.nextoverloaded)) do
          begin
            if not(m_repeat_forward in aktmodeswitches) or
-              (equal_paras(aktprocsym^.definition^.para1,pd^.nextoverloaded^.para1,false) and
+              (equal_paras(aktprocsym^.definition^.para,pd^.nextoverloaded^.para,false) and
               { for operators equal_paras is not enough !! }
               ((aktprocsym^.definition^.proctypeoption<>potype_operator) or (optoken<>_ASSIGNMENT) or
                is_equal(pd^.nextoverloaded^.retdef,aktprocsym^.definition^.retdef))) then
@@ -1902,7 +1902,15 @@ end.
 
 {
   $Log$
-  Revision 1.29  1999-10-22 10:39:35  peter
+  Revision 1.30  1999-10-26 12:30:44  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.29  1999/10/22 10:39:35  peter
     * split type reading from pdecl to ptype unit
     * parameter_dec routine is now used for procedure and procvars
 

compiler/ptype.pas

@@ -266,7 +266,7 @@ uses
 
         var
            sym : psym;
-           propertyparas : pdefcoll;
+           propertyparas : plinkedlist;
 
         { returns the matching procedure to access a property }
         function get_procdef : pprocdef;
@@ -279,7 +279,7 @@ uses
              get_procdef:=nil;
              while assigned(p) do
                begin
-                  if equal_paras(p^.para1,propertyparas,true) then
+                  if equal_paras(p^.para,propertyparas,true) then
                     break;
                   p:=p^.nextoverloaded;
                end;
@@ -345,7 +345,7 @@ uses
           end;
 
         var
-           hp2,datacoll : pdefcoll;
+           hp2,datacoll : pparaitem;
            p,p2 : ppropertysym;
            overriden : psym;
            hs : string;
@@ -363,7 +363,7 @@ uses
            if not(aktclass^.is_class) then
             Message(parser_e_syntax_error);
            consume(_PROPERTY);
-           propertyparas:=nil;
+           new(propertyparas,init);
            datacoll:=nil;
            if token=_ID then
              begin
@@ -417,20 +417,17 @@ uses
                          end
                        else
                          hp:=cformaldef;
-                       s:=sc^.get_with_tokeninfo(declarepos);
-                       while s<>'' do
-                         begin
-                            new(hp2);
-                            hp2^.paratyp:=varspez;
-                            hp2^.data:=hp;
-                            hp2^.next:=propertyparas;
-                            propertyparas:=hp2;
-                            s:=sc^.get_with_tokeninfo(declarepos);
-                         end;
+                       repeat
+                         s:=sc^.get_with_tokeninfo(declarepos);
+                         if s='' then
+                          break;
+                         new(hp2,init);
+                         hp2^.paratyp:=varspez;
+                         hp2^.data:=hp;
+                         propertyparas^.insert(hp2);
+                       until false;
                        dispose(sc,done);
-                       if token=_SEMICOLON then consume(_SEMICOLON)
-                     else break;
-                     until false;
+                     until not try_to_consume(_SEMICOLON);
                      dec(testcurobject);
                      consume(_RECKKLAMMER);
                   end;
@@ -455,11 +452,10 @@ uses
                           p^.propoptions:=p^.propoptions+[ppo_indexed];
 {$endif}
                           { concat a longint to the para template }
-                          new(hp2);
+                          new(hp2,init);
                           hp2^.paratyp:=vs_value;
                           hp2^.data:=pt^.resulttype;
-                          hp2^.next:=propertyparas;
-                          propertyparas:=hp2;
+                          propertyparas^.insert(hp2);
                           disposetree(pt);
                        end;
                   end
@@ -493,10 +489,9 @@ uses
                   Message(parser_e_cant_publish_that_property);
 
                 { create data defcoll to allow correct parameter checks }
-                new(datacoll);
+                new(datacoll,init);
                 datacoll^.paratyp:=vs_value;
                 datacoll^.data:=p^.proptype;
-                datacoll^.next:=nil;
 
                 if (idtoken=_READ) then
                   begin
@@ -529,16 +524,6 @@ uses
 
                      if assigned(sym) then
                        begin
-                          { varsym aren't allowed for an indexed property
-                            or an property with parameters }
-                          if ((sym^.typ=varsym) and
-                             { not necessary, an index forces propertyparas
-                               to be assigned
-                             }
-                             { (((p^.options and ppo_indexed)<>0) or }
-                             assigned(propertyparas)) or
-                             not(sym^.typ in [varsym,procsym]) then
-                            Message(parser_e_ill_property_access_sym);
                           { search the matching definition }
                           case sym^.typ of
                             procsym :
@@ -551,9 +536,12 @@ uses
                               end;
                             varsym :
                               begin
-                                if not(is_equal(pvarsym(sym)^.definition,p^.proptype)) then
+                                if not(propertyparas^.empty) or
+                                   not(is_equal(pvarsym(sym)^.definition,p^.proptype)) then
                                   Message(parser_e_ill_property_access_sym);
                               end;
+                            else
+                              Message(parser_e_ill_property_access_sym);
                           end;
                           addpropsymlist(p^.readaccesssym,sym);
                        end;
@@ -589,30 +577,28 @@ uses
 
                      if assigned(sym) then
                        begin
-                          if ((sym^.typ=varsym) and
-                             assigned(propertyparas)) or
-                             not(sym^.typ in [varsym,procsym]) then
-                            Message(parser_e_ill_property_access_sym);
                           { search the matching definition }
-                          if sym^.typ=procsym then
-                            begin
-                               { insert data entry to check access method }
-                               datacoll^.next:=propertyparas;
-                               propertyparas:=datacoll;
-                               pp:=get_procdef;
-                               { ... and remove it }
-                               propertyparas:=propertyparas^.next;
-                               datacoll^.next:=nil;
-                               if not(assigned(pp)) then
-                                 Message(parser_e_ill_property_access_sym);
-                               p^.writeaccessdef:=pp;
-                            end
-                          else if sym^.typ=varsym then
-                            begin
-                               if not(is_equal(pvarsym(sym)^.definition,
-                                 p^.proptype)) then
-                                 Message(parser_e_ill_property_access_sym);
-                            end;
+                          case sym^.typ of
+                            procsym :
+                              begin
+                                 { insert data entry to check access method }
+                                 propertyparas^.insert(datacoll);
+                                 pp:=get_procdef;
+                                 { ... and remove it }
+                                 propertyparas^.remove(datacoll);
+                                 if not(assigned(pp)) then
+                                   Message(parser_e_ill_property_access_sym);
+                                 p^.writeaccessdef:=pp;
+                              end;
+                            varsym :
+                              begin
+                                 if not(propertyparas^.empty) or
+                                    not(is_equal(pvarsym(sym)^.definition,p^.proptype)) then
+                                   Message(parser_e_ill_property_access_sym);
+                              end
+                            else
+                              Message(parser_e_ill_property_access_sym);
+                          end;
                           addpropsymlist(p^.writeaccesssym,sym);
                        end;
                   end;
@@ -658,32 +644,32 @@ uses
                                 if assigned(sym) then
                                   begin
                                      { only non array properties can be stored }
-                                     if assigned(propertyparas) or
-                                        not(sym^.typ in [varsym,procsym]) then
-                                       Message(parser_e_ill_property_storage_sym);
-                                     { search the matching definition }
-                                     if sym^.typ=procsym then
-                                       begin
-                                          pp:=pprocsym(sym)^.definition;
-                                          while assigned(pp) do
-                                            begin
-                                               { the stored function shouldn't have any parameters }
-                                               if not(assigned(pp^.para1)) then
-                                                 break;
-                                                pp:=pp^.nextoverloaded;
-                                            end;
-                                          { found we a procedure and does it really return a bool? }
-                                          if not(assigned(pp)) or
-                                             not(is_equal(pp^.retdef,booldef)) then
-                                            Message(parser_e_ill_property_storage_sym);
-                                          p^.storeddef:=pp;
-                                       end
-                                     else if sym^.typ=varsym then
-                                       begin
-                                          if not(is_equal(pvarsym(sym)^.definition,
-                                            booldef)) then
-                                            Message(parser_e_stored_property_must_be_boolean);
-                                       end;
+                                     case sym^.typ of
+                                       procsym :
+                                         begin
+                                           pp:=pprocsym(sym)^.definition;
+                                           while assigned(pp) do
+                                             begin
+                                                { the stored function shouldn't have any parameters }
+                                                if pp^.para^.empty then
+                                                  break;
+                                                 pp:=pp^.nextoverloaded;
+                                             end;
+                                           { found we a procedure and does it really return a bool? }
+                                           if not(assigned(pp)) or
+                                              not(is_equal(pp^.retdef,booldef)) then
+                                             Message(parser_e_ill_property_storage_sym);
+                                           p^.storeddef:=pp;
+                                         end;
+                                       varsym :
+                                         begin
+                                           if not(propertyparas^.empty) or
+                                              not(is_equal(pvarsym(sym)^.definition,booldef)) then
+                                             Message(parser_e_stored_property_must_be_boolean);
+                                         end;
+                                       else
+                                         Message(parser_e_ill_property_storage_sym);
+                                     end;
                                      addpropsymlist(p^.storedsym,sym);
                                   end;
                              end;
@@ -759,15 +745,14 @@ uses
                   end;
                 { clean up }
                 if assigned(datacoll) then
-                  disposepdefcoll(datacoll);
+                  dispose(datacoll,done);
              end
            else
              begin
                 consume(_ID);
                 consume(_SEMICOLON);
              end;
-           if assigned(propertyparas) then
-             disposepdefcoll(propertyparas);
+           dispose(propertyparas,done);
         end;
 
 
@@ -785,7 +770,7 @@ uses
            aktclass^.objectoptions:=aktclass^.objectoptions+[oo_has_destructor];
 {$endif}
            consume(_SEMICOLON);
-           if assigned(aktprocsym^.definition^.para1) then
+           if not(aktprocsym^.definition^.para^.empty) then
             Message(parser_e_no_paras_for_destructor);
            { no return value }
            aktprocsym^.definition^.retdef:=voiddef;
@@ -1608,7 +1593,15 @@ uses
 end.
 {
   $Log$
-  Revision 1.2  1999-10-22 14:37:30  peter
+  Revision 1.3  1999-10-26 12:30:45  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.2  1999/10/22 14:37:30  peter
     * error when properties are passed to var parameters
 
   Revision 1.1  1999/10/22 10:39:35  peter

compiler/symconst.pas

@@ -153,7 +153,8 @@ type
     vo_is_external,
     vo_is_dll_var,
     vo_is_thread_var,
-    vo_fpuregable
+    vo_fpuregable,
+    vo_is_const  { variable is declared as const (parameter) and can't be written to }
   );
   tvaroptions=set of tvaroption;
 
@@ -179,7 +180,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  1999-10-01 08:02:48  peter
+  Revision 1.4  1999-10-26 12:30:45  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.3  1999/10/01 08:02:48  peter
     * forward type declaration rewritten
 
   Revision 1.2  1999/08/04 13:45:29  florian

compiler/symdef.inc

@@ -2204,24 +2204,10 @@
                        TABSTRACTPROCDEF
 ***************************************************************************}
 
-    procedure disposepdefcoll(var para1 : pdefcoll);
-      var
-         hp : pdefcoll;
-      begin
-         hp:=para1;
-         while assigned(hp) do
-           begin
-              para1:=hp^.next;
-              dispose(hp);
-              hp:=para1;
-           end;
-      end;
-
-
     constructor tabstractprocdef.init;
       begin
          inherited init;
-         para1:=nil;
+         new(para,init);
          fpu_used:=0;
          proctypeoption:=potype_none;
          proccalloptions:=[];
@@ -2234,36 +2220,34 @@
 
     destructor tabstractprocdef.done;
       begin
-         disposepdefcoll(para1);
+         dispose(para,done);
          inherited done;
       end;
 
 
     procedure tabstractprocdef.concatdef(p : pdef;vsp : tvarspez);
       var
-         hp : pdefcoll;
+        hp : pparaitem;
       begin
-         new(hp);
-         hp^.paratyp:=vsp;
-         hp^.datasym:=nil;
-         hp^.data:=p;
-         hp^.next:=para1;
-         hp^.register:=R_NO;
-         para1:=hp;
+        new(hp,init);
+        hp^.paratyp:=vsp;
+        hp^.datasym:=nil;
+        hp^.data:=p;
+        hp^.register:=R_NO;
+        para^.insert(hp);
       end;
 
 
     procedure tabstractprocdef.concattypesym(p : ptypesym;vsp : tvarspez);
       var
-         hp : pdefcoll;
+        hp : pparaitem;
       begin
-         new(hp);
-         hp^.paratyp:=vsp;
-         hp^.datasym:=p;
-         hp^.data:=p^.definition;
-         hp^.next:=para1;
-         hp^.register:=R_NO;
-         para1:=hp;
+        new(hp,init);
+        hp^.paratyp:=vsp;
+        hp^.datasym:=p;
+        hp^.data:=p^.definition;
+        hp^.register:=R_NO;
+        para^.insert(hp);
       end;
 
 
@@ -2280,11 +2264,11 @@
 
     procedure tabstractprocdef.deref;
       var
-         hp : pdefcoll;
+         hp : pparaitem;
       begin
          inherited deref;
          resolvedef(retdef);
-         hp:=para1;
+         hp:=pparaitem(para^.first);
          while assigned(hp) do
            begin
               if assigned(hp^.datasym) then
@@ -2294,47 +2278,41 @@
                end
               else
                resolvedef(hp^.data);
-              hp:=hp^.next;
+              hp:=pparaitem(hp^.next);
            end;
       end;
 
 
     constructor tabstractprocdef.load;
       var
-         last,hp : pdefcoll;
+         hp : pparaitem;
          count,i : word;
       begin
          inherited load;
+         new(para,init);
          retdef:=readdefref;
          fpu_used:=readbyte;
          proctypeoption:=tproctypeoption(readlong);
          readsmallset(proccalloptions);
          readsmallset(procoptions);
          count:=readword;
-         para1:=nil;
          savesize:=target_os.size_of_pointer;
          for i:=1 to count do
            begin
-              new(hp);
+              new(hp,init);
               hp^.paratyp:=tvarspez(readbyte);
               { hp^.register:=tregister(readbyte); }
               hp^.register:=R_NO;
               hp^.data:=readdefref;
               hp^.datasym:=ptypesym(readsymref);
-              hp^.next:=nil;
-              if para1=nil then
-                para1:=hp
-              else
-                last^.next:=hp;
-              last:=hp;
+              para^.concat(hp);
            end;
       end;
 
 
     procedure tabstractprocdef.write;
       var
-         count : word;
-         hp : pdefcoll;
+        hp : pparaitem;
       begin
          inherited write;
          writedefref(retdef);
@@ -2343,15 +2321,8 @@
          writelong(ord(proctypeoption));
          writesmallset(proccalloptions);
          writesmallset(procoptions);
-         hp:=para1;
-         count:=0;
-         while assigned(hp) do
-           begin
-              inc(count);
-              hp:=hp^.next;
-           end;
-         writeword(count);
-         hp:=para1;
+         writeword(para^.count);
+         hp:=pparaitem(para^.first);
          while assigned(hp) do
            begin
               writebyte(byte(hp^.paratyp));
@@ -2366,18 +2337,18 @@
                  writedefref(hp^.data);
                  writesymref(nil);
                end;
-              hp:=hp^.next;
+              hp:=pparaitem(hp^.next);
            end;
       end;
 
 
     function tabstractprocdef.para_size : longint;
       var
-         pdc : pdefcoll;
+         pdc : pparaitem;
          l : longint;
       begin
          l:=0;
-         pdc:=para1;
+         pdc:=pparaitem(para^.first);
          while assigned(pdc) do
           begin
             case pdc^.paratyp of
@@ -2388,41 +2359,32 @@
                          else
                           inc(l,align(pdc^.data^.size,target_os.stackalignment));
             end;
-            pdc:=pdc^.next;
+            pdc:=pparaitem(pdc^.next);
           end;
          para_size:=l;
       end;
 
 
     function tabstractprocdef.demangled_paras : string;
-
-      var s : string;
-
-      procedure doconcat(p : pdefcoll);
-
-        begin
-           if assigned(p^.next) then
-             doconcat(p^.next)
-           else
-             s:='(';
-           if assigned(p^.data^.sym) then
-             s:=s+p^.data^.sym^.name
-           else if p^.paratyp=vs_var then
+      var
+        s : string;
+        hp : pparaitem;
+      begin
+        s:='(';
+        hp:=pparaitem(para^.last);
+        while assigned(hp) do
+         begin
+           if assigned(hp^.data^.sym) then
+             s:=s+hp^.data^.sym^.name
+           else if hp^.paratyp=vs_var then
              s:=s+'var'
-           else if p^.paratyp=vs_const then
+           else if hp^.paratyp=vs_const then
              s:=s+'const';
-           if p<>para1 then
-             s:=s+','
-           else
-             s:=s+')';
-        end;
-
-      begin
-        s:='';
-        { a recursive solution is the easiest way to inverse the parameter }
-        { collection                                                       }
-        if assigned(para1) then
-          doconcat(para1);
+           hp:=pparaitem(hp^.previous);
+           if assigned(hp) then
+            s:=s+',';
+         end;
+        s:=s+')';
         demangled_paras:=s;
       end;
 
@@ -2816,20 +2778,14 @@ Const local_symtable_index : longint = $8001;
 
 
     function tprocdef.stabstring : pchar;
-      var param : pdefcoll;
-          i : word;
+      var
+          i : longint;
           oldrec : pchar;
       begin
       oldrec := stabrecstring;
       getmem(StabRecString,1024);
-      param := para1;
-      i := 0;
-      while assigned(param) do
-        begin
-           inc(i);
-           param := param^.next;
-        end;
       strpcopy(StabRecString,'f'+retdef^.numberstring);
+      i:=para^.count;
       if i>0 then
         begin
         strpcopy(strend(StabRecString),','+tostr(i)+';');
@@ -2931,7 +2887,7 @@ Const local_symtable_index : longint = $8001;
     function tprocdef.cplusplusmangledname : string;
       var
          s,s2 : string;
-         param : pdefcoll;
+         param : pparaitem;
       begin
       s := sym^.name;
       if _class <> nil then
@@ -2939,12 +2895,12 @@ Const local_symtable_index : longint = $8001;
         s2 := _class^.objname^;
         s := s+'__'+tostr(length(s2))+s2;
         end else s := s + '_';
-      param := para1;
+      param := pparaitem(para^.first);
       while assigned(param) do
         begin
         s2 := param^.data^.sym^.name;
         s := s+tostr(length(s2))+s2;
-        param := param^.next;
+        param := pparaitem(param^.next);
         end;
       cplusplusmangledname:=s;
       end;
@@ -3015,22 +2971,13 @@ Const local_symtable_index : longint = $8001;
     function tprocvardef.stabstring : pchar;
       var
          nss : pchar;
-         i : word;
-         param : pdefcoll;
+         i   : longint;
       begin
-        i := 0;
-        param := para1;
-        while assigned(param) do
-          begin
-          inc(i);
-          param := param^.next;
-          end;
+        i := para^.count;
         getmem(nss,1024);
         { it is not a function but a function pointer !! (PM) }
 
         strpcopy(nss,'*f'+retdef^.numberstring{+','+tostr(i)}+';');
-        param := para1;
-        i := 0;
         { this confuses gdb !!
           we should use 'F' instead of 'f' but
           as we use c++ language mode
@@ -3038,7 +2985,10 @@ Const local_symtable_index : longint = $8001;
           Please do not remove this part
           might be used once
           gdb for pascal is ready PM }
-        (* while assigned(param) do
+        (*
+        param := para1;
+        i := 0;
+        while assigned(param) do
           begin
           inc(i);
           if param^.paratyp = vs_value then vartyp := '1' else vartyp := '0';
@@ -3066,8 +3016,8 @@ Const local_symtable_index : longint = $8001;
 
     procedure tprocvardef.write_rtti_data;
       var
-         pdc, pdc2, pdcbefore : pdefcoll;
-         methodkind, paracount, paraspec : byte;
+         pdc : pparaitem;
+         methodkind, paraspec : byte;
       begin
         if po_methodpointer in procoptions then
           begin
@@ -3083,21 +3033,14 @@ Const local_symtable_index : longint = $8001;
              rttilist^.concat(new(pai_const,init_8bit(methodkind)));
 
              { get # of parameters }
-             paracount:=0;
-             pdc:=para1;
-             while assigned(pdc) do
-               begin
-                 inc(paracount);
-                 pdc:=pdc^.next;
-               end;
-             rttilist^.concat(new(pai_const,init_8bit(paracount)));
+             rttilist^.concat(new(pai_const,init_8bit(para^.count)));
 
              { write parameter info. The parameters must be written in reverse order
                if this method uses right to left parameter pushing! }
-             pdc:=para1;
-             if assigned(pdc) and not (pocall_leftright in proccalloptions) then
-               while assigned(pdc^.next) do pdc := pdc^.next;
-
+             if (pocall_leftright in proccalloptions) then
+              pdc:=pparaitem(para^.last)
+             else
+              pdc:=pparaitem(para^.first);
              while assigned(pdc) do
                begin
                  case pdc^.paratyp of
@@ -3112,20 +3055,11 @@ Const local_symtable_index : longint = $8001;
 
                  { write name of type of current parameter }
                  pdc^.data^.write_rtti_name;
-                 if pocall_leftright in proccalloptions then
-                   pdc:=pdc^.next
+
+                 if (pocall_leftright in proccalloptions) then
+                  pdc:=pparaitem(pdc^.previous)
                  else
-                   begin
-                     { find previous argument }
-                     pdcbefore := nil;
-                     pdc2 := para1;
-                     while pdc2 <> pdc do
-                       begin
-                         pdcbefore := pdc2;
-                         pdc2 := pdc2^.next;
-                       end;
-                     pdc := pdcbefore;
-                   end;
+                  pdc:=pparaitem(pdc^.next);
                end;
 
              { write name of result type }
@@ -3427,7 +3361,7 @@ Const local_symtable_index : longint = $8001;
         news, newrec : pchar;
         pd,ipd : pprocdef;
         lindex : longint;
-        para : pdefcoll;
+        para : pparaitem;
         arglength : byte;
         sp : char;
 
@@ -3446,9 +3380,7 @@ Const local_symtable_index : longint = $8001;
                    lindex := lindex or $80000000;}
                    virtualind := '*'+tostr(lindex)+';'+ipd^._class^.numberstring+';'
                    end else virtualind := '.';
-                { arguments are not listed here }
-                {we don't need another definition}
-                 para := pd^.para1;
+
                  { used by gdbpas to recognize constructor and destructors }
                  if (pd^.proctypeoption=potype_constructor) then
                    argnames:='__ct__'
@@ -3457,6 +3389,9 @@ Const local_symtable_index : longint = $8001;
                  else
                    argnames := '';
 
+                { arguments are not listed here }
+                {we don't need another definition}
+                 para := pparaitem(pd^.para^.first);
                  while assigned(para) do
                    begin
                    if para^.data^.deftype = formaldef then
@@ -3480,7 +3415,7 @@ Const local_symtable_index : longint = $8001;
                           argnames:=argnames+'11unnamedtype';
                        end;
                      end;
-                   para := para^.next;
+                   para := pparaitem(para^.next);
                    end;
                 ipd^.is_def_stab_written := true;
                 { here 2A must be changed for private and protected }
@@ -3866,7 +3801,15 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.171  1999-10-06 17:39:15  peter
+  Revision 1.172  1999-10-26 12:30:45  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.171  1999/10/06 17:39:15  peter
     * fixed stabs writting for forward types
 
   Revision 1.170  1999/10/04 13:46:04  michael

compiler/symdefh.inc

@@ -96,15 +96,14 @@
 
        tvarspez = (vs_value,vs_const,vs_var);
 
-       pdefcoll = ^tdefcoll;
-       tdefcoll = record
-          data    : pdef;
-          datasym : ptypesym;
-          next    : pdefcoll;
-          paratyp : tvarspez;
-          argconvtyp : targconvtyp;
+       pparaitem = ^tparaitem;
+       tparaitem = object(tlinkedlist_item)
+          data         : pdef;
+          datasym      : ptypesym;
+          paratyp      : tvarspez;
+          argconvtyp   : targconvtyp;
           convertlevel : byte;
-          register : tregister;
+          register     : tregister;
        end;
 
        tfiletype = (ft_text,ft_typed,ft_untyped);
@@ -340,7 +339,7 @@
           proctypeoption  : tproctypeoption;
           proccalloptions : tproccalloptions;
           procoptions     : tprocoptions;
-          para1           : pdefcoll;
+          para            : plinkedlist;
           symtablelevel   : byte;
           fpu_used        : byte;    { how many stack fpu must be empty }
           constructor init;
@@ -531,7 +530,15 @@
 
 {
   $Log$
-  Revision 1.43  1999-10-01 10:05:44  peter
+  Revision 1.44  1999-10-26 12:30:45  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.43  1999/10/01 10:05:44  peter
     + procedure directive support in const declarations, fixes bug 232
 
   Revision 1.42  1999/10/01 08:02:48  peter

compiler/symtable.pas

@@ -409,9 +409,6 @@ unit symtable;
     procedure list_symtablestack;
 {$endif DEBUG}
 
-{*** dispose of a pdefcoll (args of a function) ***}
-    procedure disposepdefcoll(var para1 : pdefcoll);
-
 {*** Init / Done ***}
     procedure InitSymtable;
     procedure DoneSymtable;
@@ -922,9 +919,9 @@ implementation
       end;
 
 {$ifdef BrowserLog}
-    procedure add_to_browserlog(p : psym);
+    procedure add_to_browserlog(sym : pnamedindexobject);
       begin
-         p^.add_to_browserlog;
+         psym(sym)^.add_to_browserlog;
       end;
 {$endif UseBrowser}
 
@@ -2349,7 +2346,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.53  1999-10-06 17:39:15  peter
+  Revision 1.54  1999-10-26 12:30:46  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.53  1999/10/06 17:39:15  peter
     * fixed stabs writting for forward types
 
   Revision 1.52  1999/10/03 19:44:42  peter

compiler/tccal.pas

@@ -29,7 +29,7 @@ interface
 
     procedure gen_high_tree(p:ptree;openstring:boolean);
 
-    procedure firstcallparan(var p : ptree;defcoll : pdefcoll);
+    procedure firstcallparan(var p : ptree;defcoll : pparaitem);
     procedure firstcalln(var p : ptree);
     procedure firstprocinline(var p : ptree);
 
@@ -123,7 +123,7 @@ implementation
       end;
 
 
-    procedure firstcallparan(var p : ptree;defcoll : pdefcoll);
+    procedure firstcallparan(var p : ptree;defcoll : pparaitem);
       var
         old_get_para_resulttype : boolean;
         old_array_constructor : boolean;
@@ -137,7 +137,7 @@ implementation
               if defcoll=nil then
                 firstcallparan(p^.right,nil)
               else
-                firstcallparan(p^.right,defcoll^.next);
+                firstcallparan(p^.right,pparaitem(defcoll^.next));
               p^.registers32:=p^.right^.registers32;
               p^.registersfpu:=p^.right^.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -351,8 +351,8 @@ implementation
          pprocdefcoll = ^tprocdefcoll;
          tprocdefcoll = record
             data      : pprocdef;
-            nextpara  : pdefcoll;
-            firstpara : pdefcoll;
+            nextpara  : pparaitem;
+            firstpara : pparaitem;
             next      : pprocdefcoll;
          end;
       var
@@ -363,9 +363,9 @@ implementation
          def_from,def_to,conv_to : pdef;
          hpt,pt,inlinecode : ptree;
          exactmatch,inlined : boolean;
-         paralength,l,lastpara : longint;
+         paralength,lastpara : longint;
          lastparatype : pdef;
-         pdc : pdefcoll;
+         pdc : pparaitem;
 {$ifdef TEST_PROCSYMS}
          symt : psymtable;
 {$endif TEST_PROCSYMS}
@@ -497,12 +497,12 @@ implementation
               firstpass(p^.right);
 
               { check the parameters }
-              pdc:=pprocvardef(p^.right^.resulttype)^.para1;
+              pdc:=pparaitem(pprocvardef(p^.right^.resulttype)^.para^.first);
               pt:=p^.left;
               while assigned(pdc) and assigned(pt) do
                 begin
                    pt:=pt^.right;
-                   pdc:=pdc^.next;
+                   pdc:=pparaitem(pdc^.next);
                 end;
               if assigned(pt) or assigned(pdc) then
                 begin
@@ -515,7 +515,7 @@ implementation
                 begin
                    old_count_ref:=count_ref;
                    count_ref:=true;
-                   firstcallparan(p^.left,pprocvardef(p^.right^.resulttype)^.para1);
+                   firstcallparan(p^.left,pparaitem(pprocvardef(p^.right^.resulttype)^.para^.first));
                    count_ref:=old_count_ref;
                    if codegenerror then
                      goto errorexit;
@@ -590,21 +590,14 @@ implementation
                    pd:=aktcallprocsym^.definition;
                    while assigned(pd) do
                      begin
-                        pdc:=pd^.para1;
-                        l:=0;
-                        while assigned(pdc) do
-                          begin
-                             inc(l);
-                             pdc:=pdc^.next;
-                          end;
                         { only when the # of parameter are equal }
-                        if (l=paralength) then
+                        if (pd^.para^.count=paralength) then
                           begin
                              new(hp);
                              hp^.data:=pd;
                              hp^.next:=procs;
-                             hp^.nextpara:=pd^.para1;
-                             hp^.firstpara:=pd^.para1;
+                             hp^.nextpara:=pparaitem(pd^.para^.first);
+                             hp^.firstpara:=pparaitem(pd^.para^.first);
                              procs:=hp;
                           end;
                         pd:=pd^.nextoverloaded;
@@ -732,7 +725,7 @@ implementation
                         hp:=procs;
                         while assigned(hp) do
                           begin
-                             hp^.nextpara:=hp^.nextpara^.next;
+                             hp^.nextpara:=pparaitem(hp^.nextpara^.next);
                              hp:=hp^.next;
                           end;
                         { load next parameter or quit loop if no procs left }
@@ -843,7 +836,7 @@ implementation
                              hp:=procs;
                              while assigned(hp) do
                                begin
-                                  hp^.nextpara:=hp^.nextpara^.next;
+                                  hp^.nextpara:=pparaitem(hp^.nextpara^.next);
                                   hp:=hp^.next;
                                end;
                              pt:=pt^.right;
@@ -887,7 +880,7 @@ implementation
                              hp:=procs;
                              while assigned(hp) do
                                begin
-                                  hp^.nextpara:=hp^.nextpara^.next;
+                                  hp^.nextpara:=pparaitem(hp^.nextpara^.next);
                                   hp:=hp^.next;
                                end;
                              pt:=pt^.right;
@@ -935,7 +928,7 @@ implementation
                              hp:=procs;
                              while assigned(hp) do
                                begin
-                                  hp^.nextpara:=hp^.nextpara^.next;
+                                  hp^.nextpara:=pparaitem(hp^.nextpara^.next);
                                   hp:=hp^.next;
                                end;
                              pt:=pt^.right;
@@ -1057,7 +1050,7 @@ implementation
                 begin
                    old_count_ref:=count_ref;
                    count_ref:=true;
-                   firstcallparan(p^.left,p^.procdefinition^.para1);
+                   firstcallparan(p^.left,pparaitem(p^.procdefinition^.para^.first));
                    count_ref:=old_count_ref;
                 end;
 {$ifdef i386}
@@ -1228,7 +1221,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.69  1999-10-22 14:37:30  peter
+  Revision 1.70  1999-10-26 12:30:46  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.69  1999/10/22 14:37:30  peter
     * error when properties are passed to var parameters
 
   Revision 1.68  1999/10/13 10:35:27  peter

compiler/tcinl.pas

@@ -582,9 +582,7 @@ implementation
                       if codegenerror then
                        exit;
                       { first param must be var }
-                      if (p^.left^.left^.location.loc<>LOC_REFERENCE) or
-                         (p^.left^.left^.isproperty) then
-                        CGMessagePos(p^.left^.left^.fileinfo,type_e_argument_cant_be_assigned);
+                      valid_for_assign(p^.left^.left,false);
                       { check type }
                       if (p^.left^.resulttype^.deftype in [enumdef,pointerdef]) or
                          is_ordinal(p^.left^.resulttype) then
@@ -855,9 +853,7 @@ implementation
                      (hp^.right=nil) then
                     CGMessage(cg_e_illegal_expression);
                   { we need a var parameter }
-                  if (hp^.left^.location.loc<>LOC_REFERENCE) or
-                     (hp^.left^.isproperty) then
-                    CGMessagePos(p^.left^.fileinfo,type_e_argument_cant_be_assigned);
+                  valid_for_assign(hp^.left,false);
                   { generate the high() value for the shortstring }
                   if is_shortstring(hp^.left^.resulttype) then
                     gen_high_tree(hp,true);
@@ -952,14 +948,13 @@ implementation
                        if codegenerror then exit;
                        p^.left^.right := hp;
                      {code has to be a var parameter}
-                       if (p^.left^.left^.location.loc<>LOC_REFERENCE) or
-                          (p^.left^.left^.isproperty) then
-                         CGMessage(type_e_variable_id_expected)
-                       else
-                         if (p^.left^.left^.resulttype^.deftype <> orddef) or
+                       if valid_for_assign(p^.left^.left,false) then
+                        begin
+                          if (p^.left^.left^.resulttype^.deftype <> orddef) or
                             not(porddef(p^.left^.left^.resulttype)^.typ in
                                 [u16bit,s16bit,u32bit,s32bit]) then
                            CGMessage(type_e_mismatch);
+                        end;
                        hpp := p^.left^.right
                      End
                   Else hpp := p^.left;
@@ -978,16 +973,15 @@ implementation
                   if (hpp^.left^.treetype=funcretn) then
                    procinfo^.funcret_is_valid:=true;
                   hpp^.right := hp;
-                  if (hpp^.left^.location.loc<>LOC_REFERENCE) or
-                     (hpp^.left^.isproperty) then
-                    CGMessage(type_e_variable_id_expected)
-                  else
-                    If Not((hpp^.left^.resulttype^.deftype = floatdef) or
-                           ((hpp^.left^.resulttype^.deftype = orddef) And
-                            (POrdDef(hpp^.left^.resulttype)^.typ in
+                  if valid_for_assign(hpp^.left,false) then
+                   begin
+                     If Not((hpp^.left^.resulttype^.deftype = floatdef) or
+                            ((hpp^.left^.resulttype^.deftype = orddef) And
+                             (POrdDef(hpp^.left^.resulttype)^.typ in
                               [u32bit,s32bit,
-                               u8bit,s8bit,u16bit,s16bit,s64bit,u64bit])))
-                        Then CGMessage(type_e_mismatch);
+                               u8bit,s8bit,u16bit,s16bit,s64bit,u64bit]))) Then
+                       CGMessage(type_e_mismatch);
+                   end;
                   must_be_valid:=true;
                  {hp = source (String)}
                   count_ref := false;
@@ -1029,9 +1023,7 @@ implementation
                       if (p^.left^.left^.treetype=funcretn) then
                        procinfo^.funcret_is_valid:=true;
                       { first param must be var }
-                      if not(p^.left^.left^.location.loc in [LOC_REFERENCE,LOC_CREGISTER]) or
-                         (p^.left^.left^.isproperty) then
-                        CGMessagePos(p^.left^.left^.fileinfo,type_e_argument_cant_be_assigned);
+                      valid_for_assign(p^.left^.left,false);
                       { check type }
                       if (p^.left^.resulttype^.deftype=setdef) then
                         begin
@@ -1268,7 +1260,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.55  1999-10-22 14:37:31  peter
+  Revision 1.56  1999-10-26 12:30:46  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.55  1999/10/22 14:37:31  peter
     * error when properties are passed to var parameters
 
   Revision 1.54  1999/10/21 16:41:41  florian

compiler/tcld.pas

@@ -238,11 +238,6 @@ implementation
          if is_open_array(p^.left^.resulttype) then
            CGMessage(type_e_mismatch);
 
-         { assignments to addr aren't allowed, but support @procvar for tp }
-         if (p^.left^.treetype=addrn) and
-            not(p^.left^.procvarload) then
-          CGMessage(type_e_no_assign_to_addr);
-
          { test if we can avoid copying string to temp
            as in s:=s+...; (PM) }
 {$ifdef dummyi386}
@@ -317,17 +312,13 @@ implementation
              exit;
           end;
 
-         { set assigned flag for varsyms }
-         if (p^.left^.treetype=loadn) and
-            (p^.left^.symtableentry^.typ=varsym) and
-            (pvarsym(p^.left^.symtableentry)^.varstate=vs_declared) then
-           pvarsym(p^.left^.symtableentry)^.varstate:=vs_assigned;
+         { test if node can be assigned, properties are allowed }
+         valid_for_assign(p^.left,true);
 
          { check if local proc/func is assigned to procvar }
          if p^.right^.resulttype^.deftype=procvardef then
            test_local_to_procvar(pprocvardef(p^.right^.resulttype),p^.left^.resulttype);
 
-
          p^.resulttype:=voiddef;
          {
            p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
@@ -511,7 +502,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.47  1999-10-13 10:35:27  peter
+  Revision 1.48  1999-10-26 12:30:46  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.47  1999/10/13 10:35:27  peter
     * var must match exactly error msg extended with got and expected type
     * array constructor type check now gives error on wrong types
 

compiler/tcmat.pas

@@ -301,8 +301,8 @@ implementation
                 minusdef:=nil;
               while assigned(minusdef) do
                 begin
-                   if (minusdef^.para1^.data=p^.left^.resulttype) and
-                     (minusdef^.para1^.next=nil) then
+                   if (pparaitem(minusdef^.para^.first)^.data=p^.left^.resulttype) and
+                      (pparaitem(minusdef^.para^.first)^.next=nil) then
                      begin
                         t:=gencallnode(overloaded_operators[_minus],nil);
                         t^.left:=gencallparanode(p^.left,nil);
@@ -408,7 +408,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.20  1999-08-23 23:37:01  pierre
+  Revision 1.21  1999-10-26 12:30:46  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.20  1999/08/23 23:37:01  pierre
    * firstnot register counting error corrected
 
   Revision 1.19  1999/08/04 13:03:15  jonas

compiler/tcmem.pas

@@ -166,7 +166,7 @@ implementation
     procedure firstaddr(var p : ptree);
       var
          hp  : ptree;
-         hp2 : pdefcoll;
+         hp2 : pparaitem;
          store_valid : boolean;
          hp3 : pabstractprocdef;
       begin
@@ -197,6 +197,7 @@ implementation
                      end;
                    loadn,
                    subscriptn,
+                   typeconvn,
                    vecn,
                    derefn :
                      begin
@@ -269,11 +270,13 @@ implementation
 {$else}
                          pprocvardef(p^.resulttype)^.procoptions:=pprocvardef(p^.resulttype)^.procoptions+[po_methodpointer];
 {$endif}
-                       hp2:=hp3^.para1;
+                       { we need to process the parameters reverse so they are inserted
+                         in the correct right2left order (PFV) }
+                       hp2:=pparaitem(hp3^.para^.last);
                        while assigned(hp2) do
                          begin
                             pprocvardef(p^.resulttype)^.concatdef(hp2^.data,hp2^.paratyp);
-                            hp2:=hp2^.next;
+                            hp2:=pparaitem(hp2^.previous);
                          end;
                     end
                   else
@@ -286,7 +289,7 @@ implementation
                 begin
                   { what are we getting the address from an absolute sym? }
                   hp:=p^.left;
-                  while assigned(hp) and (hp^.treetype in [vecn,subscriptn]) do
+                  while assigned(hp) and (hp^.treetype in [vecn,derefn,subscriptn]) do
                    hp:=hp^.left;
                   if assigned(hp) and (hp^.treetype=loadn) and
                      ((hp^.symtableentry^.typ=absolutesym) and
@@ -409,13 +412,8 @@ implementation
              p^.resulttype:=generrordef;
              exit;
            end;
-
          p^.resulttype:=p^.vs^.definition;
-         { this must be done in the parser
-         if count_ref and not must_be_valid then
-           if (p^.vs^.properties and sp_protected)<>0 then
-             CGMessage(parser_e_cant_write_protected_member);
-         }
+
          p^.registers32:=p^.left^.registers32;
          p^.registersfpu:=p^.left^.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -631,7 +629,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.30  1999-10-13 10:40:55  peter
+  Revision 1.31  1999-10-26 12:30:46  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.30  1999/10/13 10:40:55  peter
     * subscript support for tp_procvar
 
   Revision 1.29  1999/09/27 23:45:02  peter

compiler/types.pas

@@ -140,12 +140,12 @@ interface
     { if value_equal_const is true, call by value   }
     { and call by const parameter are assumed as    }
     { equal                                         }
-    function equal_paras(def1,def2 : pdefcoll;value_equal_const : boolean) : boolean;
+    function equal_paras(paralist1,paralist2 : plinkedlist;value_equal_const : boolean) : boolean;
 
 
     { true if a type can be allowed for another one
       in a func var }
-    function convertable_paras(def1,def2 : pdefcoll;value_equal_const : boolean) : boolean;
+    function convertable_paras(paralist1,paralist2 : plinkedlist;value_equal_const : boolean) : boolean;
 
     { true if a function can be assigned to a procvar }
     function proc_to_procvar_equal(def1:pprocdef;def2:pprocvardef) : boolean;
@@ -179,8 +179,12 @@ implementation
          (sym^.typ in [propertysym,varsym]);
       end;
 
-    function equal_paras(def1,def2 : pdefcoll;value_equal_const : boolean) : boolean;
+    function equal_paras(paralist1,paralist2 : plinkedlist;value_equal_const : boolean) : boolean;
+      var
+        def1,def2 : pparaitem;
       begin
+         def1:=pparaitem(paralist1^.first);
+         def2:=pparaitem(paralist2^.first);
          while (assigned(def1)) and (assigned(def2)) do
            begin
               if value_equal_const then
@@ -205,8 +209,8 @@ implementation
                         exit;
                      end;
                 end;
-              def1:=def1^.next;
-              def2:=def2^.next;
+              def1:=pparaitem(def1^.next);
+              def2:=pparaitem(def2^.next);
            end;
          if (def1=nil) and (def2=nil) then
            equal_paras:=true
@@ -214,9 +218,13 @@ implementation
            equal_paras:=false;
       end;
 
-    function convertable_paras(def1,def2 : pdefcoll;value_equal_const : boolean) : boolean;
-      var doconv : tconverttype;
+    function convertable_paras(paralist1,paralist2 : plinkedlist;value_equal_const : boolean) : boolean;
+      var
+        def1,def2 : pparaitem;
+        doconv : tconverttype;
       begin
+         def1:=pparaitem(paralist1^.first);
+         def2:=pparaitem(paralist2^.first);
          while (assigned(def1)) and (assigned(def2)) do
            begin
               if value_equal_const then
@@ -241,8 +249,8 @@ implementation
                         exit;
                      end;
                 end;
-              def1:=def1^.next;
-              def2:=def2^.next;
+              def1:=pparaitem(def1^.next);
+              def2:=pparaitem(def2^.next);
            end;
          if (def1=nil) and (def2=nil) then
            convertable_paras:=true
@@ -278,8 +286,8 @@ implementation
          { check return value and para's and options, methodpointer is already checked
            parameters may also be convertable }
          if is_equal(def1^.retdef,def2^.retdef) and
-            (equal_paras(def1^.para1,def2^.para1,false) or
-             convertable_paras(def1^.para1,def2^.para1,false)) and
+            (equal_paras(def1^.para,def2^.para,false) or
+             convertable_paras(def1^.para,def2^.para,false)) and
             ((po_comp * def1^.procoptions)= (po_comp * def2^.procoptions)) then
            proc_to_procvar_equal:=true
          else
@@ -779,7 +787,6 @@ implementation
       var
          b : boolean;
          hd : pdef;
-         hp1,hp2 : pdefcoll;
       begin
          { both types must exists }
          if not (assigned(def1) and assigned(def2)) then
@@ -880,25 +887,8 @@ implementation
                    (pprocvardef(def1)^.proccalloptions=pprocvardef(def2)^.proccalloptions) and
                    ((pprocvardef(def1)^.procoptions * po_compatibility_options)=
                     (pprocvardef(def2)^.procoptions * po_compatibility_options)) and
-                   is_equal(pprocvardef(def1)^.retdef,pprocvardef(def2)^.retdef);
-                { now evalute the parameters }
-                if b then
-                  begin
-                     hp1:=pprocvardef(def1)^.para1;
-                     hp2:=pprocvardef(def1)^.para1;
-                     while assigned(hp1) and assigned(hp2) do
-                       begin
-                          if not(is_equal(hp1^.data,hp2^.data)) or
-                            not(hp1^.paratyp=hp2^.paratyp) then
-                            begin
-                               b:=false;
-                               break;
-                            end;
-                          hp1:=hp1^.next;
-                          hp2:=hp2^.next;
-                       end;
-                     b:=(hp1=nil) and (hp2=nil);
-                  end;
+                   is_equal(pprocvardef(def1)^.retdef,pprocvardef(def2)^.retdef) and
+                   equal_paras(pprocvardef(def1)^.para,pprocvardef(def2)^.para,false);
              end
          else
            if (def1^.deftype=arraydef) and (def2^.deftype=arraydef) then
@@ -995,7 +985,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.89  1999-10-01 10:04:07  peter
+  Revision 1.90  1999-10-26 12:30:46  peter
+    * const parameter is now checked
+    * better and generic check if a node can be used for assigning
+    * export fixes
+    * procvar equal works now (it never had worked at least from 0.99.8)
+    * defcoll changed to linkedlist with pparaitem so it can easily be
+      walked both directions
+
+  Revision 1.89  1999/10/01 10:04:07  peter
     * fixed is_equal for proc -> procvar which didn't check the
       callconvention and type anymore since the splitting of procoptions