* fixes for newppu, remake3 works now with it

compiler/pmodules.pas

@@ -330,7 +330,7 @@ unit pmodules;
                 Message(unit_f_too_much_units);
              end;
           { ok, now load the unit }
-            hp^.symtable:=new(punitsymtable,load(hp^.modulename^));
+            hp^.symtable:=new(punitsymtable,load(hp));
           { if this is the system unit insert the intern symbols }
             make_ref:=false;
             if compile_system then
@@ -352,6 +352,16 @@ unit pmodules;
                 exit;
              end;
           end;
+{$ifdef NEWPPU}
+       { The next entry should be an ibendimplementation }
+         b:=hp^.ppufile^.readentry;
+         if b <> ibendimplementation then
+          Message1(unit_f_ppu_invalid_entry,tostr(b));
+       { The next entry should be an ibend }
+         b:=hp^.ppufile^.readentry;
+         if b <> ibend then
+          Message1(unit_f_ppu_invalid_entry,tostr(b));
+{$endif}
          hp^.ppufile^.close;
 {!         dispose(hp^.ppufile,done);}
 {$else}
@@ -404,7 +414,7 @@ unit pmodules;
               hp^.ppufile^.read_data(b,1,count);
            end;
          { ok, now load the unit }
-         hp^.symtable:=new(punitsymtable,load(hp^.modulename^));
+         hp^.symtable:=new(punitsymtable,load(hp));
          { if this is the system unit insert the intern }
          { symbols                                      }
          make_ref:=false;
@@ -1110,7 +1120,10 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.16  1998-05-27 19:45:06  peter
+  Revision 1.17  1998-05-28 14:40:25  peter
+    * fixes for newppu, remake3 works now with it
+
+  Revision 1.16  1998/05/27 19:45:06  peter
     * symtable.pas splitted into includefiles
     * symtable adapted for $ifdef NEWPPU
 

compiler/ppu.pas

@@ -20,6 +20,9 @@
 
  ****************************************************************************
 }
+{$ifdef TP}
+  {$N+,E+}
+{$endif}
 unit ppu;
 interface
 
@@ -33,21 +36,25 @@ const
 {$endif}
 
 {ppu entries}
-  ibmodulename    = 1;
-  ibsourcefile    = 2;
-  ibloadunit_int  = 3;
-  ibloadunit_imp  = 4;
-  ibinitunit      = 5;
-  iblinkofile     = 6;
-  ibsharedlibs    = 7;
-  ibstaticlibs    = 8;
-  ibdbxcount      = 9;
-  ibref           = 10;
-  ibenddefs       = 250;
-  ibendsyms       = 251;
-  ibendheader     = 252;
-  ibentry         = 254;
-  ibend           = 255;
+  {special}
+  iberror             = 0;
+  ibenddefs           = 250;
+  ibendsyms           = 251;
+  ibendinterface      = 252;
+  ibendimplementation = 253;
+  ibentry             = 254;
+  ibend               = 255;
+  {general}
+  ibmodulename     = 1;
+  ibsourcefiles    = 2;
+  ibloadunit_int   = 3;
+  ibloadunit_imp   = 4;
+  ibinitunit       = 5;
+  iblinkofiles     = 6;
+  iblinksharedlibs = 7;
+  iblinkstaticlibs = 8;
+  ibdbxcount       = 9;
+  ibref            = 10;
   {syms}
   ibtypesym       = 20;
   ibprocsym       = 21;
@@ -97,8 +104,8 @@ type
     compiler : word;
     target   : word;
     flags    : longint;
-    size     : longint;
-    checksum : longint;
+    size     : longint; { size of the ppufile without header }
+    checksum : longint; { checksum for this ppufile }
   end;
 
   tppuentry=packed record
@@ -125,6 +132,7 @@ type
     bufsize,
     bufidx   : longint;
     entry    : tppuentry;
