mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-31 10:31:44 +01:00
299 lines
8.1 KiB
ObjectPascal
299 lines
8.1 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1998-2000 by Florian Klaempfl, Pierre Muller
|
|
|
|
Implementation of the reading of PPU Files for 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.
|
|
****************************************************************************
|
|
}
|
|
unit symppu;
|
|
|
|
{$i defines.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
globtype,globals,
|
|
symbase,symtype,
|
|
ppu;
|
|
|
|
type
|
|
tcompilerppufile=class(tppufile)
|
|
procedure checkerror;
|
|
procedure getguid(var g: tguid);
|
|
procedure getposinfo(var p:tfileposinfo);
|
|
function getderef : tsymtableentry;
|
|
function getsymlist:tsymlist;
|
|
procedure gettype(var t:ttype);
|
|
procedure putguid(const g: tguid);
|
|
procedure putposinfo(const p:tfileposinfo);
|
|
procedure putderef(p : tsymtableentry);
|
|
procedure putsymlist(p:tsymlist);
|
|
procedure puttype(const t:ttype);
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
symconst,
|
|
verbose;
|
|
|
|
{*****************************************************************************
|
|
TCompilerPPUFile
|
|
*****************************************************************************}
|
|
|
|
procedure tcompilerppufile.checkerror;
|
|
begin
|
|
if error then
|
|
Message(unit_f_ppu_read_error);
|
|
end;
|
|
|
|
|
|
procedure tcompilerppufile.getguid(var g: tguid);
|
|
begin
|
|
getdata(g,sizeof(g));
|
|
end;
|
|
|
|
|
|
procedure tcompilerppufile.getposinfo(var p:tfileposinfo);
|
|
begin
|
|
p.fileindex:=getword;
|
|
p.line:=getlongint;
|
|
p.column:=getword;
|
|
end;
|
|
|
|
|
|
function tcompilerppufile.getderef : tsymtableentry;
|
|
var
|
|
hp,p : tderef;
|
|
b : tdereftype;
|
|
begin
|
|
p:=nil;
|
|
repeat
|
|
hp:=p;
|
|
b:=tdereftype(getbyte);
|
|
case b of
|
|
derefnil :
|
|
break;
|
|
derefunit,
|
|
derefaktrecordindex,
|
|
derefaktlocal,
|
|
derefaktstaticindex :
|
|
begin
|
|
p:=tderef.create(b,getword);
|
|
p.next:=hp;
|
|
break;
|
|
end;
|
|
derefindex,
|
|
dereflocal,
|
|
derefpara,
|
|
derefrecord :
|
|
begin
|
|
p:=tderef.create(b,getword);
|
|
p.next:=hp;
|
|
end;
|
|
end;
|
|
until false;
|
|
getderef:=tsymtableentry(p);
|
|
end;
|
|
|
|
|
|
function tcompilerppufile.getsymlist:tsymlist;
|
|
var
|
|
sym : tsym;
|
|
p : tsymlist;
|
|
begin
|
|
p:=tsymlist.create;
|
|
p.def:=tdef(getderef);
|
|
repeat
|
|
sym:=tsym(getderef);
|
|
if sym=nil then
|
|
break;
|
|
p.addsym(sym);
|
|
until false;
|
|
getsymlist:=tsymlist(p);
|
|
end;
|
|
|
|
|
|
procedure tcompilerppufile.gettype(var t:ttype);
|
|
begin
|
|
t.def:=tdef(getderef);
|
|
t.sym:=tsym(getderef);
|
|
end;
|
|
|
|
|
|
procedure tcompilerppufile.putposinfo(const p:tfileposinfo);
|
|
var
|
|
oldcrc : boolean;
|
|
begin
|
|
{ posinfo is not relevant for changes in PPU }
|
|
oldcrc:=do_crc;
|
|
do_crc:=false;
|
|
putword(p.fileindex);
|
|
putlongint(p.line);
|
|
putword(p.column);
|
|
do_crc:=oldcrc;
|
|
end;
|
|
|
|
|
|
procedure tcompilerppufile.putguid(const g: tguid);
|
|
begin
|
|
putdata(g,sizeof(g));
|
|
end;
|
|
|
|
|
|
procedure tcompilerppufile.putderef(p : tsymtableentry);
|
|
begin
|
|
if p=nil then
|
|
putbyte(ord(derefnil))
|
|
else
|
|
begin
|
|
{ Static symtable ? }
|
|
if p.owner.symtabletype=staticsymtable then
|
|
begin
|
|
putbyte(ord(derefaktstaticindex));
|
|
putword(p.indexnr);
|
|
end
|
|
{ Local record/object symtable ? }
|
|
else if (p.owner=aktrecordsymtable) then
|
|
begin
|
|
putbyte(ord(derefaktrecordindex));
|
|
putword(p.indexnr);
|
|
end
|
|
{ Local local/para symtable ? }
|
|
else if (p.owner=aktlocalsymtable) then
|
|
begin
|
|
putbyte(ord(derefaktlocal));
|
|
putword(p.indexnr);
|
|
end
|
|
else
|
|
begin
|
|
putbyte(ord(derefindex));
|
|
putword(p.indexnr);
|
|
{ Current unit symtable ? }
|
|
repeat
|
|
if not assigned(p) then
|
|
internalerror(556655);
|
|
case p.owner.symtabletype of
|
|
{ when writing the pseudo PPU file
|
|
to get CRC values the globalsymtable is not yet
|
|
a unitsymtable PM }
|
|
globalsymtable :
|
|
begin
|
|
{ check if the unit is available in the uses
|
|
clause, else it's an error }
|
|
if p.owner.unitid=$ffff then
|
|
internalerror(55665566);
|
|
putbyte(ord(derefunit));
|
|
putword(p.owner.unitid);
|
|
break;
|
|
end;
|
|
staticsymtable :
|
|
begin
|
|
putbyte(ord(derefaktstaticindex));
|
|
putword(p.indexnr);
|
|
break;
|
|
end;
|
|
localsymtable :
|
|
begin
|
|
p:=p.owner.defowner;
|
|
putbyte(ord(dereflocal));
|
|
putword(p.indexnr);
|
|
end;
|
|
parasymtable :
|
|
begin
|
|
p:=p.owner.defowner;
|
|
putbyte(ord(derefpara));
|
|
putword(p.indexnr);
|
|
end;
|
|
objectsymtable,
|
|
recordsymtable :
|
|
begin
|
|
p:=p.owner.defowner;
|
|
putbyte(ord(derefrecord));
|
|
putword(p.indexnr);
|
|
end;
|
|
else
|
|
internalerror(556656);
|
|
end;
|
|
until false;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tcompilerppufile.putsymlist(p:tsymlist);
|
|
var
|
|
hp : psymlistitem;
|
|
begin
|
|
putderef(p.def);
|
|
hp:=p.firstsym;
|
|
while assigned(hp) do
|
|
begin
|
|
putderef(hp^.sym);
|
|
hp:=hp^.next;
|
|
end;
|
|
putderef(nil);
|
|
end;
|
|
|
|
|
|
procedure tcompilerppufile.puttype(const t:ttype);
|
|
begin
|
|
{ Don't write symbol references for the current unit
|
|
and for the system unit }
|
|
if assigned(t.sym) and
|
|
(t.sym.owner.unitid<>0) and
|
|
(t.sym.owner.unitid<>1) then
|
|
begin
|
|
putderef(nil);
|
|
putderef(t.sym);
|
|
end
|
|
else
|
|
begin
|
|
putderef(t.def);
|
|
putderef(nil);
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.6 2001-05-06 14:49:17 peter
|
|
* ppu object to class rewrite
|
|
* move ppu read and write stuff to fppu
|
|
|
|
Revision 1.5 2001/04/13 01:22:16 peter
|
|
* symtable change to classes
|
|
* range check generation and errors fixed, make cycle DEBUG=1 works
|
|
* memory leaks fixed
|
|
|
|
Revision 1.4 2000/12/25 00:07:29 peter
|
|
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
|
|
tlinkedlist objects)
|
|
|
|
Revision 1.3 2000/11/29 00:30:41 florian
|
|
* unused units removed from uses clause
|
|
* some changes for widestrings
|
|
|
|
Revision 1.2 2000/11/04 14:25:22 florian
|
|
+ merged Attila's changes for interfaces, not tested yet
|
|
|
|
Revision 1.1 2000/10/31 22:02:52 peter
|
|
* symtable splitted, no real code changes
|
|
|
|
}
|