mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 18:09:30 +02:00
* release storenumber,double_checksum
This commit is contained in:
peter
parent
9a98038489
commit
884c517b18
@ -51,7 +51,7 @@ RTL=../rtl
|
||||
override LOCALOPT+=-Sg
|
||||
|
||||
# set correct defines (-d$(CPU) is automaticly added in makefile.fpc)
|
||||
override LOCALDEF+=-dGDB
|
||||
override LOCALDEF+=-dGDB -dBROWSERLOG
|
||||
|
||||
override LOCALOPT+=$(LOCALDEF)
|
||||
|
||||
@ -383,7 +383,10 @@ $(M68KEXENAME): $(PASFILES) $(INCFILES)
|
||||
|
||||
#
|
||||
# $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
|
||||
#
|
||||
# Revision 1.25 1999/04/07 15:26:50 pierre
|
||||
|
||||
@ -710,7 +710,7 @@ do_jmp:
|
||||
|
||||
{ what a hack ! }
|
||||
if assigned(p^.exceptsymtable) then
|
||||
{$ifdef STORENUMBER}
|
||||
{$ifndef OLDPPU}
|
||||
pvarsym(p^.exceptsymtable^.symindex^.first)^.address:=ref.offset;
|
||||
{$else}
|
||||
pvarsym(p^.exceptsymtable^.searchroot)^.address:=ref.offset;
|
||||
@ -802,7 +802,10 @@ do_jmp:
|
||||
end.
|
||||
{
|
||||
$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
|
||||
* fixed some typos in double_checksum
|
||||
+ incompatible types type1 and type2 message (with storenumber)
|
||||
|
||||
@ -125,13 +125,11 @@ unit files;
|
||||
tmodule = object(tlinkedlist_item)
|
||||
ppufile : pppufile; { the PPU file }
|
||||
crc,
|
||||
{$ifdef Double_checksum}
|
||||
interface_crc : longint;
|
||||
do_reload_ppu : boolean;
|
||||
{$endif def Double_checksum}
|
||||
interface_crc,
|
||||
flags : longint; { the PPU flags }
|
||||
|
||||
compiled, { unit is already compiled }
|
||||
do_reload, { force reloading of the unit }
|
||||
do_assemble, { only assemble the object, don't recompile }
|
||||
do_compile, { need to compile the sources }
|
||||
sources_avail, { if all sources are reachable }
|
||||
@ -179,7 +177,6 @@ unit files;
|
||||
crc_array : pointer;
|
||||
crc_size : longint;
|
||||
{$endif def Test_Double_checksum}
|
||||
|
||||
constructor init(const s:string;_is_unit:boolean);
|
||||
destructor done;virtual;
|
||||
procedure reset;
|
||||
@ -192,10 +189,8 @@ unit files;
|
||||
tused_unit = object(tlinkedlist_item)
|
||||
unitid : word;
|
||||
name : pstring;
|
||||
checksum : longint;
|
||||
{$ifdef Double_checksum}
|
||||
checksum,
|
||||
interface_checksum : longint;
|
||||
{$endif def Double_checksum}
|
||||
loaded : boolean;
|
||||
in_uses,
|
||||
in_interface,
|
||||
@ -226,9 +221,6 @@ unit files;
|
||||
implementation
|
||||
|
||||
uses
|
||||
{$ifdef Double_checksum}
|
||||
comphook,
|
||||
{$endif Double_checksum}
|
||||
dos,verbose,systems,
|
||||
symtable,scanner;
|
||||
|
||||
@ -756,14 +748,14 @@ uses
|
||||
{ Load values to be access easier }
|
||||
flags:=ppufile^.header.flags;
|
||||
crc:=ppufile^.header.checksum;
|
||||
{$ifdef Double_checksum}
|
||||
{$ifndef OLDPPU}
|
||||
interface_crc:=ppufile^.header.interface_checksum;
|
||||
{$endif def Double_checksum}
|
||||
{$endif}
|
||||
{ Show Debug info }
|
||||
Message1(unit_u_ppu_time,filetimestring(ppufiletime));
|
||||
Message1(unit_u_ppu_flags,tostr(flags));
|
||||
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)');
|
||||
{$endif}
|
||||
{ check the object and assembler file to see if we need only to
|
||||
@ -938,12 +930,10 @@ uses
|
||||
|
||||
|
||||
procedure tmodule.reset;
|
||||
|
||||
{$ifdef Double_checksum}
|
||||
{$ifndef OLDPPU}
|
||||
var
|
||||
pm : pdependent_unit;
|
||||
{$endif}
|
||||
|
||||
begin
|
||||
if assigned(scanner) then
|
||||
pscannerfile(scanner)^.invalid:=true;
|
||||
@ -976,23 +966,20 @@ uses
|
||||
used_units.done;
|
||||
used_units.init;
|
||||
{ all units that depend on this one must be recompiled ! }
|
||||
{$ifdef Double_checksum}
|
||||
{$ifndef OLDPPU}
|
||||
pm:=pdependent_unit(dependent_units.first);
|
||||
while assigned(pm) do
|
||||
begin
|
||||
if pm^.u^.in_second_compile then
|
||||
begin
|
||||
writeln('No reload already in second compile: ',pm^.u^.modulename^);
|
||||
end
|
||||
Comment(v_debug,'No reload already in second compile: '+pm^.u^.modulename^)
|
||||
else
|
||||
begin
|
||||
pm^.u^.do_reload_ppu:=true;
|
||||
def_comment(v_warning,'Reloading '+pm^.u^.modulename^+' needed because '+
|
||||
modulename^+' is reloaded');
|
||||
pm^.u^.do_reload:=true;
|
||||
Comment(v_debug,'Reloading '+pm^.u^.modulename^+' needed because '+modulename^+' is reloaded');
|
||||
end;
|
||||
pm:=pdependent_unit(pm^.next);
|
||||
end;
|
||||
{$endif Double_checksum}
|
||||
{$endif OLDPPU}
|
||||
dependent_units.done;
|
||||
dependent_units.init;
|
||||
resourcefiles.done;
|
||||
@ -1016,9 +1003,7 @@ uses
|
||||
loaded_from:=nil;
|
||||
flags:=0;
|
||||
crc:=0;
|
||||
{$ifdef Double_checksum}
|
||||
interface_crc:=0;
|
||||
{$endif def Double_checksum}
|
||||
unitcount:=1;
|
||||
end;
|
||||
|
||||
@ -1082,10 +1067,8 @@ uses
|
||||
loaded_from:=nil;
|
||||
flags:=0;
|
||||
crc:=0;
|
||||
{$ifdef Double_checksum}
|
||||
interface_crc:=0;
|
||||
do_reload_ppu:=false;
|
||||
{$endif def Double_checksum}
|
||||
interface_crc:=0;
|
||||
do_reload:=false;
|
||||
unitcount:=1;
|
||||
inc(global_unit_count);
|
||||
unit_index:=global_unit_count;
|
||||
@ -1170,9 +1153,7 @@ uses
|
||||
loaded:=true;
|
||||
name:=stringdup(_u^.modulename^);
|
||||
checksum:=_u^.crc;
|
||||
{$ifdef Double_checksum}
|
||||
interface_checksum:=_u^.interface_crc;
|
||||
{$endif def Double_checksum}
|
||||
unitid:=0;
|
||||
end;
|
||||
|
||||
@ -1186,9 +1167,7 @@ uses
|
||||
loaded:=false;
|
||||
name:=stringdup(n);
|
||||
checksum:=c;
|
||||
{$ifdef Double_checksum}
|
||||
interface_checksum:=intfc;
|
||||
{$endif def Double_checksum}
|
||||
unitid:=0;
|
||||
end;
|
||||
|
||||
@ -1199,6 +1178,7 @@ uses
|
||||
inherited done;
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
TDENPENDENT_UNIT
|
||||
****************************************************************************}
|
||||
@ -1211,7 +1191,10 @@ uses
|
||||
end.
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.91 1999/04/21 09:43:36 peter
|
||||
|
||||
@ -1061,11 +1061,11 @@ unit globals;
|
||||
end;
|
||||
|
||||
procedure abstract;
|
||||
|
||||
begin
|
||||
runerror(255);
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Init
|
||||
****************************************************************************}
|
||||
@ -1113,17 +1113,11 @@ unit globals;
|
||||
usewindowapi:=false;
|
||||
description:='Compiled by FPC '+version_string+' - '+target_cpu_string;
|
||||
|
||||
{$ifdef BrowserCol}
|
||||
{$define BrowserDefault}
|
||||
{$endif BrowserCol}
|
||||
{$ifdef BrowserLog}
|
||||
{$define BrowserDefault}
|
||||
{$endif BrowserLog}
|
||||
{ Init values }
|
||||
{ Init values }
|
||||
{$ifdef i386}
|
||||
initoptprocessor:=Class386;
|
||||
initlocalswitches:=[];
|
||||
initmoduleswitches:=[cs_extsyntax{$ifdef BrowserDefault},cs_browser{$endif}];
|
||||
initmoduleswitches:=[cs_extsyntax{$ifndef OLDPPU},cs_browser{$endif}];
|
||||
initglobalswitches:=[cs_check_unit_name];
|
||||
initmodeswitches:=fpcmodeswitches;
|
||||
initpackenum:=4;
|
||||
@ -1135,7 +1129,7 @@ unit globals;
|
||||
{$ifdef m68k}
|
||||
initoptprocessor:=MC68000;
|
||||
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];
|
||||
initmodeswitches:=fpcmodeswitches;
|
||||
initpackenum:=4;
|
||||
@ -1165,7 +1159,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.2 1999/04/16 09:56:05 pierre
|
||||
|
||||
@ -45,7 +45,7 @@ interface
|
||||
{ support }
|
||||
cs_support_inline,cs_support_goto,cs_support_macro,
|
||||
cs_support_c_operators,cs_static_keyword,
|
||||
cs_typed_const_not_changeable,
|
||||
cs_typed_const_not_changeable,
|
||||
{ generation }
|
||||
cs_profile,cs_debuginfo,cs_browser,cs_local_browser,cs_compilesystem,
|
||||
{ linking }
|
||||
@ -64,6 +64,8 @@ interface
|
||||
{ optimizer }
|
||||
cs_regalloc,cs_uncertainopts,cs_littlesize,cs_optimize,
|
||||
cs_fastoptimize, cs_slowoptimize,
|
||||
{ browser }
|
||||
cs_browser_log,
|
||||
{ debugger }
|
||||
cs_gdb_dbx,cs_gdb_gsym,cs_gdb_heaptrc,
|
||||
{ assembling }
|
||||
@ -110,7 +112,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$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 !
|
||||
|
||||
Revision 1.6 1999/04/16 11:49:42 peter
|
||||
|
||||
@ -93,7 +93,7 @@ implementation
|
||||
dispose(p);
|
||||
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
|
||||
hp : pprocdef;
|
||||
@ -141,7 +141,7 @@ implementation
|
||||
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
|
||||
hp : pprocdef;
|
||||
@ -288,7 +288,7 @@ implementation
|
||||
_c : pobjectdef;
|
||||
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
|
||||
procdefcoll : pprocdefcoll;
|
||||
@ -566,7 +566,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$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
|
||||
* fixed some typos in double_checksum
|
||||
+ incompatible types type1 and type2 message (with storenumber)
|
||||
|
||||
@ -420,7 +420,8 @@ unit parser;
|
||||
|
||||
{$ifdef BrowserLog}
|
||||
{ Write Browser Log }
|
||||
if cs_browser in aktmoduleswitches then
|
||||
if (cs_browser_log in aktglobalswitches) and
|
||||
(cs_browser in aktmoduleswitches) then
|
||||
begin
|
||||
if browserlog.elements_to_list^.empty then
|
||||
begin
|
||||
@ -459,7 +460,10 @@ unit parser;
|
||||
end.
|
||||
{
|
||||
$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
|
||||
+ deffile is now removed when compiling is finished
|
||||
* ^( compiles now correct
|
||||
|
||||
@ -80,7 +80,7 @@ unit pdecl;
|
||||
function read_type(const name : stringid) : pdef;forward;
|
||||
|
||||
{ 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
|
||||
reaktvarsymtable : psymtable;
|
||||
oldaktfilepos : tfileposinfo;
|
||||
@ -1620,7 +1620,7 @@ unit pdecl;
|
||||
genvmt(aktclass);
|
||||
end;
|
||||
|
||||
{$ifndef STORENUMBER}
|
||||
{$ifdef OLDPPU}
|
||||
{ number symbols and defs }
|
||||
symtablestack^.number_defs;
|
||||
symtablestack^.number_symbols;
|
||||
@ -1660,7 +1660,7 @@ unit pdecl;
|
||||
consume(_END);
|
||||
typecanbeforward:=storetypeforwardsallowed;
|
||||
|
||||
{$ifndef STORENUMBER}
|
||||
{$ifdef OLDPPU}
|
||||
{ number symbols and defs }
|
||||
symtablestack^.number_defs;
|
||||
symtablestack^.number_symbols;
|
||||
@ -2096,7 +2096,7 @@ unit pdecl;
|
||||
getsym(typename,false);
|
||||
sym:=srsym;
|
||||
newtype:=nil;
|
||||
{$ifdef STORENUMBER}
|
||||
{$ifndef OLDPPU}
|
||||
{ found a symbol with this name? }
|
||||
if assigned(sym) then
|
||||
begin
|
||||
@ -2258,7 +2258,10 @@ unit pdecl;
|
||||
end.
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.109 1999/04/21 09:43:45 peter
|
||||
|
||||
@ -22,10 +22,6 @@
|
||||
}
|
||||
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}
|
||||
|
||||
interface
|
||||
@ -326,7 +322,7 @@ unit pmodules;
|
||||
{ ok, now load the unit }
|
||||
current_module^.globalsymtable:=new(punitsymtable,loadasunit);
|
||||
{ if this is the system unit insert the intern symbols }
|
||||
{$ifndef STORENUMBER}
|
||||
{$ifdef OLDPPU}
|
||||
if compile_system then
|
||||
begin
|
||||
make_ref:=false;
|
||||
@ -348,7 +344,7 @@ unit pmodules;
|
||||
{ register unit in used units }
|
||||
pu^.u:=loaded_unit;
|
||||
pu^.loaded:=true;
|
||||
{$ifdef Double_checksum}
|
||||
{$ifndef OLDPPU}
|
||||
{ need to recompile the current unit ? }
|
||||
if loaded_unit^.crc<>pu^.checksum then
|
||||
{ if (loaded_unit^.interface_crc<>pu^.interface_checksum) then }
|
||||
@ -359,7 +355,7 @@ unit pmodules;
|
||||
current_module^.map:=nil;
|
||||
exit;
|
||||
end;
|
||||
{$endif def Double_checksum}
|
||||
{$endif OLDPPU}
|
||||
{ setup the map entry for deref }
|
||||
{$ifndef NEWMAP}
|
||||
current_module^.map^[nextmapentry]:=loaded_unit^.globalsymtable;
|
||||
@ -459,8 +455,9 @@ unit pmodules;
|
||||
begin
|
||||
if hp^.modulename^=s then
|
||||
begin
|
||||
{$ifdef Double_checksum}
|
||||
if hp^.do_reload_ppu then
|
||||
{$ifndef OLDPPU}
|
||||
{ forced to reload ? }
|
||||
if hp^.do_reload then
|
||||
break;
|
||||
{$endif}
|
||||
{ the unit is already registered }
|
||||
@ -501,18 +498,18 @@ unit pmodules;
|
||||
loaded_units.remove(hp);
|
||||
scanner:=hp^.scanner;
|
||||
hp^.reset;
|
||||
{$ifdef Double_checksum}
|
||||
hp2:=pmodule(loaded_units.first);
|
||||
while assigned(hp2) do
|
||||
begin
|
||||
if hp2^.do_reload_ppu then
|
||||
begin
|
||||
hp2^.do_reload_ppu:=false;
|
||||
loadunit(hp^.modulename^,false);
|
||||
end;
|
||||
hp2:=pmodule(hp2^.next);
|
||||
end;
|
||||
{$endif Double_checksum}
|
||||
{$ifndef OLDPPU}
|
||||
hp2:=pmodule(loaded_units.first);
|
||||
while assigned(hp2) do
|
||||
begin
|
||||
if hp2^.do_reload then
|
||||
begin
|
||||
hp2^.do_reload:=false;
|
||||
loadunit(hp^.modulename^,false);
|
||||
end;
|
||||
hp2:=pmodule(hp2^.next);
|
||||
end;
|
||||
{$endif}
|
||||
hp^.scanner:=scanner;
|
||||
{ try to reopen ppu }
|
||||
hp^.search_unit(s,false);
|
||||
@ -777,23 +774,23 @@ unit pmodules;
|
||||
|
||||
|
||||
procedure gen_main_procsym(const name:string;options:longint;st:psymtable);
|
||||
{$ifdef Double_checksum}
|
||||
var
|
||||
stt : psymtable;
|
||||
{$endif Double_checksum}
|
||||
{$ifndef OLDPPU}
|
||||
var
|
||||
stt : psymtable;
|
||||
{$endif}
|
||||
begin
|
||||
{Generate a procsym for main}
|
||||
make_ref:=false;
|
||||
aktprocsym:=new(Pprocsym,init(name));
|
||||
{$ifdef Double_checksum}
|
||||
{$ifndef OLDPPU}
|
||||
{Try to insert in in static symtable ! }
|
||||
stt:=symtablestack;
|
||||
symtablestack:=st;
|
||||
{$endif Double_checksum}
|
||||
{$endif}
|
||||
aktprocsym^.definition:=new(Pprocdef,init);
|
||||
{$ifdef Double_checksum}
|
||||
{$ifndef OLDPPU}
|
||||
symtablestack:=stt;
|
||||
{$endif Double_checksum}
|
||||
{$endif}
|
||||
aktprocsym^.definition^.options:=aktprocsym^.definition^.options or options;
|
||||
aktprocsym^.definition^.setmangledname(target_os.cprefix+name);
|
||||
aktprocsym^.definition^.forwarddef:=false;
|
||||
@ -837,9 +834,9 @@ unit pmodules;
|
||||
{$ifdef GDB}
|
||||
pu : pused_unit;
|
||||
{$endif GDB}
|
||||
{$ifdef Double_checksum}
|
||||
{$ifdef Test_Double_checksum}
|
||||
store_crc : longint;
|
||||
{$endif def Double_checksum}
|
||||
{$endif}
|
||||
s1,s2 : ^string; {Saves stack space}
|
||||
begin
|
||||
consume(_UNIT);
|
||||
@ -980,12 +977,12 @@ unit pmodules;
|
||||
write_gdb_info;
|
||||
{$endIf Def New_GDB}
|
||||
|
||||
{$ifdef Double_CheckSum}
|
||||
{$ifdef Test_Double_checksum}
|
||||
{$ifndef OLDPPU}
|
||||
{$ifdef Test_Double_checksum}
|
||||
if (Errorcount=0) then
|
||||
writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack),true);
|
||||
{$endif Test_Double_checksum}
|
||||
{$endif Double_CheckSum}
|
||||
{$endif Test_Double_checksum}
|
||||
{$endif OLDPPU}
|
||||
|
||||
{ Parse the implementation section }
|
||||
consume(_IMPLEMENTATION);
|
||||
@ -1002,7 +999,7 @@ unit pmodules;
|
||||
{ to reinsert it after loading the implementation units }
|
||||
symtablestack:=unitst^.next;
|
||||
|
||||
{$ifndef STORENUMBER}
|
||||
{$ifdef OLDPPU}
|
||||
{ number the definitions, so a deref from other units works }
|
||||
refsymtable^.number_defs;
|
||||
refsymtable^.number_symbols;
|
||||
@ -1020,11 +1017,8 @@ unit pmodules;
|
||||
end;
|
||||
|
||||
{ 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;
|
||||
|
||||
{ All units are read, now give them a number }
|
||||
numberunits;
|
||||
|
||||
@ -1124,7 +1118,6 @@ unit pmodules;
|
||||
end;
|
||||
{$endif GDB}
|
||||
|
||||
|
||||
reset_global_defs;
|
||||
|
||||
{ tests, if all (interface) forwards are resolved }
|
||||
@ -1158,19 +1151,21 @@ unit pmodules;
|
||||
if cs_local_browser in aktmoduleswitches then
|
||||
current_module^.localsymtable:=refsymtable;
|
||||
{ Write out the ppufile }
|
||||
{$ifdef Double_checksum}
|
||||
{$ifndef OLDPPU}
|
||||
{$ifdef Test_Double_checksum}
|
||||
store_crc:=current_module^.interface_crc;
|
||||
{$endif def Double_checksum}
|
||||
{$endif Test_Double_checksum}
|
||||
{$endif}
|
||||
if (Errorcount=0) then
|
||||
writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack),false);
|
||||
|
||||
{$ifdef Double_checksum}
|
||||
{$ifdef Test_Double_checksum}
|
||||
{$ifndef OLDPPU}
|
||||
{$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}
|
||||
{$endif def Test_Double_checksum}
|
||||
{$endif OLDPPU}
|
||||
{ must be done only after local symtable ref stores !! }
|
||||
closecurrentppu;
|
||||
{$ifdef GDB}
|
||||
@ -1362,7 +1357,10 @@ unit pmodules;
|
||||
end.
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.112 1999/04/25 15:08:38 peter
|
||||
|
||||
@ -37,11 +37,11 @@ type
|
||||
{$endif Test_Double_checksum}
|
||||
|
||||
const
|
||||
{$ifndef Double_checksum}
|
||||
{$ifdef OLDPPU}
|
||||
CurrentPPUVersion=15;
|
||||
{$else Double_checksum}
|
||||
{$else}
|
||||
CurrentPPUVersion=16;
|
||||
{$endif def Double_checksum}
|
||||
{$endif}
|
||||
|
||||
{ buffer sizes }
|
||||
maxentrysize = 1024;
|
||||
@ -93,24 +93,24 @@ const
|
||||
ibfuncretsym = 31;
|
||||
ibsyssym = 32;
|
||||
{definitions}
|
||||
iborddef = 40;
|
||||
ibpointerdef = 41;
|
||||
ibarraydef = 42;
|
||||
ibprocdef = 43;
|
||||
ibstringdef = 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;
|
||||
ibfarpointerdef = 57;
|
||||
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;
|
||||
ibfarpointerdef = 57;
|
||||
|
||||
{ unit flags }
|
||||
uf_init = $1;
|
||||
@ -143,10 +143,10 @@ type
|
||||
flags : longint;
|
||||
size : longint; { size of the ppufile without header }
|
||||
checksum : longint; { checksum for this ppufile }
|
||||
{$ifdef Double_checksum}
|
||||
{$ifndef OLDPPU}
|
||||
interface_checksum : longint;
|
||||
future : array[0..2] of longint;
|
||||
{$endif def Double_checksum}
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
tppuentry=packed record
|
||||
@ -165,7 +165,6 @@ type
|
||||
|
||||
header : tppuheader;
|
||||
size,crc : longint;
|
||||
{$ifdef Double_checksum}
|
||||
{$ifdef Test_Double_checksum}
|
||||
crcindex : longint;
|
||||
crc_index : longint;
|
||||
@ -173,10 +172,7 @@ type
|
||||
{$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}
|
||||
crc_only : boolean; { used to calculate interface_crc before implementation }
|
||||
do_crc,
|
||||
change_endian : boolean;
|
||||
|
||||
@ -232,8 +228,9 @@ implementation
|
||||
{$ifdef Test_Double_checksum}
|
||||
uses
|
||||
comphook;
|
||||
|
||||
{$endif def Test_Double_checksum}
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
Crc 32
|
||||
*****************************************************************************}
|
||||
@ -317,9 +314,7 @@ constructor tppufile.init(fn:string);
|
||||
begin
|
||||
fname:=fn;
|
||||
change_endian:=false;
|
||||
{$ifdef Double_checksum}
|
||||
crc_only:=false;
|
||||
{$endif Double_checksum}
|
||||
Mode:=0;
|
||||
NewHeader;
|
||||
Error:=false;
|
||||
@ -386,11 +381,11 @@ begin
|
||||
Id[3]:='U';
|
||||
Ver[1]:='0';
|
||||
Ver[2]:='1';
|
||||
{$ifndef Double_checksum}
|
||||
{$ifdef OLDPPU}
|
||||
Ver[3]:='5';
|
||||
{$else Double_checksum}
|
||||
{$else}
|
||||
Ver[3]:='6';
|
||||
{$endif def Double_checksum}
|
||||
{$endif}
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -683,10 +678,8 @@ begin
|
||||
bufidx:=0;
|
||||
{reset}
|
||||
crc:=$ffffffff;
|
||||
{$ifdef Double_checksum}
|
||||
interface_crc:=$ffffffff;
|
||||
do_interface_crc:=true;
|
||||
{$endif def Double_checksum}
|
||||
Error:=false;
|
||||
do_crc:=true;
|
||||
size:=0;
|
||||
@ -800,7 +793,7 @@ begin
|
||||
if do_crc then
|
||||
begin
|
||||
crc:=UpdateCrc32(crc,b,len);
|
||||
{$ifdef Double_checksum}
|
||||
{$ifndef OLDPPU}
|
||||
if do_interface_crc then
|
||||
begin
|
||||
interface_crc:=UpdateCrc32(interface_crc,b,len);
|
||||
@ -828,9 +821,9 @@ begin
|
||||
end;
|
||||
end;
|
||||
if not crc_only then
|
||||
{$else not def Double_checksum}
|
||||
{$else}
|
||||
end;
|
||||
{$endif def Double_checksum}
|
||||
{$endif OLDPPU}
|
||||
writedata(b,len);
|
||||
inc(entryidx,len);
|
||||
end;
|
||||
@ -876,7 +869,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.27 1999/04/17 13:16:20 peter
|
||||
|
||||
@ -373,7 +373,7 @@ unit pstatmnt;
|
||||
objectdef : begin
|
||||
obj:=pobjectdef(p^.resulttype);
|
||||
withsymtable:=new(pwithsymtable,init);
|
||||
{$ifdef STORENUMBER}
|
||||
{$ifndef OLDPPU}
|
||||
withsymtable^.symsearch:=obj^.publicsyms^.symsearch;
|
||||
{$else}
|
||||
withsymtable^.searchroot:=obj^.publicsyms^.searchroot;
|
||||
@ -393,7 +393,7 @@ unit pstatmnt;
|
||||
begin
|
||||
symtab^.next:=new(pwithsymtable,init);
|
||||
symtab:=symtab^.next;
|
||||
{$ifdef STORENUMBER}
|
||||
{$ifndef OLDPPU}
|
||||
symtab^.symsearch:=obj^.publicsyms^.symsearch;
|
||||
{$else}
|
||||
symtab^.searchroot:=obj^.publicsyms^.searchroot;
|
||||
@ -416,7 +416,7 @@ unit pstatmnt;
|
||||
symtab:=precdef(p^.resulttype)^.symtable;
|
||||
levelcount:=1;
|
||||
withsymtable:=new(pwithsymtable,init);
|
||||
{$ifdef STORENUMBER}
|
||||
{$ifndef OLDPPU}
|
||||
withsymtable^.symsearch:=symtab^.symsearch;
|
||||
{$else}
|
||||
withsymtable^.searchroot:=symtab^.searchroot;
|
||||
@ -1283,7 +1283,10 @@ unit pstatmnt;
|
||||
end.
|
||||
{
|
||||
$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
|
||||
* fixed some typos in double_checksum
|
||||
+ incompatible types type1 and type2 message (with storenumber)
|
||||
|
||||
@ -37,3 +37,5 @@ Changes in the syntax or semantic of FPC:
|
||||
25/04/99: initialized vars supported in Delphi mode (only $J+ mode)
|
||||
getting the address of an untyped const is now
|
||||
forbidden as in BP
|
||||
27/04/99 New unit format PPU016, you need to recompile all older units
|
||||
|
||||
@ -23,13 +23,13 @@
|
||||
const
|
||||
def_alignment = 4;
|
||||
|
||||
{ different options }
|
||||
sp_public = 0;
|
||||
sp_forwarddef = 1;
|
||||
sp_protected = 2;
|
||||
sp_private = 4;
|
||||
sp_static = 8;
|
||||
sp_published = 16;
|
||||
{ symbol options }
|
||||
sp_public = $1;
|
||||
sp_private = $2;
|
||||
sp_published = $4;
|
||||
sp_protected = $8;
|
||||
sp_forwarddef = $10;
|
||||
sp_static = $20;
|
||||
|
||||
{ flags for a definition }
|
||||
df_needsrtti = $1; { the definitions needs rtti }
|
||||
@ -83,21 +83,24 @@
|
||||
oo_hasvmt = $200;
|
||||
oo_hasmsgstr = $400;
|
||||
oo_hasmsgint = $800;
|
||||
|
||||
|
||||
{ options for properties }
|
||||
ppo_indexed = $1;
|
||||
ppo_defaultproperty = $2;
|
||||
ppo_stored = $4;
|
||||
|
||||
{ options for variables }
|
||||
vo_regable = 1;
|
||||
vo_is_C_var = 2;
|
||||
vo_is_external = 4;
|
||||
vo_is_dll_var = 8;
|
||||
vo_regable = $1;
|
||||
vo_is_C_var = $2;
|
||||
vo_is_external = $4;
|
||||
vo_is_dll_var = $8;
|
||||
|
||||
{
|
||||
$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
|
||||
(saves ESI EDI and EBX for i386)
|
||||
|
||||
|
||||
@ -67,7 +67,7 @@
|
||||
|
||||
constructor tdef.init;
|
||||
begin
|
||||
{$ifdef STORENUMBER}
|
||||
{$ifndef OLDPPU}
|
||||
inherited init;
|
||||
{$else}
|
||||
indexnb := 0;
|
||||
@ -124,8 +124,8 @@
|
||||
lastglobaldef := @self;
|
||||
nextglobal := nil;
|
||||
{ load }
|
||||
{$ifdef STORENUMBER}
|
||||
indexnr:=readlong;
|
||||
{$ifndef OLDPPU}
|
||||
indexnr:=readword;
|
||||
sym:=ptypesym(readsymref);
|
||||
{$else}
|
||||
indexnb := 0;
|
||||
@ -170,7 +170,7 @@
|
||||
if assigned(owner) and
|
||||
(owner^.symtabletype in [recordsymtable,objectsymtable]) then
|
||||
begin
|
||||
{$ifdef STORENUMBER}
|
||||
{$ifndef OLDPPU}
|
||||
owner^.defindex^.delete(@self);
|
||||
{$else}
|
||||
{ no other definition
|
||||
@ -223,8 +223,8 @@
|
||||
|
||||
procedure tdef.write;
|
||||
begin
|
||||
{$ifdef STORENUMBER}
|
||||
writelong(indexnr);
|
||||
{$ifndef OLDPPU}
|
||||
writeword(indexnr);
|
||||
writesymref(sym);
|
||||
{$endif}
|
||||
{$ifdef GDB}
|
||||
@ -582,7 +582,7 @@
|
||||
else
|
||||
writelong(len);
|
||||
case string_typ of
|
||||
st_shortstring : current_ppu^.writeentry(ibstringdef);
|
||||
st_shortstring : current_ppu^.writeentry(ibshortstringdef);
|
||||
st_longstring : current_ppu^.writeentry(iblongstringdef);
|
||||
st_ansistring : current_ppu^.writeentry(ibansistringdef);
|
||||
st_widestring : current_ppu^.writeentry(ibwidestringdef);
|
||||
@ -1781,7 +1781,7 @@
|
||||
var
|
||||
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
|
||||
if (psym(s)^.typ=varsym) and
|
||||
@ -1809,7 +1809,7 @@
|
||||
|
||||
procedure trecdef.deref;
|
||||
var
|
||||
{$ifndef STORENUMBER}
|
||||
{$ifdef OLDPPU}
|
||||
hp : pdef;
|
||||
{$endif}
|
||||
oldrecsyms : psymtable;
|
||||
@ -1817,7 +1817,7 @@
|
||||
oldrecsyms:=aktrecordsymtable;
|
||||
aktrecordsymtable:=symtable;
|
||||
{ now dereference the definitions }
|
||||
{$ifdef STORENUMBER}
|
||||
{$ifndef OLDPPU}
|
||||
symtable^.deref;
|
||||
{$else}
|
||||
hp:=symtable^.rootdef;
|
||||
@ -1854,7 +1854,7 @@
|
||||
StabRecSize : longint = 0;
|
||||
RecOffset : Longint = 0;
|
||||
|
||||
procedure addname(p : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});
|
||||
procedure addname(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});
|
||||
var
|
||||
news, newrec : pchar;
|
||||
spec : string[2];
|
||||
@ -1898,7 +1898,7 @@
|
||||
function trecdef.stabstring : pchar;
|
||||
Var oldrec : pchar;
|
||||
oldsize : longint;
|
||||
{$ifndef STORENUMBER}
|
||||
{$ifdef OLDPPU}
|
||||
cur : psym;
|
||||
{$endif}
|
||||
begin
|
||||
@ -1908,16 +1908,16 @@
|
||||
stabrecsize:=memsizeinc;
|
||||
strpcopy(stabRecString,'s'+tostr(savesize));
|
||||
RecOffset := 0;
|
||||
{$ifdef nonextfield}
|
||||
{$ifndef OLDPPU}
|
||||
symtable^.foreach({$ifdef fpc}@{$endif}addname);
|
||||
{$else nonextfield}
|
||||
{$else}
|
||||
cur:=symtable^.searchroot;
|
||||
while assigned(cur) do
|
||||
begin
|
||||
addname(cur);
|
||||
cur:=cur^.nextsym;
|
||||
end;
|
||||
{$endif nonextfield}
|
||||
{$endif}
|
||||
{ FPC doesn't want to convert a char to a pchar}
|
||||
{ is this a bug ? }
|
||||
strpcopy(strend(StabRecString),';');
|
||||
@ -1939,7 +1939,7 @@
|
||||
|
||||
var
|
||||
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
|
||||
if (psym(sym)^.typ=varsym) and
|
||||
(pvarsym(sym)^.definition^.needs_inittable) then
|
||||
@ -1947,13 +1947,13 @@
|
||||
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
|
||||
inc(count);
|
||||
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
|
||||
if (psym(sym)^.typ=varsym) and
|
||||
pvarsym(sym)^.definition^.needs_inittable then
|
||||
@ -1964,14 +1964,14 @@
|
||||
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
|
||||
rttilist^.concat(new(pai_const_symbol,init(pvarsym(sym)^.definition^.get_rtti_label)));
|
||||
rttilist^.concat(new(pai_const,init_32bit(pvarsym(sym)^.address)));
|
||||
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
|
||||
if (psym(sym)^.typ=varsym) and
|
||||
pvarsym(sym)^.definition^.needs_inittable then
|
||||
@ -1980,7 +1980,7 @@
|
||||
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
|
||||
pvarsym(sym)^.definition^.get_rtti_label;
|
||||
end;
|
||||
@ -2152,14 +2152,14 @@
|
||||
begin
|
||||
inherited write;
|
||||
writedefref(retdef);
|
||||
{$ifdef Double_checksum}
|
||||
current_ppu^.do_interface_crc:=false;
|
||||
{$endif def Double_checksum}
|
||||
{$ifndef OLDPPU}
|
||||
current_ppu^.do_interface_crc:=false;
|
||||
{$endif}
|
||||
writebyte(fpu_used);
|
||||
{$ifdef OLDPPU}
|
||||
current_ppu^.do_interface_crc:=true;
|
||||
{$endif}
|
||||
writelong(options);
|
||||
{$ifdef Double_checksum}
|
||||
current_ppu^.do_interface_crc:=true;
|
||||
{$endif def Double_checksum}
|
||||
hp:=para1;
|
||||
count:=0;
|
||||
while assigned(hp) do
|
||||
@ -2291,8 +2291,6 @@
|
||||
s:=readstring;
|
||||
setstring(_mangledname,s);
|
||||
|
||||
|
||||
|
||||
extnumber:=readlong;
|
||||
nextoverloaded:=pprocdef(readdefref);
|
||||
_class := pobjectdef(readdefref);
|
||||
@ -2508,9 +2506,9 @@ Const local_symtable_index : longint = $8001;
|
||||
procedure tprocdef.write;
|
||||
begin
|
||||
inherited write;
|
||||
{$ifdef Double_checksum}
|
||||
current_ppu^.do_interface_crc:=false;
|
||||
{$endif def Double_checksum}
|
||||
{$ifndef OLDPPU}
|
||||
current_ppu^.do_interface_crc:=false;
|
||||
{$endif}
|
||||
{$ifdef i386}
|
||||
writebyte(usedregisters);
|
||||
{$endif i386}
|
||||
@ -2522,10 +2520,10 @@ Const local_symtable_index : longint = $8001;
|
||||
writelong(usedregisters_fpu);
|
||||
{$endif alpha}
|
||||
writestring(mangledname);
|
||||
{$ifndef OLDPPU}
|
||||
current_ppu^.do_interface_crc:=true;
|
||||
{$endif}
|
||||
writelong(extnumber);
|
||||
{$ifdef Double_checksum}
|
||||
current_ppu^.do_interface_crc:=true;
|
||||
{$endif def Double_checksum}
|
||||
if (options and pooperator) = 0 then
|
||||
writedefref(nextoverloaded)
|
||||
else
|
||||
@ -2882,9 +2880,7 @@ Const local_symtable_index : longint = $8001;
|
||||
options:=readlong;
|
||||
oldread_member:=read_member;
|
||||
read_member:=true;
|
||||
object_options:=true;
|
||||
publicsyms:=new(psymtable,loadas(objectsymtable));
|
||||
object_options:=false;
|
||||
read_member:=oldread_member;
|
||||
publicsyms^.defowner:=@self;
|
||||
{ publicsyms^.datasize:=savesize; }
|
||||
@ -2937,11 +2933,6 @@ Const local_symtable_index : longint = $8001;
|
||||
|
||||
destructor tobjectdef.done;
|
||||
begin
|
||||
{!!!!
|
||||
if assigned(privatesyms) then
|
||||
dispose(privatesyms,done);
|
||||
if assigned(protectedsyms) then
|
||||
dispose(protectedsyms,done); }
|
||||
if assigned(publicsyms) then
|
||||
dispose(publicsyms,done);
|
||||
if (options and oo_isforward)<>0 then
|
||||
@ -2982,7 +2973,7 @@ Const local_symtable_index : longint = $8001;
|
||||
|
||||
procedure tobjectdef.deref;
|
||||
var
|
||||
{$ifndef STORENUMBER}
|
||||
{$ifdef OLDPPU}
|
||||
hp : pdef;
|
||||
{$endif}
|
||||
oldrecsyms : psymtable;
|
||||
@ -2991,7 +2982,7 @@ Const local_symtable_index : longint = $8001;
|
||||
oldrecsyms:=aktrecordsymtable;
|
||||
aktrecordsymtable:=publicsyms;
|
||||
|
||||
{$ifdef STORENUMBER}
|
||||
{$ifndef OLDPPU}
|
||||
publicsyms^.deref;
|
||||
{$else}
|
||||
hp:=publicsyms^.rootdef;
|
||||
@ -3066,15 +3057,13 @@ Const local_symtable_index : longint = $8001;
|
||||
|
||||
oldread_member:=read_member;
|
||||
read_member:=true;
|
||||
object_options:=true;
|
||||
publicsyms^.writeas;
|
||||
object_options:=false;
|
||||
read_member:=oldread_member;
|
||||
end;
|
||||
|
||||
|
||||
{$ifdef GDB}
|
||||
procedure addprocname(p :{$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});
|
||||
procedure addprocname(p :{$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});
|
||||
var virtualind,argnames : string;
|
||||
news, newrec : pchar;
|
||||
pd,ipd : pprocdef;
|
||||
@ -3166,9 +3155,9 @@ Const local_symtable_index : longint = $8001;
|
||||
oldrec : pchar;
|
||||
oldrecsize : longint;
|
||||
str_end : string;
|
||||
{$ifndef nonextfield}
|
||||
{$ifdef OLDPPU}
|
||||
cur : psym;
|
||||
{$endif nonextfield}
|
||||
{$endif}
|
||||
begin
|
||||
oldrec := stabrecstring;
|
||||
oldrecsize:=stabrecsize;
|
||||
@ -3181,40 +3170,40 @@ Const local_symtable_index : longint = $8001;
|
||||
strpcopy(strend(stabrecstring),'!1,020,'+childof^.numberstring+';');
|
||||
{virtual table to implement yet}
|
||||
RecOffset := 0;
|
||||
{$ifdef nonextfield}
|
||||
{$ifndef OLDPPU}
|
||||
{$ifdef tp}
|
||||
publicsyms^.foreach(addname);
|
||||
{$else}
|
||||
publicsyms^.foreach(@addname);
|
||||
{$endif}
|
||||
{$else nonextfield}
|
||||
{$else}
|
||||
cur:=publicsyms^.searchroot;
|
||||
while assigned(cur) do
|
||||
begin
|
||||
addname(cur);
|
||||
cur:=psym(cur)^.nextsym;
|
||||
end;
|
||||
{$endif nonextfield}
|
||||
{$endif}
|
||||
if (options and oo_hasvmt) <> 0 then
|
||||
if not assigned(childof) or ((childof^.options and oo_hasvmt) = 0) then
|
||||
begin
|
||||
strpcopy(strend(stabrecstring),'$vf'+numberstring+':'+typeglobalnumber('vtblarray')
|
||||
+','+tostr(vmt_offset*8)+';');
|
||||
end;
|
||||
{$ifdef nonextfield}
|
||||
{$ifndef OLDPPU}
|
||||
{$ifdef tp}
|
||||
publicsyms^.foreach(addprocname);
|
||||
{$else}
|
||||
publicsyms^.foreach(@addprocname);
|
||||
{$endif tp }
|
||||
{$else nonextfield}
|
||||
{$else}
|
||||
cur:=publicsyms^.searchroot;
|
||||
while assigned(cur) do
|
||||
begin
|
||||
addprocname(cur);
|
||||
cur:=psym(cur)^.nextsym;
|
||||
end;
|
||||
{$endif nonextfield}
|
||||
{$endif}
|
||||
if (options and oo_hasvmt) <> 0 then
|
||||
begin
|
||||
anc := @self;
|
||||
@ -3273,7 +3262,7 @@ Const local_symtable_index : longint = $8001;
|
||||
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}
|
||||
begin
|
||||
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;
|
||||
|
||||
|
||||
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
|
||||
proctypesinfo : byte;
|
||||
|
||||
@ -3349,7 +3338,7 @@ Const local_symtable_index : longint = $8001;
|
||||
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}
|
||||
begin
|
||||
if (psym(sym)^.typ=propertysym) and
|
||||
@ -3476,7 +3465,10 @@ Const local_symtable_index : longint = $8001;
|
||||
|
||||
{
|
||||
$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
|
||||
* fixed some typos in double_checksum
|
||||
+ incompatible types type1 and type2 message (with storenumber)
|
||||
|
||||
@ -31,7 +31,7 @@
|
||||
classrefdef,farpointerdef);
|
||||
|
||||
pdef = ^tdef;
|
||||
{$ifdef STORENUMBER}
|
||||
{$ifndef OLDPPU}
|
||||
tdef = object(tnamedindexobject)
|
||||
{$else}
|
||||
tdef = object
|
||||
@ -512,7 +512,10 @@
|
||||
|
||||
{
|
||||
$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
|
||||
* fixed some typos in double_checksum
|
||||
+ incompatible types type1 and type2 message (with storenumber)
|
||||
|
||||
@ -117,7 +117,7 @@
|
||||
current_ppu^.putword(p^.owner^.unitid)
|
||||
else
|
||||
current_ppu^.putword(p^.owner^.unitid);
|
||||
{$ifdef STORENUMBER}
|
||||
{$ifndef OLDPPU}
|
||||
current_ppu^.putword(p^.indexnr);
|
||||
{$else}
|
||||
current_ppu^.putword(p^.indexnb);
|
||||
@ -140,7 +140,7 @@
|
||||
current_ppu^.putword(p^.owner^.unitid)
|
||||
else
|
||||
current_ppu^.putword(p^.owner^.unitid);
|
||||
{$ifdef STORENUMBER}
|
||||
{$ifndef OLDPPU}
|
||||
current_ppu^.putword(p^.indexnr);
|
||||
{$else}
|
||||
current_ppu^.putword(p^.indexnb);
|
||||
@ -175,23 +175,19 @@
|
||||
hp:=pused_unit(current_module^.used_units.first);
|
||||
while assigned(hp) do
|
||||
begin
|
||||
{$ifdef Double_checksum}
|
||||
current_ppu^.do_interface_crc:=hp^.in_interface;
|
||||
{$endif Double_checksum}
|
||||
current_ppu^.putstring(hp^.name^);
|
||||
{ the checksum should not affect the crc of this unit ! (PFV) }
|
||||
current_ppu^.do_crc:=false;
|
||||
current_ppu^.putlongint(hp^.checksum);
|
||||
{$ifdef Double_checksum}
|
||||
{$ifndef OLDPPU}
|
||||
current_ppu^.putlongint(hp^.interface_checksum);
|
||||
{$endif def Double_checksum}
|
||||
{$endif}
|
||||
current_ppu^.do_crc:=true;
|
||||
current_ppu^.putbyte(byte(hp^.in_interface));
|
||||
hp:=pused_unit(hp^.next);
|
||||
end;
|
||||
{$ifdef Double_checksum}
|
||||
current_ppu^.do_interface_crc:=true;
|
||||
{$endif Double_checksum}
|
||||
current_ppu^.writeentry(ibloadunit);
|
||||
end;
|
||||
|
||||
@ -236,7 +232,6 @@
|
||||
if not current_ppu^.create then
|
||||
Message(unit_f_ppu_cannot_write);
|
||||
|
||||
{$ifdef Double_checksum}
|
||||
current_ppu^.crc_only:=only_crc;
|
||||
{$ifdef Test_Double_checksum}
|
||||
if only_crc then
|
||||
@ -249,7 +244,6 @@
|
||||
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;
|
||||
{ write symbols and definitions }
|
||||
@ -260,9 +254,9 @@
|
||||
{ create and write header }
|
||||
current_ppu^.header.size:=current_ppu^.size;
|
||||
current_ppu^.header.checksum:=current_ppu^.crc;
|
||||
{$ifdef Double_checksum}
|
||||
{$ifndef OLDPPU}
|
||||
current_ppu^.header.interface_checksum:=current_ppu^.interface_crc;
|
||||
{$endif def Double_checksum}
|
||||
{$endif}
|
||||
current_ppu^.header.compiler:=wordversion;
|
||||
current_ppu^.header.cpu:=word(target_cpu);
|
||||
current_ppu^.header.target:=word(target_info.target);
|
||||
@ -270,9 +264,8 @@
|
||||
current_ppu^.writeheader;
|
||||
{ save crc in current_module also }
|
||||
current_module^.crc:=current_ppu^.crc;
|
||||
{$ifdef Double_checksum}
|
||||
current_module^.interface_crc:=current_ppu^.interface_crc;
|
||||
if only_crc then
|
||||
if only_crc then
|
||||
begin
|
||||
{$ifdef Test_Double_checksum}
|
||||
Current_Module^.crc_array:=current_ppu^.crc_test;
|
||||
@ -284,7 +277,6 @@
|
||||
{$ifdef Test_Double_checksum_write}
|
||||
close(CRCFile);
|
||||
{$endif Test_Double_checksum_write}
|
||||
{$endif def Double_checksum}
|
||||
end;
|
||||
|
||||
procedure closecurrentppu;
|
||||
@ -480,7 +472,7 @@
|
||||
begin
|
||||
hs:=current_ppu^.getstring;
|
||||
checksum:=current_ppu^.getlongint;
|
||||
{$ifdef DOUBLE_CHECKSUM}
|
||||
{$ifndef OLDPPU}
|
||||
intfchecksum:=current_ppu^.getlongint;
|
||||
{$else}
|
||||
intfchecksum:=0;
|
||||
@ -518,7 +510,10 @@
|
||||
|
||||
{
|
||||
$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
|
||||
* fixed some typos in double_checksum
|
||||
+ incompatible types type1 and type2 message (with storenumber)
|
||||
|
||||
@ -26,17 +26,17 @@
|
||||
|
||||
constructor tsym.init(const n : string);
|
||||
begin
|
||||
{$ifdef STORENUMBER}
|
||||
inherited init;
|
||||
{$ifndef OLDPPU}
|
||||
inherited initname(n);
|
||||
{$else}
|
||||
indexnb:=0;
|
||||
{$endif}
|
||||
left:=nil;
|
||||
right:=nil;
|
||||
{$ifdef nextfield}
|
||||
nextsym:=nil;
|
||||
{$endif nextfield}
|
||||
setname(n);
|
||||
indexnb:=0;
|
||||
{$ifdef nextfield}
|
||||
nextsym:=nil;
|
||||
{$endif nextfield}
|
||||
{$endif}
|
||||
typ:=abstractsym;
|
||||
properties:=current_object_option;
|
||||
{$ifdef GDB}
|
||||
@ -54,22 +54,20 @@
|
||||
lastref:=defref;
|
||||
end;
|
||||
|
||||
constructor tsym.load;
|
||||
|
||||
constructor tsym.load;
|
||||
begin
|
||||
{$ifdef STORENUMBER}
|
||||
{$ifndef OLDPPU}
|
||||
inherited init;
|
||||
indexnr:=readlong;
|
||||
{$endif}
|
||||
indexnr:=readword;
|
||||
{$else}
|
||||
left:=nil;
|
||||
right:=nil;
|
||||
{$endif}
|
||||
setname(readstring);
|
||||
typ:=abstractsym;
|
||||
fillchar(fileinfo,sizeof(fileinfo),0);
|
||||
if object_options then
|
||||
properties:=symprop(readbyte)
|
||||
else
|
||||
properties:=sp_public;
|
||||
properties:=symprop(readbyte);
|
||||
lastref:=nil;
|
||||
defref:=nil;
|
||||
lastwritten:=nil;
|
||||
@ -163,12 +161,12 @@
|
||||
begin
|
||||
if assigned(defref) then
|
||||
dispose(defref,done);
|
||||
{$ifdef STORENUMBER}
|
||||
{$ifndef OLDPPU}
|
||||
inherited done;
|
||||
{$else}
|
||||
{$ifdef tp}
|
||||
{$ifdef tp}
|
||||
if not(use_big) then
|
||||
{$endif tp}
|
||||
{$endif tp}
|
||||
strdispose(_name);
|
||||
if assigned(left) then
|
||||
dispose(left,done);
|
||||
@ -180,12 +178,11 @@
|
||||
|
||||
procedure tsym.write;
|
||||
begin
|
||||
{$ifdef STORENUMBER}
|
||||
writelong(indexnr);
|
||||
{$ifndef OLDPPU}
|
||||
writeword(indexnr);
|
||||
{$endif}
|
||||
writestring(name);
|
||||
if object_options then
|
||||
writebyte(byte(properties));
|
||||
writebyte(byte(properties));
|
||||
end;
|
||||
|
||||
|
||||
@ -194,15 +191,15 @@
|
||||
end;
|
||||
|
||||
|
||||
{$ifndef STORENUMBER}
|
||||
{$ifdef OLDPPU}
|
||||
function tsym.name : string;
|
||||
{$ifdef tp}
|
||||
{$ifdef tp}
|
||||
var
|
||||
s : string;
|
||||
b : byte;
|
||||
{$endif}
|
||||
{$endif}
|
||||
begin
|
||||
{$ifdef tp}
|
||||
{$ifdef tp}
|
||||
if use_big then
|
||||
begin
|
||||
symbolstream.seek(longint(_name));
|
||||
@ -212,12 +209,17 @@
|
||||
name:=s;
|
||||
end
|
||||
else
|
||||
{$endif}
|
||||
{$endif}
|
||||
if assigned(_name) then
|
||||
name:=strpas(_name)
|
||||
else
|
||||
name:='';
|
||||
end;
|
||||
|
||||
procedure tsym.setname(const s : string);
|
||||
begin
|
||||
setstring(_name,s);
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
function tsym.mangledname : string;
|
||||
@ -225,13 +227,6 @@
|
||||
mangledname:=name;
|
||||
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 }
|
||||
procedure tsym.insert_in_data;
|
||||
@ -262,6 +257,7 @@
|
||||
end;
|
||||
{$endif GDB}
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
TLABELSYM
|
||||
****************************************************************************}
|
||||
@ -1740,11 +1736,9 @@
|
||||
{$ifdef GDB}
|
||||
isusedinstab := false;
|
||||
{$endif GDB}
|
||||
{$ifndef STORENUMBER}
|
||||
forwardpointer:=nil;
|
||||
{$endif}
|
||||
if assigned(definition) and not(assigned(definition^.sym)) then
|
||||
definition^.sym:=@self;
|
||||
if assigned(definition) and not(assigned(definition^.sym)) then
|
||||
definition^.sym:=@self;
|
||||
end;
|
||||
|
||||
constructor ttypesym.load;
|
||||
@ -1752,9 +1746,7 @@
|
||||
begin
|
||||
tsym.load;
|
||||
typ:=typesym;
|
||||
{$ifndef STORENUMBER}
|
||||
forwardpointer:=nil;
|
||||
{$endif}
|
||||
{$ifdef GDB}
|
||||
isusedinstab := false;
|
||||
{$endif GDB}
|
||||
@ -1920,7 +1912,7 @@
|
||||
|
||||
procedure tsyssym.write;
|
||||
begin
|
||||
{$ifdef STORENUMBER}
|
||||
{$ifndef OLDPPU}
|
||||
tsym.write;
|
||||
writelong(number);
|
||||
current_ppu^.writeentry(ibsyssym);
|
||||
@ -1957,7 +1949,10 @@
|
||||
|
||||
{
|
||||
$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
|
||||
for Delphi in $J- mode (not yet implemented !)
|
||||
|
||||
|
||||
@ -34,7 +34,7 @@
|
||||
|
||||
{ this object is the base for all symbol objects }
|
||||
psym = ^tsym;
|
||||
{$ifdef STORENUMBER}
|
||||
{$ifndef OLDPPU}
|
||||
tsym = object(tnamedindexobject)
|
||||
{$else}
|
||||
tsym = object
|
||||
@ -42,9 +42,7 @@
|
||||
_name : pchar;
|
||||
left,right : psym;
|
||||
speedvalue : longint;
|
||||
{$ifndef nonextfield}
|
||||
nextsym : psym;
|
||||
{$endif nextfield}
|
||||
{$endif}
|
||||
typ : tsymtyp;
|
||||
properties : symprop;
|
||||
@ -62,7 +60,7 @@
|
||||
destructor done;virtual;
|
||||
procedure write;virtual;
|
||||
procedure deref;virtual;
|
||||
{$ifndef STORENUMBER}
|
||||
{$ifdef OLDPPU}
|
||||
function name : string;
|
||||
procedure setname(const s : string);
|
||||
{$endif}
|
||||
@ -346,7 +344,10 @@
|
||||
|
||||
{
|
||||
$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
|
||||
for Delphi in $J- mode (not yet implemented !)
|
||||
|
||||
|
||||
@ -683,7 +683,7 @@ implementation
|
||||
if ((parsing_para_level=0) or (p^.left<>nil)) and
|
||||
(nextprocsym=nil) then
|
||||
begin
|
||||
{$ifdef STORENUMBER}
|
||||
{$ifndef OLDPPU}
|
||||
if (not assigned(lastparatype)) and (not assigned(pt^.resulttype)) then
|
||||
internalerror(39393)
|
||||
else
|
||||
@ -1149,7 +1149,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$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
|
||||
* fix void pointer with formaldef
|
||||
|
||||
|
||||
@ -839,7 +839,7 @@ implementation
|
||||
CGMessage(cg_e_illegal_type_conversion);
|
||||
end
|
||||
else
|
||||
{$ifdef STORENUMBER}
|
||||
{$ifndef OLDPPU}
|
||||
CGMessage2(type_e_incompatible_types,p^.resulttype^.typename,p^.left^.resulttype^.typename);
|
||||
{$else}
|
||||
CGMessage(type_e_mismatch);
|
||||
@ -940,7 +940,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.24 1999/04/21 09:44:01 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user