* Patch from peter: fix macpas anonymous function procvar

compiler/globals.pas

@@ -90,7 +90,7 @@ interface
        MathNegInf : tdoublearray = (0,0,0,0,0,0,240,255);
        MathPi : tdoublearray =  (24,45,68,84,251,33,9,64);
        MathPiExtended : textendedarray = (53,194,104,33,162,218,15,201,0,64);
-{$else CPU_LITTLE_ENDIAN}       
+{$else CPU_LITTLE_ENDIAN}
        MathQNaN : tdoublearray = (255,252,0,0,0,0,0,0);
        MathInf : tdoublearray = (127,240,0,0,0,0,0,0);
        MathNegInf : tdoublearray = (255,240,0,0,0,0,0,0);
@@ -230,7 +230,7 @@ interface
         aktsetalloc,
        {$ENDIF}
        aktpackrecords,
-       aktpackenum        : longint;
+       aktpackenum        : shortint;
      {$ifdef ansistring_bits}
        aktansistring_bits : Tstringbits;
      {$endif}
@@ -356,7 +356,7 @@ interface
 
 {$IFDEF MACOS}
 
-{Since SysUtils is not yet available for MacOS, fake 
+{Since SysUtils is not yet available for MacOS, fake
  Exceptions classes are included here.}
 
 {$DEFINE MACOS_USE_FAKE_SYSUTILS}
@@ -2218,7 +2218,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.164  2005-01-31 21:30:56  olle
+  Revision 1.165  2005-02-01 08:46:13  michael
+   * Patch from peter: fix macpas anonymous function procvar
+
+  Revision 1.164  2005/01/31 21:30:56  olle
     + Added fake Exception classes, only for MACOS.
 
   Revision 1.163  2005/01/23 22:13:50  florian

compiler/parser.pas

@@ -346,7 +346,8 @@ implementation
           oldaktmoduleswitches : tmoduleswitches;
           oldaktfilepos      : tfileposinfo;
           oldaktpackrecords,
-          oldaktpackenum,oldaktmaxfpuregisters : longint;
+          oldaktpackenum       : shortint;
+          oldaktmaxfpuregisters : longint;
           oldaktalignment  : talignmentinfo;
           oldaktoutputformat : tasm;
           oldaktspecificoptprocessor,
@@ -660,7 +661,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.72  2005-01-29 11:36:52  peter
+  Revision 1.73  2005-02-01 08:46:13  michael
+   * Patch from peter: fix macpas anonymous function procvar
+
+  Revision 1.72  2005/01/29 11:36:52  peter
     * update x86_64 with new cpupara
 
   Revision 1.71  2005/01/26 16:23:28  peter

compiler/pdecobj.pas

@@ -138,7 +138,6 @@ implementation
         end;
 
       var
-         hs      : string;
          pcrd       : tclassrefdef;
          tt     : ttype;
          old_object_option : tsymoptions;
@@ -272,7 +271,7 @@ implementation
                         { a hack, but it's easy to handle }
                         { class reference type }
                         consume(_OF);
-                        single_type(tt,hs,typecanbeforward);
+                        single_type(tt,typecanbeforward);
 
                         { accept hp1, if is a forward def or a class }
                         if (tt.def.deftype=forwarddef) or
@@ -346,7 +345,7 @@ implementation
         begin
           while try_to_consume(_COMMA) do
             begin
-               id_type(tt,pattern,false);
+               id_type(tt,false);
                if (tt.def.deftype<>objectdef) then
                  begin
                     Message1(type_e_interface_type_expected,tt.def.typename);
@@ -387,7 +386,7 @@ implementation
            { reads the parent class }
            if try_to_consume(_LKLAMMER) then
              begin
-                id_type(tt,pattern,false);
+                id_type(tt,false);
                 childof:=tobjectdef(tt.def);
                 if (not assigned(childof)) or
                    (childof.deftype<>objectdef) then
@@ -730,7 +729,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.84  2004-12-26 20:11:39  peter
+  Revision 1.85  2005-02-01 08:46:13  michael
+   * Patch from peter: fix macpas anonymous function procvar
+
+  Revision 1.84  2004/12/26 20:11:39  peter
     * fix invalid typecast
 
   Revision 1.83  2004/11/16 20:32:40  peter

compiler/pdecsub.pas

@@ -388,8 +388,6 @@ implementation
         vs      : tparavarsym;
         srsym   : tsym;
         pv      : tprocvardef;
-        hs,
-        hs1 : string;
         varspez : Tvarspez;
         defaultvalue : tconstsym;
         defaultrequired : boolean;
@@ -476,14 +474,8 @@ implementation
              if parseprocvar=pv_func then
               begin
                 consume(_COLON);
-                single_type(pd.rettype,hs,false);
+                single_type(pv.rettype,false);
               end;
-             if token=_OF then
-               begin
-                 consume(_OF);
-                 consume(_OBJECT);
-                 include(pd.procoptions,po_methodpointer);
-               end;
              tt.def:=pv;
              { possible proc directives }
              if check_proc_directive(true) then
@@ -496,7 +488,6 @@ implementation
                end;
              { Add implicit hidden parameters and function result }
              handle_calling_convention(pv);
-             hs1:='procvar';
            end
           else
           { read type declaration, force reading for value and const paras }
@@ -523,7 +514,7 @@ implementation
                 else
                  begin
                    { define field type }
-                   single_type(arrayelementtype,hs1,false);
+                   single_type(arrayelementtype,false);
                    tarraydef(tt.def).setelementtype(arrayelementtype);
                  end;
               end
@@ -541,14 +532,13 @@ implementation
                  begin
                    consume(token);
                    tt:=openshortstringtype;
-                   hs1:='openstring';
                  end
                 else
                  begin
                    { everything else }
                    if (m_mac in aktmodeswitches) then
                      try_to_consume(_UNIV); {currently does nothing}
-                   single_type(tt,hs1,false);
+                   single_type(tt,false);
                  end;
 
                 if (target_info.system in [system_powerpc_morphos,system_m68k_amiga]) then
@@ -595,14 +585,7 @@ implementation
               end;
            end
           else
-           begin
-{$ifndef UseNiceNames}
-             hs1:='$$$';
-{$else UseNiceNames}
-             hs1:='var';
-{$endif UseNiceNames}
-             tt:=cformaltype;
-           end;
+           tt:=cformaltype;
 
           { File types are only allowed for var parameters }
           if (tt.def.deftype=filedef) and
@@ -876,7 +859,6 @@ implementation
     function parse_proc_dec(aclass:tobjectdef):tprocdef;
       var
         pd : tprocdef;
-        hs : string;
         isclassmethod : boolean;
       begin
         pd:=nil;
@@ -905,7 +887,7 @@ implementation
                       if try_to_consume(_COLON) then
                        begin
                          inc(testcurobject);
-                         single_type(pd.rettype,hs,false);
+                         single_type(pd.rettype,false);
                          pd.test_if_fpu_result;
                          dec(testcurobject);
                        end
@@ -1010,7 +992,7 @@ implementation
                     end
                   else
                    begin
-                     single_type(pd.rettype,hs,false);
+                     single_type(pd.rettype,false);
                      pd.test_if_fpu_result;
                      if (optoken in [_EQUAL,_GT,_LT,_GTE,_LTE]) and
                         ((pd.rettype.def.deftype<>orddef) or
@@ -2459,7 +2441,10 @@ const
 end.
 {
   $Log$
-  Revision 1.227  2005-01-31 21:27:51  peter
+  Revision 1.228  2005-02-01 08:46:13  michael
+   * Patch from peter: fix macpas anonymous function procvar
+
+  Revision 1.227  2005/01/31 21:27:51  peter
     * macpas procvars in parameters
 
   Revision 1.226  2005/01/19 22:19:41  peter

compiler/pdecvar.pas

@@ -204,9 +204,7 @@ implementation
          sym : tsym;
          p : tpropertysym;
          overriden : tsym;
-         hs : string;
          varspez : tvarspez;
-         s : string;
          tt : ttype;
          arraytype : ttype;
          def : tdef;
@@ -300,11 +298,11 @@ implementation
                         { define range and type of range }
                         tt.setdef(tarraydef.create(0,-1,s32inttype));
                         { define field type }
-                        single_type(arraytype,s,false);
+                        single_type(arraytype,false);
                         tarraydef(tt.def).setelementtype(arraytype);
                       end
                     else
-                      single_type(tt,s,false);
+                      single_type(tt,false);
                     symtablestack:=oldsymtablestack;
                   end
                 else
@@ -339,7 +337,7 @@ implementation
               oldsymtablestack:=symtablestack;
               while not(symtablestack.symtabletype in [globalsymtable,staticsymtable]) do
                 symtablestack:=symtablestack.next;
-              single_type(p.proptype,hs,false);
+              single_type(p.proptype,false);
               symtablestack:=oldsymtablestack;
               if (idtoken=_INDEX) then
                 begin
@@ -1314,7 +1312,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.92  2005-01-30 17:17:19  florian
+  Revision 1.93  2005-02-01 08:46:13  michael
+   * Patch from peter: fix macpas anonymous function procvar
+
+  Revision 1.92  2005/01/30 17:17:19  florian
     * variables exported by $J/$Z in macpas mode are never regable
 
   Revision 1.91  2005/01/06 13:30:41  florian

compiler/ptype.pas

@@ -41,14 +41,14 @@ interface
 
     { reads a string, file type or a type id and returns a name and }
     { tdef }
-    procedure single_type(var tt:ttype;var s : string;isforwarddef:boolean);
+    procedure single_type(var tt:ttype;isforwarddef:boolean);
 
     procedure read_type(var tt:ttype;const name : stringid;parseprocvardir:boolean);
 
     { reads a type definition }
     { to a appropriating tdef, s gets the name of   }
     { the type to allow name mangling          }
-    procedure id_type(var tt : ttype;var s : string;isforwarddef:boolean);
+    procedure id_type(var tt : ttype;isforwarddef:boolean);
 
 
 implementation
@@ -72,7 +72,7 @@ implementation
        pbase,pexpr,pdecsub,pdecvar,pdecobj;
 
 
-    procedure id_type(var tt : ttype;var s : string;isforwarddef:boolean);
+    procedure id_type(var tt : ttype;isforwarddef:boolean);
     { reads a type definition }
     { to a appropriating tdef, s gets the name of   }
     { the type to allow name mangling          }
@@ -81,7 +81,7 @@ implementation
         pos : tfileposinfo;
         srsym : tsym;
         srsymtable : tsymtable;
-        sorg : stringid;
+        s,sorg : stringid;
       begin
          s:=pattern;
          sorg:=orgpattern;
@@ -182,43 +182,30 @@ implementation
       end;
 
 
-    procedure single_type(var tt:ttype;var s : string;isforwarddef:boolean);
-    { reads a string, file type or a type id and returns a name and }
-    { tdef                                                        }
+    procedure single_type(var tt:ttype;isforwarddef:boolean);
        var
-          hs : string;
-          t2 : ttype;
+         t2 : ttype;
        begin
           case token of
             _STRING:
-                begin
-                   string_dec(tt);
-                   s:='STRING';
-                end;
+              string_dec(tt);
             _FILE:
-                begin
-                   consume(_FILE);
-                   if token=_OF then
-                     begin
-                        consume(_OF);
-                        single_type(t2,hs,false);
-                        tt.setdef(tfiledef.createtyped(t2));
-                        s:='FILE$OF$'+hs;
-                     end
-                   else
-                     begin
-                        tt:=cfiletype;
-                        s:='FILE';
-                     end;
-                end;
-            _ID:
               begin
-                id_type(tt,s,isforwarddef);
+                 consume(_FILE);
+                 if token=_OF then
+                   begin
+                      consume(_OF);
+                      single_type(t2,false);
+                      tt.setdef(tfiledef.createtyped(t2));
+                   end
+                 else
+                   tt:=cfiletype;
               end;
+            _ID:
+              id_type(tt,isforwarddef);
             else
               begin
                 message(type_e_type_id_expected);
-                s:='<unknown>';
                 tt:=generrortype;
               end;
          end;
@@ -489,7 +476,7 @@ implementation
          case token of
             _STRING,_FILE:
               begin
-                single_type(tt,hs,false);
+                single_type(tt,false);
               end;
            _LKLAMMER:
               begin
@@ -591,7 +578,7 @@ implementation
            _CARET:
               begin
                 consume(_CARET);
-                single_type(tt2,hs,typecanbeforward);
+                single_type(tt2,typecanbeforward);
                 tt.setdef(tpointerdef.create(tt2));
               end;
             _RECORD:
@@ -632,7 +619,7 @@ implementation
                 if is_func then
                  begin
                    consume(_COLON);
-                   single_type(pd.rettype,hs,false);
+                   single_type(pd.rettype,false);
                  end;
                 if token=_OF then
                   begin
@@ -666,7 +653,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.73  2005-01-19 22:19:41  peter
+  Revision 1.74  2005-02-01 08:46:13  michael
+   * Patch from peter: fix macpas anonymous function procvar
+
+  Revision 1.73  2005/01/19 22:19:41  peter
     * unit mapping rewrite
     * new derefmap added
 

compiler/symdef.pas

@@ -498,6 +498,7 @@ interface
           function  is_publishable : boolean;override;
           function  is_methodpointer:boolean;override;
           function  is_addressonly:boolean;override;
+          function  getmangledparaname:string;override;
           { debug }
 {$ifdef GDB}
           function stabstring : pchar;override;
@@ -4708,6 +4709,12 @@ implementation
       end;
 
 
+    function tprocvardef.getmangledparaname:string;
+      begin
+        result:='procvar';
+      end;
+
+
 {$ifdef GDB}
     function tprocvardef.stabstring : pchar;
       var
@@ -6371,7 +6378,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.292  2005-01-30 11:26:40  peter
+  Revision 1.293  2005-02-01 08:46:13  michael
+   * Patch from peter: fix macpas anonymous function procvar
+
+  Revision 1.292  2005/01/30 11:26:40  peter
     * add info that a procedure is local in error messages
 
   Revision 1.291  2005/01/24 22:08:32  peter