Prechádzať zdrojové kódy

+ merged nestedprocvars branch
+ support for nested procedural variables:
o activate using {$modeswitch nestedprocvars} (compatible with all
regular syntax modes, enabled by default for MacPas mode)
o activating this mode switch changes the way the frame pointer is
passed to nested routines into the same way that Delphi uses (always
passed via the stack, and if necessary removed from the stack by
the caller) -- Todo: possibly also allow using this parameter
passing convention without enabling nested procvars, maybe even
by default in Delphi mode, see mantis #9432
o both global and nested routines can be passed to/assigned to a
nested procvar (and called via them). Note that converting global
*procvars* to nested procvars is intentionally not supported, so
that this functionality can also be implemented via compile-time
generated trampolines if necessary (e.g. for LLVM or CIL backends
as long as they don't support the aforementioned parameter passing
convention)
o a nested procvar can both be declared using a Mac/ISO Pascal style
"inline" type declaration as a parameter type, or as a stand-alone
type (in the latter case, add "is nested" at the end in analogy to
"of object" for method pointers -- note that using variables of
such a type is dangerous, because if you call them once the enclosing
stack frame no longer exists on the stack, the results are
undefined; this is however allowed for Metaware Pascal compatibility)

git-svn-id: trunk@15694 -

Jonas Maebe 15 rokov pred
rodič
commit
57bd6d2685
60 zmenil súbory, kde vykonal 1717 pridanie a 495 odobranie
  1. 25 1
      .gitattributes
  2. 6 2
      compiler/arm/cpupara.pas
  3. 5 1
      compiler/avr/cpupara.pas
  4. 1 1
      compiler/dbgdwarf.pas
  5. 56 8
      compiler/defcmp.pas
  6. 12 2
      compiler/defutil.pas
  7. 1 1
      compiler/globals.pas
  8. 4 2
      compiler/globtype.pas
  9. 17 11
      compiler/htypechk.pas
  10. 8 5
      compiler/i386/cpupara.pas
  11. 6 2
      compiler/mips/cpupara.pas
  12. 9 2
      compiler/msg/errore.msg
  13. 3 2
      compiler/msgidx.inc
  14. 364 359
      compiler/msgtxt.inc
  15. 17 17
      compiler/ncal.pas
  16. 6 2
      compiler/ncgcal.pas
  17. 22 1
      compiler/ncgcnv.pas
  18. 8 1
      compiler/ncgutil.pas
  19. 81 33
      compiler/ncnv.pas
  20. 22 4
      compiler/nld.pas
  21. 4 3
      compiler/nmem.pas
  22. 3 1
      compiler/nutils.pas
  23. 1 1
      compiler/paramgr.pas
  24. 19 4
      compiler/pdecsub.pas
  25. 5 1
      compiler/powerpc/cpupara.pas
  26. 6 1
      compiler/powerpc64/cpupara.pas
  27. 6 2
      compiler/pp.lpi
  28. 1 1
      compiler/ppu.pas
  29. 11 2
      compiler/ptconst.pas
  30. 8 2
      compiler/ptype.pas
  31. 6 2
      compiler/sparc/cpupara.pas
  32. 16 7
      compiler/symconst.pas
  33. 36 10
      compiler/symdef.pas
  34. 1 1
      compiler/symsym.pas
  35. 2 0
      compiler/tokens.pas
  36. 0 0
      tests/test/tmaclocalprocparam1.pp
  37. 46 0
      tests/test/tmaclocalprocparam1a.pp
  38. 49 0
      tests/test/tmaclocalprocparam2.pp
  39. 51 0
      tests/test/tmaclocalprocparam2a.pp
  40. 50 0
      tests/test/tmaclocalprocparam2b.pp
  41. 52 0
      tests/test/tmaclocalprocparam2c.pp
  42. 54 0
      tests/test/tmaclocalprocparam2d.pp
  43. 53 0
      tests/test/tmaclocalprocparam2e.pp
  44. 61 0
      tests/test/tmaclocalprocparam2f.pp
  45. 43 0
      tests/test/tmaclocalprocparam3.pp
  46. 43 0
      tests/test/tmaclocalprocparam3a.pp
  47. 44 0
      tests/test/tmaclocalprocparam3b.pp
  48. 53 0
      tests/test/tmaclocalprocparam3c.pp
  49. 53 0
      tests/test/tmaclocalprocparam3d.pp
  50. 54 0
      tests/test/tmaclocalprocparam3e.pp
  51. 62 0
      tests/test/tmaclocalprocparam3f.pp
  52. 19 0
      tests/test/tmaclocalprocparam4.pp
  53. 17 0
      tests/test/tmaclocalprocparam4a.pp
  54. 14 0
      tests/test/tmaclocalprocparam4b.pp
  55. 21 0
      tests/test/tmaclocalprocparam4c.pp
  56. 21 0
      tests/test/tmaclocalprocparam4d.pp
  57. 14 0
      tests/test/tmaclocalprocparam4e.pp
  58. 21 0
      tests/test/tmaclocalprocparam4f.pp
  59. 11 0
      tests/test/tmaclocalprocparam4g.pp
  60. 13 0
      tests/test/umaclocalprocparam3f.pp

+ 25 - 1
.gitattributes

@@ -9244,7 +9244,30 @@ tests/test/tlibrary2.pp svneol=native#text/plain
 tests/test/tlibrary3.pp svneol=native#text/plain
 tests/test/tmacbool.pp svneol=native#text/plain
 tests/test/tmacfunret.pp svneol=native#text/plain
-tests/test/tmaclocalprocparam.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam1.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam1a.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam2.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam2a.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam2b.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam2c.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam2d.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam2e.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam2f.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam3.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam3a.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam3b.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam3c.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam3d.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam3e.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam3f.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam4.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam4a.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam4b.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam4c.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam4d.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam4e.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam4f.pp svneol=native#text/plain
+tests/test/tmaclocalprocparam4g.pp svneol=native#text/plain
 tests/test/tmacnonlocalexit.pp svneol=native#text/plain
 tests/test/tmacnonlocalgoto.pp svneol=native#text/plain
 tests/test/tmacpas1.pp svneol=native#text/plain
@@ -9535,6 +9558,7 @@ tests/test/uimpluni1.pp svneol=native#text/plain
 tests/test/uimpluni2.pp svneol=native#text/plain
 tests/test/uinline4a.pp svneol=native#text/plain
 tests/test/uinline4b.pp svneol=native#text/plain
+tests/test/umaclocalprocparam3f.pp svneol=native#text/plain
 tests/test/umacpas1.pp svneol=native#text/plain
 tests/test/umainnam.pp svneol=native#text/plain
 tests/test/units/classes/tmakeobjinst.pp svneol=native#text/plain

+ 6 - 2
compiler/arm/cpupara.pas

@@ -203,7 +203,7 @@ unit cpupara;
           recorddef:
             result:=def.size>4;
           procvardef:
-            if (po_methodpointer in tprocvardef(def).procoptions) then
+            if not tprocvardef(def).is_addressonly then
               result:=true
             else
               result:=false
@@ -239,7 +239,11 @@ unit cpupara;
 
       procedure assignintreg;
         begin
-           if nextintreg<=RS_R3 then
+          { In case of po_delphi_nested_cc, the parent frame pointer
+            is always passed on the stack. }
+           if (nextintreg<=RS_R3) and
+              (not(vo_is_parentfp in hp.varoptions) or
+               not(po_delphi_nested_cc in p.procoptions)) then
              begin
                paraloc^.loc:=LOC_REGISTER;
                paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE);

+ 5 - 1
compiler/avr/cpupara.pas

@@ -226,7 +226,11 @@ unit cpupara;
 
       procedure assignintreg;
         begin
-           if nextintreg<=RS_R3 then
+          { In case of po_delphi_nested_cc, the parent frame pointer
+            is always passed on the stack. }
+           if (nextintreg<=RS_R3) and
+              (not(vo_is_parentfp in hp.varoptions) or
+               not(po_delphi_nested_cc in p.procoptions)) then
              begin
                paraloc^.loc:=LOC_REGISTER;
                paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE);

+ 1 - 1
compiler/dbgdwarf.pas

@@ -1781,7 +1781,7 @@ implementation
         proc : tasmlabel;
 
       begin
-        if def.is_methodpointer then
+        if not def.is_addressonly then
           begin
             { create a structure with two elements }
             if not(tf_dwarf_only_local_labels in target_info.flags) then

+ 56 - 8
compiler/defcmp.pas

@@ -42,7 +42,8 @@ interface
           cpo_openequalisexact,
           cpo_ignoreuniv,
           cpo_warn_incompatible_univ,
-          cpo_ignorevarspez           // ignore parameter access type
+          cpo_ignorevarspez,          // ignore parameter access type
+          cpo_ignoreframepointer      // ignore frame pointer parameter (for assignment-compatibility of global procedures to nested procvars)
        );
 
        tcompare_paras_options = set of tcompare_paras_option;
@@ -1100,7 +1101,7 @@ implementation
                  procvardef :
                    begin
                      { procedure variable can be assigned to an void pointer,
-                       this not allowed for methodpointers }
+                       this is not allowed for complex procvars }
                      if (is_void(tpointerdef(def_to).pointeddef) or
                          (m_mac_procvar in current_settings.modeswitches)) and
                         tprocvardef(def_from).is_addressonly then
@@ -1203,7 +1204,10 @@ implementation
                         if subeq>te_incompatible then
                          begin
                            doconv:=tc_proc_2_procvar;
-                           eq:=te_convert_l1;
+                           if subeq>te_convert_l5 then
+                             eq:=pred(subeq)
+                           else
+                             eq:=subeq;
                          end;
                       end;
                    end;
@@ -1605,6 +1609,15 @@ implementation
                    (vo_is_hidden_para in tparavarsym(para2[i2]).varoptions) do
                inc(i2);
            end;
+         if cpo_ignoreframepointer in cpoptions then
+           begin
+             if (i1<para1.count) and
+                (vo_is_parentfp in tparavarsym(para1[i1]).varoptions) then
+               inc(i1);
+             if (i2<para2.count) and
+                (vo_is_parentfp in tparavarsym(para2[i2]).varoptions) then
+               inc(i2);
+           end;
          while (i1<para1.count) and (i2<para2.count) do
            begin
              eq:=te_incompatible;
@@ -1748,6 +1761,15 @@ implementation
                         (vo_is_hidden_para in tparavarsym(para2[i2]).varoptions) do
                     inc(i2);
                 end;
+              if cpo_ignoreframepointer in cpoptions then
+                begin
+                  if (i1<para1.count) and
+                     (vo_is_parentfp in tparavarsym(para1[i1]).varoptions) then
+                    inc(i1);
+                  if (i2<para2.count) and
+                     (vo_is_parentfp in tparavarsym(para2[i2]).varoptions) then
+                    inc(i2);
+                end;
            end;
          { when both lists are empty then the parameters are equal. Also
            when one list is empty and the other has a parameter with default
@@ -1760,7 +1782,7 @@ implementation
       end;
 
 
-    function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef; checkincompatibleuniv: boolean):tequaltype;
+    function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef;checkincompatibleuniv: boolean):tequaltype;
       var
         eq : tequaltype;
         po_comp : tprocoptions;
@@ -1769,11 +1791,31 @@ implementation
          proc_to_procvar_equal:=te_incompatible;
          if not(assigned(def1)) or not(assigned(def2)) then
            exit;
-         { check for method pointer }
-         if (def1.is_methodpointer xor def2.is_methodpointer) or
-            (def1.is_addressonly xor def2.is_addressonly) then
+         { check for method pointer and local procedure pointer:
+             a) if one is a procedure of object, the other also has to be one
+             b) if one is a pure address, the other also has to be one
+                except if def1 is a global proc and def2 is a nested procdef
+                (global procedures can be converted into nested procvars)
+             c) if def1 is a nested procedure, then def2 has to be a nested
+                procvar and def1 has to have the po_delphi_nested_cc option
+             d) if def1 is a procvar, def1 and def2 both have to be nested or
+                non-nested (we don't allow assignments from non-nested to
+                nested procvars to make sure that we can still implement
+                nested procvars using trampolines -- e.g., this would be
+                necessary for LLVM or CIL as long as they do not have support
+                for Delphi-style frame pointer parameter passing) }
+         if (def1.is_methodpointer<>def2.is_methodpointer) or  { a) }
+            ((def1.is_addressonly<>def2.is_addressonly) and    { b) }
+             (is_nested_pd(def1) or
+              not is_nested_pd(def2))) or
+            ((def1.typ=procdef) and                            { c) }
+             is_nested_pd(def1) and
+             (not(po_delphi_nested_cc in def1.procoptions) or
+              not is_nested_pd(def2))) or
+            ((def1.typ=procvardef) and                         { d) }
+             (is_nested_pd(def1)<>is_nested_pd(def2))) then
            exit;
-         pa_comp:=[];
+         pa_comp:=[cpo_ignoreframepointer];
          if checkincompatibleuniv then
            include(pa_comp,cpo_warn_incompatible_univ);
          { check return value and options, methodpointer is already checked }
@@ -1791,6 +1833,12 @@ implementation
             eq:=compare_paras(def1.paras,def2.paras,cp_procvar,pa_comp);
             if eq=te_exact then
              eq:=te_equal;
+            if (eq=te_equal) then
+              begin
+                { prefer non-nested to non-nested over non-nested to nested }
+                if (is_nested_pd(def1)<>is_nested_pd(def2)) then
+                  eq:=te_convert_l1;
+              end;
             proc_to_procvar_equal:=eq;
           end;
       end;

+ 12 - 2
compiler/defutil.pas

@@ -261,6 +261,10 @@ interface
         (basically: it must have a compile-time size) }
     function is_valid_univ_para_type(def: tdef): boolean;
 
+    { # returns whether the procdef/procvardef represents a nested procedure
+        or not }
+    function is_nested_pd(def: tabstractprocdef): boolean;{$ifdef USEINLINE}inline;{$endif}
+
 implementation
 
     uses
@@ -976,8 +980,7 @@ implementation
             result := OS_ADDR;
           procvardef:
             begin
-              if tprocvardef(def).is_methodpointer and
-                 (not tprocvardef(def).is_addressonly) then
+              if not tprocvardef(def).is_addressonly then
                 {$if sizeof(pint) = 4}
                   result:=OS_64
                 {$else} {$if sizeof(pint) = 8}
@@ -1129,4 +1132,11 @@ implementation
           (def.typ<>formaldef);
       end;
 
+
+    function is_nested_pd(def: tabstractprocdef): boolean;{$ifdef USEINLINE}inline;{$endif}
+      begin
+        result:=def.parast.symtablelevel>normal_function_level;
+      end;
+
+
 end.

+ 1 - 1
compiler/globals.pas

@@ -68,7 +68,7 @@ interface
          [m_gpc,m_all,m_tp_procvar];
 {$endif}
        macmodeswitches =
-         [m_mac,m_all,m_result,m_cvar_support,m_mac_procvar];
+         [m_mac,m_all,m_result,m_cvar_support,m_mac_procvar,m_nested_procvars];
        isomodeswitches =
          [m_iso,m_all,m_tp_procvar,m_duplicate_names];
 

+ 4 - 2
compiler/globtype.pas

@@ -271,7 +271,8 @@ interface
          m_default_inline,      { allow inline proc directive }
          m_except,              { allow exception-related keywords }
          m_objectivec1,         { support interfacing with Objective-C (1.0) }
-         m_objectivec2          { support interfacing with Objective-C (2.0) }
+         m_objectivec2,         { support interfacing with Objective-C (2.0) }
+         m_nested_procvars      { support nested procedural variables }
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -389,7 +390,8 @@ interface
          'ALLOWINLINE',
          'EXCEPTIONS',
          'OBJECTIVEC1',
-         'OBJECTIVEC2');
+         'OBJECTIVEC2',
+         'NESTEDPROCVARS');
 
 
      type

+ 17 - 11
compiler/htypechk.pas

@@ -138,7 +138,7 @@ interface
     procedure make_not_regable(p : tnode; how: tregableinfoflags);
 
     { procvar handling }
-    function  is_procvar_load(p:tnode):boolean;
+    function  is_proc2procvar_load(p:tnode;out realprocdef:tprocdef):boolean;
     procedure test_local_to_procvar(from_def:tprocvardef;to_def:tdef);
 
     { sets varsym varstate field correctly }
@@ -774,7 +774,7 @@ implementation
                           Subroutine Handling
 ****************************************************************************}
 
-    function is_procvar_load(p:tnode):boolean;
+    function is_proc2procvar_load(p:tnode;out realprocdef:tprocdef):boolean;
       begin
         result:=false;
         { remove voidpointer typecast for tp procvars }
@@ -785,13 +785,16 @@ implementation
           p:=tunarynode(p).left;
         result:=(p.nodetype=typeconvn) and
                 (ttypeconvnode(p).convtype=tc_proc_2_procvar);
+        if result then
+          realprocdef:=tprocdef(ttypeconvnode(p).left.resultdef);
       end;
 
 
     { local routines can't be assigned to procvars }
     procedure test_local_to_procvar(from_def:tprocvardef;to_def:tdef);
       begin
-         if (from_def.parast.symtablelevel>normal_function_level) and
+         if not(m_nested_procvars in current_settings.modeswitches) and
+            (from_def.parast.symtablelevel>normal_function_level) and
             (to_def.typ=procvardef) then
            CGMessage(type_e_cannot_local_proc_to_procvar);
       end;
@@ -1545,6 +1548,7 @@ implementation
     procedure para_allowed(var eq:tequaltype;p:tcallparanode;def_to:tdef);
       var
         acn: tarrayconstructornode;
+        realprocdef: tprocdef;
         tmpeq: tequaltype;
       begin
         { Note: eq must be already valid, it will only be updated! }
@@ -1586,16 +1590,18 @@ implementation
             end;
           procvardef :
             begin
-              { in tp7 mode proc -> procvar is allowed }
+              tmpeq:=te_incompatible;
+              { in tp/macpas mode proc -> procvar is allowed }
               if ((m_tp_procvar in current_settings.modeswitches) or
                   (m_mac_procvar in current_settings.modeswitches)) and
-                 (p.left.nodetype=calln) and
-                 (proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def_to),false)>=te_equal) then
-                eq:=te_equal
-              else
-                if (m_mac_procvar in current_settings.modeswitches) and
-                   is_procvar_load(p.left) then
-                  eq:=te_convert_l2;
+                 (p.left.nodetype=calln) then
+                tmpeq:=proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def_to),false);
+              if (tmpeq=te_incompatible) and
+                 (m_nested_procvars in current_settings.modeswitches) and
+                 is_proc2procvar_load(p.left,realprocdef) then
+                tmpeq:=proc_to_procvar_equal(realprocdef,tprocvardef(def_to),false);
+              if tmpeq<>te_incompatible then
+                eq:=tmpeq;
             end;
           arraydef :
             begin

+ 8 - 5
compiler/i386/cpupara.pas