+    entrybufstart,
     entrystart,
     entryidx : longint;
 
@@ -136,16 +144,18 @@ type
     function  GetPPUVersion:longint;
     procedure NewHeader;
     procedure NewEntry;
-    function  EndOfEntry:boolean;
   {read}
     function  open:boolean;
     procedure reloadbuf;
     procedure readdata(var b;len:longint);
+    procedure skipdata(len:longint);
     function  readentry:byte;
+    function  EndOfEntry:boolean;
     procedure getdata(var b;len:longint);
     function  getbyte:byte;
     function  getword:word;
     function  getlongint:longint;
+    function  getdouble:double;
     function  getstring:string;
   {write}
     function  create:boolean;
@@ -157,6 +167,7 @@ type
     procedure putbyte(b:byte);
     procedure putword(w:word);
     procedure putlongint(l:longint);
+    procedure putdouble(d:double);
     procedure putstring(s:string);
   end;
 
@@ -240,6 +251,7 @@ begin
   change_endian:=false;
   Mode:=0;
   NewHeader;
+  Error:=false;
   getmem(buf,ppubufsize);
 end;
 
@@ -308,24 +320,6 @@ begin
 end;
 
 
-procedure tppufile.NewEntry;
-begin
-  with entry do
-   begin
-     id:=ibentry;
-     nr:=ibend;
-     size:=0;
-   end;
-  entryidx:=0;
-end;
-
-
-
-function tppufile.endofentry:boolean;
-begin
-  endofentry:=(entryidx>=entry.size);
-end;
-
 {*****************************************************************************
                                 TPPUFile Reading
 *****************************************************************************}
@@ -353,7 +347,10 @@ begin
 {reset buffer}
   bufstart:=i;
   bufsize:=0;
+  bufidx:=0;
   Mode:=1;
+  FillChar(entry,sizeof(tppuentry),0);
+  Error:=false;
   open:=true;
 end;
 
@@ -366,10 +363,10 @@ var
 begin
   inc(bufstart,bufsize);
 {$ifdef TP}
-  blockread(f,buf,ppubufsize,i);
+  blockread(f,buf^,ppubufsize,i);
   bufsize:=i;
 {$else}
-  blockread(f,buf,ppubufsize,bufsize);
+  blockread(f,buf^,ppubufsize,bufsize);
 {$endif}
   bufidx:=0;
 end;
@@ -405,16 +402,48 @@ begin
 end;
 
 
+procedure tppufile.skipdata(len:longint);
+var
+  left : longint;
+begin
+  while len>0 do
+   begin
+     left:=bufsize-bufidx;
+     if len>left then
+      begin
+        dec(len,left);
+        reloadbuf;
+        if bufsize=0 then
+         exit;
+      end
+     else
+      begin
+        inc(bufidx,len);
+        exit;
+      end;
+   end;
+end;
+
+
 function tppufile.readentry:byte;
 begin
+  if entryidx<entry.size then
+   skipdata(entry.size-entryidx);
   readdata(entry,sizeof(tppuentry));
+  entryidx:=0;
   if entry.id<>ibentry then
    begin
+     readentry:=iberror;
      error:=true;
      exit;
    end;
   readentry:=entry.nr;
-  entryidx:=0;
+end;
+
+
+function tppufile.endofentry:boolean;
+begin
+  endofentry:=(entryidx>=entry.size);
 end;
 
 
@@ -485,6 +514,25 @@ begin
 end;
 
 
+function tppufile.getdouble:double;
+type
+  pdouble = ^double;
+var
+  d : double;
+begin
+  if entryidx+sizeof(double)>entry.size then
+   begin
+     error:=true;
+     exit;
+   end;
+  readdata(d,sizeof(double));
+  getdouble:=d;
+{
+  getlongint:=plongint(@entrybuf[entrybufidx])^;}
+  inc(entryidx,sizeof(double));
+end;
+
+
 function tppufile.getstring:string;
 var
   s : string;
