starting from r20123

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/blaise@20126 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 5947 insertions, 0 deletions

diff --git a/closures/compiler/symdef.pas b/closures/compiler/symdef.pas
new file mode 100644
index 0000000000..6b9852fc52
--- /dev/null
+++ b/closures/compiler/symdef.pas
@@ -0,0 +1,5947 @@
+{
+    Symbol table implementation for the definitions
+
+    Copyright (c) 1998-2005 by Florian Klaempfl, Pierre Muller
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ****************************************************************************
+}
+unit symdef;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+       { common }
+       cclasses,
+       { global }
+       globtype,globals,tokens,constexp,
+       { symtable }
+       symconst,symbase,symtype,
+       { ppu }
+       ppu,
+       { node }
+       node,
+       { aasm }
+       aasmbase,aasmtai,aasmdata,
+       cpubase,cpuinfo,
+       cgbase,cgutils,
+       parabase
+       ;
+
+
+    type
+{************************************************
+                    TDef
+************************************************}
+
+       { tstoreddef }
+
+       tstoreddef = class(tdef)
+       protected
+          typesymderef  : tderef;
+       public
+{$ifdef EXTDEBUG}
+          fileinfo   : tfileposinfo;
+{$endif}
+          { generic support }
+          genericdef      : tstoreddef;
+          genericdefderef : tderef;
+          generictokenbuf : tdynamicarray;
+          { Set if PPU was generated with another
+            endianess as current compiler or ppudump utils }
+          change_endian   : boolean;
+          constructor create(dt:tdeftyp);
+          constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
+          destructor  destroy;override;
+          function getcopy : tstoreddef;virtual;
+          procedure ppuwrite(ppufile:tcompilerppufile);virtual;
+          procedure buildderef;override;
+          procedure buildderefimpl;override;
+          procedure deref;override;
+          procedure derefimpl;override;
+          function  size:asizeint;override;
+          function  getvardef:longint;override;
+          function  alignment:shortint;override;
+          function  is_publishable : boolean;override;
+          function  needs_inittable : boolean;override;
+          function  rtti_mangledname(rt:trttitype):string;override;
+          function  OwnerHierarchyName: string; override;
+          function  in_currentunit: boolean;
+          { regvars }
+          function is_intregable : boolean;
+          function is_fpuregable : boolean;
+          { generics }
+          procedure initgeneric;
+       private
+          savesize  : asizeuint;
+       end;
+
+       tfiletyp = (ft_text,ft_typed,ft_untyped);
+
+       tfiledef = class(tstoreddef)
+          filetyp : tfiletyp;
+          typedfiledef : tdef;
+          typedfiledefderef : tderef;
+          constructor createtext;
+          constructor createuntyped;
+          constructor createtyped(def : tdef);
+          constructor ppuload(ppufile:tcompilerppufile);
+          function getcopy : tstoreddef;override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure buildderef;override;
+          procedure deref;override;
+          function  GetTypeName:string;override;
+          function  getmangledparaname:string;override;
+          procedure setsize;
+       end;
+
+       tvariantdef = class(tstoreddef)
+          varianttype : tvarianttype;
+          constructor create(v : tvarianttype);
+          constructor ppuload(ppufile:tcompilerppufile);
+          function getcopy : tstoreddef;override;
+          function GetTypeName:string;override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          function  getvardef:longint;override;
+          procedure setsize;
+          function is_publishable : boolean;override;
+          function needs_inittable : boolean;override;
+       end;
+
+       tformaldef = class(tstoreddef)
+          typed:boolean;
+          constructor create(Atyped:boolean);
+          constructor ppuload(ppufile:tcompilerppufile);
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          function  GetTypeName:string;override;
+       end;
+
+       tforwarddef = class(tstoreddef)
+          tosymname : pshortstring;
+          forwardpos : tfileposinfo;
+          constructor create(const s:string;const pos:tfileposinfo);
+          destructor destroy;override;
+          function getcopy:tstoreddef;override;
+          function GetTypeName:string;override;
+       end;
+
+       tundefineddef = class(tstoreddef)
+          constructor create;
+          constructor ppuload(ppufile:tcompilerppufile);
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          function  GetTypeName:string;override;
+       end;
+
+       terrordef = class(tstoreddef)
+          constructor create;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          function  GetTypeName:string;override;
+          function  getmangledparaname : string;override;
+       end;
+
+       tabstractpointerdef = class(tstoreddef)
+          pointeddef : tdef;
+          pointeddefderef : tderef;
+          constructor create(dt:tdeftyp;def:tdef);
+          constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure buildderef;override;
+          procedure deref;override;
+       end;
+
+       tpointerdef = class(tabstractpointerdef)
+          is_far : boolean;
+          has_pointer_math : boolean;
+          constructor create(def:tdef);
+          constructor createfar(def:tdef);
+          function getcopy:tstoreddef;override;
+          constructor ppuload(ppufile:tcompilerppufile);
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          function  GetTypeName:string;override;
+       end;
+
+       tprocdef = class;
+       { tabstractrecorddef }
+
+       tabstractrecorddef= class(tstoreddef)
+          objname,
+          objrealname    : PShortString;
+          symtable       : TSymtable;
+          cloneddef      : tabstractrecorddef;
+          cloneddefderef : tderef;
+          objectoptions  : tobjectoptions;
+          constructor create(const n:string; dt:tdeftyp);
+          constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          destructor destroy; override;
+          procedure check_forwards; virtual;
+          function find_procdef_bytype(pt:tproctypeoption): tprocdef;
+          function GetSymtable(t:tGetSymtable):TSymtable;override;
+          function is_packed:boolean;
+          function RttiName: string;
+          { enumerator support }
+          function search_enumerator_get: tprocdef; virtual;
+          function search_enumerator_move: tprocdef; virtual;
+          function search_enumerator_current: tsym; virtual;
+       end;
+
+       trecorddef = class(tabstractrecorddef)
+       public
+          isunion       : boolean;
+          constructor create(const n:string; p:TSymtable);
+          constructor ppuload(ppufile:tcompilerppufile);
+          destructor destroy;override;
+          function getcopy : tstoreddef;override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure buildderef;override;
+          procedure deref;override;
+          function  size:asizeint;override;
+          function  alignment : shortint;override;
+          function  padalignment: shortint;
+          function  GetTypeName:string;override;
+          { debug }
+          function  needs_inittable : boolean;override;
+       end;
+
+       tobjectdef = class;
+
+       { TImplementedInterface }
+
+       TImplementedInterface = class
+         IntfDef      : tobjectdef;
+         IntfDefDeref : tderef;
+         IType        : tinterfaceentrytype;
+         IOffset      : longint;
+         VtblImplIntf : TImplementedInterface;
+         NameMappings : TFPHashList;
+         ProcDefs     : TFPObjectList;
+         ImplementsGetter :  tsym;
+         constructor create(aintf: tobjectdef);
+         constructor create_deref(d:tderef);
+         destructor  destroy; override;
+         function  getcopy:TImplementedInterface;
+         procedure buildderef;
+         procedure deref;
+         procedure AddMapping(const origname, newname: string);
+         function  GetMapping(const origname: string):string;
+         procedure AddImplProc(pd:tprocdef);
+         function  IsImplMergePossible(MergingIntf:TImplementedInterface;out weight: longint): boolean;
+       end;
+
+       { tvmtentry }
+       tvmtentry = record
+         procdef      : tprocdef;
+         procdefderef : tderef;
+         visibility   : tvisibility;
+       end;
+       pvmtentry = ^tvmtentry;
+
+       { tobjectdef }
+
+       tvmcallstatic = (vmcs_default, vmcs_yes, vmcs_no, vmcs_unreachable);
+       pmvcallstaticinfo = ^tmvcallstaticinfo;
+       tmvcallstaticinfo = array[0..1024*1024-1] of tvmcallstatic;
+       tobjectdef = class(tabstractrecorddef)
+       private
+          fcurrent_dispid: longint;
+       public
+          dwarf_struct_lab : tasmsymbol;
+          childof        : tobjectdef;
+          childofderef   : tderef;
+
+          { for Object Pascal helpers }
+          extendeddef   : tdef;
+          extendeddefderef: tderef;
+          { for C++ classes: name of the library this class is imported from }
+          import_lib,
+          { for Objective-C: protocols and classes can have the same name there }
+          objextname     : pshortstring;
+          { to be able to have a variable vmt position }
+          { and no vmt field for objects without virtuals }
+          vmtentries     : TFPList;
+          vmcallstaticinfo : pmvcallstaticinfo;
+          vmt_offset     : longint;
+          iidguid        : pguid;
+          iidstr         : pshortstring;
+          { store implemented interfaces defs and name mappings }
+          ImplementedInterfaces : TFPObjectList;
+          writing_class_record_dbginfo,
+          { a class of this type has been created in this module }
+          created_in_current_module,
+          { a loadvmtnode for this class has been created in this
+            module, so if a classrefdef variable of this or a parent
+            class is used somewhere to instantiate a class, then this
+            class may be instantiated
+          }
+          maybe_created_in_current_module,
+          { a "class of" this particular class has been created in
+            this module
+          }
+          classref_created_in_current_module : boolean;
+          objecttype     : tobjecttyp;
+          constructor create(ot:tobjecttyp;const n:string;c:tobjectdef);
+          constructor ppuload(ppufile:tcompilerppufile);
+          destructor  destroy;override;
+          function getcopy : tstoreddef;override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          function GetTypeName:string;override;
+          procedure buildderef;override;
+          procedure deref;override;
+          procedure buildderefimpl;override;
+          procedure derefimpl;override;
+          procedure resetvmtentries;
+          procedure copyvmtentries(objdef:tobjectdef);
+          function  getparentdef:tdef;override;
+          function  size : asizeint;override;
+          function  alignment:shortint;override;
+          function  vmtmethodoffset(index:longint):longint;
+          function  members_need_inittable : boolean;
+          function  find_implemented_interface(aintfdef:tobjectdef):TImplementedInterface;
+          { this should be called when this class implements an interface }
+          procedure prepareguid;
+          function  is_publishable : boolean;override;
+          function  is_related(d : tdef) : boolean;override;
+          function  needs_inittable : boolean;override;
+          function  rtti_mangledname(rt:trttitype):string;override;
+          function  vmt_mangledname : string;
+          procedure check_forwards; override;
+          procedure insertvmt;
+          procedure set_parent(c : tobjectdef);
+          function find_destructor: tprocdef;
+          function implements_any_interfaces: boolean;
+          { dispinterface support }
+          function get_next_dispid: longint;
+          { enumerator support }
+          function search_enumerator_get: tprocdef; override;
+          function search_enumerator_move: tprocdef; override;
+          function search_enumerator_current: tsym; override;
+          { WPO }
+          procedure register_created_object_type;override;
+          procedure register_maybe_created_object_type;
+          procedure register_created_classref_type;
+          procedure register_vmt_call(index:longint);
+          { ObjC }
+          procedure finish_objc_data;
+          function check_objc_types: boolean;
+          { C++ }
+          procedure finish_cpp_data;
+       end;
+
+       tclassrefdef = class(tabstractpointerdef)
+          constructor create(def:tdef);
+          constructor ppuload(ppufile:tcompilerppufile);
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          function getcopy:tstoreddef;override;
+          function GetTypeName:string;override;
+          function is_publishable : boolean;override;
+          function rtti_mangledname(rt:trttitype):string;override;
+          procedure register_created_object_type;override;
+       end;
+
+       tarraydef = class(tstoreddef)
+          lowrange,
+          highrange     : asizeint;
+          rangedef      : tdef;
+          rangedefderef : tderef;
+          arrayoptions  : tarraydefoptions;
+          symtable      : TSymtable;
+       protected
+          _elementdef      : tdef;
+          _elementdefderef : tderef;
+          procedure setelementdef(def:tdef);
+       public
+          function elesize : asizeint;
+          function elepackedbitsize : asizeint;
+          function elecount : asizeuint;
+          constructor create_from_pointer(def:tdef);
+          constructor create(l,h:asizeint;def:tdef);
+          constructor ppuload(ppufile:tcompilerppufile);
+          destructor destroy; override;
+          function getcopy : tstoreddef;override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          function  GetTypeName:string;override;
+          function  getmangledparaname : string;override;
+          procedure buildderef;override;
+          procedure deref;override;
+          function size : asizeint;override;
+          function alignment : shortint;override;
+          { returns the label of the range check string }
+          function needs_inittable : boolean;override;
+          property elementdef : tdef read _elementdef write setelementdef;
+          function is_publishable : boolean;override;
+       end;
+
+       torddef = class(tstoreddef)
+          low,high : TConstExprInt;
+          ordtype  : tordtype;
+          constructor create(t : tordtype;v,b : TConstExprInt);
+          constructor ppuload(ppufile:tcompilerppufile);
+          function getcopy : tstoreddef;override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          function  is_publishable : boolean;override;
+          function  GetTypeName:string;override;
+          function alignment:shortint;override;
+          procedure setsize;
+          function  packedbitsize: asizeint; override;
+          function getvardef : longint;override;
+       end;
+
+       tfloatdef = class(tstoreddef)
+          floattype : tfloattype;
+          constructor create(t : tfloattype);
+          constructor ppuload(ppufile:tcompilerppufile);
+          function getcopy : tstoreddef;override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          function  GetTypeName:string;override;
+          function  is_publishable : boolean;override;
+          function alignment:shortint;override;
+          procedure setsize;
+          function  getvardef:longint;override;
+       end;
+
+       { tabstractprocdef }
+
+       tabstractprocdef = class(tstoreddef)
+          { saves a definition to the return type }
+          returndef       : tdef;
+          returndefderef  : tderef;
+          parast          : TSymtable;
+          paras           : tparalist;
+          proctypeoption  : tproctypeoption;
+          proccalloption  : tproccalloption;
+          procoptions     : tprocoptions;
+          callerargareasize,
+          calleeargareasize: pint;
+{$ifdef m68k}
+          exp_funcretloc : tregister;   { explicit funcretloc for AmigaOS }
+{$endif}
+          funcretloc : array[tcallercallee] of TCGPara;
+          has_paraloc_info : tcallercallee; { paraloc info is available }
+          { number of user visible parameters }
+          maxparacount,
+          minparacount    : byte;
+          constructor create(dt:tdeftyp;level:byte);
+          constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
+          destructor destroy;override;
+          procedure  ppuwrite(ppufile:tcompilerppufile);override;
+          procedure buildderef;override;
+          procedure deref;override;
+          procedure calcparas;
+          function  typename_paras(showhidden:boolean): string;
+          function  is_methodpointer:boolean;virtual;
+          function  is_addressonly:boolean;virtual;
+          function  no_self_node:boolean;
+          procedure check_mark_as_nested;
+          procedure init_paraloc_info(side: tcallercallee);
+          function stack_tainting_parameter(side: tcallercallee): boolean;
+       private
+          procedure count_para(p:TObject;arg:pointer);
+          procedure insert_para(p:TObject;arg:pointer);
+       end;
+
+       tprocvardef = class(tabstractprocdef)
+          constructor create(level:byte);
+          constructor ppuload(ppufile:tcompilerppufile);
+          function getcopy : tstoreddef;override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          function  GetSymtable(t:tGetSymtable):TSymtable;override;
+          function  size : asizeint;override;
+          function  GetTypeName:string;override;
+          function  is_publishable : boolean;override;
+          function  is_methodpointer:boolean;override;
+          function  is_addressonly:boolean;override;
+          function  getmangledparaname:string;override;
+       end;
+
+       tmessageinf = record
+         case integer of
+           0 : (str : pshortstring);
+           1 : (i : longint);
+       end;
+
+       tinlininginfo = record
+          { node tree }
+          code  : tnode;
+          flags : tprocinfoflags;
+       end;
+       pinlininginfo = ^tinlininginfo;
+
+
+{$ifdef oldregvars}
+       { register variables }
+       pregvarinfo = ^tregvarinfo;
+       tregvarinfo = record
+          regvars : array[1..maxvarregs] of tsym;
+          regvars_para : array[1..maxvarregs] of boolean;
+          regvars_refs : array[1..maxvarregs] of longint;
+
+          fpuregvars : array[1..maxfpuvarregs] of tsym;
+          fpuregvars_para : array[1..maxfpuvarregs] of boolean;
+          fpuregvars_refs : array[1..maxfpuvarregs] of longint;
+       end;
+{$endif oldregvars}
+
+       { tprocdef }
+
+       tprocdef = class(tabstractprocdef)
+       private
+          _mangledname : pshortstring;
+       public
+          messageinf : tmessageinf;
+          dispid : longint;
+{$ifndef EXTDEBUG}
+          { where is this function defined and what were the symbol
+            flags, needed here because there
+            is only one symbol for all overloaded functions
+            EXTDEBUG has fileinfo in tdef (PFV) }
+          fileinfo : tfileposinfo;
+{$endif}
+          symoptions : tsymoptions;
+          deprecatedmsg : pshortstring;
+          { symbol owning this definition }
+          procsym : tsym;
+          procsymderef : tderef;
+          { alias names }
+          aliasnames : TCmdStrList;
+          { symtables }
+          localst : TSymtable;
+          funcretsym : tsym;
+          funcretsymderef : tderef;
+          struct : tabstractrecorddef;
+          structderef : tderef;
+{$if defined(powerpc) or defined(m68k)}
+          { library symbol for AmigaOS/MorphOS }
+          libsym : tsym;
+          libsymderef : tderef;
+{$endif powerpc or m68k}
+          { name of the result variable to insert in the localsymtable }
+          resultname : pshortstring;
+          { import info }
+          import_dll,
+          import_name : pshortstring;
+          { info for inlining the subroutine, if this pointer is nil,
+            the procedure can't be inlined }
+          inlininginfo : pinlininginfo;
+{$ifdef oldregvars}
+          regvarinfo: pregvarinfo;
+{$endif oldregvars}
+          { interrupt vector }
+          interruptvector : longint;
+          { First/last assembler symbol/instruction in aasmoutput list.
+            Note: initialised after compiling the code for the procdef, but
+              not saved to/restored from ppu. Used when inserting debug info }
+          procstarttai,
+          procendtai   : tai;
+          import_nr    : word;
+          extnumber    : word;
+{$ifdef i386}
+          fpu_used     : byte;
+{$endif i386}
+          visibility   : tvisibility;
+          { true, if the procedure is only declared
+            (forward procedure) }
+          forwarddef,
+          { true if the procedure is declared in the interface }
+          interfacedef : boolean;
+          { true if the procedure has a forward declaration }
+          hasforward  : boolean;
+          constructor create(level:byte);
+          constructor ppuload(ppufile:tcompilerppufile);
+          destructor  destroy;override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure buildderef;override;
+          procedure buildderefimpl;override;
+          procedure deref;override;
+          procedure derefimpl;override;
+          function  GetSymtable(t:tGetSymtable):TSymtable;override;
+          function  GetTypeName : string;override;
+          function  mangledname : string;
+          procedure setmangledname(const s : string);
+          function  fullprocname(showhidden:boolean):string;
+          function  cplusplusmangledname : string;
+          function  objcmangledname : string;
+          function  is_methodpointer:boolean;override;
+          function  is_addressonly:boolean;override;
+          procedure make_external;
+       end;
+
+       { single linked list of overloaded procs }
+       pprocdeflist = ^tprocdeflist;
+       tprocdeflist = record
+         def  : tprocdef;
+         defderef : tderef;
+         next : pprocdeflist;
+       end;
+
+       tstringdef = class(tstoreddef)
+          encoding   : tstringencoding;
+          stringtype : tstringtype;
+          len        : asizeint;
+          constructor createshort(l : byte);
+          constructor loadshort(ppufile:tcompilerppufile);
+          constructor createlong(l : asizeint);
+          constructor loadlong(ppufile:tcompilerppufile);
+          constructor createansi(aencoding:tstringencoding);
+          constructor loadansi(ppufile:tcompilerppufile);
+          constructor createwide;
+          constructor loadwide(ppufile:tcompilerppufile);
+          constructor createunicode;
+          constructor loadunicode(ppufile:tcompilerppufile);
+          function getcopy : tstoreddef;override;
+          function  stringtypname:string;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          function  GetTypeName:string;override;
+          function  getmangledparaname:string;override;
+          function  is_publishable : boolean;override;
+          function alignment : shortint;override;
+          function  needs_inittable : boolean;override;
+          function  getvardef:longint;override;
+       end;
+
+       { tenumdef }
+
+       tenumdef = class(tstoreddef)
+          minval,
+          maxval    : asizeint;
+          basedef   : tenumdef;
+          basedefderef : tderef;
+          symtable  : TSymtable;
+          has_jumps : boolean;
+          constructor create;
+          constructor create_subrange(_basedef:tenumdef;_min,_max:asizeint);
+          constructor ppuload(ppufile:tcompilerppufile);
+          destructor destroy;override;
+          function getcopy : tstoreddef;override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure buildderef;override;
+          procedure deref;override;
+          function  GetTypeName:string;override;
+          function  is_publishable : boolean;override;
+          procedure calcsavesize;
+          function  packedbitsize: asizeint; override;
+          procedure setmax(_max:asizeint);
+          procedure setmin(_min:asizeint);
+          function  min:asizeint;
+          function  max:asizeint;
+          function  getfirstsym:tsym;
+       end;
+
+       tsetdef = class(tstoreddef)
+          elementdef : tdef;
+          elementdefderef : tderef;
+          setbase,
+          setmax   : aword;
+          constructor create(def:tdef;low, high : asizeint);
+          constructor ppuload(ppufile:tcompilerppufile);
+          function getcopy : tstoreddef;override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure buildderef;override;
+          procedure deref;override;
+          function  GetTypeName:string;override;
+          function  is_publishable : boolean;override;
+       end;
+
+       tdefawaresymtablestack = class(TSymtablestack)
+       private
+         procedure addhelpers(st: TSymtable);
+         procedure removehelpers(st: TSymtable);
+       public
+         procedure push(st: TSymtable); override;
+         procedure pop(st: TSymtable); override;
+       end;
+
+    var
+       current_structdef: tabstractrecorddef; { used for private functions check !! }
+       current_genericdef: tstoreddef;        { used to reject declaration of generic class inside generic class }
+       current_specializedef: tstoreddef;     { used to implement usage of generic class in itself }
+
+    { default types }
+       generrordef,               { error in definition }
+       voidpointertype,           { pointer for Void-pointeddef }
+       charpointertype,           { pointer for Char-pointeddef }
+       widecharpointertype,       { pointer for WideChar-pointeddef }
+       voidfarpointertype,
+       cundefinedtype,
+       cformaltype,               { unique formal definition }
+       ctypedformaltype,          { unique typed formal definition }
+       voidtype,                  { Void (procedure) }
+       cchartype,                 { Char }
+       cwidechartype,             { WideChar }
+       pasbool8type,              { boolean type }
+       pasbool16type,
+       pasbool32type,
+       pasbool64type,
+       bool8type,
+       bool16type,
+       bool32type,
+       bool64type,                { implement me }
+       u8inttype,                 { 8-Bit unsigned integer }
+       s8inttype,                 { 8-Bit signed integer }
+       u16inttype,                { 16-Bit unsigned integer }
+       s16inttype,                { 16-Bit signed integer }
+       u32inttype,                { 32-Bit unsigned integer }
+       s32inttype,                { 32-Bit signed integer }
+       u64inttype,                { 64-bit unsigned integer }
+       s64inttype,                { 64-bit signed integer }
+       s32floattype,              { 32 bit floating point number }
+       s64floattype,              { 64 bit floating point number }
+       s80floattype,              { 80 bit floating point number }
+       sc80floattype,             { 80 bit floating point number but stored like in C }
+       s64currencytype,           { pointer to a currency type }
+       cshortstringtype,          { pointer to type of short string const   }
+       clongstringtype,           { pointer to type of long string const   }
+       cansistringtype,           { pointer to type of ansi string const  }
+       cwidestringtype,           { pointer to type of wide string const  }
+       cunicodestringtype,
+       openshortstringtype,       { pointer to type of an open shortstring,
+                                    needed for readln() }
+       openchararraytype,         { pointer to type of an open array of char,
+                                    needed for readln() }
+       cfiletype,                 { get the same definition for all file }
+                                  { used for stabs }
+       methodpointertype,         { typecasting of methodpointers to extract self }
+       hresultdef,
+       { we use only one variant def for every variant class }
+       cvarianttype,
+       colevarianttype,
+       { default integer type s32inttype on 32 bit systems, s64bittype on 64 bit systems }
+       sinttype,
+       uinttype,
+       { unsigned and signed ord type with the same size as a pointer }
+       ptruinttype,
+       ptrsinttype,
+       { several types to simulate more or less C++ objects for GDB }
+       vmttype,
+       vmtarraytype,
+       pvmttype      : tdef;     { type of classrefs, used for stabs }
+
+       { pointer to the anchestor of all classes }
+       class_tobject : tobjectdef;
+       { pointer to the ancestor of all COM interfaces }
+       interface_iunknown : tobjectdef;
+       { pointer to the ancestor of all dispinterfaces }
+       interface_idispatch : tobjectdef;
+       { pointer to the TGUID type
+         of all interfaces         }
+       rec_tguid : trecorddef;
+
+       { pointer to jump buffer }
+       rec_jmp_buf : trecorddef;
+
+       { Objective-C base types }
+       objc_metaclasstype,
+       objc_superclasstype,
+       objc_idtype,
+       objc_seltype              : tpointerdef;
+       objc_objecttype           : trecorddef;
+       { base type of @protocol(protocolname) Objective-C statements }
+       objc_protocoltype         : tobjectdef;
+       { helper types for for-in "fast enumeration" support in Objective-C 2.0 }
+       objc_fastenumeration      : tobjectdef;
+       objc_fastenumerationstate : trecorddef;
+
+    const
+{$ifdef i386}
+       pbestrealtype : ^tdef = @s80floattype;
+{$endif}
+{$ifdef x86_64}
+       pbestrealtype : ^tdef = @s80floattype;
+{$endif}
+{$ifdef m68k}
+       pbestrealtype : ^tdef = @s64floattype;
+{$endif}
+{$ifdef alpha}
+       pbestrealtype : ^tdef = @s64floattype;
+{$endif}
+{$ifdef powerpc}
+       pbestrealtype : ^tdef = @s64floattype;
+{$endif}
+{$ifdef POWERPC64}
+       pbestrealtype : ^tdef = @s64floattype;
+{$endif}
+{$ifdef ia64}
+       pbestrealtype : ^tdef = @s64floattype;
+{$endif}
+{$ifdef SPARC}
+       pbestrealtype : ^tdef = @s64floattype;
+{$endif SPARC}
+{$ifdef vis}
+       pbestrealtype : ^tdef = @s64floattype;
+{$endif vis}
+{$ifdef ARM}
+       pbestrealtype : ^tdef = @s64floattype;
+{$endif ARM}
+{$ifdef MIPS}
+       pbestrealtype : ^tdef = @s64floattype;
+{$endif MIPS}
+{$ifdef AVR}
+       pbestrealtype : ^tdef = @s64floattype;
+{$endif AVR}
+
+    function make_mangledname(const typeprefix:string;st:TSymtable;const suffix:string):string;
+    function make_dllmangledname(const dllname,importname:string;
+                                 import_nr : word; pco : tproccalloption):string;
+
+    { should be in the types unit, but the types unit uses the node stuff :( }
+    function is_interfacecom(def: tdef): boolean;
+    function is_interfacecom_or_dispinterface(def: tdef): boolean;
+    function is_interfacecorba(def: tdef): boolean;
+    function is_interface(def: tdef): boolean;
+    function is_dispinterface(def: tdef): boolean;
+    function is_object(def: tdef): boolean;
+    function is_class(def: tdef): boolean;
+    function is_cppclass(def: tdef): boolean;
+    function is_objectpascal_helper(def: tdef): boolean;
+    function is_objcclass(def: tdef): boolean;
+    function is_objcclassref(def: tdef): boolean;
+    function is_objcprotocol(def: tdef): boolean;
+    function is_objccategory(def: tdef): boolean;
+    function is_objc_class_or_protocol(def: tdef): boolean;
+    function is_objc_protocol_or_category(def: tdef): boolean;
+    function is_classhelper(def: tdef): boolean;
+    function is_class_or_interface(def: tdef): boolean;
+    function is_class_or_interface_or_objc(def: tdef): boolean;
+    function is_class_or_interface_or_object(def: tdef): boolean;
+    function is_class_or_interface_or_dispinterface(def: tdef): boolean;
+    function is_implicit_pointer_object_type(def: tdef): boolean;
+    function is_class_or_object(def: tdef): boolean;
+    function is_record(def: tdef): boolean;
+
+    procedure loadobjctypes;
+    procedure maybeloadcocoatypes;
+
+    function use_vectorfpu(def : tdef) : boolean;
+
+    function getansistringcodepage:tstringencoding; inline;
+    function getansistringdef:tstringdef; inline;
+    function getparaencoding(def:tdef):tstringencoding; inline;
+
+implementation
+
+    uses
+      SysUtils,
+      cutils,
+      { global }
+      verbose,
+      { target }
+      systems,aasmcpu,paramgr,
+      { symtable }
+      symsym,symtable,symutil,defutil,objcdef,
+      { module }
+      fmodule,
+      { other }
+      gendef,
+      fpccrc
+      ;
+
+{****************************************************************************
+                                  Helpers
+****************************************************************************}
+
+    function getansistringcodepage:tstringencoding; inline;
+      begin
+        if cs_explicit_codepage in current_settings.moduleswitches then
+          result:=current_settings.sourcecodepage
+        else
+          result:=0;
+      end;
+
+    function getansistringdef:tstringdef; inline;
+      var
+        symtable:tsymtable;
+      begin
+        { if codepage is explicitly defined in this mudule we need to return
+          a replacement for ansistring def }
+        if cs_explicit_codepage in current_settings.moduleswitches then
+          begin
+            if not assigned(current_module) then
+              internalerror(2011101301);
+            { codepage can be redeclared only once per unit so we don't need a list of
+              redefined ansistring but only one pointer }
+            if not assigned(current_module.ansistrdef) then
+              begin
+                { if we did not create it yet we need to do this now }
+                if current_module.is_unit then
+                  symtable:=current_module.globalsymtable
+                else
+                  symtable:=current_module.localsymtable;
+                symtablestack.push(symtable);
+                current_module.ansistrdef:=tstringdef.createansi(current_settings.sourcecodepage);
+                symtablestack.pop(symtable);
+              end;
+            result:=tstringdef(current_module.ansistrdef);
+          end
+        else
+          result:=tstringdef(cansistringtype);
+      end;
+
+    function getparaencoding(def:tdef):tstringencoding; inline;
+      begin
+        { don't pass CP_NONE encoding to internal functions
+          they expect 0 encoding instead }
+        result:=tstringdef(def).encoding;
+        if result=CP_NONE then
+          result:=0
+      end;
+
+    function make_mangledname(const typeprefix:string;st:TSymtable;const suffix:string):string;
+      var
+        s,hs,
+        prefix : string;
+        oldlen,
+        newlen,
+        i   : longint;
+        crc : dword;
+        hp  : tparavarsym;
+      begin
+        prefix:='';
+        if not assigned(st) then
+         internalerror(200204212);
+        { sub procedures }
+        while (st.symtabletype=localsymtable) do
+         begin
+           if st.defowner.typ<>procdef then
+            internalerror(200204173);
+           { Add the full mangledname of procedure to prevent
+             conflicts with 2 overloads having both a nested procedure
+             with the same name, see tb0314 (PFV) }
+           s:=tprocdef(st.defowner).procsym.name;
+           oldlen:=length(s);
+           for i:=0 to tprocdef(st.defowner).paras.count-1 do
+            begin
+              hp:=tparavarsym(tprocdef(st.defowner).paras[i]);
+              if not(vo_is_hidden_para in hp.varoptions) then
+                s:=s+'$'+hp.vardef.mangledparaname;
+            end;
+           if not is_void(tprocdef(st.defowner).returndef) then
+             s:=s+'$$'+tprocdef(st.defowner).returndef.mangledparaname;
+           newlen:=length(s);
+           { Replace with CRC if the parameter line is very long }
+           if (newlen-oldlen>12) and
+              ((newlen+length(prefix)>100) or (newlen-oldlen>32)) then
+             begin
+               crc:=0;
+               for i:=0 to tprocdef(st.defowner).paras.count-1 do
+                 begin
+                   hp:=tparavarsym(tprocdef(st.defowner).paras[i]);
+                   if not(vo_is_hidden_para in hp.varoptions) then
+                     begin
+                       hs:=hp.vardef.mangledparaname;
+                       crc:=UpdateCrc32(crc,hs[1],length(hs));
+                     end;
+                 end;
+               hs:=hp.vardef.mangledparaname;
+               crc:=UpdateCrc32(crc,hs[1],length(hs));
+               s:=Copy(s,1,oldlen)+'$crc'+hexstr(crc,8);
+             end;
+           if prefix<>'' then
+             prefix:=s+'_'+prefix
+           else
+             prefix:=s;
+           if length(prefix)>100 then
+             begin
+               crc:=0;
+               crc:=UpdateCrc32(crc,prefix[1],length(prefix));
+               prefix:='$CRC'+hexstr(crc,8);
+             end;
+           st:=st.defowner.owner;
+         end;
+        { object/classes symtable, nested type definitions in classes require the while loop }
+        while st.symtabletype in [ObjectSymtable,recordsymtable] do
+         begin
+           if not (st.defowner.typ in [objectdef,recorddef]) then
+            internalerror(200204174);
+           prefix:=tabstractrecorddef(st.defowner).objname^+'_$_'+prefix;
+           st:=st.defowner.owner;
+         end;
+        { symtable must now be static or global }
+        if not(st.symtabletype in [staticsymtable,globalsymtable]) then
+          internalerror(200204175);
+
+        { The mangled name is made out of at most 4 parts:
+         1) Optional typeprefix given as first parameter
+            with '_$' appended if not empty
+         2) Unit name or 'P$'+program name (never empty)
+         3) optional prefix variable that contains a unique
+            name for the local symbol table (prepended with '$_$'
+            if not empty)
+         4) suffix as given as third parameter,
+            also optional (i.e. can be empty)
+            prepended by '_$$_' if not empty }
+        result:='';
+        if typeprefix<>'' then
+          result:=result+typeprefix+'_$';
+        { Add P$ for program, which can have the same name as
+          a unit }
+        if (TSymtable(main_module.localsymtable)=st) and
+           (not main_module.is_unit) then
+          result:=result+'P$'+st.name^
+        else
+          result:=result+st.name^;
+        if prefix<>'' then
+          result:=result+'$_$'+prefix;
+        if suffix<>'' then
+          result:=result+'_$$_'+suffix;
+        { the Darwin assembler assumes that all symbols starting with 'L' are local }
+        { Further, the Mac OS X 10.5 linker does not consider symbols which do not  }
+        { start with '_' as regular symbols (it does not generate N_GSYM entries    }
+        { those in the debug map, leading to troubles with dsymutil). So always     }
+        { add an underscore on darwin.                                              }
+        if (target_info.system in systems_darwin) then
+          result := '_' + result;
+      end;
+
+    function make_dllmangledname(const dllname,importname:string;import_nr : word; pco : tproccalloption):string;
+       var
+         crc : cardinal;
+         i : longint;
+         use_crc : boolean;
+         dllprefix : string;
+      begin
+        if (target_info.system in (systems_all_windows + systems_nativent +
+                           [system_i386_emx, system_i386_os2]))
+            and (dllname <> '') then
+          begin
+            dllprefix:=lower(ExtractFileName(dllname));
+            { Remove .dll suffix if present }
+            if copy(dllprefix,length(dllprefix)-3,length(dllprefix))='.dll' then
+              dllprefix:=copy(dllprefix,1,length(dllprefix)-4);
+            use_crc:=false;
+            for i:=1 to length(dllprefix) do
+              if not (dllprefix[i] in ['a'..'z','A'..'Z','_','0'..'9']) then
+                begin
+                  use_crc:=true;
+                  break;
+                end;
+            if use_crc then
+              begin
+                crc:=0;
+                crc:=UpdateCrc32(crc,dllprefix[1],length(dllprefix));
+                dllprefix:='_$dll$crc$'+hexstr(crc,8)+'$';
+              end
+            else
+              dllprefix:='_$dll$'+dllprefix+'$';
+
+            if importname<>'' then
+              result:=dllprefix+importname
+            else
+              result:=dllprefix+'_index_'+tostr(import_nr);
+            { Replace ? and @ in import name, since GNU AS does not allow these characters in symbol names. }
+            { This allows to import VC++ mangled names from DLLs. }
+            { Do not perform replacement, if external symbol is not imported from DLL. }
+            if (dllname<>'') then
+              begin
+                Replace(result,'?','__q$$');
+    {$ifdef arm}
+                { @ symbol is not allowed in ARM assembler only }
+                Replace(result,'@','__a$$');
+    {$endif arm}
+             end;
+          end
+        else
+          begin
+            if importname<>'' then
+             begin
+               if not(pco in [pocall_cdecl,pocall_cppdecl]) then
+                 result:=importname
+               else
+                 result:=target_info.Cprefix+importname;
+             end
+            else
+              result:='_index_'+tostr(import_nr);
+          end;
+
+      end;
+
+{****************************************************************************
+           TDEFAWARESYMTABLESTACK
+           (symtablestack descendant that does some special actions on
+           the pushed/popped symtables)
+****************************************************************************}
+
+    procedure tdefawaresymtablestack.addhelpers(st: TSymtable);
+      var
+        i: integer;
+        s: string;
+        list: TFPObjectList;
+        def: tdef;
+      begin
+        { search the symtable from first to last; the helper to use will be the
+          last one in the list }
+        for i:=0 to st.symlist.count-1 do
+          begin
+            if not (st.symlist[i] is ttypesym) then
+              continue;
+            def:=ttypesym(st.SymList[i]).typedef;
+            if is_objectpascal_helper(def) and
+                (tobjectdef(def).extendeddef.typ in [recorddef,objectdef]) then
+              begin
+                s:=make_mangledname('',tabstractrecorddef(tobjectdef(def).extendeddef).symtable,'');
+                list:=TFPObjectList(current_module.extendeddefs.Find(s));
+                if not assigned(list) then
+                  begin
+                    list:=TFPObjectList.Create(false);
+                    current_module.extendeddefs.Add(s,list);
+                  end;
+                list.Add(def);
+              end
+            else
+              { add nested helpers as well }
+              if def.typ in [recorddef,objectdef] then
+                addhelpers(tabstractrecorddef(def).symtable);
+          end;
+      end;
+
+    procedure tdefawaresymtablestack.removehelpers(st: TSymtable);
+      var
+        i, j: integer;
+        tmpst: TSymtable;
+        list: TFPObjectList;
+      begin
+        for i:=current_module.extendeddefs.count-1 downto 0 do
+          begin
+            list:=TFPObjectList(current_module.extendeddefs[i]);
+            for j:=list.count-1 downto 0 do
+              begin
+                if not (list[j] is tobjectdef) then
+                  Internalerror(2011031501);
+                tmpst:=tobjectdef(list[j]).owner;
+                repeat
+                  if tmpst=st then
+                    begin
+                      list.delete(j);
+                      break;
+                    end
+                  else
+                    begin
+                      if assigned(tmpst.defowner) then
+                        tmpst:=tmpst.defowner.owner
+                      else
+                        tmpst:=nil;
+                    end;
+                until not assigned(tmpst) or (tmpst.symtabletype in [globalsymtable,staticsymtable]);
+              end;
+            if list.count=0 then
+              current_module.extendeddefs.delete(i);
+          end;
+      end;
+
+    procedure tdefawaresymtablestack.push(st: TSymtable);
+      begin
+        { nested helpers will be added as well }
+        if (st.symtabletype in [globalsymtable,staticsymtable]) and
+            (sto_has_helper in st.tableoptions) then
+          addhelpers(st);
+        inherited push(st);
+      end;
+
+    procedure tdefawaresymtablestack.pop(st: TSymtable);
+      begin
+        inherited pop(st);
+        { nested helpers will be removed as well }
+        if (st.symtabletype in [globalsymtable,staticsymtable]) and
+            (sto_has_helper in st.tableoptions) then
+          removehelpers(st);
+      end;
+
+
+{****************************************************************************
+                     TDEF (base class for definitions)
+****************************************************************************}
+
+    constructor tstoreddef.create(dt:tdeftyp);
+      var
+        insertstack : psymtablestackitem;
+      begin
+         inherited create(dt);
+         savesize := 0;
+{$ifdef EXTDEBUG}
+         fileinfo := current_filepos;
+{$endif}
+         generictokenbuf:=nil;
+         genericdef:=nil;
+         change_endian:=false;
+
+         { Don't register forwarddefs, they are disposed at the
+           end of an type block }
+         if (dt=forwarddef) then
+           exit;
+         { Register in current_module }
+         if assigned(current_module) then
+           begin
+             current_module.deflist.Add(self);
+             DefId:=current_module.deflist.Count-1;
+           end;
+         { Register in symtable stack }
+         if assigned(symtablestack) then
+           begin
+             insertstack:=symtablestack.stack;
+             while assigned(insertstack) and
+                   (insertstack^.symtable.symtabletype=withsymtable) do
+               insertstack:=insertstack^.next;
+             if not assigned(insertstack) then
+               internalerror(200602044);
+             insertstack^.symtable.insertdef(self);
+           end;
+      end;
+
+
+    destructor tstoreddef.destroy;
+      begin
+        { Direct calls are not allowed, use symtable.deletedef() }
+        if assigned(owner) then
+          internalerror(200612311);
+        if assigned(generictokenbuf) then
+          begin
+            generictokenbuf.free;
+            generictokenbuf:=nil;
+          end;
+        inherited destroy;
+      end;
+
+
+    constructor tstoreddef.ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
+      var
+        sizeleft,i : longint;
+        buf  : array[0..255] of byte;
+      begin
+         inherited create(dt);
+         DefId:=ppufile.getlongint;
+         current_module.deflist[DefId]:=self;
+{$ifdef EXTDEBUG}
+         fillchar(fileinfo,sizeof(fileinfo),0);
+{$endif}
+         { load }
+         ppufile.getderef(typesymderef);
+         ppufile.getsmallset(defoptions);
+         ppufile.getsmallset(defstates);
+         if df_generic in defoptions then
+           begin
+             sizeleft:=ppufile.getlongint;
+             change_endian:=ppufile.change_endian;
+             initgeneric;
+             while sizeleft>0 do
+               begin
+                 if sizeleft>sizeof(buf) then
+                   i:=sizeof(buf)
+                 else
+                   i:=sizeleft;
+                 ppufile.getdata(buf,i);
+                 generictokenbuf.write(buf,i);
+                 dec(sizeleft,i);
+               end;
+           end;
+        if df_specialization in defoptions then
+          ppufile.getderef(genericdefderef);
+      end;
+
+
+    function Tstoreddef.rtti_mangledname(rt:trttitype):string;
+      var
+        prefix : string[4];
+      begin
+        if rt=fullrtti then
+          begin
+            prefix:='RTTI';
+            include(defstates,ds_rtti_table_used);
+          end
+        else
+          begin
+            prefix:='INIT';
+            include(defstates,ds_init_table_used);
+          end;
+        if assigned(typesym) and
+           (owner.symtabletype in [staticsymtable,globalsymtable]) then
+          result:=make_mangledname(prefix,owner,typesym.name)
+        else
+          result:=make_mangledname(prefix,findunitsymtable(owner),'DEF'+tostr(DefId))
+      end;
+
+
+    function tstoreddef.OwnerHierarchyName: string;
+      var
+        tmp: tdef;
+      begin
+        tmp:=self;
+        result:='';
+        repeat
+          if tmp.owner.symtabletype in [ObjectSymtable,recordsymtable] then
+            tmp:=tdef(tmp.owner.defowner)
+          else
+            break;
+          result:=tabstractrecorddef(tmp).objrealname^+'.'+result;
+        until tmp=nil;
+      end;
+
+
+    function tstoreddef.in_currentunit: boolean;
+      var
+        st: tsymtable;
+      begin
+        st:=owner;
+        while not(st.symtabletype in [globalsymtable,staticsymtable]) do
+          st:=st.defowner.owner;
+        result:=st.iscurrentunit;
+      end;
+
+
+    function tstoreddef.getcopy : tstoreddef;
+      begin
+        Message(sym_e_cant_create_unique_type);
+        getcopy:=terrordef.create;
+      end;
+
+
+    procedure tstoreddef.ppuwrite(ppufile:tcompilerppufile);
+      var
+        sizeleft,i : longint;
+        buf  : array[0..255] of byte;
+        oldintfcrc : boolean;
+      begin
+        ppufile.putlongint(DefId);
+        ppufile.putderef(typesymderef);
+        ppufile.putsmallset(defoptions);
+        oldintfcrc:=ppufile.do_crc;
+        ppufile.do_crc:=false;
+        ppufile.putsmallset(defstates);
+        if df_generic in defoptions then
+          begin
+            if assigned(generictokenbuf) then
+              begin
+                sizeleft:=generictokenbuf.size;
+                generictokenbuf.seek(0);
+              end
+            else
+              sizeleft:=0;
+            ppufile.putlongint(sizeleft);
+            while sizeleft>0 do
+              begin
+                if sizeleft>sizeof(buf) then
+                  i:=sizeof(buf)
+                else
+                  i:=sizeleft;
+                generictokenbuf.read(buf,i);
+                ppufile.putdata(buf,i);
+                dec(sizeleft,i);
+              end;
+          end;
+        ppufile.do_crc:=oldintfcrc;
+        if df_specialization in defoptions then
+          ppufile.putderef(genericdefderef);
+      end;
+
+
+    procedure tstoreddef.buildderef;
+      begin
+        typesymderef.build(typesym);
+        genericdefderef.build(genericdef);
+      end;
+
+
+    procedure tstoreddef.buildderefimpl;
+      begin
+      end;
+
+
+    procedure tstoreddef.deref;
+      begin
+        typesym:=ttypesym(typesymderef.resolve);
+        if df_specialization in defoptions then
+          genericdef:=tstoreddef(genericdefderef.resolve);
+      end;
+
+
+    procedure tstoreddef.derefimpl;
+      begin
+      end;
+
+
+    function tstoreddef.size : asizeint;
+      begin
+         size:=savesize;
+      end;
+
+
+    function tstoreddef.getvardef:longint;
+      begin
+        result:=varUndefined;
+      end;
+
+
+    function tstoreddef.alignment : shortint;
+      begin
+         { natural alignment by default }
+         alignment:=size_2_align(savesize);
+         { can happen if savesize = 0, e.g. for voiddef or
+           an empty record
+         }
+         if (alignment=0) then
+           alignment:=1;
+      end;
+
+
+    { returns true, if the definition can be published }
+    function tstoreddef.is_publishable : boolean;
+      begin
+         is_publishable:=false;
+      end;
+
+
+    { needs an init table }
+    function tstoreddef.needs_inittable : boolean;
+      begin
+         needs_inittable:=false;
+      end;
+
+
+   function tstoreddef.is_intregable : boolean;
+     var
+       recsize,temp: longint;
+     begin
+        is_intregable:=false;
+        case typ of
+          orddef,
+          pointerdef,
+          enumdef,
+          classrefdef:
+            is_intregable:=true;
+          procvardef :
+            is_intregable:=tprocvardef(self).is_addressonly;
+          objectdef:
+            is_intregable:=(is_implicit_pointer_object_type(self)) and not needs_inittable;
+          setdef:
+            is_intregable:=is_smallset(self);
+          recorddef:
+            begin
+              recsize:=size;
+              is_intregable:=
+                ispowerof2(recsize,temp) and
+                (recsize <= sizeof(asizeint));
+            end;
+        end;
+     end;
+
+
+   function tstoreddef.is_fpuregable : boolean;
+     begin
+{$ifdef x86}
+       result:=use_vectorfpu(self);
+{$else x86}
+       result:=(typ=floatdef) and not(cs_fp_emulation in current_settings.moduleswitches);
+{$endif x86}
+     end;
+
+
+   procedure tstoreddef.initgeneric;
+     begin
+       if assigned(generictokenbuf) then
+         internalerror(200512131);
+       generictokenbuf:=tdynamicarray.create(256);
+     end;
+
+
+{****************************************************************************
+                               Tstringdef
+****************************************************************************}
+
+    constructor tstringdef.createshort(l : byte);
+      begin
+         inherited create(stringdef);
+         stringtype:=st_shortstring;
+         encoding:=0;
+         len:=l;
+         savesize:=len+1;
+      end;
+
+
+    constructor tstringdef.loadshort(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(stringdef,ppufile);
+         stringtype:=st_shortstring;
+         encoding:=0;
+         len:=ppufile.getbyte;
+         savesize:=len+1;
+      end;
+
+
+    constructor tstringdef.createlong(l : asizeint);
+      begin
+         inherited create(stringdef);
+         stringtype:=st_longstring;
+         encoding:=0;
+         len:=l;
+         savesize:=sizeof(pint);
+      end;
+
+
+    constructor tstringdef.loadlong(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(stringdef,ppufile);
+         stringtype:=st_longstring;
+         encoding:=0;
+         len:=ppufile.getasizeint;
+         savesize:=sizeof(pint);
+      end;
+
+
+    constructor tstringdef.createansi(aencoding:tstringencoding);
+      begin
+         inherited create(stringdef);
+         stringtype:=st_ansistring;
+         encoding:=aencoding;
+         len:=-1;
+         savesize:=sizeof(pint);
+      end;
+
+
+    constructor tstringdef.loadansi(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(stringdef,ppufile);
+         stringtype:=st_ansistring;
+         len:=ppufile.getaint;
+         encoding:=ppufile.getword;
+         savesize:=sizeof(pint);
+      end;
+
+
+    constructor tstringdef.createwide;
+      begin
+         inherited create(stringdef);
+         stringtype:=st_widestring;
+         encoding:=CP_UTF16;
+         len:=-1;
+         savesize:=sizeof(pint);
+      end;
+
+
+    constructor tstringdef.loadwide(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(stringdef,ppufile);
+         stringtype:=st_widestring;
+         encoding:=CP_UTF16;
+         len:=ppufile.getaint;
+         savesize:=sizeof(pint);
+      end;
+
+
+    constructor tstringdef.createunicode;
+      begin
+         inherited create(stringdef);
+         stringtype:=st_unicodestring;
+         encoding:=CP_UTF16;
+         len:=-1;
+         savesize:=sizeof(pint);
+      end;
+
+
+    constructor tstringdef.loadunicode(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(stringdef,ppufile);
+         stringtype:=st_unicodestring;
+         len:=ppufile.getaint;
+         encoding:=ppufile.getword;
+         savesize:=sizeof(pint);
+      end;
+
+
+    function tstringdef.getcopy : tstoreddef;
+      begin
+        result:=tstringdef.create(typ);
+        result.typ:=stringdef;
+        tstringdef(result).stringtype:=stringtype;
+        tstringdef(result).encoding:=encoding;
+        tstringdef(result).len:=len;
+        tstringdef(result).savesize:=savesize;
+      end;
+
+
+    function tstringdef.stringtypname:string;
+      const
+        typname:array[tstringtype] of string[10]=(
+          'shortstr','longstr','ansistr','widestr','unicodestr'
+        );
+      begin
+        stringtypname:=typname[stringtype];
+      end;
+
+
+    procedure tstringdef.ppuwrite(ppufile:tcompilerppufile);
+      begin
+         inherited ppuwrite(ppufile);
+         if stringtype=st_shortstring then
+           begin
+{$ifdef extdebug}
+            if len > 255 then internalerror(12122002);
+{$endif}
+            ppufile.putbyte(byte(len))
+           end
+         else
+           ppufile.putaint(len);
+         if stringtype in [st_ansistring,st_unicodestring] then
+           ppufile.putword(encoding);
+         case stringtype of
+            st_shortstring : ppufile.writeentry(ibshortstringdef);
+            st_longstring : ppufile.writeentry(iblongstringdef);
+            st_ansistring : ppufile.writeentry(ibansistringdef);
+            st_widestring : ppufile.writeentry(ibwidestringdef);
+            st_unicodestring : ppufile.writeentry(ibunicodestringdef);
+         end;
+      end;
+
+
+    function tstringdef.needs_inittable : boolean;
+      begin
+         needs_inittable:=stringtype in [st_ansistring,st_widestring,st_unicodestring];
+      end;
+
+
+    function tstringdef.GetTypeName : string;
+      const
+         names : array[tstringtype] of string[15] = (
+           'ShortString','LongString','AnsiString','WideString','UnicodeString');
+      begin
+         GetTypeName:=names[stringtype];
+      end;
+
+
+    function tstringdef.getvardef : longint;
+      const
+        vardef : array[tstringtype] of longint = (
+          varUndefined,varUndefined,varString,varOleStr,varUString);
+      begin
+        result:=vardef[stringtype];
+      end;
+
+
+    function tstringdef.alignment : shortint;
+      begin
+        case stringtype of
+          st_unicodestring,
+          st_widestring,
+          st_ansistring:
+            alignment:=size_2_align(savesize);
+          st_longstring,
+          st_shortstring:
+              { char to string accesses byte 0 and 1 with one word access }
+            if (tf_requires_proper_alignment in target_info.flags) or
+              { macpas needs an alignment of 2 (MetroWerks compatible) }
+               (m_mac in current_settings.modeswitches) then
+              alignment:=size_2_align(2)
+            else
+              alignment:=size_2_align(1);
+          else
+            internalerror(200412301);
+        end;
+      end;
+
+
+    function tstringdef.getmangledparaname : string;
+      begin
+        getmangledparaname:='STRING';
+      end;
+
+
+    function tstringdef.is_publishable : boolean;
+      begin
+         is_publishable:=true;
+      end;
+
+
+{****************************************************************************
+                                 TENUMDEF
+****************************************************************************}
+
+    constructor tenumdef.create;
+      begin
+         inherited create(enumdef);
+         minval:=0;
+         maxval:=0;
+         calcsavesize;
+         has_jumps:=false;
+         basedef:=nil;
+         symtable:=tenumsymtable.create(self);
+      end;
+
+
+    constructor tenumdef.create_subrange(_basedef:tenumdef;_min,_max:asizeint);
+      begin
+         inherited create(enumdef);
+         minval:=_min;
+         maxval:=_max;
+         basedef:=_basedef;
+         calcsavesize;
+         has_jumps:=false;
+         symtable:=basedef.symtable.getcopy;
+         include(defoptions, df_copied_def);
+       end;
+
+
+    constructor tenumdef.ppuload(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(enumdef,ppufile);
+         minval:=ppufile.getaint;
+         maxval:=ppufile.getaint;
+         savesize:=ppufile.getaint;
+         has_jumps:=false;
+         if df_copied_def in defoptions then
+           begin
+             symtable:=nil;
+             ppufile.getderef(basedefderef);
+           end
+         else
+           begin
+             // create with nil defowner first to prevent values changes on insert
+             symtable:=tenumsymtable.create(nil);
+             tenumsymtable(symtable).ppuload(ppufile);
+             symtable.defowner:=self;
+           end;
+      end;
+
+    destructor tenumdef.destroy;
+      begin
+        symtable.free;
+        symtable:=nil;
+        inherited destroy;
+      end;
+
+
+    function tenumdef.getcopy : tstoreddef;
+      begin
+        if assigned(basedef) then
+          result:=tenumdef.create_subrange(basedef,minval,maxval)
+        else
+          begin
+            result:=tenumdef.create;
+            tenumdef(result).minval:=minval;
+            tenumdef(result).maxval:=maxval;
+            tenumdef(result).symtable.free;
+            tenumdef(result).symtable:=symtable.getcopy;
+            tenumdef(result).basedef:=self;
+          end;
+        tenumdef(result).has_jumps:=has_jumps;
+        tenumdef(result).basedefderef:=basedefderef;
+        include(tenumdef(result).defoptions,df_copied_def);
+      end;
+
+
+    procedure tenumdef.calcsavesize;
+      begin
+{$IFNDEF cpu64bitaddr} {$push}{$warnings off} {$ENDIF} //comparison always false warning
+        if (current_settings.packenum=8) or (min<low(longint)) or (int64(max)>high(cardinal)) then
+         savesize:=8
+{$IFDEF not cpu64bitaddr} {$pop} {$ENDIF}
+        else
+         if (current_settings.packenum=4) or (min<low(smallint)) or (max>high(word)) then
+          savesize:=4
+        else
+         if (current_settings.packenum=2) or (min<low(shortint)) or (max>high(byte)) then
+          savesize:=2
+        else
+         savesize:=1;
+      end;
+
+
+    function tenumdef.packedbitsize: asizeint;
+      var
+        sizeval: tconstexprint;
+        power: longint;
+      begin
+        result := 0;
+        if (minval >= 0) and
+           (maxval <= 1) then
+          result := 1
+        else
+          begin
+            if (minval>=0) then
+              sizeval:=maxval
+            else
+              { don't count 0 twice }
+              sizeval:=(cutils.max(-minval,maxval)*2)-1;
+            { 256 must become 512 etc. }
+            nextpowerof2(sizeval+1,power);
+            result := power;
+          end;
+      end;
+
+
+    procedure tenumdef.setmax(_max:asizeint);
+      begin
+        maxval:=_max;
+        calcsavesize;
+      end;
+
+
+    procedure tenumdef.setmin(_min:asizeint);
+      begin
+        minval:=_min;
+        calcsavesize;
+      end;
+
+
+    function tenumdef.min:asizeint;
+      begin
+        min:=minval;
+      end;
+
+
+    function tenumdef.max:asizeint;
+      begin
+        max:=maxval;
+      end;
+
+    function tenumdef.getfirstsym: tsym;
+      var
+        i:integer;
+      begin
+        for i := 0 to symtable.SymList.Count - 1 do
+          begin
+            result:=tsym(symtable.SymList[i]);
+            if tenumsym(result).value=minval then
+              exit;
+          end;
+        result:=nil;
+      end;
+
+
+    procedure tenumdef.buildderef;
+      begin
+        inherited buildderef;
+        if df_copied_def in defoptions then
+          basedefderef.build(basedef)
+        else
+          tenumsymtable(symtable).buildderef;
+      end;
+
+
+    procedure tenumdef.deref;
+      begin
+        inherited deref;
+        if df_copied_def in defoptions then
+          begin
+            basedef:=tenumdef(basedefderef.resolve);
+            symtable:=basedef.symtable.getcopy;
+          end
+        else
+          tenumsymtable(symtable).deref;
+      end;
+
+
+    procedure tenumdef.ppuwrite(ppufile:tcompilerppufile);
+      begin
+         inherited ppuwrite(ppufile);
+         ppufile.putaint(min);
+         ppufile.putaint(max);
+         ppufile.putaint(savesize);
+         if df_copied_def in defoptions then
+           ppufile.putderef(basedefderef);
+         ppufile.writeentry(ibenumdef);
+         if not (df_copied_def in defoptions) then
+           tenumsymtable(symtable).ppuwrite(ppufile);
+      end;
+
+
+    function tenumdef.is_publishable : boolean;
+      begin
+         is_publishable:=true;
+      end;
+
+
+    function tenumdef.GetTypeName : string;
+      begin
+         GetTypeName:='<enumeration type>';
+      end;
+
+
+{****************************************************************************
+                                 TORDDEF
+****************************************************************************}
+
+    constructor torddef.create(t : tordtype;v,b : TConstExprInt);
+      begin
+         inherited create(orddef);
+         low:=v;
+         high:=b;
+         ordtype:=t;
+         setsize;
+      end;
+
+
+    constructor torddef.ppuload(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(orddef,ppufile);
+         ordtype:=tordtype(ppufile.getbyte);
+         low:=ppufile.getexprint;
+         high:=ppufile.getexprint;
+         setsize;
+      end;
+
+
+    function torddef.getcopy : tstoreddef;
+      begin
+         result:=torddef.create(ordtype,low,high);
+         result.typ:=orddef;
+         torddef(result).low:=low;
+         torddef(result).high:=high;
+         torddef(result).ordtype:=ordtype;
+         torddef(result).savesize:=savesize;
+      end;
+
+
+    function torddef.alignment:shortint;
+      begin
+        if (target_info.system in [system_i386_darwin,system_i386_iphonesim,system_arm_darwin]) and
+           (ordtype in [s64bit,u64bit]) then
+          result := 4
+        else
+          result := inherited alignment;
+      end;
+
+
+    procedure torddef.setsize;
+      const
+        sizetbl : array[tordtype] of longint = (
+          0,
+          1,2,4,8,
+          1,2,4,8,
+          1,2,4,8,
+          1,2,4,8,
+          1,2,8
+        );
+      begin
+        savesize:=sizetbl[ordtype];
+      end;
+
+
+    function torddef.packedbitsize: asizeint;
+      var
+        sizeval: tconstexprint;
+        power: longint;
+      begin
+        result := 0;
+        if ordtype = uvoid then
+          exit;
+
+{$ifndef cpu64bitalu}
+        if (ordtype in [s64bit,u64bit]) then
+{$else not cpu64bitalu}
+        if (ordtype = u64bit) or
+           ((ordtype = s64bit) and
+            ((low <= (system.low(int64) div 2)) or
+             (high > (system.high(int64) div 2)))) then
+{$endif cpu64bitalu}
+          result := 64
+        else if (low >= 0) and
+           (high <= 1) then
+          result := 1
+        else
+          begin
+            if (low>=0) then
+              sizeval:=high
+            else
+              { don't count 0 twice }
+              sizeval:=(cutils.max(-low,high)*2)-1;
+            { 256 must become 512 etc. }
+            nextpowerof2(sizeval+1,power);
+            result := power;
+         end;
+      end;
+
+
+    function torddef.getvardef : longint;
+      const
+        basetype2vardef : array[tordtype] of longint = (
+          varUndefined,
+          varbyte,varword,varlongword,varqword,
+          varshortint,varsmallint,varinteger,varint64,
+          varboolean,varboolean,varboolean,varboolean,
+          varboolean,varboolean,varUndefined,varUndefined,
+          varUndefined,varUndefined,varCurrency);
+      begin
+        result:=basetype2vardef[ordtype];
+      end;
+
+
+    procedure torddef.ppuwrite(ppufile:tcompilerppufile);
+      begin
+         inherited ppuwrite(ppufile);
+         ppufile.putbyte(byte(ordtype));
+         ppufile.putexprint(low);
+         ppufile.putexprint(high);
+         ppufile.writeentry(iborddef);
+      end;
+
+
+    function torddef.is_publishable : boolean;
+      begin
+         is_publishable:=(ordtype<>uvoid);
+      end;
+
+
+    function torddef.GetTypeName : string;
+      const
+        names : array[tordtype] of string[20] = (
+          'untyped',
+          'Byte','Word','DWord','QWord',
+          'ShortInt','SmallInt','LongInt','Int64',
+          'Boolean','Boolean16','Boolean32','Boolean64',
+          'ByteBool','WordBool','LongBool','QWordBool',
+          'Char','WideChar','Currency');
+
+      begin
+         GetTypeName:=names[ordtype];
+      end;
+
+
+{****************************************************************************
+                                TFLOATDEF
+****************************************************************************}
+
+    constructor tfloatdef.create(t : tfloattype);
+      begin
+         inherited create(floatdef);
+         floattype:=t;
+         setsize;
+      end;
+
+
+    constructor tfloatdef.ppuload(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(floatdef,ppufile);
+         floattype:=tfloattype(ppufile.getbyte);
+         setsize;
+      end;
+
+
+    function tfloatdef.getcopy : tstoreddef;
+      begin
+         result:=tfloatdef.create(floattype);
+         result.typ:=floatdef;
+         tfloatdef(result).savesize:=savesize;
+      end;
+
+
+    function tfloatdef.alignment:shortint;
+      begin
+        if (target_info.system in [system_i386_darwin,system_i386_iphonesim,system_arm_darwin]) then
+          case floattype of
+            sc80real,
+            s80real: result:=16;
+            s64real,
+            s64currency,
+            s64comp : result:=4;
+            else
+              result := inherited alignment;
+          end
+        else
+          result := inherited alignment;
+      end;
+
+
+    procedure tfloatdef.setsize;
+      begin
+         case floattype of
+           s32real : savesize:=4;
+           s80real : savesize:=10;
+           sc80real:
+             if target_info.system in [system_i386_darwin,system_i386_iphonesim,system_x86_64_darwin,
+                  system_x86_64_linux,system_x86_64_freebsd,
+                  system_x86_64_solaris,system_x86_64_embedded] then
+               savesize:=16
+             else
+               savesize:=12;
+           s64real,
+           s64currency,
+           s64comp : savesize:=8;
+         else
+           savesize:=0;
+         end;
+      end;
+
+
+    function tfloatdef.getvardef : longint;
+      const
+        floattype2vardef : array[tfloattype] of longint = (
+          varSingle,varDouble,varUndefined,varUndefined,
+          varUndefined,varCurrency,varUndefined);
+      begin
+        if (upper(typename)='TDATETIME') and
+          assigned(owner) and
+          assigned(owner.name) and
+          (owner.name^='SYSTEM') then
+          result:=varDate
+        else
+          result:=floattype2vardef[floattype];
+      end;
+
+
+    procedure tfloatdef.ppuwrite(ppufile:tcompilerppufile);
+      begin
+         inherited ppuwrite(ppufile);
+         ppufile.putbyte(byte(floattype));
+         ppufile.writeentry(ibfloatdef);
+      end;
+
+
+    function tfloatdef.is_publishable : boolean;
+      begin
+         is_publishable:=true;
+      end;
+
+
+    function tfloatdef.GetTypeName : string;
+      const
+        names : array[tfloattype] of string[20] = (
+          'Single','Double','Extended','CExtended','Comp','Currency','Float128');
+      begin
+         GetTypeName:=names[floattype];
+      end;
+
+
+{****************************************************************************
+                                TFILEDEF
+****************************************************************************}
+
+    constructor tfiledef.createtext;
+      begin
+         inherited create(filedef);
+         filetyp:=ft_text;
+         typedfiledef:=nil;
+         setsize;
+      end;
+
+
+    constructor tfiledef.createuntyped;
+      begin
+         inherited create(filedef);
+         filetyp:=ft_untyped;
+         typedfiledef:=nil;
+         setsize;
+      end;
+
+
+    constructor tfiledef.createtyped(def:tdef);
+      begin
+         inherited create(filedef);
+         filetyp:=ft_typed;
+         typedfiledef:=def;
+         setsize;
+      end;
+
+
+    constructor tfiledef.ppuload(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(filedef,ppufile);
+         filetyp:=tfiletyp(ppufile.getbyte);
+         if filetyp=ft_typed then
+           ppufile.getderef(typedfiledefderef)
+         else
+           typedfiledef:=nil;
+         setsize;
+      end;
+
+
+    function tfiledef.getcopy : tstoreddef;
+      begin
+        case filetyp of
+          ft_typed:
+            result:=tfiledef.createtyped(typedfiledef);
+          ft_untyped:
+            result:=tfiledef.createuntyped;
+          ft_text:
+            result:=tfiledef.createtext;
+          else
+            internalerror(2004121201);
+        end;
+      end;
+
+
+    procedure tfiledef.buildderef;
+      begin
+        inherited buildderef;
+        if filetyp=ft_typed then
+          typedfiledefderef.build(typedfiledef);
+      end;
+
+
+    procedure tfiledef.deref;
+      begin
+        inherited deref;
+        if filetyp=ft_typed then
+          typedfiledef:=tdef(typedfiledefderef.resolve);
+      end;
+
+
+    procedure tfiledef.setsize;
+      begin
+{$ifdef cpu64bitaddr}
+        case filetyp of
+          ft_text :
+            if target_info.system in [system_x86_64_win64,system_ia64_win64] then
+              savesize:=634{+8}
+            else
+              savesize:=630{+8};
+          ft_typed,
+          ft_untyped :
+            if target_info.system in [system_x86_64_win64,system_ia64_win64] then
+              savesize:=372
+            else
+              savesize:=368;
+        end;
+{$endif cpu64bitaddr}
+{$ifdef cpu32bitaddr}
+        case filetyp of
+          ft_text :
+            savesize:=594{+4};
+          ft_typed,
+          ft_untyped :
+            savesize:=332;
+        end;
+{$endif cpu32bitaddr}
+{$ifdef cpu8bitaddr}
+        case filetyp of
+          ft_text :
+            savesize:=127;
+          ft_typed,
+          ft_untyped :
+            savesize:=127;
+        end;
+{$endif cpu8bitaddr}
+      end;
+
+
+    procedure tfiledef.ppuwrite(ppufile:tcompilerppufile);
+      begin
+         inherited ppuwrite(ppufile);
+         ppufile.putbyte(byte(filetyp));
+         if filetyp=ft_typed then
+           ppufile.putderef(typedfiledefderef);
+         ppufile.writeentry(ibfiledef);
+      end;
+
+
+    function tfiledef.GetTypeName : string;
+      begin
+         case filetyp of
+           ft_untyped:
+             GetTypeName:='File';
+           ft_typed:
+             GetTypeName:='File Of '+typedfiledef.typename;
+           ft_text:
+             GetTypeName:='Text'
+         end;
+      end;
+
+
+    function tfiledef.getmangledparaname : string;
+      begin
+         case filetyp of
+           ft_untyped:
+             getmangledparaname:='FILE';
+           ft_typed:
+             getmangledparaname:='FILE$OF$'+typedfiledef.mangledparaname;
+           ft_text:
+             getmangledparaname:='TEXT'
+         end;
+      end;
+
+
+{****************************************************************************
+                               TVARIANTDEF
+****************************************************************************}
+
+    constructor tvariantdef.create(v : tvarianttype);
+      begin
+         inherited create(variantdef);
+         varianttype:=v;
+         setsize;
+      end;
+
+
+    constructor tvariantdef.ppuload(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(variantdef,ppufile);
+         varianttype:=tvarianttype(ppufile.getbyte);
+         setsize;
+      end;
+
+
+    function tvariantdef.getcopy : tstoreddef;
+      begin
+        result:=tvariantdef.create(varianttype);
+      end;
+
+
+    procedure tvariantdef.ppuwrite(ppufile:tcompilerppufile);
+      begin
+         inherited ppuwrite(ppufile);
+         ppufile.putbyte(byte(varianttype));
+         ppufile.writeentry(ibvariantdef);
+      end;
+
+
+    function tvariantdef.getvardef : longint;
+      begin
+        Result:=varVariant;
+      end;
+
+
+    procedure tvariantdef.setsize;
+      begin
+{$ifdef cpu64bitaddr}
+        savesize:=24;
+{$else cpu64bitaddr}
+        savesize:=16;
+{$endif cpu64bitaddr}
+      end;
+
+
+    function tvariantdef.GetTypeName : string;
+      begin
+         case varianttype of
+           vt_normalvariant:
+             GetTypeName:='Variant';
+           vt_olevariant:
+             GetTypeName:='OleVariant';
+         end;
+      end;
+
+
+    function tvariantdef.needs_inittable : boolean;
+      begin
+         needs_inittable:=true;
+      end;
+
+
+    function tvariantdef.is_publishable : boolean;
+      begin
+         is_publishable:=true;
+      end;
+
+
+{****************************************************************************
+                            TABSTRACtpointerdef
+****************************************************************************}
+
+    constructor tabstractpointerdef.create(dt:tdeftyp;def:tdef);
+      begin
+        inherited create(dt);
+        pointeddef:=def;
+        savesize:=sizeof(pint);
+      end;
+
+
+    constructor tabstractpointerdef.ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(dt,ppufile);
+         ppufile.getderef(pointeddefderef);
+         savesize:=sizeof(pint);
+      end;
+
+
+    procedure tabstractpointerdef.buildderef;
+      begin
+        inherited buildderef;
+        pointeddefderef.build(pointeddef);
+      end;
+
+
+    procedure tabstractpointerdef.deref;
+      begin
+        inherited deref;
+        pointeddef:=tdef(pointeddefderef.resolve);
+      end;
+
+
+    procedure tabstractpointerdef.ppuwrite(ppufile:tcompilerppufile);
+      begin
+         inherited ppuwrite(ppufile);
+         ppufile.putderef(pointeddefderef);
+      end;
+
+
+{****************************************************************************
+                               tpointerdef
+****************************************************************************}
+
+    constructor tpointerdef.create(def:tdef);
+      begin
+        inherited create(pointerdef,def);
+        is_far:=false;
+        has_pointer_math:=cs_pointermath in current_settings.localswitches;
+      end;
+
+
+    constructor tpointerdef.createfar(def:tdef);
+      begin
+        inherited create(pointerdef,def);
+        is_far:=true;
+        has_pointer_math:=cs_pointermath in current_settings.localswitches;
+      end;
+
+
+    constructor tpointerdef.ppuload(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(pointerdef,ppufile);
+         is_far:=(ppufile.getbyte<>0);
+         has_pointer_math:=(ppufile.getbyte<>0);
+      end;
+
+
+    function tpointerdef.getcopy : tstoreddef;
+      begin
+        { don't use direct pointeddef if it is a forwarddef because in other case
+          one of them will be destroyed on forward type resolve and the second will
+          point to garbage }
+        if pointeddef.typ=forwarddef then
+          result:=tpointerdef.create(tforwarddef(pointeddef).getcopy)
+        else
+          result:=tpointerdef.create(pointeddef);
+        tpointerdef(result).is_far:=is_far;
+        tpointerdef(result).has_pointer_math:=has_pointer_math;
+        tpointerdef(result).savesize:=savesize;
+      end;
+
+
+    procedure tpointerdef.ppuwrite(ppufile:tcompilerppufile);
+      begin
+         inherited ppuwrite(ppufile);
+         ppufile.putbyte(byte(is_far));
+         ppufile.putbyte(byte(has_pointer_math));
+         ppufile.writeentry(ibpointerdef);
+      end;
+
+
+    function tpointerdef.GetTypeName : string;
+      begin
+         if is_far then
+          GetTypeName:='^'+pointeddef.typename+';far'
+         else
+          GetTypeName:='^'+pointeddef.typename;
+      end;
+
+
+{****************************************************************************
+                              TCLASSREFDEF
+****************************************************************************}
+
+    constructor tclassrefdef.create(def:tdef);
+      begin
+         inherited create(classrefdef,def);
+      end;
+
+
+    constructor tclassrefdef.ppuload(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(classrefdef,ppufile);
+      end;
+
+
+    procedure tclassrefdef.ppuwrite(ppufile:tcompilerppufile);
+      begin
+         inherited ppuwrite(ppufile);
+         ppufile.writeentry(ibclassrefdef);
+      end;
+
+
+    function tclassrefdef.getcopy:tstoreddef;
+      begin
+        if pointeddef.typ=forwarddef then
+          result:=tclassrefdef.create(tforwarddef(pointeddef).getcopy)
+        else
+          result:=tclassrefdef.create(pointeddef);
+        tclassrefdef(result).savesize:=savesize;
+      end;
+
+
+    function tclassrefdef.GetTypeName : string;
+      begin
+         GetTypeName:='Class Of '+pointeddef.typename;
+      end;
+
+
+    function tclassrefdef.is_publishable : boolean;
+      begin
+         result:=true;
+      end;
+
+
+    function tclassrefdef.rtti_mangledname(rt: trttitype): string;
+      begin
+        if (tobjectdef(pointeddef).objecttype<>odt_objcclass) then
+          result:=inherited rtti_mangledname(rt)
+        else
+          result:=tobjectdef(pointeddef).rtti_mangledname(objcmetartti);
+      end;
+
+
+    procedure tclassrefdef.register_created_object_type;
+      begin
+        tobjectdef(pointeddef).register_created_classref_type;
+      end;
+
+{***************************************************************************
+                                   TSETDEF
+***************************************************************************}
+
+    constructor tsetdef.create(def:tdef;low, high : asizeint);
+      var
+        setallocbits: aint;
+        packedsavesize: aint;
+      begin
+         inherited create(setdef);
+         elementdef:=def;
+         setmax:=high;
+         if (current_settings.setalloc=0) then
+           begin
+             setbase:=0;
+             if (high<32) then
+               savesize:=Sizeof(longint)
+             else if (high<256) then
+               savesize:=32
+             else
+               savesize:=(high+7) div 8
+           end
+         else
+           begin
+             setallocbits:=current_settings.setalloc*8;
+             setbase:=low and not(setallocbits-1);
+             packedsavesize:=current_settings.setalloc*((((high+setallocbits)-setbase)) DIV setallocbits);
+             savesize:=packedsavesize;
+             if savesize=3 then
+               savesize:=4;
+           end;
+      end;
+
+
+    constructor tsetdef.ppuload(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(setdef,ppufile);
+         ppufile.getderef(elementdefderef);
+         savesize:=ppufile.getaint;
+         setbase:=ppufile.getaint;
+         setmax:=ppufile.getaint;
+      end;
+
+
+    function tsetdef.getcopy : tstoreddef;
+      begin
+        result:=tsetdef.create(elementdef,setbase,setmax);
+        { the copy might have been created with a different setalloc setting }
+        tsetdef(result).savesize:=savesize;
+      end;
+
+
+    procedure tsetdef.ppuwrite(ppufile:tcompilerppufile);
+      begin
+         inherited ppuwrite(ppufile);
+         ppufile.putderef(elementdefderef);
+         ppufile.putaint(savesize);
+         ppufile.putaint(setbase);
+         ppufile.putaint(setmax);
+         ppufile.writeentry(ibsetdef);
+      end;
+
+
+    procedure tsetdef.buildderef;
+      begin
+        inherited buildderef;
+        elementdefderef.build(elementdef);
+      end;
+
+
+    procedure tsetdef.deref;
+      begin
+        inherited deref;
+        elementdef:=tdef(elementdefderef.resolve);
+      end;
+
+
+    function tsetdef.is_publishable : boolean;
+      begin
+         is_publishable:=savesize in [1,2,4];
+      end;
+
+
+    function tsetdef.GetTypeName : string;
+      begin
+         if assigned(elementdef) then
+          GetTypeName:='Set Of '+elementdef.typename
+         else
+          GetTypeName:='Empty Set';
+      end;
+
+
+{***************************************************************************
+                                 TFORMALDEF
+***************************************************************************}
+
+    constructor tformaldef.create(Atyped:boolean);
+      begin
+         inherited create(formaldef);
+         typed:=Atyped;
+         savesize:=0;
+      end;
+
+
+    constructor tformaldef.ppuload(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(formaldef,ppufile);
+         typed:=boolean(ppufile.getbyte);
+         savesize:=0;
+      end;
+
+
+    procedure tformaldef.ppuwrite(ppufile:tcompilerppufile);
+      begin
+         inherited ppuwrite(ppufile);
+         ppufile.putbyte(byte(typed));
+         ppufile.writeentry(ibformaldef);
+      end;
+
+
+    function tformaldef.GetTypeName : string;
+      begin
+         if typed then
+           GetTypeName:='<Typed formal type>'
+         else
+           GetTypeName:='<Formal type>';
+      end;
+
+
+{***************************************************************************
+                           TARRAYDEF
+***************************************************************************}
+
+    constructor tarraydef.create(l,h:asizeint;def:tdef);
+      begin
+         inherited create(arraydef);
+         lowrange:=l;
+         highrange:=h;
+         rangedef:=def;
+         _elementdef:=nil;
+         arrayoptions:=[];
+         symtable:=tarraysymtable.create(self);
+      end;
+
+    destructor tarraydef.destroy;
+      begin
+        symtable.free;
+        symtable:=nil;
+        inherited;
+      end;
+
+    constructor tarraydef.create_from_pointer(def:tdef);
+      begin
+         { use -1 so that the elecount will not overflow }
+         self.create(0,high(aint)-1,ptrsinttype);
+         arrayoptions:=[ado_IsConvertedPointer];
+         setelementdef(def);
+      end;
+
+
+    constructor tarraydef.ppuload(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(arraydef,ppufile);
+         { the addresses are calculated later }
+         ppufile.getderef(_elementdefderef);
+         ppufile.getderef(rangedefderef);
+         lowrange:=ppufile.getaint;
+         highrange:=ppufile.getaint;
+         ppufile.getsmallset(arrayoptions);
+         symtable:=tarraysymtable.create(self);
+         tarraysymtable(symtable).ppuload(ppufile)
+      end;
+
+
+    function tarraydef.getcopy : tstoreddef;
+      begin
+        result:=tarraydef.create(lowrange,highrange,rangedef);
+        tarraydef(result).arrayoptions:=arrayoptions;
+        tarraydef(result)._elementdef:=_elementdef;
+      end;
+
+
+    procedure tarraydef.buildderef;
+      begin
+        inherited buildderef;
+        tarraysymtable(symtable).buildderef;
+        _elementdefderef.build(_elementdef);
+        rangedefderef.build(rangedef);
+      end;
+
+
+    procedure tarraydef.deref;
+      begin
+        inherited deref;
+        tarraysymtable(symtable).deref;
+        _elementdef:=tdef(_elementdefderef.resolve);
+        rangedef:=tdef(rangedefderef.resolve);
+      end;
+
+
+    procedure tarraydef.ppuwrite(ppufile:tcompilerppufile);
+      begin
+         inherited ppuwrite(ppufile);
+         ppufile.putderef(_elementdefderef);
+         ppufile.putderef(rangedefderef);
+         ppufile.putaint(lowrange);
+         ppufile.putaint(highrange);
+         ppufile.putsmallset(arrayoptions);
+         ppufile.writeentry(ibarraydef);
+         tarraysymtable(symtable).ppuwrite(ppufile);
+      end;
+
+
+    function tarraydef.elesize : asizeint;
+      begin
+        if (ado_IsBitPacked in arrayoptions) then
+          internalerror(2006080101);
+        if assigned(_elementdef) then
+          result:=_elementdef.size
+        else
+          result:=0;
+      end;
+
+
+    function tarraydef.elepackedbitsize : asizeint;
+      begin
+        if not(ado_IsBitPacked in arrayoptions) then
+          internalerror(2006080102);
+	if assigned(_elementdef) then
+          result:=_elementdef.packedbitsize
+	else
+	  result:=0;
+      end;
+
+
+    function tarraydef.elecount : asizeuint;
+      var
+        qhigh,qlow : qword;
+      begin
+        if ado_IsDynamicArray in arrayoptions then
+          begin
+            result:=0;
+            exit;
+          end;
+        if (highrange>0) and (lowrange<0) then
+          begin
+            qhigh:=highrange;
+            qlow:=qword(-lowrange);
+            { prevent overflow, return 0 to indicate overflow }
+            if qhigh+qlow>qword(high(asizeint)-1) then
+              result:=0
+            else
+              result:=qhigh+qlow+1;
+          end
+        else
+          result:=int64(highrange)-lowrange+1;
+      end;
+
+
+    function tarraydef.size : asizeint;
+      var
+        cachedelecount : asizeuint;
+        cachedelesize : asizeint;
+      begin
+        if ado_IsDynamicArray in arrayoptions then
+          begin
+            size:=sizeof(pint);
+            exit;
+          end;
+
+        { Tarraydef.size may never be called for an open array! }
+        if highrange<lowrange then
+          internalerror(99080501);
+        if not (ado_IsBitPacked in arrayoptions) then
+          cachedelesize:=elesize
+        else
+          cachedelesize := elepackedbitsize;
+        cachedelecount:=elecount;
+
+        if (cachedelesize = 0) then
+          begin
+            size := 0;
+            exit;
+          end;
+
+        if (cachedelecount = 0) then
+          begin
+            size := -1;
+            exit;
+          end;
+
+        { prevent overflow, return -1 to indicate overflow }
+        { also make sure we don't need 64/128 bit arithmetic to calculate offsets }
+        if (cachedelecount > asizeuint(high(asizeint))) or
+           ((high(asizeint) div cachedelesize) < asizeint(cachedelecount)) or
+           { also lowrange*elesize must be < high(asizeint) to prevent overflow when
+             accessing the array, see ncgmem (PFV) }
+           ((high(asizeint) div cachedelesize) < abs(lowrange)) then
+          begin
+            result:=-1;
+            exit;
+          end;
+
+        result:=cachedelesize*asizeint(cachedelecount);
+        if (ado_IsBitPacked in arrayoptions) then
+          { can't just add 7 and divide by 8, because that may overflow }
+          result:=result div 8 + ord((result mod 8)<>0);
+      end;
+
+
+    procedure tarraydef.setelementdef(def:tdef);
+      begin
+        _elementdef:=def;
+        if not(
+               (ado_IsDynamicArray in arrayoptions) or
+               (ado_IsConvertedPointer in arrayoptions) or
+               (highrange<lowrange)
+	      ) and
+           (size=-1) then
+          Message(sym_e_segment_too_large);
+      end;
+
+
+    function tarraydef.alignment : shortint;
+      begin
+         { alignment of dyn. arrays doesn't depend on the element size }
+         if (ado_IsDynamicArray in arrayoptions) then
+           alignment:=size_2_align(sizeof(pint))
+         { alignment is the alignment of the elements }
+         else if (elementdef.typ in [arraydef,recorddef,orddef,enumdef,floatdef]) or
+           ((elementdef.typ=objectdef) and
+             is_object(elementdef)) then
+           alignment:=elementdef.alignment
+         { alignment is the size of the elements }
+         else if not (ado_IsBitPacked in arrayoptions) then
+           alignment:=size_2_align(elesize)
+         else
+           alignment:=packedbitsloadsize(elepackedbitsize);
+      end;
+
+
+    function tarraydef.needs_inittable : boolean;
+      begin
+         needs_inittable:=(ado_IsDynamicArray in arrayoptions) or elementdef.needs_inittable;
+      end;
+
+
+    function tarraydef.GetTypeName : string;
+      begin
+         if (ado_IsConstString in arrayoptions) then
+           result:='Constant String'
+         else if (ado_isarrayofconst in arrayoptions) or
+                 (ado_isConstructor in arrayoptions) then
+           begin
+             if (ado_isvariant in arrayoptions) or ((highrange=-1) and (lowrange=0)) then
+               GetTypeName:='Array Of Const'
+             else
+               GetTypeName:='Array Of Const/Constant Open Array of '+elementdef.typename;
+           end
+         else if (ado_IsDynamicArray in arrayoptions) then
+           GetTypeName:='Dynamic Array Of '+elementdef.typename
+         else if ((highrange=-1) and (lowrange=0)) then
+           GetTypeName:='Open Array Of '+elementdef.typename
+         else
+           begin
+              result := '';
+              if (ado_IsBitPacked in arrayoptions) then
+                result:='Packed ';
+              if rangedef.typ=enumdef then
+                result:=result+'Array['+rangedef.typename+'] Of '+elementdef.typename
+              else
+                result:=result+'Array['+tostr(lowrange)+'..'+
+                  tostr(highrange)+'] Of '+elementdef.typename
+           end;
+      end;
+
+
+    function tarraydef.getmangledparaname : string;
+      begin
+         if ado_isarrayofconst in arrayoptions then
+          getmangledparaname:='array_of_const'
+         else
+          if ((highrange=-1) and (lowrange=0)) then
+           getmangledparaname:='array_of_'+elementdef.mangledparaname
+         else
+          internalerror(200204176);
+      end;
+
+
+    function tarraydef.is_publishable : boolean;
+      begin
+        Result:=ado_IsDynamicArray in arrayoptions;
+      end;
+
+{***************************************************************************
+                              tabstractrecorddef
+***************************************************************************}
+
+    constructor tabstractrecorddef.create(const n:string; dt:tdeftyp);
+      begin
+        inherited create(dt);
+        objname:=stringdup(upper(n));
+        objrealname:=stringdup(n);
+        objectoptions:=[];
+      end;
+
+    constructor tabstractrecorddef.ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(dt,ppufile);
+        objrealname:=stringdup(ppufile.getstring);
+        objname:=stringdup(upper(objrealname^));
+        ppufile.getsmallset(objectoptions);
+      end;
+
+    procedure tabstractrecorddef.ppuwrite(ppufile: tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putstring(objrealname^);
+        ppufile.putsmallset(objectoptions);
+      end;
+
+    destructor tabstractrecorddef.destroy;
+      begin
+        stringdispose(objname);
+        stringdispose(objrealname);
+        inherited destroy;
+      end;
+
+    procedure tabstractrecorddef.check_forwards;
+      begin
+        tstoredsymtable(symtable).check_forwards;
+      end;
+
+    function tabstractrecorddef.find_procdef_bytype(pt:tproctypeoption): tprocdef;
+      var
+        i: longint;
+        sym: tsym;
+      begin
+        for i:=0 to symtable.SymList.Count-1 do
+          begin
+            sym:=tsym(symtable.SymList[i]);
+            if sym.typ=procsym then
+              begin
+                result:=tprocsym(sym).find_procdef_bytype(pt);
+                if assigned(result) then
+                  exit;
+              end;
+          end;
+          result:=nil;
+      end;
+
+    function tabstractrecorddef.GetSymtable(t:tGetSymtable):TSymtable;
+      begin
+        if t=gs_record then
+          GetSymtable:=symtable
+        else
+          GetSymtable:=nil;
+      end;
+
+
+    function tabstractrecorddef.is_packed:boolean;
+      begin
+        result:=tabstractrecordsymtable(symtable).is_packed;
+      end;
+
+    function tabstractrecorddef.RttiName: string;
+      begin
+        Result:=OwnerHierarchyName+objrealname^;
+      end;
+
+    function tabstractrecorddef.search_enumerator_get: tprocdef;
+      var
+        sym : tsym;
+        i : integer;
+        pd : tprocdef;
+        hashedid : THashedIDString;
+      begin
+        result:=nil;
+        hashedid.id:='GETENUMERATOR';
+        sym:=tsym(symtable.FindWithHash(hashedid));
+        if assigned(sym) and (sym.typ=procsym) then
+          begin
+            for i := 0 to Tprocsym(sym).ProcdefList.Count - 1 do
+            begin
+              pd := tprocdef(Tprocsym(sym).ProcdefList[i]);
+              if (pd.proctypeoption = potype_function) and
+                 (is_class_or_interface_or_object(pd.returndef) or is_record(pd.returndef)) and
+                 (pd.visibility >= vis_public) then
+              begin
+                result:=pd;
+                exit;
+              end;
+            end;
+          end;
+      end;
+
+    function tabstractrecorddef.search_enumerator_move: tprocdef;
+      var
+        sym : tsym;
+        i : integer;
+        pd : tprocdef;
+        hashedid : THashedIDString;
+      begin
+        result:=nil;
+        // first search for po_enumerator_movenext method modifier
+        // then search for public function MoveNext: Boolean
+        for i:=0 to symtable.SymList.Count-1 do
+          begin
+            sym:=TSym(symtable.SymList[i]);
+            if (sym.typ=procsym) then
+            begin
+              pd:=Tprocsym(sym).find_procdef_byoptions([po_enumerator_movenext]);
+              if assigned(pd) then
+                begin
+                  result:=pd;
+                  exit;
+                end;
+            end;
+          end;
+        hashedid.id:='MOVENEXT';
+        sym:=tsym(symtable.FindWithHash(hashedid));
+        if assigned(sym) and (sym.typ=procsym) then
+          begin
+            for i:=0 to Tprocsym(sym).ProcdefList.Count-1 do
+            begin
+              pd := tprocdef(Tprocsym(sym).ProcdefList[i]);
+              if (pd.proctypeoption = potype_function) and
+                 is_boolean(pd.returndef) and
+                 (pd.minparacount = 0) and
+                 (pd.visibility >= vis_public) then
+              begin
+                result:=pd;
+                exit;
+              end;
+            end;
+          end;
+      end;
+
+    function tabstractrecorddef.search_enumerator_current: tsym;
+      var
+        sym: tsym;
+        i: integer;
+        hashedid : THashedIDString;
+      begin
+        result:=nil;
+        // first search for ppo_enumerator_current property modifier
+        // then search for public property Current
+        for i:=0 to symtable.SymList.Count-1 do
+          begin
+            sym:=TSym(symtable.SymList[i]);
+            if (sym.typ=propertysym) and (ppo_enumerator_current in tpropertysym(sym).propoptions) then
+            begin
+              result:=sym;
+              exit;
+            end;
+          end;
+        hashedid.id:='CURRENT';
+        sym:=tsym(symtable.FindWithHash(hashedid));
+        if assigned(sym) and (sym.typ=propertysym) and
+           (sym.visibility >= vis_public) and not tpropertysym(sym).propaccesslist[palt_read].empty then
+          begin
+            result:=sym;
+            exit;
+          end;
+      end;
+
+{***************************************************************************
+                                  trecorddef
+***************************************************************************}
+
+    constructor trecorddef.create(const n:string; p:TSymtable);
+      begin
+         inherited create(n,recorddef);
+         symtable:=p;
+         { we can own the symtable only if nobody else owns a copy so far }
+         if symtable.refcount=1 then
+           symtable.defowner:=self;
+         isunion:=false;
+      end;
+
+
+    constructor trecorddef.ppuload(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(recorddef,ppufile);
+         if df_copied_def in defoptions then
+           ppufile.getderef(cloneddefderef)
+         else
+           begin
+             symtable:=trecordsymtable.create(objrealname^,0);
+             trecordsymtable(symtable).fieldalignment:=shortint(ppufile.getbyte);
+             trecordsymtable(symtable).recordalignment:=shortint(ppufile.getbyte);
+             trecordsymtable(symtable).padalignment:=shortint(ppufile.getbyte);
+             trecordsymtable(symtable).usefieldalignment:=shortint(ppufile.getbyte);
+             trecordsymtable(symtable).datasize:=ppufile.getasizeint;
+             trecordsymtable(symtable).paddingsize:=ppufile.getword;
+             trecordsymtable(symtable).ppuload(ppufile);
+             { requires usefieldalignment to be set }
+             symtable.defowner:=self;
+           end;
+         isunion:=false;
+      end;
+
+
+    destructor trecorddef.destroy;
+      begin
+         if assigned(symtable) then
+           begin
+             symtable.free;
+             symtable:=nil;
+           end;
+         inherited destroy;
+      end;
+
+
+    function trecorddef.getcopy : tstoreddef;
+      begin
+        result:=trecorddef.create(objrealname^,symtable.getcopy);
+        trecorddef(result).isunion:=isunion;
+        include(trecorddef(result).defoptions,df_copied_def);
+      end;
+
+
+    function trecorddef.needs_inittable : boolean;
+      begin
+        needs_inittable:=trecordsymtable(symtable).needs_init_final
+      end;
+
+
+    procedure trecorddef.buildderef;
+      begin
+         inherited buildderef;
+         if df_copied_def in defoptions then
+           cloneddefderef.build(symtable.defowner)
+         else
+           tstoredsymtable(symtable).buildderef;
+      end;
+
+
+    procedure trecorddef.deref;
+      begin
+         inherited deref;
+         { now dereference the definitions }
+         if df_copied_def in defoptions then
+           begin
+             cloneddef:=trecorddef(cloneddefderef.resolve);
+             symtable:=cloneddef.symtable.getcopy;
+           end
+         else
+           tstoredsymtable(symtable).deref;
+
+         { assign TGUID? load only from system unit }
+         if not(assigned(rec_tguid)) and
+            (upper(typename)='TGUID') and
+            assigned(owner) and
+            assigned(owner.name) and
+            (owner.name^='SYSTEM') then
+           rec_tguid:=self;
+
+         { assign JMP_BUF? load only from system unit }
+         if not(assigned(rec_jmp_buf)) and
+            (upper(typename)='JMP_BUF') and
+            assigned(owner) and
+            assigned(owner.name) and
+            (owner.name^='SYSTEM') then
+           rec_jmp_buf:=self;
+      end;
+
+
+    procedure trecorddef.ppuwrite(ppufile:tcompilerppufile);
+      begin
+         inherited ppuwrite(ppufile);
+         if df_copied_def in defoptions then
+           ppufile.putderef(cloneddefderef)
+         else
+           begin
+             ppufile.putbyte(byte(trecordsymtable(symtable).fieldalignment));
+             ppufile.putbyte(byte(trecordsymtable(symtable).recordalignment));
+             ppufile.putbyte(byte(trecordsymtable(symtable).padalignment));
+             ppufile.putbyte(byte(trecordsymtable(symtable).usefieldalignment));
+             ppufile.putasizeint(trecordsymtable(symtable).datasize);
+             ppufile.putword(trecordsymtable(symtable).paddingsize);
+           end;
+
+         ppufile.writeentry(ibrecorddef);
+
+         if not(df_copied_def in defoptions) then
+           trecordsymtable(symtable).ppuwrite(ppufile);
+      end;
+
+
+    function trecorddef.size:asizeint;
+      begin
+        result:=trecordsymtable(symtable).datasize;
+      end;
+
+
+    function trecorddef.alignment:shortint;
+      begin
+        alignment:=trecordsymtable(symtable).recordalignment;
+      end;
+
+
+    function trecorddef.padalignment:shortint;
+      begin
+        padalignment := trecordsymtable(symtable).padalignment;
+      end;
+
+
+    function trecorddef.GetTypeName : string;
+      begin
+         GetTypeName:='<record type>'
+      end;
+
+
+{***************************************************************************
+                       TABSTRACTPROCDEF
+***************************************************************************}
+
+    constructor tabstractprocdef.create(dt:tdeftyp;level:byte);
+      begin
+         inherited create(dt);
+         parast:=tparasymtable.create(self,level);
+         paras:=nil;
+         minparacount:=0;
+         maxparacount:=0;
+         proctypeoption:=potype_none;
+         proccalloption:=pocall_none;
+         procoptions:=[];
+         returndef:=voidtype;
+         savesize:=sizeof(pint);
+         callerargareasize:=0;
+         calleeargareasize:=0;
+         has_paraloc_info:=callnoside;
+         funcretloc[callerside].init;
+         funcretloc[calleeside].init;
+         check_mark_as_nested;
+      end;
+
+
+    destructor tabstractprocdef.destroy;
+      begin
+         if assigned(paras) then
+           begin
+{$ifdef MEMDEBUG}
+             memprocpara.start;
+{$endif MEMDEBUG}
+             paras.free;
+             paras:=nil;
+{$ifdef MEMDEBUG}
+             memprocpara.stop;
+{$endif MEMDEBUG}
+          end;
+         if assigned(parast) then
+          begin
+{$ifdef MEMDEBUG}
+            memprocparast.start;
+{$endif MEMDEBUG}
+            parast.free;
+            parast:=nil;
+{$ifdef MEMDEBUG}
+            memprocparast.stop;
+{$endif MEMDEBUG}
+          end;
+         funcretloc[callerside].done;
+         funcretloc[calleeside].done;
+         inherited destroy;
+      end;
+
+
+    procedure tabstractprocdef.count_para(p:TObject;arg:pointer);
+      begin
+        if (tsym(p).typ<>paravarsym) then
+          exit;
+        inc(plongint(arg)^);
+        if not(vo_is_hidden_para in tparavarsym(p).varoptions) then
+         begin
+           if not assigned(tparavarsym(p).defaultconstsym) then
+             inc(minparacount);
+           inc(maxparacount);
+         end;
+      end;
+
+
+    procedure tabstractprocdef.insert_para(p:TObject;arg:pointer);
+      begin
+        if (tsym(p).typ<>paravarsym) then
+          exit;
+        paras.add(p);
+      end;
+
+
+    procedure tabstractprocdef.calcparas;
+      var
+        paracount : longint;
+      begin
+        { This can already be assigned when
+          we need to reresolve this unit (PFV) }
+        if assigned(paras) then
+          paras.free;
+        paras:=tparalist.create(false);
+        paracount:=0;
+        minparacount:=0;
+        maxparacount:=0;
+        parast.SymList.ForEachCall(@count_para,@paracount);
+        paras.capacity:=paracount;
+        { Insert parameters in table }
+        parast.SymList.ForEachCall(@insert_para,nil);
+        { Order parameters }
+        paras.sortparas;
+      end;
+
+
+    procedure tabstractprocdef.buildderef;
+      begin
+         { released procdef? }
+         if not assigned(parast) then
+           exit;
+         inherited buildderef;
+         returndefderef.build(returndef);
+         { parast }
+         tparasymtable(parast).buildderef;
+      end;
+
+
+    procedure tabstractprocdef.deref;
+      begin
+         inherited deref;
+         returndef:=tdef(returndefderef.resolve);
+         { parast }
+         tparasymtable(parast).deref;
+         { recalculated parameters }
+         calcparas;
+      end;
+
+
+    constructor tabstractprocdef.ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(dt,ppufile);
+         parast:=nil;
+         Paras:=nil;
+         minparacount:=0;
+         maxparacount:=0;
+         ppufile.getderef(returndefderef);
+{ TODO: remove fpu_used loading}
+         ppufile.getbyte;
+         proctypeoption:=tproctypeoption(ppufile.getbyte);
+         proccalloption:=tproccalloption(ppufile.getbyte);
+         ppufile.getnormalset(procoptions);
+
+         funcretloc[callerside].init;
+         if po_explicitparaloc in procoptions then
+           funcretloc[callerside].ppuload(ppufile);
+
+         savesize:=sizeof(pint);
+         if (po_explicitparaloc in procoptions) then
+           has_paraloc_info:=callerside;
+      end;
+
+
+    procedure tabstractprocdef.ppuwrite(ppufile:tcompilerppufile);
+      var
+        oldintfcrc : boolean;
+      begin
+         { released procdef? }
+         if not assigned(parast) then
+           exit;
+         inherited ppuwrite(ppufile);
+         ppufile.putderef(returndefderef);
+         oldintfcrc:=ppufile.do_interface_crc;
+         ppufile.do_interface_crc:=false;
+         ppufile.putbyte(0);
+         ppufile.putbyte(ord(proctypeoption));
+         ppufile.putbyte(ord(proccalloption));
+         ppufile.putnormalset(procoptions);
+         ppufile.do_interface_crc:=oldintfcrc;
+
+         if (po_explicitparaloc in procoptions) then
+           funcretloc[callerside].ppuwrite(ppufile);
+      end;
+
+
+    function tabstractprocdef.typename_paras(showhidden:boolean) : string;
+      var
+        hs,s  : string;
+        hp    : TParavarsym;
+        hpc   : tconstsym;
+        first : boolean;
+        i     : integer;
+      begin
+        s:='';
+        first:=true;
+        for i:=0 to paras.count-1 do
+         begin
+           hp:=tparavarsym(paras[i]);
+           if not(vo_is_hidden_para in hp.varoptions) or
+              (showhidden) then
+            begin
+               if first then
+                begin
+                  s:=s+'(';
+                  first:=false;
+                end
+               else
+                s:=s+',';
+               if vo_is_hidden_para in hp.varoptions then
+                 s:=s+'<';
+               case hp.varspez of
+                 vs_var :
+                   s:=s+'var ';
+                 vs_const :
+                   s:=s+'const ';
+                 vs_out :
+                   s:=s+'out ';
+                 vs_constref :
+                   s:=s+'constref ';
+               end;
+               if hp.univpara then
+                 s:=s+'univ ';
+               if assigned(hp.vardef.typesym) then
+                 begin
+                   hs:=hp.vardef.typesym.realname;
+                   if hs[1]<>'$' then
+                     s:=s+hs
+                   else
+                     s:=s+hp.vardef.GetTypeName;
+                 end
+               else
+                 s:=s+hp.vardef.GetTypeName;
+               { default value }
+               if assigned(hp.defaultconstsym) then
+                begin
+                  hpc:=tconstsym(hp.defaultconstsym);
+                  hs:='';
+                  case hpc.consttyp of
+                    conststring,
+                    constresourcestring :
+                      begin
+                      If hpc.value.len>0 then
+                        begin
+                          setLength(hs,hpc.value.len);
+                          { don't write past the end of hs if the constant
+                            is > 255 chars }
+                          move(hpc.value.valueptr^,hs[1],length(hs));
+                          { make sure that constant strings with newline chars
+                            don't create a linebreak in the assembler code,
+                            since comments are line-based. Also remove nulls
+                            because the comments are written as a pchar. }
+                          ReplaceCase(hs,#0,'.');
+                          ReplaceCase(hs,#10,'.');
+                          ReplaceCase(hs,#13,'.');
+                        end;
+                      end;
+                    constreal :
+                      str(pbestreal(hpc.value.valueptr)^,hs);
+                    constpointer :
+                      hs:=tostr(hpc.value.valueordptr);
+                    constord :
+                      begin
+                        if is_boolean(hpc.constdef) then
+                          begin
+                            if hpc.value.valueord<>0 then
+                             hs:='TRUE'
+                            else
+                             hs:='FALSE';
+                          end
+                        else
+                          hs:=tostr(hpc.value.valueord);
+                      end;
+                    constnil :
+                      hs:='nil';
+                    constset :
+                      hs:='<set>';
+                  end;
+                  if hs<>'' then
+                   s:=s+'="'+hs+'"';
+                end;
+               if vo_is_hidden_para in hp.varoptions then
+                 s:=s+'>';
+             end;
+         end;
+        if not first then
+         s:=s+')';
+        if (po_varargs in procoptions) then
+         s:=s+';VarArgs';
+        typename_paras:=s;
+      end;
+
+
+    function tabstractprocdef.is_methodpointer:boolean;
+      begin
+        result:=false;
+      end;
+
+
+    function tabstractprocdef.is_addressonly:boolean;
+      begin
+        result:=true;
+      end;
+
+    function tabstractprocdef.no_self_node: boolean;
+      begin
+        Result:=([po_staticmethod,po_classmethod]<=procoptions)or
+                (proctypeoption in [potype_class_constructor,potype_class_destructor,potype_operator]);
+      end;
+
+
+    procedure tabstractprocdef.check_mark_as_nested;
+      begin
+         { nested procvars require that nested functions use the Delphi-style
+           nested procedure calling convention }
+         if (parast.symtablelevel>normal_function_level) and
+            (m_nested_procvars in current_settings.modeswitches) then
+           include(procoptions,po_delphi_nested_cc);
+      end;
+
+
+    procedure tabstractprocdef.init_paraloc_info(side: tcallercallee);
+      begin
+        if (side in [callerside,callbothsides]) and
+           not(has_paraloc_info in [callerside,callbothsides]) then
+          begin
+            callerargareasize:=paramanager.create_paraloc_info(self,callerside);
+            if has_paraloc_info in [calleeside,callbothsides] then
+              has_paraloc_info:=callbothsides
+            else
+              has_paraloc_info:=callerside;
+          end;
+        if (side in [calleeside,callbothsides]) and
+           not(has_paraloc_info in [calleeside,callbothsides]) then
+          begin
+            calleeargareasize:=paramanager.create_paraloc_info(self,calleeside);
+            if has_paraloc_info in [callerside,callbothsides] then
+              has_paraloc_info:=callbothsides
+            else
+              has_paraloc_info:=calleeside;
+          end;
+      end;
+
+
+    function tabstractprocdef.stack_tainting_parameter(side: tcallercallee): boolean;
+      var
+        p: tparavarsym;
+        ploc: PCGParalocation;
+        i: longint;
+      begin
+        result:=false;
+        init_paraloc_info(side);
+        for i:=0 to parast.SymList.Count-1 do
+          if tsym(parast.SymList[i]).typ=paravarsym then
+            begin
+              p:=tparavarsym(parast.SymList[i]);
+              { check if no parameter is located on the stack }
+              if is_open_array(p.vardef) or
+                 is_array_of_const(p.vardef) then
+                begin
+                  result:=true;
+                  exit;
+                end;
+              ploc:=p.paraloc[side].location;
+              while assigned(ploc) do
+                begin
+                  if (ploc^.loc=LOC_REFERENCE) then
+                    begin
+                      result:=true;
+                      exit
+                    end;
+                  ploc:=ploc^.next;
+                end;
+            end;
+      end;
+
+
+
+
+{***************************************************************************
+                                  TPROCDEF
+***************************************************************************}
+
+    constructor tprocdef.create(level:byte);
+      begin
+         inherited create(procdef,level);
+         localst:=tlocalsymtable.create(self,parast.symtablelevel);
+         _mangledname:=nil;
+         fileinfo:=current_filepos;
+         extnumber:=$ffff;
+         aliasnames:=TCmdStrList.create;
+         funcretsym:=nil;
+         forwarddef:=true;
+         interfacedef:=false;
+         hasforward:=false;
+         struct := nil;
+         import_dll:=nil;
+         import_name:=nil;
+         import_nr:=0;
+         inlininginfo:=nil;
+         deprecatedmsg:=nil;
+{$ifdef i386}
+          fpu_used:=maxfpuregs;
+{$endif i386}
+         interruptvector:=-1;
+      end;
+
+
+    constructor tprocdef.ppuload(ppufile:tcompilerppufile);
+      var
+        i,aliasnamescount : longint;
+        level : byte;
+      begin
+         inherited ppuload(procdef,ppufile);
+         if po_has_mangledname in procoptions then
+          _mangledname:=stringdup(ppufile.getstring)
+         else
+          _mangledname:=nil;
+         extnumber:=ppufile.getword;
+         level:=ppufile.getbyte;
+         ppufile.getderef(structderef);
+         ppufile.getderef(procsymderef);
+         ppufile.getposinfo(fileinfo);
+         visibility:=tvisibility(ppufile.getbyte);
+         ppufile.getsmallset(symoptions);
+         if sp_has_deprecated_msg in symoptions then
+           deprecatedmsg:=stringdup(ppufile.getstring)
+         else
+           deprecatedmsg:=nil;
+{$ifdef powerpc}
+         { library symbol for AmigaOS/MorphOS }
+         ppufile.getderef(libsymderef);
+{$endif powerpc}
+         { import stuff }
+         if po_has_importdll in procoptions then
+           import_dll:=stringdup(ppufile.getstring)
+         else
+           import_dll:=nil;
+         if po_has_importname in procoptions then
+           import_name:=stringdup(ppufile.getstring)
+         else
+           import_name:=nil;
+         import_nr:=ppufile.getword;
+{$ifdef FPC_HAS_SYSTEMS_INTERRUPT_TABLE}
+         if target_info.system in systems_interrupt_table then
+           interruptvector:=ppufile.getlongint;
+{$endif FPC_HAS_SYSTEMS_INTERRUPT_TABLE}
+         if (po_msgint in procoptions) then
+           messageinf.i:=ppufile.getlongint;
+         if (po_msgstr in procoptions) then
+           messageinf.str:=stringdup(ppufile.getstring);
+         if (po_dispid in procoptions) then
+           dispid:=ppufile.getlongint;
+         { inline stuff }
+         if (po_has_inlininginfo in procoptions) then
+           begin
+             ppufile.getderef(funcretsymderef);
+             new(inlininginfo);
+             ppufile.getsmallset(inlininginfo^.flags);
+           end
+         else
+           begin
+             inlininginfo:=nil;
+             funcretsym:=nil;
+           end;
+
+         aliasnames:=TCmdStrList.create;
+         { count alias names }
+         aliasnamescount:=ppufile.getbyte;
+         for i:=1 to aliasnamescount do
+           aliasnames.insert(ppufile.getstring);
+
+         { load para symtable }
+         parast:=tparasymtable.create(self,level);
+         tparasymtable(parast).ppuload(ppufile);
+         { load local symtable }
+         if (po_has_inlininginfo in procoptions) then
+          begin
+            localst:=tlocalsymtable.create(self,level);
+            tlocalsymtable(localst).ppuload(ppufile);
+          end
+         else
+          localst:=nil;
+         { inline stuff }
+         if (po_has_inlininginfo in procoptions) then
+           inlininginfo^.code:=ppuloadnodetree(ppufile);
+         { default values for no persistent data }
+         if (cs_link_deffile in current_settings.globalswitches) and
+            (tf_need_export in target_info.flags) and
+            (po_exports in procoptions) then
+           deffile.AddExport(mangledname);
+         forwarddef:=false;
+         interfacedef:=false;
+         hasforward:=false;
+         { Disable po_has_inlining until the derefimpl is done }
+         exclude(procoptions,po_has_inlininginfo);
+{$ifdef i386}
+         fpu_used:=maxfpuregs;
+{$endif i386}
+      end;
+
+
+    destructor tprocdef.destroy;
+      begin
+         aliasnames.free;
+         aliasnames:=nil;
+         if assigned(localst) and
+           (localst.symtabletype<>staticsymtable) then
+          begin
+{$ifdef MEMDEBUG}
+            memproclocalst.start;
+{$endif MEMDEBUG}
+            localst.free;
+            localst:=nil;
+{$ifdef MEMDEBUG}
+            memproclocalst.start;
+{$endif MEMDEBUG}
+          end;
+         if assigned(inlininginfo) then
+          begin
+{$ifdef MEMDEBUG}
+            memprocnodetree.start;
+{$endif MEMDEBUG}
+            tnode(inlininginfo^.code).free;
+{$ifdef MEMDEBUG}
+            memprocnodetree.start;
+{$endif MEMDEBUG}
+            dispose(inlininginfo);
+            inlininginfo:=nil;
+          end;
+         stringdispose(resultname);
+         stringdispose(import_dll);
+         stringdispose(import_name);
+         stringdispose(deprecatedmsg);
+         if (po_msgstr in procoptions) then
+           stringdispose(messageinf.str);
+         if assigned(_mangledname) then
+          begin
+{$ifdef MEMDEBUG}
+            memmanglednames.start;
+{$endif MEMDEBUG}
+            stringdispose(_mangledname);
+{$ifdef MEMDEBUG}
+            memmanglednames.stop;
+{$endif MEMDEBUG}
+          end;
+         inherited destroy;
+      end;
+
+
+    procedure tprocdef.ppuwrite(ppufile:tcompilerppufile);
+      var
+        oldintfcrc : boolean;
+        aliasnamescount : longint;
+        item : TCmdStrListItem;
+      begin
+         { released procdef? }
+         if not assigned(parast) then
+           exit;
+
+         inherited ppuwrite(ppufile);
+         if po_has_mangledname in procoptions then
+          ppufile.putstring(_mangledname^);
+
+         ppufile.putword(extnumber);
+         ppufile.putbyte(parast.symtablelevel);
+         ppufile.putderef(structderef);
+         ppufile.putderef(procsymderef);
+         ppufile.putposinfo(fileinfo);
+         ppufile.putbyte(byte(visibility));
+         ppufile.putsmallset(symoptions);
+         if sp_has_deprecated_msg in symoptions then
+           ppufile.putstring(deprecatedmsg^);
+{$ifdef powerpc}
+         { library symbol for AmigaOS/MorphOS }
+         ppufile.putderef(libsymderef);
+{$endif powerpc}
+         { import }
+         if po_has_importdll in procoptions then
+           ppufile.putstring(import_dll^);
+         if po_has_importname in procoptions then
+           ppufile.putstring(import_name^);
+         ppufile.putword(import_nr);
+{$ifdef FPC_HAS_SYSTEMS_INTERRUPT_TABLE}
+         if target_info.system in systems_interrupt_table then
+           ppufile.putlongint(interruptvector);
+{$endif FPC_HAS_SYSTEMS_INTERRUPT_TABLE}
+         if (po_msgint in procoptions) then
+           ppufile.putlongint(messageinf.i);
+         if (po_msgstr in procoptions) then
+           ppufile.putstring(messageinf.str^);
+         if (po_dispid in procoptions) then
+           ppufile.putlongint(dispid);
+         { inline stuff }
+         oldintfcrc:=ppufile.do_crc;
+         ppufile.do_crc:=false;
+         if (po_has_inlininginfo in procoptions) then
+           begin
+             ppufile.putderef(funcretsymderef);
+             ppufile.putsmallset(inlininginfo^.flags);
+           end;
+
+         { count alias names }
+         aliasnamescount:=0;
+         item:=TCmdStrListItem(aliasnames.first);
+         while assigned(item) do
+           begin
+             inc(aliasnamescount);
+             item:=TCmdStrListItem(item.next);
+           end;
+         if aliasnamescount>255 then
+           internalerror(200711021);
+         ppufile.putbyte(aliasnamescount);
+         item:=TCmdStrListItem(aliasnames.first);
+         while assigned(item) do
+          begin
+            ppufile.putstring(item.str);
+            item:=TCmdStrListItem(item.next);
+          end;
+
+         ppufile.do_crc:=oldintfcrc;
+
+         { write this entry }
+         ppufile.writeentry(ibprocdef);
+
+         { Save the para symtable, this is taken from the interface }
+         tparasymtable(parast).ppuwrite(ppufile);
+
+         { save localsymtable for inline procedures or when local
+           browser info is requested, this has no influence on the crc }
+         if (po_has_inlininginfo in procoptions) then
+          begin
+            oldintfcrc:=ppufile.do_crc;
+            ppufile.do_crc:=false;
+            tlocalsymtable(localst).ppuwrite(ppufile);
+            ppufile.do_crc:=oldintfcrc;
+          end;
+
+         { node tree for inlining }
+         oldintfcrc:=ppufile.do_crc;
+         ppufile.do_crc:=false;
+         if (po_has_inlininginfo in procoptions) then
+           ppuwritenodetree(ppufile,inlininginfo^.code);
+         ppufile.do_crc:=oldintfcrc;
+      end;
+
+
+    function tprocdef.fullprocname(showhidden:boolean):string;
+      var
+        s : string;
+        t : ttoken;
+      begin
+{$ifdef EXTDEBUG}
+        showhidden:=true;
+{$endif EXTDEBUG}
+        s:='';
+        if assigned(struct) then
+         begin
+           s:=struct.RttiName+'.';
+           if (po_classmethod in procoptions) and
+              not (proctypeoption in [potype_class_constructor,potype_class_destructor]) then
+             s:='class ' + s;
+         end;
+        if proctypeoption=potype_operator then
+          begin
+            for t:=NOTOKEN to last_overloaded do
+              if procsym.realname='$'+overloaded_names[t] then
+                begin
+                  s:='operator '+arraytokeninfo[t].str+typename_paras(showhidden);
+                  break;
+                end;
+          end
+        else
+          s:=s+procsym.realname+typename_paras(showhidden);
+        case proctypeoption of
+          potype_constructor:
+            s:='constructor '+s;
+          potype_destructor:
+            s:='destructor '+s;
+          potype_class_constructor:
+            s:='class constructor '+s;
+          potype_class_destructor:
+            s:='class destructor '+s;
+          else
+            if assigned(returndef) and
+              not(is_void(returndef)) then
+              s:=s+':'+returndef.GetTypeName;
+        end;
+        if owner.symtabletype=localsymtable then
+          s:=s+' is nested';
+        s:=s+';';
+        { forced calling convention? }
+        if (po_hascallingconvention in procoptions) then
+          s:=s+' '+ProcCallOptionStr[proccalloption]+';';
+        if (po_staticmethod in procoptions) and
+           not (proctypeoption in [potype_class_constructor,potype_class_destructor]) then
+          s:=s+' Static;';
+        fullprocname:=s;
+      end;
+
+
+    function tprocdef.is_methodpointer:boolean;
+      begin
+        { don't check assigned(_class), that's also the case for nested
+          procedures inside methods }
+        result:=owner.symtabletype=ObjectSymtable;
+      end;
+
+
+    function tprocdef.is_addressonly:boolean;
+      begin
+        result:=assigned(owner) and
+                (owner.symtabletype<>ObjectSymtable) and
+                (not(m_nested_procvars in current_settings.modeswitches) or
+                 not is_nested_pd(self));
+      end;
+
+
+    procedure tprocdef.make_external;
+      begin
+        include(procoptions,po_external);
+        forwarddef:=false;
+      end;
+
+
+    function tprocdef.GetSymtable(t:tGetSymtable):TSymtable;
+      begin
+        case t of
+          gs_local :
+            GetSymtable:=localst;
+          gs_para :
+            GetSymtable:=parast;
+          else
+            GetSymtable:=nil;
+        end;
+      end;
+
+
+    procedure tprocdef.buildderef;
+      begin
+         inherited buildderef;
+         structderef.build(struct);
+         { procsym that originaly defined this definition, should be in the
+           same symtable }
+         procsymderef.build(procsym);
+{$ifdef powerpc}
+         { library symbol for AmigaOS/MorphOS }
+         libsymderef.build(libsym);
+{$endif powerpc}
+      end;
+
+
+    procedure tprocdef.buildderefimpl;
+      begin
+         inherited buildderefimpl;
+
+         { Localst is not available for main/unit init }
+         if assigned(localst) then
+           begin
+             tlocalsymtable(localst).buildderef;
+             tlocalsymtable(localst).buildderefimpl;
+           end;
+
+         { inline tree }
+         if (po_has_inlininginfo in procoptions) then
+           begin
+             funcretsymderef.build(funcretsym);
+             inlininginfo^.code.buildderefimpl;
+           end;
+      end;
+
+
+    procedure tprocdef.deref;
+      begin
+         inherited deref;
+         struct:=tabstractrecorddef(structderef.resolve);
+         { procsym that originaly defined this definition, should be in the
+           same symtable }
+         procsym:=tprocsym(procsymderef.resolve);
+{$ifdef powerpc}
+         { library symbol for AmigaOS/MorphOS }
+         libsym:=tsym(libsymderef.resolve);
+{$endif powerpc}
+      end;
+
+
+    procedure tprocdef.derefimpl;
+      begin
+         { Enable has_inlininginfo when the inlininginfo
+           structure is available. The has_inlininginfo was disabled
+           after the load, since the data was invalid }
+         if assigned(inlininginfo) then
+           include(procoptions,po_has_inlininginfo);
+
+         { Locals }
+         if assigned(localst) then
+           begin
+             tlocalsymtable(localst).deref;
+             tlocalsymtable(localst).derefimpl;
+           end;
+
+        { Inline }
+        if (po_has_inlininginfo in procoptions) then
+          begin
+            inlininginfo^.code.derefimpl;
+            { funcretsym, this is always located in the localst }
+            funcretsym:=tsym(funcretsymderef.resolve);
+          end
+        else
+          begin
+            { safety }
+            { Not safe! A unit may be reresolved after its interface has been
+              parsed but before its implementation has been parsed, and in that
+              case the funcretsym is still required!
+            funcretsym:=nil; }
+          end;
+      end;
+
+
+    function tprocdef.GetTypeName : string;
+      begin
+         GetTypeName := FullProcName(false);
+      end;
+
+
+    function tprocdef.mangledname : string;
+      var
+        hp   : TParavarsym;
+        hs   : string;
+        crc  : dword;
+        newlen,
+        oldlen,
+        i    : integer;
+      begin
+        if assigned(_mangledname) then
+         begin
+         {$ifdef compress}
+           mangledname:=minilzw_decode(_mangledname^);
+         {$else}
+           mangledname:=_mangledname^;
+         {$endif}
+           exit;
+         end;
+        { we need to use the symtable where the procsym is inserted,
+          because that is visible to the world }
+        mangledname:=make_mangledname('',procsym.owner,procsym.name);
+        oldlen:=length(mangledname);
+        { add parameter types }
+        for i:=0 to paras.count-1 do
+         begin
+           hp:=tparavarsym(paras[i]);
+           if not(vo_is_hidden_para in hp.varoptions) then
+             mangledname:=mangledname+'$'+hp.vardef.mangledparaname;
+         end;
+        { add resultdef, add $$ as separator to make it unique from a
+          parameter separator }
+        if not is_void(returndef) then
+          mangledname:=mangledname+'$$'+returndef.mangledparaname;
+        newlen:=length(mangledname);
+        { Replace with CRC if the parameter line is very long }
+        if (newlen-oldlen>12) and
+           ((newlen>100) or (newlen-oldlen>64)) then
+          begin
+            crc:=0;
+            for i:=0 to paras.count-1 do
+              begin
+                hp:=tparavarsym(paras[i]);
+                if not(vo_is_hidden_para in hp.varoptions) then
+                  begin
+                    hs:=hp.vardef.mangledparaname;
+                    crc:=UpdateCrc32(crc,hs[1],length(hs));
+                  end;
+              end;
+            hs:=hp.vardef.mangledparaname;
+            crc:=UpdateCrc32(crc,hs[1],length(hs));
+            mangledname:=Copy(mangledname,1,oldlen)+'$crc'+hexstr(crc,8);
+          end;
+       {$ifdef compress}
+        _mangledname:=stringdup(minilzw_encode(mangledname));
+       {$else}
+        _mangledname:=stringdup(mangledname);
+       {$endif}
+      end;
+
+
+    function tprocdef.cplusplusmangledname : string;
+
+      function getcppparaname(p : tdef) : string;
+
+        const
+{$ifdef NAMEMANGLING_GCC2}
+           ordtype2str : array[tordtype] of string[2] = (
+             '',
+             'Uc','Us','Ui','Us',
+             'Sc','s','i','x',
+             'b','b','b','b','b',
+             'c','w','x');
+{$else NAMEMANGLING_GCC2}
+           ordtype2str : array[tordtype] of string[1] = (
+             'v',
+             'h','t','j','y',
+             'a','s','i','x',
+             'b','b','b','b',
+             'b','b','b','b',
+             'c','w','x');
+
+           floattype2str : array[tfloattype] of string[1] = (
+             'f','d','e','e',
+             'd','d','g');
+{$endif NAMEMANGLING_GCC2}
+
+        var
+           s : string;
+
+        begin
+           case p.typ of
+              orddef:
+                s:=ordtype2str[torddef(p).ordtype];
+              pointerdef:
+                s:='P'+getcppparaname(tpointerdef(p).pointeddef);
+{$ifndef NAMEMANGLING_GCC2}
+              floatdef:
+                s:=floattype2str[tfloatdef(p).floattype];
+{$endif NAMEMANGLING_GCC2}
+              else
+                internalerror(2103001);
+           end;
+           getcppparaname:=s;
+        end;
+
+      var
+         s,s2 : string;
+         hp   : TParavarsym;
+         i    : integer;
+
+      begin
+{$ifdef NAMEMANGLING_GCC2}
+
+        { outdated gcc 2.x name mangling scheme }
+         s := procsym.realname;
+         if procsym.owner.symtabletype=ObjectSymtable then
+           begin
+              s2:=upper(tobjectdef(procsym.owner.defowner).objrealname^);
+              case proctypeoption of
+                 potype_destructor:
+                   s:='_$_'+tostr(length(s2))+s2;
+                 potype_constructor:
+                   s:='___'+tostr(length(s2))+s2;
+                 else
+                   s:='_'+s+'__'+tostr(length(s2))+s2;
+              end;
+
+           end
+         else s:=s+'__';
+
+         s:=s+'F';
+
+         { concat modifiers }
+         { !!!!! }
+
+         { now we handle the parameters }
+         if maxparacount>0 then
+           begin
+             for i:=0 to paras.count-1 do
+               begin
+                 hp:=tparavarsym(paras[i]);
+                 { no hidden parameters form part of a C++ mangled name:
+                     a) self is not included
+                     b) there are no "high" or other hidden parameters
+                 }
+                 if vo_is_hidden_para in hp.varoptions then
+                   continue;
+                 s2:=getcppparaname(hp.vardef);
+                 if hp.varspez in [vs_var,vs_out] then
+                   s2:='R'+s2;
+                 s:=s+s2;
+               end;
+           end
+         else
+           s:=s+'v';
+         cplusplusmangledname:=s;
+{$else NAMEMANGLING_GCC2}
+
+         { gcc 3.x and 4.x name mangling scheme }
+         { see http://www.codesourcery.com/public/cxx-abi/abi.html#mangling }
+         if procsym.owner.symtabletype=ObjectSymtable then
+           begin
+             s:='_ZN';
+
+             s2:=tobjectdef(procsym.owner.defowner).objextname^;
+             s:=s+tostr(length(s2))+s2;
+             case proctypeoption of
+                potype_constructor:
+                  s:=s+'C1';
+                potype_destructor:
+                  s:=s+'D1';
+                else
+                  s:=s+tostr(length(procsym.realname))+procsym.realname;
+             end;
+
+             s:=s+'E';
+           end
+         else
+           s:=procsym.realname;
+
+         { now we handle the parameters }
+         if maxparacount>0 then
+           begin
+             for i:=0 to paras.count-1 do
+               begin
+                 hp:=tparavarsym(paras[i]);
+                 { no hidden parameters form part of a C++ mangled name:
+                     a) self is not included
+                     b) there are no "high" or other hidden parameters
+                 }
+                 if vo_is_hidden_para in hp.varoptions then
+                   continue;
+                 s2:=getcppparaname(hp.vardef);
+                 if hp.varspez in [vs_var,vs_out] then
+                   s2:='R'+s2;
+                 s:=s+s2;
+               end;
+           end
+         else
+           s:=s+'v';
+         cplusplusmangledname:=s;
+{$endif NAMEMANGLING_GCC2}
+      end;
+
+
+    function  tprocdef.objcmangledname : string;
+      var
+        manglednamelen: longint;
+        iscatmethod   : boolean;
+      begin
+        if not (po_msgstr in procoptions) then
+          internalerror(2009030901);
+        { we may very well need longer strings to handle these... }
+        manglednamelen:=length(tobjectdef(procsym.owner.defowner).objextname^)+
+          length('+"[ ]"')+length(messageinf.str^);
+        iscatmethod:=oo_is_classhelper in tobjectdef(procsym.owner.defowner).objectoptions;
+        if (iscatmethod) then
+          inc(manglednamelen,length(tobjectdef(procsym.owner.defowner).childof.objextname^)+length('()'));
+        if manglednamelen>255 then
+          Message1(parser_e_objc_message_name_too_long,messageinf.str^);
+        if not(po_classmethod in procoptions) then
+          result:='"-['
+        else
+          result:='"+[';
+        { quotes are necessary because the +/- otherwise confuse the assembler
+          into expecting a number
+        }
+        if iscatmethod then
+          result:=result+tobjectdef(procsym.owner.defowner).childof.objextname^+'(';
+        result:=result+tobjectdef(procsym.owner.defowner).objextname^;
+        if iscatmethod then
+          result:=result+')';
+        result:=result+' '+messageinf.str^+']"';
+      end;
+
+
+    procedure tprocdef.setmangledname(const s : string);
+      begin
+        { This is not allowed anymore, the forward declaration
+          already needs to create the correct mangledname, no changes
+          afterwards are allowed (PFV) }
+        { Exception: interface definitions in mode macpas, since in that }
+        {   case no reference to the old name can exist yet (JM)         }
+        if assigned(_mangledname) then
+          if ((m_mac in current_settings.modeswitches) and
+              (interfacedef)) then
+            stringdispose(_mangledname)
+          else
+            internalerror(200411171);
+      {$ifdef compress}
+        _mangledname:=stringdup(minilzw_encode(s));
+      {$else}
+        _mangledname:=stringdup(s);
+      {$endif}
+        include(procoptions,po_has_mangledname);
+      end;
+
+
+{***************************************************************************
+                                 TPROCVARDEF
+***************************************************************************}
+
+    constructor tprocvardef.create(level:byte);
+      begin
+         inherited create(procvardef,level);
+      end;
+
+
+    constructor tprocvardef.ppuload(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(procvardef,ppufile);
+         { load para symtable }
+         parast:=tparasymtable.create(self,ppufile.getbyte);
+         tparasymtable(parast).ppuload(ppufile);
+      end;
+
+
+    function tprocvardef.getcopy : tstoreddef;
+      var
+        i : tcallercallee;
+        j : longint;
+      begin
+        result:=tprocvardef.create(parast.symtablelevel);
+        tprocvardef(result).returndef:=returndef;
+        tprocvardef(result).returndefderef:=returndefderef;
+        tprocvardef(result).parast:=parast.getcopy;
+        tprocvardef(result).savesize:=savesize;
+
+        { create paralist copy }
+        tprocvardef(result).paras:=tparalist.create(false);
+        tprocvardef(result).paras.count:=paras.count;
+        for j:=0 to paras.count-1 do
+          tprocvardef(result).paras[j]:=paras[j];
+
+        tprocvardef(result).proctypeoption:=proctypeoption;
+        tprocvardef(result).proccalloption:=proccalloption;
+        tprocvardef(result).procoptions:=procoptions;
+        tprocvardef(result).callerargareasize:=callerargareasize;
+        tprocvardef(result).calleeargareasize:=calleeargareasize;
+        tprocvardef(result).maxparacount:=maxparacount;
+        tprocvardef(result).minparacount:=minparacount;
+        for i:=low(tcallercallee) to high(tcallercallee) do
+          tprocvardef(result).funcretloc[i]:=funcretloc[i].getcopy;
+        tprocvardef(result).has_paraloc_info:=has_paraloc_info;
+{$ifdef m68k}
+        tprocvardef(result).exp_funcretloc:=exp_funcretloc;
+{$endif}
+      end;
+
+
+    procedure tprocvardef.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+
+        { Save the para symtable level (necessary to distinguish nested
+          procvars) }
+        ppufile.putbyte(parast.symtablelevel);
+
+        { Write this entry }
+        ppufile.writeentry(ibprocvardef);
+
+        { Save the para symtable, this is taken from the interface }
+        tparasymtable(parast).ppuwrite(ppufile);
+      end;
+
+
+    function tprocvardef.GetSymtable(t:tGetSymtable):TSymtable;
+      begin
+        case t of
+          gs_para :
+            GetSymtable:=parast;
+          else
+            GetSymtable:=nil;
+        end;
+      end;
+
+
+    function tprocvardef.size : asizeint;
+      begin
+         if ((po_methodpointer in procoptions) or
+             is_nested_pd(self)) and
+            not(po_addressonly in procoptions) then
+           size:=2*sizeof(pint)
+         else
+           size:=sizeof(pint);
+      end;
+
+
+    function tprocvardef.is_methodpointer:boolean;
+      begin
+        result:=(po_methodpointer in procoptions);
+      end;
+
+
+    function tprocvardef.is_addressonly:boolean;
+      begin
+        result:=(not(po_methodpointer in procoptions) and
+                 not is_nested_pd(self)) or
+                (po_addressonly in procoptions);
+      end;
+
+
+    function tprocvardef.getmangledparaname:string;
+      begin
+        if not(po_methodpointer in procoptions) then
+          if not is_nested_pd(self) then
+            result:='procvar'
+          else
+            result:='nestedprovar'
+        else
+          result:='procvarofobj'
+      end;
+
+
+    function tprocvardef.is_publishable : boolean;
+      begin
+         is_publishable:=(po_methodpointer in procoptions);
+      end;
+
+
+    function tprocvardef.GetTypeName : string;
+      var
+        s: string;
+        showhidden : boolean;
+      begin
+{$ifdef EXTDEBUG}
+         showhidden:=true;
+{$else EXTDEBUG}
+         showhidden:=false;
+{$endif EXTDEBUG}
+         s:='<';
+         if po_classmethod in procoptions then
+           s := s+'class method type of'
+         else
+           if po_addressonly in procoptions then
+             s := s+'address of'
+           else
+             s := s+'procedure variable type of';
+         if assigned(returndef) and
+            (returndef<>voidtype) then
+           s:=s+' function'+typename_paras(showhidden)+':'+returndef.GetTypeName
+         else
+           s:=s+' procedure'+typename_paras(showhidden);
+         if po_methodpointer in procoptions then
+           s := s+' of object';
+         if is_nested_pd(self) then
+           s := s+' is nested';
+         GetTypeName := s+';'+ProcCallOptionStr[proccalloption]+'>';
+      end;
+
+
+{***************************************************************************
+                              TOBJECTDEF
+***************************************************************************}
+
+   constructor tobjectdef.create(ot:tobjecttyp;const n:string;c:tobjectdef);
+     begin
+        inherited create(n,objectdef);
+        fcurrent_dispid:=0;
+        objecttype:=ot;
+        childof:=nil;
+        if objecttype=odt_helper then
+          owner.includeoption(sto_has_helper);
+        symtable:=tObjectSymtable.create(self,n,current_settings.packrecords);
+        { create space for vmt !! }
+        vmtentries:=TFPList.Create;
+        vmt_offset:=0;
+        set_parent(c);
+        if objecttype in [odt_interfacecorba,odt_interfacecom,odt_dispinterface] then
+          prepareguid;
+        { setup implemented interfaces }
+        if objecttype in [odt_class,odt_objcclass,odt_objcprotocol] then
+          ImplementedInterfaces:=TFPObjectList.Create(true)
+        else
+          ImplementedInterfaces:=nil;
+        writing_class_record_dbginfo:=false;
+     end;
+
+
+    constructor tobjectdef.ppuload(ppufile:tcompilerppufile);
+      var
+         i,
+         implintfcount : longint;
+         d : tderef;
+         ImplIntf : TImplementedInterface;
+         vmtentry : pvmtentry;
+      begin
+         inherited ppuload(objectdef,ppufile);
+         objecttype:=tobjecttyp(ppufile.getbyte);
+         objextname:=stringdup(ppufile.getstring);
+         { only used for external Objective-C classes/protocols }
+         if (objextname^='') then
+           stringdispose(objextname);
+         import_lib:=stringdup(ppufile.getstring);
+         { only used for external C++ classes }
+         if (import_lib^='') then
+           stringdispose(import_lib);
+         symtable:=tObjectSymtable.create(self,objrealname^,0);
+         tObjectSymtable(symtable).datasize:=ppufile.getasizeint;
+         tObjectSymtable(symtable).paddingsize:=ppufile.getword;
+         tObjectSymtable(symtable).fieldalignment:=shortint(ppufile.getbyte);
+         tObjectSymtable(symtable).recordalignment:=shortint(ppufile.getbyte);
+         vmt_offset:=ppufile.getlongint;
+         ppufile.getderef(childofderef);
+
+         { load guid }
+         iidstr:=nil;
+         if objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface] then
+           begin
+              new(iidguid);
+              ppufile.getguid(iidguid^);
+              iidstr:=stringdup(ppufile.getstring);
+           end;
+
+         if objecttype=odt_helper then
+           ppufile.getderef(extendeddefderef);
+
+         vmtentries:=TFPList.Create;
+         vmtentries.count:=ppufile.getlongint;
+         for i:=0 to vmtentries.count-1 do
+           begin
+             ppufile.getderef(d);
+             new(vmtentry);
+             vmtentry^.procdef:=nil;
+             vmtentry^.procdefderef:=d;
+             vmtentry^.visibility:=tvisibility(ppufile.getbyte);
+             vmtentries[i]:=vmtentry;
+           end;
+
+         { load implemented interfaces }
+         if objecttype in [odt_class,odt_objcclass,odt_objcprotocol] then
+           begin
+             ImplementedInterfaces:=TFPObjectList.Create(true);
+             implintfcount:=ppufile.getlongint;
+             for i:=0 to implintfcount-1 do
+               begin
+                 ppufile.getderef(d);
+                 ImplIntf:=TImplementedInterface.Create_deref(d);
+                 ImplIntf.IOffset:=ppufile.getlongint;
+                 ImplementedInterfaces.Add(ImplIntf);
+               end;
+           end
+         else
+           ImplementedInterfaces:=nil;
+
+         if df_copied_def in defoptions then
+           ppufile.getderef(cloneddefderef)
+         else
+           tObjectSymtable(symtable).ppuload(ppufile);
+
+         { handles the predefined class tobject  }
+         { the last TOBJECT which is loaded gets }
+         { it !                                  }
+         if (childof=nil) and
+            (objecttype=odt_class) and
+            (objname^='TOBJECT') then
+           class_tobject:=self;
+         if (childof=nil) and
+            (objecttype=odt_interfacecom) then
+            if (objname^='IUNKNOWN') then
+              interface_iunknown:=self
+            else
+            if (objname^='IDISPATCH') then
+              interface_idispatch:=self;
+         if (childof=nil) and
+            (objecttype=odt_objcclass) and
+            (objname^='PROTOCOL') then
+           objc_protocoltype:=self;
+         writing_class_record_dbginfo:=false;
+       end;
+
+
+    destructor tobjectdef.destroy;
+      begin
+         if assigned(symtable) then
+           begin
+             symtable.free;
+             symtable:=nil;
+           end;
+         stringdispose(objextname);
+         stringdispose(import_lib);
+         stringdispose(iidstr);
+         if assigned(ImplementedInterfaces) then
+           begin
+             ImplementedInterfaces.free;
+             ImplementedInterfaces:=nil;
+           end;
+         if assigned(iidguid) then
+           begin
+             dispose(iidguid);
+             iidguid:=nil;
+           end;
+         if assigned(vmtentries) then
+           begin
+             resetvmtentries;
+             vmtentries.free;
+             vmtentries:=nil;
+           end;
+         if assigned(vmcallstaticinfo) then
+           begin
+             freemem(vmcallstaticinfo);
+             vmcallstaticinfo:=nil;
+           end;
+         inherited destroy;
+      end;
+
+
+    function tobjectdef.getcopy : tstoreddef;
+      var
+        i : longint;
+      begin
+        result:=tobjectdef.create(objecttype,objrealname^,childof);
+        { the constructor allocates a symtable which we release to avoid memory leaks }
+        tobjectdef(result).symtable.free;
+        tobjectdef(result).symtable:=symtable.getcopy;
+        if assigned(objextname) then
+          tobjectdef(result).objextname:=stringdup(objextname^);
+        if assigned(import_lib) then
+          tobjectdef(result).import_lib:=stringdup(import_lib^);
+        tobjectdef(result).objectoptions:=objectoptions;
+        include(tobjectdef(result).defoptions,df_copied_def);
+        tobjectdef(result).extendeddef:=extendeddef;
+        tobjectdef(result).vmt_offset:=vmt_offset;
+        if assigned(iidguid) then
+          begin
+            new(tobjectdef(result).iidguid);
+            move(iidguid^,tobjectdef(result).iidguid^,sizeof(iidguid^));
+          end;
+        if assigned(iidstr) then
+          tobjectdef(result).iidstr:=stringdup(iidstr^);
+        if assigned(ImplementedInterfaces) then
+          begin
+            for i:=0 to ImplementedInterfaces.count-1 do
+              tobjectdef(result).ImplementedInterfaces.Add(TImplementedInterface(ImplementedInterfaces[i]).Getcopy);
+          end;
+        if assigned(vmtentries) then
+          begin
+            tobjectdef(result).vmtentries:=TFPList.Create;
+            tobjectdef(result).copyvmtentries(self);
+          end;
+      end;
+
+
+    procedure tobjectdef.ppuwrite(ppufile:tcompilerppufile);
+      var
+         i : longint;
+         vmtentry : pvmtentry;
+         ImplIntf : TImplementedInterface;
+         old_do_indirect_crc: boolean;
+      begin
+         { if class1 in unit A changes, and class2 in unit B inherits from it
+           (so unit B uses unit A), then unit B with class2 will be recompiled.
+           However, if there is also a class3 in unit C that only depends on
+           unit B, then unit C will not be recompiled because nothing changed
+           to the interface of unit B. Nevertheless, unit C can indirectly
+           depend on unit A via derefs, and these must be updated -> the
+           indirect crc keeps track of such changes. }
+         old_do_indirect_crc:=ppufile.do_indirect_crc;
+         ppufile.do_indirect_crc:=true;
+         inherited ppuwrite(ppufile);
+         ppufile.putbyte(byte(objecttype));
+         if assigned(objextname) then
+           ppufile.putstring(objextname^)
+         else
+           ppufile.putstring('');
+         if assigned(import_lib) then
+           ppufile.putstring(import_lib^)
+         else
+           ppufile.putstring('');
+         ppufile.putasizeint(tObjectSymtable(symtable).datasize);
+         ppufile.putword(tObjectSymtable(symtable).paddingsize);
+         ppufile.putbyte(byte(tObjectSymtable(symtable).fieldalignment));
+         ppufile.putbyte(byte(tObjectSymtable(symtable).recordalignment));
+         ppufile.putlongint(vmt_offset);
+         ppufile.putderef(childofderef);
+         if objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface] then
+           begin
+              ppufile.putguid(iidguid^);
+              ppufile.putstring(iidstr^);
+           end;
+         if objecttype=odt_helper then
+           ppufile.putderef(extendeddefderef);
+
+         ppufile.putlongint(vmtentries.count);
+         for i:=0 to vmtentries.count-1 do
+           begin
+             vmtentry:=pvmtentry(vmtentries[i]);
+             ppufile.putderef(vmtentry^.procdefderef);
+             ppufile.putbyte(byte(vmtentry^.visibility));
+           end;
+
+
+         if assigned(ImplementedInterfaces) then
+           begin
+             ppufile.putlongint(ImplementedInterfaces.Count);
+             for i:=0 to ImplementedInterfaces.Count-1 do
+               begin
+                 ImplIntf:=TImplementedInterface(ImplementedInterfaces[i]);
+                 ppufile.putderef(ImplIntf.intfdefderef);
+                 ppufile.putlongint(ImplIntf.Ioffset);
+               end;
+           end;
+
+         if df_copied_def in defoptions then
+           ppufile.putderef(cloneddefderef);
+
+         ppufile.writeentry(ibobjectdef);
+
+         if not(df_copied_def in defoptions) then
+           tObjectSymtable(symtable).ppuwrite(ppufile);
+
+         ppufile.do_indirect_crc:=old_do_indirect_crc;
+      end;
+
+
+    function tobjectdef.GetTypeName:string;
+      begin
+        { in this case we will go in endless recursion, because then  }
+        { there is no tsym associated yet with the def. It can occur  }
+        { (tests/webtbf/tw4757.pp), so for now give a generic name    }
+        { instead of the actual type name                             }
+        if not assigned(typesym) then
+          result:='<Currently Parsed Class>'
+        else
+          result:=typesymbolprettyname;
+      end;
+
+
+    procedure tobjectdef.buildderef;
+      var
+         i : longint;
+         vmtentry : pvmtentry;
+      begin
+         inherited buildderef;
+         childofderef.build(childof);
+         if df_copied_def in defoptions then
+           cloneddefderef.build(symtable.defowner)
+         else
+           tstoredsymtable(symtable).buildderef;
+
+         if objecttype=odt_helper then
+           extendeddefderef.build(extendeddef);
+
+         for i:=0 to vmtentries.count-1 do
+           begin
+             vmtentry:=pvmtentry(vmtentries[i]);
+             vmtentry^.procdefderef.build(vmtentry^.procdef);
+           end;
+
+         if assigned(ImplementedInterfaces) then
+           begin
+             for i:=0 to ImplementedInterfaces.count-1 do
+               TImplementedInterface(ImplementedInterfaces[i]).buildderef;
+           end;
+      end;
+
+
+    procedure tobjectdef.deref;
+      var
+         i : longint;
+         vmtentry : pvmtentry;
+      begin
+         inherited deref;
+         childof:=tobjectdef(childofderef.resolve);
+         if df_copied_def in defoptions then
+           begin
+             cloneddef:=tobjectdef(cloneddefderef.resolve);
+             symtable:=cloneddef.symtable.getcopy;
+           end
+         else
+           tstoredsymtable(symtable).deref;
+         if objecttype=odt_helper then
+           extendeddef:=tdef(extendeddefderef.resolve);
+         for i:=0 to vmtentries.count-1 do
+           begin
+             vmtentry:=pvmtentry(vmtentries[i]);
+             vmtentry^.procdef:=tprocdef(vmtentry^.procdefderef.resolve);
+           end;
+         if assigned(ImplementedInterfaces) then
+           begin
+             for i:=0 to ImplementedInterfaces.count-1 do
+               TImplementedInterface(ImplementedInterfaces[i]).deref;
+           end;
+      end;
+
+
+    procedure create_class_helper_for_procdef(def: tobject; arg: pointer);
+      var
+        pd: tprocdef absolute def;
+        st: tsymtable;
+        psym: tsym;
+        nname: TIDString;
+      begin
+        if (tdef(def).typ<>procdef) then
+          exit;
+        { pd.owner = objcclass symtable -> defowner = objcclassdef ->
+          owner = symtable in which objcclassdef is defined
+        }
+        st:=pd.owner.defowner.owner;
+        nname:=class_helper_prefix+tprocsym(pd.procsym).name;
+        { check for an existing procsym with our special name }
+        psym:=tsym(st.find(nname));
+        if not assigned(psym) then
+          begin
+            psym:=tprocsym.create(nname);
+            { avoid warning about this symbol being unused }
+            psym.IncRefCount;
+            { don't check for duplicates:
+               a) we checked above
+               b) in case we are in the implementation section of a unit, this
+                  will also check for this symbol in the interface section
+                  (since you normally cannot have symbols with the same name
+                   both interface and implementation), and it's possible to
+                   have class helpers for the same class in the interface and
+                   in the implementation, and they cannot be merged since only
+                   the once in the interface must be saved to the ppu/visible
+                   from other units }
+            st.insert(psym,false);
+          end
+        else if (psym.typ<>procsym) then
+          internalerror(2009111501);
+        { add ourselves to this special procsym }
+        tprocsym(psym).procdeflist.add(def);
+      end;
+
+
+    procedure tobjectdef.buildderefimpl;
+      begin
+         inherited buildderefimpl;
+         if not (df_copied_def in defoptions) then
+           tstoredsymtable(symtable).buildderefimpl;
+      end;
+
+
+    procedure tobjectdef.derefimpl;
+      begin
+         inherited derefimpl;
+         if not (df_copied_def in defoptions) then
+           tstoredsymtable(symtable).derefimpl;
+         { the procdefs are not owned by the class helper procsyms, so they
+           are not stored/restored either -> re-add them here }
+         if (objecttype=odt_objcclass) or
+            (oo_is_classhelper in objectoptions) then
+           symtable.DefList.ForEachCall(@create_class_helper_for_procdef,nil);
+      end;
+
+
+    procedure tobjectdef.resetvmtentries;
+      var
+        i : longint;
+      begin
+        for i:=0 to vmtentries.Count-1 do
+          Dispose(pvmtentry(vmtentries[i]));
+        vmtentries.clear;
+      end;
+
+
+    procedure tobjectdef.copyvmtentries(objdef:tobjectdef);
+      var
+        i : longint;
+        vmtentry : pvmtentry;
+      begin
+        resetvmtentries;
+        vmtentries.count:=objdef.vmtentries.count;
+        for i:=0 to objdef.vmtentries.count-1 do
+          begin
+            new(vmtentry);
+            vmtentry^:=pvmtentry(objdef.vmtentries[i])^;
+            vmtentries[i]:=vmtentry;
+          end;
+       end;
+
+
+    function tobjectdef.getparentdef:tdef;
+      begin
+{ TODO: Remove getparentdef hack}
+        { With 2 forward declared classes with the child class before the
+          parent class the child class is written earlier to the ppu. Leaving it
+          possible to have a reference to the parent class for property overriding,
+          but the parent class still has the childof not resolved yet (PFV) }
+        if childof=nil then
+          childof:=tobjectdef(childofderef.resolve);
+        result:=childof;
+      end;
+
+
+    procedure tobjectdef.prepareguid;
+      begin
+        { set up guid }
+        if not assigned(iidguid) then
+         begin
+            new(iidguid);
+            fillchar(iidguid^,sizeof(iidguid^),0); { default null guid }
+         end;
+        { setup iidstring }
+        if not assigned(iidstr) then
+          iidstr:=stringdup(''); { default is empty string }
+      end;
+
+
+    procedure tobjectdef.set_parent( c : tobjectdef);
+      begin
+        if assigned(childof) then
+          exit;
+        childof:=c;
+        if not assigned(c) then
+          exit;
+        { inherit options and status }
+        objectoptions:=objectoptions+(c.objectoptions*inherited_objectoptions);
+        { add the data of the anchestor class/object }
+        if (objecttype in [odt_class,odt_object,odt_objcclass]) then
+          begin
+            tObjectSymtable(symtable).datasize:=tObjectSymtable(symtable).datasize+tObjectSymtable(c.symtable).datasize;
+            { inherit recordalignment }
+            tObjectSymtable(symtable).recordalignment:=tObjectSymtable(c.symtable).recordalignment;
+            { if both the parent and this record use C-alignment, also inherit
+              the current field alignment }
+            if (tObjectSymtable(c.symtable).usefieldalignment=C_alignment) and
+               (tObjectSymtable(symtable).usefieldalignment=C_alignment) then
+              tObjectSymtable(symtable).fieldalignment:=tObjectSymtable(c.symtable).fieldalignment;
+            { the padding is not inherited for Objective-C classes (maybe not
+              for cppclass either?) }
+            if objecttype=odt_objcclass then
+              tObjectSymtable(symtable).datasize:=tObjectSymtable(symtable).datasize-tObjectSymtable(c.symtable).paddingsize;
+            if (oo_has_vmt in objectoptions) and
+               (oo_has_vmt in c.objectoptions) then
+              tObjectSymtable(symtable).datasize:=tObjectSymtable(symtable).datasize-sizeof(pint);
+            { if parent has a vmt field then the offset is the same for the child PM }
+            if (oo_has_vmt in c.objectoptions) or is_class(self) then
+              begin
+                vmt_offset:=c.vmt_offset;
+                include(objectoptions,oo_has_vmt);
+              end;
+          end;
+      end;
+
+
+   procedure tobjectdef.insertvmt;
+     var
+       vs: tfieldvarsym;
+     begin
+        if objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol] then
+          exit;
+        if (oo_has_vmt in objectoptions) then
+          internalerror(12345)
+        else
+          begin
+             tObjectSymtable(symtable).datasize:=align(tObjectSymtable(symtable).datasize,
+                 tObjectSymtable(symtable).fieldalignment);
+
+             if (tf_requires_proper_alignment in target_info.flags) then
+               begin
+                 { Align VMT pointer and whole object instance if target CPU requires alignment. }
+                 tObjectSymtable(symtable).datasize:=align(tObjectSymtable(symtable).datasize,sizeof(pint));
+                 tObjectSymtable(symtable).alignrecord(tObjectSymtable(symtable).datasize,sizeof(pint));
+               end;
+             vs:=tfieldvarsym.create('_vptr$'+objname^,vs_value,voidpointertype,[]);
+             hidesym(vs);
+             tObjectSymtable(symtable).insert(vs);
+             tObjectSymtable(symtable).addfield(vs,vis_hidden);
+             if (tObjectSymtable(symtable).usefieldalignment<>bit_alignment) then
+               vmt_offset:=vs.fieldoffset
+             else
+               vmt_offset:=vs.fieldoffset div 8;
+             include(objectoptions,oo_has_vmt);
+          end;
+     end;
+
+
+
+   procedure tobjectdef.check_forwards;
+     begin
+        if not(objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcprotocol]) then
+          inherited;
+        if (oo_is_forward in objectoptions) then
+          begin
+             { ok, in future, the forward can be resolved }
+             Message1(sym_e_class_forward_not_resolved,objrealname^);
+             exclude(objectoptions,oo_is_forward);
+          end;
+     end;
+
+
+   { true if prot implements d (or if they are equal) }
+   function is_related_protocol(prot: tobjectdef; d : tdef) : boolean;
+     var
+       i  : longint;
+     begin
+       { objcprotocols have multiple inheritance, all protocols from which
+         the current protocol inherits are stored in implementedinterfaces }
+       result:=prot=d;
+       if result then
+         exit;
+
+       for i:=0 to prot.ImplementedInterfaces.count-1 do
+         begin
+           result:=is_related_protocol(TImplementedInterface(prot.ImplementedInterfaces[i]).intfdef,d);
+           if result then
+             exit;
+         end;
+     end;
+
+
+   { true, if self inherits from d (or if they are equal) }
+   function tobjectdef.is_related(d : tdef) : boolean;
+     var
+        hp : tobjectdef;
+     begin
+        if self=d then
+          begin
+            is_related:=true;
+            exit;
+          end;
+
+        if (d.typ<>objectdef) then
+          begin
+            is_related:=false;
+            exit;
+          end;
+
+        { Objective-C protocols can use multiple inheritance }
+        if (objecttype=odt_objcprotocol) then
+          begin
+            is_related:=is_related_protocol(self,d);
+            exit
+          end;
+
+        { formally declared Objective-C classes match Objective-C classes with
+          the same name }
+        if (objecttype=odt_objcclass) and
+           (tobjectdef(d).objecttype=odt_objcclass) and
+           ((oo_is_formal in objectoptions) or
+            (oo_is_formal in tobjectdef(d).objectoptions)) and
+           (objrealname^=tobjectdef(d).objrealname^) then
+          begin
+            is_related:=true;
+            exit;
+          end;
+
+        hp:=childof;
+        while assigned(hp) do
+          begin
+             if hp=d then
+               begin
+                  is_related:=true;
+                  exit;
+               end;
+             hp:=hp.childof;
+          end;
+        is_related:=false;
+     end;
+
+   function tobjectdef.find_destructor: tprocdef;
+     var
+       objdef: tobjectdef;
+     begin
+        objdef:=self;
+        while assigned(objdef) do
+          begin
+            result:=objdef.find_procdef_bytype(potype_destructor);
+            if assigned(result) then
+              exit;
+            objdef:=objdef.childof;
+          end;
+        result:=nil;
+     end;
+
+    function tobjectdef.implements_any_interfaces: boolean;
+      begin
+        result := (ImplementedInterfaces.Count > 0) or
+          (assigned(childof) and childof.implements_any_interfaces);
+      end;
+
+    function tobjectdef.size : asizeint;
+      begin
+        if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper] then
+          result:=sizeof(pint)
+        else
+          result:=tObjectSymtable(symtable).datasize;
+      end;
+
+
+    function tobjectdef.alignment:shortint;
+      begin
+        if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper] then
+          alignment:=sizeof(pint)
+        else
+          alignment:=tObjectSymtable(symtable).recordalignment;
+      end;
+
+
+    function tobjectdef.vmtmethodoffset(index:longint):longint;
+      begin
+        { for offset of methods for classes, see rtl/inc/objpash.inc }
+        case objecttype of
+        odt_class:
+          { the +2*sizeof(pint) is size and -size }
+          vmtmethodoffset:=(index+10)*sizeof(pint)+2*sizeof(pint);
+        odt_helper,
+        odt_objcclass,
+        odt_objcprotocol:
+          vmtmethodoffset:=0;
+        odt_interfacecom,odt_interfacecorba,odt_dispinterface:
+          vmtmethodoffset:=index*sizeof(pint);
+        else
+{$ifdef WITHDMT}
+          vmtmethodoffset:=(index+4)*sizeof(pint);
+{$else WITHDMT}
+          vmtmethodoffset:=(index+3)*sizeof(pint);
+{$endif WITHDMT}
+        end;
+      end;
+
+
+    function tobjectdef.vmt_mangledname : string;
+      begin
+        if not(oo_has_vmt in objectoptions) then
+          Message1(parser_n_object_has_no_vmt,objrealname^);
+        vmt_mangledname:=make_mangledname('VMT',owner,objname^);
+      end;
+
+
+    function tobjectdef.needs_inittable : boolean;
+      begin
+         case objecttype of
+            odt_helper,
+            odt_class :
+              needs_inittable:=false;
+            odt_dispinterface,
+            odt_interfacecom:
+              needs_inittable:=true;
+            odt_interfacecorba:
+              needs_inittable:=is_related(interface_iunknown);
+            odt_object:
+              needs_inittable:=tObjectSymtable(symtable).needs_init_final;
+            odt_cppclass,
+            odt_objcclass,
+            odt_objcprotocol:
+              needs_inittable:=false;
+            else
+              internalerror(200108267);
+         end;
+      end;
+
+
+    function tobjectdef.rtti_mangledname(rt: trttitype): string;
+      begin
+        if not(objecttype in [odt_objcclass,odt_objcprotocol]) then
+          result:=inherited rtti_mangledname(rt)
+        else
+          begin
+            { necessary in case of a dynamic array of nsobject, or
+              if an nsobject field appears in a record that needs
+              init/finalisation }
+            if rt=initrtti then
+              begin
+                result:=voidpointertype.rtti_mangledname(rt);
+                exit;
+              end;
+
+            if not(target_info.system in systems_objc_nfabi) then
+              begin
+                result:=target_asm.labelprefix;
+                case objecttype of
+                  odt_objcclass:
+                    begin
+                      case rt of
+                        objcclassrtti:
+                          if not(oo_is_classhelper in objectoptions) then
+                            result:=result+'_OBJC_CLASS_'
+                          else
+                            result:=result+'_OBJC_CATEGORY_';
+                        objcmetartti:
+                          if not(oo_is_classhelper in objectoptions) then
+                            result:=result+'_OBJC_METACLASS_'
+                          else
+                            internalerror(2009111511);
+                        else
+                         internalerror(2009092302);
+                      end;
+                    end;
+                  odt_objcprotocol:
+                    result:=result+'_OBJC_PROTOCOL_';
+                end;
+              end
+            else
+              begin
+                case objecttype of
+                  odt_objcclass:
+                    begin
+                      if (oo_is_classhelper in objectoptions) and
+                         (rt<>objcclassrtti) then
+                        internalerror(2009111512);
+                      case rt of
+                        objcclassrtti:
+                          if not(oo_is_classhelper in objectoptions) then
+                            result:='_OBJC_CLASS_$_'
+                          else
+                            result:='_OBJC_$_CATEGORY_';
+                        objcmetartti:
+                          result:='_OBJC_METACLASS_$_';
+                        objcclassrortti:
+                          result:=lower(target_asm.labelprefix)+'_OBJC_CLASS_RO_$_';
+                        objcmetarortti:
+                          result:=lower(target_asm.labelprefix)+'_OBJC_METACLASS_RO_$_';
+                        else
+                         internalerror(2009092303);
+                      end;
+                    end;
+                  odt_objcprotocol:
+                    begin
+                      result:=lower(target_asm.labelprefix);
+                      case rt of
+                        objcclassrtti:
+                          result:=result+'_OBJC_PROTOCOL_$_';
+                        objcmetartti:
+                          result:=result+'_OBJC_LABEL_PROTOCOL_$_';
+                        else
+                          internalerror(2009092501);
+                      end;
+                    end;
+                end;
+              end;
+            result:=result+objextname^;
+          end;
+      end;
+
+
+    function tobjectdef.members_need_inittable : boolean;
+      begin
+        members_need_inittable:=tObjectSymtable(symtable).needs_init_final;
+      end;
+
+
+    function tobjectdef.find_implemented_interface(aintfdef:tobjectdef):TImplementedInterface;
+      var
+        ImplIntf : TImplementedInterface;
+        i : longint;
+      begin
+        result:=nil;
+        if not assigned(ImplementedInterfaces) then
+          exit;
+        for i:=0 to ImplementedInterfaces.Count-1 do
+          begin
+            ImplIntf:=TImplementedInterface(ImplementedInterfaces[i]);
+            if ImplIntf.intfdef=aintfdef then
+              begin
+                result:=ImplIntf;
+                exit;
+              end;
+          end;
+      end;
+
+
+    function tobjectdef.is_publishable : boolean;
+      begin
+         is_publishable:=objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface];
+      end;
+
+
+    function tobjectdef.get_next_dispid: longint;
+      begin
+        inc(fcurrent_dispid);
+        result:=fcurrent_dispid;
+      end;
+
+    function tobjectdef.search_enumerator_get: tprocdef;
+      begin
+        result:=inherited;
+        if not assigned(result) and assigned(childof) then
+          result:=childof.search_enumerator_get;
+      end;
+
+    function tobjectdef.search_enumerator_move: tprocdef;
+      begin
+        result:=inherited;
+        if not assigned(result) and assigned(childof) then
+          result:=childof.search_enumerator_move;
+      end;
+
+    function tobjectdef.search_enumerator_current: tsym;
+      begin
+        result:=inherited;
+        if not assigned(result) and assigned(childof) then
+          result:=childof.search_enumerator_current;
+      end;
+
+    procedure tobjectdef.register_created_classref_type;
+      begin
+        if not classref_created_in_current_module then
+          begin
+            classref_created_in_current_module:=true;
+            current_module.wpoinfo.addcreatedobjtypeforclassref(self);
+          end;
+      end;
+
+
+    procedure tobjectdef.register_created_object_type;
+      begin
+        if not created_in_current_module then
+          begin
+            created_in_current_module:=true;
+            current_module.wpoinfo.addcreatedobjtype(self);
+          end;
+      end;
+
+
+    procedure tobjectdef.register_maybe_created_object_type;
+      begin
+        { if we know it has been created for sure, no need
+          to also record that it maybe can be created in
+          this module
+        }
+        if not (created_in_current_module) and
+           not (maybe_created_in_current_module) then
+          begin
+            maybe_created_in_current_module:=true;
+            current_module.wpoinfo.addmaybecreatedbyclassref(self);
+          end;
+      end;
+
+
+    procedure tobjectdef.register_vmt_call(index: longint);
+      begin
+        if (is_object(self) or is_class(self)) then
+          current_module.wpoinfo.addcalledvmtentry(self,index);
+      end;
+
+
+    procedure check_and_finish_msg(data: tobject; arg: pointer);
+      var
+        def: tdef absolute data;
+        pd: tprocdef absolute data;
+        i,
+        paracount: longint;
+      begin
+        if (def.typ=procdef) then
+          begin
+            { add all messages also under a dummy name to the symtable in
+              which the objcclass/protocol/category is declared, so they can
+              be called via id.<name>
+            }
+            create_class_helper_for_procdef(pd,nil);
+
+            { we have to wait until now to set the mangled name because it
+              depends on the (possibly external) class name, which is defined
+              at the very end.  }
+            if not(po_msgstr in pd.procoptions) then
+              begin
+                CGMessagePos(pd.fileinfo,parser_e_objc_requires_msgstr);
+                { recover to avoid internalerror later on }
+                include(pd.procoptions,po_msgstr);
+                pd.messageinf.str:=stringdup('MissingDeclaration');
+              end;
+            { Mangled name is already set in case this is a copy of
+              another type.  }
+            if not(po_has_mangledname in pd.procoptions) then
+              begin
+                { check whether the number of formal parameters is correct,
+                  and whether they have valid Objective-C types }
+                paracount:=0;
+                for i:=1 to length(pd.messageinf.str^) do
+                  if pd.messageinf.str^[i]=':' then
+                    inc(paracount);
+                for i:=0 to pd.paras.count-1 do
+                  if not(vo_is_hidden_para in tparavarsym(pd.paras[i]).varoptions) and
+                     not is_array_of_const(tparavarsym(pd.paras[i]).vardef) then
+                    dec(paracount);
+                if (paracount<>0) then
+                  MessagePos(pd.fileinfo,sym_e_objc_para_mismatch);
+
+                pd.setmangledname(pd.objcmangledname);
+              end
+            else
+              { all checks already done }
+              exit;
+            if not(oo_is_external in pd.struct.objectoptions) then
+              begin
+                if (po_varargs in pd.procoptions) then
+                  MessagePos(pd.fileinfo,parser_e_varargs_need_cdecl_and_external)
+                else
+                  begin
+                    { check for "array of const" parameters }
+                    for i:=0 to pd.parast.symlist.count-1 do
+                      begin
+                        if (tsym(pd.parast.symlist[i]).typ=paravarsym) and
+                           is_array_of_const(tparavarsym(pd.parast.symlist[i]).vardef) then
+                          MessagePos(pd.fileinfo,parser_e_varargs_need_cdecl_and_external);
+                      end;
+                  end;
+              end;
+          end;
+      end;
+
+
+    procedure mark_private_fields_used(data: tobject; arg: pointer);
+      var
+        sym: tsym absolute data;
+      begin
+        if (sym.typ=fieldvarsym) and
+           (tfieldvarsym(sym).visibility in [vis_private,vis_strictprivate]) then
+          sym.IncRefCount;
+      end;
+
+
+    procedure tobjectdef.finish_objc_data;
+      begin
+        self.symtable.DefList.foreachcall(@check_and_finish_msg,nil);
+        if (oo_is_external in objectoptions) then
+          self.symtable.SymList.ForEachCall(@mark_private_fields_used,nil);
+      end;
+
+
+    procedure verify_objc_vardef(data: tobject; arg: pointer);
+      var
+        sym: tabstractvarsym absolute data;
+        res: pboolean absolute arg;
+        founderrordef: tdef;
+      begin
+        if not(tsym(data).typ in [paravarsym,fieldvarsym]) then
+          exit;
+        if (sym.typ=paravarsym) and
+           ((vo_is_hidden_para in tparavarsym(sym).varoptions) or
+            is_array_of_const(tparavarsym(sym).vardef)) then
+          exit;
+        if not objcchecktype(sym.vardef,founderrordef) then
+          begin
+            MessagePos1(sym.fileinfo,type_e_objc_type_unsupported,founderrordef.typename);
+            res^:=false;
+          end;
+      end;
+
+
+    procedure verify_objc_procdef_paras(data: tobject; arg: pointer);
+      var
+        def: tdef absolute data;
+        res: pboolean absolute arg;
+        founderrordef: tdef;
+      begin
+        if (def.typ<>procdef) then
+          exit;
+        { check parameter types for validity }
+        tprocdef(def).paras.foreachcall(@verify_objc_vardef,arg);
+        { check the result type for validity }
+        if not objcchecktype(tprocdef(def).returndef,founderrordef) then
+          begin
+            MessagePos1(tprocdef(def).funcretsym.fileinfo,type_e_objc_type_unsupported,founderrordef.typename);
+            res^:=false;
+          end;
+      end;
+
+
+    function tobjectdef.check_objc_types: boolean;
+      begin
+        { done in separate step from finish_objc_data, because when
+          finish_objc_data is called, not all forwarddefs have been resolved
+          yet and we need to know all types here }
+        result:=true;
+        self.symtable.symlist.foreachcall(@verify_objc_vardef,@result);
+        self.symtable.deflist.foreachcall(@verify_objc_procdef_paras,@result);
+      end;
+
+
+    procedure do_cpp_import_info(data: tobject; arg: pointer);
+      var
+        def: tdef absolute data;
+        pd: tprocdef absolute data;
+      begin
+        if (def.typ=procdef) then
+          begin
+            pd.setmangledname(target_info.Cprefix+pd.cplusplusmangledname);
+            if (oo_is_external in pd.struct.objectoptions) then
+              begin
+                { copied from psub.read_proc }
+                if assigned(tobjectdef(pd.struct).import_lib) then
+                   current_module.AddExternalImport(tobjectdef(pd.struct).import_lib^,pd.mangledname,pd.mangledname,0,false,false)
+                 else
+                   begin
+                     { add import name to external list for DLL scanning }
+                     if tf_has_dllscanner in target_info.flags then
+                       current_module.dllscannerinputlist.Add(pd.mangledname,pd);
+                   end;
+
+              end;
+          end;
+      end;
+
+
+    procedure tobjectdef.finish_cpp_data;
+      begin
+        self.symtable.DefList.ForEachCall(@do_cpp_import_info,nil);
+      end;
+
+{****************************************************************************
+                             TImplementedInterface
+****************************************************************************}
+
+    constructor TImplementedInterface.create(aintf: tobjectdef);
+      begin
+        inherited create;
+        intfdef:=aintf;
+        IOffset:=-1;
+        IType:=etStandard;
+        NameMappings:=nil;
+        procdefs:=nil;
+      end;
+
+
+    constructor TImplementedInterface.create_deref(d:tderef);
+      begin
+        inherited create;
+        intfdef:=nil;
+        intfdefderef:=d;
+        IOffset:=-1;
+        IType:=etStandard;
+        NameMappings:=nil;
+        procdefs:=nil;
+      end;
+
+
+    destructor  TImplementedInterface.destroy;
+      var
+        i : longint;
+        mappedname : pshortstring;
+      begin
+        if assigned(NameMappings) then
+          begin
+            for i:=0 to NameMappings.Count-1 do
+              begin
+                mappedname:=pshortstring(NameMappings[i]);
+                stringdispose(mappedname);
+              end;
+            NameMappings.free;
+            NameMappings:=nil;
+          end;
+        if assigned(procdefs) then
+          begin
+            procdefs.free;
+            procdefs:=nil;
+          end;
+        inherited destroy;
+      end;
+
+
+    procedure TImplementedInterface.buildderef;
+      begin
+        intfdefderef.build(intfdef);
+      end;
+
+
+    procedure TImplementedInterface.deref;
+      begin
+        intfdef:=tobjectdef(intfdefderef.resolve);
+      end;
+
+
+    procedure TImplementedInterface.AddMapping(const origname,newname: string);
+      begin
+        if not assigned(NameMappings) then
+          NameMappings:=TFPHashList.Create;
+        NameMappings.Add(origname,stringdup(newname));
+      end;
+
+
+    function TImplementedInterface.GetMapping(const origname: string):string;
+      var
+        mappedname : pshortstring;
+      begin
+        result:='';
+        if not assigned(NameMappings) then
+          exit;
+        mappedname:=PShortstring(NameMappings.Find(origname));
+        if assigned(mappedname) then
+          result:=mappedname^;
+      end;
+
+
+    procedure TImplementedInterface.AddImplProc(pd:tprocdef);
+      begin
+        if not assigned(procdefs) then
+          procdefs:=TFPObjectList.Create(false);
+        { duplicate entries must be stored, because multiple }
+        { interfaces can declare methods with the same name  }
+        { and all of these get their own VMT entry           }
+        procdefs.Add(pd);
+      end;
+
+
+    function TImplementedInterface.IsImplMergePossible(MergingIntf:TImplementedInterface;out weight: longint): boolean;
+      var
+        i : longint;
+      begin
+        result:=false;
+        { interfaces being implemented through delegation are not mergable (FK) }
+        if (IType<>etStandard) or (MergingIntf.IType<>etStandard) or not(assigned(ProcDefs)) or not(assigned(MergingIntf.ProcDefs)) then
+          exit;
+        weight:=0;
+        { empty interface is mergeable }
+        if ProcDefs.Count=0 then
+          begin
+            result:=true;
+            exit;
+          end;
+        { The interface to merge must at least the number of
+          procedures of this interface }
+        if MergingIntf.ProcDefs.Count<ProcDefs.Count then
+          exit;
+        for i:=0 to ProcDefs.Count-1 do
+          begin
+            if MergingIntf.ProcDefs[i]<>ProcDefs[i] then
+              exit;
+          end;
+        weight:=ProcDefs.Count;
+        result:=true;
+      end;
+
+
+    function TImplementedInterface.getcopy:TImplementedInterface;
+      begin
+        Result:=TImplementedInterface.Create(nil);
+        { 1) the procdefs list will be freed once for each copy
+          2) since the procdefs list owns its elements, those will also be freed for each copy
+          3) idem for the name mappings
+        }
+        { warning: this is completely wrong on so many levels...
+        Move(pointer(self)^,pointer(result)^,InstanceSize);
+        We need to make clean copies of the different fields
+        this is not implemented yet, and thus we generate an internal
+        error instead PM 2011-06-14 }
+        internalerror(2011061401);
+      end;
+
+{****************************************************************************
+                                TFORWARDDEF
+****************************************************************************}
+
+   constructor tforwarddef.create(const s:string;const pos:tfileposinfo);
+     begin
+        inherited create(forwarddef);
+        tosymname:=stringdup(s);
+        forwardpos:=pos;
+     end;
+
+
+    function tforwarddef.GetTypeName:string;
+      begin
+        GetTypeName:='unresolved forward to '+tosymname^;
+      end;
+
+
+    destructor tforwarddef.destroy;
+      begin
+        stringdispose(tosymname);
+        inherited destroy;
+      end;
+
+    function tforwarddef.getcopy:tstoreddef;
+      begin
+        result:=tforwarddef.create(tosymname^, forwardpos);
+      end;
+
+{****************************************************************************
+                               TUNDEFINEDDEF
+****************************************************************************}
+
+   constructor tundefineddef.create;
+     begin
+        inherited create(undefineddef);
+     end;
+
+
+    constructor tundefineddef.ppuload(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(undefineddef,ppufile);
+      end;
+
+    function tundefineddef.GetTypeName:string;
+      begin
+        GetTypeName:='<undefined type>';
+      end;
+
+
+    procedure tundefineddef.ppuwrite(ppufile:tcompilerppufile);
+      begin
+         inherited ppuwrite(ppufile);
+         ppufile.writeentry(ibundefineddef);
+      end;
+
+
+{****************************************************************************
+                                  TERRORDEF
+****************************************************************************}
+
+    constructor terrordef.create;
+      begin
+        inherited create(errordef);
+        { prevent consecutive faults }
+        savesize:=1;
+      end;
+
+
+    procedure terrordef.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        { Can't write errordefs to ppu }
+        internalerror(200411063);
+      end;
+
+
+    function terrordef.GetTypeName:string;
+      begin
+        GetTypeName:='<erroneous type>';
+      end;
+
+
+    function terrordef.getmangledparaname:string;
+      begin
+        getmangledparaname:='error';
+      end;
+
+
+{****************************************************************************
+                           Definition Helpers
+****************************************************************************}
+
+    function is_interfacecom(def: tdef): boolean;
+      begin
+        is_interfacecom:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype=odt_interfacecom);
+      end;
+
+    function is_interfacecom_or_dispinterface(def: tdef): boolean;
+      begin
+        is_interfacecom_or_dispinterface:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype in [odt_interfacecom,odt_dispinterface]);
+      end;
+
+    function is_interfacecorba(def: tdef): boolean;
+      begin
+        is_interfacecorba:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype=odt_interfacecorba);
+      end;
+
+    function is_interface(def: tdef): boolean;
+      begin
+        is_interface:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype in [odt_interfacecom,odt_interfacecorba]);
+      end;
+
+
+    function is_dispinterface(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype=odt_dispinterface);
+      end;
+
+
+    function is_class(def: tdef): boolean;
+      begin
+        is_class:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype=odt_class);
+      end;
+
+
+    function is_object(def: tdef): boolean;
+      begin
+        is_object:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype=odt_object);
+      end;
+
+
+    function is_cppclass(def: tdef): boolean;
+      begin
+        is_cppclass:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype=odt_cppclass);
+      end;
+
+
+    function is_objcclass(def: tdef): boolean;
+      begin
+        is_objcclass:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype=odt_objcclass);
+      end;
+
+
+    function is_objectpascal_helper(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype=odt_helper);
+      end;
+
+
+    function is_objcclassref(def: tdef): boolean;
+      begin
+        is_objcclassref:=
+          assigned(def) and
+          (def.typ=classrefdef) and
+          is_objcclass(tclassrefdef(def).pointeddef);
+      end;
+
+
+    function is_objcprotocol(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype=odt_objcprotocol);
+      end;
+
+
+    function is_objccategory(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          { if used as a forward type }
+          ((tobjectdef(def).objecttype=odt_objccategory) or
+          { if used as after it has been resolved }
+           ((tobjectdef(def).objecttype=odt_objcclass) and
+            (oo_is_classhelper in tobjectdef(def).objectoptions)));
+      end;
+
+    function is_objc_class_or_protocol(def: tdef): boolean;
+      begin
+         result:=
+           assigned(def) and
+           (def.typ=objectdef) and
+           (tobjectdef(def).objecttype in [odt_objcclass,odt_objcprotocol]);
+      end;
+
+
+    function is_objc_protocol_or_category(def: tdef): boolean;
+      begin
+         result:=
+           assigned(def) and
+           (def.typ=objectdef) and
+           ((tobjectdef(def).objecttype = odt_objcprotocol) or
+            ((tobjectdef(def).objecttype = odt_objcclass) and
+             (oo_is_classhelper in tobjectdef(def).objectoptions)));
+      end;
+
+    function is_classhelper(def: tdef): boolean;
+      begin
+         result:=
+           is_objectpascal_helper(def) or
+           is_objccategory(def);
+      end;
+
+    function is_class_or_interface(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba]);
+      end;
+
+
+    function is_class_or_interface_or_objc(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_objcclass,odt_objcprotocol]);
+      end;
+
+
+    function is_class_or_interface_or_object(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_object]);
+      end;
+
+
+    function is_class_or_interface_or_dispinterface(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface]);
+      end;
+
+
+    function is_implicit_pointer_object_type(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper]);
+      end;
+
+    function is_class_or_object(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype in [odt_class,odt_object]);
+      end;
+
+    function is_record(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=recorddef);
+      end;
+
+    procedure loadobjctypes;
+      begin
+        objc_metaclasstype:=tpointerdef(search_named_unit_globaltype('OBJC','POBJC_CLASS',true).typedef);
+        objc_superclasstype:=tpointerdef(search_named_unit_globaltype('OBJC','POBJC_SUPER',true).typedef);
+        objc_idtype:=tpointerdef(search_named_unit_globaltype('OBJC','ID',true).typedef);
+        objc_seltype:=tpointerdef(search_named_unit_globaltype('OBJC','SEL',true).typedef);
+        objc_objecttype:=trecorddef(search_named_unit_globaltype('OBJC','OBJC_OBJECT',true).typedef);
+      end;
+
+
+    procedure maybeloadcocoatypes;
+      var
+        tsym: ttypesym;
+      begin
+        if assigned(objc_fastenumeration) then
+          exit;
+        tsym:=search_named_unit_globaltype('COCOAALL','NSFASTENUMERATIONPROTOCOL',false);
+        if assigned(tsym) then
+          objc_fastenumeration:=tobjectdef(tsym.typedef)
+        else
+          objc_fastenumeration:=nil;
+        tsym:=search_named_unit_globaltype('COCOAALL','NSFASTENUMERATIONSTATE',false);
+        if assigned(tsym) then
+          objc_fastenumerationstate:=trecorddef(tsym.typedef)
+        else
+        objc_fastenumerationstate:=nil;
+      end;
+
+
+    function use_vectorfpu(def : tdef) : boolean;
+      begin
+{$ifdef x86}
+{$define use_vectorfpuimplemented}
+        use_vectorfpu:=(is_single(def) and (current_settings.fputype in sse_singlescalar)) or
+          (is_double(def) and (current_settings.fputype in sse_doublescalar));
+{$endif x86}
+{$ifdef arm}
+{$define use_vectorfpuimplemented}
+        use_vectorfpu:=(current_settings.fputype in vfp_scalar);
+{$endif arm}
+{$ifndef use_vectorfpuimplemented}
+        use_vectorfpu:=false;
+{$endif}
+      end;
+
+end.