diff --git a/compiler/symppu.inc b/compiler/symppu.inc index b6d0b556c7..5f3e56441f 100644 --- a/compiler/symppu.inc +++ b/compiler/symppu.inc @@ -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 diff --git a/compiler/symsym.inc b/compiler/symsym.inc index df43f1d44f..ef6a72294d 100644 --- a/compiler/symsym.inc +++ b/compiler/symsym.inc @@ -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