{ $Id$ Copyright (c) 1998-2000 by Florian Klaempfl, Pierre Muller Interface for the definition types of the symtable 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. **************************************************************************** } {************************************************ TDef ************************************************} tdef = object(tsymtableentry) deftype : tdeftype; typesym : ptypesym; { which type the definition was generated this def } has_inittable : boolean; { adress of init informations } inittable_label : pasmlabel; has_rtti : boolean; { address of rtti } rtti_label : pasmlabel; nextglobal, previousglobal : pdef; {$ifdef GDB} globalnb : word; is_def_stab_written : tdefstabstatus; {$endif GDB} constructor init; constructor load; destructor done;virtual; procedure deref;virtual; function typename:string; procedure write;virtual; function size:longint;virtual; function alignment:longint;virtual; function gettypename:string;virtual; function is_publishable : boolean;virtual; function is_in_current : boolean; procedure correct_owner_symtable; { registers enumdef inside objects or record directly in the owner symtable !! } { debug } {$ifdef GDB} function stabstring : pchar;virtual; procedure concatstabto(asmlist : paasmoutput);virtual; function NumberString:string; procedure set_globalnb;virtual; function allstabstring : pchar; {$endif GDB} { init. tables } function needs_inittable : boolean;virtual; procedure generate_inittable; function get_inittable_label : pasmlabel; { the default implemenation calls write_rtti_data } { if init and rtti data is different these procedures } { must be overloaded } procedure write_init_data;virtual; procedure write_child_init_data;virtual; { rtti } procedure write_rtti_name; function get_rtti_label : string;virtual; procedure generate_rtti;virtual; procedure write_rtti_data;virtual; procedure write_child_rtti_data;virtual; function is_intregable : boolean; function is_fpuregable : boolean; private savesize : longint; end; targconvtyp = (act_convertable,act_equal,act_exact); tvarspez = (vs_value,vs_const,vs_var,vs_out); pparaitem = ^tparaitem; tparaitem = object(tlinkedlist_item) paratype : ttype; paratyp : tvarspez; argconvtyp : targconvtyp; convertlevel : byte; register : tregister; defaultvalue : psym; { pconstsym } end; { this is only here to override the count method, which can't be used } pparalinkedlist = ^tparalinkedlist; tparalinkedlist = object(tlinkedlist) function count:longint; end; tfiletyp = (ft_text,ft_typed,ft_untyped); pfiledef = ^tfiledef; tfiledef = object(tdef) filetyp : tfiletyp; typedfiletype : ttype; constructor inittext; constructor inituntyped; constructor inittyped(const tt : ttype); constructor inittypeddef(p : pdef); constructor load; procedure write;virtual; procedure deref;virtual; function gettypename:string;virtual; procedure setsize; { debug } {$ifdef GDB} function stabstring : pchar;virtual; procedure concatstabto(asmlist : paasmoutput);virtual; {$endif GDB} end; pformaldef = ^tformaldef; tformaldef = object(tdef) constructor init; constructor load; procedure write;virtual; function gettypename:string;virtual; {$ifdef GDB} function stabstring : pchar;virtual; procedure concatstabto(asmlist : paasmoutput);virtual; {$endif GDB} end; pforwarddef = ^tforwarddef; tforwarddef = object(tdef) tosymname : string; forwardpos : tfileposinfo; constructor init(const s:string;const pos : tfileposinfo); function gettypename:string;virtual; end; perrordef = ^terrordef; terrordef = object(tdef) constructor init; function gettypename:string;virtual; { debug } {$ifdef GDB} function stabstring : pchar;virtual; {$endif GDB} end; { tpointerdef and tclassrefdef should get a common base class, but I derived tclassrefdef from tpointerdef to avoid problems with bugs (FK) } ppointerdef = ^tpointerdef; tpointerdef = object(tdef) pointertype : ttype; is_far : boolean; constructor init(const tt : ttype); constructor initfar(const tt : ttype); constructor initdef(p : pdef); constructor initfardef(p : pdef); constructor load; destructor done;virtual; procedure write;virtual; procedure deref;virtual; function gettypename:string;virtual; { debug } {$ifdef GDB} function stabstring : pchar;virtual; procedure concatstabto(asmlist : paasmoutput);virtual; {$endif GDB} {private} public { I don't know the use of this FK } pointertypeis_forwarddef: boolean; end; pprocdef = ^tprocdef; pimplementedinterfaces = ^timplementedinterfaces; pobjectdef = ^tobjectdef; tobjectdef = object(tdef) childof : pobjectdef; objname : pstring; symtable : psymtable; objectoptions : tobjectoptions; { to be able to have a variable vmt position } { and no vmt field for objects without virtuals } vmt_offset : longint; {$ifdef GDB} classglobalnb, classptrglobalnb : word; writing_stabs : boolean; {$endif GDB} objecttype : tobjectdeftype; isiidguidvalid: boolean; iidguid: TGUID; iidstr: pstring; lastvtableindex: longint; { store implemented interfaces defs and name mappings } implementedinterfaces: pimplementedinterfaces; constructor init(odt : tobjectdeftype; const n : string;c : pobjectdef); constructor load; destructor done;virtual; procedure write;virtual; procedure deref;virtual; function size : longint;virtual; function alignment:longint;virtual; function vmtmethodoffset(index:longint):longint; function is_publishable : boolean;virtual; function vmt_mangledname : string; function rtti_name : string; procedure check_forwards; function is_related(d : pobjectdef) : boolean; function next_free_name_index : longint; procedure insertvmt; procedure set_parent(c : pobjectdef); function searchdestructor : pprocdef; { debug } {$ifdef GDB} function stabstring : pchar;virtual; procedure set_globalnb;virtual; function classnumberstring : string; function classptrnumberstring : string; procedure concatstabto(asmlist : paasmoutput);virtual; {$endif GDB} { init/final } function needs_inittable : boolean;virtual; procedure write_init_data;virtual; procedure write_child_init_data;virtual; { rtti } function get_rtti_label : string;virtual; procedure generate_rtti;virtual; procedure write_rtti_data;virtual; procedure write_child_rtti_data;virtual; function generate_field_table : pasmlabel; end; timplementedinterfaces = object constructor init; destructor done; virtual; function count: longint; function interfaces(intfindex: longint): pobjectdef; function ioffsets(intfindex: longint): plongint; function searchintf(def: pdef): longint; procedure addintf(def: pdef); procedure deref; procedure addintfref(def: pdef); procedure clearmappings; procedure addmappings(intfindex: longint; const name, newname: string); function getmappings(intfindex: longint; const name: string; var nextexist: pointer): string; procedure clearimplprocs; procedure addimplproc(intfindex: longint; procdef: pprocdef); function implproccount(intfindex: longint): longint; function implprocs(intfindex: longint; procindex: longint): pprocdef; function isimplmergepossible(intfindex, remainindex: longint; var weight: longint): boolean; private finterfaces: tindexarray; procedure checkindex(intfindex: longint); end; pclassrefdef = ^tclassrefdef; tclassrefdef = object(tpointerdef) constructor init(def : pdef); constructor load; procedure write;virtual; function gettypename:string;virtual; { debug } {$ifdef GDB} function stabstring : pchar;virtual; procedure concatstabto(asmlist : paasmoutput);virtual; {$endif GDB} end; parraydef = ^tarraydef; tarraydef = object(tdef) private rangenr : longint; public lowrange, highrange : longint; elementtype, rangetype : ttype; IsDynamicArray, IsVariant, IsConstructor, IsArrayOfConst : boolean; function gettypename:string;virtual; function elesize : longint; constructor init(l,h : longint;rd : pdef); constructor load; procedure write;virtual; {$ifdef GDB} function stabstring : pchar;virtual; procedure concatstabto(asmlist : paasmoutput);virtual; {$endif GDB} procedure deref;virtual; function size : longint;virtual; function alignment : longint;virtual; { generates the ranges needed by the asm instruction BOUND (i386) or CMP2 (Motorola) } procedure genrangecheck; { returns the label of the range check string } function getrangecheckstring : string; function needs_inittable : boolean;virtual; procedure write_rtti_data;virtual; procedure write_child_rtti_data;virtual; end; precorddef = ^trecorddef; trecorddef = object(tdef) symtable : psymtable; constructor init(p : psymtable); constructor load; destructor done;virtual; procedure write;virtual; procedure deref;virtual; function size:longint;virtual; function alignment : longint;virtual; function gettypename:string;virtual; { debug } {$ifdef GDB} function stabstring : pchar;virtual; procedure concatstabto(asmlist : paasmoutput);virtual; {$endif GDB} { init/final } procedure write_init_data;virtual; procedure write_child_init_data;virtual; function needs_inittable : boolean;virtual; { rtti } procedure write_rtti_data;virtual; procedure write_child_rtti_data;virtual; end; porddef = ^torddef; torddef = object(tdef) private rangenr : longint; public low,high : longint; typ : tbasetype; constructor init(t : tbasetype;v,b : longint); constructor load; procedure write;virtual; function is_publishable : boolean;virtual; function gettypename:string;virtual; procedure setsize; { generates the ranges needed by the asm instruction BOUND } { or CMP2 (Motorola) } procedure genrangecheck; function getrangecheckstring : string; { debug } {$ifdef GDB} function stabstring : pchar;virtual; {$endif GDB} { rtti } procedure write_rtti_data;virtual; end; pfloatdef = ^tfloatdef; tfloatdef = object(tdef) typ : tfloattype; constructor init(t : tfloattype); constructor load; procedure write;virtual; function gettypename:string;virtual; function is_publishable : boolean;virtual; procedure setsize; { debug } {$ifdef GDB} function stabstring : pchar;virtual; {$endif GDB} { rtti } procedure write_rtti_data;virtual; end; pabstractprocdef = ^tabstractprocdef; tabstractprocdef = object(tdef) { saves a definition to the return type } rettype : ttype; proctypeoption : tproctypeoption; proccalloptions : tproccalloptions; procoptions : tprocoptions; para : pparalinkedlist; maxparacount, minparacount : longint; symtablelevel : byte; fpu_used : byte; { how many stack fpu must be empty } constructor init; constructor load; destructor done;virtual; procedure write;virtual; procedure deref;virtual; procedure concatpara(tt:ttype;vsp : tvarspez;defval:psym); function para_size(alignsize:longint) : longint; function demangled_paras : string; function proccalloption2str : string; procedure test_if_fpu_result; { debug } {$ifdef GDB} function stabstring : pchar;virtual; procedure concatstabto(asmlist : paasmoutput);virtual; {$endif GDB} end; pprocvardef = ^tprocvardef; tprocvardef = object(tabstractprocdef) constructor init; constructor load; procedure write;virtual; function size : longint;virtual; function gettypename:string;virtual; function is_publishable : boolean;virtual; { debug } {$ifdef GDB} function stabstring : pchar;virtual; procedure concatstabto(asmlist : paasmoutput); virtual; {$endif GDB} { rtti } procedure write_child_rtti_data;virtual; procedure write_rtti_data;virtual; end; tmessageinf = record case integer of 0 : (str : pchar); 1 : (i : longint); end; tprocdef = object(tabstractprocdef) private _mangledname : pstring; public extnumber : longint; messageinf : tmessageinf; nextoverloaded : pprocdef; { where is this function defined, needed here because there is only one symbol for all overloaded functions } fileinfo : tfileposinfo; { pointer to the local symbol table } localst : psymtable; { pointer to the parameter symbol table } parast : psymtable; { symbol owning this definition } procsym : pprocsym; { browser info } lastref, defref, crossref, lastwritten : pref; refcount : longint; _class : pobjectdef; { it's a tree, but this not easy to handle } { used for inlined procs } code : pointer; { info about register variables (JM) } regvarinfo: pointer; { true, if the procedure is only declared } { (forward procedure) } forwarddef, { true if the procedure is declared in the interface } interfacedef : boolean; { true if the procedure has a forward declaration } hasforward : boolean; { check the problems of manglednames } count : boolean; is_used : boolean; { small set which contains the modified registers } {$ifdef newcg} usedregisters : tregisterset; {$else newcg} usedregisters : longint; {$endif newcg} constructor init; constructor load; destructor done;virtual; procedure write;virtual; procedure deref;virtual; function haspara:boolean; function mangledname : string; procedure setmangledname(const s : string); procedure load_references; function write_references : boolean; {$ifdef dummy} function procname: string; {$endif dummy} function cplusplusmangledname : string; { debug } {$ifdef GDB} function stabstring : pchar;virtual; procedure concatstabto(asmlist : paasmoutput);virtual; {$endif GDB} { browser } {$ifdef BrowserLog} procedure add_to_browserlog; {$endif BrowserLog} end; pstringdef = ^tstringdef; tstringdef = object(tdef) string_typ : tstringtype; len : longint; constructor shortinit(l : byte); constructor shortload; constructor longinit(l : longint); constructor longload; constructor ansiinit(l : longint); constructor ansiload; constructor wideinit(l : longint); constructor wideload; function stringtypname:string; function size : longint;virtual; procedure write;virtual; function gettypename:string;virtual; function is_publishable : boolean;virtual; { debug } {$ifdef GDB} function stabstring : pchar;virtual; procedure concatstabto(asmlist : paasmoutput);virtual; {$endif GDB} { init/final } function needs_inittable : boolean;virtual; { rtti } procedure write_rtti_data;virtual; end; penumdef = ^tenumdef; tenumdef = object(tdef) rangenr, minval, maxval : longint; has_jumps : boolean; firstenum : penumsym; basedef : penumdef; constructor init; constructor init_subrange(_basedef:penumdef;_min,_max:longint); constructor load; destructor done;virtual; procedure write;virtual; procedure deref;virtual; function gettypename:string;virtual; function is_publishable : boolean;virtual; procedure calcsavesize; procedure setmax(_max:longint); procedure setmin(_min:longint); function min:longint; function max:longint; function getrangecheckstring:string; procedure genrangecheck; { debug } {$ifdef GDB} function stabstring : pchar;virtual; {$endif GDB} { rtti } procedure write_child_rtti_data;virtual; procedure write_rtti_data;virtual; end; psetdef = ^tsetdef; tsetdef = object(tdef) elementtype : ttype; settype : tsettype; constructor init(s : pdef;high : longint); constructor load; destructor done;virtual; procedure write;virtual; procedure deref;virtual; function gettypename:string;virtual; function is_publishable : boolean;virtual; { debug } {$ifdef GDB} function stabstring : pchar;virtual; procedure concatstabto(asmlist : paasmoutput);virtual; {$endif GDB} { rtti } procedure write_rtti_data;virtual; procedure write_child_rtti_data;virtual; end; { $Log$ Revision 1.15 2000-11-04 14:25:22 florian + merged Attila's changes for interfaces, not tested yet Revision 1.14 2000/10/31 22:02:52 peter * symtable splitted, no real code changes Revision 1.13 2000/10/21 18:16:12 florian * a lot of changes: - basic dyn. array support - basic C++ support - some work for interfaces done .... Revision 1.12 2000/10/15 07:47:52 peter * unit names and procedure names are stored mixed case Revision 1.11 2000/10/14 10:14:53 peter * moehrendorf oct 2000 rewrite Revision 1.10 2000/09/24 15:06:29 peter * use defines.inc Revision 1.9 2000/09/19 23:08:03 pierre * fixes for local class debuggging problem (merged) Revision 1.8 2000/08/21 11:27:44 pierre * fix the stabs problems Revision 1.7 2000/08/06 19:39:28 peter * default parameters working ! Revision 1.6 2000/08/06 14:17:15 peter * overload fixes (merged) Revision 1.5 2000/08/03 13:17:26 jonas + allow regvars to be used inside inlined procs, which required the following changes: + load regvars in genentrycode/free them in genexitcode (cgai386) * moved all regvar related code to new regvars unit + added pregvarinfo type to hcodegen + added regvarinfo field to tprocinfo (symdef/symdefh) * deallocate the regvars of the caller in secondprocinline before inlining the called procedure and reallocate them afterwards Revision 1.4 2000/08/02 19:49:59 peter * first things for default parameters Revision 1.3 2000/07/13 12:08:27 michael + patched to 1.1.0 with former 1.09patch from peter Revision 1.2 2000/07/13 11:32:49 michael + removed logs }