View Issue Details

IDProjectCategoryView StatusLast Update
0024481FPCCompilerpublic2019-08-03 10:23
ReporterVasiliy KevroletinAssigned To 
PrioritynormalSeverityfeatureReproducibilityalways
Status newResolutionopen 
PlatformallOSallOS Version
Product Version2.7.1Product Build 
Target VersionFixed in Version 
Summary0024481: Implement closures
DescriptionImplementation of closures was started in http://svn.freepascal.org/cgi-bin/viewvc.cgi/branches/blaise/closures/. Last update in branch was more than year ago. Main part of implementation which was in compiler/pnameless.pas wasn't submitted into svn.

I decided to continue work and already done some changes. My work can be found in https://github.com/vkevroletin/freepascal/tree/closures-via-interfaces (or in attached patch). Current implementation allows to write and use anonymous functions, but don't allows to capture variables (it allocates storage for captured variables but doesn't move variables into storage).
I didn't perform proper regression testing, but write few test for things which already works. You can find it in https://github.com/vkevroletin/freepascal/tree/closures-via-interfaces/devtest/ (I will rework and move test to right place later).

* Details of implementation:

I described details of Delhpi's anonymous methods behavior here:
https://github.com/vkevroletin/Diploma/blob/master/anonym_method_delphi.pdf?raw=true.

The biggest problem with closure is memory management. Captured local variables should be allocated on the heap but not on the stack.
Since captured variables allocated on the heap someone should deallocate used memory. Manual memory management will be very complicated because:
+ different closures can capture same variables, anyway we would implement reference counting for captured variables
+ closures often appears in parameters of other function; pascal's users would decide who is responsible for deallocating closure: caller or callee;
That is why closure should be managed type with automatic memory management.

To simplify implementation it's possible to use existing managed type: COM interface.
Because closure should store captured variables we
+ create object (let's call it frame object)
+ move captured variables from stack into object which is allocated on the heap
+ closure's code is a method of this object
But we don't use frame object directly. Instead we create interface which contains single method. So variable-reference to closure will contain single value: reference to interface which contains one method(actually 4 methods: 3 methods from IUnknown and 1 method - closure code). So using reference to this interface compiler will do memory-managment magic, and we will be able to call closure's code.

* How it's done in my pilot implementation:
I didn't create new typedef classes. I used existing tobjectdef which is odt_interfacecom. I added boolean flag isClosure to tobjectdef. It's used in typecheck and during printing of proper error messages(most probably it should be changed?).
Also there is one important detail: I don't create frame object for each closure. Instead I create frame object for each subroutine which contains closures. Delhpi does like this because delhpi doesn't support capturing by value. This should be changed to support capturing by value, but this change will not break approach to use interfaces.

1. Declaration of variable

var p: reference to procedure(num: Integer);

p will hold tobjectdef wich is odt_interfacecom. It have single method: procedure Invoke(num: Integer)

2. Anonymous function (closure code)

procedure Outer;
begin
  ...
  function (arg: Integer) begin
    ...
  end;

end;

For Outer procedure frame object will be created. Frame object is tobjectdef. Later each closure will become method of frame object. For each closure we create interface which contains single method. Frame object implements this interface. Instead of anonymous function's body we will return frame object's implementation of particular interface. This interface contains single function.

3. Assignment

  p := function(arg: Integer) begin end;
  
p is interface. Anonymous function's body is replaced by particular interface of frame object. These interfaces have same structure but different names. Don't care that they have different names: simply use one instead of another, this will work. But I don't sure about Jvm. I don't know a lot about JVM: only that it's typesafe and have not pointer's arithmetic. So here I need advice.

* Questions

1. Most important question: is implementation of closures via interfaces is ok? Delphi did closures via interfaces. Will we do in same way? I think this is good and simple approach which solves problem with memory management.
2. Next question about implementation: could you please review existing changes and note most important problems.

Thanks,
Vasiliy K.
Tagsanonymous functions
Fixed in Revision
FPCOldBugId
FPCTarget
Attached Files
  • closures00.patch (176,782 bytes)
    From 9ccda6d8fe4cc15e6353f0acebef188c5331ce08 Mon Sep 17 00:00:00 2001
    From: blaise <blaise@3ad0048d-3df7-0310-abae-a5850022a9f2>
    Date: Sat, 21 Jan 2012 19:00:59 +0000
    Subject: [PATCH 01/14] ~ ncgutil: generate interface thunks for local classes
     too ~ nld: during the first pass, we rewrite the
     nodes that load captured variables, except for nodes
     marked with the new flag loadnf_captured_param =
     pdecobj, symdef: factored out
     tobjectdef.register_implemented_interface + pexpr:
     access to captured variables from expressions;
     nameless routine declarations + symconst: new flags
     for tprocoption (po_nameless, po_has_closure) and
     tobjectoption (oo_is_nameless) ~ symdef: mangled name
     generator is now aware of local classes and
     interfaces + symsym: new field
     tabstractnormalvarsym.captured_into holds a reference
     to a new location for the captured variable
    
    git-svn-id: http://svn.freepascal.org/svn/fpc/branches/blaise/closures/compiler@20138 3ad0048d-3df7-0310-abae-a5850022a9f2
    ---
     compiler/ncgvmt.pas   |   13 ++++++++++---
     compiler/nld.pas      |   18 ++++++++++++++++--
     compiler/pdecobj.pas  |    8 +-------
     compiler/pexpr.pas    |   20 +++++++++++++++++---
     compiler/symconst.pas |   12 ++++++++++--
     compiler/symdef.pas   |   17 +++++++++++++++++
     compiler/symsym.pas   |    9 +++++++++
     7 files changed, 80 insertions(+), 17 deletions(-)
    
    diff --git a/compiler/ncgvmt.pas b/compiler/ncgvmt.pas
    index 59d2413..a6f78c2 100644
    --- a/compiler/ncgvmt.pas
    +++ b/compiler/ncgvmt.pas
    @@ -921,9 +921,16 @@ implementation
             for i:=0 to st.DefList.Count-1 do
               begin
                 def:=tdef(st.DefList[i]);
    -            { if def can contain nested types then handle it symtable }
    -            if def.typ in [objectdef,recorddef] then
    -              gen_intf_wrappers(list,tabstractrecorddef(def).symtable);
    +            { if def can contain nested types then handle its symtable }
    +            case def.typ of
    +              objectdef,recorddef:
    +                gen_intf_wrappers(list,tabstractrecorddef(def).symtable);
    +              procdef:
    +                // check for local classes; currently, we only use them for closures
    +                // TODO: this can slow codegen down dramatically?!
    +                if assigned(tprocdef(def).localst) then
    +                  gen_intf_wrappers(list,tprocdef(def).localst);
    +            end;
                 if is_class(def) then
                   gen_intf_wrapper(list,tobjectdef(def));
               end;
    diff --git a/compiler/nld.pas b/compiler/nld.pas
    index 4f48a4c..5230a70 100644
    --- a/compiler/nld.pas
    +++ b/compiler/nld.pas
    @@ -44,7 +44,10 @@ interface
                Be really carefull when using this flag! }
              loadnf_isinternal_ignoreconst,
     
    -         loadnf_only_uninitialized_hint
    +         loadnf_only_uninitialized_hint,
    +         // the node loads a captured formal parameter from its original location;
    +         // such node is marked so, so it will not get rewritten during the first pass
    +         loadnf_captured_param
             );
     
            tloadnode = class(tunarynode)
    @@ -176,7 +179,7 @@ implementation
           verbose,globtype,globals,systems,constexp,
           symnot,symtable,
           defutil,defcmp,
    -      htypechk,pass_1,procinfo,paramgr,
    +      htypechk,pass_1,procinfo,paramgr,pnameless,
           cpuinfo,
           ncon,ninl,ncnv,nmem,ncal,nutils,
           cgbase
    @@ -411,6 +414,17 @@ implementation
                 localvarsym,
                 paravarsym :
                   begin
    +                if symtableentry.typ in [localvarsym,paravarsym] then
    +                  begin
    +                    // if the variable has been captured after the creation of this node,
    +                    //   then this node is no longer relevant,
    +                    //     and we shall load the variable's new location instead
    +                    // the exception is the case when we access the original location
    +                    //   in order to copy the value into the capturer
    +                    if tabstractnormalvarsym(symtableentry).is_captured
    +                        and not (loadnf_captured_param in loadnodeflags) then
    +                      exit( load_captured_variable(current_procinfo.procdef, tabstractnormalvarsym(symtableentry)) );
    +                  end;
                     if assigned(left) then
                       firstpass(left);
                     if not is_addr_param_load and
    diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
    index 61dcc0f..6485467 100644
    --- a/compiler/pdecobj.pas
    +++ b/compiler/pdecobj.pas
    @@ -324,13 +324,7 @@ implementation
             if current_objectdef.find_implemented_interface(intfdef)<>nil then
               Message1(sym_e_duplicate_id,intfdef.objname^)
             else
    -          begin
    -            { allocate and prepare the GUID only if the class
    -              implements some interfaces. }
    -            if current_objectdef.ImplementedInterfaces.count = 0 then
    -              current_objectdef.prepareguid;
    -            current_objectdef.ImplementedInterfaces.Add(TImplementedInterface.Create(intfdef));
    -          end;
    +          current_objectdef.register_implemented_interface(intfdef);
           end;
     
     
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index 3555e4e..0bc3480 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -70,7 +70,7 @@ implementation
            nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
            { parser }
            scanner,
    -       pbase,pinline,ptype,pgenutil,procinfo,cpuinfo
    +       pbase,pinline,ptype,pgenutil,procinfo,cpuinfo,pnameless,
            ;
     
         { sub_expr(opmultiply) is need to get -1 ** 4 to be
    @@ -2560,8 +2560,15 @@ implementation
                               p1:=csubscriptnode.create(srsym,p1);
                           end
                         else
    -                      { regular non-field load }
    -                      p1:=cloadnode.create(srsym,srsymtable);
    +                      begin
    +                        if srsym.typ in [localvarsym,paravarsym] then
    +                          p1:=handle_possible_capture(current_procinfo.procdef, tabstractnormalvarsym(srsym))
    +                        else
    +                          p1:=nil;
    +                        if not assigned(p1) then
    +                          { regular non-field load }
    +                          p1:=cloadnode.create(srsym,srsymtable);
    +                      end
                       end;
     
                     syssym :
    @@ -3293,6 +3300,13 @@ implementation
                    p1:=cinlinenode.create(in_objc_protocol_x,false,p1);
                  end;
     
    +             // nameless routine
    +             _PROCEDURE, _FUNCTION:
    +               if assigned(current_procinfo) then
    +                 p1:=parse_nameless_routine(current_procinfo.procdef)
    +               else // TODO: support this later? Delphi doesn't
    +                 internalerror(20120121);
    +
                  else
                    begin
                      Message(parser_e_illegal_expression);
    diff --git a/compiler/symconst.pas b/compiler/symconst.pas
    index ae98ad0..ceee977 100644
    --- a/compiler/symconst.pas
    +++ b/compiler/symconst.pas
    @@ -342,7 +342,11 @@ type
         { the visibility of of this procdef was raised automatically by the
           compiler, e.g. because it was designated as a getter/setter for a property
           with a higher visibility on the JVM target }
    -    po_auto_raised_visibility
    +    po_auto_raised_visibility,
    +    // nameless routine (including closure)
    +    po_nameless,
    +    // has at least one closure declared in the body
    +    po_has_closure
       );
       tprocoptions=set of tprocoption;
     
    @@ -436,7 +440,11 @@ type
         oo_has_class_constructor, { the object/class has a class constructor }
         oo_has_class_destructor,  { the object/class has a class destructor  }
         oo_is_enum_class,     { the class represents an enum (JVM) }
    -    oo_has_new_destructor { the object/class declares a destructor (apart from potentially inherting one from the parent) }
    +    oo_has_new_destructor,{ the object/class declares a destructor (apart from potentially inherting one from the parent) }
    +    // the interface that has no identifier; structural type equivalence is used
    +    //   currently, this flag is only used for closures
    +    //     TODO: we can get rid of it if we implement type coersion for COM-interfaces
    +    oo_is_nameless
       );
       tobjectoptions=set of tobjectoption;
     
    diff --git a/compiler/symdef.pas b/compiler/symdef.pas
    index 31ee02e..a4780d1 100644
    --- a/compiler/symdef.pas
    +++ b/compiler/symdef.pas
    @@ -376,7 +376,10 @@ interface
               function  members_need_inittable : boolean;
               function  find_implemented_interface(aintfdef:tobjectdef):TImplementedInterface;
               { this should be called when this class implements an interface }
    +          procedure register_implemented_interface(const intfdef: tobjectdef);
    +       strict private
               procedure prepareguid;
    +       public
               function  is_publishable : boolean;override;
               function  is_related(d : tdef) : boolean;override;
               function  needs_inittable : boolean;override;
    @@ -1119,10 +1122,12 @@ implementation
             i   : longint;
             crc : dword;
             hp  : tparavarsym;
    +      label again; // TODO: refactor this abomination
           begin
             prefix:='';
             if not assigned(st) then
              internalerror(200204212);
    +      again:
             { sub procedures }
             while (st.symtabletype=localsymtable) do
              begin
    @@ -1180,6 +1185,9 @@ implementation
                prefix:=tabstractrecorddef(st.defowner).objname^+'_$_'+prefix;
                st:=st.defowner.owner;
              end;
    +        if st.symtabletype = localsymtable then
    +          // local classes and interfaces
    +          goto again;
             { symtable must now be static or global }
             if not(st.symtabletype in [staticsymtable,globalsymtable]) then
               internalerror(200204175);
    @@ -5820,6 +5828,15 @@ implementation
           end;
     
     
    +    procedure tobjectdef.register_implemented_interface(const intfdef: tobjectdef);
    +      begin
    +        // allocate the GUID only if the class implements at least one interface
    +        if ImplementedInterfaces.count = 0 then
    +          prepareguid;
    +        ImplementedInterfaces.Add(TImplementedInterface.Create(intfdef));
    +      end;
    +
    +
         procedure tobjectdef.prepareguid;
           begin
             { set up guid }
    diff --git a/compiler/symsym.pas b/compiler/symsym.pas
    index 078699b..0186e29 100644
    --- a/compiler/symsym.pas
    +++ b/compiler/symsym.pas
    @@ -215,12 +215,15 @@ interface
               initialloc    : TLocation; { initial location so it can still be initialized later after the location was changed by SSA }
               currentregloc  : TLocation; { current registers for register variables with moving register numbers }
               inparentfpstruct : boolean;   { migrated to a parentfpstruct because of nested access (not written to ppu, because not important and would change interface crc) }
    +          // if var is captured by a closure, this refers to a field of the class TCapturer
    +          captured_into: tfieldvarsym;
               constructor create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
               constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
               function globalasmsym: boolean;
               procedure ppuwrite(ppufile:tcompilerppufile);override;
               procedure buildderef;override;
               procedure deref;override;
    +          function is_captured: boolean; inline;
           end;
     
           tlocalvarsym = class(tabstractnormalvarsym)
    @@ -1710,6 +1713,12 @@ implementation
           end;
     
     
    +    function tabstractnormalvarsym.is_captured: boolean; inline;
    +      begin
    +        result:=assigned(captured_into)
    +      end;
    +
    +
     {****************************************************************************
                                  Tstaticvarsym
     ****************************************************************************}
    -- 
    1.7.10.4
    
    
    From 8dfaa356d6eb4a558e38e1175d7d966ca80b7787 Mon Sep 17 00:00:00 2001
    From: blaise <blaise@3ad0048d-3df7-0310-abae-a5850022a9f2>
    Date: Wed, 1 Feb 2012 19:21:23 +0000
    Subject: [PATCH 02/14] + defcmp: structural equivalence for COM interfaces ~
     pdecobj, pdecsub: parsing mode for routines: normal,
     class method, nameless routine, method reference =
     pdecsub: factored out parse_proc_parameter_dec();
     code simplifications + symdef:
     tprocdef.add_to_procsym() + ptype, tokens: new UDT --
     method reference
    
    git-svn-id: http://svn.freepascal.org/svn/fpc/branches/blaise/closures/compiler@20212 3ad0048d-3df7-0310-abae-a5850022a9f2
    ---
     compiler/defcmp.pas   |   24 +++++-
     compiler/pdecobj.pas  |   10 +--
     compiler/pdecsub.pas  |  209 +++++++++++++++++++++++++++++--------------------
     compiler/pmodules.pas |    2 +
     compiler/psub.pas     |    3 +-
     compiler/ptype.pas    |    7 +-
     compiler/symdef.pas   |   15 ++++
     compiler/tokens.pas   |    2 +
     8 files changed, 178 insertions(+), 94 deletions(-)
    
    diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas
    index a905849..bbb841f 100644
    --- a/compiler/defcmp.pas
    +++ b/compiler/defcmp.pas
    @@ -158,7 +158,7 @@ implementation
         uses
           verbose,systems,constexp,
           symtable,symsym,
    -      defutil,symutil;
    +      defutil,symutil,pnameless;
     
     
         function compare_defs_ext(def_from,def_to : tdef;
    @@ -1588,8 +1588,26 @@ implementation
                            doconv:=tc_variant_2_interface;
                            eq:=te_convert_l2;
                          end
    -                   { ugly, but delphi allows it (enables typecasting ordinals/
    -                     enums of any size to pointer-based object defs) }
    +
    +{TODO: refactor evil merge}
    +
    +                   { interface coercion }
    +                   else if (def_from.typ=objectdef) and
    +                     (tobjectdef(def_from).objecttype=odt_interfacecom) and
    +                     (tobjectdef(def_to).objecttype=odt_interfacecom) and
    +                     are_compatible_interfaces(tobjectdef(def_to),tobjectdef(def_from)) then
    +                     begin
    +                       doconv:=tc_equal;
    +                       eq:=te_convert_l1;
    +                     end
    +                   { ugly, but delphi allows it }
    +                   else if (def_from.typ in [orddef,enumdef]) and
    +                     (m_delphi in current_settings.modeswitches) and
    +                     (cdo_explicit in cdoptions) then
    +                     begin
    +                       doconv:=tc_int_2_int;
    +                       eq:=te_convert_l1;
    +                     end;
                        { in Java enums /are/ class instances, and hence such
                          typecasts must not be treated as integer-like conversions;
                          arbitrary constants cannot be converted into classes/
    diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
    index 6485467..31664f2 100644
    --- a/compiler/pdecobj.pas
    +++ b/compiler/pdecobj.pas
    @@ -104,7 +104,7 @@ implementation
             result:=nil;
             consume(_CONSTRUCTOR);
             { must be at same level as in implementation }
    -        parse_proc_head(current_structdef,potype_class_constructor,pd);
    +        parse_proc_head(current_structdef,potype_class_constructor,ppm_class_method,pd);
             if not assigned(pd) then
               begin
                 consume(_SEMICOLON);
    @@ -129,7 +129,7 @@ implementation
             result:=nil;
             consume(_CONSTRUCTOR);
             { must be at same level as in implementation }
    -        parse_proc_head(current_structdef,potype_constructor,pd);
    +        parse_proc_head(current_structdef,potype_constructor,ppm_normal,pd);
             if not assigned(pd) then
               begin
                 consume(_SEMICOLON);
    @@ -226,7 +226,7 @@ implementation
           begin
             result:=nil;
             consume(_DESTRUCTOR);
    -        parse_proc_head(current_structdef,potype_class_destructor,pd);
    +        parse_proc_head(current_structdef,potype_class_destructor,ppm_class_method,pd);
             if not assigned(pd) then
               begin
                 consume(_SEMICOLON);
    @@ -250,7 +250,7 @@ implementation
           begin
             result:=nil;
             consume(_DESTRUCTOR);
    -        parse_proc_head(current_structdef,potype_destructor,pd);
    +        parse_proc_head(current_structdef,potype_destructor,ppm_normal,pd);
             if not assigned(pd) then
               begin
                 consume(_SEMICOLON);
    @@ -875,7 +875,7 @@ implementation
                   { which isn't declared yet                      }
                   if assigned(result) then
                     begin
    -                  parse_object_proc_directives(result);
    +                  parse_object_proc_directives(result, as_procparsemode(is_classdef));
     
                       { check if dispid is set }
                       if is_dispinterface(result.struct) and not (po_dispid in result.procoptions) then
    diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
    index c5c4cdf..487a585 100644
    --- a/compiler/pdecsub.pas
    +++ b/compiler/pdecsub.pas
    @@ -72,8 +72,12 @@ interface
         procedure parse_var_proc_directives(sym:tsym);
         procedure parse_object_proc_directives(pd:tabstractprocdef);
         procedure parse_record_proc_directives(pd:tabstractprocdef);
    -    function  parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;out pd:tprocdef):boolean;
    -    function  parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef):tprocdef;
    +
    +    type tprocparsemode = (ppm_normal, ppm_class_method, ppm_nameless_routine, ppm_method_reference);
    +    // TODO: operator :=/Explicit (const is_class_method: boolean) result: tprocparsemode;
    +    function as_procparsemode(const is_class_method: boolean): tprocparsemode; inline;
    +    function parse_proc_head(astruct: tabstractrecorddef; potype: tproctypeoption; const procparsemode: tprocparsemode; out pd: tprocdef): boolean;
    +    function parse_proc_dec(astruct: tabstractrecorddef; const procparsemode: tprocparsemode = ppm_normal): tprocdef;
     
         { parse a record method declaration (not a (class) constructor/destructor) }
         function parse_record_method_dec(astruct: tabstractrecorddef; is_classdef: boolean): tprocdef;
    @@ -540,7 +544,48 @@ implementation
           end;
     
     
    -    function parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;out pd:tprocdef):boolean;
    +    procedure parse_proc_parameter_dec(const pd: tprocdef); inline;
    +      var
    +        popclass : integer;
    +        old_current_structdef: tabstractrecorddef;
    +        old_current_genericdef,
    +        old_current_specializedef: tstoreddef;
    +      begin
    +        { Add ObjectSymtable to be able to find nested type definitions }
    +        popclass:=0;
    +        if assigned(pd.struct) and // TODO: skip for nameless? or no need
    +           (pd.parast.symtablelevel>=normal_function_level) and
    +           not(symtablestack.top.symtabletype in [ObjectSymtable,recordsymtable]) then
    +          begin
    +            popclass:=push_nested_hierarchy(pd.struct);
    +            old_current_structdef:=current_structdef;
    +            old_current_genericdef:=current_genericdef;
    +            old_current_specializedef:=current_specializedef;
    +            current_structdef:=pd.struct;
    +            if df_generic in current_structdef.defoptions then
    +              current_genericdef:=current_structdef;
    +            if df_specialization in current_structdef.defoptions then
    +              current_specializedef:=current_structdef;
    +          end;
    +        { Add parameter symtable }
    +        if pd.parast.symtabletype<>staticsymtable then
    +          symtablestack.push(pd.parast);
    +        parse_parameter_dec(pd);
    +        if pd.parast.symtabletype<>staticsymtable then
    +          symtablestack.pop(pd.parast);
    +        if popclass>0 then
    +          begin
    +            current_structdef:=old_current_structdef;
    +            current_genericdef:=old_current_genericdef;
    +            current_specializedef:=old_current_specializedef;
    +            dec(popclass,pop_nested_hierarchy(pd.struct));
    +            if popclass<>0 then
    +              internalerror(201011260); // 11 nov 2010 index 0
    +          end;
    +      end;
    +
    +
    +    function parse_proc_head(astruct: tabstractrecorddef; potype: tproctypeoption; const procparsemode: tprocparsemode; out pd: tprocdef): boolean;
           var
             hs       : string;
             orgsp,sp : TIDString;
    @@ -551,12 +596,8 @@ implementation
             st,
             genericst: TSymtable;
             aprocsym : tprocsym;
    -        popclass : integer;
             ImplIntf : TImplementedInterface;
             old_parse_generic : boolean;
    -        old_current_structdef: tabstractrecorddef;
    -        old_current_genericdef,
    -        old_current_specializedef: tstoreddef;
             lasttoken,lastidtoken: ttoken;
     
             procedure parse_operator_name;
    @@ -756,7 +797,20 @@ implementation
             pd:=nil;
             aprocsym:=nil;
     
    -        consume_proc_name;
    +        case procparsemode of
    +          ppm_nameless_routine:
    +            begin
    +              sp:='Nameless_'+inttostr(procstartfilepos.line)+'_'+inttostr(procstartfilepos.column);
    +              orgsp:=upcase(sp);
    +            end;
    +          ppm_method_reference:
    +            begin
    +              sp:='Invoke';
    +              orgsp:=upcase(sp);
    +            end;
    +          else
    +            consume_proc_name;
    +        end;
     
             { examine interface map: function/procedure iname.functionname=locfuncname }
             if assigned(astruct) and
    @@ -809,7 +863,11 @@ implementation
     
             { method  ? }
             srsym:=nil;
    -        if (consume_generic_type_parameter or not assigned(astruct)) and
    +        if procparsemode=ppm_nameless_routine then
    +          // Do nothing. This check here:
    +          //   a) skips below checks and searches, speeding things up;
    +          //   b) makes sure we do not try to parse generic type parameters.
    +        else if (consume_generic_type_parameter or not assigned(astruct)) and
                (symtablestack.top.symtablelevel=main_program_level) and
                try_to_consume(_POINT) then
              begin
    @@ -928,33 +986,39 @@ implementation
               begin
                 { create a new procsym and set the real filepos }
                 current_tokenpos:=procstartfilepos;
    -            { for operator we have only one procsym for each overloaded
    -              operation }
    -            if (potype=potype_operator) then
    -              begin
    +            case potype of
    +              potype_operator:
    +              begin // we have only one procsym for each overloaded operator
                     aprocsym:=Tprocsym(symtablestack.top.Find(sp));
                     if aprocsym=nil then
                       aprocsym:=tprocsym.create('$'+sp);
    -              end
    -            else
    -            if (potype in [potype_class_constructor,potype_class_destructor]) then
    -              aprocsym:=tprocsym.create('$'+lower(sp))
    -            else
    -              aprocsym:=tprocsym.create(orgsp);
    +              end;
    +              potype_class_constructor,potype_class_destructor:
    +                aprocsym:=tprocsym.create('$'+lower(sp))
    +              else
    +                aprocsym:=tprocsym.create(orgsp);
    +            end;
                 symtablestack.top.insert(aprocsym);
               end;
     
    -        { to get the correct symtablelevel we must ignore ObjectSymtables }
    -        st:=nil;
    -        checkstack:=symtablestack.stack;
    -        while assigned(checkstack) do
    +        if procparsemode=ppm_nameless_routine then
               begin
    -            st:=checkstack^.symtable;
    -            if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then
    -              break;
    -            checkstack:=checkstack^.next;
    -          end;
    -        pd:=tprocdef.create(st.symtablelevel+1);
    +            pd:=tprocdef.create(normal_function_level);
    +            include(pd.procoptions,po_nameless);
    +          end
    +        else begin // TODO: surely, there should be a simpler way:
    +          { to get the correct symtablelevel we must ignore ObjectSymtables }
    +          st:=nil;
    +          checkstack:=symtablestack.stack;
    +          while assigned(checkstack) do
    +            begin
    +              st:=checkstack^.symtable;
    +              if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then
    +                break;
    +              checkstack:=checkstack^.next;
    +            end;
    +          pd:=tprocdef.create(st.symtablelevel+1);
    +        end;
             pd.struct:=astruct;
             pd.procsym:=aprocsym;
             pd.proctypeoption:=potype;
    @@ -1003,46 +1067,23 @@ implementation
     
             { parse parameters }
             if token=_LKLAMMER then
    -          begin
    -            { Add ObjectSymtable to be able to find nested type definitions }
    -            popclass:=0;
    -            if assigned(pd.struct) and
    -               (pd.parast.symtablelevel>=normal_function_level) and
    -               not(symtablestack.top.symtabletype in [ObjectSymtable,recordsymtable]) then
    -              begin
    -                popclass:=push_nested_hierarchy(pd.struct);
    -                old_current_structdef:=current_structdef;
    -                old_current_genericdef:=current_genericdef;
    -                old_current_specializedef:=current_specializedef;
    -                current_structdef:=pd.struct;
    -                if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then
    -                  current_genericdef:=current_structdef;
    -                if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then
    -                  current_specializedef:=current_structdef;
    -              end;
    -            { Add parameter symtable }
    -            if pd.parast.symtabletype<>staticsymtable then
    -              symtablestack.push(pd.parast);
    -            parse_parameter_dec(pd);
    -            if pd.parast.symtabletype<>staticsymtable then
    -              symtablestack.pop(pd.parast);
    -            if popclass>0 then
    -              begin
    -                current_structdef:=old_current_structdef;
    -                current_genericdef:=old_current_genericdef;
    -                current_specializedef:=old_current_specializedef;
    -                dec(popclass,pop_nested_hierarchy(pd.struct));
    -                if popclass<>0 then
    -                  internalerror(201011260); // 11 nov 2010 index 0
    -              end;
    -          end;
    +          parse_proc_parameter_dec(pd);
     
             parse_generic:=old_parse_generic;
             result:=true;
           end;
     
     
    -    function parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef):tprocdef;
    +    function as_procparsemode(const is_class_method: boolean): tprocparsemode; inline;
    +      begin
    +        if is_class_method then
    +          result := ppm_class_method
    +        else
    +          result := ppm_normal
    +      end;
    +
    +
    +    function parse_proc_dec(astruct: tabstractrecorddef; const procparsemode: tprocparsemode = ppm_normal): tprocdef;
           var
             pd: tprocdef;
             locationstr: string;
    @@ -1071,9 +1112,9 @@ implementation
                     old_current_genericdef:=current_genericdef;
                     old_current_specializedef:=current_specializedef;
                     current_structdef:=pd.struct;
    -                if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then
    +                if df_generic in current_structdef.defoptions then
                       current_genericdef:=current_structdef;
    -                if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then
    +                if df_specialization in current_structdef.defoptions then
                       current_specializedef:=current_structdef;
                   end;
                 single_type(pd.returndef,[stoAllowSpecialization]);
    @@ -1100,7 +1141,7 @@ implementation
               _FUNCTION :
                 begin
                   consume(_FUNCTION);
    -              if parse_proc_head(astruct,potype_function,pd) then
    +              if parse_proc_head(astruct,potype_function,procparsemode,pd) then
                     begin
                       { pd=nil when it is a interface mapping }
                       if assigned(pd) then
    @@ -1144,7 +1185,7 @@ implementation
                                 consume_all_until(_SEMICOLON);
                               end;
                            end;
    -                      if isclassmethod then
    +                      if procparsemode=ppm_class_method then
                            include(pd.procoptions,po_classmethod);
                         end;
                     end
    @@ -1159,13 +1200,13 @@ implementation
               _PROCEDURE :
                 begin
                   consume(_PROCEDURE);
    -              if parse_proc_head(astruct,potype_procedure,pd) then
    +              if parse_proc_head(astruct,potype_procedure,procparsemode,pd) then
                     begin
                       { pd=nil when it is an interface mapping }
                       if assigned(pd) then
                         begin
                           pd.returndef:=voidtype;
    -                      if isclassmethod then
    +                      if procparsemode=ppm_class_method then
                             include(pd.procoptions,po_classmethod);
                         end;
                     end;
    @@ -1174,11 +1215,11 @@ implementation
               _CONSTRUCTOR :
                 begin
                   consume(_CONSTRUCTOR);
    -              if isclassmethod then
    -                parse_proc_head(astruct,potype_class_constructor,pd)
    +              if procparsemode=ppm_class_method then
    +                parse_proc_head(astruct,potype_class_constructor,procparsemode,pd)
                   else
    -                parse_proc_head(astruct,potype_constructor,pd);
    -              if not isclassmethod and
    +                parse_proc_head(astruct,potype_constructor,procparsemode,pd);
    +              if (procparsemode<>ppm_class_method) and
                      assigned(pd) and
                      assigned(pd.struct) then
                     begin
    @@ -1205,16 +1246,15 @@ implementation
               _DESTRUCTOR :
                 begin
                   consume(_DESTRUCTOR);
    -              if isclassmethod then
    -                parse_proc_head(astruct,potype_class_destructor,pd)
    +              if procparsemode=ppm_class_method then
    +                parse_proc_head(astruct,potype_class_destructor,procparsemode,pd)
                   else
    -                parse_proc_head(astruct,potype_destructor,pd);
    +                parse_proc_head(astruct,potype_destructor,procparsemode,pd);
                   if assigned(pd) then
                     pd.returndef:=voidtype;
                 end;
    -        else
    -          if (token=_OPERATOR) or
    -             (isclassmethod and (idtoken=_OPERATOR)) then
    +
    +          _OPERATOR:
                 begin
                   { we need to set the block type to bt_body, so that operator names
                     like ">", "=>" or "<>" are parsed correctly instead of e.g.
    @@ -1222,7 +1262,7 @@ implementation
                   old_block_type:=block_type;
                   block_type:=bt_body;
                   consume(_OPERATOR);
    -              parse_proc_head(astruct,potype_operator,pd);
    +              parse_proc_head(astruct,potype_operator,procparsemode,pd);
                   block_type:=old_block_type;
                   if assigned(pd) then
                     begin
    @@ -1232,7 +1272,7 @@ implementation
                       pd.procsym.owner.includeoption(sto_has_operator);
                       if pd.parast.symtablelevel>normal_function_level then
                         Message(parser_e_no_local_operator);
    -                  if isclassmethod then
    +                  if procparsemode=ppm_class_method then
                         include(pd.procoptions,po_classmethod);
                       if token<>_ID then
                         begin
    @@ -1304,7 +1344,8 @@ implementation
                     message(parser_e_field_not_allowed_here);
                     consume_all_until(_SEMICOLON);
                   end;
    -            consume(_SEMICOLON);
    +            if not (procparsemode in [ppm_nameless_routine,ppm_method_reference]) then
    +              consume(_SEMICOLON);
               end;
             result:=pd;
     
    @@ -1323,7 +1364,7 @@ implementation
           begin
             oldparse_only:=parse_only;
             parse_only:=true;
    -        result:=parse_proc_dec(is_classdef,astruct);
    +        result:=parse_proc_dec(astruct,as_procparsemode(is_classdef));
     
             { this is for error recovery as well as forward }
             { interface mappings, i.e. mapping to a method  }
    @@ -3303,7 +3344,7 @@ const
                 if (currpd.proctypeoption = potype_function) and
                    is_void(currpd.returndef) then
                   MessagePos1(currpd.fileinfo,parser_e_no_funcret_specified,currpd.procsym.realname);
    -            tprocsym(currpd.procsym).ProcdefList.Add(currpd);
    +            currpd.add_to_procsym;
               end;
     
             proc_add_definition:=forwardfound;
    diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas
    index 5800b54..9a011d8 100644
    --- a/compiler/pmodules.pas
    +++ b/compiler/pmodules.pas
    @@ -572,6 +572,8 @@ implementation
             inc(ps.refs);
             st.insert(ps);
             pd:=tprocdef(cnodeutils.create_main_procdef(target_info.cprefix+name,potype,ps));
    +{TDOO: investigate. Evil merge}
    +        pd.add_to_procsym(ps);
             { We don't need is a local symtable. Change it into the static
               symtable }
             pd.localst.free;
    diff --git a/compiler/psub.pas b/compiler/psub.pas
    index 9ff647d..113c67e 100644
    --- a/compiler/psub.pas
    +++ b/compiler/psub.pas
    @@ -28,7 +28,8 @@ interface
         uses
           globals,
           node,nbas,
    -      symdef,procinfo,optdfa;
    +      symdef,procinfo,optdfa,
    +      pdecsub;
     
         type
     
    diff --git a/compiler/ptype.pas b/compiler/ptype.pas
    index 3aad0b7..93b3e50 100644
    --- a/compiler/ptype.pas
    +++ b/compiler/ptype.pas
    @@ -81,7 +81,7 @@ implementation
            nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
            { parser }
            scanner,
    -       pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil
    +       pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil{,pnameless}
     {$ifdef jvm}
            ,pjvm
     {$endif}
    @@ -1673,6 +1673,11 @@ implementation
                     jvm_create_procvar_class(name,def);
     {$endif}
                   end;
    +            _ID:
    +              if idtoken=_REFERENCE then // TODO: $mode Delphi only?
    +                def:=parse_method_reference(name)
    +              else
    +                expr_type;
                 else
                   if (token=_KLAMMERAFFE) and (m_iso in current_settings.modeswitches) then
                     begin
    diff --git a/compiler/symdef.pas b/compiler/symdef.pas
    index a4780d1..83afc44 100644
    --- a/compiler/symdef.pas
    +++ b/compiler/symdef.pas
    @@ -718,6 +718,8 @@ interface
               function  is_methodpointer:boolean;override;
               function  is_addressonly:boolean;override;
               procedure make_external;
    +          procedure add_to_procsym; overload; inline;
    +          procedure add_to_procsym(sym: {tprocsym}tsym); overload; inline;
            end;
     
            { single linked list of overloaded procs }
    @@ -4697,6 +4699,19 @@ implementation
           end;
     
     
    +    procedure tprocdef.add_to_procsym; inline;
    +      begin
    +        tprocsym(procsym).ProcdefList.Add(self);
    +      end;
    +
    +
    +    procedure tprocdef.add_to_procsym(sym: {tprocsym}tsym); inline;
    +      begin
    +        procsym:=sym;
    +        add_to_procsym;
    +      end;
    +
    +
         procedure tprocdef.buildderef;
           begin
              inherited buildderef;
    diff --git a/compiler/tokens.pas b/compiler/tokens.pas
    index 3fe1505..3f29f59 100644
    --- a/compiler/tokens.pas
    +++ b/compiler/tokens.pas
    @@ -257,6 +257,7 @@ type
         _PROCEDURE,
         _PROTECTED,
         _PUBLISHED,
    +    _REFERENCE,
         _SOFTFLOAT,
         _THREADVAR,
         _WRITEONLY,
    @@ -556,6 +557,7 @@ const
           (str:'PROCEDURE'     ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
           (str:'PROTECTED'     ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'PUBLISHED'     ;special:false;keyword:[m_none];op:NOTOKEN),
    +      (str:'REFERENCE'     ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'SOFTFLOAT'     ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'THREADVAR'     ;special:false;keyword:alllanguagemodes-[m_iso];op:NOTOKEN),
           (str:'WRITEONLY'     ;special:false;keyword:[m_none];op:NOTOKEN),
    -- 
    1.7.10.4
    
    
    From 50d9448e318716108b8889e9e3fe258c5aba33e7 Mon Sep 17 00:00:00 2001
    From: Vasiliy Kevroletin <kevroletin@gmail.com>
    Date: Thu, 11 Apr 2013 13:41:44 +1100
    Subject: [PATCH 03/14] Fix compilation. Implementation will be fixed in the
     future.
    
    ---
     compiler/defcmp.pas    |   12 +---
     compiler/nld.pas       |    4 +-
     compiler/pdecobj.pas   |    4 +-
     compiler/pexpr.pas     |    2 +-
     compiler/pmodules.pas  |    2 -
     compiler/pnameless.pas |  146 ++++++++++++++++++++++++++++++++++++++++++++++++
     compiler/psub.pas      |    5 +-
     compiler/ptype.pas     |    2 +-
     compiler/symdef.pas    |    6 ++
     9 files changed, 163 insertions(+), 20 deletions(-)
     create mode 100644 compiler/pnameless.pas
    
    diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas
    index bbb841f..00ba2bd 100644
    --- a/compiler/defcmp.pas
    +++ b/compiler/defcmp.pas
    @@ -158,7 +158,7 @@ implementation
         uses
           verbose,systems,constexp,
           symtable,symsym,
    -      defutil,symutil,pnameless;
    +      defutil,symutil{,pnameless};
     
     
         function compare_defs_ext(def_from,def_to : tdef;
    @@ -1589,7 +1589,7 @@ implementation
                            eq:=te_convert_l2;
                          end
     
    -{TODO: refactor evil merge}
    +(*** are_compatible_interfaces is missed ***
     
                        { interface coercion }
                        else if (def_from.typ=objectdef) and
    @@ -1600,14 +1600,8 @@ implementation
                            doconv:=tc_equal;
                            eq:=te_convert_l1;
                          end
    +*)
                        { ugly, but delphi allows it }
    -                   else if (def_from.typ in [orddef,enumdef]) and
    -                     (m_delphi in current_settings.modeswitches) and
    -                     (cdo_explicit in cdoptions) then
    -                     begin
    -                       doconv:=tc_int_2_int;
    -                       eq:=te_convert_l1;
    -                     end;
                        { in Java enums /are/ class instances, and hence such
                          typecasts must not be treated as integer-like conversions;
                          arbitrary constants cannot be converted into classes/
    diff --git a/compiler/nld.pas b/compiler/nld.pas
    index 5230a70..cd6a44c 100644
    --- a/compiler/nld.pas
    +++ b/compiler/nld.pas
    @@ -30,7 +30,7 @@ interface
            {$ifdef state_tracking}
            nstate,
            {$endif}
    -       symconst,symbase,symtype,symsym,symdef;
    +       symconst,symbase,symtype,symsym,symdef,pnameless;
     
         type
            Trttidatatype = (rdt_normal,rdt_ord2str,rdt_str2ord);
    @@ -179,7 +179,7 @@ implementation
           verbose,globtype,globals,systems,constexp,
           symnot,symtable,
           defutil,defcmp,
    -      htypechk,pass_1,procinfo,paramgr,pnameless,
    +      htypechk,pass_1,procinfo,paramgr{,pnameless},
           cpuinfo,
           ncon,ninl,ncnv,nmem,ncal,nutils,
           cgbase
    diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
    index 31664f2..37f426f 100644
    --- a/compiler/pdecobj.pas
    +++ b/compiler/pdecobj.pas
    @@ -868,14 +868,14 @@ implementation
     
                   oldparse_only:=parse_only;
                   parse_only:=true;
    -              result:=parse_proc_dec(is_classdef,astruct);
    +              result:=parse_proc_dec(astruct,as_procparsemode(is_classdef));
     
                   { this is for error recovery as well as forward }
                   { interface mappings, i.e. mapping to a method  }
                   { which isn't declared yet                      }
                   if assigned(result) then
                     begin
    -                  parse_object_proc_directives(result, as_procparsemode(is_classdef));
    +                  parse_object_proc_directives(result);
     
                       { check if dispid is set }
                       if is_dispinterface(result.struct) and not (po_dispid in result.procoptions) then
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index 0bc3480..f23c2e6 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -70,7 +70,7 @@ implementation
            nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
            { parser }
            scanner,
    -       pbase,pinline,ptype,pgenutil,procinfo,cpuinfo,pnameless,
    +       pbase,pinline,ptype,pgenutil,procinfo,cpuinfo,pnameless
            ;
     
         { sub_expr(opmultiply) is need to get -1 ** 4 to be
    diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas
    index 9a011d8..5800b54 100644
    --- a/compiler/pmodules.pas
    +++ b/compiler/pmodules.pas
    @@ -572,8 +572,6 @@ implementation
             inc(ps.refs);
             st.insert(ps);
             pd:=tprocdef(cnodeutils.create_main_procdef(target_info.cprefix+name,potype,ps));
    -{TDOO: investigate. Evil merge}
    -        pd.add_to_procsym(ps);
             { We don't need is a local symtable. Change it into the static
               symtable }
             pd.localst.free;
    diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
    new file mode 100644
    index 0000000..4484fb8
    --- /dev/null
    +++ b/compiler/pnameless.pas
    @@ -0,0 +1,146 @@
    +unit pnameless;
    +
    +{$mode objfpc}
    +
    +interface
    +
    +uses node, symtype, symdef, symsym, globtype;
    +
    +function parse_method_reference(name: TIDString): tdef;
    +function handle_possible_capture(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
    +function parse_nameless_routine(pi: tprocdef): tnode;
    +function load_captured_variable(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
    +function maybe_create_frameobject(pi: tprocdef): boolean;
    +
    +implementation
    +
    +uses nld, { TODO: get rid of cicle reference }
    +
    +     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas;
    +(* FrameObject contains
    +   - captured variables of current procedure as fields
    +   - anonymous functions as
    +     - methods
    +     - implementation of interface with single method 'invoke'
    +   - pointer to FrameObject of outer procedure as fiels
    +
    +   FrameObject implements unique interface for each of it's methods
    + *)
    +function maybe_create_frameobject(pi: tprocdef): boolean;
    +var iIntfDef, intfObjDef: TObjectDef;
    +
    +  function FindTypeDefinitions: boolean;
    +  var sym: tsym;
    +      symtable: tsymtable;
    +  begin
    +    // TODO: is there better way to get tinterfacedobject ?
    +    searchsym_type('TINTERFACEDOBJECT', sym, symtable);
    +    if not assigned(sym) then InternalError(1);
    +    if (sym.typ <> typesym) then InternalError(2);
    +    intfObjDef := tobjectdef(ttypesym(sym).typedef);
    +    searchsym_type('IUNKNOWN', sym, symtable);
    +    if not assigned(sym) then InternalError(3);
    +    if (sym.typ <> typesym) then InternalError(4);
    +    iIntfDef := tobjectdef(ttypesym(sym).typedef);
    +    Result := true;
    +  end;
    +
    +var frameObjectDef: TObjectDef;
    +    name: String;
    +
    +    pObj: tlocalvarsym;
    +    pIntf: tlocalvarsym;
    +
    +    stmt, callNode: TNode;
    +    symCreateProc: TSym;
    +    dummySymTable: TSymTable;
    +    bRet: Boolean;
    +begin
    +  // - construct classed
    +  // - generate FrameObject initialization nodes
    +  if assigned(pi.frameObjectDef) then exit(false);
    +  FindTypeDefinitions();
    +  name := '$' + pi.procsym.RealName + '_FrameObject'; // TODO: think about name
    +  frameObjectDef := tobjectdef.create(odt_class, name, nil);
    +  frameObjectDef.set_parent( intfObjDef );
    +
    +  pObj := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []); // TODO: Use temp here ?
    +  pIntf := tlocalvarsym.create('$pFrameObjectIntf', vs_var, iIntfDef, []);
    +  pi.localst.insert(pObj);
    +  pi.localst.insert(pIntf);
    +
    +{ only tcgprocinfo have code field and can generate code    }
    +{ so initialization on frameobject can be added for example }
    +{ during pass_1 }
    +
    +{ may be temprorary during development generate code here and then move to appropriate place? }
    +(*
    +  bRet := searchsym_in_class( frameObjectDef, frameObjectDef, 'CREATE', symCreateProc, dummySymTable, false);
    +  if not bRet then InternalError(5);
    +  callNode := CCallNode.Create( nil,
    +                                TProcSym(symCreateProc),
    +                                frameObjectDef.symtable,
    +                                CLoadVmtAddrNode.Create(CTypeNode.Create(frameObjectDef)),
    +                                [cnf_return_value_used] ); // not sure about call parameters
    +  do_typecheckpass(callNode); // most probably should be removed after finishing development
    +
    +  stmt := TAssignmentNode.Create( TLoadNode.Create(pIntf, pi.localst),
    +                                  callNode );
    +  CStatementNode.Create(stmt, nil); { add me to proc body }
    +
    +  stmt := TAssignmentNode.Create( TLoadNode.Create(pIntf, pi.localst),
    +                                  TLoadNode.Create(pObj, pi.localst) );
    +  CStatementNode.Create(stmt, nil); { add me to proc body }
    +{ --- }
    +*)
    +
    +  pi.frameObjectDef     := frameObjectDef;
    +  { pi.frameObjectDeref }
    +  pi.frameObjectSym     := pObj;
    +  pi.frameObjectIntfSym := pIntf;
    +  Result := true;
    +end;
    +
    +function parse_method_reference(name: TIDString): tdef;
    +begin
    +  // TODO:
    +  // type
    +  //   TProc = reference to procedure(var a: Integer; ...);
    +  Result := nil;
    +end;
    +
    +function handle_possible_capture(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
    +begin
    +  // TODO:
    +  Result := nil;
    +end;
    +
    +function parse_nameless_routine(pi: tprocdef): tnode;
    +var anonymProcDef: TProcDef;
    +    intf: TObjectDef;
    +    name: String;
    +begin
    +  maybe_create_frameobject(pi);
    +  anonymProcDef := parse_proc_dec(pi.frameObjectDef, ppm_nameless_routine);
    +  handle_calling_convention(anonymProcDef); // may be after read_proc ?
    +  read_proc(false, anonymProcDef);
    +
    +  name := anonymProcDef.procsym.RealName + '_Intf'; // TODO: think about name
    +  intf := tobjectdef.create(odt_interfacecom, name, nil);
    +  intf.symtable.insert(anonymProcDef.procsym);
    +
    +  pi.frameObjectDef.register_implemented_interface(intf);
    +
    +  // generate typeconv node which return implemented interface
    +  Result := nil;
    +end;
    +
    +function load_captured_variable(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
    +begin
    +  // TODO:
    +  Result := nil;
    +end;
    +
    +begin
    +  
    +end.
    diff --git a/compiler/psub.pas b/compiler/psub.pas
    index 113c67e..fa40b14 100644
    --- a/compiler/psub.pas
    +++ b/compiler/psub.pas
    @@ -28,8 +28,7 @@ interface
         uses
           globals,
           node,nbas,
    -      symdef,procinfo,optdfa,
    -      pdecsub;
    +      symdef,procinfo,optdfa;
     
         type
     
    @@ -1938,7 +1937,7 @@ implementation
     
              if not assigned(usefwpd) then
                { parse procedure declaration }
    -           pd:=parse_proc_dec(isclassmethod,old_current_structdef)
    +           pd:=parse_proc_dec(old_current_structdef,as_procparsemode(isclassmethod))
              else
                pd:=usefwpd;
     
    diff --git a/compiler/ptype.pas b/compiler/ptype.pas
    index 93b3e50..ac32deb 100644
    --- a/compiler/ptype.pas
    +++ b/compiler/ptype.pas
    @@ -27,7 +27,7 @@ interface
     
         uses
            globtype,cclasses,
    -       symtype,symdef,symbase;
    +       symtype,symdef,symbase,pnameless;
     
         type
           TSingleTypeOption=(
    diff --git a/compiler/symdef.pas b/compiler/symdef.pas
    index 83afc44..226608b 100644
    --- a/compiler/symdef.pas
    +++ b/compiler/symdef.pas
    @@ -686,6 +686,12 @@ interface
               interfacedef : boolean;
               { true if the procedure has a forward declaration }
               hasforward  : boolean;
    +
    +          frameObjectDef     : TObjectDef; { FrameObject class }
    +          frameObjectDeref   : tderef;     { TODO: investigate where is tdref used }
    +          frameObjectSym     : tsym;       { variable which holds link to FrameObject }
    +          frameObjectIntfSym : tsym;       { interface variable which keeps FrameObject
    +                                             from garbage collection }
               constructor create(level:byte);
               constructor ppuload(ppufile:tcompilerppufile);
               destructor  destroy;override;
    -- 
    1.7.10.4
    
    
    From 189eedf919ea846ffb7ec099e6c79c3db60edfec Mon Sep 17 00:00:00 2001
    From: Vasiliy Kevroletin <kevroletin@gmail.com>
    Date: Sat, 4 May 2013 11:39:08 +1100
    Subject: [PATCH 04/14] Construct frame object. Return interface-reference as
     parsing result for anonymous function.
    
    Now we are able to generate assembler code. But it crashes :)
    1. Interface variables are not initialized.
    2. Something wrong with frame object interfaces. Even initialization of frame object by hand doesn't help.
    3. Compiler crashes if put anonymous function inside other function (currently only example have anonymous functin inside main)
    ---
     compiler/defcmp.pas    |    6 +-
     compiler/ncgvmt.pas    |   11 +--
     compiler/pdecsub.pas   |    4 +-
     compiler/pnameless.pas |  241 +++++++++++++++++++++++++++++++++++-------------
     compiler/psub.pas      |    9 +-
     compiler/ptype.pas     |    6 +-
     compiler/symdef.pas    |    5 +-
     7 files changed, 198 insertions(+), 84 deletions(-)
    
    diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas
    index 00ba2bd..4f979d0 100644
    --- a/compiler/defcmp.pas
    +++ b/compiler/defcmp.pas
    @@ -158,7 +158,7 @@ implementation
         uses
           verbose,systems,constexp,
           symtable,symsym,
    -      defutil,symutil{,pnameless};
    +      defutil,symutil,pnameless;
     
     
         function compare_defs_ext(def_from,def_to : tdef;
    @@ -1588,9 +1588,6 @@ implementation
                            doconv:=tc_variant_2_interface;
                            eq:=te_convert_l2;
                          end
    -
    -(*** are_compatible_interfaces is missed ***
    -
                        { interface coercion }
                        else if (def_from.typ=objectdef) and
                          (tobjectdef(def_from).objecttype=odt_interfacecom) and
    @@ -1600,7 +1597,6 @@ implementation
                            doconv:=tc_equal;
                            eq:=te_convert_l1;
                          end
    -*)
                        { ugly, but delphi allows it }
                        { in Java enums /are/ class instances, and hence such
                          typecasts must not be treated as integer-like conversions;
    diff --git a/compiler/ncgvmt.pas b/compiler/ncgvmt.pas
    index a6f78c2..76ecee8 100644
    --- a/compiler/ncgvmt.pas
    +++ b/compiler/ncgvmt.pas
    @@ -922,15 +922,8 @@ implementation
               begin
                 def:=tdef(st.DefList[i]);
                 { if def can contain nested types then handle its symtable }
    -            case def.typ of
    -              objectdef,recorddef:
    -                gen_intf_wrappers(list,tabstractrecorddef(def).symtable);
    -              procdef:
    -                // check for local classes; currently, we only use them for closures
    -                // TODO: this can slow codegen down dramatically?!
    -                if assigned(tprocdef(def).localst) then
    -                  gen_intf_wrappers(list,tprocdef(def).localst);
    -            end;
    +            if def.typ in [objectdef,recorddef] then
    +              gen_intf_wrappers(list,tabstractrecorddef(def).symtable);
                 if is_class(def) then
                   gen_intf_wrapper(list,tobjectdef(def));
               end;
    diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
    index 487a585..96c2a74 100644
    --- a/compiler/pdecsub.pas
    +++ b/compiler/pdecsub.pas
    @@ -1001,7 +1001,7 @@ implementation
                 symtablestack.top.insert(aprocsym);
               end;
     
    -        if procparsemode=ppm_nameless_routine then
    +        if (procparsemode=ppm_nameless_routine) or (procparsemode=ppm_method_reference) then
               begin
                 pd:=tprocdef.create(normal_function_level);
                 include(pd.procoptions,po_nameless);
    @@ -3344,7 +3344,7 @@ const
                 if (currpd.proctypeoption = potype_function) and
                    is_void(currpd.returndef) then
                   MessagePos1(currpd.fileinfo,parser_e_no_funcret_specified,currpd.procsym.realname);
    -            currpd.add_to_procsym;
    +            tprocsym(currpd.procsym).ProcdefList.Add(currpd);
               end;
     
             proc_add_definition:=forwardfound;
    diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
    index 4484fb8..464754e 100644
    --- a/compiler/pnameless.pas
    +++ b/compiler/pnameless.pas
    @@ -6,17 +6,46 @@ interface
     
     uses node, symtype, symdef, symsym, globtype;
     
    -function parse_method_reference(name: TIDString): tdef;
    +function are_compatible_interfaces(def_to: TObjectDef; def_from: TObjectDef): Boolean;
    +function parse_method_reference: tdef;
     function handle_possible_capture(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
    -function parse_nameless_routine(pi: tprocdef): tnode;
    +function parse_nameless_routine(var pi: tprocdef): tnode;
     function load_captured_variable(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
    -function maybe_create_frameobject(pi: tprocdef): boolean;
    +function maybe_create_frameobject(var pd: tprocdef): boolean;
    +function maybe_finish_frameobject(pi: tprocdef): boolean;
     
     implementation
     
    -uses nld, { TODO: get rid of cicle reference }
    +(** TODO:
    +  current implementation:
    +  Parse phase:
    ++ 1. Create frame object for parent procedures. Kepp frame object alive using local interface-variable.
    ++ 2. Each anonymous procedure is a method of frame object and method of unique interface with single
    +     method 'Invoke'. Frame object implements this interface.
    ++ 3. Each reference to procedure is interface-variable. Think how to implement.
    ++ 4. Definition of anonymous procedure returns implementation of according onterface from frame object.
    +- 5. Type convertion is aware about this dances.
    +  Typecheck pass:
    +- 6. Call for reference to procedure is translated into call of needed method from interface which is
    +     stored in variable.
    +- 7. Call for interface which is assigned to variable also converted to call of apropriate interface
    +     method.
    +  First pass ?
    +- 8. Add frame object initialization code.
    +
    +Details which should be clarified:
    +LINK [1]
    +1. Generated types registered in module local symtable.
    +   + Required to have proper destruction of data.
    +   + Simple.
    +   - Violates functional approach in developments.
    +   TODO: move to local procedure sym table
    +     - For some reasons Pascal forbids local classes. There can be problems with it. And it's not
    +       obvious to ancient Pascalists
    +*)
     
    -     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas;
    +uses nld, { TODO: get rid of cicle reference }
    +     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas, ncnv, pbase, tokens, nobj, fmodule, ncon;
     (* FrameObject contains
        - captured variables of current procedure as fields
        - anonymous functions as
    @@ -26,7 +55,72 @@ uses nld, { TODO: get rid of cicle reference }
     
        FrameObject implements unique interface for each of it's methods
      *)
    -function maybe_create_frameobject(pi: tprocdef): boolean;
    +
    +procedure BuildObjVmt_(objDef: TobjectDef);
    +var vmtBuilder: TVMTBuilder;
    +begin
    +  vmtBuilder := TVMTBuilder.Create(objDef);
    +  vmtBuilder.generate_vmt;
    +  vmtBuilder.free;
    +end;
    +
    +function maybe_finish_frameobject(pi: tprocdef): boolean;
    +
    +{ only tcgprocinfo have code field and can generate code    }
    +{ so initialization on frameobject can be added for example }
    +{ during pass_1 ? }
    +
    +  // TODO: temporary here
    +  procedure GenFrameObjectInitCode(frameObjectDef: TObjectDef; intfSym, objSym: TSym);
    +  var
    +    createObj, initIntf, assignIntf, callNode: TNode;
    +    symCreateProc: TSym;
    +    dummySymTable: TSymTable;
    +    bRet: Boolean;
    +    stmt: TStatementNode;
    +    cgpi: tcgprocinfo;
    +    block: tblocknode;
    +  begin
    +    bRet := searchsym_in_class( frameObjectDef, frameObjectDef, 'CREATE', symCreateProc, dummySymTable, false);
    +    if not bRet then InternalError(5);
    +    callNode := CCallNode.Create( nil,
    +                                  TProcSym(symCreateProc),
    +                                  frameObjectDef.symtable,
    +                                  CLoadVmtAddrNode.Create(CTypeNode.Create(frameObjectDef)),
    +                                  [cnf_return_value_used] ); // not sure about call parameters
    +    do_typecheckpass(callNode); // most probably should be removed after finishing development
    +
    +    cgpi := tcgprocinfo(current_procinfo);
    +    if cgpi.code.nodetype <> blockn then InternalError(5);
    +    block := TBlockNode(cgpi.code);
    +
    +    createObj := CAssignmentNode.Create(CLoadNode.Create(objSym, pi.localst),
    +                                        callNode);
    +    initIntf := CAssignmentNode.Create(CLoadNode.Create(intfSym, pi.localst),
    +                                       CNilNode.Create());
    +    assignIntf := CAssignmentNode.Create(CLoadNode.Create(intfSym, pi.localst),
    +                                         CLoadNode.Create(objSym, pi.localst));
    +
    +    stmt := CStatementNode.Create(createObj,
    +//            CStatementNode.Create(initIntf, // *** MEGATODO *** We broke initialization of interface variables
    +// which causes segmentation faults
    +            CStatementNode.Create(assignIntf,
    +                                  block.left));
    +    block.left := stmt;
    +
    +    do_typecheckpass(TNode(block));
    +  end;
    +
    +begin
    +  Result := assigned(pi.frameObjectDef);
    +  if Result then
    +  begin
    +    BuildObjVmt_(pi.frameObjectDef);
    +    GenFrameObjectInitCode(pi.frameObjectDef, pi.frameObjectIntfSym, pi.frameObjectSym);
    +  end;
    +end;
    +
    +function maybe_create_frameobject(var pd: tprocdef): boolean;
     var iIntfDef, intfObjDef: TObjectDef;
     
       function FindTypeDefinitions: boolean;
    @@ -48,65 +142,63 @@ var iIntfDef, intfObjDef: TObjectDef;
     var frameObjectDef: TObjectDef;
         name: String;
     
    -    pObj: tlocalvarsym;
    -    pIntf: tlocalvarsym;
    -
    -    stmt, callNode: TNode;
    -    symCreateProc: TSym;
    -    dummySymTable: TSymTable;
    -    bRet: Boolean;
    +    objSym: tlocalvarsym;
    +    intfSym: tlocalvarsym;
     begin
       // - construct classed
       // - generate FrameObject initialization nodes
    -  if assigned(pi.frameObjectDef) then exit(false);
    +  if assigned(pd.frameObjectDef) then exit(false);
       FindTypeDefinitions();
    -  name := '$' + pi.procsym.RealName + '_FrameObject'; // TODO: think about name
    +  name := '$' + pd.procsym.RealName + '_FrameObjectDef'; // TODO: think about name
       frameObjectDef := tobjectdef.create(odt_class, name, nil);
    +  include(frameObjectDef.objectoptions, oo_is_nameless);
    +  frameObjectDef.typesym := TTypeSym.Create(name, frameObjectDef);
       frameObjectDef.set_parent( intfObjDef );
     
    -  pObj := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []); // TODO: Use temp here ?
    -  pIntf := tlocalvarsym.create('$pFrameObjectIntf', vs_var, iIntfDef, []);
    -  pi.localst.insert(pObj);
    -  pi.localst.insert(pIntf);
    -
    -{ only tcgprocinfo have code field and can generate code    }
    -{ so initialization on frameobject can be added for example }
    -{ during pass_1 }
    -
    -{ may be temprorary during development generate code here and then move to appropriate place? }
    -(*
    -  bRet := searchsym_in_class( frameObjectDef, frameObjectDef, 'CREATE', symCreateProc, dummySymTable, false);
    -  if not bRet then InternalError(5);
    -  callNode := CCallNode.Create( nil,
    -                                TProcSym(symCreateProc),
    -                                frameObjectDef.symtable,
    -                                CLoadVmtAddrNode.Create(CTypeNode.Create(frameObjectDef)),
    -                                [cnf_return_value_used] ); // not sure about call parameters
    -  do_typecheckpass(callNode); // most probably should be removed after finishing development
    -
    -  stmt := TAssignmentNode.Create( TLoadNode.Create(pIntf, pi.localst),
    -                                  callNode );
    -  CStatementNode.Create(stmt, nil); { add me to proc body }
    -
    -  stmt := TAssignmentNode.Create( TLoadNode.Create(pIntf, pi.localst),
    -                                  TLoadNode.Create(pObj, pi.localst) );
    -  CStatementNode.Create(stmt, nil); { add me to proc body }
    -{ --- }
    -*)
    +  objSym := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []); // TODO: Use temp here ?
    +  intfSym := tlocalvarsym.create('$pFrameObjectIntf', vs_var, iIntfDef, []);
    +  pd.localst.insert(objSym);
    +  pd.localst.insert(intfSym);
    +//  pd.localst.insert(frameObjectDef.typesym); see comments somewhere below
    +  current_module.localsymtable.insert(frameObjectDef.typesym); // ^_^ why not ?
     
    -  pi.frameObjectDef     := frameObjectDef;
    -  { pi.frameObjectDeref }
    -  pi.frameObjectSym     := pObj;
    -  pi.frameObjectIntfSym := pIntf;
    +  pd.frameObjectDef     := frameObjectDef;
    +  { pd.frameObjectDeref }
    +  pd.frameObjectSym     := objSym;
    +  pd.frameObjectIntfSym := intfSym;
       Result := true;
    +
     end;
     
    -function parse_method_reference(name: TIDString): tdef;
    +function are_compatible_interfaces(def_to: TObjectDef; def_from: TObjectDef): Boolean;
     begin
    -  // TODO:
    -  // type
    -  //   TProc = reference to procedure(var a: Integer; ...);
    -  Result := nil;
    +  // TODO: Perform meaningful check!!!
    +  Result := def_to.isClosure and def_from.isClosure;
    +end;
    +
    +function parse_method_reference: tdef;
    +var typesym: TTypeSym;
    +    intf: TObjectDef;
    +    name: String;
    +    procDef: TProcDef;
    +begin
    +  consume(_REFERENCE); consume(_TO);
    +  name := 'SuperPuper_Intf'; // TODO: think about name
    +  intf := tobjectdef.create(odt_interfacecom, name, nil);
    +  intf.typesym := TTypeSym.Create(name, intf);
    +  intf.isClosure := true;
    +
    +  // ZZZ: tsym.name work incorrectly if not to add symbol to symtable
    +  symtablestack.top.insert(intf.typesym); // TODO: it it right place to insert ?
    +
    +  symtablestack.push(intf.symtable);
    +  procDef := parse_proc_dec(intf, ppm_method_reference);
    +  include(procDef.procoptions, po_virtualmethod);
    +  tprocsym(procDef.procsym).ProcdefList.Add(procDef); // unless procedure will be invisible
    +  handle_calling_convention(procDef);
    +  symtablestack.pop(intf.symtable);
    +  BuildObjVmt_(intf);
    +  Result := intf;
     end;
     
     function handle_possible_capture(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
    @@ -115,24 +207,49 @@ begin
       Result := nil;
     end;
     
    -function parse_nameless_routine(pi: tprocdef): tnode;
    +function parse_nameless_routine(var pi: tprocdef): tnode;
    +
    +  // well, I don't like this banch of gloval variables which each function save on stack
    +  procedure ReadProcBody_(framObjectDef: TObjectDef; anonymProcDef: TProcDef);
    +  var old_current_structdef: tabstractrecorddef;
    +  begin
    +    old_current_structdef := current_structdef;
    +    current_structdef := framObjectDef;
    +    read_proc(false, anonymProcDef);
    +    proc_add_definition(anonymProcDef);     { add definition to procsym } // TODO: does it makes sense ? // !!! doesn't checked yett
    +    current_structdef := old_current_structdef;
    +  end;
    +
     var anonymProcDef: TProcDef;
    +    cloneProcDef: TProcDef;
         intf: TObjectDef;
    -    name: String;
    +    intfName: String;
     begin
       maybe_create_frameobject(pi);
    +//  symtablestack.push(pi.frameObjectDef.symtable);
       anonymProcDef := parse_proc_dec(pi.frameObjectDef, ppm_nameless_routine);
    -  handle_calling_convention(anonymProcDef); // may be after read_proc ?
    -  read_proc(false, anonymProcDef);
    +  include(anonymProcDef.procoptions, po_virtualmethod);
    +  handle_calling_convention(anonymProcDef);
    +  cloneProcDef := TProcDef(anonymProcDef.getcopy);
     
    -  name := anonymProcDef.procsym.RealName + '_Intf'; // TODO: think about name
    -  intf := tobjectdef.create(odt_interfacecom, name, nil);
    -  intf.symtable.insert(anonymProcDef.procsym);
    +  ReadProcBody_(pi.frameObjectDef, anonymProcDef);
    +//  symtablestack.pop(pi.frameObjectDef.symtable); // think about this more
    +
    +  intfName := anonymProcDef.procsym.RealName + '_IntfDef'; // TODO: think about name
    +  intf := tobjectdef.create(odt_interfacecom, intfName, nil);
    +  intf.typesym := TTypeSym.Create(intfName, intf);
    +  current_module.localsymtable.insert(intf.typesym); // [1]
    +
    +  cloneProcDef.struct := intf;
    +  cloneProcDef.procsym := TProcSym.Create('Invoke');
    +  intf.symtable.insert(cloneProcDef.procsym);
    +  intf.isClosure := true;
    +  BuildObjVmt_(intf);
     
       pi.frameObjectDef.register_implemented_interface(intf);
     
    -  // generate typeconv node which return implemented interface
    -  Result := nil;
    +  Result := CLoadNode.Create(pi.frameObjectSym, pi.localst);
    +  inserttypeconv(Result, intf);
     end;
     
     function load_captured_variable(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
    diff --git a/compiler/psub.pas b/compiler/psub.pas
    index fa40b14..ae002ab 100644
    --- a/compiler/psub.pas
    +++ b/compiler/psub.pas
    @@ -127,6 +127,7 @@ implementation
                ,aopt
              {$endif i386}
            {$endif}
    +       ,pnameless
            ;
     
         function checknodeinlining(procdef: tprocdef): boolean;
    @@ -1712,6 +1713,7 @@ implementation
     
              { parse the code ... }
              code:=block(current_module.islibrary);
    +         maybe_finish_frameobject(self.procDef);
     
              if (df_generic in procdef.defoptions) then
                begin
    @@ -1898,7 +1900,12 @@ implementation
             { For specialization we didn't record the last semicolon. Moving this parsing
               into the parse_body routine is not done because of having better file position
               information available }
    -        if not(df_specialization in current_procinfo.procdef.defoptions) then
    +
    +        // TDOO: ugly hack
    +        if not(df_specialization in current_procinfo.procdef.defoptions) and
    +           not (assigned(current_procinfo.procdef.struct) and
    +                (oo_is_nameless in current_procinfo.procdef.struct.objectoptions))
    +        then
               consume(_SEMICOLON);
     
             if not isnestedproc then
    diff --git a/compiler/ptype.pas b/compiler/ptype.pas
    index ac32deb..07b2ba8 100644
    --- a/compiler/ptype.pas
    +++ b/compiler/ptype.pas
    @@ -27,7 +27,7 @@ interface
     
         uses
            globtype,cclasses,
    -       symtype,symdef,symbase,pnameless;
    +       symtype,symdef,symbase;
     
         type
           TSingleTypeOption=(
    @@ -81,7 +81,7 @@ implementation
            nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
            { parser }
            scanner,
    -       pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil{,pnameless}
    +       pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil,pnameless
     {$ifdef jvm}
            ,pjvm
     {$endif}
    @@ -1675,7 +1675,7 @@ implementation
                   end;
                 _ID:
                   if idtoken=_REFERENCE then // TODO: $mode Delphi only?
    -                def:=parse_method_reference(name)
    +                def:=parse_method_reference
                   else
                     expr_type;
                 else
    diff --git a/compiler/symdef.pas b/compiler/symdef.pas
    index 226608b..9f6aab7 100644
    --- a/compiler/symdef.pas
    +++ b/compiler/symdef.pas
    @@ -357,6 +357,8 @@ interface
               }
               classref_created_in_current_module : boolean;
               objecttype     : tobjecttyp;
    +                                    // TODO: this is hack
    +          isClosure      : Boolean; // Interface is generated for anonymous method or for methodvar
               constructor create(ot:tobjecttyp;const n:string;c:tobjectdef);
               constructor ppuload(ppufile:tcompilerppufile);
               destructor  destroy;override;
    @@ -377,9 +379,7 @@ interface
               function  find_implemented_interface(aintfdef:tobjectdef):TImplementedInterface;
               { this should be called when this class implements an interface }
               procedure register_implemented_interface(const intfdef: tobjectdef);
    -       strict private
               procedure prepareguid;
    -       public
               function  is_publishable : boolean;override;
               function  is_related(d : tdef) : boolean;override;
               function  needs_inittable : boolean;override;
    @@ -5395,6 +5395,7 @@ implementation
     
        constructor tobjectdef.create(ot:tobjecttyp;const n:string;c:tobjectdef);
          begin
    +        isClosure := false;
             inherited create(n,objectdef);
             fcurrent_dispid:=0;
             objecttype:=ot;
    -- 
    1.7.10.4
    
    
    From 7c8a60a91d0a6f0056783bea1367865b0738e0b2 Mon Sep 17 00:00:00 2001
    From: Vasiliy Kevroletin <kevroletin@gmail.com>
    Date: Fri, 10 May 2013 14:24:17 +1100
    Subject: [PATCH 05/14] Generate frame object's initialization code in right
     place.
    
    Now compiler parses anonymous functin not only inside PascalMain.
    
    TODO:
    Resulting programms crash. This is because compiler does not generat interface wrappers.
    ---
     compiler/pnameless.pas |  127 ++++++++++++++++++++++++------------------------
     compiler/psub.pas      |    5 +-
     2 files changed, 67 insertions(+), 65 deletions(-)
    
    diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
    index 464754e..0effb49 100644
    --- a/compiler/pnameless.pas
    +++ b/compiler/pnameless.pas
    @@ -8,16 +8,18 @@ uses node, symtype, symdef, symsym, globtype;
     
     function are_compatible_interfaces(def_to: TObjectDef; def_from: TObjectDef): Boolean;
     function parse_method_reference: tdef;
    -function handle_possible_capture(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
    -function parse_nameless_routine(var pi: tprocdef): tnode;
    -function load_captured_variable(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
    +function handle_possible_capture(pd: tprocdef; name: tabstractnormalvarsym): tnode;
    +function parse_nameless_routine(var pd: tprocdef): tnode;
    +function load_captured_variable(pd: tprocdef; name: tabstractnormalvarsym): tnode;
     function maybe_create_frameobject(var pd: tprocdef): boolean;
    -function maybe_finish_frameobject(pi: tprocdef): boolean;
    +function maybe_finish_frameobject(pd: tprocdef): boolean;
    +function add_init_frameobject(body: TNode; pd: TProcDef): TNode;
     
     implementation
     
     (** TODO:
    -  current implementation:
    +
    +Current implementation:
       Parse phase:
     + 1. Create frame object for parent procedures. Kepp frame object alive using local interface-variable.
     + 2. Each anonymous procedure is a method of frame object and method of unique interface with single
    @@ -42,6 +44,14 @@ LINK [1]
        TODO: move to local procedure sym table
          - For some reasons Pascal forbids local classes. There can be problems with it. And it's not
            obvious to ancient Pascalists
    +
    +2. How link to self will be stored?
    +
    +Current problems:
    +1. Interface variables are not initialized by 0s.
    +2. Compiler crashes if declare anonymous function not inside main.
    +3. Interface wrappers are not generated.
    +
     *)
     
     uses nld, { TODO: get rid of cicle reference }
    @@ -64,60 +74,49 @@ begin
       vmtBuilder.free;
     end;
     
    -function maybe_finish_frameobject(pi: tprocdef): boolean;
    -
    -{ only tcgprocinfo have code field and can generate code    }
    -{ so initialization on frameobject can be added for example }
    -{ during pass_1 ? }
    -
    -  // TODO: temporary here
    -  procedure GenFrameObjectInitCode(frameObjectDef: TObjectDef; intfSym, objSym: TSym);
    -  var
    -    createObj, initIntf, assignIntf, callNode: TNode;
    -    symCreateProc: TSym;
    -    dummySymTable: TSymTable;
    -    bRet: Boolean;
    -    stmt: TStatementNode;
    -    cgpi: tcgprocinfo;
    -    block: tblocknode;
    -  begin
    -    bRet := searchsym_in_class( frameObjectDef, frameObjectDef, 'CREATE', symCreateProc, dummySymTable, false);
    -    if not bRet then InternalError(5);
    -    callNode := CCallNode.Create( nil,
    -                                  TProcSym(symCreateProc),
    -                                  frameObjectDef.symtable,
    -                                  CLoadVmtAddrNode.Create(CTypeNode.Create(frameObjectDef)),
    -                                  [cnf_return_value_used] ); // not sure about call parameters
    -    do_typecheckpass(callNode); // most probably should be removed after finishing development
    -
    -    cgpi := tcgprocinfo(current_procinfo);
    -    if cgpi.code.nodetype <> blockn then InternalError(5);
    -    block := TBlockNode(cgpi.code);
    -
    -    createObj := CAssignmentNode.Create(CLoadNode.Create(objSym, pi.localst),
    -                                        callNode);
    -    initIntf := CAssignmentNode.Create(CLoadNode.Create(intfSym, pi.localst),
    -                                       CNilNode.Create());
    -    assignIntf := CAssignmentNode.Create(CLoadNode.Create(intfSym, pi.localst),
    -                                         CLoadNode.Create(objSym, pi.localst));
    -
    -    stmt := CStatementNode.Create(createObj,
    -//            CStatementNode.Create(initIntf, // *** MEGATODO *** We broke initialization of interface variables
    -// which causes segmentation faults
    -            CStatementNode.Create(assignIntf,
    -                                  block.left));
    -    block.left := stmt;
    -
    -    do_typecheckpass(TNode(block));
    -  end;
    +function add_init_frameobject(body: TNode; pd: TProcDef): TNode;
    +var
    +  createObj, assignIntf, callNode: TNode;
    +  symCreateProc: TSym;
    +  dummySymTable: TSymTable;
    +  bRet: Boolean;
    +  stmt: TStatementNode;
    +  block: tblocknode;
    +  intfSym, objSym: TSym;
    +begin
    +  intfSym := pd.frameObjectIntfSym;
    +  objSym := pd.frameObjectSym;
    +
    +  bRet := searchsym_in_class( pd.frameObjectDef, pd.frameObjectDef, 'CREATE', symCreateProc, dummySymTable, false);
    +  if not bRet then InternalError(5);
    +  callNode := CCallNode.Create( nil,
    +                                TProcSym(symCreateProc),
    +                                pd.frameObjectDef.symtable,
    +                                CLoadVmtAddrNode.Create(CTypeNode.Create(pd.frameObjectDef)),
    +                                [cnf_return_value_used] ); // not sure about call parameters
    +  do_typecheckpass(callNode); // most probably should be removed after finishing development
    +
    +  block := TBlockNode(body);
    +
    +  createObj := CAssignmentNode.Create(CLoadNode.Create(objSym, pd.localst),
    +                                      callNode);
    +  assignIntf := CAssignmentNode.Create(CLoadNode.Create(intfSym, pd.localst),
    +                                       CLoadNode.Create(objSym, pd.localst));
    +
    +  stmt := CStatementNode.Create(createObj,
    +          CStatementNode.Create(assignIntf,
    +                                block.left));
    +  block.left := stmt;
    +
    +  do_typecheckpass(TNode(block));
    +  Result := block;
    +end;
     
    +function maybe_finish_frameobject(pd: tprocdef): boolean;
     begin
    -  Result := assigned(pi.frameObjectDef);
    +  Result := assigned(pd.frameObjectDef);
       if Result then
    -  begin
    -    BuildObjVmt_(pi.frameObjectDef);
    -    GenFrameObjectInitCode(pi.frameObjectDef, pi.frameObjectIntfSym, pi.frameObjectSym);
    -  end;
    +    BuildObjVmt_(pd.frameObjectDef);
     end;
     
     function maybe_create_frameobject(var pd: tprocdef): boolean;
    @@ -201,13 +200,13 @@ begin
       Result := intf;
     end;
     
    -function handle_possible_capture(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
    +function handle_possible_capture(pd: tprocdef; name: tabstractnormalvarsym): tnode;
     begin
       // TODO:
       Result := nil;
     end;
     
    -function parse_nameless_routine(var pi: tprocdef): tnode;
    +function parse_nameless_routine(var pd: tprocdef): tnode;
     
       // well, I don't like this banch of gloval variables which each function save on stack
       procedure ReadProcBody_(framObjectDef: TObjectDef; anonymProcDef: TProcDef);
    @@ -225,14 +224,14 @@ var anonymProcDef: TProcDef;
         intf: TObjectDef;
         intfName: String;
     begin
    -  maybe_create_frameobject(pi);
    +  maybe_create_frameobject(pd);
     //  symtablestack.push(pi.frameObjectDef.symtable);
    -  anonymProcDef := parse_proc_dec(pi.frameObjectDef, ppm_nameless_routine);
    +  anonymProcDef := parse_proc_dec(pd.frameObjectDef, ppm_nameless_routine);
       include(anonymProcDef.procoptions, po_virtualmethod);
       handle_calling_convention(anonymProcDef);
       cloneProcDef := TProcDef(anonymProcDef.getcopy);
     
    -  ReadProcBody_(pi.frameObjectDef, anonymProcDef);
    +  ReadProcBody_(pd.frameObjectDef, anonymProcDef);
     //  symtablestack.pop(pi.frameObjectDef.symtable); // think about this more
     
       intfName := anonymProcDef.procsym.RealName + '_IntfDef'; // TODO: think about name
    @@ -246,13 +245,13 @@ begin
       intf.isClosure := true;
       BuildObjVmt_(intf);
     
    -  pi.frameObjectDef.register_implemented_interface(intf);
    +  pd.frameObjectDef.register_implemented_interface(intf);
     
    -  Result := CLoadNode.Create(pi.frameObjectSym, pi.localst);
    +  Result := CLoadNode.Create(pd.frameObjectSym, pd.localst);
       inserttypeconv(Result, intf);
     end;
     
    -function load_captured_variable(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
    +function load_captured_variable(pd: tprocdef; name: tabstractnormalvarsym): tnode;
     begin
       // TODO:
       Result := nil;
    diff --git a/compiler/psub.pas b/compiler/psub.pas
    index ae002ab..034195c 100644
    --- a/compiler/psub.pas
    +++ b/compiler/psub.pas
    @@ -337,6 +337,10 @@ implementation
                 begin
                    { parse routine body }
                    block:=statement_block(_BEGIN);
    +               if maybe_finish_frameobject(current_procinfo.procdef) then
    +                 block := add_init_frameobject(block, current_procinfo.procdef);
    +
    +
                    { initialized variables }
                    if current_procinfo.procdef.localst.symtabletype=localsymtable then
                      begin
    @@ -1713,7 +1717,6 @@ implementation
     
              { parse the code ... }
              code:=block(current_module.islibrary);
    -         maybe_finish_frameobject(self.procDef);
     
              if (df_generic in procdef.defoptions) then
                begin
    -- 
    1.7.10.4
    
    
    From cea0df318482744ded3c5fcb9a8e84463762bf1a Mon Sep 17 00:00:00 2001
    From: Vasiliy Kevroletin <kevroletin@gmail.com>
    Date: Mon, 13 May 2013 12:52:53 +1100
    Subject: [PATCH 06/14] Inherit created interfaces xfrom IUnknown.
    
    Current problems:
     -interface variables isn't initialized by 0s(probably because I used localvarsym instead of staticvarsym in pascalmain;
     -intf wrappers (again) is not generated. But now virtual tables are ok;
     -didn't check call of anonymous function
    ---
     compiler/pnameless.pas |   28 ++++++++++++++++------------
     1 file changed, 16 insertions(+), 12 deletions(-)
    
    diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
    index 0effb49..441d10f 100644
    --- a/compiler/pnameless.pas
    +++ b/compiler/pnameless.pas
    @@ -120,9 +120,9 @@ begin
     end;
     
     function maybe_create_frameobject(var pd: tprocdef): boolean;
    -var iIntfDef, intfObjDef: TObjectDef;
    +var intfObjDef: TObjectDef;
     
    -  function FindTypeDefinitions: boolean;
    +  function FindTypeDefinitions_: boolean;
       var sym: tsym;
           symtable: tsymtable;
       begin
    @@ -131,10 +131,6 @@ var iIntfDef, intfObjDef: TObjectDef;
         if not assigned(sym) then InternalError(1);
         if (sym.typ <> typesym) then InternalError(2);
         intfObjDef := tobjectdef(ttypesym(sym).typedef);
    -    searchsym_type('IUNKNOWN', sym, symtable);
    -    if not assigned(sym) then InternalError(3);
    -    if (sym.typ <> typesym) then InternalError(4);
    -    iIntfDef := tobjectdef(ttypesym(sym).typedef);
         Result := true;
       end;
     
    @@ -144,10 +140,8 @@ var frameObjectDef: TObjectDef;
         objSym: tlocalvarsym;
         intfSym: tlocalvarsym;
     begin
    -  // - construct classed
    -  // - generate FrameObject initialization nodes
       if assigned(pd.frameObjectDef) then exit(false);
    -  FindTypeDefinitions();
    +  FindTypeDefinitions_();
       name := '$' + pd.procsym.RealName + '_FrameObjectDef'; // TODO: think about name
       frameObjectDef := tobjectdef.create(odt_class, name, nil);
       include(frameObjectDef.objectoptions, oo_is_nameless);
    @@ -155,7 +149,7 @@ begin
       frameObjectDef.set_parent( intfObjDef );
     
       objSym := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []); // TODO: Use temp here ?
    -  intfSym := tlocalvarsym.create('$pFrameObjectIntf', vs_var, iIntfDef, []);
    +  intfSym := tlocalvarsym.create('$pFrameObjectIntf', vs_var, interface_iunknown, []);
       pd.localst.insert(objSym);
       pd.localst.insert(intfSym);
     //  pd.localst.insert(frameObjectDef.typesym); see comments somewhere below
    @@ -172,7 +166,7 @@ end;
     function are_compatible_interfaces(def_to: TObjectDef; def_from: TObjectDef): Boolean;
     begin
       // TODO: Perform meaningful check!!!
    -  Result := def_to.isClosure and def_from.isClosure;
    +  Result := def_to.isClosure or def_from.isClosure;
     end;
     
     function parse_method_reference: tdef;
    @@ -184,6 +178,7 @@ begin
       consume(_REFERENCE); consume(_TO);
       name := 'SuperPuper_Intf'; // TODO: think about name
       intf := tobjectdef.create(odt_interfacecom, name, nil);
    +  intf.set_parent(interface_iunknown);
       intf.typesym := TTypeSym.Create(name, intf);
       intf.isClosure := true;
     
    @@ -195,6 +190,7 @@ begin
       include(procDef.procoptions, po_virtualmethod);
       tprocsym(procDef.procsym).ProcdefList.Add(procDef); // unless procedure will be invisible
       handle_calling_convention(procDef);
    +  proc_add_definition(procDef); // not sure why it is here
       symtablestack.pop(intf.symtable);
       BuildObjVmt_(intf);
       Result := intf;
    @@ -211,12 +207,18 @@ function parse_nameless_routine(var pd: tprocdef): tnode;
       // well, I don't like this banch of gloval variables which each function save on stack
       procedure ReadProcBody_(framObjectDef: TObjectDef; anonymProcDef: TProcDef);
       var old_current_structdef: tabstractrecorddef;
    +      old_current_procinfo: tprocinfo;
       begin
         old_current_structdef := current_structdef;
    +    old_current_procinfo := current_procinfo;
         current_structdef := framObjectDef;
    +    while current_procinfo.parent <> nil do
    +      current_procinfo := current_procinfo.parent;
         read_proc(false, anonymProcDef);
    -    proc_add_definition(anonymProcDef);     { add definition to procsym } // TODO: does it makes sense ? // !!! doesn't checked yett
    +    proc_add_definition(anonymProcDef);     { add definition to procsym }
         current_structdef := old_current_structdef;
    +    current_procinfo := old_current_procinfo;
    +    current_module.procinfo := old_current_procinfo;
       end;
     
     var anonymProcDef: TProcDef;
    @@ -229,6 +231,7 @@ begin
       anonymProcDef := parse_proc_dec(pd.frameObjectDef, ppm_nameless_routine);
       include(anonymProcDef.procoptions, po_virtualmethod);
       handle_calling_convention(anonymProcDef);
    +//  proc_add_definition(anonymProcDef);
       cloneProcDef := TProcDef(anonymProcDef.getcopy);
     
       ReadProcBody_(pd.frameObjectDef, anonymProcDef);
    @@ -237,6 +240,7 @@ begin
       intfName := anonymProcDef.procsym.RealName + '_IntfDef'; // TODO: think about name
       intf := tobjectdef.create(odt_interfacecom, intfName, nil);
       intf.typesym := TTypeSym.Create(intfName, intf);
    +  intf.set_parent(interface_iunknown);
       current_module.localsymtable.insert(intf.typesym); // [1]
     
       cloneProcDef.struct := intf;
    -- 
    1.7.10.4
    
    
    From 636623928c62b4a38f80d6ed98c5a3a8e9a96647 Mon Sep 17 00:00:00 2001
    From: Vasiliy Kevroletin <kevroletin@gmail.com>
    Date: Sun, 19 May 2013 18:50:14 +1100
    Subject: [PATCH 07/14] Fixed generation of intf wrappers. Now vtbl for frame
     object is ok. Intf wrappers are ok.
    
    Problem: compiler generate intf wrappers for frame object only if closure defined inside PascalMain.
    Cause: during creation of tprocdef it adds itself into module defs and into top symtable defs(look into one of inherited constructors of tprocdef). Since class definition inside procedure is forbidden all class definitions was inside
    current_module.localsymtable. And code which generates wrappers didn't look into nested symtables.
    Fix: walk through nested symtables during creation of intf wrappers.
    
    Current state:
    + it's possible to assign closure to variable and call it
    + looks like parameters passing works ok
    - variables capturing doesn't work
    - compiler doesn't check types during assignment of closure to variable
    - it's magic that something works, didn't perform proper(and even not proper) testing
    ---
     compiler/ncgvmt.pas    |    8 ++++++--
     compiler/pnameless.pas |   38 +++++++++++++++++++-------------------
     2 files changed, 25 insertions(+), 21 deletions(-)
    
    diff --git a/compiler/ncgvmt.pas b/compiler/ncgvmt.pas
    index 76ecee8..cf2d7e5 100644
    --- a/compiler/ncgvmt.pas
    +++ b/compiler/ncgvmt.pas
    @@ -921,9 +921,13 @@ implementation
             for i:=0 to st.DefList.Count-1 do
               begin
                 def:=tdef(st.DefList[i]);
    -            { if def can contain nested types then handle its symtable }
    +            { if def can contain nested types then handle it symtable }
                 if def.typ in [objectdef,recorddef] then
    -              gen_intf_wrappers(list,tabstractrecorddef(def).symtable);
    +              gen_intf_wrappers(list,tabstractrecorddef(def).symtable)
    +            // Defs are inserted into top symtable during construction. During closure parsing we
    +            // create class definition for frame object, so it stored in procedure localsymtable.
    +            else if (def.typ in [procdef]) and (assigned(tprocdef(def).localst)) then
    +              gen_intf_wrappers(list,tprocdef(def).localst);
                 if is_class(def) then
                   gen_intf_wrapper(list,tobjectdef(def));
               end;
    diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
    index 441d10f..a3a640b 100644
    --- a/compiler/pnameless.pas
    +++ b/compiler/pnameless.pas
    @@ -143,10 +143,9 @@ begin
       if assigned(pd.frameObjectDef) then exit(false);
       FindTypeDefinitions_();
       name := '$' + pd.procsym.RealName + '_FrameObjectDef'; // TODO: think about name
    -  frameObjectDef := tobjectdef.create(odt_class, name, nil);
    +  frameObjectDef := tobjectdef.create(odt_class, name, intfObjDef);
    +  TTypeSym.Create(name, frameObjectDef);
       include(frameObjectDef.objectoptions, oo_is_nameless);
    -  frameObjectDef.typesym := TTypeSym.Create(name, frameObjectDef);
    -  frameObjectDef.set_parent( intfObjDef );
     
       objSym := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []); // TODO: Use temp here ?
       intfSym := tlocalvarsym.create('$pFrameObjectIntf', vs_var, interface_iunknown, []);
    @@ -176,14 +175,14 @@ var typesym: TTypeSym;
         procDef: TProcDef;
     begin
       consume(_REFERENCE); consume(_TO);
    -  name := 'SuperPuper_Intf'; // TODO: think about name
    -  intf := tobjectdef.create(odt_interfacecom, name, nil);
    -  intf.set_parent(interface_iunknown);
    +  name := 'ClosureReference_IntfDef'; // TODO: think about name
    +  intf := tobjectdef.create(odt_interfacecom, name, interface_iunknown);
       intf.typesym := TTypeSym.Create(name, intf);
       intf.isClosure := true;
     
    -  // ZZZ: tsym.name work incorrectly if not to add symbol to symtable
    -  symtablestack.top.insert(intf.typesym); // TODO: it it right place to insert ?
    +// ZZZ: tsym.name work incorrectly if not to add symbol to symtable
    +//  symtablestack.top.insert(intf.typesym); // TODO: it it right place to insert ?
    +  current_module.localsymtable.insert(intf.typesym);
     
       symtablestack.push(intf.symtable);
       procDef := parse_proc_dec(intf, ppm_method_reference);
    @@ -227,24 +226,25 @@ var anonymProcDef: TProcDef;
         intfName: String;
     begin
       maybe_create_frameobject(pd);
    -//  symtablestack.push(pi.frameObjectDef.symtable);
    +
    +  symtablestack.push(pd.frameObjectDef.symtable); // procdef will add itself in deflist during creation
       anonymProcDef := parse_proc_dec(pd.frameObjectDef, ppm_nameless_routine);
    -  include(anonymProcDef.procoptions, po_virtualmethod);
       handle_calling_convention(anonymProcDef);
    -//  proc_add_definition(anonymProcDef);
    +
    +  intfName := anonymProcDef.procsym.RealName + '_ClosureImpl_IntfDef'; // TODO: think about name
    +  intf := tobjectdef.create(odt_interfacecom, intfName, interface_iunknown);
    +  TTypeSym.Create(intfName, intf);
    +  current_module.localsymtable.insert(intf.typesym); // [1]
    +
    +  symtablestack.push(intf.symtable); // procdef should be inside intf symtable, otherwise it will not be in vtlb
       cloneProcDef := TProcDef(anonymProcDef.getcopy);
    +  symtablestack.pop(intf.symtable);
     
       ReadProcBody_(pd.frameObjectDef, anonymProcDef);
    -//  symtablestack.pop(pi.frameObjectDef.symtable); // think about this more
    -
    -  intfName := anonymProcDef.procsym.RealName + '_IntfDef'; // TODO: think about name
    -  intf := tobjectdef.create(odt_interfacecom, intfName, nil);
    -  intf.typesym := TTypeSym.Create(intfName, intf);
    -  intf.set_parent(interface_iunknown);
    -  current_module.localsymtable.insert(intf.typesym); // [1]
    +  symtablestack.pop(pd.frameObjectDef.symtable);
     
       cloneProcDef.struct := intf;
    -  cloneProcDef.procsym := TProcSym.Create('Invoke');
    +  cloneProcDef.procsym := TProcSym.Create(anonymProcDef.procsym.Name);
       intf.symtable.insert(cloneProcDef.procsym);
       intf.isClosure := true;
       BuildObjVmt_(intf);
    -- 
    1.7.10.4
    
    
    From 5e9f5873657afbbc43a70a5e589c67f78ffa845b Mon Sep 17 00:00:00 2001
    From: Vasiliy Kevroletin <kevroletin@gmail.com>
    Date: Sun, 19 May 2013 22:47:36 +1100
    Subject: [PATCH 08/14] Simple tests. Little refactoring.
    
    To run tests
    1) build compiler by lazarus(or change path to compiler executable in devtest/test.sh)
    2) cd ./devtest
    3) sh test.sh
    ---
     compiler/pnameless.pas |  124 +++++++++++++++++++++++++-----------------------
     devtest/01.out         |    3 ++
     devtest/01.pas         |   18 +++++++
     devtest/02.out         |    3 ++
     devtest/02.pas         |   22 +++++++++
     devtest/03.out         |    3 ++
     devtest/03.pas         |   27 +++++++++++
     devtest/04.out         |    3 ++
     devtest/04.pas         |   22 +++++++++
     devtest/05.out         |    4 ++
     devtest/05.pas         |   26 ++++++++++
     devtest/06.out         |    4 ++
     devtest/06.pas         |   39 +++++++++++++++
     devtest/07.out         |    2 +
     devtest/07.pas         |   19 ++++++++
     devtest/test.sh        |   31 ++++++++++++
     16 files changed, 291 insertions(+), 59 deletions(-)
     create mode 100644 devtest/01.out
     create mode 100644 devtest/01.pas
     create mode 100644 devtest/02.out
     create mode 100644 devtest/02.pas
     create mode 100644 devtest/03.out
     create mode 100644 devtest/03.pas
     create mode 100644 devtest/04.out
     create mode 100644 devtest/04.pas
     create mode 100644 devtest/05.out
     create mode 100644 devtest/05.pas
     create mode 100644 devtest/06.out
     create mode 100644 devtest/06.pas
     create mode 100644 devtest/07.out
     create mode 100644 devtest/07.pas
     create mode 100644 devtest/test.sh
    
    diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
    index a3a640b..4f33dee 100644
    --- a/compiler/pnameless.pas
    +++ b/compiler/pnameless.pas
    @@ -17,7 +17,7 @@ function add_init_frameobject(body: TNode; pd: TProcDef): TNode;
     
     implementation
     
    -(** TODO:
    +(** Instead of documentation
     
     Current implementation:
       Parse phase:
    @@ -25,46 +25,39 @@ Current implementation:
     + 2. Each anonymous procedure is a method of frame object and method of unique interface with single
          method 'Invoke'. Frame object implements this interface.
     + 3. Each reference to procedure is interface-variable. Think how to implement.
    -+ 4. Definition of anonymous procedure returns implementation of according onterface from frame object.
    ++ 4. Definition of anonymous procedure returns implementation of according interface from frame object.
     - 5. Type convertion is aware about this dances.
    ++ 8. Add frame object initialization code.
       Typecheck pass:
    -- 6. Call for reference to procedure is translated into call of needed method from interface which is
    ++ 6. Call for reference to procedure is translated into call of needed method from interface which is
          stored in variable.
    -- 7. Call for interface which is assigned to variable also converted to call of apropriate interface
    ++ 7. Call for interface which is assigned to variable also converted to call of apropriate interface
          method.
    -  First pass ?
    -- 8. Add frame object initialization code.
    +  First pass -
    +  Code generation pass -
     
     Details which should be clarified:
     LINK [1]
    -1. Generated types registered in module local symtable.
    -   + Required to have proper destruction of data.
    +1. Generated type symbols registered in module local symtable.
    +   + Required to have proper destruction of data. TODO: really? Anyway procdef registered in local symtables.
        + Simple.
        - Violates functional approach in developments.
        TODO: move to local procedure sym table
    -     - For some reasons Pascal forbids local classes. There can be problems with it. And it's not
    -       obvious to ancient Pascalists
    +     - For some reasons Pascal forbids local classes. There can be problems with it.
     
     2. How link to self will be stored?
     
     Current problems:
    -1. Interface variables are not initialized by 0s.
    -2. Compiler crashes if declare anonymous function not inside main.
    -3. Interface wrappers are not generated.
    +1. Parser don't eat semicolon after subroutine nested in closure
     
    -*)
    -
    -uses nld, { TODO: get rid of cicle reference }
    -     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas, ncnv, pbase, tokens, nobj, fmodule, ncon;
    -(* FrameObject contains
    +More aobut frame object. It contains
        - captured variables of current procedure as fields
    -   - anonymous functions as
    -     - methods
    -     - implementation of interface with single method 'invoke'
    +   + vtbl for each closure
        - pointer to FrameObject of outer procedure as fiels
    +*)
     
    -   FrameObject implements unique interface for each of it's methods
    - *)
    +uses nld, { TODO: get rid of cicle reference }
    +     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas, ncnv, pbase, tokens, nobj, fmodule, ncon, ngenutil;
     
     procedure BuildObjVmt_(objDef: TobjectDef);
     var vmtBuilder: TVMTBuilder;
    @@ -95,19 +88,15 @@ begin
                                     CLoadVmtAddrNode.Create(CTypeNode.Create(pd.frameObjectDef)),
                                     [cnf_return_value_used] ); // not sure about call parameters
       do_typecheckpass(callNode); // most probably should be removed after finishing development
    -
       block := TBlockNode(body);
    -
       createObj := CAssignmentNode.Create(CLoadNode.Create(objSym, pd.localst),
                                           callNode);
       assignIntf := CAssignmentNode.Create(CLoadNode.Create(intfSym, pd.localst),
                                            CLoadNode.Create(objSym, pd.localst));
    -
       stmt := CStatementNode.Create(createObj,
               CStatementNode.Create(assignIntf,
                                     block.left));
       block.left := stmt;
    -
       do_typecheckpass(TNode(block));
       Result := block;
     end;
    @@ -122,44 +111,67 @@ end;
     function maybe_create_frameobject(var pd: tprocdef): boolean;
     var intfObjDef: TObjectDef;
     
    -  function FindTypeDefinitions_: boolean;
    +  procedure FindTypeDefinitions_;
       var sym: tsym;
           symtable: tsymtable;
       begin
         // TODO: is there better way to get tinterfacedobject ?
         searchsym_type('TINTERFACEDOBJECT', sym, symtable);
    -    if not assigned(sym) then InternalError(1);
    -    if (sym.typ <> typesym) then InternalError(2);
    +    if (not assigned(sym)) or (sym.typ <> typesym) then InternalError(1);
         intfObjDef := tobjectdef(ttypesym(sym).typedef);
    -    Result := true;
       end;
     
    -var frameObjectDef: TObjectDef;
    +var objSym, intfSym: tabstractnormalvarsym;
    +    frameObjectDef: TObjectDef;
    +
    +  procedure InsertVarSymbols_(st: tsymtable);
    +  begin
    +    // this is come from read_var_decls function
    +    case st.symtabletype of
    +      localsymtable :
    +        begin
    +          objSym  := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []); // TODO: Use temp here ?
    +          intfSym := tlocalvarsym.create('$pFrameObjectIntf', vs_var, interface_iunknown, []);
    +          st.insert(objSym);
    +          st.insert(intfSym);
    +        end;
    +      staticsymtable,
    +      globalsymtable :
    +        begin
    +          objSym  := tstaticvarsym.create('$pFrameObjectObj', vs_value, frameObjectDef, []); // TODO: same
    +          intfSym := tstaticvarsym.create('$pFrameObjectIntf', vs_value, interface_iunknown, []);
    +          st.insert(objSym);
    +          st.insert(intfSym);
    +          cnodeutils.insertbssdata(tstaticvarsym(objSym));
    +          cnodeutils.insertbssdata(tstaticvarsym(intfSym));
    +        end;
    +    else
    +      internalerror(666);
    +    end;
    +  end;
    +
    +  procedure BuildFrameObjectDef_;
    +  var
         name: String;
    +  begin
    +    name := '$' + pd.procsym.RealName + '_FrameObjectDef'; // TODO: think about name
    +    frameObjectDef := tobjectdef.create(odt_class, name, intfObjDef);
    +    TTypeSym.Create(name, frameObjectDef);
    +    include(frameObjectDef.objectoptions, oo_is_nameless);
    +    current_module.localsymtable.insert(frameObjectDef.typesym);
    +  end;
     
    -    objSym: tlocalvarsym;
    -    intfSym: tlocalvarsym;
     begin
       if assigned(pd.frameObjectDef) then exit(false);
       FindTypeDefinitions_();
    -  name := '$' + pd.procsym.RealName + '_FrameObjectDef'; // TODO: think about name
    -  frameObjectDef := tobjectdef.create(odt_class, name, intfObjDef);
    -  TTypeSym.Create(name, frameObjectDef);
    -  include(frameObjectDef.objectoptions, oo_is_nameless);
    -
    -  objSym := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []); // TODO: Use temp here ?
    -  intfSym := tlocalvarsym.create('$pFrameObjectIntf', vs_var, interface_iunknown, []);
    -  pd.localst.insert(objSym);
    -  pd.localst.insert(intfSym);
    -//  pd.localst.insert(frameObjectDef.typesym); see comments somewhere below
    -  current_module.localsymtable.insert(frameObjectDef.typesym); // ^_^ why not ?
    +  BuildFrameObjectDef_();
    +  InsertVarSymbols_(pd.localst);
     
       pd.frameObjectDef     := frameObjectDef;
       { pd.frameObjectDeref }
       pd.frameObjectSym     := objSym;
       pd.frameObjectIntfSym := intfSym;
       Result := true;
    -
     end;
     
     function are_compatible_interfaces(def_to: TObjectDef; def_from: TObjectDef): Boolean;
    @@ -179,15 +191,11 @@ begin
       intf := tobjectdef.create(odt_interfacecom, name, interface_iunknown);
       intf.typesym := TTypeSym.Create(name, intf);
       intf.isClosure := true;
    -
    -// ZZZ: tsym.name work incorrectly if not to add symbol to symtable
    -//  symtablestack.top.insert(intf.typesym); // TODO: it it right place to insert ?
    -  current_module.localsymtable.insert(intf.typesym);
    -
    +  current_module.localsymtable.insert(intf.typesym); // tsym.name doesnt work if not to add symbol to symtable
       symtablestack.push(intf.symtable);
       procDef := parse_proc_dec(intf, ppm_method_reference);
       include(procDef.procoptions, po_virtualmethod);
    -  tprocsym(procDef.procsym).ProcdefList.Add(procDef); // unless procedure will be invisible
    +  tprocsym(procDef.procsym).ProcdefList.Add(procDef); // otherwise procedure will be invisible
       handle_calling_convention(procDef);
       proc_add_definition(procDef); // not sure why it is here
       symtablestack.pop(intf.symtable);
    @@ -214,7 +222,7 @@ function parse_nameless_routine(var pd: tprocdef): tnode;
         while current_procinfo.parent <> nil do
           current_procinfo := current_procinfo.parent;
         read_proc(false, anonymProcDef);
    -    proc_add_definition(anonymProcDef);     { add definition to procsym }
    +    proc_add_definition(anonymProcDef);
         current_structdef := old_current_structdef;
         current_procinfo := old_current_procinfo;
         current_module.procinfo := old_current_procinfo;
    @@ -239,18 +247,16 @@ begin
       symtablestack.push(intf.symtable); // procdef should be inside intf symtable, otherwise it will not be in vtlb
       cloneProcDef := TProcDef(anonymProcDef.getcopy);
       symtablestack.pop(intf.symtable);
    -
    -  ReadProcBody_(pd.frameObjectDef, anonymProcDef);
    -  symtablestack.pop(pd.frameObjectDef.symtable);
    -
       cloneProcDef.struct := intf;
    -  cloneProcDef.procsym := TProcSym.Create(anonymProcDef.procsym.Name);
    +  cloneProcDef.procsym := TProcSym.Create(anonymProcDef.procsym.Name); // same name to connect implemented method with interface method
       intf.symtable.insert(cloneProcDef.procsym);
       intf.isClosure := true;
       BuildObjVmt_(intf);
    -
       pd.frameObjectDef.register_implemented_interface(intf);
     
    +  ReadProcBody_(pd.frameObjectDef, anonymProcDef);
    +  symtablestack.pop(pd.frameObjectDef.symtable);
    +
       Result := CLoadNode.Create(pd.frameObjectSym, pd.localst);
       inserttypeconv(Result, intf);
     end;
    diff --git a/devtest/01.out b/devtest/01.out
    new file mode 100644
    index 0000000..af0523d
    --- /dev/null
    +++ b/devtest/01.out
    @@ -0,0 +1,3 @@
    +before
    +inside
    +after
    diff --git a/devtest/01.pas b/devtest/01.pas
    new file mode 100644
    index 0000000..bc26b33
    --- /dev/null
    +++ b/devtest/01.pas
    @@ -0,0 +1,18 @@
    +{$mode objfpc}
    +
    +type
    +  TProc = reference to procedure;
    +
    +var
    +  i: TProc;
    +
    +begin
    +  Writeln('before');
    +
    +  i := procedure(num: Integer) begin
    +          Writeln('inside');
    +       end;
    +  i.Invoke;
    +  
    +  Writeln('after');
    +end.
    diff --git a/devtest/02.out b/devtest/02.out
    new file mode 100644
    index 0000000..af0523d
    --- /dev/null
    +++ b/devtest/02.out
    @@ -0,0 +1,3 @@
    +before
    +inside
    +after
    diff --git a/devtest/02.pas b/devtest/02.pas
    new file mode 100644
    index 0000000..27699c2
    --- /dev/null
    +++ b/devtest/02.pas
    @@ -0,0 +1,22 @@
    +{$mode objfpc}
    +
    +type
    +  TProc = reference to procedure;
    +
    +procedure DoThings;  
    +var
    +  i: TProc;
    +begin
    +  Writeln('before');
    +
    +  i := procedure begin
    +          Writeln('inside');
    +       end;
    +  i.Invoke;
    +  
    +  Writeln('after');
    +end;
    +  
    +begin
    +  DoThings;
    +end.
    diff --git a/devtest/03.out b/devtest/03.out
    new file mode 100644
    index 0000000..af0523d
    --- /dev/null
    +++ b/devtest/03.out
    @@ -0,0 +1,3 @@
    +before
    +inside
    +after
    diff --git a/devtest/03.pas b/devtest/03.pas
    new file mode 100644
    index 0000000..74881dd
    --- /dev/null
    +++ b/devtest/03.pas
    @@ -0,0 +1,27 @@
    +{$mode objfpc}
    +
    +type
    +  TProc = reference to procedure;
    +  
    +function Factory: TProc;
    +begin
    +  Result := procedure begin
    +              Writeln('inside');
    +            end;  
    +end;
    +  
    +procedure DoThings;  
    +var
    +  i: TProc;
    +begin
    +  Writeln('before');
    +
    +  i := Factory;
    +  i.Invoke;
    +  
    +  Writeln('after');
    +end;
    +  
    +begin
    +  DoThings;
    +end.
    diff --git a/devtest/04.out b/devtest/04.out
    new file mode 100644
    index 0000000..b1f8dda
    --- /dev/null
    +++ b/devtest/04.out
    @@ -0,0 +1,3 @@
    +before
    +inside10
    +after
    diff --git a/devtest/04.pas b/devtest/04.pas
    new file mode 100644
    index 0000000..0729cb2
    --- /dev/null
    +++ b/devtest/04.pas
    @@ -0,0 +1,22 @@
    +{$mode objfpc}
    +
    +type
    +  TProc = reference to procedure(a: Integer; s: String);
    +
    +procedure DoThings;  
    +var
    +  i: TProc;
    +begin
    +  Writeln('before');
    +
    +  i := procedure(a: Integer; s: String) begin
    +          Writeln(s, a);
    +       end;
    +  i.Invoke(10, 'inside');
    +  
    +  Writeln('after');
    +end;
    +  
    +begin
    +  DoThings;
    +end.
    diff --git a/devtest/05.out b/devtest/05.out
    new file mode 100644
    index 0000000..49eef04
    --- /dev/null
    +++ b/devtest/05.out
    @@ -0,0 +1,4 @@
    +before
    +inside10
    +6
    +after
    diff --git a/devtest/05.pas b/devtest/05.pas
    new file mode 100644
    index 0000000..c5fb88f
    --- /dev/null
    +++ b/devtest/05.pas
    @@ -0,0 +1,26 @@
    +{$mode objfpc}
    +
    +type
    +  TProc = reference to procedure(a: Integer; s: String);
    +
    +procedure DoThings;  
    +var
    +  i: TProc;
    +begin
    +  Writeln('before');
    +
    +  i := procedure(a: Integer; s: String)
    +       var b: Integer;
    +       begin
    +         b := length(s);
    +         Writeln(s, a);
    +         Writeln(b);         
    +       end;
    +  i.Invoke(10, 'inside');
    +  
    +  Writeln('after');
    +end;
    +  
    +begin
    +  DoThings;
    +end.
    diff --git a/devtest/06.out b/devtest/06.out
    new file mode 100644
    index 0000000..49eef04
    --- /dev/null
    +++ b/devtest/06.out
    @@ -0,0 +1,4 @@
    +before
    +inside10
    +6
    +after
    diff --git a/devtest/06.pas b/devtest/06.pas
    new file mode 100644
    index 0000000..799dd28
    --- /dev/null
    +++ b/devtest/06.pas
    @@ -0,0 +1,39 @@
    +{$mode objfpc}
    +
    +{ closure have inner procedure }
    +{ TODO: fix issue with semicolon in parser }
    +
    +type
    +  TProc = reference to procedure(a: Integer; s: String);
    + 
    +procedure DoThings;  
    +
    +  function JustToCheckSemicolon: Integer;
    +  begin
    +    Result := 10;
    +  end;
    +
    +var
    +  i: TProc;
    +begin
    +  Writeln('before');
    +
    +  i := procedure(a: Integer; s: String)
    +         function Inner(ss: String): Integer;
    +         begin
    +           Result := length(ss);
    +         end{;}
    +       var b: Integer;
    +       begin
    +         b := Inner(s);
    +         Writeln(s, a);
    +         Writeln(b);         
    +       end;
    +  i.Invoke(10, 'inside');
    +  
    +  Writeln('after');
    +end;
    +  
    +begin
    +  DoThings;
    +end.
    diff --git a/devtest/07.out b/devtest/07.out
    new file mode 100644
    index 0000000..f727c26
    --- /dev/null
    +++ b/devtest/07.out
    @@ -0,0 +1,2 @@
    +before
    +after20
    diff --git a/devtest/07.pas b/devtest/07.pas
    new file mode 100644
    index 0000000..7a60039
    --- /dev/null
    +++ b/devtest/07.pas
    @@ -0,0 +1,19 @@
    +{$mode objfpc}
    +
    +type
    +  TProc = reference to function(num: Integer): Integer;
    +
    +var
    +  i: TProc;
    +  res: Integer;
    +
    +begin
    +  Writeln('before');
    +
    +  i := function(num: Integer): Integer begin
    +          Result := num + 10;
    +       end;
    +  res := i.Invoke(10);
    +    
    +  Writeln('after', res);
    +end.
    diff --git a/devtest/test.sh b/devtest/test.sh
    new file mode 100644
    index 0000000..7ec128f
    --- /dev/null
    +++ b/devtest/test.sh
    @@ -0,0 +1,31 @@
    +#!/bin/sh
    +
    +SCRIPT=`readlink -f $0`
    +BASEDIR=$(dirname $SCRIPT)
    +#COMPILE="${BASEDIR}/../compiler/ppc386 -Fu${BASEDIR}/../rtl/units/i386-linux" 
    +COMPILE="${BASEDIR}/../compiler/i386/pp -Fu${BASEDIR}/../rtl/units/i386-linux" 
    +
    +num=0
    +fail=""
    +for file in ${BASEDIR}/*.pas
    +do
    +    num=$((num+1));
    +    i=${file%%.pas}
    +    $COMPILE $i.pas -o$i.elf 2>&1 > $i.log
    +    if [ "$?" -eq "0" ]
    +    then
    +        $i.elf > $i.res 2> $i.res
    +    else
    +        cp $i.log $i.res
    +    fi
    +    tmp=$(diff -q -b $i.out $i.res)
    +    if [ -z $1 ] && [ "$1" != "n" ]; then echo "$i: $tmp"; fi
    +    if [ -n "$tmp" ]; then fail="$fail $i"; fi
    +done
    +echo "Number of tests: $num"
    +if [ -z  "$fail" ]
    +then
    +    echo "Ok";
    +else
    +    echo "Failed: $fail"
    +fi
    -- 
    1.7.10.4
    
    
    From fa42249ad7b3b294c4c84ad6840f82f5ae4e36d9 Mon Sep 17 00:00:00 2001
    From: Vasiliy Kevroletin <kevroletin@gmail.com>
    Date: Mon, 20 May 2013 23:37:29 +1100
    Subject: [PATCH 09/14] Fix parser to eat semicolon after all nested
     functions.
    
    Problem: parser doesn't eat semicolon after closure's nested function.
    ---
     compiler/pnameless.pas |    2 +-
     compiler/psub.pas      |   15 ++++++---------
     devtest/01.pas         |    2 +-
     devtest/06.pas         |    3 +--
     devtest/07.out         |    3 ++-
     devtest/07.pas         |   37 +++++++++++++++++++++++++++++--------
     6 files changed, 40 insertions(+), 22 deletions(-)
    
    diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
    index 4f33dee..63f7cd1 100644
    --- a/compiler/pnameless.pas
    +++ b/compiler/pnameless.pas
    @@ -221,7 +221,7 @@ function parse_nameless_routine(var pd: tprocdef): tnode;
         current_structdef := framObjectDef;
         while current_procinfo.parent <> nil do
           current_procinfo := current_procinfo.parent;
    -    read_proc(false, anonymProcDef);
    +    read_proc(false, anonymProcDef, false);
         proc_add_definition(anonymProcDef);
         current_structdef := old_current_structdef;
         current_procinfo := old_current_procinfo;
    diff --git a/compiler/psub.pas b/compiler/psub.pas
    index 034195c..e09ed49 100644
    --- a/compiler/psub.pas
    +++ b/compiler/psub.pas
    @@ -77,7 +77,7 @@ interface
         { reads any routine in the implementation, or a non-method routine
           declaration in the interface (depending on whether or not parse_only is
           true) }
    -    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef);
    +    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef; eatsemicolon: boolean = true);
     
         procedure generate_specialization_procs;
     
    @@ -1819,7 +1819,7 @@ implementation
     
     
     
    -    procedure read_proc_body(old_current_procinfo:tprocinfo;pd:tprocdef);
    +    procedure read_proc_body(old_current_procinfo:tprocinfo;pd:tprocdef;eatsemicolon:boolean=true);
           {
             Parses the procedure directives, then parses the procedure body, then
             generates the code for it
    @@ -1904,11 +1904,8 @@ implementation
               into the parse_body routine is not done because of having better file position
               information available }
     
    -        // TDOO: ugly hack
    -        if not(df_specialization in current_procinfo.procdef.defoptions) and
    -           not (assigned(current_procinfo.procdef.struct) and
    -                (oo_is_nameless in current_procinfo.procdef.struct.objectoptions))
    -        then
    +        // TODO: rework
    +        if eatsemicolon and not(df_specialization in current_procinfo.procdef.defoptions) then
               consume(_SEMICOLON);
     
             if not isnestedproc then
    @@ -1917,7 +1914,7 @@ implementation
           end;
     
     
    -    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef);
    +    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef; eatsemicolon: boolean = true);
           {
             Parses the procedure directives, then parses the procedure body, then
             generates the code for it
    @@ -2024,7 +2021,7 @@ implementation
              { compile procedure when a body is needed }
              if (pd_body in pdflags) then
                begin
    -             read_proc_body(old_current_procinfo,pd);
    +             read_proc_body(old_current_procinfo,pd,eatsemicolon);
                end
              else
                begin
    diff --git a/devtest/01.pas b/devtest/01.pas
    index bc26b33..14a55cd 100644
    --- a/devtest/01.pas
    +++ b/devtest/01.pas
    @@ -9,7 +9,7 @@ var
     begin
       Writeln('before');
     
    -  i := procedure(num: Integer) begin
    +  i := procedure begin
               Writeln('inside');
            end;
       i.Invoke;
    diff --git a/devtest/06.pas b/devtest/06.pas
    index 799dd28..db4fb34 100644
    --- a/devtest/06.pas
    +++ b/devtest/06.pas
    @@ -1,7 +1,6 @@
     {$mode objfpc}
     
     { closure have inner procedure }
    -{ TODO: fix issue with semicolon in parser }
     
     type
       TProc = reference to procedure(a: Integer; s: String);
    @@ -22,7 +21,7 @@ begin
              function Inner(ss: String): Integer;
              begin
                Result := length(ss);
    -         end{;}
    +         end;
            var b: Integer;
            begin
              b := Inner(s);
    diff --git a/devtest/07.out b/devtest/07.out
    index f727c26..d9b99ec 100644
    --- a/devtest/07.out
    +++ b/devtest/07.out
    @@ -1,2 +1,3 @@
     before
    -after20
    +20
    +after
    diff --git a/devtest/07.pas b/devtest/07.pas
    index 7a60039..7f9ce32 100644
    --- a/devtest/07.pas
    +++ b/devtest/07.pas
    @@ -1,19 +1,40 @@
     {$mode objfpc}
     
    +{ closure have inner procedure which access it's local variables}
    +
     type
    -  TProc = reference to function(num: Integer): Integer;
    +  TProc = reference to procedure(a: Integer; s: String);
    + 
    +procedure DoThings;  
    +
    +  function JustToCheckSemicolon: Integer;
    +  begin
    +    Result := 10;
    +  end;
     
     var
       i: TProc;
    -  res: Integer;
    -
     begin
       Writeln('before');
     
    -  i := function(num: Integer): Integer begin
    -          Result := num + 10;
    +  i := procedure(a: Integer)
    +       var b: Integer;
    +         function Inner(c: Integer): Integer;
    +         begin
    +           Result := a + b + c;
    +         end;
    +       var d: Integer;
    +       begin
    +         b := 6;
    +         d := Inner(4);
    +         Writeln(d);
            end;
    -  res := i.Invoke(10);
    -    
    -  Writeln('after', res);
    +  i.Invoke(10, 'inside');
    +  
    +  Writeln('after');
    +end;
    +  
    +begin
    +  DoThings;
     end.
    +
    -- 
    1.7.10.4
    
    
    From 217f0e7ecdd5daf3091012bab3f29dba8e621da6 Mon Sep 17 00:00:00 2001
    From: Vasiliy Kevroletin <kevroletin@gmail.com>
    Date: Wed, 22 May 2013 01:33:07 +1100
    Subject: [PATCH 10/14] Simple typecheck.
    
    Currently closure is an interface(objectdef) with magic boolean flag "Is closure". It should contain single method which is used to call closure. Compare return types of closure and parametes type. If parameter types are equal then all is good.
    
    TODO: Consider situatin
    A < B (A inherited from B)
    
    var
      pa: reference to procedure(arg: A);
      pb: reference to procedure(arg: B);
    begin
      pa := pb;
    
    In theory we can allow such assignment since all arguments of pa will be valid for pb.
    ---
     compiler/pnameless.pas |   31 ++++++++++++++++++++++++-------
     devtest/07.pas         |    4 ++--
     devtest/08.out         |    2 ++
     devtest/08.pas         |   20 ++++++++++++++++++++
     devtest/09.out         |    8 ++++++++
     devtest/09.pas         |   19 +++++++++++++++++++
     devtest/10.out         |    7 +++++++
     devtest/10.pas         |   19 +++++++++++++++++++
     8 files changed, 101 insertions(+), 9 deletions(-)
     create mode 100644 devtest/08.out
     create mode 100644 devtest/08.pas
     create mode 100644 devtest/09.out
     create mode 100644 devtest/09.pas
     create mode 100644 devtest/10.out
     create mode 100644 devtest/10.pas
    
    diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
    index 63f7cd1..f50a1c8 100644
    --- a/compiler/pnameless.pas
    +++ b/compiler/pnameless.pas
    @@ -6,7 +6,7 @@ interface
     
     uses node, symtype, symdef, symsym, globtype;
     
    -function are_compatible_interfaces(def_to: TObjectDef; def_from: TObjectDef): Boolean;
    +function are_compatible_interfaces(objDefTo: TObjectDef; objDefFrom: TObjectDef): Boolean;
     function parse_method_reference: tdef;
     function handle_possible_capture(pd: tprocdef; name: tabstractnormalvarsym): tnode;
     function parse_nameless_routine(var pd: tprocdef): tnode;
    @@ -41,14 +41,17 @@ LINK [1]
     1. Generated type symbols registered in module local symtable.
        + Required to have proper destruction of data. TODO: really? Anyway procdef registered in local symtables.
        + Simple.
    -   - Violates functional approach in developments.
    +   - forget this/*Violates functional approach in developments*/
        TODO: move to local procedure sym table
          - For some reasons Pascal forbids local classes. There can be problems with it.
     
     2. How link to self will be stored?
     
     Current problems:
    -1. Parser don't eat semicolon after subroutine nested in closure
    +1. Typecheck code is inspired by proc_to_procvar_equal function, but simplier. Think more about typecheck.
    +2. Typecheck messages are ugly.
    +3. We reused existing types and add some flags to these types It's time to think about inheritance.
    +4. Code is tricky. Investigate is it possible to move closure convertion into separate pass.
     
     More aobut frame object. It contains
        - captured variables of current procedure as fields
    @@ -57,7 +60,7 @@ More aobut frame object. It contains
     *)
     
     uses nld, { TODO: get rid of cicle reference }
    -     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas, ncnv, pbase, tokens, nobj, fmodule, ncon, ngenutil;
    +     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas, ncnv, pbase, tokens, nobj, fmodule, ncon, ngenutil, defcmp;
     
     procedure BuildObjVmt_(objDef: TobjectDef);
     var vmtBuilder: TVMTBuilder;
    @@ -148,6 +151,7 @@ var objSym, intfSym: tabstractnormalvarsym;
         else
           internalerror(666);
         end;
    +    objSym.varstate := vs_initialised; // prevent warning; init code will be added later
       end;
     
       procedure BuildFrameObjectDef_;
    @@ -174,10 +178,23 @@ begin
       Result := true;
     end;
     
    -function are_compatible_interfaces(def_to: TObjectDef; def_from: TObjectDef): Boolean;
    +function are_compatible_interfaces(objDefTo: TObjectDef; objDefFrom: TObjectDef): Boolean;
    +var defTo, defFrom: TProcDef;
    +    i: Integer;
    +    eq: tequaltype;
     begin
    -  // TODO: Perform meaningful check!!!
    -  Result := def_to.isClosure or def_from.isClosure;
    +  // TODO: here each good compiler's function have at least 200 lines.. add more lines
    +  if not objDefTo.isClosure or not objDefFrom.isClosure then exit(false);
    +  if (objDefTo.symtable.DefList.Count <> 1) or (objDefTo.symtable.DefList.Count <> 1) then exit(false);
    +  for i:=0 to objDefTo.symtable.DefList.Count-1 do
    +  begin
    +    defTo := tdef(objDefTo.symtable.DefList[i]) as TProcDef;
    +    defFrom := tdef(objDefFrom.symtable.DefList[i]) as TProcDef;
    +    if not equal_defs(defTo.returndef, defFrom.returndef) then exit(false);
    +    eq:=compare_paras(defTo.paras,defFrom.paras,cp_procvar,[]);
    +    if eq < te_equal then exit(false);
    +  end;
    +  Result := true;
     end;
     
     function parse_method_reference: tdef;
    diff --git a/devtest/07.pas b/devtest/07.pas
    index 7f9ce32..246c49a 100644
    --- a/devtest/07.pas
    +++ b/devtest/07.pas
    @@ -3,7 +3,7 @@
     { closure have inner procedure which access it's local variables}
     
     type
    -  TProc = reference to procedure(a: Integer; s: String);
    +  TProc = reference to procedure(a: Integer);
      
     procedure DoThings;  
     
    @@ -29,7 +29,7 @@ begin
              d := Inner(4);
              Writeln(d);
            end;
    -  i.Invoke(10, 'inside');
    +  i.Invoke(10);
       
       Writeln('after');
     end;
    diff --git a/devtest/08.out b/devtest/08.out
    new file mode 100644
    index 0000000..f727c26
    --- /dev/null
    +++ b/devtest/08.out
    @@ -0,0 +1,2 @@
    +before
    +after20
    diff --git a/devtest/08.pas b/devtest/08.pas
    new file mode 100644
    index 0000000..8cd4ddf
    --- /dev/null
    +++ b/devtest/08.pas
    @@ -0,0 +1,20 @@
    +{$mode objfpc}
    +{ closure returns value }
    +
    +type
    +  TProc = reference to function(num: Integer): Integer;
    +
    +var
    +  i: TProc;
    +  res: Integer;
    +
    +begin
    +  Writeln('before');
    +
    +  i := function(num: Integer): Integer begin
    +          Result := num + 10;
    +       end;
    +  res := i.Invoke(10);
    +    
    +  Writeln('after', res);
    +end.
    diff --git a/devtest/09.out b/devtest/09.out
    new file mode 100644
    index 0000000..e0131df
    --- /dev/null
    +++ b/devtest/09.out
    @@ -0,0 +1,8 @@
    +Free Pascal Compiler version 2.7.1 [2013/05/19] for i386
    +Copyright (c) 1993-2013 by Florian Klaempfl and others
    +Target OS: Linux for i386
    +Compiling /home/behemoth/Work/diploma/freepascal/devtest/09.pas
    +09.pas(13,8) Error: Incompatible types: got "$$main_FrameObjectDef.NAMELESS_13_18_ClosureImpl_IntfDef" expected "ClosureReference_IntfDef"
    +09.pas(16,11) Error: Wrong number of parameters specified for call to "INVOKE"
    +09.pas(20) Fatal: There were 2 errors compiling module, stopping
    +Fatal: Compilation aborted
    diff --git a/devtest/09.pas b/devtest/09.pas
    new file mode 100644
    index 0000000..d66d385
    --- /dev/null
    +++ b/devtest/09.pas
    @@ -0,0 +1,19 @@
    +{$mode objfpc}
    +{ incompatible closure and closurevar }
    +
    +type
    +  TProc = reference to procedure(i: Integer);
    +
    +var
    +  i: TProc;
    +
    +begin
    +  Writeln('before');
    +
    +  i := procedure begin
    +          Writeln('inside');
    +       end;
    +  i.Invoke;
    +  
    +  Writeln('after');
    +end.
    diff --git a/devtest/10.out b/devtest/10.out
    new file mode 100644
    index 0000000..b3bab60
    --- /dev/null
    +++ b/devtest/10.out
    @@ -0,0 +1,7 @@
    +Free Pascal Compiler version 2.7.1 [2013/05/19] for i386
    +Copyright (c) 1993-2013 by Florian Klaempfl and others
    +Target OS: Linux for i386
    +Compiling /home/behemoth/Work/diploma/freepascal/devtest/10.pas
    +10.pas(13,8) Error: Incompatible types: got "$$main_FrameObjectDef.NAMELESS_13_18_ClosureImpl_IntfDef" expected "ClosureReference_IntfDef"
    +10.pas(20) Fatal: There were 1 errors compiling module, stopping
    +Fatal: Compilation aborted
    diff --git a/devtest/10.pas b/devtest/10.pas
    new file mode 100644
    index 0000000..cd63cee
    --- /dev/null
    +++ b/devtest/10.pas
    @@ -0,0 +1,19 @@
    +{$mode objfpc}
    +{ incompatible closure and closurevar }
    +
    +type
    +  TProc = reference to function: Integer;
    +
    +var
    +  i: TProc;
    +
    +begin
    +  Writeln('before');
    +
    +  i := procedure begin
    +          Writeln('inside');
    +       end;
    +  i.Invoke;
    +  
    +  Writeln('after');
    +end.
    -- 
    1.7.10.4
    
    
    From 40bb8dd47f4cf91859230494cb95a249c173d7ba Mon Sep 17 00:00:00 2001
    From: Vasiliy Kevroletin <kevroletin@gmail.com>
    Date: Sat, 25 May 2013 23:07:08 +1100
    Subject: [PATCH 11/14] Better error messages in case of typecheck errors.
    
    Now closure implementaion and closure reference are represented as tobjectdef with flag isClosure. To make nice error messages we hardcoded into few places printing of "reference to procedure" instead of class name.
    TODO: Better to refactor this in the future.
    ---
     compiler/pdecsub.pas   |    4 ++--
     compiler/pnameless.pas |   21 ++++++++++-----------
     compiler/symdef.pas    |   15 +++++++++++----
     compiler/symtable.pas  |    4 +++-
     devtest/09.out         |    8 ++------
     devtest/10.out         |    6 +-----
     devtest/11.out         |    3 +++
     devtest/11.pas         |   17 +++++++++++++++++
     devtest/12.out         |    3 +++
     devtest/12.pas         |   13 +++++++++++++
     devtest/13.out         |    3 +++
     devtest/13.pas         |   13 +++++++++++++
     devtest/14.out         |    4 ++++
     devtest/14.pas         |   16 ++++++++++++++++
     devtest/test.sh        |    2 +-
     15 files changed, 102 insertions(+), 30 deletions(-)
     create mode 100644 devtest/11.out
     create mode 100644 devtest/11.pas
     create mode 100644 devtest/12.out
     create mode 100644 devtest/12.pas
     create mode 100644 devtest/13.out
     create mode 100644 devtest/13.pas
     create mode 100644 devtest/14.out
     create mode 100644 devtest/14.pas
    
    diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
    index 96c2a74..96b3f0f 100644
    --- a/compiler/pdecsub.pas
    +++ b/compiler/pdecsub.pas
    @@ -800,12 +800,12 @@ implementation
             case procparsemode of
               ppm_nameless_routine:
                 begin
    -              sp:='Nameless_'+inttostr(procstartfilepos.line)+'_'+inttostr(procstartfilepos.column);
    +              sp:='$Nameless_'+inttostr(procstartfilepos.line)+'_'+inttostr(procstartfilepos.column);
                   orgsp:=upcase(sp);
                 end;
               ppm_method_reference:
                 begin
    -              sp:='Invoke';
    +              sp:='$Invoke';
                   orgsp:=upcase(sp);
                 end;
               else
    diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
    index f50a1c8..4a07eb4 100644
    --- a/compiler/pnameless.pas
    +++ b/compiler/pnameless.pas
    @@ -180,20 +180,16 @@ end;
     
     function are_compatible_interfaces(objDefTo: TObjectDef; objDefFrom: TObjectDef): Boolean;
     var defTo, defFrom: TProcDef;
    -    i: Integer;
         eq: tequaltype;
     begin
       // TODO: here each good compiler's function have at least 200 lines.. add more lines
       if not objDefTo.isClosure or not objDefFrom.isClosure then exit(false);
       if (objDefTo.symtable.DefList.Count <> 1) or (objDefTo.symtable.DefList.Count <> 1) then exit(false);
    -  for i:=0 to objDefTo.symtable.DefList.Count-1 do
    -  begin
    -    defTo := tdef(objDefTo.symtable.DefList[i]) as TProcDef;
    -    defFrom := tdef(objDefFrom.symtable.DefList[i]) as TProcDef;
    -    if not equal_defs(defTo.returndef, defFrom.returndef) then exit(false);
    -    eq:=compare_paras(defTo.paras,defFrom.paras,cp_procvar,[]);
    -    if eq < te_equal then exit(false);
    -  end;
    +  defTo := tdef(objDefTo.symtable.DefList[0]) as TProcDef;
    +  defFrom := tdef(objDefFrom.symtable.DefList[0]) as TProcDef;
    +  if not equal_defs(defTo.returndef, defFrom.returndef) then exit(false);
    +  eq:=compare_paras(defTo.paras,defFrom.paras,cp_procvar,[]);
    +  if eq < te_equal then exit(false);
       Result := true;
     end;
     
    @@ -206,9 +202,12 @@ begin
       consume(_REFERENCE); consume(_TO);
       name := 'ClosureReference_IntfDef'; // TODO: think about name
       intf := tobjectdef.create(odt_interfacecom, name, interface_iunknown);
    -  intf.typesym := TTypeSym.Create(name, intf);
       intf.isClosure := true;
    -  current_module.localsymtable.insert(intf.typesym); // tsym.name doesnt work if not to add symbol to symtable
    +  if not assigned(intf.typesym) then
    +  begin
    +    intf.typesym := TTypeSym.Create(name, intf);
    +    current_module.localsymtable.insert(intf.typesym);
    +  end;
       symtablestack.push(intf.symtable);
       procDef := parse_proc_dec(intf, ppm_method_reference);
       include(procDef.procoptions, po_virtualmethod);
    diff --git a/compiler/symdef.pas b/compiler/symdef.pas
    index 9f6aab7..f9539a2 100644
    --- a/compiler/symdef.pas
    +++ b/compiler/symdef.pas
    @@ -1536,6 +1536,7 @@ implementation
                 tmp:=tdef(tmp.owner.defowner)
               else
                 break;
    +          if (tabstractrecorddef(tmp).objrealname^[1]='$') then break;
               result:=tabstractrecorddef(tmp).objrealname^+'.'+result;
             until tmp=nil;
           end;
    @@ -4523,7 +4524,7 @@ implementation
           var
             pno: tprocnameoptions;
           begin
    -        pno:=[];
    +        pno:=[pno_proctypeoption];
             if showhidden then
               include(pno,pno_showhidden);
             result:=customprocname(pno);
    @@ -4568,14 +4569,15 @@ implementation
                     if (pno_proctypeoption in pno) and
                        assigned(returndef) and
                        not(is_void(returndef)) then
    -                  s:=s+'function '
    +                  s:=s+'function'
                     else
    -                  s:=s+'procedure ';
    +                  s:=s+'procedure';
                 end;
                 if (pno_ownername in pno) and
                    (owner.symtabletype in [recordsymtable,objectsymtable]) then
                   s:=s+tabstractrecorddef(owner.defowner).RttiName+'.';
    -            rn:=procsym.realname;
    +            if not (po_nameless in procoptions) then
    +              rn:=' ' + procsym.realname;
                 if (pno_noleadingdollar in pno) and
                    (rn[1]='$') then
                   delete(rn,1,1);
    @@ -5686,6 +5688,11 @@ implementation
             { instead of the actual type name                             }
             if not assigned(typesym) then
               result:='<Currently Parsed Class>'
    +        else if isClosure then
    +          begin
    +            if not assigned(symtable.DefList[0]) then InternalError(777);
    +            result:='reference to ' + tdef(symtable.DefList[0]).GetTypeName
    +          end
             else
               result:=typesymbolprettyname;
           end;
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index 3f08b1c..5b8ddac 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -1947,7 +1947,9 @@ implementation
           var
             s1,s2 : string;
           begin
    -        if def.typ in [objectdef,recorddef] then
    +        if (def.typ=objectdef) and tobjectdef(def).isClosure then
    +          s1:=def.GetTypeName
    +        else if def.typ in [objectdef,recorddef] then
               s1:=tabstractrecorddef(def).RttiName
             else
               s1:=def.typename;
    diff --git a/devtest/09.out b/devtest/09.out
    index e0131df..7952596 100644
    --- a/devtest/09.out
    +++ b/devtest/09.out
    @@ -1,8 +1,4 @@
    -Free Pascal Compiler version 2.7.1 [2013/05/19] for i386
    -Copyright (c) 1993-2013 by Florian Klaempfl and others
    -Target OS: Linux for i386
    -Compiling /home/behemoth/Work/diploma/freepascal/devtest/09.pas
    -09.pas(13,8) Error: Incompatible types: got "$$main_FrameObjectDef.NAMELESS_13_18_ClosureImpl_IntfDef" expected "ClosureReference_IntfDef"
    -09.pas(16,11) Error: Wrong number of parameters specified for call to "INVOKE"
    +09.pas(13,8) Error: Incompatible types: got "reference to procedure;" expected "reference to procedure(LongInt);"
    +09.pas(16,11) Error: Wrong number of parameters specified for call to "$INVOKE"
     09.pas(20) Fatal: There were 2 errors compiling module, stopping
     Fatal: Compilation aborted
    diff --git a/devtest/10.out b/devtest/10.out
    index b3bab60..88f2e8f 100644
    --- a/devtest/10.out
    +++ b/devtest/10.out
    @@ -1,7 +1,3 @@
    -Free Pascal Compiler version 2.7.1 [2013/05/19] for i386
    -Copyright (c) 1993-2013 by Florian Klaempfl and others
    -Target OS: Linux for i386
    -Compiling /home/behemoth/Work/diploma/freepascal/devtest/10.pas
    -10.pas(13,8) Error: Incompatible types: got "$$main_FrameObjectDef.NAMELESS_13_18_ClosureImpl_IntfDef" expected "ClosureReference_IntfDef"
    +10.pas(13,8) Error: Incompatible types: got "reference to procedure;" expected "reference to function:LongInt;"
     10.pas(20) Fatal: There were 1 errors compiling module, stopping
     Fatal: Compilation aborted
    diff --git a/devtest/11.out b/devtest/11.out
    new file mode 100644
    index 0000000..b2b89e2
    --- /dev/null
    +++ b/devtest/11.out
    @@ -0,0 +1,3 @@
    +11.pas(13,8) Error: Incompatible types: got "reference to procedure;" expected "LongInt"
    +11.pas(18) Fatal: There were 1 errors compiling module, stopping
    +Fatal: Compilation aborted
    diff --git a/devtest/11.pas b/devtest/11.pas
    new file mode 100644
    index 0000000..327bca8
    --- /dev/null
    +++ b/devtest/11.pas
    @@ -0,0 +1,17 @@
    +{$mode objfpc}
    +{ illegal assignment }
    +
    +type
    +  TProc = reference to function: Integer;
    +
    +var
    +  p: TProc;
    +  i: Integer;
    +
    +begin
    +  
    +  i := procedure begin
    +         Writeln('inside');
    +       end;
    +  
    +end.
    diff --git a/devtest/12.out b/devtest/12.out
    new file mode 100644
    index 0000000..7c9b8cc
    --- /dev/null
    +++ b/devtest/12.out
    @@ -0,0 +1,3 @@
    +12.pas(12,11) Error: Operator is not overloaded: "ShortInt" + "reference to procedure;"
    +12.pas(14) Fatal: There were 1 errors compiling module, stopping
    +Fatal: Compilation aborted
    diff --git a/devtest/12.pas b/devtest/12.pas
    new file mode 100644
    index 0000000..033c042
    --- /dev/null
    +++ b/devtest/12.pas
    @@ -0,0 +1,13 @@
    +{$mode objfpc}
    +{ illegal arithmetics operation }
    +
    +type
    +  TProc = reference to function: Integer;
    +
    +var
    +  p: TProc;
    +  i: Integer;
    +
    +begin
    +  i := 10 + procedure begin end;
    +end.
    diff --git a/devtest/13.out b/devtest/13.out
    new file mode 100644
    index 0000000..1e8f278
    --- /dev/null
    +++ b/devtest/13.out
    @@ -0,0 +1,3 @@
    +13.pas(10,8) Error: Incompatible types: got "reference to function(LongInt):LongInt;" expected "LongInt"
    +13.pas(10,71) Fatal: Syntax error, ";" expected but "(" found
    +Fatal: Compilation aborted
    diff --git a/devtest/13.pas b/devtest/13.pas
    new file mode 100644
    index 0000000..0735890
    --- /dev/null
    +++ b/devtest/13.pas
    @@ -0,0 +1,13 @@
    +{$mode objfpc}
    +{ call of closure in place }
    +
    +var
    +  i: Integer;
    +begin
    +
    +  // now fpc parser eats first () and stops parsing of right side
    +  // delphi parser eats this but fails during runtime
    +  i := (function(num: Integer): Integer begin Result := num + 10; end)(5);
    +
    +  Writeln(i);
    +end.
    diff --git a/devtest/14.out b/devtest/14.out
    new file mode 100644
    index 0000000..6d331be
    --- /dev/null
    +++ b/devtest/14.out
    @@ -0,0 +1,4 @@
    +14.pas(10,8) Error: Incompatible types: got "reference to procedure;" expected "reference to procedure(LongInt);"
    +14.pas(13,11) Error: Wrong number of parameters specified for call to "$INVOKE"
    +14.pas(17) Fatal: There were 2 errors compiling module, stopping
    +Fatal: Compilation aborted
    diff --git a/devtest/14.pas b/devtest/14.pas
    new file mode 100644
    index 0000000..19a544f
    --- /dev/null
    +++ b/devtest/14.pas
    @@ -0,0 +1,16 @@
    +{$mode objfpc}
    +{ incompatible closure and closurevar; declaration in var section }
    +
    +var
    +  i: reference to procedure(i: Integer);
    +
    +begin
    +  Writeln('before');
    +
    +  i := procedure begin
    +          Writeln('inside');
    +       end;
    +  i.Invoke;
    +  
    +  Writeln('after');
    +end.
    diff --git a/devtest/test.sh b/devtest/test.sh
    index 7ec128f..9f07dde 100644
    --- a/devtest/test.sh
    +++ b/devtest/test.sh
    @@ -11,7 +11,7 @@ for file in ${BASEDIR}/*.pas
     do
         num=$((num+1));
         i=${file%%.pas}
    -    $COMPILE $i.pas -o$i.elf 2>&1 > $i.log
    +    $COMPILE $i.pas -o$i.elf > $i.log 2> $i.err
         if [ "$?" -eq "0" ]
         then
             $i.elf > $i.res 2> $i.res
    -- 
    1.7.10.4
    
    
    From 02f9e9e4db8c0b6c6ad8afa2fb77aab005ba8d9c Mon Sep 17 00:00:00 2001
    From: Vasiliy Kevroletin <kevroletin@gmail.com>
    Date: Sun, 26 May 2013 13:30:52 +1100
    Subject: [PATCH 12/14] Allow to call closure-variable using procvar(arg1,
     arg2, arg3, ...) or procvar; syntax. Fix error
     messages. Add more tests.
    
    ---
     compiler/ncal.pas      |    5 +++-
     compiler/nutils.pas    |   66 ++++++++++++++++++++++++++++++------------------
     compiler/pexpr.pas     |   17 ++++++++++---
     compiler/pnameless.pas |    5 ++--
     compiler/symdef.pas    |    2 +-
     devtest/01.out         |    1 +
     devtest/01.pas         |    3 ++-
     devtest/02.pas         |    2 +-
     devtest/03.pas         |    2 +-
     devtest/04.pas         |    2 +-
     devtest/05.pas         |    2 +-
     devtest/06.pas         |    2 +-
     devtest/07.pas         |    2 +-
     devtest/08.pas         |    2 +-
     devtest/09.out         |    2 +-
     devtest/09.pas         |    2 +-
     devtest/10.pas         |    2 +-
     devtest/13.out         |    5 ++--
     devtest/14.out         |    2 +-
     devtest/14.pas         |    2 +-
     devtest/15.out         |    3 +++
     devtest/15.pas         |   10 ++++++++
     devtest/16.out         |    1 +
     devtest/16.pas         |   20 +++++++++++++++
     devtest/17.out         |    3 +++
     devtest/17.pas         |   20 +++++++++++++++
     devtest/18.out         |    1 +
     devtest/18.pas         |   30 ++++++++++++++++++++++
     devtest/19.out         |    1 +
     devtest/19.pas         |   28 ++++++++++++++++++++
     devtest/20.out         |    2 ++
     devtest/20.pas         |   14 ++++++++++
     32 files changed, 214 insertions(+), 47 deletions(-)
     create mode 100644 devtest/15.out
     create mode 100644 devtest/15.pas
     create mode 100644 devtest/16.out
     create mode 100644 devtest/16.pas
     create mode 100644 devtest/17.out
     create mode 100644 devtest/17.pas
     create mode 100644 devtest/18.out
     create mode 100644 devtest/18.pas
     create mode 100644 devtest/19.out
     create mode 100644 devtest/19.pas
     create mode 100644 devtest/20.out
     create mode 100644 devtest/20.pas
    
    diff --git a/compiler/ncal.pas b/compiler/ncal.pas
    index 80b5959..068b49f 100644
    --- a/compiler/ncal.pas
    +++ b/compiler/ncal.pas
    @@ -2932,7 +2932,10 @@ implementation
                                 end
                               else
                                 begin
    -                              CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,symtableprocentry.realname);
    +                              if po_nameless in tprocdef(symtableprocentry.ProcdefList[0]).procoptions then
    +                                CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'reference to '+tdef(symtableprocentry.ProcdefList[0]).GetTypeName)
    +                              else
    +                                CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,symtableprocentry.realname);
                                   symtableprocentry.write_parameter_lists(nil);
                                 end;
                             end;
    diff --git a/compiler/nutils.pas b/compiler/nutils.pas
    index 1579890..c9e4ef2 100644
    --- a/compiler/nutils.pas
    +++ b/compiler/nutils.pas
    @@ -367,35 +367,53 @@ implementation
     
     
         function maybe_call_procvar(var p1:tnode;tponly:boolean):boolean;
    +
    +      function insert_closure_call:boolean;
    +        var objdef:tobjectdef;
    +        begin
    +          objdef:=tobjectdef(p1.resultdef);
    +          if objdef.symtable.SymList.Count<>1 then InternalError(777);
    +          p1:=ccallnode.create(nil,
    +                               tprocsym(objdef.symtable.SymList.items[0]),
    +                               objdef.symtable,
    +                               p1,
    +                               []); // TODO: not sure about parameters
    +          typecheckpass(p1);
    +          result:=true;
    +        end;
    +
           var
             hp : tnode;
           begin
             result:=false;
    -        if (p1.resultdef.typ<>procvardef) or
    -           (tponly and
    -            not(m_tp_procvar in current_settings.modeswitches)) then
    -          exit;
    -        { ignore vecn,subscriptn }
    -        hp:=p1;
    -        repeat
    -          case hp.nodetype of
    -            vecn,
    -            derefn,
    -            typeconvn,
    -            subscriptn :
    -              hp:=tunarynode(hp).left;
    -            else
    -              break;
    -          end;
    -        until false;
    -        { a tempref is used when it is loaded from a withsymtable }
    -        if (hp.nodetype in [calln,loadn,temprefn]) then
    +        if not tponly and (p1.resultdef.typ=objectdef) and tobjectdef(p1.resultdef).isClosure then
    +          result:=insert_closure_call
    +        else if (p1.resultdef.typ=procvardef) and
    +           ((not tponly) or
    +            (m_tp_procvar in current_settings.modeswitches)) then
               begin
    -            hp:=ccallnode.create_procvar(nil,p1);
    -            typecheckpass(hp);
    -            p1:=hp;
    -            result:=true;
    -          end;
    +            { ignore vecn,subscriptn }
    +            hp:=p1;
    +            repeat
    +              case hp.nodetype of
    +                vecn,
    +                derefn,
    +                typeconvn,
    +                subscriptn :
    +                  hp:=tunarynode(hp).left;
    +                else
    +                  break;
    +              end;
    +            until false;
    +            { a tempref is used when it is loaded from a withsymtable }
    +            if (hp.nodetype in [calln,loadn,temprefn]) then
    +              begin
    +                hp:=ccallnode.create_procvar(nil,p1);
    +                typecheckpass(hp);
    +                p1:=hp;
    +                result:=true;
    +              end;
    +          end
           end;
     
     
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index f23c2e6..96122c7 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -2270,9 +2270,10 @@ implementation
     
               else
                 begin
    -              { is this a procedure variable ? }
    +              { is this a procedure or closure variable ? }
                   if assigned(p1.resultdef) and
    -                 (p1.resultdef.typ=procvardef) then
    +                 ((p1.resultdef.typ=procvardef) or
    +                  ((p1.resultdef.typ=objectdef) and tobjectdef(p1.resultdef).isClosure)) then
                     begin
                       { Typenode for typecasting or expecting a procvar }
                       if (p1.nodetype=typen) or
    @@ -2296,7 +2297,17 @@ implementation
                             begin
                               p2:=parse_paras(false,false,_RKLAMMER);
                               consume(_RKLAMMER);
    -                          p1:=ccallnode.create_procvar(p2,p1);
    +                          if p1.resultdef.typ=procvardef then
    +                            p1:=ccallnode.create_procvar(p2,p1)
    +                          else
    +                            begin // call closure
    +                              if tobjectdef(p1.resultdef).symtable.SymList.Count<>1 then InternalError(777);
    +                              p1:=ccallnode.create(p2,
    +                                                   tprocsym(tobjectdef(p1.resultdef).symtable.SymList.items[0]),
    +                                                   tobjectdef(p1.resultdef).symtable,
    +                                                   p1,
    +                                                   []); // TODO: not sure about parameters
    +                            end;
                               { proc():= is never possible }
                               if token=_ASSIGNMENT then
                                 begin
    diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
    index 4a07eb4..25e4ccb 100644
    --- a/compiler/pnameless.pas
    +++ b/compiler/pnameless.pas
    @@ -60,7 +60,7 @@ More aobut frame object. It contains
     *)
     
     uses nld, { TODO: get rid of cicle reference }
    -     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas, ncnv, pbase, tokens, nobj, fmodule, ncon, ngenutil, defcmp;
    +     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas, ncnv, pbase, tokens, nobj, fmodule, ncon, ngenutil, defcmp, sysutils, globals;
     
     procedure BuildObjVmt_(objDef: TobjectDef);
     var vmtBuilder: TVMTBuilder;
    @@ -152,6 +152,7 @@ var objSym, intfSym: tabstractnormalvarsym;
           internalerror(666);
         end;
         objSym.varstate := vs_initialised; // prevent warning; init code will be added later
    +    intfSym.varstate := vs_read;       // this reference is used only to keep frame object alive
       end;
     
       procedure BuildFrameObjectDef_;
    @@ -200,7 +201,7 @@ var typesym: TTypeSym;
         procDef: TProcDef;
     begin
       consume(_REFERENCE); consume(_TO);
    -  name := 'ClosureReference_IntfDef'; // TODO: think about name
    +  name := 'ClosureReference_IntfDef' + inttostr(current_filepos.line)+'_'+inttostr(current_filepos.column); // TODO: think about name
       intf := tobjectdef.create(odt_interfacecom, name, interface_iunknown);
       intf.isClosure := true;
       if not assigned(intf.typesym) then
    diff --git a/compiler/symdef.pas b/compiler/symdef.pas
    index f9539a2..f8c749a 100644
    --- a/compiler/symdef.pas
    +++ b/compiler/symdef.pas
    @@ -5690,7 +5690,7 @@ implementation
               result:='<Currently Parsed Class>'
             else if isClosure then
               begin
    -            if not assigned(symtable.DefList[0]) then InternalError(777);
    +            if symtable.DefList.Count <> 1 then InternalError(777);
                 result:='reference to ' + tdef(symtable.DefList[0]).GetTypeName
               end
             else
    diff --git a/devtest/01.out b/devtest/01.out
    index af0523d..3c19bfa 100644
    --- a/devtest/01.out
    +++ b/devtest/01.out
    @@ -1,3 +1,4 @@
     before
     inside
    +inside
     after
    diff --git a/devtest/01.pas b/devtest/01.pas
    index 14a55cd..6916743 100644
    --- a/devtest/01.pas
    +++ b/devtest/01.pas
    @@ -12,7 +12,8 @@ begin
       i := procedure begin
               Writeln('inside');
            end;
    -  i.Invoke;
    +  i();
    +  i;
       
       Writeln('after');
     end.
    diff --git a/devtest/02.pas b/devtest/02.pas
    index 27699c2..d58e5e7 100644
    --- a/devtest/02.pas
    +++ b/devtest/02.pas
    @@ -12,7 +12,7 @@ begin
       i := procedure begin
               Writeln('inside');
            end;
    -  i.Invoke;
    +  i();
       
       Writeln('after');
     end;
    diff --git a/devtest/03.pas b/devtest/03.pas
    index 74881dd..b0b06de 100644
    --- a/devtest/03.pas
    +++ b/devtest/03.pas
    @@ -17,7 +17,7 @@ begin
       Writeln('before');
     
       i := Factory;
    -  i.Invoke;
    +  i();
       
       Writeln('after');
     end;
    diff --git a/devtest/04.pas b/devtest/04.pas
    index 0729cb2..ca4f725 100644
    --- a/devtest/04.pas
    +++ b/devtest/04.pas
    @@ -12,7 +12,7 @@ begin
       i := procedure(a: Integer; s: String) begin
               Writeln(s, a);
            end;
    -  i.Invoke(10, 'inside');
    +  i(10, 'inside');
       
       Writeln('after');
     end;
    diff --git a/devtest/05.pas b/devtest/05.pas
    index c5fb88f..ddb0147 100644
    --- a/devtest/05.pas
    +++ b/devtest/05.pas
    @@ -16,7 +16,7 @@ begin
              Writeln(s, a);
              Writeln(b);         
            end;
    -  i.Invoke(10, 'inside');
    +  i(10, 'inside');
       
       Writeln('after');
     end;
    diff --git a/devtest/06.pas b/devtest/06.pas
    index db4fb34..88a038a 100644
    --- a/devtest/06.pas
    +++ b/devtest/06.pas
    @@ -28,7 +28,7 @@ begin
              Writeln(s, a);
              Writeln(b);         
            end;
    -  i.Invoke(10, 'inside');
    +  i(10, 'inside');
       
       Writeln('after');
     end;
    diff --git a/devtest/07.pas b/devtest/07.pas
    index 246c49a..b73c0b9 100644
    --- a/devtest/07.pas
    +++ b/devtest/07.pas
    @@ -29,7 +29,7 @@ begin
              d := Inner(4);
              Writeln(d);
            end;
    -  i.Invoke(10);
    +  i(10);
       
       Writeln('after');
     end;
    diff --git a/devtest/08.pas b/devtest/08.pas
    index 8cd4ddf..4f0a6f6 100644
    --- a/devtest/08.pas
    +++ b/devtest/08.pas
    @@ -14,7 +14,7 @@ begin
       i := function(num: Integer): Integer begin
               Result := num + 10;
            end;
    -  res := i.Invoke(10);
    +  res := i(10);
         
       Writeln('after', res);
     end.
    diff --git a/devtest/09.out b/devtest/09.out
    index 7952596..4a29f1a 100644
    --- a/devtest/09.out
    +++ b/devtest/09.out
    @@ -1,4 +1,4 @@
     09.pas(13,8) Error: Incompatible types: got "reference to procedure;" expected "reference to procedure(LongInt);"
    -09.pas(16,11) Error: Wrong number of parameters specified for call to "$INVOKE"
    +09.pas(16,6) Error: Wrong number of parameters specified for call to "reference to procedure(LongInt);"
     09.pas(20) Fatal: There were 2 errors compiling module, stopping
     Fatal: Compilation aborted
    diff --git a/devtest/09.pas b/devtest/09.pas
    index d66d385..a088710 100644
    --- a/devtest/09.pas
    +++ b/devtest/09.pas
    @@ -13,7 +13,7 @@ begin
       i := procedure begin
               Writeln('inside');
            end;
    -  i.Invoke;
    +  i();
       
       Writeln('after');
     end.
    diff --git a/devtest/10.pas b/devtest/10.pas
    index cd63cee..01120b1 100644
    --- a/devtest/10.pas
    +++ b/devtest/10.pas
    @@ -13,7 +13,7 @@ begin
       i := procedure begin
               Writeln('inside');
            end;
    -  i.Invoke;
    +  i();
       
       Writeln('after');
     end.
    diff --git a/devtest/13.out b/devtest/13.out
    index 1e8f278..ac9c9a0 100644
    --- a/devtest/13.out
    +++ b/devtest/13.out
    @@ -1,3 +1,2 @@
    -13.pas(10,8) Error: Incompatible types: got "reference to function(LongInt):LongInt;" expected "LongInt"
    -13.pas(10,71) Fatal: Syntax error, ";" expected but "(" found
    -Fatal: Compilation aborted
    +// currently this test fails
    +15
    diff --git a/devtest/14.out b/devtest/14.out
    index 6d331be..a38e633 100644
    --- a/devtest/14.out
    +++ b/devtest/14.out
    @@ -1,4 +1,4 @@
     14.pas(10,8) Error: Incompatible types: got "reference to procedure;" expected "reference to procedure(LongInt);"
    -14.pas(13,11) Error: Wrong number of parameters specified for call to "$INVOKE"
    +14.pas(13,6) Error: Wrong number of parameters specified for call to "reference to procedure(LongInt);"
     14.pas(17) Fatal: There were 2 errors compiling module, stopping
     Fatal: Compilation aborted
    diff --git a/devtest/14.pas b/devtest/14.pas
    index 19a544f..9c024b3 100644
    --- a/devtest/14.pas
    +++ b/devtest/14.pas
    @@ -10,7 +10,7 @@ begin
       i := procedure begin
               Writeln('inside');
            end;
    -  i.Invoke;
    +  i();
       
       Writeln('after');
     end.
    diff --git a/devtest/15.out b/devtest/15.out
    new file mode 100644
    index 0000000..ba3c397
    --- /dev/null
    +++ b/devtest/15.out
    @@ -0,0 +1,3 @@
    +15.pas(9,18) Error: Incompatible type for arg no. 1: Got "Constant String", expected "LongInt"
    +15.pas(11) Fatal: There were 1 errors compiling module, stopping
    +Fatal: Compilation aborted
    diff --git a/devtest/15.pas b/devtest/15.pas
    new file mode 100644
    index 0000000..9a74aae
    --- /dev/null
    +++ b/devtest/15.pas
    @@ -0,0 +1,10 @@
    +{$mode objfpc}
    +{ wrong parameter type }
    +
    +var
    +  i: reference to procedure(i: Integer);
    +
    +begin
    +  i := procedure(i: Integer) begin end;
    +  i('hello world');
    +end.
    diff --git a/devtest/16.out b/devtest/16.out
    new file mode 100644
    index 0000000..60d3b2f
    --- /dev/null
    +++ b/devtest/16.out
    @@ -0,0 +1 @@
    +15
    diff --git a/devtest/16.pas b/devtest/16.pas
    new file mode 100644
    index 0000000..67511e5
    --- /dev/null
    +++ b/devtest/16.pas
    @@ -0,0 +1,20 @@
    +{$mode objfpc}
    +{ closure as function argument }
    +
    +type
    +  TFunct = reference to function(num: Integer): Integer;
    +  
    +function Call(f: TFunct; arg: Integer): Integer;
    +begin
    +  Result := f(arg);
    +end;
    +
    +var i: Integer;
    +begin
    +  i := Call( function(num: Integer): Integer
    +             begin
    +               Result := num + 5;
    +             end,
    +             10 );
    +  Writeln(i);
    +end.
    diff --git a/devtest/17.out b/devtest/17.out
    new file mode 100644
    index 0000000..0e68ff8
    --- /dev/null
    +++ b/devtest/17.out
    @@ -0,0 +1,3 @@
    +17.pas(17,17) Error: Incompatible type for arg no. 1: Got "reference to function:LongInt;", expected "reference to function(LongInt):LongInt;"
    +17.pas(21) Fatal: There were 1 errors compiling module, stopping
    +Fatal: Compilation aborted
    diff --git a/devtest/17.pas b/devtest/17.pas
    new file mode 100644
    index 0000000..41eeb6d
    --- /dev/null
    +++ b/devtest/17.pas
    @@ -0,0 +1,20 @@
    +{$mode objfpc}
    +{ closure is wrong argument of another function }
    +
    +type
    +  TFunct = reference to function(num: Integer): Integer;
    +  
    +function Call(f: TFunct; arg: Integer): Integer;
    +begin
    +  Result := f(arg);
    +end;
    +
    +var i: Integer;
    +begin
    +  i := Call( function: Integer
    +             begin
    +               Result := 5;
    +             end,
    +             10 );
    +  Writeln(i);
    +end.
    diff --git a/devtest/18.out b/devtest/18.out
    new file mode 100644
    index 0000000..7ed6ff8
    --- /dev/null
    +++ b/devtest/18.out
    @@ -0,0 +1 @@
    +5
    diff --git a/devtest/18.pas b/devtest/18.pas
    new file mode 100644
    index 0000000..596d552
    --- /dev/null
    +++ b/devtest/18.pas
    @@ -0,0 +1,30 @@
    +{$mode objfpc}
    +{ functions with closure as parameter are overloaded }
    +
    +type
    +  TFunct        = reference to function: Integer;
    +  TFunctFactory = reference to function: TFunct;
    +  
    +function Call(f: TFunct): Integer;
    +begin
    +  Result := f();
    +end;
    +
    +function Call(f: TFunctFactory): TFunct;
    +begin
    +  Result := f();
    +end;
    +
    +var i: Integer;
    +    f: TFunct;
    +begin
    +  f := Call( function: TFunct
    +             begin
    +               Result := function: Integer
    +                         begin
    +                           Result := 5;
    +                         end;
    +             end);
    +  i := Call( f );
    +  Writeln(i);
    +end.
    diff --git a/devtest/19.out b/devtest/19.out
    new file mode 100644
    index 0000000..7ed6ff8
    --- /dev/null
    +++ b/devtest/19.out
    @@ -0,0 +1 @@
    +5
    diff --git a/devtest/19.pas b/devtest/19.pas
    new file mode 100644
    index 0000000..c2db70e
    --- /dev/null
    +++ b/devtest/19.pas
    @@ -0,0 +1,28 @@
    +{$mode objfpc}
    +{ functions with closure as parameter are overloaded }
    +
    +type
    +  TFunct        = reference to function: Integer;
    +  TFunctFactory = reference to function: TFunct;
    +  
    +function Call(f: TFunct): Integer;
    +begin
    +  Result := f();
    +end;
    +
    +function Call(f: TFunctFactory): TFunct;
    +begin
    +  Result := f();
    +end;
    +
    +var i: Integer;
    +begin
    +  i := Call( Call( function: TFunct
    +                   begin
    +                     Result := function: Integer
    +                               begin
    +                                 Result := 5;
    +                               end;
    +                   end ));
    +  Writeln(i);
    +end.
    diff --git a/devtest/20.out b/devtest/20.out
    new file mode 100644
    index 0000000..80fd8df
    --- /dev/null
    +++ b/devtest/20.out
    @@ -0,0 +1,2 @@
    +9
    +10
    diff --git a/devtest/20.pas b/devtest/20.pas
    new file mode 100644
    index 0000000..db086ce
    --- /dev/null
    +++ b/devtest/20.pas
    @@ -0,0 +1,14 @@
    +{$mode objfpc}
    +{ two closures inside functin }
    +
    +type
    +  TFunct = reference to function: Integer;
    +  
    +var p1, p2: TFunct;
    +begin
    +  p1 := function: Integer begin Result := 9;  end;
    +  p2 := function: Integer begin Result := 10; end;
    +
    +  Writeln( p1() );
    +  Writeln( p2() );
    +end.
    -- 
    1.7.10.4
    
    
    From e297b696fa835f36da19140160a98a3c90f9e43f Mon Sep 17 00:00:00 2001
    From: Vasiliy Kevroletin <kevroletin@gmail.com>
    Date: Sun, 26 May 2013 15:57:08 +1100
    Subject: [PATCH 13/14] Write proper internal errors. Fix few comments. Remove
     code which was marked as redutant before.
    
    ---
     compiler/nutils.pas    |    4 ++--
     compiler/pexpr.pas     |    4 ++--
     compiler/pnameless.pas |   59 ++++++++++++++++--------------------------------
     compiler/symdef.pas    |    2 +-
     4 files changed, 25 insertions(+), 44 deletions(-)
    
    diff --git a/compiler/nutils.pas b/compiler/nutils.pas
    index c9e4ef2..55739b9 100644
    --- a/compiler/nutils.pas
    +++ b/compiler/nutils.pas
    @@ -372,12 +372,12 @@ implementation
             var objdef:tobjectdef;
             begin
               objdef:=tobjectdef(p1.resultdef);
    -          if objdef.symtable.SymList.Count<>1 then InternalError(777);
    +          if objdef.symtable.SymList.Count<>1 then InternalError(2013052604);
               p1:=ccallnode.create(nil,
                                    tprocsym(objdef.symtable.SymList.items[0]),
                                    objdef.symtable,
                                    p1,
    -                               []); // TODO: not sure about parameters
    +                               [cnf_return_value_used]); // not sure about parameters
               typecheckpass(p1);
               result:=true;
             end;
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index 96122c7..61b6b84 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -2301,12 +2301,12 @@ implementation
                                 p1:=ccallnode.create_procvar(p2,p1)
                               else
                                 begin // call closure
    -                              if tobjectdef(p1.resultdef).symtable.SymList.Count<>1 then InternalError(777);
    +                              if tobjectdef(p1.resultdef).symtable.SymList.Count<>1 then InternalError(2013052605);
                                   p1:=ccallnode.create(p2,
                                                        tprocsym(tobjectdef(p1.resultdef).symtable.SymList.items[0]),
                                                        tobjectdef(p1.resultdef).symtable,
                                                        p1,
    -                                                   []); // TODO: not sure about parameters
    +                                                   [cnf_return_value_used]); // not sure about parameters
                                 end;
                               { proc():= is never possible }
                               if token=_ASSIGNMENT then
    diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
    index 25e4ccb..323f19e 100644
    --- a/compiler/pnameless.pas
    +++ b/compiler/pnameless.pas
    @@ -21,45 +21,28 @@ implementation
     
     Current implementation:
       Parse phase:
    -+ 1. Create frame object for parent procedures. Kepp frame object alive using local interface-variable.
    ++ 1. Create frame object for procedure which contains closure. Kepp frame object alive using local interface-variable.
     + 2. Each anonymous procedure is a method of frame object and method of unique interface with single
          method 'Invoke'. Frame object implements this interface.
    -+ 3. Each reference to procedure is interface-variable. Think how to implement.
    -+ 4. Definition of anonymous procedure returns implementation of according interface from frame object.
    -- 5. Type convertion is aware about this dances.
    ++ 3. Each reference to procedure is interface-variable. This interface contains single method 'Invoke';
    ++ 4. Definition of anonymous procedure returns implementation of corresponding interface from frame object.
    ++ 5. Type convertion is aware about this dances.
     + 8. Add frame object initialization code.
    -  Typecheck pass:
     + 6. Call for reference to procedure is translated into call of needed method from interface which is
          stored in variable.
    -+ 7. Call for interface which is assigned to variable also converted to call of apropriate interface
    -     method.
    +
    +  Typecheck pass -
       First pass -
       Code generation pass -
     
    -Details which should be clarified:
    -LINK [1]
    -1. Generated type symbols registered in module local symtable.
    -   + Required to have proper destruction of data. TODO: really? Anyway procdef registered in local symtables.
    -   + Simple.
    -   - forget this/*Violates functional approach in developments*/
    -   TODO: move to local procedure sym table
    -     - For some reasons Pascal forbids local classes. There can be problems with it.
    -
    -2. How link to self will be stored?
    -
     Current problems:
     1. Typecheck code is inspired by proc_to_procvar_equal function, but simplier. Think more about typecheck.
    -2. Typecheck messages are ugly.
    -3. We reused existing types and add some flags to these types It's time to think about inheritance.
    -4. Code is tricky. Investigate is it possible to move closure convertion into separate pass.
    -
    -More aobut frame object. It contains
    -   - captured variables of current procedure as fields
    -   + vtbl for each closure
    -   - pointer to FrameObject of outer procedure as fiels
    +2. We reused existing types and add some flags to these types It's time to think about inheritance.
    +3. Code is tricky. Investigate is it possible to move closure convertion into separate pass. At least
    +   create separate classed to closure definition.
     *)
     
    -uses nld, { TODO: get rid of cicle reference }
    +uses nld, { TODO: get rid of cicle references }
          symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas, ncnv, pbase, tokens, nobj, fmodule, ncon, ngenutil, defcmp, sysutils, globals;
     
     procedure BuildObjVmt_(objDef: TobjectDef);
    @@ -84,13 +67,12 @@ begin
       objSym := pd.frameObjectSym;
     
       bRet := searchsym_in_class( pd.frameObjectDef, pd.frameObjectDef, 'CREATE', symCreateProc, dummySymTable, false);
    -  if not bRet then InternalError(5);
    +  if not bRet then InternalError(2013052601);
       callNode := CCallNode.Create( nil,
                                     TProcSym(symCreateProc),
                                     pd.frameObjectDef.symtable,
                                     CLoadVmtAddrNode.Create(CTypeNode.Create(pd.frameObjectDef)),
                                     [cnf_return_value_used] ); // not sure about call parameters
    -  do_typecheckpass(callNode); // most probably should be removed after finishing development
       block := TBlockNode(body);
       createObj := CAssignmentNode.Create(CLoadNode.Create(objSym, pd.localst),
                                           callNode);
    @@ -120,7 +102,7 @@ var intfObjDef: TObjectDef;
       begin
         // TODO: is there better way to get tinterfacedobject ?
         searchsym_type('TINTERFACEDOBJECT', sym, symtable);
    -    if (not assigned(sym)) or (sym.typ <> typesym) then InternalError(1);
    +    if (not assigned(sym)) or (sym.typ <> typesym) then InternalError(2013052602);
         intfObjDef := tobjectdef(ttypesym(sym).typedef);
       end;
     
    @@ -133,7 +115,7 @@ var objSym, intfSym: tabstractnormalvarsym;
         case st.symtabletype of
           localsymtable :
             begin
    -          objSym  := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []); // TODO: Use temp here ?
    +          objSym  := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []);
               intfSym := tlocalvarsym.create('$pFrameObjectIntf', vs_var, interface_iunknown, []);
               st.insert(objSym);
               st.insert(intfSym);
    @@ -141,7 +123,7 @@ var objSym, intfSym: tabstractnormalvarsym;
           staticsymtable,
           globalsymtable :
             begin
    -          objSym  := tstaticvarsym.create('$pFrameObjectObj', vs_value, frameObjectDef, []); // TODO: same
    +          objSym  := tstaticvarsym.create('$pFrameObjectObj', vs_value, frameObjectDef, []);
               intfSym := tstaticvarsym.create('$pFrameObjectIntf', vs_value, interface_iunknown, []);
               st.insert(objSym);
               st.insert(intfSym);
    @@ -149,7 +131,7 @@ var objSym, intfSym: tabstractnormalvarsym;
               cnodeutils.insertbssdata(tstaticvarsym(intfSym));
             end;
         else
    -      internalerror(666);
    +      internalerror(2013052603);
         end;
         objSym.varstate := vs_initialised; // prevent warning; init code will be added later
         intfSym.varstate := vs_read;       // this reference is used only to keep frame object alive
    @@ -159,7 +141,7 @@ var objSym, intfSym: tabstractnormalvarsym;
       var
         name: String;
       begin
    -    name := '$' + pd.procsym.RealName + '_FrameObjectDef'; // TODO: think about name
    +    name := '$' + pd.procsym.RealName + '_FrameObjectDef';
         frameObjectDef := tobjectdef.create(odt_class, name, intfObjDef);
         TTypeSym.Create(name, frameObjectDef);
         include(frameObjectDef.objectoptions, oo_is_nameless);
    @@ -183,7 +165,6 @@ function are_compatible_interfaces(objDefTo: TObjectDef; objDefFrom: TObjectDef)
     var defTo, defFrom: TProcDef;
         eq: tequaltype;
     begin
    -  // TODO: here each good compiler's function have at least 200 lines.. add more lines
       if not objDefTo.isClosure or not objDefFrom.isClosure then exit(false);
       if (objDefTo.symtable.DefList.Count <> 1) or (objDefTo.symtable.DefList.Count <> 1) then exit(false);
       defTo := tdef(objDefTo.symtable.DefList[0]) as TProcDef;
    @@ -212,9 +193,8 @@ begin
       symtablestack.push(intf.symtable);
       procDef := parse_proc_dec(intf, ppm_method_reference);
       include(procDef.procoptions, po_virtualmethod);
    -  tprocsym(procDef.procsym).ProcdefList.Add(procDef); // otherwise procedure will be invisible
    +  tprocsym(procDef.procsym).ProcdefList.Add(procDef);
       handle_calling_convention(procDef);
    -  proc_add_definition(procDef); // not sure why it is here
       symtablestack.pop(intf.symtable);
       BuildObjVmt_(intf);
       Result := intf;
    @@ -256,10 +236,10 @@ begin
       anonymProcDef := parse_proc_dec(pd.frameObjectDef, ppm_nameless_routine);
       handle_calling_convention(anonymProcDef);
     
    -  intfName := anonymProcDef.procsym.RealName + '_ClosureImpl_IntfDef'; // TODO: think about name
    +  intfName := anonymProcDef.procsym.RealName + '_ClosureImpl_IntfDef';
       intf := tobjectdef.create(odt_interfacecom, intfName, interface_iunknown);
       TTypeSym.Create(intfName, intf);
    -  current_module.localsymtable.insert(intf.typesym); // [1]
    +  current_module.localsymtable.insert(intf.typesym);
     
       symtablestack.push(intf.symtable); // procdef should be inside intf symtable, otherwise it will not be in vtlb
       cloneProcDef := TProcDef(anonymProcDef.getcopy);
    @@ -281,6 +261,7 @@ end;
     function load_captured_variable(pd: tprocdef; name: tabstractnormalvarsym): tnode;
     begin
       // TODO:
    +  InternalError(2013052606);
       Result := nil;
     end;
     
    diff --git a/compiler/symdef.pas b/compiler/symdef.pas
    index f8c749a..503b843 100644
    --- a/compiler/symdef.pas
    +++ b/compiler/symdef.pas
    @@ -5690,7 +5690,7 @@ implementation
               result:='<Currently Parsed Class>'
             else if isClosure then
               begin
    -            if symtable.DefList.Count <> 1 then InternalError(777);
    +            if symtable.DefList.Count <> 1 then InternalError(2013052606);
                 result:='reference to ' + tdef(symtable.DefList[0]).GetTypeName
               end
             else
    -- 
    1.7.10.4
    
    
    From 84e235669dc24ff884645bccee6ba98a91542f56 Mon Sep 17 00:00:00 2001
    From: Vasiliy Kevroletin <kevroletin@gmail.com>
    Date: Sun, 26 May 2013 16:21:16 +1100
    Subject: [PATCH 14/14] Fix coding style.
    
    ---
     compiler/pnameless.pas |  278 ++++++++++++++++++++++++------------------------
     1 file changed, 139 insertions(+), 139 deletions(-)
    
    diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
    index 323f19e..6555573 100644
    --- a/compiler/pnameless.pas
    +++ b/compiler/pnameless.pas
    @@ -4,16 +4,16 @@ unit pnameless;
     
     interface
     
    -uses node, symtype, symdef, symsym, globtype;
    +uses node,symtype,symdef,symsym,globtype;
     
    -function are_compatible_interfaces(objDefTo: TObjectDef; objDefFrom: TObjectDef): Boolean;
    -function parse_method_reference: tdef;
    -function handle_possible_capture(pd: tprocdef; name: tabstractnormalvarsym): tnode;
    -function parse_nameless_routine(var pd: tprocdef): tnode;
    -function load_captured_variable(pd: tprocdef; name: tabstractnormalvarsym): tnode;
    -function maybe_create_frameobject(var pd: tprocdef): boolean;
    -function maybe_finish_frameobject(pd: tprocdef): boolean;
    -function add_init_frameobject(body: TNode; pd: TProcDef): TNode;
    +function are_compatible_interfaces(objDefTo:tobjectdef;objDefFrom:tobjectdef):Boolean;
    +function parse_method_reference:tdef;
    +function handle_possible_capture(pd:tprocdef;name:tabstractnormalvarsym):tnode;
    +function parse_nameless_routine(var pd:tprocdef):tnode;
    +function load_captured_variable(pd:tprocdef;name:tabstractnormalvarsym):tnode;
    +function maybe_create_frameobject(var pd:tprocdef):boolean;
    +function maybe_finish_frameobject(pd:tprocdef):boolean;
    +function add_init_frameobject(body:tnode;pd:tprocdef):tnode;
     
     implementation
     
    @@ -36,95 +36,95 @@ Current implementation:
       Code generation pass -
     
     Current problems:
    -1. Typecheck code is inspired by proc_to_procvar_equal function, but simplier. Think more about typecheck.
    +1. Typecheck code is inspired by proc_to_procvar_equal function,but simplier. Think more about typecheck.
     2. We reused existing types and add some flags to these types It's time to think about inheritance.
     3. Code is tricky. Investigate is it possible to move closure convertion into separate pass. At least
        create separate classed to closure definition.
     *)
     
    -uses nld, { TODO: get rid of cicle references }
    -     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas, ncnv, pbase, tokens, nobj, fmodule, ncon, ngenutil, defcmp, sysutils, globals;
    +uses nld,{ TODO:get rid of cicle references }
    +     symconst,procinfo,pdecsub,psub,verbose,symbase,symtable,ncal,pass_1,nmem,nbas,ncnv,pbase,tokens,nobj,fmodule,ncon,ngenutil,defcmp,sysutils,globals;
     
    -procedure BuildObjVmt_(objDef: TobjectDef);
    -var vmtBuilder: TVMTBuilder;
    +procedure build_obj_vmt_(objdef:tobjectdef);
    +var vmtBuilder:TVMTBuilder;
     begin
    -  vmtBuilder := TVMTBuilder.Create(objDef);
    +  vmtBuilder:=TVMTBuilder.create(objdef);
       vmtBuilder.generate_vmt;
       vmtBuilder.free;
     end;
     
    -function add_init_frameobject(body: TNode; pd: TProcDef): TNode;
    +function add_init_frameobject(body:tnode;pd:tprocdef):tnode;
     var
    -  createObj, assignIntf, callNode: TNode;
    -  symCreateProc: TSym;
    -  dummySymTable: TSymTable;
    -  bRet: Boolean;
    -  stmt: TStatementNode;
    -  block: tblocknode;
    -  intfSym, objSym: TSym;
    +  createobj,assignitf,callnode:tnode;
    +  symcreateproc:tsym;
    +  dummysymtable:tsymtable;
    +  ret:boolean;
    +  stmt:tstatementnode;
    +  block:tblocknode;
    +  intfsym,objsym:tsym;
     begin
    -  intfSym := pd.frameObjectIntfSym;
    -  objSym := pd.frameObjectSym;
    -
    -  bRet := searchsym_in_class( pd.frameObjectDef, pd.frameObjectDef, 'CREATE', symCreateProc, dummySymTable, false);
    -  if not bRet then InternalError(2013052601);
    -  callNode := CCallNode.Create( nil,
    -                                TProcSym(symCreateProc),
    -                                pd.frameObjectDef.symtable,
    -                                CLoadVmtAddrNode.Create(CTypeNode.Create(pd.frameObjectDef)),
    -                                [cnf_return_value_used] ); // not sure about call parameters
    -  block := TBlockNode(body);
    -  createObj := CAssignmentNode.Create(CLoadNode.Create(objSym, pd.localst),
    -                                      callNode);
    -  assignIntf := CAssignmentNode.Create(CLoadNode.Create(intfSym, pd.localst),
    -                                       CLoadNode.Create(objSym, pd.localst));
    -  stmt := CStatementNode.Create(createObj,
    -          CStatementNode.Create(assignIntf,
    -                                block.left));
    -  block.left := stmt;
    -  do_typecheckpass(TNode(block));
    -  Result := block;
    +  intfsym:=pd.frameObjectIntfSym;
    +  objsym:=pd.frameObjectSym;
    +
    +  ret:=searchsym_in_class(pd.frameObjectDef,pd.frameObjectDef,'CREATE',symcreateproc,dummysymtable,false);
    +  if not ret then InternalError(2013052601);
    +  callnode:=ccallnode.create(nil,
    +                             tprocsym(symcreateproc),
    +                             pd.frameObjectDef.symtable,
    +                             cloadvmtaddrnode.create(CTypeNode.create(pd.frameObjectDef)),
    +                             [cnf_return_value_used]);// not sure about call parameters
    +  block:=tblocknode(body);
    +  createobj:=cassignmentnode.create(cloadnode.create(objsym,pd.localst),
    +                                    callnode);
    +  assignitf:=cassignmentnode.create(cloadnode.create(intfsym,pd.localst),
    +                                    cloadnode.create(objsym,pd.localst));
    +  stmt:=cstatementnode.create(createobj,
    +                              cstatementnode.create(assignitf,
    +                                                    block.left));
    +  block.left:=stmt;
    +  do_typecheckpass(tnode(block));
    +  result:=block;
     end;
     
    -function maybe_finish_frameobject(pd: tprocdef): boolean;
    +function maybe_finish_frameobject(pd:tprocdef):boolean;
     begin
    -  Result := assigned(pd.frameObjectDef);
    -  if Result then
    -    BuildObjVmt_(pd.frameObjectDef);
    +  result:=assigned(pd.frameObjectDef);
    +  if result then
    +    build_obj_vmt_(pd.frameObjectDef);
     end;
     
    -function maybe_create_frameobject(var pd: tprocdef): boolean;
    -var intfObjDef: TObjectDef;
    +function maybe_create_frameobject(var pd:tprocdef):boolean;
    +var intfObjDef:tobjectdef;
     
    -  procedure FindTypeDefinitions_;
    -  var sym: tsym;
    -      symtable: tsymtable;
    +  procedure find_type_definitions_;
    +  var sym:tsym;
    +      symtable:tsymtable;
       begin
    -    // TODO: is there better way to get tinterfacedobject ?
    -    searchsym_type('TINTERFACEDOBJECT', sym, symtable);
    -    if (not assigned(sym)) or (sym.typ <> typesym) then InternalError(2013052602);
    -    intfObjDef := tobjectdef(ttypesym(sym).typedef);
    +    // TODO:is there better way to get tinterfacedobject ?
    +    searchsym_type('TINTERFACEDOBJECT',sym,symtable);
    +    if (not assigned(sym)) or (sym.typ<>typesym) then InternalError(2013052602);
    +    intfObjDef:=tobjectdef(ttypesym(sym).typedef);
       end;
     
    -var objSym, intfSym: tabstractnormalvarsym;
    -    frameObjectDef: TObjectDef;
    +var objSym,intfSym:tabstractnormalvarsym;
    +    frameObjectDef:tobjectdef;
     
    -  procedure InsertVarSymbols_(st: tsymtable);
    +  procedure insert_var_symbols_(st:tsymtable);
       begin
         // this is come from read_var_decls function
         case st.symtabletype of
           localsymtable :
             begin
    -          objSym  := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []);
    -          intfSym := tlocalvarsym.create('$pFrameObjectIntf', vs_var, interface_iunknown, []);
    +          objSym :=tlocalvarsym.create('$pFrameObjectObj',vs_var,frameObjectDef,[]);
    +          intfSym:=tlocalvarsym.create('$pFrameObjectIntf',vs_var,interface_iunknown,[]);
               st.insert(objSym);
               st.insert(intfSym);
             end;
           staticsymtable,
           globalsymtable :
             begin
    -          objSym  := tstaticvarsym.create('$pFrameObjectObj', vs_value, frameObjectDef, []);
    -          intfSym := tstaticvarsym.create('$pFrameObjectIntf', vs_value, interface_iunknown, []);
    +          objSym :=tstaticvarsym.create('$pFrameObjectObj',vs_value,frameObjectDef,[]);
    +          intfSym:=tstaticvarsym.create('$pFrameObjectIntf',vs_value,interface_iunknown,[]);
               st.insert(objSym);
               st.insert(intfSym);
               cnodeutils.insertbssdata(tstaticvarsym(objSym));
    @@ -133,136 +133,136 @@ var objSym, intfSym: tabstractnormalvarsym;
         else
           internalerror(2013052603);
         end;
    -    objSym.varstate := vs_initialised; // prevent warning; init code will be added later
    -    intfSym.varstate := vs_read;       // this reference is used only to keep frame object alive
    +    objSym.varstate:=vs_initialised;// prevent warning;init code will be added later
    +    intfSym.varstate:=vs_read;      // this reference is used only to keep frame object alive
       end;
     
    -  procedure BuildFrameObjectDef_;
    +  procedure build_frame_object_def_;
       var
    -    name: String;
    +    name:String;
       begin
    -    name := '$' + pd.procsym.RealName + '_FrameObjectDef';
    -    frameObjectDef := tobjectdef.create(odt_class, name, intfObjDef);
    -    TTypeSym.Create(name, frameObjectDef);
    -    include(frameObjectDef.objectoptions, oo_is_nameless);
    +    name:='$' + pd.procsym.RealName + '_FrameObjectDef';
    +    frameObjectDef:=tobjectdef.create(odt_class,name,intfObjDef);
    +    ttypesym.create(name,frameObjectDef);
    +    include(frameObjectDef.objectoptions,oo_is_nameless);
         current_module.localsymtable.insert(frameObjectDef.typesym);
       end;
     
     begin
       if assigned(pd.frameObjectDef) then exit(false);
    -  FindTypeDefinitions_();
    -  BuildFrameObjectDef_();
    -  InsertVarSymbols_(pd.localst);
    +  find_type_definitions_();
    +  build_frame_object_def_();
    +  insert_var_symbols_(pd.localst);
     
    -  pd.frameObjectDef     := frameObjectDef;
    +  pd.frameObjectDef    :=frameObjectDef;
       { pd.frameObjectDeref }
    -  pd.frameObjectSym     := objSym;
    -  pd.frameObjectIntfSym := intfSym;
    -  Result := true;
    +  pd.frameObjectSym    :=objSym;
    +  pd.frameObjectIntfSym:=intfSym;
    +  result:=true;
     end;
     
    -function are_compatible_interfaces(objDefTo: TObjectDef; objDefFrom: TObjectDef): Boolean;
    -var defTo, defFrom: TProcDef;
    -    eq: tequaltype;
    +function are_compatible_interfaces(objDefTo:tobjectdef;objDefFrom:tobjectdef):Boolean;
    +var defTo,defFrom:tprocdef;
    +    eq:tequaltype;
     begin
       if not objDefTo.isClosure or not objDefFrom.isClosure then exit(false);
    -  if (objDefTo.symtable.DefList.Count <> 1) or (objDefTo.symtable.DefList.Count <> 1) then exit(false);
    -  defTo := tdef(objDefTo.symtable.DefList[0]) as TProcDef;
    -  defFrom := tdef(objDefFrom.symtable.DefList[0]) as TProcDef;
    -  if not equal_defs(defTo.returndef, defFrom.returndef) then exit(false);
    +  if (objDefTo.symtable.DefList.Count<>1) or (objDefTo.symtable.DefList.Count<>1) then exit(false);
    +  defTo:=tdef(objDefTo.symtable.DefList[0]) as tprocdef;
    +  defFrom:=tdef(objDefFrom.symtable.DefList[0]) as tprocdef;
    +  if not equal_defs(defTo.returndef,defFrom.returndef) then exit(false);
       eq:=compare_paras(defTo.paras,defFrom.paras,cp_procvar,[]);
       if eq < te_equal then exit(false);
    -  Result := true;
    +  result:=true;
     end;
     
    -function parse_method_reference: tdef;
    -var typesym: TTypeSym;
    -    intf: TObjectDef;
    -    name: String;
    -    procDef: TProcDef;
    +function parse_method_reference:tdef;
    +var typesym:ttypesym;
    +    intf:tobjectdef;
    +    name:String;
    +    procDef:tprocdef;
     begin
    -  consume(_REFERENCE); consume(_TO);
    -  name := 'ClosureReference_IntfDef' + inttostr(current_filepos.line)+'_'+inttostr(current_filepos.column); // TODO: think about name
    -  intf := tobjectdef.create(odt_interfacecom, name, interface_iunknown);
    -  intf.isClosure := true;
    +  consume(_REFERENCE);consume(_TO);
    +  name:='ClosureReference_IntfDef' + inttostr(current_filepos.line)+'_'+inttostr(current_filepos.column);// TODO:think about name
    +  intf:=tobjectdef.create(odt_interfacecom,name,interface_iunknown);
    +  intf.isClosure:=true;
       if not assigned(intf.typesym) then
       begin
    -    intf.typesym := TTypeSym.Create(name, intf);
    +    intf.typesym:=ttypesym.create(name,intf);
         current_module.localsymtable.insert(intf.typesym);
       end;
       symtablestack.push(intf.symtable);
    -  procDef := parse_proc_dec(intf, ppm_method_reference);
    -  include(procDef.procoptions, po_virtualmethod);
    +  procDef:=parse_proc_dec(intf,ppm_method_reference);
    +  include(procDef.procoptions,po_virtualmethod);
       tprocsym(procDef.procsym).ProcdefList.Add(procDef);
       handle_calling_convention(procDef);
       symtablestack.pop(intf.symtable);
    -  BuildObjVmt_(intf);
    -  Result := intf;
    +  build_obj_vmt_(intf);
    +  result:=intf;
     end;
     
    -function handle_possible_capture(pd: tprocdef; name: tabstractnormalvarsym): tnode;
    +function handle_possible_capture(pd:tprocdef;name:tabstractnormalvarsym):tnode;
     begin
       // TODO:
    -  Result := nil;
    +  result:=nil;
     end;
     
    -function parse_nameless_routine(var pd: tprocdef): tnode;
    +function parse_nameless_routine(var pd:tprocdef):tnode;
     
    -  // well, I don't like this banch of gloval variables which each function save on stack
    -  procedure ReadProcBody_(framObjectDef: TObjectDef; anonymProcDef: TProcDef);
    -  var old_current_structdef: tabstractrecorddef;
    -      old_current_procinfo: tprocinfo;
    +  // well,I don't like this banch of gloval variables which each function save on stack
    +  procedure read_proc_body_(framObjectDef:tobjectdef;anonymProcDef:tprocdef);
    +  var old_current_structdef:tabstractrecorddef;
    +      old_current_procinfo:tprocinfo;
       begin
    -    old_current_structdef := current_structdef;
    -    old_current_procinfo := current_procinfo;
    -    current_structdef := framObjectDef;
    -    while current_procinfo.parent <> nil do
    -      current_procinfo := current_procinfo.parent;
    -    read_proc(false, anonymProcDef, false);
    +    old_current_structdef:=current_structdef;
    +    old_current_procinfo:=current_procinfo;
    +    current_structdef:=framObjectDef;
    +    while current_procinfo.parent<>nil do
    +      current_procinfo:=current_procinfo.parent;
    +    read_proc(false,anonymProcDef,false);
         proc_add_definition(anonymProcDef);
    -    current_structdef := old_current_structdef;
    -    current_procinfo := old_current_procinfo;
    -    current_module.procinfo := old_current_procinfo;
    +    current_structdef:=old_current_structdef;
    +    current_procinfo:=old_current_procinfo;
    +    current_module.procinfo:=old_current_procinfo;
       end;
     
    -var anonymProcDef: TProcDef;
    -    cloneProcDef: TProcDef;
    -    intf: TObjectDef;
    -    intfName: String;
    +var anonymprocdef:tprocdef;
    +    cloneprocdef:tprocdef;
    +    intf:tobjectdef;
    +    intfName:String;
     begin
       maybe_create_frameobject(pd);
     
    -  symtablestack.push(pd.frameObjectDef.symtable); // procdef will add itself in deflist during creation
    -  anonymProcDef := parse_proc_dec(pd.frameObjectDef, ppm_nameless_routine);
    -  handle_calling_convention(anonymProcDef);
    +  symtablestack.push(pd.frameObjectDef.symtable);// procdef will add itself in deflist during creation
    +  anonymprocdef:=parse_proc_dec(pd.frameObjectDef,ppm_nameless_routine);
    +  handle_calling_convention(anonymprocdef);
     
    -  intfName := anonymProcDef.procsym.RealName + '_ClosureImpl_IntfDef';
    -  intf := tobjectdef.create(odt_interfacecom, intfName, interface_iunknown);
    -  TTypeSym.Create(intfName, intf);
    +  intfName:=anonymprocdef.procsym.RealName + '_ClosureImpl_IntfDef';
    +  intf:=tobjectdef.create(odt_interfacecom,intfName,interface_iunknown);
    +  ttypesym.create(intfName,intf);
       current_module.localsymtable.insert(intf.typesym);
     
    -  symtablestack.push(intf.symtable); // procdef should be inside intf symtable, otherwise it will not be in vtlb
    -  cloneProcDef := TProcDef(anonymProcDef.getcopy);
    +  symtablestack.push(intf.symtable);// procdef should be inside intf symtable,otherwise it will not be in vtlb
    +  cloneprocdef:=tprocdef(anonymprocdef.getcopy);
       symtablestack.pop(intf.symtable);
    -  cloneProcDef.struct := intf;
    -  cloneProcDef.procsym := TProcSym.Create(anonymProcDef.procsym.Name); // same name to connect implemented method with interface method
    -  intf.symtable.insert(cloneProcDef.procsym);
    -  intf.isClosure := true;
    -  BuildObjVmt_(intf);
    +  cloneprocdef.struct:=intf;
    +  cloneprocdef.procsym:=tprocsym.create(anonymprocdef.procsym.Name);// same name to connect implemented method with interface method
    +  intf.symtable.insert(cloneprocdef.procsym);
    +  intf.isClosure:=true;
    +  build_obj_vmt_(intf);
       pd.frameObjectDef.register_implemented_interface(intf);
     
    -  ReadProcBody_(pd.frameObjectDef, anonymProcDef);
    +  read_proc_body_(pd.frameObjectDef,anonymprocdef);
       symtablestack.pop(pd.frameObjectDef.symtable);
     
    -  Result := CLoadNode.Create(pd.frameObjectSym, pd.localst);
    -  inserttypeconv(Result, intf);
    +  result:=cloadnode.create(pd.frameObjectSym,pd.localst);
    +  inserttypeconv(result,intf);
     end;
     
    -function load_captured_variable(pd: tprocdef; name: tabstractnormalvarsym): tnode;
    +function load_captured_variable(pd:tprocdef;name:tabstractnormalvarsym):tnode;
     begin
       // TODO:
       InternalError(2013052606);
    -  Result := nil;
    +  result:=nil;
     end;
     
     begin
    -- 
    1.7.10.4
    
    
    closures00.patch (176,782 bytes)
  • closures01.patch (133,611 bytes)
    From 643c63f21fd21d2d7f4dad4ec46a630d2116e4bd Mon Sep 17 00:00:00 2001
    From: blaise <blaise@3ad0048d-3df7-0310-abae-a5850022a9f2>
    Date: Sat, 21 Jan 2012 19:00:59 +0000
    Subject: [PATCH 1/4] Parse anonymous functions.
    
    Now it's possible to parse anonymous routine inside body of other routine.
    Currently anonymous procedure have normal nesting level. So it can't access local variables of outer function. There is no check for this.
    Currently "reference to procedure" is represented as procvar. That is why there is no typecheck during assignment of "pure" procedure to "reference to" procedures.
    
    Delhi-like implementation of closure will have same syntax but will allow to capture variables.
    ---
     compiler/pclosure.pas              |  49 +++++++++++++++++
     compiler/pdecobj.pas               |  10 ++--
     compiler/pdecsub.pas               | 105 +++++++++++++++++++++++++------------
     compiler/pexpr.pas                 |   9 +++-
     compiler/psub.pas                  |  18 +++----
     compiler/ptype.pas                 |  51 ++++++++++--------
     compiler/symconst.pas              |   4 +-
     compiler/symcreat.pas              |   2 +-
     compiler/symdef.pas                |  15 ++++++
     compiler/tokens.pas                |   2 +
     compiler/utils/ppuutils/ppudump.pp |   3 +-
     11 files changed, 196 insertions(+), 72 deletions(-)
     create mode 100644 compiler/pclosure.pas
    
    diff --git a/compiler/pclosure.pas b/compiler/pclosure.pas
    new file mode 100644
    index 0000000..f6894fd
    --- /dev/null
    +++ b/compiler/pclosure.pas
    @@ -0,0 +1,49 @@
    +unit pclosure;
    +
    +{$mode objfpc}
    +
    +interface
    +
    +uses node, symtype, symdef, symsym, globtype;
    +
    +function parse_anonymous_routine(pd: tprocdef): tnode;
    +
    +implementation
    +
    +uses nld,symconst,procinfo,pdecsub,psub,verbose,symbase,symtable,ncal,pass_1,nmem,nbas,fmodule,ncnv;
    +
    +function parse_anonymous_routine(pd: tprocdef): tnode;
    +
    +  procedure read_proc_body_(objdef:tobjectdef;anonymprocdef:tprocdef);
    +  var old_current_structdef:tabstractrecorddef;
    +      old_current_procinfo:tprocinfo;
    +  begin
    +    old_current_structdef:=current_structdef;
    +    old_current_procinfo:=current_procinfo;
    +    current_structdef:=objdef;
    +    while current_procinfo.parent<>nil do
    +      current_procinfo:=current_procinfo.parent;
    +    read_proc(false,anonymprocdef,false);
    +    proc_add_definition(anonymprocdef);
    +    current_structdef:=old_current_structdef;
    +    current_procinfo:=old_current_procinfo;
    +    current_module.procinfo:=old_current_procinfo;
    +  end;
    +
    +var anonymprocdef:tprocdef;
    +    loadn,addrn:tnode;
    +begin
    +  symtablestack.push(current_module.localsymtable); // procdef will add itself in deflist during creation
    +  anonymprocdef:=parse_proc_dec(nil,ppm_anonymous_routine);
    +  symtablestack.pop(current_module.localsymtable);
    +  handle_calling_convention(anonymprocdef);
    +  read_proc_body_(nil,anonymprocdef);
    +
    +  loadn:=cloadnode.create(anonymprocdef.procsym,anonymprocdef.procsym.owner);
    +  addrn:=caddrnode.create(loadn);
    +  typecheckpass(addrn);
    +  result:=addrn;
    +end;
    +
    +begin
    +end.
    diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
    index 61dcc0f..d6a22b9 100644
    --- a/compiler/pdecobj.pas
    +++ b/compiler/pdecobj.pas
    @@ -104,7 +104,7 @@ implementation
             result:=nil;
             consume(_CONSTRUCTOR);
             { must be at same level as in implementation }
    -        parse_proc_head(current_structdef,potype_class_constructor,pd);
    +        parse_proc_head(current_structdef,potype_class_constructor,ppm_class_method,pd);
             if not assigned(pd) then
               begin
                 consume(_SEMICOLON);
    @@ -129,7 +129,7 @@ implementation
             result:=nil;
             consume(_CONSTRUCTOR);
             { must be at same level as in implementation }
    -        parse_proc_head(current_structdef,potype_constructor,pd);
    +        parse_proc_head(current_structdef,potype_constructor,ppm_normal,pd);
             if not assigned(pd) then
               begin
                 consume(_SEMICOLON);
    @@ -226,7 +226,7 @@ implementation
           begin
             result:=nil;
             consume(_DESTRUCTOR);
    -        parse_proc_head(current_structdef,potype_class_destructor,pd);
    +        parse_proc_head(current_structdef,potype_class_destructor,ppm_class_method,pd);
             if not assigned(pd) then
               begin
                 consume(_SEMICOLON);
    @@ -250,7 +250,7 @@ implementation
           begin
             result:=nil;
             consume(_DESTRUCTOR);
    -        parse_proc_head(current_structdef,potype_destructor,pd);
    +        parse_proc_head(current_structdef,potype_destructor,ppm_normal,pd);
             if not assigned(pd) then
               begin
                 consume(_SEMICOLON);
    @@ -874,7 +874,7 @@ implementation
     
                   oldparse_only:=parse_only;
                   parse_only:=true;
    -              result:=parse_proc_dec(is_classdef,astruct);
    +              result:=parse_proc_dec(astruct,as_procparsemode(is_classdef));
     
                   { this is for error recovery as well as forward }
                   { interface mappings, i.e. mapping to a method  }
    diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
    index c5c4cdf..91310ca 100644
    --- a/compiler/pdecsub.pas
    +++ b/compiler/pdecsub.pas
    @@ -72,8 +72,12 @@ interface
         procedure parse_var_proc_directives(sym:tsym);
         procedure parse_object_proc_directives(pd:tabstractprocdef);
         procedure parse_record_proc_directives(pd:tabstractprocdef);
    -    function  parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;out pd:tprocdef):boolean;
    -    function  parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef):tprocdef;
    +
    +    type tprocparsemode = (ppm_normal, ppm_class_method, ppm_anonymous_routine, ppm_method_reference);
    +    // TODO: operator :=/Explicit (const is_class_method: boolean) result: tprocparsemode;
    +    function as_procparsemode(const is_class_method: boolean): tprocparsemode; inline;
    +    function parse_proc_head(astruct: tabstractrecorddef; potype: tproctypeoption; const procparsemode: tprocparsemode; out pd: tprocdef): boolean;
    +    function parse_proc_dec(astruct: tabstractrecorddef; const procparsemode: tprocparsemode = ppm_normal): tprocdef;
     
         { parse a record method declaration (not a (class) constructor/destructor) }
         function parse_record_method_dec(astruct: tabstractrecorddef; is_classdef: boolean): tprocdef;
    @@ -540,7 +544,7 @@ implementation
           end;
     
     
    -    function parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;out pd:tprocdef):boolean;
    +    function parse_proc_head(astruct: tabstractrecorddef; potype: tproctypeoption; const procparsemode: tprocparsemode; out pd: tprocdef): boolean;
           var
             hs       : string;
             orgsp,sp : TIDString;
    @@ -756,7 +760,20 @@ implementation
             pd:=nil;
             aprocsym:=nil;
     
    -        consume_proc_name;
    +        case procparsemode of
    +          ppm_anonymous_routine:
    +            begin
    +              sp:='Anonymous_'+inttostr(procstartfilepos.line)+'_'+inttostr(procstartfilepos.column);
    +              orgsp:=upcase(sp);
    +            end;
    +          ppm_method_reference:
    +            begin
    +              sp:='Apply';
    +              orgsp:=upcase(sp);
    +            end;
    +          else
    +            consume_proc_name;
    +        end;
     
             { examine interface map: function/procedure iname.functionname=locfuncname }
             if assigned(astruct) and
    @@ -809,7 +826,11 @@ implementation
     
             { method  ? }
             srsym:=nil;
    -        if (consume_generic_type_parameter or not assigned(astruct)) and
    +        if procparsemode=ppm_anonymous_routine then
    +          // Do nothing. This check here:
    +          //   a) skips below checks and searches, speeding things up;
    +          //   b) makes sure we do not try to parse generic type parameters.
    +        else if (consume_generic_type_parameter or not assigned(astruct)) and
                (symtablestack.top.symtablelevel=main_program_level) and
                try_to_consume(_POINT) then
              begin
    @@ -944,17 +965,25 @@ implementation
                 symtablestack.top.insert(aprocsym);
               end;
     
    -        { to get the correct symtablelevel we must ignore ObjectSymtables }
    -        st:=nil;
    -        checkstack:=symtablestack.stack;
    -        while assigned(checkstack) do
    +        if procparsemode=ppm_anonymous_routine then
    +          begin
    +            pd:=tprocdef.create(normal_function_level);
    +            include(pd.procoptions,po_anonymous);
    +          end
    +        else 
               begin
    -            st:=checkstack^.symtable;
    -            if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then
    -              break;
    -            checkstack:=checkstack^.next;
    +            { to get the correct symtablelevel we must ignore ObjectSymtables }
    +            st:=nil;
    +            checkstack:=symtablestack.stack;
    +            while assigned(checkstack) do
    +              begin
    +                st:=checkstack^.symtable;
    +                if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then
    +                  break;
    +                checkstack:=checkstack^.next;
    +              end;
    +            pd:=tprocdef.create(st.symtablelevel+1);
               end;
    -        pd:=tprocdef.create(st.symtablelevel+1);
             pd.struct:=astruct;
             pd.procsym:=aprocsym;
             pd.proctypeoption:=potype;
    @@ -1042,7 +1071,16 @@ implementation
           end;
     
     
    -    function parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef):tprocdef;
    +    function as_procparsemode(const is_class_method: boolean): tprocparsemode; inline;
    +      begin
    +        if is_class_method then
    +          result := ppm_class_method
    +        else
    +          result := ppm_normal
    +      end;
    +
    +
    +    function parse_proc_dec(astruct: tabstractrecorddef; const procparsemode: tprocparsemode = ppm_normal): tprocdef;
           var
             pd: tprocdef;
             locationstr: string;
    @@ -1100,7 +1138,7 @@ implementation
               _FUNCTION :
                 begin
                   consume(_FUNCTION);
    -              if parse_proc_head(astruct,potype_function,pd) then
    +              if parse_proc_head(astruct,potype_function,procparsemode,pd) then
                     begin
                       { pd=nil when it is a interface mapping }
                       if assigned(pd) then
    @@ -1144,8 +1182,8 @@ implementation
                                 consume_all_until(_SEMICOLON);
                               end;
                            end;
    -                      if isclassmethod then
    -                       include(pd.procoptions,po_classmethod);
    +                      if procparsemode=ppm_class_method then
    +                        include(pd.procoptions,po_classmethod);
                         end;
                     end
                   else
    @@ -1159,13 +1197,13 @@ implementation
               _PROCEDURE :
                 begin
                   consume(_PROCEDURE);
    -              if parse_proc_head(astruct,potype_procedure,pd) then
    +              if parse_proc_head(astruct,potype_procedure,procparsemode,pd) then
                     begin
                       { pd=nil when it is an interface mapping }
                       if assigned(pd) then
                         begin
                           pd.returndef:=voidtype;
    -                      if isclassmethod then
    +                      if procparsemode=ppm_class_method then
                             include(pd.procoptions,po_classmethod);
                         end;
                     end;
    @@ -1174,11 +1212,11 @@ implementation
               _CONSTRUCTOR :
                 begin
                   consume(_CONSTRUCTOR);
    -              if isclassmethod then
    -                parse_proc_head(astruct,potype_class_constructor,pd)
    +              if procparsemode=ppm_class_method then
    +                parse_proc_head(astruct,potype_class_constructor,procparsemode,pd)
                   else
    -                parse_proc_head(astruct,potype_constructor,pd);
    -              if not isclassmethod and
    +                parse_proc_head(astruct,potype_constructor,procparsemode,pd);
    +              if (procparsemode<>ppm_class_method) and
                      assigned(pd) and
                      assigned(pd.struct) then
                     begin
    @@ -1205,16 +1243,16 @@ implementation
               _DESTRUCTOR :
                 begin
                   consume(_DESTRUCTOR);
    -              if isclassmethod then
    -                parse_proc_head(astruct,potype_class_destructor,pd)
    +              if procparsemode=ppm_class_method then
    +                parse_proc_head(astruct,potype_class_destructor,procparsemode,pd)
                   else
    -                parse_proc_head(astruct,potype_destructor,pd);
    +                parse_proc_head(astruct,potype_destructor,procparsemode,pd);
                   if assigned(pd) then
                     pd.returndef:=voidtype;
                 end;
             else
               if (token=_OPERATOR) or
    -             (isclassmethod and (idtoken=_OPERATOR)) then
    +             ((procparsemode=ppm_class_method) and (idtoken=_OPERATOR)) then
                 begin
                   { we need to set the block type to bt_body, so that operator names
                     like ">", "=>" or "<>" are parsed correctly instead of e.g.
    @@ -1222,7 +1260,7 @@ implementation
                   old_block_type:=block_type;
                   block_type:=bt_body;
                   consume(_OPERATOR);
    -              parse_proc_head(astruct,potype_operator,pd);
    +              parse_proc_head(astruct,potype_operator,procparsemode,pd);
                   block_type:=old_block_type;
                   if assigned(pd) then
                     begin
    @@ -1232,7 +1270,7 @@ implementation
                       pd.procsym.owner.includeoption(sto_has_operator);
                       if pd.parast.symtablelevel>normal_function_level then
                         Message(parser_e_no_local_operator);
    -                  if isclassmethod then
    +                  if procparsemode=ppm_class_method then
                         include(pd.procoptions,po_classmethod);
                       if token<>_ID then
                         begin
    @@ -1304,7 +1342,8 @@ implementation
                     message(parser_e_field_not_allowed_here);
                     consume_all_until(_SEMICOLON);
                   end;
    -            consume(_SEMICOLON);
    +            if not (procparsemode in [ppm_anonymous_routine,ppm_method_reference]) then
    +              consume(_SEMICOLON);
               end;
             result:=pd;
     
    @@ -1323,7 +1362,7 @@ implementation
           begin
             oldparse_only:=parse_only;
             parse_only:=true;
    -        result:=parse_proc_dec(is_classdef,astruct);
    +        result:=parse_proc_dec(astruct,as_procparsemode(is_classdef));
     
             { this is for error recovery as well as forward }
             { interface mappings, i.e. mapping to a method  }
    @@ -3303,7 +3342,7 @@ const
                 if (currpd.proctypeoption = potype_function) and
                    is_void(currpd.returndef) then
                   MessagePos1(currpd.fileinfo,parser_e_no_funcret_specified,currpd.procsym.realname);
    -            tprocsym(currpd.procsym).ProcdefList.Add(currpd);
    +            currpd.add_to_procsym;
               end;
     
             proc_add_definition:=forwardfound;
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index 50808ab..c05c103 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -70,7 +70,7 @@ implementation
            nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
            { parser }
            scanner,
    -       pbase,pinline,ptype,pgenutil,procinfo,cpuinfo
    +       pbase,pinline,ptype,pgenutil,procinfo,cpuinfo,pclosure
            ;
     
         { sub_expr(opmultiply) is need to get -1 ** 4 to be
    @@ -3314,6 +3314,13 @@ implementation
                    p1:=cinlinenode.create(in_objc_protocol_x,false,p1);
                  end;
     
    +             // anonymous routine
    +             _PROCEDURE, _FUNCTION:
    +               if assigned(current_procinfo) then
    +                 p1:=parse_anonymous_routine(current_procinfo.procdef)
    +               else // TODO: support this later? Delphi doesn't
    +                 internalerror(20120121);
    +
                  else
                    begin
                      Message(parser_e_illegal_expression);
    diff --git a/compiler/psub.pas b/compiler/psub.pas
    index 64f4655..a63760b 100644
    --- a/compiler/psub.pas
    +++ b/compiler/psub.pas
    @@ -77,7 +77,7 @@ interface
         { reads any routine in the implementation, or a non-method routine
           declaration in the interface (depending on whether or not parse_only is
           true) }
    -    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef);
    +    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef;eatsemicolon:boolean);
     
         procedure generate_specialization_procs;
     
    @@ -1828,7 +1828,7 @@ implementation
     
     
     
    -    procedure read_proc_body(old_current_procinfo:tprocinfo;pd:tprocdef);
    +    procedure read_proc_body(old_current_procinfo:tprocinfo;pd:tprocdef;eatsemicolon:boolean=true);
           {
             Parses the procedure directives, then parses the procedure body, then
             generates the code for it
    @@ -1912,7 +1912,7 @@ implementation
             { For specialization we didn't record the last semicolon. Moving this parsing
               into the parse_body routine is not done because of having better file position
               information available }
    -        if not(df_specialization in current_procinfo.procdef.defoptions) then
    +        if eatsemicolon and not(df_specialization in current_procinfo.procdef.defoptions) then
               consume(_SEMICOLON);
     
             if not isnestedproc then
    @@ -1921,7 +1921,7 @@ implementation
           end;
     
     
    -    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef);
    +    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef;eatsemicolon:boolean);
           {
             Parses the procedure directives, then parses the procedure body, then
             generates the code for it
    @@ -1951,7 +1951,7 @@ implementation
     
              if not assigned(usefwpd) then
                { parse procedure declaration }
    -           pd:=parse_proc_dec(isclassmethod,old_current_structdef)
    +           pd:=parse_proc_dec(old_current_structdef,as_procparsemode(isclassmethod))
              else
                pd:=usefwpd;
     
    @@ -2028,7 +2028,7 @@ implementation
              { compile procedure when a body is needed }
              if (pd_body in pdflags) then
                begin
    -             read_proc_body(old_current_procinfo,pd);
    +             read_proc_body(old_current_procinfo,pd,eatsemicolon);
                end
              else
                begin
    @@ -2152,7 +2152,7 @@ implementation
                   _PROCEDURE,
                   _OPERATOR:
                     begin
    -                  read_proc(is_classdef,nil);
    +                  read_proc(is_classdef,nil,true);
                       is_classdef:=false;
                     end;
                   _EXPORTS:
    @@ -2187,7 +2187,7 @@ implementation
                           begin
                             if is_classdef then
                               begin
    -                            read_proc(is_classdef,nil);
    +                            read_proc(is_classdef,nil,true);
                                 is_classdef:=false;
                               end
                             else
    @@ -2235,7 +2235,7 @@ implementation
                  _FUNCTION,
                  _PROCEDURE,
                  _OPERATOR :
    -               read_proc(false,nil);
    +               read_proc(false,nil,true);
                  else
                    begin
                      case idtoken of
    diff --git a/compiler/ptype.pas b/compiler/ptype.pas
    index 3aad0b7..70ee34b 100644
    --- a/compiler/ptype.pas
    +++ b/compiler/ptype.pas
    @@ -27,7 +27,7 @@ interface
     
         uses
            globtype,cclasses,
    -       symtype,symdef,symbase;
    +       symtype,symdef,symbase,pclosure;
     
         type
           TSingleTypeOption=(
    @@ -1673,26 +1673,35 @@ implementation
                     jvm_create_procvar_class(name,def);
     {$endif}
                   end;
    -            else
    -              if (token=_KLAMMERAFFE) and (m_iso in current_settings.modeswitches) then
    -                begin
    -                  consume(_KLAMMERAFFE);
    -                  single_type(tt2,SingleTypeOptionsInTypeBlock[block_type=bt_type]);
    -                  def:=tpointerdef.create(tt2);
    -                  if tt2.typ=forwarddef then
    -                    current_module.checkforwarddefs.add(def);
    -                end
    -              else
    -                if hadtypetoken and
    -                    { don't allow "type helper" in mode delphi and require modeswitch class }
    -                    ([m_delphi,m_class]*current_settings.modeswitches=[m_class]) and
    -                    (token=_ID) and (idtoken=_HELPER) then
    -                  begin
    -                    consume(_HELPER);
    -                    def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_type);
    -                  end
    -                else
    -                  expr_type;
    +           _KLAMMERAFFE:
    +             if m_iso in current_settings.modeswitches then
    +               begin
    +                 consume(_KLAMMERAFFE);
    +                 single_type(tt2,SingleTypeOptionsInTypeBlock[block_type=bt_type]);
    +                 def:=tpointerdef.create(tt2);
    +                 if tt2.typ=forwarddef then
    +                   current_module.checkforwarddefs.add(def);
    +               end
    +             else
    +               expr_type;
    +           _ID:
    +             if idtoken=_REFERENCE then
    +               begin
    +                 consume(_REFERENCE); consume(_TO);
    +                 def:=procvar_dec(genericdef,genericlist);
    +               end
    +             else
    +             if (idtoken=_HELPER) and hadtypetoken and
    +                { don't allow "type helper" in mode delphi and require modeswitch class }
    +                ([m_delphi,m_class]*current_settings.modeswitches=[m_class]) then
    +               begin
    +                 consume(_HELPER);
    +                 def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_type);
    +               end
    +             else
    +               expr_type;
    +           else
    +             expr_type;
              end;
     
              if def=nil then
    diff --git a/compiler/symconst.pas b/compiler/symconst.pas
    index 83dd798..b991e2a 100644
    --- a/compiler/symconst.pas
    +++ b/compiler/symconst.pas
    @@ -350,7 +350,9 @@ type
         { the visibility of of this procdef was raised automatically by the
           compiler, e.g. because it was designated as a getter/setter for a property
           with a higher visibility on the JVM target }
    -    po_auto_raised_visibility
    +    po_auto_raised_visibility,
    +    { anonymous routine (including closure) }
    +    po_anonymous
       );
       tprocoptions=set of tprocoption;
     
    diff --git a/compiler/symcreat.pas b/compiler/symcreat.pas
    index 06ac751..925eeda 100644
    --- a/compiler/symcreat.pas
    +++ b/compiler/symcreat.pas
    @@ -242,7 +242,7 @@ implementation
           current_scanner.substitutemacro('meth_impl_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index);
           current_scanner.readtoken(false);
           { and parse it... }
    -      read_proc(is_classdef,usefwpd);
    +      read_proc(is_classdef,usefwpd,true);
           parse_only:=oldparse_only;
           { remove the temporary macro input file again }
           current_scanner.closeinputfile;
    diff --git a/compiler/symdef.pas b/compiler/symdef.pas
    index f6f816e..59b1cb7 100644
    --- a/compiler/symdef.pas
    +++ b/compiler/symdef.pas
    @@ -731,6 +731,8 @@ interface
               function  is_methodpointer:boolean;override;
               function  is_addressonly:boolean;override;
               procedure make_external;
    +          procedure add_to_procsym; overload; inline;
    +          procedure add_to_procsym(sym: tsym); overload; inline;
            end;
     
            { single linked list of overloaded procs }
    @@ -4792,6 +4794,19 @@ implementation
           end;
     
     
    +    procedure tprocdef.add_to_procsym; inline;
    +      begin
    +        tprocsym(procsym).ProcdefList.Add(self);
    +      end;
    +
    +
    +    procedure tprocdef.add_to_procsym(sym: {tprocsym}tsym); inline;
    +      begin
    +        procsym:=sym;
    +        add_to_procsym;
    +      end;
    +
    +
         procedure tprocdef.buildderef;
           begin
              inherited buildderef;
    diff --git a/compiler/tokens.pas b/compiler/tokens.pas
    index 3fe1505..3f29f59 100644
    --- a/compiler/tokens.pas
    +++ b/compiler/tokens.pas
    @@ -257,6 +257,7 @@ type
         _PROCEDURE,
         _PROTECTED,
         _PUBLISHED,
    +    _REFERENCE,
         _SOFTFLOAT,
         _THREADVAR,
         _WRITEONLY,
    @@ -556,6 +557,7 @@ const
           (str:'PROCEDURE'     ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
           (str:'PROTECTED'     ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'PUBLISHED'     ;special:false;keyword:[m_none];op:NOTOKEN),
    +      (str:'REFERENCE'     ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'SOFTFLOAT'     ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'THREADVAR'     ;special:false;keyword:alllanguagemodes-[m_iso];op:NOTOKEN),
           (str:'WRITEONLY'     ;special:false;keyword:[m_none];op:NOTOKEN),
    diff --git a/compiler/utils/ppuutils/ppudump.pp b/compiler/utils/ppuutils/ppudump.pp
    index c4df7c0..be2b42a 100644
    --- a/compiler/utils/ppuutils/ppudump.pp
    +++ b/compiler/utils/ppuutils/ppudump.pp
    @@ -1723,7 +1723,8 @@ const
          (mask:po_java_nonvirtual; str: 'Java non-virtual method'),
          (mask:po_ignore_for_overload_resolution;str: 'Ignored for overload resolution'),
          (mask:po_rtlproc;         str: 'RTL procedure'),
    -     (mask:po_auto_raised_visibility; str: 'Visibility raised by compiler')
    +     (mask:po_auto_raised_visibility; str: 'Visibility raised by compiler'),
    +     (mask:po_anonymous;       str: 'Anonymous procedure')
       );
     var
       proctypeoption  : tproctypeoption;
    -- 
    1.8.1.2
    
    
    From 4cb8a0b64cc8176e23e83d7924e2dc067253bdca Mon Sep 17 00:00:00 2001
    From: Vasiliy Kevroletin <kevroletin@gmail.com>
    Date: Mon, 3 Jun 2013 00:24:37 +1100
    Subject: [PATCH 2/4] Show error in case of access to free variable.
    
    Problem: variable capturing is not implemented and compiler doesn't warng about it.
    Fix: Show error message. Parser performs check before creation of tloadnode.
    Anonymous routine have normal nesting level and can have nested procedures.
    So simple check of symtable nesting level is not enough to detect fact of capturing. Instead we walk through symtables using parent link. We start from current symtable and go until symtable with normal nesting level. If we didn't come to symtable of variable then this variable located in another function. And it's capturing.
    ---
     compiler/msg/errore.msg |   5 +-
     compiler/msgidx.inc     |   5 +-
     compiler/msgtxt.inc     | 868 ++++++++++++++++++++++++------------------------
     compiler/pdecsub.pas    |   2 +-
     compiler/pexpr.pas      |  39 ++-
     5 files changed, 482 insertions(+), 437 deletions(-)
    
    diff --git a/compiler/msg/errore.msg b/compiler/msg/errore.msg
    index 0058444..ed30f73 100644
    --- a/compiler/msg/errore.msg
    +++ b/compiler/msg/errore.msg
    @@ -392,7 +392,7 @@ scan_w_setpeoptflags_not_support=02092_W_SETPEOPTFLAGS is not supported by the t
     #
     # Parser
     #
    -# 03333 is the last used one
    +# 03334 is the last used one
     #
     % \section{Parser messages}
     % This section lists all parser messages. The parser takes care of the
    @@ -1490,6 +1490,9 @@ parser_e_not_allowed_in_record=03332_E_Visibility section "$1" not allowed in re
     parser_e_proc_dir_not_allowed=03333_E_Procedure directive "$1" not allowed here
     % This procedure directive is not allowed in the given context. E.g. "static"
     % is not allowed for instance methods or class operators.
    +parser_e_proc_capture_not_allowed=03334_E_Anonymous procedure can not capture local variable "$1"
    +% Anonymous procedure currently can not use local variables of declaring subroutine.
    +%
     %
     %
     % \end{description}
    diff --git a/compiler/msgidx.inc b/compiler/msgidx.inc
    index ccc4bf2..e16a897 100644
    --- a/compiler/msgidx.inc
    +++ b/compiler/msgidx.inc
    @@ -429,6 +429,7 @@ const
       parser_e_no_class_in_local_anonymous_records=03331;
       parser_e_not_allowed_in_record=03332;
       parser_e_proc_dir_not_allowed=03333;
    +  parser_e_proc_capture_not_allowed=03334;
       type_e_mismatch=04000;
       type_e_incompatible_types=04001;
       type_e_not_equal_types=04002;
    @@ -973,9 +974,9 @@ const
       option_info=11024;
       option_help_pages=11025;
     
    -  MsgTxtSize = 68955;
    +  MsgTxtSize = 69019;
     
       MsgIdxMax : array[1..20] of longint=(
    -    26,93,334,121,88,56,126,27,202,63,
    +    26,93,335,121,88,56,126,27,202,63,
         54,20,1,1,1,1,1,1,1,1
       );
    diff --git a/compiler/msgtxt.inc b/compiler/msgtxt.inc
    index 8909dae..36396c0 100644
    --- a/compiler/msgtxt.inc
    +++ b/compiler/msgtxt.inc
    @@ -536,665 +536,670 @@ const msgtxt : array[0..000287,1..240] of char=(
       'us records'#000+
       '03332_E_Visibility section "$1" not allowed in records'#000+
       '03333_E_Procedure directive "$1" not allowed here'#000+
    +  '03334_E_Anonymous procedure can no','t capture local variable "$1"'#000+
       '04000_E_Type mismatch'#000+
    -  '04001_E_Inco','mpatible types: got "$1" expected "$2"'#000+
    +  '04001_E_Incompatible types: got "$1" expected "$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+
    -  '04006_E_Boolean expression expected, ','but got "$1"'#000+
    +  '04005_E_Integer express','ion 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+
       '04009_E_class type expected, but got "$1"'#000+
    -  '04011_E_Can'#039't evaluate constant expression'#000+
    +  '04011_E_Can'#039't evaluate constant expressio','n'#000+
       '04012_E_Set elements are not compatible'#000+
    -  '04013_E_Operation not ','implemented for sets'#000+
    +  '04013_E_Operation not implemented for sets'#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+
    -  '04017_E_succ or pred on enums',' with assignments not possible'#000+
    +  '04016_E_String types',' have to match exactly in $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+
       '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+
    +  '04020_E_Can'#039't use read or write on untyped f','ile.'#000+
       '04021_E_Type conflict between set elements'#000+
    -  '04022_W_lo/hi(dw','ord/qword) returns the upper/lower word/dword'#000+
    +  '04022_W_lo/hi(dword/qword) returns the upper/lower word/dword'#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+
    -  '04026_E_Method (variable) and Procedure',' (variable) are not compatibl'+
    -  'e'#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 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',' varia'+
    -  'ble'#000+
    +  '04029_E_Argument can'#039't be assign','ed to'#000+
    +  '04030_E_Can'#039't assign local procedure/function to procedure variabl'+
    +  'e'#000+
       '04031_E_Can'#039't assign values to an address'#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+
    +  '0403','5_H_Mixing signed expressions and longwords gives a 64bit result'+
    +  #000+
       '04036_W_Mixing signed expressions and cardinals here may cause a range'+
       ' 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+
    -  '04039_E_Class or Object types "$1" ','and "$2" are not related'#000+
    +  '04038_E_enums with assignments ','can'#039't be used as array index'#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+
       '04042_E_Type "$1" is not completely defined'#000+
    -  '04043_W_String literal has more characters than short string lengt','h'#000+
    +  '04','043_W_String literal has more characters than short string length'#000+
       '04044_W_Comparison might be always false due to range of constant and '+
       'expression'#000+
       '04045_W_Comparison might be always true due to range of constant and e'+
       'xpression'#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+
    +  '04046_W_Const','ructing a class "$1" with abstract method "$2"'#000+
    +  '04047_H_The left operand of the IN operator should be byte sized'#000+
       '04048_W_Type size mismatch, possible loss of data / range check error'#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 t','aken'#000+
    +  '04049_H_Type size mismatch, possible loss of data / range ','check erro'+
    +  'r'#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+
       '04052_E_Constant Expression expected'#000+
    -  '04053_E_Operation "$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_Conversio','n between ordinals and pointers is not portable'#000+
    +  '04055_H_Conversion between ordinals and pointers is not portable'#000+
       '04056_W_Conversion between ordinals and pointers is not portable'#000+
       '04057_E_Can'#039't determine which overloaded function to call'#000+
    -  '04058_E_Illegal counter variable'#000+
    -  '04059_W_Converting constant real val','ue to double for C variable argu'+
    -  'ment, add explicit typecast to prevent this.'#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 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)Pa'+
    -  'cked Array"'#000+
    +  '04061_E_Constant packed arrays are not y','et supported'#000+
    +  '04062_E_Incompatible type for arg no. $1: Got "$2" expected "(Bit)Pack'+
    +  'ed 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 t','o '+
    +  'be initialised'#000+
    +  '04065_E_Constant packed records and objects are not yet 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+
    -  '04077_E_Can'#039't export subroutine marked as local from a unit'#000+
    -  '04078_E_Type is no','t automatable: "$1"'#000+
    +  '04077_E_Can'#039't ','export subroutine marked as local from a unit'#000+
    +  '04078_E_Type is not automatable: "$1"'#000+
       '04079_H_Converting the operands to "$1" before doing the add could pre'+
       'vent overflow errors.'#000+
    -  '04080_H_Converting the operands to "$1" before doing the subtract coul'+
    -  'd prevent overflow errors.'#000+
    -  '04081_H_Converting the operands',' to "$1" before doing the multiply co'+
    +  '04080_H_Converting the operands to "$1" before doing the subtrac','t co'+
       'uld prevent overflow errors.'#000+
    +  '04081_H_Converting the operands to "$1" before doing the multiply coul'+
    +  'd 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 G','UID'#000+
    +  '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+
       '04085_E_Expected Objective-C method, but got $1'#000+
       '04086_E_Expected Objective-C method or constant method name'#000+
    -  '04087_E_No type info available for this type'#000+
    +  '04087_E_No type info availabl','e for this type'#000+
       '04088_E_Ordinal or string expression expected'#000+
    -  '04','089_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 Object'+
    -  'ive-C runtime.'#000+
    -  '04093_E_Class or objcclass type expec','ted, but got "$1"'#000+
    +  '04092_E_The type "$1" is not supported for interaction wit','h the Obje'+
    +  'ctive-C runtime.'#000+
    +  '04093_E_Class or objcclass type expected, but got "$1"'#000+
       '04094_E_Objcclass type expected'#000+
       '04095_W_Coerced univ parameter type in procedural variable may cause c'+
       'rash or memory corruption: $1 to $2'#000+
    -  '04096_E_Type parameters of specializations of generics cannot referenc'+
    -  'e the currentl','y specialized type'#000+
    +  '04096_E_Type paramet','ers of specializations of generics cannot refere'+
    +  'nce the currently specialized type'#000+
       '04097_E_Type parameters are not allowed on non-generic class/record/ob'+
       'ject procedure or function'#000+
    -  '04098_E_Generic declaration of "$1" differs from previous declaration'#000+
    +  '04098_E_Generic declaration of "$1" differs from previous de','claratio'+
    +  'n'#000+
       '04099_E_Helper type expected'#000+
    -  '04100_E_Record type expec','ted'#000+
    +  '04100_E_Record type expected'#000+
       '04101_E_Derived class helper must extend a subclass of "$1" or the cla'+
       'ss itself'#000+
       '04102_E_Derived record or type helper must extend "$1"'#000+
    -  '04103_E_Invalid assignment, procedures return no value'#000+
    -  '04104_W_Implicit string type conversion from "','$1" to "$2"'#000+
    +  '04103_E_Invalid assignment, procedure','s return no value'#000+
    +  '04104_W_Implicit string type conversion from "$1" to "$2"'#000+
       '04105_W_Implicit string type conversion with potential data loss from '+
       '"$1" to "$2"'#000+
       '04106_-W_Explicit string typecast from "$1" to "$2"'#000+
    -  '04107_-W_Explicit string typecast with potential data loss from "$1" t'+
    -  'o "$2"'#000+
    -  '04108_W_Unicode ','constant cast with potential data loss'#000+
    +  '04107_-W_Explicit string type','cast with potential data loss from "$1"'+
    +  ' to "$2"'#000+
    +  '04108_W_Unicode constant cast with potential data loss'#000+
       '04109_E_range check error while evaluating constants ($1 must be betwe'+
       'en $2 and $3)'#000+
    -  '04110_W_range check error while evaluating constants ($1 must be betwe'+
    -  'en $2 and $3)'#000+
    -  '04111_E_This type is not supporte','d for the Default() intrinsic'#000+
    +  '04110_W_range check error while evaluating constants ','($1 must be bet'+
    +  'ween $2 and $3)'#000+
    +  '04111_E_This type is not supported for the Default() intrinsic'#000+
       '04112_E_JVM virtual class methods cannot be static'#000+
       '04113_E_Final (class) fields can only be assigned in their class'#039' '+
       '(class) constructor'#000+
    -  '04114_E_It is not possible to typecast untyped parameters on managed p'+
    -  'lat','forms, simply assign a value to them instead.'#000+
    +  '04114_E_I','t is not possible to typecast untyped parameters on managed'+
    +  ' platforms, simply assign a value to them instead.'#000+
       '04115_E_The assignment side of an expression cannot be typecasted to a'+
       ' supertype on managed platforms'#000+
    -  '04116_-W_The interface method "$1" raises the visibility of "$2" to pu'+
    -  'blic when accessed via',' an interface instance'#000+
    +  '04116_-W_The interface metho','d "$1" raises the visibility of "$2" to '+
    +  'public when accessed via an interface instance'#000+
       '04117_E_The interface method "$1" has a higher visibility (public) tha'+
       'n "$2"'#000+
       '04118_E_TYPEOF can only be used on object types with VMT'#000+
    -  '04119_E_It is not possible to define a default value for a parameter o'+
    -  'f type "$1"'#000+
    -  '0','4120_E_Type "$1" cannot be extended by a type helper'#000+
    +  '04119_E_It is not p','ossible to define a default value for a parameter'+
    +  ' of type "$1"'#000+
    +  '04120_E_Type "$1" cannot be extended by a type helper'#000+
       '05000_E_Identifier not found "$1"'#000+
       '05001_F_Internal Error in SymTableStack()'#000+
       '05002_E_Duplicate identifier "$1"'#000+
    -  '05003_H_Identifier already defined in $1 at line $2'#000+
    -  '05004_E_Unknown identifie','r "$1"'#000+
    +  '05003_H_Ident','ifier already defined in $1 at line $2'#000+
    +  '05004_E_Unknown identifier "$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+
    -  '05012_F_record or class type expected'#000,
    +  '05010_E_Only static variables can be used in static m','ethods or outsi'+
    +  'de methods'#000+
    +  '05012_F_record or class type expected'#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+
    -  '05016_E_Illegal label declaration'#000+
    -  '05017_E_GOTO and LABEL are not supported (use switch -S','g)'#000+
    +  '05016_E_Illegal label dec','laration'#000+
    +  '05017_E_GOTO and LABEL are not supported (use switch -Sg)'#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+
    +  '05022_E_Forward class definition not ','resolved "$1"'#000+
       '05023_H_Unit "$1" not used in $2'#000+
    -  '05024_H_Parameter',' "$1" not used'#000+
    +  '05024_H_Parameter "$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+
    -  '05028_H_Local $1 "$2" is not used'#000+
    -  '05029_N_Private field "$1.$2" is 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+
       '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+
    -  '05034_W_Type "$1" is not aligned correctly in current record for C',#000+
    +  '05','034_W_Type "$1" is not aligned correctly in current record for C'#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+
    -  '05038_E_identifier idents no member "$1"'#000+
    +  '05038_E_identifi','er idents no member "$1"'#000+
       '05039_H_Found declaration: $1'#000+
    -  '05040_E_D','ata element too large'#000+
    +  '05040_E_Data element too large'#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+
    -  '05055_W_Symbol "$1" is not implemented'#000+
    -  '05056_E_Can'#039't create unique type from this',' type'#000+
    +  '05055_W_Symbol "$','1" is not implemented'#000+
    +  '05056_E_Can'#039't create unique type from this type'#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+
    -  '05060_H_Function result variable does not seem to be initi','alized'#000+
    +  '05059_W_Function result variable does not seem to initia','lized'#000+
    +  '05060_H_Function result variable does not seem to be initialized'#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 declaration "$1" not resolved, assu','med 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+
    -  '05069_E_Cannot find a "Current" property in enumerator "$1"'#000+
    -  '05070_E_Mismatch between number of d','eclared parameters and number of'+
    -  ' colons in message string.'#000+
    +  '05069_E_Cannot find a "Current" ','property in enumerator "$1"'#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+
    +  '05073_N_Private property "$1.$2" nev','er used'#000+
       '05074_W_Unit "$1" is deprecated'#000+
    -  '05075_W_Unit "$1" is dep','recated: "$2"'#000+
    +  '05075_W_Unit "$1" is deprecated: "$2"'#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+
    -  '05080_E_No complete definition of the formally declared class "$1" is '+
    -  'in scope'#000,
    +  '05080_E_No comp','lete definition of the formally declared class "$1" i'+
    +  's in scope'#000+
       '05081_E_Gotos into initialization or finalization blocks of units are '+
       'not allowed'#000+
       '05082_E_Invalid external name "$1" for formal class "$2"'#000+
    -  '05083_E_Complete class definition with external name "$1" here'#000+
    -  '05084_W_Possible library conflict: sym','bol "$1" from library "$2" als'+
    -  'o found in library "$3"'#000+
    +  '05083_E_Complete class definition wit','h external name "$1" here'#000+
    +  '05084_W_Possible library conflict: symbol "$1" from library "$2" also '+
    +  'found in library "$3"'#000+
       '05085_E_Cannot add implicit constructor '#039'Create'#039' because ident'+
       'ifier already used by "$1"'#000+
    -  '05086_E_Cannot generate default constructor for class, because parent '+
    -  'has no parameterless constr','uctor'#000+
    +  '05086_E_Cannot generate default c','onstructor for class, because paren'+
    +  't has no parameterless constructor'#000+
       '05087_D_Adding helper for $1'#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 ther','e'#000+
       '06015_E_EXPORT declared functions can'#039't be called'#000+
    -  '06016_W_Poss','ible illegal call of constructor or destructor'#000+
    +  '06016_W_Possible illegal call of constructor or destructor'#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 met','hods can'#039't be inline.'#000+
    +  '06031_E_Object or class methods can'#039't be inline.'#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+
    -  '06037_E_Constructors or destructors can','not be called inside a '#039'w'+
    -  'ith'#039' clause'#000+
    +  'sed,',' 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+
       '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+
    -  '06041_W_Parameters size exceeds lim','it for certain cpu'#039's'#000+
    +  '06040_E_Control flow statements aren'#039,'t allowed in a finally block'+
    +  #000+
    +  '06041_W_Parameters size exceeds limit 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+
    -  '06046_F_Unknown compilerproc "$1". Check if you use ','the correct run '+
    -  'time library.'#000+
    +  '06045_E_CONTINUE ','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 run'+
       ' time library.'#000+
       '06048_H_Inherited call to abstract method ignored'#000+
    -  '06049_E_Goto label "$1" not defined or optimized away'#000+
    -  '06050_F_Cannot find t','ype "$1" in unit "$2". Check if you use the cor'+
    -  'rect run time library.'#000+
    +  '06049_E_Got','o 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 time library.'#000+
       '06051_E_Interprocedural gotos are allowed only to outer subroutines'#000+
    -  '06052_E_Label must be defined in the same scope as it is declared'#000+
    -  '06053_E_Leaving procedures containin','g explicit or implicit exception'+
    -  's frames using goto is not allowed'#000+
    +  '06052_E_Label must be defined in the s','ame scope as it is declared'#000+
    +  '06053_E_Leaving procedures containing explicit or implicit exceptions '+
    +  'frames using goto is not allowed'#000+
       '06054_E_In ISO mode, the mod operator is defined only for positive quo'+
       'tient'#000+
       '06055_DL_Auto inlining: $1'#000+
    -  '07000_DL_Starting $1 styled assembler parsing'#000+
    -  '07001_DL_Finished $1 sty','led assembler parsing'#000+
    +  '07000_','DL_Starting $1 styled assembler parsing'#000+
    +  '07001_DL_Finished $1 styled assembler parsing'#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 without identifier'#000+
    -  '07007_E_Cannot use local variable or parameters here'#000+
    -  '07008_E_need to',' use OFFSET here'#000+
    +  '0700','7_E_Cannot use local variable or parameters here'#000+
    +  '07008_E_need to use OFFSET here'#000+
       '07009_E_need to use $ here'#000+
       '07010_E_Cannot use multiple relocatable symbols'#000+
       '07011_E_Relocatable symbol can only be added'#000+
       '07012_E_Invalid constant expression'#000+
    -  '07013_E_Relocatable symbol is not allowed'#000+
    -  '07014_E_Invalid reference',' syntax'#000+
    +  '070','13_E_Relocatable symbol is not allowed'#000+
    +  '07014_E_Invalid reference syntax'#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+
    -  '07018_W_Possible error in object field handling'#000+
    -  '07019_E_Wrong scale factor specified'#000,
    +  '07018_W_Possible erro','r in object field handling'#000+
    +  '07019_E_Wrong scale factor specified'#000+
       '07020_E_Multiple index register usage'#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 referen','ces are not allowed'#000+
       '07025_E_Divide by zero in asm evaluator'#000+
    -  '0702','6_E_Illegal expression'#000+
    +  '07026_E_Illegal expression'#000+
       '07027_E_escape 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+
    -  '07031_W_ENTER instruction is not supported by ','Linux kernel'#000+
    +  '07030_W_$1 without operand tr','anslated into $1P'#000+
    +  '07031_W_ENTER instruction is not supported by Linux kernel'#000+
       '07032_W_Calling an overload 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 b','inary $1'#000+
    +  '07037_E_Error converting binary $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 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+
    +  '07042_E','_Cannot use OLDEBP outside a nested procedure'#000+
    +  '07043_W_Procedures can'#039't return any value in asm code'#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 destination 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 com','bination of opcode and operands'#000+
    +  '07048_E_Invalid combination of opcode and operands'#000+
       '07049_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 pointer'#000+
    -  '07053_E_Unrecognize','d opcode $1'#000+
    +  '07052_W_constant with sym','bol $1 for address which is not on a pointe'+
    +  'r'#000+
    +  '07053_E_Unrecognized opcode $1'#000+
       '07054_E_Invalid or missing opcode'#000+
       '07055_E_Invalid combination of prefix and opcode: $1'#000+
       '07056_E_Invalid combination of override and opcode: $1'#000+
    -  '07057_E_Too many operands on line'#000+
    +  '07057_E_Too many opera','nds on line'#000+
       '07058_W_NEAR ignored'#000+
       '07059_W_FAR ignored'#000+
    -  '07060_E_Dup','licate local symbol $1'#000+
    +  '07060_E_Duplicate local symbol $1'#000+
       '07061_E_Undefined local symbol $1'#000+
       '07062_E_Unknown label identifier $1'#000+
       '07063_E_Invalid register name'#000+
       '07064_E_Invalid floating point register name'#000+
    -  '07066_W_Modulo not supported'#000+
    -  '07067_E_Invalid floating point constant $1'#000,
    +  '07066_W_','Modulo not supported'#000+
    +  '07067_E_Invalid floating point constant $1'#000+
       '07068_E_Invalid floating point expression'#000+
       '07069_E_Wrong symbol type'#000+
       '07070_E_Cannot index a local var or parameter with a register'#000+
       '07071_E_Invalid segment override expression'#000+
    -  '07072_W_Identifier $1 supposed external'#000+
    -  '07073_E_Strings not allowe','d as constants'#000+
    +  '07','072_W_Identifier $1 supposed external'#000+
    +  '07073_E_Strings not allowed as constants'#000+
       '07074_E_No type of variable specified'#000+
       '07075_E_assembler code not returned to text section'#000+
       '07076_E_Not a directive or local symbol $1'#000+
    -  '07077_E_Using a defined name as a local label'#000+
    -  '07078_E_Dollar token is used without an identi','fier'#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+
       '07080_N_.align is target specific, use .balign or .p2align'#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 op'+
    -  'erands'#000+
    +  '07082_E_Can'#039't acc','ess fields of objects/classes directly'#000+
    +  '07083_E_No size specified and unable to determine the size of the oper'+
    +  'ands'#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+
    -  '07088_W_"$1 %st(n)" translated int','o "$1 %st(n),%st"'#000+
    +  '07087_W_"$1 %st(n)" tr','anslated 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+
       '07090_E_Char > not allowed here'#000+
       '07093_W_ALIGN not supported'#000+
       '07094_E_Inc and Dec cannot be together'#000+
    -  '07095_E_Invalid reglist for movem'#000+
    +  '07095_E_Invalid reglist for',' movem'#000+
       '07096_E_Reglist invalid for opcode'#000+
    -  '07097_E_Higher cpu mod','e required ($1)'#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+
    +  '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+
    -  '07','101_W_No size specified and unable to determine the size of the op'+
    -  'erands, using BYTE as default'#000+
    +  '07101_W_No size specified and unable to determine the size of the oper'+
    +  'ands, 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 convention'+
    -  #000+
    -  '07104_W_Use of -','offset(%ebp) is not recommended for local variable a'+
    -  'ccess'#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+
       '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, a'+
    -  'nd "$1" is not virtual'#000+
    -  '07107_E_Gener','ating PIC, but reference is not PIC-safe'#000+
    +  '07106_E_VMTOffset must be used in combinat','ion with a virtual method,'+
    +  ' and "$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+
    -  '07110_W_@GOTPCREL is useless and potentially dangereous for local symb'+
    -  'ols'#000+
    -  '07111_W_Con','stant with general purpose segment register'#000+
    +  '07110_W_@GOTPCREL is ','useless and potentially dangereous for local sy'+
    +  'mbols'#000+
    +  '07111_W_Constant with general purpose segment register'#000+
       '07112_E_Invalid offset value for $1'#000+
       '07113_E_Invalid register for $1'#000+
    -  '07114_E_SEH directives are allowed only in pure assembler procedures'#000+
    -  '07115_E_Directive "$1" is not supported for the current tar','get'#000+
    +  '07114_E_SEH directives are allowed only in pure assembler proced','ures'+
    +  #000+
    +  '07115_E_Directive "$1" is not supported for the current target'#000+
       '07116_E_This function'#039's result location cannot be encoded directly'+
       ' in a single operand when "nostackframe" is used'#000+
    -  '07117_E_GOTPCREL references in Intel assembler syntax cannot contain a'+
    -  ' base or index register, and their offset must 0.'#000+
    -  '0','7118_E_The current target does not support GOTPCREL relocations'#000+
    +  '07117_E_GOTPCREL references in Intel assembler syntax can','not contain'+
    +  ' a base or index register, and their offset must 0.'#000+
    +  '07118_E_The current target does not support GOTPCREL relocations'#000+
       '07119_W_Exported/global symbols should accessed via the GOT'#000+
       '07120_W_Check size of memory operand "$1"'#000+
    -  '07121_W_Check size of memory operand "$1: memory-operand-size is $2 bi'+
    -  'ts, ','but expected [$3 bits]"'#000+
    +  '07121_W_Ch','eck size of memory operand "$1: memory-operand-size is $2 '+
    +  'bits, but expected [$3 bits]"'#000+
       '07122_W_Check size of memory operand "$1: memory-operand-size is $2 bi'+
       'ts, but expected [$3 bits + $4 byte offset]"'#000+
    -  '07123_W_Check "$1: offset of memory operand is negative "$2 byte"'#000+
    -  '07124_W_Check "$1: size of memory o','perand is empty, but es exists di'+
    -  'fferent definitions of the memory size =>> map to $2 (smallest option)'+
    -  '"'#000+
    +  '07123_W_Check "$1: offset of memory o','perand is negative "$2 byte"'#000+
    +  '07124_W_Check "$1: size of memory operand is empty, but es exists diff'+
    +  'erent definitions of the memory size =>> map to $2 (smallest option)"'#000+
       '07125_E_Invalid register used in memory reference expression: "$1"'#000+
    -  '08000_F_Too many assembler files'#000+
    -  '08001_F_Selected assembler output n','ot supported'#000+
    +  '0800','0_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+
       '08004_E_Allocating of data is only allowed in bss section'#000+
    -  '08005_F_No binary writer selected'#000+
    +  '08005_F_No binary writer selecte','d'#000+
       '08006_E_Asm: Opcode $1 not in table'#000+
    -  '08007_E_Asm: $1 invalid co','mbination of opcode and operands'#000+
    +  '08007_E_Asm: $1 invalid combination of opcode and operands'#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+
    -  '08012_E_Asm: Short jump is out of rang','e $1'#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+
       '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 he','re'#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+
       '08021_E_Asm: 64 Bit operands not supported'#000+
    -  '08022_E_Asm: AH,BH,CH or DH cannot be used in an instruction requiring'+
    -  ' REX prefix'#000+
    -  '08023_E_Missing .seh_endprol','ogue directive'#000+
    +  '08022_E_Asm: AH,BH,CH or DH cannot be used in ','an instruction requiri'+
    +  'ng REX prefix'#000+
    +  '08023_E_Missing .seh_endprologue directive'#000+
       '08024_E_Function prologue exceeds 255 bytes'#000+
       '08025_E_.seh_handlerdata directive without preceding .seh_handler'#000+
    -  '08026_F_Relocation count for section $1 exceeds 65535'#000+
    +  '08026_F_Relocation count for section $1 exceeds 655','35'#000+
       '09000_W_Source operating system redefined'#000+
    -  '09001_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 (error code: $2)'#000+
       '09004_E_Can'#039't create archive file: $1'#000+
    -  '09005_E_Assembler $1 not found, switching to external assembling'#000+
    +  '09005_E_Assembler $1 not found, sw','itching 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+
    -  '09010_I_Assembling with smartlinking $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+
       '09015_I_Linking $1'#000+
    -  '09016_E_Util $1 not found, switching to external linking'#000+
    +  '09016_E_Util $1 not found, switchin','g to external linking'#000+
       '09017_T_Using util $1'#000+
    -  '09018_E_Creation of ','Executables 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 m','ode'+
    +  #000+
       '09022_I_Compiling resource $1'#000+
    -  '09023_T_unit $1 can'#039't be stati','cally 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+
    +  'g'#000,
       '09026_E_unit $1 can'#039't be smart or static linked'#000+
    -  '09027_E_unit $1 ','can'#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+
    -  '09030_E_Can'#039't call the resource compiler "$1", switching to extern'+
    -  'al mode'#000+
    -  '09031_E_Can'#039't open resource ','file "$1"'#000+
    +  '09030_E_Can'#039't call the resource compil','er "$1", switching to exte'+
    +  'rnal mode'#000+
    +  '09031_E_Can'#039't open resource file "$1"'#000+
       '09032_E_Can'#039't write resource file "$1"'#000+
       '09033_N_File "$1" not found for backquoted cat command'#000+
       '09034_W_"$1" not found, this will probably cause a linking failure'#000+
    -  '09128_F_Can'#039't post process executable $1'#000+
    -  '09129_F_Can'#039't open executabl','e $1'#000+
    +  '09128','_F_Can'#039't post process 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+
       '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+
    +  '09134_X_Stack',' space committed: $1 bytes'#000+
    +  '09200_F_Executable image size is too big 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+
       '10002_U_PPU Name: $1'#000+
    -  '10003_U_PPU Flags: $1'#000+
    +  '10003_U_PPU F','lags: $1'#000+
       '10004_U_PPU Crc: $1'#000+
       '10005_U_PPU Time: $1'#000+
    -  '10006_U_PPU Fi','le too short'#000+
    +  '10006_U_PPU File 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 another processor'#000+
    -  '10010_U_PPU is compiled for another target'#000+
    +  '10010_U_PPU is compiled for another t','arget'#000+
       '10011_U_PPU Source: $1'#000+
       '10012_U_Writing $1'#000+
    -  '10013_F_Can'#039't Wr','ite PPU-File'#000+
    +  '10013_F_Can'#039't Write 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_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+
    +  '10','019_F_Too much units'#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 found but $2 exists'#000+
    -  '10024_F_Unit $1 searched but $2 found'#000+
    +  '10024_F_Unit $1 searched but $2 fou','nd'#000+
       '10025_W_Compiling the system unit requires the -Us switch'#000+
    -  '100','26_F_There were $1 errors compiling module, stopping'#000+
    +  '10026_F_There were $1 errors compiling module, stopping'#000+
       '10027_U_Load from $1 ($2) unit $3'#000+
       '10028_U_Recompiling $1, checksum changed for $2'#000+
    -  '10029_U_Recompiling $1, source found only'#000+
    +  '10029_U_Recompiling $1, source found only',#000+
       '10030_U_Recompiling unit, static lib is older than ppufile'#000+
    -  '1003','1_U_Recompiling unit, shared lib is older than ppufile'#000+
    +  '10031_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+
    -  '10034_U_Parsing interface of $1'#000+
    +  '10034_U_Pars','ing 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+
    -  '10041_U_File $1 is newer than the one used for creating PPU file $2'#000+
    -  '10042_U_Trying to use a unit which was compiled ','with a different FPU'+
    -  ' mode'#000+
    +  '10041_U_File $1 is newer than the one used for creat','ing PPU file $2'#000+
    +  '10042_U_Trying to use a unit which was compiled with a different FPU m'+
    +  '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+
    -  '10046_U_Implementation 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 depends 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+
       '10052_U_Forced reloading'#000+
    -  '10053_U_Previous state of $1: $2'#000+
    -  '10054_U_Already compiling $1, set','ting second compile'#000+
    +  '10','053_U_Previous state of $1: $2'#000+
    +  '10054_U_Already compiling $1, setting second compile'#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_Skipping re-resolving unit $1, still loading used units'#000+
    -  '10060_U_Unloading resource unit $1 (no','t needed)'#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 (object','s/classes) CRC changed for unit $1'+
    -  #000+
    +  'wpo feedback input file fo','r 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+
    -  '11002_W_DEF file can be created only for OS/2'#000+
    -  '11003_E_nested response ','files are not supported'#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+
       '11005_N_No option inside $1 config file'#000+
       '11006_E_Illegal parameter: $1'#000+
       '11007_H_-? writes help pages'#000+
    -  '11008_F_Too many config files nested'#000+
    +  '11008_F_T','oo 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} encou'+
    -  'ntered'#000+
    -  '11014_F_In options f','ile $1 at line $2 unexpected \var{\#ENDIFs} enco'+
    -  'untered'#000+
    +  '11013_F_In options file $1 at lin','e $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+
       '11015_F_Open conditional at the end of the options file'#000+
    -  '11016_W_Debug information generation is not supported by this executab'+
    -  'le'#000+
    +  '11016_W_Debug information generation is not supported by this ex','ecut'+
    +  'able'#000+
       '11017_H_Try recompiling with -dGDB'#000+
    -  '11018_W_You are usin','g the obsolete switch $1'#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+
    -  '11021_W_Assembler output selected "$1" is not compatible with "$2"'#000+
    -  '11022_W_"$1" assembler u','se forced'#000+
    +  '11021_W_Assembler output se','lected "$1" is not compatible with "$2"'#000+
    +  '11022_W_"$1" assembler use forced'#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+
    -  '11030_H_Start of reading config file $1'#000+
    +  '11030_H_Start of reading con','fig file $1'#000+
       '11031_H_End of reading config file $1'#000+
    -  '11032_D_interp','reting option "$1"'#000+
    +  '11032_D_interpreting 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 source file name "$1"'#000+
    -  '11039_E_Unknown codepage "$1"'#000+
    +  '11039_E','_Unknown codepage "$1"'#000+
       '11040_F_Config file $1 is a directory'#000+
    -  '110','41_W_Assembler output selected "$1" cannot generate debug info, d'+
    -  'ebugging disabled'#000+
    +  '11041_W_Assembler output selected "$1" cannot generate debug info, deb'+
    +  'ugging disabled'#000+
       '11042_W_Use of ppc386.cfg is deprecated, please use fpc.cfg instead'#000+
    -  '11043_F_In options file $1 at line $2 \var{\#ELSE} directive without \'+
    -  'var{\#IF(N)DEF} fou','nd'#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 targe'+
       't 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 ',
    -  'this target, switching to static linking'#000+
    +  '11046','_N_DWARF debug information cannot be used with smart linking on'+
    +  ' this target, switching to static linking'#000+
       '11047_W_Option "$1" is ignored for the current target platform.'#000+
       '11048_W_Disabling external debug information because it is unsupported'+
    -  ' for the selected target/debug format combination.'#000+
    -  '11049_N_DWARF ','debug information cannot be used with smart linking wi'+
    -  'th external assembler, disabling static library creation.'#000+
    -  '11050_E_Invalid value for MACOSX_DEPLOYMENT_TARGET environment variabl'+
    -  'e: $1'#000+
    -  '11051_E_Invalid value for IPHONEOS_DEPLOYMENT_TARGET',' environment var'+
    -  'iable: $1'#000+
    +  ' ','for the selected target/debug format combination.'#000+
    +  '11049_N_DWARF debug information cannot be used with smart linking with'+
    +  ' external assembler, disabling static library creation.'#000+
    +  '11050_E_Invalid value for MACOSX_DEPLOYMENT_TARGET environment v','aria'+
    +  'ble: $1'#000+
    +  '11051_E_Invalid value for IPHONEOS_DEPLOYMENT_TARGET environment varia'+
    +  'ble: $1'#000+
       '11052_E_You must use a FPU type of VFPV2, VFPV3 or VFPV3_D16 when usin'+
       'g the EABIHF ABI target'#000+
    -  '11053_W_The selected debug format is not supported on the current targ'+
    -  'et, not changing the current setting'#000+
    -  '12000_F_Canno','t open whole program optimization feedback file "$1"'#000+
    +  '11053_W_The selected debug format is not supported on th','e current ta'+
    +  'rget, not changing the current setting'#000+
    +  '12000_F_Cannot open whole program optimization 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 information'+
    -  ' in wpo feedback file "$1"'#000+
    -  '12003_','E_Expected section header, but got "$2" at line $1 of wpo feed'+
    -  'back file'#000+
    +  '12002_D_Finished processing the whole p','rogram 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+
       '12004_W_No handler registered for whole program optimization section "'+
    -  '$2" at line $1 of wpo feedback file, ignoring'#000+
    -  '12005_D_Found whole program optimization section "$1','" with informati'+
    -  'on about "$2"'#000+
    +  '$2" at line $1 of wpo feedback fil','e, 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_No collected information necessary to perform "$1" whole progr'+
    -  'am optimization found'#000+
    -  '120','08_F_Specify a whole program optimization feedback file to store '+
    -  'the generated info in (using -FW)'#000+
    +  '12007_E_No collected informatio','n 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 information, yet'+
    -  ' a feedback file was specified (using -FW)'#000+
    -  '12010_E_Not performing any w','hole program optimizations, yet an input'+
    -  ' feedback file was specified (using -Fw)'#000+
    +  ' a feed','back 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+
       '12011_D_Skipping whole program optimization section "$1", because not '+
    -  'needed by the requested optimizations'#000+
    -  '12012_W_Overriding previously read information for ','"$1" from feedbac'+
    -  'k input file using information in section "$2"'#000+
    +  'needed by the requested o','ptimizations'#000+
    +  '12012_W_Overriding previously read information for "$1" from feedback '+
    +  'input file using information in section "$2"'#000+
       '12013_E_Cannot extract symbol liveness information from program when s'+
       'tripping symbols, use -Xs-'#000+
    -  '12014_E_Cannot extract symbol liveness information from program when w'+
    -  'hen not l','inking'#000+
    +  '12014_E_Cannot ','extract symbol liveness information from program when'+
    +  ' when 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 information produced by "'+
       '$1"'#000+
    -  '12017_F_Error executing "$1" (exitcode: $2) to extract symbol infor','m'+
    +  '120','17_F_Error executing "$1" (exitcode: $2) to extract symbol inform'+
       'ation 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 specified whole program optimisation feedback fi'+
    -  'le "$1"'#000+
    -  '11023_Free Pascal Compiler versio','n $FPCFULLVERSION [$FPCDATE] for $F'+
    -  'PCCPU'#010+
    +  '12019_E_Cannot create specified whole program o','ptimisation feedback '+
    +  'file "$1"'#000+
    +  '11023_Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPC'+
    +  'CPU'#010+
       'Copyright (c) 1993-2013 by Florian Klaempfl and others'#000+
       '11024_Free Pascal Compiler version $FPCVERSION'#010+
       #010+
       'Compiler Date      : $FPCDATE'#010+
    -  'Compiler CPU Target: $FPCCPU'#010+
    +  'Co','mpiler CPU Target: $FPCCPU'#010+
       #010+
       'Supported targets:'#010+
       '  $OSTARGETS'#010+
       #010+
    -  'Sup','ported CPU instruction sets:'#010+
    +  'Supported CPU instruction sets:'#010+
       '  $INSTRUCTIONSETS'#010+
       #010+
       'Supported FPU instruction sets:'#010+
    @@ -1204,11 +1209,11 @@ const msgtxt : array[0..000287,1..240] of char=(
       '  $ABITARGETS'#010+
       #010+
       'Supported Optimizations:'#010+
    -  '  $OPTIMIZATIONS'#010+
    +  '  $OPTIMI','ZATIONS'#010+
       #010+
       'Supported Whole Program Optimizations:'#010+
       '  All'#010+
    -  '  $WPOPTIM','IZATIONS'#010+
    +  '  $WPOPTIMIZATIONS'#010+
       #010+
       'Supported Microcontroller types:'#010+
       '  $CONTROLLERTYPES'#010+
    @@ -1216,248 +1221,248 @@ const msgtxt : array[0..000287,1..240] of char=(
       'This program comes under the GNU General Public Licence'#010+
       'For more information read COPYING.v2'#010+
       #010+
    -  'Please report bugs in our bug tracker on:'#010+
    -  '                 http://bugs.freepascal.o','rg'#010+
    +  'Please report bugs ','in our bug tracker on:'#010+
    +  '                 http://bugs.freepascal.org'#010+
       #010+
       'More information may be found on our WWW pages (including directions'#010+
       'for mailing lists useful for asking questions or discussing potential'#010+
       'new features, etc.):'#010+
    -  '                 http://www.freepascal.org'#000+
    -  '11025_**0*_Put + after a boolean ','switch option to enable it, - to di'+
    -  'sable it'#010+
    +  '            ','     http://www.freepascal.org'#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 assembler file'#010+
       '**2al_List sourcecode lines in assembler file'#010+
    -  '**2an_List node info in assembler file (-dEXTDEBUG compiler)'#010+
    -  '*L2ap_Use pipes instead of ','creating temporary assembler files'#010+
    +  '**2an_List node info in ','assembler file (-dEXTDEBUG compiler)'#010+
    +  '*L2ap_Use pipes instead of creating temporary assembler files'#010+
       '**2ar_List register allocation/release info in assembler file'#010+
       '**2at_List temp allocation/release info in assembler file'#010+
    -  '**1A<x>_Output format:'#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*2Anasmwin32_Win32 object file using Nasm'#010+
    -  '3*2Anasmwdosx_Win32/WDOSX object file using Nasm'#010,
    +  '3*2Anasmwin32_Win32 object f','ile 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*2Atasm_Obj file using Tasm (Borland)'#010+
    -  '3*2Aelf_ELF (Linux) using internal writer'#010+
    +  '3*2Aelf_ELF (Linux) using ','internal writer'#010+
       '3*2Acoff_COFF (Go32v2) using internal writer'#010+
    -  '3*2','Apecoff_PE-COFF (Win32) using internal writer'#010+
    +  '3*2Apecoff_PE-COFF (Win32) using internal writer'#010+
       '4*2Aas_Assemble using GNU AS'#010+
       '4*2Agas_Assemble using GNU GAS'#010+
       '4*2Agas-darwin_Assemble darwin Mach-O64 using GNU GAS'#010+
    -  '4*2Amasm_Win64 object file using ml64 (Microsoft)'#010+
    -  '4*2Apecoff_PE-COFF (Win64) usi','ng internal writer'#010+
    +  '4*2Amasm_Win64 o','bject file using ml64 (Microsoft)'#010+
    +  '4*2Apecoff_PE-COFF (Win64) using internal writer'#010+
       '4*2Aelf_ELF (Linux-64bit) using internal writer'#010+
       '6*2Aas_Unix o-file using GNU AS'#010+
       '6*2Agas_GNU Motorola assembler'#010+
       '6*2Amit_MIT Syntax (old GAS)'#010+
    -  '6*2Amot_Standard Motorola assembler'#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_Build all modules'#010+
       '**1C<x>_Code generation options:'#010+
    -  '**2C3<x>_Turn on ieee error checking for constants'#010+
    -  '**2Ca<x>_Select ABI, see fpc -i',' for possible values'#010+
    +  '**2C3<x>_Turn on i','eee error checking for constants'#010+
    +  '**2Ca<x>_Select ABI, see fpc -i for possible values'#010+
       '**2Cb_Generate code for a big-endian variant of the target architectur'+
       'e'#010+
       '**2Cc<x>_Set default calling convention to <x>'#010+
    -  '**2CD_Create also dynamic library (not supported)'#010+
    -  '**2Ce_Compilation with emulated floating point opc','odes'#010+
    +  '**2CD_Create also dynamic library (n','ot supported)'#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+
       '**2CF<x>_Minimal floating point constant precision (default, 32, 64)'#010+
       '**2Cg_Generate PIC code'#010+
    -  '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+
    -  '**2Ci_IO-checki','ng'#010+
    +  '**2','Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+
    +  '**2Ci_IO-checking'#010+
       '**2Cn_Omit linking stage'#010+
       'P*2CN_Generate nil-pointer checks (AIX-only)'#010+
       '**2Co_Check overflow of integer operations'#010+
       '**2CO_Check for possible overflow of integer operations'#010+
    -  '**2Cp<x>_Select instruction set, see fpc -i for possible values'#010+
    -  '**2C','P<x>=<y>_ packing settings'#010+
    +  '**2C','p<x>_Select instruction set, see fpc -i for possible values'#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_Verify object method call validity'#010+
    -  '**2Cs<n>_Set stack checking size to <n>'#010+
    -  '**2Ct_Stack checking (for testing o','nly, see manual)'#010+
    +  '**2Cs<n>_Se','t stack checking size to <n>'#010+
    +  '**2Ct_Stack checking (for testing only, see manual)'#010+
       'p*2CT<x>_Target-specific code generation options'#010+
       'P*2CT<x>_Target-specific code generation options'#010+
       'J*2CT<x>_Target-specific code generation options'#010+
    -  'A*2CT<x>_Target-specific code generation options'#010+
    -  'p*3CTsmalltoc_ Generate sma','ller TOCs at the expense of execution spe'+
    -  'ed (AIX)'#010+
    +  'A*2CT<x>_Tar','get-specific code generation options'#010+
    +  'p*3CTsmalltoc_ Generate smaller TOCs at the expense of execution speed'+
    +  ' (AIX)'#010+
       'P*3CTsmalltoc_ Generate smaller TOCs at the expense of execution speed'+
       ' (AIX)'#010+
    -  'J*3CTcompactintarrayinit_ Generate smaller (but potentially slower) co'+
    -  'de for initializing integer array constants',#010+
    +  'J*3CTcompactintarrayinit_ Generate smaller (but p','otentially slower) '+
    +  'code for initializing integer array constants'#010+
       'J*3CTenumfieldinit_ Initialize enumeration fields in constructors to e'+
       'numtype(0), after calling inherited constructors'#010+
    -  'J*3CTautogetterprefix=X_ Automatically create getters for properties w'+
    -  'ith prefix X (empty string disables)'#010+
    -  'J*3CTautosett','erprefix=X_ Automatically create setters for properties'+
    +  'J*3CTautogetterprefix=X_ Automatically create getters fo','r properties'+
       ' with prefix X (empty string disables)'#010+
    +  'J*3CTautosetterprefix=X_ Automatically create setters for properties w'+
    +  'ith prefix X (empty string disables)'#010+
       'A*3CTthumbinterworking_ Generate Thumb interworking-safe code if possi'+
       'ble'#010+
    -  'J*2Cv_Var/out parameter copy-out checking'#010+
    -  '**2CX_Create also smartlinked ','library'#010+
    +  'J*2Cv_Va','r/out parameter copy-out checking'#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+
       '**2Dv<x>_Set DLL version to <x>'#010+
       '*O2Dw_PM application'#010+
    -  '**1e<x>_Set path to executable'#010+
    +  '**1e<x>_Set path to executa','ble'#010+
       '**1E_Same as -Cn'#010+
       '**1fPIC_Same as -Cg'#010+
    -  '**1F<x>_Set file names ','and paths:'#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+
       '**2Fc<x>_Set input codepage to <x>'#010+
       '**2FC<x>_Set RC compiler binary name to <x>'#010+
    -  '**2Fd_Disable the compiler'#039's internal directory cache'#010+
    -  '**2FD<x>_Set the direc','tory where to search for compiler utilities'#010+
    +  '**2Fd_Disabl','e 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+
       '**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+
    +  '**2F','i<x>_Add <x> to include path'#010+
       '**2Fl<x>_Add <x> to library path'#010+
    -  '**','2FL<x>_Use <x> as dynamic linker'#010+
    +  '**2FL<x>_Use <x> as dynamic linker'#010+
       '**2Fm<x>_Load unicode conversion table from <x>.txt in the compiler di'+
       'r'#010+
       '**2Fo<x>_Add <x> to object path'#010+
       '**2Fr<x>_Load error message file <x>'#010+
    -  '**2FR<x>_Set resource (.res) linker to <x>'#010+
    -  '**2Fu<x>_Add <x> to uni','t path'#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>_Load previously stored whole-program optimization feedback fr'+
    -  'om <x>'#010+
    -  '*g1g_Generate debug information (def','ault format for target)'#010+
    +  '**2Fw<x>_Load previously stored whole-program opt','imization feedback '+
    +  'from <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+
    -  '*g2gl_Use line info unit (show more info with backtraces)'#010+
    +  '*g2gl_Use line info unit (show more info with backtra','ces)'#010+
       '*g2go<x>_Set debug information options'#010+
    -  '*g3godwarfsets_ Enab','le DWARF '#039'set'#039' type debug information (b'+
    -  'reaks gdb < 6.5)'#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+
    -  '*g3godwarfmethodclassprefix_ Prefix method names in DWARF with class n'+
    -  'ame'#010+
    -  '*g2gp_Preserve case in stabs symbol na','mes'#010+
    +  '*g3godwarfmethodclassprefix_ Prefix method names',' in DWARF with class'+
    +  ' name'#010+
    +  '*g2gp_Preserve case in stabs symbol names'#010+
       '*g2gs_Generate Stabs debug information'#010+
       '*g2gt_Trash local variables (to detect uninitialized uses)'#010+
       '*g2gv_Generates programs traceable with Valgrind'#010+
    -  '*g2gw_Generate DWARFv2 debug information (same as -gw2)'#010+
    -  '*g2gw2_Generate DWARFv2 debug inf','ormation'#010+
    +  '*g2gw_Generate DWARFv2 de','bug information (same as -gw2)'#010+
    +  '*g2gw2_Generate DWARFv2 debug information'#010+
       '*g2gw3_Generate DWARFv3 debug information'#010+
       '*g2gw4_Generate DWARFv4 debug information (experimental)'#010+
       '**1i_Information'#010+
       '**2iD_Return compiler date'#010+
    -  '**2iV_Return short compiler version'#010+
    +  '**2iV_Return short compi','ler version'#010+
       '**2iW_Return full compiler version'#010+
    -  '**2iSO_Return com','piler OS'#010+
    +  '**2iSO_Return compiler OS'#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+
       '**1k<x>_Pass <x> to the linker'#010+
    -  '**1l_Write logo'#010+
    +  '**1l_Write ','logo'#010+
       '**1M<x>_Set language mode to <x>'#010+
    -  '**2Mfpc_Free Pascal dialec','t (default)'#010+
    +  '**2Mfpc_Free Pascal dialect (default)'#010+
       '**2Mobjfpc_FPC mode with Object Pascal support'#010+
       '**2Mdelphi_Delphi 7 compatibility mode'#010+
       '**2Mtp_TP/BP 7.0 compatibility mode'#010+
    -  '**2Mmacpas_Macintosh Pascal dialects compatibility mode'#010+
    +  '**2Mmacpas_Macintosh Pascal dialects compa','tibility mode'#010+
       '**1n_Do not read the default config files'#010+
    -  '**1o<x>_','Change the name of the executable produced to <x>'#010+
    +  '**1o<x>_Change the name of the executable produced to <x>'#010+
       '**1O<x>_Optimizations:'#010+
       '**2O-_Disable optimizations'#010+
       '**2O1_Level 1 optimizations (quick and debugger friendly)'#010+
    -  '**2O2_Level 2 optimizations (-O1 + quick optimizations)'#010+
    -  '**2O3_Level 3 optimizatio','ns (-O2 + slow optimizations)'#010+
    +  '**2O2_Level 2 opt','imizations (-O1 + quick optimizations)'#010+
    +  '**2O3_Level 3 optimizations (-O2 + slow optimizations)'#010+
       '**2O4_Level 4 optimizations (-O3 + optimizations which might have unex'+
       'pected side effects)'#010+
       '**2Oa<x>=<y>_Set alignment'#010+
    -  '**2Oo[NO]<x>_Enable or disable optimizations, see fpc -i for possible '+
    -  'values'#010+
    -  '**2Op<x>_Set ta','rget cpu for optimizing, see fpc -i for possible valu'+
    -  'es'#010+
    +  '**2Oo[NO]<x>_Enable or disab','le optimizations, see fpc -i for possibl'+
    +  'e values'#010+
    +  '**2Op<x>_Set target cpu for optimizing, see fpc -i for possible values'+
    +  #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 valu','es'#010+
    +  '**2Ow<x>_Perf','orm whole-program optimization <x>, see fpc -i for poss'+
    +  'ible values'#010+
       '**2Os_Optimize for size rather than speed'#010+
       '**1pg_Generate profile code for gprof (defines FPC_PROFILE)'#010+
       'F*1P<x>_Target CPU / compiler related options:'#010+
    -  'F*2PB_Show default compiler binary'#010+
    +  'F*2PB_Show default compi','ler binary'#010+
       'F*2PP_Show default target cpu'#010+
    -  'F*2P<x>_Set target CPU ','(arm,i386,m68k,mips,mipsel,powerpc,powerpc64,'+
    -  'sparc,x86_64'#010+
    +  'F*2P<x>_Set target CPU (arm,i386,m68k,mips,mipsel,powerpc,powerpc64,sp'+
    +  'arc,x86_64'#010+
       '**1R<x>_Assembler reading style:'#010+
       '**2Rdefault_Use default assembler for target'#010+
       '3*2Ratt_Read AT&T style assembler'#010+
    -  '3*2Rintel_Read Intel style assembler'#010+
    -  '6*2RMOT_Read motorola style assem','bler'#010+
    +  '3*2Rin','tel_Read Intel style assembler'#010+
    +  '6*2RMOT_Read motorola style assembler'#010+
       '**1S<x>_Syntax options:'#010+
       '**2S2_Same as -Mobjfpc'#010+
       '**2Sc_Support operators like C (*=,+=,/= and -=)'#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 af','ter the <n> errors (default is 1)'#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*_w : Compiler also halts after warnings'#010+
       '**3*_n : Compiler also halts after notes'#010+
       '**3*_h : Compiler also halts after hints'#010+
    -  '**2Sg_Enable LABEL and GOTO (default in -Mtp and -Mdelphi)'#010+
    -  '**2Sh_Use reference c','ounted strings (ansistring by default) instead '+
    -  'of shortstrings'#010+
    +  '**2Sg_Enable LAB','EL and GOTO (default in -Mtp and -Mdelphi)'#010+
    +  '**2Sh_Use reference counted strings (ansistring by default) instead of'+
    +  ' shortstrings'#010+
       '**2Si_Turn on inlining of procedures/functions declared as "inline"'#010+
       '**2Sk_Load fpcylix unit'#010+
    -  '**2SI<x>_Set interface style to <x>'#010+
    +  '**2SI<x>_Set interfac','e style to <x>'#010+
       '**3SIcom_COM compatible interface (default)'#010+
    -  '**3SI','corba_CORBA compatible interface'#010+
    +  '**3SIcorba_CORBA compatible interface'#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+
    -  '**2Sy_@<pointer> returns',' a typed pointer, same as $T+'#010+
    +  '**2Sx_Enable exception ke','ywords (default in Delphi/ObjFPC modes)'#010+
    +  '**2Sy_@<pointer> returns a typed pointer, same as $T+'#010+
       '**1s_Do not call assembler and linker'#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+
    +  '**2sr_Skip register allocation',' phase (use with -alr)'#010+
       '**1T<x>_Target operating system:'#010+
    -  '3*2Tdarw','in_Darwin/Mac OS X'#010+
    +  '3*2Tdarwin_Darwin/Mac OS X'#010+
       '3*2Temx_OS/2 via EMX (including EMX/RSX extender)'#010+
       '3*2Tfreebsd_FreeBSD'#010+
       '3*2Tgo32v2_Version 2 of DJ Delorie DOS extender'#010+
    -  '3*2Tiphonesim_ iPhoneSimulator from iOS SDK 3.2+ (older versions: -Tda'+
    -  'rwin)'#010+
    +  '3*2Tiphonesim_ iPhoneSimulator from iOS',' SDK 3.2+ (older versions: -T'+
    +  'darwin)'#010+
       '3*2Tlinux_Linux'#010+
    -  '3*2Tnativen','t_Native NT API (experimental)'#010+
    +  '3*2Tnativent_Native NT API (experimental)'#010+
       '3*2Tnetbsd_NetBSD'#010+
       '3*2Tnetware_Novell Netware Module (clib)'#010+
       '3*2Tnetwlibc_Novell Netware Module (libc)'#010+
       '3*2Topenbsd_OpenBSD'#010+
    -  '3*2Tos2_OS/2 / eComStation'#010+
    +  '3*2Tos2_OS/2 / eComStati','on'#010+
       '3*2Tsunos_SunOS/Solaris'#010+
       '3*2Tsymbian_Symbian OS'#010+
    -  '3*2Tsolaris_So','laris'#010+
    +  '3*2Tsolaris_Solaris'#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*2Tdarwin_Darwin/Mac OS X'#010+
       '4*2Tlinux_Linux'#010+
    -  '4*2Twin64_Win64 (64 bit Windows systems)'#010+
    +  '4*2Twin64_','Win64 (64 bit Windows systems)'#010+
       '6*2Tamiga_Commodore Amiga'#010+
    -  '6*2Tata','ri_Atari ST/STe/TT'#010+
    +  '6*2Tatari_Atari ST/STe/TT'#010+
       '6*2Tlinux_Linux'#010+
       '6*2Tpalmos_PalmOS'#010+
       'A*2Tdarwin_Darwin/iPhoneOS/iOS'#010+
    @@ -1465,120 +1470,121 @@ const msgtxt : array[0..000287,1..240] of char=(
       'A*2Twince_Windows CE'#010+
       'P*2Tamiga_AmigaOS'#010+
       'P*2Tdarwin_Darwin/Mac OS X'#010+
    -  'P*2Tlinux_Linux'#010+
    +  'P*2Tlinux_','Linux'#010+
       'P*2Tmacos_Mac OS (classic)'#010+
       'P*2Tmorphos_MorphOS'#010+
    -  'S*2Tsolaris','_Solaris'#010+
    +  'S*2Tsolaris_Solaris'#010+
       'S*2Tlinux_Linux'#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 release unit files (nev','er 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*_n : Show notes                  t : Show tried/us','ed files'#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*_i : Show general info           d : Show debug info'#010+
    -  '**2*_l : Show linenumbers            r : Rhide/GCC compatibility mode'#010+
    -  '**2*_s : Show time stamps            q : Show',' message numbers'#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 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 debugging info'#010+
    +  '**2*_    with ful','l path              v : Write fpcdebug.txt with'#010+
    +  '**2*_                                    lots of debugging info'#010+
       '**2*_m<x>,<y> : Don'#039't show messages numbered <x> and <y>'#010+
       'F*1V<x>_Append '#039'-<x>'#039' to the used compiler binary name (e.g. f'+
    -  'or version)'#010+
    +  'or versio','n)'#010+
       '**1W<x>_Target-specific options (targets)'#010+
    -  '3*2WA_Specify nativ','e type application (Windows)'#010+
    +  '3*2WA_Specify native type application (Windows)'#010+
       '4*2WA_Specify native type application (Windows)'#010+
       'A*2WA_Specify native type application (Windows)'#010+
    -  '3*2Wb_Create 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_Creat','e a bundle instead of a library (Darwin)'#010+
    +  'p*2Wb_Create a bundle instead of a library (Darwin)'#010+
       'A*2Wb_Create a bundle instead of a library (Darwin)'#010+
       '4*2Wb_Create a bundle instead of a library (Darwin)'#010+
    -  '3*2WB_Create a relocatable image (Windows, Symbian)'#010+
    -  '3*2WBxxxx_Set image base to xxxx (Windows, ','Symbian)'#010+
    +  '3*2WB_Create a relocatable imag','e (Windows, Symbian)'#010+
    +  '3*2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+
       '4*2WB_Create a relocatable image (Windows)'#010+
       '4*2WBxxxx_Set image base to xxxx (Windows)'#010+
       'A*2WB_Create a relocatable image (Windows, Symbian)'#010+
    -  'A*2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+
    -  '3*2WC_Specify console type application (E','MX, OS/2, Windows)'#010+
    +  'A*2WBxxxx_Set image base to x','xxx (Windows, Symbian)'#010+
    +  '3*2WC_Specify console type application (EMX, OS/2, Windows)'#010+
       '4*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+
    -  '3*2WD_Use DEFFILE to export functions of DLL or EXE (Win','dows)'#010+
    +  'P*2WC_Specify console type application (Classic ','Mac OS)'#010+
    +  '3*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
       '4*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+
    -  'A*2We_Use external resources (Darw','in)'#010+
    +  '4*2We_Us','e external resources (Darwin)'#010+
    +  'A*2We_Use external resources (Darwin)'#010+
       'P*2We_Use external resources (Darwin)'#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+
    -  '4*2WG_Specify graphic type application (EMX, ','OS/2, Windows)'#010+
    +  '3*2WG_Specify graphic type application (E','MX, OS/2, Windows)'#010+
    +  '4*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 internal resources (Darwin)'#010+
    -  '4*2Wi_Use internal resources (Darwin)'#010+
    +  '4*2Wi_Use internal',' resources (Darwin)'#010+
       'A*2Wi_Use internal resources (Darwin)'#010+
    -  'P*2Wi_','Use internal resources (Darwin)'#010+
    +  'P*2Wi_Use internal resources (Darwin)'#010+
       'p*2Wi_Use internal resources (Darwin)'#010+
       '3*2WI_Turn on/off the usage of import sections (Windows)'#010+
    -  '4*2WI_Turn on/off the usage of import sections (Windows)'#010+
    -  'A*2WI_Turn on/off the usage of import sections (Windows)',#010+
    +  '4*2WI_Turn on/off the usage of import sections (W','indows)'#010+
    +  'A*2WI_Turn on/off the usage of import sections (Windows)'#010+
       '8*2Wm<x>_Set memory model'#010+
       '8*3WmTiny_Tiny memory model'#010+
       '8*3WmSmall_Small memory model (default)'#010+
       '3*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
       'n)'#010+
    -  '4*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
    -  'n)',#010+
    +  '4*2WM<x>','_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Dar'+
    +  'win)'#010+
       'p*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
       'n)'#010+
       'P*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
       'n)'#010+
    -  '3*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
    -  '4*2WN_Do not generate r','elocation code, needed for debugging (Windows'+
    +  '3*2WN_Do not generate relocat','ion code, needed for debugging (Windows'+
       ')'#010+
    +  '4*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
       'A*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
    -  'A*2Wpxxxx_Specify the controller type, see fpc -i for possible values'#010+
    -  'V*2Wpxxxx_Specify the controller type, see fpc -i for',' possible value'+
    +  'A*2Wpxxxx_Specify the controller type, see fpc -i for possi','ble value'+
       's'#010+
    +  'V*2Wpxxxx_Specify the controller type, see fpc -i for possible values'#010+
       '3*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ... (iphonesim)'#010+
       'A*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ... (Darwin)'#010+
    -  '3*2WR_Generate relocation code (Windows)'#010+
    +  '3*2WR_Generate relocatio','n code (Windows)'#010+
       '4*2WR_Generate relocation code (Windows)'#010+
    -  'A*2WR_','Generate relocation code (Windows)'#010+
    +  'A*2WR_Generate relocation code (Windows)'#010+
       'P*2WT_Specify MPW tool type application (Classic Mac OS)'#010+
       '**2WX_Enable executable stack (Linux)'#010+
       '**1X_Executable options:'#010+
    -  '**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Lin'+
    -  'ux)'#010+
    -  '**2Xd_Do no','t search default library path (sometimes required for cro'+
    -  'ss-compiling when not using -XR)'#010+
    +  '**2Xc_Pass --shared/-','dynamic to the linker (BeOS, Darwin, FreeBSD, L'+
    +  'inux)'#010+
    +  '**2Xd_Do not search default library path (sometimes required for cross'+
    +  '-compiling when not using -XR)'#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+
    +  '**2Xg_Create debuginfo in a separate file and add a debuglin','k sectio'+
    +  'n to executable'#010+
    +  '**2XD_Try to link units dynamically      (defines FPC_LINK_DYNAMIC)'#010+
       '**2Xi_Use internal linker'#010+
       '**2Xm_Generate link map'#010+
       '**2XM<x>_Set the name of the '#039'main'#039' program routine (default i'+
       's '#039'main'#039')'#010+
    -  'F*2Xp<x>_First search for the compiler binary in the directory <x>'#010+
    -  '**2XP<x>_Prepend the bi','nutils names with the prefix <x>'#010+
    +  'F*2Xp<x>_First search for ','the compiler binary in the directory <x>'#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, FreeBSD'+
    -  ', Linux, Mac',' OS, Solaris)'#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+
       '**2XS_Try to link units statically (default, defines FPC_LINK_STATIC)'#010+
    -  '**2Xt_Link with static libraries (-static is passed to linker)'#010+
    -  '**2XX_Try to smartlink units             (defines FPC','_LINK_SMART)'#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'
    diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
    index 91310ca..0d8f228 100644
    --- a/compiler/pdecsub.pas
    +++ b/compiler/pdecsub.pas
    @@ -965,7 +965,7 @@ implementation
                 symtablestack.top.insert(aprocsym);
               end;
     
    -        if procparsemode=ppm_anonymous_routine then
    +        if procparsemode in [ppm_anonymous_routine,ppm_method_reference] then
               begin
                 pd:=tprocdef.create(normal_function_level);
                 include(pd.procoptions,po_anonymous);
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index c05c103..2149c4f 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -2403,6 +2403,32 @@ implementation
                  result:=false;
                end;
     
    +         function is_captured(sym: tsym):boolean;
    +           var
    +             st : TSymtable;
    +             found : boolean;
    +             proccnt : integer;
    +             checkstack : psymtablestackitem = nil;
    +           begin
    +             if not assigned(current_procinfo) or
    +                not (sym.typ in [localvarsym,paravarsym]) then
    +               exit(false);
    +             checkstack:=symtablestack.stack;
    +             result:=true;
    +             found:=false;
    +             proccnt:=0; { TODO: find less tricky way }
    +             while not found and assigned(checkstack) do
    +               begin
    +                 st:=checkstack^.symtable;
    +                 if st.symtablelevel=normal_function_level then
    +                   inc(proccnt);
    +                 if sym.owner=st then
    +                   found:=true;
    +                 checkstack:=checkstack^.next;
    +               end;
    +             result:=(proccnt>2); // each procedure have 2 symtables
    +           end;
    +
              var
                srsym : tsym;
                srsymtable : TSymtable;
    @@ -2581,8 +2607,17 @@ implementation
                               p1:=csubscriptnode.create(srsym,p1);
                           end
                         else
    -                      { regular non-field load }
    -                      p1:=cloadnode.create(srsym,srsymtable);
    +                      begin
    +                        { regular non-field load }
    +                        if not is_captured(srsym) then
    +                          p1:=cloadnode.create(srsym,srsymtable)
    +                        else
    +                          begin
    +                            { Capture of local variables is forbidden. Will be supported with closures. }
    +                            message1(parser_e_proc_capture_not_allowed,srsym.realname);
    +                            p1:=cerrornode.create;
    +                          end;
    +                      end;
                       end;
     
                     syssym :
    -- 
    1.8.1.2
    
    
    From d2191f274443853b20ceabc98a187b5c84de2a74 Mon Sep 17 00:00:00 2001
    From: Vasiliy Kevroletin <kevroletin@gmail.com>
    Date: Mon, 3 Jun 2013 00:09:59 +1100
    Subject: [PATCH 3/4] Add modeswitch m_anonymous_proc.
    
    Restrict usage of anonymous functions by new modeswitch. Currently disabled for all modes.
    ---
     compiler/globtype.pas |  6 ++++--
     compiler/pexpr.pas    | 19 ++++++++++---------
     compiler/ptype.pas    |  2 +-
     3 files changed, 15 insertions(+), 12 deletions(-)
    
    diff --git a/compiler/globtype.pas b/compiler/globtype.pas
    index 570bb89..289cabe 100644
    --- a/compiler/globtype.pas
    +++ b/compiler/globtype.pas
    @@ -372,8 +372,9 @@ interface
              m_final_fields,        { allows declaring fields as "final", which means they must be initialised
                                       in the (class) constructor and are constant from then on (same as final
                                       fields in Java) }
    -         m_default_unicodestring { makes the default string type in $h+ mode unicodestring rather than
    +         m_default_unicodestring,{ makes the default string type in $h+ mode unicodestring rather than
                                        ansistring; similarly, char becomes unicodechar rather than ansichar }
    +         m_anonymous_procedure  { support anonymous functions }
            );
            tmodeswitches = set of tmodeswitch;
     
    @@ -536,7 +537,8 @@ interface
              'ISOUNARYMINUS',
              'SYSTEMCODEPAGE',
              'FINALFIELDS',
    -         'UNICODESTRINGS');
    +         'UNICODESTRINGS',
    +         'ANONYMOUSPROC');
     
     
          type
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index 2149c4f..6d49f0d 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -2410,7 +2410,8 @@ implementation
                  proccnt : integer;
                  checkstack : psymtablestackitem = nil;
                begin
    -             if not assigned(current_procinfo) or
    +             if not (m_anonymous_procedure in current_settings.modeswitches) or
    +                not assigned(current_procinfo) or
                     not (sym.typ in [localvarsym,paravarsym]) then
                    exit(false);
                  checkstack:=symtablestack.stack;
    @@ -3348,14 +3349,14 @@ implementation
                    consume(_RKLAMMER);
                    p1:=cinlinenode.create(in_objc_protocol_x,false,p1);
                  end;
    -
    -             // anonymous routine
    -             _PROCEDURE, _FUNCTION:
    -               if assigned(current_procinfo) then
    -                 p1:=parse_anonymous_routine(current_procinfo.procdef)
    -               else // TODO: support this later? Delphi doesn't
    -                 internalerror(20120121);
    -
    +           else
    +             if (token in [_PROCEDURE, _FUNCTION]) and
    +                (m_anonymous_procedure in current_settings.modeswitches) then
    +                begin
    +                  if not assigned(current_procinfo) then
    +                    internalerror(20120121);
    +                  p1:=parse_anonymous_routine(current_procinfo.procdef);
    +                end
                  else
                    begin
                      Message(parser_e_illegal_expression);
    diff --git a/compiler/ptype.pas b/compiler/ptype.pas
    index 70ee34b..3063173 100644
    --- a/compiler/ptype.pas
    +++ b/compiler/ptype.pas
    @@ -1685,7 +1685,7 @@ implementation
                  else
                    expr_type;
                _ID:
    -             if idtoken=_REFERENCE then
    +             if (idtoken=_REFERENCE) and (m_anonymous_procedure in current_settings.modeswitches) then
                    begin
                      consume(_REFERENCE); consume(_TO);
                      def:=procvar_dec(genericdef,genericlist);
    -- 
    1.8.1.2
    
    
    From 3439479a530c756d46112a0dbca01f1616e464bc Mon Sep 17 00:00:00 2001
    From: Vasiliy Kevroletin <kevroletin@gmail.com>
    Date: Fri, 31 May 2013 02:24:17 +1100
    Subject: [PATCH 4/4] Add tests for anonymous functions.
    
    Tests cover
    + basic usage of anonymous function
    + access of free variables *which is currently fail*(variables which are used in body but not parameters and not declared inside this function).
    + use of modeswitch
    + initialization of procvar in "var" section
    + test for ppu loading (anonymous function declared inside inline function)
    ---
     tests/test/tanonymproc1.pp   | 46 +++++++++++++++++++++++++++++
     tests/test/tanonymproc10.pp  | 30 +++++++++++++++++++
     tests/test/tanonymproc11.pp  | 22 ++++++++++++++
     tests/test/tanonymproc12.pp  | 22 ++++++++++++++
     tests/test/tanonymproc2.pp   | 70 ++++++++++++++++++++++++++++++++++++++++++++
     tests/test/tanonymproc3.pp   | 49 +++++++++++++++++++++++++++++++
     tests/test/tanonymproc4.pp   | 49 +++++++++++++++++++++++++++++++
     tests/test/tanonymproc5.pp   | 51 ++++++++++++++++++++++++++++++++
     tests/test/tanonymproc6.pp   | 31 ++++++++++++++++++++
     tests/test/tanonymproc7.pp   | 25 ++++++++++++++++
     tests/test/tanonymproc8.pp   | 19 ++++++++++++
     tests/test/tanonymproc9.pp   | 21 +++++++++++++
     tests/test/tfanonymproc1.pp  | 14 +++++++++
     tests/test/tfanonymproc10.pp |  9 ++++++
     tests/test/tfanonymproc11.pp | 19 ++++++++++++
     tests/test/tfanonymproc2.pp  | 14 +++++++++
     tests/test/tfanonymproc3.pp  | 14 +++++++++
     tests/test/tfanonymproc4.pp  | 15 ++++++++++
     tests/test/tfanonymproc5.pp  | 15 ++++++++++
     tests/test/tfanonymproc6.pp  | 13 ++++++++
     tests/test/tfanonymproc7.pp  | 12 ++++++++
     tests/test/tfanonymproc8.pp  | 25 ++++++++++++++++
     tests/test/tfanonymproc9.pp  | 25 ++++++++++++++++
     tests/test/uanonymproc1.pp   | 26 ++++++++++++++++
     24 files changed, 636 insertions(+)
     create mode 100644 tests/test/tanonymproc1.pp
     create mode 100644 tests/test/tanonymproc10.pp
     create mode 100644 tests/test/tanonymproc11.pp
     create mode 100644 tests/test/tanonymproc12.pp
     create mode 100644 tests/test/tanonymproc2.pp
     create mode 100644 tests/test/tanonymproc3.pp
     create mode 100644 tests/test/tanonymproc4.pp
     create mode 100644 tests/test/tanonymproc5.pp
     create mode 100644 tests/test/tanonymproc6.pp
     create mode 100644 tests/test/tanonymproc7.pp
     create mode 100644 tests/test/tanonymproc8.pp
     create mode 100644 tests/test/tanonymproc9.pp
     create mode 100644 tests/test/tfanonymproc1.pp
     create mode 100644 tests/test/tfanonymproc10.pp
     create mode 100644 tests/test/tfanonymproc11.pp
     create mode 100644 tests/test/tfanonymproc2.pp
     create mode 100644 tests/test/tfanonymproc3.pp
     create mode 100644 tests/test/tfanonymproc4.pp
     create mode 100644 tests/test/tfanonymproc5.pp
     create mode 100644 tests/test/tfanonymproc6.pp
     create mode 100644 tests/test/tfanonymproc7.pp
     create mode 100644 tests/test/tfanonymproc8.pp
     create mode 100644 tests/test/tfanonymproc9.pp
     create mode 100644 tests/test/uanonymproc1.pp
    
    diff --git a/tests/test/tanonymproc1.pp b/tests/test/tanonymproc1.pp
    new file mode 100644
    index 0000000..d6b55e6
    --- /dev/null
    +++ b/tests/test/tanonymproc1.pp
    @@ -0,0 +1,46 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ simple anonymous procedure without parameters }
    +
    +const
    +  magic:integer = 1234567890;
    +var
    +  g_result:integer;
    +
    +procedure clean_res;
    +  begin
    +    g_result:=0;
    +  end;
    +
    +procedure set_res;
    +  begin
    +    g_result:=magic;
    +  end;
    +
    +procedure check_res(num:integer);
    +  begin
    +    if g_result<>num then Halt(1);
    +  end;
    +
    +type
    +  tproc=reference to procedure;
    +  
    +var
    +  p:tproc;
    +
    +begin
    +  clean_res;
    +  p:=procedure
    +       begin
    +         set_res;
    +       end;
    +  check_res(0);
    +  
    +  clean_res;
    +  p();
    +  check_res(magic);
    +  
    +  clean_res;
    +  p;
    +  check_res(magic);
    +end.
    diff --git a/tests/test/tanonymproc10.pp b/tests/test/tanonymproc10.pp
    new file mode 100644
    index 0000000..5a6a394
    --- /dev/null
    +++ b/tests/test/tanonymproc10.pp
    @@ -0,0 +1,30 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ initialization of procvar in declaration }
    +
    +uses uanonymproc1;
    +
    +var
    +  ok:boolean=false;  
    +  i:reference to procedure(i:boolean) = procedure(val:boolean)
    +                                          begin
    +                                            ok:=val;
    +                                          end;
    +
    +procedure do_smth;
    +  var
    +    i:reference to procedure(i:boolean) = procedure(val:boolean)
    +                                            begin
    +                                              ok:=val;
    +                                            end;
    +  begin
    +    i(true);
    +    if not ok then halt(1);
    +  end;
    +  
    +begin
    +  i(true);
    +  if not ok then halt(1);
    +  do_smth;
    +  do_smth_inline;
    +end.
    diff --git a/tests/test/tanonymproc11.pp b/tests/test/tanonymproc11.pp
    new file mode 100644
    index 0000000..e66e96d
    --- /dev/null
    +++ b/tests/test/tanonymproc11.pp
    @@ -0,0 +1,22 @@
    +{$mode delphi}
    +{$modeswitch anonymousproc}
    +
    +const
    +  magic:integer=314159265;
    +
    +type
    +  myproc<T> = reference to procedure(num: T);
    +
    +var
    +  p:myproc<Integer>;
    +  res:integer;
    +
    +begin
    +  p:=procedure(num: Integer)
    +       begin
    +         res:=num;
    +       end;
    +  res:=0;
    +  p(magic);
    +  if res<>magic then halt(1);
    +end.
    diff --git a/tests/test/tanonymproc12.pp b/tests/test/tanonymproc12.pp
    new file mode 100644
    index 0000000..3f2f97b
    --- /dev/null
    +++ b/tests/test/tanonymproc12.pp
    @@ -0,0 +1,22 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +
    +const
    +  magic:integer=314159265;
    +
    +type
    +  generic myproc<T> = reference to procedure(num: T);
    +
    +var
    +  p:specialize myproc<Integer>;
    +  res:integer;
    +
    +begin
    +  p:=procedure(num: Integer)
    +       begin
    +         res:=num;
    +       end;
    +  res:=0;
    +  p(magic);
    +  if res<>magic then halt(1);
    +end.
    diff --git a/tests/test/tanonymproc2.pp b/tests/test/tanonymproc2.pp
    new file mode 100644
    index 0000000..998b77d
    --- /dev/null
    +++ b/tests/test/tanonymproc2.pp
    @@ -0,0 +1,70 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ simple anonymous procedure without parameters in nested function }
    +
    +const
    +  magic:integer = 1234567890;
    +var
    +  g_result:integer;
    +
    +procedure clean_res;
    +  begin
    +    g_result:=0;
    +  end;
    +
    +procedure set_res;
    +  begin
    +    g_result:=magic;
    +  end;
    +
    +procedure check_res(num:integer);
    +  begin
    +    if g_result<>num then halt(1);
    +  end;
    +
    +type
    +  tproc=reference to procedure;
    +  
    +procedure do_smth;  
    +  procedure nested_do_smth;
    +    var p:tproc;
    +    begin
    +      clean_res;
    +      p:=procedure
    +           begin
    +             set_res;
    +           end;
    +      check_res(0);
    +  
    +      clean_res;
    +      p();
    +      check_res(magic);
    +  
    +      clean_res;
    +      p;
    +      check_res(magic);
    +     end;
    +  var
    +    p: TProc;
    +  begin
    +    clean_res;
    +    p:=procedure
    +         begin
    +           set_res;
    +         end;
    +    check_res(0);
    +  
    +    clean_res;
    +    p();
    +    check_res(magic);
    +  
    +    clean_res;
    +    p;
    +    check_res(magic);
    +    
    +    nested_do_smth;
    +  end;
    +
    +begin
    +  do_smth;
    +end.
    diff --git a/tests/test/tanonymproc3.pp b/tests/test/tanonymproc3.pp
    new file mode 100644
    index 0000000..f8290b5
    --- /dev/null
    +++ b/tests/test/tanonymproc3.pp
    @@ -0,0 +1,49 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ pointer to anonymous procedure returned from function }
    +
    +const
    +  magic:integer = 1234567890;
    +var
    +  g_result:integer;
    +
    +procedure clean_res;
    +  begin
    +    g_result:=0;
    +  end;
    +
    +procedure set_res;
    +  begin
    +    g_result:=magic;
    +  end;
    +
    +procedure check_res(num:integer);
    +  begin
    +    if g_result<>num then halt(1);
    +  end;
    +
    +type
    +  tproc=reference to procedure;
    +  
    +function factory:tproc;
    +  begin
    +    result:=procedure
    +              begin
    +                set_res;
    +              end;
    +  end;
    +  
    +procedure do_things;  
    +  var
    +    p: TProc;
    +  begin
    +    clean_res;
    +    p:=factory;
    +    check_res(0);
    +    p();
    +    check_res(magic);    
    +  end;
    +  
    +begin
    +  do_things;
    +end.
    diff --git a/tests/test/tanonymproc4.pp b/tests/test/tanonymproc4.pp
    new file mode 100644
    index 0000000..8167a08
    --- /dev/null
    +++ b/tests/test/tanonymproc4.pp
    @@ -0,0 +1,49 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ anonymous procedure with parameters }
    +
    +const
    +  magic:integer=1234567890;
    +  magicstr:string='hello world';
    +
    +var
    +  g_res_num:integer;
    +  g_res_str:string;
    +
    +procedure clean_res;
    +  begin
    +    g_res_num:=0;
    +    g_res_str:='';
    +  end;
    +
    +procedure set_res;
    +  begin
    +    g_res_num:=magic;
    +    g_res_str:=magicstr;
    +  end;
    +
    +procedure check_res(num:integer;str:string);
    +  begin
    +    if g_res_num<>num then halt(1);
    +    if g_res_str<>str then halt(1);
    +  end;
    +
    +type
    +  tproc=reference to procedure(num:integer;str:string);
    +  
    +var
    +  p:tproc;
    +
    +begin
    +  clean_res;
    +  p:=procedure(num:integer;s:string)
    +       begin
    +         g_res_num:=num;
    +         g_res_str:=s;
    +       end;
    +  check_res(0, '');
    +  
    +  clean_res;
    +  p(magic, magicstr);
    +  check_res(magic, magicstr); 
    +end.
    diff --git a/tests/test/tanonymproc5.pp b/tests/test/tanonymproc5.pp
    new file mode 100644
    index 0000000..6755c95
    --- /dev/null
    +++ b/tests/test/tanonymproc5.pp
    @@ -0,0 +1,51 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ anonymous function }
    +
    +const
    +  magic:integer=1234567890;
    +  magicret:integer=987654321;
    +var
    +  g_result:integer;
    +
    +procedure clean_res;
    +  begin
    +    g_result:=0;
    +  end;
    +
    +procedure set_res;
    +  begin
    +    g_result:=magic;
    +  end;
    +
    +procedure check_res(num:Integer);
    +  begin
    +    if g_result<>num then halt(1);
    +  end;
    +
    +type
    +  tproc=reference to function:integer;
    +  
    +function factory:tproc;
    +  begin
    +    result:=function:Integer
    +              begin
    +                set_res;
    +                result:=magicret;
    +              end;
    +  end;
    +  
    +procedure do_things;  
    +  var
    +    p: TProc;
    +  begin
    +    clean_res;
    +    p:=factory;
    +    check_res(0);
    +    if p()<>magicret then halt(1);
    +    check_res(magic);
    +  end;
    +  
    +begin
    +  do_things;
    +end.
    diff --git a/tests/test/tanonymproc6.pp b/tests/test/tanonymproc6.pp
    new file mode 100644
    index 0000000..8abc0b1
    --- /dev/null
    +++ b/tests/test/tanonymproc6.pp
    @@ -0,0 +1,31 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ anonymous routine have inner function }
    +
    +const
    +  magicstr:string='hello';
    +  magicstrlen:integer=5;
    +
    +type
    +  tproc=reference to procedure(num:integer;s:string);
    + 
    +procedure do_things;  
    +  var
    +    p:tproc;
    +  begin
    +    p:=procedure(num:integer;s:string)
    +         function inner(ss:string):integer;
    +           begin
    +             result:=length(ss);
    +           end;
    +         var b:Integer;
    +         begin
    +           b:=inner(s);
    +           if b<>num then halt(1);
    +         end;
    +    p(magicstrlen,magicstr);
    +  end;
    +  
    +begin
    +  do_things;
    +end.
    diff --git a/tests/test/tanonymproc7.pp b/tests/test/tanonymproc7.pp
    new file mode 100644
    index 0000000..b741c77
    --- /dev/null
    +++ b/tests/test/tanonymproc7.pp
    @@ -0,0 +1,25 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ closure as function argument }
    +
    +const
    +  magic1:integer=123;
    +  magic2:integer=321123;
    +
    +type
    +  tfunct=reference to function(num:integer):integer;
    +  
    +function call(f:tfunct;arg:integer):integer;
    +  begin
    +   result:=f(arg);
    +  end;
    +
    +var i:integer;
    +begin
    +  i:=call( function(num:integer):integer
    +             begin
    +               result:=num+magic2;
    +             end,
    +           magic1 );
    +  if i<>(magic1+magic2) then halt(1);
    +end.
    diff --git a/tests/test/tanonymproc8.pp b/tests/test/tanonymproc8.pp
    new file mode 100644
    index 0000000..706403f
    --- /dev/null
    +++ b/tests/test/tanonymproc8.pp
    @@ -0,0 +1,19 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ two anonymous function inside one routine }
    +
    +const
    +  magic1:integer=777;
    +  magic2:integer=888;
    +
    +type
    +  tfunct=reference to function:integer;
    +  
    +var p1,p2:tfunct;
    +begin
    +  p1:=function: Integer begin result:=magic1; end;
    +  p2:=function: Integer begin result:=magic2; end;
    +
    +  if p1()<>magic1 then halt(1);
    +  if p2()<>magic2 then halt(2);
    +end.
    diff --git a/tests/test/tanonymproc9.pp b/tests/test/tanonymproc9.pp
    new file mode 100644
    index 0000000..36ed745
    --- /dev/null
    +++ b/tests/test/tanonymproc9.pp
    @@ -0,0 +1,21 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ acces to global variable }
    +
    +const
    +  magic:integer=1234567890;
    +
    +type
    +  tproc=reference to procedure;
    +  
    +var p:tproc;
    +    staticvar:integer;
    +begin
    +  staticvar:=0;
    +  p:=procedure
    +       begin
    +         staticvar:=magic;
    +       end;
    +  p();
    +  if staticvar<>magic then halt(1);
    +end.
    diff --git a/tests/test/tfanonymproc1.pp b/tests/test/tfanonymproc1.pp
    new file mode 100644
    index 0000000..457c7b2
    --- /dev/null
    +++ b/tests/test/tfanonymproc1.pp
    @@ -0,0 +1,14 @@
    +{ %fail }
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ incompatible proc and procvar }
    +
    +var
    +  i:reference to procedure(i:integer);
    +
    +begin
    +  i := procedure
    +         begin
    +         end;
    +  i();
    +end.
    diff --git a/tests/test/tfanonymproc10.pp b/tests/test/tfanonymproc10.pp
    new file mode 100644
    index 0000000..4befb49
    --- /dev/null
    +++ b/tests/test/tfanonymproc10.pp
    @@ -0,0 +1,9 @@
    +{$mode objfpc}
    +{ anonymous procedures doesnt work without modeswitch }
    +
    +var
    +  p:reference to procedure;
    +  
    +begin
    +  p:=procedure begin end;
    +end.
    diff --git a/tests/test/tfanonymproc11.pp b/tests/test/tfanonymproc11.pp
    new file mode 100644
    index 0000000..e05d468
    --- /dev/null
    +++ b/tests/test/tfanonymproc11.pp
    @@ -0,0 +1,19 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ initialization of procvar in declaration }
    +
    +procedure do_smth;
    +  var
    +    ok:boolean;
    +    i:reference to procedure(i:boolean) = procedure(val:boolean)
    +                                            begin
    +                                              ok:=val;
    +                                            end;
    +  begin
    +    i(true);
    +    if not ok then halt(1);
    +  end;
    +  
    +begin
    +  do_smth;
    +end.
    diff --git a/tests/test/tfanonymproc2.pp b/tests/test/tfanonymproc2.pp
    new file mode 100644
    index 0000000..8b71e5a
    --- /dev/null
    +++ b/tests/test/tfanonymproc2.pp
    @@ -0,0 +1,14 @@
    +{ %fail }
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ incompatible proc and procvar }
    +
    +var
    +  i:reference to function:integer;
    +
    +begin
    +  i := procedure
    +         begin
    +         end;
    +  i();
    +end.
    diff --git a/tests/test/tfanonymproc3.pp b/tests/test/tfanonymproc3.pp
    new file mode 100644
    index 0000000..fde91e3
    --- /dev/null
    +++ b/tests/test/tfanonymproc3.pp
    @@ -0,0 +1,14 @@
    +{ %fail }
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ illegal assignment }
    +
    +var
    +  p:reference to function:integer;
    +  i:integer;
    +
    +begin
    +  i := procedure
    +         begin
    +         end;
    +end.
    diff --git a/tests/test/tfanonymproc4.pp b/tests/test/tfanonymproc4.pp
    new file mode 100644
    index 0000000..22942a5
    --- /dev/null
    +++ b/tests/test/tfanonymproc4.pp
    @@ -0,0 +1,15 @@
    +{ %fail }
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ illegal arithmetics operation }
    +
    +type
    +  TProc = reference to function: Integer;
    +
    +var
    +  p: TProc;
    +  i: Integer;
    +
    +begin
    +  i := 10 + procedure begin end;
    +end.
    diff --git a/tests/test/tfanonymproc5.pp b/tests/test/tfanonymproc5.pp
    new file mode 100644
    index 0000000..c959d04
    --- /dev/null
    +++ b/tests/test/tfanonymproc5.pp
    @@ -0,0 +1,15 @@
    +{ %fail }    
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ call of anonymous function in place }
    +
    +var
    +  i: Integer;
    +begin
    +
    +  // now fpc parser eats first () and stops parsing of right side
    +  // delphi parser eats this but fails during runtime
    +  i := (function(num: Integer): Integer begin Result := num + 10; end)(5);
    +
    +  Writeln(i);
    +end.
    diff --git a/tests/test/tfanonymproc6.pp b/tests/test/tfanonymproc6.pp
    new file mode 100644
    index 0000000..1d7ae11
    --- /dev/null
    +++ b/tests/test/tfanonymproc6.pp
    @@ -0,0 +1,13 @@
    +{ %fail }
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ incompatible proc and and procvar }
    +
    +var
    +  i: reference to procedure(i: Integer);
    +
    +begin
    +  i := procedure
    +         begin
    +         end;
    +end.
    diff --git a/tests/test/tfanonymproc7.pp b/tests/test/tfanonymproc7.pp
    new file mode 100644
    index 0000000..19d4aa2
    --- /dev/null
    +++ b/tests/test/tfanonymproc7.pp
    @@ -0,0 +1,12 @@
    +{ %fail }
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ wrong parameter type }
    +
    +var
    +  i: reference to procedure(i:integer);
    +
    +begin
    +  i := procedure(i:integer) begin end;
    +  i('hello world');
    +end.
    diff --git a/tests/test/tfanonymproc8.pp b/tests/test/tfanonymproc8.pp
    new file mode 100644
    index 0000000..f7ca501
    --- /dev/null
    +++ b/tests/test/tfanonymproc8.pp
    @@ -0,0 +1,25 @@
    +{ %fail }
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ closure is wrong function argument }
    +
    +const
    +  magic1:integer=123;
    +  magic2:integer=321123;
    +
    +type
    +  tfunct=reference to function(num:integer):integer;
    +  
    +function call(f:tfunct;arg:integer):integer;
    +  begin
    +   result:=f(arg);
    +  end;
    +
    +var i:integer;
    +begin
    +  i:=call( function(s:string):integer
    +             begin
    +             end,
    +           magic1 );
    +end.
    +
    diff --git a/tests/test/tfanonymproc9.pp b/tests/test/tfanonymproc9.pp
    new file mode 100644
    index 0000000..38780f0
    --- /dev/null
    +++ b/tests/test/tfanonymproc9.pp
    @@ -0,0 +1,25 @@
    +{ %fail }
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ acces to local variables of outer function }
    +{ will be possible with closures }
    +
    +const
    +  magic:integer=1234567890;
    +
    +type
    +  tproc=reference to procedure;
    +  
    +procedure do_smth;
    +var p:tproc;
    +    localvar:integer;
    +begin
    +  p:=procedure
    +       begin
    +         localvar:=magic;
    +       end;
    +end;
    +
    +begin
    +  do_smth
    +end.
    diff --git a/tests/test/uanonymproc1.pp b/tests/test/uanonymproc1.pp
    new file mode 100644
    index 0000000..2129851
    --- /dev/null
    +++ b/tests/test/uanonymproc1.pp
    @@ -0,0 +1,26 @@
    +unit uanonymproc1;
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +
    +interface
    +
    +procedure do_smth_inline; inline;
    +
    +var
    +  good:boolean=false;
    +
    +implementation
    +
    +procedure do_smth_inline; inline;
    +  var
    +    i:reference to procedure = procedure
    +                                 begin
    +                                   good:=true;
    +                                 end;
    +  begin
    +    i();
    +    if not good then halt(1);
    +  end;
    +
    +begin
    +end.
    -- 
    1.8.1.2
    
    
    closures01.patch (133,611 bytes)
  • anonymous01.patch (133,611 bytes)
    From 643c63f21fd21d2d7f4dad4ec46a630d2116e4bd Mon Sep 17 00:00:00 2001
    From: blaise <blaise@3ad0048d-3df7-0310-abae-a5850022a9f2>
    Date: Sat, 21 Jan 2012 19:00:59 +0000
    Subject: [PATCH 1/4] Parse anonymous functions.
    
    Now it's possible to parse anonymous routine inside body of other routine.
    Currently anonymous procedure have normal nesting level. So it can't access local variables of outer function. There is no check for this.
    Currently "reference to procedure" is represented as procvar. That is why there is no typecheck during assignment of "pure" procedure to "reference to" procedures.
    
    Delhi-like implementation of closure will have same syntax but will allow to capture variables.
    ---
     compiler/pclosure.pas              |  49 +++++++++++++++++
     compiler/pdecobj.pas               |  10 ++--
     compiler/pdecsub.pas               | 105 +++++++++++++++++++++++++------------
     compiler/pexpr.pas                 |   9 +++-
     compiler/psub.pas                  |  18 +++----
     compiler/ptype.pas                 |  51 ++++++++++--------
     compiler/symconst.pas              |   4 +-
     compiler/symcreat.pas              |   2 +-
     compiler/symdef.pas                |  15 ++++++
     compiler/tokens.pas                |   2 +
     compiler/utils/ppuutils/ppudump.pp |   3 +-
     11 files changed, 196 insertions(+), 72 deletions(-)
     create mode 100644 compiler/pclosure.pas
    
    diff --git a/compiler/pclosure.pas b/compiler/pclosure.pas
    new file mode 100644
    index 0000000..f6894fd
    --- /dev/null
    +++ b/compiler/pclosure.pas
    @@ -0,0 +1,49 @@
    +unit pclosure;
    +
    +{$mode objfpc}
    +
    +interface
    +
    +uses node, symtype, symdef, symsym, globtype;
    +
    +function parse_anonymous_routine(pd: tprocdef): tnode;
    +
    +implementation
    +
    +uses nld,symconst,procinfo,pdecsub,psub,verbose,symbase,symtable,ncal,pass_1,nmem,nbas,fmodule,ncnv;
    +
    +function parse_anonymous_routine(pd: tprocdef): tnode;
    +
    +  procedure read_proc_body_(objdef:tobjectdef;anonymprocdef:tprocdef);
    +  var old_current_structdef:tabstractrecorddef;
    +      old_current_procinfo:tprocinfo;
    +  begin
    +    old_current_structdef:=current_structdef;
    +    old_current_procinfo:=current_procinfo;
    +    current_structdef:=objdef;
    +    while current_procinfo.parent<>nil do
    +      current_procinfo:=current_procinfo.parent;
    +    read_proc(false,anonymprocdef,false);
    +    proc_add_definition(anonymprocdef);
    +    current_structdef:=old_current_structdef;
    +    current_procinfo:=old_current_procinfo;
    +    current_module.procinfo:=old_current_procinfo;
    +  end;
    +
    +var anonymprocdef:tprocdef;
    +    loadn,addrn:tnode;
    +begin
    +  symtablestack.push(current_module.localsymtable); // procdef will add itself in deflist during creation
    +  anonymprocdef:=parse_proc_dec(nil,ppm_anonymous_routine);
    +  symtablestack.pop(current_module.localsymtable);
    +  handle_calling_convention(anonymprocdef);
    +  read_proc_body_(nil,anonymprocdef);
    +
    +  loadn:=cloadnode.create(anonymprocdef.procsym,anonymprocdef.procsym.owner);
    +  addrn:=caddrnode.create(loadn);
    +  typecheckpass(addrn);
    +  result:=addrn;
    +end;
    +
    +begin
    +end.
    diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
    index 61dcc0f..d6a22b9 100644
    --- a/compiler/pdecobj.pas
    +++ b/compiler/pdecobj.pas
    @@ -104,7 +104,7 @@ implementation
             result:=nil;
             consume(_CONSTRUCTOR);
             { must be at same level as in implementation }
    -        parse_proc_head(current_structdef,potype_class_constructor,pd);
    +        parse_proc_head(current_structdef,potype_class_constructor,ppm_class_method,pd);
             if not assigned(pd) then
               begin
                 consume(_SEMICOLON);
    @@ -129,7 +129,7 @@ implementation
             result:=nil;
             consume(_CONSTRUCTOR);
             { must be at same level as in implementation }
    -        parse_proc_head(current_structdef,potype_constructor,pd);
    +        parse_proc_head(current_structdef,potype_constructor,ppm_normal,pd);
             if not assigned(pd) then
               begin
                 consume(_SEMICOLON);
    @@ -226,7 +226,7 @@ implementation
           begin
             result:=nil;
             consume(_DESTRUCTOR);
    -        parse_proc_head(current_structdef,potype_class_destructor,pd);
    +        parse_proc_head(current_structdef,potype_class_destructor,ppm_class_method,pd);
             if not assigned(pd) then
               begin
                 consume(_SEMICOLON);
    @@ -250,7 +250,7 @@ implementation
           begin
             result:=nil;
             consume(_DESTRUCTOR);
    -        parse_proc_head(current_structdef,potype_destructor,pd);
    +        parse_proc_head(current_structdef,potype_destructor,ppm_normal,pd);
             if not assigned(pd) then
               begin
                 consume(_SEMICOLON);
    @@ -874,7 +874,7 @@ implementation
     
                   oldparse_only:=parse_only;
                   parse_only:=true;
    -              result:=parse_proc_dec(is_classdef,astruct);
    +              result:=parse_proc_dec(astruct,as_procparsemode(is_classdef));
     
                   { this is for error recovery as well as forward }
                   { interface mappings, i.e. mapping to a method  }
    diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
    index c5c4cdf..91310ca 100644
    --- a/compiler/pdecsub.pas
    +++ b/compiler/pdecsub.pas
    @@ -72,8 +72,12 @@ interface
         procedure parse_var_proc_directives(sym:tsym);
         procedure parse_object_proc_directives(pd:tabstractprocdef);
         procedure parse_record_proc_directives(pd:tabstractprocdef);
    -    function  parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;out pd:tprocdef):boolean;
    -    function  parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef):tprocdef;
    +
    +    type tprocparsemode = (ppm_normal, ppm_class_method, ppm_anonymous_routine, ppm_method_reference);
    +    // TODO: operator :=/Explicit (const is_class_method: boolean) result: tprocparsemode;
    +    function as_procparsemode(const is_class_method: boolean): tprocparsemode; inline;
    +    function parse_proc_head(astruct: tabstractrecorddef; potype: tproctypeoption; const procparsemode: tprocparsemode; out pd: tprocdef): boolean;
    +    function parse_proc_dec(astruct: tabstractrecorddef; const procparsemode: tprocparsemode = ppm_normal): tprocdef;
     
         { parse a record method declaration (not a (class) constructor/destructor) }
         function parse_record_method_dec(astruct: tabstractrecorddef; is_classdef: boolean): tprocdef;
    @@ -540,7 +544,7 @@ implementation
           end;
     
     
    -    function parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;out pd:tprocdef):boolean;
    +    function parse_proc_head(astruct: tabstractrecorddef; potype: tproctypeoption; const procparsemode: tprocparsemode; out pd: tprocdef): boolean;
           var
             hs       : string;
             orgsp,sp : TIDString;
    @@ -756,7 +760,20 @@ implementation
             pd:=nil;
             aprocsym:=nil;
     
    -        consume_proc_name;
    +        case procparsemode of
    +          ppm_anonymous_routine:
    +            begin
    +              sp:='Anonymous_'+inttostr(procstartfilepos.line)+'_'+inttostr(procstartfilepos.column);
    +              orgsp:=upcase(sp);
    +            end;
    +          ppm_method_reference:
    +            begin
    +              sp:='Apply';
    +              orgsp:=upcase(sp);
    +            end;
    +          else
    +            consume_proc_name;
    +        end;
     
             { examine interface map: function/procedure iname.functionname=locfuncname }
             if assigned(astruct) and
    @@ -809,7 +826,11 @@ implementation
     
             { method  ? }
             srsym:=nil;
    -        if (consume_generic_type_parameter or not assigned(astruct)) and
    +        if procparsemode=ppm_anonymous_routine then
    +          // Do nothing. This check here:
    +          //   a) skips below checks and searches, speeding things up;
    +          //   b) makes sure we do not try to parse generic type parameters.
    +        else if (consume_generic_type_parameter or not assigned(astruct)) and
                (symtablestack.top.symtablelevel=main_program_level) and
                try_to_consume(_POINT) then
              begin
    @@ -944,17 +965,25 @@ implementation
                 symtablestack.top.insert(aprocsym);
               end;
     
    -        { to get the correct symtablelevel we must ignore ObjectSymtables }
    -        st:=nil;
    -        checkstack:=symtablestack.stack;
    -        while assigned(checkstack) do
    +        if procparsemode=ppm_anonymous_routine then
    +          begin
    +            pd:=tprocdef.create(normal_function_level);
    +            include(pd.procoptions,po_anonymous);
    +          end
    +        else 
               begin
    -            st:=checkstack^.symtable;
    -            if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then
    -              break;
    -            checkstack:=checkstack^.next;
    +            { to get the correct symtablelevel we must ignore ObjectSymtables }
    +            st:=nil;
    +            checkstack:=symtablestack.stack;
    +            while assigned(checkstack) do
    +              begin
    +                st:=checkstack^.symtable;
    +                if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then
    +                  break;
    +                checkstack:=checkstack^.next;
    +              end;
    +            pd:=tprocdef.create(st.symtablelevel+1);
               end;
    -        pd:=tprocdef.create(st.symtablelevel+1);
             pd.struct:=astruct;
             pd.procsym:=aprocsym;
             pd.proctypeoption:=potype;
    @@ -1042,7 +1071,16 @@ implementation
           end;
     
     
    -    function parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef):tprocdef;
    +    function as_procparsemode(const is_class_method: boolean): tprocparsemode; inline;
    +      begin
    +        if is_class_method then
    +          result := ppm_class_method
    +        else
    +          result := ppm_normal
    +      end;
    +
    +
    +    function parse_proc_dec(astruct: tabstractrecorddef; const procparsemode: tprocparsemode = ppm_normal): tprocdef;
           var
             pd: tprocdef;
             locationstr: string;
    @@ -1100,7 +1138,7 @@ implementation
               _FUNCTION :
                 begin
                   consume(_FUNCTION);
    -              if parse_proc_head(astruct,potype_function,pd) then
    +              if parse_proc_head(astruct,potype_function,procparsemode,pd) then
                     begin
                       { pd=nil when it is a interface mapping }
                       if assigned(pd) then
    @@ -1144,8 +1182,8 @@ implementation
                                 consume_all_until(_SEMICOLON);
                               end;
                            end;
    -                      if isclassmethod then
    -                       include(pd.procoptions,po_classmethod);
    +                      if procparsemode=ppm_class_method then
    +                        include(pd.procoptions,po_classmethod);
                         end;
                     end
                   else
    @@ -1159,13 +1197,13 @@ implementation
               _PROCEDURE :
                 begin
                   consume(_PROCEDURE);
    -              if parse_proc_head(astruct,potype_procedure,pd) then
    +              if parse_proc_head(astruct,potype_procedure,procparsemode,pd) then
                     begin
                       { pd=nil when it is an interface mapping }
                       if assigned(pd) then
                         begin
                           pd.returndef:=voidtype;
    -                      if isclassmethod then
    +                      if procparsemode=ppm_class_method then
                             include(pd.procoptions,po_classmethod);
                         end;
                     end;
    @@ -1174,11 +1212,11 @@ implementation
               _CONSTRUCTOR :
                 begin
                   consume(_CONSTRUCTOR);
    -              if isclassmethod then
    -                parse_proc_head(astruct,potype_class_constructor,pd)
    +              if procparsemode=ppm_class_method then
    +                parse_proc_head(astruct,potype_class_constructor,procparsemode,pd)
                   else
    -                parse_proc_head(astruct,potype_constructor,pd);
    -              if not isclassmethod and
    +                parse_proc_head(astruct,potype_constructor,procparsemode,pd);
    +              if (procparsemode<>ppm_class_method) and
                      assigned(pd) and
                      assigned(pd.struct) then
                     begin
    @@ -1205,16 +1243,16 @@ implementation
               _DESTRUCTOR :
                 begin
                   consume(_DESTRUCTOR);
    -              if isclassmethod then
    -                parse_proc_head(astruct,potype_class_destructor,pd)
    +              if procparsemode=ppm_class_method then
    +                parse_proc_head(astruct,potype_class_destructor,procparsemode,pd)
                   else
    -                parse_proc_head(astruct,potype_destructor,pd);
    +                parse_proc_head(astruct,potype_destructor,procparsemode,pd);
                   if assigned(pd) then
                     pd.returndef:=voidtype;
                 end;
             else
               if (token=_OPERATOR) or
    -             (isclassmethod and (idtoken=_OPERATOR)) then
    +             ((procparsemode=ppm_class_method) and (idtoken=_OPERATOR)) then
                 begin
                   { we need to set the block type to bt_body, so that operator names
                     like ">", "=>" or "<>" are parsed correctly instead of e.g.
    @@ -1222,7 +1260,7 @@ implementation
                   old_block_type:=block_type;
                   block_type:=bt_body;
                   consume(_OPERATOR);
    -              parse_proc_head(astruct,potype_operator,pd);
    +              parse_proc_head(astruct,potype_operator,procparsemode,pd);
                   block_type:=old_block_type;
                   if assigned(pd) then
                     begin
    @@ -1232,7 +1270,7 @@ implementation
                       pd.procsym.owner.includeoption(sto_has_operator);
                       if pd.parast.symtablelevel>normal_function_level then
                         Message(parser_e_no_local_operator);
    -                  if isclassmethod then
    +                  if procparsemode=ppm_class_method then
                         include(pd.procoptions,po_classmethod);
                       if token<>_ID then
                         begin
    @@ -1304,7 +1342,8 @@ implementation
                     message(parser_e_field_not_allowed_here);
                     consume_all_until(_SEMICOLON);
                   end;
    -            consume(_SEMICOLON);
    +            if not (procparsemode in [ppm_anonymous_routine,ppm_method_reference]) then
    +              consume(_SEMICOLON);
               end;
             result:=pd;
     
    @@ -1323,7 +1362,7 @@ implementation
           begin
             oldparse_only:=parse_only;
             parse_only:=true;
    -        result:=parse_proc_dec(is_classdef,astruct);
    +        result:=parse_proc_dec(astruct,as_procparsemode(is_classdef));
     
             { this is for error recovery as well as forward }
             { interface mappings, i.e. mapping to a method  }
    @@ -3303,7 +3342,7 @@ const
                 if (currpd.proctypeoption = potype_function) and
                    is_void(currpd.returndef) then
                   MessagePos1(currpd.fileinfo,parser_e_no_funcret_specified,currpd.procsym.realname);
    -            tprocsym(currpd.procsym).ProcdefList.Add(currpd);
    +            currpd.add_to_procsym;
               end;
     
             proc_add_definition:=forwardfound;
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index 50808ab..c05c103 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -70,7 +70,7 @@ implementation
            nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
            { parser }
            scanner,
    -       pbase,pinline,ptype,pgenutil,procinfo,cpuinfo
    +       pbase,pinline,ptype,pgenutil,procinfo,cpuinfo,pclosure
            ;
     
         { sub_expr(opmultiply) is need to get -1 ** 4 to be
    @@ -3314,6 +3314,13 @@ implementation
                    p1:=cinlinenode.create(in_objc_protocol_x,false,p1);
                  end;
     
    +             // anonymous routine
    +             _PROCEDURE, _FUNCTION:
    +               if assigned(current_procinfo) then
    +                 p1:=parse_anonymous_routine(current_procinfo.procdef)
    +               else // TODO: support this later? Delphi doesn't
    +                 internalerror(20120121);
    +
                  else
                    begin
                      Message(parser_e_illegal_expression);
    diff --git a/compiler/psub.pas b/compiler/psub.pas
    index 64f4655..a63760b 100644
    --- a/compiler/psub.pas
    +++ b/compiler/psub.pas
    @@ -77,7 +77,7 @@ interface
         { reads any routine in the implementation, or a non-method routine
           declaration in the interface (depending on whether or not parse_only is
           true) }
    -    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef);
    +    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef;eatsemicolon:boolean);
     
         procedure generate_specialization_procs;
     
    @@ -1828,7 +1828,7 @@ implementation
     
     
     
    -    procedure read_proc_body(old_current_procinfo:tprocinfo;pd:tprocdef);
    +    procedure read_proc_body(old_current_procinfo:tprocinfo;pd:tprocdef;eatsemicolon:boolean=true);
           {
             Parses the procedure directives, then parses the procedure body, then
             generates the code for it
    @@ -1912,7 +1912,7 @@ implementation
             { For specialization we didn't record the last semicolon. Moving this parsing
               into the parse_body routine is not done because of having better file position
               information available }
    -        if not(df_specialization in current_procinfo.procdef.defoptions) then
    +        if eatsemicolon and not(df_specialization in current_procinfo.procdef.defoptions) then
               consume(_SEMICOLON);
     
             if not isnestedproc then
    @@ -1921,7 +1921,7 @@ implementation
           end;
     
     
    -    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef);
    +    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef;eatsemicolon:boolean);
           {
             Parses the procedure directives, then parses the procedure body, then
             generates the code for it
    @@ -1951,7 +1951,7 @@ implementation
     
              if not assigned(usefwpd) then
                { parse procedure declaration }
    -           pd:=parse_proc_dec(isclassmethod,old_current_structdef)
    +           pd:=parse_proc_dec(old_current_structdef,as_procparsemode(isclassmethod))
              else
                pd:=usefwpd;
     
    @@ -2028,7 +2028,7 @@ implementation
              { compile procedure when a body is needed }
              if (pd_body in pdflags) then
                begin
    -             read_proc_body(old_current_procinfo,pd);
    +             read_proc_body(old_current_procinfo,pd,eatsemicolon);
                end
              else
                begin
    @@ -2152,7 +2152,7 @@ implementation
                   _PROCEDURE,
                   _OPERATOR:
                     begin
    -                  read_proc(is_classdef,nil);
    +                  read_proc(is_classdef,nil,true);
                       is_classdef:=false;
                     end;
                   _EXPORTS:
    @@ -2187,7 +2187,7 @@ implementation
                           begin
                             if is_classdef then
                               begin
    -                            read_proc(is_classdef,nil);
    +                            read_proc(is_classdef,nil,true);
                                 is_classdef:=false;
                               end
                             else
    @@ -2235,7 +2235,7 @@ implementation
                  _FUNCTION,
                  _PROCEDURE,
                  _OPERATOR :
    -               read_proc(false,nil);
    +               read_proc(false,nil,true);
                  else
                    begin
                      case idtoken of
    diff --git a/compiler/ptype.pas b/compiler/ptype.pas
    index 3aad0b7..70ee34b 100644
    --- a/compiler/ptype.pas
    +++ b/compiler/ptype.pas
    @@ -27,7 +27,7 @@ interface
     
         uses
            globtype,cclasses,
    -       symtype,symdef,symbase;
    +       symtype,symdef,symbase,pclosure;
     
         type
           TSingleTypeOption=(
    @@ -1673,26 +1673,35 @@ implementation
                     jvm_create_procvar_class(name,def);
     {$endif}
                   end;
    -            else
    -              if (token=_KLAMMERAFFE) and (m_iso in current_settings.modeswitches) then
    -                begin
    -                  consume(_KLAMMERAFFE);
    -                  single_type(tt2,SingleTypeOptionsInTypeBlock[block_type=bt_type]);
    -                  def:=tpointerdef.create(tt2);
    -                  if tt2.typ=forwarddef then
    -                    current_module.checkforwarddefs.add(def);
    -                end
    -              else
    -                if hadtypetoken and
    -                    { don't allow "type helper" in mode delphi and require modeswitch class }
    -                    ([m_delphi,m_class]*current_settings.modeswitches=[m_class]) and
    -                    (token=_ID) and (idtoken=_HELPER) then
    -                  begin
    -                    consume(_HELPER);
    -                    def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_type);
    -                  end
    -                else
    -                  expr_type;
    +           _KLAMMERAFFE:
    +             if m_iso in current_settings.modeswitches then
    +               begin
    +                 consume(_KLAMMERAFFE);
    +                 single_type(tt2,SingleTypeOptionsInTypeBlock[block_type=bt_type]);
    +                 def:=tpointerdef.create(tt2);
    +                 if tt2.typ=forwarddef then
    +                   current_module.checkforwarddefs.add(def);
    +               end
    +             else
    +               expr_type;
    +           _ID:
    +             if idtoken=_REFERENCE then
    +               begin
    +                 consume(_REFERENCE); consume(_TO);
    +                 def:=procvar_dec(genericdef,genericlist);
    +               end
    +             else
    +             if (idtoken=_HELPER) and hadtypetoken and
    +                { don't allow "type helper" in mode delphi and require modeswitch class }
    +                ([m_delphi,m_class]*current_settings.modeswitches=[m_class]) then
    +               begin
    +                 consume(_HELPER);
    +                 def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_type);
    +               end
    +             else
    +               expr_type;
    +           else
    +             expr_type;
              end;
     
              if def=nil then
    diff --git a/compiler/symconst.pas b/compiler/symconst.pas
    index 83dd798..b991e2a 100644
    --- a/compiler/symconst.pas
    +++ b/compiler/symconst.pas
    @@ -350,7 +350,9 @@ type
         { the visibility of of this procdef was raised automatically by the
           compiler, e.g. because it was designated as a getter/setter for a property
           with a higher visibility on the JVM target }
    -    po_auto_raised_visibility
    +    po_auto_raised_visibility,
    +    { anonymous routine (including closure) }
    +    po_anonymous
       );
       tprocoptions=set of tprocoption;
     
    diff --git a/compiler/symcreat.pas b/compiler/symcreat.pas
    index 06ac751..925eeda 100644
    --- a/compiler/symcreat.pas
    +++ b/compiler/symcreat.pas
    @@ -242,7 +242,7 @@ implementation
           current_scanner.substitutemacro('meth_impl_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index);
           current_scanner.readtoken(false);
           { and parse it... }
    -      read_proc(is_classdef,usefwpd);
    +      read_proc(is_classdef,usefwpd,true);
           parse_only:=oldparse_only;
           { remove the temporary macro input file again }
           current_scanner.closeinputfile;
    diff --git a/compiler/symdef.pas b/compiler/symdef.pas
    index f6f816e..59b1cb7 100644
    --- a/compiler/symdef.pas
    +++ b/compiler/symdef.pas
    @@ -731,6 +731,8 @@ interface
               function  is_methodpointer:boolean;override;
               function  is_addressonly:boolean;override;
               procedure make_external;
    +          procedure add_to_procsym; overload; inline;
    +          procedure add_to_procsym(sym: tsym); overload; inline;
            end;
     
            { single linked list of overloaded procs }
    @@ -4792,6 +4794,19 @@ implementation
           end;
     
     
    +    procedure tprocdef.add_to_procsym; inline;
    +      begin
    +        tprocsym(procsym).ProcdefList.Add(self);
    +      end;
    +
    +
    +    procedure tprocdef.add_to_procsym(sym: {tprocsym}tsym); inline;
    +      begin
    +        procsym:=sym;
    +        add_to_procsym;
    +      end;
    +
    +
         procedure tprocdef.buildderef;
           begin
              inherited buildderef;
    diff --git a/compiler/tokens.pas b/compiler/tokens.pas
    index 3fe1505..3f29f59 100644
    --- a/compiler/tokens.pas
    +++ b/compiler/tokens.pas
    @@ -257,6 +257,7 @@ type
         _PROCEDURE,
         _PROTECTED,
         _PUBLISHED,
    +    _REFERENCE,
         _SOFTFLOAT,
         _THREADVAR,
         _WRITEONLY,
    @@ -556,6 +557,7 @@ const
           (str:'PROCEDURE'     ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
           (str:'PROTECTED'     ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'PUBLISHED'     ;special:false;keyword:[m_none];op:NOTOKEN),
    +      (str:'REFERENCE'     ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'SOFTFLOAT'     ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'THREADVAR'     ;special:false;keyword:alllanguagemodes-[m_iso];op:NOTOKEN),
           (str:'WRITEONLY'     ;special:false;keyword:[m_none];op:NOTOKEN),
    diff --git a/compiler/utils/ppuutils/ppudump.pp b/compiler/utils/ppuutils/ppudump.pp
    index c4df7c0..be2b42a 100644
    --- a/compiler/utils/ppuutils/ppudump.pp
    +++ b/compiler/utils/ppuutils/ppudump.pp
    @@ -1723,7 +1723,8 @@ const
          (mask:po_java_nonvirtual; str: 'Java non-virtual method'),
          (mask:po_ignore_for_overload_resolution;str: 'Ignored for overload resolution'),
          (mask:po_rtlproc;         str: 'RTL procedure'),
    -     (mask:po_auto_raised_visibility; str: 'Visibility raised by compiler')
    +     (mask:po_auto_raised_visibility; str: 'Visibility raised by compiler'),
    +     (mask:po_anonymous;       str: 'Anonymous procedure')
       );
     var
       proctypeoption  : tproctypeoption;
    -- 
    1.8.1.2
    
    
    From 4cb8a0b64cc8176e23e83d7924e2dc067253bdca Mon Sep 17 00:00:00 2001
    From: Vasiliy Kevroletin <kevroletin@gmail.com>
    Date: Mon, 3 Jun 2013 00:24:37 +1100
    Subject: [PATCH 2/4] Show error in case of access to free variable.
    
    Problem: variable capturing is not implemented and compiler doesn't warng about it.
    Fix: Show error message. Parser performs check before creation of tloadnode.
    Anonymous routine have normal nesting level and can have nested procedures.
    So simple check of symtable nesting level is not enough to detect fact of capturing. Instead we walk through symtables using parent link. We start from current symtable and go until symtable with normal nesting level. If we didn't come to symtable of variable then this variable located in another function. And it's capturing.
    ---
     compiler/msg/errore.msg |   5 +-
     compiler/msgidx.inc     |   5 +-
     compiler/msgtxt.inc     | 868 ++++++++++++++++++++++++------------------------
     compiler/pdecsub.pas    |   2 +-
     compiler/pexpr.pas      |  39 ++-
     5 files changed, 482 insertions(+), 437 deletions(-)
    
    diff --git a/compiler/msg/errore.msg b/compiler/msg/errore.msg
    index 0058444..ed30f73 100644
    --- a/compiler/msg/errore.msg
    +++ b/compiler/msg/errore.msg
    @@ -392,7 +392,7 @@ scan_w_setpeoptflags_not_support=02092_W_SETPEOPTFLAGS is not supported by the t
     #
     # Parser
     #
    -# 03333 is the last used one
    +# 03334 is the last used one
     #
     % \section{Parser messages}
     % This section lists all parser messages. The parser takes care of the
    @@ -1490,6 +1490,9 @@ parser_e_not_allowed_in_record=03332_E_Visibility section "$1" not allowed in re
     parser_e_proc_dir_not_allowed=03333_E_Procedure directive "$1" not allowed here
     % This procedure directive is not allowed in the given context. E.g. "static"
     % is not allowed for instance methods or class operators.
    +parser_e_proc_capture_not_allowed=03334_E_Anonymous procedure can not capture local variable "$1"
    +% Anonymous procedure currently can not use local variables of declaring subroutine.
    +%
     %
     %
     % \end{description}
    diff --git a/compiler/msgidx.inc b/compiler/msgidx.inc
    index ccc4bf2..e16a897 100644
    --- a/compiler/msgidx.inc
    +++ b/compiler/msgidx.inc
    @@ -429,6 +429,7 @@ const
       parser_e_no_class_in_local_anonymous_records=03331;
       parser_e_not_allowed_in_record=03332;
       parser_e_proc_dir_not_allowed=03333;
    +  parser_e_proc_capture_not_allowed=03334;
       type_e_mismatch=04000;
       type_e_incompatible_types=04001;
       type_e_not_equal_types=04002;
    @@ -973,9 +974,9 @@ const
       option_info=11024;
       option_help_pages=11025;
     
    -  MsgTxtSize = 68955;
    +  MsgTxtSize = 69019;
     
       MsgIdxMax : array[1..20] of longint=(
    -    26,93,334,121,88,56,126,27,202,63,
    +    26,93,335,121,88,56,126,27,202,63,
         54,20,1,1,1,1,1,1,1,1
       );
    diff --git a/compiler/msgtxt.inc b/compiler/msgtxt.inc
    index 8909dae..36396c0 100644
    --- a/compiler/msgtxt.inc
    +++ b/compiler/msgtxt.inc
    @@ -536,665 +536,670 @@ const msgtxt : array[0..000287,1..240] of char=(
       'us records'#000+
       '03332_E_Visibility section "$1" not allowed in records'#000+
       '03333_E_Procedure directive "$1" not allowed here'#000+
    +  '03334_E_Anonymous procedure can no','t capture local variable "$1"'#000+
       '04000_E_Type mismatch'#000+
    -  '04001_E_Inco','mpatible types: got "$1" expected "$2"'#000+
    +  '04001_E_Incompatible types: got "$1" expected "$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+
    -  '04006_E_Boolean expression expected, ','but got "$1"'#000+
    +  '04005_E_Integer express','ion 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+
       '04009_E_class type expected, but got "$1"'#000+
    -  '04011_E_Can'#039't evaluate constant expression'#000+
    +  '04011_E_Can'#039't evaluate constant expressio','n'#000+
       '04012_E_Set elements are not compatible'#000+
    -  '04013_E_Operation not ','implemented for sets'#000+
    +  '04013_E_Operation not implemented for sets'#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+
    -  '04017_E_succ or pred on enums',' with assignments not possible'#000+
    +  '04016_E_String types',' have to match exactly in $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+
       '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+
    +  '04020_E_Can'#039't use read or write on untyped f','ile.'#000+
       '04021_E_Type conflict between set elements'#000+
    -  '04022_W_lo/hi(dw','ord/qword) returns the upper/lower word/dword'#000+
    +  '04022_W_lo/hi(dword/qword) returns the upper/lower word/dword'#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+
    -  '04026_E_Method (variable) and Procedure',' (variable) are not compatibl'+
    -  'e'#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 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',' varia'+
    -  'ble'#000+
    +  '04029_E_Argument can'#039't be assign','ed to'#000+
    +  '04030_E_Can'#039't assign local procedure/function to procedure variabl'+
    +  'e'#000+
       '04031_E_Can'#039't assign values to an address'#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+
    +  '0403','5_H_Mixing signed expressions and longwords gives a 64bit result'+
    +  #000+
       '04036_W_Mixing signed expressions and cardinals here may cause a range'+
       ' 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+
    -  '04039_E_Class or Object types "$1" ','and "$2" are not related'#000+
    +  '04038_E_enums with assignments ','can'#039't be used as array index'#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+
       '04042_E_Type "$1" is not completely defined'#000+
    -  '04043_W_String literal has more characters than short string lengt','h'#000+
    +  '04','043_W_String literal has more characters than short string length'#000+
       '04044_W_Comparison might be always false due to range of constant and '+
       'expression'#000+
       '04045_W_Comparison might be always true due to range of constant and e'+
       'xpression'#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+
    +  '04046_W_Const','ructing a class "$1" with abstract method "$2"'#000+
    +  '04047_H_The left operand of the IN operator should be byte sized'#000+
       '04048_W_Type size mismatch, possible loss of data / range check error'#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 t','aken'#000+
    +  '04049_H_Type size mismatch, possible loss of data / range ','check erro'+
    +  'r'#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+
       '04052_E_Constant Expression expected'#000+
    -  '04053_E_Operation "$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_Conversio','n between ordinals and pointers is not portable'#000+
    +  '04055_H_Conversion between ordinals and pointers is not portable'#000+
       '04056_W_Conversion between ordinals and pointers is not portable'#000+
       '04057_E_Can'#039't determine which overloaded function to call'#000+
    -  '04058_E_Illegal counter variable'#000+
    -  '04059_W_Converting constant real val','ue to double for C variable argu'+
    -  'ment, add explicit typecast to prevent this.'#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 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)Pa'+
    -  'cked Array"'#000+
    +  '04061_E_Constant packed arrays are not y','et supported'#000+
    +  '04062_E_Incompatible type for arg no. $1: Got "$2" expected "(Bit)Pack'+
    +  'ed 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 t','o '+
    +  'be initialised'#000+
    +  '04065_E_Constant packed records and objects are not yet 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+
    -  '04077_E_Can'#039't export subroutine marked as local from a unit'#000+
    -  '04078_E_Type is no','t automatable: "$1"'#000+
    +  '04077_E_Can'#039't ','export subroutine marked as local from a unit'#000+
    +  '04078_E_Type is not automatable: "$1"'#000+
       '04079_H_Converting the operands to "$1" before doing the add could pre'+
       'vent overflow errors.'#000+
    -  '04080_H_Converting the operands to "$1" before doing the subtract coul'+
    -  'd prevent overflow errors.'#000+
    -  '04081_H_Converting the operands',' to "$1" before doing the multiply co'+
    +  '04080_H_Converting the operands to "$1" before doing the subtrac','t co'+
       'uld prevent overflow errors.'#000+
    +  '04081_H_Converting the operands to "$1" before doing the multiply coul'+
    +  'd 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 G','UID'#000+
    +  '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+
       '04085_E_Expected Objective-C method, but got $1'#000+
       '04086_E_Expected Objective-C method or constant method name'#000+
    -  '04087_E_No type info available for this type'#000+
    +  '04087_E_No type info availabl','e for this type'#000+
       '04088_E_Ordinal or string expression expected'#000+
    -  '04','089_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 Object'+
    -  'ive-C runtime.'#000+
    -  '04093_E_Class or objcclass type expec','ted, but got "$1"'#000+
    +  '04092_E_The type "$1" is not supported for interaction wit','h the Obje'+
    +  'ctive-C runtime.'#000+
    +  '04093_E_Class or objcclass type expected, but got "$1"'#000+
       '04094_E_Objcclass type expected'#000+
       '04095_W_Coerced univ parameter type in procedural variable may cause c'+
       'rash or memory corruption: $1 to $2'#000+
    -  '04096_E_Type parameters of specializations of generics cannot referenc'+
    -  'e the currentl','y specialized type'#000+
    +  '04096_E_Type paramet','ers of specializations of generics cannot refere'+
    +  'nce the currently specialized type'#000+
       '04097_E_Type parameters are not allowed on non-generic class/record/ob'+
       'ject procedure or function'#000+
    -  '04098_E_Generic declaration of "$1" differs from previous declaration'#000+
    +  '04098_E_Generic declaration of "$1" differs from previous de','claratio'+
    +  'n'#000+
       '04099_E_Helper type expected'#000+
    -  '04100_E_Record type expec','ted'#000+
    +  '04100_E_Record type expected'#000+
       '04101_E_Derived class helper must extend a subclass of "$1" or the cla'+
       'ss itself'#000+
       '04102_E_Derived record or type helper must extend "$1"'#000+
    -  '04103_E_Invalid assignment, procedures return no value'#000+
    -  '04104_W_Implicit string type conversion from "','$1" to "$2"'#000+
    +  '04103_E_Invalid assignment, procedure','s return no value'#000+
    +  '04104_W_Implicit string type conversion from "$1" to "$2"'#000+
       '04105_W_Implicit string type conversion with potential data loss from '+
       '"$1" to "$2"'#000+
       '04106_-W_Explicit string typecast from "$1" to "$2"'#000+
    -  '04107_-W_Explicit string typecast with potential data loss from "$1" t'+
    -  'o "$2"'#000+
    -  '04108_W_Unicode ','constant cast with potential data loss'#000+
    +  '04107_-W_Explicit string type','cast with potential data loss from "$1"'+
    +  ' to "$2"'#000+
    +  '04108_W_Unicode constant cast with potential data loss'#000+
       '04109_E_range check error while evaluating constants ($1 must be betwe'+
       'en $2 and $3)'#000+
    -  '04110_W_range check error while evaluating constants ($1 must be betwe'+
    -  'en $2 and $3)'#000+
    -  '04111_E_This type is not supporte','d for the Default() intrinsic'#000+
    +  '04110_W_range check error while evaluating constants ','($1 must be bet'+
    +  'ween $2 and $3)'#000+
    +  '04111_E_This type is not supported for the Default() intrinsic'#000+
       '04112_E_JVM virtual class methods cannot be static'#000+
       '04113_E_Final (class) fields can only be assigned in their class'#039' '+
       '(class) constructor'#000+
    -  '04114_E_It is not possible to typecast untyped parameters on managed p'+
    -  'lat','forms, simply assign a value to them instead.'#000+
    +  '04114_E_I','t is not possible to typecast untyped parameters on managed'+
    +  ' platforms, simply assign a value to them instead.'#000+
       '04115_E_The assignment side of an expression cannot be typecasted to a'+
       ' supertype on managed platforms'#000+
    -  '04116_-W_The interface method "$1" raises the visibility of "$2" to pu'+
    -  'blic when accessed via',' an interface instance'#000+
    +  '04116_-W_The interface metho','d "$1" raises the visibility of "$2" to '+
    +  'public when accessed via an interface instance'#000+
       '04117_E_The interface method "$1" has a higher visibility (public) tha'+
       'n "$2"'#000+
       '04118_E_TYPEOF can only be used on object types with VMT'#000+
    -  '04119_E_It is not possible to define a default value for a parameter o'+
    -  'f type "$1"'#000+
    -  '0','4120_E_Type "$1" cannot be extended by a type helper'#000+
    +  '04119_E_It is not p','ossible to define a default value for a parameter'+
    +  ' of type "$1"'#000+
    +  '04120_E_Type "$1" cannot be extended by a type helper'#000+
       '05000_E_Identifier not found "$1"'#000+
       '05001_F_Internal Error in SymTableStack()'#000+
       '05002_E_Duplicate identifier "$1"'#000+
    -  '05003_H_Identifier already defined in $1 at line $2'#000+
    -  '05004_E_Unknown identifie','r "$1"'#000+
    +  '05003_H_Ident','ifier already defined in $1 at line $2'#000+
    +  '05004_E_Unknown identifier "$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+
    -  '05012_F_record or class type expected'#000,
    +  '05010_E_Only static variables can be used in static m','ethods or outsi'+
    +  'de methods'#000+
    +  '05012_F_record or class type expected'#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+
    -  '05016_E_Illegal label declaration'#000+
    -  '05017_E_GOTO and LABEL are not supported (use switch -S','g)'#000+
    +  '05016_E_Illegal label dec','laration'#000+
    +  '05017_E_GOTO and LABEL are not supported (use switch -Sg)'#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+
    +  '05022_E_Forward class definition not ','resolved "$1"'#000+
       '05023_H_Unit "$1" not used in $2'#000+
    -  '05024_H_Parameter',' "$1" not used'#000+
    +  '05024_H_Parameter "$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+
    -  '05028_H_Local $1 "$2" is not used'#000+
    -  '05029_N_Private field "$1.$2" is 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+
       '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+
    -  '05034_W_Type "$1" is not aligned correctly in current record for C',#000+
    +  '05','034_W_Type "$1" is not aligned correctly in current record for C'#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+
    -  '05038_E_identifier idents no member "$1"'#000+
    +  '05038_E_identifi','er idents no member "$1"'#000+
       '05039_H_Found declaration: $1'#000+
    -  '05040_E_D','ata element too large'#000+
    +  '05040_E_Data element too large'#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+
    -  '05055_W_Symbol "$1" is not implemented'#000+
    -  '05056_E_Can'#039't create unique type from this',' type'#000+
    +  '05055_W_Symbol "$','1" is not implemented'#000+
    +  '05056_E_Can'#039't create unique type from this type'#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+
    -  '05060_H_Function result variable does not seem to be initi','alized'#000+
    +  '05059_W_Function result variable does not seem to initia','lized'#000+
    +  '05060_H_Function result variable does not seem to be initialized'#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 declaration "$1" not resolved, assu','med 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+
    -  '05069_E_Cannot find a "Current" property in enumerator "$1"'#000+
    -  '05070_E_Mismatch between number of d','eclared parameters and number of'+
    -  ' colons in message string.'#000+
    +  '05069_E_Cannot find a "Current" ','property in enumerator "$1"'#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+
    +  '05073_N_Private property "$1.$2" nev','er used'#000+
       '05074_W_Unit "$1" is deprecated'#000+
    -  '05075_W_Unit "$1" is dep','recated: "$2"'#000+
    +  '05075_W_Unit "$1" is deprecated: "$2"'#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+
    -  '05080_E_No complete definition of the formally declared class "$1" is '+
    -  'in scope'#000,
    +  '05080_E_No comp','lete definition of the formally declared class "$1" i'+
    +  's in scope'#000+
       '05081_E_Gotos into initialization or finalization blocks of units are '+
       'not allowed'#000+
       '05082_E_Invalid external name "$1" for formal class "$2"'#000+
    -  '05083_E_Complete class definition with external name "$1" here'#000+
    -  '05084_W_Possible library conflict: sym','bol "$1" from library "$2" als'+
    -  'o found in library "$3"'#000+
    +  '05083_E_Complete class definition wit','h external name "$1" here'#000+
    +  '05084_W_Possible library conflict: symbol "$1" from library "$2" also '+
    +  'found in library "$3"'#000+
       '05085_E_Cannot add implicit constructor '#039'Create'#039' because ident'+
       'ifier already used by "$1"'#000+
    -  '05086_E_Cannot generate default constructor for class, because parent '+
    -  'has no parameterless constr','uctor'#000+
    +  '05086_E_Cannot generate default c','onstructor for class, because paren'+
    +  't has no parameterless constructor'#000+
       '05087_D_Adding helper for $1'#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 ther','e'#000+
       '06015_E_EXPORT declared functions can'#039't be called'#000+
    -  '06016_W_Poss','ible illegal call of constructor or destructor'#000+
    +  '06016_W_Possible illegal call of constructor or destructor'#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 met','hods can'#039't be inline.'#000+
    +  '06031_E_Object or class methods can'#039't be inline.'#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+
    -  '06037_E_Constructors or destructors can','not be called inside a '#039'w'+
    -  'ith'#039' clause'#000+
    +  'sed,',' 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+
       '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+
    -  '06041_W_Parameters size exceeds lim','it for certain cpu'#039's'#000+
    +  '06040_E_Control flow statements aren'#039,'t allowed in a finally block'+
    +  #000+
    +  '06041_W_Parameters size exceeds limit 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+
    -  '06046_F_Unknown compilerproc "$1". Check if you use ','the correct run '+
    -  'time library.'#000+
    +  '06045_E_CONTINUE ','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 run'+
       ' time library.'#000+
       '06048_H_Inherited call to abstract method ignored'#000+
    -  '06049_E_Goto label "$1" not defined or optimized away'#000+
    -  '06050_F_Cannot find t','ype "$1" in unit "$2". Check if you use the cor'+
    -  'rect run time library.'#000+
    +  '06049_E_Got','o 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 time library.'#000+
       '06051_E_Interprocedural gotos are allowed only to outer subroutines'#000+
    -  '06052_E_Label must be defined in the same scope as it is declared'#000+
    -  '06053_E_Leaving procedures containin','g explicit or implicit exception'+
    -  's frames using goto is not allowed'#000+
    +  '06052_E_Label must be defined in the s','ame scope as it is declared'#000+
    +  '06053_E_Leaving procedures containing explicit or implicit exceptions '+
    +  'frames using goto is not allowed'#000+
       '06054_E_In ISO mode, the mod operator is defined only for positive quo'+
       'tient'#000+
       '06055_DL_Auto inlining: $1'#000+
    -  '07000_DL_Starting $1 styled assembler parsing'#000+
    -  '07001_DL_Finished $1 sty','led assembler parsing'#000+
    +  '07000_','DL_Starting $1 styled assembler parsing'#000+
    +  '07001_DL_Finished $1 styled assembler parsing'#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 without identifier'#000+
    -  '07007_E_Cannot use local variable or parameters here'#000+
    -  '07008_E_need to',' use OFFSET here'#000+
    +  '0700','7_E_Cannot use local variable or parameters here'#000+
    +  '07008_E_need to use OFFSET here'#000+
       '07009_E_need to use $ here'#000+
       '07010_E_Cannot use multiple relocatable symbols'#000+
       '07011_E_Relocatable symbol can only be added'#000+
       '07012_E_Invalid constant expression'#000+
    -  '07013_E_Relocatable symbol is not allowed'#000+
    -  '07014_E_Invalid reference',' syntax'#000+
    +  '070','13_E_Relocatable symbol is not allowed'#000+
    +  '07014_E_Invalid reference syntax'#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+
    -  '07018_W_Possible error in object field handling'#000+
    -  '07019_E_Wrong scale factor specified'#000,
    +  '07018_W_Possible erro','r in object field handling'#000+
    +  '07019_E_Wrong scale factor specified'#000+
       '07020_E_Multiple index register usage'#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 referen','ces are not allowed'#000+
       '07025_E_Divide by zero in asm evaluator'#000+
    -  '0702','6_E_Illegal expression'#000+
    +  '07026_E_Illegal expression'#000+
       '07027_E_escape 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+
    -  '07031_W_ENTER instruction is not supported by ','Linux kernel'#000+
    +  '07030_W_$1 without operand tr','anslated into $1P'#000+
    +  '07031_W_ENTER instruction is not supported by Linux kernel'#000+
       '07032_W_Calling an overload 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 b','inary $1'#000+
    +  '07037_E_Error converting binary $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 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+
    +  '07042_E','_Cannot use OLDEBP outside a nested procedure'#000+
    +  '07043_W_Procedures can'#039't return any value in asm code'#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 destination 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 com','bination of opcode and operands'#000+
    +  '07048_E_Invalid combination of opcode and operands'#000+
       '07049_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 pointer'#000+
    -  '07053_E_Unrecognize','d opcode $1'#000+
    +  '07052_W_constant with sym','bol $1 for address which is not on a pointe'+
    +  'r'#000+
    +  '07053_E_Unrecognized opcode $1'#000+
       '07054_E_Invalid or missing opcode'#000+
       '07055_E_Invalid combination of prefix and opcode: $1'#000+
       '07056_E_Invalid combination of override and opcode: $1'#000+
    -  '07057_E_Too many operands on line'#000+
    +  '07057_E_Too many opera','nds on line'#000+
       '07058_W_NEAR ignored'#000+
       '07059_W_FAR ignored'#000+
    -  '07060_E_Dup','licate local symbol $1'#000+
    +  '07060_E_Duplicate local symbol $1'#000+
       '07061_E_Undefined local symbol $1'#000+
       '07062_E_Unknown label identifier $1'#000+
       '07063_E_Invalid register name'#000+
       '07064_E_Invalid floating point register name'#000+
    -  '07066_W_Modulo not supported'#000+
    -  '07067_E_Invalid floating point constant $1'#000,
    +  '07066_W_','Modulo not supported'#000+
    +  '07067_E_Invalid floating point constant $1'#000+
       '07068_E_Invalid floating point expression'#000+
       '07069_E_Wrong symbol type'#000+
       '07070_E_Cannot index a local var or parameter with a register'#000+
       '07071_E_Invalid segment override expression'#000+
    -  '07072_W_Identifier $1 supposed external'#000+
    -  '07073_E_Strings not allowe','d as constants'#000+
    +  '07','072_W_Identifier $1 supposed external'#000+
    +  '07073_E_Strings not allowed as constants'#000+
       '07074_E_No type of variable specified'#000+
       '07075_E_assembler code not returned to text section'#000+
       '07076_E_Not a directive or local symbol $1'#000+
    -  '07077_E_Using a defined name as a local label'#000+
    -  '07078_E_Dollar token is used without an identi','fier'#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+
       '07080_N_.align is target specific, use .balign or .p2align'#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 op'+
    -  'erands'#000+
    +  '07082_E_Can'#039't acc','ess fields of objects/classes directly'#000+
    +  '07083_E_No size specified and unable to determine the size of the oper'+
    +  'ands'#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+
    -  '07088_W_"$1 %st(n)" translated int','o "$1 %st(n),%st"'#000+
    +  '07087_W_"$1 %st(n)" tr','anslated 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+
       '07090_E_Char > not allowed here'#000+
       '07093_W_ALIGN not supported'#000+
       '07094_E_Inc and Dec cannot be together'#000+
    -  '07095_E_Invalid reglist for movem'#000+
    +  '07095_E_Invalid reglist for',' movem'#000+
       '07096_E_Reglist invalid for opcode'#000+
    -  '07097_E_Higher cpu mod','e required ($1)'#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+
    +  '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+
    -  '07','101_W_No size specified and unable to determine the size of the op'+
    -  'erands, using BYTE as default'#000+
    +  '07101_W_No size specified and unable to determine the size of the oper'+
    +  'ands, 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 convention'+
    -  #000+
    -  '07104_W_Use of -','offset(%ebp) is not recommended for local variable a'+
    -  'ccess'#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+
       '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, a'+
    -  'nd "$1" is not virtual'#000+
    -  '07107_E_Gener','ating PIC, but reference is not PIC-safe'#000+
    +  '07106_E_VMTOffset must be used in combinat','ion with a virtual method,'+
    +  ' and "$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+
    -  '07110_W_@GOTPCREL is useless and potentially dangereous for local symb'+
    -  'ols'#000+
    -  '07111_W_Con','stant with general purpose segment register'#000+
    +  '07110_W_@GOTPCREL is ','useless and potentially dangereous for local sy'+
    +  'mbols'#000+
    +  '07111_W_Constant with general purpose segment register'#000+
       '07112_E_Invalid offset value for $1'#000+
       '07113_E_Invalid register for $1'#000+
    -  '07114_E_SEH directives are allowed only in pure assembler procedures'#000+
    -  '07115_E_Directive "$1" is not supported for the current tar','get'#000+
    +  '07114_E_SEH directives are allowed only in pure assembler proced','ures'+
    +  #000+
    +  '07115_E_Directive "$1" is not supported for the current target'#000+
       '07116_E_This function'#039's result location cannot be encoded directly'+
       ' in a single operand when "nostackframe" is used'#000+
    -  '07117_E_GOTPCREL references in Intel assembler syntax cannot contain a'+
    -  ' base or index register, and their offset must 0.'#000+
    -  '0','7118_E_The current target does not support GOTPCREL relocations'#000+
    +  '07117_E_GOTPCREL references in Intel assembler syntax can','not contain'+
    +  ' a base or index register, and their offset must 0.'#000+
    +  '07118_E_The current target does not support GOTPCREL relocations'#000+
       '07119_W_Exported/global symbols should accessed via the GOT'#000+
       '07120_W_Check size of memory operand "$1"'#000+
    -  '07121_W_Check size of memory operand "$1: memory-operand-size is $2 bi'+
    -  'ts, ','but expected [$3 bits]"'#000+
    +  '07121_W_Ch','eck size of memory operand "$1: memory-operand-size is $2 '+
    +  'bits, but expected [$3 bits]"'#000+
       '07122_W_Check size of memory operand "$1: memory-operand-size is $2 bi'+
       'ts, but expected [$3 bits + $4 byte offset]"'#000+
    -  '07123_W_Check "$1: offset of memory operand is negative "$2 byte"'#000+
    -  '07124_W_Check "$1: size of memory o','perand is empty, but es exists di'+
    -  'fferent definitions of the memory size =>> map to $2 (smallest option)'+
    -  '"'#000+
    +  '07123_W_Check "$1: offset of memory o','perand is negative "$2 byte"'#000+
    +  '07124_W_Check "$1: size of memory operand is empty, but es exists diff'+
    +  'erent definitions of the memory size =>> map to $2 (smallest option)"'#000+
       '07125_E_Invalid register used in memory reference expression: "$1"'#000+
    -  '08000_F_Too many assembler files'#000+
    -  '08001_F_Selected assembler output n','ot supported'#000+
    +  '0800','0_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+
       '08004_E_Allocating of data is only allowed in bss section'#000+
    -  '08005_F_No binary writer selected'#000+
    +  '08005_F_No binary writer selecte','d'#000+
       '08006_E_Asm: Opcode $1 not in table'#000+
    -  '08007_E_Asm: $1 invalid co','mbination of opcode and operands'#000+
    +  '08007_E_Asm: $1 invalid combination of opcode and operands'#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+
    -  '08012_E_Asm: Short jump is out of rang','e $1'#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+
       '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 he','re'#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+
       '08021_E_Asm: 64 Bit operands not supported'#000+
    -  '08022_E_Asm: AH,BH,CH or DH cannot be used in an instruction requiring'+
    -  ' REX prefix'#000+
    -  '08023_E_Missing .seh_endprol','ogue directive'#000+
    +  '08022_E_Asm: AH,BH,CH or DH cannot be used in ','an instruction requiri'+
    +  'ng REX prefix'#000+
    +  '08023_E_Missing .seh_endprologue directive'#000+
       '08024_E_Function prologue exceeds 255 bytes'#000+
       '08025_E_.seh_handlerdata directive without preceding .seh_handler'#000+
    -  '08026_F_Relocation count for section $1 exceeds 65535'#000+
    +  '08026_F_Relocation count for section $1 exceeds 655','35'#000+
       '09000_W_Source operating system redefined'#000+
    -  '09001_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 (error code: $2)'#000+
       '09004_E_Can'#039't create archive file: $1'#000+
    -  '09005_E_Assembler $1 not found, switching to external assembling'#000+
    +  '09005_E_Assembler $1 not found, sw','itching 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+
    -  '09010_I_Assembling with smartlinking $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+
       '09015_I_Linking $1'#000+
    -  '09016_E_Util $1 not found, switching to external linking'#000+
    +  '09016_E_Util $1 not found, switchin','g to external linking'#000+
       '09017_T_Using util $1'#000+
    -  '09018_E_Creation of ','Executables 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 m','ode'+
    +  #000+
       '09022_I_Compiling resource $1'#000+
    -  '09023_T_unit $1 can'#039't be stati','cally 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+
    +  'g'#000,
       '09026_E_unit $1 can'#039't be smart or static linked'#000+
    -  '09027_E_unit $1 ','can'#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+
    -  '09030_E_Can'#039't call the resource compiler "$1", switching to extern'+
    -  'al mode'#000+
    -  '09031_E_Can'#039't open resource ','file "$1"'#000+
    +  '09030_E_Can'#039't call the resource compil','er "$1", switching to exte'+
    +  'rnal mode'#000+
    +  '09031_E_Can'#039't open resource file "$1"'#000+
       '09032_E_Can'#039't write resource file "$1"'#000+
       '09033_N_File "$1" not found for backquoted cat command'#000+
       '09034_W_"$1" not found, this will probably cause a linking failure'#000+
    -  '09128_F_Can'#039't post process executable $1'#000+
    -  '09129_F_Can'#039't open executabl','e $1'#000+
    +  '09128','_F_Can'#039't post process 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+
       '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+
    +  '09134_X_Stack',' space committed: $1 bytes'#000+
    +  '09200_F_Executable image size is too big 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+
       '10002_U_PPU Name: $1'#000+
    -  '10003_U_PPU Flags: $1'#000+
    +  '10003_U_PPU F','lags: $1'#000+
       '10004_U_PPU Crc: $1'#000+
       '10005_U_PPU Time: $1'#000+
    -  '10006_U_PPU Fi','le too short'#000+
    +  '10006_U_PPU File 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 another processor'#000+
    -  '10010_U_PPU is compiled for another target'#000+
    +  '10010_U_PPU is compiled for another t','arget'#000+
       '10011_U_PPU Source: $1'#000+
       '10012_U_Writing $1'#000+
    -  '10013_F_Can'#039't Wr','ite PPU-File'#000+
    +  '10013_F_Can'#039't Write 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_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+
    +  '10','019_F_Too much units'#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 found but $2 exists'#000+
    -  '10024_F_Unit $1 searched but $2 found'#000+
    +  '10024_F_Unit $1 searched but $2 fou','nd'#000+
       '10025_W_Compiling the system unit requires the -Us switch'#000+
    -  '100','26_F_There were $1 errors compiling module, stopping'#000+
    +  '10026_F_There were $1 errors compiling module, stopping'#000+
       '10027_U_Load from $1 ($2) unit $3'#000+
       '10028_U_Recompiling $1, checksum changed for $2'#000+
    -  '10029_U_Recompiling $1, source found only'#000+
    +  '10029_U_Recompiling $1, source found only',#000+
       '10030_U_Recompiling unit, static lib is older than ppufile'#000+
    -  '1003','1_U_Recompiling unit, shared lib is older than ppufile'#000+
    +  '10031_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+
    -  '10034_U_Parsing interface of $1'#000+
    +  '10034_U_Pars','ing 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+
    -  '10041_U_File $1 is newer than the one used for creating PPU file $2'#000+
    -  '10042_U_Trying to use a unit which was compiled ','with a different FPU'+
    -  ' mode'#000+
    +  '10041_U_File $1 is newer than the one used for creat','ing PPU file $2'#000+
    +  '10042_U_Trying to use a unit which was compiled with a different FPU m'+
    +  '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+
    -  '10046_U_Implementation 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 depends 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+
       '10052_U_Forced reloading'#000+
    -  '10053_U_Previous state of $1: $2'#000+
    -  '10054_U_Already compiling $1, set','ting second compile'#000+
    +  '10','053_U_Previous state of $1: $2'#000+
    +  '10054_U_Already compiling $1, setting second compile'#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_Skipping re-resolving unit $1, still loading used units'#000+
    -  '10060_U_Unloading resource unit $1 (no','t needed)'#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 (object','s/classes) CRC changed for unit $1'+
    -  #000+
    +  'wpo feedback input file fo','r 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+
    -  '11002_W_DEF file can be created only for OS/2'#000+
    -  '11003_E_nested response ','files are not supported'#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+
       '11005_N_No option inside $1 config file'#000+
       '11006_E_Illegal parameter: $1'#000+
       '11007_H_-? writes help pages'#000+
    -  '11008_F_Too many config files nested'#000+
    +  '11008_F_T','oo 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} encou'+
    -  'ntered'#000+
    -  '11014_F_In options f','ile $1 at line $2 unexpected \var{\#ENDIFs} enco'+
    -  'untered'#000+
    +  '11013_F_In options file $1 at lin','e $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+
       '11015_F_Open conditional at the end of the options file'#000+
    -  '11016_W_Debug information generation is not supported by this executab'+
    -  'le'#000+
    +  '11016_W_Debug information generation is not supported by this ex','ecut'+
    +  'able'#000+
       '11017_H_Try recompiling with -dGDB'#000+
    -  '11018_W_You are usin','g the obsolete switch $1'#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+
    -  '11021_W_Assembler output selected "$1" is not compatible with "$2"'#000+
    -  '11022_W_"$1" assembler u','se forced'#000+
    +  '11021_W_Assembler output se','lected "$1" is not compatible with "$2"'#000+
    +  '11022_W_"$1" assembler use forced'#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+
    -  '11030_H_Start of reading config file $1'#000+
    +  '11030_H_Start of reading con','fig file $1'#000+
       '11031_H_End of reading config file $1'#000+
    -  '11032_D_interp','reting option "$1"'#000+
    +  '11032_D_interpreting 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 source file name "$1"'#000+
    -  '11039_E_Unknown codepage "$1"'#000+
    +  '11039_E','_Unknown codepage "$1"'#000+
       '11040_F_Config file $1 is a directory'#000+
    -  '110','41_W_Assembler output selected "$1" cannot generate debug info, d'+
    -  'ebugging disabled'#000+
    +  '11041_W_Assembler output selected "$1" cannot generate debug info, deb'+
    +  'ugging disabled'#000+
       '11042_W_Use of ppc386.cfg is deprecated, please use fpc.cfg instead'#000+
    -  '11043_F_In options file $1 at line $2 \var{\#ELSE} directive without \'+
    -  'var{\#IF(N)DEF} fou','nd'#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 targe'+
       't 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 ',
    -  'this target, switching to static linking'#000+
    +  '11046','_N_DWARF debug information cannot be used with smart linking on'+
    +  ' this target, switching to static linking'#000+
       '11047_W_Option "$1" is ignored for the current target platform.'#000+
       '11048_W_Disabling external debug information because it is unsupported'+
    -  ' for the selected target/debug format combination.'#000+
    -  '11049_N_DWARF ','debug information cannot be used with smart linking wi'+
    -  'th external assembler, disabling static library creation.'#000+
    -  '11050_E_Invalid value for MACOSX_DEPLOYMENT_TARGET environment variabl'+
    -  'e: $1'#000+
    -  '11051_E_Invalid value for IPHONEOS_DEPLOYMENT_TARGET',' environment var'+
    -  'iable: $1'#000+
    +  ' ','for the selected target/debug format combination.'#000+
    +  '11049_N_DWARF debug information cannot be used with smart linking with'+
    +  ' external assembler, disabling static library creation.'#000+
    +  '11050_E_Invalid value for MACOSX_DEPLOYMENT_TARGET environment v','aria'+
    +  'ble: $1'#000+
    +  '11051_E_Invalid value for IPHONEOS_DEPLOYMENT_TARGET environment varia'+
    +  'ble: $1'#000+
       '11052_E_You must use a FPU type of VFPV2, VFPV3 or VFPV3_D16 when usin'+
       'g the EABIHF ABI target'#000+
    -  '11053_W_The selected debug format is not supported on the current targ'+
    -  'et, not changing the current setting'#000+
    -  '12000_F_Canno','t open whole program optimization feedback file "$1"'#000+
    +  '11053_W_The selected debug format is not supported on th','e current ta'+
    +  'rget, not changing the current setting'#000+
    +  '12000_F_Cannot open whole program optimization 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 information'+
    -  ' in wpo feedback file "$1"'#000+
    -  '12003_','E_Expected section header, but got "$2" at line $1 of wpo feed'+
    -  'back file'#000+
    +  '12002_D_Finished processing the whole p','rogram 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+
       '12004_W_No handler registered for whole program optimization section "'+
    -  '$2" at line $1 of wpo feedback file, ignoring'#000+
    -  '12005_D_Found whole program optimization section "$1','" with informati'+
    -  'on about "$2"'#000+
    +  '$2" at line $1 of wpo feedback fil','e, 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_No collected information necessary to perform "$1" whole progr'+
    -  'am optimization found'#000+
    -  '120','08_F_Specify a whole program optimization feedback file to store '+
    -  'the generated info in (using -FW)'#000+
    +  '12007_E_No collected informatio','n 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 information, yet'+
    -  ' a feedback file was specified (using -FW)'#000+
    -  '12010_E_Not performing any w','hole program optimizations, yet an input'+
    -  ' feedback file was specified (using -Fw)'#000+
    +  ' a feed','back 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+
       '12011_D_Skipping whole program optimization section "$1", because not '+
    -  'needed by the requested optimizations'#000+
    -  '12012_W_Overriding previously read information for ','"$1" from feedbac'+
    -  'k input file using information in section "$2"'#000+
    +  'needed by the requested o','ptimizations'#000+
    +  '12012_W_Overriding previously read information for "$1" from feedback '+
    +  'input file using information in section "$2"'#000+
       '12013_E_Cannot extract symbol liveness information from program when s'+
       'tripping symbols, use -Xs-'#000+
    -  '12014_E_Cannot extract symbol liveness information from program when w'+
    -  'hen not l','inking'#000+
    +  '12014_E_Cannot ','extract symbol liveness information from program when'+
    +  ' when 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 information produced by "'+
       '$1"'#000+
    -  '12017_F_Error executing "$1" (exitcode: $2) to extract symbol infor','m'+
    +  '120','17_F_Error executing "$1" (exitcode: $2) to extract symbol inform'+
       'ation 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 specified whole program optimisation feedback fi'+
    -  'le "$1"'#000+
    -  '11023_Free Pascal Compiler versio','n $FPCFULLVERSION [$FPCDATE] for $F'+
    -  'PCCPU'#010+
    +  '12019_E_Cannot create specified whole program o','ptimisation feedback '+
    +  'file "$1"'#000+
    +  '11023_Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPC'+
    +  'CPU'#010+
       'Copyright (c) 1993-2013 by Florian Klaempfl and others'#000+
       '11024_Free Pascal Compiler version $FPCVERSION'#010+
       #010+
       'Compiler Date      : $FPCDATE'#010+
    -  'Compiler CPU Target: $FPCCPU'#010+
    +  'Co','mpiler CPU Target: $FPCCPU'#010+
       #010+
       'Supported targets:'#010+
       '  $OSTARGETS'#010+
       #010+
    -  'Sup','ported CPU instruction sets:'#010+
    +  'Supported CPU instruction sets:'#010+
       '  $INSTRUCTIONSETS'#010+
       #010+
       'Supported FPU instruction sets:'#010+
    @@ -1204,11 +1209,11 @@ const msgtxt : array[0..000287,1..240] of char=(
       '  $ABITARGETS'#010+
       #010+
       'Supported Optimizations:'#010+
    -  '  $OPTIMIZATIONS'#010+
    +  '  $OPTIMI','ZATIONS'#010+
       #010+
       'Supported Whole Program Optimizations:'#010+
       '  All'#010+
    -  '  $WPOPTIM','IZATIONS'#010+
    +  '  $WPOPTIMIZATIONS'#010+
       #010+
       'Supported Microcontroller types:'#010+
       '  $CONTROLLERTYPES'#010+
    @@ -1216,248 +1221,248 @@ const msgtxt : array[0..000287,1..240] of char=(
       'This program comes under the GNU General Public Licence'#010+
       'For more information read COPYING.v2'#010+
       #010+
    -  'Please report bugs in our bug tracker on:'#010+
    -  '                 http://bugs.freepascal.o','rg'#010+
    +  'Please report bugs ','in our bug tracker on:'#010+
    +  '                 http://bugs.freepascal.org'#010+
       #010+
       'More information may be found on our WWW pages (including directions'#010+
       'for mailing lists useful for asking questions or discussing potential'#010+
       'new features, etc.):'#010+
    -  '                 http://www.freepascal.org'#000+
    -  '11025_**0*_Put + after a boolean ','switch option to enable it, - to di'+
    -  'sable it'#010+
    +  '            ','     http://www.freepascal.org'#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 assembler file'#010+
       '**2al_List sourcecode lines in assembler file'#010+
    -  '**2an_List node info in assembler file (-dEXTDEBUG compiler)'#010+
    -  '*L2ap_Use pipes instead of ','creating temporary assembler files'#010+
    +  '**2an_List node info in ','assembler file (-dEXTDEBUG compiler)'#010+
    +  '*L2ap_Use pipes instead of creating temporary assembler files'#010+
       '**2ar_List register allocation/release info in assembler file'#010+
       '**2at_List temp allocation/release info in assembler file'#010+
    -  '**1A<x>_Output format:'#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*2Anasmwin32_Win32 object file using Nasm'#010+
    -  '3*2Anasmwdosx_Win32/WDOSX object file using Nasm'#010,
    +  '3*2Anasmwin32_Win32 object f','ile 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*2Atasm_Obj file using Tasm (Borland)'#010+
    -  '3*2Aelf_ELF (Linux) using internal writer'#010+
    +  '3*2Aelf_ELF (Linux) using ','internal writer'#010+
       '3*2Acoff_COFF (Go32v2) using internal writer'#010+
    -  '3*2','Apecoff_PE-COFF (Win32) using internal writer'#010+
    +  '3*2Apecoff_PE-COFF (Win32) using internal writer'#010+
       '4*2Aas_Assemble using GNU AS'#010+
       '4*2Agas_Assemble using GNU GAS'#010+
       '4*2Agas-darwin_Assemble darwin Mach-O64 using GNU GAS'#010+
    -  '4*2Amasm_Win64 object file using ml64 (Microsoft)'#010+
    -  '4*2Apecoff_PE-COFF (Win64) usi','ng internal writer'#010+
    +  '4*2Amasm_Win64 o','bject file using ml64 (Microsoft)'#010+
    +  '4*2Apecoff_PE-COFF (Win64) using internal writer'#010+
       '4*2Aelf_ELF (Linux-64bit) using internal writer'#010+
       '6*2Aas_Unix o-file using GNU AS'#010+
       '6*2Agas_GNU Motorola assembler'#010+
       '6*2Amit_MIT Syntax (old GAS)'#010+
    -  '6*2Amot_Standard Motorola assembler'#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_Build all modules'#010+
       '**1C<x>_Code generation options:'#010+
    -  '**2C3<x>_Turn on ieee error checking for constants'#010+
    -  '**2Ca<x>_Select ABI, see fpc -i',' for possible values'#010+
    +  '**2C3<x>_Turn on i','eee error checking for constants'#010+
    +  '**2Ca<x>_Select ABI, see fpc -i for possible values'#010+
       '**2Cb_Generate code for a big-endian variant of the target architectur'+
       'e'#010+
       '**2Cc<x>_Set default calling convention to <x>'#010+
    -  '**2CD_Create also dynamic library (not supported)'#010+
    -  '**2Ce_Compilation with emulated floating point opc','odes'#010+
    +  '**2CD_Create also dynamic library (n','ot supported)'#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+
       '**2CF<x>_Minimal floating point constant precision (default, 32, 64)'#010+
       '**2Cg_Generate PIC code'#010+
    -  '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+
    -  '**2Ci_IO-checki','ng'#010+
    +  '**2','Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+
    +  '**2Ci_IO-checking'#010+
       '**2Cn_Omit linking stage'#010+
       'P*2CN_Generate nil-pointer checks (AIX-only)'#010+
       '**2Co_Check overflow of integer operations'#010+
       '**2CO_Check for possible overflow of integer operations'#010+
    -  '**2Cp<x>_Select instruction set, see fpc -i for possible values'#010+
    -  '**2C','P<x>=<y>_ packing settings'#010+
    +  '**2C','p<x>_Select instruction set, see fpc -i for possible values'#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_Verify object method call validity'#010+
    -  '**2Cs<n>_Set stack checking size to <n>'#010+
    -  '**2Ct_Stack checking (for testing o','nly, see manual)'#010+
    +  '**2Cs<n>_Se','t stack checking size to <n>'#010+
    +  '**2Ct_Stack checking (for testing only, see manual)'#010+
       'p*2CT<x>_Target-specific code generation options'#010+
       'P*2CT<x>_Target-specific code generation options'#010+
       'J*2CT<x>_Target-specific code generation options'#010+
    -  'A*2CT<x>_Target-specific code generation options'#010+
    -  'p*3CTsmalltoc_ Generate sma','ller TOCs at the expense of execution spe'+
    -  'ed (AIX)'#010+
    +  'A*2CT<x>_Tar','get-specific code generation options'#010+
    +  'p*3CTsmalltoc_ Generate smaller TOCs at the expense of execution speed'+
    +  ' (AIX)'#010+
       'P*3CTsmalltoc_ Generate smaller TOCs at the expense of execution speed'+
       ' (AIX)'#010+
    -  'J*3CTcompactintarrayinit_ Generate smaller (but potentially slower) co'+
    -  'de for initializing integer array constants',#010+
    +  'J*3CTcompactintarrayinit_ Generate smaller (but p','otentially slower) '+
    +  'code for initializing integer array constants'#010+
       'J*3CTenumfieldinit_ Initialize enumeration fields in constructors to e'+
       'numtype(0), after calling inherited constructors'#010+
    -  'J*3CTautogetterprefix=X_ Automatically create getters for properties w'+
    -  'ith prefix X (empty string disables)'#010+
    -  'J*3CTautosett','erprefix=X_ Automatically create setters for properties'+
    +  'J*3CTautogetterprefix=X_ Automatically create getters fo','r properties'+
       ' with prefix X (empty string disables)'#010+
    +  'J*3CTautosetterprefix=X_ Automatically create setters for properties w'+
    +  'ith prefix X (empty string disables)'#010+
       'A*3CTthumbinterworking_ Generate Thumb interworking-safe code if possi'+
       'ble'#010+
    -  'J*2Cv_Var/out parameter copy-out checking'#010+
    -  '**2CX_Create also smartlinked ','library'#010+
    +  'J*2Cv_Va','r/out parameter copy-out checking'#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+
       '**2Dv<x>_Set DLL version to <x>'#010+
       '*O2Dw_PM application'#010+
    -  '**1e<x>_Set path to executable'#010+
    +  '**1e<x>_Set path to executa','ble'#010+
       '**1E_Same as -Cn'#010+
       '**1fPIC_Same as -Cg'#010+
    -  '**1F<x>_Set file names ','and paths:'#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+
       '**2Fc<x>_Set input codepage to <x>'#010+
       '**2FC<x>_Set RC compiler binary name to <x>'#010+
    -  '**2Fd_Disable the compiler'#039's internal directory cache'#010+
    -  '**2FD<x>_Set the direc','tory where to search for compiler utilities'#010+
    +  '**2Fd_Disabl','e 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+
       '**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+
    +  '**2F','i<x>_Add <x> to include path'#010+
       '**2Fl<x>_Add <x> to library path'#010+
    -  '**','2FL<x>_Use <x> as dynamic linker'#010+
    +  '**2FL<x>_Use <x> as dynamic linker'#010+
       '**2Fm<x>_Load unicode conversion table from <x>.txt in the compiler di'+
       'r'#010+
       '**2Fo<x>_Add <x> to object path'#010+
       '**2Fr<x>_Load error message file <x>'#010+
    -  '**2FR<x>_Set resource (.res) linker to <x>'#010+
    -  '**2Fu<x>_Add <x> to uni','t path'#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>_Load previously stored whole-program optimization feedback fr'+
    -  'om <x>'#010+
    -  '*g1g_Generate debug information (def','ault format for target)'#010+
    +  '**2Fw<x>_Load previously stored whole-program opt','imization feedback '+
    +  'from <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+
    -  '*g2gl_Use line info unit (show more info with backtraces)'#010+
    +  '*g2gl_Use line info unit (show more info with backtra','ces)'#010+
       '*g2go<x>_Set debug information options'#010+
    -  '*g3godwarfsets_ Enab','le DWARF '#039'set'#039' type debug information (b'+
    -  'reaks gdb < 6.5)'#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+
    -  '*g3godwarfmethodclassprefix_ Prefix method names in DWARF with class n'+
    -  'ame'#010+
    -  '*g2gp_Preserve case in stabs symbol na','mes'#010+
    +  '*g3godwarfmethodclassprefix_ Prefix method names',' in DWARF with class'+
    +  ' name'#010+
    +  '*g2gp_Preserve case in stabs symbol names'#010+
       '*g2gs_Generate Stabs debug information'#010+
       '*g2gt_Trash local variables (to detect uninitialized uses)'#010+
       '*g2gv_Generates programs traceable with Valgrind'#010+
    -  '*g2gw_Generate DWARFv2 debug information (same as -gw2)'#010+
    -  '*g2gw2_Generate DWARFv2 debug inf','ormation'#010+
    +  '*g2gw_Generate DWARFv2 de','bug information (same as -gw2)'#010+
    +  '*g2gw2_Generate DWARFv2 debug information'#010+
       '*g2gw3_Generate DWARFv3 debug information'#010+
       '*g2gw4_Generate DWARFv4 debug information (experimental)'#010+
       '**1i_Information'#010+
       '**2iD_Return compiler date'#010+
    -  '**2iV_Return short compiler version'#010+
    +  '**2iV_Return short compi','ler version'#010+
       '**2iW_Return full compiler version'#010+
    -  '**2iSO_Return com','piler OS'#010+
    +  '**2iSO_Return compiler OS'#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+
       '**1k<x>_Pass <x> to the linker'#010+
    -  '**1l_Write logo'#010+
    +  '**1l_Write ','logo'#010+
       '**1M<x>_Set language mode to <x>'#010+
    -  '**2Mfpc_Free Pascal dialec','t (default)'#010+
    +  '**2Mfpc_Free Pascal dialect (default)'#010+
       '**2Mobjfpc_FPC mode with Object Pascal support'#010+
       '**2Mdelphi_Delphi 7 compatibility mode'#010+
       '**2Mtp_TP/BP 7.0 compatibility mode'#010+
    -  '**2Mmacpas_Macintosh Pascal dialects compatibility mode'#010+
    +  '**2Mmacpas_Macintosh Pascal dialects compa','tibility mode'#010+
       '**1n_Do not read the default config files'#010+
    -  '**1o<x>_','Change the name of the executable produced to <x>'#010+
    +  '**1o<x>_Change the name of the executable produced to <x>'#010+
       '**1O<x>_Optimizations:'#010+
       '**2O-_Disable optimizations'#010+
       '**2O1_Level 1 optimizations (quick and debugger friendly)'#010+
    -  '**2O2_Level 2 optimizations (-O1 + quick optimizations)'#010+
    -  '**2O3_Level 3 optimizatio','ns (-O2 + slow optimizations)'#010+
    +  '**2O2_Level 2 opt','imizations (-O1 + quick optimizations)'#010+
    +  '**2O3_Level 3 optimizations (-O2 + slow optimizations)'#010+
       '**2O4_Level 4 optimizations (-O3 + optimizations which might have unex'+
       'pected side effects)'#010+
       '**2Oa<x>=<y>_Set alignment'#010+
    -  '**2Oo[NO]<x>_Enable or disable optimizations, see fpc -i for possible '+
    -  'values'#010+
    -  '**2Op<x>_Set ta','rget cpu for optimizing, see fpc -i for possible valu'+
    -  'es'#010+
    +  '**2Oo[NO]<x>_Enable or disab','le optimizations, see fpc -i for possibl'+
    +  'e values'#010+
    +  '**2Op<x>_Set target cpu for optimizing, see fpc -i for possible values'+
    +  #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 valu','es'#010+
    +  '**2Ow<x>_Perf','orm whole-program optimization <x>, see fpc -i for poss'+
    +  'ible values'#010+
       '**2Os_Optimize for size rather than speed'#010+
       '**1pg_Generate profile code for gprof (defines FPC_PROFILE)'#010+
       'F*1P<x>_Target CPU / compiler related options:'#010+
    -  'F*2PB_Show default compiler binary'#010+
    +  'F*2PB_Show default compi','ler binary'#010+
       'F*2PP_Show default target cpu'#010+
    -  'F*2P<x>_Set target CPU ','(arm,i386,m68k,mips,mipsel,powerpc,powerpc64,'+
    -  'sparc,x86_64'#010+
    +  'F*2P<x>_Set target CPU (arm,i386,m68k,mips,mipsel,powerpc,powerpc64,sp'+
    +  'arc,x86_64'#010+
       '**1R<x>_Assembler reading style:'#010+
       '**2Rdefault_Use default assembler for target'#010+
       '3*2Ratt_Read AT&T style assembler'#010+
    -  '3*2Rintel_Read Intel style assembler'#010+
    -  '6*2RMOT_Read motorola style assem','bler'#010+
    +  '3*2Rin','tel_Read Intel style assembler'#010+
    +  '6*2RMOT_Read motorola style assembler'#010+
       '**1S<x>_Syntax options:'#010+
       '**2S2_Same as -Mobjfpc'#010+
       '**2Sc_Support operators like C (*=,+=,/= and -=)'#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 af','ter the <n> errors (default is 1)'#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*_w : Compiler also halts after warnings'#010+
       '**3*_n : Compiler also halts after notes'#010+
       '**3*_h : Compiler also halts after hints'#010+
    -  '**2Sg_Enable LABEL and GOTO (default in -Mtp and -Mdelphi)'#010+
    -  '**2Sh_Use reference c','ounted strings (ansistring by default) instead '+
    -  'of shortstrings'#010+
    +  '**2Sg_Enable LAB','EL and GOTO (default in -Mtp and -Mdelphi)'#010+
    +  '**2Sh_Use reference counted strings (ansistring by default) instead of'+
    +  ' shortstrings'#010+
       '**2Si_Turn on inlining of procedures/functions declared as "inline"'#010+
       '**2Sk_Load fpcylix unit'#010+
    -  '**2SI<x>_Set interface style to <x>'#010+
    +  '**2SI<x>_Set interfac','e style to <x>'#010+
       '**3SIcom_COM compatible interface (default)'#010+
    -  '**3SI','corba_CORBA compatible interface'#010+
    +  '**3SIcorba_CORBA compatible interface'#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+
    -  '**2Sy_@<pointer> returns',' a typed pointer, same as $T+'#010+
    +  '**2Sx_Enable exception ke','ywords (default in Delphi/ObjFPC modes)'#010+
    +  '**2Sy_@<pointer> returns a typed pointer, same as $T+'#010+
       '**1s_Do not call assembler and linker'#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+
    +  '**2sr_Skip register allocation',' phase (use with -alr)'#010+
       '**1T<x>_Target operating system:'#010+
    -  '3*2Tdarw','in_Darwin/Mac OS X'#010+
    +  '3*2Tdarwin_Darwin/Mac OS X'#010+
       '3*2Temx_OS/2 via EMX (including EMX/RSX extender)'#010+
       '3*2Tfreebsd_FreeBSD'#010+
       '3*2Tgo32v2_Version 2 of DJ Delorie DOS extender'#010+
    -  '3*2Tiphonesim_ iPhoneSimulator from iOS SDK 3.2+ (older versions: -Tda'+
    -  'rwin)'#010+
    +  '3*2Tiphonesim_ iPhoneSimulator from iOS',' SDK 3.2+ (older versions: -T'+
    +  'darwin)'#010+
       '3*2Tlinux_Linux'#010+
    -  '3*2Tnativen','t_Native NT API (experimental)'#010+
    +  '3*2Tnativent_Native NT API (experimental)'#010+
       '3*2Tnetbsd_NetBSD'#010+
       '3*2Tnetware_Novell Netware Module (clib)'#010+
       '3*2Tnetwlibc_Novell Netware Module (libc)'#010+
       '3*2Topenbsd_OpenBSD'#010+
    -  '3*2Tos2_OS/2 / eComStation'#010+
    +  '3*2Tos2_OS/2 / eComStati','on'#010+
       '3*2Tsunos_SunOS/Solaris'#010+
       '3*2Tsymbian_Symbian OS'#010+
    -  '3*2Tsolaris_So','laris'#010+
    +  '3*2Tsolaris_Solaris'#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*2Tdarwin_Darwin/Mac OS X'#010+
       '4*2Tlinux_Linux'#010+
    -  '4*2Twin64_Win64 (64 bit Windows systems)'#010+
    +  '4*2Twin64_','Win64 (64 bit Windows systems)'#010+
       '6*2Tamiga_Commodore Amiga'#010+
    -  '6*2Tata','ri_Atari ST/STe/TT'#010+
    +  '6*2Tatari_Atari ST/STe/TT'#010+
       '6*2Tlinux_Linux'#010+
       '6*2Tpalmos_PalmOS'#010+
       'A*2Tdarwin_Darwin/iPhoneOS/iOS'#010+
    @@ -1465,120 +1470,121 @@ const msgtxt : array[0..000287,1..240] of char=(
       'A*2Twince_Windows CE'#010+
       'P*2Tamiga_AmigaOS'#010+
       'P*2Tdarwin_Darwin/Mac OS X'#010+
    -  'P*2Tlinux_Linux'#010+
    +  'P*2Tlinux_','Linux'#010+
       'P*2Tmacos_Mac OS (classic)'#010+
       'P*2Tmorphos_MorphOS'#010+
    -  'S*2Tsolaris','_Solaris'#010+
    +  'S*2Tsolaris_Solaris'#010+
       'S*2Tlinux_Linux'#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 release unit files (nev','er 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*_n : Show notes                  t : Show tried/us','ed files'#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*_i : Show general info           d : Show debug info'#010+
    -  '**2*_l : Show linenumbers            r : Rhide/GCC compatibility mode'#010+
    -  '**2*_s : Show time stamps            q : Show',' message numbers'#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 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 debugging info'#010+
    +  '**2*_    with ful','l path              v : Write fpcdebug.txt with'#010+
    +  '**2*_                                    lots of debugging info'#010+
       '**2*_m<x>,<y> : Don'#039't show messages numbered <x> and <y>'#010+
       'F*1V<x>_Append '#039'-<x>'#039' to the used compiler binary name (e.g. f'+
    -  'or version)'#010+
    +  'or versio','n)'#010+
       '**1W<x>_Target-specific options (targets)'#010+
    -  '3*2WA_Specify nativ','e type application (Windows)'#010+
    +  '3*2WA_Specify native type application (Windows)'#010+
       '4*2WA_Specify native type application (Windows)'#010+
       'A*2WA_Specify native type application (Windows)'#010+
    -  '3*2Wb_Create 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_Creat','e a bundle instead of a library (Darwin)'#010+
    +  'p*2Wb_Create a bundle instead of a library (Darwin)'#010+
       'A*2Wb_Create a bundle instead of a library (Darwin)'#010+
       '4*2Wb_Create a bundle instead of a library (Darwin)'#010+
    -  '3*2WB_Create a relocatable image (Windows, Symbian)'#010+
    -  '3*2WBxxxx_Set image base to xxxx (Windows, ','Symbian)'#010+
    +  '3*2WB_Create a relocatable imag','e (Windows, Symbian)'#010+
    +  '3*2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+
       '4*2WB_Create a relocatable image (Windows)'#010+
       '4*2WBxxxx_Set image base to xxxx (Windows)'#010+
       'A*2WB_Create a relocatable image (Windows, Symbian)'#010+
    -  'A*2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+
    -  '3*2WC_Specify console type application (E','MX, OS/2, Windows)'#010+
    +  'A*2WBxxxx_Set image base to x','xxx (Windows, Symbian)'#010+
    +  '3*2WC_Specify console type application (EMX, OS/2, Windows)'#010+
       '4*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+
    -  '3*2WD_Use DEFFILE to export functions of DLL or EXE (Win','dows)'#010+
    +  'P*2WC_Specify console type application (Classic ','Mac OS)'#010+
    +  '3*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
       '4*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+
    -  'A*2We_Use external resources (Darw','in)'#010+
    +  '4*2We_Us','e external resources (Darwin)'#010+
    +  'A*2We_Use external resources (Darwin)'#010+
       'P*2We_Use external resources (Darwin)'#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+
    -  '4*2WG_Specify graphic type application (EMX, ','OS/2, Windows)'#010+
    +  '3*2WG_Specify graphic type application (E','MX, OS/2, Windows)'#010+
    +  '4*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 internal resources (Darwin)'#010+
    -  '4*2Wi_Use internal resources (Darwin)'#010+
    +  '4*2Wi_Use internal',' resources (Darwin)'#010+
       'A*2Wi_Use internal resources (Darwin)'#010+
    -  'P*2Wi_','Use internal resources (Darwin)'#010+
    +  'P*2Wi_Use internal resources (Darwin)'#010+
       'p*2Wi_Use internal resources (Darwin)'#010+
       '3*2WI_Turn on/off the usage of import sections (Windows)'#010+
    -  '4*2WI_Turn on/off the usage of import sections (Windows)'#010+
    -  'A*2WI_Turn on/off the usage of import sections (Windows)',#010+
    +  '4*2WI_Turn on/off the usage of import sections (W','indows)'#010+
    +  'A*2WI_Turn on/off the usage of import sections (Windows)'#010+
       '8*2Wm<x>_Set memory model'#010+
       '8*3WmTiny_Tiny memory model'#010+
       '8*3WmSmall_Small memory model (default)'#010+
       '3*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
       'n)'#010+
    -  '4*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
    -  'n)',#010+
    +  '4*2WM<x>','_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Dar'+
    +  'win)'#010+
       'p*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
       'n)'#010+
       'P*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
       'n)'#010+
    -  '3*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
    -  '4*2WN_Do not generate r','elocation code, needed for debugging (Windows'+
    +  '3*2WN_Do not generate relocat','ion code, needed for debugging (Windows'+
       ')'#010+
    +  '4*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
       'A*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
    -  'A*2Wpxxxx_Specify the controller type, see fpc -i for possible values'#010+
    -  'V*2Wpxxxx_Specify the controller type, see fpc -i for',' possible value'+
    +  'A*2Wpxxxx_Specify the controller type, see fpc -i for possi','ble value'+
       's'#010+
    +  'V*2Wpxxxx_Specify the controller type, see fpc -i for possible values'#010+
       '3*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ... (iphonesim)'#010+
       'A*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ... (Darwin)'#010+
    -  '3*2WR_Generate relocation code (Windows)'#010+
    +  '3*2WR_Generate relocatio','n code (Windows)'#010+
       '4*2WR_Generate relocation code (Windows)'#010+
    -  'A*2WR_','Generate relocation code (Windows)'#010+
    +  'A*2WR_Generate relocation code (Windows)'#010+
       'P*2WT_Specify MPW tool type application (Classic Mac OS)'#010+
       '**2WX_Enable executable stack (Linux)'#010+
       '**1X_Executable options:'#010+
    -  '**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Lin'+
    -  'ux)'#010+
    -  '**2Xd_Do no','t search default library path (sometimes required for cro'+
    -  'ss-compiling when not using -XR)'#010+
    +  '**2Xc_Pass --shared/-','dynamic to the linker (BeOS, Darwin, FreeBSD, L'+
    +  'inux)'#010+
    +  '**2Xd_Do not search default library path (sometimes required for cross'+
    +  '-compiling when not using -XR)'#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+
    +  '**2Xg_Create debuginfo in a separate file and add a debuglin','k sectio'+
    +  'n to executable'#010+
    +  '**2XD_Try to link units dynamically      (defines FPC_LINK_DYNAMIC)'#010+
       '**2Xi_Use internal linker'#010+
       '**2Xm_Generate link map'#010+
       '**2XM<x>_Set the name of the '#039'main'#039' program routine (default i'+
       's '#039'main'#039')'#010+
    -  'F*2Xp<x>_First search for the compiler binary in the directory <x>'#010+
    -  '**2XP<x>_Prepend the bi','nutils names with the prefix <x>'#010+
    +  'F*2Xp<x>_First search for ','the compiler binary in the directory <x>'#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, FreeBSD'+
    -  ', Linux, Mac',' OS, Solaris)'#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+
       '**2XS_Try to link units statically (default, defines FPC_LINK_STATIC)'#010+
    -  '**2Xt_Link with static libraries (-static is passed to linker)'#010+
    -  '**2XX_Try to smartlink units             (defines FPC','_LINK_SMART)'#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'
    diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
    index 91310ca..0d8f228 100644
    --- a/compiler/pdecsub.pas
    +++ b/compiler/pdecsub.pas
    @@ -965,7 +965,7 @@ implementation
                 symtablestack.top.insert(aprocsym);
               end;
     
    -        if procparsemode=ppm_anonymous_routine then
    +        if procparsemode in [ppm_anonymous_routine,ppm_method_reference] then
               begin
                 pd:=tprocdef.create(normal_function_level);
                 include(pd.procoptions,po_anonymous);
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index c05c103..2149c4f 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -2403,6 +2403,32 @@ implementation
                  result:=false;
                end;
     
    +         function is_captured(sym: tsym):boolean;
    +           var
    +             st : TSymtable;
    +             found : boolean;
    +             proccnt : integer;
    +             checkstack : psymtablestackitem = nil;
    +           begin
    +             if not assigned(current_procinfo) or
    +                not (sym.typ in [localvarsym,paravarsym]) then
    +               exit(false);
    +             checkstack:=symtablestack.stack;
    +             result:=true;
    +             found:=false;
    +             proccnt:=0; { TODO: find less tricky way }
    +             while not found and assigned(checkstack) do
    +               begin
    +                 st:=checkstack^.symtable;
    +                 if st.symtablelevel=normal_function_level then
    +                   inc(proccnt);
    +                 if sym.owner=st then
    +                   found:=true;
    +                 checkstack:=checkstack^.next;
    +               end;
    +             result:=(proccnt>2); // each procedure have 2 symtables
    +           end;
    +
              var
                srsym : tsym;
                srsymtable : TSymtable;
    @@ -2581,8 +2607,17 @@ implementation
                               p1:=csubscriptnode.create(srsym,p1);
                           end
                         else
    -                      { regular non-field load }
    -                      p1:=cloadnode.create(srsym,srsymtable);
    +                      begin
    +                        { regular non-field load }
    +                        if not is_captured(srsym) then
    +                          p1:=cloadnode.create(srsym,srsymtable)
    +                        else
    +                          begin
    +                            { Capture of local variables is forbidden. Will be supported with closures. }
    +                            message1(parser_e_proc_capture_not_allowed,srsym.realname);
    +                            p1:=cerrornode.create;
    +                          end;
    +                      end;
                       end;
     
                     syssym :
    -- 
    1.8.1.2
    
    
    From d2191f274443853b20ceabc98a187b5c84de2a74 Mon Sep 17 00:00:00 2001
    From: Vasiliy Kevroletin <kevroletin@gmail.com>
    Date: Mon, 3 Jun 2013 00:09:59 +1100
    Subject: [PATCH 3/4] Add modeswitch m_anonymous_proc.
    
    Restrict usage of anonymous functions by new modeswitch. Currently disabled for all modes.
    ---
     compiler/globtype.pas |  6 ++++--
     compiler/pexpr.pas    | 19 ++++++++++---------
     compiler/ptype.pas    |  2 +-
     3 files changed, 15 insertions(+), 12 deletions(-)
    
    diff --git a/compiler/globtype.pas b/compiler/globtype.pas
    index 570bb89..289cabe 100644
    --- a/compiler/globtype.pas
    +++ b/compiler/globtype.pas
    @@ -372,8 +372,9 @@ interface
              m_final_fields,        { allows declaring fields as "final", which means they must be initialised
                                       in the (class) constructor and are constant from then on (same as final
                                       fields in Java) }
    -         m_default_unicodestring { makes the default string type in $h+ mode unicodestring rather than
    +         m_default_unicodestring,{ makes the default string type in $h+ mode unicodestring rather than
                                        ansistring; similarly, char becomes unicodechar rather than ansichar }
    +         m_anonymous_procedure  { support anonymous functions }
            );
            tmodeswitches = set of tmodeswitch;
     
    @@ -536,7 +537,8 @@ interface
              'ISOUNARYMINUS',
              'SYSTEMCODEPAGE',
              'FINALFIELDS',
    -         'UNICODESTRINGS');
    +         'UNICODESTRINGS',
    +         'ANONYMOUSPROC');
     
     
          type
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index 2149c4f..6d49f0d 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -2410,7 +2410,8 @@ implementation
                  proccnt : integer;
                  checkstack : psymtablestackitem = nil;
                begin
    -             if not assigned(current_procinfo) or
    +             if not (m_anonymous_procedure in current_settings.modeswitches) or
    +                not assigned(current_procinfo) or
                     not (sym.typ in [localvarsym,paravarsym]) then
                    exit(false);
                  checkstack:=symtablestack.stack;
    @@ -3348,14 +3349,14 @@ implementation
                    consume(_RKLAMMER);
                    p1:=cinlinenode.create(in_objc_protocol_x,false,p1);
                  end;
    -
    -             // anonymous routine
    -             _PROCEDURE, _FUNCTION:
    -               if assigned(current_procinfo) then
    -                 p1:=parse_anonymous_routine(current_procinfo.procdef)
    -               else // TODO: support this later? Delphi doesn't
    -                 internalerror(20120121);
    -
    +           else
    +             if (token in [_PROCEDURE, _FUNCTION]) and
    +                (m_anonymous_procedure in current_settings.modeswitches) then
    +                begin
    +                  if not assigned(current_procinfo) then
    +                    internalerror(20120121);
    +                  p1:=parse_anonymous_routine(current_procinfo.procdef);
    +                end
                  else
                    begin
                      Message(parser_e_illegal_expression);
    diff --git a/compiler/ptype.pas b/compiler/ptype.pas
    index 70ee34b..3063173 100644
    --- a/compiler/ptype.pas
    +++ b/compiler/ptype.pas
    @@ -1685,7 +1685,7 @@ implementation
                  else
                    expr_type;
                _ID:
    -             if idtoken=_REFERENCE then
    +             if (idtoken=_REFERENCE) and (m_anonymous_procedure in current_settings.modeswitches) then
                    begin
                      consume(_REFERENCE); consume(_TO);
                      def:=procvar_dec(genericdef,genericlist);
    -- 
    1.8.1.2
    
    
    From 3439479a530c756d46112a0dbca01f1616e464bc Mon Sep 17 00:00:00 2001
    From: Vasiliy Kevroletin <kevroletin@gmail.com>
    Date: Fri, 31 May 2013 02:24:17 +1100
    Subject: [PATCH 4/4] Add tests for anonymous functions.
    
    Tests cover
    + basic usage of anonymous function
    + access of free variables *which is currently fail*(variables which are used in body but not parameters and not declared inside this function).
    + use of modeswitch
    + initialization of procvar in "var" section
    + test for ppu loading (anonymous function declared inside inline function)
    ---
     tests/test/tanonymproc1.pp   | 46 +++++++++++++++++++++++++++++
     tests/test/tanonymproc10.pp  | 30 +++++++++++++++++++
     tests/test/tanonymproc11.pp  | 22 ++++++++++++++
     tests/test/tanonymproc12.pp  | 22 ++++++++++++++
     tests/test/tanonymproc2.pp   | 70 ++++++++++++++++++++++++++++++++++++++++++++
     tests/test/tanonymproc3.pp   | 49 +++++++++++++++++++++++++++++++
     tests/test/tanonymproc4.pp   | 49 +++++++++++++++++++++++++++++++
     tests/test/tanonymproc5.pp   | 51 ++++++++++++++++++++++++++++++++
     tests/test/tanonymproc6.pp   | 31 ++++++++++++++++++++
     tests/test/tanonymproc7.pp   | 25 ++++++++++++++++
     tests/test/tanonymproc8.pp   | 19 ++++++++++++
     tests/test/tanonymproc9.pp   | 21 +++++++++++++
     tests/test/tfanonymproc1.pp  | 14 +++++++++
     tests/test/tfanonymproc10.pp |  9 ++++++
     tests/test/tfanonymproc11.pp | 19 ++++++++++++
     tests/test/tfanonymproc2.pp  | 14 +++++++++
     tests/test/tfanonymproc3.pp  | 14 +++++++++
     tests/test/tfanonymproc4.pp  | 15 ++++++++++
     tests/test/tfanonymproc5.pp  | 15 ++++++++++
     tests/test/tfanonymproc6.pp  | 13 ++++++++
     tests/test/tfanonymproc7.pp  | 12 ++++++++
     tests/test/tfanonymproc8.pp  | 25 ++++++++++++++++
     tests/test/tfanonymproc9.pp  | 25 ++++++++++++++++
     tests/test/uanonymproc1.pp   | 26 ++++++++++++++++
     24 files changed, 636 insertions(+)
     create mode 100644 tests/test/tanonymproc1.pp
     create mode 100644 tests/test/tanonymproc10.pp
     create mode 100644 tests/test/tanonymproc11.pp
     create mode 100644 tests/test/tanonymproc12.pp
     create mode 100644 tests/test/tanonymproc2.pp
     create mode 100644 tests/test/tanonymproc3.pp
     create mode 100644 tests/test/tanonymproc4.pp
     create mode 100644 tests/test/tanonymproc5.pp
     create mode 100644 tests/test/tanonymproc6.pp
     create mode 100644 tests/test/tanonymproc7.pp
     create mode 100644 tests/test/tanonymproc8.pp
     create mode 100644 tests/test/tanonymproc9.pp
     create mode 100644 tests/test/tfanonymproc1.pp
     create mode 100644 tests/test/tfanonymproc10.pp
     create mode 100644 tests/test/tfanonymproc11.pp
     create mode 100644 tests/test/tfanonymproc2.pp
     create mode 100644 tests/test/tfanonymproc3.pp
     create mode 100644 tests/test/tfanonymproc4.pp
     create mode 100644 tests/test/tfanonymproc5.pp
     create mode 100644 tests/test/tfanonymproc6.pp
     create mode 100644 tests/test/tfanonymproc7.pp
     create mode 100644 tests/test/tfanonymproc8.pp
     create mode 100644 tests/test/tfanonymproc9.pp
     create mode 100644 tests/test/uanonymproc1.pp
    
    diff --git a/tests/test/tanonymproc1.pp b/tests/test/tanonymproc1.pp
    new file mode 100644
    index 0000000..d6b55e6
    --- /dev/null
    +++ b/tests/test/tanonymproc1.pp
    @@ -0,0 +1,46 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ simple anonymous procedure without parameters }
    +
    +const
    +  magic:integer = 1234567890;
    +var
    +  g_result:integer;
    +
    +procedure clean_res;
    +  begin
    +    g_result:=0;
    +  end;
    +
    +procedure set_res;
    +  begin
    +    g_result:=magic;
    +  end;
    +
    +procedure check_res(num:integer);
    +  begin
    +    if g_result<>num then Halt(1);
    +  end;
    +
    +type
    +  tproc=reference to procedure;
    +  
    +var
    +  p:tproc;
    +
    +begin
    +  clean_res;
    +  p:=procedure
    +       begin
    +         set_res;
    +       end;
    +  check_res(0);
    +  
    +  clean_res;
    +  p();
    +  check_res(magic);
    +  
    +  clean_res;
    +  p;
    +  check_res(magic);
    +end.
    diff --git a/tests/test/tanonymproc10.pp b/tests/test/tanonymproc10.pp
    new file mode 100644
    index 0000000..5a6a394
    --- /dev/null
    +++ b/tests/test/tanonymproc10.pp
    @@ -0,0 +1,30 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ initialization of procvar in declaration }
    +
    +uses uanonymproc1;
    +
    +var
    +  ok:boolean=false;  
    +  i:reference to procedure(i:boolean) = procedure(val:boolean)
    +                                          begin
    +                                            ok:=val;
    +                                          end;
    +
    +procedure do_smth;
    +  var
    +    i:reference to procedure(i:boolean) = procedure(val:boolean)
    +                                            begin
    +                                              ok:=val;
    +                                            end;
    +  begin
    +    i(true);
    +    if not ok then halt(1);
    +  end;
    +  
    +begin
    +  i(true);
    +  if not ok then halt(1);
    +  do_smth;
    +  do_smth_inline;
    +end.
    diff --git a/tests/test/tanonymproc11.pp b/tests/test/tanonymproc11.pp
    new file mode 100644
    index 0000000..e66e96d
    --- /dev/null
    +++ b/tests/test/tanonymproc11.pp
    @@ -0,0 +1,22 @@
    +{$mode delphi}
    +{$modeswitch anonymousproc}
    +
    +const
    +  magic:integer=314159265;
    +
    +type
    +  myproc<T> = reference to procedure(num: T);
    +
    +var
    +  p:myproc<Integer>;
    +  res:integer;
    +
    +begin
    +  p:=procedure(num: Integer)
    +       begin
    +         res:=num;
    +       end;
    +  res:=0;
    +  p(magic);
    +  if res<>magic then halt(1);
    +end.
    diff --git a/tests/test/tanonymproc12.pp b/tests/test/tanonymproc12.pp
    new file mode 100644
    index 0000000..3f2f97b
    --- /dev/null
    +++ b/tests/test/tanonymproc12.pp
    @@ -0,0 +1,22 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +
    +const
    +  magic:integer=314159265;
    +
    +type
    +  generic myproc<T> = reference to procedure(num: T);
    +
    +var
    +  p:specialize myproc<Integer>;
    +  res:integer;
    +
    +begin
    +  p:=procedure(num: Integer)
    +       begin
    +         res:=num;
    +       end;
    +  res:=0;
    +  p(magic);
    +  if res<>magic then halt(1);
    +end.
    diff --git a/tests/test/tanonymproc2.pp b/tests/test/tanonymproc2.pp
    new file mode 100644
    index 0000000..998b77d
    --- /dev/null
    +++ b/tests/test/tanonymproc2.pp
    @@ -0,0 +1,70 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ simple anonymous procedure without parameters in nested function }
    +
    +const
    +  magic:integer = 1234567890;
    +var
    +  g_result:integer;
    +
    +procedure clean_res;
    +  begin
    +    g_result:=0;
    +  end;
    +
    +procedure set_res;
    +  begin
    +    g_result:=magic;
    +  end;
    +
    +procedure check_res(num:integer);
    +  begin
    +    if g_result<>num then halt(1);
    +  end;
    +
    +type
    +  tproc=reference to procedure;
    +  
    +procedure do_smth;  
    +  procedure nested_do_smth;
    +    var p:tproc;
    +    begin
    +      clean_res;
    +      p:=procedure
    +           begin
    +             set_res;
    +           end;
    +      check_res(0);
    +  
    +      clean_res;
    +      p();
    +      check_res(magic);
    +  
    +      clean_res;
    +      p;
    +      check_res(magic);
    +     end;
    +  var
    +    p: TProc;
    +  begin
    +    clean_res;
    +    p:=procedure
    +         begin
    +           set_res;
    +         end;
    +    check_res(0);
    +  
    +    clean_res;
    +    p();
    +    check_res(magic);
    +  
    +    clean_res;
    +    p;
    +    check_res(magic);
    +    
    +    nested_do_smth;
    +  end;
    +
    +begin
    +  do_smth;
    +end.
    diff --git a/tests/test/tanonymproc3.pp b/tests/test/tanonymproc3.pp
    new file mode 100644
    index 0000000..f8290b5
    --- /dev/null
    +++ b/tests/test/tanonymproc3.pp
    @@ -0,0 +1,49 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ pointer to anonymous procedure returned from function }
    +
    +const
    +  magic:integer = 1234567890;
    +var
    +  g_result:integer;
    +
    +procedure clean_res;
    +  begin
    +    g_result:=0;
    +  end;
    +
    +procedure set_res;
    +  begin
    +    g_result:=magic;
    +  end;
    +
    +procedure check_res(num:integer);
    +  begin
    +    if g_result<>num then halt(1);
    +  end;
    +
    +type
    +  tproc=reference to procedure;
    +  
    +function factory:tproc;
    +  begin
    +    result:=procedure
    +              begin
    +                set_res;
    +              end;
    +  end;
    +  
    +procedure do_things;  
    +  var
    +    p: TProc;
    +  begin
    +    clean_res;
    +    p:=factory;
    +    check_res(0);
    +    p();
    +    check_res(magic);    
    +  end;
    +  
    +begin
    +  do_things;
    +end.
    diff --git a/tests/test/tanonymproc4.pp b/tests/test/tanonymproc4.pp
    new file mode 100644
    index 0000000..8167a08
    --- /dev/null
    +++ b/tests/test/tanonymproc4.pp
    @@ -0,0 +1,49 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ anonymous procedure with parameters }
    +
    +const
    +  magic:integer=1234567890;
    +  magicstr:string='hello world';
    +
    +var
    +  g_res_num:integer;
    +  g_res_str:string;
    +
    +procedure clean_res;
    +  begin
    +    g_res_num:=0;
    +    g_res_str:='';
    +  end;
    +
    +procedure set_res;
    +  begin
    +    g_res_num:=magic;
    +    g_res_str:=magicstr;
    +  end;
    +
    +procedure check_res(num:integer;str:string);
    +  begin
    +    if g_res_num<>num then halt(1);
    +    if g_res_str<>str then halt(1);
    +  end;
    +
    +type
    +  tproc=reference to procedure(num:integer;str:string);
    +  
    +var
    +  p:tproc;
    +
    +begin
    +  clean_res;
    +  p:=procedure(num:integer;s:string)
    +       begin
    +         g_res_num:=num;
    +         g_res_str:=s;
    +       end;
    +  check_res(0, '');
    +  
    +  clean_res;
    +  p(magic, magicstr);
    +  check_res(magic, magicstr); 
    +end.
    diff --git a/tests/test/tanonymproc5.pp b/tests/test/tanonymproc5.pp
    new file mode 100644
    index 0000000..6755c95
    --- /dev/null
    +++ b/tests/test/tanonymproc5.pp
    @@ -0,0 +1,51 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ anonymous function }
    +
    +const
    +  magic:integer=1234567890;
    +  magicret:integer=987654321;
    +var
    +  g_result:integer;
    +
    +procedure clean_res;
    +  begin
    +    g_result:=0;
    +  end;
    +
    +procedure set_res;
    +  begin
    +    g_result:=magic;
    +  end;
    +
    +procedure check_res(num:Integer);
    +  begin
    +    if g_result<>num then halt(1);
    +  end;
    +
    +type
    +  tproc=reference to function:integer;
    +  
    +function factory:tproc;
    +  begin
    +    result:=function:Integer
    +              begin
    +                set_res;
    +                result:=magicret;
    +              end;
    +  end;
    +  
    +procedure do_things;  
    +  var
    +    p: TProc;
    +  begin
    +    clean_res;
    +    p:=factory;
    +    check_res(0);
    +    if p()<>magicret then halt(1);
    +    check_res(magic);
    +  end;
    +  
    +begin
    +  do_things;
    +end.
    diff --git a/tests/test/tanonymproc6.pp b/tests/test/tanonymproc6.pp
    new file mode 100644
    index 0000000..8abc0b1
    --- /dev/null
    +++ b/tests/test/tanonymproc6.pp
    @@ -0,0 +1,31 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ anonymous routine have inner function }
    +
    +const
    +  magicstr:string='hello';
    +  magicstrlen:integer=5;
    +
    +type
    +  tproc=reference to procedure(num:integer;s:string);
    + 
    +procedure do_things;  
    +  var
    +    p:tproc;
    +  begin
    +    p:=procedure(num:integer;s:string)
    +         function inner(ss:string):integer;
    +           begin
    +             result:=length(ss);
    +           end;
    +         var b:Integer;
    +         begin
    +           b:=inner(s);
    +           if b<>num then halt(1);
    +         end;
    +    p(magicstrlen,magicstr);
    +  end;
    +  
    +begin
    +  do_things;
    +end.
    diff --git a/tests/test/tanonymproc7.pp b/tests/test/tanonymproc7.pp
    new file mode 100644
    index 0000000..b741c77
    --- /dev/null
    +++ b/tests/test/tanonymproc7.pp
    @@ -0,0 +1,25 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ closure as function argument }
    +
    +const
    +  magic1:integer=123;
    +  magic2:integer=321123;
    +
    +type
    +  tfunct=reference to function(num:integer):integer;
    +  
    +function call(f:tfunct;arg:integer):integer;
    +  begin
    +   result:=f(arg);
    +  end;
    +
    +var i:integer;
    +begin
    +  i:=call( function(num:integer):integer
    +             begin
    +               result:=num+magic2;
    +             end,
    +           magic1 );
    +  if i<>(magic1+magic2) then halt(1);
    +end.
    diff --git a/tests/test/tanonymproc8.pp b/tests/test/tanonymproc8.pp
    new file mode 100644
    index 0000000..706403f
    --- /dev/null
    +++ b/tests/test/tanonymproc8.pp
    @@ -0,0 +1,19 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ two anonymous function inside one routine }
    +
    +const
    +  magic1:integer=777;
    +  magic2:integer=888;
    +
    +type
    +  tfunct=reference to function:integer;
    +  
    +var p1,p2:tfunct;
    +begin
    +  p1:=function: Integer begin result:=magic1; end;
    +  p2:=function: Integer begin result:=magic2; end;
    +
    +  if p1()<>magic1 then halt(1);
    +  if p2()<>magic2 then halt(2);
    +end.
    diff --git a/tests/test/tanonymproc9.pp b/tests/test/tanonymproc9.pp
    new file mode 100644
    index 0000000..36ed745
    --- /dev/null
    +++ b/tests/test/tanonymproc9.pp
    @@ -0,0 +1,21 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ acces to global variable }
    +
    +const
    +  magic:integer=1234567890;
    +
    +type
    +  tproc=reference to procedure;
    +  
    +var p:tproc;
    +    staticvar:integer;
    +begin
    +  staticvar:=0;
    +  p:=procedure
    +       begin
    +         staticvar:=magic;
    +       end;
    +  p();
    +  if staticvar<>magic then halt(1);
    +end.
    diff --git a/tests/test/tfanonymproc1.pp b/tests/test/tfanonymproc1.pp
    new file mode 100644
    index 0000000..457c7b2
    --- /dev/null
    +++ b/tests/test/tfanonymproc1.pp
    @@ -0,0 +1,14 @@
    +{ %fail }
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ incompatible proc and procvar }
    +
    +var
    +  i:reference to procedure(i:integer);
    +
    +begin
    +  i := procedure
    +         begin
    +         end;
    +  i();
    +end.
    diff --git a/tests/test/tfanonymproc10.pp b/tests/test/tfanonymproc10.pp
    new file mode 100644
    index 0000000..4befb49
    --- /dev/null
    +++ b/tests/test/tfanonymproc10.pp
    @@ -0,0 +1,9 @@
    +{$mode objfpc}
    +{ anonymous procedures doesnt work without modeswitch }
    +
    +var
    +  p:reference to procedure;
    +  
    +begin
    +  p:=procedure begin end;
    +end.
    diff --git a/tests/test/tfanonymproc11.pp b/tests/test/tfanonymproc11.pp
    new file mode 100644
    index 0000000..e05d468
    --- /dev/null
    +++ b/tests/test/tfanonymproc11.pp
    @@ -0,0 +1,19 @@
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ initialization of procvar in declaration }
    +
    +procedure do_smth;
    +  var
    +    ok:boolean;
    +    i:reference to procedure(i:boolean) = procedure(val:boolean)
    +                                            begin
    +                                              ok:=val;
    +                                            end;
    +  begin
    +    i(true);
    +    if not ok then halt(1);
    +  end;
    +  
    +begin
    +  do_smth;
    +end.
    diff --git a/tests/test/tfanonymproc2.pp b/tests/test/tfanonymproc2.pp
    new file mode 100644
    index 0000000..8b71e5a
    --- /dev/null
    +++ b/tests/test/tfanonymproc2.pp
    @@ -0,0 +1,14 @@
    +{ %fail }
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ incompatible proc and procvar }
    +
    +var
    +  i:reference to function:integer;
    +
    +begin
    +  i := procedure
    +         begin
    +         end;
    +  i();
    +end.
    diff --git a/tests/test/tfanonymproc3.pp b/tests/test/tfanonymproc3.pp
    new file mode 100644
    index 0000000..fde91e3
    --- /dev/null
    +++ b/tests/test/tfanonymproc3.pp
    @@ -0,0 +1,14 @@
    +{ %fail }
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ illegal assignment }
    +
    +var
    +  p:reference to function:integer;
    +  i:integer;
    +
    +begin
    +  i := procedure
    +         begin
    +         end;
    +end.
    diff --git a/tests/test/tfanonymproc4.pp b/tests/test/tfanonymproc4.pp
    new file mode 100644
    index 0000000..22942a5
    --- /dev/null
    +++ b/tests/test/tfanonymproc4.pp
    @@ -0,0 +1,15 @@
    +{ %fail }
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ illegal arithmetics operation }
    +
    +type
    +  TProc = reference to function: Integer;
    +
    +var
    +  p: TProc;
    +  i: Integer;
    +
    +begin
    +  i := 10 + procedure begin end;
    +end.
    diff --git a/tests/test/tfanonymproc5.pp b/tests/test/tfanonymproc5.pp
    new file mode 100644
    index 0000000..c959d04
    --- /dev/null
    +++ b/tests/test/tfanonymproc5.pp
    @@ -0,0 +1,15 @@
    +{ %fail }    
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ call of anonymous function in place }
    +
    +var
    +  i: Integer;
    +begin
    +
    +  // now fpc parser eats first () and stops parsing of right side
    +  // delphi parser eats this but fails during runtime
    +  i := (function(num: Integer): Integer begin Result := num + 10; end)(5);
    +
    +  Writeln(i);
    +end.
    diff --git a/tests/test/tfanonymproc6.pp b/tests/test/tfanonymproc6.pp
    new file mode 100644
    index 0000000..1d7ae11
    --- /dev/null
    +++ b/tests/test/tfanonymproc6.pp
    @@ -0,0 +1,13 @@
    +{ %fail }
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ incompatible proc and and procvar }
    +
    +var
    +  i: reference to procedure(i: Integer);
    +
    +begin
    +  i := procedure
    +         begin
    +         end;
    +end.
    diff --git a/tests/test/tfanonymproc7.pp b/tests/test/tfanonymproc7.pp
    new file mode 100644
    index 0000000..19d4aa2
    --- /dev/null
    +++ b/tests/test/tfanonymproc7.pp
    @@ -0,0 +1,12 @@
    +{ %fail }
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ wrong parameter type }
    +
    +var
    +  i: reference to procedure(i:integer);
    +
    +begin
    +  i := procedure(i:integer) begin end;
    +  i('hello world');
    +end.
    diff --git a/tests/test/tfanonymproc8.pp b/tests/test/tfanonymproc8.pp
    new file mode 100644
    index 0000000..f7ca501
    --- /dev/null
    +++ b/tests/test/tfanonymproc8.pp
    @@ -0,0 +1,25 @@
    +{ %fail }
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ closure is wrong function argument }
    +
    +const
    +  magic1:integer=123;
    +  magic2:integer=321123;
    +
    +type
    +  tfunct=reference to function(num:integer):integer;
    +  
    +function call(f:tfunct;arg:integer):integer;
    +  begin
    +   result:=f(arg);
    +  end;
    +
    +var i:integer;
    +begin
    +  i:=call( function(s:string):integer
    +             begin
    +             end,
    +           magic1 );
    +end.
    +
    diff --git a/tests/test/tfanonymproc9.pp b/tests/test/tfanonymproc9.pp
    new file mode 100644
    index 0000000..38780f0
    --- /dev/null
    +++ b/tests/test/tfanonymproc9.pp
    @@ -0,0 +1,25 @@
    +{ %fail }
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +{ acces to local variables of outer function }
    +{ will be possible with closures }
    +
    +const
    +  magic:integer=1234567890;
    +
    +type
    +  tproc=reference to procedure;
    +  
    +procedure do_smth;
    +var p:tproc;
    +    localvar:integer;
    +begin
    +  p:=procedure
    +       begin
    +         localvar:=magic;
    +       end;
    +end;
    +
    +begin
    +  do_smth
    +end.
    diff --git a/tests/test/uanonymproc1.pp b/tests/test/uanonymproc1.pp
    new file mode 100644
    index 0000000..2129851
    --- /dev/null
    +++ b/tests/test/uanonymproc1.pp
    @@ -0,0 +1,26 @@
    +unit uanonymproc1;
    +{$mode objfpc}
    +{$modeswitch anonymousproc}
    +
    +interface
    +
    +procedure do_smth_inline; inline;
    +
    +var
    +  good:boolean=false;
    +
    +implementation
    +
    +procedure do_smth_inline; inline;
    +  var
    +    i:reference to procedure = procedure
    +                                 begin
    +                                   good:=true;
    +                                 end;
    +  begin
    +    i();
    +    if not good then halt(1);
    +  end;
    +
    +begin
    +end.
    -- 
    1.8.1.2
    
    
    anonymous01.patch (133,611 bytes)

Relationships

parent of 0035922 new TFunc, TPredicate and TProc declarations 
has duplicate 0034123 resolvedFlorian Anonymous method is a procedure or function. 
Not all the children of this issue are yet resolved or closed.

Activities

Vasiliy Kevroletin

2013-05-26 11:19

reporter  

closures00.patch (176,782 bytes)
From 9ccda6d8fe4cc15e6353f0acebef188c5331ce08 Mon Sep 17 00:00:00 2001
From: blaise <blaise@3ad0048d-3df7-0310-abae-a5850022a9f2>
Date: Sat, 21 Jan 2012 19:00:59 +0000
Subject: [PATCH 01/14] ~ ncgutil: generate interface thunks for local classes
 too ~ nld: during the first pass, we rewrite the
 nodes that load captured variables, except for nodes
 marked with the new flag loadnf_captured_param =
 pdecobj, symdef: factored out
 tobjectdef.register_implemented_interface + pexpr:
 access to captured variables from expressions;
 nameless routine declarations + symconst: new flags
 for tprocoption (po_nameless, po_has_closure) and
 tobjectoption (oo_is_nameless) ~ symdef: mangled name
 generator is now aware of local classes and
 interfaces + symsym: new field
 tabstractnormalvarsym.captured_into holds a reference
 to a new location for the captured variable

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/blaise/closures/compiler@20138 3ad0048d-3df7-0310-abae-a5850022a9f2
---
 compiler/ncgvmt.pas   |   13 ++++++++++---
 compiler/nld.pas      |   18 ++++++++++++++++--
 compiler/pdecobj.pas  |    8 +-------
 compiler/pexpr.pas    |   20 +++++++++++++++++---
 compiler/symconst.pas |   12 ++++++++++--
 compiler/symdef.pas   |   17 +++++++++++++++++
 compiler/symsym.pas   |    9 +++++++++
 7 files changed, 80 insertions(+), 17 deletions(-)

diff --git a/compiler/ncgvmt.pas b/compiler/ncgvmt.pas
index 59d2413..a6f78c2 100644
--- a/compiler/ncgvmt.pas
+++ b/compiler/ncgvmt.pas
@@ -921,9 +921,16 @@ implementation
         for i:=0 to st.DefList.Count-1 do
           begin
             def:=tdef(st.DefList[i]);
-            { if def can contain nested types then handle it symtable }
-            if def.typ in [objectdef,recorddef] then
-              gen_intf_wrappers(list,tabstractrecorddef(def).symtable);
+            { if def can contain nested types then handle its symtable }
+            case def.typ of
+              objectdef,recorddef:
+                gen_intf_wrappers(list,tabstractrecorddef(def).symtable);
+              procdef:
+                // check for local classes; currently, we only use them for closures
+                // TODO: this can slow codegen down dramatically?!
+                if assigned(tprocdef(def).localst) then
+                  gen_intf_wrappers(list,tprocdef(def).localst);
+            end;
             if is_class(def) then
               gen_intf_wrapper(list,tobjectdef(def));
           end;
diff --git a/compiler/nld.pas b/compiler/nld.pas
index 4f48a4c..5230a70 100644
--- a/compiler/nld.pas
+++ b/compiler/nld.pas
@@ -44,7 +44,10 @@ interface
            Be really carefull when using this flag! }
          loadnf_isinternal_ignoreconst,
 
-         loadnf_only_uninitialized_hint
+         loadnf_only_uninitialized_hint,
+         // the node loads a captured formal parameter from its original location;
+         // such node is marked so, so it will not get rewritten during the first pass
+         loadnf_captured_param
         );
 
        tloadnode = class(tunarynode)
@@ -176,7 +179,7 @@ implementation
       verbose,globtype,globals,systems,constexp,
       symnot,symtable,
       defutil,defcmp,
-      htypechk,pass_1,procinfo,paramgr,
+      htypechk,pass_1,procinfo,paramgr,pnameless,
       cpuinfo,
       ncon,ninl,ncnv,nmem,ncal,nutils,
       cgbase
@@ -411,6 +414,17 @@ implementation
             localvarsym,
             paravarsym :
               begin
+                if symtableentry.typ in [localvarsym,paravarsym] then
+                  begin
+                    // if the variable has been captured after the creation of this node,
+                    //   then this node is no longer relevant,
+                    //     and we shall load the variable's new location instead
+                    // the exception is the case when we access the original location
+                    //   in order to copy the value into the capturer
+                    if tabstractnormalvarsym(symtableentry).is_captured
+                        and not (loadnf_captured_param in loadnodeflags) then
+                      exit( load_captured_variable(current_procinfo.procdef, tabstractnormalvarsym(symtableentry)) );
+                  end;
                 if assigned(left) then
                   firstpass(left);
                 if not is_addr_param_load and
diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
index 61dcc0f..6485467 100644
--- a/compiler/pdecobj.pas
+++ b/compiler/pdecobj.pas
@@ -324,13 +324,7 @@ implementation
         if current_objectdef.find_implemented_interface(intfdef)<>nil then
           Message1(sym_e_duplicate_id,intfdef.objname^)
         else
-          begin
-            { allocate and prepare the GUID only if the class
-              implements some interfaces. }
-            if current_objectdef.ImplementedInterfaces.count = 0 then
-              current_objectdef.prepareguid;
-            current_objectdef.ImplementedInterfaces.Add(TImplementedInterface.Create(intfdef));
-          end;
+          current_objectdef.register_implemented_interface(intfdef);
       end;
 
 
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 3555e4e..0bc3480 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -70,7 +70,7 @@ implementation
        nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
        { parser }
        scanner,
-       pbase,pinline,ptype,pgenutil,procinfo,cpuinfo
+       pbase,pinline,ptype,pgenutil,procinfo,cpuinfo,pnameless,
        ;
 
     { sub_expr(opmultiply) is need to get -1 ** 4 to be
@@ -2560,8 +2560,15 @@ implementation
                           p1:=csubscriptnode.create(srsym,p1);
                       end
                     else
-                      { regular non-field load }
-                      p1:=cloadnode.create(srsym,srsymtable);
+                      begin
+                        if srsym.typ in [localvarsym,paravarsym] then
+                          p1:=handle_possible_capture(current_procinfo.procdef, tabstractnormalvarsym(srsym))
+                        else
+                          p1:=nil;
+                        if not assigned(p1) then
+                          { regular non-field load }
+                          p1:=cloadnode.create(srsym,srsymtable);
+                      end
                   end;
 
                 syssym :
@@ -3293,6 +3300,13 @@ implementation
                p1:=cinlinenode.create(in_objc_protocol_x,false,p1);
              end;
 
+             // nameless routine
+             _PROCEDURE, _FUNCTION:
+               if assigned(current_procinfo) then
+                 p1:=parse_nameless_routine(current_procinfo.procdef)
+               else // TODO: support this later? Delphi doesn't
+                 internalerror(20120121);
+
              else
                begin
                  Message(parser_e_illegal_expression);
diff --git a/compiler/symconst.pas b/compiler/symconst.pas
index ae98ad0..ceee977 100644
--- a/compiler/symconst.pas
+++ b/compiler/symconst.pas
@@ -342,7 +342,11 @@ type
     { the visibility of of this procdef was raised automatically by the
       compiler, e.g. because it was designated as a getter/setter for a property
       with a higher visibility on the JVM target }
-    po_auto_raised_visibility
+    po_auto_raised_visibility,
+    // nameless routine (including closure)
+    po_nameless,
+    // has at least one closure declared in the body
+    po_has_closure
   );
   tprocoptions=set of tprocoption;
 
@@ -436,7 +440,11 @@ type
     oo_has_class_constructor, { the object/class has a class constructor }
     oo_has_class_destructor,  { the object/class has a class destructor  }
     oo_is_enum_class,     { the class represents an enum (JVM) }
-    oo_has_new_destructor { the object/class declares a destructor (apart from potentially inherting one from the parent) }
+    oo_has_new_destructor,{ the object/class declares a destructor (apart from potentially inherting one from the parent) }
+    // the interface that has no identifier; structural type equivalence is used
+    //   currently, this flag is only used for closures
+    //     TODO: we can get rid of it if we implement type coersion for COM-interfaces
+    oo_is_nameless
   );
   tobjectoptions=set of tobjectoption;
 
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index 31ee02e..a4780d1 100644
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@@ -376,7 +376,10 @@ interface
           function  members_need_inittable : boolean;
           function  find_implemented_interface(aintfdef:tobjectdef):TImplementedInterface;
           { this should be called when this class implements an interface }
+          procedure register_implemented_interface(const intfdef: tobjectdef);
+       strict private
           procedure prepareguid;
+       public
           function  is_publishable : boolean;override;
           function  is_related(d : tdef) : boolean;override;
           function  needs_inittable : boolean;override;
@@ -1119,10 +1122,12 @@ implementation
         i   : longint;
         crc : dword;
         hp  : tparavarsym;
+      label again; // TODO: refactor this abomination
       begin
         prefix:='';
         if not assigned(st) then
          internalerror(200204212);
+      again:
         { sub procedures }
         while (st.symtabletype=localsymtable) do
          begin
@@ -1180,6 +1185,9 @@ implementation
            prefix:=tabstractrecorddef(st.defowner).objname^+'_$_'+prefix;
            st:=st.defowner.owner;
          end;
+        if st.symtabletype = localsymtable then
+          // local classes and interfaces
+          goto again;
         { symtable must now be static or global }
         if not(st.symtabletype in [staticsymtable,globalsymtable]) then
           internalerror(200204175);
@@ -5820,6 +5828,15 @@ implementation
       end;
 
 
+    procedure tobjectdef.register_implemented_interface(const intfdef: tobjectdef);
+      begin
+        // allocate the GUID only if the class implements at least one interface
+        if ImplementedInterfaces.count = 0 then
+          prepareguid;
+        ImplementedInterfaces.Add(TImplementedInterface.Create(intfdef));
+      end;
+
+
     procedure tobjectdef.prepareguid;
       begin
         { set up guid }
diff --git a/compiler/symsym.pas b/compiler/symsym.pas
index 078699b..0186e29 100644
--- a/compiler/symsym.pas
+++ b/compiler/symsym.pas
@@ -215,12 +215,15 @@ interface
           initialloc    : TLocation; { initial location so it can still be initialized later after the location was changed by SSA }
           currentregloc  : TLocation; { current registers for register variables with moving register numbers }
           inparentfpstruct : boolean;   { migrated to a parentfpstruct because of nested access (not written to ppu, because not important and would change interface crc) }
+          // if var is captured by a closure, this refers to a field of the class TCapturer
+          captured_into: tfieldvarsym;
           constructor create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
           constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
           function globalasmsym: boolean;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderef;override;
           procedure deref;override;
+          function is_captured: boolean; inline;
       end;
 
       tlocalvarsym = class(tabstractnormalvarsym)
@@ -1710,6 +1713,12 @@ implementation
       end;
 
 
+    function tabstractnormalvarsym.is_captured: boolean; inline;
+      begin
+        result:=assigned(captured_into)
+      end;
+
+
 {****************************************************************************
                              Tstaticvarsym
 ****************************************************************************}
-- 
1.7.10.4


From 8dfaa356d6eb4a558e38e1175d7d966ca80b7787 Mon Sep 17 00:00:00 2001
From: blaise <blaise@3ad0048d-3df7-0310-abae-a5850022a9f2>
Date: Wed, 1 Feb 2012 19:21:23 +0000
Subject: [PATCH 02/14] + defcmp: structural equivalence for COM interfaces ~
 pdecobj, pdecsub: parsing mode for routines: normal,
 class method, nameless routine, method reference =
 pdecsub: factored out parse_proc_parameter_dec();
 code simplifications + symdef:
 tprocdef.add_to_procsym() + ptype, tokens: new UDT --
 method reference

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/blaise/closures/compiler@20212 3ad0048d-3df7-0310-abae-a5850022a9f2
---
 compiler/defcmp.pas   |   24 +++++-
 compiler/pdecobj.pas  |   10 +--
 compiler/pdecsub.pas  |  209 +++++++++++++++++++++++++++++--------------------
 compiler/pmodules.pas |    2 +
 compiler/psub.pas     |    3 +-
 compiler/ptype.pas    |    7 +-
 compiler/symdef.pas   |   15 ++++
 compiler/tokens.pas   |    2 +
 8 files changed, 178 insertions(+), 94 deletions(-)

diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas
index a905849..bbb841f 100644
--- a/compiler/defcmp.pas
+++ b/compiler/defcmp.pas
@@ -158,7 +158,7 @@ implementation
     uses
       verbose,systems,constexp,
       symtable,symsym,
-      defutil,symutil;
+      defutil,symutil,pnameless;
 
 
     function compare_defs_ext(def_from,def_to : tdef;
@@ -1588,8 +1588,26 @@ implementation
                        doconv:=tc_variant_2_interface;
                        eq:=te_convert_l2;
                      end
-                   { ugly, but delphi allows it (enables typecasting ordinals/
-                     enums of any size to pointer-based object defs) }
+
+{TODO: refactor evil merge}
+
+                   { interface coercion }
+                   else if (def_from.typ=objectdef) and
+                     (tobjectdef(def_from).objecttype=odt_interfacecom) and
+                     (tobjectdef(def_to).objecttype=odt_interfacecom) and
+                     are_compatible_interfaces(tobjectdef(def_to),tobjectdef(def_from)) then
+                     begin
+                       doconv:=tc_equal;
+                       eq:=te_convert_l1;
+                     end
+                   { ugly, but delphi allows it }
+                   else if (def_from.typ in [orddef,enumdef]) and
+                     (m_delphi in current_settings.modeswitches) and
+                     (cdo_explicit in cdoptions) then
+                     begin
+                       doconv:=tc_int_2_int;
+                       eq:=te_convert_l1;
+                     end;
                    { in Java enums /are/ class instances, and hence such
                      typecasts must not be treated as integer-like conversions;
                      arbitrary constants cannot be converted into classes/
diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
index 6485467..31664f2 100644
--- a/compiler/pdecobj.pas
+++ b/compiler/pdecobj.pas
@@ -104,7 +104,7 @@ implementation
         result:=nil;
         consume(_CONSTRUCTOR);
         { must be at same level as in implementation }
-        parse_proc_head(current_structdef,potype_class_constructor,pd);
+        parse_proc_head(current_structdef,potype_class_constructor,ppm_class_method,pd);
         if not assigned(pd) then
           begin
             consume(_SEMICOLON);
@@ -129,7 +129,7 @@ implementation
         result:=nil;
         consume(_CONSTRUCTOR);
         { must be at same level as in implementation }
-        parse_proc_head(current_structdef,potype_constructor,pd);
+        parse_proc_head(current_structdef,potype_constructor,ppm_normal,pd);
         if not assigned(pd) then
           begin
             consume(_SEMICOLON);
@@ -226,7 +226,7 @@ implementation
       begin
         result:=nil;
         consume(_DESTRUCTOR);
-        parse_proc_head(current_structdef,potype_class_destructor,pd);
+        parse_proc_head(current_structdef,potype_class_destructor,ppm_class_method,pd);
         if not assigned(pd) then
           begin
             consume(_SEMICOLON);
@@ -250,7 +250,7 @@ implementation
       begin
         result:=nil;
         consume(_DESTRUCTOR);
-        parse_proc_head(current_structdef,potype_destructor,pd);
+        parse_proc_head(current_structdef,potype_destructor,ppm_normal,pd);
         if not assigned(pd) then
           begin
             consume(_SEMICOLON);
@@ -875,7 +875,7 @@ implementation
               { which isn't declared yet                      }
               if assigned(result) then
                 begin
-                  parse_object_proc_directives(result);
+                  parse_object_proc_directives(result, as_procparsemode(is_classdef));
 
                   { check if dispid is set }
                   if is_dispinterface(result.struct) and not (po_dispid in result.procoptions) then
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index c5c4cdf..487a585 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -72,8 +72,12 @@ interface
     procedure parse_var_proc_directives(sym:tsym);
     procedure parse_object_proc_directives(pd:tabstractprocdef);
     procedure parse_record_proc_directives(pd:tabstractprocdef);
-    function  parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;out pd:tprocdef):boolean;
-    function  parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef):tprocdef;
+
+    type tprocparsemode = (ppm_normal, ppm_class_method, ppm_nameless_routine, ppm_method_reference);
+    // TODO: operator :=/Explicit (const is_class_method: boolean) result: tprocparsemode;
+    function as_procparsemode(const is_class_method: boolean): tprocparsemode; inline;
+    function parse_proc_head(astruct: tabstractrecorddef; potype: tproctypeoption; const procparsemode: tprocparsemode; out pd: tprocdef): boolean;
+    function parse_proc_dec(astruct: tabstractrecorddef; const procparsemode: tprocparsemode = ppm_normal): tprocdef;
 
     { parse a record method declaration (not a (class) constructor/destructor) }
     function parse_record_method_dec(astruct: tabstractrecorddef; is_classdef: boolean): tprocdef;
@@ -540,7 +544,48 @@ implementation
       end;
 
 
-    function parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;out pd:tprocdef):boolean;
+    procedure parse_proc_parameter_dec(const pd: tprocdef); inline;
+      var
+        popclass : integer;
+        old_current_structdef: tabstractrecorddef;
+        old_current_genericdef,
+        old_current_specializedef: tstoreddef;
+      begin
+        { Add ObjectSymtable to be able to find nested type definitions }
+        popclass:=0;
+        if assigned(pd.struct) and // TODO: skip for nameless? or no need
+           (pd.parast.symtablelevel>=normal_function_level) and
+           not(symtablestack.top.symtabletype in [ObjectSymtable,recordsymtable]) then
+          begin
+            popclass:=push_nested_hierarchy(pd.struct);
+            old_current_structdef:=current_structdef;
+            old_current_genericdef:=current_genericdef;
+            old_current_specializedef:=current_specializedef;
+            current_structdef:=pd.struct;
+            if df_generic in current_structdef.defoptions then
+              current_genericdef:=current_structdef;
+            if df_specialization in current_structdef.defoptions then
+              current_specializedef:=current_structdef;
+          end;
+        { Add parameter symtable }
+        if pd.parast.symtabletype<>staticsymtable then
+          symtablestack.push(pd.parast);
+        parse_parameter_dec(pd);
+        if pd.parast.symtabletype<>staticsymtable then
+          symtablestack.pop(pd.parast);
+        if popclass>0 then
+          begin
+            current_structdef:=old_current_structdef;
+            current_genericdef:=old_current_genericdef;
+            current_specializedef:=old_current_specializedef;
+            dec(popclass,pop_nested_hierarchy(pd.struct));
+            if popclass<>0 then
+              internalerror(201011260); // 11 nov 2010 index 0
+          end;
+      end;
+
+
+    function parse_proc_head(astruct: tabstractrecorddef; potype: tproctypeoption; const procparsemode: tprocparsemode; out pd: tprocdef): boolean;
       var
         hs       : string;
         orgsp,sp : TIDString;
@@ -551,12 +596,8 @@ implementation
         st,
         genericst: TSymtable;
         aprocsym : tprocsym;
-        popclass : integer;
         ImplIntf : TImplementedInterface;
         old_parse_generic : boolean;
-        old_current_structdef: tabstractrecorddef;
-        old_current_genericdef,
-        old_current_specializedef: tstoreddef;
         lasttoken,lastidtoken: ttoken;
 
         procedure parse_operator_name;
@@ -756,7 +797,20 @@ implementation
         pd:=nil;
         aprocsym:=nil;
 
-        consume_proc_name;
+        case procparsemode of
+          ppm_nameless_routine:
+            begin
+              sp:='Nameless_'+inttostr(procstartfilepos.line)+'_'+inttostr(procstartfilepos.column);
+              orgsp:=upcase(sp);
+            end;
+          ppm_method_reference:
+            begin
+              sp:='Invoke';
+              orgsp:=upcase(sp);
+            end;
+          else
+            consume_proc_name;
+        end;
 
         { examine interface map: function/procedure iname.functionname=locfuncname }
         if assigned(astruct) and
@@ -809,7 +863,11 @@ implementation
 
         { method  ? }
         srsym:=nil;
-        if (consume_generic_type_parameter or not assigned(astruct)) and
+        if procparsemode=ppm_nameless_routine then
+          // Do nothing. This check here:
+          //   a) skips below checks and searches, speeding things up;
+          //   b) makes sure we do not try to parse generic type parameters.
+        else if (consume_generic_type_parameter or not assigned(astruct)) and
            (symtablestack.top.symtablelevel=main_program_level) and
            try_to_consume(_POINT) then
          begin
@@ -928,33 +986,39 @@ implementation
           begin
             { create a new procsym and set the real filepos }
             current_tokenpos:=procstartfilepos;
-            { for operator we have only one procsym for each overloaded
-              operation }
-            if (potype=potype_operator) then
-              begin
+            case potype of
+              potype_operator:
+              begin // we have only one procsym for each overloaded operator
                 aprocsym:=Tprocsym(symtablestack.top.Find(sp));
                 if aprocsym=nil then
                   aprocsym:=tprocsym.create('$'+sp);
-              end
-            else
-            if (potype in [potype_class_constructor,potype_class_destructor]) then
-              aprocsym:=tprocsym.create('$'+lower(sp))
-            else
-              aprocsym:=tprocsym.create(orgsp);
+              end;
+              potype_class_constructor,potype_class_destructor:
+                aprocsym:=tprocsym.create('$'+lower(sp))
+              else
+                aprocsym:=tprocsym.create(orgsp);
+            end;
             symtablestack.top.insert(aprocsym);
           end;
 
-        { to get the correct symtablelevel we must ignore ObjectSymtables }
-        st:=nil;
-        checkstack:=symtablestack.stack;
-        while assigned(checkstack) do
+        if procparsemode=ppm_nameless_routine then
           begin
-            st:=checkstack^.symtable;
-            if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then
-              break;
-            checkstack:=checkstack^.next;
-          end;
-        pd:=tprocdef.create(st.symtablelevel+1);
+            pd:=tprocdef.create(normal_function_level);
+            include(pd.procoptions,po_nameless);
+          end
+        else begin // TODO: surely, there should be a simpler way:
+          { to get the correct symtablelevel we must ignore ObjectSymtables }
+          st:=nil;
+          checkstack:=symtablestack.stack;
+          while assigned(checkstack) do
+            begin
+              st:=checkstack^.symtable;
+              if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then
+                break;
+              checkstack:=checkstack^.next;
+            end;
+          pd:=tprocdef.create(st.symtablelevel+1);
+        end;
         pd.struct:=astruct;
         pd.procsym:=aprocsym;
         pd.proctypeoption:=potype;
@@ -1003,46 +1067,23 @@ implementation
 
         { parse parameters }
         if token=_LKLAMMER then
-          begin
-            { Add ObjectSymtable to be able to find nested type definitions }
-            popclass:=0;
-            if assigned(pd.struct) and
-               (pd.parast.symtablelevel>=normal_function_level) and
-               not(symtablestack.top.symtabletype in [ObjectSymtable,recordsymtable]) then
-              begin
-                popclass:=push_nested_hierarchy(pd.struct);
-                old_current_structdef:=current_structdef;
-                old_current_genericdef:=current_genericdef;
-                old_current_specializedef:=current_specializedef;
-                current_structdef:=pd.struct;
-                if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then
-                  current_genericdef:=current_structdef;
-                if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then
-                  current_specializedef:=current_structdef;
-              end;
-            { Add parameter symtable }
-            if pd.parast.symtabletype<>staticsymtable then
-              symtablestack.push(pd.parast);
-            parse_parameter_dec(pd);
-            if pd.parast.symtabletype<>staticsymtable then
-              symtablestack.pop(pd.parast);
-            if popclass>0 then
-              begin
-                current_structdef:=old_current_structdef;
-                current_genericdef:=old_current_genericdef;
-                current_specializedef:=old_current_specializedef;
-                dec(popclass,pop_nested_hierarchy(pd.struct));
-                if popclass<>0 then
-                  internalerror(201011260); // 11 nov 2010 index 0
-              end;
-          end;
+          parse_proc_parameter_dec(pd);
 
         parse_generic:=old_parse_generic;
         result:=true;
       end;
 
 
-    function parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef):tprocdef;
+    function as_procparsemode(const is_class_method: boolean): tprocparsemode; inline;
+      begin
+        if is_class_method then
+          result := ppm_class_method
+        else
+          result := ppm_normal
+      end;
+
+
+    function parse_proc_dec(astruct: tabstractrecorddef; const procparsemode: tprocparsemode = ppm_normal): tprocdef;
       var
         pd: tprocdef;
         locationstr: string;
@@ -1071,9 +1112,9 @@ implementation
                 old_current_genericdef:=current_genericdef;
                 old_current_specializedef:=current_specializedef;
                 current_structdef:=pd.struct;
-                if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then
+                if df_generic in current_structdef.defoptions then
                   current_genericdef:=current_structdef;
-                if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then
+                if df_specialization in current_structdef.defoptions then
                   current_specializedef:=current_structdef;
               end;
             single_type(pd.returndef,[stoAllowSpecialization]);
@@ -1100,7 +1141,7 @@ implementation
           _FUNCTION :
             begin
               consume(_FUNCTION);
-              if parse_proc_head(astruct,potype_function,pd) then
+              if parse_proc_head(astruct,potype_function,procparsemode,pd) then
                 begin
                   { pd=nil when it is a interface mapping }
                   if assigned(pd) then
@@ -1144,7 +1185,7 @@ implementation
                             consume_all_until(_SEMICOLON);
                           end;
                        end;
-                      if isclassmethod then
+                      if procparsemode=ppm_class_method then
                        include(pd.procoptions,po_classmethod);
                     end;
                 end
@@ -1159,13 +1200,13 @@ implementation
           _PROCEDURE :
             begin
               consume(_PROCEDURE);
-              if parse_proc_head(astruct,potype_procedure,pd) then
+              if parse_proc_head(astruct,potype_procedure,procparsemode,pd) then
                 begin
                   { pd=nil when it is an interface mapping }
                   if assigned(pd) then
                     begin
                       pd.returndef:=voidtype;
-                      if isclassmethod then
+                      if procparsemode=ppm_class_method then
                         include(pd.procoptions,po_classmethod);
                     end;
                 end;
@@ -1174,11 +1215,11 @@ implementation
           _CONSTRUCTOR :
             begin
               consume(_CONSTRUCTOR);
-              if isclassmethod then
-                parse_proc_head(astruct,potype_class_constructor,pd)
+              if procparsemode=ppm_class_method then
+                parse_proc_head(astruct,potype_class_constructor,procparsemode,pd)
               else
-                parse_proc_head(astruct,potype_constructor,pd);
-              if not isclassmethod and
+                parse_proc_head(astruct,potype_constructor,procparsemode,pd);
+              if (procparsemode<>ppm_class_method) and
                  assigned(pd) and
                  assigned(pd.struct) then
                 begin
@@ -1205,16 +1246,15 @@ implementation
           _DESTRUCTOR :
             begin
               consume(_DESTRUCTOR);
-              if isclassmethod then
-                parse_proc_head(astruct,potype_class_destructor,pd)
+              if procparsemode=ppm_class_method then
+                parse_proc_head(astruct,potype_class_destructor,procparsemode,pd)
               else
-                parse_proc_head(astruct,potype_destructor,pd);
+                parse_proc_head(astruct,potype_destructor,procparsemode,pd);
               if assigned(pd) then
                 pd.returndef:=voidtype;
             end;
-        else
-          if (token=_OPERATOR) or
-             (isclassmethod and (idtoken=_OPERATOR)) then
+
+          _OPERATOR:
             begin
               { we need to set the block type to bt_body, so that operator names
                 like ">", "=>" or "<>" are parsed correctly instead of e.g.
@@ -1222,7 +1262,7 @@ implementation
               old_block_type:=block_type;
               block_type:=bt_body;
               consume(_OPERATOR);
-              parse_proc_head(astruct,potype_operator,pd);
+              parse_proc_head(astruct,potype_operator,procparsemode,pd);
               block_type:=old_block_type;
               if assigned(pd) then
                 begin
@@ -1232,7 +1272,7 @@ implementation
                   pd.procsym.owner.includeoption(sto_has_operator);
                   if pd.parast.symtablelevel>normal_function_level then
                     Message(parser_e_no_local_operator);
-                  if isclassmethod then
+                  if procparsemode=ppm_class_method then
                     include(pd.procoptions,po_classmethod);
                   if token<>_ID then
                     begin
@@ -1304,7 +1344,8 @@ implementation
                 message(parser_e_field_not_allowed_here);
                 consume_all_until(_SEMICOLON);
               end;
-            consume(_SEMICOLON);
+            if not (procparsemode in [ppm_nameless_routine,ppm_method_reference]) then
+              consume(_SEMICOLON);
           end;
         result:=pd;
 
@@ -1323,7 +1364,7 @@ implementation
       begin
         oldparse_only:=parse_only;
         parse_only:=true;
-        result:=parse_proc_dec(is_classdef,astruct);
+        result:=parse_proc_dec(astruct,as_procparsemode(is_classdef));
 
         { this is for error recovery as well as forward }
         { interface mappings, i.e. mapping to a method  }
@@ -3303,7 +3344,7 @@ const
             if (currpd.proctypeoption = potype_function) and
                is_void(currpd.returndef) then
               MessagePos1(currpd.fileinfo,parser_e_no_funcret_specified,currpd.procsym.realname);
-            tprocsym(currpd.procsym).ProcdefList.Add(currpd);
+            currpd.add_to_procsym;
           end;
 
         proc_add_definition:=forwardfound;
diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas
index 5800b54..9a011d8 100644
--- a/compiler/pmodules.pas
+++ b/compiler/pmodules.pas
@@ -572,6 +572,8 @@ implementation
         inc(ps.refs);
         st.insert(ps);
         pd:=tprocdef(cnodeutils.create_main_procdef(target_info.cprefix+name,potype,ps));
+{TDOO: investigate. Evil merge}
+        pd.add_to_procsym(ps);
         { We don't need is a local symtable. Change it into the static
           symtable }
         pd.localst.free;
diff --git a/compiler/psub.pas b/compiler/psub.pas
index 9ff647d..113c67e 100644
--- a/compiler/psub.pas
+++ b/compiler/psub.pas
@@ -28,7 +28,8 @@ interface
     uses
       globals,
       node,nbas,
-      symdef,procinfo,optdfa;
+      symdef,procinfo,optdfa,
+      pdecsub;
 
     type
 
diff --git a/compiler/ptype.pas b/compiler/ptype.pas
index 3aad0b7..93b3e50 100644
--- a/compiler/ptype.pas
+++ b/compiler/ptype.pas
@@ -81,7 +81,7 @@ implementation
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
        { parser }
        scanner,
-       pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil
+       pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil{,pnameless}
 {$ifdef jvm}
        ,pjvm
 {$endif}
@@ -1673,6 +1673,11 @@ implementation
                 jvm_create_procvar_class(name,def);
 {$endif}
               end;
+            _ID:
+              if idtoken=_REFERENCE then // TODO: $mode Delphi only?
+                def:=parse_method_reference(name)
+              else
+                expr_type;
             else
               if (token=_KLAMMERAFFE) and (m_iso in current_settings.modeswitches) then
                 begin
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index a4780d1..83afc44 100644
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@@ -718,6 +718,8 @@ interface
           function  is_methodpointer:boolean;override;
           function  is_addressonly:boolean;override;
           procedure make_external;
+          procedure add_to_procsym; overload; inline;
+          procedure add_to_procsym(sym: {tprocsym}tsym); overload; inline;
        end;
 
        { single linked list of overloaded procs }
@@ -4697,6 +4699,19 @@ implementation
       end;
 
 
+    procedure tprocdef.add_to_procsym; inline;
+      begin
+        tprocsym(procsym).ProcdefList.Add(self);
+      end;
+
+
+    procedure tprocdef.add_to_procsym(sym: {tprocsym}tsym); inline;
+      begin
+        procsym:=sym;
+        add_to_procsym;
+      end;
+
+
     procedure tprocdef.buildderef;
       begin
          inherited buildderef;
diff --git a/compiler/tokens.pas b/compiler/tokens.pas
index 3fe1505..3f29f59 100644
--- a/compiler/tokens.pas
+++ b/compiler/tokens.pas
@@ -257,6 +257,7 @@ type
     _PROCEDURE,
     _PROTECTED,
     _PUBLISHED,
+    _REFERENCE,
     _SOFTFLOAT,
     _THREADVAR,
     _WRITEONLY,
@@ -556,6 +557,7 @@ const
       (str:'PROCEDURE'     ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'PROTECTED'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'PUBLISHED'     ;special:false;keyword:[m_none];op:NOTOKEN),
+      (str:'REFERENCE'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'SOFTFLOAT'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'THREADVAR'     ;special:false;keyword:alllanguagemodes-[m_iso];op:NOTOKEN),
       (str:'WRITEONLY'     ;special:false;keyword:[m_none];op:NOTOKEN),
-- 
1.7.10.4


From 50d9448e318716108b8889e9e3fe258c5aba33e7 Mon Sep 17 00:00:00 2001
From: Vasiliy Kevroletin <kevroletin@gmail.com>
Date: Thu, 11 Apr 2013 13:41:44 +1100
Subject: [PATCH 03/14] Fix compilation. Implementation will be fixed in the
 future.

---
 compiler/defcmp.pas    |   12 +---
 compiler/nld.pas       |    4 +-
 compiler/pdecobj.pas   |    4 +-
 compiler/pexpr.pas     |    2 +-
 compiler/pmodules.pas  |    2 -
 compiler/pnameless.pas |  146 ++++++++++++++++++++++++++++++++++++++++++++++++
 compiler/psub.pas      |    5 +-
 compiler/ptype.pas     |    2 +-
 compiler/symdef.pas    |    6 ++
 9 files changed, 163 insertions(+), 20 deletions(-)
 create mode 100644 compiler/pnameless.pas

diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas
index bbb841f..00ba2bd 100644
--- a/compiler/defcmp.pas
+++ b/compiler/defcmp.pas
@@ -158,7 +158,7 @@ implementation
     uses
       verbose,systems,constexp,
       symtable,symsym,
-      defutil,symutil,pnameless;
+      defutil,symutil{,pnameless};
 
 
     function compare_defs_ext(def_from,def_to : tdef;
@@ -1589,7 +1589,7 @@ implementation
                        eq:=te_convert_l2;
                      end
 
-{TODO: refactor evil merge}
+(*** are_compatible_interfaces is missed ***
 
                    { interface coercion }
                    else if (def_from.typ=objectdef) and
@@ -1600,14 +1600,8 @@ implementation
                        doconv:=tc_equal;
                        eq:=te_convert_l1;
                      end
+*)
                    { ugly, but delphi allows it }
-                   else if (def_from.typ in [orddef,enumdef]) and
-                     (m_delphi in current_settings.modeswitches) and
-                     (cdo_explicit in cdoptions) then
-                     begin
-                       doconv:=tc_int_2_int;
-                       eq:=te_convert_l1;
-                     end;
                    { in Java enums /are/ class instances, and hence such
                      typecasts must not be treated as integer-like conversions;
                      arbitrary constants cannot be converted into classes/
diff --git a/compiler/nld.pas b/compiler/nld.pas
index 5230a70..cd6a44c 100644
--- a/compiler/nld.pas
+++ b/compiler/nld.pas
@@ -30,7 +30,7 @@ interface
        {$ifdef state_tracking}
        nstate,
        {$endif}
-       symconst,symbase,symtype,symsym,symdef;
+       symconst,symbase,symtype,symsym,symdef,pnameless;
 
     type
        Trttidatatype = (rdt_normal,rdt_ord2str,rdt_str2ord);
@@ -179,7 +179,7 @@ implementation
       verbose,globtype,globals,systems,constexp,
       symnot,symtable,
       defutil,defcmp,
-      htypechk,pass_1,procinfo,paramgr,pnameless,
+      htypechk,pass_1,procinfo,paramgr{,pnameless},
       cpuinfo,
       ncon,ninl,ncnv,nmem,ncal,nutils,
       cgbase
diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
index 31664f2..37f426f 100644
--- a/compiler/pdecobj.pas
+++ b/compiler/pdecobj.pas
@@ -868,14 +868,14 @@ implementation
 
               oldparse_only:=parse_only;
               parse_only:=true;
-              result:=parse_proc_dec(is_classdef,astruct);
+              result:=parse_proc_dec(astruct,as_procparsemode(is_classdef));
 
               { this is for error recovery as well as forward }
               { interface mappings, i.e. mapping to a method  }
               { which isn't declared yet                      }
               if assigned(result) then
                 begin
-                  parse_object_proc_directives(result, as_procparsemode(is_classdef));
+                  parse_object_proc_directives(result);
 
                   { check if dispid is set }
                   if is_dispinterface(result.struct) and not (po_dispid in result.procoptions) then
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 0bc3480..f23c2e6 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -70,7 +70,7 @@ implementation
        nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
        { parser }
        scanner,
-       pbase,pinline,ptype,pgenutil,procinfo,cpuinfo,pnameless,
+       pbase,pinline,ptype,pgenutil,procinfo,cpuinfo,pnameless
        ;
 
     { sub_expr(opmultiply) is need to get -1 ** 4 to be
diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas
index 9a011d8..5800b54 100644
--- a/compiler/pmodules.pas
+++ b/compiler/pmodules.pas
@@ -572,8 +572,6 @@ implementation
         inc(ps.refs);
         st.insert(ps);
         pd:=tprocdef(cnodeutils.create_main_procdef(target_info.cprefix+name,potype,ps));
-{TDOO: investigate. Evil merge}
-        pd.add_to_procsym(ps);
         { We don't need is a local symtable. Change it into the static
           symtable }
         pd.localst.free;
diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
new file mode 100644
index 0000000..4484fb8
--- /dev/null
+++ b/compiler/pnameless.pas
@@ -0,0 +1,146 @@
+unit pnameless;
+
+{$mode objfpc}
+
+interface
+
+uses node, symtype, symdef, symsym, globtype;
+
+function parse_method_reference(name: TIDString): tdef;
+function handle_possible_capture(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
+function parse_nameless_routine(pi: tprocdef): tnode;
+function load_captured_variable(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
+function maybe_create_frameobject(pi: tprocdef): boolean;
+
+implementation
+
+uses nld, { TODO: get rid of cicle reference }
+
+     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas;
+(* FrameObject contains
+   - captured variables of current procedure as fields
+   - anonymous functions as
+     - methods
+     - implementation of interface with single method 'invoke'
+   - pointer to FrameObject of outer procedure as fiels
+
+   FrameObject implements unique interface for each of it's methods
+ *)
+function maybe_create_frameobject(pi: tprocdef): boolean;
+var iIntfDef, intfObjDef: TObjectDef;
+
+  function FindTypeDefinitions: boolean;
+  var sym: tsym;
+      symtable: tsymtable;
+  begin
+    // TODO: is there better way to get tinterfacedobject ?
+    searchsym_type('TINTERFACEDOBJECT', sym, symtable);
+    if not assigned(sym) then InternalError(1);
+    if (sym.typ <> typesym) then InternalError(2);
+    intfObjDef := tobjectdef(ttypesym(sym).typedef);
+    searchsym_type('IUNKNOWN', sym, symtable);
+    if not assigned(sym) then InternalError(3);
+    if (sym.typ <> typesym) then InternalError(4);
+    iIntfDef := tobjectdef(ttypesym(sym).typedef);
+    Result := true;
+  end;
+
+var frameObjectDef: TObjectDef;
+    name: String;
+
+    pObj: tlocalvarsym;
+    pIntf: tlocalvarsym;
+
+    stmt, callNode: TNode;
+    symCreateProc: TSym;
+    dummySymTable: TSymTable;
+    bRet: Boolean;
+begin
+  // - construct classed
+  // - generate FrameObject initialization nodes
+  if assigned(pi.frameObjectDef) then exit(false);
+  FindTypeDefinitions();
+  name := '$' + pi.procsym.RealName + '_FrameObject'; // TODO: think about name
+  frameObjectDef := tobjectdef.create(odt_class, name, nil);
+  frameObjectDef.set_parent( intfObjDef );
+
+  pObj := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []); // TODO: Use temp here ?
+  pIntf := tlocalvarsym.create('$pFrameObjectIntf', vs_var, iIntfDef, []);
+  pi.localst.insert(pObj);
+  pi.localst.insert(pIntf);
+
+{ only tcgprocinfo have code field and can generate code    }
+{ so initialization on frameobject can be added for example }
+{ during pass_1 }
+
+{ may be temprorary during development generate code here and then move to appropriate place? }
+(*
+  bRet := searchsym_in_class( frameObjectDef, frameObjectDef, 'CREATE', symCreateProc, dummySymTable, false);
+  if not bRet then InternalError(5);
+  callNode := CCallNode.Create( nil,
+                                TProcSym(symCreateProc),
+                                frameObjectDef.symtable,
+                                CLoadVmtAddrNode.Create(CTypeNode.Create(frameObjectDef)),
+                                [cnf_return_value_used] ); // not sure about call parameters
+  do_typecheckpass(callNode); // most probably should be removed after finishing development
+
+  stmt := TAssignmentNode.Create( TLoadNode.Create(pIntf, pi.localst),
+                                  callNode );
+  CStatementNode.Create(stmt, nil); { add me to proc body }
+
+  stmt := TAssignmentNode.Create( TLoadNode.Create(pIntf, pi.localst),
+                                  TLoadNode.Create(pObj, pi.localst) );
+  CStatementNode.Create(stmt, nil); { add me to proc body }
+{ --- }
+*)
+
+  pi.frameObjectDef     := frameObjectDef;
+  { pi.frameObjectDeref }
+  pi.frameObjectSym     := pObj;
+  pi.frameObjectIntfSym := pIntf;
+  Result := true;
+end;
+
+function parse_method_reference(name: TIDString): tdef;
+begin
+  // TODO:
+  // type
+  //   TProc = reference to procedure(var a: Integer; ...);
+  Result := nil;
+end;
+
+function handle_possible_capture(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
+begin
+  // TODO:
+  Result := nil;
+end;
+
+function parse_nameless_routine(pi: tprocdef): tnode;
+var anonymProcDef: TProcDef;
+    intf: TObjectDef;
+    name: String;
+begin
+  maybe_create_frameobject(pi);
+  anonymProcDef := parse_proc_dec(pi.frameObjectDef, ppm_nameless_routine);
+  handle_calling_convention(anonymProcDef); // may be after read_proc ?
+  read_proc(false, anonymProcDef);
+
+  name := anonymProcDef.procsym.RealName + '_Intf'; // TODO: think about name
+  intf := tobjectdef.create(odt_interfacecom, name, nil);
+  intf.symtable.insert(anonymProcDef.procsym);
+
+  pi.frameObjectDef.register_implemented_interface(intf);
+
+  // generate typeconv node which return implemented interface
+  Result := nil;
+end;
+
+function load_captured_variable(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
+begin
+  // TODO:
+  Result := nil;
+end;
+
+begin
+  
+end.
diff --git a/compiler/psub.pas b/compiler/psub.pas
index 113c67e..fa40b14 100644
--- a/compiler/psub.pas
+++ b/compiler/psub.pas
@@ -28,8 +28,7 @@ interface
     uses
       globals,
       node,nbas,
-      symdef,procinfo,optdfa,
-      pdecsub;
+      symdef,procinfo,optdfa;
 
     type
 
@@ -1938,7 +1937,7 @@ implementation
 
          if not assigned(usefwpd) then
            { parse procedure declaration }
-           pd:=parse_proc_dec(isclassmethod,old_current_structdef)
+           pd:=parse_proc_dec(old_current_structdef,as_procparsemode(isclassmethod))
          else
            pd:=usefwpd;
 
diff --git a/compiler/ptype.pas b/compiler/ptype.pas
index 93b3e50..ac32deb 100644
--- a/compiler/ptype.pas
+++ b/compiler/ptype.pas
@@ -27,7 +27,7 @@ interface
 
     uses
        globtype,cclasses,
-       symtype,symdef,symbase;
+       symtype,symdef,symbase,pnameless;
 
     type
       TSingleTypeOption=(
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index 83afc44..226608b 100644
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@@ -686,6 +686,12 @@ interface
           interfacedef : boolean;
           { true if the procedure has a forward declaration }
           hasforward  : boolean;
+
+          frameObjectDef     : TObjectDef; { FrameObject class }
+          frameObjectDeref   : tderef;     { TODO: investigate where is tdref used }
+          frameObjectSym     : tsym;       { variable which holds link to FrameObject }
+          frameObjectIntfSym : tsym;       { interface variable which keeps FrameObject
+                                             from garbage collection }
           constructor create(level:byte);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
-- 
1.7.10.4


From 189eedf919ea846ffb7ec099e6c79c3db60edfec Mon Sep 17 00:00:00 2001
From: Vasiliy Kevroletin <kevroletin@gmail.com>
Date: Sat, 4 May 2013 11:39:08 +1100
Subject: [PATCH 04/14] Construct frame object. Return interface-reference as
 parsing result for anonymous function.

Now we are able to generate assembler code. But it crashes :)
1. Interface variables are not initialized.
2. Something wrong with frame object interfaces. Even initialization of frame object by hand doesn't help.
3. Compiler crashes if put anonymous function inside other function (currently only example have anonymous functin inside main)
---
 compiler/defcmp.pas    |    6 +-
 compiler/ncgvmt.pas    |   11 +--
 compiler/pdecsub.pas   |    4 +-
 compiler/pnameless.pas |  241 +++++++++++++++++++++++++++++++++++-------------
 compiler/psub.pas      |    9 +-
 compiler/ptype.pas     |    6 +-
 compiler/symdef.pas    |    5 +-
 7 files changed, 198 insertions(+), 84 deletions(-)

diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas
index 00ba2bd..4f979d0 100644
--- a/compiler/defcmp.pas
+++ b/compiler/defcmp.pas
@@ -158,7 +158,7 @@ implementation
     uses
       verbose,systems,constexp,
       symtable,symsym,
-      defutil,symutil{,pnameless};
+      defutil,symutil,pnameless;
 
 
     function compare_defs_ext(def_from,def_to : tdef;
@@ -1588,9 +1588,6 @@ implementation
                        doconv:=tc_variant_2_interface;
                        eq:=te_convert_l2;
                      end
-
-(*** are_compatible_interfaces is missed ***
-
                    { interface coercion }
                    else if (def_from.typ=objectdef) and
                      (tobjectdef(def_from).objecttype=odt_interfacecom) and
@@ -1600,7 +1597,6 @@ implementation
                        doconv:=tc_equal;
                        eq:=te_convert_l1;
                      end
-*)
                    { ugly, but delphi allows it }
                    { in Java enums /are/ class instances, and hence such
                      typecasts must not be treated as integer-like conversions;
diff --git a/compiler/ncgvmt.pas b/compiler/ncgvmt.pas
index a6f78c2..76ecee8 100644
--- a/compiler/ncgvmt.pas
+++ b/compiler/ncgvmt.pas
@@ -922,15 +922,8 @@ implementation
           begin
             def:=tdef(st.DefList[i]);
             { if def can contain nested types then handle its symtable }
-            case def.typ of
-              objectdef,recorddef:
-                gen_intf_wrappers(list,tabstractrecorddef(def).symtable);
-              procdef:
-                // check for local classes; currently, we only use them for closures
-                // TODO: this can slow codegen down dramatically?!
-                if assigned(tprocdef(def).localst) then
-                  gen_intf_wrappers(list,tprocdef(def).localst);
-            end;
+            if def.typ in [objectdef,recorddef] then
+              gen_intf_wrappers(list,tabstractrecorddef(def).symtable);
             if is_class(def) then
               gen_intf_wrapper(list,tobjectdef(def));
           end;
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index 487a585..96c2a74 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -1001,7 +1001,7 @@ implementation
             symtablestack.top.insert(aprocsym);
           end;
 
-        if procparsemode=ppm_nameless_routine then
+        if (procparsemode=ppm_nameless_routine) or (procparsemode=ppm_method_reference) then
           begin
             pd:=tprocdef.create(normal_function_level);
             include(pd.procoptions,po_nameless);
@@ -3344,7 +3344,7 @@ const
             if (currpd.proctypeoption = potype_function) and
                is_void(currpd.returndef) then
               MessagePos1(currpd.fileinfo,parser_e_no_funcret_specified,currpd.procsym.realname);
-            currpd.add_to_procsym;
+            tprocsym(currpd.procsym).ProcdefList.Add(currpd);
           end;
 
         proc_add_definition:=forwardfound;
diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
index 4484fb8..464754e 100644
--- a/compiler/pnameless.pas
+++ b/compiler/pnameless.pas
@@ -6,17 +6,46 @@ interface
 
 uses node, symtype, symdef, symsym, globtype;
 
-function parse_method_reference(name: TIDString): tdef;
+function are_compatible_interfaces(def_to: TObjectDef; def_from: TObjectDef): Boolean;
+function parse_method_reference: tdef;
 function handle_possible_capture(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
-function parse_nameless_routine(pi: tprocdef): tnode;
+function parse_nameless_routine(var pi: tprocdef): tnode;
 function load_captured_variable(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
-function maybe_create_frameobject(pi: tprocdef): boolean;
+function maybe_create_frameobject(var pd: tprocdef): boolean;
+function maybe_finish_frameobject(pi: tprocdef): boolean;
 
 implementation
 
-uses nld, { TODO: get rid of cicle reference }
+(** TODO:
+  current implementation:
+  Parse phase:
++ 1. Create frame object for parent procedures. Kepp frame object alive using local interface-variable.
++ 2. Each anonymous procedure is a method of frame object and method of unique interface with single
+     method 'Invoke'. Frame object implements this interface.
++ 3. Each reference to procedure is interface-variable. Think how to implement.
++ 4. Definition of anonymous procedure returns implementation of according onterface from frame object.
+- 5. Type convertion is aware about this dances.
+  Typecheck pass:
+- 6. Call for reference to procedure is translated into call of needed method from interface which is
+     stored in variable.
+- 7. Call for interface which is assigned to variable also converted to call of apropriate interface
+     method.
+  First pass ?
+- 8. Add frame object initialization code.
+
+Details which should be clarified:
+LINK [1]
+1. Generated types registered in module local symtable.
+   + Required to have proper destruction of data.
+   + Simple.
+   - Violates functional approach in developments.
+   TODO: move to local procedure sym table
+     - For some reasons Pascal forbids local classes. There can be problems with it. And it's not
+       obvious to ancient Pascalists
+*)
 
-     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas;
+uses nld, { TODO: get rid of cicle reference }
+     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas, ncnv, pbase, tokens, nobj, fmodule, ncon;
 (* FrameObject contains
    - captured variables of current procedure as fields
    - anonymous functions as
@@ -26,7 +55,72 @@ uses nld, { TODO: get rid of cicle reference }
 
    FrameObject implements unique interface for each of it's methods
  *)
-function maybe_create_frameobject(pi: tprocdef): boolean;
+
+procedure BuildObjVmt_(objDef: TobjectDef);
+var vmtBuilder: TVMTBuilder;
+begin
+  vmtBuilder := TVMTBuilder.Create(objDef);
+  vmtBuilder.generate_vmt;
+  vmtBuilder.free;
+end;
+
+function maybe_finish_frameobject(pi: tprocdef): boolean;
+
+{ only tcgprocinfo have code field and can generate code    }
+{ so initialization on frameobject can be added for example }
+{ during pass_1 ? }
+
+  // TODO: temporary here
+  procedure GenFrameObjectInitCode(frameObjectDef: TObjectDef; intfSym, objSym: TSym);
+  var
+    createObj, initIntf, assignIntf, callNode: TNode;
+    symCreateProc: TSym;
+    dummySymTable: TSymTable;
+    bRet: Boolean;
+    stmt: TStatementNode;
+    cgpi: tcgprocinfo;
+    block: tblocknode;
+  begin
+    bRet := searchsym_in_class( frameObjectDef, frameObjectDef, 'CREATE', symCreateProc, dummySymTable, false);
+    if not bRet then InternalError(5);
+    callNode := CCallNode.Create( nil,
+                                  TProcSym(symCreateProc),
+                                  frameObjectDef.symtable,
+                                  CLoadVmtAddrNode.Create(CTypeNode.Create(frameObjectDef)),
+                                  [cnf_return_value_used] ); // not sure about call parameters
+    do_typecheckpass(callNode); // most probably should be removed after finishing development
+
+    cgpi := tcgprocinfo(current_procinfo);
+    if cgpi.code.nodetype <> blockn then InternalError(5);
+    block := TBlockNode(cgpi.code);
+
+    createObj := CAssignmentNode.Create(CLoadNode.Create(objSym, pi.localst),
+                                        callNode);
+    initIntf := CAssignmentNode.Create(CLoadNode.Create(intfSym, pi.localst),
+                                       CNilNode.Create());
+    assignIntf := CAssignmentNode.Create(CLoadNode.Create(intfSym, pi.localst),
+                                         CLoadNode.Create(objSym, pi.localst));
+
+    stmt := CStatementNode.Create(createObj,
+//            CStatementNode.Create(initIntf, // *** MEGATODO *** We broke initialization of interface variables
+// which causes segmentation faults
+            CStatementNode.Create(assignIntf,
+                                  block.left));
+    block.left := stmt;
+
+    do_typecheckpass(TNode(block));
+  end;
+
+begin
+  Result := assigned(pi.frameObjectDef);
+  if Result then
+  begin
+    BuildObjVmt_(pi.frameObjectDef);
+    GenFrameObjectInitCode(pi.frameObjectDef, pi.frameObjectIntfSym, pi.frameObjectSym);
+  end;
+end;
+
+function maybe_create_frameobject(var pd: tprocdef): boolean;
 var iIntfDef, intfObjDef: TObjectDef;
 
   function FindTypeDefinitions: boolean;
@@ -48,65 +142,63 @@ var iIntfDef, intfObjDef: TObjectDef;
 var frameObjectDef: TObjectDef;
     name: String;
 
-    pObj: tlocalvarsym;
-    pIntf: tlocalvarsym;
-
-    stmt, callNode: TNode;
-    symCreateProc: TSym;
-    dummySymTable: TSymTable;
-    bRet: Boolean;
+    objSym: tlocalvarsym;
+    intfSym: tlocalvarsym;
 begin
   // - construct classed
   // - generate FrameObject initialization nodes
-  if assigned(pi.frameObjectDef) then exit(false);
+  if assigned(pd.frameObjectDef) then exit(false);
   FindTypeDefinitions();
-  name := '$' + pi.procsym.RealName + '_FrameObject'; // TODO: think about name
+  name := '$' + pd.procsym.RealName + '_FrameObjectDef'; // TODO: think about name
   frameObjectDef := tobjectdef.create(odt_class, name, nil);
+  include(frameObjectDef.objectoptions, oo_is_nameless);
+  frameObjectDef.typesym := TTypeSym.Create(name, frameObjectDef);
   frameObjectDef.set_parent( intfObjDef );
 
-  pObj := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []); // TODO: Use temp here ?
-  pIntf := tlocalvarsym.create('$pFrameObjectIntf', vs_var, iIntfDef, []);
-  pi.localst.insert(pObj);
-  pi.localst.insert(pIntf);
-
-{ only tcgprocinfo have code field and can generate code    }
-{ so initialization on frameobject can be added for example }
-{ during pass_1 }
-
-{ may be temprorary during development generate code here and then move to appropriate place? }
-(*
-  bRet := searchsym_in_class( frameObjectDef, frameObjectDef, 'CREATE', symCreateProc, dummySymTable, false);
-  if not bRet then InternalError(5);
-  callNode := CCallNode.Create( nil,
-                                TProcSym(symCreateProc),
-                                frameObjectDef.symtable,
-                                CLoadVmtAddrNode.Create(CTypeNode.Create(frameObjectDef)),
-                                [cnf_return_value_used] ); // not sure about call parameters
-  do_typecheckpass(callNode); // most probably should be removed after finishing development
-
-  stmt := TAssignmentNode.Create( TLoadNode.Create(pIntf, pi.localst),
-                                  callNode );
-  CStatementNode.Create(stmt, nil); { add me to proc body }
-
-  stmt := TAssignmentNode.Create( TLoadNode.Create(pIntf, pi.localst),
-                                  TLoadNode.Create(pObj, pi.localst) );
-  CStatementNode.Create(stmt, nil); { add me to proc body }
-{ --- }
-*)
+  objSym := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []); // TODO: Use temp here ?
+  intfSym := tlocalvarsym.create('$pFrameObjectIntf', vs_var, iIntfDef, []);
+  pd.localst.insert(objSym);
+  pd.localst.insert(intfSym);
+//  pd.localst.insert(frameObjectDef.typesym); see comments somewhere below
+  current_module.localsymtable.insert(frameObjectDef.typesym); // ^_^ why not ?
 
-  pi.frameObjectDef     := frameObjectDef;
-  { pi.frameObjectDeref }
-  pi.frameObjectSym     := pObj;
-  pi.frameObjectIntfSym := pIntf;
+  pd.frameObjectDef     := frameObjectDef;
+  { pd.frameObjectDeref }
+  pd.frameObjectSym     := objSym;
+  pd.frameObjectIntfSym := intfSym;
   Result := true;
+
 end;
 
-function parse_method_reference(name: TIDString): tdef;
+function are_compatible_interfaces(def_to: TObjectDef; def_from: TObjectDef): Boolean;
 begin
-  // TODO:
-  // type
-  //   TProc = reference to procedure(var a: Integer; ...);
-  Result := nil;
+  // TODO: Perform meaningful check!!!
+  Result := def_to.isClosure and def_from.isClosure;
+end;
+
+function parse_method_reference: tdef;
+var typesym: TTypeSym;
+    intf: TObjectDef;
+    name: String;
+    procDef: TProcDef;
+begin
+  consume(_REFERENCE); consume(_TO);
+  name := 'SuperPuper_Intf'; // TODO: think about name
+  intf := tobjectdef.create(odt_interfacecom, name, nil);
+  intf.typesym := TTypeSym.Create(name, intf);
+  intf.isClosure := true;
+
+  // ZZZ: tsym.name work incorrectly if not to add symbol to symtable
+  symtablestack.top.insert(intf.typesym); // TODO: it it right place to insert ?
+
+  symtablestack.push(intf.symtable);
+  procDef := parse_proc_dec(intf, ppm_method_reference);
+  include(procDef.procoptions, po_virtualmethod);
+  tprocsym(procDef.procsym).ProcdefList.Add(procDef); // unless procedure will be invisible
+  handle_calling_convention(procDef);
+  symtablestack.pop(intf.symtable);
+  BuildObjVmt_(intf);
+  Result := intf;
 end;
 
 function handle_possible_capture(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
@@ -115,24 +207,49 @@ begin
   Result := nil;
 end;
 
-function parse_nameless_routine(pi: tprocdef): tnode;
+function parse_nameless_routine(var pi: tprocdef): tnode;
+
+  // well, I don't like this banch of gloval variables which each function save on stack
+  procedure ReadProcBody_(framObjectDef: TObjectDef; anonymProcDef: TProcDef);
+  var old_current_structdef: tabstractrecorddef;
+  begin
+    old_current_structdef := current_structdef;
+    current_structdef := framObjectDef;
+    read_proc(false, anonymProcDef);
+    proc_add_definition(anonymProcDef);     { add definition to procsym } // TODO: does it makes sense ? // !!! doesn't checked yett
+    current_structdef := old_current_structdef;
+  end;
+
 var anonymProcDef: TProcDef;
+    cloneProcDef: TProcDef;
     intf: TObjectDef;
-    name: String;
+    intfName: String;
 begin
   maybe_create_frameobject(pi);
+//  symtablestack.push(pi.frameObjectDef.symtable);
   anonymProcDef := parse_proc_dec(pi.frameObjectDef, ppm_nameless_routine);
-  handle_calling_convention(anonymProcDef); // may be after read_proc ?
-  read_proc(false, anonymProcDef);
+  include(anonymProcDef.procoptions, po_virtualmethod);
+  handle_calling_convention(anonymProcDef);
+  cloneProcDef := TProcDef(anonymProcDef.getcopy);
 
-  name := anonymProcDef.procsym.RealName + '_Intf'; // TODO: think about name
-  intf := tobjectdef.create(odt_interfacecom, name, nil);
-  intf.symtable.insert(anonymProcDef.procsym);
+  ReadProcBody_(pi.frameObjectDef, anonymProcDef);
+//  symtablestack.pop(pi.frameObjectDef.symtable); // think about this more
+
+  intfName := anonymProcDef.procsym.RealName + '_IntfDef'; // TODO: think about name
+  intf := tobjectdef.create(odt_interfacecom, intfName, nil);
+  intf.typesym := TTypeSym.Create(intfName, intf);
+  current_module.localsymtable.insert(intf.typesym); // [1]
+
+  cloneProcDef.struct := intf;
+  cloneProcDef.procsym := TProcSym.Create('Invoke');
+  intf.symtable.insert(cloneProcDef.procsym);
+  intf.isClosure := true;
+  BuildObjVmt_(intf);
 
   pi.frameObjectDef.register_implemented_interface(intf);
 
-  // generate typeconv node which return implemented interface
-  Result := nil;
+  Result := CLoadNode.Create(pi.frameObjectSym, pi.localst);
+  inserttypeconv(Result, intf);
 end;
 
 function load_captured_variable(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
diff --git a/compiler/psub.pas b/compiler/psub.pas
index fa40b14..ae002ab 100644
--- a/compiler/psub.pas
+++ b/compiler/psub.pas
@@ -127,6 +127,7 @@ implementation
            ,aopt
          {$endif i386}
        {$endif}
+       ,pnameless
        ;
 
     function checknodeinlining(procdef: tprocdef): boolean;
@@ -1712,6 +1713,7 @@ implementation
 
          { parse the code ... }
          code:=block(current_module.islibrary);
+         maybe_finish_frameobject(self.procDef);
 
          if (df_generic in procdef.defoptions) then
            begin
@@ -1898,7 +1900,12 @@ implementation
         { For specialization we didn't record the last semicolon. Moving this parsing
           into the parse_body routine is not done because of having better file position
           information available }
-        if not(df_specialization in current_procinfo.procdef.defoptions) then
+
+        // TDOO: ugly hack
+        if not(df_specialization in current_procinfo.procdef.defoptions) and
+           not (assigned(current_procinfo.procdef.struct) and
+                (oo_is_nameless in current_procinfo.procdef.struct.objectoptions))
+        then
           consume(_SEMICOLON);
 
         if not isnestedproc then
diff --git a/compiler/ptype.pas b/compiler/ptype.pas
index ac32deb..07b2ba8 100644
--- a/compiler/ptype.pas
+++ b/compiler/ptype.pas
@@ -27,7 +27,7 @@ interface
 
     uses
        globtype,cclasses,
-       symtype,symdef,symbase,pnameless;
+       symtype,symdef,symbase;
 
     type
       TSingleTypeOption=(
@@ -81,7 +81,7 @@ implementation
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
        { parser }
        scanner,
-       pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil{,pnameless}
+       pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil,pnameless
 {$ifdef jvm}
        ,pjvm
 {$endif}
@@ -1675,7 +1675,7 @@ implementation
               end;
             _ID:
               if idtoken=_REFERENCE then // TODO: $mode Delphi only?
-                def:=parse_method_reference(name)
+                def:=parse_method_reference
               else
                 expr_type;
             else
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index 226608b..9f6aab7 100644
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@@ -357,6 +357,8 @@ interface
           }
           classref_created_in_current_module : boolean;
           objecttype     : tobjecttyp;
+                                    // TODO: this is hack
+          isClosure      : Boolean; // Interface is generated for anonymous method or for methodvar
           constructor create(ot:tobjecttyp;const n:string;c:tobjectdef);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
@@ -377,9 +379,7 @@ interface
           function  find_implemented_interface(aintfdef:tobjectdef):TImplementedInterface;
           { this should be called when this class implements an interface }
           procedure register_implemented_interface(const intfdef: tobjectdef);
-       strict private
           procedure prepareguid;
-       public
           function  is_publishable : boolean;override;
           function  is_related(d : tdef) : boolean;override;
           function  needs_inittable : boolean;override;
@@ -5395,6 +5395,7 @@ implementation
 
    constructor tobjectdef.create(ot:tobjecttyp;const n:string;c:tobjectdef);
      begin
+        isClosure := false;
         inherited create(n,objectdef);
         fcurrent_dispid:=0;
         objecttype:=ot;
-- 
1.7.10.4


From 7c8a60a91d0a6f0056783bea1367865b0738e0b2 Mon Sep 17 00:00:00 2001
From: Vasiliy Kevroletin <kevroletin@gmail.com>
Date: Fri, 10 May 2013 14:24:17 +1100
Subject: [PATCH 05/14] Generate frame object's initialization code in right
 place.

Now compiler parses anonymous functin not only inside PascalMain.

TODO:
Resulting programms crash. This is because compiler does not generat interface wrappers.
---
 compiler/pnameless.pas |  127 ++++++++++++++++++++++++------------------------
 compiler/psub.pas      |    5 +-
 2 files changed, 67 insertions(+), 65 deletions(-)

diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
index 464754e..0effb49 100644
--- a/compiler/pnameless.pas
+++ b/compiler/pnameless.pas
@@ -8,16 +8,18 @@ uses node, symtype, symdef, symsym, globtype;
 
 function are_compatible_interfaces(def_to: TObjectDef; def_from: TObjectDef): Boolean;
 function parse_method_reference: tdef;
-function handle_possible_capture(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
-function parse_nameless_routine(var pi: tprocdef): tnode;
-function load_captured_variable(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
+function handle_possible_capture(pd: tprocdef; name: tabstractnormalvarsym): tnode;
+function parse_nameless_routine(var pd: tprocdef): tnode;
+function load_captured_variable(pd: tprocdef; name: tabstractnormalvarsym): tnode;
 function maybe_create_frameobject(var pd: tprocdef): boolean;
-function maybe_finish_frameobject(pi: tprocdef): boolean;
+function maybe_finish_frameobject(pd: tprocdef): boolean;
+function add_init_frameobject(body: TNode; pd: TProcDef): TNode;
 
 implementation
 
 (** TODO:
-  current implementation:
+
+Current implementation:
   Parse phase:
 + 1. Create frame object for parent procedures. Kepp frame object alive using local interface-variable.
 + 2. Each anonymous procedure is a method of frame object and method of unique interface with single
@@ -42,6 +44,14 @@ LINK [1]
    TODO: move to local procedure sym table
      - For some reasons Pascal forbids local classes. There can be problems with it. And it's not
        obvious to ancient Pascalists
+
+2. How link to self will be stored?
+
+Current problems:
+1. Interface variables are not initialized by 0s.
+2. Compiler crashes if declare anonymous function not inside main.
+3. Interface wrappers are not generated.
+
 *)
 
 uses nld, { TODO: get rid of cicle reference }
@@ -64,60 +74,49 @@ begin
   vmtBuilder.free;
 end;
 
-function maybe_finish_frameobject(pi: tprocdef): boolean;
-
-{ only tcgprocinfo have code field and can generate code    }
-{ so initialization on frameobject can be added for example }
-{ during pass_1 ? }
-
-  // TODO: temporary here
-  procedure GenFrameObjectInitCode(frameObjectDef: TObjectDef; intfSym, objSym: TSym);
-  var
-    createObj, initIntf, assignIntf, callNode: TNode;
-    symCreateProc: TSym;
-    dummySymTable: TSymTable;
-    bRet: Boolean;
-    stmt: TStatementNode;
-    cgpi: tcgprocinfo;
-    block: tblocknode;
-  begin
-    bRet := searchsym_in_class( frameObjectDef, frameObjectDef, 'CREATE', symCreateProc, dummySymTable, false);
-    if not bRet then InternalError(5);
-    callNode := CCallNode.Create( nil,
-                                  TProcSym(symCreateProc),
-                                  frameObjectDef.symtable,
-                                  CLoadVmtAddrNode.Create(CTypeNode.Create(frameObjectDef)),
-                                  [cnf_return_value_used] ); // not sure about call parameters
-    do_typecheckpass(callNode); // most probably should be removed after finishing development
-
-    cgpi := tcgprocinfo(current_procinfo);
-    if cgpi.code.nodetype <> blockn then InternalError(5);
-    block := TBlockNode(cgpi.code);
-
-    createObj := CAssignmentNode.Create(CLoadNode.Create(objSym, pi.localst),
-                                        callNode);
-    initIntf := CAssignmentNode.Create(CLoadNode.Create(intfSym, pi.localst),
-                                       CNilNode.Create());
-    assignIntf := CAssignmentNode.Create(CLoadNode.Create(intfSym, pi.localst),
-                                         CLoadNode.Create(objSym, pi.localst));
-
-    stmt := CStatementNode.Create(createObj,
-//            CStatementNode.Create(initIntf, // *** MEGATODO *** We broke initialization of interface variables
-// which causes segmentation faults
-            CStatementNode.Create(assignIntf,
-                                  block.left));
-    block.left := stmt;
-
-    do_typecheckpass(TNode(block));
-  end;
+function add_init_frameobject(body: TNode; pd: TProcDef): TNode;
+var
+  createObj, assignIntf, callNode: TNode;
+  symCreateProc: TSym;
+  dummySymTable: TSymTable;
+  bRet: Boolean;
+  stmt: TStatementNode;
+  block: tblocknode;
+  intfSym, objSym: TSym;
+begin
+  intfSym := pd.frameObjectIntfSym;
+  objSym := pd.frameObjectSym;
+
+  bRet := searchsym_in_class( pd.frameObjectDef, pd.frameObjectDef, 'CREATE', symCreateProc, dummySymTable, false);
+  if not bRet then InternalError(5);
+  callNode := CCallNode.Create( nil,
+                                TProcSym(symCreateProc),
+                                pd.frameObjectDef.symtable,
+                                CLoadVmtAddrNode.Create(CTypeNode.Create(pd.frameObjectDef)),
+                                [cnf_return_value_used] ); // not sure about call parameters
+  do_typecheckpass(callNode); // most probably should be removed after finishing development
+
+  block := TBlockNode(body);
+
+  createObj := CAssignmentNode.Create(CLoadNode.Create(objSym, pd.localst),
+                                      callNode);
+  assignIntf := CAssignmentNode.Create(CLoadNode.Create(intfSym, pd.localst),
+                                       CLoadNode.Create(objSym, pd.localst));
+
+  stmt := CStatementNode.Create(createObj,
+          CStatementNode.Create(assignIntf,
+                                block.left));
+  block.left := stmt;
+
+  do_typecheckpass(TNode(block));
+  Result := block;
+end;
 
+function maybe_finish_frameobject(pd: tprocdef): boolean;
 begin
-  Result := assigned(pi.frameObjectDef);
+  Result := assigned(pd.frameObjectDef);
   if Result then
-  begin
-    BuildObjVmt_(pi.frameObjectDef);
-    GenFrameObjectInitCode(pi.frameObjectDef, pi.frameObjectIntfSym, pi.frameObjectSym);
-  end;
+    BuildObjVmt_(pd.frameObjectDef);
 end;
 
 function maybe_create_frameobject(var pd: tprocdef): boolean;
@@ -201,13 +200,13 @@ begin
   Result := intf;
 end;
 
-function handle_possible_capture(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
+function handle_possible_capture(pd: tprocdef; name: tabstractnormalvarsym): tnode;
 begin
   // TODO:
   Result := nil;
 end;
 
-function parse_nameless_routine(var pi: tprocdef): tnode;
+function parse_nameless_routine(var pd: tprocdef): tnode;
 
   // well, I don't like this banch of gloval variables which each function save on stack
   procedure ReadProcBody_(framObjectDef: TObjectDef; anonymProcDef: TProcDef);
@@ -225,14 +224,14 @@ var anonymProcDef: TProcDef;
     intf: TObjectDef;
     intfName: String;
 begin
-  maybe_create_frameobject(pi);
+  maybe_create_frameobject(pd);
 //  symtablestack.push(pi.frameObjectDef.symtable);
-  anonymProcDef := parse_proc_dec(pi.frameObjectDef, ppm_nameless_routine);
+  anonymProcDef := parse_proc_dec(pd.frameObjectDef, ppm_nameless_routine);
   include(anonymProcDef.procoptions, po_virtualmethod);
   handle_calling_convention(anonymProcDef);
   cloneProcDef := TProcDef(anonymProcDef.getcopy);
 
-  ReadProcBody_(pi.frameObjectDef, anonymProcDef);
+  ReadProcBody_(pd.frameObjectDef, anonymProcDef);
 //  symtablestack.pop(pi.frameObjectDef.symtable); // think about this more
 
   intfName := anonymProcDef.procsym.RealName + '_IntfDef'; // TODO: think about name
@@ -246,13 +245,13 @@ begin
   intf.isClosure := true;
   BuildObjVmt_(intf);
 
-  pi.frameObjectDef.register_implemented_interface(intf);
+  pd.frameObjectDef.register_implemented_interface(intf);
 
-  Result := CLoadNode.Create(pi.frameObjectSym, pi.localst);
+  Result := CLoadNode.Create(pd.frameObjectSym, pd.localst);
   inserttypeconv(Result, intf);
 end;
 
-function load_captured_variable(procinfo: tprocdef; name: tabstractnormalvarsym): tnode;
+function load_captured_variable(pd: tprocdef; name: tabstractnormalvarsym): tnode;
 begin
   // TODO:
   Result := nil;
diff --git a/compiler/psub.pas b/compiler/psub.pas
index ae002ab..034195c 100644
--- a/compiler/psub.pas
+++ b/compiler/psub.pas
@@ -337,6 +337,10 @@ implementation
             begin
                { parse routine body }
                block:=statement_block(_BEGIN);
+               if maybe_finish_frameobject(current_procinfo.procdef) then
+                 block := add_init_frameobject(block, current_procinfo.procdef);
+
+
                { initialized variables }
                if current_procinfo.procdef.localst.symtabletype=localsymtable then
                  begin
@@ -1713,7 +1717,6 @@ implementation
 
          { parse the code ... }
          code:=block(current_module.islibrary);
-         maybe_finish_frameobject(self.procDef);
 
          if (df_generic in procdef.defoptions) then
            begin
-- 
1.7.10.4


From cea0df318482744ded3c5fcb9a8e84463762bf1a Mon Sep 17 00:00:00 2001
From: Vasiliy Kevroletin <kevroletin@gmail.com>
Date: Mon, 13 May 2013 12:52:53 +1100
Subject: [PATCH 06/14] Inherit created interfaces xfrom IUnknown.

Current problems:
 -interface variables isn't initialized by 0s(probably because I used localvarsym instead of staticvarsym in pascalmain;
 -intf wrappers (again) is not generated. But now virtual tables are ok;
 -didn't check call of anonymous function
---
 compiler/pnameless.pas |   28 ++++++++++++++++------------
 1 file changed, 16 insertions(+), 12 deletions(-)

diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
index 0effb49..441d10f 100644
--- a/compiler/pnameless.pas
+++ b/compiler/pnameless.pas
@@ -120,9 +120,9 @@ begin
 end;
 
 function maybe_create_frameobject(var pd: tprocdef): boolean;
-var iIntfDef, intfObjDef: TObjectDef;
+var intfObjDef: TObjectDef;
 
-  function FindTypeDefinitions: boolean;
+  function FindTypeDefinitions_: boolean;
   var sym: tsym;
       symtable: tsymtable;
   begin
@@ -131,10 +131,6 @@ var iIntfDef, intfObjDef: TObjectDef;
     if not assigned(sym) then InternalError(1);
     if (sym.typ <> typesym) then InternalError(2);
     intfObjDef := tobjectdef(ttypesym(sym).typedef);
-    searchsym_type('IUNKNOWN', sym, symtable);
-    if not assigned(sym) then InternalError(3);
-    if (sym.typ <> typesym) then InternalError(4);
-    iIntfDef := tobjectdef(ttypesym(sym).typedef);
     Result := true;
   end;
 
@@ -144,10 +140,8 @@ var frameObjectDef: TObjectDef;
     objSym: tlocalvarsym;
     intfSym: tlocalvarsym;
 begin
-  // - construct classed
-  // - generate FrameObject initialization nodes
   if assigned(pd.frameObjectDef) then exit(false);
-  FindTypeDefinitions();
+  FindTypeDefinitions_();
   name := '$' + pd.procsym.RealName + '_FrameObjectDef'; // TODO: think about name
   frameObjectDef := tobjectdef.create(odt_class, name, nil);
   include(frameObjectDef.objectoptions, oo_is_nameless);
@@ -155,7 +149,7 @@ begin
   frameObjectDef.set_parent( intfObjDef );
 
   objSym := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []); // TODO: Use temp here ?
-  intfSym := tlocalvarsym.create('$pFrameObjectIntf', vs_var, iIntfDef, []);
+  intfSym := tlocalvarsym.create('$pFrameObjectIntf', vs_var, interface_iunknown, []);
   pd.localst.insert(objSym);
   pd.localst.insert(intfSym);
 //  pd.localst.insert(frameObjectDef.typesym); see comments somewhere below
@@ -172,7 +166,7 @@ end;
 function are_compatible_interfaces(def_to: TObjectDef; def_from: TObjectDef): Boolean;
 begin
   // TODO: Perform meaningful check!!!
-  Result := def_to.isClosure and def_from.isClosure;
+  Result := def_to.isClosure or def_from.isClosure;
 end;
 
 function parse_method_reference: tdef;
@@ -184,6 +178,7 @@ begin
   consume(_REFERENCE); consume(_TO);
   name := 'SuperPuper_Intf'; // TODO: think about name
   intf := tobjectdef.create(odt_interfacecom, name, nil);
+  intf.set_parent(interface_iunknown);
   intf.typesym := TTypeSym.Create(name, intf);
   intf.isClosure := true;
 
@@ -195,6 +190,7 @@ begin
   include(procDef.procoptions, po_virtualmethod);
   tprocsym(procDef.procsym).ProcdefList.Add(procDef); // unless procedure will be invisible
   handle_calling_convention(procDef);
+  proc_add_definition(procDef); // not sure why it is here
   symtablestack.pop(intf.symtable);
   BuildObjVmt_(intf);
   Result := intf;
@@ -211,12 +207,18 @@ function parse_nameless_routine(var pd: tprocdef): tnode;
   // well, I don't like this banch of gloval variables which each function save on stack
   procedure ReadProcBody_(framObjectDef: TObjectDef; anonymProcDef: TProcDef);
   var old_current_structdef: tabstractrecorddef;
+      old_current_procinfo: tprocinfo;
   begin
     old_current_structdef := current_structdef;
+    old_current_procinfo := current_procinfo;
     current_structdef := framObjectDef;
+    while current_procinfo.parent <> nil do
+      current_procinfo := current_procinfo.parent;
     read_proc(false, anonymProcDef);
-    proc_add_definition(anonymProcDef);     { add definition to procsym } // TODO: does it makes sense ? // !!! doesn't checked yett
+    proc_add_definition(anonymProcDef);     { add definition to procsym }
     current_structdef := old_current_structdef;
+    current_procinfo := old_current_procinfo;
+    current_module.procinfo := old_current_procinfo;
   end;
 
 var anonymProcDef: TProcDef;
@@ -229,6 +231,7 @@ begin
   anonymProcDef := parse_proc_dec(pd.frameObjectDef, ppm_nameless_routine);
   include(anonymProcDef.procoptions, po_virtualmethod);
   handle_calling_convention(anonymProcDef);
+//  proc_add_definition(anonymProcDef);
   cloneProcDef := TProcDef(anonymProcDef.getcopy);
 
   ReadProcBody_(pd.frameObjectDef, anonymProcDef);
@@ -237,6 +240,7 @@ begin
   intfName := anonymProcDef.procsym.RealName + '_IntfDef'; // TODO: think about name
   intf := tobjectdef.create(odt_interfacecom, intfName, nil);
   intf.typesym := TTypeSym.Create(intfName, intf);
+  intf.set_parent(interface_iunknown);
   current_module.localsymtable.insert(intf.typesym); // [1]
 
   cloneProcDef.struct := intf;
-- 
1.7.10.4


From 636623928c62b4a38f80d6ed98c5a3a8e9a96647 Mon Sep 17 00:00:00 2001
From: Vasiliy Kevroletin <kevroletin@gmail.com>
Date: Sun, 19 May 2013 18:50:14 +1100
Subject: [PATCH 07/14] Fixed generation of intf wrappers. Now vtbl for frame
 object is ok. Intf wrappers are ok.

Problem: compiler generate intf wrappers for frame object only if closure defined inside PascalMain.
Cause: during creation of tprocdef it adds itself into module defs and into top symtable defs(look into one of inherited constructors of tprocdef). Since class definition inside procedure is forbidden all class definitions was inside
current_module.localsymtable. And code which generates wrappers didn't look into nested symtables.
Fix: walk through nested symtables during creation of intf wrappers.

Current state:
+ it's possible to assign closure to variable and call it
+ looks like parameters passing works ok
- variables capturing doesn't work
- compiler doesn't check types during assignment of closure to variable
- it's magic that something works, didn't perform proper(and even not proper) testing
---
 compiler/ncgvmt.pas    |    8 ++++++--
 compiler/pnameless.pas |   38 +++++++++++++++++++-------------------
 2 files changed, 25 insertions(+), 21 deletions(-)

diff --git a/compiler/ncgvmt.pas b/compiler/ncgvmt.pas
index 76ecee8..cf2d7e5 100644
--- a/compiler/ncgvmt.pas
+++ b/compiler/ncgvmt.pas
@@ -921,9 +921,13 @@ implementation
         for i:=0 to st.DefList.Count-1 do
           begin
             def:=tdef(st.DefList[i]);
-            { if def can contain nested types then handle its symtable }
+            { if def can contain nested types then handle it symtable }
             if def.typ in [objectdef,recorddef] then
-              gen_intf_wrappers(list,tabstractrecorddef(def).symtable);
+              gen_intf_wrappers(list,tabstractrecorddef(def).symtable)
+            // Defs are inserted into top symtable during construction. During closure parsing we
+            // create class definition for frame object, so it stored in procedure localsymtable.
+            else if (def.typ in [procdef]) and (assigned(tprocdef(def).localst)) then
+              gen_intf_wrappers(list,tprocdef(def).localst);
             if is_class(def) then
               gen_intf_wrapper(list,tobjectdef(def));
           end;
diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
index 441d10f..a3a640b 100644
--- a/compiler/pnameless.pas
+++ b/compiler/pnameless.pas
@@ -143,10 +143,9 @@ begin
   if assigned(pd.frameObjectDef) then exit(false);
   FindTypeDefinitions_();
   name := '$' + pd.procsym.RealName + '_FrameObjectDef'; // TODO: think about name
-  frameObjectDef := tobjectdef.create(odt_class, name, nil);
+  frameObjectDef := tobjectdef.create(odt_class, name, intfObjDef);
+  TTypeSym.Create(name, frameObjectDef);
   include(frameObjectDef.objectoptions, oo_is_nameless);
-  frameObjectDef.typesym := TTypeSym.Create(name, frameObjectDef);
-  frameObjectDef.set_parent( intfObjDef );
 
   objSym := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []); // TODO: Use temp here ?
   intfSym := tlocalvarsym.create('$pFrameObjectIntf', vs_var, interface_iunknown, []);
@@ -176,14 +175,14 @@ var typesym: TTypeSym;
     procDef: TProcDef;
 begin
   consume(_REFERENCE); consume(_TO);
-  name := 'SuperPuper_Intf'; // TODO: think about name
-  intf := tobjectdef.create(odt_interfacecom, name, nil);
-  intf.set_parent(interface_iunknown);
+  name := 'ClosureReference_IntfDef'; // TODO: think about name
+  intf := tobjectdef.create(odt_interfacecom, name, interface_iunknown);
   intf.typesym := TTypeSym.Create(name, intf);
   intf.isClosure := true;
 
-  // ZZZ: tsym.name work incorrectly if not to add symbol to symtable
-  symtablestack.top.insert(intf.typesym); // TODO: it it right place to insert ?
+// ZZZ: tsym.name work incorrectly if not to add symbol to symtable
+//  symtablestack.top.insert(intf.typesym); // TODO: it it right place to insert ?
+  current_module.localsymtable.insert(intf.typesym);
 
   symtablestack.push(intf.symtable);
   procDef := parse_proc_dec(intf, ppm_method_reference);
@@ -227,24 +226,25 @@ var anonymProcDef: TProcDef;
     intfName: String;
 begin
   maybe_create_frameobject(pd);
-//  symtablestack.push(pi.frameObjectDef.symtable);
+
+  symtablestack.push(pd.frameObjectDef.symtable); // procdef will add itself in deflist during creation
   anonymProcDef := parse_proc_dec(pd.frameObjectDef, ppm_nameless_routine);
-  include(anonymProcDef.procoptions, po_virtualmethod);
   handle_calling_convention(anonymProcDef);
-//  proc_add_definition(anonymProcDef);
+
+  intfName := anonymProcDef.procsym.RealName + '_ClosureImpl_IntfDef'; // TODO: think about name
+  intf := tobjectdef.create(odt_interfacecom, intfName, interface_iunknown);
+  TTypeSym.Create(intfName, intf);
+  current_module.localsymtable.insert(intf.typesym); // [1]
+
+  symtablestack.push(intf.symtable); // procdef should be inside intf symtable, otherwise it will not be in vtlb
   cloneProcDef := TProcDef(anonymProcDef.getcopy);
+  symtablestack.pop(intf.symtable);
 
   ReadProcBody_(pd.frameObjectDef, anonymProcDef);
-//  symtablestack.pop(pi.frameObjectDef.symtable); // think about this more
-
-  intfName := anonymProcDef.procsym.RealName + '_IntfDef'; // TODO: think about name
-  intf := tobjectdef.create(odt_interfacecom, intfName, nil);
-  intf.typesym := TTypeSym.Create(intfName, intf);
-  intf.set_parent(interface_iunknown);
-  current_module.localsymtable.insert(intf.typesym); // [1]
+  symtablestack.pop(pd.frameObjectDef.symtable);
 
   cloneProcDef.struct := intf;
-  cloneProcDef.procsym := TProcSym.Create('Invoke');
+  cloneProcDef.procsym := TProcSym.Create(anonymProcDef.procsym.Name);
   intf.symtable.insert(cloneProcDef.procsym);
   intf.isClosure := true;
   BuildObjVmt_(intf);
-- 
1.7.10.4


From 5e9f5873657afbbc43a70a5e589c67f78ffa845b Mon Sep 17 00:00:00 2001
From: Vasiliy Kevroletin <kevroletin@gmail.com>
Date: Sun, 19 May 2013 22:47:36 +1100
Subject: [PATCH 08/14] Simple tests. Little refactoring.

To run tests
1) build compiler by lazarus(or change path to compiler executable in devtest/test.sh)
2) cd ./devtest
3) sh test.sh
---
 compiler/pnameless.pas |  124 +++++++++++++++++++++++++-----------------------
 devtest/01.out         |    3 ++
 devtest/01.pas         |   18 +++++++
 devtest/02.out         |    3 ++
 devtest/02.pas         |   22 +++++++++
 devtest/03.out         |    3 ++
 devtest/03.pas         |   27 +++++++++++
 devtest/04.out         |    3 ++
 devtest/04.pas         |   22 +++++++++
 devtest/05.out         |    4 ++
 devtest/05.pas         |   26 ++++++++++
 devtest/06.out         |    4 ++
 devtest/06.pas         |   39 +++++++++++++++
 devtest/07.out         |    2 +
 devtest/07.pas         |   19 ++++++++
 devtest/test.sh        |   31 ++++++++++++
 16 files changed, 291 insertions(+), 59 deletions(-)
 create mode 100644 devtest/01.out
 create mode 100644 devtest/01.pas
 create mode 100644 devtest/02.out
 create mode 100644 devtest/02.pas
 create mode 100644 devtest/03.out
 create mode 100644 devtest/03.pas
 create mode 100644 devtest/04.out
 create mode 100644 devtest/04.pas
 create mode 100644 devtest/05.out
 create mode 100644 devtest/05.pas
 create mode 100644 devtest/06.out
 create mode 100644 devtest/06.pas
 create mode 100644 devtest/07.out
 create mode 100644 devtest/07.pas
 create mode 100644 devtest/test.sh

diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
index a3a640b..4f33dee 100644
--- a/compiler/pnameless.pas
+++ b/compiler/pnameless.pas
@@ -17,7 +17,7 @@ function add_init_frameobject(body: TNode; pd: TProcDef): TNode;
 
 implementation
 
-(** TODO:
+(** Instead of documentation
 
 Current implementation:
   Parse phase:
@@ -25,46 +25,39 @@ Current implementation:
 + 2. Each anonymous procedure is a method of frame object and method of unique interface with single
      method 'Invoke'. Frame object implements this interface.
 + 3. Each reference to procedure is interface-variable. Think how to implement.
-+ 4. Definition of anonymous procedure returns implementation of according onterface from frame object.
++ 4. Definition of anonymous procedure returns implementation of according interface from frame object.
 - 5. Type convertion is aware about this dances.
++ 8. Add frame object initialization code.
   Typecheck pass:
-- 6. Call for reference to procedure is translated into call of needed method from interface which is
++ 6. Call for reference to procedure is translated into call of needed method from interface which is
      stored in variable.
-- 7. Call for interface which is assigned to variable also converted to call of apropriate interface
++ 7. Call for interface which is assigned to variable also converted to call of apropriate interface
      method.
-  First pass ?
-- 8. Add frame object initialization code.
+  First pass -
+  Code generation pass -
 
 Details which should be clarified:
 LINK [1]
-1. Generated types registered in module local symtable.
-   + Required to have proper destruction of data.
+1. Generated type symbols registered in module local symtable.
+   + Required to have proper destruction of data. TODO: really? Anyway procdef registered in local symtables.
    + Simple.
    - Violates functional approach in developments.
    TODO: move to local procedure sym table
-     - For some reasons Pascal forbids local classes. There can be problems with it. And it's not
-       obvious to ancient Pascalists
+     - For some reasons Pascal forbids local classes. There can be problems with it.
 
 2. How link to self will be stored?
 
 Current problems:
-1. Interface variables are not initialized by 0s.
-2. Compiler crashes if declare anonymous function not inside main.
-3. Interface wrappers are not generated.
+1. Parser don't eat semicolon after subroutine nested in closure
 
-*)
-
-uses nld, { TODO: get rid of cicle reference }
-     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas, ncnv, pbase, tokens, nobj, fmodule, ncon;
-(* FrameObject contains
+More aobut frame object. It contains
    - captured variables of current procedure as fields
-   - anonymous functions as
-     - methods
-     - implementation of interface with single method 'invoke'
+   + vtbl for each closure
    - pointer to FrameObject of outer procedure as fiels
+*)
 
-   FrameObject implements unique interface for each of it's methods
- *)
+uses nld, { TODO: get rid of cicle reference }
+     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas, ncnv, pbase, tokens, nobj, fmodule, ncon, ngenutil;
 
 procedure BuildObjVmt_(objDef: TobjectDef);
 var vmtBuilder: TVMTBuilder;
@@ -95,19 +88,15 @@ begin
                                 CLoadVmtAddrNode.Create(CTypeNode.Create(pd.frameObjectDef)),
                                 [cnf_return_value_used] ); // not sure about call parameters
   do_typecheckpass(callNode); // most probably should be removed after finishing development
-
   block := TBlockNode(body);
-
   createObj := CAssignmentNode.Create(CLoadNode.Create(objSym, pd.localst),
                                       callNode);
   assignIntf := CAssignmentNode.Create(CLoadNode.Create(intfSym, pd.localst),
                                        CLoadNode.Create(objSym, pd.localst));
-
   stmt := CStatementNode.Create(createObj,
           CStatementNode.Create(assignIntf,
                                 block.left));
   block.left := stmt;
-
   do_typecheckpass(TNode(block));
   Result := block;
 end;
@@ -122,44 +111,67 @@ end;
 function maybe_create_frameobject(var pd: tprocdef): boolean;
 var intfObjDef: TObjectDef;
 
-  function FindTypeDefinitions_: boolean;
+  procedure FindTypeDefinitions_;
   var sym: tsym;
       symtable: tsymtable;
   begin
     // TODO: is there better way to get tinterfacedobject ?
     searchsym_type('TINTERFACEDOBJECT', sym, symtable);
-    if not assigned(sym) then InternalError(1);
-    if (sym.typ <> typesym) then InternalError(2);
+    if (not assigned(sym)) or (sym.typ <> typesym) then InternalError(1);
     intfObjDef := tobjectdef(ttypesym(sym).typedef);
-    Result := true;
   end;
 
-var frameObjectDef: TObjectDef;
+var objSym, intfSym: tabstractnormalvarsym;
+    frameObjectDef: TObjectDef;
+
+  procedure InsertVarSymbols_(st: tsymtable);
+  begin
+    // this is come from read_var_decls function
+    case st.symtabletype of
+      localsymtable :
+        begin
+          objSym  := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []); // TODO: Use temp here ?
+          intfSym := tlocalvarsym.create('$pFrameObjectIntf', vs_var, interface_iunknown, []);
+          st.insert(objSym);
+          st.insert(intfSym);
+        end;
+      staticsymtable,
+      globalsymtable :
+        begin
+          objSym  := tstaticvarsym.create('$pFrameObjectObj', vs_value, frameObjectDef, []); // TODO: same
+          intfSym := tstaticvarsym.create('$pFrameObjectIntf', vs_value, interface_iunknown, []);
+          st.insert(objSym);
+          st.insert(intfSym);
+          cnodeutils.insertbssdata(tstaticvarsym(objSym));
+          cnodeutils.insertbssdata(tstaticvarsym(intfSym));
+        end;
+    else
+      internalerror(666);
+    end;
+  end;
+
+  procedure BuildFrameObjectDef_;
+  var
     name: String;
+  begin
+    name := '$' + pd.procsym.RealName + '_FrameObjectDef'; // TODO: think about name
+    frameObjectDef := tobjectdef.create(odt_class, name, intfObjDef);
+    TTypeSym.Create(name, frameObjectDef);
+    include(frameObjectDef.objectoptions, oo_is_nameless);
+    current_module.localsymtable.insert(frameObjectDef.typesym);
+  end;
 
-    objSym: tlocalvarsym;
-    intfSym: tlocalvarsym;
 begin
   if assigned(pd.frameObjectDef) then exit(false);
   FindTypeDefinitions_();
-  name := '$' + pd.procsym.RealName + '_FrameObjectDef'; // TODO: think about name
-  frameObjectDef := tobjectdef.create(odt_class, name, intfObjDef);
-  TTypeSym.Create(name, frameObjectDef);
-  include(frameObjectDef.objectoptions, oo_is_nameless);
-
-  objSym := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []); // TODO: Use temp here ?
-  intfSym := tlocalvarsym.create('$pFrameObjectIntf', vs_var, interface_iunknown, []);
-  pd.localst.insert(objSym);
-  pd.localst.insert(intfSym);
-//  pd.localst.insert(frameObjectDef.typesym); see comments somewhere below
-  current_module.localsymtable.insert(frameObjectDef.typesym); // ^_^ why not ?
+  BuildFrameObjectDef_();
+  InsertVarSymbols_(pd.localst);
 
   pd.frameObjectDef     := frameObjectDef;
   { pd.frameObjectDeref }
   pd.frameObjectSym     := objSym;
   pd.frameObjectIntfSym := intfSym;
   Result := true;
-
 end;
 
 function are_compatible_interfaces(def_to: TObjectDef; def_from: TObjectDef): Boolean;
@@ -179,15 +191,11 @@ begin
   intf := tobjectdef.create(odt_interfacecom, name, interface_iunknown);
   intf.typesym := TTypeSym.Create(name, intf);
   intf.isClosure := true;
-
-// ZZZ: tsym.name work incorrectly if not to add symbol to symtable
-//  symtablestack.top.insert(intf.typesym); // TODO: it it right place to insert ?
-  current_module.localsymtable.insert(intf.typesym);
-
+  current_module.localsymtable.insert(intf.typesym); // tsym.name doesnt work if not to add symbol to symtable
   symtablestack.push(intf.symtable);
   procDef := parse_proc_dec(intf, ppm_method_reference);
   include(procDef.procoptions, po_virtualmethod);
-  tprocsym(procDef.procsym).ProcdefList.Add(procDef); // unless procedure will be invisible
+  tprocsym(procDef.procsym).ProcdefList.Add(procDef); // otherwise procedure will be invisible
   handle_calling_convention(procDef);
   proc_add_definition(procDef); // not sure why it is here
   symtablestack.pop(intf.symtable);
@@ -214,7 +222,7 @@ function parse_nameless_routine(var pd: tprocdef): tnode;
     while current_procinfo.parent <> nil do
       current_procinfo := current_procinfo.parent;
     read_proc(false, anonymProcDef);
-    proc_add_definition(anonymProcDef);     { add definition to procsym }
+    proc_add_definition(anonymProcDef);
     current_structdef := old_current_structdef;
     current_procinfo := old_current_procinfo;
     current_module.procinfo := old_current_procinfo;
@@ -239,18 +247,16 @@ begin
   symtablestack.push(intf.symtable); // procdef should be inside intf symtable, otherwise it will not be in vtlb
   cloneProcDef := TProcDef(anonymProcDef.getcopy);
   symtablestack.pop(intf.symtable);
-
-  ReadProcBody_(pd.frameObjectDef, anonymProcDef);
-  symtablestack.pop(pd.frameObjectDef.symtable);
-
   cloneProcDef.struct := intf;
-  cloneProcDef.procsym := TProcSym.Create(anonymProcDef.procsym.Name);
+  cloneProcDef.procsym := TProcSym.Create(anonymProcDef.procsym.Name); // same name to connect implemented method with interface method
   intf.symtable.insert(cloneProcDef.procsym);
   intf.isClosure := true;
   BuildObjVmt_(intf);
-
   pd.frameObjectDef.register_implemented_interface(intf);
 
+  ReadProcBody_(pd.frameObjectDef, anonymProcDef);
+  symtablestack.pop(pd.frameObjectDef.symtable);
+
   Result := CLoadNode.Create(pd.frameObjectSym, pd.localst);
   inserttypeconv(Result, intf);
 end;
diff --git a/devtest/01.out b/devtest/01.out
new file mode 100644
index 0000000..af0523d
--- /dev/null
+++ b/devtest/01.out
@@ -0,0 +1,3 @@
+before
+inside
+after
diff --git a/devtest/01.pas b/devtest/01.pas
new file mode 100644
index 0000000..bc26b33
--- /dev/null
+++ b/devtest/01.pas
@@ -0,0 +1,18 @@
+{$mode objfpc}
+
+type
+  TProc = reference to procedure;
+
+var
+  i: TProc;
+
+begin
+  Writeln('before');
+
+  i := procedure(num: Integer) begin
+          Writeln('inside');
+       end;
+  i.Invoke;
+  
+  Writeln('after');
+end.
diff --git a/devtest/02.out b/devtest/02.out
new file mode 100644
index 0000000..af0523d
--- /dev/null
+++ b/devtest/02.out
@@ -0,0 +1,3 @@
+before
+inside
+after
diff --git a/devtest/02.pas b/devtest/02.pas
new file mode 100644
index 0000000..27699c2
--- /dev/null
+++ b/devtest/02.pas
@@ -0,0 +1,22 @@
+{$mode objfpc}
+
+type
+  TProc = reference to procedure;
+
+procedure DoThings;  
+var
+  i: TProc;
+begin
+  Writeln('before');
+
+  i := procedure begin
+          Writeln('inside');
+       end;
+  i.Invoke;
+  
+  Writeln('after');
+end;
+  
+begin
+  DoThings;
+end.
diff --git a/devtest/03.out b/devtest/03.out
new file mode 100644
index 0000000..af0523d
--- /dev/null
+++ b/devtest/03.out
@@ -0,0 +1,3 @@
+before
+inside
+after
diff --git a/devtest/03.pas b/devtest/03.pas
new file mode 100644
index 0000000..74881dd
--- /dev/null
+++ b/devtest/03.pas
@@ -0,0 +1,27 @@
+{$mode objfpc}
+
+type
+  TProc = reference to procedure;
+  
+function Factory: TProc;
+begin
+  Result := procedure begin
+              Writeln('inside');
+            end;  
+end;
+  
+procedure DoThings;  
+var
+  i: TProc;
+begin
+  Writeln('before');
+
+  i := Factory;
+  i.Invoke;
+  
+  Writeln('after');
+end;
+  
+begin
+  DoThings;
+end.
diff --git a/devtest/04.out b/devtest/04.out
new file mode 100644
index 0000000..b1f8dda
--- /dev/null
+++ b/devtest/04.out
@@ -0,0 +1,3 @@
+before
+inside10
+after
diff --git a/devtest/04.pas b/devtest/04.pas
new file mode 100644
index 0000000..0729cb2
--- /dev/null
+++ b/devtest/04.pas
@@ -0,0 +1,22 @@
+{$mode objfpc}
+
+type
+  TProc = reference to procedure(a: Integer; s: String);
+
+procedure DoThings;  
+var
+  i: TProc;
+begin
+  Writeln('before');
+
+  i := procedure(a: Integer; s: String) begin
+          Writeln(s, a);
+       end;
+  i.Invoke(10, 'inside');
+  
+  Writeln('after');
+end;
+  
+begin
+  DoThings;
+end.
diff --git a/devtest/05.out b/devtest/05.out
new file mode 100644
index 0000000..49eef04
--- /dev/null
+++ b/devtest/05.out
@@ -0,0 +1,4 @@
+before
+inside10
+6
+after
diff --git a/devtest/05.pas b/devtest/05.pas
new file mode 100644
index 0000000..c5fb88f
--- /dev/null
+++ b/devtest/05.pas
@@ -0,0 +1,26 @@
+{$mode objfpc}
+
+type
+  TProc = reference to procedure(a: Integer; s: String);
+
+procedure DoThings;  
+var
+  i: TProc;
+begin
+  Writeln('before');
+
+  i := procedure(a: Integer; s: String)
+       var b: Integer;
+       begin
+         b := length(s);
+         Writeln(s, a);
+         Writeln(b);         
+       end;
+  i.Invoke(10, 'inside');
+  
+  Writeln('after');
+end;
+  
+begin
+  DoThings;
+end.
diff --git a/devtest/06.out b/devtest/06.out
new file mode 100644
index 0000000..49eef04
--- /dev/null
+++ b/devtest/06.out
@@ -0,0 +1,4 @@
+before
+inside10
+6
+after
diff --git a/devtest/06.pas b/devtest/06.pas
new file mode 100644
index 0000000..799dd28
--- /dev/null
+++ b/devtest/06.pas
@@ -0,0 +1,39 @@
+{$mode objfpc}
+
+{ closure have inner procedure }
+{ TODO: fix issue with semicolon in parser }
+
+type
+  TProc = reference to procedure(a: Integer; s: String);
+ 
+procedure DoThings;  
+
+  function JustToCheckSemicolon: Integer;
+  begin
+    Result := 10;
+  end;
+
+var
+  i: TProc;
+begin
+  Writeln('before');
+
+  i := procedure(a: Integer; s: String)
+         function Inner(ss: String): Integer;
+         begin
+           Result := length(ss);
+         end{;}
+       var b: Integer;
+       begin
+         b := Inner(s);
+         Writeln(s, a);
+         Writeln(b);         
+       end;
+  i.Invoke(10, 'inside');
+  
+  Writeln('after');
+end;
+  
+begin
+  DoThings;
+end.
diff --git a/devtest/07.out b/devtest/07.out
new file mode 100644
index 0000000..f727c26
--- /dev/null
+++ b/devtest/07.out
@@ -0,0 +1,2 @@
+before
+after20
diff --git a/devtest/07.pas b/devtest/07.pas
new file mode 100644
index 0000000..7a60039
--- /dev/null
+++ b/devtest/07.pas
@@ -0,0 +1,19 @@
+{$mode objfpc}
+
+type
+  TProc = reference to function(num: Integer): Integer;
+
+var
+  i: TProc;
+  res: Integer;
+
+begin
+  Writeln('before');
+
+  i := function(num: Integer): Integer begin
+          Result := num + 10;
+       end;
+  res := i.Invoke(10);
+    
+  Writeln('after', res);
+end.
diff --git a/devtest/test.sh b/devtest/test.sh
new file mode 100644
index 0000000..7ec128f
--- /dev/null
+++ b/devtest/test.sh
@@ -0,0 +1,31 @@
+#!/bin/sh
+
+SCRIPT=`readlink -f $0`
+BASEDIR=$(dirname $SCRIPT)
+#COMPILE="${BASEDIR}/../compiler/ppc386 -Fu${BASEDIR}/../rtl/units/i386-linux" 
+COMPILE="${BASEDIR}/../compiler/i386/pp -Fu${BASEDIR}/../rtl/units/i386-linux" 
+
+num=0
+fail=""
+for file in ${BASEDIR}/*.pas
+do
+    num=$((num+1));
+    i=${file%%.pas}
+    $COMPILE $i.pas -o$i.elf 2>&1 > $i.log
+    if [ "$?" -eq "0" ]
+    then
+        $i.elf > $i.res 2> $i.res
+    else
+        cp $i.log $i.res
+    fi
+    tmp=$(diff -q -b $i.out $i.res)
+    if [ -z $1 ] && [ "$1" != "n" ]; then echo "$i: $tmp"; fi
+    if [ -n "$tmp" ]; then fail="$fail $i"; fi
+done
+echo "Number of tests: $num"
+if [ -z  "$fail" ]
+then
+    echo "Ok";
+else
+    echo "Failed: $fail"
+fi
-- 
1.7.10.4


From fa42249ad7b3b294c4c84ad6840f82f5ae4e36d9 Mon Sep 17 00:00:00 2001
From: Vasiliy Kevroletin <kevroletin@gmail.com>
Date: Mon, 20 May 2013 23:37:29 +1100
Subject: [PATCH 09/14] Fix parser to eat semicolon after all nested
 functions.

Problem: parser doesn't eat semicolon after closure's nested function.
---
 compiler/pnameless.pas |    2 +-
 compiler/psub.pas      |   15 ++++++---------
 devtest/01.pas         |    2 +-
 devtest/06.pas         |    3 +--
 devtest/07.out         |    3 ++-
 devtest/07.pas         |   37 +++++++++++++++++++++++++++++--------
 6 files changed, 40 insertions(+), 22 deletions(-)

diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
index 4f33dee..63f7cd1 100644
--- a/compiler/pnameless.pas
+++ b/compiler/pnameless.pas
@@ -221,7 +221,7 @@ function parse_nameless_routine(var pd: tprocdef): tnode;
     current_structdef := framObjectDef;
     while current_procinfo.parent <> nil do
       current_procinfo := current_procinfo.parent;
-    read_proc(false, anonymProcDef);
+    read_proc(false, anonymProcDef, false);
     proc_add_definition(anonymProcDef);
     current_structdef := old_current_structdef;
     current_procinfo := old_current_procinfo;
diff --git a/compiler/psub.pas b/compiler/psub.pas
index 034195c..e09ed49 100644
--- a/compiler/psub.pas
+++ b/compiler/psub.pas
@@ -77,7 +77,7 @@ interface
     { reads any routine in the implementation, or a non-method routine
       declaration in the interface (depending on whether or not parse_only is
       true) }
-    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef);
+    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef; eatsemicolon: boolean = true);
 
     procedure generate_specialization_procs;
 
@@ -1819,7 +1819,7 @@ implementation
 
 
 
-    procedure read_proc_body(old_current_procinfo:tprocinfo;pd:tprocdef);
+    procedure read_proc_body(old_current_procinfo:tprocinfo;pd:tprocdef;eatsemicolon:boolean=true);
       {
         Parses the procedure directives, then parses the procedure body, then
         generates the code for it
@@ -1904,11 +1904,8 @@ implementation
           into the parse_body routine is not done because of having better file position
           information available }
 
-        // TDOO: ugly hack
-        if not(df_specialization in current_procinfo.procdef.defoptions) and
-           not (assigned(current_procinfo.procdef.struct) and
-                (oo_is_nameless in current_procinfo.procdef.struct.objectoptions))
-        then
+        // TODO: rework
+        if eatsemicolon and not(df_specialization in current_procinfo.procdef.defoptions) then
           consume(_SEMICOLON);
 
         if not isnestedproc then
@@ -1917,7 +1914,7 @@ implementation
       end;
 
 
-    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef);
+    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef; eatsemicolon: boolean = true);
       {
         Parses the procedure directives, then parses the procedure body, then
         generates the code for it
@@ -2024,7 +2021,7 @@ implementation
          { compile procedure when a body is needed }
          if (pd_body in pdflags) then
            begin
-             read_proc_body(old_current_procinfo,pd);
+             read_proc_body(old_current_procinfo,pd,eatsemicolon);
            end
          else
            begin
diff --git a/devtest/01.pas b/devtest/01.pas
index bc26b33..14a55cd 100644
--- a/devtest/01.pas
+++ b/devtest/01.pas
@@ -9,7 +9,7 @@ var
 begin
   Writeln('before');
 
-  i := procedure(num: Integer) begin
+  i := procedure begin
           Writeln('inside');
        end;
   i.Invoke;
diff --git a/devtest/06.pas b/devtest/06.pas
index 799dd28..db4fb34 100644
--- a/devtest/06.pas
+++ b/devtest/06.pas
@@ -1,7 +1,6 @@
 {$mode objfpc}
 
 { closure have inner procedure }
-{ TODO: fix issue with semicolon in parser }
 
 type
   TProc = reference to procedure(a: Integer; s: String);
@@ -22,7 +21,7 @@ begin
          function Inner(ss: String): Integer;
          begin
            Result := length(ss);
-         end{;}
+         end;
        var b: Integer;
        begin
          b := Inner(s);
diff --git a/devtest/07.out b/devtest/07.out
index f727c26..d9b99ec 100644
--- a/devtest/07.out
+++ b/devtest/07.out
@@ -1,2 +1,3 @@
 before
-after20
+20
+after
diff --git a/devtest/07.pas b/devtest/07.pas
index 7a60039..7f9ce32 100644
--- a/devtest/07.pas
+++ b/devtest/07.pas
@@ -1,19 +1,40 @@
 {$mode objfpc}
 
+{ closure have inner procedure which access it's local variables}
+
 type
-  TProc = reference to function(num: Integer): Integer;
+  TProc = reference to procedure(a: Integer; s: String);
+ 
+procedure DoThings;  
+
+  function JustToCheckSemicolon: Integer;
+  begin
+    Result := 10;
+  end;
 
 var
   i: TProc;
-  res: Integer;
-
 begin
   Writeln('before');
 
-  i := function(num: Integer): Integer begin
-          Result := num + 10;
+  i := procedure(a: Integer)
+       var b: Integer;
+         function Inner(c: Integer): Integer;
+         begin
+           Result := a + b + c;
+         end;
+       var d: Integer;
+       begin
+         b := 6;
+         d := Inner(4);
+         Writeln(d);
        end;
-  res := i.Invoke(10);
-    
-  Writeln('after', res);
+  i.Invoke(10, 'inside');
+  
+  Writeln('after');
+end;
+  
+begin
+  DoThings;
 end.
+
-- 
1.7.10.4


From 217f0e7ecdd5daf3091012bab3f29dba8e621da6 Mon Sep 17 00:00:00 2001
From: Vasiliy Kevroletin <kevroletin@gmail.com>
Date: Wed, 22 May 2013 01:33:07 +1100
Subject: [PATCH 10/14] Simple typecheck.

Currently closure is an interface(objectdef) with magic boolean flag "Is closure". It should contain single method which is used to call closure. Compare return types of closure and parametes type. If parameter types are equal then all is good.

TODO: Consider situatin
A < B (A inherited from B)

var
  pa: reference to procedure(arg: A);
  pb: reference to procedure(arg: B);
begin
  pa := pb;

In theory we can allow such assignment since all arguments of pa will be valid for pb.
---
 compiler/pnameless.pas |   31 ++++++++++++++++++++++++-------
 devtest/07.pas         |    4 ++--
 devtest/08.out         |    2 ++
 devtest/08.pas         |   20 ++++++++++++++++++++
 devtest/09.out         |    8 ++++++++
 devtest/09.pas         |   19 +++++++++++++++++++
 devtest/10.out         |    7 +++++++
 devtest/10.pas         |   19 +++++++++++++++++++
 8 files changed, 101 insertions(+), 9 deletions(-)
 create mode 100644 devtest/08.out
 create mode 100644 devtest/08.pas
 create mode 100644 devtest/09.out
 create mode 100644 devtest/09.pas
 create mode 100644 devtest/10.out
 create mode 100644 devtest/10.pas

diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
index 63f7cd1..f50a1c8 100644
--- a/compiler/pnameless.pas
+++ b/compiler/pnameless.pas
@@ -6,7 +6,7 @@ interface
 
 uses node, symtype, symdef, symsym, globtype;
 
-function are_compatible_interfaces(def_to: TObjectDef; def_from: TObjectDef): Boolean;
+function are_compatible_interfaces(objDefTo: TObjectDef; objDefFrom: TObjectDef): Boolean;
 function parse_method_reference: tdef;
 function handle_possible_capture(pd: tprocdef; name: tabstractnormalvarsym): tnode;
 function parse_nameless_routine(var pd: tprocdef): tnode;
@@ -41,14 +41,17 @@ LINK [1]
 1. Generated type symbols registered in module local symtable.
    + Required to have proper destruction of data. TODO: really? Anyway procdef registered in local symtables.
    + Simple.
-   - Violates functional approach in developments.
+   - forget this/*Violates functional approach in developments*/
    TODO: move to local procedure sym table
      - For some reasons Pascal forbids local classes. There can be problems with it.
 
 2. How link to self will be stored?
 
 Current problems:
-1. Parser don't eat semicolon after subroutine nested in closure
+1. Typecheck code is inspired by proc_to_procvar_equal function, but simplier. Think more about typecheck.
+2. Typecheck messages are ugly.
+3. We reused existing types and add some flags to these types It's time to think about inheritance.
+4. Code is tricky. Investigate is it possible to move closure convertion into separate pass.
 
 More aobut frame object. It contains
    - captured variables of current procedure as fields
@@ -57,7 +60,7 @@ More aobut frame object. It contains
 *)
 
 uses nld, { TODO: get rid of cicle reference }
-     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas, ncnv, pbase, tokens, nobj, fmodule, ncon, ngenutil;
+     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas, ncnv, pbase, tokens, nobj, fmodule, ncon, ngenutil, defcmp;
 
 procedure BuildObjVmt_(objDef: TobjectDef);
 var vmtBuilder: TVMTBuilder;
@@ -148,6 +151,7 @@ var objSym, intfSym: tabstractnormalvarsym;
     else
       internalerror(666);
     end;
+    objSym.varstate := vs_initialised; // prevent warning; init code will be added later
   end;
 
   procedure BuildFrameObjectDef_;
@@ -174,10 +178,23 @@ begin
   Result := true;
 end;
 
-function are_compatible_interfaces(def_to: TObjectDef; def_from: TObjectDef): Boolean;
+function are_compatible_interfaces(objDefTo: TObjectDef; objDefFrom: TObjectDef): Boolean;
+var defTo, defFrom: TProcDef;
+    i: Integer;
+    eq: tequaltype;
 begin
-  // TODO: Perform meaningful check!!!
-  Result := def_to.isClosure or def_from.isClosure;
+  // TODO: here each good compiler's function have at least 200 lines.. add more lines
+  if not objDefTo.isClosure or not objDefFrom.isClosure then exit(false);
+  if (objDefTo.symtable.DefList.Count <> 1) or (objDefTo.symtable.DefList.Count <> 1) then exit(false);
+  for i:=0 to objDefTo.symtable.DefList.Count-1 do
+  begin
+    defTo := tdef(objDefTo.symtable.DefList[i]) as TProcDef;
+    defFrom := tdef(objDefFrom.symtable.DefList[i]) as TProcDef;
+    if not equal_defs(defTo.returndef, defFrom.returndef) then exit(false);
+    eq:=compare_paras(defTo.paras,defFrom.paras,cp_procvar,[]);
+    if eq < te_equal then exit(false);
+  end;
+  Result := true;
 end;
 
 function parse_method_reference: tdef;
diff --git a/devtest/07.pas b/devtest/07.pas
index 7f9ce32..246c49a 100644
--- a/devtest/07.pas
+++ b/devtest/07.pas
@@ -3,7 +3,7 @@
 { closure have inner procedure which access it's local variables}
 
 type
-  TProc = reference to procedure(a: Integer; s: String);
+  TProc = reference to procedure(a: Integer);
  
 procedure DoThings;  
 
@@ -29,7 +29,7 @@ begin
          d := Inner(4);
          Writeln(d);
        end;
-  i.Invoke(10, 'inside');
+  i.Invoke(10);
   
   Writeln('after');
 end;
diff --git a/devtest/08.out b/devtest/08.out
new file mode 100644
index 0000000..f727c26
--- /dev/null
+++ b/devtest/08.out
@@ -0,0 +1,2 @@
+before
+after20
diff --git a/devtest/08.pas b/devtest/08.pas
new file mode 100644
index 0000000..8cd4ddf
--- /dev/null
+++ b/devtest/08.pas
@@ -0,0 +1,20 @@
+{$mode objfpc}
+{ closure returns value }
+
+type
+  TProc = reference to function(num: Integer): Integer;
+
+var
+  i: TProc;
+  res: Integer;
+
+begin
+  Writeln('before');
+
+  i := function(num: Integer): Integer begin
+          Result := num + 10;
+       end;
+  res := i.Invoke(10);
+    
+  Writeln('after', res);
+end.
diff --git a/devtest/09.out b/devtest/09.out
new file mode 100644
index 0000000..e0131df
--- /dev/null
+++ b/devtest/09.out
@@ -0,0 +1,8 @@
+Free Pascal Compiler version 2.7.1 [2013/05/19] for i386
+Copyright (c) 1993-2013 by Florian Klaempfl and others
+Target OS: Linux for i386
+Compiling /home/behemoth/Work/diploma/freepascal/devtest/09.pas
+09.pas(13,8) Error: Incompatible types: got "$$main_FrameObjectDef.NAMELESS_13_18_ClosureImpl_IntfDef" expected "ClosureReference_IntfDef"
+09.pas(16,11) Error: Wrong number of parameters specified for call to "INVOKE"
+09.pas(20) Fatal: There were 2 errors compiling module, stopping
+Fatal: Compilation aborted
diff --git a/devtest/09.pas b/devtest/09.pas
new file mode 100644
index 0000000..d66d385
--- /dev/null
+++ b/devtest/09.pas
@@ -0,0 +1,19 @@
+{$mode objfpc}
+{ incompatible closure and closurevar }
+
+type
+  TProc = reference to procedure(i: Integer);
+
+var
+  i: TProc;
+
+begin
+  Writeln('before');
+
+  i := procedure begin
+          Writeln('inside');
+       end;
+  i.Invoke;
+  
+  Writeln('after');
+end.
diff --git a/devtest/10.out b/devtest/10.out
new file mode 100644
index 0000000..b3bab60
--- /dev/null
+++ b/devtest/10.out
@@ -0,0 +1,7 @@
+Free Pascal Compiler version 2.7.1 [2013/05/19] for i386
+Copyright (c) 1993-2013 by Florian Klaempfl and others
+Target OS: Linux for i386
+Compiling /home/behemoth/Work/diploma/freepascal/devtest/10.pas
+10.pas(13,8) Error: Incompatible types: got "$$main_FrameObjectDef.NAMELESS_13_18_ClosureImpl_IntfDef" expected "ClosureReference_IntfDef"
+10.pas(20) Fatal: There were 1 errors compiling module, stopping
+Fatal: Compilation aborted
diff --git a/devtest/10.pas b/devtest/10.pas
new file mode 100644
index 0000000..cd63cee
--- /dev/null
+++ b/devtest/10.pas
@@ -0,0 +1,19 @@
+{$mode objfpc}
+{ incompatible closure and closurevar }
+
+type
+  TProc = reference to function: Integer;
+
+var
+  i: TProc;
+
+begin
+  Writeln('before');
+
+  i := procedure begin
+          Writeln('inside');
+       end;
+  i.Invoke;
+  
+  Writeln('after');
+end.
-- 
1.7.10.4


From 40bb8dd47f4cf91859230494cb95a249c173d7ba Mon Sep 17 00:00:00 2001
From: Vasiliy Kevroletin <kevroletin@gmail.com>
Date: Sat, 25 May 2013 23:07:08 +1100
Subject: [PATCH 11/14] Better error messages in case of typecheck errors.

Now closure implementaion and closure reference are represented as tobjectdef with flag isClosure. To make nice error messages we hardcoded into few places printing of "reference to procedure" instead of class name.
TODO: Better to refactor this in the future.
---
 compiler/pdecsub.pas   |    4 ++--
 compiler/pnameless.pas |   21 ++++++++++-----------
 compiler/symdef.pas    |   15 +++++++++++----
 compiler/symtable.pas  |    4 +++-
 devtest/09.out         |    8 ++------
 devtest/10.out         |    6 +-----
 devtest/11.out         |    3 +++
 devtest/11.pas         |   17 +++++++++++++++++
 devtest/12.out         |    3 +++
 devtest/12.pas         |   13 +++++++++++++
 devtest/13.out         |    3 +++
 devtest/13.pas         |   13 +++++++++++++
 devtest/14.out         |    4 ++++
 devtest/14.pas         |   16 ++++++++++++++++
 devtest/test.sh        |    2 +-
 15 files changed, 102 insertions(+), 30 deletions(-)
 create mode 100644 devtest/11.out
 create mode 100644 devtest/11.pas
 create mode 100644 devtest/12.out
 create mode 100644 devtest/12.pas
 create mode 100644 devtest/13.out
 create mode 100644 devtest/13.pas
 create mode 100644 devtest/14.out
 create mode 100644 devtest/14.pas

diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index 96c2a74..96b3f0f 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -800,12 +800,12 @@ implementation
         case procparsemode of
           ppm_nameless_routine:
             begin
-              sp:='Nameless_'+inttostr(procstartfilepos.line)+'_'+inttostr(procstartfilepos.column);
+              sp:='$Nameless_'+inttostr(procstartfilepos.line)+'_'+inttostr(procstartfilepos.column);
               orgsp:=upcase(sp);
             end;
           ppm_method_reference:
             begin
-              sp:='Invoke';
+              sp:='$Invoke';
               orgsp:=upcase(sp);
             end;
           else
diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
index f50a1c8..4a07eb4 100644
--- a/compiler/pnameless.pas
+++ b/compiler/pnameless.pas
@@ -180,20 +180,16 @@ end;
 
 function are_compatible_interfaces(objDefTo: TObjectDef; objDefFrom: TObjectDef): Boolean;
 var defTo, defFrom: TProcDef;
-    i: Integer;
     eq: tequaltype;
 begin
   // TODO: here each good compiler's function have at least 200 lines.. add more lines
   if not objDefTo.isClosure or not objDefFrom.isClosure then exit(false);
   if (objDefTo.symtable.DefList.Count <> 1) or (objDefTo.symtable.DefList.Count <> 1) then exit(false);
-  for i:=0 to objDefTo.symtable.DefList.Count-1 do
-  begin
-    defTo := tdef(objDefTo.symtable.DefList[i]) as TProcDef;
-    defFrom := tdef(objDefFrom.symtable.DefList[i]) as TProcDef;
-    if not equal_defs(defTo.returndef, defFrom.returndef) then exit(false);
-    eq:=compare_paras(defTo.paras,defFrom.paras,cp_procvar,[]);
-    if eq < te_equal then exit(false);
-  end;
+  defTo := tdef(objDefTo.symtable.DefList[0]) as TProcDef;
+  defFrom := tdef(objDefFrom.symtable.DefList[0]) as TProcDef;
+  if not equal_defs(defTo.returndef, defFrom.returndef) then exit(false);
+  eq:=compare_paras(defTo.paras,defFrom.paras,cp_procvar,[]);
+  if eq < te_equal then exit(false);
   Result := true;
 end;
 
@@ -206,9 +202,12 @@ begin
   consume(_REFERENCE); consume(_TO);
   name := 'ClosureReference_IntfDef'; // TODO: think about name
   intf := tobjectdef.create(odt_interfacecom, name, interface_iunknown);
-  intf.typesym := TTypeSym.Create(name, intf);
   intf.isClosure := true;
-  current_module.localsymtable.insert(intf.typesym); // tsym.name doesnt work if not to add symbol to symtable
+  if not assigned(intf.typesym) then
+  begin
+    intf.typesym := TTypeSym.Create(name, intf);
+    current_module.localsymtable.insert(intf.typesym);
+  end;
   symtablestack.push(intf.symtable);
   procDef := parse_proc_dec(intf, ppm_method_reference);
   include(procDef.procoptions, po_virtualmethod);
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index 9f6aab7..f9539a2 100644
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@@ -1536,6 +1536,7 @@ implementation
             tmp:=tdef(tmp.owner.defowner)
           else
             break;
+          if (tabstractrecorddef(tmp).objrealname^[1]='$') then break;
           result:=tabstractrecorddef(tmp).objrealname^+'.'+result;
         until tmp=nil;
       end;
@@ -4523,7 +4524,7 @@ implementation
       var
         pno: tprocnameoptions;
       begin
-        pno:=[];
+        pno:=[pno_proctypeoption];
         if showhidden then
           include(pno,pno_showhidden);
         result:=customprocname(pno);
@@ -4568,14 +4569,15 @@ implementation
                 if (pno_proctypeoption in pno) and
                    assigned(returndef) and
                    not(is_void(returndef)) then
-                  s:=s+'function '
+                  s:=s+'function'
                 else
-                  s:=s+'procedure ';
+                  s:=s+'procedure';
             end;
             if (pno_ownername in pno) and
                (owner.symtabletype in [recordsymtable,objectsymtable]) then
               s:=s+tabstractrecorddef(owner.defowner).RttiName+'.';
-            rn:=procsym.realname;
+            if not (po_nameless in procoptions) then
+              rn:=' ' + procsym.realname;
             if (pno_noleadingdollar in pno) and
                (rn[1]='$') then
               delete(rn,1,1);
@@ -5686,6 +5688,11 @@ implementation
         { instead of the actual type name                             }
         if not assigned(typesym) then
           result:='<Currently Parsed Class>'
+        else if isClosure then
+          begin
+            if not assigned(symtable.DefList[0]) then InternalError(777);
+            result:='reference to ' + tdef(symtable.DefList[0]).GetTypeName
+          end
         else
           result:=typesymbolprettyname;
       end;
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 3f08b1c..5b8ddac 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -1947,7 +1947,9 @@ implementation
       var
         s1,s2 : string;
       begin
-        if def.typ in [objectdef,recorddef] then
+        if (def.typ=objectdef) and tobjectdef(def).isClosure then
+          s1:=def.GetTypeName
+        else if def.typ in [objectdef,recorddef] then
           s1:=tabstractrecorddef(def).RttiName
         else
           s1:=def.typename;
diff --git a/devtest/09.out b/devtest/09.out
index e0131df..7952596 100644
--- a/devtest/09.out
+++ b/devtest/09.out
@@ -1,8 +1,4 @@
-Free Pascal Compiler version 2.7.1 [2013/05/19] for i386
-Copyright (c) 1993-2013 by Florian Klaempfl and others
-Target OS: Linux for i386
-Compiling /home/behemoth/Work/diploma/freepascal/devtest/09.pas
-09.pas(13,8) Error: Incompatible types: got "$$main_FrameObjectDef.NAMELESS_13_18_ClosureImpl_IntfDef" expected "ClosureReference_IntfDef"
-09.pas(16,11) Error: Wrong number of parameters specified for call to "INVOKE"
+09.pas(13,8) Error: Incompatible types: got "reference to procedure;" expected "reference to procedure(LongInt);"
+09.pas(16,11) Error: Wrong number of parameters specified for call to "$INVOKE"
 09.pas(20) Fatal: There were 2 errors compiling module, stopping
 Fatal: Compilation aborted
diff --git a/devtest/10.out b/devtest/10.out
index b3bab60..88f2e8f 100644
--- a/devtest/10.out
+++ b/devtest/10.out
@@ -1,7 +1,3 @@
-Free Pascal Compiler version 2.7.1 [2013/05/19] for i386
-Copyright (c) 1993-2013 by Florian Klaempfl and others
-Target OS: Linux for i386
-Compiling /home/behemoth/Work/diploma/freepascal/devtest/10.pas
-10.pas(13,8) Error: Incompatible types: got "$$main_FrameObjectDef.NAMELESS_13_18_ClosureImpl_IntfDef" expected "ClosureReference_IntfDef"
+10.pas(13,8) Error: Incompatible types: got "reference to procedure;" expected "reference to function:LongInt;"
 10.pas(20) Fatal: There were 1 errors compiling module, stopping
 Fatal: Compilation aborted
diff --git a/devtest/11.out b/devtest/11.out
new file mode 100644
index 0000000..b2b89e2
--- /dev/null
+++ b/devtest/11.out
@@ -0,0 +1,3 @@
+11.pas(13,8) Error: Incompatible types: got "reference to procedure;" expected "LongInt"
+11.pas(18) Fatal: There were 1 errors compiling module, stopping
+Fatal: Compilation aborted
diff --git a/devtest/11.pas b/devtest/11.pas
new file mode 100644
index 0000000..327bca8
--- /dev/null
+++ b/devtest/11.pas
@@ -0,0 +1,17 @@
+{$mode objfpc}
+{ illegal assignment }
+
+type
+  TProc = reference to function: Integer;
+
+var
+  p: TProc;
+  i: Integer;
+
+begin
+  
+  i := procedure begin
+         Writeln('inside');
+       end;
+  
+end.
diff --git a/devtest/12.out b/devtest/12.out
new file mode 100644
index 0000000..7c9b8cc
--- /dev/null
+++ b/devtest/12.out
@@ -0,0 +1,3 @@
+12.pas(12,11) Error: Operator is not overloaded: "ShortInt" + "reference to procedure;"
+12.pas(14) Fatal: There were 1 errors compiling module, stopping
+Fatal: Compilation aborted
diff --git a/devtest/12.pas b/devtest/12.pas
new file mode 100644
index 0000000..033c042
--- /dev/null
+++ b/devtest/12.pas
@@ -0,0 +1,13 @@
+{$mode objfpc}
+{ illegal arithmetics operation }
+
+type
+  TProc = reference to function: Integer;
+
+var
+  p: TProc;
+  i: Integer;
+
+begin
+  i := 10 + procedure begin end;
+end.
diff --git a/devtest/13.out b/devtest/13.out
new file mode 100644
index 0000000..1e8f278
--- /dev/null
+++ b/devtest/13.out
@@ -0,0 +1,3 @@
+13.pas(10,8) Error: Incompatible types: got "reference to function(LongInt):LongInt;" expected "LongInt"
+13.pas(10,71) Fatal: Syntax error, ";" expected but "(" found
+Fatal: Compilation aborted
diff --git a/devtest/13.pas b/devtest/13.pas
new file mode 100644
index 0000000..0735890
--- /dev/null
+++ b/devtest/13.pas
@@ -0,0 +1,13 @@
+{$mode objfpc}
+{ call of closure in place }
+
+var
+  i: Integer;
+begin
+
+  // now fpc parser eats first () and stops parsing of right side
+  // delphi parser eats this but fails during runtime
+  i := (function(num: Integer): Integer begin Result := num + 10; end)(5);
+
+  Writeln(i);
+end.
diff --git a/devtest/14.out b/devtest/14.out
new file mode 100644
index 0000000..6d331be
--- /dev/null
+++ b/devtest/14.out
@@ -0,0 +1,4 @@
+14.pas(10,8) Error: Incompatible types: got "reference to procedure;" expected "reference to procedure(LongInt);"
+14.pas(13,11) Error: Wrong number of parameters specified for call to "$INVOKE"
+14.pas(17) Fatal: There were 2 errors compiling module, stopping
+Fatal: Compilation aborted
diff --git a/devtest/14.pas b/devtest/14.pas
new file mode 100644
index 0000000..19a544f
--- /dev/null
+++ b/devtest/14.pas
@@ -0,0 +1,16 @@
+{$mode objfpc}
+{ incompatible closure and closurevar; declaration in var section }
+
+var
+  i: reference to procedure(i: Integer);
+
+begin
+  Writeln('before');
+
+  i := procedure begin
+          Writeln('inside');
+       end;
+  i.Invoke;
+  
+  Writeln('after');
+end.
diff --git a/devtest/test.sh b/devtest/test.sh
index 7ec128f..9f07dde 100644
--- a/devtest/test.sh
+++ b/devtest/test.sh
@@ -11,7 +11,7 @@ for file in ${BASEDIR}/*.pas
 do
     num=$((num+1));
     i=${file%%.pas}
-    $COMPILE $i.pas -o$i.elf 2>&1 > $i.log
+    $COMPILE $i.pas -o$i.elf > $i.log 2> $i.err
     if [ "$?" -eq "0" ]
     then
         $i.elf > $i.res 2> $i.res
-- 
1.7.10.4


From 02f9e9e4db8c0b6c6ad8afa2fb77aab005ba8d9c Mon Sep 17 00:00:00 2001
From: Vasiliy Kevroletin <kevroletin@gmail.com>
Date: Sun, 26 May 2013 13:30:52 +1100
Subject: [PATCH 12/14] Allow to call closure-variable using procvar(arg1,
 arg2, arg3, ...) or procvar; syntax. Fix error
 messages. Add more tests.

---
 compiler/ncal.pas      |    5 +++-
 compiler/nutils.pas    |   66 ++++++++++++++++++++++++++++++------------------
 compiler/pexpr.pas     |   17 ++++++++++---
 compiler/pnameless.pas |    5 ++--
 compiler/symdef.pas    |    2 +-
 devtest/01.out         |    1 +
 devtest/01.pas         |    3 ++-
 devtest/02.pas         |    2 +-
 devtest/03.pas         |    2 +-
 devtest/04.pas         |    2 +-
 devtest/05.pas         |    2 +-
 devtest/06.pas         |    2 +-
 devtest/07.pas         |    2 +-
 devtest/08.pas         |    2 +-
 devtest/09.out         |    2 +-
 devtest/09.pas         |    2 +-
 devtest/10.pas         |    2 +-
 devtest/13.out         |    5 ++--
 devtest/14.out         |    2 +-
 devtest/14.pas         |    2 +-
 devtest/15.out         |    3 +++
 devtest/15.pas         |   10 ++++++++
 devtest/16.out         |    1 +
 devtest/16.pas         |   20 +++++++++++++++
 devtest/17.out         |    3 +++
 devtest/17.pas         |   20 +++++++++++++++
 devtest/18.out         |    1 +
 devtest/18.pas         |   30 ++++++++++++++++++++++
 devtest/19.out         |    1 +
 devtest/19.pas         |   28 ++++++++++++++++++++
 devtest/20.out         |    2 ++
 devtest/20.pas         |   14 ++++++++++
 32 files changed, 214 insertions(+), 47 deletions(-)
 create mode 100644 devtest/15.out
 create mode 100644 devtest/15.pas
 create mode 100644 devtest/16.out
 create mode 100644 devtest/16.pas
 create mode 100644 devtest/17.out
 create mode 100644 devtest/17.pas
 create mode 100644 devtest/18.out
 create mode 100644 devtest/18.pas
 create mode 100644 devtest/19.out
 create mode 100644 devtest/19.pas
 create mode 100644 devtest/20.out
 create mode 100644 devtest/20.pas

diff --git a/compiler/ncal.pas b/compiler/ncal.pas
index 80b5959..068b49f 100644
--- a/compiler/ncal.pas
+++ b/compiler/ncal.pas
@@ -2932,7 +2932,10 @@ implementation
                             end
                           else
                             begin
-                              CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,symtableprocentry.realname);
+                              if po_nameless in tprocdef(symtableprocentry.ProcdefList[0]).procoptions then
+                                CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'reference to '+tdef(symtableprocentry.ProcdefList[0]).GetTypeName)
+                              else
+                                CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,symtableprocentry.realname);
                               symtableprocentry.write_parameter_lists(nil);
                             end;
                         end;
diff --git a/compiler/nutils.pas b/compiler/nutils.pas
index 1579890..c9e4ef2 100644
--- a/compiler/nutils.pas
+++ b/compiler/nutils.pas
@@ -367,35 +367,53 @@ implementation
 
 
     function maybe_call_procvar(var p1:tnode;tponly:boolean):boolean;
+
+      function insert_closure_call:boolean;
+        var objdef:tobjectdef;
+        begin
+          objdef:=tobjectdef(p1.resultdef);
+          if objdef.symtable.SymList.Count<>1 then InternalError(777);
+          p1:=ccallnode.create(nil,
+                               tprocsym(objdef.symtable.SymList.items[0]),
+                               objdef.symtable,
+                               p1,
+                               []); // TODO: not sure about parameters
+          typecheckpass(p1);
+          result:=true;
+        end;
+
       var
         hp : tnode;
       begin
         result:=false;
-        if (p1.resultdef.typ<>procvardef) or
-           (tponly and
-            not(m_tp_procvar in current_settings.modeswitches)) then
-          exit;
-        { ignore vecn,subscriptn }
-        hp:=p1;
-        repeat
-          case hp.nodetype of
-            vecn,
-            derefn,
-            typeconvn,
-            subscriptn :
-              hp:=tunarynode(hp).left;
-            else
-              break;
-          end;
-        until false;
-        { a tempref is used when it is loaded from a withsymtable }
-        if (hp.nodetype in [calln,loadn,temprefn]) then
+        if not tponly and (p1.resultdef.typ=objectdef) and tobjectdef(p1.resultdef).isClosure then
+          result:=insert_closure_call
+        else if (p1.resultdef.typ=procvardef) and
+           ((not tponly) or
+            (m_tp_procvar in current_settings.modeswitches)) then
           begin
-            hp:=ccallnode.create_procvar(nil,p1);
-            typecheckpass(hp);
-            p1:=hp;
-            result:=true;
-          end;
+            { ignore vecn,subscriptn }
+            hp:=p1;
+            repeat
+              case hp.nodetype of
+                vecn,
+                derefn,
+                typeconvn,
+                subscriptn :
+                  hp:=tunarynode(hp).left;
+                else
+                  break;
+              end;
+            until false;
+            { a tempref is used when it is loaded from a withsymtable }
+            if (hp.nodetype in [calln,loadn,temprefn]) then
+              begin
+                hp:=ccallnode.create_procvar(nil,p1);
+                typecheckpass(hp);
+                p1:=hp;
+                result:=true;
+              end;
+          end
       end;
 
 
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index f23c2e6..96122c7 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -2270,9 +2270,10 @@ implementation
 
           else
             begin
-              { is this a procedure variable ? }
+              { is this a procedure or closure variable ? }
               if assigned(p1.resultdef) and
-                 (p1.resultdef.typ=procvardef) then
+                 ((p1.resultdef.typ=procvardef) or
+                  ((p1.resultdef.typ=objectdef) and tobjectdef(p1.resultdef).isClosure)) then
                 begin
                   { Typenode for typecasting or expecting a procvar }
                   if (p1.nodetype=typen) or
@@ -2296,7 +2297,17 @@ implementation
                         begin
                           p2:=parse_paras(false,false,_RKLAMMER);
                           consume(_RKLAMMER);
-                          p1:=ccallnode.create_procvar(p2,p1);
+                          if p1.resultdef.typ=procvardef then
+                            p1:=ccallnode.create_procvar(p2,p1)
+                          else
+                            begin // call closure
+                              if tobjectdef(p1.resultdef).symtable.SymList.Count<>1 then InternalError(777);
+                              p1:=ccallnode.create(p2,
+                                                   tprocsym(tobjectdef(p1.resultdef).symtable.SymList.items[0]),
+                                                   tobjectdef(p1.resultdef).symtable,
+                                                   p1,
+                                                   []); // TODO: not sure about parameters
+                            end;
                           { proc():= is never possible }
                           if token=_ASSIGNMENT then
                             begin
diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
index 4a07eb4..25e4ccb 100644
--- a/compiler/pnameless.pas
+++ b/compiler/pnameless.pas
@@ -60,7 +60,7 @@ More aobut frame object. It contains
 *)
 
 uses nld, { TODO: get rid of cicle reference }
-     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas, ncnv, pbase, tokens, nobj, fmodule, ncon, ngenutil, defcmp;
+     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas, ncnv, pbase, tokens, nobj, fmodule, ncon, ngenutil, defcmp, sysutils, globals;
 
 procedure BuildObjVmt_(objDef: TobjectDef);
 var vmtBuilder: TVMTBuilder;
@@ -152,6 +152,7 @@ var objSym, intfSym: tabstractnormalvarsym;
       internalerror(666);
     end;
     objSym.varstate := vs_initialised; // prevent warning; init code will be added later
+    intfSym.varstate := vs_read;       // this reference is used only to keep frame object alive
   end;
 
   procedure BuildFrameObjectDef_;
@@ -200,7 +201,7 @@ var typesym: TTypeSym;
     procDef: TProcDef;
 begin
   consume(_REFERENCE); consume(_TO);
-  name := 'ClosureReference_IntfDef'; // TODO: think about name
+  name := 'ClosureReference_IntfDef' + inttostr(current_filepos.line)+'_'+inttostr(current_filepos.column); // TODO: think about name
   intf := tobjectdef.create(odt_interfacecom, name, interface_iunknown);
   intf.isClosure := true;
   if not assigned(intf.typesym) then
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index f9539a2..f8c749a 100644
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@@ -5690,7 +5690,7 @@ implementation
           result:='<Currently Parsed Class>'
         else if isClosure then
           begin
-            if not assigned(symtable.DefList[0]) then InternalError(777);
+            if symtable.DefList.Count <> 1 then InternalError(777);
             result:='reference to ' + tdef(symtable.DefList[0]).GetTypeName
           end
         else
diff --git a/devtest/01.out b/devtest/01.out
index af0523d..3c19bfa 100644
--- a/devtest/01.out
+++ b/devtest/01.out
@@ -1,3 +1,4 @@
 before
 inside
+inside
 after
diff --git a/devtest/01.pas b/devtest/01.pas
index 14a55cd..6916743 100644
--- a/devtest/01.pas
+++ b/devtest/01.pas
@@ -12,7 +12,8 @@ begin
   i := procedure begin
           Writeln('inside');
        end;
-  i.Invoke;
+  i();
+  i;
   
   Writeln('after');
 end.
diff --git a/devtest/02.pas b/devtest/02.pas
index 27699c2..d58e5e7 100644
--- a/devtest/02.pas
+++ b/devtest/02.pas
@@ -12,7 +12,7 @@ begin
   i := procedure begin
           Writeln('inside');
        end;
-  i.Invoke;
+  i();
   
   Writeln('after');
 end;
diff --git a/devtest/03.pas b/devtest/03.pas
index 74881dd..b0b06de 100644
--- a/devtest/03.pas
+++ b/devtest/03.pas
@@ -17,7 +17,7 @@ begin
   Writeln('before');
 
   i := Factory;
-  i.Invoke;
+  i();
   
   Writeln('after');
 end;
diff --git a/devtest/04.pas b/devtest/04.pas
index 0729cb2..ca4f725 100644
--- a/devtest/04.pas
+++ b/devtest/04.pas
@@ -12,7 +12,7 @@ begin
   i := procedure(a: Integer; s: String) begin
           Writeln(s, a);
        end;
-  i.Invoke(10, 'inside');
+  i(10, 'inside');
   
   Writeln('after');
 end;
diff --git a/devtest/05.pas b/devtest/05.pas
index c5fb88f..ddb0147 100644
--- a/devtest/05.pas
+++ b/devtest/05.pas
@@ -16,7 +16,7 @@ begin
          Writeln(s, a);
          Writeln(b);         
        end;
-  i.Invoke(10, 'inside');
+  i(10, 'inside');
   
   Writeln('after');
 end;
diff --git a/devtest/06.pas b/devtest/06.pas
index db4fb34..88a038a 100644
--- a/devtest/06.pas
+++ b/devtest/06.pas
@@ -28,7 +28,7 @@ begin
          Writeln(s, a);
          Writeln(b);         
        end;
-  i.Invoke(10, 'inside');
+  i(10, 'inside');
   
   Writeln('after');
 end;
diff --git a/devtest/07.pas b/devtest/07.pas
index 246c49a..b73c0b9 100644
--- a/devtest/07.pas
+++ b/devtest/07.pas
@@ -29,7 +29,7 @@ begin
          d := Inner(4);
          Writeln(d);
        end;
-  i.Invoke(10);
+  i(10);
   
   Writeln('after');
 end;
diff --git a/devtest/08.pas b/devtest/08.pas
index 8cd4ddf..4f0a6f6 100644
--- a/devtest/08.pas
+++ b/devtest/08.pas
@@ -14,7 +14,7 @@ begin
   i := function(num: Integer): Integer begin
           Result := num + 10;
        end;
-  res := i.Invoke(10);
+  res := i(10);
     
   Writeln('after', res);
 end.
diff --git a/devtest/09.out b/devtest/09.out
index 7952596..4a29f1a 100644
--- a/devtest/09.out
+++ b/devtest/09.out
@@ -1,4 +1,4 @@
 09.pas(13,8) Error: Incompatible types: got "reference to procedure;" expected "reference to procedure(LongInt);"
-09.pas(16,11) Error: Wrong number of parameters specified for call to "$INVOKE"
+09.pas(16,6) Error: Wrong number of parameters specified for call to "reference to procedure(LongInt);"
 09.pas(20) Fatal: There were 2 errors compiling module, stopping
 Fatal: Compilation aborted
diff --git a/devtest/09.pas b/devtest/09.pas
index d66d385..a088710 100644
--- a/devtest/09.pas
+++ b/devtest/09.pas
@@ -13,7 +13,7 @@ begin
   i := procedure begin
           Writeln('inside');
        end;
-  i.Invoke;
+  i();
   
   Writeln('after');
 end.
diff --git a/devtest/10.pas b/devtest/10.pas
index cd63cee..01120b1 100644
--- a/devtest/10.pas
+++ b/devtest/10.pas
@@ -13,7 +13,7 @@ begin
   i := procedure begin
           Writeln('inside');
        end;
-  i.Invoke;
+  i();
   
   Writeln('after');
 end.
diff --git a/devtest/13.out b/devtest/13.out
index 1e8f278..ac9c9a0 100644
--- a/devtest/13.out
+++ b/devtest/13.out
@@ -1,3 +1,2 @@
-13.pas(10,8) Error: Incompatible types: got "reference to function(LongInt):LongInt;" expected "LongInt"
-13.pas(10,71) Fatal: Syntax error, ";" expected but "(" found
-Fatal: Compilation aborted
+// currently this test fails
+15
diff --git a/devtest/14.out b/devtest/14.out
index 6d331be..a38e633 100644
--- a/devtest/14.out
+++ b/devtest/14.out
@@ -1,4 +1,4 @@
 14.pas(10,8) Error: Incompatible types: got "reference to procedure;" expected "reference to procedure(LongInt);"
-14.pas(13,11) Error: Wrong number of parameters specified for call to "$INVOKE"
+14.pas(13,6) Error: Wrong number of parameters specified for call to "reference to procedure(LongInt);"
 14.pas(17) Fatal: There were 2 errors compiling module, stopping
 Fatal: Compilation aborted
diff --git a/devtest/14.pas b/devtest/14.pas
index 19a544f..9c024b3 100644
--- a/devtest/14.pas
+++ b/devtest/14.pas
@@ -10,7 +10,7 @@ begin
   i := procedure begin
           Writeln('inside');
        end;
-  i.Invoke;
+  i();
   
   Writeln('after');
 end.
diff --git a/devtest/15.out b/devtest/15.out
new file mode 100644
index 0000000..ba3c397
--- /dev/null
+++ b/devtest/15.out
@@ -0,0 +1,3 @@
+15.pas(9,18) Error: Incompatible type for arg no. 1: Got "Constant String", expected "LongInt"
+15.pas(11) Fatal: There were 1 errors compiling module, stopping
+Fatal: Compilation aborted
diff --git a/devtest/15.pas b/devtest/15.pas
new file mode 100644
index 0000000..9a74aae
--- /dev/null
+++ b/devtest/15.pas
@@ -0,0 +1,10 @@
+{$mode objfpc}
+{ wrong parameter type }
+
+var
+  i: reference to procedure(i: Integer);
+
+begin
+  i := procedure(i: Integer) begin end;
+  i('hello world');
+end.
diff --git a/devtest/16.out b/devtest/16.out
new file mode 100644
index 0000000..60d3b2f
--- /dev/null
+++ b/devtest/16.out
@@ -0,0 +1 @@
+15
diff --git a/devtest/16.pas b/devtest/16.pas
new file mode 100644
index 0000000..67511e5
--- /dev/null
+++ b/devtest/16.pas
@@ -0,0 +1,20 @@
+{$mode objfpc}
+{ closure as function argument }
+
+type
+  TFunct = reference to function(num: Integer): Integer;
+  
+function Call(f: TFunct; arg: Integer): Integer;
+begin
+  Result := f(arg);
+end;
+
+var i: Integer;
+begin
+  i := Call( function(num: Integer): Integer
+             begin
+               Result := num + 5;
+             end,
+             10 );
+  Writeln(i);
+end.
diff --git a/devtest/17.out b/devtest/17.out
new file mode 100644
index 0000000..0e68ff8
--- /dev/null
+++ b/devtest/17.out
@@ -0,0 +1,3 @@
+17.pas(17,17) Error: Incompatible type for arg no. 1: Got "reference to function:LongInt;", expected "reference to function(LongInt):LongInt;"
+17.pas(21) Fatal: There were 1 errors compiling module, stopping
+Fatal: Compilation aborted
diff --git a/devtest/17.pas b/devtest/17.pas
new file mode 100644
index 0000000..41eeb6d
--- /dev/null
+++ b/devtest/17.pas
@@ -0,0 +1,20 @@
+{$mode objfpc}
+{ closure is wrong argument of another function }
+
+type
+  TFunct = reference to function(num: Integer): Integer;
+  
+function Call(f: TFunct; arg: Integer): Integer;
+begin
+  Result := f(arg);
+end;
+
+var i: Integer;
+begin
+  i := Call( function: Integer
+             begin
+               Result := 5;
+             end,
+             10 );
+  Writeln(i);
+end.
diff --git a/devtest/18.out b/devtest/18.out
new file mode 100644
index 0000000..7ed6ff8
--- /dev/null
+++ b/devtest/18.out
@@ -0,0 +1 @@
+5
diff --git a/devtest/18.pas b/devtest/18.pas
new file mode 100644
index 0000000..596d552
--- /dev/null
+++ b/devtest/18.pas
@@ -0,0 +1,30 @@
+{$mode objfpc}
+{ functions with closure as parameter are overloaded }
+
+type
+  TFunct        = reference to function: Integer;
+  TFunctFactory = reference to function: TFunct;
+  
+function Call(f: TFunct): Integer;
+begin
+  Result := f();
+end;
+
+function Call(f: TFunctFactory): TFunct;
+begin
+  Result := f();
+end;
+
+var i: Integer;
+    f: TFunct;
+begin
+  f := Call( function: TFunct
+             begin
+               Result := function: Integer
+                         begin
+                           Result := 5;
+                         end;
+             end);
+  i := Call( f );
+  Writeln(i);
+end.
diff --git a/devtest/19.out b/devtest/19.out
new file mode 100644
index 0000000..7ed6ff8
--- /dev/null
+++ b/devtest/19.out
@@ -0,0 +1 @@
+5
diff --git a/devtest/19.pas b/devtest/19.pas
new file mode 100644
index 0000000..c2db70e
--- /dev/null
+++ b/devtest/19.pas
@@ -0,0 +1,28 @@
+{$mode objfpc}
+{ functions with closure as parameter are overloaded }
+
+type
+  TFunct        = reference to function: Integer;
+  TFunctFactory = reference to function: TFunct;
+  
+function Call(f: TFunct): Integer;
+begin
+  Result := f();
+end;
+
+function Call(f: TFunctFactory): TFunct;
+begin
+  Result := f();
+end;
+
+var i: Integer;
+begin
+  i := Call( Call( function: TFunct
+                   begin
+                     Result := function: Integer
+                               begin
+                                 Result := 5;
+                               end;
+                   end ));
+  Writeln(i);
+end.
diff --git a/devtest/20.out b/devtest/20.out
new file mode 100644
index 0000000..80fd8df
--- /dev/null
+++ b/devtest/20.out
@@ -0,0 +1,2 @@
+9
+10
diff --git a/devtest/20.pas b/devtest/20.pas
new file mode 100644
index 0000000..db086ce
--- /dev/null
+++ b/devtest/20.pas
@@ -0,0 +1,14 @@
+{$mode objfpc}
+{ two closures inside functin }
+
+type
+  TFunct = reference to function: Integer;
+  
+var p1, p2: TFunct;
+begin
+  p1 := function: Integer begin Result := 9;  end;
+  p2 := function: Integer begin Result := 10; end;
+
+  Writeln( p1() );
+  Writeln( p2() );
+end.
-- 
1.7.10.4


From e297b696fa835f36da19140160a98a3c90f9e43f Mon Sep 17 00:00:00 2001
From: Vasiliy Kevroletin <kevroletin@gmail.com>
Date: Sun, 26 May 2013 15:57:08 +1100
Subject: [PATCH 13/14] Write proper internal errors. Fix few comments. Remove
 code which was marked as redutant before.

---
 compiler/nutils.pas    |    4 ++--
 compiler/pexpr.pas     |    4 ++--
 compiler/pnameless.pas |   59 ++++++++++++++++--------------------------------
 compiler/symdef.pas    |    2 +-
 4 files changed, 25 insertions(+), 44 deletions(-)

diff --git a/compiler/nutils.pas b/compiler/nutils.pas
index c9e4ef2..55739b9 100644
--- a/compiler/nutils.pas
+++ b/compiler/nutils.pas
@@ -372,12 +372,12 @@ implementation
         var objdef:tobjectdef;
         begin
           objdef:=tobjectdef(p1.resultdef);
-          if objdef.symtable.SymList.Count<>1 then InternalError(777);
+          if objdef.symtable.SymList.Count<>1 then InternalError(2013052604);
           p1:=ccallnode.create(nil,
                                tprocsym(objdef.symtable.SymList.items[0]),
                                objdef.symtable,
                                p1,
-                               []); // TODO: not sure about parameters
+                               [cnf_return_value_used]); // not sure about parameters
           typecheckpass(p1);
           result:=true;
         end;
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 96122c7..61b6b84 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -2301,12 +2301,12 @@ implementation
                             p1:=ccallnode.create_procvar(p2,p1)
                           else
                             begin // call closure
-                              if tobjectdef(p1.resultdef).symtable.SymList.Count<>1 then InternalError(777);
+                              if tobjectdef(p1.resultdef).symtable.SymList.Count<>1 then InternalError(2013052605);
                               p1:=ccallnode.create(p2,
                                                    tprocsym(tobjectdef(p1.resultdef).symtable.SymList.items[0]),
                                                    tobjectdef(p1.resultdef).symtable,
                                                    p1,
-                                                   []); // TODO: not sure about parameters
+                                                   [cnf_return_value_used]); // not sure about parameters
                             end;
                           { proc():= is never possible }
                           if token=_ASSIGNMENT then
diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
index 25e4ccb..323f19e 100644
--- a/compiler/pnameless.pas
+++ b/compiler/pnameless.pas
@@ -21,45 +21,28 @@ implementation
 
 Current implementation:
   Parse phase:
-+ 1. Create frame object for parent procedures. Kepp frame object alive using local interface-variable.
++ 1. Create frame object for procedure which contains closure. Kepp frame object alive using local interface-variable.
 + 2. Each anonymous procedure is a method of frame object and method of unique interface with single
      method 'Invoke'. Frame object implements this interface.
-+ 3. Each reference to procedure is interface-variable. Think how to implement.
-+ 4. Definition of anonymous procedure returns implementation of according interface from frame object.
-- 5. Type convertion is aware about this dances.
++ 3. Each reference to procedure is interface-variable. This interface contains single method 'Invoke';
++ 4. Definition of anonymous procedure returns implementation of corresponding interface from frame object.
++ 5. Type convertion is aware about this dances.
 + 8. Add frame object initialization code.
-  Typecheck pass:
 + 6. Call for reference to procedure is translated into call of needed method from interface which is
      stored in variable.
-+ 7. Call for interface which is assigned to variable also converted to call of apropriate interface
-     method.
+
+  Typecheck pass -
   First pass -
   Code generation pass -
 
-Details which should be clarified:
-LINK [1]
-1. Generated type symbols registered in module local symtable.
-   + Required to have proper destruction of data. TODO: really? Anyway procdef registered in local symtables.
-   + Simple.
-   - forget this/*Violates functional approach in developments*/
-   TODO: move to local procedure sym table
-     - For some reasons Pascal forbids local classes. There can be problems with it.
-
-2. How link to self will be stored?
-
 Current problems:
 1. Typecheck code is inspired by proc_to_procvar_equal function, but simplier. Think more about typecheck.
-2. Typecheck messages are ugly.
-3. We reused existing types and add some flags to these types It's time to think about inheritance.
-4. Code is tricky. Investigate is it possible to move closure convertion into separate pass.
-
-More aobut frame object. It contains
-   - captured variables of current procedure as fields
-   + vtbl for each closure
-   - pointer to FrameObject of outer procedure as fiels
+2. We reused existing types and add some flags to these types It's time to think about inheritance.
+3. Code is tricky. Investigate is it possible to move closure convertion into separate pass. At least
+   create separate classed to closure definition.
 *)
 
-uses nld, { TODO: get rid of cicle reference }
+uses nld, { TODO: get rid of cicle references }
      symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas, ncnv, pbase, tokens, nobj, fmodule, ncon, ngenutil, defcmp, sysutils, globals;
 
 procedure BuildObjVmt_(objDef: TobjectDef);
@@ -84,13 +67,12 @@ begin
   objSym := pd.frameObjectSym;
 
   bRet := searchsym_in_class( pd.frameObjectDef, pd.frameObjectDef, 'CREATE', symCreateProc, dummySymTable, false);
-  if not bRet then InternalError(5);
+  if not bRet then InternalError(2013052601);
   callNode := CCallNode.Create( nil,
                                 TProcSym(symCreateProc),
                                 pd.frameObjectDef.symtable,
                                 CLoadVmtAddrNode.Create(CTypeNode.Create(pd.frameObjectDef)),
                                 [cnf_return_value_used] ); // not sure about call parameters
-  do_typecheckpass(callNode); // most probably should be removed after finishing development
   block := TBlockNode(body);
   createObj := CAssignmentNode.Create(CLoadNode.Create(objSym, pd.localst),
                                       callNode);
@@ -120,7 +102,7 @@ var intfObjDef: TObjectDef;
   begin
     // TODO: is there better way to get tinterfacedobject ?
     searchsym_type('TINTERFACEDOBJECT', sym, symtable);
-    if (not assigned(sym)) or (sym.typ <> typesym) then InternalError(1);
+    if (not assigned(sym)) or (sym.typ <> typesym) then InternalError(2013052602);
     intfObjDef := tobjectdef(ttypesym(sym).typedef);
   end;
 
@@ -133,7 +115,7 @@ var objSym, intfSym: tabstractnormalvarsym;
     case st.symtabletype of
       localsymtable :
         begin
-          objSym  := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []); // TODO: Use temp here ?
+          objSym  := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []);
           intfSym := tlocalvarsym.create('$pFrameObjectIntf', vs_var, interface_iunknown, []);
           st.insert(objSym);
           st.insert(intfSym);
@@ -141,7 +123,7 @@ var objSym, intfSym: tabstractnormalvarsym;
       staticsymtable,
       globalsymtable :
         begin
-          objSym  := tstaticvarsym.create('$pFrameObjectObj', vs_value, frameObjectDef, []); // TODO: same
+          objSym  := tstaticvarsym.create('$pFrameObjectObj', vs_value, frameObjectDef, []);
           intfSym := tstaticvarsym.create('$pFrameObjectIntf', vs_value, interface_iunknown, []);
           st.insert(objSym);
           st.insert(intfSym);
@@ -149,7 +131,7 @@ var objSym, intfSym: tabstractnormalvarsym;
           cnodeutils.insertbssdata(tstaticvarsym(intfSym));
         end;
     else
-      internalerror(666);
+      internalerror(2013052603);
     end;
     objSym.varstate := vs_initialised; // prevent warning; init code will be added later
     intfSym.varstate := vs_read;       // this reference is used only to keep frame object alive
@@ -159,7 +141,7 @@ var objSym, intfSym: tabstractnormalvarsym;
   var
     name: String;
   begin
-    name := '$' + pd.procsym.RealName + '_FrameObjectDef'; // TODO: think about name
+    name := '$' + pd.procsym.RealName + '_FrameObjectDef';
     frameObjectDef := tobjectdef.create(odt_class, name, intfObjDef);
     TTypeSym.Create(name, frameObjectDef);
     include(frameObjectDef.objectoptions, oo_is_nameless);
@@ -183,7 +165,6 @@ function are_compatible_interfaces(objDefTo: TObjectDef; objDefFrom: TObjectDef)
 var defTo, defFrom: TProcDef;
     eq: tequaltype;
 begin
-  // TODO: here each good compiler's function have at least 200 lines.. add more lines
   if not objDefTo.isClosure or not objDefFrom.isClosure then exit(false);
   if (objDefTo.symtable.DefList.Count <> 1) or (objDefTo.symtable.DefList.Count <> 1) then exit(false);
   defTo := tdef(objDefTo.symtable.DefList[0]) as TProcDef;
@@ -212,9 +193,8 @@ begin
   symtablestack.push(intf.symtable);
   procDef := parse_proc_dec(intf, ppm_method_reference);
   include(procDef.procoptions, po_virtualmethod);
-  tprocsym(procDef.procsym).ProcdefList.Add(procDef); // otherwise procedure will be invisible
+  tprocsym(procDef.procsym).ProcdefList.Add(procDef);
   handle_calling_convention(procDef);
-  proc_add_definition(procDef); // not sure why it is here
   symtablestack.pop(intf.symtable);
   BuildObjVmt_(intf);
   Result := intf;
@@ -256,10 +236,10 @@ begin
   anonymProcDef := parse_proc_dec(pd.frameObjectDef, ppm_nameless_routine);
   handle_calling_convention(anonymProcDef);
 
-  intfName := anonymProcDef.procsym.RealName + '_ClosureImpl_IntfDef'; // TODO: think about name
+  intfName := anonymProcDef.procsym.RealName + '_ClosureImpl_IntfDef';
   intf := tobjectdef.create(odt_interfacecom, intfName, interface_iunknown);
   TTypeSym.Create(intfName, intf);
-  current_module.localsymtable.insert(intf.typesym); // [1]
+  current_module.localsymtable.insert(intf.typesym);
 
   symtablestack.push(intf.symtable); // procdef should be inside intf symtable, otherwise it will not be in vtlb
   cloneProcDef := TProcDef(anonymProcDef.getcopy);
@@ -281,6 +261,7 @@ end;
 function load_captured_variable(pd: tprocdef; name: tabstractnormalvarsym): tnode;
 begin
   // TODO:
+  InternalError(2013052606);
   Result := nil;
 end;
 
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index f8c749a..503b843 100644
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@@ -5690,7 +5690,7 @@ implementation
           result:='<Currently Parsed Class>'
         else if isClosure then
           begin
-            if symtable.DefList.Count <> 1 then InternalError(777);
+            if symtable.DefList.Count <> 1 then InternalError(2013052606);
             result:='reference to ' + tdef(symtable.DefList[0]).GetTypeName
           end
         else
-- 
1.7.10.4


From 84e235669dc24ff884645bccee6ba98a91542f56 Mon Sep 17 00:00:00 2001
From: Vasiliy Kevroletin <kevroletin@gmail.com>
Date: Sun, 26 May 2013 16:21:16 +1100
Subject: [PATCH 14/14] Fix coding style.

---
 compiler/pnameless.pas |  278 ++++++++++++++++++++++++------------------------
 1 file changed, 139 insertions(+), 139 deletions(-)

diff --git a/compiler/pnameless.pas b/compiler/pnameless.pas
index 323f19e..6555573 100644
--- a/compiler/pnameless.pas
+++ b/compiler/pnameless.pas
@@ -4,16 +4,16 @@ unit pnameless;
 
 interface
 
-uses node, symtype, symdef, symsym, globtype;
+uses node,symtype,symdef,symsym,globtype;
 
-function are_compatible_interfaces(objDefTo: TObjectDef; objDefFrom: TObjectDef): Boolean;
-function parse_method_reference: tdef;
-function handle_possible_capture(pd: tprocdef; name: tabstractnormalvarsym): tnode;
-function parse_nameless_routine(var pd: tprocdef): tnode;
-function load_captured_variable(pd: tprocdef; name: tabstractnormalvarsym): tnode;
-function maybe_create_frameobject(var pd: tprocdef): boolean;
-function maybe_finish_frameobject(pd: tprocdef): boolean;
-function add_init_frameobject(body: TNode; pd: TProcDef): TNode;
+function are_compatible_interfaces(objDefTo:tobjectdef;objDefFrom:tobjectdef):Boolean;
+function parse_method_reference:tdef;
+function handle_possible_capture(pd:tprocdef;name:tabstractnormalvarsym):tnode;
+function parse_nameless_routine(var pd:tprocdef):tnode;
+function load_captured_variable(pd:tprocdef;name:tabstractnormalvarsym):tnode;
+function maybe_create_frameobject(var pd:tprocdef):boolean;
+function maybe_finish_frameobject(pd:tprocdef):boolean;
+function add_init_frameobject(body:tnode;pd:tprocdef):tnode;
 
 implementation
 
@@ -36,95 +36,95 @@ Current implementation:
   Code generation pass -
 
 Current problems:
-1. Typecheck code is inspired by proc_to_procvar_equal function, but simplier. Think more about typecheck.
+1. Typecheck code is inspired by proc_to_procvar_equal function,but simplier. Think more about typecheck.
 2. We reused existing types and add some flags to these types It's time to think about inheritance.
 3. Code is tricky. Investigate is it possible to move closure convertion into separate pass. At least
    create separate classed to closure definition.
 *)
 
-uses nld, { TODO: get rid of cicle references }
-     symconst, procinfo, pdecsub, psub, verbose, symbase, symtable, ncal, pass_1, nmem, nbas, ncnv, pbase, tokens, nobj, fmodule, ncon, ngenutil, defcmp, sysutils, globals;
+uses nld,{ TODO:get rid of cicle references }
+     symconst,procinfo,pdecsub,psub,verbose,symbase,symtable,ncal,pass_1,nmem,nbas,ncnv,pbase,tokens,nobj,fmodule,ncon,ngenutil,defcmp,sysutils,globals;
 
-procedure BuildObjVmt_(objDef: TobjectDef);
-var vmtBuilder: TVMTBuilder;
+procedure build_obj_vmt_(objdef:tobjectdef);
+var vmtBuilder:TVMTBuilder;
 begin
-  vmtBuilder := TVMTBuilder.Create(objDef);
+  vmtBuilder:=TVMTBuilder.create(objdef);
   vmtBuilder.generate_vmt;
   vmtBuilder.free;
 end;
 
-function add_init_frameobject(body: TNode; pd: TProcDef): TNode;
+function add_init_frameobject(body:tnode;pd:tprocdef):tnode;
 var
-  createObj, assignIntf, callNode: TNode;
-  symCreateProc: TSym;
-  dummySymTable: TSymTable;
-  bRet: Boolean;
-  stmt: TStatementNode;
-  block: tblocknode;
-  intfSym, objSym: TSym;
+  createobj,assignitf,callnode:tnode;
+  symcreateproc:tsym;
+  dummysymtable:tsymtable;
+  ret:boolean;
+  stmt:tstatementnode;
+  block:tblocknode;
+  intfsym,objsym:tsym;
 begin
-  intfSym := pd.frameObjectIntfSym;
-  objSym := pd.frameObjectSym;
-
-  bRet := searchsym_in_class( pd.frameObjectDef, pd.frameObjectDef, 'CREATE', symCreateProc, dummySymTable, false);
-  if not bRet then InternalError(2013052601);
-  callNode := CCallNode.Create( nil,
-                                TProcSym(symCreateProc),
-                                pd.frameObjectDef.symtable,
-                                CLoadVmtAddrNode.Create(CTypeNode.Create(pd.frameObjectDef)),
-                                [cnf_return_value_used] ); // not sure about call parameters
-  block := TBlockNode(body);
-  createObj := CAssignmentNode.Create(CLoadNode.Create(objSym, pd.localst),
-                                      callNode);
-  assignIntf := CAssignmentNode.Create(CLoadNode.Create(intfSym, pd.localst),
-                                       CLoadNode.Create(objSym, pd.localst));
-  stmt := CStatementNode.Create(createObj,
-          CStatementNode.Create(assignIntf,
-                                block.left));
-  block.left := stmt;
-  do_typecheckpass(TNode(block));
-  Result := block;
+  intfsym:=pd.frameObjectIntfSym;
+  objsym:=pd.frameObjectSym;
+
+  ret:=searchsym_in_class(pd.frameObjectDef,pd.frameObjectDef,'CREATE',symcreateproc,dummysymtable,false);
+  if not ret then InternalError(2013052601);
+  callnode:=ccallnode.create(nil,
+                             tprocsym(symcreateproc),
+                             pd.frameObjectDef.symtable,
+                             cloadvmtaddrnode.create(CTypeNode.create(pd.frameObjectDef)),
+                             [cnf_return_value_used]);// not sure about call parameters
+  block:=tblocknode(body);
+  createobj:=cassignmentnode.create(cloadnode.create(objsym,pd.localst),
+                                    callnode);
+  assignitf:=cassignmentnode.create(cloadnode.create(intfsym,pd.localst),
+                                    cloadnode.create(objsym,pd.localst));
+  stmt:=cstatementnode.create(createobj,
+                              cstatementnode.create(assignitf,
+                                                    block.left));
+  block.left:=stmt;
+  do_typecheckpass(tnode(block));
+  result:=block;
 end;
 
-function maybe_finish_frameobject(pd: tprocdef): boolean;
+function maybe_finish_frameobject(pd:tprocdef):boolean;
 begin
-  Result := assigned(pd.frameObjectDef);
-  if Result then
-    BuildObjVmt_(pd.frameObjectDef);
+  result:=assigned(pd.frameObjectDef);
+  if result then
+    build_obj_vmt_(pd.frameObjectDef);
 end;
 
-function maybe_create_frameobject(var pd: tprocdef): boolean;
-var intfObjDef: TObjectDef;
+function maybe_create_frameobject(var pd:tprocdef):boolean;
+var intfObjDef:tobjectdef;
 
-  procedure FindTypeDefinitions_;
-  var sym: tsym;
-      symtable: tsymtable;
+  procedure find_type_definitions_;
+  var sym:tsym;
+      symtable:tsymtable;
   begin
-    // TODO: is there better way to get tinterfacedobject ?
-    searchsym_type('TINTERFACEDOBJECT', sym, symtable);
-    if (not assigned(sym)) or (sym.typ <> typesym) then InternalError(2013052602);
-    intfObjDef := tobjectdef(ttypesym(sym).typedef);
+    // TODO:is there better way to get tinterfacedobject ?
+    searchsym_type('TINTERFACEDOBJECT',sym,symtable);
+    if (not assigned(sym)) or (sym.typ<>typesym) then InternalError(2013052602);
+    intfObjDef:=tobjectdef(ttypesym(sym).typedef);
   end;
 
-var objSym, intfSym: tabstractnormalvarsym;
-    frameObjectDef: TObjectDef;
+var objSym,intfSym:tabstractnormalvarsym;
+    frameObjectDef:tobjectdef;
 
-  procedure InsertVarSymbols_(st: tsymtable);
+  procedure insert_var_symbols_(st:tsymtable);
   begin
     // this is come from read_var_decls function
     case st.symtabletype of
       localsymtable :
         begin
-          objSym  := tlocalvarsym.create('$pFrameObjectObj', vs_var, frameObjectDef, []);
-          intfSym := tlocalvarsym.create('$pFrameObjectIntf', vs_var, interface_iunknown, []);
+          objSym :=tlocalvarsym.create('$pFrameObjectObj',vs_var,frameObjectDef,[]);
+          intfSym:=tlocalvarsym.create('$pFrameObjectIntf',vs_var,interface_iunknown,[]);
           st.insert(objSym);
           st.insert(intfSym);
         end;
       staticsymtable,
       globalsymtable :
         begin
-          objSym  := tstaticvarsym.create('$pFrameObjectObj', vs_value, frameObjectDef, []);
-          intfSym := tstaticvarsym.create('$pFrameObjectIntf', vs_value, interface_iunknown, []);
+          objSym :=tstaticvarsym.create('$pFrameObjectObj',vs_value,frameObjectDef,[]);
+          intfSym:=tstaticvarsym.create('$pFrameObjectIntf',vs_value,interface_iunknown,[]);
           st.insert(objSym);
           st.insert(intfSym);
           cnodeutils.insertbssdata(tstaticvarsym(objSym));
@@ -133,136 +133,136 @@ var objSym, intfSym: tabstractnormalvarsym;
     else
       internalerror(2013052603);
     end;
-    objSym.varstate := vs_initialised; // prevent warning; init code will be added later
-    intfSym.varstate := vs_read;       // this reference is used only to keep frame object alive
+    objSym.varstate:=vs_initialised;// prevent warning;init code will be added later
+    intfSym.varstate:=vs_read;      // this reference is used only to keep frame object alive
   end;
 
-  procedure BuildFrameObjectDef_;
+  procedure build_frame_object_def_;
   var
-    name: String;
+    name:String;
   begin
-    name := '$' + pd.procsym.RealName + '_FrameObjectDef';
-    frameObjectDef := tobjectdef.create(odt_class, name, intfObjDef);
-    TTypeSym.Create(name, frameObjectDef);
-    include(frameObjectDef.objectoptions, oo_is_nameless);
+    name:='$' + pd.procsym.RealName + '_FrameObjectDef';
+    frameObjectDef:=tobjectdef.create(odt_class,name,intfObjDef);
+    ttypesym.create(name,frameObjectDef);
+    include(frameObjectDef.objectoptions,oo_is_nameless);
     current_module.localsymtable.insert(frameObjectDef.typesym);
   end;
 
 begin
   if assigned(pd.frameObjectDef) then exit(false);
-  FindTypeDefinitions_();
-  BuildFrameObjectDef_();
-  InsertVarSymbols_(pd.localst);
+  find_type_definitions_();
+  build_frame_object_def_();
+  insert_var_symbols_(pd.localst);
 
-  pd.frameObjectDef     := frameObjectDef;
+  pd.frameObjectDef    :=frameObjectDef;
   { pd.frameObjectDeref }
-  pd.frameObjectSym     := objSym;
-  pd.frameObjectIntfSym := intfSym;
-  Result := true;
+  pd.frameObjectSym    :=objSym;
+  pd.frameObjectIntfSym:=intfSym;
+  result:=true;
 end;
 
-function are_compatible_interfaces(objDefTo: TObjectDef; objDefFrom: TObjectDef): Boolean;
-var defTo, defFrom: TProcDef;
-    eq: tequaltype;
+function are_compatible_interfaces(objDefTo:tobjectdef;objDefFrom:tobjectdef):Boolean;
+var defTo,defFrom:tprocdef;
+    eq:tequaltype;
 begin
   if not objDefTo.isClosure or not objDefFrom.isClosure then exit(false);
-  if (objDefTo.symtable.DefList.Count <> 1) or (objDefTo.symtable.DefList.Count <> 1) then exit(false);
-  defTo := tdef(objDefTo.symtable.DefList[0]) as TProcDef;
-  defFrom := tdef(objDefFrom.symtable.DefList[0]) as TProcDef;
-  if not equal_defs(defTo.returndef, defFrom.returndef) then exit(false);
+  if (objDefTo.symtable.DefList.Count<>1) or (objDefTo.symtable.DefList.Count<>1) then exit(false);
+  defTo:=tdef(objDefTo.symtable.DefList[0]) as tprocdef;
+  defFrom:=tdef(objDefFrom.symtable.DefList[0]) as tprocdef;
+  if not equal_defs(defTo.returndef,defFrom.returndef) then exit(false);
   eq:=compare_paras(defTo.paras,defFrom.paras,cp_procvar,[]);
   if eq < te_equal then exit(false);
-  Result := true;
+  result:=true;
 end;
 
-function parse_method_reference: tdef;
-var typesym: TTypeSym;
-    intf: TObjectDef;
-    name: String;
-    procDef: TProcDef;
+function parse_method_reference:tdef;
+var typesym:ttypesym;
+    intf:tobjectdef;
+    name:String;
+    procDef:tprocdef;
 begin
-  consume(_REFERENCE); consume(_TO);
-  name := 'ClosureReference_IntfDef' + inttostr(current_filepos.line)+'_'+inttostr(current_filepos.column); // TODO: think about name
-  intf := tobjectdef.create(odt_interfacecom, name, interface_iunknown);
-  intf.isClosure := true;
+  consume(_REFERENCE);consume(_TO);
+  name:='ClosureReference_IntfDef' + inttostr(current_filepos.line)+'_'+inttostr(current_filepos.column);// TODO:think about name
+  intf:=tobjectdef.create(odt_interfacecom,name,interface_iunknown);
+  intf.isClosure:=true;
   if not assigned(intf.typesym) then
   begin
-    intf.typesym := TTypeSym.Create(name, intf);
+    intf.typesym:=ttypesym.create(name,intf);
     current_module.localsymtable.insert(intf.typesym);
   end;
   symtablestack.push(intf.symtable);
-  procDef := parse_proc_dec(intf, ppm_method_reference);
-  include(procDef.procoptions, po_virtualmethod);
+  procDef:=parse_proc_dec(intf,ppm_method_reference);
+  include(procDef.procoptions,po_virtualmethod);
   tprocsym(procDef.procsym).ProcdefList.Add(procDef);
   handle_calling_convention(procDef);
   symtablestack.pop(intf.symtable);
-  BuildObjVmt_(intf);
-  Result := intf;
+  build_obj_vmt_(intf);
+  result:=intf;
 end;
 
-function handle_possible_capture(pd: tprocdef; name: tabstractnormalvarsym): tnode;
+function handle_possible_capture(pd:tprocdef;name:tabstractnormalvarsym):tnode;
 begin
   // TODO:
-  Result := nil;
+  result:=nil;
 end;
 
-function parse_nameless_routine(var pd: tprocdef): tnode;
+function parse_nameless_routine(var pd:tprocdef):tnode;
 
-  // well, I don't like this banch of gloval variables which each function save on stack
-  procedure ReadProcBody_(framObjectDef: TObjectDef; anonymProcDef: TProcDef);
-  var old_current_structdef: tabstractrecorddef;
-      old_current_procinfo: tprocinfo;
+  // well,I don't like this banch of gloval variables which each function save on stack
+  procedure read_proc_body_(framObjectDef:tobjectdef;anonymProcDef:tprocdef);
+  var old_current_structdef:tabstractrecorddef;
+      old_current_procinfo:tprocinfo;
   begin
-    old_current_structdef := current_structdef;
-    old_current_procinfo := current_procinfo;
-    current_structdef := framObjectDef;
-    while current_procinfo.parent <> nil do
-      current_procinfo := current_procinfo.parent;
-    read_proc(false, anonymProcDef, false);
+    old_current_structdef:=current_structdef;
+    old_current_procinfo:=current_procinfo;
+    current_structdef:=framObjectDef;
+    while current_procinfo.parent<>nil do
+      current_procinfo:=current_procinfo.parent;
+    read_proc(false,anonymProcDef,false);
     proc_add_definition(anonymProcDef);
-    current_structdef := old_current_structdef;
-    current_procinfo := old_current_procinfo;
-    current_module.procinfo := old_current_procinfo;
+    current_structdef:=old_current_structdef;
+    current_procinfo:=old_current_procinfo;
+    current_module.procinfo:=old_current_procinfo;
   end;
 
-var anonymProcDef: TProcDef;
-    cloneProcDef: TProcDef;
-    intf: TObjectDef;
-    intfName: String;
+var anonymprocdef:tprocdef;
+    cloneprocdef:tprocdef;
+    intf:tobjectdef;
+    intfName:String;
 begin
   maybe_create_frameobject(pd);
 
-  symtablestack.push(pd.frameObjectDef.symtable); // procdef will add itself in deflist during creation
-  anonymProcDef := parse_proc_dec(pd.frameObjectDef, ppm_nameless_routine);
-  handle_calling_convention(anonymProcDef);
+  symtablestack.push(pd.frameObjectDef.symtable);// procdef will add itself in deflist during creation
+  anonymprocdef:=parse_proc_dec(pd.frameObjectDef,ppm_nameless_routine);
+  handle_calling_convention(anonymprocdef);
 
-  intfName := anonymProcDef.procsym.RealName + '_ClosureImpl_IntfDef';
-  intf := tobjectdef.create(odt_interfacecom, intfName, interface_iunknown);
-  TTypeSym.Create(intfName, intf);
+  intfName:=anonymprocdef.procsym.RealName + '_ClosureImpl_IntfDef';
+  intf:=tobjectdef.create(odt_interfacecom,intfName,interface_iunknown);
+  ttypesym.create(intfName,intf);
   current_module.localsymtable.insert(intf.typesym);
 
-  symtablestack.push(intf.symtable); // procdef should be inside intf symtable, otherwise it will not be in vtlb
-  cloneProcDef := TProcDef(anonymProcDef.getcopy);
+  symtablestack.push(intf.symtable);// procdef should be inside intf symtable,otherwise it will not be in vtlb
+  cloneprocdef:=tprocdef(anonymprocdef.getcopy);
   symtablestack.pop(intf.symtable);
-  cloneProcDef.struct := intf;
-  cloneProcDef.procsym := TProcSym.Create(anonymProcDef.procsym.Name); // same name to connect implemented method with interface method
-  intf.symtable.insert(cloneProcDef.procsym);
-  intf.isClosure := true;
-  BuildObjVmt_(intf);
+  cloneprocdef.struct:=intf;
+  cloneprocdef.procsym:=tprocsym.create(anonymprocdef.procsym.Name);// same name to connect implemented method with interface method
+  intf.symtable.insert(cloneprocdef.procsym);
+  intf.isClosure:=true;
+  build_obj_vmt_(intf);
   pd.frameObjectDef.register_implemented_interface(intf);
 
-  ReadProcBody_(pd.frameObjectDef, anonymProcDef);
+  read_proc_body_(pd.frameObjectDef,anonymprocdef);
   symtablestack.pop(pd.frameObjectDef.symtable);
 
-  Result := CLoadNode.Create(pd.frameObjectSym, pd.localst);
-  inserttypeconv(Result, intf);
+  result:=cloadnode.create(pd.frameObjectSym,pd.localst);
+  inserttypeconv(result,intf);
 end;
 
-function load_captured_variable(pd: tprocdef; name: tabstractnormalvarsym): tnode;
+function load_captured_variable(pd:tprocdef;name:tabstractnormalvarsym):tnode;
 begin
   // TODO:
   InternalError(2013052606);
-  Result := nil;
+  result:=nil;
 end;
 
 begin
-- 
1.7.10.4

closures00.patch (176,782 bytes)

Sven Barth

2013-05-26 16:53

manager   ~0067879

I agree with the need for reference counting for closures and also with your approach to use interfaces for this.

What I'm still not sure about is whether using a single FrameObject is good. Imagine you create two closures in a procedure. One accesses a big record (no pointer, thus the whole records needs to be stored) and the other a Boolean variable. Now both share the same FrameObject. If the latter lives (significantly) longer than the former (e.g. because it's returned from the procedure) then the memory of the copied record will stay alive as well... So even though Delphi only uses one FrameObject using multiple FrameObjects for each closure would be better (maybe only for those that have different code?).

Also the following question: Is the case handled correctly that multiple closures with the same signature, but different code also result in multiple implementations inside the FrameObject? And can be called correctly?

I have the following remarks about your concrete implementation (I have not looked in exact detail though, because I'm a bit busy currently):
- store and load the is_closure flag in the PPU (don't forget to increase the PPU version and to adjust the ppudump tool)
- don't use default parameters
- you should add your tests to the tests/test/ directory and redesign them in a way that they work as the other tests; this way you can use the existing test framework to check for regressions as well (of course you can still use your script as an alternative for quick checks)
- I don't think it's necessary to have the test outputs versioned

Otherwise: Keep up the good work and I hope to do a more thorough review of your code (maybe at the hackathon next week).

Regards,
Sven

Florian

2013-05-26 17:34

administrator   ~0067881

Just a first remark about the closure flag: if we keep this approach, I think a new object type should be introduced instead behaving similiar to a com interface, something like odt_closureinterface.

Sven Barth

2013-05-26 19:46

manager   ~0067884

Last edited: 2013-05-26 19:47

View 2 revisions

This would also be an idea depending on how visible the interfaces are to non-compiler-generated code... (and this also means to adjust all expressions in the compiler where for COM interfaces is checked to either mean only odt_cominterface or also odt_closureinterface)

Regards,
Sven

Vasiliy Kevroletin

2013-05-27 00:52

reporter   ~0067893

Sven,
Multiple closures with the same signature, but different code will result different interfaces. For each interface frame object will have separate implementation of this interface. So this case is handled correctly.

I also think that using separate object for each closure would be better. Mostly because it is required to implement capturing by value. I put it my TODO list.

Florian,
thanks for advice.

Vasiliy Kevroletin

2013-05-31 13:33

reporter   ~0067961

It makes sense to separate changes in parser from logic of variables capturing. Syntax will be changed once and will remain same. But implementation of capturing can be changed. Different implementation will have same behaviour and will share tests.
As first step I created branch where I work only on parser(to allow Delphi's syntax for anonymous functions) https://github.com/vkevroletin/freepascal/tree/anonymous-routines.
In this branch
+ anonymous procedure will became simple procedure with normal nesting level
+ "reference to procedure" is simple procvar
+ capturing of variables is forbidden
I will debug syntax, write tests and will restrict this extension by mode Delphi.
Full closures implementation will be based on changed described above. This will allow in the future to split integration in different patches of smaller size.

Vasiliy Kevroletin

2013-06-07 16:06

reporter  

closures01.patch (133,611 bytes)
From 643c63f21fd21d2d7f4dad4ec46a630d2116e4bd Mon Sep 17 00:00:00 2001
From: blaise <blaise@3ad0048d-3df7-0310-abae-a5850022a9f2>
Date: Sat, 21 Jan 2012 19:00:59 +0000
Subject: [PATCH 1/4] Parse anonymous functions.

Now it's possible to parse anonymous routine inside body of other routine.
Currently anonymous procedure have normal nesting level. So it can't access local variables of outer function. There is no check for this.
Currently "reference to procedure" is represented as procvar. That is why there is no typecheck during assignment of "pure" procedure to "reference to" procedures.

Delhi-like implementation of closure will have same syntax but will allow to capture variables.
---
 compiler/pclosure.pas              |  49 +++++++++++++++++
 compiler/pdecobj.pas               |  10 ++--
 compiler/pdecsub.pas               | 105 +++++++++++++++++++++++++------------
 compiler/pexpr.pas                 |   9 +++-
 compiler/psub.pas                  |  18 +++----
 compiler/ptype.pas                 |  51 ++++++++++--------
 compiler/symconst.pas              |   4 +-
 compiler/symcreat.pas              |   2 +-
 compiler/symdef.pas                |  15 ++++++
 compiler/tokens.pas                |   2 +
 compiler/utils/ppuutils/ppudump.pp |   3 +-
 11 files changed, 196 insertions(+), 72 deletions(-)
 create mode 100644 compiler/pclosure.pas

diff --git a/compiler/pclosure.pas b/compiler/pclosure.pas
new file mode 100644
index 0000000..f6894fd
--- /dev/null
+++ b/compiler/pclosure.pas
@@ -0,0 +1,49 @@
+unit pclosure;
+
+{$mode objfpc}
+
+interface
+
+uses node, symtype, symdef, symsym, globtype;
+
+function parse_anonymous_routine(pd: tprocdef): tnode;
+
+implementation
+
+uses nld,symconst,procinfo,pdecsub,psub,verbose,symbase,symtable,ncal,pass_1,nmem,nbas,fmodule,ncnv;
+
+function parse_anonymous_routine(pd: tprocdef): tnode;
+
+  procedure read_proc_body_(objdef:tobjectdef;anonymprocdef:tprocdef);
+  var old_current_structdef:tabstractrecorddef;
+      old_current_procinfo:tprocinfo;
+  begin
+    old_current_structdef:=current_structdef;
+    old_current_procinfo:=current_procinfo;
+    current_structdef:=objdef;
+    while current_procinfo.parent<>nil do
+      current_procinfo:=current_procinfo.parent;
+    read_proc(false,anonymprocdef,false);
+    proc_add_definition(anonymprocdef);
+    current_structdef:=old_current_structdef;
+    current_procinfo:=old_current_procinfo;
+    current_module.procinfo:=old_current_procinfo;
+  end;
+
+var anonymprocdef:tprocdef;
+    loadn,addrn:tnode;
+begin
+  symtablestack.push(current_module.localsymtable); // procdef will add itself in deflist during creation
+  anonymprocdef:=parse_proc_dec(nil,ppm_anonymous_routine);
+  symtablestack.pop(current_module.localsymtable);
+  handle_calling_convention(anonymprocdef);
+  read_proc_body_(nil,anonymprocdef);
+
+  loadn:=cloadnode.create(anonymprocdef.procsym,anonymprocdef.procsym.owner);
+  addrn:=caddrnode.create(loadn);
+  typecheckpass(addrn);
+  result:=addrn;
+end;
+
+begin
+end.
diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
index 61dcc0f..d6a22b9 100644
--- a/compiler/pdecobj.pas
+++ b/compiler/pdecobj.pas
@@ -104,7 +104,7 @@ implementation
         result:=nil;
         consume(_CONSTRUCTOR);
         { must be at same level as in implementation }
-        parse_proc_head(current_structdef,potype_class_constructor,pd);
+        parse_proc_head(current_structdef,potype_class_constructor,ppm_class_method,pd);
         if not assigned(pd) then
           begin
             consume(_SEMICOLON);
@@ -129,7 +129,7 @@ implementation
         result:=nil;
         consume(_CONSTRUCTOR);
         { must be at same level as in implementation }
-        parse_proc_head(current_structdef,potype_constructor,pd);
+        parse_proc_head(current_structdef,potype_constructor,ppm_normal,pd);
         if not assigned(pd) then
           begin
             consume(_SEMICOLON);
@@ -226,7 +226,7 @@ implementation
       begin
         result:=nil;
         consume(_DESTRUCTOR);
-        parse_proc_head(current_structdef,potype_class_destructor,pd);
+        parse_proc_head(current_structdef,potype_class_destructor,ppm_class_method,pd);
         if not assigned(pd) then
           begin
             consume(_SEMICOLON);
@@ -250,7 +250,7 @@ implementation
       begin
         result:=nil;
         consume(_DESTRUCTOR);
-        parse_proc_head(current_structdef,potype_destructor,pd);
+        parse_proc_head(current_structdef,potype_destructor,ppm_normal,pd);
         if not assigned(pd) then
           begin
             consume(_SEMICOLON);
@@ -874,7 +874,7 @@ implementation
 
               oldparse_only:=parse_only;
               parse_only:=true;
-              result:=parse_proc_dec(is_classdef,astruct);
+              result:=parse_proc_dec(astruct,as_procparsemode(is_classdef));
 
               { this is for error recovery as well as forward }
               { interface mappings, i.e. mapping to a method  }
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index c5c4cdf..91310ca 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -72,8 +72,12 @@ interface
     procedure parse_var_proc_directives(sym:tsym);
     procedure parse_object_proc_directives(pd:tabstractprocdef);
     procedure parse_record_proc_directives(pd:tabstractprocdef);
-    function  parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;out pd:tprocdef):boolean;
-    function  parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef):tprocdef;
+
+    type tprocparsemode = (ppm_normal, ppm_class_method, ppm_anonymous_routine, ppm_method_reference);
+    // TODO: operator :=/Explicit (const is_class_method: boolean) result: tprocparsemode;
+    function as_procparsemode(const is_class_method: boolean): tprocparsemode; inline;
+    function parse_proc_head(astruct: tabstractrecorddef; potype: tproctypeoption; const procparsemode: tprocparsemode; out pd: tprocdef): boolean;
+    function parse_proc_dec(astruct: tabstractrecorddef; const procparsemode: tprocparsemode = ppm_normal): tprocdef;
 
     { parse a record method declaration (not a (class) constructor/destructor) }
     function parse_record_method_dec(astruct: tabstractrecorddef; is_classdef: boolean): tprocdef;
@@ -540,7 +544,7 @@ implementation
       end;
 
 
-    function parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;out pd:tprocdef):boolean;
+    function parse_proc_head(astruct: tabstractrecorddef; potype: tproctypeoption; const procparsemode: tprocparsemode; out pd: tprocdef): boolean;
       var
         hs       : string;
         orgsp,sp : TIDString;
@@ -756,7 +760,20 @@ implementation
         pd:=nil;
         aprocsym:=nil;
 
-        consume_proc_name;
+        case procparsemode of
+          ppm_anonymous_routine:
+            begin
+              sp:='Anonymous_'+inttostr(procstartfilepos.line)+'_'+inttostr(procstartfilepos.column);
+              orgsp:=upcase(sp);
+            end;
+          ppm_method_reference:
+            begin
+              sp:='Apply';
+              orgsp:=upcase(sp);
+            end;
+          else
+            consume_proc_name;
+        end;
 
         { examine interface map: function/procedure iname.functionname=locfuncname }
         if assigned(astruct) and
@@ -809,7 +826,11 @@ implementation
 
         { method  ? }
         srsym:=nil;
-        if (consume_generic_type_parameter or not assigned(astruct)) and
+        if procparsemode=ppm_anonymous_routine then
+          // Do nothing. This check here:
+          //   a) skips below checks and searches, speeding things up;
+          //   b) makes sure we do not try to parse generic type parameters.
+        else if (consume_generic_type_parameter or not assigned(astruct)) and
            (symtablestack.top.symtablelevel=main_program_level) and
            try_to_consume(_POINT) then
          begin
@@ -944,17 +965,25 @@ implementation
             symtablestack.top.insert(aprocsym);
           end;
 
-        { to get the correct symtablelevel we must ignore ObjectSymtables }
-        st:=nil;
-        checkstack:=symtablestack.stack;
-        while assigned(checkstack) do
+        if procparsemode=ppm_anonymous_routine then
+          begin
+            pd:=tprocdef.create(normal_function_level);
+            include(pd.procoptions,po_anonymous);
+          end
+        else 
           begin
-            st:=checkstack^.symtable;
-            if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then
-              break;
-            checkstack:=checkstack^.next;
+            { to get the correct symtablelevel we must ignore ObjectSymtables }
+            st:=nil;
+            checkstack:=symtablestack.stack;
+            while assigned(checkstack) do
+              begin
+                st:=checkstack^.symtable;
+                if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then
+                  break;
+                checkstack:=checkstack^.next;
+              end;
+            pd:=tprocdef.create(st.symtablelevel+1);
           end;
-        pd:=tprocdef.create(st.symtablelevel+1);
         pd.struct:=astruct;
         pd.procsym:=aprocsym;
         pd.proctypeoption:=potype;
@@ -1042,7 +1071,16 @@ implementation
       end;
 
 
-    function parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef):tprocdef;
+    function as_procparsemode(const is_class_method: boolean): tprocparsemode; inline;
+      begin
+        if is_class_method then
+          result := ppm_class_method
+        else
+          result := ppm_normal
+      end;
+
+
+    function parse_proc_dec(astruct: tabstractrecorddef; const procparsemode: tprocparsemode = ppm_normal): tprocdef;
       var
         pd: tprocdef;
         locationstr: string;
@@ -1100,7 +1138,7 @@ implementation
           _FUNCTION :
             begin
               consume(_FUNCTION);
-              if parse_proc_head(astruct,potype_function,pd) then
+              if parse_proc_head(astruct,potype_function,procparsemode,pd) then
                 begin
                   { pd=nil when it is a interface mapping }
                   if assigned(pd) then
@@ -1144,8 +1182,8 @@ implementation
                             consume_all_until(_SEMICOLON);
                           end;
                        end;
-                      if isclassmethod then
-                       include(pd.procoptions,po_classmethod);
+                      if procparsemode=ppm_class_method then
+                        include(pd.procoptions,po_classmethod);
                     end;
                 end
               else
@@ -1159,13 +1197,13 @@ implementation
           _PROCEDURE :
             begin
               consume(_PROCEDURE);
-              if parse_proc_head(astruct,potype_procedure,pd) then
+              if parse_proc_head(astruct,potype_procedure,procparsemode,pd) then
                 begin
                   { pd=nil when it is an interface mapping }
                   if assigned(pd) then
                     begin
                       pd.returndef:=voidtype;
-                      if isclassmethod then
+                      if procparsemode=ppm_class_method then
                         include(pd.procoptions,po_classmethod);
                     end;
                 end;
@@ -1174,11 +1212,11 @@ implementation
           _CONSTRUCTOR :
             begin
               consume(_CONSTRUCTOR);
-              if isclassmethod then
-                parse_proc_head(astruct,potype_class_constructor,pd)
+              if procparsemode=ppm_class_method then
+                parse_proc_head(astruct,potype_class_constructor,procparsemode,pd)
               else
-                parse_proc_head(astruct,potype_constructor,pd);
-              if not isclassmethod and
+                parse_proc_head(astruct,potype_constructor,procparsemode,pd);
+              if (procparsemode<>ppm_class_method) and
                  assigned(pd) and
                  assigned(pd.struct) then
                 begin
@@ -1205,16 +1243,16 @@ implementation
           _DESTRUCTOR :
             begin
               consume(_DESTRUCTOR);
-              if isclassmethod then
-                parse_proc_head(astruct,potype_class_destructor,pd)
+              if procparsemode=ppm_class_method then
+                parse_proc_head(astruct,potype_class_destructor,procparsemode,pd)
               else
-                parse_proc_head(astruct,potype_destructor,pd);
+                parse_proc_head(astruct,potype_destructor,procparsemode,pd);
               if assigned(pd) then
                 pd.returndef:=voidtype;
             end;
         else
           if (token=_OPERATOR) or
-             (isclassmethod and (idtoken=_OPERATOR)) then
+             ((procparsemode=ppm_class_method) and (idtoken=_OPERATOR)) then
             begin
               { we need to set the block type to bt_body, so that operator names
                 like ">", "=>" or "<>" are parsed correctly instead of e.g.
@@ -1222,7 +1260,7 @@ implementation
               old_block_type:=block_type;
               block_type:=bt_body;
               consume(_OPERATOR);
-              parse_proc_head(astruct,potype_operator,pd);
+              parse_proc_head(astruct,potype_operator,procparsemode,pd);
               block_type:=old_block_type;
               if assigned(pd) then
                 begin
@@ -1232,7 +1270,7 @@ implementation
                   pd.procsym.owner.includeoption(sto_has_operator);
                   if pd.parast.symtablelevel>normal_function_level then
                     Message(parser_e_no_local_operator);
-                  if isclassmethod then
+                  if procparsemode=ppm_class_method then
                     include(pd.procoptions,po_classmethod);
                   if token<>_ID then
                     begin
@@ -1304,7 +1342,8 @@ implementation
                 message(parser_e_field_not_allowed_here);
                 consume_all_until(_SEMICOLON);
               end;
-            consume(_SEMICOLON);
+            if not (procparsemode in [ppm_anonymous_routine,ppm_method_reference]) then
+              consume(_SEMICOLON);
           end;
         result:=pd;
 
@@ -1323,7 +1362,7 @@ implementation
       begin
         oldparse_only:=parse_only;
         parse_only:=true;
-        result:=parse_proc_dec(is_classdef,astruct);
+        result:=parse_proc_dec(astruct,as_procparsemode(is_classdef));
 
         { this is for error recovery as well as forward }
         { interface mappings, i.e. mapping to a method  }
@@ -3303,7 +3342,7 @@ const
             if (currpd.proctypeoption = potype_function) and
                is_void(currpd.returndef) then
               MessagePos1(currpd.fileinfo,parser_e_no_funcret_specified,currpd.procsym.realname);
-            tprocsym(currpd.procsym).ProcdefList.Add(currpd);
+            currpd.add_to_procsym;
           end;
 
         proc_add_definition:=forwardfound;
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 50808ab..c05c103 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -70,7 +70,7 @@ implementation
        nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
        { parser }
        scanner,
-       pbase,pinline,ptype,pgenutil,procinfo,cpuinfo
+       pbase,pinline,ptype,pgenutil,procinfo,cpuinfo,pclosure
        ;
 
     { sub_expr(opmultiply) is need to get -1 ** 4 to be
@@ -3314,6 +3314,13 @@ implementation
                p1:=cinlinenode.create(in_objc_protocol_x,false,p1);
              end;
 
+             // anonymous routine
+             _PROCEDURE, _FUNCTION:
+               if assigned(current_procinfo) then
+                 p1:=parse_anonymous_routine(current_procinfo.procdef)
+               else // TODO: support this later? Delphi doesn't
+                 internalerror(20120121);
+
              else
                begin
                  Message(parser_e_illegal_expression);
diff --git a/compiler/psub.pas b/compiler/psub.pas
index 64f4655..a63760b 100644
--- a/compiler/psub.pas
+++ b/compiler/psub.pas
@@ -77,7 +77,7 @@ interface
     { reads any routine in the implementation, or a non-method routine
       declaration in the interface (depending on whether or not parse_only is
       true) }
-    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef);
+    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef;eatsemicolon:boolean);
 
     procedure generate_specialization_procs;
 
@@ -1828,7 +1828,7 @@ implementation
 
 
 
-    procedure read_proc_body(old_current_procinfo:tprocinfo;pd:tprocdef);
+    procedure read_proc_body(old_current_procinfo:tprocinfo;pd:tprocdef;eatsemicolon:boolean=true);
       {
         Parses the procedure directives, then parses the procedure body, then
         generates the code for it
@@ -1912,7 +1912,7 @@ implementation
         { For specialization we didn't record the last semicolon. Moving this parsing
           into the parse_body routine is not done because of having better file position
           information available }
-        if not(df_specialization in current_procinfo.procdef.defoptions) then
+        if eatsemicolon and not(df_specialization in current_procinfo.procdef.defoptions) then
           consume(_SEMICOLON);
 
         if not isnestedproc then
@@ -1921,7 +1921,7 @@ implementation
       end;
 
 
-    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef);
+    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef;eatsemicolon:boolean);
       {
         Parses the procedure directives, then parses the procedure body, then
         generates the code for it
@@ -1951,7 +1951,7 @@ implementation
 
          if not assigned(usefwpd) then
            { parse procedure declaration }
-           pd:=parse_proc_dec(isclassmethod,old_current_structdef)
+           pd:=parse_proc_dec(old_current_structdef,as_procparsemode(isclassmethod))
          else
            pd:=usefwpd;
 
@@ -2028,7 +2028,7 @@ implementation
          { compile procedure when a body is needed }
          if (pd_body in pdflags) then
            begin
-             read_proc_body(old_current_procinfo,pd);
+             read_proc_body(old_current_procinfo,pd,eatsemicolon);
            end
          else
            begin
@@ -2152,7 +2152,7 @@ implementation
               _PROCEDURE,
               _OPERATOR:
                 begin
-                  read_proc(is_classdef,nil);
+                  read_proc(is_classdef,nil,true);
                   is_classdef:=false;
                 end;
               _EXPORTS:
@@ -2187,7 +2187,7 @@ implementation
                       begin
                         if is_classdef then
                           begin
-                            read_proc(is_classdef,nil);
+                            read_proc(is_classdef,nil,true);
                             is_classdef:=false;
                           end
                         else
@@ -2235,7 +2235,7 @@ implementation
              _FUNCTION,
              _PROCEDURE,
              _OPERATOR :
-               read_proc(false,nil);
+               read_proc(false,nil,true);
              else
                begin
                  case idtoken of
diff --git a/compiler/ptype.pas b/compiler/ptype.pas
index 3aad0b7..70ee34b 100644
--- a/compiler/ptype.pas
+++ b/compiler/ptype.pas
@@ -27,7 +27,7 @@ interface
 
     uses
        globtype,cclasses,
-       symtype,symdef,symbase;
+       symtype,symdef,symbase,pclosure;
 
     type
       TSingleTypeOption=(
@@ -1673,26 +1673,35 @@ implementation
                 jvm_create_procvar_class(name,def);
 {$endif}
               end;
-            else
-              if (token=_KLAMMERAFFE) and (m_iso in current_settings.modeswitches) then
-                begin
-                  consume(_KLAMMERAFFE);
-                  single_type(tt2,SingleTypeOptionsInTypeBlock[block_type=bt_type]);
-                  def:=tpointerdef.create(tt2);
-                  if tt2.typ=forwarddef then
-                    current_module.checkforwarddefs.add(def);
-                end
-              else
-                if hadtypetoken and
-                    { don't allow "type helper" in mode delphi and require modeswitch class }
-                    ([m_delphi,m_class]*current_settings.modeswitches=[m_class]) and
-                    (token=_ID) and (idtoken=_HELPER) then
-                  begin
-                    consume(_HELPER);
-                    def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_type);
-                  end
-                else
-                  expr_type;
+           _KLAMMERAFFE:
+             if m_iso in current_settings.modeswitches then
+               begin
+                 consume(_KLAMMERAFFE);
+                 single_type(tt2,SingleTypeOptionsInTypeBlock[block_type=bt_type]);
+                 def:=tpointerdef.create(tt2);
+                 if tt2.typ=forwarddef then
+                   current_module.checkforwarddefs.add(def);
+               end
+             else
+               expr_type;
+           _ID:
+             if idtoken=_REFERENCE then
+               begin
+                 consume(_REFERENCE); consume(_TO);
+                 def:=procvar_dec(genericdef,genericlist);
+               end
+             else
+             if (idtoken=_HELPER) and hadtypetoken and
+                { don't allow "type helper" in mode delphi and require modeswitch class }
+                ([m_delphi,m_class]*current_settings.modeswitches=[m_class]) then
+               begin
+                 consume(_HELPER);
+                 def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_type);
+               end
+             else
+               expr_type;
+           else
+             expr_type;
          end;
 
          if def=nil then
diff --git a/compiler/symconst.pas b/compiler/symconst.pas
index 83dd798..b991e2a 100644
--- a/compiler/symconst.pas
+++ b/compiler/symconst.pas
@@ -350,7 +350,9 @@ type
     { the visibility of of this procdef was raised automatically by the
       compiler, e.g. because it was designated as a getter/setter for a property
       with a higher visibility on the JVM target }
-    po_auto_raised_visibility
+    po_auto_raised_visibility,
+    { anonymous routine (including closure) }
+    po_anonymous
   );
   tprocoptions=set of tprocoption;
 
diff --git a/compiler/symcreat.pas b/compiler/symcreat.pas
index 06ac751..925eeda 100644
--- a/compiler/symcreat.pas
+++ b/compiler/symcreat.pas
@@ -242,7 +242,7 @@ implementation
       current_scanner.substitutemacro('meth_impl_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index);
       current_scanner.readtoken(false);
       { and parse it... }
-      read_proc(is_classdef,usefwpd);
+      read_proc(is_classdef,usefwpd,true);
       parse_only:=oldparse_only;
       { remove the temporary macro input file again }
       current_scanner.closeinputfile;
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index f6f816e..59b1cb7 100644
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@@ -731,6 +731,8 @@ interface
           function  is_methodpointer:boolean;override;
           function  is_addressonly:boolean;override;
           procedure make_external;
+          procedure add_to_procsym; overload; inline;
+          procedure add_to_procsym(sym: tsym); overload; inline;
        end;
 
        { single linked list of overloaded procs }
@@ -4792,6 +4794,19 @@ implementation
       end;
 
 
+    procedure tprocdef.add_to_procsym; inline;
+      begin
+        tprocsym(procsym).ProcdefList.Add(self);
+      end;
+
+
+    procedure tprocdef.add_to_procsym(sym: {tprocsym}tsym); inline;
+      begin
+        procsym:=sym;
+        add_to_procsym;
+      end;
+
+
     procedure tprocdef.buildderef;
       begin
          inherited buildderef;
diff --git a/compiler/tokens.pas b/compiler/tokens.pas
index 3fe1505..3f29f59 100644
--- a/compiler/tokens.pas
+++ b/compiler/tokens.pas
@@ -257,6 +257,7 @@ type
     _PROCEDURE,
     _PROTECTED,
     _PUBLISHED,
+    _REFERENCE,
     _SOFTFLOAT,
     _THREADVAR,
     _WRITEONLY,
@@ -556,6 +557,7 @@ const
       (str:'PROCEDURE'     ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'PROTECTED'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'PUBLISHED'     ;special:false;keyword:[m_none];op:NOTOKEN),
+      (str:'REFERENCE'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'SOFTFLOAT'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'THREADVAR'     ;special:false;keyword:alllanguagemodes-[m_iso];op:NOTOKEN),
       (str:'WRITEONLY'     ;special:false;keyword:[m_none];op:NOTOKEN),
diff --git a/compiler/utils/ppuutils/ppudump.pp b/compiler/utils/ppuutils/ppudump.pp
index c4df7c0..be2b42a 100644
--- a/compiler/utils/ppuutils/ppudump.pp
+++ b/compiler/utils/ppuutils/ppudump.pp
@@ -1723,7 +1723,8 @@ const
      (mask:po_java_nonvirtual; str: 'Java non-virtual method'),
      (mask:po_ignore_for_overload_resolution;str: 'Ignored for overload resolution'),
      (mask:po_rtlproc;         str: 'RTL procedure'),
-     (mask:po_auto_raised_visibility; str: 'Visibility raised by compiler')
+     (mask:po_auto_raised_visibility; str: 'Visibility raised by compiler'),
+     (mask:po_anonymous;       str: 'Anonymous procedure')
   );
 var
   proctypeoption  : tproctypeoption;
-- 
1.8.1.2


From 4cb8a0b64cc8176e23e83d7924e2dc067253bdca Mon Sep 17 00:00:00 2001
From: Vasiliy Kevroletin <kevroletin@gmail.com>
Date: Mon, 3 Jun 2013 00:24:37 +1100
Subject: [PATCH 2/4] Show error in case of access to free variable.

Problem: variable capturing is not implemented and compiler doesn't warng about it.
Fix: Show error message. Parser performs check before creation of tloadnode.
Anonymous routine have normal nesting level and can have nested procedures.
So simple check of symtable nesting level is not enough to detect fact of capturing. Instead we walk through symtables using parent link. We start from current symtable and go until symtable with normal nesting level. If we didn't come to symtable of variable then this variable located in another function. And it's capturing.
---
 compiler/msg/errore.msg |   5 +-
 compiler/msgidx.inc     |   5 +-
 compiler/msgtxt.inc     | 868 ++++++++++++++++++++++++------------------------
 compiler/pdecsub.pas    |   2 +-
 compiler/pexpr.pas      |  39 ++-
 5 files changed, 482 insertions(+), 437 deletions(-)

diff --git a/compiler/msg/errore.msg b/compiler/msg/errore.msg
index 0058444..ed30f73 100644
--- a/compiler/msg/errore.msg
+++ b/compiler/msg/errore.msg
@@ -392,7 +392,7 @@ scan_w_setpeoptflags_not_support=02092_W_SETPEOPTFLAGS is not supported by the t
 #
 # Parser
 #
-# 03333 is the last used one
+# 03334 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -1490,6 +1490,9 @@ parser_e_not_allowed_in_record=03332_E_Visibility section "$1" not allowed in re
 parser_e_proc_dir_not_allowed=03333_E_Procedure directive "$1" not allowed here
 % This procedure directive is not allowed in the given context. E.g. "static"
 % is not allowed for instance methods or class operators.
+parser_e_proc_capture_not_allowed=03334_E_Anonymous procedure can not capture local variable "$1"
+% Anonymous procedure currently can not use local variables of declaring subroutine.
+%
 %
 %
 % \end{description}
diff --git a/compiler/msgidx.inc b/compiler/msgidx.inc
index ccc4bf2..e16a897 100644
--- a/compiler/msgidx.inc
+++ b/compiler/msgidx.inc
@@ -429,6 +429,7 @@ const
   parser_e_no_class_in_local_anonymous_records=03331;
   parser_e_not_allowed_in_record=03332;
   parser_e_proc_dir_not_allowed=03333;
+  parser_e_proc_capture_not_allowed=03334;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -973,9 +974,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 68955;
+  MsgTxtSize = 69019;
 
   MsgIdxMax : array[1..20] of longint=(
-    26,93,334,121,88,56,126,27,202,63,
+    26,93,335,121,88,56,126,27,202,63,
     54,20,1,1,1,1,1,1,1,1
   );
diff --git a/compiler/msgtxt.inc b/compiler/msgtxt.inc
index 8909dae..36396c0 100644
--- a/compiler/msgtxt.inc
+++ b/compiler/msgtxt.inc
@@ -536,665 +536,670 @@ const msgtxt : array[0..000287,1..240] of char=(
   'us records'#000+
   '03332_E_Visibility section "$1" not allowed in records'#000+
   '03333_E_Procedure directive "$1" not allowed here'#000+
+  '03334_E_Anonymous procedure can no','t capture local variable "$1"'#000+
   '04000_E_Type mismatch'#000+
-  '04001_E_Inco','mpatible types: got "$1" expected "$2"'#000+
+  '04001_E_Incompatible types: got "$1" expected "$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+
-  '04006_E_Boolean expression expected, ','but got "$1"'#000+
+  '04005_E_Integer express','ion 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+
   '04009_E_class type expected, but got "$1"'#000+
-  '04011_E_Can'#039't evaluate constant expression'#000+
+  '04011_E_Can'#039't evaluate constant expressio','n'#000+
   '04012_E_Set elements are not compatible'#000+
-  '04013_E_Operation not ','implemented for sets'#000+
+  '04013_E_Operation not implemented for sets'#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+
-  '04017_E_succ or pred on enums',' with assignments not possible'#000+
+  '04016_E_String types',' have to match exactly in $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+
   '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+
+  '04020_E_Can'#039't use read or write on untyped f','ile.'#000+
   '04021_E_Type conflict between set elements'#000+
-  '04022_W_lo/hi(dw','ord/qword) returns the upper/lower word/dword'#000+
+  '04022_W_lo/hi(dword/qword) returns the upper/lower word/dword'#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+
-  '04026_E_Method (variable) and Procedure',' (variable) are not compatibl'+
-  'e'#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 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',' varia'+
-  'ble'#000+
+  '04029_E_Argument can'#039't be assign','ed to'#000+
+  '04030_E_Can'#039't assign local procedure/function to procedure variabl'+
+  'e'#000+
   '04031_E_Can'#039't assign values to an address'#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+
+  '0403','5_H_Mixing signed expressions and longwords gives a 64bit result'+
+  #000+
   '04036_W_Mixing signed expressions and cardinals here may cause a range'+
   ' 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+
-  '04039_E_Class or Object types "$1" ','and "$2" are not related'#000+
+  '04038_E_enums with assignments ','can'#039't be used as array index'#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+
   '04042_E_Type "$1" is not completely defined'#000+
-  '04043_W_String literal has more characters than short string lengt','h'#000+
+  '04','043_W_String literal has more characters than short string length'#000+
   '04044_W_Comparison might be always false due to range of constant and '+
   'expression'#000+
   '04045_W_Comparison might be always true due to range of constant and e'+
   'xpression'#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+
+  '04046_W_Const','ructing a class "$1" with abstract method "$2"'#000+
+  '04047_H_The left operand of the IN operator should be byte sized'#000+
   '04048_W_Type size mismatch, possible loss of data / range check error'#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 t','aken'#000+
+  '04049_H_Type size mismatch, possible loss of data / range ','check erro'+
+  'r'#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+
   '04052_E_Constant Expression expected'#000+
-  '04053_E_Operation "$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_Conversio','n between ordinals and pointers is not portable'#000+
+  '04055_H_Conversion between ordinals and pointers is not portable'#000+
   '04056_W_Conversion between ordinals and pointers is not portable'#000+
   '04057_E_Can'#039't determine which overloaded function to call'#000+
-  '04058_E_Illegal counter variable'#000+
-  '04059_W_Converting constant real val','ue to double for C variable argu'+
-  'ment, add explicit typecast to prevent this.'#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 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)Pa'+
-  'cked Array"'#000+
+  '04061_E_Constant packed arrays are not y','et supported'#000+
+  '04062_E_Incompatible type for arg no. $1: Got "$2" expected "(Bit)Pack'+
+  'ed 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 t','o '+
+  'be initialised'#000+
+  '04065_E_Constant packed records and objects are not yet 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+
-  '04077_E_Can'#039't export subroutine marked as local from a unit'#000+
-  '04078_E_Type is no','t automatable: "$1"'#000+
+  '04077_E_Can'#039't ','export subroutine marked as local from a unit'#000+
+  '04078_E_Type is not automatable: "$1"'#000+
   '04079_H_Converting the operands to "$1" before doing the add could pre'+
   'vent overflow errors.'#000+
-  '04080_H_Converting the operands to "$1" before doing the subtract coul'+
-  'd prevent overflow errors.'#000+
-  '04081_H_Converting the operands',' to "$1" before doing the multiply co'+
+  '04080_H_Converting the operands to "$1" before doing the subtrac','t co'+
   'uld prevent overflow errors.'#000+
+  '04081_H_Converting the operands to "$1" before doing the multiply coul'+
+  'd 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 G','UID'#000+
+  '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+
   '04085_E_Expected Objective-C method, but got $1'#000+
   '04086_E_Expected Objective-C method or constant method name'#000+
-  '04087_E_No type info available for this type'#000+
+  '04087_E_No type info availabl','e for this type'#000+
   '04088_E_Ordinal or string expression expected'#000+
-  '04','089_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 Object'+
-  'ive-C runtime.'#000+
-  '04093_E_Class or objcclass type expec','ted, but got "$1"'#000+
+  '04092_E_The type "$1" is not supported for interaction wit','h the Obje'+
+  'ctive-C runtime.'#000+
+  '04093_E_Class or objcclass type expected, but got "$1"'#000+
   '04094_E_Objcclass type expected'#000+
   '04095_W_Coerced univ parameter type in procedural variable may cause c'+
   'rash or memory corruption: $1 to $2'#000+
-  '04096_E_Type parameters of specializations of generics cannot referenc'+
-  'e the currentl','y specialized type'#000+
+  '04096_E_Type paramet','ers of specializations of generics cannot refere'+
+  'nce the currently specialized type'#000+
   '04097_E_Type parameters are not allowed on non-generic class/record/ob'+
   'ject procedure or function'#000+
-  '04098_E_Generic declaration of "$1" differs from previous declaration'#000+
+  '04098_E_Generic declaration of "$1" differs from previous de','claratio'+
+  'n'#000+
   '04099_E_Helper type expected'#000+
-  '04100_E_Record type expec','ted'#000+
+  '04100_E_Record type expected'#000+
   '04101_E_Derived class helper must extend a subclass of "$1" or the cla'+
   'ss itself'#000+
   '04102_E_Derived record or type helper must extend "$1"'#000+
-  '04103_E_Invalid assignment, procedures return no value'#000+
-  '04104_W_Implicit string type conversion from "','$1" to "$2"'#000+
+  '04103_E_Invalid assignment, procedure','s return no value'#000+
+  '04104_W_Implicit string type conversion from "$1" to "$2"'#000+
   '04105_W_Implicit string type conversion with potential data loss from '+
   '"$1" to "$2"'#000+
   '04106_-W_Explicit string typecast from "$1" to "$2"'#000+
-  '04107_-W_Explicit string typecast with potential data loss from "$1" t'+
-  'o "$2"'#000+
-  '04108_W_Unicode ','constant cast with potential data loss'#000+
+  '04107_-W_Explicit string type','cast with potential data loss from "$1"'+
+  ' to "$2"'#000+
+  '04108_W_Unicode constant cast with potential data loss'#000+
   '04109_E_range check error while evaluating constants ($1 must be betwe'+
   'en $2 and $3)'#000+
-  '04110_W_range check error while evaluating constants ($1 must be betwe'+
-  'en $2 and $3)'#000+
-  '04111_E_This type is not supporte','d for the Default() intrinsic'#000+
+  '04110_W_range check error while evaluating constants ','($1 must be bet'+
+  'ween $2 and $3)'#000+
+  '04111_E_This type is not supported for the Default() intrinsic'#000+
   '04112_E_JVM virtual class methods cannot be static'#000+
   '04113_E_Final (class) fields can only be assigned in their class'#039' '+
   '(class) constructor'#000+
-  '04114_E_It is not possible to typecast untyped parameters on managed p'+
-  'lat','forms, simply assign a value to them instead.'#000+
+  '04114_E_I','t is not possible to typecast untyped parameters on managed'+
+  ' platforms, simply assign a value to them instead.'#000+
   '04115_E_The assignment side of an expression cannot be typecasted to a'+
   ' supertype on managed platforms'#000+
-  '04116_-W_The interface method "$1" raises the visibility of "$2" to pu'+
-  'blic when accessed via',' an interface instance'#000+
+  '04116_-W_The interface metho','d "$1" raises the visibility of "$2" to '+
+  'public when accessed via an interface instance'#000+
   '04117_E_The interface method "$1" has a higher visibility (public) tha'+
   'n "$2"'#000+
   '04118_E_TYPEOF can only be used on object types with VMT'#000+
-  '04119_E_It is not possible to define a default value for a parameter o'+
-  'f type "$1"'#000+
-  '0','4120_E_Type "$1" cannot be extended by a type helper'#000+
+  '04119_E_It is not p','ossible to define a default value for a parameter'+
+  ' of type "$1"'#000+
+  '04120_E_Type "$1" cannot be extended by a type helper'#000+
   '05000_E_Identifier not found "$1"'#000+
   '05001_F_Internal Error in SymTableStack()'#000+
   '05002_E_Duplicate identifier "$1"'#000+
-  '05003_H_Identifier already defined in $1 at line $2'#000+
-  '05004_E_Unknown identifie','r "$1"'#000+
+  '05003_H_Ident','ifier already defined in $1 at line $2'#000+
+  '05004_E_Unknown identifier "$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+
-  '05012_F_record or class type expected'#000,
+  '05010_E_Only static variables can be used in static m','ethods or outsi'+
+  'de methods'#000+
+  '05012_F_record or class type expected'#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+
-  '05016_E_Illegal label declaration'#000+
-  '05017_E_GOTO and LABEL are not supported (use switch -S','g)'#000+
+  '05016_E_Illegal label dec','laration'#000+
+  '05017_E_GOTO and LABEL are not supported (use switch -Sg)'#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+
+  '05022_E_Forward class definition not ','resolved "$1"'#000+
   '05023_H_Unit "$1" not used in $2'#000+
-  '05024_H_Parameter',' "$1" not used'#000+
+  '05024_H_Parameter "$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+
-  '05028_H_Local $1 "$2" is not used'#000+
-  '05029_N_Private field "$1.$2" is 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+
   '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+
-  '05034_W_Type "$1" is not aligned correctly in current record for C',#000+
+  '05','034_W_Type "$1" is not aligned correctly in current record for C'#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+
-  '05038_E_identifier idents no member "$1"'#000+
+  '05038_E_identifi','er idents no member "$1"'#000+
   '05039_H_Found declaration: $1'#000+
-  '05040_E_D','ata element too large'#000+
+  '05040_E_Data element too large'#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+
-  '05055_W_Symbol "$1" is not implemented'#000+
-  '05056_E_Can'#039't create unique type from this',' type'#000+
+  '05055_W_Symbol "$','1" is not implemented'#000+
+  '05056_E_Can'#039't create unique type from this type'#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+
-  '05060_H_Function result variable does not seem to be initi','alized'#000+
+  '05059_W_Function result variable does not seem to initia','lized'#000+
+  '05060_H_Function result variable does not seem to be initialized'#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 declaration "$1" not resolved, assu','med 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+
-  '05069_E_Cannot find a "Current" property in enumerator "$1"'#000+
-  '05070_E_Mismatch between number of d','eclared parameters and number of'+
-  ' colons in message string.'#000+
+  '05069_E_Cannot find a "Current" ','property in enumerator "$1"'#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+
+  '05073_N_Private property "$1.$2" nev','er used'#000+
   '05074_W_Unit "$1" is deprecated'#000+
-  '05075_W_Unit "$1" is dep','recated: "$2"'#000+
+  '05075_W_Unit "$1" is deprecated: "$2"'#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+
-  '05080_E_No complete definition of the formally declared class "$1" is '+
-  'in scope'#000,
+  '05080_E_No comp','lete definition of the formally declared class "$1" i'+
+  's in scope'#000+
   '05081_E_Gotos into initialization or finalization blocks of units are '+
   'not allowed'#000+
   '05082_E_Invalid external name "$1" for formal class "$2"'#000+
-  '05083_E_Complete class definition with external name "$1" here'#000+
-  '05084_W_Possible library conflict: sym','bol "$1" from library "$2" als'+
-  'o found in library "$3"'#000+
+  '05083_E_Complete class definition wit','h external name "$1" here'#000+
+  '05084_W_Possible library conflict: symbol "$1" from library "$2" also '+
+  'found in library "$3"'#000+
   '05085_E_Cannot add implicit constructor '#039'Create'#039' because ident'+
   'ifier already used by "$1"'#000+
-  '05086_E_Cannot generate default constructor for class, because parent '+
-  'has no parameterless constr','uctor'#000+
+  '05086_E_Cannot generate default c','onstructor for class, because paren'+
+  't has no parameterless constructor'#000+
   '05087_D_Adding helper for $1'#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 ther','e'#000+
   '06015_E_EXPORT declared functions can'#039't be called'#000+
-  '06016_W_Poss','ible illegal call of constructor or destructor'#000+
+  '06016_W_Possible illegal call of constructor or destructor'#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 met','hods can'#039't be inline.'#000+
+  '06031_E_Object or class methods can'#039't be inline.'#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+
-  '06037_E_Constructors or destructors can','not be called inside a '#039'w'+
-  'ith'#039' clause'#000+
+  'sed,',' 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+
   '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+
-  '06041_W_Parameters size exceeds lim','it for certain cpu'#039's'#000+
+  '06040_E_Control flow statements aren'#039,'t allowed in a finally block'+
+  #000+
+  '06041_W_Parameters size exceeds limit 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+
-  '06046_F_Unknown compilerproc "$1". Check if you use ','the correct run '+
-  'time library.'#000+
+  '06045_E_CONTINUE ','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 run'+
   ' time library.'#000+
   '06048_H_Inherited call to abstract method ignored'#000+
-  '06049_E_Goto label "$1" not defined or optimized away'#000+
-  '06050_F_Cannot find t','ype "$1" in unit "$2". Check if you use the cor'+
-  'rect run time library.'#000+
+  '06049_E_Got','o 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 time library.'#000+
   '06051_E_Interprocedural gotos are allowed only to outer subroutines'#000+
-  '06052_E_Label must be defined in the same scope as it is declared'#000+
-  '06053_E_Leaving procedures containin','g explicit or implicit exception'+
-  's frames using goto is not allowed'#000+
+  '06052_E_Label must be defined in the s','ame scope as it is declared'#000+
+  '06053_E_Leaving procedures containing explicit or implicit exceptions '+
+  'frames using goto is not allowed'#000+
   '06054_E_In ISO mode, the mod operator is defined only for positive quo'+
   'tient'#000+
   '06055_DL_Auto inlining: $1'#000+
-  '07000_DL_Starting $1 styled assembler parsing'#000+
-  '07001_DL_Finished $1 sty','led assembler parsing'#000+
+  '07000_','DL_Starting $1 styled assembler parsing'#000+
+  '07001_DL_Finished $1 styled assembler parsing'#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 without identifier'#000+
-  '07007_E_Cannot use local variable or parameters here'#000+
-  '07008_E_need to',' use OFFSET here'#000+
+  '0700','7_E_Cannot use local variable or parameters here'#000+
+  '07008_E_need to use OFFSET here'#000+
   '07009_E_need to use $ here'#000+
   '07010_E_Cannot use multiple relocatable symbols'#000+
   '07011_E_Relocatable symbol can only be added'#000+
   '07012_E_Invalid constant expression'#000+
-  '07013_E_Relocatable symbol is not allowed'#000+
-  '07014_E_Invalid reference',' syntax'#000+
+  '070','13_E_Relocatable symbol is not allowed'#000+
+  '07014_E_Invalid reference syntax'#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+
-  '07018_W_Possible error in object field handling'#000+
-  '07019_E_Wrong scale factor specified'#000,
+  '07018_W_Possible erro','r in object field handling'#000+
+  '07019_E_Wrong scale factor specified'#000+
   '07020_E_Multiple index register usage'#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 referen','ces are not allowed'#000+
   '07025_E_Divide by zero in asm evaluator'#000+
-  '0702','6_E_Illegal expression'#000+
+  '07026_E_Illegal expression'#000+
   '07027_E_escape 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+
-  '07031_W_ENTER instruction is not supported by ','Linux kernel'#000+
+  '07030_W_$1 without operand tr','anslated into $1P'#000+
+  '07031_W_ENTER instruction is not supported by Linux kernel'#000+
   '07032_W_Calling an overload 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 b','inary $1'#000+
+  '07037_E_Error converting binary $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 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+
+  '07042_E','_Cannot use OLDEBP outside a nested procedure'#000+
+  '07043_W_Procedures can'#039't return any value in asm code'#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 destination 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 com','bination of opcode and operands'#000+
+  '07048_E_Invalid combination of opcode and operands'#000+
   '07049_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 pointer'#000+
-  '07053_E_Unrecognize','d opcode $1'#000+
+  '07052_W_constant with sym','bol $1 for address which is not on a pointe'+
+  'r'#000+
+  '07053_E_Unrecognized opcode $1'#000+
   '07054_E_Invalid or missing opcode'#000+
   '07055_E_Invalid combination of prefix and opcode: $1'#000+
   '07056_E_Invalid combination of override and opcode: $1'#000+
-  '07057_E_Too many operands on line'#000+
+  '07057_E_Too many opera','nds on line'#000+
   '07058_W_NEAR ignored'#000+
   '07059_W_FAR ignored'#000+
-  '07060_E_Dup','licate local symbol $1'#000+
+  '07060_E_Duplicate local symbol $1'#000+
   '07061_E_Undefined local symbol $1'#000+
   '07062_E_Unknown label identifier $1'#000+
   '07063_E_Invalid register name'#000+
   '07064_E_Invalid floating point register name'#000+
-  '07066_W_Modulo not supported'#000+
-  '07067_E_Invalid floating point constant $1'#000,
+  '07066_W_','Modulo not supported'#000+
+  '07067_E_Invalid floating point constant $1'#000+
   '07068_E_Invalid floating point expression'#000+
   '07069_E_Wrong symbol type'#000+
   '07070_E_Cannot index a local var or parameter with a register'#000+
   '07071_E_Invalid segment override expression'#000+
-  '07072_W_Identifier $1 supposed external'#000+
-  '07073_E_Strings not allowe','d as constants'#000+
+  '07','072_W_Identifier $1 supposed external'#000+
+  '07073_E_Strings not allowed as constants'#000+
   '07074_E_No type of variable specified'#000+
   '07075_E_assembler code not returned to text section'#000+
   '07076_E_Not a directive or local symbol $1'#000+
-  '07077_E_Using a defined name as a local label'#000+
-  '07078_E_Dollar token is used without an identi','fier'#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+
   '07080_N_.align is target specific, use .balign or .p2align'#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 op'+
-  'erands'#000+
+  '07082_E_Can'#039't acc','ess fields of objects/classes directly'#000+
+  '07083_E_No size specified and unable to determine the size of the oper'+
+  'ands'#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+
-  '07088_W_"$1 %st(n)" translated int','o "$1 %st(n),%st"'#000+
+  '07087_W_"$1 %st(n)" tr','anslated 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+
   '07090_E_Char > not allowed here'#000+
   '07093_W_ALIGN not supported'#000+
   '07094_E_Inc and Dec cannot be together'#000+
-  '07095_E_Invalid reglist for movem'#000+
+  '07095_E_Invalid reglist for',' movem'#000+
   '07096_E_Reglist invalid for opcode'#000+
-  '07097_E_Higher cpu mod','e required ($1)'#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+
+  '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+
-  '07','101_W_No size specified and unable to determine the size of the op'+
-  'erands, using BYTE as default'#000+
+  '07101_W_No size specified and unable to determine the size of the oper'+
+  'ands, 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 convention'+
-  #000+
-  '07104_W_Use of -','offset(%ebp) is not recommended for local variable a'+
-  'ccess'#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+
   '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, a'+
-  'nd "$1" is not virtual'#000+
-  '07107_E_Gener','ating PIC, but reference is not PIC-safe'#000+
+  '07106_E_VMTOffset must be used in combinat','ion with a virtual method,'+
+  ' and "$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+
-  '07110_W_@GOTPCREL is useless and potentially dangereous for local symb'+
-  'ols'#000+
-  '07111_W_Con','stant with general purpose segment register'#000+
+  '07110_W_@GOTPCREL is ','useless and potentially dangereous for local sy'+
+  'mbols'#000+
+  '07111_W_Constant with general purpose segment register'#000+
   '07112_E_Invalid offset value for $1'#000+
   '07113_E_Invalid register for $1'#000+
-  '07114_E_SEH directives are allowed only in pure assembler procedures'#000+
-  '07115_E_Directive "$1" is not supported for the current tar','get'#000+
+  '07114_E_SEH directives are allowed only in pure assembler proced','ures'+
+  #000+
+  '07115_E_Directive "$1" is not supported for the current target'#000+
   '07116_E_This function'#039's result location cannot be encoded directly'+
   ' in a single operand when "nostackframe" is used'#000+
-  '07117_E_GOTPCREL references in Intel assembler syntax cannot contain a'+
-  ' base or index register, and their offset must 0.'#000+
-  '0','7118_E_The current target does not support GOTPCREL relocations'#000+
+  '07117_E_GOTPCREL references in Intel assembler syntax can','not contain'+
+  ' a base or index register, and their offset must 0.'#000+
+  '07118_E_The current target does not support GOTPCREL relocations'#000+
   '07119_W_Exported/global symbols should accessed via the GOT'#000+
   '07120_W_Check size of memory operand "$1"'#000+
-  '07121_W_Check size of memory operand "$1: memory-operand-size is $2 bi'+
-  'ts, ','but expected [$3 bits]"'#000+
+  '07121_W_Ch','eck size of memory operand "$1: memory-operand-size is $2 '+
+  'bits, but expected [$3 bits]"'#000+
   '07122_W_Check size of memory operand "$1: memory-operand-size is $2 bi'+
   'ts, but expected [$3 bits + $4 byte offset]"'#000+
-  '07123_W_Check "$1: offset of memory operand is negative "$2 byte"'#000+
-  '07124_W_Check "$1: size of memory o','perand is empty, but es exists di'+
-  'fferent definitions of the memory size =>> map to $2 (smallest option)'+
-  '"'#000+
+  '07123_W_Check "$1: offset of memory o','perand is negative "$2 byte"'#000+
+  '07124_W_Check "$1: size of memory operand is empty, but es exists diff'+
+  'erent definitions of the memory size =>> map to $2 (smallest option)"'#000+
   '07125_E_Invalid register used in memory reference expression: "$1"'#000+
-  '08000_F_Too many assembler files'#000+
-  '08001_F_Selected assembler output n','ot supported'#000+
+  '0800','0_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+
   '08004_E_Allocating of data is only allowed in bss section'#000+
-  '08005_F_No binary writer selected'#000+
+  '08005_F_No binary writer selecte','d'#000+
   '08006_E_Asm: Opcode $1 not in table'#000+
-  '08007_E_Asm: $1 invalid co','mbination of opcode and operands'#000+
+  '08007_E_Asm: $1 invalid combination of opcode and operands'#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+
-  '08012_E_Asm: Short jump is out of rang','e $1'#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+
   '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 he','re'#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+
   '08021_E_Asm: 64 Bit operands not supported'#000+
-  '08022_E_Asm: AH,BH,CH or DH cannot be used in an instruction requiring'+
-  ' REX prefix'#000+
-  '08023_E_Missing .seh_endprol','ogue directive'#000+
+  '08022_E_Asm: AH,BH,CH or DH cannot be used in ','an instruction requiri'+
+  'ng REX prefix'#000+
+  '08023_E_Missing .seh_endprologue directive'#000+
   '08024_E_Function prologue exceeds 255 bytes'#000+
   '08025_E_.seh_handlerdata directive without preceding .seh_handler'#000+
-  '08026_F_Relocation count for section $1 exceeds 65535'#000+
+  '08026_F_Relocation count for section $1 exceeds 655','35'#000+
   '09000_W_Source operating system redefined'#000+
-  '09001_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 (error code: $2)'#000+
   '09004_E_Can'#039't create archive file: $1'#000+
-  '09005_E_Assembler $1 not found, switching to external assembling'#000+
+  '09005_E_Assembler $1 not found, sw','itching 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+
-  '09010_I_Assembling with smartlinking $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+
   '09015_I_Linking $1'#000+
-  '09016_E_Util $1 not found, switching to external linking'#000+
+  '09016_E_Util $1 not found, switchin','g to external linking'#000+
   '09017_T_Using util $1'#000+
-  '09018_E_Creation of ','Executables 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 m','ode'+
+  #000+
   '09022_I_Compiling resource $1'#000+
-  '09023_T_unit $1 can'#039't be stati','cally 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+
+  'g'#000,
   '09026_E_unit $1 can'#039't be smart or static linked'#000+
-  '09027_E_unit $1 ','can'#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+
-  '09030_E_Can'#039't call the resource compiler "$1", switching to extern'+
-  'al mode'#000+
-  '09031_E_Can'#039't open resource ','file "$1"'#000+
+  '09030_E_Can'#039't call the resource compil','er "$1", switching to exte'+
+  'rnal mode'#000+
+  '09031_E_Can'#039't open resource file "$1"'#000+
   '09032_E_Can'#039't write resource file "$1"'#000+
   '09033_N_File "$1" not found for backquoted cat command'#000+
   '09034_W_"$1" not found, this will probably cause a linking failure'#000+
-  '09128_F_Can'#039't post process executable $1'#000+
-  '09129_F_Can'#039't open executabl','e $1'#000+
+  '09128','_F_Can'#039't post process 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+
   '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+
+  '09134_X_Stack',' space committed: $1 bytes'#000+
+  '09200_F_Executable image size is too big 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+
   '10002_U_PPU Name: $1'#000+
-  '10003_U_PPU Flags: $1'#000+
+  '10003_U_PPU F','lags: $1'#000+
   '10004_U_PPU Crc: $1'#000+
   '10005_U_PPU Time: $1'#000+
-  '10006_U_PPU Fi','le too short'#000+
+  '10006_U_PPU File 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 another processor'#000+
-  '10010_U_PPU is compiled for another target'#000+
+  '10010_U_PPU is compiled for another t','arget'#000+
   '10011_U_PPU Source: $1'#000+
   '10012_U_Writing $1'#000+
-  '10013_F_Can'#039't Wr','ite PPU-File'#000+
+  '10013_F_Can'#039't Write 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_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+
+  '10','019_F_Too much units'#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 found but $2 exists'#000+
-  '10024_F_Unit $1 searched but $2 found'#000+
+  '10024_F_Unit $1 searched but $2 fou','nd'#000+
   '10025_W_Compiling the system unit requires the -Us switch'#000+
-  '100','26_F_There were $1 errors compiling module, stopping'#000+
+  '10026_F_There were $1 errors compiling module, stopping'#000+
   '10027_U_Load from $1 ($2) unit $3'#000+
   '10028_U_Recompiling $1, checksum changed for $2'#000+
-  '10029_U_Recompiling $1, source found only'#000+
+  '10029_U_Recompiling $1, source found only',#000+
   '10030_U_Recompiling unit, static lib is older than ppufile'#000+
-  '1003','1_U_Recompiling unit, shared lib is older than ppufile'#000+
+  '10031_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+
-  '10034_U_Parsing interface of $1'#000+
+  '10034_U_Pars','ing 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+
-  '10041_U_File $1 is newer than the one used for creating PPU file $2'#000+
-  '10042_U_Trying to use a unit which was compiled ','with a different FPU'+
-  ' mode'#000+
+  '10041_U_File $1 is newer than the one used for creat','ing PPU file $2'#000+
+  '10042_U_Trying to use a unit which was compiled with a different FPU m'+
+  '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+
-  '10046_U_Implementation 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 depends 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+
   '10052_U_Forced reloading'#000+
-  '10053_U_Previous state of $1: $2'#000+
-  '10054_U_Already compiling $1, set','ting second compile'#000+
+  '10','053_U_Previous state of $1: $2'#000+
+  '10054_U_Already compiling $1, setting second compile'#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_Skipping re-resolving unit $1, still loading used units'#000+
-  '10060_U_Unloading resource unit $1 (no','t needed)'#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 (object','s/classes) CRC changed for unit $1'+
-  #000+
+  'wpo feedback input file fo','r 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+
-  '11002_W_DEF file can be created only for OS/2'#000+
-  '11003_E_nested response ','files are not supported'#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+
   '11005_N_No option inside $1 config file'#000+
   '11006_E_Illegal parameter: $1'#000+
   '11007_H_-? writes help pages'#000+
-  '11008_F_Too many config files nested'#000+
+  '11008_F_T','oo 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} encou'+
-  'ntered'#000+
-  '11014_F_In options f','ile $1 at line $2 unexpected \var{\#ENDIFs} enco'+
-  'untered'#000+
+  '11013_F_In options file $1 at lin','e $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+
   '11015_F_Open conditional at the end of the options file'#000+
-  '11016_W_Debug information generation is not supported by this executab'+
-  'le'#000+
+  '11016_W_Debug information generation is not supported by this ex','ecut'+
+  'able'#000+
   '11017_H_Try recompiling with -dGDB'#000+
-  '11018_W_You are usin','g the obsolete switch $1'#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+
-  '11021_W_Assembler output selected "$1" is not compatible with "$2"'#000+
-  '11022_W_"$1" assembler u','se forced'#000+
+  '11021_W_Assembler output se','lected "$1" is not compatible with "$2"'#000+
+  '11022_W_"$1" assembler use forced'#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+
-  '11030_H_Start of reading config file $1'#000+
+  '11030_H_Start of reading con','fig file $1'#000+
   '11031_H_End of reading config file $1'#000+
-  '11032_D_interp','reting option "$1"'#000+
+  '11032_D_interpreting 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 source file name "$1"'#000+
-  '11039_E_Unknown codepage "$1"'#000+
+  '11039_E','_Unknown codepage "$1"'#000+
   '11040_F_Config file $1 is a directory'#000+
-  '110','41_W_Assembler output selected "$1" cannot generate debug info, d'+
-  'ebugging disabled'#000+
+  '11041_W_Assembler output selected "$1" cannot generate debug info, deb'+
+  'ugging disabled'#000+
   '11042_W_Use of ppc386.cfg is deprecated, please use fpc.cfg instead'#000+
-  '11043_F_In options file $1 at line $2 \var{\#ELSE} directive without \'+
-  'var{\#IF(N)DEF} fou','nd'#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 targe'+
   't 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 ',
-  'this target, switching to static linking'#000+
+  '11046','_N_DWARF debug information cannot be used with smart linking on'+
+  ' this target, switching to static linking'#000+
   '11047_W_Option "$1" is ignored for the current target platform.'#000+
   '11048_W_Disabling external debug information because it is unsupported'+
-  ' for the selected target/debug format combination.'#000+
-  '11049_N_DWARF ','debug information cannot be used with smart linking wi'+
-  'th external assembler, disabling static library creation.'#000+
-  '11050_E_Invalid value for MACOSX_DEPLOYMENT_TARGET environment variabl'+
-  'e: $1'#000+
-  '11051_E_Invalid value for IPHONEOS_DEPLOYMENT_TARGET',' environment var'+
-  'iable: $1'#000+
+  ' ','for the selected target/debug format combination.'#000+
+  '11049_N_DWARF debug information cannot be used with smart linking with'+
+  ' external assembler, disabling static library creation.'#000+
+  '11050_E_Invalid value for MACOSX_DEPLOYMENT_TARGET environment v','aria'+
+  'ble: $1'#000+
+  '11051_E_Invalid value for IPHONEOS_DEPLOYMENT_TARGET environment varia'+
+  'ble: $1'#000+
   '11052_E_You must use a FPU type of VFPV2, VFPV3 or VFPV3_D16 when usin'+
   'g the EABIHF ABI target'#000+
-  '11053_W_The selected debug format is not supported on the current targ'+
-  'et, not changing the current setting'#000+
-  '12000_F_Canno','t open whole program optimization feedback file "$1"'#000+
+  '11053_W_The selected debug format is not supported on th','e current ta'+
+  'rget, not changing the current setting'#000+
+  '12000_F_Cannot open whole program optimization 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 information'+
-  ' in wpo feedback file "$1"'#000+
-  '12003_','E_Expected section header, but got "$2" at line $1 of wpo feed'+
-  'back file'#000+
+  '12002_D_Finished processing the whole p','rogram 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+
   '12004_W_No handler registered for whole program optimization section "'+
-  '$2" at line $1 of wpo feedback file, ignoring'#000+
-  '12005_D_Found whole program optimization section "$1','" with informati'+
-  'on about "$2"'#000+
+  '$2" at line $1 of wpo feedback fil','e, 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_No collected information necessary to perform "$1" whole progr'+
-  'am optimization found'#000+
-  '120','08_F_Specify a whole program optimization feedback file to store '+
-  'the generated info in (using -FW)'#000+
+  '12007_E_No collected informatio','n 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 information, yet'+
-  ' a feedback file was specified (using -FW)'#000+
-  '12010_E_Not performing any w','hole program optimizations, yet an input'+
-  ' feedback file was specified (using -Fw)'#000+
+  ' a feed','back 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+
   '12011_D_Skipping whole program optimization section "$1", because not '+
-  'needed by the requested optimizations'#000+
-  '12012_W_Overriding previously read information for ','"$1" from feedbac'+
-  'k input file using information in section "$2"'#000+
+  'needed by the requested o','ptimizations'#000+
+  '12012_W_Overriding previously read information for "$1" from feedback '+
+  'input file using information in section "$2"'#000+
   '12013_E_Cannot extract symbol liveness information from program when s'+
   'tripping symbols, use -Xs-'#000+
-  '12014_E_Cannot extract symbol liveness information from program when w'+
-  'hen not l','inking'#000+
+  '12014_E_Cannot ','extract symbol liveness information from program when'+
+  ' when 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 information produced by "'+
   '$1"'#000+
-  '12017_F_Error executing "$1" (exitcode: $2) to extract symbol infor','m'+
+  '120','17_F_Error executing "$1" (exitcode: $2) to extract symbol inform'+
   'ation 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 specified whole program optimisation feedback fi'+
-  'le "$1"'#000+
-  '11023_Free Pascal Compiler versio','n $FPCFULLVERSION [$FPCDATE] for $F'+
-  'PCCPU'#010+
+  '12019_E_Cannot create specified whole program o','ptimisation feedback '+
+  'file "$1"'#000+
+  '11023_Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPC'+
+  'CPU'#010+
   'Copyright (c) 1993-2013 by Florian Klaempfl and others'#000+
   '11024_Free Pascal Compiler version $FPCVERSION'#010+
   #010+
   'Compiler Date      : $FPCDATE'#010+
-  'Compiler CPU Target: $FPCCPU'#010+
+  'Co','mpiler CPU Target: $FPCCPU'#010+
   #010+
   'Supported targets:'#010+
   '  $OSTARGETS'#010+
   #010+
-  'Sup','ported CPU instruction sets:'#010+
+  'Supported CPU instruction sets:'#010+
   '  $INSTRUCTIONSETS'#010+
   #010+
   'Supported FPU instruction sets:'#010+
@@ -1204,11 +1209,11 @@ const msgtxt : array[0..000287,1..240] of char=(
   '  $ABITARGETS'#010+
   #010+
   'Supported Optimizations:'#010+
-  '  $OPTIMIZATIONS'#010+
+  '  $OPTIMI','ZATIONS'#010+
   #010+
   'Supported Whole Program Optimizations:'#010+
   '  All'#010+
-  '  $WPOPTIM','IZATIONS'#010+
+  '  $WPOPTIMIZATIONS'#010+
   #010+
   'Supported Microcontroller types:'#010+
   '  $CONTROLLERTYPES'#010+
@@ -1216,248 +1221,248 @@ const msgtxt : array[0..000287,1..240] of char=(
   'This program comes under the GNU General Public Licence'#010+
   'For more information read COPYING.v2'#010+
   #010+
-  'Please report bugs in our bug tracker on:'#010+
-  '                 http://bugs.freepascal.o','rg'#010+
+  'Please report bugs ','in our bug tracker on:'#010+
+  '                 http://bugs.freepascal.org'#010+
   #010+
   'More information may be found on our WWW pages (including directions'#010+
   'for mailing lists useful for asking questions or discussing potential'#010+
   'new features, etc.):'#010+
-  '                 http://www.freepascal.org'#000+
-  '11025_**0*_Put + after a boolean ','switch option to enable it, - to di'+
-  'sable it'#010+
+  '            ','     http://www.freepascal.org'#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 assembler file'#010+
   '**2al_List sourcecode lines in assembler file'#010+
-  '**2an_List node info in assembler file (-dEXTDEBUG compiler)'#010+
-  '*L2ap_Use pipes instead of ','creating temporary assembler files'#010+
+  '**2an_List node info in ','assembler file (-dEXTDEBUG compiler)'#010+
+  '*L2ap_Use pipes instead of creating temporary assembler files'#010+
   '**2ar_List register allocation/release info in assembler file'#010+
   '**2at_List temp allocation/release info in assembler file'#010+
-  '**1A<x>_Output format:'#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*2Anasmwin32_Win32 object file using Nasm'#010+
-  '3*2Anasmwdosx_Win32/WDOSX object file using Nasm'#010,
+  '3*2Anasmwin32_Win32 object f','ile 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*2Atasm_Obj file using Tasm (Borland)'#010+
-  '3*2Aelf_ELF (Linux) using internal writer'#010+
+  '3*2Aelf_ELF (Linux) using ','internal writer'#010+
   '3*2Acoff_COFF (Go32v2) using internal writer'#010+
-  '3*2','Apecoff_PE-COFF (Win32) using internal writer'#010+
+  '3*2Apecoff_PE-COFF (Win32) using internal writer'#010+
   '4*2Aas_Assemble using GNU AS'#010+
   '4*2Agas_Assemble using GNU GAS'#010+
   '4*2Agas-darwin_Assemble darwin Mach-O64 using GNU GAS'#010+
-  '4*2Amasm_Win64 object file using ml64 (Microsoft)'#010+
-  '4*2Apecoff_PE-COFF (Win64) usi','ng internal writer'#010+
+  '4*2Amasm_Win64 o','bject file using ml64 (Microsoft)'#010+
+  '4*2Apecoff_PE-COFF (Win64) using internal writer'#010+
   '4*2Aelf_ELF (Linux-64bit) using internal writer'#010+
   '6*2Aas_Unix o-file using GNU AS'#010+
   '6*2Agas_GNU Motorola assembler'#010+
   '6*2Amit_MIT Syntax (old GAS)'#010+
-  '6*2Amot_Standard Motorola assembler'#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_Build all modules'#010+
   '**1C<x>_Code generation options:'#010+
-  '**2C3<x>_Turn on ieee error checking for constants'#010+
-  '**2Ca<x>_Select ABI, see fpc -i',' for possible values'#010+
+  '**2C3<x>_Turn on i','eee error checking for constants'#010+
+  '**2Ca<x>_Select ABI, see fpc -i for possible values'#010+
   '**2Cb_Generate code for a big-endian variant of the target architectur'+
   'e'#010+
   '**2Cc<x>_Set default calling convention to <x>'#010+
-  '**2CD_Create also dynamic library (not supported)'#010+
-  '**2Ce_Compilation with emulated floating point opc','odes'#010+
+  '**2CD_Create also dynamic library (n','ot supported)'#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+
   '**2CF<x>_Minimal floating point constant precision (default, 32, 64)'#010+
   '**2Cg_Generate PIC code'#010+
-  '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+
-  '**2Ci_IO-checki','ng'#010+
+  '**2','Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+
+  '**2Ci_IO-checking'#010+
   '**2Cn_Omit linking stage'#010+
   'P*2CN_Generate nil-pointer checks (AIX-only)'#010+
   '**2Co_Check overflow of integer operations'#010+
   '**2CO_Check for possible overflow of integer operations'#010+
-  '**2Cp<x>_Select instruction set, see fpc -i for possible values'#010+
-  '**2C','P<x>=<y>_ packing settings'#010+
+  '**2C','p<x>_Select instruction set, see fpc -i for possible values'#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_Verify object method call validity'#010+
-  '**2Cs<n>_Set stack checking size to <n>'#010+
-  '**2Ct_Stack checking (for testing o','nly, see manual)'#010+
+  '**2Cs<n>_Se','t stack checking size to <n>'#010+
+  '**2Ct_Stack checking (for testing only, see manual)'#010+
   'p*2CT<x>_Target-specific code generation options'#010+
   'P*2CT<x>_Target-specific code generation options'#010+
   'J*2CT<x>_Target-specific code generation options'#010+
-  'A*2CT<x>_Target-specific code generation options'#010+
-  'p*3CTsmalltoc_ Generate sma','ller TOCs at the expense of execution spe'+
-  'ed (AIX)'#010+
+  'A*2CT<x>_Tar','get-specific code generation options'#010+
+  'p*3CTsmalltoc_ Generate smaller TOCs at the expense of execution speed'+
+  ' (AIX)'#010+
   'P*3CTsmalltoc_ Generate smaller TOCs at the expense of execution speed'+
   ' (AIX)'#010+
-  'J*3CTcompactintarrayinit_ Generate smaller (but potentially slower) co'+
-  'de for initializing integer array constants',#010+
+  'J*3CTcompactintarrayinit_ Generate smaller (but p','otentially slower) '+
+  'code for initializing integer array constants'#010+
   'J*3CTenumfieldinit_ Initialize enumeration fields in constructors to e'+
   'numtype(0), after calling inherited constructors'#010+
-  'J*3CTautogetterprefix=X_ Automatically create getters for properties w'+
-  'ith prefix X (empty string disables)'#010+
-  'J*3CTautosett','erprefix=X_ Automatically create setters for properties'+
+  'J*3CTautogetterprefix=X_ Automatically create getters fo','r properties'+
   ' with prefix X (empty string disables)'#010+
+  'J*3CTautosetterprefix=X_ Automatically create setters for properties w'+
+  'ith prefix X (empty string disables)'#010+
   'A*3CTthumbinterworking_ Generate Thumb interworking-safe code if possi'+
   'ble'#010+
-  'J*2Cv_Var/out parameter copy-out checking'#010+
-  '**2CX_Create also smartlinked ','library'#010+
+  'J*2Cv_Va','r/out parameter copy-out checking'#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+
   '**2Dv<x>_Set DLL version to <x>'#010+
   '*O2Dw_PM application'#010+
-  '**1e<x>_Set path to executable'#010+
+  '**1e<x>_Set path to executa','ble'#010+
   '**1E_Same as -Cn'#010+
   '**1fPIC_Same as -Cg'#010+
-  '**1F<x>_Set file names ','and paths:'#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+
   '**2Fc<x>_Set input codepage to <x>'#010+
   '**2FC<x>_Set RC compiler binary name to <x>'#010+
-  '**2Fd_Disable the compiler'#039's internal directory cache'#010+
-  '**2FD<x>_Set the direc','tory where to search for compiler utilities'#010+
+  '**2Fd_Disabl','e 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+
   '**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+
+  '**2F','i<x>_Add <x> to include path'#010+
   '**2Fl<x>_Add <x> to library path'#010+
-  '**','2FL<x>_Use <x> as dynamic linker'#010+
+  '**2FL<x>_Use <x> as dynamic linker'#010+
   '**2Fm<x>_Load unicode conversion table from <x>.txt in the compiler di'+
   'r'#010+
   '**2Fo<x>_Add <x> to object path'#010+
   '**2Fr<x>_Load error message file <x>'#010+
-  '**2FR<x>_Set resource (.res) linker to <x>'#010+
-  '**2Fu<x>_Add <x> to uni','t path'#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>_Load previously stored whole-program optimization feedback fr'+
-  'om <x>'#010+
-  '*g1g_Generate debug information (def','ault format for target)'#010+
+  '**2Fw<x>_Load previously stored whole-program opt','imization feedback '+
+  'from <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+
-  '*g2gl_Use line info unit (show more info with backtraces)'#010+
+  '*g2gl_Use line info unit (show more info with backtra','ces)'#010+
   '*g2go<x>_Set debug information options'#010+
-  '*g3godwarfsets_ Enab','le DWARF '#039'set'#039' type debug information (b'+
-  'reaks gdb < 6.5)'#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+
-  '*g3godwarfmethodclassprefix_ Prefix method names in DWARF with class n'+
-  'ame'#010+
-  '*g2gp_Preserve case in stabs symbol na','mes'#010+
+  '*g3godwarfmethodclassprefix_ Prefix method names',' in DWARF with class'+
+  ' name'#010+
+  '*g2gp_Preserve case in stabs symbol names'#010+
   '*g2gs_Generate Stabs debug information'#010+
   '*g2gt_Trash local variables (to detect uninitialized uses)'#010+
   '*g2gv_Generates programs traceable with Valgrind'#010+
-  '*g2gw_Generate DWARFv2 debug information (same as -gw2)'#010+
-  '*g2gw2_Generate DWARFv2 debug inf','ormation'#010+
+  '*g2gw_Generate DWARFv2 de','bug information (same as -gw2)'#010+
+  '*g2gw2_Generate DWARFv2 debug information'#010+
   '*g2gw3_Generate DWARFv3 debug information'#010+
   '*g2gw4_Generate DWARFv4 debug information (experimental)'#010+
   '**1i_Information'#010+
   '**2iD_Return compiler date'#010+
-  '**2iV_Return short compiler version'#010+
+  '**2iV_Return short compi','ler version'#010+
   '**2iW_Return full compiler version'#010+
-  '**2iSO_Return com','piler OS'#010+
+  '**2iSO_Return compiler OS'#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+
   '**1k<x>_Pass <x> to the linker'#010+
-  '**1l_Write logo'#010+
+  '**1l_Write ','logo'#010+
   '**1M<x>_Set language mode to <x>'#010+
-  '**2Mfpc_Free Pascal dialec','t (default)'#010+
+  '**2Mfpc_Free Pascal dialect (default)'#010+
   '**2Mobjfpc_FPC mode with Object Pascal support'#010+
   '**2Mdelphi_Delphi 7 compatibility mode'#010+
   '**2Mtp_TP/BP 7.0 compatibility mode'#010+
-  '**2Mmacpas_Macintosh Pascal dialects compatibility mode'#010+
+  '**2Mmacpas_Macintosh Pascal dialects compa','tibility mode'#010+
   '**1n_Do not read the default config files'#010+
-  '**1o<x>_','Change the name of the executable produced to <x>'#010+
+  '**1o<x>_Change the name of the executable produced to <x>'#010+
   '**1O<x>_Optimizations:'#010+
   '**2O-_Disable optimizations'#010+
   '**2O1_Level 1 optimizations (quick and debugger friendly)'#010+
-  '**2O2_Level 2 optimizations (-O1 + quick optimizations)'#010+
-  '**2O3_Level 3 optimizatio','ns (-O2 + slow optimizations)'#010+
+  '**2O2_Level 2 opt','imizations (-O1 + quick optimizations)'#010+
+  '**2O3_Level 3 optimizations (-O2 + slow optimizations)'#010+
   '**2O4_Level 4 optimizations (-O3 + optimizations which might have unex'+
   'pected side effects)'#010+
   '**2Oa<x>=<y>_Set alignment'#010+
-  '**2Oo[NO]<x>_Enable or disable optimizations, see fpc -i for possible '+
-  'values'#010+
-  '**2Op<x>_Set ta','rget cpu for optimizing, see fpc -i for possible valu'+
-  'es'#010+
+  '**2Oo[NO]<x>_Enable or disab','le optimizations, see fpc -i for possibl'+
+  'e values'#010+
+  '**2Op<x>_Set target cpu for optimizing, see fpc -i for possible values'+
+  #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 valu','es'#010+
+  '**2Ow<x>_Perf','orm whole-program optimization <x>, see fpc -i for poss'+
+  'ible values'#010+
   '**2Os_Optimize for size rather than speed'#010+
   '**1pg_Generate profile code for gprof (defines FPC_PROFILE)'#010+
   'F*1P<x>_Target CPU / compiler related options:'#010+
-  'F*2PB_Show default compiler binary'#010+
+  'F*2PB_Show default compi','ler binary'#010+
   'F*2PP_Show default target cpu'#010+
-  'F*2P<x>_Set target CPU ','(arm,i386,m68k,mips,mipsel,powerpc,powerpc64,'+
-  'sparc,x86_64'#010+
+  'F*2P<x>_Set target CPU (arm,i386,m68k,mips,mipsel,powerpc,powerpc64,sp'+
+  'arc,x86_64'#010+
   '**1R<x>_Assembler reading style:'#010+
   '**2Rdefault_Use default assembler for target'#010+
   '3*2Ratt_Read AT&T style assembler'#010+
-  '3*2Rintel_Read Intel style assembler'#010+
-  '6*2RMOT_Read motorola style assem','bler'#010+
+  '3*2Rin','tel_Read Intel style assembler'#010+
+  '6*2RMOT_Read motorola style assembler'#010+
   '**1S<x>_Syntax options:'#010+
   '**2S2_Same as -Mobjfpc'#010+
   '**2Sc_Support operators like C (*=,+=,/= and -=)'#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 af','ter the <n> errors (default is 1)'#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*_w : Compiler also halts after warnings'#010+
   '**3*_n : Compiler also halts after notes'#010+
   '**3*_h : Compiler also halts after hints'#010+
-  '**2Sg_Enable LABEL and GOTO (default in -Mtp and -Mdelphi)'#010+
-  '**2Sh_Use reference c','ounted strings (ansistring by default) instead '+
-  'of shortstrings'#010+
+  '**2Sg_Enable LAB','EL and GOTO (default in -Mtp and -Mdelphi)'#010+
+  '**2Sh_Use reference counted strings (ansistring by default) instead of'+
+  ' shortstrings'#010+
   '**2Si_Turn on inlining of procedures/functions declared as "inline"'#010+
   '**2Sk_Load fpcylix unit'#010+
-  '**2SI<x>_Set interface style to <x>'#010+
+  '**2SI<x>_Set interfac','e style to <x>'#010+
   '**3SIcom_COM compatible interface (default)'#010+
-  '**3SI','corba_CORBA compatible interface'#010+
+  '**3SIcorba_CORBA compatible interface'#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+
-  '**2Sy_@<pointer> returns',' a typed pointer, same as $T+'#010+
+  '**2Sx_Enable exception ke','ywords (default in Delphi/ObjFPC modes)'#010+
+  '**2Sy_@<pointer> returns a typed pointer, same as $T+'#010+
   '**1s_Do not call assembler and linker'#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+
+  '**2sr_Skip register allocation',' phase (use with -alr)'#010+
   '**1T<x>_Target operating system:'#010+
-  '3*2Tdarw','in_Darwin/Mac OS X'#010+
+  '3*2Tdarwin_Darwin/Mac OS X'#010+
   '3*2Temx_OS/2 via EMX (including EMX/RSX extender)'#010+
   '3*2Tfreebsd_FreeBSD'#010+
   '3*2Tgo32v2_Version 2 of DJ Delorie DOS extender'#010+
-  '3*2Tiphonesim_ iPhoneSimulator from iOS SDK 3.2+ (older versions: -Tda'+
-  'rwin)'#010+
+  '3*2Tiphonesim_ iPhoneSimulator from iOS',' SDK 3.2+ (older versions: -T'+
+  'darwin)'#010+
   '3*2Tlinux_Linux'#010+
-  '3*2Tnativen','t_Native NT API (experimental)'#010+
+  '3*2Tnativent_Native NT API (experimental)'#010+
   '3*2Tnetbsd_NetBSD'#010+
   '3*2Tnetware_Novell Netware Module (clib)'#010+
   '3*2Tnetwlibc_Novell Netware Module (libc)'#010+
   '3*2Topenbsd_OpenBSD'#010+
-  '3*2Tos2_OS/2 / eComStation'#010+
+  '3*2Tos2_OS/2 / eComStati','on'#010+
   '3*2Tsunos_SunOS/Solaris'#010+
   '3*2Tsymbian_Symbian OS'#010+
-  '3*2Tsolaris_So','laris'#010+
+  '3*2Tsolaris_Solaris'#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*2Tdarwin_Darwin/Mac OS X'#010+
   '4*2Tlinux_Linux'#010+
-  '4*2Twin64_Win64 (64 bit Windows systems)'#010+
+  '4*2Twin64_','Win64 (64 bit Windows systems)'#010+
   '6*2Tamiga_Commodore Amiga'#010+
-  '6*2Tata','ri_Atari ST/STe/TT'#010+
+  '6*2Tatari_Atari ST/STe/TT'#010+
   '6*2Tlinux_Linux'#010+
   '6*2Tpalmos_PalmOS'#010+
   'A*2Tdarwin_Darwin/iPhoneOS/iOS'#010+
@@ -1465,120 +1470,121 @@ const msgtxt : array[0..000287,1..240] of char=(
   'A*2Twince_Windows CE'#010+
   'P*2Tamiga_AmigaOS'#010+
   'P*2Tdarwin_Darwin/Mac OS X'#010+
-  'P*2Tlinux_Linux'#010+
+  'P*2Tlinux_','Linux'#010+
   'P*2Tmacos_Mac OS (classic)'#010+
   'P*2Tmorphos_MorphOS'#010+
-  'S*2Tsolaris','_Solaris'#010+
+  'S*2Tsolaris_Solaris'#010+
   'S*2Tlinux_Linux'#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 release unit files (nev','er 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*_n : Show notes                  t : Show tried/us','ed files'#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*_i : Show general info           d : Show debug info'#010+
-  '**2*_l : Show linenumbers            r : Rhide/GCC compatibility mode'#010+
-  '**2*_s : Show time stamps            q : Show',' message numbers'#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 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 debugging info'#010+
+  '**2*_    with ful','l path              v : Write fpcdebug.txt with'#010+
+  '**2*_                                    lots of debugging info'#010+
   '**2*_m<x>,<y> : Don'#039't show messages numbered <x> and <y>'#010+
   'F*1V<x>_Append '#039'-<x>'#039' to the used compiler binary name (e.g. f'+
-  'or version)'#010+
+  'or versio','n)'#010+
   '**1W<x>_Target-specific options (targets)'#010+
-  '3*2WA_Specify nativ','e type application (Windows)'#010+
+  '3*2WA_Specify native type application (Windows)'#010+
   '4*2WA_Specify native type application (Windows)'#010+
   'A*2WA_Specify native type application (Windows)'#010+
-  '3*2Wb_Create 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_Creat','e a bundle instead of a library (Darwin)'#010+
+  'p*2Wb_Create a bundle instead of a library (Darwin)'#010+
   'A*2Wb_Create a bundle instead of a library (Darwin)'#010+
   '4*2Wb_Create a bundle instead of a library (Darwin)'#010+
-  '3*2WB_Create a relocatable image (Windows, Symbian)'#010+
-  '3*2WBxxxx_Set image base to xxxx (Windows, ','Symbian)'#010+
+  '3*2WB_Create a relocatable imag','e (Windows, Symbian)'#010+
+  '3*2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+
   '4*2WB_Create a relocatable image (Windows)'#010+
   '4*2WBxxxx_Set image base to xxxx (Windows)'#010+
   'A*2WB_Create a relocatable image (Windows, Symbian)'#010+
-  'A*2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+
-  '3*2WC_Specify console type application (E','MX, OS/2, Windows)'#010+
+  'A*2WBxxxx_Set image base to x','xxx (Windows, Symbian)'#010+
+  '3*2WC_Specify console type application (EMX, OS/2, Windows)'#010+
   '4*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+
-  '3*2WD_Use DEFFILE to export functions of DLL or EXE (Win','dows)'#010+
+  'P*2WC_Specify console type application (Classic ','Mac OS)'#010+
+  '3*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
   '4*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+
-  'A*2We_Use external resources (Darw','in)'#010+
+  '4*2We_Us','e external resources (Darwin)'#010+
+  'A*2We_Use external resources (Darwin)'#010+
   'P*2We_Use external resources (Darwin)'#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+
-  '4*2WG_Specify graphic type application (EMX, ','OS/2, Windows)'#010+
+  '3*2WG_Specify graphic type application (E','MX, OS/2, Windows)'#010+
+  '4*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 internal resources (Darwin)'#010+
-  '4*2Wi_Use internal resources (Darwin)'#010+
+  '4*2Wi_Use internal',' resources (Darwin)'#010+
   'A*2Wi_Use internal resources (Darwin)'#010+
-  'P*2Wi_','Use internal resources (Darwin)'#010+
+  'P*2Wi_Use internal resources (Darwin)'#010+
   'p*2Wi_Use internal resources (Darwin)'#010+
   '3*2WI_Turn on/off the usage of import sections (Windows)'#010+
-  '4*2WI_Turn on/off the usage of import sections (Windows)'#010+
-  'A*2WI_Turn on/off the usage of import sections (Windows)',#010+
+  '4*2WI_Turn on/off the usage of import sections (W','indows)'#010+
+  'A*2WI_Turn on/off the usage of import sections (Windows)'#010+
   '8*2Wm<x>_Set memory model'#010+
   '8*3WmTiny_Tiny memory model'#010+
   '8*3WmSmall_Small memory model (default)'#010+
   '3*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
   'n)'#010+
-  '4*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
-  'n)',#010+
+  '4*2WM<x>','_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Dar'+
+  'win)'#010+
   'p*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
   'n)'#010+
   'P*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
   'n)'#010+
-  '3*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
-  '4*2WN_Do not generate r','elocation code, needed for debugging (Windows'+
+  '3*2WN_Do not generate relocat','ion code, needed for debugging (Windows'+
   ')'#010+
+  '4*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
   'A*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
-  'A*2Wpxxxx_Specify the controller type, see fpc -i for possible values'#010+
-  'V*2Wpxxxx_Specify the controller type, see fpc -i for',' possible value'+
+  'A*2Wpxxxx_Specify the controller type, see fpc -i for possi','ble value'+
   's'#010+
+  'V*2Wpxxxx_Specify the controller type, see fpc -i for possible values'#010+
   '3*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ... (iphonesim)'#010+
   'A*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ... (Darwin)'#010+
-  '3*2WR_Generate relocation code (Windows)'#010+
+  '3*2WR_Generate relocatio','n code (Windows)'#010+
   '4*2WR_Generate relocation code (Windows)'#010+
-  'A*2WR_','Generate relocation code (Windows)'#010+
+  'A*2WR_Generate relocation code (Windows)'#010+
   'P*2WT_Specify MPW tool type application (Classic Mac OS)'#010+
   '**2WX_Enable executable stack (Linux)'#010+
   '**1X_Executable options:'#010+
-  '**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Lin'+
-  'ux)'#010+
-  '**2Xd_Do no','t search default library path (sometimes required for cro'+
-  'ss-compiling when not using -XR)'#010+
+  '**2Xc_Pass --shared/-','dynamic to the linker (BeOS, Darwin, FreeBSD, L'+
+  'inux)'#010+
+  '**2Xd_Do not search default library path (sometimes required for cross'+
+  '-compiling when not using -XR)'#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+
+  '**2Xg_Create debuginfo in a separate file and add a debuglin','k sectio'+
+  'n to executable'#010+
+  '**2XD_Try to link units dynamically      (defines FPC_LINK_DYNAMIC)'#010+
   '**2Xi_Use internal linker'#010+
   '**2Xm_Generate link map'#010+
   '**2XM<x>_Set the name of the '#039'main'#039' program routine (default i'+
   's '#039'main'#039')'#010+
-  'F*2Xp<x>_First search for the compiler binary in the directory <x>'#010+
-  '**2XP<x>_Prepend the bi','nutils names with the prefix <x>'#010+
+  'F*2Xp<x>_First search for ','the compiler binary in the directory <x>'#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, FreeBSD'+
-  ', Linux, Mac',' OS, Solaris)'#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+
   '**2XS_Try to link units statically (default, defines FPC_LINK_STATIC)'#010+
-  '**2Xt_Link with static libraries (-static is passed to linker)'#010+
-  '**2XX_Try to smartlink units             (defines FPC','_LINK_SMART)'#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'
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index 91310ca..0d8f228 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -965,7 +965,7 @@ implementation
             symtablestack.top.insert(aprocsym);
           end;
 
-        if procparsemode=ppm_anonymous_routine then
+        if procparsemode in [ppm_anonymous_routine,ppm_method_reference] then
           begin
             pd:=tprocdef.create(normal_function_level);
             include(pd.procoptions,po_anonymous);
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index c05c103..2149c4f 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -2403,6 +2403,32 @@ implementation
              result:=false;
            end;
 
+         function is_captured(sym: tsym):boolean;
+           var
+             st : TSymtable;
+             found : boolean;
+             proccnt : integer;
+             checkstack : psymtablestackitem = nil;
+           begin
+             if not assigned(current_procinfo) or
+                not (sym.typ in [localvarsym,paravarsym]) then
+               exit(false);
+             checkstack:=symtablestack.stack;
+             result:=true;
+             found:=false;
+             proccnt:=0; { TODO: find less tricky way }
+             while not found and assigned(checkstack) do
+               begin
+                 st:=checkstack^.symtable;
+                 if st.symtablelevel=normal_function_level then
+                   inc(proccnt);
+                 if sym.owner=st then
+                   found:=true;
+                 checkstack:=checkstack^.next;
+               end;
+             result:=(proccnt>2); // each procedure have 2 symtables
+           end;
+
          var
            srsym : tsym;
            srsymtable : TSymtable;
@@ -2581,8 +2607,17 @@ implementation
                           p1:=csubscriptnode.create(srsym,p1);
                       end
                     else
-                      { regular non-field load }
-                      p1:=cloadnode.create(srsym,srsymtable);
+                      begin
+                        { regular non-field load }
+                        if not is_captured(srsym) then
+                          p1:=cloadnode.create(srsym,srsymtable)
+                        else
+                          begin
+                            { Capture of local variables is forbidden. Will be supported with closures. }
+                            message1(parser_e_proc_capture_not_allowed,srsym.realname);
+                            p1:=cerrornode.create;
+                          end;
+                      end;
                   end;
 
                 syssym :
-- 
1.8.1.2


From d2191f274443853b20ceabc98a187b5c84de2a74 Mon Sep 17 00:00:00 2001
From: Vasiliy Kevroletin <kevroletin@gmail.com>
Date: Mon, 3 Jun 2013 00:09:59 +1100
Subject: [PATCH 3/4] Add modeswitch m_anonymous_proc.

Restrict usage of anonymous functions by new modeswitch. Currently disabled for all modes.
---
 compiler/globtype.pas |  6 ++++--
 compiler/pexpr.pas    | 19 ++++++++++---------
 compiler/ptype.pas    |  2 +-
 3 files changed, 15 insertions(+), 12 deletions(-)

diff --git a/compiler/globtype.pas b/compiler/globtype.pas
index 570bb89..289cabe 100644
--- a/compiler/globtype.pas
+++ b/compiler/globtype.pas
@@ -372,8 +372,9 @@ interface
          m_final_fields,        { allows declaring fields as "final", which means they must be initialised
                                   in the (class) constructor and are constant from then on (same as final
                                   fields in Java) }
-         m_default_unicodestring { makes the default string type in $h+ mode unicodestring rather than
+         m_default_unicodestring,{ makes the default string type in $h+ mode unicodestring rather than
                                    ansistring; similarly, char becomes unicodechar rather than ansichar }
+         m_anonymous_procedure  { support anonymous functions }
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -536,7 +537,8 @@ interface
          'ISOUNARYMINUS',
          'SYSTEMCODEPAGE',
          'FINALFIELDS',
-         'UNICODESTRINGS');
+         'UNICODESTRINGS',
+         'ANONYMOUSPROC');
 
 
      type
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 2149c4f..6d49f0d 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -2410,7 +2410,8 @@ implementation
              proccnt : integer;
              checkstack : psymtablestackitem = nil;
            begin
-             if not assigned(current_procinfo) or
+             if not (m_anonymous_procedure in current_settings.modeswitches) or
+                not assigned(current_procinfo) or
                 not (sym.typ in [localvarsym,paravarsym]) then
                exit(false);
              checkstack:=symtablestack.stack;
@@ -3348,14 +3349,14 @@ implementation
                consume(_RKLAMMER);
                p1:=cinlinenode.create(in_objc_protocol_x,false,p1);
              end;
-
-             // anonymous routine
-             _PROCEDURE, _FUNCTION:
-               if assigned(current_procinfo) then
-                 p1:=parse_anonymous_routine(current_procinfo.procdef)
-               else // TODO: support this later? Delphi doesn't
-                 internalerror(20120121);
-
+           else
+             if (token in [_PROCEDURE, _FUNCTION]) and
+                (m_anonymous_procedure in current_settings.modeswitches) then
+                begin
+                  if not assigned(current_procinfo) then
+                    internalerror(20120121);
+                  p1:=parse_anonymous_routine(current_procinfo.procdef);
+                end
              else
                begin
                  Message(parser_e_illegal_expression);
diff --git a/compiler/ptype.pas b/compiler/ptype.pas
index 70ee34b..3063173 100644
--- a/compiler/ptype.pas
+++ b/compiler/ptype.pas
@@ -1685,7 +1685,7 @@ implementation
              else
                expr_type;
            _ID:
-             if idtoken=_REFERENCE then
+             if (idtoken=_REFERENCE) and (m_anonymous_procedure in current_settings.modeswitches) then
                begin
                  consume(_REFERENCE); consume(_TO);
                  def:=procvar_dec(genericdef,genericlist);
-- 
1.8.1.2


From 3439479a530c756d46112a0dbca01f1616e464bc Mon Sep 17 00:00:00 2001
From: Vasiliy Kevroletin <kevroletin@gmail.com>
Date: Fri, 31 May 2013 02:24:17 +1100
Subject: [PATCH 4/4] Add tests for anonymous functions.

Tests cover
+ basic usage of anonymous function
+ access of free variables *which is currently fail*(variables which are used in body but not parameters and not declared inside this function).
+ use of modeswitch
+ initialization of procvar in "var" section
+ test for ppu loading (anonymous function declared inside inline function)
---
 tests/test/tanonymproc1.pp   | 46 +++++++++++++++++++++++++++++
 tests/test/tanonymproc10.pp  | 30 +++++++++++++++++++
 tests/test/tanonymproc11.pp  | 22 ++++++++++++++
 tests/test/tanonymproc12.pp  | 22 ++++++++++++++
 tests/test/tanonymproc2.pp   | 70 ++++++++++++++++++++++++++++++++++++++++++++
 tests/test/tanonymproc3.pp   | 49 +++++++++++++++++++++++++++++++
 tests/test/tanonymproc4.pp   | 49 +++++++++++++++++++++++++++++++
 tests/test/tanonymproc5.pp   | 51 ++++++++++++++++++++++++++++++++
 tests/test/tanonymproc6.pp   | 31 ++++++++++++++++++++
 tests/test/tanonymproc7.pp   | 25 ++++++++++++++++
 tests/test/tanonymproc8.pp   | 19 ++++++++++++
 tests/test/tanonymproc9.pp   | 21 +++++++++++++
 tests/test/tfanonymproc1.pp  | 14 +++++++++
 tests/test/tfanonymproc10.pp |  9 ++++++
 tests/test/tfanonymproc11.pp | 19 ++++++++++++
 tests/test/tfanonymproc2.pp  | 14 +++++++++
 tests/test/tfanonymproc3.pp  | 14 +++++++++
 tests/test/tfanonymproc4.pp  | 15 ++++++++++
 tests/test/tfanonymproc5.pp  | 15 ++++++++++
 tests/test/tfanonymproc6.pp  | 13 ++++++++
 tests/test/tfanonymproc7.pp  | 12 ++++++++
 tests/test/tfanonymproc8.pp  | 25 ++++++++++++++++
 tests/test/tfanonymproc9.pp  | 25 ++++++++++++++++
 tests/test/uanonymproc1.pp   | 26 ++++++++++++++++
 24 files changed, 636 insertions(+)
 create mode 100644 tests/test/tanonymproc1.pp
 create mode 100644 tests/test/tanonymproc10.pp
 create mode 100644 tests/test/tanonymproc11.pp
 create mode 100644 tests/test/tanonymproc12.pp
 create mode 100644 tests/test/tanonymproc2.pp
 create mode 100644 tests/test/tanonymproc3.pp
 create mode 100644 tests/test/tanonymproc4.pp
 create mode 100644 tests/test/tanonymproc5.pp
 create mode 100644 tests/test/tanonymproc6.pp
 create mode 100644 tests/test/tanonymproc7.pp
 create mode 100644 tests/test/tanonymproc8.pp
 create mode 100644 tests/test/tanonymproc9.pp
 create mode 100644 tests/test/tfanonymproc1.pp
 create mode 100644 tests/test/tfanonymproc10.pp
 create mode 100644 tests/test/tfanonymproc11.pp
 create mode 100644 tests/test/tfanonymproc2.pp
 create mode 100644 tests/test/tfanonymproc3.pp
 create mode 100644 tests/test/tfanonymproc4.pp
 create mode 100644 tests/test/tfanonymproc5.pp
 create mode 100644 tests/test/tfanonymproc6.pp
 create mode 100644 tests/test/tfanonymproc7.pp
 create mode 100644 tests/test/tfanonymproc8.pp
 create mode 100644 tests/test/tfanonymproc9.pp
 create mode 100644 tests/test/uanonymproc1.pp

diff --git a/tests/test/tanonymproc1.pp b/tests/test/tanonymproc1.pp
new file mode 100644
index 0000000..d6b55e6
--- /dev/null
+++ b/tests/test/tanonymproc1.pp
@@ -0,0 +1,46 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ simple anonymous procedure without parameters }
+
+const
+  magic:integer = 1234567890;
+var
+  g_result:integer;
+
+procedure clean_res;
+  begin
+    g_result:=0;
+  end;
+
+procedure set_res;
+  begin
+    g_result:=magic;
+  end;
+
+procedure check_res(num:integer);
+  begin
+    if g_result<>num then Halt(1);
+  end;
+
+type
+  tproc=reference to procedure;
+  
+var
+  p:tproc;
+
+begin
+  clean_res;
+  p:=procedure
+       begin
+         set_res;
+       end;
+  check_res(0);
+  
+  clean_res;
+  p();
+  check_res(magic);
+  
+  clean_res;
+  p;
+  check_res(magic);
+end.
diff --git a/tests/test/tanonymproc10.pp b/tests/test/tanonymproc10.pp
new file mode 100644
index 0000000..5a6a394
--- /dev/null
+++ b/tests/test/tanonymproc10.pp
@@ -0,0 +1,30 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ initialization of procvar in declaration }
+
+uses uanonymproc1;
+
+var
+  ok:boolean=false;  
+  i:reference to procedure(i:boolean) = procedure(val:boolean)
+                                          begin
+                                            ok:=val;
+                                          end;
+
+procedure do_smth;
+  var
+    i:reference to procedure(i:boolean) = procedure(val:boolean)
+                                            begin
+                                              ok:=val;
+                                            end;
+  begin
+    i(true);
+    if not ok then halt(1);
+  end;
+  
+begin
+  i(true);
+  if not ok then halt(1);
+  do_smth;
+  do_smth_inline;
+end.
diff --git a/tests/test/tanonymproc11.pp b/tests/test/tanonymproc11.pp
new file mode 100644
index 0000000..e66e96d
--- /dev/null
+++ b/tests/test/tanonymproc11.pp
@@ -0,0 +1,22 @@
+{$mode delphi}
+{$modeswitch anonymousproc}
+
+const
+  magic:integer=314159265;
+
+type
+  myproc<T> = reference to procedure(num: T);
+
+var
+  p:myproc<Integer>;
+  res:integer;
+
+begin
+  p:=procedure(num: Integer)
+       begin
+         res:=num;
+       end;
+  res:=0;
+  p(magic);
+  if res<>magic then halt(1);
+end.
diff --git a/tests/test/tanonymproc12.pp b/tests/test/tanonymproc12.pp
new file mode 100644
index 0000000..3f2f97b
--- /dev/null
+++ b/tests/test/tanonymproc12.pp
@@ -0,0 +1,22 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+
+const
+  magic:integer=314159265;
+
+type
+  generic myproc<T> = reference to procedure(num: T);
+
+var
+  p:specialize myproc<Integer>;
+  res:integer;
+
+begin
+  p:=procedure(num: Integer)
+       begin
+         res:=num;
+       end;
+  res:=0;
+  p(magic);
+  if res<>magic then halt(1);
+end.
diff --git a/tests/test/tanonymproc2.pp b/tests/test/tanonymproc2.pp
new file mode 100644
index 0000000..998b77d
--- /dev/null
+++ b/tests/test/tanonymproc2.pp
@@ -0,0 +1,70 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ simple anonymous procedure without parameters in nested function }
+
+const
+  magic:integer = 1234567890;
+var
+  g_result:integer;
+
+procedure clean_res;
+  begin
+    g_result:=0;
+  end;
+
+procedure set_res;
+  begin
+    g_result:=magic;
+  end;
+
+procedure check_res(num:integer);
+  begin
+    if g_result<>num then halt(1);
+  end;
+
+type
+  tproc=reference to procedure;
+  
+procedure do_smth;  
+  procedure nested_do_smth;
+    var p:tproc;
+    begin
+      clean_res;
+      p:=procedure
+           begin
+             set_res;
+           end;
+      check_res(0);
+  
+      clean_res;
+      p();
+      check_res(magic);
+  
+      clean_res;
+      p;
+      check_res(magic);
+     end;
+  var
+    p: TProc;
+  begin
+    clean_res;
+    p:=procedure
+         begin
+           set_res;
+         end;
+    check_res(0);
+  
+    clean_res;
+    p();
+    check_res(magic);
+  
+    clean_res;
+    p;
+    check_res(magic);
+    
+    nested_do_smth;
+  end;
+
+begin
+  do_smth;
+end.
diff --git a/tests/test/tanonymproc3.pp b/tests/test/tanonymproc3.pp
new file mode 100644
index 0000000..f8290b5
--- /dev/null
+++ b/tests/test/tanonymproc3.pp
@@ -0,0 +1,49 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ pointer to anonymous procedure returned from function }
+
+const
+  magic:integer = 1234567890;
+var
+  g_result:integer;
+
+procedure clean_res;
+  begin
+    g_result:=0;
+  end;
+
+procedure set_res;
+  begin
+    g_result:=magic;
+  end;
+
+procedure check_res(num:integer);
+  begin
+    if g_result<>num then halt(1);
+  end;
+
+type
+  tproc=reference to procedure;
+  
+function factory:tproc;
+  begin
+    result:=procedure
+              begin
+                set_res;
+              end;
+  end;
+  
+procedure do_things;  
+  var
+    p: TProc;
+  begin
+    clean_res;
+    p:=factory;
+    check_res(0);
+    p();
+    check_res(magic);    
+  end;
+  
+begin
+  do_things;
+end.
diff --git a/tests/test/tanonymproc4.pp b/tests/test/tanonymproc4.pp
new file mode 100644
index 0000000..8167a08
--- /dev/null
+++ b/tests/test/tanonymproc4.pp
@@ -0,0 +1,49 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ anonymous procedure with parameters }
+
+const
+  magic:integer=1234567890;
+  magicstr:string='hello world';
+
+var
+  g_res_num:integer;
+  g_res_str:string;
+
+procedure clean_res;
+  begin
+    g_res_num:=0;
+    g_res_str:='';
+  end;
+
+procedure set_res;
+  begin
+    g_res_num:=magic;
+    g_res_str:=magicstr;
+  end;
+
+procedure check_res(num:integer;str:string);
+  begin
+    if g_res_num<>num then halt(1);
+    if g_res_str<>str then halt(1);
+  end;
+
+type
+  tproc=reference to procedure(num:integer;str:string);
+  
+var
+  p:tproc;
+
+begin
+  clean_res;
+  p:=procedure(num:integer;s:string)
+       begin
+         g_res_num:=num;
+         g_res_str:=s;
+       end;
+  check_res(0, '');
+  
+  clean_res;
+  p(magic, magicstr);
+  check_res(magic, magicstr); 
+end.
diff --git a/tests/test/tanonymproc5.pp b/tests/test/tanonymproc5.pp
new file mode 100644
index 0000000..6755c95
--- /dev/null
+++ b/tests/test/tanonymproc5.pp
@@ -0,0 +1,51 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ anonymous function }
+
+const
+  magic:integer=1234567890;
+  magicret:integer=987654321;
+var
+  g_result:integer;
+
+procedure clean_res;
+  begin
+    g_result:=0;
+  end;
+
+procedure set_res;
+  begin
+    g_result:=magic;
+  end;
+
+procedure check_res(num:Integer);
+  begin
+    if g_result<>num then halt(1);
+  end;
+
+type
+  tproc=reference to function:integer;
+  
+function factory:tproc;
+  begin
+    result:=function:Integer
+              begin
+                set_res;
+                result:=magicret;
+              end;
+  end;
+  
+procedure do_things;  
+  var
+    p: TProc;
+  begin
+    clean_res;
+    p:=factory;
+    check_res(0);
+    if p()<>magicret then halt(1);
+    check_res(magic);
+  end;
+  
+begin
+  do_things;
+end.
diff --git a/tests/test/tanonymproc6.pp b/tests/test/tanonymproc6.pp
new file mode 100644
index 0000000..8abc0b1
--- /dev/null
+++ b/tests/test/tanonymproc6.pp
@@ -0,0 +1,31 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ anonymous routine have inner function }
+
+const
+  magicstr:string='hello';
+  magicstrlen:integer=5;
+
+type
+  tproc=reference to procedure(num:integer;s:string);
+ 
+procedure do_things;  
+  var
+    p:tproc;
+  begin
+    p:=procedure(num:integer;s:string)
+         function inner(ss:string):integer;
+           begin
+             result:=length(ss);
+           end;
+         var b:Integer;
+         begin
+           b:=inner(s);
+           if b<>num then halt(1);
+         end;
+    p(magicstrlen,magicstr);
+  end;
+  
+begin
+  do_things;
+end.
diff --git a/tests/test/tanonymproc7.pp b/tests/test/tanonymproc7.pp
new file mode 100644
index 0000000..b741c77
--- /dev/null
+++ b/tests/test/tanonymproc7.pp
@@ -0,0 +1,25 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ closure as function argument }
+
+const
+  magic1:integer=123;
+  magic2:integer=321123;
+
+type
+  tfunct=reference to function(num:integer):integer;
+  
+function call(f:tfunct;arg:integer):integer;
+  begin
+   result:=f(arg);
+  end;
+
+var i:integer;
+begin
+  i:=call( function(num:integer):integer
+             begin
+               result:=num+magic2;
+             end,
+           magic1 );
+  if i<>(magic1+magic2) then halt(1);
+end.
diff --git a/tests/test/tanonymproc8.pp b/tests/test/tanonymproc8.pp
new file mode 100644
index 0000000..706403f
--- /dev/null
+++ b/tests/test/tanonymproc8.pp
@@ -0,0 +1,19 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ two anonymous function inside one routine }
+
+const
+  magic1:integer=777;
+  magic2:integer=888;
+
+type
+  tfunct=reference to function:integer;
+  
+var p1,p2:tfunct;
+begin
+  p1:=function: Integer begin result:=magic1; end;
+  p2:=function: Integer begin result:=magic2; end;
+
+  if p1()<>magic1 then halt(1);
+  if p2()<>magic2 then halt(2);
+end.
diff --git a/tests/test/tanonymproc9.pp b/tests/test/tanonymproc9.pp
new file mode 100644
index 0000000..36ed745
--- /dev/null
+++ b/tests/test/tanonymproc9.pp
@@ -0,0 +1,21 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ acces to global variable }
+
+const
+  magic:integer=1234567890;
+
+type
+  tproc=reference to procedure;
+  
+var p:tproc;
+    staticvar:integer;
+begin
+  staticvar:=0;
+  p:=procedure
+       begin
+         staticvar:=magic;
+       end;
+  p();
+  if staticvar<>magic then halt(1);
+end.
diff --git a/tests/test/tfanonymproc1.pp b/tests/test/tfanonymproc1.pp
new file mode 100644
index 0000000..457c7b2
--- /dev/null
+++ b/tests/test/tfanonymproc1.pp
@@ -0,0 +1,14 @@
+{ %fail }
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ incompatible proc and procvar }
+
+var
+  i:reference to procedure(i:integer);
+
+begin
+  i := procedure
+         begin
+         end;
+  i();
+end.
diff --git a/tests/test/tfanonymproc10.pp b/tests/test/tfanonymproc10.pp
new file mode 100644
index 0000000..4befb49
--- /dev/null
+++ b/tests/test/tfanonymproc10.pp
@@ -0,0 +1,9 @@
+{$mode objfpc}
+{ anonymous procedures doesnt work without modeswitch }
+
+var
+  p:reference to procedure;
+  
+begin
+  p:=procedure begin end;
+end.
diff --git a/tests/test/tfanonymproc11.pp b/tests/test/tfanonymproc11.pp
new file mode 100644
index 0000000..e05d468
--- /dev/null
+++ b/tests/test/tfanonymproc11.pp
@@ -0,0 +1,19 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ initialization of procvar in declaration }
+
+procedure do_smth;
+  var
+    ok:boolean;
+    i:reference to procedure(i:boolean) = procedure(val:boolean)
+                                            begin
+                                              ok:=val;
+                                            end;
+  begin
+    i(true);
+    if not ok then halt(1);
+  end;
+  
+begin
+  do_smth;
+end.
diff --git a/tests/test/tfanonymproc2.pp b/tests/test/tfanonymproc2.pp
new file mode 100644
index 0000000..8b71e5a
--- /dev/null
+++ b/tests/test/tfanonymproc2.pp
@@ -0,0 +1,14 @@
+{ %fail }
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ incompatible proc and procvar }
+
+var
+  i:reference to function:integer;
+
+begin
+  i := procedure
+         begin
+         end;
+  i();
+end.
diff --git a/tests/test/tfanonymproc3.pp b/tests/test/tfanonymproc3.pp
new file mode 100644
index 0000000..fde91e3
--- /dev/null
+++ b/tests/test/tfanonymproc3.pp
@@ -0,0 +1,14 @@
+{ %fail }
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ illegal assignment }
+
+var
+  p:reference to function:integer;
+  i:integer;
+
+begin
+  i := procedure
+         begin
+         end;
+end.
diff --git a/tests/test/tfanonymproc4.pp b/tests/test/tfanonymproc4.pp
new file mode 100644
index 0000000..22942a5
--- /dev/null
+++ b/tests/test/tfanonymproc4.pp
@@ -0,0 +1,15 @@
+{ %fail }
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ illegal arithmetics operation }
+
+type
+  TProc = reference to function: Integer;
+
+var
+  p: TProc;
+  i: Integer;
+
+begin
+  i := 10 + procedure begin end;
+end.
diff --git a/tests/test/tfanonymproc5.pp b/tests/test/tfanonymproc5.pp
new file mode 100644
index 0000000..c959d04
--- /dev/null
+++ b/tests/test/tfanonymproc5.pp
@@ -0,0 +1,15 @@
+{ %fail }    
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ call of anonymous function in place }
+
+var
+  i: Integer;
+begin
+
+  // now fpc parser eats first () and stops parsing of right side
+  // delphi parser eats this but fails during runtime
+  i := (function(num: Integer): Integer begin Result := num + 10; end)(5);
+
+  Writeln(i);
+end.
diff --git a/tests/test/tfanonymproc6.pp b/tests/test/tfanonymproc6.pp
new file mode 100644
index 0000000..1d7ae11
--- /dev/null
+++ b/tests/test/tfanonymproc6.pp
@@ -0,0 +1,13 @@
+{ %fail }
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ incompatible proc and and procvar }
+
+var
+  i: reference to procedure(i: Integer);
+
+begin
+  i := procedure
+         begin
+         end;
+end.
diff --git a/tests/test/tfanonymproc7.pp b/tests/test/tfanonymproc7.pp
new file mode 100644
index 0000000..19d4aa2
--- /dev/null
+++ b/tests/test/tfanonymproc7.pp
@@ -0,0 +1,12 @@
+{ %fail }
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ wrong parameter type }
+
+var
+  i: reference to procedure(i:integer);
+
+begin
+  i := procedure(i:integer) begin end;
+  i('hello world');
+end.
diff --git a/tests/test/tfanonymproc8.pp b/tests/test/tfanonymproc8.pp
new file mode 100644
index 0000000..f7ca501
--- /dev/null
+++ b/tests/test/tfanonymproc8.pp
@@ -0,0 +1,25 @@
+{ %fail }
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ closure is wrong function argument }
+
+const
+  magic1:integer=123;
+  magic2:integer=321123;
+
+type
+  tfunct=reference to function(num:integer):integer;
+  
+function call(f:tfunct;arg:integer):integer;
+  begin
+   result:=f(arg);
+  end;
+
+var i:integer;
+begin
+  i:=call( function(s:string):integer
+             begin
+             end,
+           magic1 );
+end.
+
diff --git a/tests/test/tfanonymproc9.pp b/tests/test/tfanonymproc9.pp
new file mode 100644
index 0000000..38780f0
--- /dev/null
+++ b/tests/test/tfanonymproc9.pp
@@ -0,0 +1,25 @@
+{ %fail }
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ acces to local variables of outer function }
+{ will be possible with closures }
+
+const
+  magic:integer=1234567890;
+
+type
+  tproc=reference to procedure;
+  
+procedure do_smth;
+var p:tproc;
+    localvar:integer;
+begin
+  p:=procedure
+       begin
+         localvar:=magic;
+       end;
+end;
+
+begin
+  do_smth
+end.
diff --git a/tests/test/uanonymproc1.pp b/tests/test/uanonymproc1.pp
new file mode 100644
index 0000000..2129851
--- /dev/null
+++ b/tests/test/uanonymproc1.pp
@@ -0,0 +1,26 @@
+unit uanonymproc1;
+{$mode objfpc}
+{$modeswitch anonymousproc}
+
+interface
+
+procedure do_smth_inline; inline;
+
+var
+  good:boolean=false;
+
+implementation
+
+procedure do_smth_inline; inline;
+  var
+    i:reference to procedure = procedure
+                                 begin
+                                   good:=true;
+                                 end;
+  begin
+    i();
+    if not good then halt(1);
+  end;
+
+begin
+end.
-- 
1.8.1.2

closures01.patch (133,611 bytes)

Vasiliy Kevroletin

2013-06-07 16:06

reporter  

anonymous01.patch (133,611 bytes)
From 643c63f21fd21d2d7f4dad4ec46a630d2116e4bd Mon Sep 17 00:00:00 2001
From: blaise <blaise@3ad0048d-3df7-0310-abae-a5850022a9f2>
Date: Sat, 21 Jan 2012 19:00:59 +0000
Subject: [PATCH 1/4] Parse anonymous functions.

Now it's possible to parse anonymous routine inside body of other routine.
Currently anonymous procedure have normal nesting level. So it can't access local variables of outer function. There is no check for this.
Currently "reference to procedure" is represented as procvar. That is why there is no typecheck during assignment of "pure" procedure to "reference to" procedures.

Delhi-like implementation of closure will have same syntax but will allow to capture variables.
---
 compiler/pclosure.pas              |  49 +++++++++++++++++
 compiler/pdecobj.pas               |  10 ++--
 compiler/pdecsub.pas               | 105 +++++++++++++++++++++++++------------
 compiler/pexpr.pas                 |   9 +++-
 compiler/psub.pas                  |  18 +++----
 compiler/ptype.pas                 |  51 ++++++++++--------
 compiler/symconst.pas              |   4 +-
 compiler/symcreat.pas              |   2 +-
 compiler/symdef.pas                |  15 ++++++
 compiler/tokens.pas                |   2 +
 compiler/utils/ppuutils/ppudump.pp |   3 +-
 11 files changed, 196 insertions(+), 72 deletions(-)
 create mode 100644 compiler/pclosure.pas

diff --git a/compiler/pclosure.pas b/compiler/pclosure.pas
new file mode 100644
index 0000000..f6894fd
--- /dev/null
+++ b/compiler/pclosure.pas
@@ -0,0 +1,49 @@
+unit pclosure;
+
+{$mode objfpc}
+
+interface
+
+uses node, symtype, symdef, symsym, globtype;
+
+function parse_anonymous_routine(pd: tprocdef): tnode;
+
+implementation
+
+uses nld,symconst,procinfo,pdecsub,psub,verbose,symbase,symtable,ncal,pass_1,nmem,nbas,fmodule,ncnv;
+
+function parse_anonymous_routine(pd: tprocdef): tnode;
+
+  procedure read_proc_body_(objdef:tobjectdef;anonymprocdef:tprocdef);
+  var old_current_structdef:tabstractrecorddef;
+      old_current_procinfo:tprocinfo;
+  begin
+    old_current_structdef:=current_structdef;
+    old_current_procinfo:=current_procinfo;
+    current_structdef:=objdef;
+    while current_procinfo.parent<>nil do
+      current_procinfo:=current_procinfo.parent;
+    read_proc(false,anonymprocdef,false);
+    proc_add_definition(anonymprocdef);
+    current_structdef:=old_current_structdef;
+    current_procinfo:=old_current_procinfo;
+    current_module.procinfo:=old_current_procinfo;
+  end;
+
+var anonymprocdef:tprocdef;
+    loadn,addrn:tnode;
+begin
+  symtablestack.push(current_module.localsymtable); // procdef will add itself in deflist during creation
+  anonymprocdef:=parse_proc_dec(nil,ppm_anonymous_routine);
+  symtablestack.pop(current_module.localsymtable);
+  handle_calling_convention(anonymprocdef);
+  read_proc_body_(nil,anonymprocdef);
+
+  loadn:=cloadnode.create(anonymprocdef.procsym,anonymprocdef.procsym.owner);
+  addrn:=caddrnode.create(loadn);
+  typecheckpass(addrn);
+  result:=addrn;
+end;
+
+begin
+end.
diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
index 61dcc0f..d6a22b9 100644
--- a/compiler/pdecobj.pas
+++ b/compiler/pdecobj.pas
@@ -104,7 +104,7 @@ implementation
         result:=nil;
         consume(_CONSTRUCTOR);
         { must be at same level as in implementation }
-        parse_proc_head(current_structdef,potype_class_constructor,pd);
+        parse_proc_head(current_structdef,potype_class_constructor,ppm_class_method,pd);
         if not assigned(pd) then
           begin
             consume(_SEMICOLON);
@@ -129,7 +129,7 @@ implementation
         result:=nil;
         consume(_CONSTRUCTOR);
         { must be at same level as in implementation }
-        parse_proc_head(current_structdef,potype_constructor,pd);
+        parse_proc_head(current_structdef,potype_constructor,ppm_normal,pd);
         if not assigned(pd) then
           begin
             consume(_SEMICOLON);
@@ -226,7 +226,7 @@ implementation
       begin
         result:=nil;
         consume(_DESTRUCTOR);
-        parse_proc_head(current_structdef,potype_class_destructor,pd);
+        parse_proc_head(current_structdef,potype_class_destructor,ppm_class_method,pd);
         if not assigned(pd) then
           begin
             consume(_SEMICOLON);
@@ -250,7 +250,7 @@ implementation
       begin
         result:=nil;
         consume(_DESTRUCTOR);
-        parse_proc_head(current_structdef,potype_destructor,pd);
+        parse_proc_head(current_structdef,potype_destructor,ppm_normal,pd);
         if not assigned(pd) then
           begin
             consume(_SEMICOLON);
@@ -874,7 +874,7 @@ implementation
 
               oldparse_only:=parse_only;
               parse_only:=true;
-              result:=parse_proc_dec(is_classdef,astruct);
+              result:=parse_proc_dec(astruct,as_procparsemode(is_classdef));
 
               { this is for error recovery as well as forward }
               { interface mappings, i.e. mapping to a method  }
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index c5c4cdf..91310ca 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -72,8 +72,12 @@ interface
     procedure parse_var_proc_directives(sym:tsym);
     procedure parse_object_proc_directives(pd:tabstractprocdef);
     procedure parse_record_proc_directives(pd:tabstractprocdef);
-    function  parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;out pd:tprocdef):boolean;
-    function  parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef):tprocdef;
+
+    type tprocparsemode = (ppm_normal, ppm_class_method, ppm_anonymous_routine, ppm_method_reference);
+    // TODO: operator :=/Explicit (const is_class_method: boolean) result: tprocparsemode;
+    function as_procparsemode(const is_class_method: boolean): tprocparsemode; inline;
+    function parse_proc_head(astruct: tabstractrecorddef; potype: tproctypeoption; const procparsemode: tprocparsemode; out pd: tprocdef): boolean;
+    function parse_proc_dec(astruct: tabstractrecorddef; const procparsemode: tprocparsemode = ppm_normal): tprocdef;
 
     { parse a record method declaration (not a (class) constructor/destructor) }
     function parse_record_method_dec(astruct: tabstractrecorddef; is_classdef: boolean): tprocdef;
@@ -540,7 +544,7 @@ implementation
       end;
 
 
-    function parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;out pd:tprocdef):boolean;
+    function parse_proc_head(astruct: tabstractrecorddef; potype: tproctypeoption; const procparsemode: tprocparsemode; out pd: tprocdef): boolean;
       var
         hs       : string;
         orgsp,sp : TIDString;
@@ -756,7 +760,20 @@ implementation
         pd:=nil;
         aprocsym:=nil;
 
-        consume_proc_name;
+        case procparsemode of
+          ppm_anonymous_routine:
+            begin
+              sp:='Anonymous_'+inttostr(procstartfilepos.line)+'_'+inttostr(procstartfilepos.column);
+              orgsp:=upcase(sp);
+            end;
+          ppm_method_reference:
+            begin
+              sp:='Apply';
+              orgsp:=upcase(sp);
+            end;
+          else
+            consume_proc_name;
+        end;
 
         { examine interface map: function/procedure iname.functionname=locfuncname }
         if assigned(astruct) and
@@ -809,7 +826,11 @@ implementation
 
         { method  ? }
         srsym:=nil;
-        if (consume_generic_type_parameter or not assigned(astruct)) and
+        if procparsemode=ppm_anonymous_routine then
+          // Do nothing. This check here:
+          //   a) skips below checks and searches, speeding things up;
+          //   b) makes sure we do not try to parse generic type parameters.
+        else if (consume_generic_type_parameter or not assigned(astruct)) and
            (symtablestack.top.symtablelevel=main_program_level) and
            try_to_consume(_POINT) then
          begin
@@ -944,17 +965,25 @@ implementation
             symtablestack.top.insert(aprocsym);
           end;
 
-        { to get the correct symtablelevel we must ignore ObjectSymtables }
-        st:=nil;
-        checkstack:=symtablestack.stack;
-        while assigned(checkstack) do
+        if procparsemode=ppm_anonymous_routine then
+          begin
+            pd:=tprocdef.create(normal_function_level);
+            include(pd.procoptions,po_anonymous);
+          end
+        else 
           begin
-            st:=checkstack^.symtable;
-            if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then
-              break;
-            checkstack:=checkstack^.next;
+            { to get the correct symtablelevel we must ignore ObjectSymtables }
+            st:=nil;
+            checkstack:=symtablestack.stack;
+            while assigned(checkstack) do
+              begin
+                st:=checkstack^.symtable;
+                if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then
+                  break;
+                checkstack:=checkstack^.next;
+              end;
+            pd:=tprocdef.create(st.symtablelevel+1);
           end;
-        pd:=tprocdef.create(st.symtablelevel+1);
         pd.struct:=astruct;
         pd.procsym:=aprocsym;
         pd.proctypeoption:=potype;
@@ -1042,7 +1071,16 @@ implementation
       end;
 
 
-    function parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef):tprocdef;
+    function as_procparsemode(const is_class_method: boolean): tprocparsemode; inline;
+      begin
+        if is_class_method then
+          result := ppm_class_method
+        else
+          result := ppm_normal
+      end;
+
+
+    function parse_proc_dec(astruct: tabstractrecorddef; const procparsemode: tprocparsemode = ppm_normal): tprocdef;
       var
         pd: tprocdef;
         locationstr: string;
@@ -1100,7 +1138,7 @@ implementation
           _FUNCTION :
             begin
               consume(_FUNCTION);
-              if parse_proc_head(astruct,potype_function,pd) then
+              if parse_proc_head(astruct,potype_function,procparsemode,pd) then
                 begin
                   { pd=nil when it is a interface mapping }
                   if assigned(pd) then
@@ -1144,8 +1182,8 @@ implementation
                             consume_all_until(_SEMICOLON);
                           end;
                        end;
-                      if isclassmethod then
-                       include(pd.procoptions,po_classmethod);
+                      if procparsemode=ppm_class_method then
+                        include(pd.procoptions,po_classmethod);
                     end;
                 end
               else
@@ -1159,13 +1197,13 @@ implementation
           _PROCEDURE :
             begin
               consume(_PROCEDURE);
-              if parse_proc_head(astruct,potype_procedure,pd) then
+              if parse_proc_head(astruct,potype_procedure,procparsemode,pd) then
                 begin
                   { pd=nil when it is an interface mapping }
                   if assigned(pd) then
                     begin
                       pd.returndef:=voidtype;
-                      if isclassmethod then
+                      if procparsemode=ppm_class_method then
                         include(pd.procoptions,po_classmethod);
                     end;
                 end;
@@ -1174,11 +1212,11 @@ implementation
           _CONSTRUCTOR :
             begin
               consume(_CONSTRUCTOR);
-              if isclassmethod then
-                parse_proc_head(astruct,potype_class_constructor,pd)
+              if procparsemode=ppm_class_method then
+                parse_proc_head(astruct,potype_class_constructor,procparsemode,pd)
               else
-                parse_proc_head(astruct,potype_constructor,pd);
-              if not isclassmethod and
+                parse_proc_head(astruct,potype_constructor,procparsemode,pd);
+              if (procparsemode<>ppm_class_method) and
                  assigned(pd) and
                  assigned(pd.struct) then
                 begin
@@ -1205,16 +1243,16 @@ implementation
           _DESTRUCTOR :
             begin
               consume(_DESTRUCTOR);
-              if isclassmethod then
-                parse_proc_head(astruct,potype_class_destructor,pd)
+              if procparsemode=ppm_class_method then
+                parse_proc_head(astruct,potype_class_destructor,procparsemode,pd)
               else
-                parse_proc_head(astruct,potype_destructor,pd);
+                parse_proc_head(astruct,potype_destructor,procparsemode,pd);
               if assigned(pd) then
                 pd.returndef:=voidtype;
             end;
         else
           if (token=_OPERATOR) or
-             (isclassmethod and (idtoken=_OPERATOR)) then
+             ((procparsemode=ppm_class_method) and (idtoken=_OPERATOR)) then
             begin
               { we need to set the block type to bt_body, so that operator names
                 like ">", "=>" or "<>" are parsed correctly instead of e.g.
@@ -1222,7 +1260,7 @@ implementation
               old_block_type:=block_type;
               block_type:=bt_body;
               consume(_OPERATOR);
-              parse_proc_head(astruct,potype_operator,pd);
+              parse_proc_head(astruct,potype_operator,procparsemode,pd);
               block_type:=old_block_type;
               if assigned(pd) then
                 begin
@@ -1232,7 +1270,7 @@ implementation
                   pd.procsym.owner.includeoption(sto_has_operator);
                   if pd.parast.symtablelevel>normal_function_level then
                     Message(parser_e_no_local_operator);
-                  if isclassmethod then
+                  if procparsemode=ppm_class_method then
                     include(pd.procoptions,po_classmethod);
                   if token<>_ID then
                     begin
@@ -1304,7 +1342,8 @@ implementation
                 message(parser_e_field_not_allowed_here);
                 consume_all_until(_SEMICOLON);
               end;
-            consume(_SEMICOLON);
+            if not (procparsemode in [ppm_anonymous_routine,ppm_method_reference]) then
+              consume(_SEMICOLON);
           end;
         result:=pd;
 
@@ -1323,7 +1362,7 @@ implementation
       begin
         oldparse_only:=parse_only;
         parse_only:=true;
-        result:=parse_proc_dec(is_classdef,astruct);
+        result:=parse_proc_dec(astruct,as_procparsemode(is_classdef));
 
         { this is for error recovery as well as forward }
         { interface mappings, i.e. mapping to a method  }
@@ -3303,7 +3342,7 @@ const
             if (currpd.proctypeoption = potype_function) and
                is_void(currpd.returndef) then
               MessagePos1(currpd.fileinfo,parser_e_no_funcret_specified,currpd.procsym.realname);
-            tprocsym(currpd.procsym).ProcdefList.Add(currpd);
+            currpd.add_to_procsym;
           end;
 
         proc_add_definition:=forwardfound;
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 50808ab..c05c103 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -70,7 +70,7 @@ implementation
        nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
        { parser }
        scanner,
-       pbase,pinline,ptype,pgenutil,procinfo,cpuinfo
+       pbase,pinline,ptype,pgenutil,procinfo,cpuinfo,pclosure
        ;
 
     { sub_expr(opmultiply) is need to get -1 ** 4 to be
@@ -3314,6 +3314,13 @@ implementation
                p1:=cinlinenode.create(in_objc_protocol_x,false,p1);
              end;
 
+             // anonymous routine
+             _PROCEDURE, _FUNCTION:
+               if assigned(current_procinfo) then
+                 p1:=parse_anonymous_routine(current_procinfo.procdef)
+               else // TODO: support this later? Delphi doesn't
+                 internalerror(20120121);
+
              else
                begin
                  Message(parser_e_illegal_expression);
diff --git a/compiler/psub.pas b/compiler/psub.pas
index 64f4655..a63760b 100644
--- a/compiler/psub.pas
+++ b/compiler/psub.pas
@@ -77,7 +77,7 @@ interface
     { reads any routine in the implementation, or a non-method routine
       declaration in the interface (depending on whether or not parse_only is
       true) }
-    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef);
+    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef;eatsemicolon:boolean);
 
     procedure generate_specialization_procs;
 
@@ -1828,7 +1828,7 @@ implementation
 
 
 
-    procedure read_proc_body(old_current_procinfo:tprocinfo;pd:tprocdef);
+    procedure read_proc_body(old_current_procinfo:tprocinfo;pd:tprocdef;eatsemicolon:boolean=true);
       {
         Parses the procedure directives, then parses the procedure body, then
         generates the code for it
@@ -1912,7 +1912,7 @@ implementation
         { For specialization we didn't record the last semicolon. Moving this parsing
           into the parse_body routine is not done because of having better file position
           information available }
-        if not(df_specialization in current_procinfo.procdef.defoptions) then
+        if eatsemicolon and not(df_specialization in current_procinfo.procdef.defoptions) then
           consume(_SEMICOLON);
 
         if not isnestedproc then
@@ -1921,7 +1921,7 @@ implementation
       end;
 
 
-    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef);
+    procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef;eatsemicolon:boolean);
       {
         Parses the procedure directives, then parses the procedure body, then
         generates the code for it
@@ -1951,7 +1951,7 @@ implementation
 
          if not assigned(usefwpd) then
            { parse procedure declaration }
-           pd:=parse_proc_dec(isclassmethod,old_current_structdef)
+           pd:=parse_proc_dec(old_current_structdef,as_procparsemode(isclassmethod))
          else
            pd:=usefwpd;
 
@@ -2028,7 +2028,7 @@ implementation
          { compile procedure when a body is needed }
          if (pd_body in pdflags) then
            begin
-             read_proc_body(old_current_procinfo,pd);
+             read_proc_body(old_current_procinfo,pd,eatsemicolon);
            end
          else
            begin
@@ -2152,7 +2152,7 @@ implementation
               _PROCEDURE,
               _OPERATOR:
                 begin
-                  read_proc(is_classdef,nil);
+                  read_proc(is_classdef,nil,true);
                   is_classdef:=false;
                 end;
               _EXPORTS:
@@ -2187,7 +2187,7 @@ implementation
                       begin
                         if is_classdef then
                           begin
-                            read_proc(is_classdef,nil);
+                            read_proc(is_classdef,nil,true);
                             is_classdef:=false;
                           end
                         else
@@ -2235,7 +2235,7 @@ implementation
              _FUNCTION,
              _PROCEDURE,
              _OPERATOR :
-               read_proc(false,nil);
+               read_proc(false,nil,true);
              else
                begin
                  case idtoken of
diff --git a/compiler/ptype.pas b/compiler/ptype.pas
index 3aad0b7..70ee34b 100644
--- a/compiler/ptype.pas
+++ b/compiler/ptype.pas
@@ -27,7 +27,7 @@ interface
 
     uses
        globtype,cclasses,
-       symtype,symdef,symbase;
+       symtype,symdef,symbase,pclosure;
 
     type
       TSingleTypeOption=(
@@ -1673,26 +1673,35 @@ implementation
                 jvm_create_procvar_class(name,def);
 {$endif}
               end;
-            else
-              if (token=_KLAMMERAFFE) and (m_iso in current_settings.modeswitches) then
-                begin
-                  consume(_KLAMMERAFFE);
-                  single_type(tt2,SingleTypeOptionsInTypeBlock[block_type=bt_type]);
-                  def:=tpointerdef.create(tt2);
-                  if tt2.typ=forwarddef then
-                    current_module.checkforwarddefs.add(def);
-                end
-              else
-                if hadtypetoken and
-                    { don't allow "type helper" in mode delphi and require modeswitch class }
-                    ([m_delphi,m_class]*current_settings.modeswitches=[m_class]) and
-                    (token=_ID) and (idtoken=_HELPER) then
-                  begin
-                    consume(_HELPER);
-                    def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_type);
-                  end
-                else
-                  expr_type;
+           _KLAMMERAFFE:
+             if m_iso in current_settings.modeswitches then
+               begin
+                 consume(_KLAMMERAFFE);
+                 single_type(tt2,SingleTypeOptionsInTypeBlock[block_type=bt_type]);
+                 def:=tpointerdef.create(tt2);
+                 if tt2.typ=forwarddef then
+                   current_module.checkforwarddefs.add(def);
+               end
+             else
+               expr_type;
+           _ID:
+             if idtoken=_REFERENCE then
+               begin
+                 consume(_REFERENCE); consume(_TO);
+                 def:=procvar_dec(genericdef,genericlist);
+               end
+             else
+             if (idtoken=_HELPER) and hadtypetoken and
+                { don't allow "type helper" in mode delphi and require modeswitch class }
+                ([m_delphi,m_class]*current_settings.modeswitches=[m_class]) then
+               begin
+                 consume(_HELPER);
+                 def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_type);
+               end
+             else
+               expr_type;
+           else
+             expr_type;
          end;
 
          if def=nil then
diff --git a/compiler/symconst.pas b/compiler/symconst.pas
index 83dd798..b991e2a 100644
--- a/compiler/symconst.pas
+++ b/compiler/symconst.pas
@@ -350,7 +350,9 @@ type
     { the visibility of of this procdef was raised automatically by the
       compiler, e.g. because it was designated as a getter/setter for a property
       with a higher visibility on the JVM target }
-    po_auto_raised_visibility
+    po_auto_raised_visibility,
+    { anonymous routine (including closure) }
+    po_anonymous
   );
   tprocoptions=set of tprocoption;
 
diff --git a/compiler/symcreat.pas b/compiler/symcreat.pas
index 06ac751..925eeda 100644
--- a/compiler/symcreat.pas
+++ b/compiler/symcreat.pas
@@ -242,7 +242,7 @@ implementation
       current_scanner.substitutemacro('meth_impl_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index);
       current_scanner.readtoken(false);
       { and parse it... }
-      read_proc(is_classdef,usefwpd);
+      read_proc(is_classdef,usefwpd,true);
       parse_only:=oldparse_only;
       { remove the temporary macro input file again }
       current_scanner.closeinputfile;
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index f6f816e..59b1cb7 100644
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@@ -731,6 +731,8 @@ interface
           function  is_methodpointer:boolean;override;
           function  is_addressonly:boolean;override;
           procedure make_external;
+          procedure add_to_procsym; overload; inline;
+          procedure add_to_procsym(sym: tsym); overload; inline;
        end;
 
        { single linked list of overloaded procs }
@@ -4792,6 +4794,19 @@ implementation
       end;
 
 
+    procedure tprocdef.add_to_procsym; inline;
+      begin
+        tprocsym(procsym).ProcdefList.Add(self);
+      end;
+
+
+    procedure tprocdef.add_to_procsym(sym: {tprocsym}tsym); inline;
+      begin
+        procsym:=sym;
+        add_to_procsym;
+      end;
+
+
     procedure tprocdef.buildderef;
       begin
          inherited buildderef;
diff --git a/compiler/tokens.pas b/compiler/tokens.pas
index 3fe1505..3f29f59 100644
--- a/compiler/tokens.pas
+++ b/compiler/tokens.pas
@@ -257,6 +257,7 @@ type
     _PROCEDURE,
     _PROTECTED,
     _PUBLISHED,
+    _REFERENCE,
     _SOFTFLOAT,
     _THREADVAR,
     _WRITEONLY,
@@ -556,6 +557,7 @@ const
       (str:'PROCEDURE'     ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'PROTECTED'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'PUBLISHED'     ;special:false;keyword:[m_none];op:NOTOKEN),
+      (str:'REFERENCE'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'SOFTFLOAT'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'THREADVAR'     ;special:false;keyword:alllanguagemodes-[m_iso];op:NOTOKEN),
       (str:'WRITEONLY'     ;special:false;keyword:[m_none];op:NOTOKEN),
diff --git a/compiler/utils/ppuutils/ppudump.pp b/compiler/utils/ppuutils/ppudump.pp
index c4df7c0..be2b42a 100644
--- a/compiler/utils/ppuutils/ppudump.pp
+++ b/compiler/utils/ppuutils/ppudump.pp
@@ -1723,7 +1723,8 @@ const
      (mask:po_java_nonvirtual; str: 'Java non-virtual method'),
      (mask:po_ignore_for_overload_resolution;str: 'Ignored for overload resolution'),
      (mask:po_rtlproc;         str: 'RTL procedure'),
-     (mask:po_auto_raised_visibility; str: 'Visibility raised by compiler')
+     (mask:po_auto_raised_visibility; str: 'Visibility raised by compiler'),
+     (mask:po_anonymous;       str: 'Anonymous procedure')
   );
 var
   proctypeoption  : tproctypeoption;
-- 
1.8.1.2


From 4cb8a0b64cc8176e23e83d7924e2dc067253bdca Mon Sep 17 00:00:00 2001
From: Vasiliy Kevroletin <kevroletin@gmail.com>
Date: Mon, 3 Jun 2013 00:24:37 +1100
Subject: [PATCH 2/4] Show error in case of access to free variable.

Problem: variable capturing is not implemented and compiler doesn't warng about it.
Fix: Show error message. Parser performs check before creation of tloadnode.
Anonymous routine have normal nesting level and can have nested procedures.
So simple check of symtable nesting level is not enough to detect fact of capturing. Instead we walk through symtables using parent link. We start from current symtable and go until symtable with normal nesting level. If we didn't come to symtable of variable then this variable located in another function. And it's capturing.
---
 compiler/msg/errore.msg |   5 +-
 compiler/msgidx.inc     |   5 +-
 compiler/msgtxt.inc     | 868 ++++++++++++++++++++++++------------------------
 compiler/pdecsub.pas    |   2 +-
 compiler/pexpr.pas      |  39 ++-
 5 files changed, 482 insertions(+), 437 deletions(-)

diff --git a/compiler/msg/errore.msg b/compiler/msg/errore.msg
index 0058444..ed30f73 100644
--- a/compiler/msg/errore.msg
+++ b/compiler/msg/errore.msg
@@ -392,7 +392,7 @@ scan_w_setpeoptflags_not_support=02092_W_SETPEOPTFLAGS is not supported by the t
 #
 # Parser
 #
-# 03333 is the last used one
+# 03334 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -1490,6 +1490,9 @@ parser_e_not_allowed_in_record=03332_E_Visibility section "$1" not allowed in re
 parser_e_proc_dir_not_allowed=03333_E_Procedure directive "$1" not allowed here
 % This procedure directive is not allowed in the given context. E.g. "static"
 % is not allowed for instance methods or class operators.
+parser_e_proc_capture_not_allowed=03334_E_Anonymous procedure can not capture local variable "$1"
+% Anonymous procedure currently can not use local variables of declaring subroutine.
+%
 %
 %
 % \end{description}
diff --git a/compiler/msgidx.inc b/compiler/msgidx.inc
index ccc4bf2..e16a897 100644
--- a/compiler/msgidx.inc
+++ b/compiler/msgidx.inc
@@ -429,6 +429,7 @@ const
   parser_e_no_class_in_local_anonymous_records=03331;
   parser_e_not_allowed_in_record=03332;
   parser_e_proc_dir_not_allowed=03333;
+  parser_e_proc_capture_not_allowed=03334;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -973,9 +974,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 68955;
+  MsgTxtSize = 69019;
 
   MsgIdxMax : array[1..20] of longint=(
-    26,93,334,121,88,56,126,27,202,63,
+    26,93,335,121,88,56,126,27,202,63,
     54,20,1,1,1,1,1,1,1,1
   );
diff --git a/compiler/msgtxt.inc b/compiler/msgtxt.inc
index 8909dae..36396c0 100644
--- a/compiler/msgtxt.inc
+++ b/compiler/msgtxt.inc
@@ -536,665 +536,670 @@ const msgtxt : array[0..000287,1..240] of char=(
   'us records'#000+
   '03332_E_Visibility section "$1" not allowed in records'#000+
   '03333_E_Procedure directive "$1" not allowed here'#000+
+  '03334_E_Anonymous procedure can no','t capture local variable "$1"'#000+
   '04000_E_Type mismatch'#000+
-  '04001_E_Inco','mpatible types: got "$1" expected "$2"'#000+
+  '04001_E_Incompatible types: got "$1" expected "$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+
-  '04006_E_Boolean expression expected, ','but got "$1"'#000+
+  '04005_E_Integer express','ion 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+
   '04009_E_class type expected, but got "$1"'#000+
-  '04011_E_Can'#039't evaluate constant expression'#000+
+  '04011_E_Can'#039't evaluate constant expressio','n'#000+
   '04012_E_Set elements are not compatible'#000+
-  '04013_E_Operation not ','implemented for sets'#000+
+  '04013_E_Operation not implemented for sets'#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+
-  '04017_E_succ or pred on enums',' with assignments not possible'#000+
+  '04016_E_String types',' have to match exactly in $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+
   '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+
+  '04020_E_Can'#039't use read or write on untyped f','ile.'#000+
   '04021_E_Type conflict between set elements'#000+
-  '04022_W_lo/hi(dw','ord/qword) returns the upper/lower word/dword'#000+
+  '04022_W_lo/hi(dword/qword) returns the upper/lower word/dword'#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+
-  '04026_E_Method (variable) and Procedure',' (variable) are not compatibl'+
-  'e'#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 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',' varia'+
-  'ble'#000+
+  '04029_E_Argument can'#039't be assign','ed to'#000+
+  '04030_E_Can'#039't assign local procedure/function to procedure variabl'+
+  'e'#000+
   '04031_E_Can'#039't assign values to an address'#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+
+  '0403','5_H_Mixing signed expressions and longwords gives a 64bit result'+
+  #000+
   '04036_W_Mixing signed expressions and cardinals here may cause a range'+
   ' 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+
-  '04039_E_Class or Object types "$1" ','and "$2" are not related'#000+
+  '04038_E_enums with assignments ','can'#039't be used as array index'#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+
   '04042_E_Type "$1" is not completely defined'#000+
-  '04043_W_String literal has more characters than short string lengt','h'#000+
+  '04','043_W_String literal has more characters than short string length'#000+
   '04044_W_Comparison might be always false due to range of constant and '+
   'expression'#000+
   '04045_W_Comparison might be always true due to range of constant and e'+
   'xpression'#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+
+  '04046_W_Const','ructing a class "$1" with abstract method "$2"'#000+
+  '04047_H_The left operand of the IN operator should be byte sized'#000+
   '04048_W_Type size mismatch, possible loss of data / range check error'#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 t','aken'#000+
+  '04049_H_Type size mismatch, possible loss of data / range ','check erro'+
+  'r'#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+
   '04052_E_Constant Expression expected'#000+
-  '04053_E_Operation "$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_Conversio','n between ordinals and pointers is not portable'#000+
+  '04055_H_Conversion between ordinals and pointers is not portable'#000+
   '04056_W_Conversion between ordinals and pointers is not portable'#000+
   '04057_E_Can'#039't determine which overloaded function to call'#000+
-  '04058_E_Illegal counter variable'#000+
-  '04059_W_Converting constant real val','ue to double for C variable argu'+
-  'ment, add explicit typecast to prevent this.'#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 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)Pa'+
-  'cked Array"'#000+
+  '04061_E_Constant packed arrays are not y','et supported'#000+
+  '04062_E_Incompatible type for arg no. $1: Got "$2" expected "(Bit)Pack'+
+  'ed 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 t','o '+
+  'be initialised'#000+
+  '04065_E_Constant packed records and objects are not yet 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+
-  '04077_E_Can'#039't export subroutine marked as local from a unit'#000+
-  '04078_E_Type is no','t automatable: "$1"'#000+
+  '04077_E_Can'#039't ','export subroutine marked as local from a unit'#000+
+  '04078_E_Type is not automatable: "$1"'#000+
   '04079_H_Converting the operands to "$1" before doing the add could pre'+
   'vent overflow errors.'#000+
-  '04080_H_Converting the operands to "$1" before doing the subtract coul'+
-  'd prevent overflow errors.'#000+
-  '04081_H_Converting the operands',' to "$1" before doing the multiply co'+
+  '04080_H_Converting the operands to "$1" before doing the subtrac','t co'+
   'uld prevent overflow errors.'#000+
+  '04081_H_Converting the operands to "$1" before doing the multiply coul'+
+  'd 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 G','UID'#000+
+  '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+
   '04085_E_Expected Objective-C method, but got $1'#000+
   '04086_E_Expected Objective-C method or constant method name'#000+
-  '04087_E_No type info available for this type'#000+
+  '04087_E_No type info availabl','e for this type'#000+
   '04088_E_Ordinal or string expression expected'#000+
-  '04','089_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 Object'+
-  'ive-C runtime.'#000+
-  '04093_E_Class or objcclass type expec','ted, but got "$1"'#000+
+  '04092_E_The type "$1" is not supported for interaction wit','h the Obje'+
+  'ctive-C runtime.'#000+
+  '04093_E_Class or objcclass type expected, but got "$1"'#000+
   '04094_E_Objcclass type expected'#000+
   '04095_W_Coerced univ parameter type in procedural variable may cause c'+
   'rash or memory corruption: $1 to $2'#000+
-  '04096_E_Type parameters of specializations of generics cannot referenc'+
-  'e the currentl','y specialized type'#000+
+  '04096_E_Type paramet','ers of specializations of generics cannot refere'+
+  'nce the currently specialized type'#000+
   '04097_E_Type parameters are not allowed on non-generic class/record/ob'+
   'ject procedure or function'#000+
-  '04098_E_Generic declaration of "$1" differs from previous declaration'#000+
+  '04098_E_Generic declaration of "$1" differs from previous de','claratio'+
+  'n'#000+
   '04099_E_Helper type expected'#000+
-  '04100_E_Record type expec','ted'#000+
+  '04100_E_Record type expected'#000+
   '04101_E_Derived class helper must extend a subclass of "$1" or the cla'+
   'ss itself'#000+
   '04102_E_Derived record or type helper must extend "$1"'#000+
-  '04103_E_Invalid assignment, procedures return no value'#000+
-  '04104_W_Implicit string type conversion from "','$1" to "$2"'#000+
+  '04103_E_Invalid assignment, procedure','s return no value'#000+
+  '04104_W_Implicit string type conversion from "$1" to "$2"'#000+
   '04105_W_Implicit string type conversion with potential data loss from '+
   '"$1" to "$2"'#000+
   '04106_-W_Explicit string typecast from "$1" to "$2"'#000+
-  '04107_-W_Explicit string typecast with potential data loss from "$1" t'+
-  'o "$2"'#000+
-  '04108_W_Unicode ','constant cast with potential data loss'#000+
+  '04107_-W_Explicit string type','cast with potential data loss from "$1"'+
+  ' to "$2"'#000+
+  '04108_W_Unicode constant cast with potential data loss'#000+
   '04109_E_range check error while evaluating constants ($1 must be betwe'+
   'en $2 and $3)'#000+
-  '04110_W_range check error while evaluating constants ($1 must be betwe'+
-  'en $2 and $3)'#000+
-  '04111_E_This type is not supporte','d for the Default() intrinsic'#000+
+  '04110_W_range check error while evaluating constants ','($1 must be bet'+
+  'ween $2 and $3)'#000+
+  '04111_E_This type is not supported for the Default() intrinsic'#000+
   '04112_E_JVM virtual class methods cannot be static'#000+
   '04113_E_Final (class) fields can only be assigned in their class'#039' '+
   '(class) constructor'#000+
-  '04114_E_It is not possible to typecast untyped parameters on managed p'+
-  'lat','forms, simply assign a value to them instead.'#000+
+  '04114_E_I','t is not possible to typecast untyped parameters on managed'+
+  ' platforms, simply assign a value to them instead.'#000+
   '04115_E_The assignment side of an expression cannot be typecasted to a'+
   ' supertype on managed platforms'#000+
-  '04116_-W_The interface method "$1" raises the visibility of "$2" to pu'+
-  'blic when accessed via',' an interface instance'#000+
+  '04116_-W_The interface metho','d "$1" raises the visibility of "$2" to '+
+  'public when accessed via an interface instance'#000+
   '04117_E_The interface method "$1" has a higher visibility (public) tha'+
   'n "$2"'#000+
   '04118_E_TYPEOF can only be used on object types with VMT'#000+
-  '04119_E_It is not possible to define a default value for a parameter o'+
-  'f type "$1"'#000+
-  '0','4120_E_Type "$1" cannot be extended by a type helper'#000+
+  '04119_E_It is not p','ossible to define a default value for a parameter'+
+  ' of type "$1"'#000+
+  '04120_E_Type "$1" cannot be extended by a type helper'#000+
   '05000_E_Identifier not found "$1"'#000+
   '05001_F_Internal Error in SymTableStack()'#000+
   '05002_E_Duplicate identifier "$1"'#000+
-  '05003_H_Identifier already defined in $1 at line $2'#000+
-  '05004_E_Unknown identifie','r "$1"'#000+
+  '05003_H_Ident','ifier already defined in $1 at line $2'#000+
+  '05004_E_Unknown identifier "$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+
-  '05012_F_record or class type expected'#000,
+  '05010_E_Only static variables can be used in static m','ethods or outsi'+
+  'de methods'#000+
+  '05012_F_record or class type expected'#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+
-  '05016_E_Illegal label declaration'#000+
-  '05017_E_GOTO and LABEL are not supported (use switch -S','g)'#000+
+  '05016_E_Illegal label dec','laration'#000+
+  '05017_E_GOTO and LABEL are not supported (use switch -Sg)'#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+
+  '05022_E_Forward class definition not ','resolved "$1"'#000+
   '05023_H_Unit "$1" not used in $2'#000+
-  '05024_H_Parameter',' "$1" not used'#000+
+  '05024_H_Parameter "$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+
-  '05028_H_Local $1 "$2" is not used'#000+
-  '05029_N_Private field "$1.$2" is 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+
   '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+
-  '05034_W_Type "$1" is not aligned correctly in current record for C',#000+
+  '05','034_W_Type "$1" is not aligned correctly in current record for C'#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+
-  '05038_E_identifier idents no member "$1"'#000+
+  '05038_E_identifi','er idents no member "$1"'#000+
   '05039_H_Found declaration: $1'#000+
-  '05040_E_D','ata element too large'#000+
+  '05040_E_Data element too large'#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+
-  '05055_W_Symbol "$1" is not implemented'#000+
-  '05056_E_Can'#039't create unique type from this',' type'#000+
+  '05055_W_Symbol "$','1" is not implemented'#000+
+  '05056_E_Can'#039't create unique type from this type'#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+
-  '05060_H_Function result variable does not seem to be initi','alized'#000+
+  '05059_W_Function result variable does not seem to initia','lized'#000+
+  '05060_H_Function result variable does not seem to be initialized'#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 declaration "$1" not resolved, assu','med 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+
-  '05069_E_Cannot find a "Current" property in enumerator "$1"'#000+
-  '05070_E_Mismatch between number of d','eclared parameters and number of'+
-  ' colons in message string.'#000+
+  '05069_E_Cannot find a "Current" ','property in enumerator "$1"'#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+
+  '05073_N_Private property "$1.$2" nev','er used'#000+
   '05074_W_Unit "$1" is deprecated'#000+
-  '05075_W_Unit "$1" is dep','recated: "$2"'#000+
+  '05075_W_Unit "$1" is deprecated: "$2"'#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+
-  '05080_E_No complete definition of the formally declared class "$1" is '+
-  'in scope'#000,
+  '05080_E_No comp','lete definition of the formally declared class "$1" i'+
+  's in scope'#000+
   '05081_E_Gotos into initialization or finalization blocks of units are '+
   'not allowed'#000+
   '05082_E_Invalid external name "$1" for formal class "$2"'#000+
-  '05083_E_Complete class definition with external name "$1" here'#000+
-  '05084_W_Possible library conflict: sym','bol "$1" from library "$2" als'+
-  'o found in library "$3"'#000+
+  '05083_E_Complete class definition wit','h external name "$1" here'#000+
+  '05084_W_Possible library conflict: symbol "$1" from library "$2" also '+
+  'found in library "$3"'#000+
   '05085_E_Cannot add implicit constructor '#039'Create'#039' because ident'+
   'ifier already used by "$1"'#000+
-  '05086_E_Cannot generate default constructor for class, because parent '+
-  'has no parameterless constr','uctor'#000+
+  '05086_E_Cannot generate default c','onstructor for class, because paren'+
+  't has no parameterless constructor'#000+
   '05087_D_Adding helper for $1'#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 ther','e'#000+
   '06015_E_EXPORT declared functions can'#039't be called'#000+
-  '06016_W_Poss','ible illegal call of constructor or destructor'#000+
+  '06016_W_Possible illegal call of constructor or destructor'#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 met','hods can'#039't be inline.'#000+
+  '06031_E_Object or class methods can'#039't be inline.'#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+
-  '06037_E_Constructors or destructors can','not be called inside a '#039'w'+
-  'ith'#039' clause'#000+
+  'sed,',' 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+
   '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+
-  '06041_W_Parameters size exceeds lim','it for certain cpu'#039's'#000+
+  '06040_E_Control flow statements aren'#039,'t allowed in a finally block'+
+  #000+
+  '06041_W_Parameters size exceeds limit 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+
-  '06046_F_Unknown compilerproc "$1". Check if you use ','the correct run '+
-  'time library.'#000+
+  '06045_E_CONTINUE ','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 run'+
   ' time library.'#000+
   '06048_H_Inherited call to abstract method ignored'#000+
-  '06049_E_Goto label "$1" not defined or optimized away'#000+
-  '06050_F_Cannot find t','ype "$1" in unit "$2". Check if you use the cor'+
-  'rect run time library.'#000+
+  '06049_E_Got','o 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 time library.'#000+
   '06051_E_Interprocedural gotos are allowed only to outer subroutines'#000+
-  '06052_E_Label must be defined in the same scope as it is declared'#000+
-  '06053_E_Leaving procedures containin','g explicit or implicit exception'+
-  's frames using goto is not allowed'#000+
+  '06052_E_Label must be defined in the s','ame scope as it is declared'#000+
+  '06053_E_Leaving procedures containing explicit or implicit exceptions '+
+  'frames using goto is not allowed'#000+
   '06054_E_In ISO mode, the mod operator is defined only for positive quo'+
   'tient'#000+
   '06055_DL_Auto inlining: $1'#000+
-  '07000_DL_Starting $1 styled assembler parsing'#000+
-  '07001_DL_Finished $1 sty','led assembler parsing'#000+
+  '07000_','DL_Starting $1 styled assembler parsing'#000+
+  '07001_DL_Finished $1 styled assembler parsing'#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 without identifier'#000+
-  '07007_E_Cannot use local variable or parameters here'#000+
-  '07008_E_need to',' use OFFSET here'#000+
+  '0700','7_E_Cannot use local variable or parameters here'#000+
+  '07008_E_need to use OFFSET here'#000+
   '07009_E_need to use $ here'#000+
   '07010_E_Cannot use multiple relocatable symbols'#000+
   '07011_E_Relocatable symbol can only be added'#000+
   '07012_E_Invalid constant expression'#000+
-  '07013_E_Relocatable symbol is not allowed'#000+
-  '07014_E_Invalid reference',' syntax'#000+
+  '070','13_E_Relocatable symbol is not allowed'#000+
+  '07014_E_Invalid reference syntax'#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+
-  '07018_W_Possible error in object field handling'#000+
-  '07019_E_Wrong scale factor specified'#000,
+  '07018_W_Possible erro','r in object field handling'#000+
+  '07019_E_Wrong scale factor specified'#000+
   '07020_E_Multiple index register usage'#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 referen','ces are not allowed'#000+
   '07025_E_Divide by zero in asm evaluator'#000+
-  '0702','6_E_Illegal expression'#000+
+  '07026_E_Illegal expression'#000+
   '07027_E_escape 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+
-  '07031_W_ENTER instruction is not supported by ','Linux kernel'#000+
+  '07030_W_$1 without operand tr','anslated into $1P'#000+
+  '07031_W_ENTER instruction is not supported by Linux kernel'#000+
   '07032_W_Calling an overload 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 b','inary $1'#000+
+  '07037_E_Error converting binary $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 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+
+  '07042_E','_Cannot use OLDEBP outside a nested procedure'#000+
+  '07043_W_Procedures can'#039't return any value in asm code'#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 destination 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 com','bination of opcode and operands'#000+
+  '07048_E_Invalid combination of opcode and operands'#000+
   '07049_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 pointer'#000+
-  '07053_E_Unrecognize','d opcode $1'#000+
+  '07052_W_constant with sym','bol $1 for address which is not on a pointe'+
+  'r'#000+
+  '07053_E_Unrecognized opcode $1'#000+
   '07054_E_Invalid or missing opcode'#000+
   '07055_E_Invalid combination of prefix and opcode: $1'#000+
   '07056_E_Invalid combination of override and opcode: $1'#000+
-  '07057_E_Too many operands on line'#000+
+  '07057_E_Too many opera','nds on line'#000+
   '07058_W_NEAR ignored'#000+
   '07059_W_FAR ignored'#000+
-  '07060_E_Dup','licate local symbol $1'#000+
+  '07060_E_Duplicate local symbol $1'#000+
   '07061_E_Undefined local symbol $1'#000+
   '07062_E_Unknown label identifier $1'#000+
   '07063_E_Invalid register name'#000+
   '07064_E_Invalid floating point register name'#000+
-  '07066_W_Modulo not supported'#000+
-  '07067_E_Invalid floating point constant $1'#000,
+  '07066_W_','Modulo not supported'#000+
+  '07067_E_Invalid floating point constant $1'#000+
   '07068_E_Invalid floating point expression'#000+
   '07069_E_Wrong symbol type'#000+
   '07070_E_Cannot index a local var or parameter with a register'#000+
   '07071_E_Invalid segment override expression'#000+
-  '07072_W_Identifier $1 supposed external'#000+
-  '07073_E_Strings not allowe','d as constants'#000+
+  '07','072_W_Identifier $1 supposed external'#000+
+  '07073_E_Strings not allowed as constants'#000+
   '07074_E_No type of variable specified'#000+
   '07075_E_assembler code not returned to text section'#000+
   '07076_E_Not a directive or local symbol $1'#000+
-  '07077_E_Using a defined name as a local label'#000+
-  '07078_E_Dollar token is used without an identi','fier'#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+
   '07080_N_.align is target specific, use .balign or .p2align'#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 op'+
-  'erands'#000+
+  '07082_E_Can'#039't acc','ess fields of objects/classes directly'#000+
+  '07083_E_No size specified and unable to determine the size of the oper'+
+  'ands'#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+
-  '07088_W_"$1 %st(n)" translated int','o "$1 %st(n),%st"'#000+
+  '07087_W_"$1 %st(n)" tr','anslated 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+
   '07090_E_Char > not allowed here'#000+
   '07093_W_ALIGN not supported'#000+
   '07094_E_Inc and Dec cannot be together'#000+
-  '07095_E_Invalid reglist for movem'#000+
+  '07095_E_Invalid reglist for',' movem'#000+
   '07096_E_Reglist invalid for opcode'#000+
-  '07097_E_Higher cpu mod','e required ($1)'#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+
+  '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+
-  '07','101_W_No size specified and unable to determine the size of the op'+
-  'erands, using BYTE as default'#000+
+  '07101_W_No size specified and unable to determine the size of the oper'+
+  'ands, 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 convention'+
-  #000+
-  '07104_W_Use of -','offset(%ebp) is not recommended for local variable a'+
-  'ccess'#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+
   '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, a'+
-  'nd "$1" is not virtual'#000+
-  '07107_E_Gener','ating PIC, but reference is not PIC-safe'#000+
+  '07106_E_VMTOffset must be used in combinat','ion with a virtual method,'+
+  ' and "$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+
-  '07110_W_@GOTPCREL is useless and potentially dangereous for local symb'+
-  'ols'#000+
-  '07111_W_Con','stant with general purpose segment register'#000+
+  '07110_W_@GOTPCREL is ','useless and potentially dangereous for local sy'+
+  'mbols'#000+
+  '07111_W_Constant with general purpose segment register'#000+
   '07112_E_Invalid offset value for $1'#000+
   '07113_E_Invalid register for $1'#000+
-  '07114_E_SEH directives are allowed only in pure assembler procedures'#000+
-  '07115_E_Directive "$1" is not supported for the current tar','get'#000+
+  '07114_E_SEH directives are allowed only in pure assembler proced','ures'+
+  #000+
+  '07115_E_Directive "$1" is not supported for the current target'#000+
   '07116_E_This function'#039's result location cannot be encoded directly'+
   ' in a single operand when "nostackframe" is used'#000+
-  '07117_E_GOTPCREL references in Intel assembler syntax cannot contain a'+
-  ' base or index register, and their offset must 0.'#000+
-  '0','7118_E_The current target does not support GOTPCREL relocations'#000+
+  '07117_E_GOTPCREL references in Intel assembler syntax can','not contain'+
+  ' a base or index register, and their offset must 0.'#000+
+  '07118_E_The current target does not support GOTPCREL relocations'#000+
   '07119_W_Exported/global symbols should accessed via the GOT'#000+
   '07120_W_Check size of memory operand "$1"'#000+
-  '07121_W_Check size of memory operand "$1: memory-operand-size is $2 bi'+
-  'ts, ','but expected [$3 bits]"'#000+
+  '07121_W_Ch','eck size of memory operand "$1: memory-operand-size is $2 '+
+  'bits, but expected [$3 bits]"'#000+
   '07122_W_Check size of memory operand "$1: memory-operand-size is $2 bi'+
   'ts, but expected [$3 bits + $4 byte offset]"'#000+
-  '07123_W_Check "$1: offset of memory operand is negative "$2 byte"'#000+
-  '07124_W_Check "$1: size of memory o','perand is empty, but es exists di'+
-  'fferent definitions of the memory size =>> map to $2 (smallest option)'+
-  '"'#000+
+  '07123_W_Check "$1: offset of memory o','perand is negative "$2 byte"'#000+
+  '07124_W_Check "$1: size of memory operand is empty, but es exists diff'+
+  'erent definitions of the memory size =>> map to $2 (smallest option)"'#000+
   '07125_E_Invalid register used in memory reference expression: "$1"'#000+
-  '08000_F_Too many assembler files'#000+
-  '08001_F_Selected assembler output n','ot supported'#000+
+  '0800','0_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+
   '08004_E_Allocating of data is only allowed in bss section'#000+
-  '08005_F_No binary writer selected'#000+
+  '08005_F_No binary writer selecte','d'#000+
   '08006_E_Asm: Opcode $1 not in table'#000+
-  '08007_E_Asm: $1 invalid co','mbination of opcode and operands'#000+
+  '08007_E_Asm: $1 invalid combination of opcode and operands'#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+
-  '08012_E_Asm: Short jump is out of rang','e $1'#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+
   '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 he','re'#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+
   '08021_E_Asm: 64 Bit operands not supported'#000+
-  '08022_E_Asm: AH,BH,CH or DH cannot be used in an instruction requiring'+
-  ' REX prefix'#000+
-  '08023_E_Missing .seh_endprol','ogue directive'#000+
+  '08022_E_Asm: AH,BH,CH or DH cannot be used in ','an instruction requiri'+
+  'ng REX prefix'#000+
+  '08023_E_Missing .seh_endprologue directive'#000+
   '08024_E_Function prologue exceeds 255 bytes'#000+
   '08025_E_.seh_handlerdata directive without preceding .seh_handler'#000+
-  '08026_F_Relocation count for section $1 exceeds 65535'#000+
+  '08026_F_Relocation count for section $1 exceeds 655','35'#000+
   '09000_W_Source operating system redefined'#000+
-  '09001_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 (error code: $2)'#000+
   '09004_E_Can'#039't create archive file: $1'#000+
-  '09005_E_Assembler $1 not found, switching to external assembling'#000+
+  '09005_E_Assembler $1 not found, sw','itching 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+
-  '09010_I_Assembling with smartlinking $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+
   '09015_I_Linking $1'#000+
-  '09016_E_Util $1 not found, switching to external linking'#000+
+  '09016_E_Util $1 not found, switchin','g to external linking'#000+
   '09017_T_Using util $1'#000+
-  '09018_E_Creation of ','Executables 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 m','ode'+
+  #000+
   '09022_I_Compiling resource $1'#000+
-  '09023_T_unit $1 can'#039't be stati','cally 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+
+  'g'#000,
   '09026_E_unit $1 can'#039't be smart or static linked'#000+
-  '09027_E_unit $1 ','can'#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+
-  '09030_E_Can'#039't call the resource compiler "$1", switching to extern'+
-  'al mode'#000+
-  '09031_E_Can'#039't open resource ','file "$1"'#000+
+  '09030_E_Can'#039't call the resource compil','er "$1", switching to exte'+
+  'rnal mode'#000+
+  '09031_E_Can'#039't open resource file "$1"'#000+
   '09032_E_Can'#039't write resource file "$1"'#000+
   '09033_N_File "$1" not found for backquoted cat command'#000+
   '09034_W_"$1" not found, this will probably cause a linking failure'#000+
-  '09128_F_Can'#039't post process executable $1'#000+
-  '09129_F_Can'#039't open executabl','e $1'#000+
+  '09128','_F_Can'#039't post process 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+
   '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+
+  '09134_X_Stack',' space committed: $1 bytes'#000+
+  '09200_F_Executable image size is too big 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+
   '10002_U_PPU Name: $1'#000+
-  '10003_U_PPU Flags: $1'#000+
+  '10003_U_PPU F','lags: $1'#000+
   '10004_U_PPU Crc: $1'#000+
   '10005_U_PPU Time: $1'#000+
-  '10006_U_PPU Fi','le too short'#000+
+  '10006_U_PPU File 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 another processor'#000+
-  '10010_U_PPU is compiled for another target'#000+
+  '10010_U_PPU is compiled for another t','arget'#000+
   '10011_U_PPU Source: $1'#000+
   '10012_U_Writing $1'#000+
-  '10013_F_Can'#039't Wr','ite PPU-File'#000+
+  '10013_F_Can'#039't Write 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_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+
+  '10','019_F_Too much units'#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 found but $2 exists'#000+
-  '10024_F_Unit $1 searched but $2 found'#000+
+  '10024_F_Unit $1 searched but $2 fou','nd'#000+
   '10025_W_Compiling the system unit requires the -Us switch'#000+
-  '100','26_F_There were $1 errors compiling module, stopping'#000+
+  '10026_F_There were $1 errors compiling module, stopping'#000+
   '10027_U_Load from $1 ($2) unit $3'#000+
   '10028_U_Recompiling $1, checksum changed for $2'#000+
-  '10029_U_Recompiling $1, source found only'#000+
+  '10029_U_Recompiling $1, source found only',#000+
   '10030_U_Recompiling unit, static lib is older than ppufile'#000+
-  '1003','1_U_Recompiling unit, shared lib is older than ppufile'#000+
+  '10031_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+
-  '10034_U_Parsing interface of $1'#000+
+  '10034_U_Pars','ing 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+
-  '10041_U_File $1 is newer than the one used for creating PPU file $2'#000+
-  '10042_U_Trying to use a unit which was compiled ','with a different FPU'+
-  ' mode'#000+
+  '10041_U_File $1 is newer than the one used for creat','ing PPU file $2'#000+
+  '10042_U_Trying to use a unit which was compiled with a different FPU m'+
+  '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+
-  '10046_U_Implementation 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 depends 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+
   '10052_U_Forced reloading'#000+
-  '10053_U_Previous state of $1: $2'#000+
-  '10054_U_Already compiling $1, set','ting second compile'#000+
+  '10','053_U_Previous state of $1: $2'#000+
+  '10054_U_Already compiling $1, setting second compile'#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_Skipping re-resolving unit $1, still loading used units'#000+
-  '10060_U_Unloading resource unit $1 (no','t needed)'#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 (object','s/classes) CRC changed for unit $1'+
-  #000+
+  'wpo feedback input file fo','r 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+
-  '11002_W_DEF file can be created only for OS/2'#000+
-  '11003_E_nested response ','files are not supported'#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+
   '11005_N_No option inside $1 config file'#000+
   '11006_E_Illegal parameter: $1'#000+
   '11007_H_-? writes help pages'#000+
-  '11008_F_Too many config files nested'#000+
+  '11008_F_T','oo 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} encou'+
-  'ntered'#000+
-  '11014_F_In options f','ile $1 at line $2 unexpected \var{\#ENDIFs} enco'+
-  'untered'#000+
+  '11013_F_In options file $1 at lin','e $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+
   '11015_F_Open conditional at the end of the options file'#000+
-  '11016_W_Debug information generation is not supported by this executab'+
-  'le'#000+
+  '11016_W_Debug information generation is not supported by this ex','ecut'+
+  'able'#000+
   '11017_H_Try recompiling with -dGDB'#000+
-  '11018_W_You are usin','g the obsolete switch $1'#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+
-  '11021_W_Assembler output selected "$1" is not compatible with "$2"'#000+
-  '11022_W_"$1" assembler u','se forced'#000+
+  '11021_W_Assembler output se','lected "$1" is not compatible with "$2"'#000+
+  '11022_W_"$1" assembler use forced'#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+
-  '11030_H_Start of reading config file $1'#000+
+  '11030_H_Start of reading con','fig file $1'#000+
   '11031_H_End of reading config file $1'#000+
-  '11032_D_interp','reting option "$1"'#000+
+  '11032_D_interpreting 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 source file name "$1"'#000+
-  '11039_E_Unknown codepage "$1"'#000+
+  '11039_E','_Unknown codepage "$1"'#000+
   '11040_F_Config file $1 is a directory'#000+
-  '110','41_W_Assembler output selected "$1" cannot generate debug info, d'+
-  'ebugging disabled'#000+
+  '11041_W_Assembler output selected "$1" cannot generate debug info, deb'+
+  'ugging disabled'#000+
   '11042_W_Use of ppc386.cfg is deprecated, please use fpc.cfg instead'#000+
-  '11043_F_In options file $1 at line $2 \var{\#ELSE} directive without \'+
-  'var{\#IF(N)DEF} fou','nd'#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 targe'+
   't 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 ',
-  'this target, switching to static linking'#000+
+  '11046','_N_DWARF debug information cannot be used with smart linking on'+
+  ' this target, switching to static linking'#000+
   '11047_W_Option "$1" is ignored for the current target platform.'#000+
   '11048_W_Disabling external debug information because it is unsupported'+
-  ' for the selected target/debug format combination.'#000+
-  '11049_N_DWARF ','debug information cannot be used with smart linking wi'+
-  'th external assembler, disabling static library creation.'#000+
-  '11050_E_Invalid value for MACOSX_DEPLOYMENT_TARGET environment variabl'+
-  'e: $1'#000+
-  '11051_E_Invalid value for IPHONEOS_DEPLOYMENT_TARGET',' environment var'+
-  'iable: $1'#000+
+  ' ','for the selected target/debug format combination.'#000+
+  '11049_N_DWARF debug information cannot be used with smart linking with'+
+  ' external assembler, disabling static library creation.'#000+
+  '11050_E_Invalid value for MACOSX_DEPLOYMENT_TARGET environment v','aria'+
+  'ble: $1'#000+
+  '11051_E_Invalid value for IPHONEOS_DEPLOYMENT_TARGET environment varia'+
+  'ble: $1'#000+
   '11052_E_You must use a FPU type of VFPV2, VFPV3 or VFPV3_D16 when usin'+
   'g the EABIHF ABI target'#000+
-  '11053_W_The selected debug format is not supported on the current targ'+
-  'et, not changing the current setting'#000+
-  '12000_F_Canno','t open whole program optimization feedback file "$1"'#000+
+  '11053_W_The selected debug format is not supported on th','e current ta'+
+  'rget, not changing the current setting'#000+
+  '12000_F_Cannot open whole program optimization 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 information'+
-  ' in wpo feedback file "$1"'#000+
-  '12003_','E_Expected section header, but got "$2" at line $1 of wpo feed'+
-  'back file'#000+
+  '12002_D_Finished processing the whole p','rogram 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+
   '12004_W_No handler registered for whole program optimization section "'+
-  '$2" at line $1 of wpo feedback file, ignoring'#000+
-  '12005_D_Found whole program optimization section "$1','" with informati'+
-  'on about "$2"'#000+
+  '$2" at line $1 of wpo feedback fil','e, 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_No collected information necessary to perform "$1" whole progr'+
-  'am optimization found'#000+
-  '120','08_F_Specify a whole program optimization feedback file to store '+
-  'the generated info in (using -FW)'#000+
+  '12007_E_No collected informatio','n 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 information, yet'+
-  ' a feedback file was specified (using -FW)'#000+
-  '12010_E_Not performing any w','hole program optimizations, yet an input'+
-  ' feedback file was specified (using -Fw)'#000+
+  ' a feed','back 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+
   '12011_D_Skipping whole program optimization section "$1", because not '+
-  'needed by the requested optimizations'#000+
-  '12012_W_Overriding previously read information for ','"$1" from feedbac'+
-  'k input file using information in section "$2"'#000+
+  'needed by the requested o','ptimizations'#000+
+  '12012_W_Overriding previously read information for "$1" from feedback '+
+  'input file using information in section "$2"'#000+
   '12013_E_Cannot extract symbol liveness information from program when s'+
   'tripping symbols, use -Xs-'#000+
-  '12014_E_Cannot extract symbol liveness information from program when w'+
-  'hen not l','inking'#000+
+  '12014_E_Cannot ','extract symbol liveness information from program when'+
+  ' when 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 information produced by "'+
   '$1"'#000+
-  '12017_F_Error executing "$1" (exitcode: $2) to extract symbol infor','m'+
+  '120','17_F_Error executing "$1" (exitcode: $2) to extract symbol inform'+
   'ation 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 specified whole program optimisation feedback fi'+
-  'le "$1"'#000+
-  '11023_Free Pascal Compiler versio','n $FPCFULLVERSION [$FPCDATE] for $F'+
-  'PCCPU'#010+
+  '12019_E_Cannot create specified whole program o','ptimisation feedback '+
+  'file "$1"'#000+
+  '11023_Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPC'+
+  'CPU'#010+
   'Copyright (c) 1993-2013 by Florian Klaempfl and others'#000+
   '11024_Free Pascal Compiler version $FPCVERSION'#010+
   #010+
   'Compiler Date      : $FPCDATE'#010+
-  'Compiler CPU Target: $FPCCPU'#010+
+  'Co','mpiler CPU Target: $FPCCPU'#010+
   #010+
   'Supported targets:'#010+
   '  $OSTARGETS'#010+
   #010+
-  'Sup','ported CPU instruction sets:'#010+
+  'Supported CPU instruction sets:'#010+
   '  $INSTRUCTIONSETS'#010+
   #010+
   'Supported FPU instruction sets:'#010+
@@ -1204,11 +1209,11 @@ const msgtxt : array[0..000287,1..240] of char=(
   '  $ABITARGETS'#010+
   #010+
   'Supported Optimizations:'#010+
-  '  $OPTIMIZATIONS'#010+
+  '  $OPTIMI','ZATIONS'#010+
   #010+
   'Supported Whole Program Optimizations:'#010+
   '  All'#010+
-  '  $WPOPTIM','IZATIONS'#010+
+  '  $WPOPTIMIZATIONS'#010+
   #010+
   'Supported Microcontroller types:'#010+
   '  $CONTROLLERTYPES'#010+
@@ -1216,248 +1221,248 @@ const msgtxt : array[0..000287,1..240] of char=(
   'This program comes under the GNU General Public Licence'#010+
   'For more information read COPYING.v2'#010+
   #010+
-  'Please report bugs in our bug tracker on:'#010+
-  '                 http://bugs.freepascal.o','rg'#010+
+  'Please report bugs ','in our bug tracker on:'#010+
+  '                 http://bugs.freepascal.org'#010+
   #010+
   'More information may be found on our WWW pages (including directions'#010+
   'for mailing lists useful for asking questions or discussing potential'#010+
   'new features, etc.):'#010+
-  '                 http://www.freepascal.org'#000+
-  '11025_**0*_Put + after a boolean ','switch option to enable it, - to di'+
-  'sable it'#010+
+  '            ','     http://www.freepascal.org'#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 assembler file'#010+
   '**2al_List sourcecode lines in assembler file'#010+
-  '**2an_List node info in assembler file (-dEXTDEBUG compiler)'#010+
-  '*L2ap_Use pipes instead of ','creating temporary assembler files'#010+
+  '**2an_List node info in ','assembler file (-dEXTDEBUG compiler)'#010+
+  '*L2ap_Use pipes instead of creating temporary assembler files'#010+
   '**2ar_List register allocation/release info in assembler file'#010+
   '**2at_List temp allocation/release info in assembler file'#010+
-  '**1A<x>_Output format:'#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*2Anasmwin32_Win32 object file using Nasm'#010+
-  '3*2Anasmwdosx_Win32/WDOSX object file using Nasm'#010,
+  '3*2Anasmwin32_Win32 object f','ile 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*2Atasm_Obj file using Tasm (Borland)'#010+
-  '3*2Aelf_ELF (Linux) using internal writer'#010+
+  '3*2Aelf_ELF (Linux) using ','internal writer'#010+
   '3*2Acoff_COFF (Go32v2) using internal writer'#010+
-  '3*2','Apecoff_PE-COFF (Win32) using internal writer'#010+
+  '3*2Apecoff_PE-COFF (Win32) using internal writer'#010+
   '4*2Aas_Assemble using GNU AS'#010+
   '4*2Agas_Assemble using GNU GAS'#010+
   '4*2Agas-darwin_Assemble darwin Mach-O64 using GNU GAS'#010+
-  '4*2Amasm_Win64 object file using ml64 (Microsoft)'#010+
-  '4*2Apecoff_PE-COFF (Win64) usi','ng internal writer'#010+
+  '4*2Amasm_Win64 o','bject file using ml64 (Microsoft)'#010+
+  '4*2Apecoff_PE-COFF (Win64) using internal writer'#010+
   '4*2Aelf_ELF (Linux-64bit) using internal writer'#010+
   '6*2Aas_Unix o-file using GNU AS'#010+
   '6*2Agas_GNU Motorola assembler'#010+
   '6*2Amit_MIT Syntax (old GAS)'#010+
-  '6*2Amot_Standard Motorola assembler'#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_Build all modules'#010+
   '**1C<x>_Code generation options:'#010+
-  '**2C3<x>_Turn on ieee error checking for constants'#010+
-  '**2Ca<x>_Select ABI, see fpc -i',' for possible values'#010+
+  '**2C3<x>_Turn on i','eee error checking for constants'#010+
+  '**2Ca<x>_Select ABI, see fpc -i for possible values'#010+
   '**2Cb_Generate code for a big-endian variant of the target architectur'+
   'e'#010+
   '**2Cc<x>_Set default calling convention to <x>'#010+
-  '**2CD_Create also dynamic library (not supported)'#010+
-  '**2Ce_Compilation with emulated floating point opc','odes'#010+
+  '**2CD_Create also dynamic library (n','ot supported)'#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+
   '**2CF<x>_Minimal floating point constant precision (default, 32, 64)'#010+
   '**2Cg_Generate PIC code'#010+
-  '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+
-  '**2Ci_IO-checki','ng'#010+
+  '**2','Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+
+  '**2Ci_IO-checking'#010+
   '**2Cn_Omit linking stage'#010+
   'P*2CN_Generate nil-pointer checks (AIX-only)'#010+
   '**2Co_Check overflow of integer operations'#010+
   '**2CO_Check for possible overflow of integer operations'#010+
-  '**2Cp<x>_Select instruction set, see fpc -i for possible values'#010+
-  '**2C','P<x>=<y>_ packing settings'#010+
+  '**2C','p<x>_Select instruction set, see fpc -i for possible values'#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_Verify object method call validity'#010+
-  '**2Cs<n>_Set stack checking size to <n>'#010+
-  '**2Ct_Stack checking (for testing o','nly, see manual)'#010+
+  '**2Cs<n>_Se','t stack checking size to <n>'#010+
+  '**2Ct_Stack checking (for testing only, see manual)'#010+
   'p*2CT<x>_Target-specific code generation options'#010+
   'P*2CT<x>_Target-specific code generation options'#010+
   'J*2CT<x>_Target-specific code generation options'#010+
-  'A*2CT<x>_Target-specific code generation options'#010+
-  'p*3CTsmalltoc_ Generate sma','ller TOCs at the expense of execution spe'+
-  'ed (AIX)'#010+
+  'A*2CT<x>_Tar','get-specific code generation options'#010+
+  'p*3CTsmalltoc_ Generate smaller TOCs at the expense of execution speed'+
+  ' (AIX)'#010+
   'P*3CTsmalltoc_ Generate smaller TOCs at the expense of execution speed'+
   ' (AIX)'#010+
-  'J*3CTcompactintarrayinit_ Generate smaller (but potentially slower) co'+
-  'de for initializing integer array constants',#010+
+  'J*3CTcompactintarrayinit_ Generate smaller (but p','otentially slower) '+
+  'code for initializing integer array constants'#010+
   'J*3CTenumfieldinit_ Initialize enumeration fields in constructors to e'+
   'numtype(0), after calling inherited constructors'#010+
-  'J*3CTautogetterprefix=X_ Automatically create getters for properties w'+
-  'ith prefix X (empty string disables)'#010+
-  'J*3CTautosett','erprefix=X_ Automatically create setters for properties'+
+  'J*3CTautogetterprefix=X_ Automatically create getters fo','r properties'+
   ' with prefix X (empty string disables)'#010+
+  'J*3CTautosetterprefix=X_ Automatically create setters for properties w'+
+  'ith prefix X (empty string disables)'#010+
   'A*3CTthumbinterworking_ Generate Thumb interworking-safe code if possi'+
   'ble'#010+
-  'J*2Cv_Var/out parameter copy-out checking'#010+
-  '**2CX_Create also smartlinked ','library'#010+
+  'J*2Cv_Va','r/out parameter copy-out checking'#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+
   '**2Dv<x>_Set DLL version to <x>'#010+
   '*O2Dw_PM application'#010+
-  '**1e<x>_Set path to executable'#010+
+  '**1e<x>_Set path to executa','ble'#010+
   '**1E_Same as -Cn'#010+
   '**1fPIC_Same as -Cg'#010+
-  '**1F<x>_Set file names ','and paths:'#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+
   '**2Fc<x>_Set input codepage to <x>'#010+
   '**2FC<x>_Set RC compiler binary name to <x>'#010+
-  '**2Fd_Disable the compiler'#039's internal directory cache'#010+
-  '**2FD<x>_Set the direc','tory where to search for compiler utilities'#010+
+  '**2Fd_Disabl','e 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+
   '**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+
+  '**2F','i<x>_Add <x> to include path'#010+
   '**2Fl<x>_Add <x> to library path'#010+
-  '**','2FL<x>_Use <x> as dynamic linker'#010+
+  '**2FL<x>_Use <x> as dynamic linker'#010+
   '**2Fm<x>_Load unicode conversion table from <x>.txt in the compiler di'+
   'r'#010+
   '**2Fo<x>_Add <x> to object path'#010+
   '**2Fr<x>_Load error message file <x>'#010+
-  '**2FR<x>_Set resource (.res) linker to <x>'#010+
-  '**2Fu<x>_Add <x> to uni','t path'#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>_Load previously stored whole-program optimization feedback fr'+
-  'om <x>'#010+
-  '*g1g_Generate debug information (def','ault format for target)'#010+
+  '**2Fw<x>_Load previously stored whole-program opt','imization feedback '+
+  'from <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+
-  '*g2gl_Use line info unit (show more info with backtraces)'#010+
+  '*g2gl_Use line info unit (show more info with backtra','ces)'#010+
   '*g2go<x>_Set debug information options'#010+
-  '*g3godwarfsets_ Enab','le DWARF '#039'set'#039' type debug information (b'+
-  'reaks gdb < 6.5)'#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+
-  '*g3godwarfmethodclassprefix_ Prefix method names in DWARF with class n'+
-  'ame'#010+
-  '*g2gp_Preserve case in stabs symbol na','mes'#010+
+  '*g3godwarfmethodclassprefix_ Prefix method names',' in DWARF with class'+
+  ' name'#010+
+  '*g2gp_Preserve case in stabs symbol names'#010+
   '*g2gs_Generate Stabs debug information'#010+
   '*g2gt_Trash local variables (to detect uninitialized uses)'#010+
   '*g2gv_Generates programs traceable with Valgrind'#010+
-  '*g2gw_Generate DWARFv2 debug information (same as -gw2)'#010+
-  '*g2gw2_Generate DWARFv2 debug inf','ormation'#010+
+  '*g2gw_Generate DWARFv2 de','bug information (same as -gw2)'#010+
+  '*g2gw2_Generate DWARFv2 debug information'#010+
   '*g2gw3_Generate DWARFv3 debug information'#010+
   '*g2gw4_Generate DWARFv4 debug information (experimental)'#010+
   '**1i_Information'#010+
   '**2iD_Return compiler date'#010+
-  '**2iV_Return short compiler version'#010+
+  '**2iV_Return short compi','ler version'#010+
   '**2iW_Return full compiler version'#010+
-  '**2iSO_Return com','piler OS'#010+
+  '**2iSO_Return compiler OS'#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+
   '**1k<x>_Pass <x> to the linker'#010+
-  '**1l_Write logo'#010+
+  '**1l_Write ','logo'#010+
   '**1M<x>_Set language mode to <x>'#010+
-  '**2Mfpc_Free Pascal dialec','t (default)'#010+
+  '**2Mfpc_Free Pascal dialect (default)'#010+
   '**2Mobjfpc_FPC mode with Object Pascal support'#010+
   '**2Mdelphi_Delphi 7 compatibility mode'#010+
   '**2Mtp_TP/BP 7.0 compatibility mode'#010+
-  '**2Mmacpas_Macintosh Pascal dialects compatibility mode'#010+
+  '**2Mmacpas_Macintosh Pascal dialects compa','tibility mode'#010+
   '**1n_Do not read the default config files'#010+
-  '**1o<x>_','Change the name of the executable produced to <x>'#010+
+  '**1o<x>_Change the name of the executable produced to <x>'#010+
   '**1O<x>_Optimizations:'#010+
   '**2O-_Disable optimizations'#010+
   '**2O1_Level 1 optimizations (quick and debugger friendly)'#010+
-  '**2O2_Level 2 optimizations (-O1 + quick optimizations)'#010+
-  '**2O3_Level 3 optimizatio','ns (-O2 + slow optimizations)'#010+
+  '**2O2_Level 2 opt','imizations (-O1 + quick optimizations)'#010+
+  '**2O3_Level 3 optimizations (-O2 + slow optimizations)'#010+
   '**2O4_Level 4 optimizations (-O3 + optimizations which might have unex'+
   'pected side effects)'#010+
   '**2Oa<x>=<y>_Set alignment'#010+
-  '**2Oo[NO]<x>_Enable or disable optimizations, see fpc -i for possible '+
-  'values'#010+
-  '**2Op<x>_Set ta','rget cpu for optimizing, see fpc -i for possible valu'+
-  'es'#010+
+  '**2Oo[NO]<x>_Enable or disab','le optimizations, see fpc -i for possibl'+
+  'e values'#010+
+  '**2Op<x>_Set target cpu for optimizing, see fpc -i for possible values'+
+  #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 valu','es'#010+
+  '**2Ow<x>_Perf','orm whole-program optimization <x>, see fpc -i for poss'+
+  'ible values'#010+
   '**2Os_Optimize for size rather than speed'#010+
   '**1pg_Generate profile code for gprof (defines FPC_PROFILE)'#010+
   'F*1P<x>_Target CPU / compiler related options:'#010+
-  'F*2PB_Show default compiler binary'#010+
+  'F*2PB_Show default compi','ler binary'#010+
   'F*2PP_Show default target cpu'#010+
-  'F*2P<x>_Set target CPU ','(arm,i386,m68k,mips,mipsel,powerpc,powerpc64,'+
-  'sparc,x86_64'#010+
+  'F*2P<x>_Set target CPU (arm,i386,m68k,mips,mipsel,powerpc,powerpc64,sp'+
+  'arc,x86_64'#010+
   '**1R<x>_Assembler reading style:'#010+
   '**2Rdefault_Use default assembler for target'#010+
   '3*2Ratt_Read AT&T style assembler'#010+
-  '3*2Rintel_Read Intel style assembler'#010+
-  '6*2RMOT_Read motorola style assem','bler'#010+
+  '3*2Rin','tel_Read Intel style assembler'#010+
+  '6*2RMOT_Read motorola style assembler'#010+
   '**1S<x>_Syntax options:'#010+
   '**2S2_Same as -Mobjfpc'#010+
   '**2Sc_Support operators like C (*=,+=,/= and -=)'#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 af','ter the <n> errors (default is 1)'#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*_w : Compiler also halts after warnings'#010+
   '**3*_n : Compiler also halts after notes'#010+
   '**3*_h : Compiler also halts after hints'#010+
-  '**2Sg_Enable LABEL and GOTO (default in -Mtp and -Mdelphi)'#010+
-  '**2Sh_Use reference c','ounted strings (ansistring by default) instead '+
-  'of shortstrings'#010+
+  '**2Sg_Enable LAB','EL and GOTO (default in -Mtp and -Mdelphi)'#010+
+  '**2Sh_Use reference counted strings (ansistring by default) instead of'+
+  ' shortstrings'#010+
   '**2Si_Turn on inlining of procedures/functions declared as "inline"'#010+
   '**2Sk_Load fpcylix unit'#010+
-  '**2SI<x>_Set interface style to <x>'#010+
+  '**2SI<x>_Set interfac','e style to <x>'#010+
   '**3SIcom_COM compatible interface (default)'#010+
-  '**3SI','corba_CORBA compatible interface'#010+
+  '**3SIcorba_CORBA compatible interface'#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+
-  '**2Sy_@<pointer> returns',' a typed pointer, same as $T+'#010+
+  '**2Sx_Enable exception ke','ywords (default in Delphi/ObjFPC modes)'#010+
+  '**2Sy_@<pointer> returns a typed pointer, same as $T+'#010+
   '**1s_Do not call assembler and linker'#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+
+  '**2sr_Skip register allocation',' phase (use with -alr)'#010+
   '**1T<x>_Target operating system:'#010+
-  '3*2Tdarw','in_Darwin/Mac OS X'#010+
+  '3*2Tdarwin_Darwin/Mac OS X'#010+
   '3*2Temx_OS/2 via EMX (including EMX/RSX extender)'#010+
   '3*2Tfreebsd_FreeBSD'#010+
   '3*2Tgo32v2_Version 2 of DJ Delorie DOS extender'#010+
-  '3*2Tiphonesim_ iPhoneSimulator from iOS SDK 3.2+ (older versions: -Tda'+
-  'rwin)'#010+
+  '3*2Tiphonesim_ iPhoneSimulator from iOS',' SDK 3.2+ (older versions: -T'+
+  'darwin)'#010+
   '3*2Tlinux_Linux'#010+
-  '3*2Tnativen','t_Native NT API (experimental)'#010+
+  '3*2Tnativent_Native NT API (experimental)'#010+
   '3*2Tnetbsd_NetBSD'#010+
   '3*2Tnetware_Novell Netware Module (clib)'#010+
   '3*2Tnetwlibc_Novell Netware Module (libc)'#010+
   '3*2Topenbsd_OpenBSD'#010+
-  '3*2Tos2_OS/2 / eComStation'#010+
+  '3*2Tos2_OS/2 / eComStati','on'#010+
   '3*2Tsunos_SunOS/Solaris'#010+
   '3*2Tsymbian_Symbian OS'#010+
-  '3*2Tsolaris_So','laris'#010+
+  '3*2Tsolaris_Solaris'#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*2Tdarwin_Darwin/Mac OS X'#010+
   '4*2Tlinux_Linux'#010+
-  '4*2Twin64_Win64 (64 bit Windows systems)'#010+
+  '4*2Twin64_','Win64 (64 bit Windows systems)'#010+
   '6*2Tamiga_Commodore Amiga'#010+
-  '6*2Tata','ri_Atari ST/STe/TT'#010+
+  '6*2Tatari_Atari ST/STe/TT'#010+
   '6*2Tlinux_Linux'#010+
   '6*2Tpalmos_PalmOS'#010+
   'A*2Tdarwin_Darwin/iPhoneOS/iOS'#010+
@@ -1465,120 +1470,121 @@ const msgtxt : array[0..000287,1..240] of char=(
   'A*2Twince_Windows CE'#010+
   'P*2Tamiga_AmigaOS'#010+
   'P*2Tdarwin_Darwin/Mac OS X'#010+
-  'P*2Tlinux_Linux'#010+
+  'P*2Tlinux_','Linux'#010+
   'P*2Tmacos_Mac OS (classic)'#010+
   'P*2Tmorphos_MorphOS'#010+
-  'S*2Tsolaris','_Solaris'#010+
+  'S*2Tsolaris_Solaris'#010+
   'S*2Tlinux_Linux'#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 release unit files (nev','er 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*_n : Show notes                  t : Show tried/us','ed files'#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*_i : Show general info           d : Show debug info'#010+
-  '**2*_l : Show linenumbers            r : Rhide/GCC compatibility mode'#010+
-  '**2*_s : Show time stamps            q : Show',' message numbers'#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 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 debugging info'#010+
+  '**2*_    with ful','l path              v : Write fpcdebug.txt with'#010+
+  '**2*_                                    lots of debugging info'#010+
   '**2*_m<x>,<y> : Don'#039't show messages numbered <x> and <y>'#010+
   'F*1V<x>_Append '#039'-<x>'#039' to the used compiler binary name (e.g. f'+
-  'or version)'#010+
+  'or versio','n)'#010+
   '**1W<x>_Target-specific options (targets)'#010+
-  '3*2WA_Specify nativ','e type application (Windows)'#010+
+  '3*2WA_Specify native type application (Windows)'#010+
   '4*2WA_Specify native type application (Windows)'#010+
   'A*2WA_Specify native type application (Windows)'#010+
-  '3*2Wb_Create 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_Creat','e a bundle instead of a library (Darwin)'#010+
+  'p*2Wb_Create a bundle instead of a library (Darwin)'#010+
   'A*2Wb_Create a bundle instead of a library (Darwin)'#010+
   '4*2Wb_Create a bundle instead of a library (Darwin)'#010+
-  '3*2WB_Create a relocatable image (Windows, Symbian)'#010+
-  '3*2WBxxxx_Set image base to xxxx (Windows, ','Symbian)'#010+
+  '3*2WB_Create a relocatable imag','e (Windows, Symbian)'#010+
+  '3*2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+
   '4*2WB_Create a relocatable image (Windows)'#010+
   '4*2WBxxxx_Set image base to xxxx (Windows)'#010+
   'A*2WB_Create a relocatable image (Windows, Symbian)'#010+
-  'A*2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+
-  '3*2WC_Specify console type application (E','MX, OS/2, Windows)'#010+
+  'A*2WBxxxx_Set image base to x','xxx (Windows, Symbian)'#010+
+  '3*2WC_Specify console type application (EMX, OS/2, Windows)'#010+
   '4*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+
-  '3*2WD_Use DEFFILE to export functions of DLL or EXE (Win','dows)'#010+
+  'P*2WC_Specify console type application (Classic ','Mac OS)'#010+
+  '3*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
   '4*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+
-  'A*2We_Use external resources (Darw','in)'#010+
+  '4*2We_Us','e external resources (Darwin)'#010+
+  'A*2We_Use external resources (Darwin)'#010+
   'P*2We_Use external resources (Darwin)'#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+
-  '4*2WG_Specify graphic type application (EMX, ','OS/2, Windows)'#010+
+  '3*2WG_Specify graphic type application (E','MX, OS/2, Windows)'#010+
+  '4*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 internal resources (Darwin)'#010+
-  '4*2Wi_Use internal resources (Darwin)'#010+
+  '4*2Wi_Use internal',' resources (Darwin)'#010+
   'A*2Wi_Use internal resources (Darwin)'#010+
-  'P*2Wi_','Use internal resources (Darwin)'#010+
+  'P*2Wi_Use internal resources (Darwin)'#010+
   'p*2Wi_Use internal resources (Darwin)'#010+
   '3*2WI_Turn on/off the usage of import sections (Windows)'#010+
-  '4*2WI_Turn on/off the usage of import sections (Windows)'#010+
-  'A*2WI_Turn on/off the usage of import sections (Windows)',#010+
+  '4*2WI_Turn on/off the usage of import sections (W','indows)'#010+
+  'A*2WI_Turn on/off the usage of import sections (Windows)'#010+
   '8*2Wm<x>_Set memory model'#010+
   '8*3WmTiny_Tiny memory model'#010+
   '8*3WmSmall_Small memory model (default)'#010+
   '3*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
   'n)'#010+
-  '4*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
-  'n)',#010+
+  '4*2WM<x>','_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Dar'+
+  'win)'#010+
   'p*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
   'n)'#010+
   'P*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+
   'n)'#010+
-  '3*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
-  '4*2WN_Do not generate r','elocation code, needed for debugging (Windows'+
+  '3*2WN_Do not generate relocat','ion code, needed for debugging (Windows'+
   ')'#010+
+  '4*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
   'A*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
-  'A*2Wpxxxx_Specify the controller type, see fpc -i for possible values'#010+
-  'V*2Wpxxxx_Specify the controller type, see fpc -i for',' possible value'+
+  'A*2Wpxxxx_Specify the controller type, see fpc -i for possi','ble value'+
   's'#010+
+  'V*2Wpxxxx_Specify the controller type, see fpc -i for possible values'#010+
   '3*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ... (iphonesim)'#010+
   'A*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ... (Darwin)'#010+
-  '3*2WR_Generate relocation code (Windows)'#010+
+  '3*2WR_Generate relocatio','n code (Windows)'#010+
   '4*2WR_Generate relocation code (Windows)'#010+
-  'A*2WR_','Generate relocation code (Windows)'#010+
+  'A*2WR_Generate relocation code (Windows)'#010+
   'P*2WT_Specify MPW tool type application (Classic Mac OS)'#010+
   '**2WX_Enable executable stack (Linux)'#010+
   '**1X_Executable options:'#010+
-  '**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Lin'+
-  'ux)'#010+
-  '**2Xd_Do no','t search default library path (sometimes required for cro'+
-  'ss-compiling when not using -XR)'#010+
+  '**2Xc_Pass --shared/-','dynamic to the linker (BeOS, Darwin, FreeBSD, L'+
+  'inux)'#010+
+  '**2Xd_Do not search default library path (sometimes required for cross'+
+  '-compiling when not using -XR)'#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+
+  '**2Xg_Create debuginfo in a separate file and add a debuglin','k sectio'+
+  'n to executable'#010+
+  '**2XD_Try to link units dynamically      (defines FPC_LINK_DYNAMIC)'#010+
   '**2Xi_Use internal linker'#010+
   '**2Xm_Generate link map'#010+
   '**2XM<x>_Set the name of the '#039'main'#039' program routine (default i'+
   's '#039'main'#039')'#010+
-  'F*2Xp<x>_First search for the compiler binary in the directory <x>'#010+
-  '**2XP<x>_Prepend the bi','nutils names with the prefix <x>'#010+
+  'F*2Xp<x>_First search for ','the compiler binary in the directory <x>'#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, FreeBSD'+
-  ', Linux, Mac',' OS, Solaris)'#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+
   '**2XS_Try to link units statically (default, defines FPC_LINK_STATIC)'#010+
-  '**2Xt_Link with static libraries (-static is passed to linker)'#010+
-  '**2XX_Try to smartlink units             (defines FPC','_LINK_SMART)'#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'
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index 91310ca..0d8f228 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -965,7 +965,7 @@ implementation
             symtablestack.top.insert(aprocsym);
           end;
 
-        if procparsemode=ppm_anonymous_routine then
+        if procparsemode in [ppm_anonymous_routine,ppm_method_reference] then
           begin
             pd:=tprocdef.create(normal_function_level);
             include(pd.procoptions,po_anonymous);
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index c05c103..2149c4f 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -2403,6 +2403,32 @@ implementation
              result:=false;
            end;
 
+         function is_captured(sym: tsym):boolean;
+           var
+             st : TSymtable;
+             found : boolean;
+             proccnt : integer;
+             checkstack : psymtablestackitem = nil;
+           begin
+             if not assigned(current_procinfo) or
+                not (sym.typ in [localvarsym,paravarsym]) then
+               exit(false);
+             checkstack:=symtablestack.stack;
+             result:=true;
+             found:=false;
+             proccnt:=0; { TODO: find less tricky way }
+             while not found and assigned(checkstack) do
+               begin
+                 st:=checkstack^.symtable;
+                 if st.symtablelevel=normal_function_level then
+                   inc(proccnt);
+                 if sym.owner=st then
+                   found:=true;
+                 checkstack:=checkstack^.next;
+               end;
+             result:=(proccnt>2); // each procedure have 2 symtables
+           end;
+
          var
            srsym : tsym;
            srsymtable : TSymtable;
@@ -2581,8 +2607,17 @@ implementation
                           p1:=csubscriptnode.create(srsym,p1);
                       end
                     else
-                      { regular non-field load }
-                      p1:=cloadnode.create(srsym,srsymtable);
+                      begin
+                        { regular non-field load }
+                        if not is_captured(srsym) then
+                          p1:=cloadnode.create(srsym,srsymtable)
+                        else
+                          begin
+                            { Capture of local variables is forbidden. Will be supported with closures. }
+                            message1(parser_e_proc_capture_not_allowed,srsym.realname);
+                            p1:=cerrornode.create;
+                          end;
+                      end;
                   end;
 
                 syssym :
-- 
1.8.1.2


From d2191f274443853b20ceabc98a187b5c84de2a74 Mon Sep 17 00:00:00 2001
From: Vasiliy Kevroletin <kevroletin@gmail.com>
Date: Mon, 3 Jun 2013 00:09:59 +1100
Subject: [PATCH 3/4] Add modeswitch m_anonymous_proc.

Restrict usage of anonymous functions by new modeswitch. Currently disabled for all modes.
---
 compiler/globtype.pas |  6 ++++--
 compiler/pexpr.pas    | 19 ++++++++++---------
 compiler/ptype.pas    |  2 +-
 3 files changed, 15 insertions(+), 12 deletions(-)

diff --git a/compiler/globtype.pas b/compiler/globtype.pas
index 570bb89..289cabe 100644
--- a/compiler/globtype.pas
+++ b/compiler/globtype.pas
@@ -372,8 +372,9 @@ interface
          m_final_fields,        { allows declaring fields as "final", which means they must be initialised
                                   in the (class) constructor and are constant from then on (same as final
                                   fields in Java) }
-         m_default_unicodestring { makes the default string type in $h+ mode unicodestring rather than
+         m_default_unicodestring,{ makes the default string type in $h+ mode unicodestring rather than
                                    ansistring; similarly, char becomes unicodechar rather than ansichar }
+         m_anonymous_procedure  { support anonymous functions }
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -536,7 +537,8 @@ interface
          'ISOUNARYMINUS',
          'SYSTEMCODEPAGE',
          'FINALFIELDS',
-         'UNICODESTRINGS');
+         'UNICODESTRINGS',
+         'ANONYMOUSPROC');
 
 
      type
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 2149c4f..6d49f0d 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -2410,7 +2410,8 @@ implementation
              proccnt : integer;
              checkstack : psymtablestackitem = nil;
            begin
-             if not assigned(current_procinfo) or
+             if not (m_anonymous_procedure in current_settings.modeswitches) or
+                not assigned(current_procinfo) or
                 not (sym.typ in [localvarsym,paravarsym]) then
                exit(false);
              checkstack:=symtablestack.stack;
@@ -3348,14 +3349,14 @@ implementation
                consume(_RKLAMMER);
                p1:=cinlinenode.create(in_objc_protocol_x,false,p1);
              end;
-
-             // anonymous routine
-             _PROCEDURE, _FUNCTION:
-               if assigned(current_procinfo) then
-                 p1:=parse_anonymous_routine(current_procinfo.procdef)
-               else // TODO: support this later? Delphi doesn't
-                 internalerror(20120121);
-
+           else
+             if (token in [_PROCEDURE, _FUNCTION]) and
+                (m_anonymous_procedure in current_settings.modeswitches) then
+                begin
+                  if not assigned(current_procinfo) then
+                    internalerror(20120121);
+                  p1:=parse_anonymous_routine(current_procinfo.procdef);
+                end
              else
                begin
                  Message(parser_e_illegal_expression);
diff --git a/compiler/ptype.pas b/compiler/ptype.pas
index 70ee34b..3063173 100644
--- a/compiler/ptype.pas
+++ b/compiler/ptype.pas
@@ -1685,7 +1685,7 @@ implementation
              else
                expr_type;
            _ID:
-             if idtoken=_REFERENCE then
+             if (idtoken=_REFERENCE) and (m_anonymous_procedure in current_settings.modeswitches) then
                begin
                  consume(_REFERENCE); consume(_TO);
                  def:=procvar_dec(genericdef,genericlist);
-- 
1.8.1.2


From 3439479a530c756d46112a0dbca01f1616e464bc Mon Sep 17 00:00:00 2001
From: Vasiliy Kevroletin <kevroletin@gmail.com>
Date: Fri, 31 May 2013 02:24:17 +1100
Subject: [PATCH 4/4] Add tests for anonymous functions.

Tests cover
+ basic usage of anonymous function
+ access of free variables *which is currently fail*(variables which are used in body but not parameters and not declared inside this function).
+ use of modeswitch
+ initialization of procvar in "var" section
+ test for ppu loading (anonymous function declared inside inline function)
---
 tests/test/tanonymproc1.pp   | 46 +++++++++++++++++++++++++++++
 tests/test/tanonymproc10.pp  | 30 +++++++++++++++++++
 tests/test/tanonymproc11.pp  | 22 ++++++++++++++
 tests/test/tanonymproc12.pp  | 22 ++++++++++++++
 tests/test/tanonymproc2.pp   | 70 ++++++++++++++++++++++++++++++++++++++++++++
 tests/test/tanonymproc3.pp   | 49 +++++++++++++++++++++++++++++++
 tests/test/tanonymproc4.pp   | 49 +++++++++++++++++++++++++++++++
 tests/test/tanonymproc5.pp   | 51 ++++++++++++++++++++++++++++++++
 tests/test/tanonymproc6.pp   | 31 ++++++++++++++++++++
 tests/test/tanonymproc7.pp   | 25 ++++++++++++++++
 tests/test/tanonymproc8.pp   | 19 ++++++++++++
 tests/test/tanonymproc9.pp   | 21 +++++++++++++
 tests/test/tfanonymproc1.pp  | 14 +++++++++
 tests/test/tfanonymproc10.pp |  9 ++++++
 tests/test/tfanonymproc11.pp | 19 ++++++++++++
 tests/test/tfanonymproc2.pp  | 14 +++++++++
 tests/test/tfanonymproc3.pp  | 14 +++++++++
 tests/test/tfanonymproc4.pp  | 15 ++++++++++
 tests/test/tfanonymproc5.pp  | 15 ++++++++++
 tests/test/tfanonymproc6.pp  | 13 ++++++++
 tests/test/tfanonymproc7.pp  | 12 ++++++++
 tests/test/tfanonymproc8.pp  | 25 ++++++++++++++++
 tests/test/tfanonymproc9.pp  | 25 ++++++++++++++++
 tests/test/uanonymproc1.pp   | 26 ++++++++++++++++
 24 files changed, 636 insertions(+)
 create mode 100644 tests/test/tanonymproc1.pp
 create mode 100644 tests/test/tanonymproc10.pp
 create mode 100644 tests/test/tanonymproc11.pp
 create mode 100644 tests/test/tanonymproc12.pp
 create mode 100644 tests/test/tanonymproc2.pp
 create mode 100644 tests/test/tanonymproc3.pp
 create mode 100644 tests/test/tanonymproc4.pp
 create mode 100644 tests/test/tanonymproc5.pp
 create mode 100644 tests/test/tanonymproc6.pp
 create mode 100644 tests/test/tanonymproc7.pp
 create mode 100644 tests/test/tanonymproc8.pp
 create mode 100644 tests/test/tanonymproc9.pp
 create mode 100644 tests/test/tfanonymproc1.pp
 create mode 100644 tests/test/tfanonymproc10.pp
 create mode 100644 tests/test/tfanonymproc11.pp
 create mode 100644 tests/test/tfanonymproc2.pp
 create mode 100644 tests/test/tfanonymproc3.pp
 create mode 100644 tests/test/tfanonymproc4.pp
 create mode 100644 tests/test/tfanonymproc5.pp
 create mode 100644 tests/test/tfanonymproc6.pp
 create mode 100644 tests/test/tfanonymproc7.pp
 create mode 100644 tests/test/tfanonymproc8.pp
 create mode 100644 tests/test/tfanonymproc9.pp
 create mode 100644 tests/test/uanonymproc1.pp

diff --git a/tests/test/tanonymproc1.pp b/tests/test/tanonymproc1.pp
new file mode 100644
index 0000000..d6b55e6
--- /dev/null
+++ b/tests/test/tanonymproc1.pp
@@ -0,0 +1,46 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ simple anonymous procedure without parameters }
+
+const
+  magic:integer = 1234567890;
+var
+  g_result:integer;
+
+procedure clean_res;
+  begin
+    g_result:=0;
+  end;
+
+procedure set_res;
+  begin
+    g_result:=magic;
+  end;
+
+procedure check_res(num:integer);
+  begin
+    if g_result<>num then Halt(1);
+  end;
+
+type
+  tproc=reference to procedure;
+  
+var
+  p:tproc;
+
+begin
+  clean_res;
+  p:=procedure
+       begin
+         set_res;
+       end;
+  check_res(0);
+  
+  clean_res;
+  p();
+  check_res(magic);
+  
+  clean_res;
+  p;
+  check_res(magic);
+end.
diff --git a/tests/test/tanonymproc10.pp b/tests/test/tanonymproc10.pp
new file mode 100644
index 0000000..5a6a394
--- /dev/null
+++ b/tests/test/tanonymproc10.pp
@@ -0,0 +1,30 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ initialization of procvar in declaration }
+
+uses uanonymproc1;
+
+var
+  ok:boolean=false;  
+  i:reference to procedure(i:boolean) = procedure(val:boolean)
+                                          begin
+                                            ok:=val;
+                                          end;
+
+procedure do_smth;
+  var
+    i:reference to procedure(i:boolean) = procedure(val:boolean)
+                                            begin
+                                              ok:=val;
+                                            end;
+  begin
+    i(true);
+    if not ok then halt(1);
+  end;
+  
+begin
+  i(true);
+  if not ok then halt(1);
+  do_smth;
+  do_smth_inline;
+end.
diff --git a/tests/test/tanonymproc11.pp b/tests/test/tanonymproc11.pp
new file mode 100644
index 0000000..e66e96d
--- /dev/null
+++ b/tests/test/tanonymproc11.pp
@@ -0,0 +1,22 @@
+{$mode delphi}
+{$modeswitch anonymousproc}
+
+const
+  magic:integer=314159265;
+
+type
+  myproc<T> = reference to procedure(num: T);
+
+var
+  p:myproc<Integer>;
+  res:integer;
+
+begin
+  p:=procedure(num: Integer)
+       begin
+         res:=num;
+       end;
+  res:=0;
+  p(magic);
+  if res<>magic then halt(1);
+end.
diff --git a/tests/test/tanonymproc12.pp b/tests/test/tanonymproc12.pp
new file mode 100644
index 0000000..3f2f97b
--- /dev/null
+++ b/tests/test/tanonymproc12.pp
@@ -0,0 +1,22 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+
+const
+  magic:integer=314159265;
+
+type
+  generic myproc<T> = reference to procedure(num: T);
+
+var
+  p:specialize myproc<Integer>;
+  res:integer;
+
+begin
+  p:=procedure(num: Integer)
+       begin
+         res:=num;
+       end;
+  res:=0;
+  p(magic);
+  if res<>magic then halt(1);
+end.
diff --git a/tests/test/tanonymproc2.pp b/tests/test/tanonymproc2.pp
new file mode 100644
index 0000000..998b77d
--- /dev/null
+++ b/tests/test/tanonymproc2.pp
@@ -0,0 +1,70 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ simple anonymous procedure without parameters in nested function }
+
+const
+  magic:integer = 1234567890;
+var
+  g_result:integer;
+
+procedure clean_res;
+  begin
+    g_result:=0;
+  end;
+
+procedure set_res;
+  begin
+    g_result:=magic;
+  end;
+
+procedure check_res(num:integer);
+  begin
+    if g_result<>num then halt(1);
+  end;
+
+type
+  tproc=reference to procedure;
+  
+procedure do_smth;  
+  procedure nested_do_smth;
+    var p:tproc;
+    begin
+      clean_res;
+      p:=procedure
+           begin
+             set_res;
+           end;
+      check_res(0);
+  
+      clean_res;
+      p();
+      check_res(magic);
+  
+      clean_res;
+      p;
+      check_res(magic);
+     end;
+  var
+    p: TProc;
+  begin
+    clean_res;
+    p:=procedure
+         begin
+           set_res;
+         end;
+    check_res(0);
+  
+    clean_res;
+    p();
+    check_res(magic);
+  
+    clean_res;
+    p;
+    check_res(magic);
+    
+    nested_do_smth;
+  end;
+
+begin
+  do_smth;
+end.
diff --git a/tests/test/tanonymproc3.pp b/tests/test/tanonymproc3.pp
new file mode 100644
index 0000000..f8290b5
--- /dev/null
+++ b/tests/test/tanonymproc3.pp
@@ -0,0 +1,49 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ pointer to anonymous procedure returned from function }
+
+const
+  magic:integer = 1234567890;
+var
+  g_result:integer;
+
+procedure clean_res;
+  begin
+    g_result:=0;
+  end;
+
+procedure set_res;
+  begin
+    g_result:=magic;
+  end;
+
+procedure check_res(num:integer);
+  begin
+    if g_result<>num then halt(1);
+  end;
+
+type
+  tproc=reference to procedure;
+  
+function factory:tproc;
+  begin
+    result:=procedure
+              begin
+                set_res;
+              end;
+  end;
+  
+procedure do_things;  
+  var
+    p: TProc;
+  begin
+    clean_res;
+    p:=factory;
+    check_res(0);
+    p();
+    check_res(magic);    
+  end;
+  
+begin
+  do_things;
+end.
diff --git a/tests/test/tanonymproc4.pp b/tests/test/tanonymproc4.pp
new file mode 100644
index 0000000..8167a08
--- /dev/null
+++ b/tests/test/tanonymproc4.pp
@@ -0,0 +1,49 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ anonymous procedure with parameters }
+
+const
+  magic:integer=1234567890;
+  magicstr:string='hello world';
+
+var
+  g_res_num:integer;
+  g_res_str:string;
+
+procedure clean_res;
+  begin
+    g_res_num:=0;
+    g_res_str:='';
+  end;
+
+procedure set_res;
+  begin
+    g_res_num:=magic;
+    g_res_str:=magicstr;
+  end;
+
+procedure check_res(num:integer;str:string);
+  begin
+    if g_res_num<>num then halt(1);
+    if g_res_str<>str then halt(1);
+  end;
+
+type
+  tproc=reference to procedure(num:integer;str:string);
+  
+var
+  p:tproc;
+
+begin
+  clean_res;
+  p:=procedure(num:integer;s:string)
+       begin
+         g_res_num:=num;
+         g_res_str:=s;
+       end;
+  check_res(0, '');
+  
+  clean_res;
+  p(magic, magicstr);
+  check_res(magic, magicstr); 
+end.
diff --git a/tests/test/tanonymproc5.pp b/tests/test/tanonymproc5.pp
new file mode 100644
index 0000000..6755c95
--- /dev/null
+++ b/tests/test/tanonymproc5.pp
@@ -0,0 +1,51 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ anonymous function }
+
+const
+  magic:integer=1234567890;
+  magicret:integer=987654321;
+var
+  g_result:integer;
+
+procedure clean_res;
+  begin
+    g_result:=0;
+  end;
+
+procedure set_res;
+  begin
+    g_result:=magic;
+  end;
+
+procedure check_res(num:Integer);
+  begin
+    if g_result<>num then halt(1);
+  end;
+
+type
+  tproc=reference to function:integer;
+  
+function factory:tproc;
+  begin
+    result:=function:Integer
+              begin
+                set_res;
+                result:=magicret;
+              end;
+  end;
+  
+procedure do_things;  
+  var
+    p: TProc;
+  begin
+    clean_res;
+    p:=factory;
+    check_res(0);
+    if p()<>magicret then halt(1);
+    check_res(magic);
+  end;
+  
+begin
+  do_things;
+end.
diff --git a/tests/test/tanonymproc6.pp b/tests/test/tanonymproc6.pp
new file mode 100644
index 0000000..8abc0b1
--- /dev/null
+++ b/tests/test/tanonymproc6.pp
@@ -0,0 +1,31 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ anonymous routine have inner function }
+
+const
+  magicstr:string='hello';
+  magicstrlen:integer=5;
+
+type
+  tproc=reference to procedure(num:integer;s:string);
+ 
+procedure do_things;  
+  var
+    p:tproc;
+  begin
+    p:=procedure(num:integer;s:string)
+         function inner(ss:string):integer;
+           begin
+             result:=length(ss);
+           end;
+         var b:Integer;
+         begin
+           b:=inner(s);
+           if b<>num then halt(1);
+         end;
+    p(magicstrlen,magicstr);
+  end;
+  
+begin
+  do_things;
+end.
diff --git a/tests/test/tanonymproc7.pp b/tests/test/tanonymproc7.pp
new file mode 100644
index 0000000..b741c77
--- /dev/null
+++ b/tests/test/tanonymproc7.pp
@@ -0,0 +1,25 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ closure as function argument }
+
+const
+  magic1:integer=123;
+  magic2:integer=321123;
+
+type
+  tfunct=reference to function(num:integer):integer;
+  
+function call(f:tfunct;arg:integer):integer;
+  begin
+   result:=f(arg);
+  end;
+
+var i:integer;
+begin
+  i:=call( function(num:integer):integer
+             begin
+               result:=num+magic2;
+             end,
+           magic1 );
+  if i<>(magic1+magic2) then halt(1);
+end.
diff --git a/tests/test/tanonymproc8.pp b/tests/test/tanonymproc8.pp
new file mode 100644
index 0000000..706403f
--- /dev/null
+++ b/tests/test/tanonymproc8.pp
@@ -0,0 +1,19 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ two anonymous function inside one routine }
+
+const
+  magic1:integer=777;
+  magic2:integer=888;
+
+type
+  tfunct=reference to function:integer;
+  
+var p1,p2:tfunct;
+begin
+  p1:=function: Integer begin result:=magic1; end;
+  p2:=function: Integer begin result:=magic2; end;
+
+  if p1()<>magic1 then halt(1);
+  if p2()<>magic2 then halt(2);
+end.
diff --git a/tests/test/tanonymproc9.pp b/tests/test/tanonymproc9.pp
new file mode 100644
index 0000000..36ed745
--- /dev/null
+++ b/tests/test/tanonymproc9.pp
@@ -0,0 +1,21 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ acces to global variable }
+
+const
+  magic:integer=1234567890;
+
+type
+  tproc=reference to procedure;
+  
+var p:tproc;
+    staticvar:integer;
+begin
+  staticvar:=0;
+  p:=procedure
+       begin
+         staticvar:=magic;
+       end;
+  p();
+  if staticvar<>magic then halt(1);
+end.
diff --git a/tests/test/tfanonymproc1.pp b/tests/test/tfanonymproc1.pp
new file mode 100644
index 0000000..457c7b2
--- /dev/null
+++ b/tests/test/tfanonymproc1.pp
@@ -0,0 +1,14 @@
+{ %fail }
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ incompatible proc and procvar }
+
+var
+  i:reference to procedure(i:integer);
+
+begin
+  i := procedure
+         begin
+         end;
+  i();
+end.
diff --git a/tests/test/tfanonymproc10.pp b/tests/test/tfanonymproc10.pp
new file mode 100644
index 0000000..4befb49
--- /dev/null
+++ b/tests/test/tfanonymproc10.pp
@@ -0,0 +1,9 @@
+{$mode objfpc}
+{ anonymous procedures doesnt work without modeswitch }
+
+var
+  p:reference to procedure;
+  
+begin
+  p:=procedure begin end;
+end.
diff --git a/tests/test/tfanonymproc11.pp b/tests/test/tfanonymproc11.pp
new file mode 100644
index 0000000..e05d468
--- /dev/null
+++ b/tests/test/tfanonymproc11.pp
@@ -0,0 +1,19 @@
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ initialization of procvar in declaration }
+
+procedure do_smth;
+  var
+    ok:boolean;
+    i:reference to procedure(i:boolean) = procedure(val:boolean)
+                                            begin
+                                              ok:=val;
+                                            end;
+  begin
+    i(true);
+    if not ok then halt(1);
+  end;
+  
+begin
+  do_smth;
+end.
diff --git a/tests/test/tfanonymproc2.pp b/tests/test/tfanonymproc2.pp
new file mode 100644
index 0000000..8b71e5a
--- /dev/null
+++ b/tests/test/tfanonymproc2.pp
@@ -0,0 +1,14 @@
+{ %fail }
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ incompatible proc and procvar }
+
+var
+  i:reference to function:integer;
+
+begin
+  i := procedure
+         begin
+         end;
+  i();
+end.
diff --git a/tests/test/tfanonymproc3.pp b/tests/test/tfanonymproc3.pp
new file mode 100644
index 0000000..fde91e3
--- /dev/null
+++ b/tests/test/tfanonymproc3.pp
@@ -0,0 +1,14 @@
+{ %fail }
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ illegal assignment }
+
+var
+  p:reference to function:integer;
+  i:integer;
+
+begin
+  i := procedure
+         begin
+         end;
+end.
diff --git a/tests/test/tfanonymproc4.pp b/tests/test/tfanonymproc4.pp
new file mode 100644
index 0000000..22942a5
--- /dev/null
+++ b/tests/test/tfanonymproc4.pp
@@ -0,0 +1,15 @@
+{ %fail }
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ illegal arithmetics operation }
+
+type
+  TProc = reference to function: Integer;
+
+var
+  p: TProc;
+  i: Integer;
+
+begin
+  i := 10 + procedure begin end;
+end.
diff --git a/tests/test/tfanonymproc5.pp b/tests/test/tfanonymproc5.pp
new file mode 100644
index 0000000..c959d04
--- /dev/null
+++ b/tests/test/tfanonymproc5.pp
@@ -0,0 +1,15 @@
+{ %fail }    
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ call of anonymous function in place }
+
+var
+  i: Integer;
+begin
+
+  // now fpc parser eats first () and stops parsing of right side
+  // delphi parser eats this but fails during runtime
+  i := (function(num: Integer): Integer begin Result := num + 10; end)(5);
+
+  Writeln(i);
+end.
diff --git a/tests/test/tfanonymproc6.pp b/tests/test/tfanonymproc6.pp
new file mode 100644
index 0000000..1d7ae11
--- /dev/null
+++ b/tests/test/tfanonymproc6.pp
@@ -0,0 +1,13 @@
+{ %fail }
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ incompatible proc and and procvar }
+
+var
+  i: reference to procedure(i: Integer);
+
+begin
+  i := procedure
+         begin
+         end;
+end.
diff --git a/tests/test/tfanonymproc7.pp b/tests/test/tfanonymproc7.pp
new file mode 100644
index 0000000..19d4aa2
--- /dev/null
+++ b/tests/test/tfanonymproc7.pp
@@ -0,0 +1,12 @@
+{ %fail }
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ wrong parameter type }
+
+var
+  i: reference to procedure(i:integer);
+
+begin
+  i := procedure(i:integer) begin end;
+  i('hello world');
+end.
diff --git a/tests/test/tfanonymproc8.pp b/tests/test/tfanonymproc8.pp
new file mode 100644
index 0000000..f7ca501
--- /dev/null
+++ b/tests/test/tfanonymproc8.pp
@@ -0,0 +1,25 @@
+{ %fail }
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ closure is wrong function argument }
+
+const
+  magic1:integer=123;
+  magic2:integer=321123;
+
+type
+  tfunct=reference to function(num:integer):integer;
+  
+function call(f:tfunct;arg:integer):integer;
+  begin
+   result:=f(arg);
+  end;
+
+var i:integer;
+begin
+  i:=call( function(s:string):integer
+             begin
+             end,
+           magic1 );
+end.
+
diff --git a/tests/test/tfanonymproc9.pp b/tests/test/tfanonymproc9.pp
new file mode 100644
index 0000000..38780f0
--- /dev/null
+++ b/tests/test/tfanonymproc9.pp
@@ -0,0 +1,25 @@
+{ %fail }
+{$mode objfpc}
+{$modeswitch anonymousproc}
+{ acces to local variables of outer function }
+{ will be possible with closures }
+
+const
+  magic:integer=1234567890;
+
+type
+  tproc=reference to procedure;
+  
+procedure do_smth;
+var p:tproc;
+    localvar:integer;
+begin
+  p:=procedure
+       begin
+         localvar:=magic;
+       end;
+end;
+
+begin
+  do_smth
+end.
diff --git a/tests/test/uanonymproc1.pp b/tests/test/uanonymproc1.pp
new file mode 100644
index 0000000..2129851
--- /dev/null
+++ b/tests/test/uanonymproc1.pp
@@ -0,0 +1,26 @@
+unit uanonymproc1;
+{$mode objfpc}
+{$modeswitch anonymousproc}
+
+interface
+
+procedure do_smth_inline; inline;
+
+var
+  good:boolean=false;
+
+implementation
+
+procedure do_smth_inline; inline;
+  var
+    i:reference to procedure = procedure
+                                 begin
+                                   good:=true;
+                                 end;
+  begin
+    i();
+    if not good then halt(1);
+  end;
+
+begin
+end.
-- 
1.8.1.2

anonymous01.patch (133,611 bytes)

Vasiliy Kevroletin

2013-06-07 17:32

reporter   ~0068115

Last edited: 2013-06-07 17:36

View 2 revisions

I uploaded changes required to parse delphi-like anonymous functions: anonymous01.patch. There is new modeswitch which will allow to use anonymous functions.

I decided to change name of "frame object" to "capturer". This name is shorter and in future I plan to replace one big frame object by little object for each closure. So name frame object which is come from delphi will be confusing.
Also I significantly improved implementation of closures. Currently possible to capture variables. To do this:
1. During parsing: captured variables detected and marked.
2. Each captured variable have clone in corresponding capturer. Access to this variable will be redirected to access of capturer's field.
3. During pass_1: tloadnode of captured variable is replaced by load of capturer + sequence of tsubscriptnodes.
4. For procedures which have capturer I add initialization code to body. It creates capturer and copies captured parameters to capturer's fields-clones.

Current advantages:
+ new code located in one place and have little changes in other code (most changes which can have bad side-effects are in anonymous01.patch).
+ new changes are limited by modeswitch, they should not break something if user doesn't use closures (except anonymous01.patch).
+ there are only transformations of syntax tree and generation of new classes; no changes and use of code generator.

Current problems are:
- captured variables are not removed from procedure symtable
- generated code is not optimal:
  - capturer contains all captured variables of current procedure
  - we create capturer for each procedure which are on path from closure to captured variable (look into tclosure6.pp in attached files. access to captured variable will cause 10 dereferences).

I didn't remove is_closure flag to keep implementation simple. Now there is small amount of changes in few files. I believe that simple not optimal implementation is good first step. Next is refactoring and optimization. And testing between each steps.

Paul Ishenin

2013-06-09 13:13

developer   ~0068150

Vasiliy, if you plan to work on FPC after then maybe better to perform your development in a separate branch for easier review and merge?

Vasiliy Kevroletin

2013-06-10 06:54

reporter   ~0068168

Last edited: 2013-06-10 10:39

View 3 revisions

Hi Paul,

Yes I plan to continue work.
But I prefer to use git. I use svn-like vcs in my official work and have negative impressions about it:). For me git is better for local development of features.

I guess that patch created with git is problem for svn users. Sorry for that. I simply got instructions from http://wiki.freepascal.org/Creating_A_Patch and didn't think about svn. I can provide patches in different format so you will be able to apply and review them.

Iff you want to participate and to submit changes in this "separate feature branch" then separate svn branch is required. But with svn I will produce a lot of bugfixes(like in closures01.patch). Actually anonymous01.patch is result of more than 3 commits. I merged them, changed order of commits and now they are much better than before.
IMO little bugfixes will complicate review even more than fact that changes are not in svn. That is why I prefer to use git.

Sven Barth

2013-06-10 12:15

manager   ~0068185

It might nevertheless be better to ask Florian for a branch. You could work on it using git-svn then and it would be enough if you only present your patch sets that you'd otherwise attach here this way. This way I (or some other dev) can look at your changes through the webview of Subversion instead of scrolling through lines of msgtxt.inc changes (not your fault, but annoying nevertheless...).

I've nevertheless looked at your patch set regarding anonymous procedures and to sum it up you can continue your work. I've not seen any big problematic points only small ones which now follow:

1. Coding style: There are still a few locations where your coding style differs. I'm not doing this to annoy you, but I just don't want to introduce more inconsistencies in the coding style to the compiler than there already is (sidenote: I'm not a fan of that coding style either, but "when in Rome..." ;) )
  - pclosure:
      please don't put the unit names into one long line; structure them a bit by function like done in (most) other compiler units (e.g. global units, parser units, node units, etc.)
  - pdecsub:
    - parse_proc_head and parse_proc_dec declaration
    - as_procparsemode implementation
  - symdef:
      declaration of add_to_procsym
  - pexpr:
      please move "consume(_REFERENCE); consume(_OF);" into seperate lines
  
2. Please move tprocparsemode to globtype and layout it similar to tblock_type (maybe also with comments explaining the purpose of each element)
And forget the idea about an operator overload... the function is enough

3. in parse_proc_head: your usage of orgsp and sp is not consistent with the rest of the unit: orgsp contains the function/procedure name as written by the user while sp contains it in all uppercase. So it might be better to either swap orgsp and sp or write both in uppercase as you don't use user provided patterns for that...

4. pexpr: why did you move the case for "_FUNCTION" and "_PROCEDURE" out into the else in your third patch? You could just check for the modeswitch and otherwise do a "Message(parser_e_illegal_expression)". Also can the internal error be triggered by any code that the user can write? If so it shouldn't be an internal error, but also a "Message(parser_e_illegal_expression)" or so.

5. ptype: I like your restructering of the else-branch of the case :)

6. symdef: add_to_procsym does not need overload modifiers as the compiler is compiled in mode objfpc which does not need them

7. pexpr: a potential alternative to walking the stack in "is_captured" would be to check the owners of syms, defs and symtables (I do this quite a lot with generics). I've not tested it, so I can't say whether this would be a less hacky approach...

8. globtype: I would call the modeswitch "ANONYMOUSPROCEDURES"; no need for abbreviations here :)

9. mainly out of curiosity: does tanonymproc10.pp compile in Delphi?

Did you do regression tests?

To sum it up (again): keep up the good work. :)

Regards,
Sven

Florian

2013-06-10 20:14

administrator   ~0068191

> But I prefer to use git. I use svn-like vcs in my official work and have negative impressions about it:). For me git is better for local development of features.

But please avoid posting patches twice or in different flavours. Having an svn branch which nicely ordered and immutable commits makes reviewing much easier, less error prone and far less tedious using tools like CommitMonitor.

Vasiliy Kevroletin

2013-06-14 15:22

reporter   ~0068303

Hi Sven,
Thanks for review. I will answer and fix issues few days later.

Florian,
Could you friendly create me a branch. My mailbox is kevroletin@gmail.com

rd0x

2018-09-12 21:04

reporter   ~0110706

Any news on this?

Sven Barth

2018-09-21 14:39

manager   ~0110925

It's still being worked on.

Issue History

Date Modified Username Field Change
2013-05-26 11:19 Vasiliy Kevroletin New Issue
2013-05-26 11:19 Vasiliy Kevroletin File Added: closures00.patch
2013-05-26 16:53 Sven Barth Note Added: 0067879
2013-05-26 17:34 Florian Note Added: 0067881
2013-05-26 19:46 Sven Barth Note Added: 0067884
2013-05-26 19:47 Sven Barth Note Edited: 0067884 View Revisions
2013-05-27 00:52 Vasiliy Kevroletin Note Added: 0067893
2013-05-31 13:33 Vasiliy Kevroletin Note Added: 0067961
2013-06-07 16:06 Vasiliy Kevroletin File Added: closures01.patch
2013-06-07 16:06 Vasiliy Kevroletin File Added: anonymous01.patch
2013-06-07 17:32 Vasiliy Kevroletin Note Added: 0068115
2013-06-07 17:36 Vasiliy Kevroletin Note Edited: 0068115 View Revisions
2013-06-09 13:13 Paul Ishenin Note Added: 0068150
2013-06-10 06:54 Vasiliy Kevroletin Note Added: 0068168
2013-06-10 06:55 Vasiliy Kevroletin Note Edited: 0068168 View Revisions
2013-06-10 10:39 Vasiliy Kevroletin Note Edited: 0068168 View Revisions
2013-06-10 12:15 Sven Barth Note Added: 0068185
2013-06-10 20:14 Florian Note Added: 0068191
2013-06-14 15:22 Vasiliy Kevroletin Note Added: 0068303
2018-08-17 21:41 Florian Relationship added has duplicate 0034123
2018-09-12 21:04 rd0x Note Added: 0110706
2018-09-21 14:39 Sven Barth Note Added: 0110925
2019-08-03 10:22 Sven Barth Relationship added parent of 0035922
2019-08-03 10:23 Sven Barth Tag Attached: anonymous functions