@@ -214,7 +214,7 @@ unit cpupara;
           stringdef :
             result:= (tstringdef(def).stringtype in [st_shortstring,st_longstring]);
           procvardef :
-            result:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and (po_methodpointer in tprocvardef(def).procoptions);
+            result:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and not tprocvardef(def).is_addressonly;
           setdef :
             result:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and (not is_smallset(def));
         end;
@@ -598,13 +598,16 @@ unit cpupara;
 
                       64bit values,floats,arrays and records are always
                       on the stack.
+
+                      In case of po_delphi_nested_cc, the parent frame pointer
+                      is also always passed on the stack.
                     }
                     if (parareg<=high(parasupregs)) and
                        (paralen<=sizeof(aint)) and
-                       (
-                        not(hp.vardef.typ in [floatdef,recorddef,arraydef]) or
-                        pushaddr
-                       ) then
+                       (not(hp.vardef.typ in [floatdef,recorddef,arraydef]) or
+                        pushaddr) and
+                       (not(vo_is_parentfp in hp.varoptions) or
+                        not(po_delphi_nested_cc in p.procoptions)) then
                       begin
                         if pass=1 then
                           begin

+ 6 - 2
compiler/mips/cpupara.pas

@@ -127,7 +127,7 @@ implementation
           stringdef :
             result:=(tstringdef(def).stringtype in [st_shortstring,st_longstring]);
           procvardef :
-            result:=(po_methodpointer in tprocvardef(def).procoptions);
+            result:=not tprocvardef(def).is_addressonly;
           setdef :
             result:=not(is_smallset(def));
         end;
@@ -297,7 +297,11 @@ implementation
                     end;
                     inc(parasize,align(tcgsize2size[paraloc^.size],sizeof(aint)));
                   end
-                else if (intparareg<=high(tparasupregs)) then
+                { In case of po_delphi_nested_cc, the parent frame pointer
+                  is always passed on the stack. }
+                else if (intparareg<=high(tparasupregs)) and
+                   (not(vo_is_parentfp in hp.varoptions) or
+                    not(po_delphi_nested_cc in p.procoptions)) then
                   begin
                     paraloc^.loc:=LOC_REGISTER;
                     paraloc^.register:=newreg(R_INTREGISTER,hparasupregs^[intparareg],R_SUBWHOLE);

+ 9 - 2
compiler/msg/errore.msg

@@ -368,7 +368,7 @@ scanner_w_illegal_warn_identifier=02087_W_Illegal identifier "$1" for $WARN dire
 #
 # Parser
 #
-# 03295 is the last used one
+# 03296 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -950,7 +950,7 @@ parser_w_proc_overriding_calling=03182_W_Overriding calling convention "$1" with
 % There are two directives in the procedure declaration that specify a calling
 % convention. Only the last directive will be used.
 parser_e_no_procvarobj_const=03183_E_Typed constants of the type "procedure of object" can only be initialized with NIL
-% You can't assign the address of a method to a typed constant which has a
+% You cannot assign the address of a method to a typed constant which has a
 % 'procedure of object' type, because such a constant requires two addresses:
 % that of the method (which is known at compile time) and that of the object or
 % class instance it operates on (which cannot be known at compile time).
@@ -1325,6 +1325,13 @@ parser_e_objc_missing_enumeration_defs=03295_E_The compiler cannot find the NSFa
 % NSFastEnumerationProtocol and NSFastEnumerationState types. If you get this
 % error, most likely the compiler is finding and loading an alternate CocoaAll
 % unit.
+parser_e_no_procvarnested_const=03296_E_Typed constants of the type 'procedure is nested' can only be initialized with NIL and global procedures/functions
+% A nested procedural variable consists of two components: the address of the
+% procedure/function to call (which is always known at compile time), and also
+% a parent frame pointer (which is never known at compile time) in case the
+% procedural variable contains a reference to a nested procedure/function.
+% Therefore such typed constants can only be initialized with global
+% functions/procedures since these do not require a parent frame pointer.
 % \end{description}
 #
 # Type Checking

+ 3 - 2
compiler/msgidx.inc

@@ -384,6 +384,7 @@ const
   parser_e_widestring_to_ansi_compile_time=03293;
   parser_e_objc_enumerator_2_0=03294;
   parser_e_objc_missing_enumeration_defs=03295;
+  parser_e_no_procvarnested_const=03296;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -863,9 +864,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 56778;
+  MsgTxtSize = 56901;
 
   MsgIdxMax : array[1..20] of longint=(
-    24,88,296,96,81,51,110,22,202,63,
+    24,88,297,96,81,51,110,22,202,63,
     49,20,1,1,1,1,1,1,1,1
   );

+ 364 - 359
compiler/msgtxt.inc

@@ -1,7 +1,7 @@
 {$ifdef Delphi}
