123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071 |
- {
- $Id$
- Copyright (c) 1998-2002 by Florian Klaempfl
- Routines to read/write ppu files
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
- }
- unit ppu;
- {$i fpcdefs.inc}
- interface
- { Also write the ppu if only crc if done, this can be used with ppudump to
- see the differences between the intf and implementation }
- { define INTFPPU}
- {$ifdef Test_Double_checksum}
- var
- CRCFile : text;
- const
- CRC_array_Size = 200000;
- type
- tcrc_array = array[0..crc_array_size] of longint;
- pcrc_array = ^tcrc_array;
- {$endif Test_Double_checksum}
- const
- CurrentPPUVersion=29;
- { buffer sizes }
- maxentrysize = 1024;
- ppubufsize = 16384;
- {ppu entries}
- mainentryid = 1;
- subentryid = 2;
- {special}
- iberror = 0;
- ibstartdefs = 248;
- ibenddefs = 249;
- ibstartsyms = 250;
- ibendsyms = 251;
- ibendinterface = 252;
- ibendimplementation = 253;
- ibendbrowser = 254;
- ibend = 255;
- {general}
- ibmodulename = 1;
- ibsourcefiles = 2;
- ibloadunit = 3;
- ibinitunit = 4;
- iblinkunitofiles = 5;
- iblinkunitstaticlibs = 6;
- iblinkunitsharedlibs = 7;
- iblinkotherofiles = 8;
- iblinkotherstaticlibs = 9;
- iblinkothersharedlibs = 10;
- ibdbxcount = 11;
- ibsymref = 12;
- ibdefref = 13;
- ibendsymtablebrowser = 14;
- ibbeginsymtablebrowser = 15;
- ibusedmacros = 16;
- {syms}
- ibtypesym = 20;
- ibprocsym = 21;
- ibvarsym = 22;
- ibconstsym = 23;
- ibenumsym = 24;
- ibtypedconstsym = 25;
- ibabsolutesym = 26;
- ibpropertysym = 27;
- ibvarsym_C = 28;
- ibunitsym = 29; { needed for browser }
- iblabelsym = 30;
- ibfuncretsym = 31;
- ibsyssym = 32;
- ibrttisym = 33;
- {definitions}
- iborddef = 40;
- ibpointerdef = 41;
- ibarraydef = 42;
- ibprocdef = 43;
- ibshortstringdef = 44;
- ibrecorddef = 45;
- ibfiledef = 46;
- ibformaldef = 47;
- ibobjectdef = 48;
- ibenumdef = 49;
- ibsetdef = 50;
- ibprocvardef = 51;
- ibfloatdef = 52;
- ibclassrefdef = 53;
- iblongstringdef = 54;
- ibansistringdef = 55;
- ibwidestringdef = 56;
- ibvariantdef = 57;
- {implementation/objectdata}
- ibasmsymbols = 80;
- {tais}
- ibtaidirect = 100;
- ibtaistring = 101;
- ibtailabel = 102;
- ibtaicomment = 103;
- ibtaiinstruction = 104;
- ibtaidatablock = 105;
- ibtaisymbol = 106;
- ibtaisymbol_end = 107;
- ibtaiconst_32bit = 108;
- ibtaiconst_16bit = 109;
- ibtaiconst_8bit = 110;
- ibtaiconst_symbol = 111;
- ibtaireal_80bit = 112;
- ibtaireal_64bit = 113;
- ibtaireal_32bit = 114;
- ibtaicomp_64bit = 115;
- ibtaialign = 116;
- ibtaisection = 117;
- ibtaiconst_rva = 118;
- ibtaistabn = 119;
- ibtaistabs = 120;
- ibtaiforce_line = 121;
- ibtaifunction_name = 122;
- ibtaicut = 123;
- ibtairegalloc = 124;
- ibtaitempalloc = 125;
- ibtaimarker = 126;
- {tnodes}
- ibnode = 150;
- { unit flags }
- uf_init = $1;
- uf_finalize = $2;
- uf_big_endian = $4;
- uf_has_dbx = $8;
- uf_has_browser = $10;
- uf_in_library = $20; { is the file in another file than <ppufile>.* ? }
- uf_smart_linked = $40; { the ppu can be smartlinked }
- uf_static_linked = $80; { the ppu can be linked static }
- uf_shared_linked = $100; { the ppu can be linked shared }
- uf_local_browser = $200;
- uf_no_link = $400; { unit has no .o generated, but can still have
- external linking! }
- uf_has_resources = $800; { unit has resource section }
- uf_little_endian = $1000;
- uf_release = $2000;{ unit was compiled with -Ur option }
- uf_local_threadvars = $4000; { unit has local threadvars }
- uf_fpu_emulation = $8000; { this unit was compiled with fpu emulation on }
- type
- ppureal=extended;
- tppuerror=(ppuentrytoobig,ppuentryerror);
- tppuheader=packed record { 36 bytes }
- id : array[1..3] of char; { = 'PPU' }
- ver : array[1..3] of char;
- compiler : word;
- cpu : word;
- target : word;
- flags : longint;
- size : longint; { size of the ppufile without header }
- checksum : cardinal; { checksum for this ppufile }
- interface_checksum : cardinal;
- future : array[0..2] of longint;
- end;
- tppuentry=packed record
- id : byte;
- nr : byte;
- size : longint;
- end;
- tppufile=class
- private
- f : file;
- mode : byte; {0 - Closed, 1 - Reading, 2 - Writing}
- fname : string;
- fsize : integer;
- {$ifdef Test_Double_checksum}
- crcindex,
- crc_index,
- crcindex2,
- crc_index2 : cardinal;
- crc_test,
- crc_test2 : pcrc_array;
- {$endif def Test_Double_checksum}
- change_endian : boolean;
- buf : pchar;
- bufstart,
- bufsize,
- bufidx : integer;
- entrybufstart,
- entrystart,
- entryidx : integer;
- entry : tppuentry;
- closed,
- tempclosed : boolean;
- closepos : integer;
- public
- entrytyp : byte;
- header : tppuheader;
- size : integer;
- crc,
- interface_crc : cardinal;
- error,
- do_crc,
- do_interface_crc : boolean;
- crc_only : boolean; { used to calculate interface_crc before implementation }
- constructor Create(const fn:string);
- destructor Destroy;override;
- procedure flush;
- procedure closefile;
- function CheckPPUId:boolean;
- function GetPPUVersion:integer;
- procedure NewHeader;
- procedure NewEntry;
- {read}
- function openfile:boolean;
- procedure reloadbuf;
- procedure readdata(var b;len:integer);
- procedure skipdata(len:integer);
- function readentry:byte;
- function EndOfEntry:boolean;
- procedure getdatabuf(var b;len:integer;var res:integer);
- procedure getdata(var b;len:integer);
- function getbyte:byte;
- function getword:word;
- function getlongint:longint;
- function getreal:ppureal;
- function getstring:string;
- procedure getnormalset(var b);
- procedure getsmallset(var b);
- function skipuntilentry(untilb:byte):boolean;
- {write}
- function createfile:boolean;
- procedure writeheader;
- procedure writebuf;
- procedure writedata(const b;len:integer);
- procedure writeentry(ibnr:byte);
- procedure putdata(const b;len:integer);
- procedure putbyte(b:byte);
- procedure putword(w:word);
- procedure putlongint(l:longint);
- procedure putreal(d:ppureal);
- procedure putstring(s:string);
- procedure putnormalset(const b);
- procedure putsmallset(const b);
- procedure tempclose;
- function tempopen:boolean;
- end;
- implementation
- uses
- {$ifdef Test_Double_checksum}
- comphook,
- {$endif def Test_Double_checksum}
- crc;
- {*****************************************************************************
- Endian Handling
- *****************************************************************************}
- Function SwapLong(x : longint): longint;
- var
- y : word;
- z : word;
- Begin
- y := (x shr 16) and $FFFF;
- y := (y shl 8) or ((y shr 8) and $ff);
- z := x and $FFFF;
- z := (z shl 8) or ((z shr 8) and $ff);
- SwapLong := (longint(z) shl 16) or longint(y);
- End;
- Function SwapWord(x : word): word;
- var
- z : byte;
- Begin
- z := (x shr 8) and $ff;
- x := x and $ff;
- x := (x shl 8);
- SwapWord := x or z;
- End;
- {*****************************************************************************
- TPPUFile
- *****************************************************************************}
- constructor tppufile.Create(const fn:string);
- begin
- fname:=fn;
- change_endian:=false;
- crc_only:=false;
- Mode:=0;
- NewHeader;
- Error:=false;
- closed:=true;
- tempclosed:=false;
- getmem(buf,ppubufsize);
- end;
- destructor tppufile.destroy;
- begin
- closefile;
- if assigned(buf) then
- freemem(buf,ppubufsize);
- end;
- procedure tppufile.flush;
- begin
- if Mode=2 then
- writebuf;
- end;
- procedure tppufile.closefile;
- begin
- {$ifdef Test_Double_checksum}
- if mode=2 then
- begin
- if assigned(crc_test) then
- dispose(crc_test);
- if assigned(crc_test2) then
- dispose(crc_test2);
- end;
- {$endif Test_Double_checksum}
- if Mode<>0 then
- begin
- Flush;
- {$I-}
- system.close(f);
- {$I+}
- if ioresult<>0 then;
- Mode:=0;
- closed:=true;
- end;
- end;
- function tppufile.CheckPPUId:boolean;
- begin
- CheckPPUId:=((Header.Id[1]='P') and (Header.Id[2]='P') and (Header.Id[3]='U'));
- end;
- function tppufile.GetPPUVersion:integer;
- var
- l : integer;
- code : integer;
- begin
- Val(header.ver[1]+header.ver[2]+header.ver[3],l,code);
- if code=0 then
- GetPPUVersion:=l
- else
- GetPPUVersion:=0;
- end;
- procedure tppufile.NewHeader;
- var
- s : string;
- begin
- fillchar(header,sizeof(tppuheader),0);
- str(currentppuversion,s);
- while length(s)<3 do
- s:='0'+s;
- with header do
- begin
- Id[1]:='P';
- Id[2]:='P';
- Id[3]:='U';
- Ver[1]:=s[1];
- Ver[2]:=s[2];
- Ver[3]:=s[3];
- end;
- end;
- {*****************************************************************************
- TPPUFile Reading
- *****************************************************************************}
- function tppufile.openfile:boolean;
- var
- ofmode : byte;
- i : integer;
- begin
- openfile:=false;
- assign(f,fname);
- ofmode:=filemode;
- filemode:=$0;
- {$I-}
- reset(f,1);
- {$I+}
- filemode:=ofmode;
- if ioresult<>0 then
- exit;
- closed:=false;
- {read ppuheader}
- fsize:=filesize(f);
- if fsize<sizeof(tppuheader) then
- exit;
- blockread(f,header,sizeof(tppuheader),i);
- { The header is always stored in little endian order }
- { therefore swap if on a big endian machine }
- {$IFDEF ENDIAN_BIG}
- header.compiler := SwapWord(header.compiler);
- header.cpu := SwapWord(header.cpu);
- header.target := SwapWord(header.target);
- header.flags := SwapLong(header.flags);
- header.size := SwapLong(header.size);
- header.checksum := SwapLong(header.checksum);
- header.interface_checksum := SwapLong(header.interface_checksum);
- {$ENDIF}
- { the PPU DATA is stored in native order }
- if (header.flags and uf_big_endian) = uf_big_endian then
- Begin
- {$IFDEF ENDIAN_LITTLE}
- change_endian := TRUE;
- {$ELSE}
- change_endian := FALSE;
- {$ENDIF}
- End
- else if (header.flags and uf_little_endian) = uf_little_endian then
- Begin
- {$IFDEF ENDIAN_BIG}
- change_endian := TRUE;
- {$ELSE}
- change_endian := FALSE;
- {$ENDIF}
- End;
- {reset buffer}
- bufstart:=i;
- bufsize:=0;
- bufidx:=0;
- Mode:=1;
- FillChar(entry,sizeof(tppuentry),0);
- entryidx:=0;
- entrystart:=0;
- entrybufstart:=0;
- Error:=false;
- openfile:=true;
- end;
- procedure tppufile.reloadbuf;
- begin
- inc(bufstart,bufsize);
- blockread(f,buf^,ppubufsize,bufsize);
- bufidx:=0;
- end;
- procedure tppufile.readdata(var b;len:integer);
- var
- p : pchar;
- left,
- idx : integer;
- begin
- p:=pchar(@b);
- idx:=0;
- while len>0 do
- begin
- left:=bufsize-bufidx;
- if len>left then
- begin
- move(buf[bufidx],p[idx],left);
- dec(len,left);
- inc(idx,left);
- reloadbuf;
- if bufsize=0 then
- exit;
- end
- else
- begin
- move(buf[bufidx],p[idx],len);
- inc(bufidx,len);
- exit;
- end;
- end;
- end;
- procedure tppufile.skipdata(len:integer);
- var
- left : integer;
- 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));
- entrystart:=bufstart+bufidx;
- entryidx:=0;
- if not(entry.id in [mainentryid,subentryid]) then
- begin
- readentry:=iberror;
- error:=true;
- exit;
- end;
- readentry:=entry.nr;
- end;
- function tppufile.endofentry:boolean;
- begin
- endofentry:=(entryidx>=entry.size);
- end;
- procedure tppufile.getdatabuf(var b;len:integer;var res:integer);
- begin
- if entryidx+len>entry.size then
- res:=entry.size-entryidx
- else
- res:=len;
- readdata(b,res);
- inc(entryidx,res);
- end;
- procedure tppufile.getdata(var b;len:integer);
- begin
- if entryidx+len>entry.size then
- begin
- error:=true;
- exit;
- end;
- readdata(b,len);
- inc(entryidx,len);
- end;
- function tppufile.getbyte:byte;
- var
- b : byte;
- begin
- if entryidx+1>entry.size then
- begin
- error:=true;
- getbyte:=0;
- exit;
- end;
- readdata(b,1);
- getbyte:=b;
- inc(entryidx);
- end;
- function tppufile.getword:word;
- var
- w : word;
- begin
- if entryidx+2>entry.size then
- begin
- error:=true;
- getword:=0;
- exit;
- end;
- readdata(w,2);
- if change_endian then
- getword:=swapword(w)
- else
- getword:=w;
- inc(entryidx,2);
- end;
- function tppufile.getlongint:longint;
- var
- l : longint;
- begin
- if entryidx+4>entry.size then
- begin
- error:=true;
- getlongint:=0;
- exit;
- end;
- readdata(l,4);
- if change_endian then
- getlongint:=swaplong(l)
- else
- getlongint:=l;
- inc(entryidx,4);
- end;
- function tppufile.getreal:ppureal;
- var
- d : ppureal;
- begin
- if entryidx+sizeof(ppureal)>entry.size then
- begin
- error:=true;
- getreal:=0;
- exit;
- end;
- readdata(d,sizeof(ppureal));
- getreal:=d;
- inc(entryidx,sizeof(ppureal));
- end;
- function tppufile.getstring:string;
- var
- s : string;
- begin
- s[0]:=chr(getbyte);
- if entryidx+length(s)>entry.size then
- begin
- error:=true;
- exit;
- end;
- ReadData(s[1],length(s));
- getstring:=s;
- inc(entryidx,length(s));
- end;
- procedure tppufile.getsmallset(var b);
- var
- l : longint;
- begin
- l:=getlongint;
- longint(b):=l;
- end;
- procedure tppufile.getnormalset(var b);
- type
- SetLongintArray = Array [0..7] of longint;
- var
- i : longint;
- begin
- if change_endian then
- begin
- for i:=0 to 7 do
- SetLongintArray(b)[i]:=getlongint;
- end
- else
- getdata(b,32);
- end;
- function tppufile.skipuntilentry(untilb:byte):boolean;
- var
- b : byte;
- begin
- repeat
- b:=readentry;
- until (b in [ibend,iberror]) or ((b=untilb) and (entry.id=mainentryid));
- skipuntilentry:=(b=untilb);
- end;
- {*****************************************************************************
- TPPUFile Writing
- *****************************************************************************}
- function tppufile.createfile:boolean;
- begin
- createfile:=false;
- {$ifdef INTFPPU}
- if crc_only then
- begin
- fname:=fname+'.intf';
- crc_only:=false;
- end;
- {$endif}
- if not crc_only then
- begin
- assign(f,fname);
- {$I-}
- rewrite(f,1);
- {$I+}
- if ioresult<>0 then
- exit;
- Mode:=2;
- {write header for sure}
- blockwrite(f,header,sizeof(tppuheader));
- end;
- bufsize:=ppubufsize;
- bufstart:=sizeof(tppuheader);
- bufidx:=0;
- {reset}
- crc:=cardinal($ffffffff);
- interface_crc:=cardinal($ffffffff);
- do_interface_crc:=true;
- Error:=false;
- do_crc:=true;
- size:=0;
- entrytyp:=mainentryid;
- {start}
- NewEntry;
- createfile:=true;
- end;
- procedure tppufile.writeheader;
- var
- opos : integer;
- begin
- { flush buffer }
- writebuf;
- { update size (w/o header!) in the header }
- header.size:=bufstart-sizeof(tppuheader);
- { set the endian flag }
- {$IFDEF SOURCE_BIG_ENDIAN}
- header.flags := header.flags or uf_big_endian;
- {$ENDIF}
- {$IFDEF SOURCE_LITTLE_ENDIAN}
- header.flags := header.flags or uf_little_endian;
- {$ENDIF}
- { Now swap the header in the correct endian (always little endian) }
- {$IFDEF SOURCE_BIG_ENDIAN}
- header.compiler := SwapWord(header.compiler);
- header.cpu := SwapWord(header.cpu);
- header.target := SwapWord(header.target);
- header.flags := SwapLong(header.flags);
- header.size := SwapLong(header.size);
- header.checksum := SwapLong(header.checksum);
- header.interface_checksum := SwapLong(header.interface_checksum);
- {$ENDIF}
- { write header and restore filepos after it }
- opos:=filepos(f);
- seek(f,0);
- blockwrite(f,header,sizeof(tppuheader));
- seek(f,opos);
- end;
- procedure tppufile.writebuf;
- begin
- if not crc_only then
- blockwrite(f,buf^,bufidx);
- inc(bufstart,bufidx);
- bufidx:=0;
- end;
- procedure tppufile.writedata(const b;len:integer);
- var
- p : pchar;
- left,
- idx : integer;
- begin
- if crc_only then
- exit;
- p:=pchar(@b);
- idx:=0;
- while len>0 do
- begin
- left:=bufsize-bufidx;
- if len>left then
- begin
- move(p[idx],buf[bufidx],left);
- dec(len,left);
- inc(idx,left);
- inc(bufidx,left);
- writebuf;
- end
- else
- begin
- move(p[idx],buf[bufidx],len);
- inc(bufidx,len);
- exit;
- end;
- end;
- end;
- procedure tppufile.NewEntry;
- begin
- with entry do
- begin
- id:=entrytyp;
- 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 : integer;
- begin
- {create entry}
- entry.id:=entrytyp;
- entry.nr:=ibnr;
- entry.size:=entryidx;
- {it's already been sent to disk ?}
- if entrybufstart<>bufstart then
- begin
- if not crc_only then
- begin
- {flush to be sure}
- WriteBuf;
- {write entry}
- opos:=filepos(f);
- seek(f,entrystart);
- blockwrite(f,entry,sizeof(tppuentry));
- seek(f,opos);
- end;
- 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;
- end;
- procedure tppufile.putdata(const b;len:integer);
- begin
- if do_crc then
- begin
- crc:=UpdateCrc32(crc,b,len);
- {$ifdef Test_Double_checksum}
- if crc_only then
- begin
- crc_test2^[crc_index2]:=crc;
- {$ifdef Test_Double_checksum_write}
- Writeln(CRCFile,crc);
- {$endif Test_Double_checksum_write}
- if crc_index2<crc_array_size then
- inc(crc_index2);
- end
- else
- begin
- if (crcindex2<crc_array_size) and (crcindex2<crc_index2) and
- (crc_test2^[crcindex2]<>crc) then
- Do_comment(V_Warning,'impl CRC changed');
- {$ifdef Test_Double_checksum_write}
- Writeln(CRCFile,crc);
- {$endif Test_Double_checksum_write}
- inc(crcindex2);
- end;
- {$endif def Test_Double_checksum}
- if do_interface_crc then
- begin
- interface_crc:=UpdateCrc32(interface_crc,b,len);
- {$ifdef Test_Double_checksum}
- if crc_only then
- begin
- crc_test^[crc_index]:=interface_crc;
- {$ifdef Test_Double_checksum_write}
- Writeln(CRCFile,interface_crc);
- {$endif Test_Double_checksum_write}
- if crc_index<crc_array_size then
- inc(crc_index);
- end
- else
- begin
- if (crcindex<crc_array_size) and (crcindex<crc_index) and
- (crc_test^[crcindex]<>interface_crc) then
- Do_comment(V_Warning,'CRC changed');
- {$ifdef Test_Double_checksum_write}
- Writeln(CRCFile,interface_crc);
- {$endif Test_Double_checksum_write}
- inc(crcindex);
- end;
- {$endif def Test_Double_checksum}
- end;
- end;
- if not crc_only then
- writedata(b,len);
- inc(entryidx,len);
- end;
- procedure tppufile.putbyte(b:byte);
- begin
- putdata(b,1);
- end;
- procedure tppufile.putword(w:word);
- begin
- putdata(w,2);
- end;
- procedure tppufile.putlongint(l:longint);
- begin
- putdata(l,4);
- end;
- procedure tppufile.putreal(d:ppureal);
- begin
- putdata(d,sizeof(ppureal));
- end;
- procedure tppufile.putstring(s:string);
- begin
- putdata(s,length(s)+1);
- end;
- procedure tppufile.putsmallset(const b);
- var
- l : longint;
- begin
- l:=longint(b);
- putlongint(l);
- end;
- procedure tppufile.putnormalset(const b);
- type
- SetLongintArray = Array [0..7] of longint;
- var
- i : longint;
- tempb : setlongintarray;
- begin
- if change_endian then
- begin
- for i:=0 to 7 do
- tempb[i]:=SwapLong(SetLongintArray(b)[i]);
- putdata(tempb,32);
- end
- else
- putdata(b,32);
- end;
- procedure tppufile.tempclose;
- begin
- if not closed then
- begin
- closepos:=filepos(f);
- {$I-}
- system.close(f);
- {$I+}
- if ioresult<>0 then;
- closed:=true;
- tempclosed:=true;
- end;
- end;
- function tppufile.tempopen:boolean;
- var
- ofm : byte;
- begin
- tempopen:=false;
- if not closed or not tempclosed then
- exit;
- ofm:=filemode;
- filemode:=0;
- {$I-}
- reset(f,1);
- {$I+}
- filemode:=ofm;
- if ioresult<>0 then
- exit;
- closed:=false;
- tempclosed:=false;
- { restore state }
- seek(f,closepos);
- tempopen:=true;
- end;
- end.
- {
- $Log$
- Revision 1.25 2002-08-15 19:10:35 peter
- * first things tai,tnode storing in ppu
- Revision 1.24 2002/08/15 15:09:42 carl
- + fpu emulation helpers (ppu checking also)
- Revision 1.23 2002/08/13 21:40:56 florian
- * more fixes for ppc calling conventions
- Revision 1.22 2002/08/11 13:24:12 peter
- * saving of asmsymbols in ppu supported
- * asmsymbollist global is removed and moved into a new class
- tasmlibrarydata that will hold the info of a .a file which
- corresponds with a single module. Added librarydata to tmodule
- to keep the library info stored for the module. In the future the
- objectfiles will also be stored to the tasmlibrarydata class
- * all getlabel/newasmsymbol and friends are moved to the new class
- Revision 1.21 2002/08/09 07:33:02 florian
- * a couple of interface related fixes
- Revision 1.20 2002/05/18 13:34:13 peter
- * readded missing revisions
- Revision 1.19 2002/05/16 19:46:44 carl
- + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
- + try to fix temp allocation (still in ifdef)
- + generic constructor calls
- + start of tassembler / tmodulebase class cleanup
- Revision 1.17 2002/04/04 19:06:03 peter
- * removed unused units
- * use tlocation.size in cg.a_*loc*() routines
- Revision 1.16 2002/03/31 20:26:36 jonas
- + a_loadfpu_* and a_loadmm_* methods in tcg
- * register allocation is now handled by a class and is mostly processor
- independent (+rgobj.pas and i386/rgcpu.pas)
- * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
- * some small improvements and fixes to the optimizer
- * some register allocation fixes
- * some fpuvaroffset fixes in the unary minus node
- * push/popusedregisters is now called rg.save/restoreusedregisters and
- (for i386) uses temps instead of push/pop's when using -Op3 (that code is
- also better optimizable)
- * fixed and optimized register saving/restoring for new/dispose nodes
- * LOC_FPU locations now also require their "register" field to be set to
- R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
- - list field removed of the tnode class because it's not used currently
- and can cause hard-to-find bugs
- Revision 1.15 2002/03/28 16:07:52 armin
- + initialize threadvars defined local in units
- }
|