paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 11:09:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ added vmt_offset in tobjectdef.write for fututre use

Browse Source 
(first steps to have objects without vmt if no virtual !!)
  + added fpu_used field for tabstractprocdef  :
    sets this level to 2 if the functions return with value in FPU
    (is then set to correct value at parsing of implementation)
    THIS MIGHT refuse some code with FPU expression too complex
    that were accepted before and even in some cases
    that don't overflow in fact
    ( like if f : float; is a forward that finally in implementation
     only uses one fpu register !!)
    Nevertheless I think that it will improve security on
    FPU operations !!
  * most other changes only for UseBrowser code
    (added symtable references for record and objects)
    local switch for refs to args and local of each function
    (static symtable still missing)
    UseBrowser still not stable and probably broken by
    the definition hash array !!
This commit is contained in:
pierre 1998-09-21 08:45:05 +00:00
parent 92b80224c7
commit d11f7636be
14 changed files with 624 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

165
compiler/browser.pas
View File

@ -41,6 +41,7 @@ type
nextref : pref;
posinfo : tfileposinfo;
moduleindex : word;
is_written : boolean;
constructor init(ref:pref;pos:pfileposinfo);
destructor done; virtual;
function get_file_line : string;
@ -50,7 +51,9 @@ type
tbrowser=object
fname : string;
logopen : boolean;
stderrlog : boolean;
f : file;
elements_to_list : pstringqueue;
buf : pchar;
bufidx : longint;
identidx : longint;
@ -64,6 +67,8 @@ type
procedure closelog;
procedure ident;
procedure unident;
procedure browse_symbol(s : string);
procedure list_elements;
end;
var
@ -74,7 +79,7 @@ var
implementation
uses
comphook,globals,systems,verbose;
comphook,globals,symtable,systems,verbose;
{****************************************************************************
TRef
@ -90,6 +95,7 @@ implementation
moduleindex:=current_module^.unit_index;
if assigned(ref) then
ref^.nextref:=@self;
is_written:=false;
end;
@ -138,6 +144,7 @@ implementation
begin
fname:=FixFileName('browser.log');
logopen:=false;
elements_to_list:=new(pstringqueue,init);
end;
@ -174,7 +181,17 @@ implementation
procedure tbrowser.flushlog;
begin
if logopen then
blockwrite(f,buf^,bufidx);
if not stderrlog then
blockwrite(f,buf^,bufidx)
else
begin
buf[bufidx]:=#0;
{$ifndef TP}
write(stderr,buf);
{$else TP}
write(buf);
{$endif TP}
end;
bufidx:=0;
end;
@ -189,7 +206,21 @@ implementation
logopen:=false;
end;
end;
procedure tbrowser.list_elements;
begin
stderrlog:=true;
getmem(buf,logbufsize);
logopen:=true;
while not elements_to_list^.empty do
browse_symbol(elements_to_list^.get);
flushlog;
logopen:=false;
freemem(buf,logbufsize);
stderrlog:=false;
end;
procedure tbrowser.addlog(const s:string);
begin
@ -234,6 +265,112 @@ implementation
end;
procedure tbrowser.browse_symbol(s : string);
var
sym,symb : psym;
symt : psymtable;
hp : pmodule;
ss : string;
p : byte;
procedure next_substring;
begin
p:=pos('.',s);
if p>0 then
begin
ss:=copy(s,1,p-1);
s:=copy(s,p+1,255);
end
else
begin
ss:=s;
s:='';
end;
end;
begin
symt:=symtablestack;
next_substring;
sym:=symt^.search(ss);
if not assigned(sym) then
begin
symt:=nil;
{ try all loaded_units }
hp:=pmodule(loaded_units.first);
while assigned(hp) do
begin
if hp^.modulename^=ss then
begin
symt:=hp^.symtable;
break;
end;
hp:=pmodule(hp^.next);
end;
if not assigned(symt) then
begin
addlog('!!!Symbol '+ss+' not found !!!');
exit;
end
else
begin
next_substring;
sym:=symt^.search(ss);
end;
end;
if (sym^.typ=unitsym) and (s<>'') then
begin
symt:=punitsym(sym)^.unitsymtable;
next_substring;
sym:=symt^.search(ss);
end;
while assigned(sym) and (s<>'') do
begin
next_substring;
case sym^.typ of
typesym :
begin
if ptypesym(sym)^.definition^.deftype in [recorddef,objectdef] then
begin
if ptypesym(sym)^.definition^.deftype=recorddef then
symt:=precdef(ptypesym(sym)^.definition)^.symtable
else
symt:=pobjectdef(ptypesym(sym)^.definition)^.publicsyms;
sym:=symt^.search(ss);
end;
end;
varsym :
begin
if pvarsym(sym)^.definition^.deftype in [recorddef,objectdef] then
begin
if pvarsym(sym)^.definition^.deftype=recorddef then
symt:=precdef(pvarsym(sym)^.definition)^.symtable
else
symt:=pobjectdef(pvarsym(sym)^.definition)^.publicsyms;
sym:=symt^.search(ss);
end;
end;
procsym :
begin
symt:=pprocsym(sym)^.definition^.parast;
symb:=symt^.search(ss);
if not assigned(symb) then
begin
symt:=pprocsym(sym)^.definition^.parast;
sym:=symt^.search(ss);
end
else
sym:=symb;
end;
{else
sym^.add_to_browserlog;}
end;
end;
if assigned(sym) then
sym^.add_to_browserlog
else
addlog('!!!Symbol '+ss+' not found !!!');
end;
procedure tbrowser.ident;
begin
inc(identidx,2);
@ -271,7 +408,7 @@ implementation
get_source_file:=f;
exit;
end;
f:=pinputfile(f^.next);
f:=pinputfile(f^.ref_next);
end;
end;
@ -280,7 +417,27 @@ begin
end.
{
$Log$
Revision 1.6 1998-09-01 07:54:16 pierre
Revision 1.7 1998-09-21 08:45:05 pierre
+ added vmt_offset in tobjectdef.write for fututre use
(first steps to have objects without vmt if no virtual !!)
+ added fpu_used field for tabstractprocdef :
sets this level to 2 if the functions return with value in FPU
(is then set to correct value at parsing of implementation)
THIS MIGHT refuse some code with FPU expression too complex
that were accepted before and even in some cases
that don't overflow in fact
( like if f : float; is a forward that finally in implementation
only uses one fpu register !!)
Nevertheless I think that it will improve security on
FPU operations !!
* most other changes only for UseBrowser code
(added symtable references for record and objects)
local switch for refs to args and local of each function
(static symtable still missing)
UseBrowser still not stable and probably broken by
the definition hash array !!
Revision 1.6 1998/09/01 07:54:16 pierre
* UseBrowser a little updated (might still be buggy !!)
* bug in psub.pas in function specifier removed
* stdcall allowed in interface and in implementation

26
compiler/cg386cal.pas
View File

@ -883,6 +883,7 @@ implementation
new(r);
reset_reference(r^);
r^.base:=R_ESI;
r^.offset:= p^.procdefinition^._class^.vmt_offset;
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
end;
@ -930,6 +931,7 @@ implementation
new(r);
reset_reference(r^);
r^.base:=R_ESI;
r^.offset:= p^.procdefinition^._class^.vmt_offset;
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
end
else
@ -1024,6 +1026,8 @@ implementation
new(r);
reset_reference(r^);
r^.base:=R_ESI;
{ this is one point where we need vmt_offset (PM) }
r^.offset:= p^.procdefinition^._class^.vmt_offset;
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
new(r);
reset_reference(r^);
@ -1390,7 +1394,27 @@ implementation
end.
{
$Log$
Revision 1.25 1998-09-20 12:26:35 peter
Revision 1.26 1998-09-21 08:45:06 pierre
+ added vmt_offset in tobjectdef.write for fututre use
(first steps to have objects without vmt if no virtual !!)
+ added fpu_used field for tabstractprocdef :
sets this level to 2 if the functions return with value in FPU
(is then set to correct value at parsing of implementation)
THIS MIGHT refuse some code with FPU expression too complex
that were accepted before and even in some cases
that don't overflow in fact
( like if f : float; is a forward that finally in implementation
only uses one fpu register !!)
Nevertheless I think that it will improve security on
FPU operations !!
* most other changes only for UseBrowser code
(added symtable references for record and objects)
local switch for refs to args and local of each function
(static symtable still missing)
UseBrowser still not stable and probably broken by
the definition hash array !!
Revision 1.25 1998/09/20 12:26:35 peter
* merged fixes
Revision 1.24 1998/09/17 09:42:10 peter

24
compiler/cg386inl.pas
View File

@ -626,6 +626,8 @@ implementation
p^.location.loc:=LOC_REGISTER;
p^.location.register:=getregister32;
{ load VMT pointer }
inc(p^.left^.location.reference.offset,
pobjectdef(p^.left^.resulttype)^.vmt_offset);
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
newreference(p^.left^.location.reference),
p^.location.register)));
@ -934,7 +936,27 @@ implementation
end.
{
$Log$
Revision 1.6 1998-09-20 12:26:37 peter
Revision 1.7 1998-09-21 08:45:07 pierre
+ added vmt_offset in tobjectdef.write for fututre use
(first steps to have objects without vmt if no virtual !!)
+ added fpu_used field for tabstractprocdef :
sets this level to 2 if the functions return with value in FPU
(is then set to correct value at parsing of implementation)
THIS MIGHT refuse some code with FPU expression too complex
that were accepted before and even in some cases
that don't overflow in fact
( like if f : float; is a forward that finally in implementation
only uses one fpu register !!)
Nevertheless I think that it will improve security on
FPU operations !!
* most other changes only for UseBrowser code
(added symtable references for record and objects)
local switch for refs to args and local of each function
(static symtable still missing)
UseBrowser still not stable and probably broken by
the definition hash array !!
Revision 1.6 1998/09/20 12:26:37 peter
* merged fixes
Revision 1.5 1998/09/17 09:42:15 peter

27
compiler/csopt386.pas
View File

@ -278,7 +278,10 @@ Procedure RemoveInstructs(AsmL: PAasmOutput; First, Last: Pai);
{Removes the marked instructions and disposes the PPaiProps of the other
instructions, restoring theirline number}
Var p, hp1: Pai;
TmpLine, InstrCnt: Longint;
{$IfDef TP}
TmpLine: Longint;
{$EndIf TP}
InstrCnt: Longint;
Begin
p := First;
If (p^.typ in SkipInstr) Then
@ -324,7 +327,27 @@ End.
{
$Log$
Revision 1.7 1998-09-20 17:12:35 jonas
Revision 1.8 1998-09-21 08:45:09 pierre
+ added vmt_offset in tobjectdef.write for fututre use
(first steps to have objects without vmt if no virtual !!)
+ added fpu_used field for tabstractprocdef :
sets this level to 2 if the functions return with value in FPU
(is then set to correct value at parsing of implementation)
THIS MIGHT refuse some code with FPU expression too complex
that were accepted before and even in some cases
that don't overflow in fact
( like if f : float; is a forward that finally in implementation
only uses one fpu register !!)
Nevertheless I think that it will improve security on
FPU operations !!
* most other changes only for UseBrowser code
(added symtable references for record and objects)
local switch for refs to args and local of each function
(static symtable still missing)
UseBrowser still not stable and probably broken by
the definition hash array !!
Revision 1.7 1998/09/20 17:12:35 jonas
* small fix for uncertain optimizations & more cleaning up
Revision 1.5 1998/09/16 17:59:59 jonas

40
compiler/files.pas
View File

@ -94,6 +94,7 @@ unit files;
constructor init;
destructor done;
procedure register_file(f : pinputfile);
procedure inverse_register_indexes;
function get_file(l:longint) : pinputfile;
function get_file_name(l :longint):string;
function get_file_path(l :longint):string;
@ -485,6 +486,23 @@ unit files;
end;
{ this procedure is necessary after loading the
sources files from a PPU file PM }
procedure tfilemanager.inverse_register_indexes;
var
f : pinputfile;
begin
f:=files;
while assigned(f) do
begin
f^.ref_index:=last_ref_index-f^.ref_index+1;
f:=f^.ref_next;
end;
end;
function tfilemanager.get_file(l :longint) : pinputfile;
var
ff : pinputfile;
@ -869,7 +887,27 @@ unit files;
end.
{
$Log$
Revision 1.45 1998-09-18 09:58:51 peter
Revision 1.46 1998-09-21 08:45:10 pierre
+ added vmt_offset in tobjectdef.write for fututre use
(first steps to have objects without vmt if no virtual !!)
+ added fpu_used field for tabstractprocdef :
sets this level to 2 if the functions return with value in FPU
(is then set to correct value at parsing of implementation)
THIS MIGHT refuse some code with FPU expression too complex
that were accepted before and even in some cases
that don't overflow in fact
( like if f : float; is a forward that finally in implementation
only uses one fpu register !!)
Nevertheless I think that it will improve security on
FPU operations !!
* most other changes only for UseBrowser code
(added symtable references for record and objects)
local switch for refs to args and local of each function
(static symtable still missing)
UseBrowser still not stable and probably broken by
the definition hash array !!
Revision 1.45 1998/09/18 09:58:51 peter
* -s doesn't require the .o to be available, this allows compiling of
everything on other platforms (profiling the windows.pp loading ;)

33
compiler/parser.pas
View File

@ -355,10 +355,13 @@ unit parser;
{$ifdef UseBrowser}
{ Write Browser }
if cs_browser in aktmoduleswitches then
begin
Message1(parser_i_writing_browser_log,Browse.Fname);
write_browser_log;
end;
if Browse.elements_to_list^.empty then
begin
Message1(parser_i_writing_browser_log,Browse.Fname);
write_browser_log;
end
else
Browse.list_elements;
{$endif UseBrowser}
end;
@ -368,7 +371,27 @@ unit parser;
end.
{
$Log$
Revision 1.45 1998-09-18 08:01:35 pierre
Revision 1.46 1998-09-21 08:45:12 pierre
+ added vmt_offset in tobjectdef.write for fututre use
(first steps to have objects without vmt if no virtual !!)
+ added fpu_used field for tabstractprocdef :
sets this level to 2 if the functions return with value in FPU
(is then set to correct value at parsing of implementation)
THIS MIGHT refuse some code with FPU expression too complex
that were accepted before and even in some cases
that don't overflow in fact
( like if f : float; is a forward that finally in implementation
only uses one fpu register !!)
Nevertheless I think that it will improve security on
FPU operations !!
* most other changes only for UseBrowser code
(added symtable references for record and objects)
local switch for refs to args and local of each function
(static symtable still missing)
UseBrowser still not stable and probably broken by
the definition hash array !!
Revision 1.45 1998/09/18 08:01:35 pierre
+ improvement on the usebrowser part
(does not work correctly for now)

24
compiler/pass_1.pas
View File

@ -3644,10 +3644,8 @@ unit pass_1;
end;
end;
{$ifdef StoreFPULevel}
{ a fpu can be used in any procedure !! }
p^.registersfpu:=p^.procdefinition^.fpu_used;
{$endif StoreFPULevel}
{ if this is a call to a method calc the registers }
if (p^.methodpointer<>nil) then
begin
@ -5514,7 +5512,27 @@ unit pass_1;
end.
{
$Log$
Revision 1.87 1998-09-20 18:00:21 florian
Revision 1.88 1998-09-21 08:45:14 pierre
+ added vmt_offset in tobjectdef.write for fututre use
(first steps to have objects without vmt if no virtual !!)
+ added fpu_used field for tabstractprocdef :
sets this level to 2 if the functions return with value in FPU
(is then set to correct value at parsing of implementation)
THIS MIGHT refuse some code with FPU expression too complex
that were accepted before and even in some cases
that don't overflow in fact
( like if f : float; is a forward that finally in implementation
only uses one fpu register !!)
Nevertheless I think that it will improve security on
FPU operations !!
* most other changes only for UseBrowser code
(added symtable references for record and objects)
local switch for refs to args and local of each function
(static symtable still missing)
UseBrowser still not stable and probably broken by
the definition hash array !!
Revision 1.87 1998/09/20 18:00:21 florian
* small compiling problems fixed
Revision 1.86 1998/09/20 17:46:50 florian

24
compiler/pass_2.pas
View File

@ -470,9 +470,7 @@ implementation
make_const_global:=true;
do_secondpass(p);
{$ifdef StoreFPULevel}
procinfo.def^.fpu_used:=p^.registersfpu;
{$endif StoreFPULevel}
{ all registers can be used again }
resetusableregisters;
end;
@ -483,7 +481,27 @@ implementation
end.
{
$Log$
Revision 1.3 1998-09-17 09:42:40 peter
Revision 1.4 1998-09-21 08:45:16 pierre
+ added vmt_offset in tobjectdef.write for fututre use
(first steps to have objects without vmt if no virtual !!)
+ added fpu_used field for tabstractprocdef :
sets this level to 2 if the functions return with value in FPU
(is then set to correct value at parsing of implementation)
THIS MIGHT refuse some code with FPU expression too complex
that were accepted before and even in some cases
that don't overflow in fact
( like if f : float; is a forward that finally in implementation
only uses one fpu register !!)
Nevertheless I think that it will improve security on
FPU operations !!
* most other changes only for UseBrowser code
(added symtable references for record and objects)
local switch for refs to args and local of each function
(static symtable still missing)
UseBrowser still not stable and probably broken by
the definition hash array !!
Revision 1.3 1998/09/17 09:42:40 peter
+ pass_2 for cg386
* Message() -> CGMessage() for pass_1/pass_2

27
compiler/pmodules.pas
View File

@ -178,7 +178,7 @@ unit pmodules;
var
pu : pused_unit;
loaded_unit : pmodule;
nextmapentry,firstimplementation : longint;
nextmapentry : longint;
begin
{ init the map }
new(current_module^.map);
@ -210,7 +210,6 @@ unit pmodules;
end;
pu:=pused_unit(pu^.next);
end;
firstimplementation:=nextmapentry;
{ ok, now load the unit }
current_module^.symtable:=new(punitsymtable,loadasunit);
{ if this is the system unit insert the intern symbols }
@ -254,7 +253,7 @@ unit pmodules;
if cs_browser in aktmoduleswitches then
begin
punitsymtable(current_module^.symtable)^.
load_implementation_refs(firstimplementation);
load_symtable_refs;
end;
{$endif UseBrowser}
{ remove the map, it's not needed anymore }
@ -925,7 +924,27 @@ unit pmodules;
end.
{
$Log$
Revision 1.49 1998-09-18 08:01:36 pierre
Revision 1.50 1998-09-21 08:45:17 pierre
+ added vmt_offset in tobjectdef.write for fututre use
(first steps to have objects without vmt if no virtual !!)
+ added fpu_used field for tabstractprocdef :
sets this level to 2 if the functions return with value in FPU
(is then set to correct value at parsing of implementation)
THIS MIGHT refuse some code with FPU expression too complex
that were accepted before and even in some cases
that don't overflow in fact
( like if f : float; is a forward that finally in implementation
only uses one fpu register !!)
Nevertheless I think that it will improve security on
FPU operations !!
* most other changes only for UseBrowser code
(added symtable references for record and objects)
local switch for refs to args and local of each function
(static symtable still missing)
UseBrowser still not stable and probably broken by
the definition hash array !!
Revision 1.49 1998/09/18 08:01:36 pierre
+ improvement on the usebrowser part
(does not work correctly for now)

28
compiler/ppu.pas
View File

@ -70,7 +70,9 @@ const
ibabsolutesym = 26;
ibpropertysym = 27;
ibvarsym_C = 28;
{defenitions}
ibunitsym = 29; { needed for browser }
iblabelsym = 30;
{definitions}
iborddef = 40;
ibpointerdef = 41;
ibarraydef = 42;
@ -99,7 +101,7 @@ const
uf_in_library = $40; { is the file in another file than <ppufile>.* ? }
uf_static_linked = $80;
uf_shared_linked = $100;
uf_local_browser = $200;
type
{$ifdef m68k}
@ -772,7 +774,27 @@ end;
end.
{
$Log$
Revision 1.12 1998-09-18 08:01:37 pierre
Revision 1.13 1998-09-21 08:45:18 pierre
+ added vmt_offset in tobjectdef.write for fututre use
(first steps to have objects without vmt if no virtual !!)
+ added fpu_used field for tabstractprocdef :
sets this level to 2 if the functions return with value in FPU
(is then set to correct value at parsing of implementation)
THIS MIGHT refuse some code with FPU expression too complex
that were accepted before and even in some cases
that don't overflow in fact
( like if f : float; is a forward that finally in implementation
only uses one fpu register !!)
Nevertheless I think that it will improve security on
FPU operations !!
* most other changes only for UseBrowser code
(added symtable references for record and objects)
local switch for refs to args and local of each function
(static symtable still missing)
UseBrowser still not stable and probably broken by
the definition hash array !!
Revision 1.12 1998/09/18 08:01:37 pierre
+ improvement on the usebrowser part
(does not work correctly for now)

108
compiler/symdef.inc
View File

@ -1774,9 +1774,7 @@
begin
inherited init;
para1:=nil;
{$ifdef StoreFPULevel}
fpu_used:=255;
{$endif StoreFPULevel}
fpu_used:=0;
options:=0;
retdef:=voiddef;
savesize:=Sizeof(pointer);
@ -1810,6 +1808,15 @@
para1:=hp;
end;
{ all functions returning in FPU are
assume to use 2 FPU registers
until the function implementation
is processed PM }
procedure tabstractprocdef.test_if_fpu_result;
begin
if assigned(retdef) and is_fpu(retdef) then
fpu_used:=2;
end;
procedure tabstractprocdef.deref;
var
@ -1833,9 +1840,7 @@
begin
inherited load;
retdef:=readdefref;
{$ifdef StoreFPULevel}
fpu_used:=readbyte;
{$endif StoreFPULevel}
options:=readlong;
count:=readword;
para1:=nil;
@ -1888,9 +1893,7 @@
begin
inherited write;
writedefref(retdef);
{$ifdef StoreFPULevel}
writebyte(fpu_used);
{$endif StoreFPULevel}
writelong(options);
hp:=para1;
count:=0;
@ -2046,23 +2049,37 @@
procedure tprocdef.load_references;
var
pos : tfileposinfo;
move_last : boolean;
begin
move_last:=lastwritten=lastref;
while (not current_ppu^.endofentry) do
begin
readposinfo(pos);
inc(refcount);
lastref:=new(pref,init(lastref,@pos));
lastref^.is_written:=true;
if refcount=1 then
defref:=lastref;
end;
if move_last then
lastwritten:=lastref;
if (current_module^.flags and uf_local_browser)<>0 then
begin
new(parast,load);
parast^.load_browser;
new(localst,load);
localst^.load_browser;
end;
end;
procedure tprocdef.write_references;
function tprocdef.write_references : boolean;
var
ref : pref;
move_last : boolean;
begin
if lastwritten=lastref then
move_last:=lastwritten=lastref;
if move_last and ((current_module^.flags and uf_local_browser)=0) then
exit;
{ write address of this symbol }
writedefref(@self);
@ -2072,12 +2089,35 @@
else
ref:=defref;
while assigned(ref) do
begin
writeposinfo(ref^.posinfo);
ref:=ref^.nextref;
end;
begin
if ref^.moduleindex=current_module^.unit_index then
begin
writeposinfo(ref^.posinfo);
ref^.is_written:=true;
if move_last then
lastwritten:=ref;
end
else if not ref^.is_written then
move_last:=false
else if move_last then
lastwritten:=ref;
ref:=ref^.nextref;
end;
current_ppu^.writeentry(ibdefref);
lastwritten:=lastref;
write_references:=true;
if (current_module^.flags and uf_local_browser)<>0 then
begin
{ we need dummy para and local symtables
PPU files are then easier to read PM }
if not assigned(parast) then
parast:=new(psymtable,init(parasymtable));
parast^.write;
parast^.write_browser;
if not assigned(localst) then
localst:=new(psymtable,init(localsymtable));
localst^.write;
localst^.write_browser;
end;
end;
@ -2087,10 +2127,13 @@
begin
Browse.AddLog('***'+mangledname);
Browse.AddLogRefs(defref);
if assigned(parast) then
parast^.writebrowserlog;
if assigned(localst) then
localst^.writebrowserlog;
if (current_module^.flags and uf_local_browser)<>0 then
begin
if assigned(parast) then
parast^.writebrowserlog;
if assigned(localst) then
localst^.writebrowserlog;
end;
end;
end;
{$endif UseBrowser}
@ -2317,12 +2360,12 @@
begin
{ here we cannot get a real good value so just give something }
{ plausible (PM) }
{$ifdef StoreFPULevel}
{ a more secure way would be
to allways store in a temp }
if is_fpu(retdef) then
fpu_used:=2
else
fpu_used:=0;
{$endif StoreFPULevel}
inherited write;
current_ppu^.writeentry(ibprocvardef);
end;
@ -2417,6 +2460,7 @@
deftype:=objectdef;
childof:=c;
options:=0;
vmt_offset:=0;
{ some options are inherited !! }
if assigned(c) then
options:= c^.options and
@ -2447,6 +2491,7 @@
tdef.load;
deftype:=objectdef;
savesize:=readlong;
vmt_offset:=readlong;
name:=stringdup(readstring);
childof:=pobjectdef(readdefref);
options:=readlong;
@ -2601,6 +2646,7 @@
begin
tdef.write;
writelong(size);
writelong(vmt_offset);
writestring(name^);
writedefref(childof);
writelong(options);
@ -2969,7 +3015,27 @@
{
$Log$
Revision 1.45 1998-09-20 08:31:29 florian
Revision 1.46 1998-09-21 08:45:21 pierre
+ added vmt_offset in tobjectdef.write for fututre use
(first steps to have objects without vmt if no virtual !!)
+ added fpu_used field for tabstractprocdef :
sets this level to 2 if the functions return with value in FPU
(is then set to correct value at parsing of implementation)
THIS MIGHT refuse some code with FPU expression too complex
that were accepted before and even in some cases
that don't overflow in fact
( like if f : float; is a forward that finally in implementation
only uses one fpu register !!)
Nevertheless I think that it will improve security on
FPU operations !!
* most other changes only for UseBrowser code
(added symtable references for record and objects)
local switch for refs to args and local of each function
(static symtable still missing)
UseBrowser still not stable and probably broken by
the definition hash array !!
Revision 1.45 1998/09/20 08:31:29 florian
+ bit 6 of tpropinfo.propprocs is set, if the property contains a
constant index

40
compiler/symppu.inc
View File

@ -133,18 +133,13 @@
procedure writesourcefiles;
var
hp : pinputfile;
index : longint;
begin
{ second write the used source files }
hp:=current_module^.sourcefiles.files;
index:=current_module^.sourcefiles.last_ref_index;
while assigned(hp) do
begin
{ only name and extension }
current_ppu^.putstring(hp^.name^);
{ index in that order }
hp^.ref_index:=index;
dec(index);
hp:=hp^.ref_next;
end;
current_ppu^.writeentry(ibsourcefiles);
@ -380,17 +375,20 @@
temp:=temp+' *'
end;
end;
{$ifdef UseBrowser}
new(hp,init(hs));
{ the indexing is wrong here PM }
current_module^.sourcefiles.register_file(hp);
{$endif UseBrowser}
end;
Message1(unit_t_ppu_source,hs+temp);
{$ifdef UseBrowser}
new(hp,init(hs));
{ the indexing should match what is done in writeasunit }
current_module^.sourcefiles.register_file(hp);
{$endif UseBrowser}
end;
{ main source is always the last }
stringdispose(current_module^.mainsource);
current_module^.mainsource:=stringdup(hs);
{ the indexing is corrected here PM }
current_module^.sourcefiles.inverse_register_indexes;
{ check if we want to rebuild every unit, only if the sources are
available }
if do_build and current_module^.sources_avail then
@ -441,7 +439,27 @@
{
$Log$
Revision 1.14 1998-09-01 07:54:24 pierre
Revision 1.15 1998-09-21 08:45:23 pierre
+ added vmt_offset in tobjectdef.write for fututre use
(first steps to have objects without vmt if no virtual !!)
+ added fpu_used field for tabstractprocdef :
sets this level to 2 if the functions return with value in FPU
(is then set to correct value at parsing of implementation)
THIS MIGHT refuse some code with FPU expression too complex
that were accepted before and even in some cases
that don't overflow in fact
( like if f : float; is a forward that finally in implementation
only uses one fpu register !!)
Nevertheless I think that it will improve security on
FPU operations !!
* most other changes only for UseBrowser code
(added symtable references for record and objects)
local switch for refs to args and local of each function
(static symtable still missing)
UseBrowser still not stable and probably broken by
the definition hash array !!
Revision 1.14 1998/09/01 07:54:24 pierre
* UseBrowser a little updated (might still be buggy !!)
* bug in psub.pas in function specifier removed
* stdcall allowed in interface and in implementation

124
compiler/symsym.inc
View File

@ -76,27 +76,38 @@
procedure tsym.load_references;
var
pos : tfileposinfo;
move_last : boolean;
begin
move_last:=lastwritten=lastref;
while (not current_ppu^.endofentry) do
begin
readposinfo(pos);
inc(refcount);
lastref:=new(pref,init(lastref,@pos));
lastref^.is_written:=true;
if refcount=1 then
defref:=lastref;
end;
lastwritten:=lastref;
if move_last then
lastwritten:=lastref;
end;
procedure tsym.write_references;
{ big problem here :
wrong refs were written because of
interface parsing of other units PM
moduleindex must be checked !! }
function tsym.write_references : boolean;
var
ref : pref;
prdef : pdef;
symref_written,move_last : boolean;
begin
write_references:=false;
if lastwritten=lastref then
exit;
{ write address to this symbol }
writesymref(@self);
{ should we update lastref }
move_last:=true;
symref_written:=false;
{ write symbol refs }
if assigned(lastwritten) then
ref:=lastwritten
@ -104,17 +115,32 @@
ref:=defref;
while assigned(ref) do
begin
writeposinfo(ref^.posinfo);
if ref^.moduleindex=current_module^.unit_index then
begin
{ write address to this symbol }
if not symref_written then
begin
writesymref(@self);
symref_written:=true;
end;
writeposinfo(ref^.posinfo);
ref^.is_written:=true;
if move_last then
lastwritten:=ref;
end
else if not ref^.is_written then
move_last:=false
else if move_last then
lastwritten:=ref;
ref:=ref^.nextref;
end;
lastwritten:=lastref;
current_ppu^.writeentry(ibsymref);
if symref_written then
current_ppu^.writeentry(ibsymref);
write_references:=symref_written;
end;
procedure tsym.add_to_browserlog;
var
prdef : pprocdef;
begin
if assigned(defref) then
begin
@ -147,10 +173,6 @@
writestring(name);
if object_options then
writebyte(byte(properties));
{$ifdef UseBrowser}
{ if cs_browser in aktmoduleswitches then
write_references; }
{$endif UseBrowser}
end;
procedure tsym.deref;
@ -237,6 +259,17 @@
defined:=false;
end;
constructor tlabelsym.load;
begin
tsym.load;
typ:=labelsym;
{ this is all dummy
it is only used for local browsing }
number:=nil;
defined:=true;
end;
destructor tlabelsym.done;
begin
@ -255,7 +288,13 @@
procedure tlabelsym.write;
begin
Message(sym_e_ill_label_decl);
if owner^.symtabletype in [unitsymtable,globalsymtable] then
Message(sym_e_ill_label_decl)
else
begin
tsym.write;
current_ppu^.writeentry(iblabelsym);
end;
end;
{****************************************************************************
@ -277,6 +316,15 @@
refs:=0;
end;
constructor tunitsym.load;
begin
tsym.load;
typ:=unitsym;
unitsymtable:=punitsymtable(current_module^.symtable);
prevsym:=nil;
end;
destructor tunitsym.done;
begin
if assigned(unitsymtable) and (unitsymtable^.unitsym=@self) then
@ -286,6 +334,8 @@
procedure tunitsym.write;
begin
tsym.write;
current_ppu^.writeentry(ibunitsym);
end;
{$ifdef GDB}
@ -422,11 +472,14 @@
end;
end;
procedure tprocsym.write_references;
function tprocsym.write_references : boolean;
var
prdef : pprocdef;
begin
inherited write_references;
write_references:=false;
if not inherited write_references then
exit;
write_references:=true;
prdef:=definition;
while assigned(prdef) and (prdef^.owner=definition^.owner) do
begin
@ -1567,22 +1620,19 @@
pobjectdef(definition)^.publicsyms^.load_browser;
end;
procedure ttypesym.write_references;
function ttypesym.write_references : boolean;
begin
if lastwritten<>lastref then
begin
inherited write_references;
end
if not inherited write_references then
{ write address of this symbol if record or object
even if no real refs are there
because we need it for the symtable }
else if (definition^.deftype=recorddef) or
(definition^.deftype=objectdef) then
if (definition^.deftype=recorddef) or
(definition^.deftype=objectdef) then
begin
writesymref(@self);
current_ppu^.writeentry(ibsymref);
end;
write_references:=true;
if (definition^.deftype=recorddef) then
precdef(definition)^.symtable^.write_browser;
if (definition^.deftype=objectdef) then
@ -1590,8 +1640,6 @@
end;
procedure ttypesym.add_to_browserlog;
var
aktobjdef : pobjectdef;
begin
inherited add_to_browserlog;
if (definition^.deftype=recorddef) then
@ -1669,7 +1717,27 @@
{
$Log$
Revision 1.44 1998-09-18 16:03:47 florian
Revision 1.45 1998-09-21 08:45:24 pierre
+ added vmt_offset in tobjectdef.write for fututre use
(first steps to have objects without vmt if no virtual !!)
+ added fpu_used field for tabstractprocdef :
sets this level to 2 if the functions return with value in FPU
(is then set to correct value at parsing of implementation)
THIS MIGHT refuse some code with FPU expression too complex
that were accepted before and even in some cases
that don't overflow in fact
( like if f : float; is a forward that finally in implementation
only uses one fpu register !!)
Nevertheless I think that it will improve security on
FPU operations !!
* most other changes only for UseBrowser code
(added symtable references for record and objects)
local switch for refs to args and local of each function
(static symtable still missing)
UseBrowser still not stable and probably broken by
the definition hash array !!
Revision 1.44 1998/09/18 16:03:47 florian
* some changes to compile with Delphi
Revision 1.43 1998/09/18 08:01:38 pierre

24
compiler/tree.pas
View File

@ -191,8 +191,6 @@ unit tree;
{$endif SUPPORT_MMX}
left,right : ptree;
resulttype : pdef;
{ line : longint;
fileindex,colon : word; }
fileinfo : tfileposinfo;
localswitches : tlocalswitches;
{$ifdef extdebug}
@ -1569,7 +1567,27 @@ unit tree;
end.
{
$Log$
Revision 1.38 1998-09-16 01:06:47 carl
Revision 1.39 1998-09-21 08:45:27 pierre
+ added vmt_offset in tobjectdef.write for fututre use
(first steps to have objects without vmt if no virtual !!)
+ added fpu_used field for tabstractprocdef :
sets this level to 2 if the functions return with value in FPU
(is then set to correct value at parsing of implementation)
THIS MIGHT refuse some code with FPU expression too complex
that were accepted before and even in some cases
that don't overflow in fact
( like if f : float; is a forward that finally in implementation
only uses one fpu register !!)
Nevertheless I think that it will improve security on
FPU operations !!
* most other changes only for UseBrowser code
(added symtable references for record and objects)
local switch for refs to args and local of each function
(static symtable still missing)
UseBrowser still not stable and probably broken by
the definition hash array !!
Revision 1.38 1998/09/16 01:06:47 carl
* crash bugfix in firstaddr
Revision 1.37 1998/09/08 10:38:04 pierre