-const msgtxt : array[0..000236] of string[240]=(
+const msgtxt : array[0..000237] of string[240]=(
 {$else Delphi}
-const msgtxt : array[0..000236,1..240] of char=(
+const msgtxt : array[0..000237,1..240] of char=(
 {$endif Delphi}
   '01000_T_Compiler: $1'#000+
   '01001_D_Compiler OS: $1'#000+
@@ -461,567 +461,571 @@ const msgtxt : array[0..000236,1..240] of char=(
   'C2\} to be',' active'#000+
   '03295_E_The compiler cannot find the NSFastEnumerationProtocol or NSFa'+
   'stEnumerationState type in the CocoaAll unit'#000+
+  '03296_E_Typed constants of the type '#039'procedure is nested'#039' can '+
+  'only be initialized with NIL and global procedures/func','tions'#000+
   '04000_E_Type mismatch'#000+
   '04001_E_Incompatible types: got "$1" expected "$2"'#000+
-  '04002_E_Type mismatch between "$1" and "$2"'#000,
+  '04002_E_Type mismatch between "$1" and "$2"'#000+
   '04003_E_Type identifier expected'#000+
   '04004_E_Variable identifier expected'#000+
-  '04005_E_Integer expression expected, but got "$1"'#000+
+  '04005_E_Integer expression expected, but got "$','1"'#000+
   '04006_E_Boolean expression expected, but got "$1"'#000+
   '04007_E_Ordinal expression expected'#000+
-  '04008_E_pointer type expected, but',' got "$1"'#000+
+  '04008_E_pointer type expected, but got "$1"'#000+
   '04009_E_class type expected, but got "$1"'#000+
   '04011_E_Can'#039't evaluate constant expression'#000+
-  '04012_E_Set elements are not compatible'#000+
+  '04012_E_Set elements a','re not compatible'#000+
   '04013_E_Operation not implemented for sets'#000+
-  '04014_W_Automatic type conversion from floating type to COMP w','hich i'+
-  's an integer type'#000+
+  '04014_W_Automatic type conversion from floating type to COMP which is '+
+  'an integer type'#000+
   '04015_H_use DIV instead to get an integer result'#000+
-  '04016_E_String types have to match exactly in $V+ mode'#000+
+  '04016_E_String types have to match exactly i','n $V+ mode'#000+
   '04017_E_succ or pred on enums with assignments not possible'#000+
   '04018_E_Can'#039't read or write variables of this type'#000+
-  '0','4019_E_Can'#039't use readln or writeln on typed file'#000+
+  '04019_E_Can'#039't use readln or writeln on typed file'#000+
   '04020_E_Can'#039't use read or write on untyped file.'#000+
-  '04021_E_Type conflict between set elements'#000+
+  '04021_E_Type confli','ct between set elements'#000+
   '04022_W_lo/hi(dword/qword) returns the upper/lower word/dword'#000+
-  '04023_E_Integer or real expression ex','pected'#000+
+  '04023_E_Integer or real expression expected'#000+
   '04024_E_Wrong type "$1" in array constructor'#000+
-  '04025_E_Incompatible type for arg no. $1: Got "$2", expected "$3"'#000+
+  '04025_E_Incompatible type for arg no. $1: Got "$2", expected "$3"',#000+
   '04026_E_Method (variable) and Procedure (variable) are not compatible'#000+
-  '04027_E_Illegal constant passed to internal math fun','ction'#000+
+  '04027_E_Illegal constant passed to internal math function'#000+
   '04028_E_Can'#039't take the address of constant expressions'#000+
   '04029_E_Argument can'#039't be assigned to'#000+
-  '04030_E_Can'#039't assign local procedure/function to procedure variabl'+
-  'e'#000+
+  '04030_E_Can'#039't assi','gn local procedure/function to procedure varia'+
+  'ble'#000+
   '04031_E_Can'#039't assign values to an address'#000+
-  '04032_E_Can'#039't assign values to ','const variable'#000+
+  '04032_E_Can'#039't assign values to const variable'#000+
   '04033_E_Array type required'#000+
   '04034_E_interface type expected, but got "$1"'#000+
-  '04035_H_Mixing signed expressions and longwords gives a 64bit result'#000+
+  '04035_H_Mixing signed expres','sions and longwords gives a 64bit result'+
+  #000+
   '04036_W_Mixing signed expressions and cardinals here may cause a range'+
-  ' check error',#000+
+  ' check error'#000+
   '04037_E_Typecast has different size ($1 -> $2) in assignment'#000+
-  '04038_E_enums with assignments can'#039't be used as array index'#000+
+  '04038_E_enums with assignments can'#039't be used as array i','ndex'#000+
   '04039_E_Class or Object types "$1" and "$2" are not related'#000+
   '04040_W_Class types "$1" and "$2" are not related'#000+
-  '04041_E_','Class or interface type expected, but got "$1"'#000+
+  '04041_E_Class or interface type expected, but got "$1"'#000+
   '04042_E_Type "$1" is not completely defined'#000+
-  '04043_W_String literal has more characters than short string length'#000+
+  '04043_W_String literal has',' more characters than short string length'#000+
   '04044_W_Comparison is always false due to range of values'#000+
-  '04045_W_Comparison is a','lways true due to range of values'#000+
+  '04045_W_Comparison is always true due to range of values'#000+
   '04046_W_Constructing a class "$1" with abstract method "$2"'#000+
-  '04047_H_The left operand of the IN operator should be byte sized'#000+
+  '04047_H_The left operan','d of the IN operator should be byte sized'#000+
   '04048_W_Type size mismatch, possible loss of data / range check error'#000+
-  '04049_H_Typ','e size mismatch, possible loss of data / range check erro'+
-  'r'#000+
+  '04049_H_Type size mismatch, possible loss of data / range check error'#000+
   '04050_E_The address of an abstract method can'#039't be taken'#000+
-  '04051_E_Assignments to formal parameters and open arrays are not possi'+
-  'ble'#000+
+  '0','4051_E_Assignments to formal parameters and open arrays are not pos'+
+  'sible'#000+
   '04052_E_Constant Expression expected'#000+
-  '04053_E_Opera','tion "$1" not supported for types "$2" and "$3"'#000+
+  '04053_E_Operation "$1" not supported for types "$2" and "$3"'#000+
   '04054_E_Illegal type conversion: "$1" to "$2"'#000+
-  '04055_H_Conversion between ordinals and pointers is not portable'#000+
+  '04055_H_Conversion betw','een ordinals and pointers is not portable'#000+
   '04056_W_Conversion between ordinals and pointers is not portable'#000+
-  '04057_E_Can'#039't de','termine which overloaded function to call'#000+
+  '04057_E_Can'#039't determine which overloaded function to call'#000+
   '04058_E_Illegal counter variable'#000+
-  '04059_W_Converting constant real value to double for C variable argume'+
-  'nt, add explicit typecast to prevent this.'#000+
-  '04060_E_Class or COM interface type expected, but go','t "$1"'#000+
+  '04059_W_Converting constant real value to ','double for C variable argu'+
+  'ment, add explicit typecast to prevent this.'#000+
+  '04060_E_Class or COM interface type expected, but got "$1"'#000+
   '04061_E_Constant packed arrays are not yet supported'#000+
-  '04062_E_Incompatible type for arg no. $1: Got "$2" expected "(Bit)Pack'+
-  'ed Array"'#000+
+  '04062_E_Incompatible type for arg no. $1: Got "$2" expect','ed "(Bit)Pa'+
+  'cked Array"'#000+
   '04063_E_Incompatible type for arg no. $1: Got "$2" expected "(not pack'+
   'ed) Array"'#000+
-  '04064_E_Elements of',' packed arrays cannot be of a type which need to '+
-  'be initialised'#000+
-  '04065_E_Constant packed records and objects are not yet supported'#000+
+  '04064_E_Elements of packed arrays cannot be of a type which need to be'+
+  ' initialised'#000+
+  '04065_E_Constant packed records and objects are not y','et supported'#000+
   '04066_W_Arithmetic "$1" on untyped pointer is unportable to {$T+}, sug'+
   'gest typecast'#000+
-  '04076_E_Can'#039't take address',' of a subroutine marked as local'#000+
+  '04076_E_Can'#039't take address of a subroutine marked as local'#000+
   '04077_E_Can'#039't export subroutine marked as local from a unit'#000+
-  '04078_E_Type is not automatable: "$1"'#000+
+  '04078_E_Type is not auto','matable: "$1"'#000+
   '04079_H_Converting the operands to "$1" before doing the add could pre'+
   'vent overflow errors.'#000+
-  '04080_H_Convertin','g the operands to "$1" before doing the subtract co'+
-  'uld prevent overflow errors.'#000+
-  '04081_H_Converting the operands to "$1" before doing the multiply coul'+
+  '04080_H_Converting the operands to "$1" before doing the subtract coul'+
   'd prevent overflow errors.'#000+
-  '04082_W_Converting pointers to signed integers may result in wr','ong c'+
-  'omparison results and range errors, use an unsigned type instead.'#000+
+  '04081_H_Converting the operands to "$','1" before doing the multiply co'+
+  'uld prevent overflow errors.'#000+
+  '04082_W_Converting pointers to signed integers may result in wrong com'+
+  'parison results and range errors, use an unsigned type instead.'#000+
   '04083_E_Interface type $1 has no valid GUID'#000+
-  '04084_E_Invalid selector name "$1"'#000+
+  '04','084_E_Invalid selector name "$1"'#000+
   '04085_E_Expected Objective-C method, but got $1'#000+
-  '04086_E_Expected Objective-C method or con','stant method name'#000+
+  '04086_E_Expected Objective-C method or constant method name'#000+
   '04087_E_No type info available for this type'#000+
   '04088_E_Ordinal or string expression expected'#000+
-  '04089_E_String expression expected'#000+
+  '04089_E_','String expression expected'#000+
   '04090_W_Converting 0 to NIL'#000+
   '04091_E_Objective-C protocol type expected, but got "$1"'#000+
-  '04092_E_The',' type "$1" is not supported for interaction with the Obje'+
-  'ctive-C runtime.'#000+
-  '04093_E_Class or objcclass type expected, but got "$1"'#000+
+  '04092_E_The type "$1" is not supported for interaction with the Object'+
+  'ive-C runtime.'#000+
+  '04093_E_Class or objcclass type expected, b','ut got "$1"'#000+
   '04094_E_Objcclass type expected'#000+
   '04095_W_Coerced univ parameter type in procedural variable may cause c'+
-  'rash or m','emory corruption: $1 to $2'#000+
+  'rash or memory corruption: $1 to $2'#000+
   '05000_E_Identifier not found "$1"'#000+
   '05001_F_Internal Error in SymTableStack()'#000+
-  '05002_E_Duplicate identifier "$1"'#000+
+  '05002_E_Duplic','ate identifier "$1"'#000+
   '05003_H_Identifier already defined in $1 at line $2'#000+
   '05004_E_Unknown identifier "$1"'#000+
-  '05005_E_Forward dec','laration not solved "$1"'#000+
+  '05005_E_Forward declaration not solved "$1"'#000+
   '05007_E_Error in type definition'#000+
   '05009_E_Forward type not resolved "$1"'#000+
-  '05010_E_Only static variables can be used in static methods or outside'+
-  ' methods'#000+
+  '05010_E_Only static ','variables can be used in static methods or outsi'+
+  'de methods'#000+
   '05012_F_record or class type expected'#000+
-  '05013_E_Instances of class','es or objects with an abstract method are '+
-  'not allowed'#000+
+  '05013_E_Instances of classes or objects with an abstract method are no'+
+  't allowed'#000+
   '05014_W_Label not defined "$1"'#000+
-  '05015_E_Label used but not defined "$1"'#000+
+  '05015_E_Label used but not defin','ed "$1"'#000+
   '05016_E_Illegal label declaration'#000+
   '05017_E_GOTO and LABEL are not supported (use switch -Sg)'#000+
-  '05018_E_Label not found',#000+
+  '05018_E_Label not found'#000+
   '05019_E_identifier isn'#039't a label'#000+
   '05020_E_label already defined'#000+
   '05021_E_illegal type declaration of set elements'#000+
-  '05022_E_Forward class definition not resolved "$1"'#000+
+  '0502','2_E_Forward class definition not resolved "$1"'#000+
   '05023_H_Unit "$1" not used in $2'#000+
   '05024_H_Parameter "$1" not used'#000+
-  '05025_N_Loc','al variable "$1" not used'#000+
+  '05025_N_Local variable "$1" not used'#000+
   '05026_H_Value parameter "$1" is assigned but never used'#000+
-  '05027_N_Local variable "$1" is assigned but never used'#000+
+  '05027_N_Local variable "$1" is assi','gned but never used'#000+
   '05028_H_Local $1 "$2" is not used'#000+
   '05029_N_Private field "$1.$2" is never used'#000+
-  '05030_N_Private field "$1','.$2" is assigned but never used'#000+
+  '05030_N_Private field "$1.$2" is assigned but never used'#000+
   '05031_N_Private method "$1.$2" never used'#000+
   '05032_E_Set type expected'#000+
-  '05033_W_Function result does not seem to be set'#000+
+  '05033_W_Function ','result does not seem to be set'#000+
   '05034_W_Type "$1" is not aligned correctly in current record for C'#000+
-  '05035_E_Unknown record fi','eld identifier "$1"'#000+
+  '05035_E_Unknown record field identifier "$1"'#000+
   '05036_W_Local variable "$1" does not seem to be initialized'#000+
-  '05037_W_Variable "$1" does not seem to be initialized'#000+
+  '05037_W_Variable "$1" does not seem t','o be initialized'#000+
   '05038_E_identifier idents no member "$1"'#000+
   '05039_H_Found declaration: $1'#000+
   '05040_E_Data element too large'#000+
-  '0504','2_E_No matching implementation for interface method "$1" found'#000+
+  '05042_E_No matching implementation for interface method "$1" found'#000+
   '05043_W_Symbol "$1" is deprecated'#000+
-  '05044_W_Symbol "$1" is not portable'#000+
+  '05044_W_Symbol "$1" ','is not portable'#000+
   '05055_W_Symbol "$1" is not implemented'#000+
   '05056_E_Can'#039't create unique type from this type'#000+
-  '05057_H_Local variab','le "$1" does not seem to be initialized'#000+
+  '05057_H_Local variable "$1" does not seem to be initialized'#000+
   '05058_H_Variable "$1" does not seem to be initialized'#000+
-  '05059_W_Function result variable does not seem to initialized'#000+
+  '05059_W_Function result',' variable does not seem to initialized'#000+
   '05060_H_Function result variable does not seem to be initialized'#000+
-  '05061_W_Variable "$','1" read but nowhere assigned'#000+
+  '05061_W_Variable "$1" read but nowhere assigned'#000+
   '05062_H_Found abstract method: $1'#000+
   '05063_W_Symbol "$1" is experimental'#000+
-  '05064_W_Forward declaration "$1" not resolved, assumed external'#000+
+  '05064_W_Forward de','claration "$1" not resolved, assumed external'#000+
   '05065_W_Symbol "$1" is belongs to a library'#000+
-  '05066_W_Symbol "$1" is deprecated',': "$2"'#000+
+  '05066_W_Symbol "$1" is deprecated: "$2"'#000+
   '05067_E_Cannot find an enumerator for the type "$1"'#000+
-  '05068_E_Cannot find a "MoveNext" method in enumerator "$1"'#000+
+  '05068_E_Cannot find a "MoveNext" method in enumerator "$1"',#000+
   '05069_E_Cannot find a "Current" property in enumerator "$1"'#000+
-  '05070_E_Mismatch between number of declared parameters and num','ber of'+
-  ' colons in message string.'#000+
+  '05070_E_Mismatch between number of declared parameters and number of c'+
+  'olons in message string.'#000+
   '05071_N_Private type "$1.$2" never used'#000+
   '05072_N_Private const "$1.$2" never used'#000+
-  '05073_N_Private property "$1.$2" never used'#000+
+  '050','73_N_Private property "$1.$2" never used'#000+
   '05074_W_Unit "$1" is deprecated'#000+
   '05075_W_Unit "$1" is deprecated: "$2"'#000+
-  '05076_W_Unit',' "$1" is not portable'#000+
+  '05076_W_Unit "$1" is not portable'#000+
   '05077_W_Unit "$1" is belongs to a library'#000+
   '05078_W_Unit "$1" is not implemented'#000+
-  '05079_W_Unit "$1" is experimental'#000+
+  '05079_W_Unit "$1','" is experimental'#000+
   '05080_E_No complete definition of the formally declared objcclass "$1"'+
   ' is in scope'#000+
-  '06009_E_Parameter list',' size exceeds 65535 bytes'#000+
+  '06009_E_Parameter list size exceeds 65535 bytes'#000+
   '06012_E_File types must be var parameters'#000+
-  '06013_E_The use of a far pointer isn'#039't allowed there'#000+
+  '06013_E_The use of a far pointer isn'#039't allowed th','ere'#000+
   '06015_E_EXPORT declared functions can'#039't be called'#000+
   '06016_W_Possible illegal call of constructor or destructor'#000+
-  '06017_N_In','efficient code'#000+
+  '06017_N_Inefficient code'#000+
   '06018_W_unreachable code'#000+
   '06020_E_Abstract methods can'#039't be called directly'#000+
-  '06027_DL_Register $1 weight $2 $3'#000+
+  '06027_DL_Register $1 weight',' $2 $3'#000+
   '06029_DL_Stack frame is omitted'#000+
   '06031_E_Object or class methods can'#039't be inline.'#000+
-  '06032_E_Procvar calls cannot be inl','ine.'#000+
+  '06032_E_Procvar calls cannot be inline.'#000+
   '06033_E_No code for inline procedure stored'#000+
   '06035_E_Element zero of an ansi/wide- or longstring can'#039't be acces'+
-  'sed, use (set)length instead'#000+
+  'se','d, use (set)length instead'#000+
   '06037_E_Constructors or destructors cannot be called inside a '#039'wit'+
   'h'#039' clause'#000+
-  '06038_E_Cannot call ','message handler methods directly'#000+
+  '06038_E_Cannot call message handler methods directly'#000+
   '06039_E_Jump in or outside of an exception block'#000+
-  '06040_E_Control flow statements aren'#039't allowed in a finally block'#000+
+  '06040_E_Control flow statements are','n'#039't allowed in a finally bloc'+
+  'k'#000+
   '06041_W_Parameters size exceeds limit for certain cpu'#039's'#000+
-  '06042_W_Local variable size exceed l','imit for certain cpu'#039's'#000+
+  '06042_W_Local variable size exceed limit for certain cpu'#039's'#000+
   '06043_E_Local variables size exceeds supported limit'#000+
   '06044_E_BREAK not allowed'#000+
-  '06045_E_CONTINUE not allowed'#000+
+  '06045_E_CONTINU','E not allowed'#000+
   '06046_F_Unknown compilerproc "$1". Check if you use the correct run ti'+
   'me library.'#000+
-  '06047_F_Cannot find system ','type "$1". Check if you use the correct r'+
-  'un time library.'#000+
+  '06047_F_Cannot find system type "$1". Check if you use the correct run'+
+  ' time library.'#000+
   '06048_H_Inherited call to abstract method ignored'#000+
-  '06049_E_Goto label "$1" not defined or optimized away'#000+
+  '06049_E_G','oto label "$1" not defined or optimized away'#000+
   '06050_F_Cannot find type "$1" in unit "$2". Check if you use the corre'+
-  'ct run t','ime library.'#000+
+  'ct run time library.'#000+
   '07000_DL_Starting $1 styled assembler parsing'#000+
   '07001_DL_Finished $1 styled assembler parsing'#000+
-  '07002_E_Non-label pattern contains @'#000+
+  '07002_E_Non-','label pattern contains @'#000+
   '07004_E_Error building record offset'#000+
   '07005_E_OFFSET used without identifier'#000+
-  '07006_E_TYPE used with','out identifier'#000+
+  '07006_E_TYPE used without identifier'#000+
   '07007_E_Cannot use local variable or parameters here'#000+
   '07008_E_need to use OFFSET here'#000+
-  '07009_E_need to use $ here'#000+
+  '07009_E_need to u','se $ here'#000+
   '07010_E_Cannot use multiple relocatable symbols'#000+
   '07011_E_Relocatable symbol can only be added'#000+
-  '07012_E_Invalid cons','tant expression'#000+
+  '07012_E_Invalid constant expression'#000+
   '07013_E_Relocatable symbol is not allowed'#000+
   '07014_E_Invalid reference syntax'#000+
-  '07015_E_You cannot reach $1 from that code'#000+
+  '07015_E_You cannot reach $','1 from that code'#000+
   '07016_E_Local symbols/labels aren'#039't allowed as references'#000+
   '07017_E_Invalid base and index register usage'#000+
-  '07','018_W_Possible error in object field handling'#000+
+  '07018_W_Possible error in object field handling'#000+
   '07019_E_Wrong scale factor specified'#000+
-  '07020_E_Multiple index register usage'#000+
+  '07020_E_Multiple index register us','age'#000+
   '07021_E_Invalid operand type'#000+
   '07022_E_Invalid string as opcode operand: $1'#000+
   '07023_W_@CODE and @DATA not supported'#000+
-  '07024_E','_Null label references are not allowed'#000+
+  '07024_E_Null label references are not allowed'#000+
   '07025_E_Divide by zero in asm evaluator'#000+
   '07026_E_Illegal expression'#000+
-  '07027_E_escape sequence ignored: $1'#000+
+  '07027_E_esc','ape sequence ignored: $1'#000+
   '07028_E_Invalid symbol reference'#000+
   '07029_W_Fwait can cause emulation problems with emu387'#000+
-  '07030_W_$1',' without operand translated into $1P'#000+
+  '07030_W_$1 without operand translated into $1P'#000+
   '07031_W_ENTER instruction is not supported by Linux kernel'#000+
-  '07032_W_Calling an overload function in assembler'#000+
+  '07032_W_Calling an ov','erload function in assembler'#000+
   '07033_E_Unsupported symbol type for operand'#000+
   '07034_E_Constant value out of bounds'#000+
-  '07035_E_Error',' converting decimal $1'#000+
+  '07035_E_Error converting decimal $1'#000+
   '07036_E_Error converting octal $1'#000+
   '07037_E_Error converting binary $1'#000+
-  '07038_E_Error converting hexadecimal $1'#000+
+  '07038_E_Error converting ','hexadecimal $1'#000+
   '07039_H_$1 translated to $2'#000+
   '07040_W_$1 is associated to an overloaded function'#000+
-  '07041_E_Cannot use SELF outsi','de a method'#000+
+  '07041_E_Cannot use SELF outside a method'#000+
   '07042_E_Cannot use OLDEBP outside a nested procedure'#000+
-  '07043_W_Procedures can'#039't return any value in asm code'#000+
+  '07043_W_Procedures can'#039't return any value in asm cod','e'#000+
   '07044_E_SEG not supported'#000+
   '07045_E_Size suffix and destination or source size do not match'#000+
-  '07046_W_Size suffix and destina','tion or source size do not match'#000+
+  '07046_W_Size suffix and destination or source size do not match'#000+
   '07047_E_Assembler syntax error'#000+
   '07048_E_Invalid combination of opcode and operands'#000+
-  '07049_E_Assembler syntax error in operand'#000+
+  '07','049_E_Assembler syntax error in operand'#000+
   '07050_E_Assembler syntax error in constant'#000+
   '07051_E_Invalid String expression'#000+
-  '07052_','W_constant with symbol $1 for address which is not on a pointe'+
-  'r'#000+
+  '07052_W_constant with symbol $1 for address which is not on a pointer'#000+
   '07053_E_Unrecognized opcode $1'#000+
-  '07054_E_Invalid or missing opcode'#000+
+  '07054_E_Invalid or mis','sing opcode'#000+
   '07055_E_Invalid combination of prefix and opcode: $1'#000+
   '07056_E_Invalid combination of override and opcode: $1'#000+
-  '070','57_E_Too many operands on line'#000+
+  '07057_E_Too many operands on line'#000+
   '07058_W_NEAR ignored'#000+
   '07059_W_FAR ignored'#000+
   '07060_E_Duplicate local symbol $1'#000+
-  '07061_E_Undefined local symbol $1'#000+
+  '07061_E_Und','efined local symbol $1'#000+
   '07062_E_Unknown label identifier $1'#000+
   '07063_E_Invalid register name'#000+
-  '07064_E_Invalid floating point reg','ister name'#000+
+  '07064_E_Invalid floating point register name'#000+
   '07066_W_Modulo not supported'#000+
   '07067_E_Invalid floating point constant $1'#000+
-  '07068_E_Invalid floating point expression'#000+
+  '07068_E_Invalid floating point exp','ression'#000+
   '07069_E_Wrong symbol type'#000+
   '07070_E_Cannot index a local var or parameter with a register'#000+
-  '07071_E_Invalid segment ove','rride expression'#000+
+  '07071_E_Invalid segment override expression'#000+
   '07072_W_Identifier $1 supposed external'#000+
   '07073_E_Strings not allowed as constants'#000+
-  '07074_No type of variable specified'#000+
+  '07074_No type of va','riable specified'#000+
   '07075_E_assembler code not returned to text section'#000+
   '07076_E_Not a directive or local symbol $1'#000+
-  '07077_E_Usi','ng a defined name as a local label'#000+
+  '07077_E_Using a defined name as a local label'#000+
   '07078_E_Dollar token is used without an identifier'#000+
-  '07079_W_32bit constant created for address'#000+
+  '07079_W_32bit constant created ','for address'#000+
   '07080_N_.align is target specific, use .balign or .p2align'#000+
-  '07081_E_Can'#039't access fields directly for parameters'#000,
+  '07081_E_Can'#039't access fields directly for parameters'#000+
   '07082_E_Can'#039't access fields of objects/classes directly'#000+
-  '07083_E_No size specified and unable to determine the size of the oper'+
-  'ands'#000+
+  '07083_E_No size specified and unable to determine the size of',' the op'+
+  'erands'#000+
   '07084_E_Cannot use RESULT in this function'#000+
   '07086_W_"$1" without operand translated into "$1 %st,%st(1)"'#000+
-  '07087','_W_"$1 %st(n)" translated into "$1 %st,%st(n)"'#000+
+  '07087_W_"$1 %st(n)" translated into "$1 %st,%st(n)"'#000+
   '07088_W_"$1 %st(n)" translated into "$1 %st(n),%st"'#000+
-  '07089_E_Char < not allowed here'#000+
+  '07089_E_Char < not',' allowed here'#000+
   '07090_E_Char > not allowed here'#000+
   '07093_W_ALIGN not supported'#000+
   '07094_E_Inc and Dec cannot be together'#000+
-  '07095_E_In','valid reglist for movem'#000+
+  '07095_E_Invalid reglist for movem'#000+
   '07096_E_Reglist invalid for opcode'#000+
   '07097_E_Higher cpu mode required ($1)'#000+
-  '07098_W_No size specified and unable to determine the size of the oper'+
-  'ands, using DWORD as default'#000+
-  '07099_E_Syntax error while trying to parse a',' shifter operand'#000+
+  '07098_W_No size spec','ified and unable to determine the size of the op'+
+  'erands, using DWORD as default'#000+
+  '07099_E_Syntax error while trying to parse a shifter operand'#000+
   '07100_E_Address of packed component is not at a byte boundary'#000+
-  '07101_W_No size specified and unable to determine the size of the oper'+
-  'ands, using BYTE as default'#000+
+  '07101_W_No size specified and unable t','o determine the size of the op'+
+  'erands, using BYTE as default'#000+
   '07102_W_Use of +offset(%ebp) for parameters invalid here'#000+
-  '07103_','W_Use of +offset(%ebp) is not compatible with regcall conventi'+
-  'on'#000+
-  '07104_W_Use of -offset(%ebp) is not recommended for local variable acc'+
-  'ess'#000+
+  '07103_W_Use of +offset(%ebp) is not compatible with regcall convention'+
+  #000+
+  '07104_W_Use of -offset(%ebp) is not recommended for ','local variable a'+
+  'ccess'#000+
   '07105_W_Use of -offset(%esp), access may cause a crash or value may be'+
   ' lost'#000+
-  '07106_E_VMTOffset must be',' used in combination with a virtual method,'+
-  ' and "$1" is not virtual'#000+
-  '07107_E_Generating PIC, but reference is not PIC-safe'#000+
+  '07106_E_VMTOffset must be used in combination with a virtual method, a'+
+  'nd "$1" is not virtual'#000+
+  '07107_E_Generating PIC, but reference is not PIC-','safe'#000+
   '07108_E_All registers in a register set must be of the same kind and w'+
   'idth'#000+
   '07109_E_A register set cannot be empty'#000+
-  '0800','0_F_Too many assembler files'#000+
+  '08000_F_Too many assembler files'#000+
   '08001_F_Selected assembler output not supported'#000+
   '08002_F_Comp not supported'#000+
-  '08003_F_Direct not support for binary writers'#000+
+  '08003_F_Direc','t not support for binary writers'#000+
   '08004_E_Allocating of data is only allowed in bss section'#000+
-  '08005_F_No binary writer selecte','d'#000+
+  '08005_F_No binary writer selected'#000+
   '08006_E_Asm: Opcode $1 not in table'#000+
   '08007_E_Asm: $1 invalid combination of opcode and operands'#000+
-  '08008_E_Asm: 16 Bit references not supported'#000+
+  '08008_E_Asm: 16 Bit ','references not supported'#000+
   '08009_E_Asm: Invalid effective address'#000+
   '08010_E_Asm: Immediate or reference expected'#000+
-  '08011_E_Asm: $','1 value exceeds bounds $2'#000+
+  '08011_E_Asm: $1 value exceeds bounds $2'#000+
   '08012_E_Asm: Short jump is out of range $1'#000+
   '08013_E_Asm: Undefined label $1'#000+
-  '08014_E_Asm: Comp type not supported for this target'#000+
+  '08014_E_Asm: Com','p type not supported for this target'#000+
   '08015_E_Asm: Extended type not supported for this target'#000+
-  '08016_E_Asm: Duplicate label ','$1'#000+
+  '08016_E_Asm: Duplicate label $1'#000+
   '08017_E_Asm: Redefined label $1'#000+
   '08018_E_Asm: First defined here'#000+
   '08019_E_Asm: Invalid register $1'#000+
-  '08020_E_Asm: 16 or 32 Bit references not supported'#000+
+  '08020_E_Asm: 16 o','r 32 Bit references not supported'#000+
   '08021_E_Asm: 64 Bit operands not supported'#000+
   '09000_W_Source operating system redefined'#000+
-  '0900','1_I_Assembling (pipe) $1'#000+
+  '09001_I_Assembling (pipe) $1'#000+
   '09002_E_Can'#039't create assembler file: $1'#000+
   '09003_E_Can'#039't create object file: $1'#000+
-  '09004_E_Can'#039't create archive file: $1'#000+
+  '09004_E_Can'#039't c','reate archive file: $1'#000+
   '09005_E_Assembler $1 not found, switching to external assembling'#000+
   '09006_T_Using assembler: $1'#000+
-  '09007_E','_Error while assembling exitcode $1'#000+
+  '09007_E_Error while assembling exitcode $1'#000+
   '09008_E_Can'#039't call the assembler, error $1 switching to external a'+
   'ssembling'#000+
-  '09009_I_Assembling $1'#000+
+  '09009','_I_Assembling $1'#000+
   '09010_I_Assembling with smartlinking $1'#000+
   '09011_W_Object $1 not found, Linking may fail !'#000+
-  '09012_W_Library $1',' not found, Linking may fail !'#000+
+  '09012_W_Library $1 not found, Linking may fail !'#000+
   '09013_E_Error while linking'#000+
-  '09014_E_Can'#039't call the linker, switching to external linking'#000+
+  '09014_E_Can'#039't call the linker, switching to external linki','ng'#000+
   '09015_I_Linking $1'#000+
   '09016_E_Util $1 not found, switching to external linking'#000+
   '09017_T_Using util $1'#000+
-  '09018_E_Creation of Ex','ecutables not supported'#000+
+  '09018_E_Creation of Executables not supported'#000+
   '09019_E_Creation of Dynamic/Shared Libraries not supported'#000+
   '09020_I_Closing script $1'#000+
-  '09021_E_resource compiler "$1" not found, switching to external mode'#000+
+  '09021_E_','resource compiler "$1" not found, switching to external mode'+
+  #000+
   '09022_I_Compiling resource $1'#000+
-  '09023_T_unit $1 can'#039't be statica','lly linked, switching to smart l'+
-  'inking'#000+
+  '09023_T_unit $1 can'#039't be statically linked, switching to smart lin'+
+  'king'#000+
   '09024_T_unit $1 can'#039't be smart linked, switching to static linking'+
   #000+
-  '09025_T_unit $1 can'#039't be shared linked, switching to static linkin'+
-  'g'#000+
+  '09025_T_uni','t $1 can'#039't be shared linked, switching to static link'+
+  'ing'#000+
   '09026_E_unit $1 can'#039't be smart or static linked'#000+
-  '09027_E_unit $1 ca','n'#039't be shared or static linked'#000+
+  '09027_E_unit $1 can'#039't be shared or static linked'#000+
   '09028_D_Calling resource compiler "$1" with "$2" as command line'#000+
-  '09029_E_Error while compiling resources'#000+
+  '09029_E_Error while c','ompiling resources'#000+
   '09030_E_Can'#039't call the resource compiler "$1", switching to extern'+
   'al mode'#000+
-  '09031_E_Can'#039't open resource fi','le "$1"'#000+
+  '09031_E_Can'#039't open resource file "$1"'#000+
   '09032_E_Can'#039't write resource file "$1"'#000+
   '09128_F_Can'#039't post process executable $1'#000+
-  '09129_F_Can'#039't open executable $1'#000+
+  '09129_F_Can'#039't open executable',' $1'#000+
   '09130_X_Size of Code: $1 bytes'#000+
   '09131_X_Size of initialized data: $1 bytes'#000+
-  '09132_X_Size of uninitialized data: $1 bytes'#000,
+  '09132_X_Size of uninitialized data: $1 bytes'#000+
   '09133_X_Stack space reserved: $1 bytes'#000+
   '09134_X_Stack space committed: $1 bytes'#000+
-  '09200_F_Executable image size is too big for $1 target.'#000+
+  '09200_F_Executable image size is too b','ig for $1 target.'#000+
   '09201_W_Object file "$1" contains 32-bit absolute relocation to symbol'+
   ' "$2".'#000+
   '10000_T_Unitsearch: $1'#000+
-  '10001','_T_PPU Loading $1'#000+
+  '10001_T_PPU Loading $1'#000+
   '10002_U_PPU Name: $1'#000+
   '10003_U_PPU Flags: $1'#000+
   '10004_U_PPU Crc: $1'#000+
   '10005_U_PPU Time: $1'#000+
-  '10006_U_PPU File too short'#000+
+  '10006_U_PPU Fil','e too short'#000+
   '10007_U_PPU Invalid Header (no PPU at the begin)'#000+
   '10008_U_PPU Invalid Version $1'#000+
-  '10009_U_PPU is compiled for ano','ther processor'#000+
+  '10009_U_PPU is compiled for another processor'#000+
   '10010_U_PPU is compiled for an other target'#000+
   '10011_U_PPU Source: $1'#000+
   '10012_U_Writing $1'#000+
-  '10013_F_Can'#039't Write PPU-File'#000+
+  '10013_F_Can'#039't Wr','ite PPU-File'#000+
   '10014_F_Error reading PPU-File'#000+
   '10015_F_unexpected end of PPU-File'#000+
   '10016_F_Invalid PPU-File entry: $1'#000+
-  '10017_F_P','PU Dbx count problem'#000+
+  '10017_F_PPU Dbx count problem'#000+
   '10018_E_Illegal unit name: $1'#000+
   '10019_F_Too much units'#000+
-  '10020_F_Circular unit reference between $1 and $2'#000+
+  '10020_F_Circular unit reference between $1 ','and $2'#000+
   '10021_F_Can'#039't compile unit $1, no sources available'#000+
   '10022_F_Can'#039't find unit $1 used by $2'#000+
-  '10023_W_Unit $1 was not fo','und but $2 exists'#000+
+  '10023_W_Unit $1 was not found but $2 exists'#000+
   '10024_F_Unit $1 searched but $2 found'#000+
   '10025_W_Compiling the system unit requires the -Us switch'#000+
-  '10026_F_There were $1 errors compiling module, stopping'#000+
+  '100','26_F_There were $1 errors compiling module, stopping'#000+
   '10027_U_Load from $1 ($2) unit $3'#000+
-  '10028_U_Recompiling $1, checksum cha','nged for $2'#000+
+  '10028_U_Recompiling $1, checksum changed for $2'#000+
   '10029_U_Recompiling $1, source found only'#000+
   '10030_U_Recompiling unit, static lib is older than ppufile'#000+
-  '10031_U_Recompiling unit, shared lib is older than ppufile'#000+
+  '1003','1_U_Recompiling unit, shared lib is older than ppufile'#000+
   '10032_U_Recompiling unit, obj and asm are older than ppufile'#000+
-  '10033_U','_Recompiling unit, obj is older than asm'#000+
+  '10033_U_Recompiling unit, obj is older than asm'#000+
   '10034_U_Parsing interface of $1'#000+
   '10035_U_Parsing implementation of $1'#000+
-  '10036_U_Second load for unit $1'#000+
+  '10036_U','_Second load for unit $1'#000+
   '10037_U_PPU Check file $1 time $2'#000+
-  '10040_W_Can'#039't recompile unit $1, but found modifed include files',#000+
+  '10040_W_Can'#039't recompile unit $1, but found modifed include files'#000+
   '10041_U_File $1 is newer than PPU file $2'#000+
   '10042_U_Trying to use a unit which was compiled with a different FPU m'+
-  'ode'#000+
+  'ode'#000,
   '10043_U_Loading interface units from $1'#000+
   '10044_U_Loading implementation units from $1'#000+
-  '10045_U_Interface CRC changed for unit',' $1'#000+
+  '10045_U_Interface CRC changed for unit $1'#000+
   '10046_U_Implementation CRC changed for unit $1'#000+
   '10047_U_Finished compiling unit $1'#000+
-  '10048_U_Adding dependency: $1 depends on $2'#000+
+  '10048_U_Adding dependency: $1 d','epends on $2'#000+
   '10049_U_No reload, is caller: $1'#000+
   '10050_U_No reload, already in second compile: $1'#000+
-  '10051_U_Flag for reload: $1'#000,
+  '10051_U_Flag for reload: $1'#000+
   '10052_U_Forced reloading'#000+
   '10053_U_Previous state of $1: $2'#000+
   '10054_U_Already compiling $1, setting second compile'#000+
-  '10055_U_Loading unit $1'#000+
+  '10055_','U_Loading unit $1'#000+
   '10056_U_Finished loading unit $1'#000+
   '10057_U_Registering new unit $1'#000+
   '10058_U_Re-resolving unit $1'#000+
-  '10059_U_Ski','pping re-resolving unit $1, still loading used units'#000+
+  '10059_U_Skipping re-resolving unit $1, still loading used units'#000+
   '10060_U_Unloading resource unit $1 (not needed)'#000+
-  '10061_E_Unit $1 was compiled using a different whole program optimizat'+
-  'ion feedback input ($2, $3); recompile it without wpo or use the same',
-  ' wpo feedback input file for this compilation invocation'#000+
-  '10062_U_Indirect interface (objects/classes) CRC changed for unit $1'#000+
+  '10061_E_Unit $1 ','was compiled using a different whole program optimiz'+
+  'ation feedback input ($2, $3); recompile it without wpo or use the sam'+
+  'e wpo feedback input file for this compilation invocation'#000+
+  '10062_U_Indirect interface (objects/classes) CRC changed for',' unit $1'+
+  #000+
   '11000_O_$1 [options] <inputfile> [options]'#000+
   '11001_W_Only one source file supported, changing source file to compil'+
-  'e',' from "$1" into "$2"'#000+
+  'e from "$1" into "$2"'#000+
   '11002_W_DEF file can be created only for OS/2'#000+
   '11003_E_nested response files are not supported'#000+
-  '11004_F_No source file name in command line'#000+
+  '11','004_F_No source file name in command line'#000+
   '11005_N_No option inside $1 config file'#000+
   '11006_E_Illegal parameter: $1'#000+
-  '11007_H_-? ','writes help pages'#000+
+  '11007_H_-? writes help pages'#000+
   '11008_F_Too many config files nested'#000+
   '11009_F_Unable to open file $1'#000+
-  '11010_D_Reading further options from $1'#000+
+  '11010_D_Reading further options',' from $1'#000+
   '11011_W_Target is already set to: $1'#000+
   '11012_W_Shared libs not supported on DOS platform, reverting to static'+
   #000+
-  '11013_','F_In options file $1 at line $2 too many \var{\#IF(N)DEFs} enc'+
-  'ountered'#000+
-  '11014_F_In options file $1 at line $2 unexpected \var{\#ENDIFs} encoun'+
-  'tered'#000+
+  '11013_F_In options file $1 at line $2 too many \var{\#IF(N)DEFs} encou'+
+  'ntered'#000+
+  '11014_F_In options file $1 at line $2 unexpect','ed \var{\#ENDIFs} enco'+
+  'untered'#000+
   '11015_F_Open conditional at the end of the options file'#000+
-  '11016_W_Debug information generation ','is not supported by this execut'+
-  'able'#000+
+  '11016_W_Debug information generation is not supported by this executab'+
+  'le'#000+
   '11017_H_Try recompiling with -dGDB'#000+
   '11018_W_You are using the obsolete switch $1'#000+
-  '11019_W_You are using the obsolete switch $1, please use $2'#000+
-  '11020_N_Switching assembler to default source writing assembler'#000,
+  '1','1019_W_You are using the obsolete switch $1, please use $2'#000+
+  '11020_N_Switching assembler to default source writing assembler'#000+
   '11021_W_Assembler output selected "$1" is not compatible with "$2"'#000+
   '11022_W_"$1" assembler use forced'#000+
-  '11026_T_Reading options from file $1'#000+
+  '11026_T_Reading ','options from file $1'#000+
   '11027_T_Reading options from environment $1'#000+
   '11028_D_Handling option "$1"'#000+
   '11029_O_*** press enter ***'#000+
-  '1','1030_H_Start of reading config file $1'#000+
+  '11030_H_Start of reading config file $1'#000+
   '11031_H_End of reading config file $1'#000+
   '11032_D_interpreting option "$1"'#000+
-  '11036_D_interpreting firstpass option "$1"'#000+
+  '11036_D','_interpreting firstpass option "$1"'#000+
   '11033_D_interpreting file option "$1"'#000+
   '11034_D_Reading config file "$1"'#000+
-  '11035_D_found so','urce file name "$1"'#000+
+  '11035_D_found source file name "$1"'#000+
   '11039_E_Unknown code page'#000+
   '11040_F_Config file $1 is a directory'#000+
-  '11041_W_Assembler output selected "$1" cannot generate debug info, deb'+
-  'ugging disabled'#000+
+  '11041_W_Assembler output selected',' "$1" cannot generate debug info, d'+
+  'ebugging disabled'#000+
   '11042_W_Use of ppc386.cfg is deprecated, please use fpc.cfg instead'#000+
-  '11','043_F_In options file $1 at line $2 \var{\#ELSE} directive without'+
-  ' \var{\#IF(N)DEF} found'#000+
-  '11044_F_Option "$1" is not, or not yet, supported on the current targe'+
-  't platform'#000+
-  '11045_F_The feature "$1" is not, or not yet, supported on the selecte',
-  'd target platform'#000+
+  '11043_F_In options file $1 at line $2 \var{\#ELSE} directive without \'+
+  'var{\#IF(N)DEF} found'#000+
+  '11044_F_Option "$1" is not,',' or not yet, supported on the current tar'+
+  'get platform'#000+
+  '11045_F_The feature "$1" is not, or not yet, supported on the selected'+
+  ' target platform'#000+
   '11046_N_DWARF debug information cannot be used with smart linking on t'+
-  'his target, switching to static linking'#000+
+  'his target, switching to stat','ic linking'#000+
   '11047_W_Option "$1" is ignored for the current target platform.'#000+
-  '11048_W_Disabling external debug information bec','ause it is unsupport'+
-  'ed for the selected target/debug format combination.'#000+
-  '12000_F_Cannot open whole program optimization feedback file "$1"'#000+
+  '11048_W_Disabling external debug information because it is unsupported'+
+  ' for the selected target/debug format combination.'#000+
+  '12000_F_Cannot open whole program optimizati','on feedback file "$1"'#000+
   '12001_D_Processing whole program optimization information in wpo feedb'+
   'ack file "$1"'#000+
-  '12002_D_Finished ','processing the whole program optimization informati'+
-  'on in wpo feedback file "$1"'#000+
-  '12003_E_Expected section header, but got "$2" at line $1 of wpo feedba'+
-  'ck file'#000+
+  '12002_D_Finished processing the whole program optimization information'+
+  ' in wpo feedback file "$1"'#000+
+  '12003_E_Expected section header, but ','got "$2" at line $1 of wpo feed'+
+  'back file'#000+
   '12004_W_No handler registered for whole program optimization section "'+
-  '$2" at line ','$1 of wpo feedback file, ignoring'#000+
+  '$2" at line $1 of wpo feedback file, ignoring'#000+
   '12005_D_Found whole program optimization section "$1" with information'+
   ' about "$2"'#000+
-  '12006_F_The selected whole program optimizations require a previously '+
-  'generated feedback file (use -Fw to specify)'#000+
-  '12007_E_N','o collected information necessary to perform "$1" whole pro'+
-  'gram optimization found'#000+
-  '12008_F_Specify a whole program optimization feedback file to store th'+
-  'e generated info in (using -FW)'#000+
-  '12009_E_Not generating any whole program optimization i','nformation, y'+
-  'et a feedback file was specified (using -FW)'#000+
-  '12010_E_Not performing any whole program optimizations, yet an input f'+
-  'eedback file was specified (using -Fw)'#000+
+  '1','2006_F_The selected whole program optimizations require a previousl'+
+  'y generated feedback file (use -Fw to specify)'#000+
+  '12007_E_No collected information necessary to perform "$1" whole progr'+
+  'am optimization found'#000+
+  '12008_F_Specify a whole program op','timization feedback file to store '+
+  'the generated info in (using -FW)'#000+
+  '12009_E_Not generating any whole program optimization information, yet'+
+  ' a feedback file was specified (using -FW)'#000+
+  '12010_E_Not performing any whole program optimizations, yet',' an input'+
+  ' feedback file was specified (using -Fw)'#000+
   '12011_D_Skipping whole program optimization section "$1", because not '+
-  'nee','ded by the requested optimizations'#000+
+  'needed by the requested optimizations'#000+
   '12012_W_Overriding previously read information for "$1" from feedback '+
-  'input file using information in section "$2"'#000+
+  'input file u','sing information in section "$2"'#000+
   '12013_E_Cannot extract symbol liveness information from program when s'+
-  'tripping symbols, us','e -Xs-'#000+
+  'tripping symbols, use -Xs-'#000+
   '12014_E_Cannot extract symbol liveness information from program when w'+
   'hen not linking'#000+
-  '12015_F_Cannot find "$1" or "$2" to extract symbol liveness informatio'+
-  'n from linked program'#000+
-  '12016_E_Error during reading symbol liveness informatio','n produced by'+
-  ' "$1"'#000+
+  '12015_F_Cannot find "$1"',' or "$2" to extract symbol liveness informat'+
+  'ion from linked program'#000+
+  '12016_E_Error during reading symbol liveness information produced by "'+
+  '$1"'#000+
   '12017_F_Error executing "$1" (exitcode: $2) to extract symbol informat'+
   'ion from linked program'#000+
-  '12018_E_Collection of symbol liveness information can only help when u'+
-  'sing smart linking, use -CX -XX'#000+
-  '12019_E_Cannot create spe','cified whole program optimisation feedback '+
-  'file "$1"'#000+
-  '11023_Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPC'+
-  'CPU'#010+
+  '1201','8_E_Collection of symbol liveness information can only help when'+
+  ' using smart linking, use -CX -XX'#000+
+  '12019_E_Cannot create specified whole program optimisation feedback fi'+
+  'le "$1"'#000+
+  '11023_Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] fo','r $F'+
+  'PCCPU'#010+
   'Copyright (c) 1993-2009 by Florian Klaempfl'#000+
   '11024_Free Pascal Compiler version $FPCVERSION'#010+
   #010+
-  'Compiler Date      : ','$FPCDATE'#010+
+  'Compiler Date      : $FPCDATE'#010+
   'Compiler CPU Target: $FPCCPU'#010+
   #010+
   'Supported targets:'#010+
   '  $OSTARGETS'#010+
   #010+
   'Supported CPU instruction sets:'#010+
-  '  $INSTRUCTIONSETS'#010+
+  '  $INSTRUCTIO','NSETS'#010+
   #010+
   'Supported FPU instruction sets:'#010+
   '  $FPUINSTRUCTIONSETS'#010+
@@ -1029,305 +1033,306 @@ const msgtxt : array[0..000236,1..240] of char=(
   'Supported ABI targets:'#010+
   '  $ABITARGETS'#010+
   #010+
-  'Supported Optimizations',':'#010+
+  'Supported Optimizations:'#010+
   '  $OPTIMIZATIONS'#010+
   #010+
   'Supported Whole Program Optimizations:'#010+
   '  All'#010+
   '  $WPOPTIMIZATIONS'#010+
   #010+
-  'Supported Microcontroller types:'#010+
+  'Supported Microcontroller types:',#010+
   '  $CONTROLLERTYPES'#010+
   #010+
   'This program comes under the GNU General Public Licence'#010+
   'For more information read COPYING.FPC'#010+
   #010+
-  'Report ','bugs, suggestions, etc. to:'#010+
+  'Report bugs, suggestions, etc. to:'#010+
   '                 http://bugs.freepascal.org'#010+
   'or'#010+
   '                 [email protected]'#000+
-  '11025_**0*_Put + after a boolean switch option to enable it, - to disa'+
-  'ble it'#010+
-  '**1a_The compiler doesn'#039't delete the generated asse','mbler file'#010+
+  '11025','_**0*_Put + after a boolean switch option to enable it, - to di'+
+  'sable it'#010+
+  '**1a_The compiler doesn'#039't delete the generated assembler file'#010+
   '**2al_List sourcecode lines in assembler file'#010+
   '**2an_List node info in assembler file'#010+
-  '*L2ap_Use pipes instead of creating temporary assembler files'#010+
+  '*L2ap_Use pipes inste','ad of creating temporary assembler files'#010+
   '**2ar_List register allocation/release info in assembler file'#010+
-  '**2at_List temp allo','cation/release info in assembler file'#010+
+  '**2at_List temp allocation/release info in assembler file'#010+
   '**1A<x>_Output format:'#010+
   '**2Adefault_Use default assembler'#010+
-  '3*2Aas_Assemble using GNU AS'#010+
+  '3*2Aas_Assemble using ','GNU AS'#010+
   '3*2Amacho_Mach-O (Darwin, Intel 32 bit) using internal writer'#010+
   '3*2Anasmcoff_COFF (Go32v2) file using Nasm'#010+
-  '3*2Anasmelf','_ELF32 (Linux) file using Nasm'#010+
+  '3*2Anasmelf_ELF32 (Linux) file using Nasm'#010+
   '3*2Anasmwin32_Win32 object file using Nasm'#010+
-  '3*2Anasmwdosx_Win32/WDOSX object file using Nasm'#010+
+  '3*2Anasmwdosx_Win32/WDOSX object file using',' Nasm'#010+
   '3*2Awasm_Obj file using Wasm (Watcom)'#010+
   '3*2Anasmobj_Obj file using Nasm'#010+
   '3*2Amasm_Obj file using Masm (Microsoft)'#010+
-  '3*2Ata','sm_Obj file using Tasm (Borland)'#010+
+  '3*2Atasm_Obj file using Tasm (Borland)'#010+
   '3*2Aelf_ELF (Linux) using internal writer'#010+
-  '3*2Acoff_COFF (Go32v2) using internal writer'#010+
+  '3*2Acoff_COFF (Go32v2) using internal writ','er'#010+
   '3*2Apecoff_PE-COFF (Win32) using internal writer'#010+
   '4*2Aas_Assemble using GNU AS'#010+
   '6*2Aas_Unix o-file using GNU AS'#010+
-  '6*2Agas_GN','U Motorola assembler'#010+
+  '6*2Agas_GNU Motorola assembler'#010+
   '6*2Amit_MIT Syntax (old GAS)'#010+
   '6*2Amot_Standard Motorola assembler'#010+
   'A*2Aas_Assemble using GNU AS'#010+
-  'P*2Aas_Assemble using GNU AS'#010+
+  'P*','2Aas_Assemble using GNU AS'#010+
   'S*2Aas_Assemble using GNU AS'#010+
   '**1b_Generate browser info'#010+
   '**2bl_Generate local symbol info'#010+
-  '**1B_Bu','ild all modules'#010+
+  '**1B_Build all modules'#010+
   '**1C<x>_Code generation options:'#010+
   '**2Ca<x>_Select ABI, see fpc -i for possible values'#010+
-  '**2Cb_Generate big-endian code'#010+
+  '**2Cb_Generate b','ig-endian code'#010+
   '**2Cc<x>_Set default calling convention to <x>'#010+
   '**2CD_Create also dynamic library (not supported)'#010+
-  '**2Ce_Compi','lation with emulated floating point opcodes'#010+
+  '**2Ce_Compilation with emulated floating point opcodes'#010+
   '**2Cf<x>_Select fpu instruction set to use, see fpc -i for possible va'+
-  'lues'#010+
+  'lue','s'#010+
   '**2CF<x>_Minimal floating point constant precision (default, 32, 64)'#010+
   '**2Cg_Generate PIC code'#010+
-  '**2Ch<n>_<n> bytes heap (bet','ween 1023 and 67107840)'#010+
+  '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+
   '**2Ci_IO-checking'#010+
   '**2Cn_Omit linking stage'#010+
   '**2Co_Check overflow of integer operations'#010+
-  '**2CO_Check for possible overflow of integer operations'#010+
+  '**2CO_C','heck for possible overflow of integer operations'#010+
   '**2Cp<x>_Select instruction set, see fpc -i for possible values'#010+
-  '**2CP<x>=<','y>_ packing settings'#010+
+  '**2CP<x>=<y>_ packing settings'#010+
   '**3CPPACKSET=<y>_ <y> set allocation: 0, 1 or DEFAULT or NORMAL, 2, 4 '+
   'and 8'#010+
-  '**2Cr_Range checking'#010+
+  '**2Cr_Range checking',#010+
   '**2CR_Verify object method call validity'#010+
   '**2Cs<n>_Set stack checking size to <n>'#010+
-  '**2Ct_Stack checking (for testing only, s','ee manual)'#010+
+  '**2Ct_Stack checking (for testing only, see manual)'#010+
   '**2CX_Create also smartlinked library'#010+
   '**1d<x>_Defines the symbol <x>'#010+
   '**1D_Generate a DEF file'#010+
-  '**2Dd<x>_Set description to <x>'#010+
+  '**2Dd<x>_Set',' description to <x>'#010+
   '**2Dv<x>_Set DLL version to <x>'#010+
   '*O2Dw_PM application'#010+
   '**1e<x>_Set path to executable'#010+
   '**1E_Same as -Cn'#010+
-  '**','1fPIC_Same as -Cg'#010+
+  '**1fPIC_Same as -Cg'#010+
   '**1F<x>_Set file names and paths:'#010+
-  '**2Fa<x>[,y]_(for a program) load units <x> and [y] before uses is par'+
-  'sed'#010+
+  '**2Fa<x>[,y]_(for a program) load units <x> and [y] before uses i','s p'+
+  'arsed'#010+
   '**2Fc<x>_Set input codepage to <x>'#010+
   '**2FC<x>_Set RC compiler binary name to <x>'#010+
-  '**2Fd_Disable the compiler'#039's intern','al directory cache'#010+
+  '**2Fd_Disable the compiler'#039's internal directory cache'#010+
   '**2FD<x>_Set the directory where to search for compiler utilities'#010+
-  '**2Fe<x>_Redirect error output to <x>'#010+
+  '**2Fe<x>_Redirect error output t','o <x>'#010+
   '**2Ff<x>_Add <x> to framework path (Darwin only)'#010+
   '**2FE<x>_Set exe/unit output path to <x>'#010+
-  '**2Fi<x>_Add <x> to include',' path'#010+
+  '**2Fi<x>_Add <x> to include path'#010+
   '**2Fl<x>_Add <x> to library path'#010+
   '**2FL<x>_Use <x> as dynamic linker'#010+
-  '**2Fm<x>_Load unicode conversion table from <x>.txt in the compiler di'+
-  'r'#010+
+  '**2Fm<x>_Load unicode conversion table from',' <x>.txt in the compiler '+
+  'dir'#010+
   '**2Fo<x>_Add <x> to object path'#010+
   '**2Fr<x>_Load error message file <x>'#010+
-  '**2FR<x>_Set resource (.r','es) linker to <x>'#010+
+  '**2FR<x>_Set resource (.res) linker to <x>'#010+
   '**2Fu<x>_Add <x> to unit path'#010+
   '**2FU<x>_Set unit output path to <x>, overrides -FE'#010+
-  '**2FW<x>_Store generated whole-program optimization feedback in <x>'#010+
+  '**2FW<x>_Store ge','nerated whole-program optimization feedback in <x>'#010+
   '**2Fw<x>_Load previously stored whole-program optimization feedback fr'+
-  'om',' <x>'#010+
+  'om <x>'#010+
   '*g1g_Generate debug information (default format for target)'#010+
   '*g2gc_Generate checks for pointers'#010+
-  '*g2gh_Use heaptrace unit (for memory leak/corruption debugging)'#010+
+  '*g2gh_Use heaptra','ce unit (for memory leak/corruption debugging)'#010+
   '*g2gl_Use line info unit (show more info with backtraces)'#010+
-  '*g2go<x>_Set debug',' information options'#010+
+  '*g2go<x>_Set debug information options'#010+
   '*g3godwarfsets_ Enable DWARF '#039'set'#039' type debug information (bre'+
   'aks gdb < 6.5)'#010+
-  '*g3gostabsabsincludes_ Store absolute/full include file paths in Stabs'+
-  #010+
+  '*g3gostabsabsinclud','es_ Store absolute/full include file paths in Sta'+
+  'bs'#010+
   '*g3godwarfmethodclassprefix_ Prefix method names in DWARF with class n'+
-  'a','me'#010+
+  'ame'#010+
   '*g2gp_Preserve case in stabs symbol names'#010+
   '*g2gs_Generate Stabs debug information'#010+
-  '*g2gt_Trash local variables (to detect uninitialized uses)'#010+
+  '*g2gt_Trash local variables (to d','etect uninitialized uses)'#010+
   '*g2gv_Generates programs traceable with Valgrind'#010+
-  '*g2gw_Generate DWARFv2 debug information (same a','s -gw2)'#010+
+  '*g2gw_Generate DWARFv2 debug information (same as -gw2)'#010+
   '*g2gw2_Generate DWARFv2 debug information'#010+
   '*g2gw3_Generate DWARFv3 debug information'#010+
   '**1i_Information'#010+
-  '**2iD_Return compiler date'#010+
+  '**2iD_Re','turn compiler date'#010+
   '**2iV_Return short compiler version'#010+
   '**2iW_Return full compiler version'#010+
   '**2iSO_Return compiler OS'#010+
-  '**2iSP_','Return compiler host processor'#010+
+  '**2iSP_Return compiler host processor'#010+
   '**2iTO_Return target OS'#010+
   '**2iTP_Return target processor'#010+
-  '**1I<x>_Add <x> to include path'#010+
+  '**1I<x>_Add <x> to include path',#010+
   '**1k<x>_Pass <x> to the linker'#010+
   '**1l_Write logo'#010+
   '**1M<x>_Set language mode to <x>'#010+
   '**2Mfpc_Free Pascal dialect (default)'#010+
-  '**2M','objfpc_FPC mode with Object Pascal support'#010+
+  '**2Mobjfpc_FPC mode with Object Pascal support'#010+
   '**2Mdelphi_Delphi 7 compatibility mode'#010+
-  '**2Mtp_TP/BP 7.0 compatibility mode'#010+
+  '**2Mtp_TP/BP 7.0 compatibility mode',#010+
   '**2Mmacpas_Macintosh Pascal dialects compatibility mode'#010+
   '**1n_Do not read the default config files'#010+
-  '**1N<x>_Node tree optimi','zations'#010+
+  '**1N<x>_Node tree optimizations'#010+
   '**2Nu_Unroll loops'#010+
   '**1o<x>_Change the name of the executable produced to <x>'#010+
   '**1O<x>_Optimizations:'#010+
-  '**2O-_Disable optimizations'#010+
+  '**2O-_Dis','able optimizations'#010+
   '**2O1_Level 1 optimizations (quick and debugger friendly)'#010+
-  '**2O2_Level 2 optimizations (-O1 + quick optim','izations)'#010+
+  '**2O2_Level 2 optimizations (-O1 + quick optimizations)'#010+
   '**2O3_Level 3 optimizations (-O2 + slow optimizations)'#010+
   '**2Oa<x>=<y>_Set alignment'#010+
-  '**2Oo[NO]<x>_Enable or disable optimizations, see fpc -i for possible '+
-  'values'#010+
+  '**2Oo[NO]<x>_Enable or di','sable optimizations, see fpc -i for possibl'+
+  'e values'#010+
   '**2Op<x>_Set target cpu for optimizing, see fpc -i for possible values'+
-  #010,
+  #010+
   '**2OW<x>_Generate whole-program optimization feedback for optimization'+
   ' <x>, see fpc -i for possible values'#010+
-  '**2Ow<x>_Perform whole-program optimization <x>, see fpc -i for possib'+
-  'le values'#010+
+  '**2Ow<x>_P','erform whole-program optimization <x>, see fpc -i for poss'+
+  'ible values'#010+
   '**2Os_Optimize for size rather than speed'#010+
-  '**1pg_Gener','ate profile code for gprof (defines FPC_PROFILE)'#010+
+  '**1pg_Generate profile code for gprof (defines FPC_PROFILE)'#010+
   '**1R<x>_Assembler reading style:'#010+
-  '**2Rdefault_Use default assembler for target'#010+
+  '**2Rdefault_Use default assembler f','or target'#010+
   '3*2Ratt_Read AT&T style assembler'#010+
   '3*2Rintel_Read Intel style assembler'#010+
   '6*2RMOT_Read motorola style assembler'#010+
-  '**1S','<x>_Syntax options:'#010+
+  '**1S<x>_Syntax options:'#010+
   '**2S2_Same as -Mobjfpc'#010+
   '**2Sc_Support operators like C (*=,+=,/= and -=)'#010+
-  '**2Sa_Turn on assertions'#010+
+  '**2Sa_Turn on assertions'#010,
   '**2Sd_Same as -Mdelphi'#010+
   '**2Se<x>_Error options. <x> is a combination of the following:'#010+
-  '**3*_<n> : Compiler halts after the <','n> errors (default is 1)'#010+
+  '**3*_<n> : Compiler halts after the <n> errors (default is 1)'#010+
   '**3*_w : Compiler also halts after warnings'#010+
   '**3*_n : Compiler also halts after notes'#010+
-  '**3*_h : Compiler also halts after hints'#010+
+  '**3*_h ',': Compiler also halts after hints'#010+
   '**2Sg_Enable LABEL and GOTO (default in -Mtp and -Mdelphi)'#010+
-  '**2Sh_Use ansistrings by defau','lt instead of shortstrings'#010+
+  '**2Sh_Use ansistrings by default instead of shortstrings'#010+
   '**2Si_Turn on inlining of procedures/functions declared as "inline"'#010+
-  '**2Sk_Load fpcylix unit'#010+
+  '**2Sk_Load fpcylix uni','t'#010+
   '**2SI<x>_Set interface style to <x>'#010+
   '**3SIcom_COM compatible interface (default)'#010+
   '**3SIcorba_CORBA compatible interface'#010+
-  '**2','Sm_Support macros like C (global)'#010+
+  '**2Sm_Support macros like C (global)'#010+
   '**2So_Same as -Mtp'#010+
   '**2Ss_Constructor name must be init (destructor must be done)'#010+
-  '**2Sx_Enable exception keywords (default in Delphi/ObjFPC modes)'#010+
+  '**','2Sx_Enable exception keywords (default in Delphi/ObjFPC modes)'#010+
   '**1s_Do not call assembler and linker'#010+
-  '**2sh_Generate script ','to link on host'#010+
+  '**2sh_Generate script to link on host'#010+
   '**2st_Generate script to link on target'#010+
   '**2sr_Skip register allocation phase (use with -alr)'#010+
-  '**1T<x>_Target operating system:'#010+
+  '**1T<x>_','Target operating system:'#010+
   '3*2Temx_OS/2 via EMX (including EMX/RSX extender)'#010+
   '3*2Tfreebsd_FreeBSD'#010+
-  '3*2Tgo32v2_Version 2 of DJ D','elorie DOS extender'#010+
+  '3*2Tgo32v2_Version 2 of DJ Delorie DOS extender'#010+
   '3*2Tlinux_Linux'#010+
   '3*2Tnetbsd_NetBSD'#010+
   '3*2Tnetware_Novell Netware Module (clib)'#010+
-  '3*2Tnetwlibc_Novell Netware Module (libc)'#010+
+  '3*2Tnetwlibc_Novell Ne','tware Module (libc)'#010+
   '3*2Topenbsd_OpenBSD'#010+
   '3*2Tos2_OS/2 / eComStation'#010+
   '3*2Tsunos_SunOS/Solaris'#010+
   '3*2Tsymbian_Symbian OS'#010+
-  '3*2Twatco','m_Watcom compatible DOS extender'#010+
+  '3*2Twatcom_Watcom compatible DOS extender'#010+
   '3*2Twdosx_WDOSX DOS extender'#010+
   '3*2Twin32_Windows 32 Bit'#010+
   '3*2Twince_Windows CE'#010+
-  '4*2Tlinux_Linux'#010+
+  '4*2Tlinux','_Linux'#010+
   '6*2Tamiga_Commodore Amiga'#010+
   '6*2Tatari_Atari ST/STe/TT'#010+
   '6*2Tlinux_Linux/m68k'#010+
   '6*2Tmacos_Macintosh m68k (not supported)'#010+
-  '6*','2Tpalmos_PalmOS'#010+
+  '6*2Tpalmos_PalmOS'#010+
   'A*2Tlinux_Linux'#010+
   'A*2Twince_Windows CE'#010+
   'P*2Tamiga_AmigaOS on PowerPC'#010+
-  'P*2Tdarwin_Darwin and Mac OS X on PowerPC'#010+
+  'P*2Tdarwin_Darwin and Mac OS X on P','owerPC'#010+
   'P*2Tlinux_Linux on PowerPC'#010+
   'P*2Tmacos_Mac OS (classic) on PowerPC'#010+
   'P*2Tmorphos_MorphOS'#010+
   'S*2Tlinux_Linux'#010+
-  '**1u<x>_Undefin','es the symbol <x>'#010+
+  '**1u<x>_Undefines the symbol <x>'#010+
   '**1U_Unit options:'#010+
   '**2Un_Do not check where the unit name matches the file name'#010+
-  '**2Ur_Generate release unit files (never automatically recompiled)'#010+
+  '**2Ur_Generate rele','ase unit files (never automatically recompiled)'#010+
   '**2Us_Compile a system unit'#010+
-  '**1v<x>_Be verbose. <x> is a combination of the',' following letters:'#010+
+  '**1v<x>_Be verbose. <x> is a combination of the following letters:'#010+
   '**2*_e : Show errors (default)       0 : Show nothing (except errors)'#010+
-  '**2*_w : Show warnings               u : Show unit info'#010+
+  '**2*_w : Show warnings     ','          u : Show unit info'#010+
   '**2*_n : Show notes                  t : Show tried/used files'#010+
-  '**2*_h : Show hints            ','      c : Show conditionals'#010+
+  '**2*_h : Show hints                  c : Show conditionals'#010+
   '**2*_i : Show general info           d : Show debug info'#010+
-  '**2*_l : Show linenumbers            r : Rhide/GCC compatibility mode'#010+
+  '**2*_l : Show linenumbers       ','     r : Rhide/GCC compatibility mod'+
+  'e'#010+
   '**2*_s : Show time stamps            q : Show message numbers'#010+
-  '**2*_a : Show everythin','g             x : Executable info (Win32 only'+
-  ')'#010+
-  '**2*_b : Write file names messages   p : Write tree.log with parse tre'+
+  '**2*_a : Show everything             x : Executable info (Win32 only)'#010+
+  '**2*_b : Write file names messages   p : Write tree.log with parse tre',
   'e'#010+
   '**2*_    with full path              v : Write fpcdebug.txt with'#010+
-  '**2*_                                    lots of debuggi','ng info'#010+
+  '**2*_                                    lots of debugging info'#010+
   '**2*_m<x>,<y> : Don'#039't show messages numbered <x> and <y>'#010+
   '3*1W<x>_Target-specific options (targets)'#010+
-  'A*1W<x>_Target-specific options (targets)'#010+
+  'A*1W<x>_Ta','rget-specific options (targets)'#010+
   'P*1W<x>_Target-specific options (targets)'#010+
   'p*1W<x>_Target-specific options (targets)'#010+
-  '3*2Wb_C','reate a bundle instead of a library (Darwin)'#010+
+  '3*2Wb_Create a bundle instead of a library (Darwin)'#010+
   'P*2Wb_Create a bundle instead of a library (Darwin)'#010+
-  'p*2Wb_Create a bundle instead of a library (Darwin)'#010+
+  'p*2Wb_Create a bundl','e instead of a library (Darwin)'#010+
   '3*2WB_Create a relocatable image (Windows)'#010+
-  'A*2WB_Create a relocatable image (Windows, Symbi','an)'#010+
+  'A*2WB_Create a relocatable image (Windows, Symbian)'#010+
   '3*2WC_Specify console type application (EMX, OS/2, Windows)'#010+
   'A*2WC_Specify console type application (Windows)'#010+
-  'P*2WC_Specify console type application (Classic Mac OS)'#010+
+  'P*2W','C_Specify console type application (Classic Mac OS)'#010+
   '3*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
-  'A*2WD_Use',' DEFFILE to export functions of DLL or EXE (Windows)'#010+
+  'A*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
   '3*2We_Use external resources (Darwin)'#010+
-  '4*2We_Use external resources (Darwin)'#010+
+  '4*2We_Use external resourc','es (Darwin)'#010+
   'A*2We_Use external resources (Darwin)'#010+
   'P*2We_Use external resources (Darwin)'#010+
-  'p*2We_Use external resources (Darwi','n)'#010+
+  'p*2We_Use external resources (Darwin)'#010+
   '3*2WF_Specify full-screen type application (EMX, OS/2)'#010+
-  '3*2WG_Specify graphic type application (EMX, OS/2, Windows)'#010+
+  '3*2WG_Specify graphic type application (EMX, OS/2, Windows)',#010+
   'A*2WG_Specify graphic type application (Windows)'#010+
   'P*2WG_Specify graphic type application (Classic Mac OS)'#010+
-  '3*2Wi_Use interna','l resources (Darwin)'#010+
+  '3*2Wi_Use internal resources (Darwin)'#010+
   'P*2Wi_Use internal resources (Darwin)'#010+
   'p*2Wi_Use internal resources (Darwin)'#010+
-  '3*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
+  '3*2WN_Do not generat','e relocation code, needed for debugging (Windows'+
+  ')'#010+
   'A*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
-  '3*2','WR_Generate relocation code (Windows)'#010+
+  '3*2WR_Generate relocation code (Windows)'#010+
   'A*2WR_Generate relocation code (Windows)'#010+
-  'P*2WT_Specify MPW tool type application (Classic Mac OS)'#010+
+  'P*2WT_Specify MPW tool type applicatio','n (Classic Mac OS)'#010+
   '3*2WX_Enable executable stack (Linux)'#010+
   'A*2WX_Enable executable stack (Linux)'#010+
-  'p*2WX_Enable executable stac','k (Linux)'#010+
+  'p*2WX_Enable executable stack (Linux)'#010+
   'P*2WX_Enable executable stack (Linux)'#010+
   '**1X_Executable options:'#010+
-  '**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Lin'+
-  'ux)'#010+
+  '**2Xc_Pass --shared/-dynamic to the linker (','BeOS, Darwin, FreeBSD, L'+
+  'inux)'#010+
   '**2Xd_Do not use standard library search path (needed for cross compil'+
   'e)'#010+
-  '**2Xe_Use external l','inker'#010+
+  '**2Xe_Use external linker'#010+
   '**2Xg_Create debuginfo in a separate file and add a debuglink section '+
   'to executable'#010+
-  '**2XD_Try to link units dynamically      (defines FPC_LINK_DYNAMIC)'#010+
+  '**2XD_Try to link units dyn','amically      (defines FPC_LINK_DYNAMIC)'#010+
   '**2Xi_Use internal linker'#010+
   '**2Xm_Generate link map'#010+
-  '**2XM<x>_Set the name of the '#039'ma','in'#039' program routine (default'+
-  ' is '#039'main'#039')'#010+
+  '**2XM<x>_Set the name of the '#039'main'#039' program routine (default i'+
+  's '#039'main'#039')'#010+
   '**2XP<x>_Prepend the binutils names with the prefix <x>'#010+
-  '**2Xr<x>_Set the linker'#039's rlink-path to <x> (needed for cross comp'+
-  'ile, see the ld manual for more information) (BeOS, Linux)'#010+
-  '**2XR<x>_Prepend <x','> to all linker search paths (BeOS, Darwin, FreeB'+
-  'SD, Linux, Mac OS, Solaris)'#010+
-  '**2Xs_Strip all symbols from executable'#010+
+  '**2Xr<x>_Set the link','er'#039's rlink-path to <x> (needed for cross co'+
+  'mpile, see the ld manual for more information) (BeOS, Linux)'#010+
+  '**2XR<x>_Prepend <x> to all linker search paths (BeOS, Darwin, FreeBSD'+
+  ', Linux, Mac OS, Solaris)'#010+
+  '**2Xs_Strip all symbols from executable'#010,
   '**2XS_Try to link units statically (default, defines FPC_LINK_STATIC)'#010+
-  '**2Xt_Link with static libraries (-static is passed t','o linker)'#010+
+  '**2Xt_Link with static libraries (-static is passed to linker)'#010+
   '**2XX_Try to smartlink units             (defines FPC_LINK_SMART)'#010+
   '**1*_'#010+
   '**1?_Show this help'#010+
-  '**1h_Shows this help without waiting'
+  '**1h_Shows this',' help without waiting'
 );

+ 17 - 17
compiler/ncal.pas

@@ -61,7 +61,7 @@ interface
           function  is_simple_para_load(p:tnode; may_be_in_reg: boolean):boolean;
           procedure maybe_load_in_temp(var p:tnode);
           function  gen_high_tree(var p:tnode;paradef:tdef):tnode;
-          function  gen_self_tree_methodpointer:tnode;
+          function  gen_procvar_context_tree:tnode;
           function  gen_self_tree:tnode;
           function  gen_vmt_tree:tnode;
           procedure gen_hidden_parameters;
@@ -680,6 +680,7 @@ implementation
                  ttypeconvnode(hp).left:=nil;
                  hp.free;
                end;
+             maybe_global_proc_to_nested(left,parasym.vardef);
 
              { Handle varargs and hidden paras directly, no typeconvs or }
              { pass_typechecking needed                                       }
@@ -1564,18 +1565,12 @@ implementation
       end;
 
 
-    function tcallnode.gen_self_tree_methodpointer:tnode;
-      var
-        hsym : tfieldvarsym;
-      begin
-        { find self field in methodpointer record }
-        hsym:=tfieldvarsym(trecorddef(methodpointertype).symtable.Find('self'));
-        if not assigned(hsym) then
-          internalerror(200305251);
-        { Load tmehodpointer(right).self }
-        result:=csubscriptnode.create(
-                     hsym,
-                     ctypeconvnode.create_internal(right.getcopy,methodpointertype));
+    function tcallnode.gen_procvar_context_tree:tnode;
+      begin
+        { Load tmehodpointer(right).self (either self or parentfp) }
+        result:=genloadfield(ctypeconvnode.create_internal(
+          right.getcopy,methodpointertype),
+          'self');
       end;
 
 
@@ -2252,7 +2247,7 @@ implementation
                  if vo_is_self in para.parasym.varoptions then
                    begin
                      if assigned(right) then
-                       para.left:=gen_self_tree_methodpointer
+                       para.left:=gen_procvar_context_tree
                      else
                        para.left:=gen_self_tree;
                    end
@@ -2272,9 +2267,14 @@ implementation
                 else
                  if vo_is_parentfp in para.parasym.varoptions then
                    begin
-                     if not(assigned(procdefinition.owner.defowner)) then
-                       internalerror(200309287);
-                     para.left:=cloadparentfpnode.create(tprocdef(procdefinition.owner.defowner));
+                     if not assigned(right) then
+                       begin
+                         if not(assigned(procdefinition.owner.defowner)) then
+                           internalerror(200309287);
+                         para.left:=cloadparentfpnode.create(tprocdef(procdefinition.owner.defowner))
+                       end
+                     else
+                       para.left:=gen_procvar_context_tree;
                    end
                 else
                  if vo_is_range_check in para.parasym.varoptions then

+ 6 - 2
compiler/ncgcal.pas

@@ -843,8 +843,12 @@ implementation
               dec(pop_size,sizeof(pint));
             { Remove parameters/alignment from the stack }
             pop_parasize(pop_size);
-          end;
-
+          end
+         { frame pointer parameter is popped by the caller when it's passed the
+           Delphi way }
+         else if (po_delphi_nested_cc in procdefinition.procoptions) and
+                 not use_fixed_stack then
+           pop_parasize(sizeof(pint));
          { Release registers, but not the registers that contain the
            function result }
          if (not is_void(resultdef)) then

+ 22 - 1
compiler/ncgcnv.pas

@@ -362,6 +362,8 @@ interface
 
 
     procedure tcgtypeconvnode.second_proc_to_procvar;
+      var
+        tmpreg: tregister;
       begin
         if tabstractprocdef(resultdef).is_addressonly then
           begin
@@ -370,7 +372,26 @@ interface
             cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,location.register);
           end
         else
-          location_copy(location,left.location);
+          begin
+            if not tabstractprocdef(left.resultdef).is_addressonly then
+              location_copy(location,left.location)
+            else
+              begin
+                { assigning a global function to a nested procvar -> create
+                  tmethodpointer record and set the "frame pointer" to nil }
+                location_reset_ref(location,LOC_REFERENCE,int_cgsize(sizeof(pint)*2),sizeof(pint));
+                tg.gettemp(current_asmdata.CurrAsmList,resultdef.size,sizeof(pint),tt_normal,location.reference);
+                tmpreg:=cg.getaddressregister(current_asmdata.CurrAsmList);
+                cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,tmpreg);
+                cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,tmpreg,location.reference);
+                { setting the frame pointer to nil is not strictly necessary
+                  since the global procedure won't use it, but it can help with
+                  debugging }
+                inc(location.reference.offset,sizeof(pint));
+                cg.a_load_const_ref(current_asmdata.CurrAsmList,OS_ADDR,0,location.reference);
+                dec(location.reference.offset,sizeof(pint));
+              end;
+          end;
       end;
 
     procedure Tcgtypeconvnode.second_nil_to_methodprocvar;

+ 8 - 1
compiler/ncgutil.pas

@@ -2343,7 +2343,14 @@ implementation
               inc(parasize,sizeof(pint));
           end
         else
-          parasize:=current_procinfo.para_stack_size;
+          begin
+            parasize:=current_procinfo.para_stack_size;
+            { the parent frame pointer para has to be removed by the caller in
+              case of Delphi-style parent frame pointer passing }
+            if not use_fixed_stack and
+               (po_delphi_nested_cc in current_procinfo.procdef.procoptions) then
+              dec(parasize,sizeof(pint));
+          end;
 
         { generate target specific proc exit code }
         cg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions));

