Browse Source

* constant sets are now written correctly to the ppufile

peter 27 years ago
parent
commit
a30819a8ee
2 changed files with 54 additions and 43 deletions
  1. 8 5
      compiler/symppu.inc
  2. 46 38
      compiler/symsym.inc

+ 8 - 5
compiler/symppu.inc

@@ -68,9 +68,9 @@
       end;
       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
       begin
-        current_ppu^.putdata(s,32);
+        current_ppu^.putdata(s,sizeof(tnormalset));
       end;
       end;
 
 
 
 
@@ -264,9 +264,9 @@
       end;
       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
       begin
-        current_ppu^.getdata(s,32);
+        current_ppu^.getdata(s,sizeof(tnormalset));
         if current_ppu^.error then
         if current_ppu^.error then
          Message(unit_f_ppu_read_error);
          Message(unit_f_ppu_read_error);
       end;
       end;
@@ -694,7 +694,10 @@
 
 
 {
 {
   $Log$
   $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
     * write extended to ppu file
     * new version 0.99.7
     * new version 0.99.7
 
 

+ 46 - 38
compiler/symsym.inc

@@ -1325,7 +1325,6 @@
 ****************************************************************************}
 ****************************************************************************}
 
 
     constructor tconstsym.init(const n : string;t : tconsttype;v : longint;def : pdef);
     constructor tconstsym.init(const n : string;t : tconsttype;v : longint;def : pdef);
-
       begin
       begin
          tsym.init(n);
          tsym.init(n);
          typ:=constsym;
          typ:=constsym;
@@ -1334,62 +1333,66 @@
          value:=v;
          value:=v;
       end;
       end;
 
 
-    constructor tconstsym.load;
 
 
+    constructor tconstsym.load;
       var
       var
          pd : pbestreal;
          pd : pbestreal;
-         ps : pointer;  {***SETCONST}
-
+         ps : pnormalset;
       begin
       begin
          tsym.load;
          tsym.load;
          typ:=constsym;
          typ:=constsym;
          consttype:=tconsttype(readbyte);
          consttype:=tconsttype(readbyte);
          case consttype of
          case consttype of
             constint,
             constint,
-            constbool,
-            constchar : value:=readlong;
+           constbool,
+           constchar : value:=readlong;
             constord : begin
             constord : begin
                           definition:=readdefref;
                           definition:=readdefref;
                           value:=readlong;
                           value:=readlong;
                        end;
                        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;
                        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;
       end;
       end;
 
 
+
     destructor tconstsym.done;
     destructor tconstsym.done;
       begin
       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;
       end;
 
 
-    function tconstsym.mangledname : string;
 
 
+    function tconstsym.mangledname : string;
       begin
       begin
          mangledname:=name;
          mangledname:=name;
       end;
       end;
 
 
-    procedure tconstsym.deref;
 
 
+    procedure tconstsym.deref;
       begin
       begin
-         if consttype=constord then
-           resolvedef(pdef(definition));
+        if consttype in [constord,constseta] then
+         resolvedef(pdef(definition));
       end;
       end;
 
 
-    procedure tconstsym.write;
 
 
+    procedure tconstsym.write;
       begin
       begin
 {$ifdef OLDPPU}
 {$ifdef OLDPPU}
          writebyte(ibconstsym);
          writebyte(ibconstsym);
@@ -1397,19 +1400,21 @@
          tsym.write;
          tsym.write;
          writebyte(byte(consttype));
          writebyte(byte(consttype));
          case consttype of
          case consttype of
-            constint,
-            constbool,
-            constchar : writelong(value);
+           constint,
+           constbool,
+           constchar : writelong(value);
             constord : begin
             constord : begin
-                          writedefref(definition);
-                          writelong(value);
+                         writedefref(definition);
+                         writelong(value);
+                       end;
+         conststring : writestring(pstring(value)^);
+           constreal : writereal(pbestreal(value)^);
+           constseta : begin
+                         writedefref(definition);
+                         writenormalset(pointer(value)^);
                        end;
                        end;
-            conststring : writestring(pstring(value)^);
-            constreal : writereal(pbestreal(value)^);
-{***SETCONST}
-            constseta: writeset(pointer(value)^);
-{***}
-            else internalerror(13);
+         else
+           internalerror(13);
          end;
          end;
 {$ifndef OLDPPU}
 {$ifndef OLDPPU}
         current_ppu^.writeentry(ibconstsym);
         current_ppu^.writeentry(ibconstsym);
@@ -1671,7 +1676,10 @@
 
 
 {
 {
   $Log$
   $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
     * write extended to ppu file
     * new version 0.99.7
     * new version 0.99.7