* release storenumber,double_checksum

This commit is contained in:
peter 1999-04-26 13:31:24 +00:00
parent 9a98038489
commit 884c517b18
20 changed files with 293 additions and 298 deletions

View File

@ -51,7 +51,7 @@ RTL=../rtl
override LOCALOPT+=-Sg override LOCALOPT+=-Sg
# set correct defines (-d$(CPU) is automaticly added in makefile.fpc) # set correct defines (-d$(CPU) is automaticly added in makefile.fpc)
override LOCALDEF+=-dGDB override LOCALDEF+=-dGDB -dBROWSERLOG
override LOCALOPT+=$(LOCALDEF) override LOCALOPT+=$(LOCALDEF)
@ -383,7 +383,10 @@ $(M68KEXENAME): $(PASFILES) $(INCFILES)
# #
# $Log$ # $Log$
# Revision 1.26 1999-04-09 10:14:19 peter # Revision 1.27 1999-04-26 13:31:24 peter
# * release storenumber,double_checksum
#
# Revision 1.26 1999/04/09 10:14:19 peter
# * renamed language -> fpclang # * renamed language -> fpclang
# #
# Revision 1.25 1999/04/07 15:26:50 pierre # Revision 1.25 1999/04/07 15:26:50 pierre

View File

@ -710,7 +710,7 @@ do_jmp:
{ what a hack ! } { what a hack ! }
if assigned(p^.exceptsymtable) then if assigned(p^.exceptsymtable) then
{$ifdef STORENUMBER} {$ifndef OLDPPU}
pvarsym(p^.exceptsymtable^.symindex^.first)^.address:=ref.offset; pvarsym(p^.exceptsymtable^.symindex^.first)^.address:=ref.offset;
{$else} {$else}
pvarsym(p^.exceptsymtable^.searchroot)^.address:=ref.offset; pvarsym(p^.exceptsymtable^.searchroot)^.address:=ref.offset;
@ -802,7 +802,10 @@ do_jmp:
end. end.
{ {
$Log$ $Log$
Revision 1.33 1999-04-21 09:43:29 peter Revision 1.34 1999-04-26 13:31:25 peter
* release storenumber,double_checksum
Revision 1.33 1999/04/21 09:43:29 peter
* storenumber works * storenumber works
* fixed some typos in double_checksum * fixed some typos in double_checksum
+ incompatible types type1 and type2 message (with storenumber) + incompatible types type1 and type2 message (with storenumber)

View File

@ -125,13 +125,11 @@ 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,
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 }
do_reload, { force reloading of the unit }
do_assemble, { only assemble the object, don't recompile } do_assemble, { only assemble the object, don't recompile }
do_compile, { need to compile the sources } do_compile, { need to compile the sources }
sources_avail, { if all sources are reachable } sources_avail, { if all sources are reachable }
@ -179,7 +177,6 @@ unit files;
crc_array : pointer; crc_array : pointer;
crc_size : longint; crc_size : longint;
{$endif def Test_Double_checksum} {$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;
procedure reset; procedure reset;
@ -192,10 +189,8 @@ unit files;
tused_unit = object(tlinkedlist_item) tused_unit = object(tlinkedlist_item)
unitid : word; unitid : word;
name : pstring; name : pstring;
checksum : longint; checksum,
{$ifdef Double_checksum}
interface_checksum : longint; interface_checksum : longint;
{$endif def Double_checksum}
loaded : boolean; loaded : boolean;
in_uses, in_uses,
in_interface, in_interface,
@ -226,9 +221,6 @@ unit files;
implementation implementation
uses uses
{$ifdef Double_checksum}
comphook,
{$endif Double_checksum}
dos,verbose,systems, dos,verbose,systems,
symtable,scanner; symtable,scanner;
@ -756,14 +748,14 @@ 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} {$ifndef OLDPPU}
interface_crc:=ppufile^.header.interface_checksum; interface_crc:=ppufile^.header.interface_checksum;
{$endif def Double_checksum} {$endif}
{ 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));
Message1(unit_u_ppu_crc,tostr(ppufile^.header.checksum)); Message1(unit_u_ppu_crc,tostr(ppufile^.header.checksum));
{$ifdef Double_checksum} {$ifndef OLDPPU}
Message1(unit_u_ppu_crc,tostr(ppufile^.header.interface_checksum)+' (intfc)'); Message1(unit_u_ppu_crc,tostr(ppufile^.header.interface_checksum)+' (intfc)');
{$endif} {$endif}
{ check the object and assembler file to see if we need only to { check the object and assembler file to see if we need only to
@ -938,12 +930,10 @@ uses
procedure tmodule.reset; procedure tmodule.reset;
{$ifndef OLDPPU}
{$ifdef Double_checksum}
var var
pm : pdependent_unit; pm : pdependent_unit;
{$endif} {$endif}
begin begin
if assigned(scanner) then if assigned(scanner) then
pscannerfile(scanner)^.invalid:=true; pscannerfile(scanner)^.invalid:=true;
@ -976,23 +966,20 @@ uses
used_units.done; used_units.done;
used_units.init; used_units.init;
{ all units that depend on this one must be recompiled ! } { all units that depend on this one must be recompiled ! }
{$ifdef Double_checksum} {$ifndef OLDPPU}
pm:=pdependent_unit(dependent_units.first); pm:=pdependent_unit(dependent_units.first);
while assigned(pm) do while assigned(pm) do
begin begin
if pm^.u^.in_second_compile then if pm^.u^.in_second_compile then
begin Comment(v_debug,'No reload already in second compile: '+pm^.u^.modulename^)
writeln('No reload already in second compile: ',pm^.u^.modulename^);
end
else else
begin begin
pm^.u^.do_reload_ppu:=true; pm^.u^.do_reload:=true;
def_comment(v_warning,'Reloading '+pm^.u^.modulename^+' needed because '+ Comment(v_debug,'Reloading '+pm^.u^.modulename^+' needed because '+modulename^+' is reloaded');
modulename^+' is reloaded');
end; end;
pm:=pdependent_unit(pm^.next); pm:=pdependent_unit(pm^.next);
end; end;
{$endif Double_checksum} {$endif OLDPPU}
dependent_units.done; dependent_units.done;
dependent_units.init; dependent_units.init;
resourcefiles.done; resourcefiles.done;
@ -1016,9 +1003,7 @@ uses
loaded_from:=nil; loaded_from:=nil;
flags:=0; flags:=0;
crc:=0; crc:=0;
{$ifdef Double_checksum}
interface_crc:=0; interface_crc:=0;
{$endif def Double_checksum}
unitcount:=1; unitcount:=1;
end; end;
@ -1082,10 +1067,8 @@ uses
loaded_from:=nil; loaded_from:=nil;
flags:=0; flags:=0;
crc:=0; crc:=0;
{$ifdef Double_checksum} interface_crc:=0;
interface_crc:=0; do_reload:=false;
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;
@ -1170,9 +1153,7 @@ 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; interface_checksum:=_u^.interface_crc;
{$endif def Double_checksum}
unitid:=0; unitid:=0;
end; end;
@ -1186,9 +1167,7 @@ uses
loaded:=false; loaded:=false;
name:=stringdup(n); name:=stringdup(n);
checksum:=c; checksum:=c;
{$ifdef Double_checksum}
interface_checksum:=intfc; interface_checksum:=intfc;
{$endif def Double_checksum}
unitid:=0; unitid:=0;
end; end;
@ -1199,6 +1178,7 @@ uses
inherited done; inherited done;
end; end;
{**************************************************************************** {****************************************************************************
TDENPENDENT_UNIT TDENPENDENT_UNIT
****************************************************************************} ****************************************************************************}
@ -1211,7 +1191,10 @@ uses
end. end.
{ {
$Log$ $Log$
Revision 1.92 1999-04-25 15:08:36 peter Revision 1.93 1999-04-26 13:31:29 peter
* release storenumber,double_checksum
Revision 1.92 1999/04/25 15:08:36 peter
* small fixes for double_checksum * small fixes for double_checksum
Revision 1.91 1999/04/21 09:43:36 peter Revision 1.91 1999/04/21 09:43:36 peter

View File

@ -1061,11 +1061,11 @@ unit globals;
end; end;
procedure abstract; procedure abstract;
begin begin
runerror(255); runerror(255);
end; end;
{**************************************************************************** {****************************************************************************
Init Init
****************************************************************************} ****************************************************************************}
@ -1113,17 +1113,11 @@ unit globals;
usewindowapi:=false; usewindowapi:=false;
description:='Compiled by FPC '+version_string+' - '+target_cpu_string; description:='Compiled by FPC '+version_string+' - '+target_cpu_string;
{$ifdef BrowserCol} { Init values }
{$define BrowserDefault}
{$endif BrowserCol}
{$ifdef BrowserLog}
{$define BrowserDefault}
{$endif BrowserLog}
{ Init values }
{$ifdef i386} {$ifdef i386}
initoptprocessor:=Class386; initoptprocessor:=Class386;
initlocalswitches:=[]; initlocalswitches:=[];
initmoduleswitches:=[cs_extsyntax{$ifdef BrowserDefault},cs_browser{$endif}]; initmoduleswitches:=[cs_extsyntax{$ifndef OLDPPU},cs_browser{$endif}];
initglobalswitches:=[cs_check_unit_name]; initglobalswitches:=[cs_check_unit_name];
initmodeswitches:=fpcmodeswitches; initmodeswitches:=fpcmodeswitches;
initpackenum:=4; initpackenum:=4;
@ -1135,7 +1129,7 @@ unit globals;
{$ifdef m68k} {$ifdef m68k}
initoptprocessor:=MC68000; initoptprocessor:=MC68000;
initlocalswitches:=[]; initlocalswitches:=[];
initmoduleswitches:=[cs_extsyntax{$ifdef BrowserDefault},cs_browser{$endif},cs_fp_emulation]; initmoduleswitches:=[cs_extsyntax{$ifndef OLDPPU},cs_browser{$endif},cs_fp_emulation];
initglobalswitches:=[cs_check_unit_name]; initglobalswitches:=[cs_check_unit_name];
initmodeswitches:=fpcmodeswitches; initmodeswitches:=fpcmodeswitches;
initpackenum:=4; initpackenum:=4;
@ -1165,7 +1159,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.3 1999-04-21 14:12:55 peter Revision 1.4 1999-04-26 13:31:32 peter
* release storenumber,double_checksum
Revision 1.3 1999/04/21 14:12:55 peter
* default asm changed to att * default asm changed to att
Revision 1.2 1999/04/16 09:56:05 pierre Revision 1.2 1999/04/16 09:56:05 pierre

View File

@ -45,7 +45,7 @@ interface
{ support } { support }
cs_support_inline,cs_support_goto,cs_support_macro, cs_support_inline,cs_support_goto,cs_support_macro,
cs_support_c_operators,cs_static_keyword, cs_support_c_operators,cs_static_keyword,
cs_typed_const_not_changeable, cs_typed_const_not_changeable,
{ generation } { generation }
cs_profile,cs_debuginfo,cs_browser,cs_local_browser,cs_compilesystem, cs_profile,cs_debuginfo,cs_browser,cs_local_browser,cs_compilesystem,
{ linking } { linking }
@ -64,6 +64,8 @@ interface
{ optimizer } { optimizer }
cs_regalloc,cs_uncertainopts,cs_littlesize,cs_optimize, cs_regalloc,cs_uncertainopts,cs_littlesize,cs_optimize,
cs_fastoptimize, cs_slowoptimize, cs_fastoptimize, cs_slowoptimize,
{ browser }
cs_browser_log,
{ debugger } { debugger }
cs_gdb_dbx,cs_gdb_gsym,cs_gdb_heaptrc, cs_gdb_dbx,cs_gdb_gsym,cs_gdb_heaptrc,
{ assembling } { assembling }
@ -110,7 +112,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.7 1999-04-25 22:34:58 pierre Revision 1.8 1999-04-26 13:31:33 peter
* release storenumber,double_checksum
Revision 1.7 1999/04/25 22:34:58 pierre
+ cs_typed_const_not_changeable added but not implemented yet ! + cs_typed_const_not_changeable added but not implemented yet !
Revision 1.6 1999/04/16 11:49:42 peter Revision 1.6 1999/04/16 11:49:42 peter

View File

@ -93,7 +93,7 @@ implementation
dispose(p); dispose(p);
end; end;
procedure insertmsgstr(p : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef FPC}far;{$endif FPC} procedure insertmsgstr(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef FPC}far;{$endif FPC}
var var
hp : pprocdef; hp : pprocdef;
@ -141,7 +141,7 @@ implementation
end; end;
end; end;
procedure insertmsgint(p : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef FPC}far;{$endif FPC} procedure insertmsgint(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef FPC}far;{$endif FPC}
var var
hp : pprocdef; hp : pprocdef;
@ -288,7 +288,7 @@ implementation
_c : pobjectdef; _c : pobjectdef;
has_constructor,has_virtual_method : boolean; has_constructor,has_virtual_method : boolean;
procedure eachsym(sym : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef FPC}far;{$endif FPC} procedure eachsym(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef FPC}far;{$endif FPC}
var var
procdefcoll : pprocdefcoll; procdefcoll : pprocdefcoll;
@ -566,7 +566,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.2 1999-04-21 09:43:37 peter Revision 1.3 1999-04-26 13:31:34 peter
* release storenumber,double_checksum
Revision 1.2 1999/04/21 09:43:37 peter
* storenumber works * storenumber works
* fixed some typos in double_checksum * fixed some typos in double_checksum
+ incompatible types type1 and type2 message (with storenumber) + incompatible types type1 and type2 message (with storenumber)

View File

@ -420,7 +420,8 @@ unit parser;
{$ifdef BrowserLog} {$ifdef BrowserLog}
{ Write Browser Log } { Write Browser Log }
if cs_browser in aktmoduleswitches then if (cs_browser_log in aktglobalswitches) and
(cs_browser in aktmoduleswitches) then
begin begin
if browserlog.elements_to_list^.empty then if browserlog.elements_to_list^.empty then
begin begin
@ -459,7 +460,10 @@ unit parser;
end. end.
{ {
$Log$ $Log$
Revision 1.71 1999-03-26 00:05:33 peter Revision 1.72 1999-04-26 13:31:36 peter
* release storenumber,double_checksum
Revision 1.71 1999/03/26 00:05:33 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

View File

@ -80,7 +80,7 @@ unit pdecl;
function read_type(const name : stringid) : pdef;forward; function read_type(const name : stringid) : pdef;forward;
{ search in symtablestack used, but not defined type } { search in symtablestack used, but not defined type }
procedure testforward_type(p : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef FPC}far;{$endif} procedure testforward_type(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef FPC}far;{$endif}
var var
reaktvarsymtable : psymtable; reaktvarsymtable : psymtable;
oldaktfilepos : tfileposinfo; oldaktfilepos : tfileposinfo;
@ -1620,7 +1620,7 @@ unit pdecl;
genvmt(aktclass); genvmt(aktclass);
end; end;
{$ifndef STORENUMBER} {$ifdef OLDPPU}
{ number symbols and defs } { number symbols and defs }
symtablestack^.number_defs; symtablestack^.number_defs;
symtablestack^.number_symbols; symtablestack^.number_symbols;
@ -1660,7 +1660,7 @@ unit pdecl;
consume(_END); consume(_END);
typecanbeforward:=storetypeforwardsallowed; typecanbeforward:=storetypeforwardsallowed;
{$ifndef STORENUMBER} {$ifdef OLDPPU}
{ number symbols and defs } { number symbols and defs }
symtablestack^.number_defs; symtablestack^.number_defs;
symtablestack^.number_symbols; symtablestack^.number_symbols;
@ -2096,7 +2096,7 @@ unit pdecl;
getsym(typename,false); getsym(typename,false);
sym:=srsym; sym:=srsym;
newtype:=nil; newtype:=nil;
{$ifdef STORENUMBER} {$ifndef OLDPPU}
{ found a symbol with this name? } { found a symbol with this name? }
if assigned(sym) then if assigned(sym) then
begin begin
@ -2258,7 +2258,10 @@ unit pdecl;
end. end.
{ {
$Log$ $Log$
Revision 1.110 1999-04-25 22:42:16 pierre Revision 1.111 1999-04-26 13:31:37 peter
* release storenumber,double_checksum
Revision 1.110 1999/04/25 22:42:16 pierre
+ code for initialized vars in Delphi mode + code for initialized vars in Delphi mode
Revision 1.109 1999/04/21 09:43:45 peter Revision 1.109 1999/04/21 09:43:45 peter

View File

@ -22,10 +22,6 @@
} }
unit pmodules; unit pmodules;
{ define TEST_IMPL does not work well }
{ replaced by $define Double_checksum}
{ other way to get correct type info, in test (PM) }
{$define New_GDB} {$define New_GDB}
interface interface
@ -326,7 +322,7 @@ unit pmodules;
{ ok, now load the unit } { ok, now load the unit }
current_module^.globalsymtable:=new(punitsymtable,loadasunit); current_module^.globalsymtable:=new(punitsymtable,loadasunit);
{ if this is the system unit insert the intern symbols } { if this is the system unit insert the intern symbols }
{$ifndef STORENUMBER} {$ifdef OLDPPU}
if compile_system then if compile_system then
begin begin
make_ref:=false; make_ref:=false;
@ -348,7 +344,7 @@ 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 Double_checksum} {$ifndef OLDPPU}
{ 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
{ if (loaded_unit^.interface_crc<>pu^.interface_checksum) then } { if (loaded_unit^.interface_crc<>pu^.interface_checksum) then }
@ -359,7 +355,7 @@ unit pmodules;
current_module^.map:=nil; current_module^.map:=nil;
exit; exit;
end; end;
{$endif def Double_checksum} {$endif OLDPPU}
{ 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;
@ -459,8 +455,9 @@ unit pmodules;
begin begin
if hp^.modulename^=s then if hp^.modulename^=s then
begin begin
{$ifdef Double_checksum} {$ifndef OLDPPU}
if hp^.do_reload_ppu then { forced to reload ? }
if hp^.do_reload then
break; break;
{$endif} {$endif}
{ the unit is already registered } { the unit is already registered }
@ -501,18 +498,18 @@ unit pmodules;
loaded_units.remove(hp); loaded_units.remove(hp);
scanner:=hp^.scanner; scanner:=hp^.scanner;
hp^.reset; hp^.reset;
{$ifdef Double_checksum} {$ifndef OLDPPU}
hp2:=pmodule(loaded_units.first); hp2:=pmodule(loaded_units.first);
while assigned(hp2) do while assigned(hp2) do
begin begin
if hp2^.do_reload_ppu then if hp2^.do_reload then
begin begin
hp2^.do_reload_ppu:=false; hp2^.do_reload:=false;
loadunit(hp^.modulename^,false); loadunit(hp^.modulename^,false);
end; end;
hp2:=pmodule(hp2^.next); hp2:=pmodule(hp2^.next);
end; end;
{$endif Double_checksum} {$endif}
hp^.scanner:=scanner; hp^.scanner:=scanner;
{ try to reopen ppu } { try to reopen ppu }
hp^.search_unit(s,false); hp^.search_unit(s,false);
@ -777,23 +774,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} {$ifndef OLDPPU}
var var
stt : psymtable; stt : psymtable;
{$endif Double_checksum} {$endif}
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} {$ifndef OLDPPU}
{Try to insert in in static symtable ! } {Try to insert in in static symtable ! }
stt:=symtablestack; stt:=symtablestack;
symtablestack:=st; symtablestack:=st;
{$endif Double_checksum} {$endif}
aktprocsym^.definition:=new(Pprocdef,init); aktprocsym^.definition:=new(Pprocdef,init);
{$ifdef Double_checksum} {$ifndef OLDPPU}
symtablestack:=stt; symtablestack:=stt;
{$endif Double_checksum} {$endif}
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;
@ -837,9 +834,9 @@ unit pmodules;
{$ifdef GDB} {$ifdef GDB}
pu : pused_unit; pu : pused_unit;
{$endif GDB} {$endif GDB}
{$ifdef Double_checksum} {$ifdef Test_Double_checksum}
store_crc : longint; store_crc : longint;
{$endif def Double_checksum} {$endif}
s1,s2 : ^string; {Saves stack space} s1,s2 : ^string; {Saves stack space}
begin begin
consume(_UNIT); consume(_UNIT);
@ -980,12 +977,12 @@ unit pmodules;
write_gdb_info; write_gdb_info;
{$endIf Def New_GDB} {$endIf Def New_GDB}
{$ifdef Double_CheckSum} {$ifndef OLDPPU}
{$ifdef Test_Double_checksum} {$ifdef Test_Double_checksum}
if (Errorcount=0) then if (Errorcount=0) then
writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack),true); writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack),true);
{$endif Test_Double_checksum} {$endif Test_Double_checksum}
{$endif Double_CheckSum} {$endif OLDPPU}
{ Parse the implementation section } { Parse the implementation section }
consume(_IMPLEMENTATION); consume(_IMPLEMENTATION);
@ -1002,7 +999,7 @@ unit pmodules;
{ to reinsert it after loading the implementation units } { to reinsert it after loading the implementation units }
symtablestack:=unitst^.next; symtablestack:=unitst^.next;
{$ifndef STORENUMBER} {$ifdef OLDPPU}
{ number the definitions, so a deref from other units works } { number the definitions, so a deref from other units works }
refsymtable^.number_defs; refsymtable^.number_defs;
refsymtable^.number_symbols; refsymtable^.number_symbols;
@ -1020,11 +1017,8 @@ unit pmodules;
end; end;
{ reset ranges/stabs in exported definitions } { reset ranges/stabs in exported definitions }
{ If I find who removed this line !!!!!!!
I AM TIRED OF THIS !!!!!!!!!!!
DONT TOUCH WITHOUT ASKING ME Pierre Muller }
reset_global_defs; reset_global_defs;
{ All units are read, now give them a number } { All units are read, now give them a number }
numberunits; numberunits;
@ -1124,7 +1118,6 @@ unit pmodules;
end; end;
{$endif GDB} {$endif GDB}
reset_global_defs; reset_global_defs;
{ tests, if all (interface) forwards are resolved } { tests, if all (interface) forwards are resolved }
@ -1158,19 +1151,21 @@ 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} {$ifndef OLDPPU}
{$ifdef Test_Double_checksum}
store_crc:=current_module^.interface_crc; store_crc:=current_module^.interface_crc;
{$endif def Double_checksum} {$endif Test_Double_checksum}
{$endif}
if (Errorcount=0) then if (Errorcount=0) then
writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack),false); writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack),false);
{$ifdef Double_checksum} {$ifndef OLDPPU}
{$ifdef Test_Double_checksum} {$ifdef Test_Double_checksum}
if store_crc<>current_module^.interface_crc then if store_crc<>current_module^.interface_crc then
Def_comment(V_Warning,current_module^.ppufilename^+' CRC changed '+ Def_comment(V_Warning,current_module^.ppufilename^+' CRC changed '+
tostr(store_crc)+'<>'+tostr(current_module^.interface_crc)); tostr(store_crc)+'<>'+tostr(current_module^.interface_crc));
{$endif def TestDouble_checksum} {$endif def Test_Double_checksum}
{$endif def Double_checksum} {$endif OLDPPU}
{ must be done only after local symtable ref stores !! } { must be done only after local symtable ref stores !! }
closecurrentppu; closecurrentppu;
{$ifdef GDB} {$ifdef GDB}
@ -1362,7 +1357,10 @@ unit pmodules;
end. end.
{ {
$Log$ $Log$
Revision 1.113 1999-04-25 17:32:14 peter Revision 1.114 1999-04-26 13:31:39 peter
* release storenumber,double_checksum
Revision 1.113 1999/04/25 17:32:14 peter
* fixed double_checksum * fixed double_checksum
Revision 1.112 1999/04/25 15:08:38 peter Revision 1.112 1999/04/25 15:08:38 peter

View File

@ -37,11 +37,11 @@ type
{$endif Test_Double_checksum} {$endif Test_Double_checksum}
const const
{$ifndef Double_checksum} {$ifdef OLDPPU}
CurrentPPUVersion=15; CurrentPPUVersion=15;
{$else Double_checksum} {$else}
CurrentPPUVersion=16; CurrentPPUVersion=16;
{$endif def Double_checksum} {$endif}
{ buffer sizes } { buffer sizes }
maxentrysize = 1024; maxentrysize = 1024;
@ -93,24 +93,24 @@ const
ibfuncretsym = 31; ibfuncretsym = 31;
ibsyssym = 32; ibsyssym = 32;
{definitions} {definitions}
iborddef = 40; iborddef = 40;
ibpointerdef = 41; ibpointerdef = 41;
ibarraydef = 42; ibarraydef = 42;
ibprocdef = 43; ibprocdef = 43;
ibstringdef = 44; ibshortstringdef = 44;
ibrecorddef = 45; ibrecorddef = 45;
ibfiledef = 46; ibfiledef = 46;
ibformaldef = 47; ibformaldef = 47;
ibobjectdef = 48; ibobjectdef = 48;
ibenumdef = 49; ibenumdef = 49;
ibsetdef = 50; ibsetdef = 50;
ibprocvardef = 51; ibprocvardef = 51;
ibfloatdef = 52; ibfloatdef = 52;
ibclassrefdef = 53; ibclassrefdef = 53;
iblongstringdef = 54; iblongstringdef = 54;
ibansistringdef = 55; ibansistringdef = 55;
ibwidestringdef = 56; ibwidestringdef = 56;
ibfarpointerdef = 57; ibfarpointerdef = 57;
{ unit flags } { unit flags }
uf_init = $1; uf_init = $1;
@ -143,10 +143,10 @@ 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} {$ifndef OLDPPU}
interface_checksum : longint; interface_checksum : longint;
future : array[0..2] of longint; future : array[0..2] of longint;
{$endif def Double_checksum} {$endif}
end; end;
tppuentry=packed record tppuentry=packed record
@ -165,7 +165,6 @@ type
header : tppuheader; header : tppuheader;
size,crc : longint; size,crc : longint;
{$ifdef Double_checksum}
{$ifdef Test_Double_checksum} {$ifdef Test_Double_checksum}
crcindex : longint; crcindex : longint;
crc_index : longint; crc_index : longint;
@ -173,10 +172,7 @@ type
{$endif def Test_Double_checksum} {$endif def Test_Double_checksum}
interface_crc : longint; interface_crc : longint;
do_interface_crc : boolean; do_interface_crc : boolean;
{ used to calculate interface_crc crc_only : boolean; { used to calculate interface_crc before implementation }
before implementation }
crc_only : boolean;
{$endif def Double_checksum}
do_crc, do_crc,
change_endian : boolean; change_endian : boolean;
@ -232,8 +228,9 @@ implementation
{$ifdef Test_Double_checksum} {$ifdef Test_Double_checksum}
uses uses
comphook; comphook;
{$endif def Test_Double_checksum} {$endif def Test_Double_checksum}
{***************************************************************************** {*****************************************************************************
Crc 32 Crc 32
*****************************************************************************} *****************************************************************************}
@ -317,9 +314,7 @@ constructor tppufile.init(fn:string);
begin begin
fname:=fn; fname:=fn;
change_endian:=false; change_endian:=false;
{$ifdef Double_checksum}
crc_only:=false; crc_only:=false;
{$endif Double_checksum}
Mode:=0; Mode:=0;
NewHeader; NewHeader;
Error:=false; Error:=false;
@ -386,11 +381,11 @@ begin
Id[3]:='U'; Id[3]:='U';
Ver[1]:='0'; Ver[1]:='0';
Ver[2]:='1'; Ver[2]:='1';
{$ifndef Double_checksum} {$ifdef OLDPPU}
Ver[3]:='5'; Ver[3]:='5';
{$else Double_checksum} {$else}
Ver[3]:='6'; Ver[3]:='6';
{$endif def Double_checksum} {$endif}
end; end;
end; end;
@ -683,10 +678,8 @@ begin
bufidx:=0; bufidx:=0;
{reset} {reset}
crc:=$ffffffff; crc:=$ffffffff;
{$ifdef Double_checksum}
interface_crc:=$ffffffff; interface_crc:=$ffffffff;
do_interface_crc:=true; do_interface_crc:=true;
{$endif def Double_checksum}
Error:=false; Error:=false;
do_crc:=true; do_crc:=true;
size:=0; size:=0;
@ -800,7 +793,7 @@ begin
if do_crc then if do_crc then
begin begin
crc:=UpdateCrc32(crc,b,len); crc:=UpdateCrc32(crc,b,len);
{$ifdef Double_checksum} {$ifndef OLDPPU}
if do_interface_crc then if do_interface_crc then
begin begin
interface_crc:=UpdateCrc32(interface_crc,b,len); interface_crc:=UpdateCrc32(interface_crc,b,len);
@ -828,9 +821,9 @@ begin
end; end;
end; end;
if not crc_only then if not crc_only then
{$else not def Double_checksum} {$else}
end; end;
{$endif def Double_checksum} {$endif OLDPPU}
writedata(b,len); writedata(b,len);
inc(entryidx,len); inc(entryidx,len);
end; end;
@ -876,7 +869,10 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.28 1999-04-26 09:33:07 peter Revision 1.29 1999-04-26 13:31:41 peter
* release storenumber,double_checksum
Revision 1.28 1999/04/26 09:33:07 peter
* header extended to 40 bytes so there is room for future * header extended to 40 bytes so there is room for future
Revision 1.27 1999/04/17 13:16:20 peter Revision 1.27 1999/04/17 13:16:20 peter

View File

@ -373,7 +373,7 @@ unit pstatmnt;
objectdef : begin objectdef : begin
obj:=pobjectdef(p^.resulttype); obj:=pobjectdef(p^.resulttype);
withsymtable:=new(pwithsymtable,init); withsymtable:=new(pwithsymtable,init);
{$ifdef STORENUMBER} {$ifndef OLDPPU}
withsymtable^.symsearch:=obj^.publicsyms^.symsearch; withsymtable^.symsearch:=obj^.publicsyms^.symsearch;
{$else} {$else}
withsymtable^.searchroot:=obj^.publicsyms^.searchroot; withsymtable^.searchroot:=obj^.publicsyms^.searchroot;
@ -393,7 +393,7 @@ unit pstatmnt;
begin begin
symtab^.next:=new(pwithsymtable,init); symtab^.next:=new(pwithsymtable,init);
symtab:=symtab^.next; symtab:=symtab^.next;
{$ifdef STORENUMBER} {$ifndef OLDPPU}
symtab^.symsearch:=obj^.publicsyms^.symsearch; symtab^.symsearch:=obj^.publicsyms^.symsearch;
{$else} {$else}
symtab^.searchroot:=obj^.publicsyms^.searchroot; symtab^.searchroot:=obj^.publicsyms^.searchroot;
@ -416,7 +416,7 @@ unit pstatmnt;
symtab:=precdef(p^.resulttype)^.symtable; symtab:=precdef(p^.resulttype)^.symtable;
levelcount:=1; levelcount:=1;
withsymtable:=new(pwithsymtable,init); withsymtable:=new(pwithsymtable,init);
{$ifdef STORENUMBER} {$ifndef OLDPPU}
withsymtable^.symsearch:=symtab^.symsearch; withsymtable^.symsearch:=symtab^.symsearch;
{$else} {$else}
withsymtable^.searchroot:=symtab^.searchroot; withsymtable^.searchroot:=symtab^.searchroot;
@ -1283,7 +1283,10 @@ unit pstatmnt;
end. end.
{ {
$Log$ $Log$
Revision 1.80 1999-04-21 09:43:48 peter Revision 1.81 1999-04-26 13:31:42 peter
* release storenumber,double_checksum
Revision 1.80 1999/04/21 09:43:48 peter
* storenumber works * storenumber works
* fixed some typos in double_checksum * fixed some typos in double_checksum
+ incompatible types type1 and type2 message (with storenumber) + incompatible types type1 and type2 message (with storenumber)

View File

@ -37,3 +37,5 @@ Changes in the syntax or semantic of FPC:
25/04/99: initialized vars supported in Delphi mode (only $J+ mode) 25/04/99: initialized vars supported in Delphi mode (only $J+ mode)
getting the address of an untyped const is now getting the address of an untyped const is now
forbidden as in BP forbidden as in BP
27/04/99 New unit format PPU016, you need to recompile all older units

View File

@ -23,13 +23,13 @@
const const
def_alignment = 4; def_alignment = 4;
{ different options } { symbol options }
sp_public = 0; sp_public = $1;
sp_forwarddef = 1; sp_private = $2;
sp_protected = 2; sp_published = $4;
sp_private = 4; sp_protected = $8;
sp_static = 8; sp_forwarddef = $10;
sp_published = 16; sp_static = $20;
{ flags for a definition } { flags for a definition }
df_needsrtti = $1; { the definitions needs rtti } df_needsrtti = $1; { the definitions needs rtti }
@ -83,21 +83,24 @@
oo_hasvmt = $200; oo_hasvmt = $200;
oo_hasmsgstr = $400; oo_hasmsgstr = $400;
oo_hasmsgint = $800; oo_hasmsgint = $800;
{ options for properties } { options for properties }
ppo_indexed = $1; ppo_indexed = $1;
ppo_defaultproperty = $2; ppo_defaultproperty = $2;
ppo_stored = $4; ppo_stored = $4;
{ options for variables } { options for variables }
vo_regable = 1; vo_regable = $1;
vo_is_C_var = 2; vo_is_C_var = $2;
vo_is_external = 4; vo_is_external = $4;
vo_is_dll_var = 8; vo_is_dll_var = $8;
{ {
$Log$ $Log$
Revision 1.4 1999-04-16 10:28:26 pierre Revision 1.5 1999-04-26 13:31:46 peter
* release storenumber,double_checksum
Revision 1.4 1999/04/16 10:28:26 pierre
+ added posavestdregs used for cdecl AND stdcall functions + added posavestdregs used for cdecl AND stdcall functions
(saves ESI EDI and EBX for i386) (saves ESI EDI and EBX for i386)

View File

@ -67,7 +67,7 @@
constructor tdef.init; constructor tdef.init;
begin begin
{$ifdef STORENUMBER} {$ifndef OLDPPU}
inherited init; inherited init;
{$else} {$else}
indexnb := 0; indexnb := 0;
@ -124,8 +124,8 @@
lastglobaldef := @self; lastglobaldef := @self;
nextglobal := nil; nextglobal := nil;
{ load } { load }
{$ifdef STORENUMBER} {$ifndef OLDPPU}
indexnr:=readlong; indexnr:=readword;
sym:=ptypesym(readsymref); sym:=ptypesym(readsymref);
{$else} {$else}
indexnb := 0; indexnb := 0;
@ -170,7 +170,7 @@
if assigned(owner) and if assigned(owner) and
(owner^.symtabletype in [recordsymtable,objectsymtable]) then (owner^.symtabletype in [recordsymtable,objectsymtable]) then
begin begin
{$ifdef STORENUMBER} {$ifndef OLDPPU}
owner^.defindex^.delete(@self); owner^.defindex^.delete(@self);
{$else} {$else}
{ no other definition { no other definition
@ -223,8 +223,8 @@
procedure tdef.write; procedure tdef.write;
begin begin
{$ifdef STORENUMBER} {$ifndef OLDPPU}
writelong(indexnr); writeword(indexnr);
writesymref(sym); writesymref(sym);
{$endif} {$endif}
{$ifdef GDB} {$ifdef GDB}
@ -582,7 +582,7 @@
else else
writelong(len); writelong(len);
case string_typ of case string_typ of
st_shortstring : current_ppu^.writeentry(ibstringdef); st_shortstring : current_ppu^.writeentry(ibshortstringdef);
st_longstring : current_ppu^.writeentry(iblongstringdef); st_longstring : current_ppu^.writeentry(iblongstringdef);
st_ansistring : current_ppu^.writeentry(ibansistringdef); st_ansistring : current_ppu^.writeentry(ibansistringdef);
st_widestring : current_ppu^.writeentry(ibwidestringdef); st_widestring : current_ppu^.writeentry(ibwidestringdef);
@ -1781,7 +1781,7 @@
var var
binittable : boolean; binittable : boolean;
procedure check_rec_inittable(s : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif}); procedure check_rec_inittable(s : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});
begin begin
if (psym(s)^.typ=varsym) and if (psym(s)^.typ=varsym) and
@ -1809,7 +1809,7 @@
procedure trecdef.deref; procedure trecdef.deref;
var var
{$ifndef STORENUMBER} {$ifdef OLDPPU}
hp : pdef; hp : pdef;
{$endif} {$endif}
oldrecsyms : psymtable; oldrecsyms : psymtable;
@ -1817,7 +1817,7 @@
oldrecsyms:=aktrecordsymtable; oldrecsyms:=aktrecordsymtable;
aktrecordsymtable:=symtable; aktrecordsymtable:=symtable;
{ now dereference the definitions } { now dereference the definitions }
{$ifdef STORENUMBER} {$ifndef OLDPPU}
symtable^.deref; symtable^.deref;
{$else} {$else}
hp:=symtable^.rootdef; hp:=symtable^.rootdef;
@ -1854,7 +1854,7 @@
StabRecSize : longint = 0; StabRecSize : longint = 0;
RecOffset : Longint = 0; RecOffset : Longint = 0;
procedure addname(p : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif}); procedure addname(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});
var var
news, newrec : pchar; news, newrec : pchar;
spec : string[2]; spec : string[2];
@ -1898,7 +1898,7 @@
function trecdef.stabstring : pchar; function trecdef.stabstring : pchar;
Var oldrec : pchar; Var oldrec : pchar;
oldsize : longint; oldsize : longint;
{$ifndef STORENUMBER} {$ifdef OLDPPU}
cur : psym; cur : psym;
{$endif} {$endif}
begin begin
@ -1908,16 +1908,16 @@
stabrecsize:=memsizeinc; stabrecsize:=memsizeinc;
strpcopy(stabRecString,'s'+tostr(savesize)); strpcopy(stabRecString,'s'+tostr(savesize));
RecOffset := 0; RecOffset := 0;
{$ifdef nonextfield} {$ifndef OLDPPU}
symtable^.foreach({$ifdef fpc}@{$endif}addname); symtable^.foreach({$ifdef fpc}@{$endif}addname);
{$else nonextfield} {$else}
cur:=symtable^.searchroot; cur:=symtable^.searchroot;
while assigned(cur) do while assigned(cur) do
begin begin
addname(cur); addname(cur);
cur:=cur^.nextsym; cur:=cur^.nextsym;
end; end;
{$endif nonextfield} {$endif}
{ FPC doesn't want to convert a char to a pchar} { FPC doesn't want to convert a char to a pchar}
{ is this a bug ? } { is this a bug ? }
strpcopy(strend(StabRecString),';'); strpcopy(strend(StabRecString),';');
@ -1939,7 +1939,7 @@
var var
count : longint; count : longint;
procedure count_inittable_fields(sym : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} procedure count_inittable_fields(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif}
begin begin
if (psym(sym)^.typ=varsym) and if (psym(sym)^.typ=varsym) and
(pvarsym(sym)^.definition^.needs_inittable) then (pvarsym(sym)^.definition^.needs_inittable) then
@ -1947,13 +1947,13 @@
end; end;
procedure count_fields(sym : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} procedure count_fields(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif}
begin begin
inc(count); inc(count);
end; end;
procedure write_field_inittable(sym : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} procedure write_field_inittable(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif}
begin begin
if (psym(sym)^.typ=varsym) and if (psym(sym)^.typ=varsym) and
pvarsym(sym)^.definition^.needs_inittable then pvarsym(sym)^.definition^.needs_inittable then
@ -1964,14 +1964,14 @@
end; end;
procedure write_field_rtti(sym : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} procedure write_field_rtti(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif}
begin begin
rttilist^.concat(new(pai_const_symbol,init(pvarsym(sym)^.definition^.get_rtti_label))); rttilist^.concat(new(pai_const_symbol,init(pvarsym(sym)^.definition^.get_rtti_label)));
rttilist^.concat(new(pai_const,init_32bit(pvarsym(sym)^.address))); rttilist^.concat(new(pai_const,init_32bit(pvarsym(sym)^.address)));
end; end;
procedure generate_child_inittable(sym:{$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} procedure generate_child_inittable(sym:{$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif}
begin begin
if (psym(sym)^.typ=varsym) and if (psym(sym)^.typ=varsym) and
pvarsym(sym)^.definition^.needs_inittable then pvarsym(sym)^.definition^.needs_inittable then
@ -1980,7 +1980,7 @@
end; end;
procedure generate_child_rtti(sym : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} procedure generate_child_rtti(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif}
begin begin
pvarsym(sym)^.definition^.get_rtti_label; pvarsym(sym)^.definition^.get_rtti_label;
end; end;
@ -2152,14 +2152,14 @@
begin begin
inherited write; inherited write;
writedefref(retdef); writedefref(retdef);
{$ifdef Double_checksum} {$ifndef OLDPPU}
current_ppu^.do_interface_crc:=false; current_ppu^.do_interface_crc:=false;
{$endif def Double_checksum} {$endif}
writebyte(fpu_used); writebyte(fpu_used);
{$ifdef OLDPPU}
current_ppu^.do_interface_crc:=true;
{$endif}
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
@ -2291,8 +2291,6 @@
s:=readstring; s:=readstring;
setstring(_mangledname,s); setstring(_mangledname,s);
extnumber:=readlong; extnumber:=readlong;
nextoverloaded:=pprocdef(readdefref); nextoverloaded:=pprocdef(readdefref);
_class := pobjectdef(readdefref); _class := pobjectdef(readdefref);
@ -2508,9 +2506,9 @@ Const local_symtable_index : longint = $8001;
procedure tprocdef.write; procedure tprocdef.write;
begin begin
inherited write; inherited write;
{$ifdef Double_checksum} {$ifndef OLDPPU}
current_ppu^.do_interface_crc:=false; current_ppu^.do_interface_crc:=false;
{$endif def Double_checksum} {$endif}
{$ifdef i386} {$ifdef i386}
writebyte(usedregisters); writebyte(usedregisters);
{$endif i386} {$endif i386}
@ -2522,10 +2520,10 @@ Const local_symtable_index : longint = $8001;
writelong(usedregisters_fpu); writelong(usedregisters_fpu);
{$endif alpha} {$endif alpha}
writestring(mangledname); writestring(mangledname);
{$ifndef OLDPPU}
current_ppu^.do_interface_crc:=true;
{$endif}
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
@ -2882,9 +2880,7 @@ Const local_symtable_index : longint = $8001;
options:=readlong; options:=readlong;
oldread_member:=read_member; oldread_member:=read_member;
read_member:=true; read_member:=true;
object_options:=true;
publicsyms:=new(psymtable,loadas(objectsymtable)); publicsyms:=new(psymtable,loadas(objectsymtable));
object_options:=false;
read_member:=oldread_member; read_member:=oldread_member;
publicsyms^.defowner:=@self; publicsyms^.defowner:=@self;
{ publicsyms^.datasize:=savesize; } { publicsyms^.datasize:=savesize; }
@ -2937,11 +2933,6 @@ Const local_symtable_index : longint = $8001;
destructor tobjectdef.done; destructor tobjectdef.done;
begin begin
{!!!!
if assigned(privatesyms) then
dispose(privatesyms,done);
if assigned(protectedsyms) then
dispose(protectedsyms,done); }
if assigned(publicsyms) then if assigned(publicsyms) then
dispose(publicsyms,done); dispose(publicsyms,done);
if (options and oo_isforward)<>0 then if (options and oo_isforward)<>0 then
@ -2982,7 +2973,7 @@ Const local_symtable_index : longint = $8001;
procedure tobjectdef.deref; procedure tobjectdef.deref;
var var
{$ifndef STORENUMBER} {$ifdef OLDPPU}
hp : pdef; hp : pdef;
{$endif} {$endif}
oldrecsyms : psymtable; oldrecsyms : psymtable;
@ -2991,7 +2982,7 @@ Const local_symtable_index : longint = $8001;
oldrecsyms:=aktrecordsymtable; oldrecsyms:=aktrecordsymtable;
aktrecordsymtable:=publicsyms; aktrecordsymtable:=publicsyms;
{$ifdef STORENUMBER} {$ifndef OLDPPU}
publicsyms^.deref; publicsyms^.deref;
{$else} {$else}
hp:=publicsyms^.rootdef; hp:=publicsyms^.rootdef;
@ -3066,15 +3057,13 @@ Const local_symtable_index : longint = $8001;
oldread_member:=read_member; oldread_member:=read_member;
read_member:=true; read_member:=true;
object_options:=true;
publicsyms^.writeas; publicsyms^.writeas;
object_options:=false;
read_member:=oldread_member; read_member:=oldread_member;
end; end;
{$ifdef GDB} {$ifdef GDB}
procedure addprocname(p :{$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif}); procedure addprocname(p :{$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});
var virtualind,argnames : string; var virtualind,argnames : string;
news, newrec : pchar; news, newrec : pchar;
pd,ipd : pprocdef; pd,ipd : pprocdef;
@ -3166,9 +3155,9 @@ Const local_symtable_index : longint = $8001;
oldrec : pchar; oldrec : pchar;
oldrecsize : longint; oldrecsize : longint;
str_end : string; str_end : string;
{$ifndef nonextfield} {$ifdef OLDPPU}
cur : psym; cur : psym;
{$endif nonextfield} {$endif}
begin begin
oldrec := stabrecstring; oldrec := stabrecstring;
oldrecsize:=stabrecsize; oldrecsize:=stabrecsize;
@ -3181,40 +3170,40 @@ Const local_symtable_index : longint = $8001;
strpcopy(strend(stabrecstring),'!1,020,'+childof^.numberstring+';'); strpcopy(strend(stabrecstring),'!1,020,'+childof^.numberstring+';');
{virtual table to implement yet} {virtual table to implement yet}
RecOffset := 0; RecOffset := 0;
{$ifdef nonextfield} {$ifndef OLDPPU}
{$ifdef tp} {$ifdef tp}
publicsyms^.foreach(addname); publicsyms^.foreach(addname);
{$else} {$else}
publicsyms^.foreach(@addname); publicsyms^.foreach(@addname);
{$endif} {$endif}
{$else nonextfield} {$else}
cur:=publicsyms^.searchroot; cur:=publicsyms^.searchroot;
while assigned(cur) do while assigned(cur) do
begin begin
addname(cur); addname(cur);
cur:=psym(cur)^.nextsym; cur:=psym(cur)^.nextsym;
end; end;
{$endif nonextfield} {$endif}
if (options and oo_hasvmt) <> 0 then if (options and oo_hasvmt) <> 0 then
if not assigned(childof) or ((childof^.options and oo_hasvmt) = 0) then if not assigned(childof) or ((childof^.options and oo_hasvmt) = 0) then
begin begin
strpcopy(strend(stabrecstring),'$vf'+numberstring+':'+typeglobalnumber('vtblarray') strpcopy(strend(stabrecstring),'$vf'+numberstring+':'+typeglobalnumber('vtblarray')
+','+tostr(vmt_offset*8)+';'); +','+tostr(vmt_offset*8)+';');
end; end;
{$ifdef nonextfield} {$ifndef OLDPPU}
{$ifdef tp} {$ifdef tp}
publicsyms^.foreach(addprocname); publicsyms^.foreach(addprocname);
{$else} {$else}
publicsyms^.foreach(@addprocname); publicsyms^.foreach(@addprocname);
{$endif tp } {$endif tp }
{$else nonextfield} {$else}
cur:=publicsyms^.searchroot; cur:=publicsyms^.searchroot;
while assigned(cur) do while assigned(cur) do
begin begin
addprocname(cur); addprocname(cur);
cur:=psym(cur)^.nextsym; cur:=psym(cur)^.nextsym;
end; end;
{$endif nonextfield} {$endif}
if (options and oo_hasvmt) <> 0 then if (options and oo_hasvmt) <> 0 then
begin begin
anc := @self; anc := @self;
@ -3273,7 +3262,7 @@ Const local_symtable_index : longint = $8001;
end; end;
procedure count_published_properties(sym:{$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif}); procedure count_published_properties(sym:{$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});
{$ifndef fpc}far;{$endif} {$ifndef fpc}far;{$endif}
begin begin
if (psym(sym)^.typ=propertysym) and ((psym(sym)^.properties and sp_published)<>0) then if (psym(sym)^.typ=propertysym) and ((psym(sym)^.properties and sp_published)<>0) then
@ -3281,7 +3270,7 @@ Const local_symtable_index : longint = $8001;
end; end;
procedure write_property_info(sym : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} procedure write_property_info(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif}
var var
proctypesinfo : byte; proctypesinfo : byte;
@ -3349,7 +3338,7 @@ Const local_symtable_index : longint = $8001;
end; end;
procedure generate_published_child_rtti(sym : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif}); procedure generate_published_child_rtti(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});
{$ifndef fpc}far;{$endif} {$ifndef fpc}far;{$endif}
begin begin
if (psym(sym)^.typ=propertysym) and if (psym(sym)^.typ=propertysym) and
@ -3476,7 +3465,10 @@ Const local_symtable_index : longint = $8001;
{ {
$Log$ $Log$
Revision 1.104 1999-04-21 09:43:50 peter Revision 1.105 1999-04-26 13:31:47 peter
* release storenumber,double_checksum
Revision 1.104 1999/04/21 09:43:50 peter
* storenumber works * storenumber works
* fixed some typos in double_checksum * fixed some typos in double_checksum
+ incompatible types type1 and type2 message (with storenumber) + incompatible types type1 and type2 message (with storenumber)

View File

@ -31,7 +31,7 @@
classrefdef,farpointerdef); classrefdef,farpointerdef);
pdef = ^tdef; pdef = ^tdef;
{$ifdef STORENUMBER} {$ifndef OLDPPU}
tdef = object(tnamedindexobject) tdef = object(tnamedindexobject)
{$else} {$else}
tdef = object tdef = object
@ -512,7 +512,10 @@
{ {
$Log$ $Log$
Revision 1.21 1999-04-21 09:43:52 peter Revision 1.22 1999-04-26 13:31:49 peter
* release storenumber,double_checksum
Revision 1.21 1999/04/21 09:43:52 peter
* storenumber works * storenumber works
* fixed some typos in double_checksum * fixed some typos in double_checksum
+ incompatible types type1 and type2 message (with storenumber) + incompatible types type1 and type2 message (with storenumber)

View File

@ -117,7 +117,7 @@
current_ppu^.putword(p^.owner^.unitid) current_ppu^.putword(p^.owner^.unitid)
else else
current_ppu^.putword(p^.owner^.unitid); current_ppu^.putword(p^.owner^.unitid);
{$ifdef STORENUMBER} {$ifndef OLDPPU}
current_ppu^.putword(p^.indexnr); current_ppu^.putword(p^.indexnr);
{$else} {$else}
current_ppu^.putword(p^.indexnb); current_ppu^.putword(p^.indexnb);
@ -140,7 +140,7 @@
current_ppu^.putword(p^.owner^.unitid) current_ppu^.putword(p^.owner^.unitid)
else else
current_ppu^.putword(p^.owner^.unitid); current_ppu^.putword(p^.owner^.unitid);
{$ifdef STORENUMBER} {$ifndef OLDPPU}
current_ppu^.putword(p^.indexnr); current_ppu^.putword(p^.indexnr);
{$else} {$else}
current_ppu^.putword(p^.indexnb); current_ppu^.putword(p^.indexnb);
@ -175,23 +175,19 @@
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; 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) } { the checksum should not affect the crc of this unit ! (PFV) }
current_ppu^.do_crc:=false; current_ppu^.do_crc:=false;
current_ppu^.putlongint(hp^.checksum); current_ppu^.putlongint(hp^.checksum);
{$ifdef Double_checksum} {$ifndef OLDPPU}
current_ppu^.putlongint(hp^.interface_checksum); current_ppu^.putlongint(hp^.interface_checksum);
{$endif def Double_checksum} {$endif}
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; current_ppu^.do_interface_crc:=true;
{$endif Double_checksum}
current_ppu^.writeentry(ibloadunit); current_ppu^.writeentry(ibloadunit);
end; end;
@ -236,7 +232,6 @@
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; current_ppu^.crc_only:=only_crc;
{$ifdef Test_Double_checksum} {$ifdef Test_Double_checksum}
if only_crc then if only_crc then
@ -249,7 +244,6 @@
current_ppu^.crc_index:=Current_Module^.crc_size; current_ppu^.crc_index:=Current_Module^.crc_size;
end; end;
{$endif def Test_Double_checksum} {$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 }
@ -260,9 +254,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} {$ifndef OLDPPU}
current_ppu^.header.interface_checksum:=current_ppu^.interface_crc; current_ppu^.header.interface_checksum:=current_ppu^.interface_crc;
{$endif def Double_checksum} {$endif}
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);
@ -270,9 +264,8 @@
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; current_module^.interface_crc:=current_ppu^.interface_crc;
if only_crc then if only_crc then
begin begin
{$ifdef Test_Double_checksum} {$ifdef Test_Double_checksum}
Current_Module^.crc_array:=current_ppu^.crc_test; Current_Module^.crc_array:=current_ppu^.crc_test;
@ -284,7 +277,6 @@
{$ifdef Test_Double_checksum_write} {$ifdef Test_Double_checksum_write}
close(CRCFile); close(CRCFile);
{$endif Test_Double_checksum_write} {$endif Test_Double_checksum_write}
{$endif def Double_checksum}
end; end;
procedure closecurrentppu; procedure closecurrentppu;
@ -480,7 +472,7 @@
begin begin
hs:=current_ppu^.getstring; hs:=current_ppu^.getstring;
checksum:=current_ppu^.getlongint; checksum:=current_ppu^.getlongint;
{$ifdef DOUBLE_CHECKSUM} {$ifndef OLDPPU}
intfchecksum:=current_ppu^.getlongint; intfchecksum:=current_ppu^.getlongint;
{$else} {$else}
intfchecksum:=0; intfchecksum:=0;
@ -518,7 +510,10 @@
{ {
$Log$ $Log$
Revision 1.37 1999-04-21 09:43:53 peter Revision 1.38 1999-04-26 13:31:51 peter
* release storenumber,double_checksum
Revision 1.37 1999/04/21 09:43:53 peter
* storenumber works * storenumber works
* fixed some typos in double_checksum * fixed some typos in double_checksum
+ incompatible types type1 and type2 message (with storenumber) + incompatible types type1 and type2 message (with storenumber)

View File

@ -26,17 +26,17 @@
constructor tsym.init(const n : string); constructor tsym.init(const n : string);
begin begin
{$ifdef STORENUMBER} {$ifndef OLDPPU}
inherited init; inherited initname(n);
{$else} {$else}
indexnb:=0;
{$endif}
left:=nil; left:=nil;
right:=nil; right:=nil;
{$ifdef nextfield}
nextsym:=nil;
{$endif nextfield}
setname(n); setname(n);
indexnb:=0;
{$ifdef nextfield}
nextsym:=nil;
{$endif nextfield}
{$endif}
typ:=abstractsym; typ:=abstractsym;
properties:=current_object_option; properties:=current_object_option;
{$ifdef GDB} {$ifdef GDB}
@ -54,22 +54,20 @@
lastref:=defref; lastref:=defref;
end; end;
constructor tsym.load;
constructor tsym.load;
begin begin
{$ifdef STORENUMBER} {$ifndef OLDPPU}
inherited init; inherited init;
indexnr:=readlong; indexnr:=readword;
{$endif} {$else}
left:=nil; left:=nil;
right:=nil; right:=nil;
{$endif}
setname(readstring); setname(readstring);
typ:=abstractsym; typ:=abstractsym;
fillchar(fileinfo,sizeof(fileinfo),0); fillchar(fileinfo,sizeof(fileinfo),0);
if object_options then properties:=symprop(readbyte);
properties:=symprop(readbyte)
else
properties:=sp_public;
lastref:=nil; lastref:=nil;
defref:=nil; defref:=nil;
lastwritten:=nil; lastwritten:=nil;
@ -163,12 +161,12 @@
begin begin
if assigned(defref) then if assigned(defref) then
dispose(defref,done); dispose(defref,done);
{$ifdef STORENUMBER} {$ifndef OLDPPU}
inherited done; inherited done;
{$else} {$else}
{$ifdef tp} {$ifdef tp}
if not(use_big) then if not(use_big) then
{$endif tp} {$endif tp}
strdispose(_name); strdispose(_name);
if assigned(left) then if assigned(left) then
dispose(left,done); dispose(left,done);
@ -180,12 +178,11 @@
procedure tsym.write; procedure tsym.write;
begin begin
{$ifdef STORENUMBER} {$ifndef OLDPPU}
writelong(indexnr); writeword(indexnr);
{$endif} {$endif}
writestring(name); writestring(name);
if object_options then writebyte(byte(properties));
writebyte(byte(properties));
end; end;
@ -194,15 +191,15 @@
end; end;
{$ifndef STORENUMBER} {$ifdef OLDPPU}
function tsym.name : string; function tsym.name : string;
{$ifdef tp} {$ifdef tp}
var var
s : string; s : string;
b : byte; b : byte;
{$endif} {$endif}
begin begin
{$ifdef tp} {$ifdef tp}
if use_big then if use_big then
begin begin
symbolstream.seek(longint(_name)); symbolstream.seek(longint(_name));
@ -212,12 +209,17 @@
name:=s; name:=s;
end end
else else
{$endif} {$endif}
if assigned(_name) then if assigned(_name) then
name:=strpas(_name) name:=strpas(_name)
else else
name:=''; name:='';
end; end;
procedure tsym.setname(const s : string);
begin
setstring(_name,s);
end;
{$endif} {$endif}
function tsym.mangledname : string; function tsym.mangledname : string;
@ -225,13 +227,6 @@
mangledname:=name; mangledname:=name;
end; end;
{$ifndef STORENUMBER}
procedure tsym.setname(const s : string);
begin
setstring(_name,s);
end;
{$endif}
{ for most symbol types there is nothing to do at all } { for most symbol types there is nothing to do at all }
procedure tsym.insert_in_data; procedure tsym.insert_in_data;
@ -262,6 +257,7 @@
end; end;
{$endif GDB} {$endif GDB}
{**************************************************************************** {****************************************************************************
TLABELSYM TLABELSYM
****************************************************************************} ****************************************************************************}
@ -1740,11 +1736,9 @@
{$ifdef GDB} {$ifdef GDB}
isusedinstab := false; isusedinstab := false;
{$endif GDB} {$endif GDB}
{$ifndef STORENUMBER}
forwardpointer:=nil; forwardpointer:=nil;
{$endif} if assigned(definition) and not(assigned(definition^.sym)) then
if assigned(definition) and not(assigned(definition^.sym)) then definition^.sym:=@self;
definition^.sym:=@self;
end; end;
constructor ttypesym.load; constructor ttypesym.load;
@ -1752,9 +1746,7 @@
begin begin
tsym.load; tsym.load;
typ:=typesym; typ:=typesym;
{$ifndef STORENUMBER}
forwardpointer:=nil; forwardpointer:=nil;
{$endif}
{$ifdef GDB} {$ifdef GDB}
isusedinstab := false; isusedinstab := false;
{$endif GDB} {$endif GDB}
@ -1920,7 +1912,7 @@
procedure tsyssym.write; procedure tsyssym.write;
begin begin
{$ifdef STORENUMBER} {$ifndef OLDPPU}
tsym.write; tsym.write;
writelong(number); writelong(number);
current_ppu^.writeentry(ibsyssym); current_ppu^.writeentry(ibsyssym);
@ -1957,7 +1949,10 @@
{ {
$Log$ $Log$
Revision 1.81 1999-04-25 22:38:39 pierre Revision 1.82 1999-04-26 13:31:52 peter
* release storenumber,double_checksum
Revision 1.81 1999/04/25 22:38:39 pierre
+ added is_really_const booleanfield for typedconstsym + added is_really_const booleanfield for typedconstsym
for Delphi in $J- mode (not yet implemented !) for Delphi in $J- mode (not yet implemented !)

View File

@ -34,7 +34,7 @@
{ this object is the base for all symbol objects } { this object is the base for all symbol objects }
psym = ^tsym; psym = ^tsym;
{$ifdef STORENUMBER} {$ifndef OLDPPU}
tsym = object(tnamedindexobject) tsym = object(tnamedindexobject)
{$else} {$else}
tsym = object tsym = object
@ -42,9 +42,7 @@
_name : pchar; _name : pchar;
left,right : psym; left,right : psym;
speedvalue : longint; speedvalue : longint;
{$ifndef nonextfield}
nextsym : psym; nextsym : psym;
{$endif nextfield}
{$endif} {$endif}
typ : tsymtyp; typ : tsymtyp;
properties : symprop; properties : symprop;
@ -62,7 +60,7 @@
destructor done;virtual; destructor done;virtual;
procedure write;virtual; procedure write;virtual;
procedure deref;virtual; procedure deref;virtual;
{$ifndef STORENUMBER} {$ifdef OLDPPU}
function name : string; function name : string;
procedure setname(const s : string); procedure setname(const s : string);
{$endif} {$endif}
@ -346,7 +344,10 @@
{ {
$Log$ $Log$
Revision 1.21 1999-04-25 22:38:40 pierre Revision 1.22 1999-04-26 13:31:53 peter
* release storenumber,double_checksum
Revision 1.21 1999/04/25 22:38:40 pierre
+ added is_really_const booleanfield for typedconstsym + added is_really_const booleanfield for typedconstsym
for Delphi in $J- mode (not yet implemented !) for Delphi in $J- mode (not yet implemented !)

View File

@ -683,7 +683,7 @@ implementation
if ((parsing_para_level=0) or (p^.left<>nil)) and if ((parsing_para_level=0) or (p^.left<>nil)) and
(nextprocsym=nil) then (nextprocsym=nil) then
begin begin
{$ifdef STORENUMBER} {$ifndef OLDPPU}
if (not assigned(lastparatype)) and (not assigned(pt^.resulttype)) then if (not assigned(lastparatype)) and (not assigned(pt^.resulttype)) then
internalerror(39393) internalerror(39393)
else else
@ -1149,7 +1149,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.36 1999-04-26 09:30:46 peter Revision 1.37 1999-04-26 13:31:57 peter
* release storenumber,double_checksum
Revision 1.36 1999/04/26 09:30:46 peter
* small tp7 fix * small tp7 fix
* fix void pointer with formaldef * fix void pointer with formaldef

View File

@ -839,7 +839,7 @@ implementation
CGMessage(cg_e_illegal_type_conversion); CGMessage(cg_e_illegal_type_conversion);
end end
else else
{$ifdef STORENUMBER} {$ifndef OLDPPU}
CGMessage2(type_e_incompatible_types,p^.resulttype^.typename,p^.left^.resulttype^.typename); CGMessage2(type_e_incompatible_types,p^.resulttype^.typename,p^.left^.resulttype^.typename);
{$else} {$else}
CGMessage(type_e_mismatch); CGMessage(type_e_mismatch);
@ -940,7 +940,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.25 1999-04-22 10:49:09 peter Revision 1.26 1999-04-26 13:31:58 peter
* release storenumber,double_checksum
Revision 1.25 1999/04/22 10:49:09 peter
* fixed pchar to string location * fixed pchar to string location
Revision 1.24 1999/04/21 09:44:01 peter Revision 1.24 1999/04/21 09:44:01 peter