diff options
Diffstat (limited to 'closures/compiler')
| -rw-r--r-- | closures/compiler/ncgutil.pas | 13 | ||||
| -rw-r--r-- | closures/compiler/nld.pas | 18 | ||||
| -rw-r--r-- | closures/compiler/pdecobj.pas | 8 | ||||
| -rw-r--r-- | closures/compiler/pexpr.pas | 20 | ||||
| -rw-r--r-- | closures/compiler/symconst.pas | 12 | ||||
| -rw-r--r-- | closures/compiler/symdef.pas | 17 | ||||
| -rw-r--r-- | closures/compiler/symsym.pas | 9 |
7 files changed, 80 insertions, 17 deletions
diff --git a/closures/compiler/ncgutil.pas b/closures/compiler/ncgutil.pas index 093708bf55..be668fd0cb 100644 --- a/closures/compiler/ncgutil.pas +++ b/closures/compiler/ncgutil.pas @@ -3075,9 +3075,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,true); + { if def can contain nested types then handle its symtable } + case def.typ of + objectdef,recorddef: + gen_intf_wrappers(list,tabstractrecorddef(def).symtable,true); + 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,true); + end; if is_class(def) then gen_intf_wrapper(list,tobjectdef(def)); end; diff --git a/closures/compiler/nld.pas b/closures/compiler/nld.pas index 2f2dc872af..fa31b825ed 100644 --- a/closures/compiler/nld.pas +++ b/closures/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) @@ -167,7 +170,7 @@ implementation cutils,verbose,globtype,globals,systems, symnot,symtable, defutil,defcmp, - htypechk,pass_1,procinfo,paramgr, + htypechk,pass_1,procinfo,paramgr,pnameless, cpuinfo, ncon,ninl,ncnv,nmem,ncal,nutils,nbas, cgobj,cgbase @@ -393,6 +396,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/closures/compiler/pdecobj.pas b/closures/compiler/pdecobj.pas index 1c29df2437..098dcc67d1 100644 --- a/closures/compiler/pdecobj.pas +++ b/closures/compiler/pdecobj.pas @@ -268,13 +268,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/closures/compiler/pexpr.pas b/closures/compiler/pexpr.pas index 98002d8b10..2678308a86 100644 --- a/closures/compiler/pexpr.pas +++ b/closures/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, + pbase,pinline,ptype,pgenutil,pnameless, { codegen } cgbase,procinfo,cpuinfo ; @@ -2248,8 +2248,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 : @@ -2946,6 +2953,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/closures/compiler/symconst.pas b/closures/compiler/symconst.pas index 3c40411871..af3ea2c722 100644 --- a/closures/compiler/symconst.pas +++ b/closures/compiler/symconst.pas @@ -320,7 +320,11 @@ type simply not see the frame pointer parameter, and since the caller cleans up the stack will also remain balanced) } po_delphi_nested_cc, - po_rtlproc + po_rtlproc, + // nameless routine (including closure) + po_nameless, + // has at least one closure declared in the body + po_has_closure ); tprocoptions=set of tprocoption; @@ -382,7 +386,11 @@ type oo_is_formal, { the class is only formally defined in this module (x = objcclass; external [name 'x'];) } oo_is_classhelper, { objcclasses that represent categories, and Delpi-style class helpers, are marked like this } oo_has_class_constructor, { the object/class has a class constructor } - oo_has_class_destructor { the object/class has a class destructor } + oo_has_class_destructor, { the object/class has a class destructor } + // 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/closures/compiler/symdef.pas b/closures/compiler/symdef.pas index 6b9852fc52..4dea14eb01 100644 --- a/closures/compiler/symdef.pas +++ b/closures/compiler/symdef.pas @@ -312,7 +312,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; @@ -907,10 +910,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 @@ -968,6 +973,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); @@ -4859,6 +4867,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/closures/compiler/symsym.pas b/closures/compiler/symsym.pas index c91d3e5d80..653867552e 100644 --- a/closures/compiler/symsym.pas +++ b/closures/compiler/symsym.pas @@ -180,11 +180,14 @@ interface defaultconstsymderef : tderef; localloc : TLocation; { register/reference for local var } initialloc : TLocation; { initial location so it can still be initialized later after the location was changed by SSA } + // 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); procedure ppuwrite(ppufile:tcompilerppufile);override; procedure buildderef;override; procedure deref;override; + function is_captured: boolean; inline; end; tlocalvarsym = class(tabstractnormalvarsym) @@ -1397,6 +1400,12 @@ implementation end; + function tabstractnormalvarsym.is_captured: boolean; inline; + begin + result:=assigned(captured_into) + end; + + {**************************************************************************** Tstaticvarsym ****************************************************************************} |