paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-27 08:13:42 +02:00
Code Issues Packages Projects Releases Wiki Activity
d27b21891b
fpc/compiler/symsym.inc
florian d27b21891b * changes of Bruessel: 
+ message handler can now take an explicit self
     * typinfo fixed: sometimes the type names weren't written
     * the type checking for pointer comparisations and subtraction
       and are now more strict (was also buggy)
     * small bug fix to link.pas to support compiling on another
       drive
     * probable bug in popt386 fixed: call/jmp => push/jmp
       transformation didn't count correctly the jmp references
     + threadvar support
     * warning if ln/sqrt gets an invalid constant argument
1999-04-28 06:01:54 +00:00

2304 lines
66 KiB
PHP
Raw Blame History

{
$Id$
Copyright (c) 1993-98 by Florian Klaempfl, Pierre Muller
Implementation for the symbols 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.
****************************************************************************
}
{****************************************************************************
TSYM (base for all symtypes)
****************************************************************************}
constructor tsym.init(const n : string);
begin
{$ifndef OLDPPU}
inherited initname(n);
{$else}
left:=nil;
right:=nil;
setname(n);
indexnb:=0;
{$ifdef nextfield}
nextsym:=nil;
{$endif nextfield}
{$endif}
typ:=abstractsym;
properties:=current_object_option;
{$ifdef GDB}
isstabwritten := false;
{$endif GDB}
fileinfo:=tokenpos;
defref:=nil;
lastwritten:=nil;
refcount:=0;
if (cs_browser in aktmoduleswitches) and make_ref then
begin
defref:=new(pref,init(defref,@tokenpos));
inc(refcount);
end;
lastref:=defref;
end;
constructor tsym.load;
begin
{$ifndef OLDPPU}
inherited init;
indexnr:=readword;
{$else}
left:=nil;
right:=nil;
{$endif}
setname(readstring);
typ:=abstractsym;
fillchar(fileinfo,sizeof(fileinfo),0);
properties:=symprop(readbyte);
lastref:=nil;
defref:=nil;
lastwritten:=nil;
refcount:=0;
{$ifdef GDB}
isstabwritten := false;
{$endif GDB}
end;
procedure tsym.load_references;
var
pos : tfileposinfo;
move_last : boolean;
begin
move_last:=lastwritten=lastref;
while (not current_ppu^.endofentry) do
begin
readposinfo(pos);
inc(refcount);
lastref:=new(pref,init(lastref,@pos));
lastref^.is_written:=true;
if refcount=1 then
defref:=lastref;
end;
if move_last then
lastwritten:=lastref;
end;
{ big problem here :
wrong refs were written because of
interface parsing of other units PM
moduleindex must be checked !! }
function tsym.write_references : boolean;
var
ref : pref;
symref_written,move_last : boolean;
begin
write_references:=false;
if lastwritten=lastref then
exit;
{ should we update lastref }
move_last:=true;
symref_written:=false;
{ write symbol refs }
if assigned(lastwritten) then
ref:=lastwritten
else
ref:=defref;
while assigned(ref) do
begin
if ref^.moduleindex=current_module^.unit_index then
begin
{ write address to this symbol }
if not symref_written then
begin
writesymref(@self);
symref_written:=true;
end;
writeposinfo(ref^.posinfo);
ref^.is_written:=true;
if move_last then
lastwritten:=ref;
end
else if not ref^.is_written then
move_last:=false
else if move_last then
lastwritten:=ref;
ref:=ref^.nextref;
end;
if symref_written then
current_ppu^.writeentry(ibsymref);
write_references:=symref_written;
end;
{$ifdef BrowserLog}
procedure tsym.add_to_browserlog;
begin
if assigned(defref) then
begin
browserlog.AddLog('***'+name+'***');
browserlog.AddLogRefs(defref);
end;
end;
{$endif BrowserLog}
destructor tsym.done;
begin
if assigned(defref) then
dispose(defref,done);
{$ifndef OLDPPU}
inherited done;
{$else}
{$ifdef tp}
if not(use_big) then
{$endif tp}
strdispose(_name);
if assigned(left) then
dispose(left,done);
if assigned(right) then
dispose(right,done);
{$endif}
end;
procedure tsym.write;
begin
{$ifndef OLDPPU}
writeword(indexnr);
{$endif}
writestring(name);
writebyte(byte(properties));
end;
procedure tsym.deref;
begin
end;
{$ifdef OLDPPU}
function tsym.name : string;
{$ifdef tp}
var
s : string;
b : byte;
{$endif}
begin
{$ifdef tp}
if use_big then
begin
symbolstream.seek(longint(_name));
symbolstream.read(b,1);
symbolstream.read(s[1],b);
s[0]:=chr(b);
name:=s;
end
else
{$endif}
if assigned(_name) then
name:=strpas(_name)
else
name:='';
end;
procedure tsym.setname(const s : string);
begin
setstring(_name,s);
end;
{$endif}
function tsym.mangledname : string;
begin
mangledname:=name;
end;
{ for most symbol types there is nothing to do at all }
procedure tsym.insert_in_data;
begin
end;
{$ifdef GDB}
function tsym.stabstring : pchar;
begin
stabstring:=strpnew('"'+name+'",'+tostr(N_LSYM)+',0,'+
tostr(fileinfo.line)+',0');
end;
procedure tsym.concatstabto(asmlist : paasmoutput);
var stab_str : pchar;
begin
if not isstabwritten then
begin
stab_str := stabstring;
if asmlist = debuglist then do_count_dbx := true;
{ count_dbx(stab_str); moved to GDB.PAS }
asmlist^.concat(new(pai_stabs,init(stab_str)));
isstabwritten:=true;
end;
end;
{$endif GDB}
{****************************************************************************
TLABELSYM
****************************************************************************}
constructor tlabelsym.init(const n : string; l : plabel);
begin
inherited init(n);
typ:=labelsym;
number:=l;
number^.is_used:=false;
number^.is_set:=true;
number^.refcount:=0;
defined:=false;
end;
constructor tlabelsym.load;
begin
tsym.load;
typ:=labelsym;
{ this is all dummy
it is only used for local browsing }
number:=nil;
defined:=true;
end;
destructor tlabelsym.done;
begin
inherited done;
end;
function tlabelsym.mangledname : string;
begin
{ this also sets the is_used field }
mangledname:=lab2str(number);
end;
procedure tlabelsym.write;
begin
if owner^.symtabletype in [unitsymtable,globalsymtable] then
Message(sym_e_ill_label_decl)
else
begin
tsym.write;
current_ppu^.writeentry(iblabelsym);
end;
end;
{****************************************************************************
TUNITSYM
****************************************************************************}
constructor tunitsym.init(const n : string;ref : punitsymtable);
var
old_make_ref : boolean;
begin
old_make_ref:=make_ref;
make_ref:=false;
inherited init(n);
make_ref:=old_make_ref;
typ:=unitsym;
unitsymtable:=ref;
prevsym:=ref^.unitsym;
ref^.unitsym:=@self;
refs:=0;
end;
constructor tunitsym.load;
begin
tsym.load;
typ:=unitsym;
unitsymtable:=punitsymtable(current_module^.globalsymtable);
prevsym:=nil;
end;
destructor tunitsym.done;
begin
if assigned(unitsymtable) and (unitsymtable^.unitsym=@self) then
unitsymtable^.unitsym:=prevsym;
inherited done;
end;
procedure tunitsym.write;
begin
tsym.write;
current_ppu^.writeentry(ibunitsym);
end;
{$ifdef GDB}
procedure tunitsym.concatstabto(asmlist : paasmoutput);
begin
{Nothing to write to stabs !}
end;
{$endif GDB}
{****************************************************************************
TPROCSYM
****************************************************************************}
constructor tprocsym.init(const n : string);
begin
tsym.init(n);
typ:=procsym;
definition:=nil;
owner:=nil;
{$ifdef GDB}
is_global := false;
{$endif GDB}
end;
constructor tprocsym.load;
begin
tsym.load;
typ:=procsym;
definition:=pprocdef(readdefref);
{$ifdef GDB}
is_global := false;
{$endif GDB}
end;
destructor tprocsym.done;
begin
check_forward;
tsym.done;
end;
function tprocsym.mangledname : string;
begin
mangledname:=definition^.mangledname;
end;
function tprocsym.demangledname:string;
begin
demangledname:=name+definition^.demangled_paras;
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;
oldaktfilepos : tfileposinfo;
begin
{ don't check if errors !! }
if Errorcount>0 then
exit;
pd:=definition;
while assigned(pd) do
begin
if pd^.forwarddef then
begin
oldaktfilepos:=aktfilepos;
aktfilepos:=fileinfo;
if assigned(pd^._class) then
Message1(sym_e_forward_not_resolved,pd^._class^.objname^+'.'+name+demangledparas(pd^.demangled_paras))
else
Message1(sym_e_forward_not_resolved,name+pd^.demangled_paras);
aktfilepos:=oldaktfilepos;
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.write;
begin
tsym.write;
writedefref(pdef(definition));
current_ppu^.writeentry(ibprocsym);
end;
procedure tprocsym.load_references;
(* var
prdef,prdef2 : pprocdef;
b : byte; *)
begin
inherited load_references;
(* prdef:=definition;
{ take care about operators !! }
if (current_module^.flags and uf_has_browser) <>0 then
while assigned(prdef) and (prdef^.owner=definition^.owner) do
begin
b:=current_ppu^.readentry;
if b<>ibdefref then
Message(unit_f_ppu_read_error);
prdef2:=pprocdef(readdefref);
resolvedef(prdef2);
if prdef<>prdef2 then
Message(unit_f_ppu_read_error);
prdef^.load_references;
prdef:=prdef^.nextoverloaded;
end; *)
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;
{$ifdef BrowserLog}
procedure tprocsym.add_to_browserlog;
var
prdef : pprocdef;
begin
inherited add_to_browserlog;
prdef:=definition;
while assigned(prdef) do
begin
pprocdef(prdef)^.add_to_browserlog;
prdef:=pprocdef(prdef)^.nextoverloaded;
end;
end;
{$endif BrowserLog}
{$ifdef GDB}
function tprocsym.stabstring : pchar;
Var RetType : Char;
Obj,Info : String;
stabsstr : string;
p : pchar;
begin
obj := name;
info := '';
if is_global then
RetType := 'F'
else
RetType := 'f';
if assigned(owner) then
begin
if (owner^.symtabletype = objectsymtable) then
obj := owner^.name^+'__'+name;
{ this code was correct only as long as the local symboltable
of the parent had the same name as the function
but this is no true anymore !! PM
if (owner^.symtabletype=localsymtable) and assigned(owner^.name) then
info := ','+name+','+owner^.name^; }
if (owner^.symtabletype=localsymtable) and assigned(owner^.defowner) and
assigned(owner^.defowner^.sym) then
info := ','+name+','+owner^.defowner^.sym^.name;
end;
stabsstr:=definition^.mangledname;
getmem(p,length(stabsstr)+255);
strpcopy(p,'"'+obj+':'+RetType
+definition^.retdef^.numberstring+info+'",'+tostr(n_function)
+',0,'+
tostr(aktfilepos.line)
+',');
strpcopy(strend(p),stabsstr);
stabstring:=strnew(p);
freemem(p,length(stabsstr)+255);
end;
procedure tprocsym.concatstabto(asmlist : paasmoutput);
begin
if (definition^.options and pointernproc) <> 0 then exit;
if not isstabwritten then
asmlist^.concat(new(pai_stabs,init(stabstring)));
isstabwritten := true;
if assigned(definition^.parast) then
definition^.parast^.concatstabto(asmlist);
if assigned(definition^.localst) then
definition^.localst^.concatstabto(asmlist);
definition^.is_def_stab_written := true;
end;
{$endif GDB}
{****************************************************************************
TPROGRAMSYM
****************************************************************************}
constructor tprogramsym.init(const n : string);
begin
inherited init(n);
typ:=programsym;
end;
{****************************************************************************
TERRORSYM
****************************************************************************}
constructor terrorsym.init;
begin
inherited init('');
typ:=errorsym;
end;
{****************************************************************************
TPROPERTYSYM
****************************************************************************}
constructor tpropertysym.init(const n : string);
begin
inherited init(n);
typ:=propertysym;
options:=0;
proptype:=nil;
readaccessdef:=nil;
writeaccessdef:=nil;
readaccesssym:=nil;
writeaccesssym:=nil;
storedsym:=nil;
storeddef:=nil;
index:=0;
default:=0;
end;
destructor tpropertysym.done;
begin
inherited done;
end;
constructor tpropertysym.load;
begin
inherited load;
typ:=propertysym;
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.write;
begin
tsym.write;
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;
{$ifdef GDB}
function tpropertysym.stabstring : pchar;
begin
{ !!!! don't know how to handle }
stabstring:=strpnew('');
end;
procedure tpropertysym.concatstabto(asmlist : paasmoutput);
begin
{ !!!! don't know how to handle }
end;
{$endif GDB}
{****************************************************************************
TFUNCRETSYM
****************************************************************************}
constructor tfuncretsym.init(const n : string;approcinfo : pointer{pprocinfo});
begin
tsym.init(n);
typ:=funcretsym;
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;
begin
tsym.load;
funcretdef:=readdefref;
address:=readlong;
funcretprocinfo:=nil;
typ:=funcretsym;
end;
procedure tfuncretsym.write;
begin
(*
Normally all references are
transfered to the function symbol itself !! PM *)
tsym.write;
writedefref(funcretdef);
writelong(address);
current_ppu^.writeentry(ibfuncretsym);
end;
procedure tfuncretsym.deref;
begin
resolvedef(funcretdef);
end;
{$ifdef GDB}
procedure tfuncretsym.concatstabto(asmlist : paasmoutput);
begin
{ Nothing to do here, it is done in genexitcode }
end;
{$endif GDB}
procedure tfuncretsym.insert_in_data;
var
l : longint;
begin
{ allocate space in local if ret in acc or in fpu }
if ret_in_acc(procinfo.retdef) or (procinfo.retdef^.deftype=floatdef) then
begin
l:=funcretdef^.size;
inc(owner^.datasize,l);
{$ifdef m68k}
{ word alignment required for motorola }
if (l=1) then
inc(owner^.datasize,1)
else
{$endif}
if (l>=4) and ((owner^.datasize and 3)<>0) then
inc(owner^.datasize,4-(owner^.datasize and 3))
else if (l>=2) and ((owner^.datasize and 1)<>0) then
inc(owner^.datasize,2-(owner^.datasize and 1));
address:=owner^.datasize;
procinfo.retoffset:=-owner^.datasize;
end;
end;
{****************************************************************************
TABSOLUTESYM
****************************************************************************}
constructor tabsolutesym.init(const n : string;p : pdef);
begin
inherited init(n,p);
typ:=absolutesym;
end;
constructor tabsolutesym.load;
begin
tvarsym.load;
typ:=absolutesym;
ref:=nil;
address:=0;
asmname:=nil;
abstyp:=absolutetyp(readbyte);
absseg:=false;
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.write;
begin
tsym.write;
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;
procedure tabsolutesym.insert_in_data;
begin
end;
{$ifdef GDB}
procedure tabsolutesym.concatstabto(asmlist : paasmoutput);
begin
{ I don't know how to handle this !! }
end;
{$endif GDB}
{****************************************************************************
TVARSYM
****************************************************************************}
constructor tvarsym.init(const n : string;p : pdef);
begin
tsym.init(n);
typ:=varsym;
definition:=p;
_mangledname:=nil;
varspez:=vs_value;
address:=0;
islocalcopy:=false;
localvarsym:=nil;
refs:=0;
is_valid := 1;
var_options:=0;
{ can we load the value into a register ? }
case p^.deftype of
pointerdef,
enumdef,
procvardef :
var_options:=var_options or vo_regable;
orddef :
case porddef(p)^.typ of
bool8bit,bool16bit,bool32bit,
u8bit,u16bit,u32bit,
s8bit,s16bit,s32bit :
var_options:=var_options or vo_regable;
else
var_options:=var_options and not vo_regable;
end;
setdef:
if psetdef(p)^.settype=smallset then
var_options:=var_options or vo_regable;
else
var_options:=var_options and not vo_regable;
end;
reg:=R_NO;
end;
constructor tvarsym.init_dll(const n : string;p : pdef);
begin
{ The tvarsym is necessary for 0.99.5 (PFV) }
tvarsym.init(n,p);
var_options:=var_options or vo_is_dll_var;
end;
constructor tvarsym.init_C(const n,mangled : string;p : pdef);
begin
{ The tvarsym is necessary for 0.99.5 (PFV) }
tvarsym.init(n,p);
var_options:=var_options or vo_is_C_var;
setmangledname(mangled);
end;
constructor tvarsym.load;
begin
tsym.load;
typ:=varsym;
_mangledname:=nil;
reg:=R_NO;
refs := 0;
is_valid := 1;
varspez:=tvarspez(readbyte);
if read_member then
address:=readlong
else
address:=0;
islocalcopy:=false;
localvarsym:=nil;
definition:=readdefref;
var_options:=readbyte;
if (var_options and vo_is_C_var)<>0 then
setmangledname(readstring);
end;
procedure tvarsym.deref;
begin
resolvedef(definition);
end;
procedure tvarsym.write;
begin
tsym.write;
writebyte(byte(varspez));
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:=strpnew(s);
end;
function tvarsym.mangledname : string;
var
prefix : string;
begin
if assigned(_mangledname) then
begin
mangledname:=strpas(_mangledname);
exit;
end;
case owner^.symtabletype of
staticsymtable :
if (cs_smartlink in aktmoduleswitches) then
prefix:='_'+owner^.name^+'$$$_'
else
prefix:='_';
unitsymtable,
globalsymtable :
prefix:='U_'+owner^.name^+'_';
else
Message(sym_e_invalid_call_tvarsymmangledname);
end;
mangledname:=prefix+name;
end;
function tvarsym.getsize : longint;
begin
if assigned(definition) and (varspez=vs_value) then
getsize:=definition^.size
else
getsize:=0;
end;
function tvarsym.getpushsize : longint;
begin
if assigned(definition) then
begin
case varspez of
vs_var :
getpushsize:=target_os.size_of_pointer;
vs_value,
vs_const :
begin
case definition^.deftype of
arraydef,
setdef,
stringdef,
recorddef,
objectdef :
getpushsize:=target_os.size_of_pointer;
else
getpushsize:=definition^.size;
end;
end;
end;
end
else
getpushsize:=0;
end;
procedure tvarsym.insert_in_data;
var
l,modulo : longint;
begin
if (var_options and vo_is_external)<>0 then
exit;
{ handle static variables of objects especially }
if read_member and (owner^.symtabletype=objectsymtable) and
((properties and sp_static)<>0) then
begin
{ the data filed is generated in parser.pas
with a tobject_FIELDNAME variable }
{ this symbol can't be loaded to a register }
var_options:=var_options and not vo_regable;
end
else
if not(read_member) then
begin
{ made problems with parameters etc. ! (FK) }
{ check for instance of an abstract object or class }
{
if (pvarsym(sym)^.definition^.deftype=objectdef) and
((pobjectdef(pvarsym(sym)^.definition)^.options and oo_is_abstract)<>0) then
Message(sym_e_no_instance_of_abstract_object);
}
if ((var_options and vo_is_thread_var)<>0) then
l:=4
else
l:=getsize;
case owner^.symtabletype of
stt_exceptsymtable:
{ can contain only one symbol, address calculated later }
;
localsymtable :
begin
is_valid := 0;
modulo:=owner^.datasize and 3;
{$ifdef m68k}
{ word alignment required for motorola }
if (l=1) then
l:=2
else
{$endif}
if (l>=4) and (modulo<>0) then
inc(l,4-modulo)
else
if (l>=2) and ((modulo and 1)<>0) then
inc(l,2-(modulo and 1));
inc(owner^.datasize,l);
address:=owner^.datasize;
end;
staticsymtable :
begin
{ enable unitilized warning for local symbols }
is_valid := 0;
if (cs_smartlink in aktmoduleswitches) then
bsssegment^.concat(new(pai_cut,init));
{$ifdef GDB}
if cs_debuginfo in aktmoduleswitches then
concatstabto(bsssegment);
{$endif GDB}
if (cs_smartlink in aktmoduleswitches) or
((var_options and vo_is_c_var)<>0) then
bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)))
else
bsssegment^.concat(new(pai_datablock,init(mangledname,l)));
{ increase datasize }
inc(owner^.datasize,l);
{ this symbol can't be loaded to a register }
var_options:=var_options and not vo_regable;
end;
globalsymtable :
begin
if (cs_smartlink in aktmoduleswitches) then
bsssegment^.concat(new(pai_cut,init));
{$ifdef GDB}
if cs_debuginfo in aktmoduleswitches then
concatstabto(bsssegment);
{$endif GDB}
bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)));
inc(owner^.datasize,l);
{ this symbol can't be loaded to a register }
var_options:=var_options and not vo_regable;
end;
recordsymtable,
objectsymtable :
begin
{ this symbol can't be loaded to a register }
var_options:=var_options and not vo_regable;
{ align record and object fields }
if (l=1) or (aktpackrecords=1) then
begin
address:=owner^.datasize;
inc(owner^.datasize,l)
end
else
if (l=2) or (aktpackrecords=2) then
begin
owner^.datasize:=(owner^.datasize+1) and (not 1);
address:=owner^.datasize;
inc(owner^.datasize,l)
end
else
if (l<=4) or (aktpackrecords=4) then
begin
owner^.datasize:=(owner^.datasize+3) and (not 3);
address:=owner^.datasize;
inc(owner^.datasize,l);
end
else
if (l<=8) or (aktpackrecords=8) then
begin
owner^.datasize:=(owner^.datasize+7) and (not 7);
address:=owner^.datasize;
inc(owner^.datasize,l);
end
else
if (l<=16) or (aktpackrecords=16) then
begin
owner^.datasize:=(owner^.datasize+15) and (not 15);
address:=owner^.datasize;
inc(owner^.datasize,l);
end
else
if (l<=32) or (aktpackrecords=32) then
begin
owner^.datasize:=(owner^.datasize+31) and (not 31);
address:=owner^.datasize;
inc(owner^.datasize,l);
end;
end;
parasymtable :
begin
{ here we need the size of a push instead of the
size of the data }
l:=getpushsize;
address:=owner^.datasize;
owner^.datasize:=align(owner^.datasize+l,target_os.stackalignment);
end
else
begin
modulo:=owner^.datasize and 3 ;
if (l>=4) and (modulo<>0) then
inc(owner^.datasize,4-modulo)
else
if (l>=2) and ((modulo and 1)<>0) then
inc(owner^.datasize);
address:=owner^.datasize;
inc(owner^.datasize,l);
end;
end;
end;
end;
{$ifdef GDB}
function tvarsym.stabstring : pchar;
var
st : char;
begin
if (owner^.symtabletype = objectsymtable) and
((properties and sp_static)<>0) then
begin
if (cs_gdb_gsym in aktglobalswitches) then st := 'G' else st := 'S';
stabstring := strpnew('"'+owner^.name^+'__'+name+':'+
+definition^.numberstring+'",'+
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
end
else if (owner^.symtabletype = globalsymtable) or
(owner^.symtabletype = unitsymtable) then
begin
{ Here we used S instead of
because with G GDB doesn't look at the address field
but searches the same name or with a leading underscore
but these names don't exist in pascal !}
if (cs_gdb_gsym in aktglobalswitches) then st := 'G' else st := 'S';
stabstring := strpnew('"'+name+':'+st
+definition^.numberstring+'",'+
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
end
else if owner^.symtabletype = staticsymtable then
begin
stabstring := strpnew('"'+name+':S'
+definition^.numberstring+'",'+
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
end
else if (owner^.symtabletype=parasymtable) then
begin
case varspez of
vs_var : st := 'v';
vs_value,
vs_const : if push_addr_param(definition) then
st := 'v' { should be 'i' but 'i' doesn't work }
else
st := 'p';
end;
stabstring := strpnew('"'+name+':'+st
+definition^.numberstring+'",'+
tostr(N_PSYM)+',0,'+tostr(fileinfo.line)+','+
tostr(address+owner^.address_fixup));
{offset to ebp => will not work if the framepointer is esp
so some optimizing will make things harder to debug }
end
else if (owner^.symtabletype=localsymtable) then
{$ifdef i386}
if reg<>R_NO then
begin
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
{ this is the register order for GDB}
stabstring:=strpnew('"'+name+':r'
+definition^.numberstring+'",'+
tostr(N_RSYM)+',0,'+
tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
end
else
{$endif i386}
stabstring := strpnew('"'+name+':'
+definition^.numberstring+'",'+
tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',-'+tostr(address))
else
stabstring := inherited stabstring;
end;
procedure tvarsym.concatstabto(asmlist : paasmoutput);
{$ifdef i386}
var stab_str : pchar;
{$endif i386}
begin
inherited concatstabto(asmlist);
{$ifdef i386}
if (owner^.symtabletype=parasymtable) and
(reg<>R_NO) then
begin
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
{ this is the register order for GDB}
stab_str:=strpnew('"'+name+':r'
+definition^.numberstring+'",'+
tostr(N_RSYM)+',0,'+
tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
asmlist^.concat(new(pai_stabs,init(stab_str)));
end;
{$endif i386}
end;
{$endif GDB}
destructor tvarsym.done;
begin
strdispose(_mangledname);
inherited done;
end;
{****************************************************************************
TTYPEDCONSTSYM
*****************************************************************************}
constructor ttypedconstsym.init(const n : string;p : pdef;really_const : boolean);
begin
tsym.init(n);
typ:=typedconstsym;
definition:=p;
is_really_const:=really_const;
prefix:=stringdup(procprefix);
end;
constructor ttypedconstsym.load;
begin
tsym.load;
typ:=typedconstsym;
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;
destructor ttypedconstsym.done;
begin
stringdispose(prefix);
tsym.done;
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.deref;
begin
resolvedef(definition);
end;
procedure ttypedconstsym.write;
begin
tsym.write;
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;
begin
{ here there is a problem for ansistrings !! }
{ we must write the label only after the 12 header bytes (PM)
if not is_ansistring(definition) then
}
{ solved, the ansis string is moved to consts (FK) }
really_insert_in_data;
end;
procedure ttypedconstsym.really_insert_in_data;
var curconstsegment : paasmoutput;
begin
if is_really_const then
curconstsegment:=consts
else
curconstsegment:=datasegment;
if owner^.symtabletype=globalsymtable then
begin
if (cs_smartlink in aktmoduleswitches) then
curconstsegment^.concat(new(pai_cut,init));
{$ifdef GDB}
if cs_debuginfo in aktmoduleswitches then
concatstabto(curconstsegment);
{$endif GDB}
curconstsegment^.concat(new(pai_symbol,init_global(mangledname)));
end
else
if owner^.symtabletype<>unitsymtable then
begin
if (cs_smartlink in aktmoduleswitches) then
curconstsegment^.concat(new(pai_cut,init));
{$ifdef GDB}
if cs_debuginfo in aktmoduleswitches then
concatstabto(curconstsegment);
{$endif GDB}
if (cs_smartlink in aktmoduleswitches) then
curconstsegment^.concat(new(pai_symbol,init_global(mangledname)))
else
curconstsegment^.concat(new(pai_symbol,init(mangledname)));
end;
end;
{$ifdef GDB}
function ttypedconstsym.stabstring : pchar;
var
st : char;
begin
if (cs_gdb_gsym in aktglobalswitches) and (owner^.symtabletype in [unitsymtable,globalsymtable]) then
st := 'G'
else
st := 'S';
stabstring := strpnew('"'+name+':'+st+
definition^.numberstring+'",'+tostr(n_STSYM)+',0,'+
tostr(fileinfo.line)+','+mangledname);
end;
{$endif GDB}
{****************************************************************************
TCONSTSYM
****************************************************************************}
constructor tconstsym.init(const n : string;t : tconsttype;v : longint);
begin
inherited init(n);
typ:=constsym;
consttype:=t;
value:=v;
definition:=nil;
len:=0;
end;
constructor tconstsym.init_def(const n : string;t : tconsttype;v : longint;def : pdef);
begin
inherited init(n);
typ:=constsym;
consttype:=t;
value:=v;
definition:=def;
len:=0;
end;
constructor tconstsym.init_string(const n : string;t : tconsttype;str:pchar;l:longint);
begin
inherited init(n);
typ:=constsym;
consttype:=t;
value:=longint(str);
definition:=nil;
len:=l;
end;
constructor tconstsym.load;
var
pd : pbestreal;
ps : pnormalset;
begin
tsym.load;
typ:=constsym;
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;
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;
function tconstsym.mangledname : string;
begin
mangledname:=name;
end;
procedure tconstsym.deref;
begin
if consttype in [constord,constset] then
resolvedef(pdef(definition));
end;
procedure tconstsym.write;
begin
tsym.write;
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;
{$ifdef GDB}
function tconstsym.stabstring : pchar;
var st : string;
begin
{even GDB v4.16 only now 'i' 'r' and 'e' !!!}
case consttype of
conststring : begin
{ I had to remove ibm2ascii !! }
st := pstring(value)^;
{st := ibm2ascii(pstring(value)^);}
st := 's'''+st+'''';
end;
constbool, constint, constord, constchar : st := 'i'+tostr(value);
constreal : begin
system.str(pbestreal(value)^,st);
st := 'r'+st;
end;
{ if we don't know just put zero !! }
else st:='i0';
{***SETCONST}
{constset:;} {*** I don't know what to do with a set.}
{ sets are not recognized by GDB}
{***}
end;
stabstring := strpnew('"'+name+':c='+st+'",'+tostr(N_function)+',0,'+
tostr(fileinfo.line)+',0');
end;
procedure tconstsym.concatstabto(asmlist : paasmoutput);
begin
if consttype <> conststring then
inherited concatstabto(asmlist);
end;
{$endif GDB}
{****************************************************************************
TENUMSYM
****************************************************************************}
constructor tenumsym.init(const n : string;def : penumdef;v : longint);
begin
tsym.init(n);
typ:=enumsym;
definition:=def;
value:=v;
if def^.min>v then
def^.setmin(v);
if def^.max<v then
def^.setmax(v);
order;
end;
constructor tenumsym.load;
begin
tsym.load;
typ:=enumsym;
definition:=penumdef(readdefref);
value:=readlong;
nextenum := Nil;
end;
procedure tenumsym.deref;
begin
resolvedef(pdef(definition));
order;
end;
procedure tenumsym.order;
var
sym : penumsym;
begin
sym := definition^.firstenum;
if sym = nil then
begin
definition^.firstenum := @self;
nextenum := nil;
exit;
end;
{ reorder the symbols in increasing value }
if value < sym^.value then
begin
nextenum := sym;
definition^.firstenum := @self;
end
else
begin
while (sym^.value <= value) and assigned(sym^.nextenum) do
sym := sym^.nextenum;
nextenum := sym^.nextenum;
sym^.nextenum := @self;
end;
end;
procedure tenumsym.write;
begin
tsym.write;
writedefref(definition);
writelong(value);
current_ppu^.writeentry(ibenumsym);
end;
{$ifdef GDB}
procedure tenumsym.concatstabto(asmlist : paasmoutput);
begin
{enum elements have no stab !}
end;
{$EndIf GDB}
{****************************************************************************
TTYPESYM
****************************************************************************}
constructor ttypesym.init(const n : string;d : pdef);
begin
tsym.init(n);
typ:=typesym;
definition:=d;
{$ifdef GDB}
isusedinstab := false;
{$endif GDB}
forwardpointer:=nil;
if assigned(definition) and not(assigned(definition^.sym)) then
definition^.sym:=@self;
end;
constructor ttypesym.load;
begin
tsym.load;
typ:=typesym;
forwardpointer:=nil;
{$ifdef GDB}
isusedinstab := false;
{$endif GDB}
definition:=readdefref;
end;
destructor ttypesym.done;
begin
if assigned(definition) then
if definition^.sym=@self then
definition^.sym:=nil;
inherited done;
end;
procedure ttypesym.deref;
begin
resolvedef(definition);
if assigned(definition) then
begin
if definition^.sym=nil then
definition^.sym:=@self;
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.write;
begin
tsym.write;
writedefref(definition);
current_ppu^.writeentry(ibtypesym);
end;
procedure ttypesym.load_references;
begin
inherited load_references;
if (definition^.deftype=recorddef) then
precdef(definition)^.symtable^.load_browser;
if (definition^.deftype=objectdef) 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.addforwardpointer(p:ppointerdef);
var
hfp : pforwardpointer;
begin
new(hfp);
hfp^.next:=forwardpointer;
hfp^.def:=p;
forwardpointer:=hfp;
end;
procedure ttypesym.updateforwarddef(p:pdef);
var
lasthfp,hfp : pforwardpointer;
begin
definition:=p;
properties:=current_object_option;
fileinfo:=tokenpos;
if assigned(definition) and not(assigned(definition^.sym)) then
definition^.sym:=@self;
{ update all forwardpointers to this definition }
hfp:=forwardpointer;
while assigned(hfp) do
begin
lasthfp:=hfp;
hfp^.def^.definition:=definition;
hfp:=hfp^.next;
dispose(lasthfp);
end;
end;
{$ifdef BrowserLog}
procedure ttypesym.add_to_browserlog;
begin
inherited add_to_browserlog;
if (definition^.deftype=recorddef) then
precdef(definition)^.symtable^.writebrowserlog;
if (definition^.deftype=objectdef) then
pobjectdef(definition)^.publicsyms^.writebrowserlog;
end;
{$endif BrowserLog}
{$ifdef GDB}
function ttypesym.stabstring : pchar;
var stabchar : string[2];
short : string;
begin
if definition^.deftype in tagtypes then
stabchar := 'Tt'
else
stabchar := 't';
short := '"'+name+':'+stabchar+definition^.numberstring
+'",'+tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',0';
stabstring := strpnew(short);
end;
procedure ttypesym.concatstabto(asmlist : paasmoutput);
begin
{not stabs for forward defs }
if assigned(definition) then
if (definition^.sym = @self) then
definition^.concatstabto(asmlist)
else
inherited concatstabto(asmlist);
end;
{$endif GDB}
{****************************************************************************
TSYSSYM
****************************************************************************}
constructor tsyssym.init(const n : string;l : longint);
begin
inherited init(n);
typ:=syssym;
number:=l;
end;
constructor tsyssym.load;
begin
tsym.load;
typ:=syssym;
number:=readlong;
end;
destructor tsyssym.done;
begin
inherited done;
end;
procedure tsyssym.write;
begin
{$ifndef OLDPPU}
tsym.write;
writelong(number);
current_ppu^.writeentry(ibsyssym);
{$endif}
end;
{$ifdef GDB}
procedure tsyssym.concatstabto(asmlist : paasmoutput);
begin
end;
{$endif GDB}
{****************************************************************************
TMACROSYM
****************************************************************************}
constructor tmacrosym.init(const n : string);
begin
inherited init(n);
typ:=macrosym;
defined:=true;
buftext:=nil;
buflen:=0;
end;
destructor tmacrosym.done;
begin
if assigned(buftext) then
freemem(buftext,buflen);
inherited done;
end;
{
$Log$
Revision 1.83 1999-04-28 06:02:13 florian
* changes of Bruessel:
+ message handler can now take an explicit self
* typinfo fixed: sometimes the type names weren't written
* the type checking for pointer comparisations and subtraction
and are now more strict (was also buggy)
* small bug fix to link.pas to support compiling on another
drive
* probable bug in popt386 fixed: call/jmp => push/jmp
transformation didn't count correctly the jmp references
+ threadvar support
* warning if ln/sqrt gets an invalid constant argument
Revision 1.82 1999/04/26 13:31:52 peter
* release storenumber,double_checksum
Revision 1.81 1999/04/25 22:38:39 pierre
+ added is_really_const booleanfield for typedconstsym
for Delphi in $J- mode (not yet implemented !)
Revision 1.80 1999/04/21 09:43:54 peter
* storenumber works
* fixed some typos in double_checksum
+ incompatible types type1 and type2 message (with storenumber)
Revision 1.79 1999/04/17 13:16:21 peter
* fixes for storenumber
Revision 1.78 1999/04/14 09:15:02 peter
* first things to store the symbol/def number in the ppu
Revision 1.77 1999/04/08 10:11:32 pierre
+ enable uninitilized warnings for static symbols
Revision 1.76 1999/03/31 13:55:21 peter
* assembler inlining working for ag386bin
Revision 1.75 1999/03/24 23:17:27 peter
* fixed bugs 212,222,225,227,229,231,233
Revision 1.74 1999/02/23 18:29:27 pierre
* win32 compilation error fix
+ some work for local browser (not cl=omplete yet)
Revision 1.73 1999/02/22 13:07:09 pierre
+ -b and -bl options work !
+ cs_local_browser ($L+) is disabled if cs_browser ($Y+)
is not enabled when quitting global section
* local vars and procedures are not yet stored into PPU
Revision 1.72 1999/02/08 09:51:22 pierre
* gdb info for local functions was wrong
Revision 1.71 1999/01/23 23:29:41 florian
* first running version of the new code generator
* when compiling exceptions under Linux fixed
Revision 1.70 1999/01/21 22:10:48 peter
* fixed array of const
* generic platform independent high() support
Revision 1.69 1999/01/20 10:20:20 peter
* don't make localvar copies for assembler procedures
Revision 1.68 1999/01/12 14:25:36 peter
+ BrowserLog for browser.log generation
+ BrowserCol for browser info in TCollections
* released all other UseBrowser
Revision 1.67 1998/12/30 22:15:54 peter
+ farpointer type
* absolutesym now also stores if its far
Revision 1.66 1998/12/30 13:41:14 peter
* released valuepara
Revision 1.65 1998/12/26 15:35:44 peter
+ read/write of constnil
Revision 1.64 1998/12/08 10:18:15 peter
+ -gh for heaptrc unit
Revision 1.63 1998/11/28 16:20:56 peter
+ support for dll variables
Revision 1.62 1998/11/27 14:50:48 peter
+ open strings, $P switch support
Revision 1.61 1998/11/18 15:44:18 peter
* VALUEPARA for tp7 compatible value parameters
Revision 1.60 1998/11/16 10:13:51 peter
* label defines are checked at the end of the proc
Revision 1.59 1998/11/13 12:09:11 peter
* unused label is now a warning
Revision 1.58 1998/11/10 10:50:57 pierre
* temporary fix for long mangled procsym names
Revision 1.57 1998/11/05 23:39:31 peter
+ typedconst.getsize
Revision 1.56 1998/10/28 18:26:18 pierre
* removed some erros after other errors (introduced by useexcept)
* stabs works again correctly (for how long !)
Revision 1.55 1998/10/20 08:07:00 pierre
* several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default
that ra386dir translates global and unit symbols
+ added a first field in tsymtable and
a nextsym field in tsym
(this allows to obtain ordered type info for
records and objects in gdb !)
Revision 1.54 1998/10/19 08:55:07 pierre
* wrong stabs info corrected once again !!
+ variable vmt offset with vmt field only if required
implemented now !!!
Revision 1.53 1998/10/16 08:51:53 peter
+ target_os.stackalignment
+ stack can be aligned at 2 or 4 byte boundaries
Revision 1.52 1998/10/08 17:17:32 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.51 1998/10/08 13:48:50 peter
* fixed memory leaks for do nothing source
* fixed unit interdependency
Revision 1.50 1998/10/06 17:16:56 pierre
* some memory leaks fixed (thanks to Peter for heaptrc !)
Revision 1.49 1998/10/01 09:22:55 peter
* fixed value openarray
* ungettemp of arrayconstruct
Revision 1.48 1998/09/26 17:45:44 peter
+ idtoken and only one token table
Revision 1.47 1998/09/24 15:11:17 peter
* fixed enum for not GDB
Revision 1.46 1998/09/23 15:39:13 pierre
* browser bugfixes
was adding a reference when looking for the symbol
if -bSYM_NAME was used
Revision 1.45 1998/09/21 08:45:24 pierre
+ added vmt_offset in tobjectdef.write for fututre use
(first steps to have objects without vmt if no virtual !!)
+ added fpu_used field for tabstractprocdef :
sets this level to 2 if the functions return with value in FPU
(is then set to correct value at parsing of implementation)
THIS MIGHT refuse some code with FPU expression too complex
that were accepted before and even in some cases
that don't overflow in fact
( like if f : float; is a forward that finally in implementation
only uses one fpu register !!)
Nevertheless I think that it will improve security on
FPU operations !!
* most other changes only for UseBrowser code
(added symtable references for record and objects)
local switch for refs to args and local of each function
(static symtable still missing)
UseBrowser still not stable and probably broken by
the definition hash array !!
Revision 1.44 1998/09/18 16:03:47 florian
* some changes to compile with Delphi
Revision 1.43 1998/09/18 08:01:38 pierre
+ improvement on the usebrowser part
(does not work correctly for now)
Revision 1.42 1998/09/07 19:33:25 florian
+ some stuff for property rtti added:
- NameIndex of the TPropInfo record is now written correctly
- the DEFAULT/NODEFAULT keyword is supported now
- the default value and the storedsym/def are now written to
the PPU fiel
Revision 1.41 1998/09/07 18:46:12 peter
* update smartlinking, uses getdatalabel
* renamed ptree.value vars to value_str,value_real,value_set
Revision 1.40 1998/09/07 17:37:04 florian
* first fixes for published properties
Revision 1.39 1998/09/05 22:11:02 florian
+ switch -vb
* while/repeat loops accept now also word/longbool conditions
* makebooltojump did an invalid ungetregister32, fixed
Revision 1.38 1998/09/01 12:53:26 peter
+ aktpackenum
Revision 1.37 1998/09/01 07:54:25 pierre
* UseBrowser a little updated (might still be buggy !!)
* bug in psub.pas in function specifier removed
* stdcall allowed in interface and in implementation
(FPC will not yet complain if it is missing in either part
because stdcall is only a dummy !!)
Revision 1.36 1998/08/25 13:09:26 pierre
* corrected mangling sheme :
cvar add Cprefix to the mixed case name whereas
export or public use direct name
Revision 1.35 1998/08/25 12:42:46 pierre
* CDECL changed to CVAR for variables
specifications are read in structures also
+ started adding GPC compatibility mode ( option -Sp)
* names changed to lowercase
Revision 1.34 1998/08/21 14:08:53 pierre
+ TEST_FUNCRET now default (old code removed)
works also for m68k (at least compiles)
Revision 1.33 1998/08/20 12:53:27 peter
* object_options are always written for object syms
Revision 1.32 1998/08/20 09:26:46 pierre
+ funcret setting in underproc testing
compile with _dTEST_FUNCRET
Revision 1.31 1998/08/17 10:10:12 peter
- removed OLDPPU
Revision 1.30 1998/08/13 10:57:29 peter
* constant sets are now written correctly to the ppufile
Revision 1.29 1998/08/11 15:31:42 peter
* write extended to ppu file
* new version 0.99.7
Revision 1.28 1998/08/11 14:07:27 peter
* fixed pushing of high value for openarray
Revision 1.27 1998/08/10 14:50:31 peter
+ localswitches, moduleswitches, globalswitches splitting
Revision 1.26 1998/08/10 10:18:35 peter
+ Compiler,Comphook unit which are the new interface units to the
compiler
Revision 1.25 1998/07/30 11:18:19 florian
+ first implementation of try ... except on .. do end;
* limitiation of 65535 bytes parameters for cdecl removed
Revision 1.24 1998/07/20 18:40:16 florian
* handling of ansi string constants should now work
Revision 1.23 1998/07/14 21:37:24 peter
* fixed packrecords as discussed at the alias
Revision 1.22 1998/07/14 14:47:08 peter
* released NEWINPUT
Revision 1.21 1998/07/13 21:17:38 florian
* changed to compile with TP
Revision 1.20 1998/07/10 00:00:05 peter
* fixed ttypesym bug finally
* fileinfo in the symtable and better using for unused vars
Revision 1.19 1998/07/07 17:40:39 peter
* packrecords 4 works
* word aligning of parameters
Revision 1.18 1998/07/07 11:20:15 peter
+ NEWINPUT for a better inputfile and scanner object
Revision 1.17 1998/06/24 14:48:40 peter
* ifdef newppu -> ifndef oldppu
Revision 1.16 1998/06/19 15:40:42 peter
* removed cosntructor/constructor warning and 0.99.5 recompiles it again
Revision 1.15 1998/06/17 14:10:18 peter
* small os2 fixes
* fixed interdependent units with newppu (remake3 under linux works now)
Revision 1.14 1998/06/16 08:56:34 peter
+ targetcpu
* cleaner pmodules for newppu
Revision 1.13 1998/06/15 15:38:10 pierre
* small bug in systems.pas corrected
+ operators in different units better hanlded
Revision 1.12 1998/06/15 14:23:44 daniel
* Reverted my changes.
Revision 1.10 1998/06/13 00:10:18 peter
* working browser and newppu
* some small fixes against crashes which occured in bp7 (but not in
fpc?!)
Revision 1.9 1998/06/12 16:15:35 pierre
* external name 'C_var';
export name 'intern_C_var';
cdecl;
cdecl;external;
are now supported only with -Sv switch
Revision 1.8 1998/06/11 10:11:59 peter
* -gb works again
Revision 1.7 1998/06/09 16:01:51 pierre
+ added procedure directive parsing for procvars
(accepted are popstack cdecl and pascal)
+ added C vars with the following syntax
var C calias 'true_c_name';(can be followed by external)
reason is that you must add the Cprefix
which is target dependent
Revision 1.6 1998/06/08 22:59:53 peter
* smartlinking works for win32
* some defines to exclude some compiler parts
Revision 1.5 1998/06/04 23:52:02 peter
* m68k compiles
+ .def file creation moved to gendef.pas so it could also be used
for win32
Revision 1.4 1998/06/04 09:55:46 pierre
* demangled name of procsym reworked to become independant of the mangling scheme
Revision 1.3 1998/06/03 22:14:20 florian
* problem with sizes of classes fixed (if the anchestor was declared
forward, the compiler doesn't update the child classes size)
Revision 1.2 1998/05/28 14:40:29 peter
* fixes for newppu, remake3 works now with it
Revision 1.1 1998/05/27 19:45:09 peter
* symtable.pas splitted into includefiles
* symtable adapted for $ifndef OLDPPU
}
Reference in New Issue View Git Blame Copy Permalink