@@ -519,10 +567,15 @@ begin
 {write header for sure}
   blockwrite(f,header,sizeof(tppuheader));
   bufsize:=ppubufsize;
+  bufstart:=sizeof(tppuheader);
+  bufidx:=0;
 {reset}
   crc:=$ffffffff;
+  Error:=false;
   do_crc:=true;
   size:=0;
+{start}
+  NewEntry;
   create:=true;
 end;
 
@@ -531,7 +584,11 @@ procedure tppufile.writeheader;
 var
   opos : longint;
 begin
+{ flush buffer }
   writebuf;
+{ update size (w/o header!) in the header }
+  header.size:=bufstart-sizeof(tppuheader);
+{ write header and restore filepos after it }
   opos:=filepos(f);
   seek(f,0);
   blockwrite(f,header,sizeof(tppuheader));
@@ -543,7 +600,7 @@ procedure tppufile.writebuf;
 begin
   if do_crc then
    UpdateCrc32(crc,buf,bufidx);
-  blockwrite(f,buf,bufidx);
+  blockwrite(f,buf^,bufidx);
   inc(bufstart,bufidx);
   bufidx:=0;
 end;
@@ -565,6 +622,7 @@ begin
         move(p[idx],buf[bufidx],left);
         dec(len,left);
         inc(idx,left);
+        inc(bufidx,left);
         writebuf;
       end
      else
@@ -577,6 +635,23 @@ begin
 end;
 
 
+procedure tppufile.NewEntry;
+begin
+  with entry do
+   begin
+     id:=ibentry;
+     nr:=ibend;
+     size:=0;
+   end;
+{Reset Entry State}
+  entryidx:=0;
+  entrybufstart:=bufstart;
+  entrystart:=bufstart+bufidx;
+{Alloc in buffer}
+  writedata(entry,sizeof(tppuentry));
+end;
+
+
 procedure tppufile.writeentry(ibnr:byte);
 var
   opos : longint;
@@ -585,17 +660,24 @@ begin
   entry.id:=ibentry;
   entry.nr:=ibnr;
   entry.size:=entryidx;