+ 81 - 33
compiler/ncnv.pas

@@ -229,6 +229,8 @@ interface
     procedure arrayconstructor_to_set(var p : tnode);
     procedure insert_varargstypeconv(var p : tnode; iscvarargs: boolean);
 
+    function maybe_global_proc_to_nested(var fromnode: tnode; todef: tdef): boolean;
+
 
 implementation
 
@@ -669,6 +671,39 @@ implementation
         typecheckpass(p);
       end;
 
+
+    { in FPC mode, @procname immediately has to be evaluated as a
+      procvar. If procname is global, then this will be a global
+      procvar. Since converting global procvars to local procvars is
+      not allowed (see point d in defcmp.proc_to_procvar_equal()),
+      this results in errors when passing global procedures to local
+      procvar parameters or assigning them to nested procvars. The
+      solution is to remove the (wrong) conversion to a global procvar,
+      and instead insert a conversion to the local procvar type. }
+    function maybe_global_proc_to_nested(var fromnode: tnode; todef: tdef): boolean;
+      var
+        hp: tnode;
+      begin
+        result:=false;
+        if (m_nested_procvars in current_settings.modeswitches) and
+           not(m_tp_procvar in current_settings.modeswitches) and
+           (todef.typ=procvardef) and
+           is_nested_pd(tprocvardef(todef)) and
+           (fromnode.nodetype=typeconvn) and
+           (ttypeconvnode(fromnode).convtype=tc_proc_2_procvar) and
+           not is_nested_pd(tprocvardef(fromnode.resultdef)) and
+           (proc_to_procvar_equal(tprocdef(ttypeconvnode(fromnode).left.resultdef),tprocvardef(todef),false)>=te_convert_l1) then
+          begin
+            hp:=fromnode;
+            fromnode:=ctypeconvnode.create_proc_to_procvar(ttypeconvnode(fromnode).left);
+            ttypeconvnode(fromnode).totypedef:=todef;
+            typecheckpass(fromnode);
+            ttypeconvnode(hp).left:=nil;
+            hp.free;
+            result:=true;
+          end;
+      end;
+
 {*****************************************************************************
                            TTYPECONVNODE
 *****************************************************************************}
