* @procvar is now always needed for FPC

compiler/README

@@ -52,4 +52,6 @@ Changes in the syntax or semantic of FPC:
              exceptions and exceptions need the class OOP model
   18/05/99   The compiler will stop directly if there are errors in the
              commandline parameters
+  01/06/99   You now need really always a @ to get the address of a procedure,
+             or you need to use the -So switch for tp7 style procvar
 

compiler/aasm.pas

@@ -846,11 +846,7 @@ uses
 
     procedure ResetAsmsymbolList;
       begin
-        {$ifdef tp}
+        asmsymbollist^.foreach({$ifdef fpc}@{$endif}resetasmsym);
-        asmsymbollist^.foreach(resetasmsym);
-        {$else}
-        asmsymbollist^.foreach(@resetasmsym);
-        {$endif}
       end;
 
 
@@ -900,7 +896,10 @@ uses
 end.
 {
   $Log$
-  Revision 1.48  1999-05-28 09:11:39  peter
+  Revision 1.49  1999-06-01 14:45:41  peter
+    * @procvar is now always needed for FPC
+
+  Revision 1.48  1999/05/28 09:11:39  peter
     * also count ref when asmlabel^.name is used
 
   Revision 1.47  1999/05/27 19:43:55  peter

compiler/ag386int.pas

@@ -584,7 +584,7 @@ ait_stab_function_name : ;
     procedure ti386intasmlist.WriteExternals;
       begin
         currentasmlist:=@self;
-        AsmSymbolList^.foreach(writeexternal);
+        AsmSymbolList^.foreach({$ifdef fpc}@{$endif}writeexternal);
       end;
 
 
@@ -627,7 +627,10 @@ ait_stab_function_name : ;
 end.
 {
   $Log$
-  Revision 1.44  1999-05-27 19:44:00  peter
+  Revision 1.45  1999-06-01 14:45:43  peter
+    * @procvar is now always needed for FPC
+
+  Revision 1.44  1999/05/27 19:44:00  peter
     * removed oldasm
     * plabel -> pasmlabel
     * -a switches to source writing automaticly

compiler/ag386nsm.pas

@@ -559,7 +559,7 @@ ait_stab_function_name : ;
     procedure ti386nasmasmlist.WriteExternals;
       begin
         currentasmlist:=@self;
-        AsmSymbolList^.foreach(writeexternal);
+        AsmSymbolList^.foreach({$ifdef fpc}@{$endif}writeexternal);
       end;
 
 
@@ -597,7 +597,10 @@ ait_stab_function_name : ;
 end.
 {
   $Log$
-  Revision 1.40  1999-05-27 19:44:02  peter
+  Revision 1.41  1999-06-01 14:45:44  peter
+    * @procvar is now always needed for FPC
+
+  Revision 1.40  1999/05/27 19:44:02  peter
     * removed oldasm
     * plabel -> pasmlabel
     * -a switches to source writing automaticly

compiler/hcgdata.pas

@@ -203,7 +203,7 @@ implementation
          root:=nil;
          count:=0;
          { insert all message handlers into a tree, sorted by name }
-         _class^.publicsyms^.foreach(insertmsgstr);
+         _class^.publicsyms^.foreach({$ifdef fpc}@{$endif}insertmsgstr);
 
          { write all names }
          if assigned(root) then
@@ -245,7 +245,7 @@ implementation
          root:=nil;
          count:=0;
          { insert all message handlers into a tree, sorted by name }
-         _class^.publicsyms^.foreach(insertmsgint);
+         _class^.publicsyms^.foreach({$ifdef fpc}@{$endif}insertmsgint);
 
          { now start writing of the message string table }
          getdatalabel(r);
@@ -471,11 +471,7 @@ implementation
 
            { walk through all public syms }
            _c:=_class;
-{$ifdef tp}
+           p^.publicsyms^.foreach({$ifdef fpc}@{$endif}eachsym);
-           p^.publicsyms^.foreach(eachsym);
-{$else}
-           p^.publicsyms^.foreach(@eachsym);
-{$endif}
         end;
 
       var
@@ -562,7 +558,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.7  1999-05-27 19:44:30  peter
+  Revision 1.8  1999-06-01 14:45:49  peter
+    * @procvar is now always needed for FPC
+
+  Revision 1.7  1999/05/27 19:44:30  peter
     * removed oldasm
     * plabel -> pasmlabel
     * -a switches to source writing automaticly

compiler/pass_2.pas

@@ -410,18 +410,10 @@ implementation
                         for i:=1 to maxvarregs do
                           regvars[i]:=nil;
                         parasym:=false;
-                      {$ifdef tp}
+                        symtablestack^.foreach({$ifdef fpc}@{$endif}searchregvars);
-                        symtablestack^.foreach(searchregvars);
-                      {$else}
-                        symtablestack^.foreach(@searchregvars);
-                      {$endif}
                         { copy parameter into a register ? }
                         parasym:=true;
-                      {$ifdef tp}
+                        symtablestack^.next^.foreach({$ifdef fpc}@{$endif}searchregvars);
-                        symtablestack^.next^.foreach(searchregvars);
-                      {$else}
-                        symtablestack^.next^.foreach(@searchregvars);
-                      {$endif}
                         { hold needed registers free }
                         for i:=maxvarregs downto maxvarregs-p^.registers32+1 do
                           regvars[i]:=nil;
@@ -547,7 +539,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.23  1999-05-27 19:44:43  peter
+  Revision 1.24  1999-06-01 14:45:50  peter
+    * @procvar is now always needed for FPC
+
+  Revision 1.23  1999/05/27 19:44:43  peter
     * removed oldasm
     * plabel -> pasmlabel
     * -a switches to source writing automaticly

compiler/pdecl.pas

@@ -100,11 +100,7 @@ unit pdecl;
                reaktvarsymtable:=precdef(ptypesym(p)^.definition)^.symtable
              else
                reaktvarsymtable:=pobjectdef(ptypesym(p)^.definition)^.publicsyms;
-           {$ifdef tp}
+             reaktvarsymtable^.foreach({$ifdef fpc}@{$endif}testforward_type);
-             reaktvarsymtable^.foreach(testforward_type);
-           {$else}
-             reaktvarsymtable^.foreach(@testforward_type);
-           {$endif}
            end;
       end;
 
@@ -2109,11 +2105,7 @@ unit pdecl;
              parse_var_proc_directives(newtype);
          until token<>ID;
          typecanbeforward:=false;
-      {$ifdef tp}
+         symtablestack^.foreach({$ifdef fpc}@{$endif}testforward_type);
-         symtablestack^.foreach(testforward_type);
-      {$else}
-         symtablestack^.foreach(@testforward_type);
-      {$endif}
          resolve_forwards;
          block_type:=bt_general;
       end;
@@ -2224,7 +2216,10 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.123  1999-05-27 19:44:45  peter
+  Revision 1.124  1999-06-01 14:45:51  peter
+    * @procvar is now always needed for FPC
+
+  Revision 1.123  1999/05/27 19:44:45  peter
     * removed oldasm
     * plabel -> pasmlabel
     * -a switches to source writing automaticly

compiler/symdef.inc

@@ -1878,7 +1878,7 @@
          { procedure of needs_rtti !                         }
          oldb:=binittable;
          binittable:=false;
-         symtable^.foreach(check_rec_inittable);
+         symtable^.foreach({$ifdef fpc}@{$endif}check_rec_inittable);
          needs_inittable:=binittable;
          binittable:=oldb;
       end;
@@ -2037,13 +2037,13 @@
 
     procedure trecdef.write_child_rtti_data;
       begin
-         symtable^.foreach(generate_child_rtti);
+         symtable^.foreach({$ifdef fpc}@{$endif}generate_child_rtti);
       end;
 
 
     procedure trecdef.write_child_init_data;
       begin
-         symtable^.foreach(generate_child_inittable);
+         symtable^.foreach({$ifdef fpc}@{$endif}generate_child_inittable);
       end;
 
 
@@ -2053,9 +2053,9 @@
          write_rtti_name;
          rttilist^.concat(new(pai_const,init_32bit(size)));
          count:=0;
-         symtable^.foreach(count_fields);
+         symtable^.foreach({$ifdef fpc}@{$endif}count_fields);
          rttilist^.concat(new(pai_const,init_32bit(count)));
-         symtable^.foreach(write_field_rtti);
+         symtable^.foreach({$ifdef fpc}@{$endif}write_field_rtti);
       end;
 
 
@@ -2065,9 +2065,9 @@
          write_rtti_name;
          rttilist^.concat(new(pai_const,init_32bit(size)));
          count:=0;
-         symtable^.foreach(count_inittable_fields);
+         symtable^.foreach({$ifdef fpc}@{$endif}count_inittable_fields);
          rttilist^.concat(new(pai_const,init_32bit(count)));
-         symtable^.foreach(write_field_inittable);
+         symtable^.foreach({$ifdef fpc}@{$endif}write_field_inittable);
       end;
 
     function trecdef.gettypename : string;
@@ -2637,11 +2637,7 @@ Const local_symtable_index : longint = $8001;
         strpcopy(strend(StabRecString),','+tostr(i)+';');
         (* confuse gdb !! PM
         if assigned(parast) then
-          {$IfDef TP}
+          parast^.foreach({$ifdef fpc}@{$endif}addparaname)
-          parast^.foreach(addparaname)
-          {$Else}
-          parast^.foreach(@addparaname)
-          {$EndIf}
           else
           begin
           param := para1;
@@ -3214,22 +3210,14 @@ Const local_symtable_index : longint = $8001;
           strpcopy(strend(stabrecstring),'!1,020,'+childof^.numberstring+';');
         {virtual table to implement yet}
         RecOffset := 0;
-        {$ifdef tp}
+        publicsyms^.foreach({$ifdef fpc}@{$endif}addname);
-          publicsyms^.foreach(addname);
-        {$else}
-          publicsyms^.foreach(@addname);
-        {$endif}
       if (options and oo_hasvmt) <> 0 then
         if not assigned(childof) or ((childof^.options and oo_hasvmt) = 0) then
            begin
               strpcopy(strend(stabrecstring),'$vf'+numberstring+':'+typeglobalnumber('vtblarray')
                 +','+tostr(vmt_offset*8)+';');
            end;
-        {$ifdef tp}
+        publicsyms^.foreach({$ifdef fpc}@{$endif}addprocname);
-          publicsyms^.foreach(addprocname);
-        {$else}
-          publicsyms^.foreach(@addprocname);
-        {$endif tp }
         if (options and oo_hasvmt) <> 0  then
           begin
              anc := @self;
@@ -3266,9 +3254,9 @@ Const local_symtable_index : longint = $8001;
 
          rttilist^.concat(new(pai_const,init_32bit(size)));
          count:=0;
-         publicsyms^.foreach(count_inittable_fields);
+         publicsyms^.foreach({$ifdef fpc}@{$endif}count_inittable_fields);
          rttilist^.concat(new(pai_const,init_32bit(count)));
-         publicsyms^.foreach(write_field_inittable);
+         publicsyms^.foreach({$ifdef fpc}@{$endif}write_field_inittable);
       end;
 
 
@@ -3282,7 +3270,7 @@ Const local_symtable_index : longint = $8001;
          { procedure of needs_rtti !                              }
          oldb:=binittable;
          binittable:=false;
-         publicsyms^.foreach(check_rec_inittable);
+         publicsyms^.foreach({$ifdef fpc}@{$endif}check_rec_inittable);
          needs_inittable:=binittable;
          binittable:=oldb;
       end;
@@ -3375,7 +3363,7 @@ Const local_symtable_index : longint = $8001;
 
     procedure tobjectdef.write_child_rtti_data;
       begin
-         publicsyms^.foreach(generate_published_child_rtti);
+         publicsyms^.foreach({$ifdef fpc}@{$endif}generate_published_child_rtti);
       end;
 
 
@@ -3399,7 +3387,7 @@ Const local_symtable_index : longint = $8001;
          else
            i:=0;
          count:=0;
-         publicsyms^.foreach(count_published_properties);
+         publicsyms^.foreach({$ifdef fpc}@{$endif}count_published_properties);
          next_free_name_index:=i+count;
       end;
 
@@ -3431,7 +3419,7 @@ Const local_symtable_index : longint = $8001;
            count:=0;
 
          { write it }
-         publicsyms^.foreach(count_published_properties);
+         publicsyms^.foreach({$ifdef fpc}@{$endif}count_published_properties);
          rttilist^.concat(new(pai_const,init_16bit(count)));
 
          { write unit name }
@@ -3445,7 +3433,7 @@ Const local_symtable_index : longint = $8001;
 
          { write published properties count }
          count:=0;
-         publicsyms^.foreach(count_published_properties);
+         publicsyms^.foreach({$ifdef fpc}@{$endif}count_published_properties);
          rttilist^.concat(new(pai_const,init_16bit(count)));
 
          { count is used to write nameindex   }
@@ -3456,7 +3444,7 @@ Const local_symtable_index : longint = $8001;
          else
            count:=0;
 
-         publicsyms^.foreach(write_property_info);
+         publicsyms^.foreach({$ifdef fpc}@{$endif}write_property_info);
       end;
 
 
@@ -3497,7 +3485,10 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.124  1999-05-31 16:42:33  peter
+  Revision 1.125  1999-06-01 14:45:56  peter
+    * @procvar is now always needed for FPC
+
+  Revision 1.124  1999/05/31 16:42:33  peter
     * interfacedef flag for procdef if it's defined in the interface, to
       make a difference with 'forward;' directive forwarddef. Fixes 253
 

compiler/symtable.pas

@@ -1614,11 +1614,7 @@ const localsymtablestack : psymtable = nil;
               aktrecordsymtable:=@self;
            end;
          current_ppu^.writeentry(ibbeginsymtablebrowser);
-      {$ifdef tp}
+         foreach({$ifdef fpc}@{$endif}write_refs);
-         foreach(write_refs);
-      {$else}
-         foreach(@write_refs);
-      {$endif}
          current_ppu^.writeentry(ibendsymtablebrowser);
          if symtabletype in [recordsymtable,objectsymtable,
                     parasymtable,localsymtable] then
@@ -1642,11 +1638,7 @@ const localsymtablestack : psymtable = nil;
                   Browserlog.AddLog('---Symtable with no name');
              end;
            Browserlog.Ident;
-         {$ifdef tp}
+           foreach({$ifdef fpc}@{$endif}add_to_browserlog);
-           foreach(add_to_browserlog);
-         {$else}
-           foreach(@add_to_browserlog);
-         {$endif}
            browserlog.Unident;
          end;
       end;
@@ -1660,20 +1652,12 @@ const localsymtablestack : psymtable = nil;
     { checks, if all procsyms and methods are defined }
     procedure tsymtable.check_forwards;
       begin
-      {$ifdef tp}
+         foreach({$ifdef fpc}@{$endif}check_procsym_forward);
-         foreach(check_procsym_forward);
-      {$else}
-         foreach(@check_procsym_forward);
-      {$endif}
       end;
 
     procedure tsymtable.checklabels;
       begin
-      {$ifdef tp}
+         foreach({$ifdef fpc}@{$endif}labeldefined);
-         foreach(labeldefined);
-      {$else}
-         foreach(@labeldefined);
-      {$endif}
       end;
 
     procedure tsymtable.set_alignment(_alignment : byte);
@@ -1721,30 +1705,18 @@ const localsymtablestack : psymtable = nil;
 
     procedure tsymtable.allunitsused;
       begin
-      {$ifdef tp}
+         foreach({$ifdef fpc}@{$endif}unitsymbolused);
-         foreach(unitsymbolused);
-      {$else}
-         foreach(@unitsymbolused);
-      {$endif}
       end;
 
     procedure tsymtable.allsymbolsused;
       begin
-      {$ifdef tp}
+         foreach({$ifdef fpc}@{$endif}varsymbolused);
-         foreach(varsymbolused);
-      {$else}
-         foreach(@varsymbolused);
-      {$endif}
       end;
 
 {$ifdef CHAINPROCSYMS}
     procedure tsymtable.chainprocsyms;
       begin
-      {$ifdef tp}
+         foreach({$ifdef fpc}@{$endif}chainprocsym);
-         foreach(chainprocsym);
-      {$else}
-         foreach(@chainprocsym);
-      {$endif}
       end;
 {$endif CHAINPROCSYMS}
 
@@ -1752,11 +1724,7 @@ const localsymtablestack : psymtable = nil;
       procedure tsymtable.concatstabto(asmlist : paasmoutput);
       begin
         asmoutput:=asmlist;
-      {$ifdef tp}
+        foreach({$ifdef fpc}@{$endif}concatstab);
-        foreach(concatstab);
-      {$else}
-        foreach(@concatstab);
-      {$endif}
       end;
 {$endif}
 
@@ -2004,11 +1972,7 @@ const localsymtablestack : psymtable = nil;
                 dbx_counter := @dbx_count;
              end;
            asmoutput:=asmlist;
-           {$ifdef tp}
+           foreach({$ifdef fpc}@{$endif}concattypestab);
-             foreach(concattypestab);
-           {$else}
-             foreach(@concattypestab);
-           {$endif}
            if cs_gdb_dbx in aktglobalswitches then
              begin
                 dbx_counter := prev_dbx_count;
@@ -2163,11 +2127,7 @@ const localsymtablestack : psymtable = nil;
         _defaultprop:=nil;
         while assigned(pd) do
           begin
-           {$ifdef tp}
+             pd^.publicsyms^.foreach({$ifdef fpc}@{$endif}testfordefaultproperty);
-             pd^.publicsyms^.foreach(testfordefaultproperty);
-           {$else}
-             pd^.publicsyms^.foreach(@testfordefaultproperty);
-           {$endif}
              if assigned(_defaultprop) then
                break;
              pd:=pd^.childof;
@@ -2341,7 +2301,10 @@ const localsymtablestack : psymtable = nil;
 end.
 {
   $Log$
-  Revision 1.17  1999-05-27 19:45:08  peter
+  Revision 1.18  1999-06-01 14:45:58  peter
+    * @procvar is now always needed for FPC
+
+  Revision 1.17  1999/05/27 19:45:08  peter
     * removed oldasm
     * plabel -> pasmlabel
     * -a switches to source writing automaticly

compiler/tccal.pas

@@ -690,10 +690,11 @@ implementation
                     begin
                       { there is an error, must be wrong type, because
                         wrong size is already checked (PFV) }
-                      if ((parsing_para_level=0) or (p^.left<>nil)) and
+                      {if ((parsing_para_level=0) or (p^.left<>nil)) and
-                         (nextprocsym=nil) then
+                         (nextprocsym=nil) then }
+                      if parsing_para_level=0 then
                        begin
-                         if (not assigned(lastparatype)) and (not assigned(pt^.resulttype)) then
+                         if (not assigned(lastparatype)) or (not assigned(pt^.resulttype)) then
                           internalerror(39393)
                          else
                           CGMessage3(type_e_wrong_parameter_type,tostr(lastpara),
@@ -703,13 +704,22 @@ implementation
                        end
                       else
                        begin
-                         { try to convert to procvar }
+                         if (m_tp_procvar in aktmodeswitches) then
-                         p^.treetype:=loadn;
+                          begin
-                         p^.resulttype:=pprocsym(p^.symtableprocentry)^.definition;
+                            { try to convert to procvar }
-                         p^.symtableentry:=p^.symtableprocentry;
+                            p^.treetype:=loadn;
-                         p^.is_first:=false;
+                            p^.resulttype:=pprocsym(p^.symtableprocentry)^.definition;
-                         p^.disposetyp:=dt_nothing;
+                            p^.symtableentry:=p^.symtableprocentry;
-                         firstpass(p);
+                            p^.is_first:=false;
+                            p^.disposetyp:=dt_nothing;
+                            firstpass(p);
+                          end
+                         else
+                          begin
+                            { only return the resulttype, the check for equal will be done
+                              in the para parsing of the previous function }
+                            p^.resulttype:=pprocsym(p^.symtableprocentry)^.definition^.retdef;
+                          end;
                          goto errorexit;
                        end;
                      end;
@@ -1162,7 +1172,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.49  1999-05-31 20:34:51  peter
+  Revision 1.50  1999-06-01 14:46:00  peter
+    * @procvar is now always needed for FPC
+
+  Revision 1.49  1999/05/31 20:34:51  peter
     * fixed hightree generation when loading highSYM
 
   Revision 1.48  1999/05/27 19:45:13  peter