-{flush}
-  writebuf;
-{write entry}
-  opos:=filepos(f);
-  seek(f,entrystart);
-  blockwrite(f,entry,sizeof(tppuentry));
-  seek(f,opos);
-  entrystart:=opos; {next entry position}
+{it's already been sent to disk ?}
+  if entrybufstart<>bufstart then
+   begin
+   {flush when the entry is partly in the new buffer}
+     if entrybufstart+sizeof(entry)>bufstart then
+      WriteBuf;
+   {write entry}
+     opos:=filepos(f);
+     seek(f,entrystart);
+     blockwrite(f,entry,sizeof(tppuentry));
+     seek(f,opos);
+     entrybufstart:=bufstart;
+   end
+  else
+   move(entry,buf[entrystart-bufstart],sizeof(entry));
 {Add New Entry, which is ibend by default}
+  entrystart:=bufstart+bufidx; {next entry position}
   NewEntry;
-  writedata(entry,sizeof(tppuentry));
 end;
 
 
@@ -640,6 +722,15 @@ begin
 end;
 
 
+procedure tppufile.putdouble(d:double);
+type
+  pdouble = ^double;
+begin
+{  plongint(@entrybuf[entrybufidx])^:=l;}
+  writedata(d,sizeof(double));
+  inc(entryidx,sizeof(double));
+end;
+
 procedure tppufile.putstring(s:string);
 begin
   writedata(s,length(s)+1);
@@ -651,7 +742,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  1998-05-27 19:45:08  peter
+  Revision 1.3  1998-05-28 14:40:26  peter
+    * fixes for newppu, remake3 works now with it
+
+  Revision 1.2  1998/05/27 19:45:08  peter
     * symtable.pas splitted into includefiles
     * symtable adapted for $ifdef NEWPPU
 

compiler/symppu.inc

@@ -39,32 +39,32 @@
 
     procedure writebyte(b:byte);
       begin
-        ppufile.putbyte(b);
+        ppufile^.putbyte(b);
       end;
 
     procedure writeword(w:word);
       begin
-        ppufile.putword(w);
+        ppufile^.putword(w);
       end;
 
     procedure writelong(l:longint);
       begin
-        ppufile.putlongint(l);
+        ppufile^.putlongint(l);
       end;
 
     procedure writedouble(d:double);
       begin
-        ppufile.putdata(d,sizeof(double));
+        ppufile^.putdata(d,sizeof(double));
       end;
 
     procedure writestring(const s:string);
       begin
-        ppufile.putstring(s);
+        ppufile^.putstring(s);
       end;
 
     procedure writeset(var s); {You cannot pass an array[0..31] of byte!}
       begin
-        ppufile.putdata(s,32);
+        ppufile^.putdata(s,32);
       end;
 
     procedure writecontainer(var p:tstringcontainer;id:byte;hold:boolean);
@@ -77,11 +77,11 @@
         while not p.empty do
          begin
            s:=p.get;
-           ppufile.putstring(s);
+           ppufile^.putstring(s);
            if hold then
             hcontainer.insert(s);
          end;
-        ppufile.writeentry(id);
+        ppufile^.writeentry(id);
         if hold then
          p:=hcontainer;
       end;
@@ -96,14 +96,14 @@
     procedure writedefref(p : pdef);
       begin
         if p=nil then
-         ppufile.putlongint($ffffffff)
+         ppufile^.putlongint($ffffffff)
         else
          begin
            if (p^.owner^.symtabletype in [recordsymtable,objectsymtable]) then
-            ppufile.putword($ffff)
+            ppufile^.putword($ffff)
            else
-            ppufile.putword(p^.owner^.unitid);
-           ppufile.putword(p^.number);
+            ppufile^.putword(p^.owner^.unitid);
+           ppufile^.putword(p^.number);
          end;
       end;
 
@@ -151,9 +151,9 @@
 {$endif UseBrowser}
           end;
 
-         ppufile.init(s);
-         ppufile.change_endian:=source_os.endian<>target_os.endian;
-         if not ppufile.create then
+         ppufile:=new(pppufile,init(s));
+         ppufile^.change_endian:=source_os.endian<>target_os.endian;
+         if not ppufile^.create then
           Message(unit_f_ppu_cannot_write);
          unit_symtable^.writeasunit;
 {$ifdef UseBrowser}
@@ -167,19 +167,19 @@
               pus:=punitsymtable(pus^.next);
            end;
 {$endif UseBrowser}
-         ppufile.flush;
+         ppufile^.flush;
        { create and write header }
-         ppufile.header.size:=ppufile.size;
-         ppufile.header.checksum:=ppufile.crc;
-         ppufile.header.compiler:=wordversion;
-         ppufile.header.target:=word(target_info.target);
-         ppufile.header.flags:=current_module^.flags;
-         ppufile.writeheader;
+         ppufile^.header.size:=ppufile^.size;
+         ppufile^.header.checksum:=ppufile^.crc;
+         ppufile^.header.compiler:=wordversion;
+         ppufile^.header.target:=word(target_info.target);
+         ppufile^.header.flags:=current_module^.flags;
+         ppufile^.writeheader;
        { save crc in current_module also }
-         current_module^.crc:=ppufile.crc;
+         current_module^.crc:=ppufile^.crc;
        { close }
-         ppufile.close;
-         ppufile.done;
+         ppufile^.close;
+         dispose(ppufile,done);
       end;
 
 
@@ -343,22 +343,22 @@
 {$ifdef NEWPPU}
     function readbyte:byte;
       begin
-        readbyte:=current_module^.ppufile^.getbyte;
-        if current_module^.ppufile^.error then
+        readbyte:=ppufile^.getbyte;
+        if ppufile^.error then
          Message(unit_f_ppu_read_error);
       end;
 
     function readword:word;
       begin
-        readword:=current_module^.ppufile^.getword;
-        if current_module^.ppufile^.error then
+        readword:=ppufile^.getword;
+        if ppufile^.error then
          Message(unit_f_ppu_read_error);
       end;
 
     function readlong:longint;
       begin
-        readlong:=current_module^.ppufile^.getlongint;
-        if current_module^.ppufile^.error then
+        readlong:=ppufile^.getlongint;
+        if ppufile^.error then
          Message(unit_f_ppu_read_error);
       end;
 
@@ -366,29 +366,28 @@
       var
          d : double;
       begin
-        current_module^.ppufile^.getdata(d,sizeof(double));
-        if current_module^.ppufile^.error then
+        ppufile^.getdata(d,sizeof(double));
+        if ppufile^.error then
          Message(unit_f_ppu_read_error);
         readdouble:=d;
       end;
 
     function readstring : string;
       begin
-        readstring:=current_module^.ppufile^.getstring;
-        if current_module^.ppufile^.error then
+        readstring:=ppufile^.getstring;
+        if ppufile^.error then
          Message(unit_f_ppu_read_error);
       end;
 
     procedure readset(var s);   {You cannot pass an array [0..31] of byte.}
       begin
-        current_module^.ppufile^.getdata(s,32);
-        if current_module^.ppufile^.error then
+        ppufile^.getdata(s,32);
+        if ppufile^.error then
          Message(unit_f_ppu_read_error);
       end;
 
     procedure readcontainer(var p:tstringcontainer);
       begin
-        p.init;
         while not current_module^.ppufile^.endofentry do
          p.insert(current_module^.ppufile^.getstring);
       end;
@@ -533,7 +532,10 @@
 
 {
   $Log$
-  Revision 1.1  1998-05-27 19:45:09  peter
+  Revision 1.2  1998-05-28 14:40:28  peter
+    * fixes for newppu, remake3 works now with it
+
+  Revision 1.1  1998/05/27 19:45:09  peter
     * symtable.pas splitted into includefiles
     * symtable adapted for $ifdef NEWPPU
 

compiler/symsym.inc

@@ -89,7 +89,7 @@
          b:=readentry;
          if b=ibref then
           begin
-            while (not ppufile.endofentry) do
+            while (not ppufile^.endofentry) do
              begin
                fileindex:=readword;
                l:=readlong;
@@ -112,7 +112,7 @@
       { references do not change the ppu caracteristics      }
       { this only save the references to variables/functions }
       { defined in the unit what about the others            }
-         ppufile.do_crc:=false;
+         ppufile^.do_crc:=false;
          if assigned(lastwritten) then
            ref:=lastwritten
          else
@@ -123,8 +123,8 @@
               ref:=ref^.nextref;
            end;
          lastwritten:=lastref;
-         ppufile.writeentry(ibref);
-         ppufile.do_crc:=true;
+         ppufile^.writeentry(ibref);
+         ppufile^.do_crc:=true;
       end;
 
 
@@ -156,7 +156,7 @@
       var ref : pref;
           prdef : pdef;
       begin
-         ppufile.do_crc:=false;
+         ppufile^.do_crc:=false;
          if lastwritten=lastref then
            exit;
          writesymref(@self);
@@ -173,7 +173,7 @@
                    prdef:=pprocdef(prdef)^.nextoverloaded;
                 end;
            end;
-         ppufile.do_crc:=true;
+         ppufile^.do_crc:=true;
       end;
 
 {$else NEWPPU}
@@ -209,7 +209,7 @@
       { references do not change the ppu caracteristics      }
       { this only save the references to variables/functions }
       { defined in the unit what about the others            }
-         ppufile.do_crc:=false;
+         ppufile^.do_crc:=false;
          if assigned(lastwritten) then
            ref:=lastwritten
          else
@@ -224,7 +224,7 @@
            end;
          lastwritten:=lastref;
          writebyte(ibend);
-         ppufile.do_crc:=true;
+         ppufile^.do_crc:=true;
       end;
 
 
@@ -263,7 +263,7 @@
       var ref : pref;
           prdef : pdef;
       begin
-         ppufile.do_crc:=false;
+         ppufile^.do_crc:=false;
          if lastwritten=lastref then
            exit;
          writebyte(ibextsymref);
@@ -291,7 +291,7 @@
                    prdef:=pprocdef(prdef)^.nextoverloaded;
                 end;
            end;
-         ppufile.do_crc:=true;
+         ppufile^.do_crc:=true;
       end;
 
 {$endif NEWPPU}
@@ -363,7 +363,7 @@
       var
          s : string;
          b : byte;
-{$endif tp}
+{$endif}
       begin
 {$ifdef tp}
          if use_big then
@@ -376,7 +376,10 @@
            end
          else
 {$endif}
-          name:=strpas(_name);
+        if assigned(_name) then
+         name:=strpas(_name)
+        else
+         name:='';
       end;
 
     function tsym.mangledname : string;
@@ -575,7 +578,7 @@
          tsym.write;
          writedefref(pdef(definition));
 {$ifdef NEWPPU}
-         ppufile.writeentry(ibprocsym);
+         ppufile^.writeentry(ibprocsym);
 {$endif}
       end;
 
@@ -733,7 +736,7 @@
          writedefref(readaccessdef);
          writedefref(writeaccessdef);
 {$ifdef NEWPPU}
-         ppufile.writeentry(ibpropertysym);
+         ppufile^.writeentry(ibpropertysym);
 {$endif}
       end;
 
@@ -816,7 +819,7 @@
           toaddr : writelong(address);
          end;
 {$ifdef NEWPPU}
-        ppufile.writeentry(ibabsolutesym);
+        ppufile^.writeentry(ibabsolutesym);
 {$endif}
       end;
 
@@ -929,7 +932,7 @@
 
          writedefref(definition);
 {$ifdef NEWPPU}
-         ppufile.writeentry(ibvarsym);
+         ppufile^.writeentry(ibvarsym);
 {$endif}
       end;
 
@@ -1248,7 +1251,7 @@
          writedefref(definition);
          writestring(prefix^);
 {$ifdef NEWPPU}
-         ppufile.writeentry(ibtypedconstsym);
+         ppufile^.writeentry(ibtypedconstsym);
 {$endif}
       end;
 
@@ -1394,7 +1397,7 @@
             else internalerror(13);
          end;
 {$ifdef NEWPPU}
-        ppufile.writeentry(ibconstsym);
+        ppufile^.writeentry(ibconstsym);
 {$endif}
       end;
 
@@ -1504,7 +1507,7 @@
          writedefref(definition);
          writelong(value);
 {$ifdef NEWPPU}
-         ppufile.writeentry(ibenumsym);
+         ppufile^.writeentry(ibenumsym);
 {$endif}
       end;
 
@@ -1580,7 +1583,7 @@
          tsym.write;
          writedefref(definition);
 {$ifdef NEWPPU}
-         ppufile.writeentry(ibtypesym);
+         ppufile^.writeentry(ibtypesym);
 {$endif}
       end;
 
@@ -1687,9 +1690,12 @@
 
 {
   $Log$
-  Revision 1.1  1998-05-27 19:45:09  peter
+  Revision 1.2  1998-05-28 14:40:29  peter
+    * fixes for newppu, remake3 works now with it
+
+  Revision 1.1  1998/05/27 19:45:09  peter
     * symtable.pas splitted into includefiles
     * symtable adapted for $ifdef NEWPPU
 
 }
-  
+