@@ -1547,37 +1582,44 @@ implementation
     function ttypeconvnode.typecheck_proc_to_procvar : tnode;
       var
         pd : tabstractprocdef;
+        nestinglevel : byte;
       begin
         result:=nil;
         pd:=tabstractprocdef(left.resultdef);
 
-        { create procvardef }
-        resultdef:=tprocvardef.create(pd.parast.symtablelevel);
-        tprocvardef(resultdef).proctypeoption:=pd.proctypeoption;
-        tprocvardef(resultdef).proccalloption:=pd.proccalloption;
-        tprocvardef(resultdef).procoptions:=pd.procoptions;
-        tprocvardef(resultdef).returndef:=pd.returndef;
-
-        { method ? then set the methodpointer flag }
-        if (pd.owner.symtabletype=ObjectSymtable) then
-          include(tprocvardef(resultdef).procoptions,po_methodpointer);
-
-        { was it a local procedure? }
-        if (pd.owner.symtabletype=localsymtable) then
-          include(tprocvardef(resultdef).procoptions,po_local);
-
-        { only need the address of the method? this is needed
-          for @tobject.create. In this case there will be a loadn without
-          a methodpointer. }
-        if (left.nodetype=loadn) and
-           not assigned(tloadnode(left).left) then
-          include(tprocvardef(resultdef).procoptions,po_addressonly);
-
-        { Add parameters use only references, we don't need to keep the
-          parast. We use the parast from the original function to calculate
-          our parameter data and reset it afterwards }
-        pd.parast.SymList.ForEachCall(@copyparasym,tprocvardef(resultdef).parast);
-        tprocvardef(resultdef).calcparas;
+        { create procvardef (default for create_proc_to_procvar is voiddef,
+          but if later a regular inserttypeconvnode() is used to insert a type
+          conversion to the actual procvardef, totypedef will be set to the
+          real procvartype that we are converting to) }
+        if assigned(totypedef) and
+           (totypedef.typ=procvardef) then
+          resultdef:=totypedef
+        else
+         begin
+           nestinglevel:=pd.parast.symtablelevel;
+           resultdef:=tprocvardef.create(nestinglevel);
+           tprocvardef(resultdef).proctypeoption:=pd.proctypeoption;
+           tprocvardef(resultdef).proccalloption:=pd.proccalloption;
+           tprocvardef(resultdef).procoptions:=pd.procoptions;
+           tprocvardef(resultdef).returndef:=pd.returndef;
+           { method ? then set the methodpointer flag }
+           if (pd.owner.symtabletype=ObjectSymtable) then
+             include(tprocvardef(resultdef).procoptions,po_methodpointer);
+           { only need the address of the method? this is needed
+             for @tobject.create. In this case there will be a loadn without
+             a methodpointer. }
+           if (left.nodetype=loadn) and
+              not assigned(tloadnode(left).left) and
+              (not(m_nested_procvars in current_settings.modeswitches) or
+               not is_nested_pd(tprocvardef(resultdef))) then
+             include(tprocvardef(resultdef).procoptions,po_addressonly);
+
+           { Add parameters use only references, we don't need to keep the
+             parast. We use the parast from the original function to calculate
+             our parameter data and reset it afterwards }
+           pd.parast.SymList.ForEachCall(@copyparasym,tprocvardef(resultdef).parast);
+           tprocvardef(resultdef).calcparas;
+         end;
       end;
 
 
