mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 14:39:36 +01:00
4678 lines
177 KiB
ObjectPascal
4678 lines
177 KiB
ObjectPascal
{
|
|
Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
|
|
|
|
This unit handles the symbol tables
|
|
|
|
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 symtable;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{ common }
|
|
cutils,cclasses,globtype,tokens,
|
|
{ symtable }
|
|
symconst,symbase,symtype,symdef,symsym;
|
|
|
|
|
|
{****************************************************************************
|
|
Symtable types
|
|
****************************************************************************}
|
|
|
|
type
|
|
tstoredsymtable = class(TSymtable)
|
|
private
|
|
init_final_check_done : boolean;
|
|
procedure _needs_init_final(sym:TObject;arg:pointer);
|
|
procedure do_init_final_check;
|
|
procedure check_forward(sym:TObject;arg:pointer);
|
|
procedure check_block_valid(def: TObject;arg:pointer);
|
|
procedure register_defs(def:tobject;arg:pointer);
|
|
procedure register_syms(sym:tobject;arg:pointer);
|
|
procedure labeldefined(sym:TObject;arg:pointer);
|
|
procedure varsymbolused(sym:TObject;arg:pointer);
|
|
procedure TestPrivate(sym:TObject;arg:pointer);
|
|
procedure objectprivatesymbolused(sym:TObject;arg:pointer);
|
|
procedure loaddefs(ppufile:tcompilerppufile);
|
|
procedure loadsyms(ppufile:tcompilerppufile);
|
|
procedure writedefs(ppufile:tcompilerppufile);
|
|
procedure writesyms(ppufile:tcompilerppufile);
|
|
public
|
|
constructor create(const s:string);
|
|
procedure insert(sym:TSymEntry;checkdup:boolean=true);override;
|
|
procedure delete(sym:TSymEntry);override;
|
|
{ load/write }
|
|
procedure ppuload(ppufile:tcompilerppufile);virtual;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);virtual;
|
|
procedure buildderef;
|
|
procedure buildderefimpl;
|
|
{ buildderef but only for (recursively) used symbols/defs }
|
|
procedure buildderef_registered;
|
|
procedure deref(only_registered: boolean);virtual;
|
|
procedure derefimpl(only_registered: boolean);virtual;
|
|
function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
|
|
procedure allsymbolsused;
|
|
procedure allprivatesused;
|
|
procedure check_forwards;
|
|
procedure checklabels;
|
|
function needs_init_final : boolean; virtual;
|
|
function has_non_trivial_init:boolean;virtual;
|
|
procedure testfordefaultproperty(sym:TObject;arg:pointer);
|
|
procedure register_children;
|
|
end;
|
|
|
|
{$ifdef llvm}
|
|
tllvmshadowsymtableentry = class
|
|
constructor create(def: tdef; fieldoffset: aint);
|
|
private
|
|
ffieldoffset: aint;
|
|
fdef: tdef;
|
|
public
|
|
property fieldoffset: aint read ffieldoffset;
|
|
property def: tdef read fdef;
|
|
end;
|
|
|
|
tllvmshadowsymtable = class;
|
|
{$endif llvm}
|
|
|
|
tmanagementoperator_offset_entry = record
|
|
pd : tprocdef;
|
|
offset : asizeint;
|
|
end;
|
|
pmanagementoperator_offset_entry = ^tmanagementoperator_offset_entry;
|
|
|
|
tabstractrecordsymtable = class(tstoredsymtable)
|
|
{$ifdef llvm}
|
|
private
|
|
fllvmst: tllvmshadowsymtable;
|
|
function getllvmshadowsymtabll: tllvmshadowsymtable;
|
|
{$endif llvm}
|
|
public
|
|
usefieldalignment, { alignment to use for fields (PACKRECORDS value), C_alignment is C style }
|
|
recordalignment, { alignment desired when inserting this record }
|
|
fieldalignment, { alignment current alignment used when fields are inserted }
|
|
padalignment : shortint; { size to a multiple of which the symtable has to be rounded up }
|
|
recordalignmin, { local equivalents of global settings, so that records can }
|
|
maxCrecordalign: shortint; { be created with custom settings internally }
|
|
has_fields_with_mop : tmanagementoperators; { whether any of the fields has the need for a management operator (or one of the field's fields) }
|
|
constructor create(const n:string;usealign,recordminalign,recordmaxCalign:shortint);
|
|
destructor destroy;override;
|
|
procedure ppuload(ppufile:tcompilerppufile);override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
procedure alignrecord(fieldoffset:asizeint;varalign:shortint);
|
|
procedure addfield(sym:tfieldvarsym;vis:tvisibility);
|
|
procedure addfieldlist(list: tfpobjectlist; maybereorder: boolean);
|
|
{ returns the field closest to this offset (may not be exact because
|
|
of padding; internalerrors for variant records, assumes fields are
|
|
ordered by increasing offset) }
|
|
function findfieldbyoffset(offset:asizeint): tfieldvarsym;
|
|
procedure addalignmentpadding;
|
|
procedure insertdef(def:TDefEntry);override;
|
|
function is_packed: boolean;
|
|
function has_single_field(out def:tdef): boolean;
|
|
function get_unit_symtable: tsymtable;
|
|
{ collects all management operators of the specified type in list (which
|
|
is not cleared); the entries are copies and thus must be freed by the
|
|
caller }
|
|
procedure get_managementoperator_offset_list(mop:tmanagementoperator;list:tfplist);
|
|
protected
|
|
{ size in bytes including padding }
|
|
_datasize : asizeint;
|
|
{ size in bits of the data in case of bitpacked record. Only important during construction, }
|
|
{ no need to save in/restore from ppu file. datasize is always (databitsize+7) div 8. }
|
|
databitsize : asizeint;
|
|
{ size in bytes of padding }
|
|
_paddingsize : word;
|
|
{ array of tmanagementoperator_offset_entry lists; only assigned if
|
|
they had been queried once by get_management_operator_list }
|
|
mop_list : array[tmanagementoperator] of tfplist;
|
|
procedure setdatasize(val: asizeint);
|
|
function getfieldoffset(sym: tfieldvarsym; base: asizeint; var globalfieldalignment: shortint): asizeint;
|
|
procedure do_get_managementoperator_offset_list(data:tobject;arg:pointer);
|
|
public
|
|
function iscurrentunit: boolean; override;
|
|
property datasize : asizeint read _datasize write setdatasize;
|
|
property paddingsize: word read _paddingsize write _paddingsize;
|
|
{$ifdef llvm}
|
|
property llvmst: tllvmshadowsymtable read getllvmshadowsymtabll;
|
|
{$endif llvm}
|
|
end;
|
|
|
|
trecordsymtable = class(tabstractrecordsymtable)
|
|
public
|
|
{ maybe someday is worth to move managementoperators to }
|
|
{ tabstractrecordsymtable to perform management class operators for }
|
|
{ object/classes. In XE5 and newer is possible to use class operator }
|
|
{ for classes (like for Delphi .NET before) only for Delphi NEXTGEN }
|
|
managementoperators : tmanagementoperators;
|
|
constructor create(const n:string;usealign,recordminalign,recordmaxCalign:shortint);
|
|
procedure insertunionst(unionst : trecordsymtable;offset : asizeint);
|
|
procedure includemanagementoperator(mop:tmanagementoperator);
|
|
end;
|
|
|
|
tObjectSymtable = class(tabstractrecordsymtable)
|
|
public
|
|
constructor create(adefowner:tdef;const n:string;usealign,recordminalign,recordmaxCalign:shortint);
|
|
function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
|
|
end;
|
|
|
|
{$ifdef llvm}
|
|
{ llvm record definitions cannot contain variant/union parts, }
|
|
{ you have to flatten them first. the tllvmshadowsymtable }
|
|
{ contains a flattened version of a record/object symtable }
|
|
tllvmshadowsymtable = class
|
|
private
|
|
equivst: tabstractrecordsymtable;
|
|
curroffset: aint;
|
|
function get(f: tfieldvarsym): tllvmshadowsymtableentry;
|
|
function get_by_llvm_index(index: longint): tllvmshadowsymtableentry;
|
|
public
|
|
symdeflist: TFPObjectList;
|
|
|
|
constructor create(st: tabstractrecordsymtable);
|
|
destructor destroy; override;
|
|
|
|
property entries[index: tfieldvarsym]: tllvmshadowsymtableentry read get; default;
|
|
{ warning: do not call this with field.llvmfieldnr, as
|
|
field.llvmfieldnr will only be initialised when the llvm shadow
|
|
symtable is accessed for the first time. Use the default/entries
|
|
property instead in this case }
|
|
property entries_by_llvm_index[index: longint]: tllvmshadowsymtableentry read get_by_llvm_index;
|
|
private
|
|
// generate the table
|
|
procedure generate;
|
|
// helpers
|
|
procedure appenddefoffset(vardef:tdef; fieldoffset: aint; derefclass: boolean);
|
|
procedure findvariantstarts(variantstarts: tfplist);
|
|
procedure addalignmentpadding(finalsize: aint);
|
|
procedure buildmapping(variantstarts: tfplist);
|
|
procedure buildtable(variantstarts: tfplist);
|
|
end;
|
|
{$endif llvm}
|
|
|
|
{ tabstractsubsymtable }
|
|
|
|
tabstractsubsymtable = class(tstoredsymtable)
|
|
public
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
end;
|
|
|
|
{ tabstractlocalsymtable }
|
|
|
|
tabstractlocalsymtable = class(tabstractsubsymtable)
|
|
public
|
|
function count_locals:longint;
|
|
function iscurrentunit: boolean; override;
|
|
end;
|
|
|
|
tlocalsymtable = class(tabstractlocalsymtable)
|
|
public
|
|
constructor create(adefowner:tdef;level:byte);
|
|
function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
|
|
end;
|
|
|
|
{ tparasymtable }
|
|
|
|
tparasymtable = class(tabstractlocalsymtable)
|
|
public
|
|
readonly: boolean;
|
|
constructor create(adefowner:tdef;level:byte);
|
|
function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
|
|
procedure insertdef(def:TDefEntry);override;
|
|
end;
|
|
|
|
tabstractuniTSymtable = class(tstoredsymtable)
|
|
public
|
|
constructor create(const n : string;id:word);
|
|
function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
|
|
function findnamespace(const n:string):TSymEntry;virtual;
|
|
function iscurrentunit:boolean;override;
|
|
function needs_init_final: boolean; override;
|
|
procedure insertunit(sym:TSymEntry);
|
|
function has_class_condestructors: boolean;
|
|
end;
|
|
|
|
tglobalsymtable = class(tabstractuniTSymtable)
|
|
public
|
|
unittypecount : word;
|
|
constructor create(const n : string;id:word);
|
|
procedure ppuload(ppufile:tcompilerppufile);override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
end;
|
|
|
|
tstaticsymtable = class(tabstractuniTSymtable)
|
|
public
|
|
constructor create(const n : string;id:word);
|
|
procedure ppuload(ppufile:tcompilerppufile);override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
|
|
function findnamespace(const n:string):TSymEntry;override;
|
|
end;
|
|
|
|
tspecializesymtable = class(tglobalsymtable)
|
|
public
|
|
constructor create(const n : string;id:word);
|
|
function iscurrentunit:boolean;override;
|
|
end;
|
|
|
|
twithsymtable = class(TSymtable)
|
|
withrefnode : tobject; { tnode }
|
|
constructor create(aowner:tdef;ASymList:TFPHashObjectList;refnode:tobject{tnode});
|
|
destructor destroy;override;
|
|
procedure clear;override;
|
|
procedure insertdef(def:TDefEntry);override;
|
|
end;
|
|
|
|
tstt_excepTSymtable = class(TSymtable)
|
|
public
|
|
constructor create;
|
|
end;
|
|
|
|
tmacrosymtable = class(tstoredsymtable)
|
|
public
|
|
constructor create(exported: boolean);
|
|
end;
|
|
|
|
{ tenumsymtable }
|
|
|
|
tenumsymtable = class(tabstractsubsymtable)
|
|
public
|
|
procedure insert(sym: TSymEntry; checkdup: boolean = true); override;
|
|
constructor create(adefowner:tdef);
|
|
end;
|
|
|
|
{ tarraysymtable }
|
|
|
|
tarraysymtable = class(tabstractsubsymtable)
|
|
public
|
|
procedure insertdef(def:TDefEntry);override;
|
|
constructor create(adefowner:tdef);
|
|
end;
|
|
|
|
var
|
|
systemunit : tglobalsymtable; { pointer to the system unit }
|
|
|
|
type
|
|
tsymbol_search_flag = (
|
|
ssf_search_option,
|
|
ssf_search_helper,
|
|
ssf_has_inherited,
|
|
ssf_no_addsymref
|
|
);
|
|
tsymbol_search_flags = set of tsymbol_search_flag;
|
|
|
|
|
|
{****************************************************************************
|
|
Functions
|
|
****************************************************************************}
|
|
|
|
{*** Misc ***}
|
|
function FullTypeName(def,otherdef:tdef):string;
|
|
function generate_nested_name(symtable:tsymtable;delimiter:string):string;
|
|
{ def is the extended type of a helper }
|
|
function generate_objectpascal_helper_key(def:tdef):string;
|
|
procedure incompatibletypes(def1,def2:tdef);
|
|
procedure hidesym(sym:TSymEntry);
|
|
procedure duplicatesym(var hashedid: THashedIDString; dupsym, origsym:TSymEntry; warn: boolean);
|
|
function handle_generic_dummysym(sym:TSymEntry;var symoptions:tsymoptions):boolean;
|
|
{ writes all declarations for the specified system unit symbol }
|
|
procedure write_system_parameter_lists(const name:string);
|
|
|
|
{*** Search ***}
|
|
procedure addsymref(sym:tsym);
|
|
function is_owned_by(nesteddef,ownerdef:tdef):boolean;
|
|
function sym_is_owned_by(childsym:tsym;symtable:tsymtable):boolean;
|
|
function defs_belong_to_same_generic(def1,def2:tdef):boolean;
|
|
function get_generic_in_hierarchy_by_name(srsym:tsym;def:tdef):tdef;
|
|
function return_specialization_of_generic(nesteddef,genericdef:tdef;out resultdef:tdef):boolean;
|
|
function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tabstractrecorddef):boolean;
|
|
function is_visible_for_object(pd:tprocdef;contextobjdef:tabstractrecorddef):boolean;
|
|
function is_visible_for_object(sym:tsym;contextobjdef:tabstractrecorddef):boolean;
|
|
function searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
|
function searchsym_with_flags(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;flags:tsymbol_search_flags):boolean;
|
|
function searchsym_maybe_with_symoption(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;flags:tsymbol_search_flags;option:tsymoption):boolean;
|
|
{ searches for a symbol with the given name that has the given option in
|
|
symoptions set }
|
|
function searchsym_with_symoption(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;option:tsymoption):boolean;
|
|
function searchsym_type(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
|
function searchsym_in_module(pm:pointer;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
|
function searchsym_in_named_module(const unitname, symname: TIDString; out srsym: tsym; out srsymtable: tsymtable): boolean;
|
|
function searchsym_in_class(classh: tobjectdef; contextclassh:tabstractrecorddef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;flags:tsymbol_search_flags):boolean;
|
|
function searchsym_in_record(recordh:tabstractrecorddef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
|
function searchsym_in_class_by_msgint(classh:tobjectdef;msgid:longint;out srdef : tdef;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
|
function searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
|
{ searches symbols inside of a helper's implementation }
|
|
function searchsym_in_helper(classh,contextclassh:tobjectdef;const s: TIDString;out srsym:tsym;out srsymtable:TSymtable;flags:tsymbol_search_flags):boolean;
|
|
function search_system_type(const s: TIDString): ttypesym;
|
|
function try_search_system_type(const s: TIDString): ttypesym;
|
|
function try_search_current_module_type(const s: TIDString): ttypesym;
|
|
function search_system_proc(const s: TIDString): tprocdef;
|
|
function search_named_unit_globaltype(const unitname, typename: TIDString; throwerror: boolean): ttypesym;
|
|
function search_struct_member(pd : tabstractrecorddef;const s : string):tsym;
|
|
function search_struct_member_no_helper(pd : tabstractrecorddef;const s : string):tsym;
|
|
function search_assignment_operator(from_def,to_def:Tdef;explicit:boolean):Tprocdef;
|
|
function search_enumerator_operator(from_def,to_def:Tdef):Tprocdef;
|
|
function search_management_operator(mop:tmanagementoperator;pd:Tdef):Tprocdef;
|
|
{ searches for the helper definition that's currently active for pd }
|
|
function search_last_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;out odef : tobjectdef):boolean;
|
|
{ searches whether the symbol s is available in the currently active }
|
|
{ helper for pd }
|
|
function search_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
|
|
function search_objc_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
|
|
function search_objc_method(const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
|
|
{Looks for macro s (must be given in upper case) in the macrosymbolstack, }
|
|
{and returns it if found. Returns nil otherwise.}
|
|
function search_macro(const s : string):tsym;
|
|
{ Additionally to searching for a macro, also checks whether it's still }
|
|
{ actually defined (could be disable using "undef") }
|
|
function defined_macro(const s : string):boolean;
|
|
{ Look for a system procedure (no overloads supported) }
|
|
|
|
{*** Object Helpers ***}
|
|
function search_default_property(pd : tabstractrecorddef) : tpropertysym;
|
|
function maybe_find_real_class_definition(pd: tdef; erroronfailure: boolean): tdef;
|
|
function find_real_class_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
|
|
|
|
{*** Macro Helpers ***}
|
|
{If called initially, the following procedures manipulate macros in }
|
|
{initialmacrotable, otherwise they manipulate system macros local to a module.}
|
|
{Name can be given in any case (it will be converted to upper case).}
|
|
procedure def_system_macro(const name : string);
|
|
procedure set_system_macro(const name, value : string);
|
|
procedure set_system_compvar(const name, value : string);
|
|
procedure undef_system_macro(const name : string);
|
|
|
|
{*** symtable stack ***}
|
|
{ $ifdef DEBUG
|
|
procedure test_symtablestack;
|
|
procedure list_symtablestack;
|
|
$endif DEBUG}
|
|
|
|
{$ifdef UNITALIASES}
|
|
type
|
|
punit_alias = ^tunit_alias;
|
|
tunit_alias = object(TNamedIndexItem)
|
|
newname : pshortstring;
|
|
constructor init(const n:string);
|
|
destructor done;virtual;
|
|
end;
|
|
var
|
|
unitaliases : pdictionary;
|
|
|
|
procedure addunitalias(const n:string);
|
|
function getunitalias(const n:string):string;
|
|
{$endif UNITALIASES}
|
|
|
|
{*** Init / Done ***}
|
|
procedure IniTSymtable;
|
|
procedure DoneSymtable;
|
|
|
|
const
|
|
overloaded_names : array [NOTOKEN..last_overloaded] of string[16] = (
|
|
{ NOTOKEN } 'error',
|
|
{ _PLUS } 'plus',
|
|
{ _MINUS } 'minus',
|
|
{ _STAR } 'star',
|
|
{ _SLASH } 'slash',
|
|
{ _EQ } 'equal',
|
|
{ _GT } 'greater',
|
|
{ _LT } 'lower',
|
|
{ _GTE } 'greater_or_equal',
|
|
{ _LTE } 'lower_or_equal',
|
|
{ _NE } 'not_equal',
|
|
{ _SYMDIF } 'sym_diff',
|
|
{ _STARSTAR } 'starstar',
|
|
{ _OP_AS } 'as',
|
|
{ _OP_IN } 'in',
|
|
{ _OP_IS } 'is',
|
|
{ _OP_OR } 'or',
|
|
{ _OP_AND } 'and',
|
|
{ _OP_DIV } 'div',
|
|
{ _OP_MOD } 'mod',
|
|
{ _OP_NOT } 'not',
|
|
{ _OP_SHL } 'shl',
|
|
{ _OP_SHR } 'shr',
|
|
{ _OP_XOR } 'xor',
|
|
{ _ASSIGNMENT } 'assign',
|
|
{ _OP_EXPLICIT } 'explicit',
|
|
{ _OP_ENUMERATOR } 'enumerator',
|
|
{ _OP_INITIALIZE } 'initialize',
|
|
{ _OP_FINALIZE } 'finalize',
|
|
{ _OP_ADDREF } 'addref',
|
|
{ _OP_COPY } 'copy',
|
|
{ _OP_INC } 'inc',
|
|
{ _OP_DEC } 'dec');
|
|
|
|
managementoperator2tok:array[tmanagementoperator] of ttoken = (
|
|
{ mop_none } NOTOKEN,
|
|
{ mop_initialize } _OP_INITIALIZE,
|
|
{ mop_finalize } _OP_FINALIZE,
|
|
{ mop_addref } _OP_ADDREF,
|
|
{ mop_copy } _OP_COPY
|
|
);
|
|
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
{ global }
|
|
verbose,globals,
|
|
{ symtable }
|
|
symutil,defutil,defcmp,objcdef,
|
|
{ module }
|
|
fmodule,
|
|
{ codegen }
|
|
procinfo,
|
|
{ ppu }
|
|
entfile,
|
|
{ parser }
|
|
scanner
|
|
;
|
|
|
|
|
|
var
|
|
dupnr : longint; { unique number for duplicate symbols }
|
|
|
|
{*****************************************************************************
|
|
TStoredSymtable
|
|
*****************************************************************************}
|
|
|
|
constructor tstoredsymtable.create(const s:string);
|
|
begin
|
|
inherited create(s);
|
|
{ Note: this happens for the initial macro symtable, so no error here }
|
|
if not assigned(current_module) then
|
|
comment(v_debug,'Current module not available for module id')
|
|
else
|
|
moduleid:=current_module.moduleid;
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.insert(sym:TSymEntry;checkdup:boolean=true);
|
|
begin
|
|
inherited insert(sym,checkdup);
|
|
init_final_check_done:=false;
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.delete(sym:TSymEntry);
|
|
begin
|
|
inherited delete(sym);
|
|
init_final_check_done:=false;
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.ppuload(ppufile:tcompilerppufile);
|
|
begin
|
|
{ load the table's flags }
|
|
if ppufile.readentry<>ibsymtableoptions then
|
|
Message(unit_f_ppu_read_error);
|
|
ppufile.getsmallset(tableoptions);
|
|
|
|
{ load definitions }
|
|
loaddefs(ppufile);
|
|
|
|
{ load symbols }
|
|
loadsyms(ppufile);
|
|
|
|
init_final_check_done:=true;
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
{ ensure that we have the sto_needs_init_final flag set if needed }
|
|
if not init_final_check_done then
|
|
needs_init_final;
|
|
|
|
{ write the table's flags }
|
|
ppufile.putsmallset(tableoptions);
|
|
ppufile.writeentry(ibsymtableoptions);
|
|
|
|
{ write definitions }
|
|
writedefs(ppufile);
|
|
|
|
{ write symbols }
|
|
writesyms(ppufile);
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.loaddefs(ppufile:tcompilerppufile);
|
|
var
|
|
def : tdef;
|
|
b : byte;
|
|
begin
|
|
def:=nil;
|
|
{ load start of definition section, which holds the amount of defs }
|
|
if ppufile.readentry<>ibstartdefs then
|
|
Message(unit_f_ppu_read_error);
|
|
{ read definitions }
|
|
repeat
|
|
b:=ppufile.readentry;
|
|
case b of
|
|
ibpointerdef : def:=cpointerdef.ppuload(ppufile);
|
|
ibarraydef : def:=carraydef.ppuload(ppufile);
|
|
iborddef : def:=corddef.ppuload(ppufile);
|
|
ibfloatdef : def:=cfloatdef.ppuload(ppufile);
|
|
ibprocdef : def:=cprocdef.ppuload(ppufile);
|
|
ibshortstringdef : def:=cstringdef.loadshort(ppufile);
|
|
iblongstringdef : def:=cstringdef.loadlong(ppufile);
|
|
ibansistringdef : def:=cstringdef.loadansi(ppufile);
|
|
ibwidestringdef : def:=cstringdef.loadwide(ppufile);
|
|
ibunicodestringdef : def:=cstringdef.loadunicode(ppufile);
|
|
ibrecorddef : def:=crecorddef.ppuload(ppufile);
|
|
ibobjectdef : def:=cobjectdef.ppuload(ppufile);
|
|
ibenumdef : def:=cenumdef.ppuload(ppufile);
|
|
ibsetdef : def:=csetdef.ppuload(ppufile);
|
|
ibprocvardef : def:=cprocvardef.ppuload(ppufile);
|
|
ibfiledef : def:=cfiledef.ppuload(ppufile);
|
|
ibclassrefdef : def:=cclassrefdef.ppuload(ppufile);
|
|
ibformaldef : def:=cformaldef.ppuload(ppufile);
|
|
ibvariantdef : def:=cvariantdef.ppuload(ppufile);
|
|
ibundefineddef : def:=cundefineddef.ppuload(ppufile);
|
|
ibenddefs : break;
|
|
ibend : Message(unit_f_ppu_read_error);
|
|
else
|
|
Message1(unit_f_ppu_invalid_entry,tostr(b));
|
|
end;
|
|
InsertDef(def);
|
|
until false;
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.loadsyms(ppufile:tcompilerppufile);
|
|
var
|
|
b : byte;
|
|
sym : tsym;
|
|
begin
|
|
sym:=nil;
|
|
{ load start of definition section, which holds the amount of defs }
|
|
if ppufile.readentry<>ibstartsyms then
|
|
Message(unit_f_ppu_read_error);
|
|
{ now read the symbols }
|
|
repeat
|
|
b:=ppufile.readentry;
|
|
case b of
|
|
ibtypesym : sym:=ctypesym.ppuload(ppufile);
|
|
ibprocsym : sym:=cprocsym.ppuload(ppufile);
|
|
ibconstsym : sym:=cconstsym.ppuload(ppufile);
|
|
ibstaticvarsym : sym:=cstaticvarsym.ppuload(ppufile);
|
|
iblocalvarsym : sym:=clocalvarsym.ppuload(ppufile);
|
|
ibparavarsym : sym:=cparavarsym.ppuload(ppufile);
|
|
ibfieldvarsym : sym:=cfieldvarsym.ppuload(ppufile);
|
|
ibabsolutevarsym : sym:=cabsolutevarsym.ppuload(ppufile);
|
|
ibenumsym : sym:=cenumsym.ppuload(ppufile);
|
|
ibpropertysym : sym:=cpropertysym.ppuload(ppufile);
|
|
ibunitsym : sym:=cunitsym.ppuload(ppufile);
|
|
iblabelsym : sym:=clabelsym.ppuload(ppufile);
|
|
ibsyssym : sym:=csyssym.ppuload(ppufile);
|
|
ibmacrosym : sym:=tmacro.ppuload(ppufile);
|
|
ibnamespacesym : sym:=cnamespacesym.ppuload(ppufile);
|
|
ibendsyms : break;
|
|
ibend : Message(unit_f_ppu_read_error);
|
|
else
|
|
Message1(unit_f_ppu_invalid_entry,tostr(b));
|
|
end;
|
|
Insert(sym,false);
|
|
until false;
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.writedefs(ppufile:tcompilerppufile);
|
|
var
|
|
defcount,
|
|
i : longint;
|
|
def : tstoreddef;
|
|
begin
|
|
defcount:=0;
|
|
for i:=0 to DefList.Count-1 do
|
|
if tstoreddef(DefList[i]).is_registered then
|
|
inc(defcount);
|
|
{ each definition get a number, write then the amount of defs to the
|
|
ibstartdef entry }
|
|
ppufile.putlongint(defcount);
|
|
ppufile.writeentry(ibstartdefs);
|
|
{ now write the definition }
|
|
for i:=0 to DefList.Count-1 do
|
|
begin
|
|
def:=tstoreddef(DefList[i]);
|
|
if def.is_registered then
|
|
def.ppuwrite(ppufile);
|
|
end;
|
|
{ write end of definitions }
|
|
ppufile.writeentry(ibenddefs);
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.writesyms(ppufile:tcompilerppufile);
|
|
var
|
|
symcount,
|
|
i : longint;
|
|
sym : Tstoredsym;
|
|
begin
|
|
symcount:=0;
|
|
for i:=0 to SymList.Count-1 do
|
|
if tstoredsym(SymList[i]).is_registered then
|
|
inc(symcount);
|
|
{ each definition get a number, write then the amount of syms and the
|
|
datasize to the ibsymdef entry }
|
|
ppufile.putlongint(symcount);
|
|
ppufile.writeentry(ibstartsyms);
|
|
{ foreach is used to write all symbols }
|
|
for i:=0 to SymList.Count-1 do
|
|
begin
|
|
sym:=tstoredsym(SymList[i]);
|
|
if sym.is_registered then
|
|
sym.ppuwrite(ppufile);
|
|
end;
|
|
{ end of symbols }
|
|
ppufile.writeentry(ibendsyms);
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.buildderef;
|
|
var
|
|
i : longint;
|
|
def : tstoreddef;
|
|
sym : tstoredsym;
|
|
begin
|
|
{ interface definitions }
|
|
for i:=0 to DefList.Count-1 do
|
|
begin
|
|
def:=tstoreddef(DefList[i]);
|
|
def.buildderef;
|
|
end;
|
|
{ interface symbols }
|
|
for i:=0 to SymList.Count-1 do
|
|
begin
|
|
sym:=tstoredsym(SymList[i]);
|
|
sym.buildderef;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.buildderefimpl;
|
|
var
|
|
i : longint;
|
|
def : tstoreddef;
|
|
begin
|
|
{ implementation definitions }
|
|
for i:=0 to DefList.Count-1 do
|
|
begin
|
|
def:=tstoreddef(DefList[i]);
|
|
def.buildderefimpl;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.buildderef_registered;
|
|
var
|
|
def : tstoreddef;
|
|
sym : tstoredsym;
|
|
i : longint;
|
|
defidmax,
|
|
symidmax: longint;
|
|
newbuiltdefderefs,
|
|
builtdefderefs,
|
|
builtsymderefs: array of boolean;
|
|
begin
|
|
newbuiltdefderefs:=nil;
|
|
builtdefderefs:=nil;
|
|
builtsymderefs:=nil;
|
|
{ tdefs for which we already built the deref }
|
|
setlength(builtdefderefs,deflist.count);
|
|
{ tdefs for which we built the deref in this iteration }
|
|
setlength(newbuiltdefderefs,deflist.count);
|
|
{ syms for which we already built the deref }
|
|
setlength(builtsymderefs,symlist.count);
|
|
repeat
|
|
{ we only have to store the defs (recursively) referred by wpo info
|
|
or inlined routines in the static symbtable }
|
|
|
|
{ current number of registered defs/syms }
|
|
defidmax:=current_module.deflist.count;
|
|
symidmax:=current_module.symlist.count;
|
|
|
|
{ build the derefs for the registered defs we haven't processed yet }
|
|
for i:=0 to DefList.Count-1 do
|
|
begin
|
|
if not builtdefderefs[i] then
|
|
begin
|
|
def:=tstoreddef(DefList[i]);
|
|
if def.is_registered then
|
|
begin
|
|
def.buildderef;
|
|
newbuiltdefderefs[i]:=true;
|
|
builtdefderefs[i]:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
{ same for the syms }
|
|
for i:=0 to SymList.Count-1 do
|
|
begin
|
|
if not builtsymderefs[i] then
|
|
begin
|
|
sym:=tstoredsym(SymList[i]);
|
|
if sym.is_registered then
|
|
begin
|
|
sym.buildderef;
|
|
builtsymderefs[i]:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
{ now buildderefimpl for the defs we processed in this iteration }
|
|
for i:=0 to DefList.Count-1 do
|
|
begin
|
|
if newbuiltdefderefs[i] then
|
|
begin
|
|
newbuiltdefderefs[i]:=false;
|
|
tstoreddef(DefList[i]).buildderefimpl;
|
|
end;
|
|
end;
|
|
{ stop when no new defs or syms have been registered while processing
|
|
the currently registered ones (defs/syms get added to the module's
|
|
deflist/symlist when they are registered) }
|
|
until
|
|
(defidmax=current_module.deflist.count) and
|
|
(symidmax=current_module.symlist.count);
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.deref(only_registered: boolean);
|
|
var
|
|
i : longint;
|
|
def : tstoreddef;
|
|
sym : tstoredsym;
|
|
begin
|
|
{ first deref the interface ttype symbols. This is needs
|
|
to be done before the interface defs are derefed, because
|
|
the interface defs can contain references to the type symbols
|
|
which then already need to contain a resolved typedef field (PFV) }
|
|
for i:=0 to SymList.Count-1 do
|
|
begin
|
|
sym:=tstoredsym(SymList[i]);
|
|
if (sym.typ=typesym) and
|
|
(not only_registered or
|
|
sym.is_registered) then
|
|
sym.deref;
|
|
end;
|
|
{ interface definitions }
|
|
for i:=0 to DefList.Count-1 do
|
|
begin
|
|
def:=tstoreddef(DefList[i]);
|
|
if not only_registered or
|
|
def.is_registered then
|
|
def.deref;
|
|
end;
|
|
{ interface symbols }
|
|
for i:=0 to SymList.Count-1 do
|
|
begin
|
|
sym:=tstoredsym(SymList[i]);
|
|
if (not only_registered or
|
|
sym.is_registered) and
|
|
(sym.typ<>typesym) then
|
|
sym.deref;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.derefimpl(only_registered: boolean);
|
|
var
|
|
i : longint;
|
|
def : tstoreddef;
|
|
begin
|
|
{ implementation definitions }
|
|
for i:=0 to DefList.Count-1 do
|
|
begin
|
|
def:=tstoreddef(DefList[i]);
|
|
if not only_registered or
|
|
def.is_registered then
|
|
def.derefimpl;
|
|
end;
|
|
end;
|
|
|
|
|
|
function tstoredsymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;
|
|
var
|
|
hsym : tsym;
|
|
begin
|
|
hsym:=tsym(FindWithHash(hashedid));
|
|
if assigned(hsym) then
|
|
DuplicateSym(hashedid,sym,hsym,false);
|
|
result:=assigned(hsym);
|
|
end;
|
|
|
|
|
|
{**************************************
|
|
Callbacks
|
|
**************************************}
|
|
|
|
procedure TStoredSymtable.check_forward(sym:TObject;arg:pointer);
|
|
begin
|
|
if tsym(sym).typ=procsym then
|
|
tprocsym(sym).check_forward
|
|
{ check also object method table }
|
|
{ we needn't to test the def list }
|
|
{ because each object has to have a type sym,
|
|
only test objects declarations, not type renamings }
|
|
else
|
|
if (tsym(sym).typ=typesym) and
|
|
assigned(ttypesym(sym).typedef) and
|
|
(ttypesym(sym).typedef.typesym=ttypesym(sym)) and
|
|
(ttypesym(sym).typedef.typ in [objectdef,recorddef]) then
|
|
tabstractrecorddef(ttypesym(sym).typedef).check_forwards;
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.check_block_valid(def: TObject; arg: pointer);
|
|
var
|
|
founderrordef: tdef;
|
|
begin
|
|
{ all parameters passed to a block must be handled by the Objective-C
|
|
runtime }
|
|
if is_block(tdef(def)) and
|
|
not objcchecktype(tdef(def),founderrordef) then
|
|
if assigned(tdef(def).typesym) then
|
|
MessagePos1(tdef(def).typesym.fileinfo,type_e_objc_type_unsupported,founderrordef.typename)
|
|
else
|
|
Message1(type_e_objc_type_unsupported,tprocvardef(def).typename)
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.register_syms(sym:tobject;arg:pointer);
|
|
begin
|
|
tsym(sym).register_sym;
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.register_defs(def:tobject;arg:pointer);
|
|
begin
|
|
tdef(def).register_def;
|
|
end;
|
|
|
|
|
|
procedure TStoredSymtable.labeldefined(sym:TObject;arg:pointer);
|
|
begin
|
|
if (tsym(sym).typ=labelsym) and
|
|
not(tlabelsym(sym).defined) then
|
|
begin
|
|
if tlabelsym(sym).used then
|
|
Message1(sym_e_label_used_and_not_defined,tlabelsym(sym).realname)
|
|
else
|
|
Message1(sym_w_label_not_defined,tlabelsym(sym).realname);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TStoredSymtable.varsymbolused(sym:TObject;arg:pointer);
|
|
begin
|
|
if (tsym(sym).typ in [staticvarsym,localvarsym,paravarsym,fieldvarsym]) and
|
|
((tsym(sym).owner.symtabletype in
|
|
[parasymtable,localsymtable,ObjectSymtable,recordsymtable,staticsymtable])) then
|
|
begin
|
|
{ unused symbol should be reported only if no }
|
|
{ error is reported }
|
|
{ if the symbol is in a register it is used }
|
|
{ also don't count the value parameters which have local copies }
|
|
{ also don't claim for high param of open parameters (PM) }
|
|
{ also don't complain about unused symbols in generic procedures }
|
|
{ and methods }
|
|
{ and neither in abstract methods }
|
|
if (Errorcount<>0) or
|
|
([vo_is_hidden_para,vo_is_funcret] * tabstractvarsym(sym).varoptions = [vo_is_hidden_para]) or
|
|
(sp_internal in tsym(sym).symoptions) or
|
|
((assigned(tsym(sym).owner.defowner) and
|
|
(tsym(sym).owner.defowner.typ=procdef) and
|
|
((df_generic in tprocdef(tsym(sym).owner.defowner).defoptions) or
|
|
(po_abstractmethod in tprocdef(tsym(sym).owner.defowner).procoptions)))) then
|
|
exit;
|
|
if (tstoredsym(sym).refs=0) then
|
|
begin
|
|
if (vo_is_funcret in tabstractvarsym(sym).varoptions) then
|
|
begin
|
|
{ don't warn about the result of constructors }
|
|
if ((tsym(sym).owner.symtabletype<>localsymtable) or
|
|
(tprocdef(tsym(sym).owner.defowner).proctypeoption<>potype_constructor)) and
|
|
not (po_noreturn in tprocdef(tsym(sym).owner.defowner).procoptions) and
|
|
not(cs_opt_nodedfa in current_settings.optimizerswitches) then
|
|
MessagePos(tsym(sym).fileinfo,sym_w_function_result_not_set)
|
|
end
|
|
else if (tsym(sym).owner.symtabletype=parasymtable) then
|
|
MessagePos1(tsym(sym).fileinfo,sym_h_para_identifier_not_used,tsym(sym).prettyname)
|
|
else if (tsym(sym).owner.symtabletype in [ObjectSymtable,recordsymtable]) then
|
|
MessagePos2(tsym(sym).fileinfo,sym_n_private_identifier_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname)
|
|
else
|
|
MessagePos1(tsym(sym).fileinfo,sym_n_local_identifier_not_used,tsym(sym).prettyname);
|
|
end
|
|
else if tabstractvarsym(sym).varstate in [vs_written,vs_initialised] then
|
|
begin
|
|
if (tsym(sym).owner.symtabletype=parasymtable) then
|
|
begin
|
|
if not(tabstractvarsym(sym).varspez in [vs_var,vs_out,vs_constref]) and
|
|
not(vo_is_funcret in tabstractvarsym(sym).varoptions) then
|
|
MessagePos1(tsym(sym).fileinfo,sym_h_para_identifier_only_set,tsym(sym).prettyname)
|
|
end
|
|
else if (tsym(sym).owner.symtabletype in [ObjectSymtable,recordsymtable]) then
|
|
MessagePos2(tsym(sym).fileinfo,sym_n_private_identifier_only_set,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname)
|
|
else if tabstractvarsym(sym).varoptions*[vo_is_funcret,vo_is_public,vo_is_external]=[] then
|
|
MessagePos1(tsym(sym).fileinfo,sym_n_local_identifier_only_set,tsym(sym).prettyname);
|
|
end
|
|
else if (tabstractvarsym(sym).varstate = vs_read_not_warned) and
|
|
([vo_is_public,vo_is_external] * tabstractvarsym(sym).varoptions = []) then
|
|
MessagePos1(tsym(sym).fileinfo,sym_w_identifier_only_read,tsym(sym).prettyname)
|
|
end
|
|
else if ((tsym(sym).owner.symtabletype in
|
|
[ObjectSymtable,parasymtable,localsymtable,staticsymtable,recordsymtable])) then
|
|
begin
|
|
if (Errorcount<>0) or
|
|
(sp_internal in tsym(sym).symoptions) then
|
|
exit;
|
|
{ do not claim for inherited private fields !! }
|
|
if (tsym(sym).refs=0) and (tsym(sym).owner.symtabletype in [ObjectSymtable,recordsymtable]) then
|
|
case tsym(sym).typ of
|
|
typesym:
|
|
MessagePos2(tsym(sym).fileinfo,sym_n_private_type_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname);
|
|
constsym:
|
|
MessagePos2(tsym(sym).fileinfo,sym_n_private_const_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname);
|
|
propertysym:
|
|
MessagePos2(tsym(sym).fileinfo,sym_n_private_property_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname);
|
|
else
|
|
MessagePos2(tsym(sym).fileinfo,sym_n_private_method_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname);
|
|
end
|
|
{ units references are problematic }
|
|
else
|
|
begin
|
|
if (tsym(sym).refs=0) and
|
|
not(tsym(sym).typ in [enumsym,unitsym,namespacesym]) and
|
|
not(is_funcret_sym(tsym(sym))) and
|
|
{ don't complain about compiler generated syms for specializations, see also #13405 }
|
|
not((tsym(sym).typ=typesym) and (df_specialization in ttypesym(sym).typedef.defoptions) and
|
|
(pos('$',ttypesym(sym).Realname)<>0)) and
|
|
(
|
|
(tsym(sym).typ<>procsym) or
|
|
((tsym(sym).owner.symtabletype=staticsymtable) and
|
|
not current_module.is_unit)
|
|
) and
|
|
{ don't complain about alias for hidden _cmd parameter to
|
|
obj-c methods }
|
|
not((tsym(sym).typ in [localvarsym,paravarsym,absolutevarsym]) and
|
|
(vo_is_msgsel in tabstractvarsym(sym).varoptions)) then
|
|
MessagePos2(tsym(sym).fileinfo,sym_h_local_symbol_not_used,SymTypeName[tsym(sym).typ],tsym(sym).prettyname);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TStoredSymtable.TestPrivate(sym:TObject;arg:pointer);
|
|
begin
|
|
if tsym(sym).visibility in [vis_private,vis_strictprivate] then
|
|
varsymbolused(sym,arg);
|
|
end;
|
|
|
|
|
|
procedure TStoredSymtable.objectprivatesymbolused(sym:TObject;arg:pointer);
|
|
begin
|
|
{
|
|
Don't test simple object aliases PM
|
|
}
|
|
if (tsym(sym).typ=typesym) and
|
|
(ttypesym(sym).typedef.typ in [objectdef,recorddef]) and
|
|
(ttypesym(sym).typedef.typesym=tsym(sym)) then
|
|
tabstractrecorddef(ttypesym(sym).typedef).symtable.SymList.ForEachCall(@TestPrivate,nil);
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.testfordefaultproperty(sym:TObject;arg:pointer);
|
|
begin
|
|
if (tsym(sym).typ=propertysym) and
|
|
(ppo_defaultproperty in tpropertysym(sym).propoptions) then
|
|
ppointer(arg)^:=sym;
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.register_children;
|
|
begin
|
|
SymList.ForEachCall(@register_syms,nil);
|
|
DefList.ForEachCall(@register_defs,nil);
|
|
end;
|
|
|
|
|
|
{***********************************************
|
|
Process all entries
|
|
***********************************************}
|
|
|
|
{ checks, if all procsyms and methods are defined }
|
|
procedure tstoredsymtable.check_forwards;
|
|
begin
|
|
SymList.ForEachCall(@check_forward,nil);
|
|
{ check whether all block definitions contain valid Objective-C types
|
|
(now that all forward definitions have been resolved) }
|
|
DefList.ForEachCall(@check_block_valid,nil);
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.checklabels;
|
|
begin
|
|
SymList.ForEachCall(@labeldefined,nil);
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.allsymbolsused;
|
|
begin
|
|
SymList.ForEachCall(@varsymbolused,nil);
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.allprivatesused;
|
|
begin
|
|
SymList.ForEachCall(@objectprivatesymbolused,nil);
|
|
end;
|
|
|
|
|
|
procedure TStoredSymtable._needs_init_final(sym:TObject;arg:pointer);
|
|
begin
|
|
if [sto_needs_init_final,sto_has_non_trivial_init] <= tableoptions then
|
|
exit;
|
|
{ don't check static symbols - they can be present in structures only and
|
|
always have a reference to a symbol defined on unit level }
|
|
if sp_static in tsym(sym).symoptions then
|
|
exit;
|
|
case tsym(sym).typ of
|
|
fieldvarsym,
|
|
staticvarsym,
|
|
localvarsym,
|
|
paravarsym :
|
|
begin
|
|
if assigned(tabstractvarsym(sym).vardef) and
|
|
is_managed_type(tabstractvarsym(sym).vardef) then
|
|
include(tableoptions,sto_needs_init_final);
|
|
if is_record((tabstractvarsym(sym).vardef)) and
|
|
(mop_initialize in trecordsymtable(trecorddef(tabstractvarsym(sym).vardef).symtable).managementoperators) then
|
|
include(tableoptions,sto_has_non_trivial_init);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tstoredsymtable.do_init_final_check;
|
|
begin
|
|
if not init_final_check_done then
|
|
begin
|
|
exclude(tableoptions,sto_needs_init_final);
|
|
exclude(tableoptions,sto_has_non_trivial_init);
|
|
SymList.ForEachCall(@_needs_init_final,nil);
|
|
init_final_check_done:=true;
|
|
end;
|
|
end;
|
|
|
|
{ returns true, if p contains data which needs init/final code }
|
|
function tstoredsymtable.needs_init_final : boolean;
|
|
begin
|
|
do_init_final_check;
|
|
result:=sto_needs_init_final in tableoptions;
|
|
end;
|
|
|
|
|
|
function tstoredsymtable.has_non_trivial_init:boolean;
|
|
begin
|
|
do_init_final_check;
|
|
result:=sto_has_non_trivial_init in tableoptions;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TAbstractRecordSymtable
|
|
****************************************************************************}
|
|
|
|
{$ifdef llvm}
|
|
function tabstractrecordsymtable.getllvmshadowsymtabll: tllvmshadowsymtable;
|
|
begin
|
|
if not assigned(fllvmst) then
|
|
fllvmst:=tllvmshadowsymtable.create(self);
|
|
result:=fllvmst;
|
|
end;
|
|
{$endif llvm}
|
|
|
|
constructor tabstractrecordsymtable.create(const n:string;usealign,recordminalign,recordmaxCalign:shortint);
|
|
begin
|
|
inherited create(n);
|
|
_datasize:=0;
|
|
databitsize:=0;
|
|
recordalignment:=1;
|
|
usefieldalignment:=usealign;
|
|
recordalignmin:=recordminalign;
|
|
maxCrecordalign:=recordmaxCalign;
|
|
padalignment:=1;
|
|
{ recordalign C_alignment means C record packing, that starts
|
|
with an alignment of 1 }
|
|
case usealign of
|
|
C_alignment,
|
|
bit_alignment:
|
|
fieldalignment:=1;
|
|
mac68k_alignment:
|
|
fieldalignment:=2;
|
|
else
|
|
fieldalignment:=usealign;
|
|
end;
|
|
end;
|
|
|
|
|
|
destructor tabstractrecordsymtable.destroy;
|
|
|
|
{ for some reason a compiler built with 3.3.1 fails building the libxml2
|
|
package if the below define is not defined and thus the code snippet is
|
|
part of the destructor itself and not a nested procedure; until that bug
|
|
is fixed this is used as a workaround :/ }
|
|
{$define codegen_workaround}
|
|
{$ifdef codegen_workaround}
|
|
procedure free_mop_list(mop:tmanagementoperator);
|
|
var
|
|
i : longint;
|
|
begin
|
|
if assigned(mop_list[mop]) then
|
|
for i:=0 to mop_list[mop].count-1 do
|
|
dispose(pmanagementoperator_offset_entry(mop_list[mop][i]));
|
|
mop_list[mop].free;
|
|
end;
|
|
{$endif codegen_workaround}
|
|
|
|
var
|
|
mop : tmanagementoperator;
|
|
{$ifndef codegen_workaround}
|
|
i : longint;
|
|
{$endif codegen_workaround}
|
|
begin
|
|
if refcount>1 then
|
|
exit;
|
|
{$ifdef llvm}
|
|
fllvmst.free;
|
|
{$endif llvm}
|
|
for mop:=low(tmanagementoperator) to high(tmanagementoperator) do
|
|
begin
|
|
{$ifdef codegen_workaround}
|
|
free_mop_list(mop);
|
|
{$else codegen_workaround}
|
|
if assigned(mop_list[mop]) then
|
|
for i:=0 to mop_list[mop].count-1 do
|
|
dispose(pmanagementoperator_offset_entry(mop_list[mop][i]));
|
|
mop_list[mop].free;
|
|
{$endif codegen_workaround}
|
|
end;
|
|
inherited destroy;
|
|
end;
|
|
|
|
|
|
procedure tabstractrecordsymtable.ppuload(ppufile:tcompilerppufile);
|
|
begin
|
|
if ppufile.readentry<>ibrecsymtableoptions then
|
|
Message(unit_f_ppu_read_error);
|
|
recordalignment:=shortint(ppufile.getbyte);
|
|
usefieldalignment:=shortint(ppufile.getbyte);
|
|
recordalignmin:=shortint(ppufile.getbyte);
|
|
if (usefieldalignment=C_alignment) then
|
|
fieldalignment:=shortint(ppufile.getbyte);
|
|
ppufile.getsmallset(has_fields_with_mop);
|
|
inherited ppuload(ppufile);
|
|
end;
|
|
|
|
|
|
procedure tabstractrecordsymtable.ppuwrite(ppufile:tcompilerppufile);
|
|
var
|
|
oldtyp : byte;
|
|
begin
|
|
oldtyp:=ppufile.entrytyp;
|
|
ppufile.entrytyp:=subentryid;
|
|
{ in case of classes using C alignment, the alignment of the parent
|
|
affects the alignment of fields of the childs }
|
|
ppufile.putbyte(byte(recordalignment));
|
|
ppufile.putbyte(byte(usefieldalignment));
|
|
ppufile.putbyte(byte(recordalignmin));
|
|
if (usefieldalignment=C_alignment) then
|
|
ppufile.putbyte(byte(fieldalignment));
|
|
{ it's not really a "symtableoption", but loading this from the record
|
|
def requires storing the set in the recorddef at least between
|
|
ppuload and deref/derefimpl }
|
|
ppufile.putsmallset(has_fields_with_mop);
|
|
ppufile.writeentry(ibrecsymtableoptions);
|
|
|
|
inherited ppuwrite(ppufile);
|
|
|
|
ppufile.entrytyp:=oldtyp;
|
|
end;
|
|
|
|
|
|
function field2recordalignment(fieldoffs, fieldalign: asizeint): asizeint;
|
|
begin
|
|
{ optimal alignment of the record when declaring a variable of this }
|
|
{ type is independent of the packrecords setting }
|
|
if (fieldoffs mod fieldalign) = 0 then
|
|
result:=fieldalign
|
|
else if (fieldalign >= 16) and
|
|
((fieldoffs mod 16) = 0) and
|
|
((fieldalign mod 16) = 0) then
|
|
result:=16
|
|
else if (fieldalign >= 8) and
|
|
((fieldoffs mod 8) = 0) and
|
|
((fieldalign mod 8) = 0) then
|
|
result:=8
|
|
else if (fieldalign >= 4) and
|
|
((fieldoffs mod 4) = 0) and
|
|
((fieldalign mod 4) = 0) then
|
|
result:=4
|
|
else if (fieldalign >= 2) and
|
|
((fieldoffs mod 2) = 0) and
|
|
((fieldalign mod 2) = 0) then
|
|
result:=2
|
|
else
|
|
result:=1;
|
|
end;
|
|
|
|
procedure tabstractrecordsymtable.alignrecord(fieldoffset:asizeint;varalign:shortint);
|
|
var
|
|
varalignrecord: shortint;
|
|
begin
|
|
case usefieldalignment of
|
|
C_alignment:
|
|
varalignrecord:=used_align(varalign,recordalignmin,maxCrecordalign);
|
|
mac68k_alignment:
|
|
varalignrecord:=2;
|
|
else
|
|
varalignrecord:=field2recordalignment(fieldoffset,varalign);
|
|
end;
|
|
recordalignment:=max(recordalignment,varalignrecord);
|
|
end;
|
|
|
|
procedure tabstractrecordsymtable.addfield(sym:tfieldvarsym;vis:tvisibility);
|
|
var
|
|
l : asizeint;
|
|
varalign : shortint;
|
|
vardef : tdef;
|
|
begin
|
|
if (sym.owner<>self) then
|
|
internalerror(200602031);
|
|
if sym.fieldoffset<>-1 then
|
|
internalerror(200602032);
|
|
{ set visibility for the symbol }
|
|
sym.visibility:=vis;
|
|
{ this symbol can't be loaded to a register }
|
|
sym.varregable:=vr_none;
|
|
{ management operators }
|
|
if sym.vardef.typ in [recorddef,objectdef] then
|
|
has_fields_with_mop:=has_fields_with_mop + tabstractrecordsymtable(tabstractrecorddef(sym.vardef).symtable).has_fields_with_mop;
|
|
if sym.vardef.typ=recorddef then
|
|
has_fields_with_mop:=has_fields_with_mop + trecordsymtable(trecorddef(sym.vardef).symtable).managementoperators;
|
|
{ Calculate field offset }
|
|
l:=sym.getsize;
|
|
vardef:=sym.vardef;
|
|
varalign:=vardef.structalignment;
|
|
case usefieldalignment of
|
|
bit_alignment:
|
|
begin
|
|
{ bitpacking only happens for ordinals, the rest is aligned at }
|
|
{ 1 byte (compatible with GPC/GCC) }
|
|
if is_ordinal(vardef) then
|
|
begin
|
|
sym.fieldoffset:=databitsize;
|
|
l:=sym.getpackedbitsize;
|
|
end
|
|
else
|
|
begin
|
|
databitsize:=_datasize*8;
|
|
sym.fieldoffset:=databitsize;
|
|
if (l>high(asizeint) div 8) then
|
|
Message(sym_e_segment_too_large);
|
|
l:=l*8;
|
|
end;
|
|
if varalign=0 then
|
|
varalign:=size_2_align(l);
|
|
recordalignment:=max(recordalignment,field2recordalignment(databitsize mod 8,varalign));
|
|
{ bit packed records are limited to high(aint) bits }
|
|
{ instead of bytes to avoid double precision }
|
|
{ arithmetic in offset calculations }
|
|
if int64(l)>high(asizeint)-sym.fieldoffset then
|
|
begin
|
|
Message(sym_e_segment_too_large);
|
|
_datasize:=high(asizeint);
|
|
databitsize:=high(asizeint);
|
|
end
|
|
else
|
|
begin
|
|
databitsize:=sym.fieldoffset+l;
|
|
_datasize:=(databitsize+7) div 8;
|
|
end;
|
|
{ rest is not applicable }
|
|
exit;
|
|
end;
|
|
else
|
|
begin
|
|
sym.fieldoffset:=getfieldoffset(sym,_datasize,fieldalignment);
|
|
if l>high(asizeint)-sym.fieldoffset then
|
|
begin
|
|
Message(sym_e_segment_too_large);
|
|
_datasize:=high(asizeint);
|
|
end
|
|
else
|
|
_datasize:=sym.fieldoffset+l;
|
|
{ Calc alignment needed for this record }
|
|
alignrecord(sym.fieldoffset,varalign);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function field_alignment_compare(item1, item2: pointer): integer;
|
|
var
|
|
field1: tfieldvarsym absolute item1;
|
|
field2: tfieldvarsym absolute item2;
|
|
begin
|
|
{ we don't care about static fields, those become global variables }
|
|
if (sp_static in field1.symoptions) or
|
|
(sp_static in field2.symoptions) then
|
|
exit(0);
|
|
{ sort from large to small alignment, and in case of the same alignment
|
|
in declaration order (items declared close together are possibly
|
|
also related and hence possibly used together -> putting them next
|
|
to each other can improve cache behaviour) }
|
|
result:=field2.vardef.alignment-field1.vardef.alignment;
|
|
if result=0 then
|
|
result:=field1.fieldoffset-field2.fieldoffset;
|
|
end;
|
|
|
|
|
|
procedure tabstractrecordsymtable.addfieldlist(list: tfpobjectlist; maybereorder: boolean);
|
|
var
|
|
fieldvs, insertfieldvs: tfieldvarsym;
|
|
base, fieldoffset, space, insertfieldsize, insertfieldoffset, bestinsertfieldoffset, bestspaceleft: asizeint;
|
|
i, j, bestfieldindex: longint;
|
|
globalfieldalignment,
|
|
prevglobalfieldalignment,
|
|
newfieldalignment: shortint;
|
|
changed: boolean;
|
|
begin
|
|
if maybereorder and
|
|
(cs_opt_reorder_fields in current_settings.optimizerswitches) then
|
|
begin
|
|
{ assign dummy field offsets so we can know their order in the
|
|
sorting routine }
|
|
for i:=0 to list.count-1 do
|
|
tfieldvarsym(list[i]).fieldoffset:=i;
|
|
{ sort the non-class fields to minimise losses due to alignment }
|
|
list.sort(@field_alignment_compare);
|
|
{ now fill up gaps caused by alignment skips with smaller fields
|
|
where possible }
|
|
repeat
|
|
i:=0;
|
|
base:=_datasize;
|
|
globalfieldalignment:=fieldalignment;
|
|
changed:=false;
|
|
while i<list.count do
|
|
begin
|
|
fieldvs:=tfieldvarsym(list[i]);
|
|
if sp_static in fieldvs.symoptions then
|
|
begin
|
|
inc(i);
|
|
continue;
|
|
end;
|
|
prevglobalfieldalignment:=globalfieldalignment;
|
|
fieldoffset:=getfieldoffset(fieldvs,base,globalfieldalignment);
|
|
newfieldalignment:=globalfieldalignment;
|
|
|
|
{ size of the gap between the end of the previous field and
|
|
the start of the current one }
|
|
space:=fieldoffset-base;
|
|
bestspaceleft:=space;
|
|
while space>0 do
|
|
begin
|
|
bestfieldindex:=-1;
|
|
bestinsertfieldoffset:=-1;
|
|
for j:=i+1 to list.count-1 do
|
|
begin
|
|
insertfieldvs:=tfieldvarsym(list[j]);
|
|
if sp_static in insertfieldvs.symoptions then
|
|
continue;
|
|
insertfieldsize:=insertfieldvs.getsize;
|
|
{ can the new field fit possibly in the gap? }
|
|
if insertfieldsize<=space then
|
|
begin
|
|
{ restore globalfieldalignment to situation before
|
|
the original field was inserted }
|
|
globalfieldalignment:=prevglobalfieldalignment;
|
|
{ at what offset would it be inserted? (this new
|
|
field has its own alignment requirements, which
|
|
may make it impossible to fit after all) }
|
|
insertfieldoffset:=getfieldoffset(insertfieldvs,base,globalfieldalignment);
|
|
globalfieldalignment:=prevglobalfieldalignment;
|
|
{ taking into account the alignment, does it still
|
|
fit and if so, does it fit better than the
|
|
previously found best fit? }
|
|
if (insertfieldoffset+insertfieldsize<=fieldoffset) and
|
|
(fieldoffset-insertfieldoffset-insertfieldsize<bestspaceleft) then
|
|
begin
|
|
{ new best fit }
|
|
bestfieldindex:=j;
|
|
bestinsertfieldoffset:=insertfieldoffset;
|
|
bestspaceleft:=fieldoffset-insertfieldoffset-insertfieldsize;
|
|
if bestspaceleft=0 then
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
{ if we didn't find any field to fit, stop trying for this
|
|
gap }
|
|
if bestfieldindex=-1 then
|
|
break;
|
|
changed:=true;
|
|
{ we found a field to insert -> adjust the new base
|
|
address }
|
|
base:=bestinsertfieldoffset+tfieldvarsym(list[bestfieldindex]).getsize;
|
|
{ update globalfieldalignment for this newly inserted
|
|
field }
|
|
getfieldoffset(tfieldvarsym(list[bestfieldindex]),base,globalfieldalignment);
|
|
{ move the new field before the current one }
|
|
list.move(bestfieldindex,i);
|
|
{ and skip the new field (which is now at position i) }
|
|
inc(i);
|
|
{ there may be more space left -> continue }
|
|
space:=bestspaceleft;
|
|
end;
|
|
if base>fieldoffset then
|
|
internalerror(2012071302);
|
|
{ check the next field }
|
|
base:=fieldoffset+fieldvs.getsize;
|
|
{ since the original field had the same or greater alignment
|
|
than anything we inserted before it, the global field
|
|
alignment is still the same now as it was originally after
|
|
inserting that field }
|
|
globalfieldalignment:=newfieldalignment;
|
|
inc(i);
|
|
end;
|
|
{ there may be small gaps left *before* inserted fields }
|
|
until not changed;
|
|
end;
|
|
{ reset the dummy field offsets }
|
|
for i:=0 to list.count-1 do
|
|
tfieldvarsym(list[i]).fieldoffset:=-1;
|
|
{ finally, set the actual field offsets }
|
|
for i:=0 to list.count-1 do
|
|
begin
|
|
fieldvs:=tfieldvarsym(list[i]);
|
|
{ static data fields are already inserted in the globalsymtable }
|
|
if not(sp_static in fieldvs.symoptions) then
|
|
begin
|
|
{ read_record_fields already set the visibility of the fields,
|
|
because a single list can contain symbols with different
|
|
visibility }
|
|
addfield(fieldvs,fieldvs.visibility);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function tabstractrecordsymtable.findfieldbyoffset(offset: asizeint): tfieldvarsym;
|
|
var
|
|
i: longint;
|
|
sym: tsym;
|
|
begin
|
|
{ there could be multiple fields in case of a variant record }
|
|
if (defowner.typ=recorddef) and
|
|
trecorddef(defowner).isunion then
|
|
internalerror(2014090403);
|
|
for i:=0 to SymList.count-1 do
|
|
begin
|
|
sym:=tsym(symlist[i]);
|
|
if (sym.typ=fieldvarsym) and
|
|
not(sp_static in sym.symoptions) and
|
|
(tfieldvarsym(sym).fieldoffset>=offset) then
|
|
begin
|
|
result:=tfieldvarsym(sym);
|
|
exit;
|
|
end;
|
|
end;
|
|
result:=nil;
|
|
end;
|
|
|
|
|
|
procedure tabstractrecordsymtable.addalignmentpadding;
|
|
var
|
|
padded_datasize: asizeint;
|
|
begin
|
|
{ make the record size aligned correctly so it can be
|
|
used as elements in an array. For C records we
|
|
use the fieldalignment, because that is updated with the
|
|
used alignment. }
|
|
if (padalignment = 1) then
|
|
case usefieldalignment of
|
|
C_alignment:
|
|
padalignment:=fieldalignment;
|
|
{ bitpacked }
|
|
bit_alignment:
|
|
padalignment:=1;
|
|
{ mac68k: always round to multiple of 2 }
|
|
mac68k_alignment:
|
|
padalignment:=2;
|
|
{ default/no packrecords specified }
|
|
0:
|
|
padalignment:=recordalignment
|
|
{ specific packrecords setting -> use as upper limit }
|
|
else
|
|
padalignment:=min(recordalignment,usefieldalignment);
|
|
end;
|
|
padded_datasize:=align(_datasize,padalignment);
|
|
_paddingsize:=padded_datasize-_datasize;
|
|
_datasize:=padded_datasize;
|
|
end;
|
|
|
|
|
|
procedure tabstractrecordsymtable.insertdef(def:TDefEntry);
|
|
begin
|
|
{ Enums must also be available outside the record scope,
|
|
insert in the owner of this symtable }
|
|
if def.typ=enumdef then
|
|
defowner.owner.insertdef(def)
|
|
else
|
|
inherited insertdef(def);
|
|
end;
|
|
|
|
|
|
function tabstractrecordsymtable.is_packed: boolean;
|
|
begin
|
|
result:=usefieldalignment=bit_alignment;
|
|
end;
|
|
|
|
|
|
function tabstractrecordsymtable.has_single_field(out def:tdef): boolean;
|
|
var
|
|
i: longint;
|
|
currentsymlist: TFPHashObjectList;
|
|
currentdef: tdef;
|
|
sym: tfieldvarsym;
|
|
begin
|
|
result:=false;
|
|
{ If a record contains a union, it does not contain a "single
|
|
non-composite field" in the context of certain ABIs requiring
|
|
special treatment for such records }
|
|
if (defowner.typ=recorddef) and
|
|
trecorddef(defowner).isunion then
|
|
exit;
|
|
{ a record/object can contain other things than fields }
|
|
currentsymlist:=symlist;
|
|
{ recurse in arrays and records }
|
|
sym:=nil;
|
|
repeat
|
|
{ record has one field? }
|
|
for i:=0 to currentsymlist.Count-1 do
|
|
begin
|
|
if (tsym(currentsymlist[i]).typ=fieldvarsym) and
|
|
not(sp_static in tsym(currentsymlist[i]).symoptions) then
|
|
begin
|
|
if result then
|
|
begin
|
|
result:=false;
|
|
exit;
|
|
end;
|
|
result:=true;
|
|
sym:=tfieldvarsym(currentsymlist[i])
|
|
end;
|
|
end;
|
|
if assigned(sym) then
|
|
begin
|
|
{ if the field is an array, does it contain one element? }
|
|
currentdef:=sym.vardef;
|
|
while (currentdef.typ=arraydef) and
|
|
not is_special_array(currentdef) do
|
|
begin
|
|
if tarraydef(currentdef).elecount<>1 then
|
|
begin
|
|
result:=false;
|
|
exit;
|
|
end;
|
|
currentdef:=tarraydef(currentdef).elementdef;
|
|
end;
|
|
{ if the array element is again a record, continue descending }
|
|
if currentdef.typ=recorddef then
|
|
currentsymlist:=trecorddef(currentdef).symtable.SymList
|
|
else
|
|
begin
|
|
{ otherwise we found the type of the single element }
|
|
def:=currentdef;
|
|
exit;
|
|
end;
|
|
end
|
|
else
|
|
exit
|
|
until false;
|
|
end;
|
|
|
|
function tabstractrecordsymtable.get_unit_symtable: tsymtable;
|
|
begin
|
|
result:=defowner.owner;
|
|
while assigned(result) and (result.symtabletype in [ObjectSymtable,recordsymtable]) do
|
|
result:=result.defowner.owner;
|
|
end;
|
|
|
|
|
|
procedure tabstractrecordsymtable.do_get_managementoperator_offset_list(data:tobject;arg:pointer);
|
|
var
|
|
sym : tsym absolute data;
|
|
fsym : tfieldvarsym absolute data;
|
|
mop : tmanagementoperator;
|
|
entry : pmanagementoperator_offset_entry;
|
|
sublist : tfplist;
|
|
i : longint;
|
|
begin
|
|
if sym.typ<>fieldvarsym then
|
|
exit;
|
|
if not is_record(fsym.vardef) and not is_object(fsym.vardef) and not is_cppclass(fsym.vardef) then
|
|
exit;
|
|
mop:=tmanagementoperator(ptruint(arg));
|
|
if not assigned(mop_list[mop]) then
|
|
internalerror(2018082303);
|
|
|
|
if is_record(fsym.vardef) then
|
|
begin
|
|
if mop in trecordsymtable(trecorddef(fsym.vardef).symtable).managementoperators then
|
|
begin
|
|
new(entry);
|
|
entry^.pd:=search_management_operator(mop,fsym.vardef);
|
|
if not assigned(entry^.pd) then
|
|
internalerror(2018082302);
|
|
entry^.offset:=fsym.fieldoffset;
|
|
mop_list[mop].add(entry);
|
|
end;
|
|
end;
|
|
|
|
sublist:=tfplist.create;
|
|
tabstractrecordsymtable(tabstractrecorddef(fsym.vardef).symtable).get_managementoperator_offset_list(mop,sublist);
|
|
for i:=0 to sublist.count-1 do
|
|
begin
|
|
entry:=pmanagementoperator_offset_entry(sublist[i]);
|
|
entry^.offset:=entry^.offset+fsym.fieldoffset;
|
|
mop_list[mop].add(entry);
|
|
end;
|
|
{ we don't need to remove the entries as they become part of list }
|
|
sublist.free;
|
|
end;
|
|
|
|
procedure tabstractrecordsymtable.get_managementoperator_offset_list(mop:tmanagementoperator;list:tfplist);
|
|
var
|
|
i : longint;
|
|
entry,entrycopy : pmanagementoperator_offset_entry;
|
|
begin
|
|
if not assigned(list) then
|
|
internalerror(2018082301);
|
|
if mop=mop_none then
|
|
exit;
|
|
if not (mop in has_fields_with_mop) then
|
|
{ none of the fields or one of the field's fields has the requested operator }
|
|
exit;
|
|
if not assigned(mop_list[mop]) then
|
|
begin
|
|
mop_list[mop]:=tfplist.create;
|
|
SymList.ForEachCall(@do_get_managementoperator_offset_list,pointer(ptruint(mop)));
|
|
end;
|
|
for i:=0 to mop_list[mop].count-1 do
|
|
begin
|
|
entry:=pmanagementoperator_offset_entry(mop_list[mop][i]);
|
|
New(entrycopy);
|
|
entrycopy^:=entry^;
|
|
list.add(entrycopy);
|
|
end;
|
|
end;
|
|
|
|
procedure tabstractrecordsymtable.setdatasize(val: asizeint);
|
|
begin
|
|
_datasize:=val;
|
|
if (usefieldalignment=bit_alignment) then
|
|
{ can overflow in non bitpacked records }
|
|
databitsize:=val*8;
|
|
end;
|
|
|
|
function tabstractrecordsymtable.getfieldoffset(sym: tfieldvarsym; base: asizeint; var globalfieldalignment: shortint): asizeint;
|
|
var
|
|
l : asizeint;
|
|
varalignfield,
|
|
varalign : shortint;
|
|
vardef : tdef;
|
|
begin
|
|
{ Calculate field offset }
|
|
l:=sym.getsize;
|
|
vardef:=sym.vardef;
|
|
varalign:=vardef.structalignment;
|
|
case usefieldalignment of
|
|
bit_alignment:
|
|
{ has to be handled separately }
|
|
internalerror(2012071301);
|
|
C_alignment:
|
|
begin
|
|
{ Calc the alignment size for C style records }
|
|
if (varalign>4) and
|
|
((varalign mod 4)<>0) and
|
|
(vardef.typ=arraydef) then
|
|
Message1(sym_w_wrong_C_pack,vardef.typename);
|
|
if varalign=0 then
|
|
varalign:=l;
|
|
if (globalfieldalignment<maxCrecordalign) then
|
|
begin
|
|
if (varalign>16) and (globalfieldalignment<32) then
|
|
globalfieldalignment:=32
|
|
else if (varalign>12) and (globalfieldalignment<16) then
|
|
globalfieldalignment:=16
|
|
{ 12 is needed for long double }
|
|
else if (varalign>8) and (globalfieldalignment<12) then
|
|
globalfieldalignment:=12
|
|
else if (varalign>4) and (globalfieldalignment<8) then
|
|
globalfieldalignment:=8
|
|
else if (varalign>2) and (globalfieldalignment<4) then
|
|
globalfieldalignment:=4
|
|
else if (varalign>1) and (globalfieldalignment<2) then
|
|
globalfieldalignment:=2;
|
|
end;
|
|
globalfieldalignment:=min(globalfieldalignment,maxCrecordalign);
|
|
end;
|
|
mac68k_alignment:
|
|
begin
|
|
{ mac68k alignment (C description):
|
|
* char is aligned to 1 byte
|
|
* everything else (except vector) is aligned to 2 bytes
|
|
* vector is aligned to 16 bytes
|
|
}
|
|
if l>1 then
|
|
globalfieldalignment:=2
|
|
else
|
|
globalfieldalignment:=1;
|
|
varalign:=2;
|
|
end;
|
|
end;
|
|
if varalign=0 then
|
|
varalign:=size_2_align(l);
|
|
varalignfield:=used_align(varalign,recordalignmin,globalfieldalignment);
|
|
|
|
result:=align(base,varalignfield);
|
|
end;
|
|
|
|
function tabstractrecordsymtable.iscurrentunit: boolean;
|
|
begin
|
|
Result:=assigned(current_module)and(current_module.moduleid=moduleid);
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TRecordSymtable
|
|
****************************************************************************}
|
|
|
|
constructor trecordsymtable.create(const n:string;usealign,recordminalign,recordmaxCalign:shortint);
|
|
begin
|
|
inherited create(n,usealign,recordminalign,recordmaxCalign);
|
|
symtabletype:=recordsymtable;
|
|
end;
|
|
|
|
|
|
{ this procedure is reserved for inserting case variant into
|
|
a record symtable }
|
|
{ the offset is the location of the start of the variant
|
|
and datasize and dataalignment corresponds to
|
|
the complete size (see code in pdecl unit) PM }
|
|
procedure trecordsymtable.insertunionst(unionst : trecordsymtable;offset : asizeint);
|
|
var
|
|
sym : tsym;
|
|
def : tdef;
|
|
i : integer;
|
|
varalignrecord,varalign,
|
|
storesize,storealign : asizeint;
|
|
bitsize: tcgint;
|
|
begin
|
|
storesize:=_datasize;
|
|
storealign:=fieldalignment;
|
|
_datasize:=offset;
|
|
if (usefieldalignment=bit_alignment) then
|
|
databitsize:=offset*8;
|
|
|
|
{ We move the ownership of the defs and symbols to the new recordsymtable.
|
|
The old unionsymtable keeps the references, but doesn't own the
|
|
objects anymore }
|
|
unionst.DefList.OwnsObjects:=false;
|
|
unionst.SymList.OwnsObjects:=false;
|
|
|
|
{ copy symbols }
|
|
for i:=0 to unionst.SymList.Count-1 do
|
|
begin
|
|
sym:=TSym(unionst.SymList[i]);
|
|
if sym.typ<>fieldvarsym then
|
|
internalerror(200601272);
|
|
if tfieldvarsym(sym).fieldoffset=0 then
|
|
include(tfieldvarsym(sym).varoptions,vo_is_first_field);
|
|
|
|
{ add to this record symtable, checking for duplicate names }
|
|
// unionst.SymList.List.List^[i].Data:=nil;
|
|
insert(sym);
|
|
varalign:=tfieldvarsym(sym).vardef.alignment;
|
|
if varalign=0 then
|
|
varalign:=size_2_align(tfieldvarsym(sym).getsize);
|
|
{ retrieve size }
|
|
if (usefieldalignment=bit_alignment) then
|
|
begin
|
|
{ bit packed records are limited to high(aint) bits }
|
|
{ instead of bytes to avoid double precision }
|
|
{ arithmetic in offset calculations }
|
|
if is_ordinal(tfieldvarsym(sym).vardef) then
|
|
bitsize:=tfieldvarsym(sym).getpackedbitsize
|
|
else
|
|
begin
|
|
bitsize:=tfieldvarsym(sym).getsize;
|
|
if (bitsize>high(asizeint) div 8) then
|
|
Message(sym_e_segment_too_large);
|
|
bitsize:=bitsize*8;
|
|
end;
|
|
if bitsize>high(asizeint)-databitsize then
|
|
begin
|
|
Message(sym_e_segment_too_large);
|
|
_datasize:=high(asizeint);
|
|
databitsize:=high(asizeint);
|
|
end
|
|
else
|
|
begin
|
|
databitsize:=tfieldvarsym(sym).fieldoffset+offset*8;
|
|
_datasize:=(databitsize+7) div 8;
|
|
end;
|
|
tfieldvarsym(sym).fieldoffset:=databitsize;
|
|
varalignrecord:=field2recordalignment(tfieldvarsym(sym).fieldoffset div 8,varalign);
|
|
end
|
|
else
|
|
begin
|
|
if tfieldvarsym(sym).getsize>high(asizeint)-_datasize then
|
|
begin
|
|
Message(sym_e_segment_too_large);
|
|
_datasize:=high(asizeint);
|
|
end
|
|
else
|
|
_datasize:=tfieldvarsym(sym).fieldoffset+offset;
|
|
{ update address }
|
|
tfieldvarsym(sym).fieldoffset:=_datasize;
|
|
varalignrecord:=field2recordalignment(tfieldvarsym(sym).fieldoffset,varalign);
|
|
end;
|
|
{ update alignment of this record }
|
|
if (usefieldalignment<>C_alignment) and
|
|
(usefieldalignment<>mac68k_alignment) then
|
|
recordalignment:=max(recordalignment,varalignrecord);
|
|
end;
|
|
{ update alignment for C records }
|
|
if (usefieldalignment=C_alignment) and
|
|
(usefieldalignment<>mac68k_alignment) then
|
|
recordalignment:=max(recordalignment,unionst.recordalignment);
|
|
{ Register defs in the new record symtable }
|
|
for i:=0 to unionst.DefList.Count-1 do
|
|
begin
|
|
def:=TDef(unionst.DefList[i]);
|
|
def.ChangeOwner(self);
|
|
end;
|
|
_datasize:=storesize;
|
|
fieldalignment:=storealign;
|
|
{ If a record contains a union, it does not contain a "single
|
|
non-composite field" in the context of certain ABIs requiring
|
|
special treatment for such records }
|
|
if defowner.typ=recorddef then
|
|
trecorddef(defowner).isunion:=true;
|
|
end;
|
|
|
|
|
|
procedure trecordsymtable.includemanagementoperator(mop:tmanagementoperator);
|
|
begin
|
|
if mop in managementoperators then
|
|
exit;
|
|
include(managementoperators,mop);
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TObjectSymtable
|
|
****************************************************************************}
|
|
|
|
constructor tObjectSymtable.create(adefowner:tdef;const n:string;usealign,recordminalign,recordmaxCalign:shortint);
|
|
begin
|
|
inherited create(n,usealign,recordminalign,recordmaxCalign);
|
|
symtabletype:=ObjectSymtable;
|
|
defowner:=adefowner;
|
|
end;
|
|
|
|
|
|
function tObjectSymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;
|
|
var
|
|
hsym: tsym;
|
|
warn: boolean;
|
|
begin
|
|
result:=false;
|
|
if not assigned(defowner) then
|
|
internalerror(200602061);
|
|
|
|
{ procsym and propertysym have special code
|
|
to override values in inherited classes. For other
|
|
symbols check for duplicates }
|
|
if not(sym.typ in [procsym,propertysym]) then
|
|
begin
|
|
{ but private ids can be reused }
|
|
hsym:=search_struct_member(tobjectdef(defowner),hashedid.id);
|
|
if assigned(hsym) and
|
|
(
|
|
(
|
|
not(m_delphi in current_settings.modeswitches) and
|
|
is_visible_for_object(hsym,tobjectdef(defowner))
|
|
) or
|
|
(
|
|
{ In Delphi, you can repeat members of a parent class. You can't }
|
|
{ do this for objects however, and you (obviouly) can't }
|
|
{ declare two fields with the same name in a single class }
|
|
(m_delphi in current_settings.modeswitches) and
|
|
(
|
|
is_object(tdef(defowner)) or
|
|
(hsym.owner = self)
|
|
)
|
|
)
|
|
) then
|
|
begin
|
|
{ only watn when a parameter/local variable in a method
|
|
conflicts with a category method, because this can easily
|
|
happen due to all possible categories being imported via
|
|
CocoaAll }
|
|
warn:=
|
|
(is_objccategory(tdef(hsym.owner.defowner)) or
|
|
is_classhelper(tdef(hsym.owner.defowner))) and
|
|
(sym.typ in [paravarsym,localvarsym,fieldvarsym]);
|
|
DuplicateSym(hashedid,sym,hsym,warn);
|
|
result:=true;
|
|
end;
|
|
end
|
|
else
|
|
result:=inherited checkduplicate(hashedid,sym);
|
|
end;
|
|
|
|
|
|
{$ifdef llvm}
|
|
|
|
{****************************************************************************
|
|
tLlvmShadowSymtableEntry
|
|
****************************************************************************}
|
|
|
|
constructor tllvmshadowsymtableentry.create(def: tdef; fieldoffset: aint);
|
|
begin
|
|
fdef:=def;
|
|
ffieldoffset:=fieldoffset;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TLlvmShadowSymtable
|
|
****************************************************************************}
|
|
|
|
function tllvmshadowsymtable.get(f: tfieldvarsym): tllvmshadowsymtableentry;
|
|
begin
|
|
result:=get_by_llvm_index(f.llvmfieldnr)
|
|
end;
|
|
|
|
|
|
function tllvmshadowsymtable.get_by_llvm_index(index: longint): tllvmshadowsymtableentry;
|
|
begin
|
|
result:=tllvmshadowsymtableentry(symdeflist[index]);
|
|
end;
|
|
|
|
|
|
constructor tllvmshadowsymtable.create(st: tabstractrecordsymtable);
|
|
begin
|
|
equivst:=st;
|
|
curroffset:=0;
|
|
symdeflist:=tfpobjectlist.create(true);
|
|
generate;
|
|
end;
|
|
|
|
|
|
destructor tllvmshadowsymtable.destroy;
|
|
begin
|
|
symdeflist.free;
|
|
end;
|
|
|
|
|
|
procedure tllvmshadowsymtable.appenddefoffset(vardef:tdef; fieldoffset: aint; derefclass: boolean);
|
|
var
|
|
sizectr,
|
|
tmpsize: aint;
|
|
begin
|
|
case equivst.usefieldalignment of
|
|
bit_alignment:
|
|
begin
|
|
{ curoffset: bit address after the previous field. }
|
|
{ llvm has no special support for bitfields in records, }
|
|
{ so we replace them with plain bytes. }
|
|
{ as soon as a single bit of a byte is allocated, we }
|
|
{ allocate the byte in the llvm shadow record }
|
|
if (fieldoffset>curroffset) then
|
|
curroffset:=align(curroffset,8);
|
|
{ fields in bitpacked records always start either right }
|
|
{ after the previous one, or at the next byte boundary. }
|
|
if (curroffset<>fieldoffset) then
|
|
internalerror(2008051002);
|
|
if is_ordinal(vardef) then
|
|
begin
|
|
tmpsize:=vardef.packedbitsize;
|
|
sizectr:=((curroffset+tmpsize+7) shr 3)-((curroffset+7) shr 3);
|
|
inc(curroffset,tmpsize);
|
|
tmpsize:=0;
|
|
while sizectr<>0 do
|
|
begin
|
|
symdeflist.add(tllvmshadowsymtableentry.create(u8inttype,fieldoffset+tmpsize*8));
|
|
dec(sizectr);
|
|
inc(tmpsize);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
symdeflist.add(tllvmshadowsymtableentry.create(vardef,fieldoffset));
|
|
if not(derefclass) then
|
|
inc(curroffset,vardef.size*8)
|
|
else
|
|
inc(curroffset,tobjectsymtable(tobjectdef(vardef).symtable).datasize*8);
|
|
end;
|
|
end
|
|
else if not(df_llvm_no_struct_packing in tdef(equivst.defowner).defoptions) then
|
|
begin
|
|
{ curoffset: address right after the previous field }
|
|
while (fieldoffset>curroffset) do
|
|
begin
|
|
symdeflist.add(tllvmshadowsymtableentry.create(u8inttype,curroffset));
|
|
inc(curroffset);
|
|
end;
|
|
symdeflist.add(tllvmshadowsymtableentry.create(vardef,fieldoffset));
|
|
if not(derefclass) then
|
|
inc(curroffset,vardef.size)
|
|
else
|
|
inc(curroffset,tobjectsymtable(tobjectdef(vardef).symtable).datasize);
|
|
end
|
|
else
|
|
{ default for llvm, don't add explicit padding }
|
|
symdeflist.add(tllvmshadowsymtableentry.create(vardef,fieldoffset));
|
|
end
|
|
end;
|
|
|
|
|
|
procedure tllvmshadowsymtable.addalignmentpadding(finalsize: aint);
|
|
begin
|
|
case equivst.usefieldalignment of
|
|
{ already correct in this case }
|
|
bit_alignment:
|
|
;
|
|
else if not(df_llvm_no_struct_packing in tdef(equivst.defowner).defoptions) then
|
|
begin
|
|
{ add padding fields }
|
|
while (finalsize>curroffset) do
|
|
begin
|
|
symdeflist.add(tllvmshadowsymtableentry.create(u8inttype,curroffset));
|
|
inc(curroffset);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tllvmshadowsymtable.findvariantstarts(variantstarts: tfplist);
|
|
var
|
|
sym: tfieldvarsym;
|
|
lastoffset: aint;
|
|
newalignment: aint;
|
|
i, j: longint;
|
|
begin
|
|
i:=0;
|
|
while (i<equivst.symlist.count) do
|
|
begin
|
|
if (tsym(equivst.symlist[i]).typ<>fieldvarsym) or
|
|
(sp_static in tsym(equivst.symlist[i]).symoptions) then
|
|
begin
|
|
inc(i);
|
|
continue;
|
|
end;
|
|
sym:=tfieldvarsym(equivst.symlist[i]);
|
|
{ a "better" algorithm might be to use the largest }
|
|
{ variant in case of (bit)packing, since then }
|
|
{ alignment doesn't matter }
|
|
if (vo_is_first_field in sym.varoptions) then
|
|
begin
|
|
{ we assume that all fields are processed in order. }
|
|
if (variantstarts.count<>0) then
|
|
lastoffset:=tfieldvarsym(variantstarts[variantstarts.count-1]).fieldoffset
|
|
else
|
|
lastoffset:=-1;
|
|
|
|
{ new variant at same level as last one: use if higher alignment }
|
|
if (lastoffset=sym.fieldoffset) then
|
|
begin
|
|
if (equivst.fieldalignment<>bit_alignment) then
|
|
newalignment:=used_align(sym.vardef.alignment,equivst.recordalignmin,equivst.fieldalignment)
|
|
else
|
|
newalignment:=1;
|
|
if (newalignment>tfieldvarsym(variantstarts[variantstarts.count-1]).vardef.alignment) then
|
|
variantstarts[variantstarts.count-1]:=sym;
|
|
end
|
|
{ variant at deeper level than last one -> add }
|
|
else if (lastoffset<sym.fieldoffset) then
|
|
variantstarts.add(sym)
|
|
else
|
|
begin
|
|
{ a variant at a less deep level, so backtrack }
|
|
j:=variantstarts.count-2;
|
|
while (j>=0) do
|
|
begin
|
|
if (tfieldvarsym(variantstarts[j]).fieldoffset=sym.fieldoffset) then
|
|
break;
|
|
dec(j);
|
|
end;
|
|
if (j<0) then
|
|
internalerror(2008051003);
|
|
{ new variant has higher alignment? }
|
|
if (equivst.fieldalignment<>bit_alignment) then
|
|
newalignment:=used_align(sym.vardef.alignment,equivst.recordalignmin,equivst.fieldalignment)
|
|
else
|
|
newalignment:=1;
|
|
{ yes, replace and remove previous nested variants }
|
|
if (newalignment>tfieldvarsym(variantstarts[j]).vardef.alignment) then
|
|
begin
|
|
variantstarts[j]:=sym;
|
|
variantstarts.count:=j+1;
|
|
end
|
|
{ no, skip this variant }
|
|
else
|
|
begin
|
|
inc(i);
|
|
while (i<equivst.symlist.count) and
|
|
((tsym(equivst.symlist[i]).typ<>fieldvarsym) or
|
|
(sp_static in tsym(equivst.symlist[i]).symoptions) or
|
|
(tfieldvarsym(equivst.symlist[i]).fieldoffset>sym.fieldoffset)) do
|
|
inc(i);
|
|
continue;
|
|
end;
|
|
end;
|
|
end;
|
|
inc(i);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tllvmshadowsymtable.buildtable(variantstarts: tfplist);
|
|
var
|
|
lastvaroffsetprocessed: aint;
|
|
i, equivcount, varcount: longint;
|
|
begin
|
|
{ if it's an object/class, the first entry is the parent (if there is one) }
|
|
if (equivst.symtabletype=objectsymtable) and
|
|
assigned(tobjectdef(equivst.defowner).childof) then
|
|
appenddefoffset(tobjectdef(equivst.defowner).childof,0,is_class_or_interface_or_dispinterface(tobjectdef(equivst.defowner).childof));
|
|
equivcount:=equivst.symlist.count;
|
|
varcount:=0;
|
|
i:=0;
|
|
lastvaroffsetprocessed:=-1;
|
|
while (i<equivcount) do
|
|
begin
|
|
if (tsym(equivst.symlist[i]).typ<>fieldvarsym) or
|
|
(sp_static in tsym(equivst.symlist[i]).symoptions) then
|
|
begin
|
|
inc(i);
|
|
continue;
|
|
end;
|
|
{ start of a new variant? }
|
|
if (vo_is_first_field in tfieldvarsym(equivst.symlist[i]).varoptions) then
|
|
begin
|
|
{ if we want to process the same variant offset twice, it means that we }
|
|
{ got to the end and are trying to process the next variant part -> stop }
|
|
if (tfieldvarsym(equivst.symlist[i]).fieldoffset<=lastvaroffsetprocessed) then
|
|
break;
|
|
|
|
if (varcount>=variantstarts.count) then
|
|
internalerror(2008051005);
|
|
{ new variant part -> use the one with the biggest alignment }
|
|
i:=equivst.symlist.indexof(tobject(variantstarts[varcount]));
|
|
lastvaroffsetprocessed:=tfieldvarsym(equivst.symlist[i]).fieldoffset;
|
|
inc(varcount);
|
|
if (i<0) then
|
|
internalerror(2008051004);
|
|
end;
|
|
appenddefoffset(tfieldvarsym(equivst.symlist[i]).vardef,tfieldvarsym(equivst.symlist[i]).fieldoffset,false);
|
|
inc(i);
|
|
end;
|
|
addalignmentpadding(equivst.datasize);
|
|
end;
|
|
|
|
|
|
procedure tllvmshadowsymtable.buildmapping(variantstarts: tfplist);
|
|
var
|
|
i, varcount: longint;
|
|
shadowindex: longint;
|
|
equivcount : longint;
|
|
begin
|
|
varcount:=0;
|
|
shadowindex:=0;
|
|
equivcount:=equivst.symlist.count;
|
|
i:=0;
|
|
while (i < equivcount) do
|
|
begin
|
|
if (tsym(equivst.symlist[i]).typ<>fieldvarsym) or
|
|
(sp_static in tsym(equivst.symlist[i]).symoptions) then
|
|
begin
|
|
inc(i);
|
|
continue;
|
|
end;
|
|
{ start of a new variant? }
|
|
if (vo_is_first_field in tfieldvarsym(equivst.symlist[i]).varoptions) then
|
|
begin
|
|
{ back up to a less deeply nested variant level? }
|
|
while (tfieldvarsym(equivst.symlist[i]).fieldoffset<tfieldvarsym(variantstarts[varcount]).fieldoffset) do
|
|
dec(varcount);
|
|
{ it's possible that some variants are more deeply nested than the
|
|
one we recorded in the shadowsymtable (since we recorded the one
|
|
with the biggest alignment, not necessarily the biggest one in size
|
|
}
|
|
if (tfieldvarsym(equivst.symlist[i]).fieldoffset>tfieldvarsym(variantstarts[varcount]).fieldoffset) then
|
|
varcount:=variantstarts.count-1
|
|
else if (tfieldvarsym(equivst.symlist[i]).fieldoffset<>tfieldvarsym(variantstarts[varcount]).fieldoffset) then
|
|
internalerror(2008051006);
|
|
{ reset the shadowindex to the start of this variant. }
|
|
{ in case the llvmfieldnr is not (yet) set for this }
|
|
{ field, shadowindex will simply be reset to zero and }
|
|
{ we'll start searching from the start of the record }
|
|
shadowindex:=tfieldvarsym(variantstarts[varcount]).llvmfieldnr;
|
|
if (varcount<pred(variantstarts.count)) then
|
|
inc(varcount);
|
|
end;
|
|
|
|
{ find the last shadowfield whose offset <= the current field's offset }
|
|
while (tllvmshadowsymtableentry(symdeflist[shadowindex]).fieldoffset<tfieldvarsym(equivst.symlist[i]).fieldoffset) and
|
|
(shadowindex<symdeflist.count-1) and
|
|
(tllvmshadowsymtableentry(symdeflist[shadowindex+1]).fieldoffset<=tfieldvarsym(equivst.symlist[i]).fieldoffset) do
|
|
inc(shadowindex);
|
|
{ set the field number and potential offset from that field (in case }
|
|
{ of overlapping variants) }
|
|
tfieldvarsym(equivst.symlist[i]).llvmfieldnr:=shadowindex;
|
|
tfieldvarsym(equivst.symlist[i]).offsetfromllvmfield:=
|
|
tfieldvarsym(equivst.symlist[i]).fieldoffset-tllvmshadowsymtableentry(symdeflist[shadowindex]).fieldoffset;
|
|
inc(i);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tllvmshadowsymtable.generate;
|
|
var
|
|
variantstarts: tfplist;
|
|
begin
|
|
variantstarts:=tfplist.create;
|
|
|
|
{ first go through the entire record and }
|
|
{ store the fieldvarsyms of the variants }
|
|
{ with the highest alignment }
|
|
findvariantstarts(variantstarts);
|
|
|
|
{ now go through the regular fields and the selected variants, }
|
|
{ and add them to the llvm shadow record symtable }
|
|
buildtable(variantstarts);
|
|
|
|
{ finally map all original fields to the llvm definition }
|
|
buildmapping(variantstarts);
|
|
|
|
variantstarts.free;
|
|
end;
|
|
|
|
{$endif llvm}
|
|
|
|
{****************************************************************************
|
|
TAbstractSubSymtable
|
|
****************************************************************************}
|
|
|
|
procedure tabstractsubsymtable.ppuwrite(ppufile:tcompilerppufile);
|
|
var
|
|
oldtyp : byte;
|
|
begin
|
|
oldtyp:=ppufile.entrytyp;
|
|
ppufile.entrytyp:=subentryid;
|
|
|
|
inherited ppuwrite(ppufile);
|
|
|
|
ppufile.entrytyp:=oldtyp;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TAbstractLocalSymtable
|
|
****************************************************************************}
|
|
|
|
function tabstractlocalsymtable.count_locals:longint;
|
|
var
|
|
i : longint;
|
|
sym : tsym;
|
|
begin
|
|
result:=0;
|
|
for i:=0 to SymList.Count-1 do
|
|
begin
|
|
sym:=tsym(SymList[i]);
|
|
{ Count only varsyms, but ignore the funcretsym }
|
|
if (tsym(sym).typ in [localvarsym,paravarsym]) and
|
|
(tsym(sym)<>current_procinfo.procdef.funcretsym) and
|
|
(not(vo_is_parentfp in tabstractvarsym(sym).varoptions) or
|
|
(tstoredsym(sym).refs>0)) then
|
|
inc(result);
|
|
end;
|
|
end;
|
|
|
|
function tabstractlocalsymtable.iscurrentunit: boolean;
|
|
begin
|
|
Result:=
|
|
assigned(defowner) and
|
|
defowner.owner.iscurrentunit;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TLocalSymtable
|
|
****************************************************************************}
|
|
|
|
constructor tlocalsymtable.create(adefowner:tdef;level:byte);
|
|
begin
|
|
inherited create('');
|
|
defowner:=adefowner;
|
|
symtabletype:=localsymtable;
|
|
symtablelevel:=level;
|
|
end;
|
|
|
|
|
|
function tlocalsymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;
|
|
var
|
|
hsym : tsym;
|
|
begin
|
|
if not assigned(defowner) or
|
|
(defowner.typ<>procdef) then
|
|
internalerror(200602042);
|
|
|
|
result:=false;
|
|
hsym:=tsym(FindWithHash(hashedid));
|
|
if assigned(hsym) then
|
|
begin
|
|
{ a local and the function can have the same
|
|
name in TP and Delphi, but RESULT not }
|
|
if (m_duplicate_names in current_settings.modeswitches) and
|
|
(hsym.typ in [absolutevarsym,localvarsym]) and
|
|
(vo_is_funcret in tabstractvarsym(hsym).varoptions) and
|
|
not((m_result in current_settings.modeswitches) and
|
|
(vo_is_result in tabstractvarsym(hsym).varoptions)) then
|
|
HideSym(hsym)
|
|
else
|
|
DuplicateSym(hashedid,sym,hsym,false);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
|
|
{ check also parasymtable, this needs to be done here because
|
|
of the special situation with the funcret sym that needs to be
|
|
hidden for tp and delphi modes }
|
|
hsym:=tsym(tabstractprocdef(defowner).parast.FindWithHash(hashedid));
|
|
if assigned(hsym) then
|
|
begin
|
|
{ a local and the function can have the same
|
|
name in TP and Delphi, but RESULT not }
|
|
if (m_duplicate_names in current_settings.modeswitches) and
|
|
(sym.typ in [absolutevarsym,localvarsym]) and
|
|
(vo_is_funcret in tabstractvarsym(sym).varoptions) and
|
|
not((m_result in current_settings.modeswitches) and
|
|
(vo_is_result in tabstractvarsym(sym).varoptions)) then
|
|
Hidesym(sym)
|
|
else
|
|
DuplicateSym(hashedid,sym,hsym,false);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
|
|
{ check ObjectSymtable, skip this for funcret sym because
|
|
that will always be positive because it has the same name
|
|
as the procsym }
|
|
if not is_funcret_sym(sym) and
|
|
(defowner.typ=procdef) and
|
|
assigned(tprocdef(defowner).struct) and
|
|
(tprocdef(defowner).owner.defowner=tprocdef(defowner).struct) and
|
|
(
|
|
not(m_delphi in current_settings.modeswitches) or
|
|
is_object(tprocdef(defowner).struct)
|
|
) then
|
|
result:=tprocdef(defowner).struct.symtable.checkduplicate(hashedid,sym);
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TParaSymtable
|
|
****************************************************************************}
|
|
|
|
constructor tparasymtable.create(adefowner:tdef;level:byte);
|
|
begin
|
|
inherited create('');
|
|
readonly:=false;
|
|
defowner:=adefowner;
|
|
symtabletype:=parasymtable;
|
|
symtablelevel:=level;
|
|
end;
|
|
|
|
|
|
function tparasymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;
|
|
begin
|
|
result:=inherited checkduplicate(hashedid,sym);
|
|
if result then
|
|
exit;
|
|
if not(m_duplicate_names in current_settings.modeswitches) and
|
|
assigned(defowner) and (defowner.typ=procdef) and
|
|
assigned(tprocdef(defowner).struct) and
|
|
assigned(tprocdef(defowner).owner) and
|
|
(tprocdef(defowner).owner.defowner=tprocdef(defowner).struct) and
|
|
(
|
|
not(m_delphi in current_settings.modeswitches) or
|
|
is_object(tprocdef(defowner).struct)
|
|
) then
|
|
result:=tprocdef(defowner).struct.symtable.checkduplicate(hashedid,sym);
|
|
end;
|
|
|
|
procedure tparasymtable.insertdef(def: TDefEntry);
|
|
begin
|
|
if readonly then
|
|
defowner.owner.insertdef(def)
|
|
else
|
|
inherited insertdef(def);
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TAbstractUniTSymtable
|
|
****************************************************************************}
|
|
|
|
constructor tabstractuniTSymtable.create(const n : string;id:word);
|
|
begin
|
|
inherited create(n);
|
|
moduleid:=id;
|
|
end;
|
|
|
|
|
|
function tabstractuniTSymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;
|
|
var
|
|
hsym : tsym;
|
|
begin
|
|
result:=false;
|
|
hsym:=tsym(FindWithHash(hashedid));
|
|
if assigned(hsym) then
|
|
begin
|
|
if (sym is tstoredsym) and handle_generic_dummysym(hsym,tstoredsym(sym).symoptions) then
|
|
exit;
|
|
if hsym.typ=symconst.namespacesym then
|
|
begin
|
|
case sym.typ of
|
|
symconst.namespacesym:;
|
|
symconst.unitsym:
|
|
begin
|
|
HideSym(sym); { if we add a unit and there is a namespace with the same name then hide the unit name and not the namespace }
|
|
tnamespacesym(hsym).unitsym:=tsym(sym);
|
|
end
|
|
else
|
|
HideSym(hsym);
|
|
end;
|
|
end
|
|
else
|
|
{ In delphi (contrary to TP) you can have a symbol with the same name as the
|
|
unit, the unit can then not be accessed anymore using
|
|
<unit>.<id>, so we can hide the symbol.
|
|
Do the same if we add a namespace and there is a unit with the same name }
|
|
if (hsym.typ=symconst.unitsym) and
|
|
((m_delphi in current_settings.modeswitches) or (sym.typ=symconst.namespacesym)) then
|
|
begin
|
|
HideSym(hsym);
|
|
if sym.typ=symconst.namespacesym then
|
|
tnamespacesym(sym).unitsym:=tsym(hsym);
|
|
end
|
|
{ iso mode program parameters: staticvarsyms might have the same name as a program parameters,
|
|
in this case, copy the isoindex and make the original symbol invisible }
|
|
else if (m_isolike_program_para in current_settings.modeswitches) and (hsym.typ=programparasym) and (sym.typ=staticvarsym)
|
|
and (tprogramparasym(hsym).isoindex<>0) then
|
|
begin
|
|
HideSym(hsym);
|
|
tstaticvarsym(sym).isoindex:=tprogramparasym(hsym).isoindex;
|
|
end
|
|
else
|
|
DuplicateSym(hashedid,sym,hsym,false);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
function tabstractuniTSymtable.findnamespace(const n:string):TSymEntry;
|
|
begin
|
|
result:=find(n);
|
|
if assigned(result)and(result.typ<>namespacesym)then
|
|
result:=nil;
|
|
end;
|
|
|
|
function tabstractuniTSymtable.iscurrentunit:boolean;
|
|
begin
|
|
result:=assigned(current_module) and
|
|
(
|
|
(current_module.globalsymtable=self) or
|
|
(current_module.localsymtable=self)
|
|
);
|
|
end;
|
|
|
|
|
|
function tabstractuniTSymtable.needs_init_final: boolean;
|
|
begin
|
|
if not init_final_check_done then
|
|
begin
|
|
result:=inherited needs_init_final;
|
|
if not result then
|
|
begin
|
|
result:=has_class_condestructors;
|
|
if result then
|
|
include(tableoptions,sto_needs_init_final);
|
|
end;
|
|
end;
|
|
result:=sto_needs_init_final in tableoptions;
|
|
end;
|
|
|
|
|
|
procedure tabstractuniTSymtable.insertunit(sym:TSymEntry);
|
|
var
|
|
p:integer;
|
|
n,ns:string;
|
|
oldsym:TSymEntry;
|
|
begin
|
|
insert(sym);
|
|
n:=sym.realname;
|
|
p:=pos('.',n);
|
|
ns:='';
|
|
while p>0 do
|
|
begin
|
|
if ns='' then
|
|
ns:=copy(n,1,p-1)
|
|
else
|
|
ns:=ns+'.'+copy(n,1,p-1);
|
|
system.delete(n,1,p);
|
|
oldsym:=findnamespace(upper(ns));
|
|
if not assigned(oldsym) then
|
|
insert(cnamespacesym.create(ns));
|
|
p:=pos('.',n);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure CheckForClassConDestructors(p:TObject;arg:pointer);
|
|
var
|
|
result: pboolean absolute arg;
|
|
begin
|
|
if result^ then
|
|
exit;
|
|
if (tdef(p).typ in [objectdef,recorddef]) and
|
|
not (df_generic in tdef(p).defoptions) then
|
|
begin
|
|
{ first check the class... }
|
|
if ([oo_has_class_constructor,oo_has_class_destructor] * tabstractrecorddef(p).objectoptions <> []) then
|
|
result^:=true;;
|
|
{ ... and then also check all subclasses }
|
|
if not result^ then
|
|
tabstractrecorddef(p).symtable.deflist.foreachcall(@CheckForClassConDestructors,arg);
|
|
end;
|
|
end;
|
|
|
|
|
|
function tabstractuniTSymtable.has_class_condestructors: boolean;
|
|
begin
|
|
result:=false;
|
|
deflist.foreachcall(@CheckForClassConDestructors,@result);
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TStaticSymtable
|
|
****************************************************************************}
|
|
|
|
constructor tstaticsymtable.create(const n : string;id:word);
|
|
begin
|
|
inherited create(n,id);
|
|
symtabletype:=staticsymtable;
|
|
symtablelevel:=main_program_level;
|
|
currentvisibility:=vis_private;
|
|
end;
|
|
|
|
|
|
procedure tstaticsymtable.ppuload(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuload(ppufile);
|
|
|
|
{ now we can deref the syms and defs }
|
|
deref(false);
|
|
end;
|
|
|
|
|
|
procedure tstaticsymtable.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuwrite(ppufile);
|
|
end;
|
|
|
|
|
|
function tstaticsymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;
|
|
begin
|
|
result:=inherited checkduplicate(hashedid,sym);
|
|
|
|
if not result and
|
|
(current_module.localsymtable=self) and
|
|
assigned(current_module.globalsymtable) then
|
|
result:=tglobalsymtable(current_module.globalsymtable).checkduplicate(hashedid,sym);
|
|
end;
|
|
|
|
function tstaticsymtable.findnamespace(const n:string):TSymEntry;
|
|
begin
|
|
result:=inherited findnamespace(n);
|
|
if not assigned(result) and
|
|
(current_module.localsymtable=self) and
|
|
assigned(current_module.globalsymtable) then
|
|
result:=tglobalsymtable(current_module.globalsymtable).findnamespace(n);
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TGlobalSymtable
|
|
****************************************************************************}
|
|
|
|
constructor tglobalsymtable.create(const n : string;id:word);
|
|
begin
|
|
inherited create(n,id);
|
|
symtabletype:=globalsymtable;
|
|
symtablelevel:=main_program_level;
|
|
end;
|
|
|
|
|
|
procedure tglobalsymtable.ppuload(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited ppuload(ppufile);
|
|
|
|
{ now we can deref the syms and defs }
|
|
deref(false);
|
|
end;
|
|
|
|
|
|
procedure tglobalsymtable.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
{ write the symtable entries }
|
|
inherited ppuwrite(ppufile);
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
tspecializesymtable
|
|
*****************************************************************************}
|
|
|
|
constructor tspecializesymtable.create(const n : string;id:word);
|
|
begin
|
|
inherited create(n,id);
|
|
{ the specialize symtable does not own the syms and defs as they are all
|
|
moved to a different symtable before the symtable is destroyed; this
|
|
avoids calls to "extract" }
|
|
symlist.ownsobjects:=false;
|
|
deflist.ownsobjects:=false;
|
|
end;
|
|
|
|
function tspecializesymtable.iscurrentunit: boolean;
|
|
begin
|
|
Result:=true;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TWITHSYMTABLE
|
|
****************************************************************************}
|
|
|
|
constructor twithsymtable.create(aowner:tdef;ASymList:TFPHashObjectList;refnode:tobject{tnode});
|
|
begin
|
|
inherited create('');
|
|
symtabletype:=withsymtable;
|
|
withrefnode:=refnode;
|
|
{ Replace SymList with the passed symlist }
|
|
SymList.free;
|
|
SymList:=ASymList;
|
|
defowner:=aowner;
|
|
end;
|
|
|
|
|
|
destructor twithsymtable.destroy;
|
|
begin
|
|
if refcount>1 then
|
|
exit;
|
|
withrefnode.free;
|
|
{ Disable SymList because we don't Own it }
|
|
SymList:=nil;
|
|
inherited destroy;
|
|
end;
|
|
|
|
|
|
procedure twithsymtable.clear;
|
|
begin
|
|
{ remove no entry from a withsymtable as it is only a pointer to the
|
|
recorddef or objectdef symtable }
|
|
end;
|
|
|
|
|
|
procedure twithsymtable.insertdef(def:TDefEntry);
|
|
begin
|
|
{ Definitions can't be registered in the withsymtable
|
|
because the withsymtable is removed after the with block.
|
|
We can't easily solve it here because the next symtable in the
|
|
stack is not known. }
|
|
internalerror(200602046);
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TSTT_ExceptionSymtable
|
|
****************************************************************************}
|
|
|
|
constructor tstt_excepTSymtable.create;
|
|
begin
|
|
inherited create('');
|
|
symtabletype:=stt_excepTSymtable;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TMacroSymtable
|
|
****************************************************************************}
|
|
|
|
constructor tmacrosymtable.create(exported: boolean);
|
|
begin
|
|
inherited create('');
|
|
if exported then
|
|
symtabletype:=exportedmacrosymtable
|
|
else
|
|
symtabletype:=localmacrosymtable;
|
|
symtablelevel:=main_program_level;
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TEnumSymtable
|
|
****************************************************************************}
|
|
|
|
procedure tenumsymtable.insert(sym: TSymEntry; checkdup: boolean);
|
|
var
|
|
value: longint;
|
|
def: tenumdef;
|
|
begin
|
|
// defowner = nil only when we are loading from ppu
|
|
if defowner<>nil then
|
|
begin
|
|
{ First entry? Then we need to set the minval }
|
|
value:=tenumsym(sym).value;
|
|
def:=tenumdef(defowner);
|
|
if SymList.count=0 then
|
|
begin
|
|
if value>0 then
|
|
def.has_jumps:=true;
|
|
def.setmin(value);
|
|
def.setmax(value);
|
|
end
|
|
else
|
|
begin
|
|
{ check for jumps }
|
|
if value>def.max+1 then
|
|
def.has_jumps:=true;
|
|
{ update low and high }
|
|
if def.min>value then
|
|
def.setmin(value);
|
|
if def.max<value then
|
|
def.setmax(value);
|
|
end;
|
|
end;
|
|
inherited insert(sym, checkdup);
|
|
end;
|
|
|
|
constructor tenumsymtable.create(adefowner: tdef);
|
|
begin
|
|
inherited Create('');
|
|
symtabletype:=enumsymtable;
|
|
defowner:=adefowner;
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TArraySymtable
|
|
****************************************************************************}
|
|
|
|
procedure tarraysymtable.insertdef(def: TDefEntry);
|
|
begin
|
|
{ Enums must also be available outside the record scope,
|
|
insert in the owner of this symtable }
|
|
if def.typ=enumdef then
|
|
defowner.owner.insertdef(def)
|
|
else
|
|
inherited insertdef(def);
|
|
end;
|
|
|
|
constructor tarraysymtable.create(adefowner: tdef);
|
|
begin
|
|
inherited Create('');
|
|
symtabletype:=arraysymtable;
|
|
defowner:=adefowner;
|
|
end;
|
|
|
|
{*****************************************************************************
|
|
Helper Routines
|
|
*****************************************************************************}
|
|
|
|
function FullTypeName(def,otherdef:tdef):string;
|
|
var
|
|
s1,s2 : string;
|
|
begin
|
|
if def.typ in [objectdef,recorddef] then
|
|
s1:=tabstractrecorddef(def).RttiName
|
|
else
|
|
s1:=def.typename;
|
|
{ When the names are the same try to include the unit name }
|
|
if assigned(otherdef) and
|
|
(def.owner.symtabletype in [globalsymtable,staticsymtable]) then
|
|
begin
|
|
s2:=otherdef.typename;
|
|
if upper(s1)=upper(s2) then
|
|
s1:=def.owner.realname^+'.'+s1;
|
|
end;
|
|
FullTypeName:=s1;
|
|
end;
|
|
|
|
function generate_nested_name(symtable:tsymtable;delimiter:string):string;
|
|
begin
|
|
result:='';
|
|
while assigned(symtable) and (symtable.symtabletype in [ObjectSymtable,recordsymtable]) do
|
|
begin
|
|
if (result='') then
|
|
if symtable.name<>nil then
|
|
result:=symtable.name^
|
|
else
|
|
else
|
|
if symtable.name<>nil then
|
|
result:=symtable.name^+delimiter+result
|
|
else
|
|
result:=delimiter+result;
|
|
symtable:=symtable.defowner.owner;
|
|
end;
|
|
end;
|
|
|
|
|
|
function generate_objectpascal_helper_key(def:tdef):string;
|
|
begin
|
|
if not assigned(def) then
|
|
internalerror(2013020501);
|
|
if def.typ in [recorddef,objectdef] then
|
|
result:=make_mangledname('',tabstractrecorddef(def).symtable,'')
|
|
else
|
|
result:=make_mangledname('',def.owner,def.typesym.name);
|
|
end;
|
|
|
|
|
|
procedure incompatibletypes(def1,def2:tdef);
|
|
begin
|
|
{ When there is an errordef there is already an error message show }
|
|
if (def2.typ=errordef) or
|
|
(def1.typ=errordef) then
|
|
exit;
|
|
CGMessage2(type_e_incompatible_types,FullTypeName(def1,def2),FullTypeName(def2,def1));
|
|
end;
|
|
|
|
|
|
procedure hidesym(sym:TSymEntry);
|
|
begin
|
|
sym.realname:='$hidden'+sym.realname;
|
|
tsym(sym).visibility:=vis_hidden;
|
|
end;
|
|
|
|
|
|
procedure duplicatesym(var hashedid: THashedIDString; dupsym, origsym: TSymEntry; warn: boolean);
|
|
var
|
|
st : TSymtable;
|
|
filename : TIDString;
|
|
begin
|
|
if not warn then
|
|
Message1(sym_e_duplicate_id,tsym(origsym).realname)
|
|
else
|
|
Message1(sym_w_duplicate_id,tsym(origsym).realname);
|
|
{ Write hint where the original symbol was found }
|
|
st:=finduniTSymtable(origsym.owner);
|
|
with tsym(origsym).fileinfo do
|
|
begin
|
|
if assigned(st) and
|
|
(st.symtabletype=globalsymtable) and
|
|
st.iscurrentunit then
|
|
Message2(sym_h_duplicate_id_where,current_module.sourcefiles.get_file_name(fileindex),tostr(line))
|
|
else if assigned(st.name) then
|
|
begin
|
|
filename:=find_module_from_symtable(st).sourcefiles.get_file_name(fileindex);
|
|
if filename<>'' then
|
|
Message2(sym_h_duplicate_id_where,'unit '+st.name^+': '+filename,tostr(line))
|
|
else
|
|
Message2(sym_h_duplicate_id_where,'unit '+st.name^,tostr(line))
|
|
end;
|
|
end;
|
|
{ Rename duplicate sym to an unreachable name, but it can be
|
|
inserted in the symtable without errors }
|
|
inc(dupnr);
|
|
hashedid.id:='dup'+tostr(dupnr)+hashedid.id;
|
|
if assigned(dupsym) then
|
|
include(tsym(dupsym).symoptions,sp_implicitrename);
|
|
end;
|
|
|
|
function handle_generic_dummysym(sym:TSymEntry;var symoptions:tsymoptions):boolean;
|
|
begin
|
|
result:=false;
|
|
if not assigned(sym) or not (sym is tstoredsym) then
|
|
Internalerror(2011081101);
|
|
{ For generics a dummy symbol without the parameter count is created
|
|
if such a symbol not yet exists so that different parts of the
|
|
parser can find that symbol. If that symbol is still a
|
|
undefineddef we replace the generic dummy symbol's
|
|
name with a "dup" name and use the new symbol as the generic dummy
|
|
symbol }
|
|
if (sp_generic_dummy in tstoredsym(sym).symoptions) and
|
|
(sym.typ=typesym) and (ttypesym(sym).typedef.typ=undefineddef) and
|
|
(m_delphi in current_settings.modeswitches) then
|
|
begin
|
|
inc(dupnr);
|
|
sym.Owner.SymList.Rename(upper(sym.realname),'dup_'+tostr(dupnr)+sym.realname);
|
|
include(tsym(sym).symoptions,sp_implicitrename);
|
|
{ we need to find the new symbol now if checking for a dummy }
|
|
include(symoptions,sp_generic_dummy);
|
|
result:=true;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure write_system_parameter_lists(const name:string);
|
|
var
|
|
srsym:tprocsym;
|
|
begin
|
|
srsym:=tprocsym(systemunit.find(name));
|
|
if not assigned(srsym) or not (srsym.typ=procsym) then
|
|
internalerror(2016060302);
|
|
srsym.write_parameter_lists(nil);
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
Search
|
|
*****************************************************************************}
|
|
|
|
procedure addsymref(sym:tsym);
|
|
var
|
|
owner: tsymtable;
|
|
begin
|
|
{ for symbols used in preprocessor expressions, we don't want to
|
|
increase references count (for smaller final binaries) }
|
|
if not assigned(current_scanner) then
|
|
internalerror(2017050601);
|
|
if current_scanner.in_preproc_comp_expr then
|
|
exit;
|
|
{ symbol uses count }
|
|
sym.IncRefCount;
|
|
owner:=sym.owner;
|
|
while owner.symtabletype in [objectsymtable,recordsymtable,enumsymtable] do
|
|
owner:=tdef(owner.defowner).owner;
|
|
if assigned(current_module) and
|
|
(owner.symtabletype=globalsymtable) then
|
|
begin
|
|
if tglobalsymtable(owner).moduleid>=current_module.unitmapsize then
|
|
internalerror(200501152);
|
|
{ unit uses count }
|
|
inc(current_module.unitmap[tglobalsymtable(owner).moduleid].refs);
|
|
{ Note: don't check the symtable directly as owner might be
|
|
a specialize symtable which is a globalsymtable as well }
|
|
if (
|
|
assigned(current_module.globalsymtable) and
|
|
(current_module.globalsymtable.moduleid<>owner.moduleid)
|
|
) or (
|
|
assigned(current_module.localsymtable) and
|
|
(current_module.localsymtable.moduleid<>owner.moduleid)
|
|
) then
|
|
{ symbol is imported from another unit }
|
|
current_module.addimportedsym(sym);
|
|
end;
|
|
end;
|
|
|
|
|
|
function is_owned_by(nesteddef,ownerdef:tdef):boolean;
|
|
begin
|
|
result:=nesteddef=ownerdef;
|
|
if not result and
|
|
{ types declared locally in a record method are not defined in the
|
|
record itself }
|
|
not(nesteddef.owner.symtabletype in [localsymtable,parasymtable]) and
|
|
assigned(nesteddef.owner.defowner) then
|
|
result:=is_owned_by(tdef(nesteddef.owner.defowner),ownerdef);
|
|
end;
|
|
|
|
function sym_is_owned_by(childsym:tsym;symtable:tsymtable):boolean;
|
|
begin
|
|
result:=assigned(childsym) and (childsym.owner=symtable);
|
|
if not result and assigned(childsym) and
|
|
(childsym.owner.symtabletype in [objectsymtable,recordsymtable]) then
|
|
result:=sym_is_owned_by(tabstractrecorddef(childsym.owner.defowner).typesym,symtable);
|
|
end;
|
|
|
|
function defs_belong_to_same_generic(def1, def2: tdef): boolean;
|
|
begin
|
|
result:=false;
|
|
if not assigned(def1) or not assigned(def2) then
|
|
exit;
|
|
{ for both defs walk to the topmost generic }
|
|
while assigned(def1.owner.defowner) and (df_generic in tstoreddef(def1.owner.defowner).defoptions) do
|
|
def1:=tdef(def1.owner.defowner);
|
|
while assigned(def2.owner.defowner) and (df_generic in tstoreddef(def2.owner.defowner).defoptions) do
|
|
def2:=tdef(def2.owner.defowner);
|
|
result:=def1=def2;
|
|
end;
|
|
|
|
function get_generic_in_hierarchy_by_name(srsym: tsym; def: tdef): tdef;
|
|
var
|
|
uname : string;
|
|
begin
|
|
{ TODO : check regarding arrays and records declared as their type }
|
|
if not (def.typ in [recorddef,objectdef]) then
|
|
internalerror(2012051501);
|
|
uname:=upper(srsym.realname);
|
|
repeat
|
|
if uname=copy(tabstractrecorddef(def).objname^,1,pos('$',tabstractrecorddef(def).objname^)-1) then
|
|
begin
|
|
result:=def;
|
|
exit;
|
|
end;
|
|
def:=tdef(def.owner.defowner);
|
|
until not assigned(def) or not (def.typ in [recorddef,objectdef]);
|
|
result:=nil;
|
|
end;
|
|
|
|
function return_specialization_of_generic(nesteddef,genericdef:tdef; out resultdef:tdef):boolean;
|
|
begin
|
|
{ TODO : check regarding arrays and records declared as their type }
|
|
if not (nesteddef.typ in [recorddef,objectdef]) then
|
|
internalerror(2012051601);
|
|
repeat
|
|
if tstoreddef(nesteddef).genericdef=genericdef then
|
|
begin
|
|
resultdef:=nesteddef;
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
nesteddef:=tdef(nesteddef.owner.defowner);
|
|
until not assigned(nesteddef) or not (nesteddef.typ in [recorddef,objectdef]);
|
|
resultdef:=nil;
|
|
result:=false;
|
|
end;
|
|
|
|
{ symst: symboltable that contains the symbol (-> symowner def: record/objectdef in which the symbol is defined)
|
|
symvisibility: visibility of the symbol
|
|
contextobjdef: via which def the symbol is accessed, e.g.:
|
|
fieldname:=1 -> contextobjdef = current_structdef
|
|
objfield.fieldname:=1 -> contextobjdef = def of objfield
|
|
}
|
|
function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tabstractrecorddef):boolean;
|
|
var
|
|
symownerdef : tabstractrecorddef;
|
|
nonlocalst : tsymtable;
|
|
isspezproc : boolean;
|
|
begin
|
|
result:=false;
|
|
|
|
{ Get objdectdef owner of the symtable for the is_related checks }
|
|
if not assigned(symst) or
|
|
not (symst.symtabletype in [objectsymtable,recordsymtable]) then
|
|
internalerror(200810285);
|
|
symownerdef:=tabstractrecorddef(symst.defowner);
|
|
{ specializations might belong to a localsymtable or parasymtable }
|
|
nonlocalst:=symownerdef.owner;
|
|
if tstoreddef(symst.defowner).is_specialization then
|
|
while nonlocalst.symtabletype in [localsymtable,parasymtable] do
|
|
nonlocalst:=nonlocalst.defowner.owner;
|
|
isspezproc:=false;
|
|
if assigned(current_procinfo) then
|
|
begin
|
|
if current_procinfo.procdef.is_specialization and
|
|
assigned(current_procinfo.procdef.struct) then
|
|
isspezproc:=true;
|
|
end;
|
|
case symvisibility of
|
|
vis_private :
|
|
begin
|
|
{ private symbols are allowed when we are in the same
|
|
module as they are defined }
|
|
result:=(
|
|
(nonlocalst.symtabletype in [globalsymtable,staticsymtable]) and
|
|
(nonlocalst.iscurrentunit)
|
|
) or
|
|
( // the case of specialize inside the generic declaration and nested types
|
|
(nonlocalst.symtabletype in [objectsymtable,recordsymtable]) and
|
|
(
|
|
assigned(current_structdef) and
|
|
(
|
|
(current_structdef=symownerdef) or
|
|
(current_structdef.owner.iscurrentunit)
|
|
)
|
|
) or
|
|
(
|
|
not assigned(current_structdef) and
|
|
(symownerdef.owner.iscurrentunit)
|
|
) or
|
|
{ access from a generic method that belongs to the class
|
|
but that is specialized elsewere }
|
|
(
|
|
isspezproc and
|
|
(current_procinfo.procdef.struct=current_structdef)
|
|
) or
|
|
{ specializations may access private symbols that their
|
|
generics are allowed to access }
|
|
(
|
|
assigned(current_structdef) and
|
|
(df_specialization in current_structdef.defoptions) and
|
|
(symst.moduleid=current_structdef.genericdef.owner.moduleid)
|
|
)
|
|
);
|
|
end;
|
|
vis_strictprivate :
|
|
begin
|
|
result:=assigned(current_structdef) and
|
|
is_owned_by(current_structdef,symownerdef);
|
|
end;
|
|
vis_strictprotected :
|
|
begin
|
|
result:=(
|
|
{ access from nested class }
|
|
assigned(current_structdef) and
|
|
is_owned_by(current_structdef,symownerdef)
|
|
) or
|
|
(
|
|
{ access from child class }
|
|
assigned(contextobjdef) and
|
|
assigned(current_structdef) and
|
|
def_is_related(contextobjdef,symownerdef) and
|
|
def_is_related(current_structdef,contextobjdef)
|
|
) or
|
|
(
|
|
{ helpers can access strict protected symbols }
|
|
is_objectpascal_helper(contextobjdef) and
|
|
def_is_related(tobjectdef(contextobjdef).extendeddef,symownerdef)
|
|
) or
|
|
(
|
|
{ same as above, but from context of call node inside
|
|
helper method }
|
|
is_objectpascal_helper(current_structdef) and
|
|
def_is_related(tobjectdef(current_structdef).extendeddef,symownerdef)
|
|
);
|
|
end;
|
|
vis_protected :
|
|
begin
|
|
{ protected symbols are visible in the module that defines them and
|
|
also visible to related objects. The related object must be defined
|
|
in the current module }
|
|
result:=(
|
|
(
|
|
(nonlocalst.symtabletype in [globalsymtable,staticsymtable]) and
|
|
(nonlocalst.iscurrentunit)
|
|
) or
|
|
(
|
|
assigned(contextobjdef) and
|
|
(contextobjdef.owner.symtabletype in [globalsymtable,staticsymtable,ObjectSymtable,recordsymtable]) and
|
|
(contextobjdef.owner.iscurrentunit) and
|
|
def_is_related(contextobjdef,symownerdef)
|
|
) or
|
|
( // the case of specialize inside the generic declaration and nested types
|
|
(nonlocalst.symtabletype in [objectsymtable,recordsymtable]) and
|
|
(
|
|
assigned(current_structdef) and
|
|
(
|
|
(current_structdef=symownerdef) or
|
|
(current_structdef.owner.iscurrentunit)
|
|
)
|
|
) or
|
|
(
|
|
not assigned(current_structdef) and
|
|
(symownerdef.owner.iscurrentunit)
|
|
) or
|
|
(
|
|
{ helpers can access protected symbols }
|
|
is_objectpascal_helper(contextobjdef) and
|
|
def_is_related(tobjectdef(contextobjdef).extendeddef,symownerdef)
|
|
)
|
|
) or
|
|
{ access from a generic method that belongs to the class
|
|
but that is specialized elsewere }
|
|
(
|
|
isspezproc and
|
|
(current_procinfo.procdef.struct=current_structdef)
|
|
) or
|
|
{ specializations may access private symbols that their
|
|
generics are allowed to access }
|
|
(
|
|
assigned(current_structdef) and
|
|
(df_specialization in current_structdef.defoptions) and
|
|
(symst.moduleid=current_structdef.genericdef.owner.moduleid)
|
|
)
|
|
);
|
|
end;
|
|
vis_public,
|
|
vis_published :
|
|
result:=true;
|
|
end;
|
|
end;
|
|
|
|
|
|
function is_visible_for_object(pd:tprocdef;contextobjdef:tabstractrecorddef):boolean;
|
|
begin
|
|
result:=is_visible_for_object(pd.owner,pd.visibility,contextobjdef);
|
|
end;
|
|
|
|
|
|
function is_visible_for_object(sym:tsym;contextobjdef:tabstractrecorddef):boolean;
|
|
var
|
|
i : longint;
|
|
pd : tprocdef;
|
|
begin
|
|
if sym.typ=procsym then
|
|
begin
|
|
{ A procsym is visible, when there is at least one of the procdefs visible }
|
|
result:=false;
|
|
for i:=0 to tprocsym(sym).ProcdefList.Count-1 do
|
|
begin
|
|
pd:=tprocdef(tprocsym(sym).ProcdefList[i]);
|
|
if (pd.owner=sym.owner) and
|
|
is_visible_for_object(pd,contextobjdef) then
|
|
begin
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
result:=is_visible_for_object(sym.owner,sym.visibility,contextobjdef);
|
|
end;
|
|
|
|
|
|
function searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
|
begin
|
|
result:=searchsym_maybe_with_symoption(s,srsym,srsymtable,[],sp_none);
|
|
end;
|
|
|
|
|
|
function searchsym_with_flags(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;flags:tsymbol_search_flags):boolean;
|
|
begin
|
|
result:=searchsym_maybe_with_symoption(s,srsym,srsymtable,flags,sp_none);
|
|
end;
|
|
|
|
|
|
function searchsym_maybe_with_symoption(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;flags:tsymbol_search_flags;option:tsymoption):boolean;
|
|
var
|
|
hashedid: THashedIDString;
|
|
contextstructdef: tabstractrecorddef;
|
|
stackitem: psymtablestackitem;
|
|
begin
|
|
result:=false;
|
|
hashedid.id:=s;
|
|
stackitem:=symtablestack.stack;
|
|
while assigned(stackitem) do
|
|
begin
|
|
srsymtable:=stackitem^.symtable;
|
|
if (srsymtable.symtabletype=objectsymtable) then
|
|
begin
|
|
{ TODO : implement the search for an option in classes as well }
|
|
if ssf_search_option in flags then
|
|
begin
|
|
result:=false;
|
|
exit;
|
|
end;
|
|
if searchsym_in_class(tobjectdef(srsymtable.defowner),tobjectdef(srsymtable.defowner),s,srsym,srsymtable,flags+[ssf_search_helper]) then
|
|
begin
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end
|
|
else if not((srsymtable.symtabletype=withsymtable) and assigned(srsymtable.defowner) and
|
|
(srsymtable.defowner.typ=undefineddef)) then
|
|
begin
|
|
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
|
{ First check if it is a unit/namespace symbol.
|
|
They are visible only if they are from the current unit or
|
|
unit of generic of currently processed specialization. }
|
|
if assigned(srsym) and
|
|
(
|
|
not(srsym.typ in [unitsym,namespacesym]) or
|
|
srsymtable.iscurrentunit or
|
|
(assigned(current_specializedef)and(current_specializedef.genericdef.owner.moduleid=srsymtable.moduleid)) or
|
|
(
|
|
assigned(current_procinfo) and
|
|
(df_specialization in current_procinfo.procdef.defoptions) and
|
|
(current_procinfo.procdef.genericdef.owner.moduleid=srsymtable.moduleid)
|
|
)
|
|
) and
|
|
(not (ssf_search_option in flags) or (option in srsym.symoptions))then
|
|
begin
|
|
{ use the class from withsymtable only when it is
|
|
defined in this unit }
|
|
if (srsymtable.symtabletype=withsymtable) and
|
|
assigned(srsymtable.defowner) and
|
|
(srsymtable.defowner.typ in [recorddef,objectdef]) and
|
|
(srsymtable.defowner.owner.symtabletype in [globalsymtable,staticsymtable,objectsymtable,recordsymtable]) and
|
|
(srsymtable.defowner.owner.iscurrentunit) then
|
|
contextstructdef:=tabstractrecorddef(srsymtable.defowner)
|
|
else
|
|
contextstructdef:=current_structdef;
|
|
if not(srsym.owner.symtabletype in [objectsymtable,recordsymtable]) or
|
|
is_visible_for_object(srsym,contextstructdef) then
|
|
begin
|
|
{ we need to know if a procedure references symbols
|
|
in the static symtable, because then it can't be
|
|
inlined from outside this unit }
|
|
if assigned(current_procinfo) and
|
|
(srsym.owner.symtabletype=staticsymtable) then
|
|
include(current_procinfo.flags,pi_uses_static_symtable);
|
|
if not (ssf_no_addsymref in flags) then
|
|
addsymref(srsym);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
stackitem:=stackitem^.next;
|
|
end;
|
|
srsym:=nil;
|
|
srsymtable:=nil;
|
|
end;
|
|
|
|
function searchsym_with_symoption(const s: TIDString;out srsym:tsym;out
|
|
srsymtable:TSymtable;option:tsymoption):boolean;
|
|
begin
|
|
result:=searchsym_maybe_with_symoption(s,srsym,srsymtable,[ssf_search_option],option);
|
|
end;
|
|
|
|
function searchsym_type(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
|
var
|
|
hashedid : THashedIDString;
|
|
stackitem : psymtablestackitem;
|
|
classh : tobjectdef;
|
|
begin
|
|
result:=false;
|
|
hashedid.id:=s;
|
|
stackitem:=symtablestack.stack;
|
|
while assigned(stackitem) do
|
|
begin
|
|
{
|
|
It is not possible to have type symbols in:
|
|
parameters
|
|
Exception are classes, objects, records, generic definitions and specializations
|
|
that have the parameterized types inserted in the symtable.
|
|
}
|
|
srsymtable:=stackitem^.symtable;
|
|
if (srsymtable.symtabletype=ObjectSymtable) then
|
|
begin
|
|
classh:=tobjectdef(srsymtable.defowner);
|
|
while assigned(classh) do
|
|
begin
|
|
srsymtable:=classh.symtable;
|
|
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
|
if assigned(srsym) and
|
|
not(srsym.typ in [fieldvarsym,paravarsym,propertysym,procsym,labelsym]) and
|
|
is_visible_for_object(srsym,current_structdef) then
|
|
begin
|
|
addsymref(srsym);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
classh:=classh.childof;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
|
if assigned(srsym) and
|
|
(
|
|
not(srsym.typ in [unitsym,namespacesym]) or
|
|
srsymtable.iscurrentunit or
|
|
(assigned(current_specializedef)and(current_specializedef.genericdef.owner.moduleid=srsymtable.moduleid))
|
|
) and
|
|
not(srsym.typ in [fieldvarsym,paravarsym,propertysym,procsym,labelsym]) and
|
|
(not (srsym.owner.symtabletype in [objectsymtable,recordsymtable]) or is_visible_for_object(srsym,current_structdef)) then
|
|
begin
|
|
{ we need to know if a procedure references symbols
|
|
in the static symtable, because then it can't be
|
|
inlined from outside this unit }
|
|
if assigned(current_procinfo) and
|
|
(srsym.owner.symtabletype=staticsymtable) then
|
|
include(current_procinfo.flags,pi_uses_static_symtable);
|
|
addsymref(srsym);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
stackitem:=stackitem^.next;
|
|
end;
|
|
result:=false;
|
|
srsym:=nil;
|
|
srsymtable:=nil;
|
|
end;
|
|
|
|
|
|
function searchsym_in_module(pm:pointer;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
|
var
|
|
pmod : tmodule;
|
|
begin
|
|
pmod:=tmodule(pm);
|
|
result:=false;
|
|
if assigned(pmod.globalsymtable) then
|
|
begin
|
|
srsym:=tsym(pmod.globalsymtable.Find(s));
|
|
if assigned(srsym) then
|
|
begin
|
|
srsymtable:=pmod.globalsymtable;
|
|
addsymref(srsym);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
{ If the module is the current unit we also need
|
|
to search the local symtable }
|
|
if (pmod=current_module) and
|
|
assigned(pmod.localsymtable) then
|
|
begin
|
|
srsym:=tsym(pmod.localsymtable.Find(s));
|
|
if assigned(srsym) then
|
|
begin
|
|
srsymtable:=pmod.localsymtable;
|
|
addsymref(srsym);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
srsym:=nil;
|
|
srsymtable:=nil;
|
|
end;
|
|
|
|
|
|
function searchsym_in_named_module(const unitname, symname: TIDString; out srsym: tsym; out srsymtable: tsymtable): boolean;
|
|
var
|
|
stackitem : psymtablestackitem;
|
|
begin
|
|
result:=false;
|
|
stackitem:=symtablestack.stack;
|
|
while assigned(stackitem) do
|
|
begin
|
|
srsymtable:=stackitem^.symtable;
|
|
if (srsymtable.symtabletype=globalsymtable) and
|
|
(srsymtable.name^=unitname) then
|
|
begin
|
|
srsym:=tsym(srsymtable.find(symname));
|
|
if not assigned(srsym) then
|
|
break;
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
stackitem:=stackitem^.next;
|
|
end;
|
|
|
|
{ If the module is the current unit we also need
|
|
to search the local symtable }
|
|
if assigned(current_module.localsymtable) and
|
|
(current_module.localsymtable.name^=unitname) then
|
|
begin
|
|
srsymtable:=current_module.localsymtable;
|
|
srsym:=tsym(srsymtable.find(symname));
|
|
if assigned(srsym) then
|
|
begin
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function maybe_find_real_class_definition(pd: tdef; erroronfailure: boolean): tdef;
|
|
begin
|
|
result:=pd;
|
|
if pd.typ<>objectdef then
|
|
exit;
|
|
result:=find_real_class_definition(tobjectdef(pd),erroronfailure);
|
|
end;
|
|
|
|
|
|
function find_real_class_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
|
|
var
|
|
hashedid : THashedIDString;
|
|
stackitem : psymtablestackitem;
|
|
srsymtable : tsymtable;
|
|
srsym : tsym;
|
|
formalname,
|
|
foundname : shortstring;
|
|
formalnameptr,
|
|
foundnameptr: pshortstring;
|
|
begin
|
|
{ not a formal definition -> return it }
|
|
if not(oo_is_formal in pd.objectoptions) then
|
|
begin
|
|
result:=pd;
|
|
exit;
|
|
end;
|
|
hashedid.id:=pd.typesym.name;
|
|
stackitem:=symtablestack.stack;
|
|
while assigned(stackitem) do
|
|
begin
|
|
srsymtable:=stackitem^.symtable;
|
|
{ ObjC classes can't appear in generics or as nested class
|
|
definitions. Java classes can. }
|
|
if not(srsymtable.symtabletype in [recordsymtable,parasymtable]) or
|
|
(is_java_class_or_interface(pd) and
|
|
(srsymtable.symtabletype=ObjectSymtable)) then
|
|
begin
|
|
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
|
if assigned(srsym) and
|
|
(srsym.typ=typesym) and
|
|
(ttypesym(srsym).typedef.typ=objectdef) and
|
|
(tobjectdef(ttypesym(srsym).typedef).objecttype=pd.objecttype) and
|
|
not(oo_is_formal in tobjectdef(ttypesym(srsym).typedef).objectoptions) then
|
|
begin
|
|
if not(oo_is_forward in tobjectdef(ttypesym(srsym).typedef).objectoptions) then
|
|
begin
|
|
{ the external name for the formal and the real
|
|
definition must match }
|
|
if assigned(tobjectdef(ttypesym(srsym).typedef).import_lib) or
|
|
assigned(pd.import_lib) then
|
|
begin
|
|
if assigned(pd.import_lib) then
|
|
formalname:=pd.import_lib^+'.'
|
|
else
|
|
formalname:='';
|
|
formalname:=formalname+pd.objextname^;
|
|
if assigned(tobjectdef(ttypesym(srsym).typedef).import_lib) then
|
|
foundname:=tobjectdef(ttypesym(srsym).typedef).import_lib^+'.'
|
|
else
|
|
foundname:='';
|
|
foundname:=foundname+tobjectdef(ttypesym(srsym).typedef).objextname^;
|
|
|
|
formalnameptr:=@formalname;
|
|
foundnameptr:=@foundname;
|
|
end
|
|
else
|
|
begin
|
|
formalnameptr:=pd.objextname;
|
|
foundnameptr:=tobjectdef(ttypesym(srsym).typedef).objextname;
|
|
end;
|
|
if foundnameptr^<>formalnameptr^ then
|
|
begin
|
|
MessagePos2(pd.typesym.fileinfo,sym_e_external_class_name_mismatch1,formalnameptr^,pd.typename);
|
|
MessagePos1(srsym.fileinfo,sym_e_external_class_name_mismatch2,foundnameptr^);
|
|
end;
|
|
end;
|
|
result:=tobjectdef(ttypesym(srsym).typedef);
|
|
if assigned(current_procinfo) and
|
|
(srsym.owner.symtabletype=staticsymtable) then
|
|
include(current_procinfo.flags,pi_uses_static_symtable);
|
|
addsymref(srsym);
|
|
exit;
|
|
end;
|
|
end;
|
|
stackitem:=stackitem^.next;
|
|
end;
|
|
{ nothing found: optionally give an error and return the original
|
|
(empty) one }
|
|
if erroronfailure then
|
|
Message1(sym_e_formal_class_not_resolved,pd.objrealname^);
|
|
result:=pd;
|
|
end;
|
|
|
|
|
|
function searchsym_in_class(classh: tobjectdef;contextclassh:tabstractrecorddef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;flags:tsymbol_search_flags):boolean;
|
|
var
|
|
hashedid : THashedIDString;
|
|
orgclass : tobjectdef;
|
|
i : longint;
|
|
begin
|
|
orgclass:=classh;
|
|
{ in case this is a formal class, first find the real definition }
|
|
if assigned(classh) then
|
|
begin
|
|
if (oo_is_formal in classh.objectoptions) then
|
|
classh:=find_real_class_definition(classh,true);
|
|
{ The contextclassh is used for visibility. The classh must be equal to
|
|
or be a parent of contextclassh. E.g. for inherited searches the classh is the
|
|
parent or a class helper. }
|
|
if not (def_is_related(contextclassh,classh) or
|
|
(is_classhelper(contextclassh) and
|
|
assigned(tobjectdef(contextclassh).extendeddef) and
|
|
(tobjectdef(contextclassh).extendeddef.typ=objectdef) and
|
|
def_is_related(tobjectdef(contextclassh).extendeddef,classh))) then
|
|
internalerror(200811161);
|
|
end;
|
|
result:=false;
|
|
hashedid.id:=s;
|
|
{ an Objective-C protocol or Java interface can inherit from multiple
|
|
other protocols/interfaces -> use ImplementedInterfaces instead }
|
|
if is_objcprotocol(classh) or
|
|
is_javainterface(classh) then
|
|
begin
|
|
srsymtable:=classh.symtable;
|
|
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
|
if assigned(srsym) and
|
|
is_visible_for_object(srsym,contextclassh) then
|
|
begin
|
|
if not (ssf_no_addsymref in flags) then
|
|
addsymref(srsym);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
for i:=0 to classh.ImplementedInterfaces.count-1 do
|
|
begin
|
|
if searchsym_in_class(TImplementedInterface(classh.ImplementedInterfaces[i]).intfdef,contextclassh,s,srsym,srsymtable,flags-[ssf_search_helper]) then
|
|
begin
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
if is_objectpascal_helper(classh) then
|
|
begin
|
|
{ helpers have their own obscure search logic... }
|
|
result:=searchsym_in_helper(classh,tobjectdef(contextclassh),s,srsym,srsymtable,flags-[ssf_has_inherited]);
|
|
if result then
|
|
exit;
|
|
end
|
|
else
|
|
begin
|
|
while assigned(classh) do
|
|
begin
|
|
{ search for a class helper method first if this is an Object
|
|
Pascal class and we haven't yet found a helper symbol }
|
|
if (classh.objecttype in objecttypes_with_helpers) and
|
|
(ssf_search_helper in flags) then
|
|
begin
|
|
result:=search_objectpascal_helper(classh,contextclassh,s,srsym,srsymtable);
|
|
{ an eventual overload inside the extended type's hierarchy
|
|
will be found by tcallcandidates }
|
|
if result then
|
|
exit;
|
|
end;
|
|
srsymtable:=classh.symtable;
|
|
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
|
if assigned(srsym) and
|
|
is_visible_for_object(srsym,contextclassh) then
|
|
begin
|
|
if not (ssf_no_addsymref in flags) then
|
|
addsymref(srsym);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
classh:=classh.childof;
|
|
end;
|
|
end;
|
|
if is_objcclass(orgclass) then
|
|
result:=search_objc_helper(orgclass,s,srsym,srsymtable)
|
|
else
|
|
begin
|
|
srsym:=nil;
|
|
srsymtable:=nil;
|
|
end;
|
|
end;
|
|
|
|
function searchsym_in_record(recordh:tabstractrecorddef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
|
var
|
|
hashedid : THashedIDString;
|
|
begin
|
|
result:=false;
|
|
hashedid.id:=s;
|
|
{ search for a record helper method first }
|
|
result:=search_objectpascal_helper(recordh,recordh,s,srsym,srsymtable);
|
|
if result then
|
|
{ an eventual overload inside the extended type's hierarchy
|
|
will be found by tcallcandidates }
|
|
exit;
|
|
srsymtable:=recordh.symtable;
|
|
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
|
if assigned(srsym) and is_visible_for_object(srsym,recordh) then
|
|
begin
|
|
addsymref(srsym);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
srsym:=nil;
|
|
srsymtable:=nil;
|
|
end;
|
|
|
|
function searchsym_in_class_by_msgint(classh:tobjectdef;msgid:longint;out srdef : tdef;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
|
var
|
|
def : tdef;
|
|
i : longint;
|
|
begin
|
|
{ in case this is a formal class, first find the real definition }
|
|
if assigned(classh) and
|
|
(oo_is_formal in classh.objectoptions) then
|
|
classh:=find_real_class_definition(classh,true);
|
|
result:=false;
|
|
def:=nil;
|
|
while assigned(classh) do
|
|
begin
|
|
for i:=0 to classh.symtable.DefList.Count-1 do
|
|
begin
|
|
def:=tstoreddef(classh.symtable.DefList[i]);
|
|
{ Find also all hidden private methods to
|
|
be compatible with delphi, see tw6203 (PFV) }
|
|
if (def.typ=procdef) and
|
|
(po_msgint in tprocdef(def).procoptions) and
|
|
(tprocdef(def).messageinf.i=msgid) then
|
|
begin
|
|
srdef:=def;
|
|
srsym:=tprocdef(def).procsym;
|
|
srsymtable:=classh.symtable;
|
|
addsymref(srsym);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
classh:=classh.childof;
|
|
end;
|
|
srdef:=nil;
|
|
srsym:=nil;
|
|
srsymtable:=nil;
|
|
end;
|
|
|
|
|
|
function searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
|
var
|
|
def : tdef;
|
|
i : longint;
|
|
begin
|
|
{ in case this is a formal class, first find the real definition }
|
|
if assigned(classh) and
|
|
(oo_is_formal in classh.objectoptions) then
|
|
classh:=find_real_class_definition(classh,true);
|
|
result:=false;
|
|
def:=nil;
|
|
while assigned(classh) do
|
|
begin
|
|
for i:=0 to classh.symtable.DefList.Count-1 do
|
|
begin
|
|
def:=tstoreddef(classh.symtable.DefList[i]);
|
|
{ Find also all hidden private methods to
|
|
be compatible with delphi, see tw6203 (PFV) }
|
|
if (def.typ=procdef) and
|
|
(po_msgstr in tprocdef(def).procoptions) and
|
|
(tprocdef(def).messageinf.str^=s) then
|
|
begin
|
|
srsym:=tprocdef(def).procsym;
|
|
srsymtable:=classh.symtable;
|
|
addsymref(srsym);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
classh:=classh.childof;
|
|
end;
|
|
srsym:=nil;
|
|
srsymtable:=nil;
|
|
end;
|
|
|
|
function searchsym_in_helper(classh,contextclassh:tobjectdef;const s: TIDString;out srsym:tsym;out srsymtable:TSymtable;flags:tsymbol_search_flags):boolean;
|
|
var
|
|
hashedid : THashedIDString;
|
|
parentclassh : tobjectdef;
|
|
begin
|
|
result:=false;
|
|
if not is_objectpascal_helper(classh) then
|
|
Internalerror(2011030101);
|
|
hashedid.id:=s;
|
|
{ in a helper things are a bit more complex:
|
|
1. search the symbol in the helper (if not "inherited")
|
|
2. search the symbol in the extended type
|
|
3. search the symbol in the parent helpers
|
|
4. only classes: search the symbol in the parents of the extended type
|
|
}
|
|
if not (ssf_has_inherited in flags) then
|
|
begin
|
|
{ search in the helper itself }
|
|
srsymtable:=classh.symtable;
|
|
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
|
if assigned(srsym) and
|
|
is_visible_for_object(srsym,contextclassh) then
|
|
begin
|
|
if not (ssf_no_addsymref in flags) then
|
|
addsymref(srsym);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
{ now search in the extended type itself }
|
|
{ Note: the extendeddef might be Nil if we are currently parsing the
|
|
extended type itself and the identifier was not found }
|
|
if assigned(classh.extendeddef) and (classh.extendeddef.typ in [recorddef,objectdef]) then
|
|
begin
|
|
srsymtable:=tabstractrecorddef(classh.extendeddef).symtable;
|
|
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
|
if assigned(srsym) and
|
|
is_visible_for_object(srsym,contextclassh) then
|
|
begin
|
|
if not (ssf_no_addsymref in flags) then
|
|
addsymref(srsym);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
{ now search in the parent helpers }
|
|
parentclassh:=classh.childof;
|
|
while assigned(parentclassh) do
|
|
begin
|
|
srsymtable:=parentclassh.symtable;
|
|
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
|
if assigned(srsym) and
|
|
is_visible_for_object(srsym,contextclassh) then
|
|
begin
|
|
if not (ssf_no_addsymref in flags) then
|
|
addsymref(srsym);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
parentclassh:=parentclassh.childof;
|
|
end;
|
|
if is_class(classh.extendeddef) then
|
|
{ now search in the parents of the extended class (with helpers!) }
|
|
result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
|
|
{ addsymref is already called by searchsym_in_class }
|
|
end;
|
|
|
|
function search_specific_assignment_operator(assignment_type:ttoken;from_def,to_def:Tdef):Tprocdef;
|
|
var
|
|
sym : Tprocsym;
|
|
hashedid : THashedIDString;
|
|
curreq,
|
|
besteq : tequaltype;
|
|
currpd,
|
|
bestpd : tprocdef;
|
|
stackitem : psymtablestackitem;
|
|
begin
|
|
hashedid.id:=overloaded_names[assignment_type];
|
|
besteq:=te_incompatible;
|
|
bestpd:=nil;
|
|
stackitem:=symtablestack.stack;
|
|
while assigned(stackitem) do
|
|
begin
|
|
sym:=Tprocsym(stackitem^.symtable.FindWithHash(hashedid));
|
|
if sym<>nil then
|
|
begin
|
|
if sym.typ<>procsym then
|
|
internalerror(200402031);
|
|
{ if the source type is an alias then this is only the second choice,
|
|
if you mess with this code, check tw4093 }
|
|
currpd:=sym.find_procdef_assignment_operator(from_def,to_def,curreq);
|
|
if curreq>besteq then
|
|
begin
|
|
besteq:=curreq;
|
|
bestpd:=currpd;
|
|
if (besteq=te_exact) then
|
|
break;
|
|
end;
|
|
end;
|
|
stackitem:=stackitem^.next;
|
|
end;
|
|
result:=bestpd;
|
|
end;
|
|
|
|
|
|
function search_assignment_operator(from_def,to_def:Tdef;explicit:boolean):Tprocdef;
|
|
begin
|
|
{ search record/object symtable first for a suitable operator }
|
|
if from_def.typ in [recorddef,objectdef] then
|
|
symtablestack.push(tabstractrecorddef(from_def).symtable);
|
|
if to_def.typ in [recorddef,objectdef] then
|
|
symtablestack.push(tabstractrecorddef(to_def).symtable);
|
|
|
|
{ if type conversion is explicit then search first for explicit
|
|
operator overload and if not found then use implicit operator }
|
|
if explicit then
|
|
result:=search_specific_assignment_operator(_OP_EXPLICIT,from_def,to_def)
|
|
else
|
|
result:=nil;
|
|
if result=nil then
|
|
result:=search_specific_assignment_operator(_ASSIGNMENT,from_def,to_def);
|
|
|
|
{ restore symtable stack }
|
|
if to_def.typ in [recorddef,objectdef] then
|
|
symtablestack.pop(tabstractrecorddef(to_def).symtable);
|
|
if from_def.typ in [recorddef,objectdef] then
|
|
symtablestack.pop(tabstractrecorddef(from_def).symtable);
|
|
end;
|
|
|
|
|
|
function search_enumerator_operator(from_def,to_def:Tdef): Tprocdef;
|
|
var
|
|
sym : Tprocsym;
|
|
hashedid : THashedIDString;
|
|
curreq,
|
|
besteq : tequaltype;
|
|
currpd,
|
|
bestpd : tprocdef;
|
|
stackitem : psymtablestackitem;
|
|
begin
|
|
hashedid.id:='enumerator';
|
|
besteq:=te_incompatible;
|
|
bestpd:=nil;
|
|
stackitem:=symtablestack.stack;
|
|
while assigned(stackitem) do
|
|
begin
|
|
sym:=Tprocsym(stackitem^.symtable.FindWithHash(hashedid));
|
|
if sym<>nil then
|
|
begin
|
|
if sym.typ<>procsym then
|
|
internalerror(200910241);
|
|
{ if the source type is an alias then this is only the second choice,
|
|
if you mess with this code, check tw4093 }
|
|
currpd:=sym.find_procdef_enumerator_operator(from_def,to_def,curreq);
|
|
if curreq>besteq then
|
|
begin
|
|
besteq:=curreq;
|
|
bestpd:=currpd;
|
|
if (besteq=te_exact) then
|
|
break;
|
|
end;
|
|
end;
|
|
stackitem:=stackitem^.next;
|
|
end;
|
|
result:=bestpd;
|
|
end;
|
|
|
|
|
|
function search_management_operator(mop:tmanagementoperator;pd:Tdef):Tprocdef;
|
|
var
|
|
sym : Tprocsym;
|
|
hashedid : THashedIDString;
|
|
optoken: ttoken;
|
|
begin
|
|
optoken := managementoperator2tok[mop];
|
|
if (optoken<first_managment_operator) or
|
|
(optoken>last_managment_operator) then
|
|
internalerror(201602280);
|
|
hashedid.id:=overloaded_names[optoken];
|
|
if not (pd.typ in [recorddef]) then
|
|
internalerror(201602281);
|
|
sym:=Tprocsym(tabstractrecorddef(pd).symtable.FindWithHash(hashedid));
|
|
if sym<>nil then
|
|
begin
|
|
if sym.typ<>procsym then
|
|
internalerror(201602282);
|
|
result:=sym.find_procdef_bytype(potype_operator);
|
|
end
|
|
else
|
|
result:=nil;
|
|
end;
|
|
|
|
|
|
function search_system_type(const s: TIDString): ttypesym;
|
|
var
|
|
sym : tsym;
|
|
begin
|
|
sym:=tsym(systemunit.Find(s));
|
|
if not assigned(sym) or
|
|
(sym.typ<>typesym) then
|
|
message1(cg_f_unknown_system_type,s);
|
|
result:=ttypesym(sym);
|
|
end;
|
|
|
|
|
|
function try_search_system_type(const s: TIDString): ttypesym;
|
|
var
|
|
sym : tsym;
|
|
begin
|
|
sym:=tsym(systemunit.Find(s));
|
|
if not assigned(sym) then
|
|
result:=nil
|
|
else
|
|
begin
|
|
if sym.typ<>typesym then
|
|
message1(cg_f_unknown_system_type,s);
|
|
result:=ttypesym(sym);
|
|
end;
|
|
end;
|
|
|
|
|
|
function try_search_current_module_type(const s: TIDString): ttypesym;
|
|
var
|
|
found: boolean;
|
|
srsymtable: tsymtable;
|
|
srsym: tsym;
|
|
begin
|
|
if s[1]='$' then
|
|
found:=searchsym_in_module(current_module,copy(s,2,length(s)),srsym,srsymtable)
|
|
else
|
|
found:=searchsym_in_module(current_module,s,srsym,srsymtable);
|
|
if found then
|
|
begin
|
|
if (srsym.typ<>typesym) then
|
|
internalerror(2014091207);
|
|
result:=ttypesym(srsym);
|
|
end
|
|
else
|
|
result:=nil;
|
|
end;
|
|
|
|
|
|
function search_system_proc(const s: TIDString): tprocdef;
|
|
var
|
|
srsym: tsym;
|
|
begin
|
|
srsym:=tsym(systemunit.find(s));
|
|
if not assigned(srsym) and
|
|
(cs_compilesystem in current_settings.moduleswitches) then
|
|
srsym:=tsym(systemunit.Find(upper(s)));
|
|
if not assigned(srsym) or
|
|
(srsym.typ<>procsym) then
|
|
message1(cg_f_unknown_compilerproc,s);
|
|
result:=tprocdef(tprocsym(srsym).procdeflist[0]);
|
|
end;
|
|
|
|
|
|
function search_named_unit_globaltype(const unitname, typename: TIDString; throwerror: boolean): ttypesym;
|
|
var
|
|
srsymtable: tsymtable;
|
|
sym: tsym;
|
|
begin
|
|
sym:=nil;
|
|
if searchsym_in_named_module(unitname,typename,sym,srsymtable) and
|
|
(sym.typ=typesym) then
|
|
begin
|
|
result:=ttypesym(sym);
|
|
exit;
|
|
end
|
|
else
|
|
begin
|
|
if throwerror then
|
|
message2(cg_f_unknown_type_in_unit,typename,unitname);
|
|
result:=nil;
|
|
end;
|
|
end;
|
|
|
|
function search_last_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;out odef : tobjectdef):boolean;
|
|
var
|
|
s: string;
|
|
list: TFPObjectList;
|
|
i: integer;
|
|
st: tsymtable;
|
|
begin
|
|
result:=false;
|
|
odef:=nil;
|
|
{ when there are no helpers active currently then we don't need to do
|
|
anything }
|
|
if current_module.extendeddefs.count=0 then
|
|
exit;
|
|
{ no helpers for anonymous types }
|
|
if ((pd.typ in [recorddef,objectdef]) and
|
|
(
|
|
not assigned(tabstractrecorddef(pd).objrealname) or
|
|
(tabstractrecorddef(pd).objrealname^='')
|
|
)
|
|
) or
|
|
not assigned(pd.typesym) then
|
|
exit;
|
|
{ if pd is defined inside a procedure we must not use make_mangledname
|
|
(as a helper may not be defined in a procedure this is no problem...)}
|
|
st:=pd.owner;
|
|
while st.symtabletype in [objectsymtable,recordsymtable] do
|
|
st:=st.defowner.owner;
|
|
if st.symtabletype=localsymtable then
|
|
exit;
|
|
{ the mangled name is used as the key for tmodule.extendeddefs }
|
|
s:=generate_objectpascal_helper_key(pd);
|
|
list:=TFPObjectList(current_module.extendeddefs.Find(s));
|
|
if assigned(list) and (list.count>0) then
|
|
begin
|
|
i:=list.count-1;
|
|
repeat
|
|
odef:=tobjectdef(list[list.count-1]);
|
|
result:=(odef.owner.symtabletype in [staticsymtable,globalsymtable]) or
|
|
is_visible_for_object(tobjectdef(list[i]).typesym,contextclassh);
|
|
dec(i);
|
|
until result or (i<0);
|
|
if not result then
|
|
{ just to be sure that noone uses odef }
|
|
odef:=nil;
|
|
end;
|
|
end;
|
|
|
|
function search_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;const s: string; out srsym: tsym; out srsymtable: tsymtable):boolean;
|
|
|
|
var
|
|
hashedid : THashedIDString;
|
|
classh : tobjectdef;
|
|
i : integer;
|
|
pdef : tprocdef;
|
|
begin
|
|
result:=false;
|
|
|
|
{ if there is no class helper for the class then there is no need to
|
|
search further }
|
|
if not search_last_objectpascal_helper(pd,contextclassh,classh) then
|
|
exit;
|
|
|
|
hashedid.id:=s;
|
|
|
|
repeat
|
|
srsymtable:=classh.symtable;
|
|
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
|
|
|
if srsym<>nil then
|
|
begin
|
|
case srsym.typ of
|
|
procsym:
|
|
begin
|
|
for i:=0 to tprocsym(srsym).procdeflist.count-1 do
|
|
begin
|
|
pdef:=tprocdef(tprocsym(srsym).procdeflist[i]);
|
|
if not is_visible_for_object(pdef.owner,pdef.visibility,contextclassh) then
|
|
continue;
|
|
{ we need to know if a procedure references symbols
|
|
in the static symtable, because then it can't be
|
|
inlined from outside this unit }
|
|
if assigned(current_procinfo) and
|
|
(srsym.owner.symtabletype=staticsymtable) then
|
|
include(current_procinfo.flags,pi_uses_static_symtable);
|
|
{ the first found method wins }
|
|
srsym:=tprocdef(tprocsym(srsym).procdeflist[i]).procsym;
|
|
srsymtable:=srsym.owner;
|
|
addsymref(srsym);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
typesym,
|
|
fieldvarsym,
|
|
constsym,
|
|
enumsym,
|
|
undefinedsym,
|
|
propertysym:
|
|
begin
|
|
addsymref(srsym);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
else
|
|
internalerror(2014041101);
|
|
end;
|
|
end;
|
|
|
|
{ try the helper parent if available }
|
|
classh:=classh.childof;
|
|
until classh=nil;
|
|
|
|
srsym:=nil;
|
|
srsymtable:=nil;
|
|
end;
|
|
|
|
function search_objc_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
|
|
var
|
|
hashedid : THashedIDString;
|
|
stackitem : psymtablestackitem;
|
|
i : longint;
|
|
defowner : tobjectdef;
|
|
begin
|
|
hashedid.id:=class_helper_prefix+s;
|
|
stackitem:=symtablestack.stack;
|
|
while assigned(stackitem) do
|
|
begin
|
|
srsymtable:=stackitem^.symtable;
|
|
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
|
if assigned(srsym) then
|
|
begin
|
|
if not(srsymtable.symtabletype in [globalsymtable,staticsymtable]) or
|
|
not(srsym.owner.symtabletype in [globalsymtable,staticsymtable]) or
|
|
(srsym.typ<>procsym) then
|
|
internalerror(2009111505);
|
|
{ check whether this procsym includes a helper for this particular class }
|
|
for i:=0 to tprocsym(srsym).procdeflist.count-1 do
|
|
begin
|
|
{ does pd inherit from (or is the same as) the class
|
|
that this method's category extended?
|
|
|
|
Warning: this list contains both category and objcclass methods
|
|
(for id.randommethod), so only check category methods here
|
|
}
|
|
defowner:=tobjectdef(tprocdef(tprocsym(srsym).procdeflist[i]).owner.defowner);
|
|
if is_objccategory(defowner) and
|
|
def_is_related(pd,defowner.childof) then
|
|
begin
|
|
{ we need to know if a procedure references symbols
|
|
in the static symtable, because then it can't be
|
|
inlined from outside this unit }
|
|
if assigned(current_procinfo) and
|
|
(srsym.owner.symtabletype=staticsymtable) then
|
|
include(current_procinfo.flags,pi_uses_static_symtable);
|
|
{ no need to keep looking. There might be other
|
|
categories that extend this, a parent or child
|
|
class with a method with the same name (either
|
|
overriding this one, or overridden by this one),
|
|
but that doesn't matter as far as the basic
|
|
procsym is concerned.
|
|
}
|
|
srsym:=tprocdef(tprocsym(srsym).procdeflist[i]).procsym;
|
|
srsymtable:=srsym.owner;
|
|
addsymref(srsym);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
stackitem:=stackitem^.next;
|
|
end;
|
|
srsym:=nil;
|
|
srsymtable:=nil;
|
|
result:=false;
|
|
end;
|
|
|
|
|
|
function search_objc_method(const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
|
|
var
|
|
hashedid : THashedIDString;
|
|
stackitem : psymtablestackitem;
|
|
i : longint;
|
|
begin
|
|
hashedid.id:=class_helper_prefix+s;
|
|
stackitem:=symtablestack.stack;
|
|
while assigned(stackitem) do
|
|
begin
|
|
srsymtable:=stackitem^.symtable;
|
|
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
|
if assigned(srsym) then
|
|
begin
|
|
if not(srsymtable.symtabletype in [globalsymtable,staticsymtable]) or
|
|
not(srsym.owner.symtabletype in [globalsymtable,staticsymtable]) or
|
|
(srsym.typ<>procsym) then
|
|
internalerror(2009112005);
|
|
{ check whether this procsym includes a helper for this particular class }
|
|
for i:=0 to tprocsym(srsym).procdeflist.count-1 do
|
|
begin
|
|
{ we need to know if a procedure references symbols
|
|
in the static symtable, because then it can't be
|
|
inlined from outside this unit }
|
|
if assigned(current_procinfo) and
|
|
(srsym.owner.symtabletype=staticsymtable) then
|
|
include(current_procinfo.flags,pi_uses_static_symtable);
|
|
{ no need to keep looking. There might be other
|
|
methods with the same name, but that doesn't matter
|
|
as far as the basic procsym is concerned.
|
|
}
|
|
srsym:=tprocdef(tprocsym(srsym).procdeflist[i]).procsym;
|
|
{ We need the symtable in which the classhelper-like sym
|
|
is located, not the objectdef. The reason is that the
|
|
callnode will climb the symtablestack until it encounters
|
|
this symtable to start looking for overloads (and it won't
|
|
find the objectsymtable in which this method sym is
|
|
located
|
|
|
|
srsymtable:=srsym.owner;
|
|
}
|
|
addsymref(srsym);
|
|
result:=true;
|
|
exit;
|
|
end;
|
|
end;
|
|
stackitem:=stackitem^.next;
|
|
end;
|
|
srsym:=nil;
|
|
srsymtable:=nil;
|
|
result:=false;
|
|
end;
|
|
|
|
|
|
function search_struct_member(pd : tabstractrecorddef;const s : string):tsym;
|
|
{ searches n in symtable of pd and all anchestors }
|
|
var
|
|
srsymtable : tsymtable;
|
|
begin
|
|
{ in case this is a formal class, first find the real definition }
|
|
if (oo_is_formal in pd.objectoptions) then
|
|
pd:=find_real_class_definition(tobjectdef(pd),true);
|
|
|
|
if search_objectpascal_helper(pd, pd, s, result, srsymtable) then
|
|
exit;
|
|
|
|
result:=search_struct_member_no_helper(pd,s);
|
|
if assigned(result) then
|
|
exit;
|
|
|
|
{ not found, now look for class helpers }
|
|
if is_objcclass(pd) then
|
|
search_objc_helper(tobjectdef(pd),s,result,srsymtable)
|
|
end;
|
|
|
|
|
|
function search_struct_member_no_helper(pd: tabstractrecorddef; const s: string): tsym;
|
|
var
|
|
hashedid : THashedIDString;
|
|
srsym : tsym;
|
|
begin
|
|
hashedid.id:=s;
|
|
while assigned(pd) do
|
|
begin
|
|
srsym:=tsym(pd.symtable.FindWithHash(hashedid));
|
|
if assigned(srsym) then
|
|
begin
|
|
result:=srsym;
|
|
exit;
|
|
end;
|
|
if pd.typ=objectdef then
|
|
pd:=tobjectdef(pd).childof
|
|
else
|
|
pd:=nil;
|
|
end;
|
|
result:=nil;
|
|
end;
|
|
|
|
|
|
function search_macro(const s : string):tsym;
|
|
var
|
|
stackitem : psymtablestackitem;
|
|
hashedid : THashedIDString;
|
|
srsym : tsym;
|
|
begin
|
|
hashedid.id:=s;
|
|
|
|
{ First search the localmacrosymtable before searching the
|
|
global macrosymtables from the units }
|
|
if assigned(current_module) then
|
|
begin
|
|
srsym:=tsym(current_module.localmacrosymtable.FindWithHash(hashedid));
|
|
if assigned(srsym) then
|
|
begin
|
|
result:= srsym;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
stackitem:=macrosymtablestack.stack;
|
|
while assigned(stackitem) do
|
|
begin
|
|
srsym:=tsym(stackitem^.symtable.FindWithHash(hashedid));
|
|
if assigned(srsym) then
|
|
begin
|
|
result:= srsym;
|
|
exit;
|
|
end;
|
|
stackitem:=stackitem^.next;
|
|
end;
|
|
result:= nil;
|
|
end;
|
|
|
|
|
|
function defined_macro(const s : string):boolean;
|
|
var
|
|
mac: tmacro;
|
|
begin
|
|
mac:=tmacro(search_macro(s));
|
|
if assigned(mac) then
|
|
begin
|
|
mac.is_used:=true;
|
|
defined_macro:=mac.defined;
|
|
end
|
|
else
|
|
defined_macro:=false;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
Object Helpers
|
|
****************************************************************************}
|
|
|
|
function search_default_property(pd : tabstractrecorddef) : tpropertysym;
|
|
{ returns the default property of a class, searches also anchestors }
|
|
var
|
|
_defaultprop : tpropertysym;
|
|
helperpd : tobjectdef;
|
|
begin
|
|
_defaultprop:=nil;
|
|
{ first search in helper's hierarchy }
|
|
if search_last_objectpascal_helper(pd,nil,helperpd) then
|
|
while assigned(helperpd) do
|
|
begin
|
|
helperpd.symtable.SymList.ForEachCall(@tstoredsymtable(helperpd.symtable).testfordefaultproperty,@_defaultprop);
|
|
if assigned(_defaultprop) then
|
|
break;
|
|
helperpd:=helperpd.childof;
|
|
end;
|
|
if assigned(_defaultprop) then
|
|
begin
|
|
search_default_property:=_defaultprop;
|
|
exit;
|
|
end;
|
|
{ now search in the type's hierarchy itself }
|
|
while assigned(pd) do
|
|
begin
|
|
pd.symtable.SymList.ForEachCall(@tstoredsymtable(pd.symtable).testfordefaultproperty,@_defaultprop);
|
|
if assigned(_defaultprop) then
|
|
break;
|
|
if (pd.typ=objectdef) then
|
|
pd:=tobjectdef(pd).childof
|
|
else
|
|
break;
|
|
end;
|
|
search_default_property:=_defaultprop;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
Macro Helpers
|
|
****************************************************************************}
|
|
|
|
procedure def_system_macro(const name : string);
|
|
var
|
|
mac : tmacro;
|
|
s: string;
|
|
begin
|
|
if name = '' then
|
|
internalerror(2004121202);
|
|
s:= upper(name);
|
|
mac:=tmacro(search_macro(s));
|
|
if not assigned(mac) then
|
|
begin
|
|
mac:=tmacro.create(s);
|
|
if assigned(current_module) then
|
|
current_module.localmacrosymtable.insert(mac)
|
|
else
|
|
initialmacrosymtable.insert(mac);
|
|
end;
|
|
Message1(parser_c_macro_defined,mac.name);
|
|
mac.defined:=true;
|
|
end;
|
|
|
|
|
|
procedure set_system_macro(const name, value : string);
|
|
var
|
|
mac : tmacro;
|
|
s: string;
|
|
begin
|
|
if name = '' then
|
|
internalerror(2004121203);
|
|
s:= upper(name);
|
|
mac:=tmacro(search_macro(s));
|
|
if not assigned(mac) then
|
|
begin
|
|
mac:=tmacro.create(s);
|
|
if assigned(current_module) then
|
|
current_module.localmacrosymtable.insert(mac)
|
|
else
|
|
initialmacrosymtable.insert(mac);
|
|
end
|
|
else
|
|
begin
|
|
mac.is_compiler_var:=false;
|
|
if assigned(mac.buftext) then
|
|
freemem(mac.buftext,mac.buflen);
|
|
end;
|
|
Message2(parser_c_macro_set_to,mac.name,value);
|
|
mac.buflen:=length(value);
|
|
getmem(mac.buftext,mac.buflen);
|
|
move(value[1],mac.buftext^,mac.buflen);
|
|
mac.defined:=true;
|
|
end;
|
|
|
|
|
|
procedure set_system_compvar(const name, value : string);
|
|
var
|
|
mac : tmacro;
|
|
s: string;
|
|
begin
|
|
if name = '' then
|
|
internalerror(2004121204);
|
|
s:= upper(name);
|
|
mac:=tmacro(search_macro(s));
|
|
if not assigned(mac) then
|
|
begin
|
|
mac:=tmacro.create(s);
|
|
mac.is_compiler_var:=true;
|
|
if assigned(current_module) then
|
|
current_module.localmacrosymtable.insert(mac)
|
|
else
|
|
initialmacrosymtable.insert(mac);
|
|
end
|
|
else
|
|
begin
|
|
mac.is_compiler_var:=true;
|
|
if assigned(mac.buftext) then
|
|
freemem(mac.buftext,mac.buflen);
|
|
end;
|
|
Message2(parser_c_macro_set_to,mac.name,value);
|
|
mac.buflen:=length(value);
|
|
getmem(mac.buftext,mac.buflen);
|
|
move(value[1],mac.buftext^,mac.buflen);
|
|
mac.defined:=true;
|
|
end;
|
|
|
|
|
|
procedure undef_system_macro(const name : string);
|
|
var
|
|
mac : tmacro;
|
|
s: string;
|
|
begin
|
|
if name = '' then
|
|
internalerror(2004121205);
|
|
s:= upper(name);
|
|
mac:=tmacro(search_macro(s));
|
|
if not assigned(mac) then
|
|
{If not found, then it's already undefined.}
|
|
else
|
|
begin
|
|
Message1(parser_c_macro_undefined,mac.name);
|
|
mac.defined:=false;
|
|
mac.is_compiler_var:=false;
|
|
{ delete old definition }
|
|
if assigned(mac.buftext) then
|
|
begin
|
|
freemem(mac.buftext,mac.buflen);
|
|
mac.buftext:=nil;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{$ifdef UNITALIASES}
|
|
{****************************************************************************
|
|
TUNIT_ALIAS
|
|
****************************************************************************}
|
|
|
|
constructor tunit_alias.create(const n:string);
|
|
var
|
|
i : longint;
|
|
begin
|
|
i:=pos('=',n);
|
|
if i=0 then
|
|
fail;
|
|
inherited createname(Copy(n,1,i-1));
|
|
newname:=stringdup(Copy(n,i+1,255));
|
|
end;
|
|
|
|
|
|
destructor tunit_alias.destroy;
|
|
begin
|
|
stringdispose(newname);
|
|
inherited destroy;
|
|
end;
|
|
|
|
|
|
procedure addunitalias(const n:string);
|
|
begin
|
|
unitaliases^.insert(tunit_alias,init(Upper(n))));
|
|
end;
|
|
|
|
|
|
function getunitalias(const n:string):string;
|
|
var
|
|
p : punit_alias;
|
|
begin
|
|
p:=punit_alias(unitaliases^.Find(Upper(n)));
|
|
if assigned(p) then
|
|
getunitalias:=punit_alias(p).newname^
|
|
else
|
|
getunitalias:=n;
|
|
end;
|
|
{$endif UNITALIASES}
|
|
|
|
|
|
{****************************************************************************
|
|
Init/Done Symtable
|
|
****************************************************************************}
|
|
|
|
procedure InitSymtable;
|
|
begin
|
|
{ Reset symbolstack }
|
|
symtablestack:=nil;
|
|
systemunit:=nil;
|
|
{ create error syms and def }
|
|
generrorsym:=terrorsym.create;
|
|
generrordef:=cerrordef.create;
|
|
{ macros }
|
|
initialmacrosymtable:=tmacrosymtable.create(false);
|
|
macrosymtablestack:=TSymtablestack.create;
|
|
macrosymtablestack.push(initialmacrosymtable);
|
|
{$ifdef UNITALIASES}
|
|
{ unit aliases }
|
|
unitaliases:=TFPHashObjectList.create;
|
|
{$endif}
|
|
{ set some global vars to nil, might be important for the ide }
|
|
class_tobject:=nil;
|
|
interface_iunknown:=nil;
|
|
interface_idispatch:=nil;
|
|
rec_tguid:=nil;
|
|
rec_jmp_buf:=nil;
|
|
rec_exceptaddr:=nil;
|
|
objc_metaclasstype:=nil;
|
|
objc_superclasstype:=nil;
|
|
objc_idtype:=nil;
|
|
objc_seltype:=nil;
|
|
objc_objecttype:=nil;
|
|
dupnr:=0;
|
|
end;
|
|
|
|
|
|
procedure DoneSymtable;
|
|
begin
|
|
generrorsym.owner:=nil;
|
|
generrorsym.free;
|
|
generrordef.owner:=nil;
|
|
generrordef.free;
|
|
initialmacrosymtable.free;
|
|
macrosymtablestack.free;
|
|
{$ifdef UNITALIASES}
|
|
unitaliases.free;
|
|
{$endif}
|
|
end;
|
|
|
|
end.
|