|
|
@@ -1,1588 +0,0 @@
|
|
|
-{
|
|
|
- $Id$
|
|
|
-
|
|
|
- Copyright (C) 1998-2000 by Daniel Mantione
|
|
|
- and other members of the Free Pascal development team
|
|
|
-
|
|
|
- This unit handles symbols
|
|
|
-
|
|
|
- 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.
|
|
|
- ****************************************************************************
|
|
|
-}
|
|
|
-{$ifdef TP}
|
|
|
- {$N+,E+,F+}
|
|
|
-{$endif}
|
|
|
-
|
|
|
-unit symbols;
|
|
|
-
|
|
|
-interface
|
|
|
-
|
|
|
-uses symtable,aasm,objects,cobjects,defs,cpubase,tokens;
|
|
|
-
|
|
|
-{Note: It is forbidden to add the symtablt unit. A symbol should not now in
|
|
|
- which symtable it is.}
|
|
|
-
|
|
|
-{The tokens unit is only needed for the overloaded operators array. This
|
|
|
- array can better be moved into another unit.}
|
|
|
-
|
|
|
-type Ttypeprop=(sp_primary_typesym);
|
|
|
- Ttypepropset=set of Ttypeprop;
|
|
|
-
|
|
|
- Tobjprop=(sp_public,sp_private,sp_protected,sp_published,sp_static);
|
|
|
- Tobjpropset=set of Tobjprop;
|
|
|
-
|
|
|
- Tpropprop=(ppo_indexed,ppo_defaultproperty,
|
|
|
- ppo_stored,ppo_published,ppo_hasparameters);
|
|
|
- Tproppropset=set of Tpropprop;
|
|
|
-
|
|
|
- Tvarprop=(vo_regable,vo_fpuregable,vo_is_C_var,vo_is_external,
|
|
|
- vo_is_dll_var,vo_is_thread_var);
|
|
|
- Tvarpropset=set of Tvarprop;
|
|
|
-
|
|
|
- {State of a variable, if it's declared, assigned or used.}
|
|
|
- Tvarstate=(vs_none,vs_declared,vs_declared_and_first_found,
|
|
|
- vs_set_but_first_not_passed,vs_assigned,vs_used);
|
|
|
-
|
|
|
- Plabelsym=^Tlabelsym;
|
|
|
- Tlabelsym=object(Tsym)
|
|
|
- lab:Pasmlabel;
|
|
|
- defined:boolean;
|
|
|
- constructor init(const n:string;l:Pasmlabel);
|
|
|
- constructor load(var s:Tstream);
|
|
|
- function mangledname:string;virtual;
|
|
|
- procedure store(var s:Tstream);virtual;
|
|
|
- end;
|
|
|
-
|
|
|
-{ Punitsym=^Tunitsym;
|
|
|
- Tunitsym=object(Tsym)
|
|
|
- unitsymtable : punitsymtable;
|
|
|
- prevsym : punitsym;
|
|
|
- refs : longint;
|
|
|
- constructor init(const n : string;ref : punitsymtable);
|
|
|
- constructor load(var s:Tstream);
|
|
|
- destructor done;virtual;
|
|
|
- procedure store(var s:Tstream);virtual;
|
|
|
- end;}
|
|
|
-
|
|
|
- Perrorsym=^Terrorsym;
|
|
|
- Terrorsym=object(tsym)
|
|
|
- constructor init;
|
|
|
- end;
|
|
|
-
|
|
|
- Pprocsym=^Tprocsym;
|
|
|
- Tprocsym=object(Tsym)
|
|
|
- definitions:Pobject; {Is Pprocdef when procedure not
|
|
|
- overloaded, or a Pcollection of
|
|
|
- Pprocdef when it is overloaded.
|
|
|
- Since most procedures are not
|
|
|
- overloaded, this saves a lot of
|
|
|
- memory.}
|
|
|
- objprop:Tobjpropset; {All overloaded procedures should
|
|
|
- have the same scope, so the object
|
|
|
- scope information is put in the
|
|
|
- symbol.}
|
|
|
- sub_of:Pprocsym;
|
|
|
- _class:Pobjectdef;
|
|
|
- constructor init(const n:string;Asub_of:Pprocsym);
|
|
|
- constructor load(var s:Tstream);
|
|
|
- function count:word;
|
|
|
- function firstthat(action:pointer):Pprocdef;
|
|
|
- procedure foreach(action:pointer);
|
|
|
- procedure insert(def:Pprocdef);
|
|
|
- function mangledname:string;virtual; {Causes internalerror.}
|
|
|
- {Writes all declarations.}
|
|
|
- procedure write_parameter_lists;
|
|
|
- {Tests, if all procedures definitions are defined and not
|
|
|
- just available as forward,}
|
|
|
- procedure check_forward;
|
|
|
- procedure store(var s:Tstream);virtual;
|
|
|
- procedure deref;virtual;
|
|
|
- procedure load_references;virtual;
|
|
|
- function write_references:boolean;virtual;
|
|
|
- destructor done;virtual;
|
|
|
- end;
|
|
|
-
|
|
|
- Ptypesym=^Ttypesym;
|
|
|
- Ttypesym=object(Tsym)
|
|
|
- definition:Pdef;
|
|
|
- forwardpointers:Pcollection; {Contains the forwardpointers.}
|
|
|
- properties:Ttypepropset;
|
|
|
- synonym:Ptypesym;
|
|
|
- constructor init(const n:string;d:Pdef);
|
|
|
- constructor load(var s:Tstream);
|
|
|
-{ procedure addforwardpointer(p:Ppointerdef);}
|
|
|
- procedure deref;virtual;
|
|
|
- procedure store(var s:Tstream);virtual;
|
|
|
- procedure load_references;virtual;
|
|
|
- procedure updateforwarddef(p:pdef);
|
|
|
- function write_references:boolean;virtual;
|
|
|
- destructor done;virtual;
|
|
|
- end;
|
|
|
-
|
|
|
- Psyssym=^Tsyssym;
|
|
|
- Tsyssym=object(Tsym)
|
|
|
- number:longint;
|
|
|
- constructor init(const n:string;l:longint);
|
|
|
- constructor load(var s:Tstream);
|
|
|
- procedure store(var s:Tstream);virtual;
|
|
|
- end;
|
|
|
-
|
|
|
- Pmacrosym=^Tmacrosym;
|
|
|
- Tmacrosym=object(Tsym)
|
|
|
- defined,is_used:boolean;
|
|
|
- buftext:Pchar;
|
|
|
- buflen:longint;
|
|
|
- {Macros aren't written to PPU files !}
|
|
|
- constructor init(const n:string);
|
|
|
- destructor done;virtual;
|
|
|
- end;
|
|
|
-
|
|
|
- Penumsym=^Tenumsym;
|
|
|
- Tenumsym=object(tsym)
|
|
|
- value:longint;
|
|
|
- definition:Penumdef;
|
|
|
- nextenum:Penumsym;
|
|
|
- constructor init(const n:string;def:Penumdef;v:longint);
|
|
|
- constructor load(var s:Tstream);
|
|
|
- procedure store(var s:Tstream);virtual;
|
|
|
- procedure deref;virtual;
|
|
|
- procedure order;
|
|
|
- end;
|
|
|
-
|
|
|
- Pprogramsym=^Tprogramsym;
|
|
|
- Tprogramsym=object(Tsym)
|
|
|
- end;
|
|
|
-
|
|
|
- Pvarsym=^Tvarsym;
|
|
|
- Tvarsym=object(tsym)
|
|
|
- address:longint;
|
|
|
- localvarsym:Pvarsym;
|
|
|
- islocalcopy:boolean;
|
|
|
- definition:Pdef;
|
|
|
- refs:longint;
|
|
|
- properties:Tvarpropset;
|
|
|
- state:Tvarstate;
|
|
|
- objprop:Tobjpropset;
|
|
|
- _mangledname:Pstring;
|
|
|
- reg:Tregister; {If reg<>R_NO, then the variable is an register
|
|
|
- variable }
|
|
|
- constructor init(const n:string;p:Pdef);
|
|
|
- constructor init_dll(const n:string;p:Pdef);
|
|
|
- constructor init_C(const n,mangled:string;p:Pdef);
|
|
|
- constructor load(var s:Tstream);
|
|
|
- procedure concatdata(const n:string;len:longint);
|
|
|
- procedure deref;virtual;
|
|
|
- function getsize:longint;virtual;
|
|
|
- function mangledname:string;virtual;
|
|
|
- procedure insert_in_data;virtual;
|
|
|
- procedure setmangledname(const s:string);
|
|
|
- procedure store(var s:Tstream);virtual;
|
|
|
- destructor done;virtual;
|
|
|
- end;
|
|
|
-
|
|
|
- Pparamsym=^Tparamsym;
|
|
|
- Tparamsym=object(Tvarsym)
|
|
|
- varspez:Tvarspez;
|
|
|
- pushaddress:longint;
|
|
|
- constructor init(const n:string;p:Pdef;vs:Tvarspez);
|
|
|
- function getsize:longint;virtual;
|
|
|
- function getpushsize:longint;virtual;
|
|
|
- procedure insert_in_data;virtual;
|
|
|
- end;
|
|
|
-
|
|
|
- Ptypedconstsym=^Ttypedconstsym;
|
|
|
- Ttypedconstsym=object(Tsym)
|
|
|
- prefix:Pstring;
|
|
|
- definition:Pdef;
|
|
|
- is_really_const:boolean;
|
|
|
- constructor init(const n:string;p:Pdef;really_const:boolean);
|
|
|
- constructor load(var s:Tstream);
|
|
|
- destructor done;virtual;
|
|
|
- function mangledname:string;virtual;
|
|
|
- procedure store(var s:Tstream);virtual;
|
|
|
- procedure deref;virtual;
|
|
|
- function getsize:longint;
|
|
|
- procedure insert_in_data;virtual;
|
|
|
- end;
|
|
|
-
|
|
|
- Tconsttype=(constord,conststring,constreal,constbool,
|
|
|
- constint,constchar,constset,constnil);
|
|
|
-
|
|
|
- Pconstsym=^Tconstsym;
|
|
|
- Tconstsym=object(Tsym)
|
|
|
- definition:Pdef;
|
|
|
- consttype:Tconsttype;
|
|
|
- value,len:longint; {Len is needed for string length.}
|
|
|
- constructor init(const n:string;t:Tconsttype;v:longint);
|
|
|
- constructor init_def(const n:string;t:Tconsttype;v:longint;
|
|
|
- def:Pdef);
|
|
|
- constructor init_string(const n:string;t:Tconsttype;
|
|
|
- str:Pchar;l:longint);
|
|
|
- constructor load(var s:Tstream);
|
|
|
- procedure deref;virtual;
|
|
|
- procedure store(var s:Tstream);virtual;
|
|
|
- destructor done;virtual;
|
|
|
- end;
|
|
|
-
|
|
|
- absolutetyp = (tovar,toasm,toaddr);
|
|
|
-
|
|
|
- Pabsolutesym = ^tabsolutesym;
|
|
|
- Tabsolutesym = object(tvarsym)
|
|
|
- abstyp:absolutetyp;
|
|
|
- absseg:boolean;
|
|
|
- ref:Psym;
|
|
|
- asmname:Pstring;
|
|
|
- constructor load(var s:Tstream);
|
|
|
- procedure deref;virtual;
|
|
|
- function mangledname : string;virtual;
|
|
|
- procedure store(var s:Tstream);virtual;
|
|
|
- end;
|
|
|
-
|
|
|
- Pfuncretsym=^Tfuncretsym;
|
|
|
- Tfuncretsym=object(tsym)
|
|
|
- funcretprocinfo:pointer{Pprocinfo};
|
|
|
- definition:Pdef;
|
|
|
- address:longint;
|
|
|
- constructor init(const n:string;approcinfo:pointer{pprocinfo});
|
|
|
- constructor load(var s:Tstream);
|
|
|
- procedure insert_in_data;virtual;
|
|
|
- procedure store(var s:Tstream);virtual;
|
|
|
- procedure deref;virtual;
|
|
|
- end;
|
|
|
-
|
|
|
- Ppropertysym=^Tpropertysym;
|
|
|
- Tpropertysym=object(Tsym)
|
|
|
- properties:Tproppropset;
|
|
|
- definition:Pdef;
|
|
|
- objprop:Tobjpropset;
|
|
|
- rangedef:Pdef; {Type of the range for array properties.}
|
|
|
- {For record property's like property x read a.b.c, the
|
|
|
- collection contains a as first element, b as second element,
|
|
|
- and c as the third element.}
|
|
|
- readaccess,
|
|
|
- writeaccess,
|
|
|
- storedaccess:Pcollection;
|
|
|
- index,default:longint;
|
|
|
- constructor load(var s:Tstream);
|
|
|
- function getsize:longint;virtual;
|
|
|
- procedure store(var s:Tstream);virtual;
|
|
|
- procedure deref;virtual;
|
|
|
- end;
|
|
|
-
|
|
|
-const {Last and first operators which can be overloaded.}
|
|
|
- first_overloaded = _PLUS;
|
|
|
- last_overloaded = _ASSIGNMENT;
|
|
|
- overloaded_names : array [first_overloaded..
|
|
|
- last_overloaded] of string[16] =
|
|
|
- ('plus','minus','star','slash',
|
|
|
- 'equal','greater','lower','greater_or_equal',
|
|
|
- 'lower_or_equal','sym_diff','starstar','as',
|
|
|
- 'is','in','or','and',
|
|
|
- 'div','mod','shl','shr',
|
|
|
- 'xor','assign');
|
|
|
-
|
|
|
-var current_object_option:Tobjprop;
|
|
|
- current_type_option:Ttypepropset;
|
|
|
-
|
|
|
- aktprocsym:Pprocsym; {Pointer to the symbol for the
|
|
|
- currently parsed procedure.}
|
|
|
- aktprocdef:Pprocdef; {Pointer to the defnition for the
|
|
|
- currently parsed procedure.}
|
|
|
- aktvarsym:Pvarsym; {Pointer to the symbol for the
|
|
|
- currently read var, only used
|
|
|
- for variable directives.}
|
|
|
-
|
|
|
- overloaded_operators:array[first_overloaded..
|
|
|
- last_overloaded] of Pprocsym;
|
|
|
- { unequal is not equal}
|
|
|
-
|
|
|
-implementation
|
|
|
-
|
|
|
-uses callspec,verbose,globals,systems,globtype,types;
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Tlabelsym
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-constructor Tlabelsym.init(const n:string;l:Pasmlabel);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited init(n);
|
|
|
- {$IFDEF TP}setparent(typeof(Tsym));{$ENDIF}
|
|
|
- lab:=l;
|
|
|
- defined:=false;
|
|
|
-end;
|
|
|
-
|
|
|
-constructor Tlabelsym.load(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited load(s);
|
|
|
- defined:=true;
|
|
|
-end;
|
|
|
-
|
|
|
-function Tlabelsym.mangledname:string;
|
|
|
-
|
|
|
-begin
|
|
|
- mangledname:=lab^.name;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Tlabelsym.store(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited store(s);
|
|
|
-{ current_ppu^.writeentry(iblabelsym);}
|
|
|
-end;
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Terrorsym
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-constructor terrorsym.init;
|
|
|
-
|
|
|
-begin
|
|
|
- inherited init('');
|
|
|
- {$IFDEF TP}setparent(typeof(Tsym));{$ENDIF}
|
|
|
-end;
|
|
|
-{****************************************************************************
|
|
|
- Tprocsym
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-constructor Tprocsym.init(const n:string;Asub_of:Pprocsym);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited init(n);
|
|
|
- {$IFDEF TP}setparent(typeof(Tsym));{$ENDIF}
|
|
|
- sub_of:=Asub_of;
|
|
|
-end;
|
|
|
-
|
|
|
-constructor Tprocsym.load(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited load(s);
|
|
|
-{ definition:=Pprocdef(readdefref);}
|
|
|
-end;
|
|
|
-
|
|
|
-function Tprocsym.count:word;
|
|
|
-
|
|
|
-begin
|
|
|
- if typeof(definitions^)=typeof(Tcollection) then
|
|
|
- count:=Pcollection(definitions)^.count
|
|
|
- else
|
|
|
- count:=1;
|
|
|
-end;
|
|
|
-
|
|
|
-function Tprocsym.firstthat(action:pointer):Pprocdef;
|
|
|
-
|
|
|
-begin
|
|
|
- firstthat:=nil;
|
|
|
- if definitions<>nil then
|
|
|
- if typeof(definitions^)=typeof(Tcollection) then
|
|
|
- firstthat:=Pcollection(definitions)^.firstthat(action)
|
|
|
- else if boolean(byte(longint(callpointerlocal(action,
|
|
|
- previousframepointer,definitions)))) then
|
|
|
- firstthat:=Pprocdef(definitions);
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Tprocsym.foreach(action:pointer);
|
|
|
-
|
|
|
-begin
|
|
|
- if definitions<>nil then
|
|
|
- begin
|
|
|
- if typeof(definitions^)=typeof(Tcollection) then
|
|
|
- Pcollection(definitions)^.foreach(action)
|
|
|
- else
|
|
|
- callpointerlocal(action,previousframepointer,definitions);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Tprocsym.insert(def:Pprocdef);
|
|
|
-
|
|
|
- function matchparas(item:pointer):boolean;{$IFDEF TP}far;{$ENDIF}
|
|
|
-
|
|
|
- begin
|
|
|
- matchparas:=equal_paras(Pprocdef(item)^.parameters,
|
|
|
- Pprocdef(def)^.parameters,false);
|
|
|
- end;
|
|
|
-
|
|
|
-var c:Pcollection;
|
|
|
- ovs:Pprocsym;
|
|
|
- ovd:Pprocdef;
|
|
|
- ve:Pvmtentry;
|
|
|
- errparam:string;
|
|
|
-
|
|
|
-begin
|
|
|
- if _class<>nil then
|
|
|
- begin
|
|
|
- {Update object information.}
|
|
|
- if po_virtualmethod in def^.options then
|
|
|
- include(_class^.options,oo_has_virtual);
|
|
|
- if po_abstractmethod in def^.options then
|
|
|
- include(_class^.options,oo_has_abstract);
|
|
|
- if def^.proctype=po_type_constructor then
|
|
|
- include(_class^.options,oo_has_constructor);
|
|
|
- if def^.proctype=po_type_destructor then
|
|
|
- include(_class^.options,oo_has_destructor);
|
|
|
- {Check if we are overriding an existing method.}
|
|
|
- ovs:=Pprocsym(_class^.childof^.search(name,true));
|
|
|
- ovd:=ovs^.firstthat(@matchparas);
|
|
|
- if ovd<>nil then
|
|
|
- begin
|
|
|
- errparam:=_class^.objname^+'.'+name;
|
|
|
- {If the old method is virtual and we are not, we
|
|
|
- refuse this for objects, and warn for classes.}
|
|
|
- if (po_virtualmethod in ovd^.options) then
|
|
|
- if (po_virtualmethod in Pprocdef(def)^.options) then
|
|
|
- if oo_is_class in _class^.options then
|
|
|
- message1(parser_w_should_use_override,errparam)
|
|
|
- else
|
|
|
- message1(parser_w_overloaded_are_not_both_virtual,errparam)
|
|
|
- else
|
|
|
- {Both are virtual.
|
|
|
- The flags have to match except abstract,
|
|
|
- assembler and override.}
|
|
|
- if (def^.calloptions<>ovd^.calloptions) or
|
|
|
- (def^.proctype<>ovd^.proctype) or
|
|
|
- ((def^.options-[po_abstractmethod,po_overridingmethod,po_assembler])<>
|
|
|
- (ovd^.options-[po_abstractmethod,po_overridingmethod,po_assembler])) then
|
|
|
- message1(parser_e_header_dont_match_forward,errparam);
|
|
|
- {Error if the return types aren't equal.}
|
|
|
- if not(is_equal(def^.retdef,ovd^.retdef)) and
|
|
|
- not(def^.retdef^.is_object(typeof(Tobjectdef)) and
|
|
|
- Pprocdef(ovd)^.retdef^.is_object(typeof(Tobjectdef)) and
|
|
|
- (oo_is_class in Pobjectdef(def^.retdef)^.options) and
|
|
|
- (oo_is_class in Pobjectdef(ovd^.retdef)^.options) and
|
|
|
- (pobjectdef(def^.retdef)^.is_related(pobjectdef(ovd^.retdef)))) then
|
|
|
- message1(parser_e_overloaded_methodes_not_same_ret,errparam);
|
|
|
- if po_virtualmethod in def^.options then
|
|
|
- begin
|
|
|
- if not(oo_has_constructor in _class^.options) then
|
|
|
- message1(parser_w_virtual_without_constructor,_class^.objname^);
|
|
|
- {We change the the vmt layout so we are called instead
|
|
|
- of our ancestor.}
|
|
|
- if sp_private in objprop then
|
|
|
- ve:=new(Plocalvmtentry,init(_class,def))
|
|
|
- else
|
|
|
- ve:=new(Pglobalvmtentry,init(_class,def));
|
|
|
- _class^.vmt_layout^.atput(ovd^.vmt_index,ve);
|
|
|
- def^.vmt_index:=ovd^.vmt_index;
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- if not(oo_has_constructor in _class^.options) then
|
|
|
- message1(parser_w_virtual_without_constructor,_class^.objname^);
|
|
|
- {The method is not overridden; if it is virtual we should
|
|
|
- generate a vmt entry.}
|
|
|
- if po_virtualmethod in def^.options then
|
|
|
- begin
|
|
|
- if sp_private in objprop then
|
|
|
- ve:=new(Plocalvmtentry,init(_class,def))
|
|
|
- else
|
|
|
- ve:=new(Pglobalvmtentry,init(_class,def));
|
|
|
- _class^.vmt_layout^.insert(ve);
|
|
|
- def^.vmt_index:=_class^.vmt_layout^.count-1;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- if definitions=nil then
|
|
|
- definitions:=def
|
|
|
- else
|
|
|
- if typeof(definitions^)=typeof(Tcollection) then
|
|
|
- Pcollection(def)^.insert(def)
|
|
|
- else
|
|
|
- begin
|
|
|
- c:=new(Pcollection,init(8,4));
|
|
|
- c^.insert(definitions);
|
|
|
- definitions:=c;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-function Tprocsym.mangledname:string;
|
|
|
-
|
|
|
-{This function calls internalerror, because procsyms can be overloaded.
|
|
|
- Procedures should use the foreach to check for the right overloaded procsym
|
|
|
- and then call mangledname on that procsym.}
|
|
|
-
|
|
|
-begin
|
|
|
- internalerror($99080201);
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Tprocsym.write_parameter_lists;
|
|
|
-
|
|
|
-{var p:Pprocdef;}
|
|
|
-
|
|
|
-begin
|
|
|
-(* p:=definition;
|
|
|
- while assigned(p) do
|
|
|
- begin
|
|
|
- {Force the error to be printed.}
|
|
|
- verbose.message1(sym_b_param_list,name+p^.demangled_paras);
|
|
|
- p:=p^.nextoverloaded;
|
|
|
- end;*)
|
|
|
-end;
|
|
|
-
|
|
|
-procedure tprocsym.check_forward;
|
|
|
-
|
|
|
-{var pd:Pprocdef;}
|
|
|
-
|
|
|
-begin
|
|
|
-(* pd:=definition;
|
|
|
- while assigned(pd) do
|
|
|
- begin
|
|
|
- if pd^.forwarddef then
|
|
|
- begin
|
|
|
- if assigned(pd^._class) then
|
|
|
- messagepos1(fileinfo,sym_e_forward_not_resolved,
|
|
|
- pd^._class^.objname^+'.'+name+
|
|
|
- demangledparas(pd^.demangled_paras))
|
|
|
- else
|
|
|
- messagepos1(fileinfo,sym_e_forward_not_resolved,
|
|
|
- name+pd^.demangled_paras);
|
|
|
- {Turn futher error messages off.}
|
|
|
- pd^.forwarddef:=false;
|
|
|
- end;
|
|
|
-
|
|
|
- pd:=pd^.nextoverloaded;
|
|
|
- end;*)
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-procedure tprocsym.deref;
|
|
|
-
|
|
|
-{var t:ttoken;
|
|
|
- last:Pprocdef;}
|
|
|
-
|
|
|
-begin
|
|
|
-(*
|
|
|
- resolvedef(pdef(definition));
|
|
|
- if (definition^.options and pooperator) <> 0 then
|
|
|
- begin
|
|
|
- last:=definition;
|
|
|
- while assigned(last^.nextoverloaded) do
|
|
|
- last:=last^.nextoverloaded;
|
|
|
- for t:=first_overloaded to last_overloaded do
|
|
|
- if (name=overloaded_names[t]) then
|
|
|
- begin
|
|
|
- if assigned(overloaded_operators[t]) then
|
|
|
- last^.nextoverloaded:=overloaded_operators[t]^.definition;
|
|
|
- overloaded_operators[t]:=@self;
|
|
|
- end;
|
|
|
- end;*)
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Tprocsym.store(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited store(s);
|
|
|
-{ writedefref(pdef(definition));
|
|
|
- current_ppu^.writeentry(ibprocsym);}
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-procedure tprocsym.load_references;
|
|
|
-
|
|
|
-begin
|
|
|
- inherited load_references;
|
|
|
-end;
|
|
|
-
|
|
|
-function Tprocsym.write_references:boolean;
|
|
|
-
|
|
|
-{var prdef:Pprocdef;}
|
|
|
-
|
|
|
-begin
|
|
|
-(* write_references:=false;
|
|
|
- if not inherited write_references then
|
|
|
- exit;
|
|
|
- write_references:=true;
|
|
|
- prdef:=definition;
|
|
|
- while assigned(prdef) and (prdef^.owner=definition^.owner) do
|
|
|
- begin
|
|
|
- prdef^.write_references;
|
|
|
- prdef:=prdef^.nextoverloaded;
|
|
|
- end;*)
|
|
|
-end;
|
|
|
-
|
|
|
-destructor Tprocsym.done;
|
|
|
-
|
|
|
-begin
|
|
|
- {Don't check if errors !!}
|
|
|
- if errorcount=0 then
|
|
|
- check_forward;
|
|
|
- inherited done;
|
|
|
-end;
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Ttypesym
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-constructor Ttypesym.init(const n:string;d:Pdef);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited init(n);
|
|
|
- {$IFDEF TP}setparent(typeof(Tsym));{$ENDIF}
|
|
|
- definition:=d;
|
|
|
- if assigned(definition) then
|
|
|
- begin
|
|
|
- if definition^.sym<>nil then
|
|
|
- begin
|
|
|
- definition^.sym:=@self;
|
|
|
- properties:=[sp_primary_typesym];
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- synonym:=Ptypesym(definition^.sym)^.synonym;
|
|
|
- Ptypesym(definition^.sym)^.synonym:=@self;
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-constructor Ttypesym.load(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited load(s);
|
|
|
-{ definition:=readdefref;}
|
|
|
-end;
|
|
|
-
|
|
|
-{procedure Ttypesym.addforwardpointer(p:Ppointerdef);
|
|
|
-
|
|
|
-begin
|
|
|
- if forwardpointers=nil then
|
|
|
- new(forwardpointers,init(8,4));
|
|
|
- forwardpointers^.insert(p);
|
|
|
-end;}
|
|
|
-
|
|
|
-procedure ttypesym.deref;
|
|
|
-
|
|
|
-begin
|
|
|
-(* resolvedef(definition);
|
|
|
- if assigned(definition) then
|
|
|
- begin
|
|
|
- if properties=sp_primary_typesym then
|
|
|
- begin
|
|
|
- if definition^.sym<>@self then
|
|
|
- synonym:=definition^.sym;
|
|
|
- definition^.sym:=@self;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- if assigned(definition^.sym) then
|
|
|
- begin
|
|
|
- synonym:=definition^.sym^.synonym;
|
|
|
- if definition^.sym<>@self then
|
|
|
- definition^.sym^.synonym:=@self;
|
|
|
- end
|
|
|
- else
|
|
|
- definition^.sym:=@self;
|
|
|
- end;
|
|
|
- if (definition^.deftype=recorddef) and
|
|
|
- assigned(precdef(definition)^.symtable) and
|
|
|
- (definition^.sym=@self) then
|
|
|
- precdef(definition)^.symtable^.name:=stringdup('record '+name);
|
|
|
- end;*)
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-procedure ttypesym.store(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited store(s);
|
|
|
-{ writedefref(definition);
|
|
|
- current_ppu^.writeentry(ibtypesym);}
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-procedure ttypesym.load_references;
|
|
|
-
|
|
|
-begin
|
|
|
- inherited load_references;
|
|
|
-{ if typeof(definition^)=typeof(Trecorddef) then
|
|
|
- Precdef(definition)^.symtable^.load_browser;
|
|
|
- if typeof(definition^)=typeof(Tobjectdef) then
|
|
|
- Pobjectdef(definition)^.publicsyms^.load_browser;}
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-function ttypesym.write_references : boolean;
|
|
|
-
|
|
|
-begin
|
|
|
-(* if not inherited write_references then
|
|
|
- {Write address of this symbol if record or object
|
|
|
- even if no real refs are there
|
|
|
- because we need it for the symtable }
|
|
|
- if (definition^.deftype=recorddef) or
|
|
|
- (definition^.deftype=objectdef) then
|
|
|
- begin
|
|
|
- writesymref(@self);
|
|
|
- current_ppu^.writeentry(ibsymref);
|
|
|
- end;
|
|
|
- write_references:=true;
|
|
|
- if (definition^.deftype=recorddef) then
|
|
|
- precdef(definition)^.symtable^.write_browser;
|
|
|
- if (definition^.deftype=objectdef) then
|
|
|
- pobjectdef(definition)^.publicsyms^.write_browser;*)
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-procedure ttypesym.updateforwarddef(p:pdef);
|
|
|
-
|
|
|
-var i:word;
|
|
|
-
|
|
|
-begin
|
|
|
- if definition<>nil then
|
|
|
- internalerror($99080203)
|
|
|
- else
|
|
|
- definition:=p;
|
|
|
- properties:=current_type_option;
|
|
|
- fileinfo:=tokenpos;
|
|
|
- if assigned(definition) and not(assigned(definition^.sym)) then
|
|
|
- definition^.sym:=@self;
|
|
|
- {Update all forwardpointers to this definition.}
|
|
|
-{ for i:=1 to forwardpointers^.count do
|
|
|
- Ppointerdef(forwardpointers^.at(i))^.definition:=definition;}
|
|
|
- forwardpointers^.deleteall;
|
|
|
- dispose(forwardpointers,done);
|
|
|
- forwardpointers:=nil;
|
|
|
-end;
|
|
|
-
|
|
|
-destructor Ttypesym.done;
|
|
|
-
|
|
|
-var prevsym:Ptypesym;
|
|
|
-
|
|
|
-begin
|
|
|
- if assigned(definition) then
|
|
|
- begin
|
|
|
- prevsym:=Ptypesym(definition^.sym);
|
|
|
- if prevsym=@self then
|
|
|
- definition^.sym:=synonym;
|
|
|
- while assigned(prevsym) do
|
|
|
- begin
|
|
|
- if (prevsym^.synonym=@self) then
|
|
|
- begin
|
|
|
- prevsym^.synonym:=synonym;
|
|
|
- break;
|
|
|
- end;
|
|
|
- prevsym:=prevsym^.synonym;
|
|
|
- end;
|
|
|
- end;
|
|
|
- synonym:=nil;
|
|
|
- definition:=nil;
|
|
|
- inherited done;
|
|
|
-end;
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Tsyssym
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-constructor Tsyssym.init(const n:string;l:longint);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited init(n);
|
|
|
- {$IFDEF TP}setparent(typeof(Tsym));{$ENDIF}
|
|
|
- number:=l;
|
|
|
-end;
|
|
|
-
|
|
|
-constructor Tsyssym.load(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited load(s);
|
|
|
-{ number:=readlong;}
|
|
|
-end;
|
|
|
-
|
|
|
-procedure tsyssym.store(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- Tsym.store(s);
|
|
|
-{ writelong(number);
|
|
|
- current_ppu^.writeentry(ibsyssym);}
|
|
|
-end;
|
|
|
-{****************************************************************************
|
|
|
- Tenumsym
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-constructor Tenumsym.init(const n:string;def:Penumdef;v:longint);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited init(n);
|
|
|
- {$IFDEF TP}setparent(typeof(Tsym));{$ENDIF}
|
|
|
- definition:=def;
|
|
|
- value:=v;
|
|
|
- if def^.minval>v then
|
|
|
- def^.setmin(v);
|
|
|
- if def^.maxval<v then
|
|
|
- def^.setmax(v);
|
|
|
- order;
|
|
|
-end;
|
|
|
-
|
|
|
-constructor Tenumsym.load(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited load(s);
|
|
|
-{ definition:=Penumdef(readdefref);
|
|
|
- value:=readlong;}
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Tenumsym.deref;
|
|
|
-
|
|
|
-begin
|
|
|
-{ resolvedef(pdef(definition));
|
|
|
- order;}
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Tenumsym.order;
|
|
|
-
|
|
|
-var i:word;
|
|
|
-
|
|
|
-label inserted;
|
|
|
-
|
|
|
-begin
|
|
|
- {Keep the enum symbols ordered by value...}
|
|
|
- with definition^.symbols^ do
|
|
|
- begin
|
|
|
- {Most of the time, enums are defined in order, so we count down.}
|
|
|
- for i:=count-1 downto 0 do
|
|
|
- begin
|
|
|
- if Penumsym(at(i))^.value<value then
|
|
|
- begin
|
|
|
- atinsert(i+1,@self);
|
|
|
- {We have to use goto to keep the
|
|
|
- code efficient :( }
|
|
|
- goto inserted;
|
|
|
- end;
|
|
|
- end;
|
|
|
- atinsert(0,@self);
|
|
|
- inserted:
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-procedure Tenumsym.store(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited store(s);
|
|
|
-(* writedefref(definition);
|
|
|
- writelong(value);
|
|
|
- current_ppu^.writeentry(ibenumsym);*)
|
|
|
-end;
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Tmacrosym
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-constructor Tmacrosym.init(const n:string);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited init(n);
|
|
|
- defined:=true;
|
|
|
-end;
|
|
|
-
|
|
|
-destructor Tmacrosym.done;
|
|
|
-
|
|
|
-begin
|
|
|
- if assigned(buftext) then
|
|
|
- freemem(buftext,buflen);
|
|
|
- inherited done;
|
|
|
-end;
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Tprogramsym
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Tvarsym
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-
|
|
|
-constructor Tvarsym.init(const n:string;p:Pdef);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited init(n);
|
|
|
- {$IFDEF TP}setparent(typeof(Tsym));{$ENDIF}
|
|
|
- definition:=p;
|
|
|
- {Can we load the value into a register ? }
|
|
|
- if dp_regable in p^.properties then
|
|
|
- include(properties,vo_regable);
|
|
|
- reg:=R_NO;
|
|
|
-end;
|
|
|
-
|
|
|
-constructor Tvarsym.init_dll(const n:string;p:Pdef);
|
|
|
-
|
|
|
-begin
|
|
|
- init(n,p);
|
|
|
- include(properties,vo_is_dll_var);
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-constructor Tvarsym.init_C(const n,mangled:string;p:Pdef);
|
|
|
-
|
|
|
-begin
|
|
|
- init(n,p);
|
|
|
- include(properties,vo_is_C_var);
|
|
|
- setmangledname(mangled);
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Tvarsym.concatdata(const n:string;len:longint);
|
|
|
-
|
|
|
-begin
|
|
|
-end;
|
|
|
-
|
|
|
-constructor Tvarsym.load(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited load(s);
|
|
|
- reg:=R_NO;
|
|
|
-{ if read_member then
|
|
|
- address:=readlong
|
|
|
- else
|
|
|
- address:=0;
|
|
|
- definition:=readdefref;
|
|
|
- var_options:=readbyte;
|
|
|
- if (var_options and vo_is_C_var)<>0 then
|
|
|
- setmangledname(readstring);}
|
|
|
-end;
|
|
|
-
|
|
|
-function Tvarsym.getsize:longint;
|
|
|
-
|
|
|
-begin
|
|
|
- if definition<>nil then
|
|
|
- getsize:=definition^.size
|
|
|
- else
|
|
|
- getsize:=0;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Tvarsym.deref;
|
|
|
-
|
|
|
-begin
|
|
|
-{ resolvedef(definition);}
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-procedure Tvarsym.store(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
-(* inherited store(s);
|
|
|
- if read_member then
|
|
|
- writelong(address);
|
|
|
- writedefref(definition);
|
|
|
- { symbols which are load are never candidates for a register,
|
|
|
- turn of the regable }
|
|
|
- writebyte(var_options and (not vo_regable));
|
|
|
- if (var_options and vo_is_C_var)<>0 then
|
|
|
- writestring(mangledname);
|
|
|
- current_ppu^.writeentry(ibvarsym);*)
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-procedure Tvarsym.setmangledname(const s:string);
|
|
|
-
|
|
|
-begin
|
|
|
- _mangledname:=stringdup(s);
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-function Tvarsym.mangledname:string;
|
|
|
-
|
|
|
-var prefix:string;
|
|
|
-
|
|
|
-begin
|
|
|
- if assigned(_mangledname) then
|
|
|
- mangledname:=_mangledname^
|
|
|
- else
|
|
|
- mangledname:=owner^.varsymprefix+name;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Tvarsym.insert_in_data;
|
|
|
-
|
|
|
-var l,ali,modulo:longint;
|
|
|
- storefilepos:Tfileposinfo;
|
|
|
-
|
|
|
-begin
|
|
|
- if (vo_is_external in properties) then
|
|
|
- begin
|
|
|
- {Handle static variables of objects especially }
|
|
|
- if read_member and (sp_static in objprop) then
|
|
|
- begin
|
|
|
- {The data field is generated in parser.pas
|
|
|
- with a tobject_FIELDNAME variable, so we do
|
|
|
- not need to do it in this procedure.}
|
|
|
-
|
|
|
- {This symbol can't be loaded to a register.}
|
|
|
- exclude(properties,vo_regable);
|
|
|
- end
|
|
|
- else
|
|
|
- if not(read_member) then
|
|
|
- begin
|
|
|
- storefilepos:=aktfilepos;
|
|
|
- aktfilepos:=tokenpos;
|
|
|
- if (vo_is_thread_var in properties) then
|
|
|
- l:=4
|
|
|
- else
|
|
|
- l:=getsize;
|
|
|
- address:=owner^.varsymtodata(@self,l);
|
|
|
- aktfilepos:=storefilepos;
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-destructor Tvarsym.done;
|
|
|
-
|
|
|
-begin
|
|
|
- disposestr(_mangledname);
|
|
|
- inherited done;
|
|
|
-end;
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Tparamsym
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-constructor Tparamsym.init(const n:string;p:Pdef;vs:Tvarspez);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited init(n,p);
|
|
|
- {$IFDEF TP}setparent(typeof(Tsym));{$ENDIF}
|
|
|
- varspez:=vs;
|
|
|
-end;
|
|
|
-
|
|
|
-function Tparamsym.getsize:longint;
|
|
|
-
|
|
|
-begin
|
|
|
- if (definition<>nil) and (varspez=vs_value) then
|
|
|
- getsize:=definition^.size
|
|
|
- else
|
|
|
- getsize:=0;
|
|
|
-end;
|
|
|
-
|
|
|
-function Tparamsym.getpushsize:longint;
|
|
|
-
|
|
|
-begin
|
|
|
- if assigned(definition) then
|
|
|
- begin
|
|
|
- case varspez of
|
|
|
- vs_var:
|
|
|
- getpushsize:=target_os.size_of_pointer;
|
|
|
- vs_value,vs_const:
|
|
|
- if dp_pointer_param in definition^.properties then
|
|
|
- getpushsize:=target_os.size_of_pointer
|
|
|
- else
|
|
|
- getpushsize:=definition^.size;
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- getpushsize:=0;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Tparamsym.insert_in_data;
|
|
|
-
|
|
|
-var storefilepos:Tfileposinfo;
|
|
|
-
|
|
|
-begin
|
|
|
- storefilepos:=aktfilepos;
|
|
|
- if not(read_member) then
|
|
|
- pushaddress:=owner^.varsymtodata(@self,getpushsize);
|
|
|
- if (varspez=vs_var) then
|
|
|
- address:=0
|
|
|
- else if (varspez=vs_value) then
|
|
|
- if dp_pointer_param in definition^.properties then
|
|
|
- begin
|
|
|
- {Allocate local space.}
|
|
|
- address:=owner^.datasize;
|
|
|
- inc(owner^.datasize,getsize);
|
|
|
- end
|
|
|
- else
|
|
|
- address:=pushaddress
|
|
|
- else
|
|
|
- {vs_const}
|
|
|
- if dp_pointer_param in definition^.properties then
|
|
|
- address:=0
|
|
|
- else
|
|
|
- address:=pushaddress;
|
|
|
- aktfilepos:=storefilepos;
|
|
|
-end;
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Ttypedconstsym
|
|
|
-*****************************************************************************}
|
|
|
-
|
|
|
-constructor Ttypedconstsym.init(const n:string;p:Pdef;really_const:boolean);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited init(n);
|
|
|
- {$IFDEF TP}setparent(typeof(Tsym));{$ENDIF}
|
|
|
- definition:=p;
|
|
|
- is_really_const:=really_const;
|
|
|
- prefix:=stringdup(procprefix);
|
|
|
-end;
|
|
|
-
|
|
|
-constructor Ttypedconstsym.load(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited load(s);
|
|
|
-(* definition:=readdefref;
|
|
|
-{$ifdef DELPHI_CONST_IN_RODATA}
|
|
|
- is_really_const:=boolean(readbyte);
|
|
|
-{$else DELPHI_CONST_IN_RODATA}
|
|
|
- is_really_const:=false;
|
|
|
-{$endif DELPHI_CONST_IN_RODATA}
|
|
|
- prefix:=stringdup(readstring);*)
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Ttypedconstsym.deref;
|
|
|
-
|
|
|
-begin
|
|
|
-{ resolvedef(definition);}
|
|
|
-end;
|
|
|
-
|
|
|
-function Ttypedconstsym.mangledname:string;
|
|
|
-
|
|
|
-begin
|
|
|
- mangledname:='TC_'+prefix^+'_'+name;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-function Ttypedconstsym.getsize:longint;
|
|
|
-
|
|
|
-begin
|
|
|
- if assigned(definition) then
|
|
|
- getsize:=definition^.size
|
|
|
- else
|
|
|
- getsize:=0;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Ttypedconstsym.store(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited store(s);
|
|
|
-(* writedefref(definition);
|
|
|
- writestring(prefix^);
|
|
|
-{$ifdef DELPHI_CONST_IN_RODATA}
|
|
|
- writebyte(byte(is_really_const));
|
|
|
-{$endif DELPHI_CONST_IN_RODATA}
|
|
|
- current_ppu^.writeentry(ibtypedconstsym);*)
|
|
|
-end;
|
|
|
-
|
|
|
-{ for most symbol types ther is nothing to do at all }
|
|
|
-procedure Ttypedconstsym.insert_in_data;
|
|
|
-
|
|
|
-var constsegment:Paasmoutput;
|
|
|
- l,ali,modulo:longint;
|
|
|
- storefilepos:Tfileposinfo;
|
|
|
-
|
|
|
-begin
|
|
|
- storefilepos:=aktfilepos;
|
|
|
- aktfilepos:=tokenpos;
|
|
|
- owner^.tconstsymtodata(@self,getsize);
|
|
|
- aktfilepos:=storefilepos;
|
|
|
-end;
|
|
|
-
|
|
|
-destructor Ttypedconstsym.done;
|
|
|
-
|
|
|
-begin
|
|
|
- stringdispose(prefix);
|
|
|
- inherited done;
|
|
|
-end;
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- TCONSTSYM
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-constructor Tconstsym.init(const n : string;t : tconsttype;v : longint);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited init(n);
|
|
|
- {$IFDEF TP}setparent(typeof(Tsym));{$ENDIF}
|
|
|
- consttype:=t;
|
|
|
- value:=v;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-constructor Tconstsym.init_def(const n:string;t:Tconsttype;
|
|
|
- v:longint;def:Pdef);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited init(n);
|
|
|
- consttype:=t;
|
|
|
- value:=v;
|
|
|
- definition:=def;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-constructor Tconstsym.init_string(const n:string;t:Tconsttype;str:Pchar;l:longint);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited init(n);
|
|
|
- consttype:=t;
|
|
|
- value:=longint(str);
|
|
|
- len:=l;
|
|
|
-end;
|
|
|
-
|
|
|
-constructor Tconstsym.load(var s:Tstream);
|
|
|
-
|
|
|
-var pd:Pbestreal;
|
|
|
- ps:Pnormalset;
|
|
|
-
|
|
|
-begin
|
|
|
- inherited load(s);
|
|
|
-(* consttype:=tconsttype(readbyte);
|
|
|
- case consttype of
|
|
|
- constint,
|
|
|
- constbool,
|
|
|
- constchar : value:=readlong;
|
|
|
- constord :
|
|
|
- begin
|
|
|
- definition:=readdefref;
|
|
|
- value:=readlong;
|
|
|
- end;
|
|
|
- conststring :
|
|
|
- begin
|
|
|
- len:=readlong;
|
|
|
- getmem(pchar(value),len+1);
|
|
|
- current_ppu^.getdata(pchar(value)^,len);
|
|
|
- end;
|
|
|
- constreal :
|
|
|
- begin
|
|
|
- new(pd);
|
|
|
- pd^:=readreal;
|
|
|
- value:=longint(pd);
|
|
|
- end;
|
|
|
- constset :
|
|
|
- begin
|
|
|
- definition:=readdefref;
|
|
|
- new(ps);
|
|
|
- readnormalset(ps^);
|
|
|
- value:=longint(ps);
|
|
|
- end;
|
|
|
- constnil : ;
|
|
|
- else
|
|
|
- Message1(unit_f_ppu_invalid_entry,tostr(ord(consttype)));
|
|
|
- end;*)
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Tconstsym.deref;
|
|
|
-
|
|
|
-begin
|
|
|
-{ if consttype in [constord,constset] then
|
|
|
- resolvedef(pdef(definition));}
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-procedure Tconstsym.store(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
-(* inherited store(s);
|
|
|
- writebyte(byte(consttype));
|
|
|
- case consttype of
|
|
|
- constnil : ;
|
|
|
- constint,
|
|
|
- constbool,
|
|
|
- constchar :
|
|
|
- writelong(value);
|
|
|
- constord :
|
|
|
- begin
|
|
|
- writedefref(definition);
|
|
|
- writelong(value);
|
|
|
- end;
|
|
|
- conststring :
|
|
|
- begin
|
|
|
- writelong(len);
|
|
|
- current_ppu^.putdata(pchar(value)^,len);
|
|
|
- end;
|
|
|
- constreal :
|
|
|
- writereal(pbestreal(value)^);
|
|
|
- constset :
|
|
|
- begin
|
|
|
- writedefref(definition);
|
|
|
- writenormalset(pointer(value)^);
|
|
|
- end;
|
|
|
- else
|
|
|
- internalerror(13);
|
|
|
- end;
|
|
|
- current_ppu^.writeentry(ibconstsym);*)
|
|
|
-end;
|
|
|
-
|
|
|
-destructor Tconstsym.done;
|
|
|
-
|
|
|
-begin
|
|
|
- case consttype of
|
|
|
- conststring:
|
|
|
- freemem(Pchar(value),len+1);
|
|
|
- constreal:
|
|
|
- dispose(Pbestreal(value));
|
|
|
- constset:
|
|
|
- dispose(Pnormalset(value));
|
|
|
- end;
|
|
|
- inherited done;
|
|
|
-end;
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Tabsolutesym
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-constructor Tabsolutesym.load(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited load(s);
|
|
|
-(* typ:=absolutesym;
|
|
|
- abstyp:=absolutetyp(readbyte);
|
|
|
- case abstyp of
|
|
|
- tovar :
|
|
|
- begin
|
|
|
- asmname:=stringdup(readstring);
|
|
|
- ref:=srsym;
|
|
|
- end;
|
|
|
- toasm :
|
|
|
- asmname:=stringdup(readstring);
|
|
|
- toaddr :
|
|
|
- begin
|
|
|
- address:=readlong;
|
|
|
- absseg:=boolean(readbyte);
|
|
|
- end;
|
|
|
- end;*)
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-procedure tabsolutesym.store(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited store(s);
|
|
|
-(* writebyte(byte(varspez));
|
|
|
- if read_member then
|
|
|
- writelong(address);
|
|
|
- writedefref(definition);
|
|
|
- writebyte(var_options and (not vo_regable));
|
|
|
- writebyte(byte(abstyp));
|
|
|
- case abstyp of
|
|
|
- tovar :
|
|
|
- writestring(ref^.name);
|
|
|
- toasm :
|
|
|
- writestring(asmname^);
|
|
|
- toaddr :
|
|
|
- begin
|
|
|
- writelong(address);
|
|
|
- writebyte(byte(absseg));
|
|
|
- end;
|
|
|
- end;
|
|
|
- current_ppu^.writeentry(ibabsolutesym);*)
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-procedure tabsolutesym.deref;
|
|
|
-
|
|
|
-begin
|
|
|
-(* resolvedef(definition);
|
|
|
- if (abstyp=tovar) and (asmname<>nil) then
|
|
|
- begin
|
|
|
- { search previous loaded symtables }
|
|
|
- getsym(asmname^,false);
|
|
|
- if not(assigned(srsym)) then
|
|
|
- getsymonlyin(owner,asmname^);
|
|
|
- if not(assigned(srsym)) then
|
|
|
- srsym:=generrorsym;
|
|
|
- ref:=srsym;
|
|
|
- stringdispose(asmname);
|
|
|
- end;*)
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-function Tabsolutesym.mangledname : string;
|
|
|
-
|
|
|
-begin
|
|
|
- case abstyp of
|
|
|
- tovar :
|
|
|
- mangledname:=ref^.mangledname;
|
|
|
- toasm :
|
|
|
- mangledname:=asmname^;
|
|
|
- toaddr :
|
|
|
- mangledname:='$'+tostr(address);
|
|
|
- else
|
|
|
- internalerror(10002);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Tfuncretsym
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-constructor Tfuncretsym.init(const n:string;approcinfo:pointer{pprocinfo});
|
|
|
-
|
|
|
-begin
|
|
|
- inherited init(n);
|
|
|
- {$IFDEF TP}setparent(typeof(Tsym));{$ENDIF}
|
|
|
- funcretprocinfo:=approcinfo;
|
|
|
-{ funcretdef:=Pprocinfo(approcinfo)^.retdef;}
|
|
|
- { address valid for ret in param only }
|
|
|
- { otherwise set by insert }
|
|
|
-{ address:=pprocinfo(approcinfo)^.retoffset;}
|
|
|
-end;
|
|
|
-
|
|
|
-constructor Tfuncretsym.load(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited load(s);
|
|
|
-{ funcretdef:=readdefref;
|
|
|
- address:=readlong;
|
|
|
- funcretprocinfo:=nil;
|
|
|
- typ:=funcretsym;}
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Tfuncretsym.store(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- (*
|
|
|
- Normally all references are
|
|
|
- transfered to the function symbol itself !! PM *)
|
|
|
- inherited store(s);
|
|
|
-{ writedefref(funcretdef);
|
|
|
- writelong(address);
|
|
|
-
|
|
|
- current_ppu^.writeentry(ibfuncretsym);}
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Tfuncretsym.deref;
|
|
|
-
|
|
|
-begin
|
|
|
- {resolvedef(funcretdef);}
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Tfuncretsym.insert_in_data;
|
|
|
-
|
|
|
-var l:longint;
|
|
|
-
|
|
|
-begin
|
|
|
- {Allocate space in local if ret in acc or in fpu.}
|
|
|
-{ if dp_ret_in_acc in procinfo.retdef^.properties
|
|
|
- or (procinfo.retdef^.deftype=floatdef) then
|
|
|
- begin
|
|
|
- l:=funcretdef^.size;
|
|
|
- adress:=owner^.varsymtodata('',l);
|
|
|
- procinfo.retoffset:=-owner^.datasize;
|
|
|
- end;}
|
|
|
-end;
|
|
|
-
|
|
|
-{****************************************************************************
|
|
|
- Tpropertysym
|
|
|
-****************************************************************************}
|
|
|
-
|
|
|
-constructor tpropertysym.load(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- inherited load(s);
|
|
|
-(* proptype:=readdefref;
|
|
|
- options:=readlong;
|
|
|
- index:=readlong;
|
|
|
- default:=readlong;
|
|
|
- { it's hack ... }
|
|
|
- readaccesssym:=psym(stringdup(readstring));
|
|
|
- writeaccesssym:=psym(stringdup(readstring));
|
|
|
- storedsym:=psym(stringdup(readstring));
|
|
|
- { now the defs: }
|
|
|
- readaccessdef:=readdefref;
|
|
|
- writeaccessdef:=readdefref;
|
|
|
- storeddef:=readdefref;*)
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Tpropertysym.deref;
|
|
|
-
|
|
|
-begin
|
|
|
-(* resolvedef(proptype);
|
|
|
- resolvedef(readaccessdef);
|
|
|
- resolvedef(writeaccessdef);
|
|
|
- resolvedef(storeddef);
|
|
|
- { solve the hack we did in load: }
|
|
|
- if pstring(readaccesssym)^<>'' then
|
|
|
- begin
|
|
|
- srsym:=search_class_member(pobjectdef(owner^.defowner),pstring(readaccesssym)^);
|
|
|
- if not(assigned(srsym)) then
|
|
|
- srsym:=generrorsym;
|
|
|
- end
|
|
|
- else
|
|
|
- srsym:=nil;
|
|
|
- stringdispose(pstring(readaccesssym));
|
|
|
- readaccesssym:=srsym;
|
|
|
-
|
|
|
- if pstring(writeaccesssym)^<>'' then
|
|
|
- begin
|
|
|
- srsym:=search_class_member(pobjectdef(owner^.defowner),pstring(writeaccesssym)^);
|
|
|
- if not(assigned(srsym)) then
|
|
|
- srsym:=generrorsym;
|
|
|
- end
|
|
|
- else
|
|
|
- srsym:=nil;
|
|
|
- stringdispose(pstring(writeaccesssym));
|
|
|
- writeaccesssym:=srsym;
|
|
|
-
|
|
|
- if pstring(storedsym)^<>'' then
|
|
|
- begin
|
|
|
- srsym:=search_class_member(pobjectdef(owner^.defowner),pstring(storedsym)^);
|
|
|
- if not(assigned(srsym)) then
|
|
|
- srsym:=generrorsym;
|
|
|
- end
|
|
|
- else
|
|
|
- srsym:=nil;
|
|
|
- stringdispose(pstring(storedsym));
|
|
|
- storedsym:=srsym;*)
|
|
|
-end;
|
|
|
-
|
|
|
-function Tpropertysym.getsize:longint;
|
|
|
-
|
|
|
-begin
|
|
|
- getsize:=0;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Tpropertysym.store(var s:Tstream);
|
|
|
-
|
|
|
-begin
|
|
|
- Tsym.store(s);
|
|
|
-(* writedefref(proptype);
|
|
|
- writelong(options);
|
|
|
- writelong(index);
|
|
|
- writelong(default);
|
|
|
- if assigned(readaccesssym) then
|
|
|
- writestring(readaccesssym^.name)
|
|
|
- else
|
|
|
- writestring('');
|
|
|
- if assigned(writeaccesssym) then
|
|
|
- writestring(writeaccesssym^.name)
|
|
|
- else
|
|
|
- writestring('');
|
|
|
- if assigned(storedsym) then
|
|
|
- writestring(storedsym^.name)
|
|
|
- else
|
|
|
- writestring('');
|
|
|
- writedefref(readaccessdef);
|
|
|
- writedefref(writeaccessdef);
|
|
|
- writedefref(storeddef);
|
|
|
- current_ppu^.writeentry(ibpropertysym);*)
|
|
|
-end;
|
|
|
-
|
|
|
-end.
|
|
|
-
|
|
|
-{
|
|
|
- $Log$
|
|
|
- Revision 1.1 2000-07-13 06:30:13 michael
|
|
|
- + Initial import
|
|
|
-
|
|
|
- Revision 1.6 2000/03/16 12:52:48 daniel
|
|
|
- * Changed names of procedures flags
|
|
|
- * Changed VMT generation
|
|
|
-
|
|
|
- Revision 1.5 2000/03/11 21:11:25 daniel
|
|
|
- * Ported hcgdata to new symtable.
|
|
|
- * Alignment code changed as suggested by Peter
|
|
|
- + Usage of my is operator replacement, is_object
|
|
|
-
|
|
|
- Revision 1.4 2000/03/01 11:43:56 daniel
|
|
|
- * Some more work on the new symtable.
|
|
|
- + Symtable stack unit 'symstack' added.
|
|
|
-
|
|
|
-}
|
peter