paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-24 09:19:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

* unit mapping rewrite

Browse Source 
* new derefmap added
This commit is contained in:
peter 2005-01-19 22:19:41 +00:00
parent 66d9ada975
commit 8d251e8506
20 changed files with 489 additions and 237 deletions

202
compiler/fmodule.pas
View File

@ -80,11 +80,21 @@ interface
tused_unit = class;
tunitmaprec = record
u : tmodule;
unitsym : tunitsym;
u : tmodule;
{ number of references }
refs : longint;
{ index in the derefmap }
derefidx : longint;
end;
punitmap = ^tunitmaprec;
tderefmaprec = record
u : tmodule;
{ modulename, used during ppu load }
modulename : pstring;
end;
pderefmap = ^tderefmaprec;
tmodule = class(tmodulebase)
do_reload, { force reloading of the unit }
do_compile, { need to compile the sources }
@ -102,8 +112,12 @@ interface
interface_crc : cardinal;
flags : cardinal; { the PPU flags }
islibrary : boolean; { if it is a library (win32 dll) }
map : punitmap; { mapping of all used units }
mapsize : longint; { number of units in the map }
moduleid : longint;
unitmap : punitmap; { mapping of all used units }
unitmapsize : longint; { number of units in the map }
derefmap : pderefmap; { mapping of all units needed for deref }
derefmapcnt : longint; { number of units in the map }
derefmapsize : longint; { number of units in the map }
derefdataintflen : longint;
derefdata : tdynamicarray;
globalsymtable, { pointer to the global symtable of this unit }
@ -145,7 +159,9 @@ interface
procedure adddependency(callermodule:tmodule);
procedure flagdependent(callermodule:tmodule);
function addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
procedure numberunits;
procedure updatemaps;
function derefidx_unit(id:longint):longint;
function resolve_unit(id:longint):tmodule;
procedure allunitsused;
procedure setmodulename(const s:string);
end;
@ -174,7 +190,8 @@ interface
SmartLinkOFiles : TStringList; { List of .o files which are generated,
used to delete them after linking }
function get_source_file(moduleindex,fileindex : longint) : tinputfile;
function get_source_file(moduleindex,fileindex : longint) : tinputfile;
procedure addloadedunit(hp:tmodule);
implementation
@ -187,7 +204,7 @@ implementation
dos,
{$ENDIF USE_SYSUTILS}
verbose,systems,
scanner,
scanner,ppu,
procinfo;
@ -209,6 +226,13 @@ implementation
end;
procedure addloadedunit(hp:tmodule);
begin
hp.moduleid:=loaded_units.count;
loaded_units.concat(hp);
end;
{****************************************************************************
TLinkContainerItem
****************************************************************************}
@ -393,8 +417,11 @@ implementation
interface_crc:=0;
flags:=0;
scanner:=nil;
map:=nil;
mapsize:=0;
unitmap:=nil;
unitmapsize:=0;
derefmap:=nil;
derefmapsize:=0;
derefmapcnt:=0;
derefdata:=TDynamicArray.Create(1024);
derefdataintflen:=0;
globalsymtable:=nil;
@ -429,9 +456,17 @@ implementation
{$ifdef MEMDEBUG}
d : tmemdebug;
{$endif}
i : longint;
hpi : tprocinfo;
begin
dispose(map);
if assigned(unitmap) then
freemem(unitmap);
if assigned(derefmap) then
begin
for i:=0 to derefmapcnt-1 do
stringdispose(derefmap[i].modulename);
freemem(derefmap);
end;
if assigned(imports) then
imports.free;
if assigned(_exports) then
@ -512,6 +547,7 @@ implementation
procedure tmodule.reset;
var
hpi : tprocinfo;
i : longint;
begin
if assigned(scanner) then
begin
@ -556,13 +592,22 @@ implementation
end;
derefdata.free;
derefdata:=TDynamicArray.Create(1024);
if assigned(map) then
if assigned(unitmap) then
begin
freemem(map);
map:=nil;
freemem(unitmap);
unitmap:=nil;
end;
if assigned(derefmap) then
begin
for i:=0 to derefmapcnt-1 do
stringdispose(derefmap[i].modulename);
freemem(derefmap);
derefmap:=nil;
end;
unitmapsize:=0;
derefmapsize:=0;
derefmapcnt:=0;
derefdataintflen:=0;
mapsize:=0;
sourcefiles.free;
sourcefiles:=tinputfilemanager.create;
librarydata.free;
@ -665,55 +710,110 @@ implementation
end;
procedure tmodule.numberunits;
procedure tmodule.updatemaps;
var
pu : tused_unit;
hp : tmodule;
i : integer;
oldmapsize : longint;
hp : tmodule;
i : longint;
begin
{ Reset all numbers to -1 }
{ Extend unitmap }
oldmapsize:=unitmapsize;
unitmapsize:=loaded_units.count;
reallocmem(unitmap,unitmapsize*sizeof(tunitmaprec));
fillchar(unitmap[oldmapsize],(unitmapsize-oldmapsize)*sizeof(tunitmaprec),0);
{ Extend Derefmap }
oldmapsize:=derefmapsize;
derefmapsize:=loaded_units.count;
reallocmem(derefmap,derefmapsize*sizeof(tderefmaprec));
fillchar(derefmap[oldmapsize],(derefmapsize-oldmapsize)*sizeof(tderefmaprec),0);
{ Add all units to unitmap }
hp:=tmodule(loaded_units.first);
i:=0;
while assigned(hp) do
begin
if assigned(hp.globalsymtable) then
hp.globalsymtable.unitid:=$ffff;
hp:=tmodule(hp.next);
end;
{ Allocate map }
mapsize:=used_units.count+1;
reallocmem(map,mapsize*sizeof(tunitmaprec));
{ Our own symtable gets unitid 0, for a program there is
no globalsymtable }
if assigned(globalsymtable) then
globalsymtable.unitid:=0;
map[0].u:=self;
map[0].unitsym:=nil;
{ number units and map }
i:=1;
pu:=tused_unit(used_units.first);
while assigned(pu) do
begin
if assigned(pu.u.globalsymtable) then
if hp.moduleid>=unitmapsize then
internalerror(200501151);
{ Verify old entries }
if (i<oldmapsize) then
begin
tsymtable(pu.u.globalsymtable).unitid:=i;
map[i].u:=pu.u;
map[i].unitsym:=pu.unitsym;
inc(i);
if (hp.moduleid<>i) or
(unitmap[hp.moduleid].u<>hp) then
internalerror(200501156);
end
else
begin
unitmap[hp.moduleid].u:=hp;
unitmap[hp.moduleid].derefidx:=-1;
end;
pu:=tused_unit(pu.next);
inc(i);
hp:=tmodule(hp.next);
end;
end;
function tmodule.derefidx_unit(id:longint):longint;
begin
if id>=unitmapsize then
internalerror(2005011511);
if unitmap[id].derefidx=-1 then
begin
unitmap[id].derefidx:=derefmapcnt;
inc(derefmapcnt);
derefmap[unitmap[id].derefidx].u:=unitmap[id].u;
end;
if unitmap[id].derefidx>=derefmapsize then
internalerror(2005011514);
result:=unitmap[id].derefidx;
end;
function tmodule.resolve_unit(id:longint):tmodule;
var
hp : tmodule;
begin
if id>=derefmapsize then
internalerror(200306231);
result:=derefmap[id].u;
if not assigned(result) then
begin
if not assigned(derefmap[id].modulename) or
(derefmap[id].modulename^='') then
internalerror(200501159);
hp:=tmodule(loaded_units.first);
while assigned(hp) do
begin
if hp.modulename^=derefmap[id].modulename^ then
break;
hp:=tmodule(hp.next);
end;
if not assigned(hp) then
internalerror(2005011510);
derefmap[id].u:=hp;
result:=hp;
end;
end;
procedure tmodule.allunitsused;
var
i : longint;
pu : tused_unit;
begin
for i:=0 to mapsize-1 do
pu:=tused_unit(used_units.first);
while assigned(pu) do
begin
if assigned(map[i].unitsym) and
(map[i].unitsym.refs=0) then
MessagePos2(map[i].unitsym.fileinfo,sym_n_unit_not_used,map[i].u.realmodulename^,realmodulename^);
if assigned(pu.u.globalsymtable) then
begin
if unitmap[pu.u.moduleid].u<>pu.u then
internalerror(200501157);
{ Give a note when the unit is not referenced, skip
this is for units with an initialization/finalization }
if (unitmap[pu.u.moduleid].refs=0) and
((pu.u.flags and (uf_init or uf_finalize))=0) then
CGMessagePos2(pu.unitsym.fileinfo,sym_n_unit_not_used,pu.u.realmodulename^,realmodulename^);
end;
pu:=tused_unit(pu.next);
end;
end;
@ -732,7 +832,11 @@ implementation
end.
{
$Log$
Revision 1.51 2005-01-09 20:24:43 olle
Revision 1.52 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.51 2005/01/09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas

74
compiler/fppu.pas
View File

@ -67,12 +67,14 @@ interface
procedure writesourcefiles;
procedure writeusedunit(intf:boolean);
procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
procedure writederefmap;
procedure writederefdata;
procedure putasmsymbol_in_idx(s:tnamedindexitem;arg:pointer);
procedure writeasmsymbols;
procedure readsourcefiles;
procedure readloadunit;
procedure readlinkcontainer(var p:tlinkcontainer);
procedure readderefmap;
procedure readderefdata;
procedure readasmsymbols;
{$IFDEF MACRO_DIFF_HINT}
@ -462,8 +464,6 @@ uses
hp : tused_unit;
oldcrc : boolean;
begin
{ renumber the units for derefence writing }
numberunits;
{ write a reference for each used unit }
hp:=tused_unit(used_units.first);
while assigned(hp) do
@ -508,6 +508,27 @@ uses
end;
procedure tppumodule.writederefmap;
var
i : longint;
oldcrc : boolean;
begin
{ This does not influence crc }
oldcrc:=ppufile.do_crc;
ppufile.do_crc:=false;
{ The unit map used for resolving }
ppufile.putlongint(derefmapcnt);
for i:=0 to derefmapcnt-1 do
begin
if not assigned(derefmap[i].u) then
internalerror(2005011512);
ppufile.putstring(derefmap[i].u.modulename^)
end;
ppufile.writeentry(ibderefmap);
ppufile.do_crc:=oldcrc;
end;
procedure tppumodule.writederefdata;
var
oldcrc : boolean;
@ -604,20 +625,20 @@ uses
Define MACRO_DIFF_HINT for the whole compiler (and ppudump)
to turn this facility on. Also the hint messages defined
below must be commented in in the msg/errore.msg file.
There is some problems with this, thats why it is shut off:
At the first compilation, consider a macro which is not initially
defined, but it is used (e g the check that it is undefined is true).
Since it do not exist, there is no macro object where the is_used
Since it do not exist, there is no macro object where the is_used
flag can be set. Later on when the macro is defined, and the ppu
is opened, the check cannot detect this.
Also, in which macro object should this flag be set ? It cant be set
for macros in the initialmacrosymboltable since this table is shared
between different files.
}
procedure tppumodule.readusedmacros;
var
hs : string;
@ -797,6 +818,19 @@ uses
end;
procedure tppumodule.readderefmap;
var
i : longint;
begin
{ Load unit map used for resolving }
derefmapsize:=ppufile.getlongint;
getmem(derefmap,derefmapsize*sizeof(tderefmaprec));
fillchar(derefmap^,derefmapsize*sizeof(tderefmaprec),0);
for i:=0 to derefmapsize-1 do
derefmap[i].modulename:=stringdup(ppufile.getstring);
end;
procedure tppumodule.readderefdata;
var
len,hlen : longint;
@ -898,6 +932,8 @@ uses
readlinkcontainer(LinkotherStaticLibs);
iblinkothersharedlibs :
readlinkcontainer(LinkotherSharedLibs);
ibderefmap :
readderefmap;
ibderefdata :
readderefdata;
ibendinterface :
@ -941,7 +977,7 @@ uses
if (flags and uf_has_browser)<>0 then
begin
tstoredsymtable(globalsymtable).load_references(ppufile,true);
for i:=0 to mapsize-1 do
for i:=0 to unitmapsize-1 do
tstoredsymtable(globalsymtable).load_references(ppufile,false);
b:=ppufile.readentry;
if b<>ibendbrowser then
@ -1023,6 +1059,7 @@ uses
tstoredsymtable(localsymtable).buildderef;
tstoredsymtable(localsymtable).buildderefimpl;
end;
writederefmap;
writederefdata;
ppufile.writeentry(ibendinterface);
@ -1034,7 +1071,7 @@ uses
begin
ppufile.putbyte(byte(true));
ppufile.writeentry(ibexportedmacros);
tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile);
tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile);
end
else
begin
@ -1130,6 +1167,7 @@ uses
derefdata.reset;
tstoredsymtable(globalsymtable).buildderef;
derefdataintflen:=derefdata.size;
writederefmap;
writederefdata;
ppufile.writeentry(ibendinterface);
@ -1141,7 +1179,7 @@ uses
begin
ppufile.putbyte(byte(true));
ppufile.writeentry(ibexportedmacros);
tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile);
tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile);
end
else
begin
@ -1227,14 +1265,13 @@ uses
end;
pu:=tused_unit(pu.next);
end;
numberunits;
{ ok, now load the interface of this unit }
if current_module<>self then
internalerror(200208187);
globalsymtable:=tglobalsymtable.create(modulename^);
globalsymtable:=tglobalsymtable.create(modulename^,moduleid);
tstoredsymtable(globalsymtable).ppuload(ppufile);
if ppufile.readentry<>ibexportedmacros then
Message(unit_f_ppu_read_error);
if boolean(ppufile.getbyte) then
@ -1273,12 +1310,11 @@ uses
end;
pu:=tused_unit(pu.next);
end;
numberunits;
{ load implementation symtable }
if (flags and uf_local_symtable)<>0 then
begin
localsymtable:=tstaticsymtable.create(modulename^);
localsymtable:=tstaticsymtable.create(modulename^,moduleid);
tstaticsymtable(localsymtable).ppuload(ppufile);
end;
@ -1566,7 +1602,7 @@ uses
Message1(unit_u_registering_new_unit,Upper(s));
hp:=tppumodule.create(callermodule,s,fn,true);
hp.loaded_from:=callermodule;
loaded_units.insert(hp);
addloadedunit(hp);
end;
{ return }
registerunit:=hp;
@ -1575,7 +1611,11 @@ uses
end.
{
$Log$
Revision 1.65 2005-01-10 21:02:35 olle
Revision 1.66 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.65 2005/01/10 21:02:35 olle
- disabled macro diff message
Revision 1.64 2005/01/09 20:24:43 olle

8
compiler/htypechk.pas
View File

@ -1337,7 +1337,7 @@ implementation
if assigned(st) and
(st.symtabletype=objectsymtable) and
(st.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
(st.defowner.owner.unitid=0) then
st.defowner.owner.iscurrentunit then
topclassh:=tobjectdef(st.defowner)
else
begin
@ -1986,7 +1986,11 @@ implementation
end.
{
$Log$
Revision 1.109 2005-01-19 20:53:27 florian
Revision 1.110 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.109 2005/01/19 20:53:27 florian
* tmypointer(12435)^ is an l-value
Revision 1.108 2005/01/10 22:10:26 peter

9
compiler/i386/ra386int.pas
View File

@ -387,7 +387,8 @@ Unit Ra386int;
searchsym(actasmpattern,srsym,srsymtable);
if assigned(srsym) and
(srsym.typ=unitsym) and
(srsym.owner.unitid=0) then
(srsym.owner.symtabletype in [staticsymtable,globalsymtable]) and
srsym.owner.iscurrentunit then
begin
{ Add . to create System.Identifier }
actasmpattern:=actasmpattern+c;
@ -2035,7 +2036,11 @@ begin
end.
{
$Log$
Revision 1.84 2005-01-19 20:21:51 peter
Revision 1.85 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.84 2005/01/19 20:21:51 peter
* support labels in references
Revision 1.83 2004/12/22 17:09:55 peter

9
compiler/ncal.pas
View File

@ -2180,7 +2180,8 @@ type
if (st.symtabletype=objectsymtable) then
st:=st.defowner.owner;
if (pi_uses_static_symtable in tprocdef(procdefinition).inlininginfo^.flags) and
(st.unitid<>0) then
(st.symtabletype=globalsymtable) and
(not st.iscurrentunit) then
begin
Comment(V_lineinfo+V_Debug,'Not inlining "'+tprocdef(procdefinition).procsym.realname+'", references static symtable');
end
@ -2495,7 +2496,11 @@ begin
end.
{
$Log$
Revision 1.275 2005-01-04 16:36:31 peter
Revision 1.276 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.275 2005/01/04 16:36:31 peter
* fix aftercosntruction calls, vmt=1 is used to indicate that
afterconstruction needs to be called
* only accept resourcestring when objpas is loaded

27
compiler/parser.pas
View File

@ -460,18 +460,19 @@ implementation
exceptblockcounter:=0;
aktmaxfpuregisters:=-1;
{ reset the unit or create a new program }
if not assigned(current_module) then
begin
current_module:=tppumodule.create(nil,filename,'',false);
main_module:=current_module;
current_module.state:=ms_compile;
end;
if not(current_module.state in [ms_compile,ms_second_compile]) then
internalerror(200212281);
{ a unit compiled at command line must be inside the loaded_unit list }
if (compile_level=1) then
loaded_units.insert(current_module);
begin
if assigned(current_module) then
internalerror(200501158);
current_module:=tppumodule.create(nil,filename,'',false);
addloadedunit(current_module);
main_module:=current_module;
current_module.state:=ms_compile;
end;
if not(assigned(current_module) and
(current_module.state in [ms_compile,ms_second_compile])) then
internalerror(200212281);
{ Set the module to use for verbose }
compiled_module:=current_module;
@ -699,7 +700,11 @@ implementation
end.
{
$Log$
Revision 1.69 2005-01-09 20:24:43 olle
Revision 1.70 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.69 2005/01/09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas

10
compiler/pbase.pas
View File

@ -209,9 +209,11 @@ implementation
begin
if (srsym.typ=unitsym) then
begin
if not(srsym.owner.symtabletype in [staticsymtable,globalsymtable]) then
internalerror(200501154);
{ only allow unit.symbol access if the name was
found in the current module }
if srsym.owner.unitid=0 then
if srsym.owner.iscurrentunit then
begin
consume(_ID);
consume(_POINT);
@ -271,7 +273,11 @@ implementation
end.
{
$Log$
Revision 1.29 2004-08-08 12:06:38 florian
Revision 1.30 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.29 2004/08/08 12:06:38 florian
* finally is an "endtoken" as well
Revision 1.28 2004/06/20 08:55:30 florian

18
compiler/pdecsub.pas
View File

@ -734,7 +734,7 @@ implementation
not assigned(srsym) and
(symtablestack.symtabletype=staticsymtable) and
assigned(symtablestack.next) and
(symtablestack.next.unitid=0) then
(symtablestack.next.iscurrentunit) then
begin
{ The procedure we prepare for is in the implementation
part of the unit we compile. It is also possible that we
@ -1212,7 +1212,7 @@ begin
begin
consume(_LEGACY);
include(pd.procoptions,po_syscall_legacy);
end
end
else if idtoken=_SYSV then
begin
consume(_SYSV);
@ -1222,7 +1222,7 @@ begin
begin
consume(_BASESYSV);
include(pd.procoptions,po_syscall_basesysv);
end
end
else if idtoken=_SYSVBASE then
begin
consume(_SYSVBASE);
@ -1233,8 +1233,8 @@ begin
consume(_R12BASE);
include(pd.procoptions,po_syscall_r12base);
end
else
if syscall_convention='LEGACY' then
else
if syscall_convention='LEGACY' then
include(pd.procoptions,po_syscall_legacy)
else if syscall_convention='SYSV' then
include(pd.procoptions,po_syscall_sysv)
@ -1246,7 +1246,7 @@ begin
include(pd.procoptions,po_syscall_r12base)
else
internalerror(2005010404);
if consume_sym(sym,symtable) then
begin
if (sym.typ=globalvarsym) and
@ -2408,7 +2408,11 @@ const
end.
{
$Log$
Revision 1.225 2005-01-06 02:13:03 karoly
Revision 1.226 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.225 2005/01/06 02:13:03 karoly
* more SysV call support stuff for MorphOS
Revision 1.224 2005/01/05 02:31:06 karoly

43
compiler/pmodules.pas
View File

@ -487,7 +487,7 @@ implementation
hp3 : tsymtable;
unitsym : tunitsym;
top_of_macrosymtable : tsymtable;
begin
consume(_USES);
{$ifdef DEBUG}
@ -567,11 +567,6 @@ implementation
pu.interface_checksum:=pu.u.interface_crc;
{ connect unitsym to the globalsymtable of the unit }
pu.unitsym.unitsymtable:=pu.u.globalsymtable;
{ increase refs of the unitsym when the unit contains
initialization/finalization code so it doesn't trigger
the unit not used hint }
if (pu.u.flags and (uf_init or uf_finalize))<>0 then
inc(pu.unitsym.refs);
end;
pu:=tused_unit(pu.next);
end;
@ -700,7 +695,7 @@ implementation
begin
debugList.concat(tai_comment.Create(strpnew('EINCL of global '+
tglobalsymtable(current_module.globalsymtable).name^+' has index '+
tostr(tglobalsymtable(current_module.globalsymtable).unitid))));
tostr(tglobalsymtable(current_module.globalsymtable).moduleid))));
debugList.concat(Tai_stabs.Create(strpnew('"'+
tglobalsymtable(current_module.globalsymtable).name^+'",'+
tostr(N_EINCL)+',0,0,0')));
@ -894,7 +889,7 @@ implementation
if assigned(hp) then
current_module.localmacrosymtable.delete(hp);
end;
procedure proc_unit;
function is_assembler_generated:boolean;
@ -926,7 +921,7 @@ implementation
ConsolidateMode;
current_module.mode_switch_allowed:= false;
end;
consume(_UNIT);
if compile_level=1 then
Status.IsExe:=false;
@ -995,7 +990,7 @@ implementation
parse_only:=true;
{ generate now the global symboltable }
st:=tglobalsymtable.create(current_module.modulename^);
st:=tglobalsymtable.create(current_module.modulename^,current_module.moduleid);
refsymtable:=st;
unitst:=tglobalsymtable(st);
{ define first as local to overcome dependency conflicts }
@ -1057,7 +1052,7 @@ implementation
{ number all units, so we know if a unit is used by this unit or
needs to be added implicitly }
current_module.numberunits;
current_module.updatemaps;
{ ... parse the declarations }
Message1(parser_u_parsing_interface,current_module.realmodulename^);
@ -1091,16 +1086,16 @@ implementation
parse_only:=false;
{ generates static symbol table }
st:=tstaticsymtable.create(current_module.modulename^);
st:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
current_module.localsymtable:=st;
{ Swap the positions of the local and global macro sym table}
{ Swap the positions of the local and global macro sym table}
if assigned(current_module.globalmacrosymtable) then
begin
macrosymtablestack:=current_module.localmacrosymtable;
current_module.globalmacrosymtable.next:= current_module.localmacrosymtable.next;
current_module.localmacrosymtable.next:=current_module.globalmacrosymtable;
current_module.globalmacrosymtable.foreach_static(@delete_duplicate_macros, nil);
end;
@ -1110,11 +1105,11 @@ implementation
{ we don't want implementation units symbols in unitsymtable !! PM }
refsymtable:=st;
if has_impl then
begin
consume(_IMPLEMENTATION);
Message1(unit_u_loading_implementation_units,current_module.modulename^);
consume(_IMPLEMENTATION);
Message1(unit_u_loading_implementation_units,current_module.modulename^);
{ Read the implementation units }
parse_implementation_uses;
end;
@ -1126,7 +1121,7 @@ implementation
reset_all_defs;
{ All units are read, now give them a number }
current_module.numberunits;
current_module.updatemaps;
{ now we can change refsymtable }
refsymtable:=st;
@ -1390,7 +1385,7 @@ implementation
{ insert after the unit symbol tables the static symbol table }
{ of the program }
st:=tstaticsymtable.create(current_module.modulename^);;
st:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
current_module.localsymtable:=st;
refsymtable:=st;
@ -1401,7 +1396,7 @@ implementation
current_module.localmacrosymtable.next:=macrosymtablestack;
macrosymtablestack:=current_module.localmacrosymtable;
{Load the units used by the program we compile.}
if token=_USES then
loadunits;
@ -1410,7 +1405,7 @@ implementation
reset_all_defs;
{ All units are read, now give them a number }
current_module.numberunits;
current_module.updatemaps;
{Insert the name of the main program into the symbol table.}
if current_module.realmodulename^<>'' then
@ -1600,7 +1595,11 @@ implementation
end.
{
$Log$
Revision 1.179 2005-01-09 20:24:43 olle
Revision 1.180 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.179 2005/01/09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas

19
compiler/powerpc/nppcld.pas
View File

@ -58,9 +58,11 @@ unit nppcld;
system_powerpc_darwin:
begin
if (symtableentry.typ = procsym) and
not assigned(left) and
((tprocsym(symtableentry).owner.unitid<>0) or
(po_external in tprocsym(symtableentry).procdef[1].procoptions)) then
(tprocsym(symtableentry).owner.symtabletype in [staticsymtable,globalsymtable]) and
(
(not tabstractunitsymtable(tprocsym(symtableentry).owner).iscurrentmodule) or
(po_external in tprocsym(symtableentry).procdef[1].procoptions)
) then
begin
l:=objectlibrary.getasmsymbol('L'+tprocsym(symtableentry).procdef[1].mangledname+'$non_lazy_ptr');
if not(assigned(l)) then
@ -90,8 +92,9 @@ unit nppcld;
case target_info.system of
system_powerpc_darwin:
begin
if (tglobalvarsym(symtableentry).owner.unitid<>0) or
(vo_is_dll_var in tglobalvarsym(symtableentry).varoptions) then
if (vo_is_dll_var in tglobalvarsym(symtableentry).varoptions) and
(tglobalvarsym(symtableentry).owner.symtabletype in [staticsymtable,globalsymtable]) and
not(tabstractunitsymtable(tglobalvarsym(symtableentry).owner).iscurrentmodule) then
begin
l:=objectlibrary.getasmsymbol('L'+tglobalvarsym(symtableentry).mangledname+'$non_lazy_ptr');
if not(assigned(l)) then
@ -122,7 +125,11 @@ begin
end.
{
$Log$
Revision 1.5 2004-11-11 19:31:33 peter
Revision 1.6 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.5 2004/11/11 19:31:33 peter
* fixed compile of powerpc,sparc,arm
Revision 1.4 2004/07/19 12:45:43 jonas

9
compiler/ppu.pas
View File

@ -44,7 +44,7 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion=47;
CurrentPPUVersion=48;
{ buffer sizes }
maxentrysize = 1024;
@ -84,6 +84,7 @@ const
{$ENDIF}
ibderefdata = 17;
ibexportedmacros = 18;
ibderefmap = 19;
{syms}
ibtypesym = 20;
ibprocsym = 21;
@ -1059,7 +1060,11 @@ end;
end.
{
$Log$
Revision 1.61 2005-01-09 20:24:43 olle
Revision 1.62 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.61 2005/01/09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas

13
compiler/psystem.pas
View File

@ -44,7 +44,7 @@ implementation
uses
globals,globtype,verbose,
symconst,symtype,symsym,symdef,symtable,
aasmtai,aasmcpu,ncgutil,
aasmtai,aasmcpu,ncgutil,fmodule,
{$ifdef GDB}
gdb,
{$endif GDB}
@ -255,7 +255,11 @@ implementation
t:=ttypesym(srsym).restype;
end;
var
oldcurrentmodule : tmodule;
begin
oldcurrentmodule:=current_module;
current_module:=nil;
loadtype('byte',u8inttype);
loadtype('shortint',s8inttype);
loadtype('word',u16inttype);
@ -305,6 +309,7 @@ implementation
sinttype:=s32inttype;
ptrinttype:=u32inttype;
{$endif cpu64bit}
current_module:=oldcurrentmodule;
end;
@ -537,7 +542,11 @@ implementation
end.
{
$Log$
Revision 1.75 2004-12-07 16:11:52 peter
Revision 1.76 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.75 2004/12/07 16:11:52 peter
* set vo_explicit_paraloc flag
Revision 1.74 2004/12/07 13:52:54 michael

21
compiler/ptype.pas
View File

@ -111,7 +111,11 @@ implementation
begin
is_unit_specific:=true;
consume(_POINT);
if srsym.owner.unitid=0 then
if not(srsym.owner.symtabletype in [staticsymtable,globalsymtable]) then
internalerror(200501155);
{ only allow unit.symbol access if the name was
found in the current module }
if srsym.owner.iscurrentunit then
begin
srsym:=searchsymonlyin(tunitsym(srsym).unitsymtable,pattern);
pos:=akttokenpos;
@ -166,9 +170,12 @@ implementation
they can be refered from the parameters and symbols are not
loaded at that time. Only write the definition when the
symbol is the real owner of the definition (not a redefine) }
if (ttypesym(srsym).owner.unitid=0) and
((ttypesym(srsym).restype.def.typesym=nil) or
(srsym=ttypesym(srsym).restype.def.typesym)) then
if (ttypesym(srsym).owner.symtabletype in [staticsymtable,globalsymtable]) and
ttypesym(srsym).owner.iscurrentunit and
(
(ttypesym(srsym).restype.def.typesym=nil) or
(srsym=ttypesym(srsym).restype.def.typesym)
) then
tt.setdef(ttypesym(srsym).restype.def)
else
tt.setsym(srsym);
@ -659,7 +666,11 @@ implementation
end.
{
$Log$
Revision 1.72 2005-01-04 16:39:12 peter
Revision 1.73 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.72 2005/01/04 16:39:12 peter
* allow enum with jumps as array index in delphi mode
Revision 1.71 2004/11/16 20:32:41 peter

9
compiler/raatt.pas
View File

@ -371,7 +371,8 @@ unit raatt;
searchsym(actasmpattern,srsym,srsymtable);
if assigned(srsym) and
(srsym.typ=unitsym) and
(srsym.owner.unitid=0) then
(srsym.owner.symtabletype in [staticsymtable,globalsymtable]) and
srsym.owner.iscurrentunit then
begin
actasmpattern:=actasmpattern+c;
c:=current_scanner.asmgetchar;
@ -1522,7 +1523,11 @@ end.
{
$Log$
Revision 1.16 2004-12-22 17:09:55 peter
Revision 1.17 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.16 2004/12/22 17:09:55 peter
* support sizeof()
* fix typecasting a constant like dword(4)

9
compiler/rautils.pas
View File

@ -1211,7 +1211,8 @@ begin
if assigned(srsym) then
begin
if (srsym.typ=unitsym) and
(srsym.owner.unitid=0) then
(srsym.owner.symtabletype in [staticsymtable,globalsymtable]) and
srsym.owner.iscurrentunit then
srsym:=searchsymonlyin(tunitsym(srsym).unitsymtable,Copy(s,i+1,255))
else
srsym:=nil;
@ -1625,7 +1626,11 @@ end;
end.
{
$Log$
Revision 1.100 2005-01-05 15:22:39 florian
Revision 1.101 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.100 2005/01/05 15:22:39 florian
* added support of shifter ops in arm inline assembler
Revision 1.99 2004/12/22 17:09:55 peter

17
compiler/symbase.pas
View File

@ -103,10 +103,9 @@ interface
next : tsymtable;
defowner : tdefentry; { for records and objects }
symtabletype : tsymtabletype;
{ each symtable gets a number }
unitid : word;
{ level of symtable, used for nested procedures }
symtablelevel : byte;
moduleid : longint;
refcount : integer;
constructor Create(const s:string);
destructor destroy;override;
@ -123,6 +122,7 @@ interface
function search(const s : stringid) : tsymentry;
function speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;virtual;
procedure registerdef(p : tdefentry);
function iscurrentunit:boolean;virtual;
{$ifdef EXTDEBUG}
procedure dump;
{$endif EXTDEBUG}
@ -178,7 +178,6 @@ implementation
defindex:=TIndexArray.create(indexgrowsize);
symsearch:=tdictionary.create;
symsearch.noclear:=true;
unitid:=0;
refcount:=1;
end;
@ -242,6 +241,12 @@ implementation
end;
function tsymtable.iscurrentunit:boolean;
begin
result:=false;
end;
procedure tsymtable.foreach(proc2call : tnamedindexcallback;arg:pointer);
begin
symindex.foreach(proc2call,arg);
@ -345,7 +350,11 @@ implementation
end.
{
$Log$
Revision 1.24 2005-01-09 20:24:43 olle
Revision 1.25 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.24 2005/01/09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas

44
compiler/symdef.pas
View File

@ -1132,8 +1132,9 @@ implementation
end;
if (cs_gdb_dbx in aktglobalswitches) and
assigned(typesym) and
(ttypesym(typesym).owner.unitid<>0) then
result:='('+tostr(ttypesym(typesym).owner.unitid)+','+tostr(tstoreddef(ttypesym(typesym).restype.def).globalnb)+')'
(ttypesym(typesym).owner.symtabletype in [staticsymtable,globalsymtable]) and
(ttypesym(typesym).owner.iscurrentunit) then
result:='('+tostr(tabstractunitsymtable(ttypesym(typesym).owner).moduleid)+','+tostr(tstoreddef(ttypesym(typesym).restype.def).globalnb)+')'
else
result:=tostr(globalnb);
end;
@ -3315,7 +3316,7 @@ implementation
{ now dereference the definitions }
tstoredsymtable(symtable).deref;
aktrecordsymtable:=oldrecsyms;
{ assign TGUID? load only from system unit (unitid=1) }
{ assign TGUID? load only from system unit }
if not(assigned(rec_tguid)) and
(upper(typename)='TGUID') and
assigned(owner) and
@ -3837,6 +3838,8 @@ implementation
{$ifdef GDB}
isstabwritten := false;
{$endif GDB}
{ Disable po_has_inlining until the derefimpl is done }
exclude(procoptions,po_has_inlininginfo);
end;
@ -4034,7 +4037,7 @@ implementation
module as they are defined }
if (sp_private in symoptions) and
(owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
(owner.defowner.owner.unitid<>0) then
not(owner.defowner.owner.iscurrentunit) then
exit;
{ protected symbols are vissible in the module that defines them and
@ -4044,11 +4047,12 @@ implementation
(
(
(owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
(owner.defowner.owner.unitid<>0)
not(owner.defowner.owner.iscurrentunit)
) and
not(
assigned(currobjdef) and
(currobjdef.owner.unitid=0) and
(currobjdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
(currobjdef.owner.iscurrentunit) and
currobjdef.is_related(tobjectdef(owner.defowner))
)
) then
@ -4155,6 +4159,7 @@ implementation
end;
ppufile.writeentry(ibdefref);
write_references:=true;
{$ifdef supportbrowser}
if ((current_module.flags and uf_local_browser)<>0) and
assigned(localst) and
locals then
@ -4165,14 +4170,14 @@ implementation
begin
if pdo.symtable<>aktrecordsymtable then
begin
pdo.symtable.unitid:=local_symtable_index;
pdo.symtable.moduleid:=local_symtable_index;
inc(local_symtable_index);
end;
pdo:=pdo.childof;
end;
parast.unitid:=local_symtable_index;
parast.moduleid:=local_symtable_index;
inc(local_symtable_index);
localst.unitid:=local_symtable_index;
localst.moduleid:=local_symtable_index;
inc(local_symtable_index);
tstoredsymtable(parast).write_references(ppufile,locals);
tstoredsymtable(localst).write_references(ppufile,locals);
@ -4187,6 +4192,7 @@ implementation
pdo:=pdo.childof;
end;
end;
{$endif supportbrowser}
aktparasymtable:=oldparasymtable;
aktlocalsymtable:=oldlocalsymtable;
end;
@ -4303,6 +4309,12 @@ implementation
inherited buildderefimpl;
{ Enable has_inlininginfo when the inlininginfo
structure is available. The has_inlininginfo was disabled
after the load, since the data was invalid }
if assigned(inlininginfo) then
include(procoptions,po_has_inlininginfo);
{ Locals }
if assigned(localst) and
((po_has_inlininginfo in procoptions) or
@ -4566,7 +4578,7 @@ implementation
function tprocvardef.getcopy : tstoreddef;
begin
{
(*
{ saves a definition to the return type }
rettype : ttype;
parast : tsymtable;
@ -4588,7 +4600,7 @@ implementation
constructor create(level:byte);
constructor ppuload(ppufile:tcompilerppufile);
function getcopy : tstoreddef;override;
}
*)
end;
@ -4959,7 +4971,7 @@ implementation
function tobjectdef.getcopy : tstoreddef;
begin
result:=inherited getcopy;
{
(*
result:=tobjectdef.create(objecttype,objname^,childof);
childofderef : tderef;
objname,
@ -4977,7 +4989,7 @@ implementation
lastvtableindex: longint;
{ store implemented interfaces defs and name mappings }
implementedinterfaces: timplementedinterfaces;
}
*)
end;
@ -6355,7 +6367,11 @@ implementation
end.
{
$Log$
Revision 1.289 2005-01-16 14:47:26 florian
Revision 1.290 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.289 2005/01/16 14:47:26 florian
* typeinfo in typedata is now aligned
Revision 1.288 2005/01/09 15:05:29 peter

110
compiler/symtable.pas
View File

@ -138,16 +138,17 @@ interface
prev_dbx_counter : plongint;
dbx_count_ok : boolean;
{$endif GDB}
constructor create(const n : string);
constructor create(const n : string;id:word);
{$ifdef GDB}
procedure concattypestabto(asmlist : taasmoutput);
{$endif GDB}
function iscurrentunit:boolean;override;
end;
tglobalsymtable = class(tabstractunitsymtable)
public
unittypecount : word;
constructor create(const n : string);
constructor create(const n : string;id:word);
procedure ppuload(ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
@ -160,7 +161,7 @@ interface
tstaticsymtable = class(tabstractunitsymtable)
public
constructor create(const n : string);
constructor create(const n : string;id:word);
procedure ppuload(ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
@ -591,7 +592,9 @@ implementation
st:=findunitsymtable(sym.owner);
with tsym(sym).fileinfo do
begin
if assigned(st) and (st.unitid<>0) then
if assigned(st) and
(st.symtabletype=globalsymtable) and
(not st.iscurrentunit) then
Message2(sym_h_duplicate_id_where,'unit '+st.name^,tostr(line))
else
Message2(sym_h_duplicate_id_where,current_module.sourcefiles.get_file_name(fileindex),tostr(line));
@ -661,19 +664,14 @@ implementation
Message(sym_e_only_static_in_static);
{ unit uses count }
if (unitid<>0) and
(symtabletype = globalsymtable) and
assigned(current_module) and
(unitid<current_module.mapsize) and
assigned(current_module.map[unitid].unitsym) then
inc(current_module.map[unitid].unitsym.refs);
if assigned(current_module) and
(symtabletype=globalsymtable) then
begin
if tglobalsymtable(self).moduleid>current_module.unitmapsize then
internalerror(200501152);
inc(current_module.unitmap[tglobalsymtable(self).moduleid].refs);
end;
{ unitsym are only loaded for browsing PM }
{ this was buggy anyway because we could use }
{ unitsyms from other units in _USES !! }
{if (symtabletype=unitsymtable) and (hp.typ=unitsym) and
assigned(current_module) and (current_module.globalsymtable<>.load) then
hp:=nil;}
if make_ref and (cs_browser in aktmoduleswitches) then
begin
newref:=tref.create(hp.lastref,@akttokenpos);
@ -1344,9 +1342,10 @@ implementation
TAbstractUnitSymtable
****************************************************************************}
constructor tabstractunitsymtable.create(const n : string);
constructor tabstractunitsymtable.create(const n : string;id:word);
begin
inherited create(n);
moduleid:=id;
symsearch.usehash;
{$ifdef GDB}
{ reset GDB things }
@ -1357,6 +1356,16 @@ implementation
end;
function tabstractunitsymtable.iscurrentunit:boolean;
begin
result:=assigned(current_module) and
(
(current_module.globalsymtable=self) or
(current_module.localsymtable=self)
);
end;
{$ifdef GDB}
procedure tabstractunitsymtable.concattypestabto(asmlist : taasmoutput);
@ -1368,7 +1377,7 @@ implementation
while assigned(p) do
begin
{ also insert local types for the current unit }
if (unitid=0) then
if iscurrentunit then
begin
case p.deftype of
procdef :
@ -1390,23 +1399,23 @@ implementation
begin
if not assigned(name) then
name := stringdup('Main_program');
asmList.concat(tai_comment.Create(strpnew('Begin unit '+name^+' has index '+tostr(unitid))));
asmList.concat(tai_comment.Create(strpnew('Begin unit '+name^+' has index '+tostr(moduleid))));
if cs_gdb_dbx in aktglobalswitches then
begin
if dbx_count_ok then
begin
asmList.concat(tai_comment.Create(strpnew('"repeated" unit '+name^
+' has index '+tostr(unitid)+' dbx count = '+tostr(dbx_count))));
+' has index '+tostr(moduleid)+' dbx count = '+tostr(dbx_count))));
asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'
+tostr(N_EXCL)+',0,0,'+tostr(dbx_count))));
exit;
end
else if (current_module.globalsymtable<>self) then
else if not iscurrentunit then
begin
prev_dbx_count := dbx_counter;
dbx_counter := nil;
do_count_dbx:=false;
if (symtabletype = globalsymtable) and (unitid<>0) then
if (symtabletype = globalsymtable) then
asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0')));
dbx_counter := @dbx_count;
dbx_count:=0;
@ -1421,7 +1430,7 @@ implementation
if cs_gdb_dbx in aktglobalswitches then
begin
if (current_module.globalsymtable<>self) then
if not iscurrentunit then
begin
dbx_counter := prev_dbx_count;
do_count_dbx:=false;
@ -1431,7 +1440,7 @@ implementation
dbx_count_ok := {true}false;
end;
end;
asmList.concat(tai_comment.Create(strpnew('End unit '+name^+' has index '+tostr(unitid))));
asmList.concat(tai_comment.Create(strpnew('End unit '+name^+' has index '+tostr(moduleid))));
end;
{$endif GDB}
@ -1440,9 +1449,9 @@ implementation
TStaticSymtable
****************************************************************************}
constructor tstaticsymtable.create(const n : string);
constructor tstaticsymtable.create(const n : string;id:word);
begin
inherited create(n);
inherited create(n,id);
symtabletype:=staticsymtable;
symtablelevel:=main_program_level;
end;
@ -1487,7 +1496,8 @@ implementation
begin
{ also check the global symtable }
if assigned(next) and
(next.unitid=0) then
(next.symtabletype=globalsymtable) and
(next.iscurrentunit) then
begin
hsym:=tsym(next.search(sym.name));
if assigned(hsym) then
@ -1511,20 +1521,19 @@ implementation
TGlobalSymtable
****************************************************************************}
constructor tglobalsymtable.create(const n : string);
constructor tglobalsymtable.create(const n : string;id:word);
begin
inherited create(n);
inherited create(n,id);
symtabletype:=globalsymtable;
symtablelevel:=main_program_level;
unitid:=0;
{$ifdef GDB}
if cs_gdb_dbx in aktglobalswitches then
begin
dbx_count := 0;
unittypecount:=1;
pglobaltypecount := @unittypecount;
{unitid:=current_module.unitcount;}
{debugList.concat(tai_comment.Create(strpnew('Global '+name^+' has index '+tostr(unitid))));
{moduleid:=current_module.unitcount;}
{debugList.concat(tai_comment.Create(strpnew('Global '+name^+' has index '+tostr(moduleid))));
debugList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0')));}
{inc(current_module.unitcount);}
{ we can't use dbx_vcount, because we don't know
@ -1624,24 +1633,6 @@ implementation
var
hsym : tsym;
begin
{ also check the global symtable }
if assigned(next) and
(next.unitid=0) then
begin
hsym:=tsym(next.search(sym.name));
if assigned(hsym) then
begin
{ Delphi you can have a symbol with the same name as the
unit, the unit can then not be accessed anymore using
<unit>.<id>, so we can hide the symbol }
if (m_duplicate_names in aktmodeswitches) and
(hsym.typ=symconst.unitsym) then
hsym.owner.rename(hsym.name,'hidden'+hsym.name)
else
DuplicateSym(sym,hsym);
end;
end;
hsym:=tsym(search(sym.name));
if assigned(hsym) then
begin
@ -1834,7 +1825,7 @@ implementation
assigned(srsymtable.defowner) and
(srsymtable.defowner.deftype=objectdef) and
(srsymtable.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
(srsymtable.defowner.owner.unitid=0) then
(srsymtable.defowner.owner.iscurrentunit) then
topclass:=tobjectdef(srsymtable.defowner)
else
begin
@ -1904,7 +1895,8 @@ implementation
exit;
end;
{ also check in the local symtbale if it exists }
if (p=tsymtable(current_module.globalsymtable)) then
if (p.symtabletype=globalsymtable) and
(p.iscurrentunit) then
begin
srsym:=tsym(current_module.localsymtable.search(s));
if assigned(srsym) then
@ -1931,7 +1923,7 @@ implementation
units. At least kylix supports it this way (PFV) }
if assigned(classh) and
(classh.owner.symtabletype in [globalsymtable,staticsymtable]) and
(classh.owner.unitid=0) then
classh.owner.iscurrentunit then
topclassh:=classh
else
begin
@ -1965,7 +1957,7 @@ implementation
units. At least kylix supports it this way (PFV) }
if assigned(classh) and
(classh.owner.symtabletype in [globalsymtable,staticsymtable]) and
(classh.owner.unitid=0) then
classh.owner.iscurrentunit then
topclassh:=classh
else
begin
@ -2016,7 +2008,7 @@ implementation
units. At least kylix supports it this way (PFV) }
if assigned(classh) and
(classh.owner.symtabletype in [globalsymtable,staticsymtable]) and
(classh.owner.unitid=0) then
classh.owner.iscurrentunit then
topclassh:=classh
else
begin
@ -2286,7 +2278,7 @@ implementation
macrosymtablestack.next.insert(mac)
end;
if not mac.defined then
Message1(parser_c_macro_defined,mac.name);
Message1(parser_c_macro_defined,mac.name);
mac.defined:=true;
end;
@ -2471,7 +2463,11 @@ implementation
end.
{
$Log$
Revision 1.168 2005-01-09 20:24:43 olle
Revision 1.169 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.168 2005/01/09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas

47
compiler/symtype.pas
View File

@ -479,7 +479,7 @@ implementation
if (sp_private in symoptions) and
assigned(owner.defowner) and
(owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
(owner.defowner.owner.unitid<>0) then
(not owner.defowner.owner.iscurrentunit) then
exit;
{ protected symbols are vissible in the module that defines them and
@ -489,7 +489,7 @@ implementation
(
assigned(owner.defowner) and
(owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
(owner.defowner.owner.unitid<>0)
(not owner.defowner.owner.iscurrentunit)
) and
not(
assigned(currobjdef) {and
@ -595,8 +595,10 @@ implementation
if assigned(sym) and
(
(sym<>def.typesym) or
((sym.owner.unitid<>0) and
(sym.owner.unitid<>1))
(
not((sym.owner.symtabletype in [globalsymtable,staticsymtable]) and
sym.owner.iscurrentunit)
)
) then
deref.build(sym)
else
@ -811,33 +813,33 @@ implementation
end;
procedure addowner(s:tsymtableentry);
var
idx : longint;
begin
if not assigned(s.owner) then
internalerror(200306063);
case s.owner.symtabletype of
globalsymtable :
begin
if s.owner.unitid=0 then
if s.owner.iscurrentunit then
begin
data[len]:=ord(deref_aktglobal);
inc(len);
end
else
begin
{ check if the unit is available in the uses
clause, else it's an error }
if s.owner.unitid=$ffff then
internalerror(200306063);
{ register that the unit is needed for resolving }
idx:=current_module.derefidx_unit(s.owner.moduleid);
data[len]:=ord(deref_unit);
data[len+1]:=s.owner.unitid shr 8;
data[len+2]:=s.owner.unitid and $ff;
data[len+1]:=idx shr 8;
data[len+2]:=idx and $ff;
inc(len,3);
end;
end;
staticsymtable :
begin
{ only references to the current static symtable are allowed }
if s.owner<>current_module.localsymtable then
if not s.owner.iscurrentunit then
internalerror(200306233);
data[len]:=ord(deref_aktstatic);
inc(len);
@ -893,12 +895,11 @@ implementation
while (currdef<>ownerdef) do
begin
nextdef:=currdef.getparentdef;
{ objects are only allowed in globalsymtable,staticsymtable this check is
needed because we need the unitid }
{ objects are only allowed in globalsymtable,staticsymtable }
if not(nextdef.owner.symtabletype in [globalsymtable,staticsymtable]) then
internalerror(200306187);
{ Next parent is in a different unit, then stop }
if nextdef.owner.unitid<>0 then
if not(nextdef.owner.iscurrentunit) then
break;
currdef:=nextdef;
end;
@ -940,14 +941,14 @@ implementation
begin
{ Static symtable of current unit ? }
if (s.owner.symtabletype=staticsymtable) and
(s.owner.unitid=0) then
s.owner.iscurrentunit then
begin
data[len]:=ord(deref_aktstatic);
inc(len);
end
{ Global symtable of current unit ? }
else if (s.owner.symtabletype=globalsymtable) and
(s.owner.unitid=0) then
s.owner.iscurrentunit then
begin
data[len]:=ord(deref_aktglobal);
inc(len);
@ -1075,11 +1076,7 @@ implementation
begin
idx:=(data[i] shl 8) or data[i+1];
inc(i,2);
if idx>current_module.mapsize then
internalerror(200306231);
pm:=current_module.map[idx].u;
if not assigned(pm) then
internalerror(200212273);
pm:=current_module.resolve_unit(idx);
st:=pm.globalsymtable;
end;
deref_local :
@ -1457,7 +1454,11 @@ finalization
end.
{
$Log$
Revision 1.49 2004-12-15 21:09:06 peter
Revision 1.50 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.49 2004/12/15 21:09:06 peter
* 64bit typecast
Revision 1.48 2004/11/15 23:35:31 peter

28
compiler/utils/ppudump.pp
View File

@ -28,9 +28,9 @@ uses
ppu;
const
Version = 'Version 1.10';
Version = 'Version 1.9.8';
Title = 'PPU-Analyser';
Copyright = 'Copyright (c) 1998-2003 by the Free Pascal Development Team';
Copyright = 'Copyright (c) 1998-2005 by the Free Pascal Development Team';
{ verbosity }
v_none = $0;
@ -76,7 +76,6 @@ type
var
ppufile : tppufile;
space : string;
unitnumber,
unitindex : longint;
verbose : longint;
derefdata : pbyte;
@ -391,8 +390,7 @@ var
begin
while not ppufile.EndOfEntry do
begin
inc(unitnumber);
write('Uses unit: ',ppufile.getstring,' (Number: ',unitnumber,')');
write('Uses unit: ',ppufile.getstring);
ucrc:=cardinal(ppufile.getlongint);
uintfcrc:=cardinal(ppufile.getlongint);
writeln(' (Crc: ',hexstr(ucrc,8),', IntfcCrc: ',hexstr(uintfcrc,8),')');
@ -400,6 +398,17 @@ begin
end;
Procedure ReadDerefmap;
var
i,mapsize : longint;
begin
mapsize:=ppufile.getword;
writeln('DerefMapsize: ',mapsize);
for i:=0 to mapsize-1 do
writeln('DerefMap[',i,'] = ',ppufile.getstring);
end;
Procedure ReadDerefdata;
begin
derefdatalen:=ppufile.entrysize;
@ -1764,6 +1773,9 @@ begin
ibderefdata :
ReadDerefData;
ibderefmap :
ReadDerefMap;
iberror :
begin
Writeln('Error in PPU');
@ -2132,7 +2144,11 @@ begin
end.
{
$Log$
Revision 1.64 2005-01-09 20:24:43 olle
Revision 1.65 2005-01-19 22:19:41 peter
* unit mapping rewrite
* new derefmap added
Revision 1.64 2005/01/09 20:24:43 olle
* rework of macro subsystem
+ exportable macros for mode macpas