@@ -1804,7 +1846,13 @@ implementation
                         (proc_to_procvar_equal(currprocdef,tprocvardef(resultdef),false)=te_incompatible) then
                        IncompatibleTypes(left.resultdef,resultdef);
                      exit;
-                   end;
+                   end
+                  else if maybe_global_proc_to_nested(left,resultdef) then
+                    begin
+                      result:=left;
+                      left:=nil;
+                      exit;
+                    end;
 
                   { Handle explicit type conversions }
                   if nf_explicit in flags then
@@ -2164,7 +2212,7 @@ implementation
                  methodpointer. The typeconv of the methodpointer will then
                  take care of updateing size of niln to OS_64 }
                if not((resultdef.typ=procvardef) and
-                      (po_methodpointer in tprocvardef(resultdef).procoptions)) then
+                      not(tprocvardef(resultdef).is_addressonly)) then
                  begin
                    left.resultdef:=resultdef;
                    if ([nf_explicit,nf_internal] * flags <> []) then
@@ -2615,10 +2663,10 @@ implementation
     function ttypeconvnode.first_proc_to_procvar : tnode;
       begin
          first_proc_to_procvar:=nil;
-         { if we take the address of a nested function, it'll  }
-         { probably be used in a foreach() construct and then  }
-         { the parent needs a stackframe                       }
-         if (tprocdef(left.resultdef).parast.symtablelevel>=normal_function_level) then
+         { if we take the address of a nested function, the current function/
+           procedure needs a stack frame since it's required to construct
+           the nested procvar }
+         if is_nested_pd(tprocvardef(resultdef)) then
            include(current_procinfo.flags,pi_needs_stackframe);
          if tabstractprocdef(resultdef).is_addressonly then
            expectloc:=LOC_REGISTER

+ 22 - 4
compiler/nld.pas

@@ -333,7 +333,7 @@ implementation
                  that the address needs to be returned }
                resultdef:=fprocdef;
 
-               { process methodpointer }
+               { process methodpointer/framepointer }
                if assigned(left) then
                  typecheckpass(left);
              end;
@@ -391,7 +391,10 @@ implementation
               end;
             procsym :
                 begin
-                   { method pointer ? }
+                   { initialise left for nested procs if necessary }
+                   if (m_nested_procvars in current_settings.modeswitches) then
+                     setprocdef(fprocdef);
+                   { method pointer or nested proc ? }
                    if assigned(left) then
                      begin
                         expectloc:=LOC_CREFERENCE;
@@ -430,8 +433,23 @@ implementation
       begin
         fprocdef:=p;
         resultdef:=p;
-        if po_local in p.procoptions then
-          CGMessage(type_e_cant_take_address_of_local_subroutine);
+        { nested procedure? }
+        if assigned(p) and
+           is_nested_pd(p) then
+          begin
+            if not(m_nested_procvars in current_settings.modeswitches) then
+              CGMessage(type_e_cant_take_address_of_local_subroutine)
+            else
+              begin
+                { parent frame pointer pointer as "self" }
+                left.free;
+                left:=cloadparentfpnode.create(tprocdef(p.owner.defowner));
+              end;
+          end
+        { we should never go from nested to non-nested }
+        else if assigned(left) and
+                (left.nodetype=loadparentfpn) then
+          internalerror(2010072201);
       end;
 
 {*****************************************************************************

+ 4 - 3
compiler/nmem.pas

@@ -453,9 +453,10 @@ implementation
                   end
                 else
                   begin
-                    { For procvars we need to return the proc field of the
-                      methodpointer }
-                    if isprocvar then
+                    { For procvars and for nested routines we need to return
+                      the proc field of the methodpointer }
+                    if isprocvar or
+                       is_nested_pd(tabstractprocdef(left.resultdef)) then
                       begin
                         { find proc field in methodpointer record }
                         hsym:=tfieldvarsym(trecorddef(methodpointertype).symtable.Find('proc'));

+ 3 - 1
compiler/nutils.pas

@@ -97,7 +97,7 @@ interface
     function is_bitpacked_access(n: tnode): boolean;
 
     { creates a load of field 'fieldname' in the record/class/...
-      represented by n; assumes the resultdef of n is set }
+      represented by n }
     function genloadfield(n: tnode; const fieldname: string): tnode;
 
 
