paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 17:29:11 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ double_checksum code added

Browse Source
This commit is contained in:
pierre 1999-04-07 15:39:29 +00:00
parent 5f410c2cd3
commit ab9465df1b
5 changed files with 345 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
compiler/files.pas
View File

@ -125,6 +125,10 @@ unit files;
tmodule = object(tlinkedlist_item) tmodule = object(tlinkedlist_item)
ppufile : pppufile; { the PPU file } ppufile : pppufile; { the PPU file }
crc, crc,
{$ifdef Double_checksum}
interface_crc : longint;
do_reload_ppu : boolean;
{$endif def Double_checksum}
flags : longint; { the PPU flags } flags : longint; { the PPU flags }
compiled, { unit is already compiled } compiled, { unit is already compiled }
@ -154,7 +158,7 @@ unit files;
linkunitfiles, linkunitfiles,
linkofiles : tstringcontainer; linkofiles : tstringcontainer;
used_units : tlinkedlist; used_units : tlinkedlist;
dependent_units : tlinkedlist;
localunitsearchpath, { local searchpaths } localunitsearchpath, { local searchpaths }
localobjectsearchpath, localobjectsearchpath,
localincludesearchpath, localincludesearchpath,
@ -171,6 +175,10 @@ unit files;
exefilename, { fullname of the exefile } exefilename, { fullname of the exefile }
asmprefix, { prefix for the smartlink asmfiles } asmprefix, { prefix for the smartlink asmfiles }
mainsource : pstring; { name of the main sourcefile } mainsource : pstring; { name of the main sourcefile }
{$ifdef Test_Double_checksum}
crc_array : pointer;
crc_size : longint;
{$endif def Test_Double_checksum}
constructor init(const s:string;_is_unit:boolean); constructor init(const s:string;_is_unit:boolean);
destructor done;virtual; destructor done;virtual;
@ -185,6 +193,9 @@ unit files;
unitid : word; unitid : word;
name : pstring; name : pstring;
checksum : longint; checksum : longint;
{$ifdef Double_checksum}
interface_checksum : longint;
{$endif def Double_checksum}
loaded : boolean; loaded : boolean;
in_uses, in_uses,
in_interface, in_interface,
@ -195,6 +206,12 @@ unit files;
destructor done;virtual; destructor done;virtual;
end; end;
pdependent_unit = ^tdependent_unit;
tdependent_unit = object(tlinkedlist_item)
u : pmodule;
constructor init(_u : pmodule);
end;
var var
main_module : pmodule; { Main module of the program } main_module : pmodule; { Main module of the program }
current_module : pmodule; { Current module which is compiled } current_module : pmodule; { Current module which is compiled }
@ -209,6 +226,9 @@ unit files;
implementation implementation
uses uses
{$ifdef Double_checksum}
comphook,
{$endif Double_checksum}
dos,verbose,systems, dos,verbose,systems,
symtable,scanner; symtable,scanner;
@ -713,7 +733,7 @@ uses
exit; exit;
end; end;
{ check for allowed PPU versions } { check for allowed PPU versions }
if not (ppufile^.GetPPUVersion = 15) then if not (ppufile^.GetPPUVersion = CurrentPPUVersion) then
begin begin
dispose(ppufile,done); dispose(ppufile,done);
Message1(unit_u_ppu_invalid_version,tostr(ppufile^.GetPPUVersion)); Message1(unit_u_ppu_invalid_version,tostr(ppufile^.GetPPUVersion));
@ -736,6 +756,9 @@ uses
{ Load values to be access easier } { Load values to be access easier }
flags:=ppufile^.header.flags; flags:=ppufile^.header.flags;
crc:=ppufile^.header.checksum; crc:=ppufile^.header.checksum;
{$ifdef Double_checksum}
interface_crc:=ppufile^.header.interface_checksum;
{$endif def Double_checksum}
{ Show Debug info } { Show Debug info }
Message1(unit_u_ppu_time,filetimestring(ppufiletime)); Message1(unit_u_ppu_time,filetimestring(ppufiletime));
Message1(unit_u_ppu_flags,tostr(flags)); Message1(unit_u_ppu_flags,tostr(flags));
@ -898,6 +921,10 @@ uses
end; end;
procedure tmodule.reset; procedure tmodule.reset;
var
pm : pdependent_unit;
begin begin
if assigned(scanner) then if assigned(scanner) then
pscannerfile(scanner)^.invalid:=true; pscannerfile(scanner)^.invalid:=true;
@ -929,6 +956,19 @@ uses
_exports^.init; _exports^.init;
used_units.done; used_units.done;
used_units.init; used_units.init;
{ all units that depend on this one must be recompiled ! }
{$ifdef Double_checksum}
pm:=pdependent_unit(dependent_units.first);
while assigned(pm) do
begin
pm^.u^.do_reload_ppu:=true;
def_comment(v_warning,'Reloading '+pm^.u^.mainsource^+' needed because '+
mainsource^+' is reloaded');
pm:=pdependent_unit(pm^.next);
end;
{$endif Double_checksum}
dependent_units.done;
dependent_units.init;
resourcefiles.done; resourcefiles.done;
resourcefiles.init_no_double; resourcefiles.init_no_double;
linkunitfiles.done; linkunitfiles.done;
@ -950,6 +990,9 @@ uses
loaded_from:=nil; loaded_from:=nil;
flags:=0; flags:=0;
crc:=0; crc:=0;
{$ifdef Double_checksum}
interface_crc:=0;
{$endif def Double_checksum}
unitcount:=1; unitcount:=1;
end; end;
@ -998,6 +1041,7 @@ uses
localincludesearchpath:=nil; localincludesearchpath:=nil;
locallibrarysearchpath:=nil; locallibrarysearchpath:=nil;
used_units.init; used_units.init;
dependent_units.init;
new(sourcefiles,init); new(sourcefiles,init);
resourcefiles.init_no_double; resourcefiles.init_no_double;
linkunitfiles.init_no_double; linkunitfiles.init_no_double;
@ -1012,6 +1056,10 @@ uses
loaded_from:=nil; loaded_from:=nil;
flags:=0; flags:=0;
crc:=0; crc:=0;
{$ifdef Double_checksum}
interface_crc:=0;
do_reload_ppu:=false;
{$endif def Double_checksum}
unitcount:=1; unitcount:=1;
inc(global_unit_count); inc(global_unit_count);
unit_index:=global_unit_count; unit_index:=global_unit_count;
@ -1055,6 +1103,7 @@ uses
dispose(sourcefiles,done); dispose(sourcefiles,done);
sourcefiles:=nil; sourcefiles:=nil;
used_units.done; used_units.done;
dependent_units.done;
resourcefiles.done; resourcefiles.done;
linkunitfiles.done; linkunitfiles.done;
linkofiles.done; linkofiles.done;
@ -1098,6 +1147,9 @@ uses
loaded:=true; loaded:=true;
name:=stringdup(_u^.modulename^); name:=stringdup(_u^.modulename^);
checksum:=_u^.crc; checksum:=_u^.crc;
{$ifdef Double_checksum}
interface_checksum:=_u^.interface_crc;
{$endif def Double_checksum}
unitid:=0; unitid:=0;
end; end;
@ -1111,6 +1163,13 @@ uses
loaded:=false; loaded:=false;
name:=stringdup(n); name:=stringdup(n);
checksum:=c; checksum:=c;
{$ifdef Double_checksum}
if not in_interface then
begin
interface_checksum:=c;
checksum:=0;
end;
{$endif def Double_checksum}
unitid:=0; unitid:=0;
end; end;
@ -1121,10 +1180,22 @@ uses
inherited done; inherited done;
end; end;
{****************************************************************************
TDENPENDENT_UNIT
****************************************************************************}
constructor tdependent_unit.init(_u : pmodule);
begin
u:=_u;
end;
end. end.
{ {
$Log$ $Log$
Revision 1.88 1999-03-25 16:55:29 peter Revision 1.89 1999-04-07 15:39:29 pierre
+ double_checksum code added
Revision 1.88 1999/03/25 16:55:29 peter
+ unitpath,librarypath,includepath,objectpath directives + unitpath,librarypath,includepath,objectpath directives
Revision 1.87 1999/02/16 00:48:23 peter Revision 1.87 1999/02/16 00:48:23 peter

117
compiler/pmodules.pas
View File

@ -22,7 +22,8 @@
} }
unit pmodules; unit pmodules;
{.$define TEST_IMPL does not work well } { define TEST_IMPL does not work well }
{ replaced by $define Double_checksum}
{ other way to get correct type info, in test (PM) } { other way to get correct type info, in test (PM) }
{$define New_GDB} {$define New_GDB}
@ -126,7 +127,14 @@ unit pmodules;
fixseg(codesegment,sec_code); fixseg(codesegment,sec_code);
fixseg(datasegment,sec_data); fixseg(datasegment,sec_data);
fixseg(bsssegment,sec_bss); fixseg(bsssegment,sec_bss);
{ we should use .rdata section for these two no ? }
{ .rdata is a read only data section (PM) }
fixseg(rttilist,sec_data);
fixseg(consts,sec_data); fixseg(consts,sec_data);
{$ifdef GDB}
if assigned(debuglist) then
fixseg(debuglist,sec_code);
{$endif GDB}
end; end;
@ -226,8 +234,10 @@ unit pmodules;
var var
pu : pused_unit; pu : pused_unit;
loaded_unit : pmodule; loaded_unit : pmodule;
load_refs : boolean;
nextmapentry : longint; nextmapentry : longint;
begin begin
load_refs:=true;
{ init the map } { init the map }
new(current_module^.map); new(current_module^.map);
fillchar(current_module^.map^,sizeof(tunitmap),#0); fillchar(current_module^.map^,sizeof(tunitmap),#0);
@ -248,11 +258,20 @@ unit pmodules;
{ register unit in used units } { register unit in used units }
pu^.u:=loaded_unit; pu^.u:=loaded_unit;
pu^.loaded:=true; pu^.loaded:=true;
{ doubles are not important for that list PM }
pu^.u^.dependent_units.concat(new(pdependent_unit,init(current_module)));
{ need to recompile the current unit ? } { need to recompile the current unit ? }
if loaded_unit^.crc<>pu^.checksum then if loaded_unit^.crc<>pu^.checksum then
begin begin
Message2(unit_u_recompile_crc_change,current_module^.modulename^,pu^.name^); Message2(unit_u_recompile_crc_change,current_module^.modulename^,pu^.name^);
current_module^.do_compile:=true; current_module^.do_compile:=true;
{ if the checksum was known but has changed then
we should also recompile the loaded unit ! }
if (pu^.checksum<>0) and (loaded_unit^.sources_avail) then
begin
Message2(unit_u_recompile_crc_change,loaded_unit^.modulename^,current_module^.modulename^);
loaded_unit^.do_compile:=true;
end;
dispose(current_module^.map); dispose(current_module^.map);
current_module^.map:=nil; current_module^.map:=nil;
exit; exit;
@ -292,17 +311,22 @@ unit pmodules;
{ register unit in used units } { register unit in used units }
pu^.u:=loaded_unit; pu^.u:=loaded_unit;
pu^.loaded:=true; pu^.loaded:=true;
{$ifdef TEST_IMPL} {$ifdef Double_checksum}
{ need to recompile the current unit ? } { need to recompile the current unit ? }
if loaded_unit^.crc<>pu^.checksum then if (loaded_unit^.interface_crc<>pu^.interface_checksum) then
begin { checksum change whereas it was already known
Message2(unit_u_recompile_crc_change,current_module^.modulename^,pu^.name^); loade_unit was changed so we need to recompile this unit }
current_module^.do_compile:=true; begin
dispose(current_module^.map); {if (loaded_unit^.sources_avail) then
current_module^.map:=nil; begin
exit; loaded_unit^.do_compile:=true;
end; end; }
{$endif TEST_IMPL} Message2(unit_u_recompile_crc_change,loaded_unit^.modulename^,current_module^.modulename^);
loaded_unit^.do_compile:=true;
if(pu^.interface_checksum<>0) then
load_refs:=false;
end;
{$endif def Double_checksum}
{ setup the map entry for deref } { setup the map entry for deref }
{$ifndef NEWMAP} {$ifndef NEWMAP}
current_module^.map^[nextmapentry]:=loaded_unit^.globalsymtable; current_module^.map^[nextmapentry]:=loaded_unit^.globalsymtable;
@ -316,7 +340,7 @@ unit pmodules;
pu:=pused_unit(pu^.next); pu:=pused_unit(pu^.next);
end; end;
{ load browser info if stored } { load browser info if stored }
if ((current_module^.flags and uf_has_browser)<>0) then if ((current_module^.flags and uf_has_browser)<>0) and load_refs then
punitsymtable(current_module^.globalsymtable)^.load_symtable_refs; punitsymtable(current_module^.globalsymtable)^.load_symtable_refs;
{ remove the map, it's not needed anymore } { remove the map, it's not needed anymore }
dispose(current_module^.map); dispose(current_module^.map);
@ -426,12 +450,37 @@ unit pmodules;
end; end;
end; end;
break; break;
end
{$ifdef Double_checksum}
else if hp^.do_reload_ppu then
begin
{ remove the old unit }
loaded_units.remove(hp);
scanner:=hp^.scanner;
name:=hp^.modulename^;
hp^.reset;
hp^.do_reload_ppu:=false;
hp^.scanner:=scanner;
{ try to reopen ppu }
hp^.search_unit(name,false);
{ try to load the unit a second time first }
current_module:=hp;
current_module^.in_second_compile:=true;
{ now realy load the ppu }
loadppufile;
{ set compiled flag }
current_module^.compiled:=true;
end; end;
{$endif Double_checksum}
{ the next unit } { the next unit }
hp:=pmodule(hp^.next); hp:=pmodule(hp^.next);
end; end;
{ the unit is not in the symtable stack } { the unit is not in the symtable stack }
if (not assigned(st)) then if (not assigned(st))
{$ifdef Double_checksum}
or (assigned(hp) and hp^.do_reload_ppu)
{$endif Double_checksum}
then
begin begin
if assigned(hp) then if assigned(hp) then
begin begin
@ -439,6 +488,9 @@ unit pmodules;
loaded_units.remove(hp); loaded_units.remove(hp);
scanner:=hp^.scanner; scanner:=hp^.scanner;
hp^.reset; hp^.reset;
{$ifdef Double_checksum}
hp^.do_reload_ppu:=false;
{$endif Double_checksum}
hp^.scanner:=scanner; hp^.scanner:=scanner;
{ try to reopen ppu } { try to reopen ppu }
hp^.search_unit(s,false); hp^.search_unit(s,false);
@ -703,11 +755,23 @@ unit pmodules;
procedure gen_main_procsym(const name:string;options:longint;st:psymtable); procedure gen_main_procsym(const name:string;options:longint;st:psymtable);
{$ifdef Double_checksum}
var
stt : psymtable;
{$endif Double_checksum}
begin begin
{Generate a procsym for main} {Generate a procsym for main}
make_ref:=false; make_ref:=false;
aktprocsym:=new(Pprocsym,init(name)); aktprocsym:=new(Pprocsym,init(name));
{$ifdef Double_checksum}
{Try to insert in in static symtable ! }
stt:=symtablestack;
symtablestack:=st;
{$endif Double_checksum}
aktprocsym^.definition:=new(Pprocdef,init); aktprocsym^.definition:=new(Pprocdef,init);
{$ifdef Double_checksum}
symtablestack:=stt;
{$endif Double_checksum}
aktprocsym^.definition^.options:=aktprocsym^.definition^.options or options; aktprocsym^.definition^.options:=aktprocsym^.definition^.options or options;
aktprocsym^.definition^.setmangledname(target_os.cprefix+name); aktprocsym^.definition^.setmangledname(target_os.cprefix+name);
aktprocsym^.definition^.forwarddef:=false; aktprocsym^.definition^.forwarddef:=false;
@ -751,6 +815,9 @@ unit pmodules;
{$ifdef GDB} {$ifdef GDB}
pu : pused_unit; pu : pused_unit;
{$endif GDB} {$endif GDB}
{$ifdef Double_checksum}
store_crc : longint;
{$endif def Double_checksum}
s1,s2 : ^string; {Saves stack space} s1,s2 : ^string; {Saves stack space}
begin begin
consume(_UNIT); consume(_UNIT);
@ -891,6 +958,13 @@ unit pmodules;
write_gdb_info; write_gdb_info;
{$endIf Def New_GDB} {$endIf Def New_GDB}
{$ifdef Double_CheckSum}
{$ifdef Test_Double_checksum}
if (Errorcount=0) then
writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack),true);
{$endif Test_Double_checksum}
{$endif Double_CheckSum}
{ Parse the implementation section } { Parse the implementation section }
consume(_IMPLEMENTATION); consume(_IMPLEMENTATION);
current_module^.in_implementation:=true; current_module^.in_implementation:=true;
@ -1059,9 +1133,19 @@ unit pmodules;
if cs_local_browser in aktmoduleswitches then if cs_local_browser in aktmoduleswitches then
current_module^.localsymtable:=refsymtable; current_module^.localsymtable:=refsymtable;
{ Write out the ppufile } { Write out the ppufile }
{$ifdef Double_checksum}
store_crc:=current_module^.interface_crc;
{$endif def Double_checksum}
if (Errorcount=0) then if (Errorcount=0) then
writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack)); writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack),false);
{$ifdef Double_checksum}
{$ifdef Test_Double_checksum}
if store_crc<>current_module^.interface_crc then
Def_comment(V_Warning,current_module^.ppufilename^+' CRC changed '+
tostr(store_crc)+'<>'+tostr(current_module^.interface_crc));
{$endif def TestDouble_checksum}
{$endif def Double_checksum}
{ must be done only after local symtable ref stores !! } { must be done only after local symtable ref stores !! }
closecurrentppu; closecurrentppu;
{$ifdef GDB} {$ifdef GDB}
@ -1255,7 +1339,10 @@ unit pmodules;
end. end.
{ {
$Log$ $Log$
Revision 1.105 1999-03-26 00:05:38 peter Revision 1.106 1999-04-07 15:39:30 pierre
+ double_checksum code added
Revision 1.105 1999/03/26 00:05:38 peter
* released valintern * released valintern
+ deffile is now removed when compiling is finished + deffile is now removed when compiling is finished
* ^( compiles now correct * ^( compiles now correct

88
compiler/ppu.pas
View File

@ -26,7 +26,23 @@
unit ppu; unit ppu;
interface interface
{$ifdef Test_Double_checksum}
var
CRCFile : text;
const const
CRC_array_Size = 20000;
type
tcrc_array = array[0..crc_array_size] of longint;
pcrc_array = ^tcrc_array;
{$endif Test_Double_checksum}
const
{$ifndef Double_checksum}
CurrentPPUVersion=15;
{$else Double_checksum}
CurrentPPUVersion=16;
{$endif def Double_checksum}
{ buffer sizes } { buffer sizes }
maxentrysize = 1024; maxentrysize = 1024;
{$ifdef TP} {$ifdef TP}
@ -126,6 +142,9 @@ type
flags : longint; flags : longint;
size : longint; { size of the ppufile without header } size : longint; { size of the ppufile without header }
checksum : longint; { checksum for this ppufile } checksum : longint; { checksum for this ppufile }
{$ifdef Double_checksum}
interface_checksum : longint;
{$endif def Double_checksum}
end; end;
tppuentry=packed record tppuentry=packed record
@ -144,6 +163,18 @@ type
header : tppuheader; header : tppuheader;
size,crc : longint; size,crc : longint;
{$ifdef Double_checksum}
{$ifdef Test_Double_checksum}
crcindex : longint;
crc_index : longint;
crc_test : pcrc_array;
{$endif def Test_Double_checksum}
interface_crc : longint;
do_interface_crc : boolean;
{ used to calculate interface_crc
before implementation }
crc_only : boolean;
{$endif def Double_checksum}
do_crc, do_crc,
change_endian : boolean; change_endian : boolean;
@ -196,6 +227,11 @@ type
implementation implementation
{$ifdef Test_Double_checksum}
uses
comphook;
{$endif def Test_Double_checksum}
{***************************************************************************** {*****************************************************************************
Crc 32 Crc 32
*****************************************************************************} *****************************************************************************}
@ -279,6 +315,9 @@ constructor tppufile.init(fn:string);
begin begin
fname:=fn; fname:=fn;
change_endian:=false; change_endian:=false;
{$ifdef Double_checksum}
crc_only:=false;
{$endif Double_checksum}
Mode:=0; Mode:=0;
NewHeader; NewHeader;
Error:=false; Error:=false;
@ -345,7 +384,11 @@ begin
Id[3]:='U'; Id[3]:='U';
Ver[1]:='0'; Ver[1]:='0';
Ver[2]:='1'; Ver[2]:='1';
{$ifndef Double_checksum}
Ver[3]:='5'; Ver[3]:='5';
{$else Double_checksum}
Ver[3]:='6';
{$endif def Double_checksum}
end; end;
end; end;
@ -638,6 +681,10 @@ begin
bufidx:=0; bufidx:=0;
{reset} {reset}
crc:=$ffffffff; crc:=$ffffffff;
{$ifdef Double_checksum}
interface_crc:=$ffffffff;
do_interface_crc:=true;
{$endif def Double_checksum}
Error:=false; Error:=false;
do_crc:=true; do_crc:=true;
size:=0; size:=0;
@ -749,8 +796,40 @@ end;
procedure tppufile.putdata(var b;len:longint); procedure tppufile.putdata(var b;len:longint);
begin begin
if do_crc then if do_crc then
crc:=UpdateCrc32(crc,b,len); begin
writedata(b,len); crc:=UpdateCrc32(crc,b,len);
{$ifdef 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
Def_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
{$else not def Double_checksum}
end;
{$endif def Double_checksum}
writedata(b,len);
inc(entryidx,len); inc(entryidx,len);
end; end;
@ -795,7 +874,10 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.25 1999-03-02 13:49:18 peter Revision 1.26 1999-04-07 15:39:31 pierre
+ double_checksum code added
Revision 1.25 1999/03/02 13:49:18 peter
* renamed loadunit_int -> loadunit * renamed loadunit_int -> loadunit
Revision 1.24 1999/02/22 13:07:00 pierre Revision 1.24 1999/02/22 13:07:00 pierre

25
compiler/symdef.inc
View File

@ -1521,9 +1521,11 @@
deftype:=formaldef; deftype:=formaldef;
registerdef:=stregdef; registerdef:=stregdef;
{ formaldef must be registered at unit level !! } { formaldef must be registered at unit level !! }
if registerdef and assigned(current_module) and if registerdef and assigned(current_module) then
assigned(current_module^.globalsymtable) then if assigned(current_module^.localsymtable) then
psymtable(current_module^.globalsymtable)^.registerdef(@self); psymtable(current_module^.localsymtable)^.registerdef(@self)
else if assigned(current_module^.globalsymtable) then
psymtable(current_module^.globalsymtable)^.registerdef(@self);
savesize:=target_os.size_of_pointer; savesize:=target_os.size_of_pointer;
end; end;
@ -2103,8 +2105,14 @@
begin begin
inherited write; inherited write;
writedefref(retdef); writedefref(retdef);
{$ifdef Double_checksum}
current_ppu^.do_interface_crc:=false;
{$endif def Double_checksum}
writebyte(fpu_used); writebyte(fpu_used);
writelong(options); writelong(options);
{$ifdef Double_checksum}
current_ppu^.do_interface_crc:=true;
{$endif def Double_checksum}
hp:=para1; hp:=para1;
count:=0; count:=0;
while assigned(hp) do while assigned(hp) do
@ -2453,6 +2461,9 @@ Const local_symtable_index : longint = $8001;
procedure tprocdef.write; procedure tprocdef.write;
begin begin
inherited write; inherited write;
{$ifdef Double_checksum}
current_ppu^.do_interface_crc:=false;
{$endif def Double_checksum}
{$ifdef i386} {$ifdef i386}
writebyte(usedregisters); writebyte(usedregisters);
{$endif i386} {$endif i386}
@ -2465,6 +2476,9 @@ Const local_symtable_index : longint = $8001;
{$endif alpha} {$endif alpha}
writestring(mangledname); writestring(mangledname);
writelong(extnumber); writelong(extnumber);
{$ifdef Double_checksum}
current_ppu^.do_interface_crc:=true;
{$endif def Double_checksum}
if (options and pooperator) = 0 then if (options and pooperator) = 0 then
writedefref(nextoverloaded) writedefref(nextoverloaded)
else else
@ -3409,7 +3423,10 @@ Const local_symtable_index : longint = $8001;
{ {
$Log$ $Log$
Revision 1.98 1999-03-06 17:24:16 peter Revision 1.99 1999-04-07 15:39:32 pierre
+ double_checksum code added
Revision 1.98 1999/03/06 17:24:16 peter
* reset savesize in tdef.init * reset savesize in tdef.init
Revision 1.97 1999/03/01 13:45:04 pierre Revision 1.97 1999/03/01 13:45:04 pierre

66
compiler/symppu.inc
View File

@ -167,19 +167,32 @@
hp:=pused_unit(current_module^.used_units.first); hp:=pused_unit(current_module^.used_units.first);
while assigned(hp) do while assigned(hp) do
begin begin
{$ifdef Double_checksum}
current_ppu^.do_interface_crc:=hp^.in_interface;
{$endif Double_checksum}
current_ppu^.putstring(hp^.name^); current_ppu^.putstring(hp^.name^);
{ the checksum should not affect the crc of this unit ! (PFV) }
current_ppu^.do_crc:=false; current_ppu^.do_crc:=false;
{$ifndef Double_checksum}
{ the checksum should not affect the crc of this unit ! (PFV) }
current_ppu^.putlongint(hp^.checksum); current_ppu^.putlongint(hp^.checksum);
{$else Double_checksum}
if hp^.in_interface then
current_ppu^.putlongint(hp^.checksum)
else
current_ppu^.putlongint(hp^.interface_checksum);
{$endif def Double_checksum}
current_ppu^.do_crc:=true; current_ppu^.do_crc:=true;
current_ppu^.putbyte(byte(hp^.in_interface)); current_ppu^.putbyte(byte(hp^.in_interface));
hp:=pused_unit(hp^.next); hp:=pused_unit(hp^.next);
end; end;
{$ifdef Double_checksum}
current_ppu^.do_interface_crc:=true;
{$endif Double_checksum}
current_ppu^.writeentry(ibloadunit); current_ppu^.writeentry(ibloadunit);
end; end;
procedure writeunitas(const s : string;unittable : punitsymtable); procedure writeunitas(const s : string;unittable : punitsymtable;only_crc : boolean);
begin begin
Message1(unit_u_ppu_write,s); Message1(unit_u_ppu_write,s);
@ -207,11 +220,33 @@
flags:=flags or uf_local_browser; flags:=flags or uf_local_browser;
end; end;
{$ifdef Test_Double_checksum_write}
If only_crc then
Assign(CRCFile,s+'.INT')
else
Assign(CRCFile,s+'.IMP');
Rewrite(CRCFile);
{$endif def Test_Double_checksum_write}
{ open ppufile } { open ppufile }
current_ppu:=new(pppufile,init(s)); current_ppu:=new(pppufile,init(s));
if not current_ppu^.create then if not current_ppu^.create then
Message(unit_f_ppu_cannot_write); Message(unit_f_ppu_cannot_write);
{$ifdef Double_checksum}
current_ppu^.crc_only:=only_crc;
{$ifdef Test_Double_checksum}
if only_crc then
begin
new(current_ppu^.crc_test);
end
else
begin
current_ppu^.crc_test:=Current_Module^.crc_array;
current_ppu^.crc_index:=Current_Module^.crc_size;
end;
{$endif def Test_Double_checksum}
{$endif Double_checksum}
current_ppu^.change_endian:=source_os.endian<>target_os.endian; current_ppu^.change_endian:=source_os.endian<>target_os.endian;
{ write symbols and definitions } { write symbols and definitions }
unittable^.writeasunit; unittable^.writeasunit;
@ -221,6 +256,9 @@
{ create and write header } { create and write header }
current_ppu^.header.size:=current_ppu^.size; current_ppu^.header.size:=current_ppu^.size;
current_ppu^.header.checksum:=current_ppu^.crc; current_ppu^.header.checksum:=current_ppu^.crc;
{$ifdef Double_checksum}
current_module^.interface_crc:=current_ppu^.interface_crc;
{$endif def Double_checksum}
current_ppu^.header.compiler:=wordversion; current_ppu^.header.compiler:=wordversion;
current_ppu^.header.cpu:=word(target_cpu); current_ppu^.header.cpu:=word(target_cpu);
current_ppu^.header.target:=word(target_info.target); current_ppu^.header.target:=word(target_info.target);
@ -228,10 +266,29 @@
current_ppu^.writeheader; current_ppu^.writeheader;
{ save crc in current_module also } { save crc in current_module also }
current_module^.crc:=current_ppu^.crc; current_module^.crc:=current_ppu^.crc;
{$ifdef Double_checksum}
current_module^.interface_crc:=current_ppu^.interface_crc;
if only_crc then
begin
{$ifdef Test_Double_checksum}
Current_Module^.crc_array:=current_ppu^.crc_test;
current_ppu^.crc_test:=nil;
Current_Module^.crc_size:=current_ppu^.crc_index;
{$endif def Test_Double_checksum}
closecurrentppu;
end;
{$ifdef Test_Double_checksum_write}
close(CRCFile);
{$endif Test_Double_checksum_write}
{$endif def Double_checksum}
end; end;
procedure closecurrentppu; procedure closecurrentppu;
begin begin
{$ifdef Test_Double_checksum}
if assigned(current_ppu^.crc_test) then
dispose(current_ppu^.crc_test);
{$endif Test_Double_checksum}
{ close } { close }
current_ppu^.close; current_ppu^.close;
dispose(current_ppu,done); dispose(current_ppu,done);
@ -451,7 +508,10 @@
{ {
$Log$ $Log$
Revision 1.34 1999-03-02 13:49:19 peter Revision 1.35 1999-04-07 15:39:35 pierre
+ double_checksum code added
Revision 1.34 1999/03/02 13:49:19 peter
* renamed loadunit_int -> loadunit * renamed loadunit_int -> loadunit
Revision 1.33 1999/02/23 18:29:25 pierre Revision 1.33 1999/02/23 18:29:25 pierre