diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 44dd99376f..c9ff5b4093 100644 --- a/compiler/pmodules.pas +++ b/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 diff --git a/compiler/ppu.pas b/compiler/ppu.pas index 96d9f67614..887d1053b4 100644 --- a/compiler/ppu.pas +++ b/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 entryidxibentry 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 diff --git a/compiler/symppu.inc b/compiler/symppu.inc index 0140d04e88..8aa5c5150b 100644 --- a/compiler/symppu.inc +++ b/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 diff --git a/compiler/symsym.inc b/compiler/symsym.inc index a18e9825fa..7c84e4bfcb 100644 --- a/compiler/symsym.inc +++ b/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 } - \ No newline at end of file +