@@ -1104,6 +1104,8 @@ implementation
       var
         vs         : tsym;
       begin
+        if not assigned(n.resultdef) then
+          typecheckpass(n);
         vs:=tsym(tabstractrecorddef(n.resultdef).symtable.find(fieldname));
         if not assigned(vs) or
            (vs.typ<>fieldvarsym) then

+ 1 - 1
compiler/paramgr.pas

@@ -153,7 +153,7 @@ implementation
          ret_in_param:=((def.typ=arraydef) and not(is_dynamic_array(def))) or
            (def.typ=recorddef) or
            (def.typ=stringdef) or
-           ((def.typ=procvardef) and (po_methodpointer in tprocvardef(def).procoptions)) or
+           ((def.typ=procvardef) and not tprocvardef(def).is_addressonly) or
            { interfaces are also passed by reference to be compatible with delphi and COM }
            ((def.typ=objectdef) and (is_object(def) or is_interface(def))) or
            (def.typ=variantdef) or

+ 19 - 4
compiler/pdecsub.pas

@@ -137,6 +137,7 @@ implementation
       var
         storepos : tfileposinfo;
         vs       : tparavarsym;
+        paranr   : longint;
       begin
         if pd.parast.symtablelevel>normal_function_level then
           begin
@@ -144,10 +145,23 @@ implementation
             if pd.typ=procdef then
              current_tokenpos:=tprocdef(pd).fileinfo;
 
+            { if no support for nested procvars is activated, use the old
+              calling convention to pass the parent frame pointer for backwards
+              compatibility }
+            if not(m_nested_procvars in current_settings.modeswitches) then
+              paranr:=paranr_parentfp
+            { nested procvars require Delphi-style parentfp passing, see
+              po_delphi_nested_cc declaration for more info }
+{$ifdef i386}
+            else if (pd.proccalloption in pushleftright_pocalls) then
+              paranr:=paranr_parentfp_delphi_cc_leftright
+{$endif i386}
+            else
+              paranr:=paranr_parentfp_delphi_cc;
             { Generate result variable accessing function result, it
               can't be put in a register since it must be accessable
               from the framepointer }
-            vs:=tparavarsym.create('$parentfp',paranr_parentfp,vs_value
+            vs:=tparavarsym.create('$parentfp',paranr,vs_value
                   ,voidpointertype,[vo_is_parentfp,vo_is_hidden_para]);
             vs.varregable:=vr_none;
             pd.parast.insert(vs);
@@ -467,14 +481,14 @@ implementation
                 break;
               end
           else
-            if (m_mac in current_settings.modeswitches) and
+            if (m_nested_procvars in current_settings.modeswitches) and
                try_to_consume(_PROCEDURE) then
               begin
                 parseprocvar:=pv_proc;
                 varspez:=vs_const;
               end
           else
-            if (m_mac in current_settings.modeswitches) and
+            if (m_nested_procvars in current_settings.modeswitches) and
                try_to_consume(_FUNCTION) then
               begin
                 parseprocvar:=pv_func;
@@ -500,7 +514,8 @@ implementation
           { macpas anonymous procvar }
           if parseprocvar<>pv_none then
            begin
-             pv:=tprocvardef.create(normal_function_level);
+             { inline procvar definitions are always nested procvars }
+             pv:=tprocvardef.create(normal_function_level+1);
              if token=_LKLAMMER then
                parse_parameter_dec(pv);
              if parseprocvar=pv_func then

+ 5 - 1
compiler/powerpc/cpupara.pas

@@ -486,8 +486,12 @@ unit cpupara;
               while (paralen > 0) do
                 begin
                   paraloc:=hp.paraloc[side].add_location;
+                  { In case of po_delphi_nested_cc, the parent frame pointer
+                    is always passed on the stack. }
                   if (loc = LOC_REGISTER) and
-                     (nextintreg <= RS_R10) then
+                     (nextintreg <= RS_R10) and
+                     (not(vo_is_parentfp in hp.varoptions) or
+                      not(po_delphi_nested_cc in p.procoptions)) then
                     begin
                       paraloc^.loc := loc;
                       { make sure we don't lose whether or not the type is signed }

+ 6 - 1
compiler/powerpc64/cpupara.pas

@@ -398,7 +398,12 @@ begin
 
     while (paralen > 0) do begin
       paraloc := hp.paraloc[side].add_location;
-      if (loc = LOC_REGISTER) and (nextintreg <= RS_R10) then begin
+      { In case of po_delphi_nested_cc, the parent frame pointer
+        is always passed on the stack. }
+      if (loc = LOC_REGISTER) and
+         (nextintreg <= RS_R10) and
+         (not(vo_is_parentfp in hp.varoptions) or
+          not(po_delphi_nested_cc in p.procoptions)) then begin
         paraloc^.loc := loc;
         paraloc^.shiftval := parashift;
 

+ 6 - 2
compiler/pp.lpi

@@ -2,7 +2,7 @@
 <CONFIG>
   <ProjectOptions>
     <PathDelim Value="\"/>
-    <Version Value="7"/>
+    <Version Value="8"/>
     <General>
       <Flags>
         <MainUnitHasUsesSectionForAllUnits Value="False"/>
@@ -15,6 +15,9 @@
       <TargetFileExt Value=".exe"/>
       <Title Value="pp"/>
     </General>
+    <VersionInfo>
+      <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion="0.0.0.0"/>
+    </VersionInfo>
     <PublishOptions>
       <Version Value="2"/>
       <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
@@ -41,7 +44,7 @@
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="8"/>
+    <Version Value="9"/>
     <PathDelim Value="\"/>
     <Target>
       <Filename Value="i386\pp"/>
@@ -56,6 +59,7 @@
         <CStyleOperator Value="False"/>
         <AllowLabel Value="False"/>
         <CPPInline Value="False"/>
+        <UseAnsiStrings Value="False"/>
       </SyntaxOptions>
     </Parsing>
     <Linking>

+ 1 - 1
compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 119;
+  CurrentPPUVersion = 120;
 
 { buffer sizes }
   maxentrysize = 1024;

+ 11 - 2
compiler/ptconst.pas

@@ -464,7 +464,7 @@ implementation
             end
           else
             if (p.nodetype=addrn) or
-               is_procvar_load(p) then
+               is_proc2procvar_load(p,pd) then
               begin
                 { insert typeconv }
                 inserttypeconv(p,def);
@@ -958,7 +958,7 @@ implementation
           if try_to_consume(_NIL) then
             begin
                list.concat(Tai_const.Create_sym(nil));
-               if (po_methodpointer in def.procoptions) then
+               if not def.is_addressonly then
                  list.concat(Tai_const.Create_sym(nil));
                exit;
             end;
@@ -1007,6 +1007,15 @@ implementation
             begin
               pd:=tloadnode(n).procdef;
               list.concat(Tai_const.createname(pd.mangledname,0));
+              { nested procvar typed consts can only be initialised with nil
+                (checked above) or with a global procedure (checked here),
+                because in other cases we need a valid frame pointer }
+              if is_nested_pd(def) then
+                begin
+                  if is_nested_pd(pd) then
+                    Message(parser_e_no_procvarnested_const);
+                  list.concat(Tai_const.Create_sym(nil));
+                end
             end
           else
             Message(parser_e_illegal_expression);

+ 8 - 2
compiler/ptype.pas

@@ -1065,11 +1065,17 @@ implementation
                    consume(_COLON);
                    single_type(pd.returndef,false,false);
                  end;
-                if token=_OF then
+                if try_to_consume(_OF) then
                   begin
-                    consume(_OF);
                     consume(_OBJECT);
                     include(pd.procoptions,po_methodpointer);
+                  end
+                else if (m_nested_procvars in current_settings.modeswitches) and
+                        try_to_consume(_IS) then
+                  begin
+                    consume(_NESTED);
+                    pd.parast.symtablelevel:=normal_function_level+1;
+                    pd.check_mark_as_nested;
                   end;
                 def:=pd;
                 { possible proc directives }

+ 6 - 2
compiler/sparc/cpupara.pas

@@ -132,7 +132,7 @@ implementation
           stringdef :
             result:=(tstringdef(def).stringtype in [st_shortstring,st_longstring]);
           procvardef :
-            result:=(po_methodpointer in tprocvardef(def).procoptions);
+            result:=not tprocvardef(def).is_addressonly;
           setdef :
             result:=not is_smallset(def);
         end;
@@ -294,7 +294,11 @@ implementation
                       paraloc^.reference.index:=NR_FRAME_POINTER_REG;
                     paraloc^.reference.offset:=64;
                   end
-                else if (intparareg<=high(tparasupregs)) then
+                { In case of po_delphi_nested_cc, the parent frame pointer
+                  is always passed on the stack. }
+                else if (intparareg<=high(tparasupregs)) and
+                   (not(vo_is_parentfp in hp.varoptions) or
+                    not(po_delphi_nested_cc in p.procoptions)) then
                   begin
                     paraloc^.loc:=LOC_REGISTER;
                     paraloc^.register:=newreg(R_INTREGISTER,hparasupregs^[intparareg],R_SUBWHOLE);

+ 16 - 7
compiler/symconst.pas

@@ -109,6 +109,7 @@ const
     and will increase with 10 for each parameter. The high parameters
     will be inserted with n+1 }
   paranr_parentfp = 1;
+  paranr_parentfp_delphi_cc_leftright = 1;
   paranr_self = 2;
   paranr_result = 3;
   paranr_vmt = 4;
@@ -118,11 +119,12 @@ const
   paranr_objc_self = 4;
   paranr_objc_cmd = 5;
   { Required to support variations of syscalls on MorphOS }
-  paranr_syscall_basesysv = 9;
-  paranr_syscall_sysvbase = high(word)-4;
-  paranr_syscall_r12base  = high(word)-3;
-  paranr_syscall_legacy   = high(word)-2;
-  paranr_result_leftright = high(word)-1;
+  paranr_syscall_basesysv    = 9;
+  paranr_syscall_sysvbase    = high(word)-5;
+  paranr_syscall_r12base     = high(word)-4;
+  paranr_syscall_legacy      = high(word)-3;
+  paranr_result_leftright    = high(word)-2;
+  paranr_parentfp_delphi_cc  = high(word)-1;
 
   { prefix for names of class helper procsyms added to regular symtables }
   class_helper_prefix = 'CH$';
@@ -282,7 +284,6 @@ type
     po_syscall_basesysv,
     po_syscall_sysvbase,
     po_syscall_r12base,
-    po_local,
     { Procedure can be inlined }
     po_inline,
     { Procedure is used for internal compiler calls }
@@ -299,7 +300,15 @@ type
     { enumerator support }
     po_enumerator_movenext,
     { optional Objective-C protocol method }
-    po_optional
+    po_optional,
+    { nested procedure that uses Delphi-style calling convention for passing
+      the frame pointer (pushed on the stack, always the last parameter,
+      removed by the caller). Required for nested procvar compatibility,
+      because such procvars can hold both regular and nested procedures
+      (when calling a regular procedure using the above convention, it will
+       simply not see the frame pointer parameter, and since the caller cleans
+       up the stack will also remain balanced) }
+    po_delphi_nested_cc
   );
   tprocoptions=set of tprocoption;
 

+ 36 - 10
compiler/symdef.pas

@@ -423,6 +423,7 @@ interface
           function  is_methodpointer:boolean;virtual;
           function  is_addressonly:boolean;virtual;
           function  no_self_node:boolean;
+          procedure check_mark_as_nested;
        private
           procedure count_para(p:TObject;arg:pointer);
           procedure insert_para(p:TObject;arg:pointer);
@@ -1170,7 +1171,7 @@ implementation
           classrefdef:
             is_intregable:=true;
           procvardef :
-            is_intregable:=not(po_methodpointer in tprocvardef(self).procoptions);
+            is_intregable:=tprocvardef(self).is_addressonly;
           objectdef:
             is_intregable:=(is_class_or_interface_or_dispinterface_or_objc(self)) and not needs_inittable;
           setdef:
@@ -2751,6 +2752,7 @@ implementation
          has_paraloc_info:=false;
          funcretloc[callerside].init;
          funcretloc[calleeside].init;
+         check_mark_as_nested;
       end;
 
 
@@ -3011,6 +3013,16 @@ implementation
       end;
 
 
+    procedure tabstractprocdef.check_mark_as_nested;
+      begin
+         { nested procvars require that nested functions use the Delphi-style
+           nested procedure calling convention }
+         if (parast.symtablelevel>normal_function_level) and
+            (m_nested_procvars in current_settings.modeswitches) then
+           include(procoptions,po_delphi_nested_cc);
+      end;
+
+
 {***************************************************************************
                                   TPROCDEF
 ***************************************************************************}
@@ -3286,8 +3298,6 @@ implementation
               not (proctypeoption in [potype_class_constructor,potype_class_destructor]) then
              s:='class ' + s;
          end;
-        if owner.symtabletype=localsymtable then
-          s:='local ' + s;
         if proctypeoption=potype_operator then
           begin
             for t:=NOTOKEN to last_overloaded do
@@ -3313,6 +3323,8 @@ implementation
               not(is_void(returndef)) then
               s:=s+':'+returndef.GetTypeName;
         end;
+        if owner.symtabletype=localsymtable then
+          s:=s+' is nested';
         s:=s+';';
         { forced calling convention? }
         if (po_hascallingconvention in procoptions) then
@@ -3333,7 +3345,9 @@ implementation
     function tprocdef.is_addressonly:boolean;
       begin
         result:=assigned(owner) and
-                (owner.symtabletype<>ObjectSymtable);
+                (owner.symtabletype<>ObjectSymtable) and
+                (not(m_nested_procvars in current_settings.modeswitches) or
+                 not is_nested_pd(self));
       end;
 
     function tprocdef.GetSymtable(t:tGetSymtable):TSymtable;
@@ -3707,7 +3721,7 @@ implementation
       begin
          inherited ppuload(procvardef,ppufile);
          { load para symtable }
-         parast:=tparasymtable.create(self,unknown_level);
+         parast:=tparasymtable.create(self,ppufile.getbyte);
          tparasymtable(parast).ppuload(ppufile);
       end;
 
@@ -3748,6 +3762,10 @@ implementation
       begin
         inherited ppuwrite(ppufile);
 
+        { Save the para symtable level (necessary to distinguish nested
+          procvars) }
+        ppufile.putbyte(parast.symtablelevel);
+
         { Write this entry }
         ppufile.writeentry(ibprocvardef);
 
@@ -3769,7 +3787,8 @@ implementation
 
     function tprocvardef.size : aint;
       begin
-         if (po_methodpointer in procoptions) and
+         if ((po_methodpointer in procoptions) or
+             is_nested_pd(self)) and
             not(po_addressonly in procoptions) then
            size:=2*sizeof(pint)
          else
@@ -3785,14 +3804,21 @@ implementation
 
     function tprocvardef.is_addressonly:boolean;
       begin
-        result:=not(po_methodpointer in procoptions) or
+        result:=(not(po_methodpointer in procoptions) and
+                 not is_nested_pd(self)) or
                 (po_addressonly in procoptions);
       end;
 
 
     function tprocvardef.getmangledparaname:string;
       begin
-        result:='procvar';
+        if not(po_methodpointer in procoptions) then
+          if not is_nested_pd(self) then
+            result:='procvar'
+          else
+            result:='nestedprovar'
+        else
+          result:='procvarofobj'
       end;
 
 
@@ -3820,8 +3846,6 @@ implementation
              s := s+'address of'
            else
              s := s+'procedure variable type of';
-         if po_local in procoptions then
-           s := s+' local';
          if assigned(returndef) and
             (returndef<>voidtype) then
            s:=s+' function'+typename_paras(showhidden)+':'+returndef.GetTypeName
@@ -3829,6 +3853,8 @@ implementation
            s:=s+' procedure'+typename_paras(showhidden);
          if po_methodpointer in procoptions then
            s := s+' of object';
+         if is_nested_pd(self) then
+           s := s+' is nested';
          GetTypeName := s+';'+ProcCallOptionStr[proccalloption]+'>';
       end;
 

+ 1 - 1
compiler/symsym.pas

@@ -698,7 +698,7 @@ implementation
           begin
             pd:=tprocdef(ProcdefList[i]);
             eq:=proc_to_procvar_equal(pd,d,false);
-            if eq>=te_equal then
+            if eq>=te_convert_l1 then
               begin
                 { multiple procvars with the same equal level }
                 if assigned(bestpd) and

+ 2 - 0
compiler/tokens.pas

@@ -164,6 +164,7 @@ type
     _EXPORT,
     _INLINE,
     _LEGACY,
+    _NESTED,
     _OBJECT,
     _PACKED,
     _PASCAL,
@@ -425,6 +426,7 @@ const
       (str:'EXPORT'        ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'INLINE'        ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'LEGACY'        ;special:false;keyword:m_none;op:NOTOKEN),   { Syscall variation on MorphOS }
+      (str:'NESTED'        ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'OBJECT'        ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'PACKED'        ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'PASCAL'        ;special:false;keyword:m_none;op:NOTOKEN),

+ 0 - 0
tests/test/tmaclocalprocparam.pp → tests/test/tmaclocalprocparam1.pp


+ 46 - 0
tests/test/tmaclocalprocparam1a.pp

@@ -0,0 +1,46 @@
+program tmaclocalprocparam;
+{$MODE MACPAS}
+
+        type
+                tnestedproc = procedure is nested;
+
+	var
+		failed: Boolean;
+
+
+	procedure Outside (P: tnestedproc);
+	begin
+		P;
+	end;
+
+	procedure Global;
+
+		var
+			nonlocalvar: integer;
+
+		procedure Local;
+		begin
+			nonlocalvar := 42;
+		end;
+
+	begin
+		nonlocalvar := 24;
+		Outside(Local);
+		failed := (nonlocalvar <> 42);
+	end;
+
+
+
+begin
+	Global;
+
+	if failed then
+		writeln('Failed')
+	else
+		writeln('Succeded');
+
+   {$IFC UNDEFINED THINK_Pascal}
+	if failed then
+		Halt(1);
+   {$ENDC}
+end.

+ 49 - 0
tests/test/tmaclocalprocparam2.pp

