paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-07 17:05:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

* constant sets are now written correctly to the ppufile

Browse Source
This commit is contained in:
peter 1998-08-13 10:57:29 +00:00
parent 6fe91685a0
commit a30819a8ee
2 changed files with 54 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
compiler/symppu.inc
View File

@ -68,9 +68,9 @@
end;
procedure writeset(var s); {You cannot pass an array[0..31] of byte!}
procedure writenormalset(var s); {You cannot pass an array[0..31] of byte!}
begin
current_ppu^.putdata(s,32);
current_ppu^.putdata(s,sizeof(tnormalset));
end;
@ -264,9 +264,9 @@
end;
procedure readset(var s); {You cannot pass an array [0..31] of byte.}
procedure readnormalset(var s); {You cannot pass an array [0..31] of byte.}
begin
current_ppu^.getdata(s,32);
current_ppu^.getdata(s,sizeof(tnormalset));
if current_ppu^.error then
Message(unit_f_ppu_read_error);
end;
@ -694,7 +694,10 @@
{
$Log$
Revision 1.9 1998-08-11 15:31:41 peter
Revision 1.10 1998-08-13 10:57:30 peter
* constant sets are now written correctly to the ppufile
Revision 1.9 1998/08/11 15:31:41 peter
* write extended to ppu file
* new version 0.99.7

84
compiler/symsym.inc
View File

@ -1325,7 +1325,6 @@
****************************************************************************}
constructor tconstsym.init(const n : string;t : tconsttype;v : longint;def : pdef);
begin
tsym.init(n);
typ:=constsym;
@ -1334,62 +1333,66 @@
value:=v;
end;
constructor tconstsym.load;
constructor tconstsym.load;
var
pd : pbestreal;
ps : pointer; {***SETCONST}
ps : pnormalset;
begin
tsym.load;
typ:=constsym;
consttype:=tconsttype(readbyte);
case consttype of
constint,
constbool,
constchar : value:=readlong;
constbool,
constchar : value:=readlong;
constord : begin
definition:=readdefref;
value:=readlong;
end;
conststring : value:=longint(stringdup(readstring));
constreal : begin
new(pd);
pd^:=readreal;
value:=longint(pd);
end;
{***SETCONST}
constseta : begin
getmem(ps,32);
readset(ps^);
value:=longint(ps);
conststring : value:=longint(stringdup(readstring));
constreal : begin
new(pd);
pd^:=readreal;
value:=longint(pd);
end;
{***}
else Message1(unit_f_ppu_invalid_entry,tostr(ord(consttype)));
constseta : begin
definition:=readdefref;
new(ps);
readnormalset(ps^);
value:=longint(ps);
end;
else
Message1(unit_f_ppu_invalid_entry,tostr(ord(consttype)));
end;
end;
destructor tconstsym.done;
begin
if consttype = conststring then stringdispose(pstring(value));
inherited done;
case consttype of
conststring : stringdispose(pstring(value));
constreal : dispose(pbestreal(value));
constseta : dispose(pnormalset(value));
end;
inherited done;
end;
function tconstsym.mangledname : string;
function tconstsym.mangledname : string;
begin
mangledname:=name;
end;
procedure tconstsym.deref;
procedure tconstsym.deref;
begin
if consttype=constord then
resolvedef(pdef(definition));
if consttype in [constord,constseta] then
resolvedef(pdef(definition));
end;
procedure tconstsym.write;
procedure tconstsym.write;
begin
{$ifdef OLDPPU}
writebyte(ibconstsym);
@ -1397,19 +1400,21 @@
tsym.write;
writebyte(byte(consttype));
case consttype of
constint,
constbool,
constchar : writelong(value);
constint,
constbool,
constchar : writelong(value);
constord : begin
writedefref(definition);
writelong(value);
writedefref(definition);
writelong(value);
end;
conststring : writestring(pstring(value)^);
constreal : writereal(pbestreal(value)^);
{***SETCONST}
constseta: writeset(pointer(value)^);
{***}
else internalerror(13);
conststring : writestring(pstring(value)^);
constreal : writereal(pbestreal(value)^);
constseta : begin
writedefref(definition);
writenormalset(pointer(value)^);
end;
else
internalerror(13);
end;
{$ifndef OLDPPU}
current_ppu^.writeentry(ibconstsym);
@ -1671,7 +1676,10 @@
{
$Log$
Revision 1.29 1998-08-11 15:31:42 peter
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