@@ -0,0 +1,49 @@
+{$mode macpas}
+program tmaclocalprocparam2;
+
+  procedure p1( procedure pp( pi: longint); i: longint);
+  begin
+    pp( i)
+  end;
+
+  procedure p2( procedure pp( pi: longint); i: longint);
+  begin
+    p1( pp, i)
+  end;
+
+  procedure n( ri: longint);
+  begin
+    if ri = 1 then
+      writeln( 'success for n')
+    else
+      begin
+        writeln( 'fail');
+        halt( 1)
+      end
+   end;
+
+  procedure q;
+  var qi: longint;
+
+    procedure r( ri: longint);
+    begin
+      if qi = ri then
+        writeln( 'success for r')
+      else
+        begin
+        writeln( 'fail');
+        halt( 1)
+      end
+    end;
+
+  begin
+    qi:= 1;
+    p1( r, qi);
+    p2( r, qi);
+    p1( n, qi);
+    p2( n, qi);
+  end;
+
+begin
+    q
+end.

+ 51 - 0
tests/test/tmaclocalprocparam2a.pp

@@ -0,0 +1,51 @@
+{$mode fpc}
+{$modeswitch nestedprocvars}
+
+program tmaclocalprocparam2;
+
+  procedure p1( procedure pp( pi: longint); i: longint);
+  begin
+    pp( i)
+  end;
+
+  procedure p2( procedure pp( pi: longint); i: longint);
+  begin
+    p1( pp, i)
+  end;
+
+  procedure n( ri: longint);
+  begin
+    if ri = 1 then
+      writeln( 'success for n')
+    else
+      begin
+        writeln( 'fail');
+        halt( 1)
+      end
+   end;
+
+  procedure q;
+  var qi: longint;
+
+    procedure r( ri: longint);
+    begin
+      if qi = ri then
+        writeln( 'success for r')
+      else
+        begin
+        writeln( 'fail');
+        halt( 1)
+      end
+    end;
+
+  begin
+    qi:= 1;
+    p1( @r, qi);
+    p2( @r, qi);
+    p1( @n, qi);
+    p2( @n, qi);
+  end;
+
+begin
+    q
+end.

+ 50 - 0
tests/test/tmaclocalprocparam2b.pp

@@ -0,0 +1,50 @@
+{$mode tp}
+{$modeswitch nestedprocvars}
+program tmaclocalprocparam2;
+
+  procedure p1( procedure pp( pi: longint); i: longint);
+  begin
+    pp( i)
+  end;
+
+  procedure p2( procedure pp( pi: longint); i: longint);
+  begin
+    p1( pp, i)
+  end;
+
+  procedure n( ri: longint);
+  begin
+    if ri = 1 then
+      writeln( 'success for n')
+    else
+      begin
+        writeln( 'fail');
+        halt( 1)
+      end
+   end;
+
+  procedure q;
+  var qi: longint;
+
+    procedure r( ri: longint);
+    begin
+      if qi = ri then
+        writeln( 'success for r')
+      else
+        begin
+        writeln( 'fail');
+        halt( 1)
+      end
+    end;
+
+  begin
+    qi:= 1;
+    p1( r, qi);
+    p2( r, qi);
+    p1( n, qi);
+    p2( n, qi);
+  end;
+
+begin
+    q
+end.

+ 52 - 0
tests/test/tmaclocalprocparam2c.pp

@@ -0,0 +1,52 @@
+{$mode macpas}
+program tmaclocalprocparam2;
+
+type
+  tnestedprocvar = procedure ( pi: longint) is nested;
+
+  procedure p1(pp: tnestedprocvar ; i: longint);
+  begin
+    pp( i)
+  end;
+
+  procedure p2(pp: tnestedprocvar ; i: longint);
+  begin
+    p1( pp, i)
+  end;
+
+  procedure n( ri: longint);
+  begin
+    if ri = 1 then
+      writeln( 'success for n')
+    else
+      begin
+        writeln( 'fail');
+        halt( 1)
+      end
+   end;
+
+  procedure q;
+  var qi: longint;
+
+    procedure r( ri: longint);
+    begin
+      if qi = ri then
+        writeln( 'success for r')
+      else
+        begin
+        writeln( 'fail');
+        halt( 1)
+      end
+    end;
+
+  begin
+    qi:= 1;
+    p1( r, qi);
+    p2( r, qi);
+    p1( n, qi);
+    p2( n, qi);
+  end;
+
+begin
+    q
+end.

+ 54 - 0
tests/test/tmaclocalprocparam2d.pp

@@ -0,0 +1,54 @@
+{$mode fpc}
+{$modeswitch nestedprocvars}
+
+program tmaclocalprocparam2;
+
+type
+  tnestedprocvar = procedure ( pi: longint) is nested;
+
+  procedure p1(pp: tnestedprocvar; i: longint);
+  begin
+    pp( i)
+  end;
+
+  procedure p2( pp: tnestedprocvar; i: longint);
+  begin
+    p1( pp, i)
+  end;
+
+  procedure n( ri: longint);
+  begin
+    if ri = 1 then
+      writeln( 'success for n')
+    else
+      begin
+        writeln( 'fail');
+        halt( 1)
+      end
+   end;
+
+  procedure q;
+  var qi: longint;
+
+    procedure r( ri: longint);
+    begin
+      if qi = ri then
+        writeln( 'success for r')
+      else
+        begin
+        writeln( 'fail');
+        halt( 1)
+      end
+    end;
+
+  begin
+    qi:= 1;
+    p1( @r, qi);
+    p2( @r, qi);
+    p1( @n, qi);
+    p2( @n, qi);
+  end;
+
+begin
+    q
+end.

+ 53 - 0
tests/test/tmaclocalprocparam2e.pp

@@ -0,0 +1,53 @@
+{$mode tp}
+{$modeswitch nestedprocvars}
+program tmaclocalprocparam2;
+
+type
+  tnestedprocvar = procedure( pi: longint) is nested;
+
+  procedure p1(pp: tnestedprocvar ; i: longint);
+  begin
+    pp( i)
+  end;
+
+  procedure p2( pp: tnestedprocvar; i: longint);
+  begin
+    p1( pp, i)
+  end;
+
+  procedure n( ri: longint);
+  begin
+    if ri = 1 then
+      writeln( 'success for n')
+    else
+      begin
+        writeln( 'fail');
+        halt( 1)
+      end
+   end;
+
+  procedure q;
+  var qi: longint;
+
+    procedure r( ri: longint);
+    begin
+      if qi = ri then
+        writeln( 'success for r')
+      else
+        begin
+        writeln( 'fail');
+        halt( 1)
+      end
+    end;
+
+  begin
+    qi:= 1;
+    p1( r, qi);
+    p2( r, qi);
+    p1( n, qi);
+    p2( n, qi);
+  end;
+
+begin
+    q
+end.

+ 61 - 0
tests/test/tmaclocalprocparam2f.pp

@@ -0,0 +1,61 @@
+{$mode macpas}
+program tmaclocalprocparam2;
+
+type
+  tnestedprocvar = procedure ( pi: longint) is nested;
+
+  procedure p1(pp: tnestedprocvar ; i: longint);
+  begin
+    pp( i)
+  end;
+
+  procedure p2(pp: tnestedprocvar ; i: longint);
+  begin
+    p1( pp, i)
+  end;
+
+  procedure n( ri: longint);
+  begin
+    if ri = 1 then
+      writeln( 'success for n')
+    else
+      begin
+        writeln( 'fail');
+        halt( 1)
+      end
+   end;
+
+  procedure q;
+  var qi: longint;
+
+    procedure r( ri: longint);
+      var
+        si: longint;
+
+      procedure g( ri: longint);
+        begin
+          if qi = ri then
+            writeln( 'success for g')
+          else
+            begin
+              writeln( 'fail');
+              halt( 1)
+           end
+        end;
+
+      begin
+        si:=ri;
+        p1( g, qi);
+        p2( g, qi);
+        p1( g, qi);
+        p2( g, qi);
+      end;
+
+  begin
+    qi:= 1;
+    r(qi);
+  end;
+
+begin
+    q
+end.

+ 43 - 0
tests/test/tmaclocalprocparam3.pp

@@ -0,0 +1,43 @@
+{$mode macpas}
+program tmaclocalprocparam3;
+
+  procedure p1( procedure pp);
+  begin
+    pp
+  end;
+
+  procedure p2( procedure pp);
+  begin
+    p1( pp)
+  end;
+
+  procedure n;
+  begin
+    writeln( 'calling through n')
+  end;
+
+  procedure q;
+  var qi: longint;
+
+    procedure r;
+    begin
+      if qi = 1 then
+        writeln( 'success for r')
+      else
+        begin
+        writeln( 'fail');
+        halt( 1)
+      end
+    end;
+
+  begin
+    qi:= 1;
+    p1( r);
+    p2( r);
+    p1( n);
+    p2( n);
+  end;
+
+begin
+	q
+end.

+ 43 - 0
tests/test/tmaclocalprocparam3a.pp

@@ -0,0 +1,43 @@
+{$modeswitch nestedprocvars}
+program tmaclocalprocparam3;
+
+  procedure p1( procedure pp);
+  begin
+    pp
+  end;
+
+  procedure p2( procedure pp);
+  begin
+    p1( pp)
+  end;
+
+  procedure n;
+  begin
+    writeln( 'calling through n')
+  end;
+
+  procedure q;
+  var qi: longint;
+
+    procedure r;
+    begin
+      if qi = 1 then
+        writeln( 'success for r')
+      else
+        begin
+        writeln( 'fail');
+        halt( 1)
+      end
+    end;
+
+  begin
+    qi:= 1;
+    p1( @r);
+    p2( @r);
+    p1( @n);
+    p2( @n);
+  end;
+
+begin
+	q
+end.

+ 44 - 0
tests/test/tmaclocalprocparam3b.pp

@@ -0,0 +1,44 @@
+{$mode tp}
+{$modeswitch nestedprocvars}
+program tmaclocalprocparam3;
+
+  procedure p1( procedure pp);
+  begin
+    pp
+  end;
+
+  procedure p2( procedure pp);
+  begin
+    p1( pp)
+  end;
+
+  procedure n;
+  begin
+    writeln( 'calling through n')
+  end;
+
+  procedure q;
+  var qi: longint;
+
+    procedure r;
+    begin
+      if qi = 1 then
+        writeln( 'success for r')
+      else
+        begin
+        writeln( 'fail');
+        halt( 1)
+      end
+    end;
+
+  begin
+    qi:= 1;
+    p1( r);
+    p2( r);
+    p1( n);
+    p2( n);
+  end;
+
+begin
+	q
+end.

+ 53 - 0
tests/test/tmaclocalprocparam3c.pp

@@ -0,0 +1,53 @@
+{$mode macpas}
+program tmaclocalprocparam3;
+
+type
+  tnestedprocvar = procedure is nested;
+
+var
+  tempp: tnestedprocvar;
+
+  procedure p1( pp: tnestedprocvar);
+  begin
+    tempp:=pp;
+    tempp
+  end;
+
+  procedure p2( pp: tnestedprocvar);
+  var
+    localpp: tnestedprocvar;
+  begin
+    localpp:=pp;
+    p1( localpp)
+  end;
+
+  procedure n;
+  begin
+    writeln( 'calling through n')
+  end;
+
+  procedure q;
+  var qi: longint;
+
+    procedure r;
+    begin
+      if qi = 1 then
+        writeln( 'success for r')
+      else
+        begin
+        writeln( 'fail');
+        halt( 1)
+      end
+    end;
+
+  begin
+    qi:= 1;
+    p1( r);
+    p2( r);
+    p1( n);
+    p2( n);
+  end;
+
+begin
+	q
+end.

+ 53 - 0
tests/test/tmaclocalprocparam3d.pp

@@ -0,0 +1,53 @@
+{$modeswitch nestedprocvars}
+program tmaclocalprocparam3;
+
+type
+  tnestedprocvar = procedure is nested;
+
+var
+  tempp: tnestedprocvar;
+
+  procedure p1( pp: tnestedprocvar);
+  begin
+    tempp:=pp;
+    tempp
+  end;
+
+  procedure p2( pp: tnestedprocvar);
+  var
+    localpp: tnestedprocvar;
+  begin
+    localpp:=pp;
+    p1( localpp)
+  end;
+
+  procedure n;
+  begin
+    writeln( 'calling through n')
+  end;
+
+  procedure q;
+  var qi: longint;
+
+    procedure r;
+    begin
+      if qi = 1 then
+        writeln( 'success for r')
+      else
+        begin
+        writeln( 'fail');
+        halt( 1)
+      end
+    end;
+
+  begin
+    qi:= 1;
+    p1( @r);
+    p2( @r);
+    p1( @n);
+    p2( @n);
+  end;
+
+begin
+	q
+end.

+ 54 - 0
tests/test/tmaclocalprocparam3e.pp

@@ -0,0 +1,54 @@
+{$mode tp}
+{$modeswitch nestedprocvars}
+program tmaclocalprocparam3;
+
+type
+  tnestedprocvar = procedure is nested;
+
+var
+  tempp: tnestedprocvar;
+
+  procedure p1( pp: tnestedprocvar);
+  begin
+    tempp:=pp;
+    tempp
+  end;
+
+  procedure p2( pp: tnestedprocvar);
+  var
+    localpp: tnestedprocvar;
+  begin
+    localpp:=pp;
+    p1( localpp)
+  end;
+
+  procedure n;
+  begin
+    writeln( 'calling through n')
+  end;
+
+  procedure q;
+  var qi: longint;
+
+    procedure r;
+    begin
+      if qi = 1 then
+        writeln( 'success for r')
+      else
+        begin
+        writeln( 'fail');
+        halt( 1)
+      end
+    end;
+
+  begin
+    qi:= 1;
+    p1( r);
+    p2( r);
+    p1( n);
+    p2( n);
+  end;
+
+begin
+	q
+end.

+ 62 - 0
tests/test/tmaclocalprocparam3f.pp

@@ -0,0 +1,62 @@
+{ %recompile }
+
+{$modeswitch nestedprocvars}
+program tmaclocalprocparam3;
+
+uses
+  umaclocalprocparam3f;
+
+var
+  tempp: tnestedprocvar2;
+
+  procedure finalglobal;
+    begin
+      writeln('final');
+    end;
+
+  procedure p1( pp: tnestedprocvar2; p: tnestedprocvar);
+  begin
+    tempp:=pp;
+    tempp(p);
+  end;
+
+  procedure p2( pp: tnestedprocvar2; p: tnestedprocvar);
+  var
+    localpp: tnestedprocvar2;
+  begin
+    localpp:=pp;
+    p1( localpp, p)
+  end;
+
+  procedure n(pp: tnestedprocvar);
+  begin
+    writeln( 'calling through n');
+    pp();
+  end;
+
+  procedure q;
+  var qi: longint;
+
+    procedure r(pp: tnestedprocvar);
+    begin
+      if qi = 1 then
+        writeln( 'success for r')
+      else
+        begin
+        writeln( 'fail');
+        halt( 1)
+      end;
+      pp();
+    end;
+
+  begin
+    qi:= 1;
+    p1( @r, @finalglobal);
+    p2( @r, @finalglobal);
+    p1( @n, @finalglobal);
+    p2( @n, @finalglobal);
+  end;
+
+begin
+	q
+end.

+ 19 - 0
tests/test/tmaclocalprocparam4.pp

@@ -0,0 +1,19 @@
+{ %fail }
+
+{$modeswitch nestedprocvars}
+
+type
+  tprocedure = procedure;
+
+procedure test(procedure nestedproc);
+begin
+end;
+
+var
+  pp: tprocedure;
+begin
+  { passing global procvars to nested procedures is not allowed to
+    ensure that they can also be implemented using compile-time
+    generated trampolines if necesarry }
+  test(pp);
+end.

+ 17 - 0
tests/test/tmaclocalprocparam4a.pp

@@ -0,0 +1,17 @@
+{ %fail }
+
+{$modeswitch nestedprocvars}
+
+type
+  tprocedure = procedure;
+  tnestedprocedure = procedure is nested;
+
+var
+  pp: tprocedure;
+  pn: tnestedprocedure;
+begin
+  { passing global procvars to nested procedures is not allowed to
+    ensure that they can also be implemented using compile-time
+    generated trampolines if necesarry }
+  pn:=pp;
+end.

+ 14 - 0
tests/test/tmaclocalprocparam4b.pp

@@ -0,0 +1,14 @@
+{ %fail }
+
+{$modeswitch nestedprocvars}
+
+type
+  tprocedure = procedure;
+  tnestedprocedure = procedure is nested;
+
+var
+  pp: tprocedure;
+  pn: tnestedprocedure;
+begin
+  pp:=pn;
+end.

+ 21 - 0
tests/test/tmaclocalprocparam4c.pp

@@ -0,0 +1,21 @@
+{ %norun }
+
+{$mode tp}
+{$modeswitch nestedprocvars}
+
+type
+  tprocedure = procedure;
+
+procedure test(p: pointer);
+
+  procedure nested;
+    begin
+    end;
+
+begin
+  { this should be a plain pointer }
+  test(@nested);
+end;
+
+begin
+end.

+ 21 - 0
tests/test/tmaclocalprocparam4d.pp

@@ -0,0 +1,21 @@
+{ %fail }
+
+{$mode tp}
+{$modeswitch nestedprocvars}
+
+type
+  tprocedure = procedure;
+
+procedure test(procedure pp);
+
+  procedure nested;
+    begin
+    end;
+
+begin
+  { this should be a plain pointer }
+  test(@nested);
+end;
+
+begin
+end.

+ 14 - 0
tests/test/tmaclocalprocparam4e.pp

@@ -0,0 +1,14 @@
+{$modeswitch nestedprocvars}
+
+function test(l: longint): longint;
+begin
+  test:=l*2;
+end;
+
+const
+  pp: function(l: longint): longint is nested = @test;
+
+begin
+  if pp(6)<>12 then
+    halt(1);
+end.

+ 21 - 0
tests/test/tmaclocalprocparam4f.pp

@@ -0,0 +1,21 @@
+{ %fail }
+
+{$modeswitch nestedprocvars}
+
+procedure outer;
+
+  function test(l: longint): longint;
+  begin
+    test:=l*2;
+  end;
+
+{ can't assign nested proc to typed const, requires
+  frame pointer }
+  const
+    pp: function(l: longint): longint is nested = @test;
+
+begin
+end;
+
+begin
+end.

+ 11 - 0
tests/test/tmaclocalprocparam4g.pp

@@ -0,0 +1,11 @@
+{ %fail }
+
+{$modeswitch nestedprocvars}
+
+{ should fail because such inline definitions are always nested }
+procedure test(procedure pp is nested);
+begin
+end;
+
+begin
+end.

+ 13 - 0
tests/test/umaclocalprocparam3f.pp

@@ -0,0 +1,13 @@
+{$modeswitch nestedprocvars}
+
+unit umaclocalprocparam3f;
+
+interface
+
+type
+  tnestedprocvar = procedure is nested;
+  tnestedprocvar2 = procedure(pp: tnestedprocvar) is nested;
+
+implementation
+
+end.