* working browser and newppu

* some small fixes against crashes which occured in bp7 (but not in
    fpc?!)
This commit is contained in:
peter 1998-06-13 00:10:04 +00:00
parent c248434392
commit c614d62eaf
11 changed files with 593 additions and 477 deletions

View File

@ -1,8 +1,8 @@
{ {
$Id$ $Id$
Copyright (c) 1996-98 by Florian Klaempfl Copyright (c) 1993-98 by the FPC development team
This unit implements a browser object Support routines for the browser
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
@ -17,78 +17,98 @@
You should have received a copy of the GNU General Public License You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
****************************************************************************
}
{$ifdef TP}
{$N+,E+}
{$endif}
unit browser; unit browser;
interface interface
uses
cobjects,files;
uses globals,cobjects,files; const
{$ifdef TP}
logbufsize = 1024;
{$else}
logbufsize = 16384;
{$endif}
type type
pref = ^tref; pref = ^tref;
tref = object tref = object
nextref : pref; nextref : pref;
posinfo : tfileposinfo; posinfo : tfileposinfo;
moduleindex : word; moduleindex : word;
constructor init(ref : pref;pos : pfileposinfo); constructor init(ref:pref;pos:pfileposinfo);
constructor load(var ref : pref;fileindex : word;line,column : longint); destructor done; virtual;
destructor done; virtual; function get_file_line : string;
function get_file_line : string; end;
end;
{ simple method to chain all refs } pbrowser=^tbrowser;
procedure add_new_ref(var ref : pref;pos : pfileposinfo); tbrowser=object
fname : string;
logopen : boolean;
f : file;
buf : pchar;
bufidx : longint;
identidx : longint;
constructor init;
destructor done;
procedure setfilename(const fn:string);
procedure createlog;
procedure flushlog;
procedure addlog(const s:string);
procedure addlogrefs(p:pref);
procedure closelog;
procedure ident;
procedure unident;
end;
var
browse : tbrowser;
function get_source_file(moduleindex,fileindex : word) : pinputfile; function get_source_file(moduleindex,fileindex : word) : pinputfile;
{ one big problem remains for overloaded procedure }
{ we should be able to separate them }
{ this might be feasable in pass_1 }
implementation implementation
uses scanner,verbose; uses
globals,systems,verbose;
constructor tref.init(ref :pref;pos : pfileposinfo); {****************************************************************************
TRef
****************************************************************************}
begin
nextref:=nil; constructor tref.init(ref :pref;pos : pfileposinfo);
if ref<>nil then begin
nextref:=nil;
if assigned(pos) then
posinfo:=pos^;
if assigned(current_module) then
moduleindex:=current_module^.unit_index;
if assigned(ref) then
ref^.nextref:=@self; ref^.nextref:=@self;
if assigned(pos) then end;
posinfo:=pos^;
if current_module<>nil then
begin
moduleindex:=current_module^.unit_index;
end;
end;
constructor tref.load(var ref : pref;fileindex : word;line,column : longint);
begin destructor tref.done;
moduleindex:=current_module^.unit_index; var
if assigned(ref) then inputfile : pinputfile;
ref^.nextref:=@self; ref : pref;
nextref:=nil; begin
posinfo.fileindex:=fileindex; inputfile:=get_source_file(moduleindex,posinfo.fileindex);
posinfo.line:=line; if inputfile<>nil then
posinfo.column:=column; dec(inputfile^.ref_count);
ref:=@self; ref:=@self;
end; if assigned(ref^.nextref) then
dispose(ref^.nextref,done);
nextref:=nil;
end;
destructor tref.done;
var
inputfile : pinputfile;
begin
inputfile:=get_source_file(moduleindex,posinfo.fileindex);
if inputfile<>nil then
dec(inputfile^.ref_count);
end;
function tref.get_file_line : string; function tref.get_file_line : string;
var var
inputfile : pinputfile; inputfile : pinputfile;
begin begin
@ -110,15 +130,125 @@ implementation
+tostr(posinfo.line)+','+tostr(posinfo.column)+')' +tostr(posinfo.line)+','+tostr(posinfo.column)+')'
end; end;
procedure add_new_ref(var ref : pref;pos : pfileposinfo); {****************************************************************************
TBrowser
****************************************************************************}
var constructor tbrowser.init;
newref : pref; begin
fname:=FixFileName('browser.log');
logopen:=false;
end;
destructor tbrowser.done;
begin
if logopen then
closelog;
end;
procedure tbrowser.setfilename(const fn:string);
begin
fname:=FixFileName(fn);
end;
procedure tbrowser.createlog;
begin
if logopen then
closelog;
assign(f,fname);
{$I-}
rewrite(f,1);
{$I+}
if ioresult<>0 then
exit;
logopen:=true;
getmem(buf,logbufsize);
bufidx:=0;
identidx:=0;
end;
procedure tbrowser.flushlog;
begin
if logopen then
blockwrite(f,buf^,bufidx);
bufidx:=0;
end;
procedure tbrowser.closelog;
begin
if logopen then
begin
flushlog;
close(f);
freemem(buf,logbufsize);
logopen:=false;
end;
end;
procedure tbrowser.addlog(const s:string);
begin
if not logopen then
exit;
{ add ident }
if identidx>0 then
begin
if bufidx+identidx>logbufsize then
flushlog;
fillchar(buf[bufidx],identidx,' ');
inc(bufidx,identidx);
end;
{ add text }
if bufidx+length(s)>logbufsize-2 then
flushlog;
move(s[1],buf[bufidx],length(s));
inc(bufidx,length(s));
{ add crlf }
buf[bufidx]:=target_os.newline[1];
inc(bufidx);
if length(target_os.newline)=2 then
begin
buf[bufidx]:=target_os.newline[2];
inc(bufidx);
end;
end;
procedure tbrowser.addlogrefs(p:pref);
var
ref : pref;
begin
ref:=p;
Ident;
while assigned(ref) do
begin
Browse.AddLog(ref^.get_file_line);
ref:=ref^.nextref;
end;
Unident;
end;
procedure tbrowser.ident;
begin
inc(identidx,2);
end;
procedure tbrowser.unident;
begin
dec(identidx,2);
end;
{****************************************************************************
Helpers
****************************************************************************}
begin
new(newref,init(ref,pos));
ref:=newref;
end;
function get_source_file(moduleindex,fileindex : word) : pinputfile; function get_source_file(moduleindex,fileindex : word) : pinputfile;
@ -145,10 +275,17 @@ implementation
end; end;
end; end;
begin
browse.init
end. end.
{ {
$Log$ $Log$
Revision 1.4 1998-06-11 10:11:57 peter Revision 1.5 1998-06-13 00:10:04 peter
* working browser and newppu
* some small fixes against crashes which occured in bp7 (but not in
fpc?!)
Revision 1.4 1998/06/11 10:11:57 peter
* -gb works again * -gb works again
Revision 1.3 1998/05/20 09:42:32 pierre Revision 1.3 1998/05/20 09:42:32 pierre
@ -167,34 +304,5 @@ end.
+ UseTokenInfo for better source position + UseTokenInfo for better source position
* fixed one remaining bug in scanner for line counts * fixed one remaining bug in scanner for line counts
* several little fixes * several little fixes
Revision 1.1.1.1 1998/03/25 11:18:12 root
* Restored version
Revision 1.5 1998/03/10 16:27:36 pierre
* better line info in stabs debug
* symtabletype and lexlevel separated into two fields of tsymtable
+ ifdef MAKELIB for direct library output, not complete
+ ifdef CHAINPROCSYMS for overloaded seach across units, not fully
working
+ ifdef TESTFUNCRET for setting func result in underfunction, not
working
Revision 1.4 1998/03/10 01:17:15 peter
* all files have the same header
* messages are fully implemented, EXTDEBUG uses Comment()
+ AG... files for the Assembler generation
Revision 1.3 1998/03/02 01:48:06 peter
* renamed target_DOS to target_GO32V1
+ new verbose system, merged old errors and verbose units into one new
verbose.pas, so errors.pas is obsolete
Revision 1.2 1998/02/13 10:34:37 daniel
* Made Motorola version compilable.
* Fixed optimizer
Revision 1.1.1.1 1997/11/27 08:32:51 michael
FPC Compiler CVS start
} }

View File

@ -210,8 +210,8 @@ unit files;
{ unit flags } { unit flags }
uf_init = $1; uf_init = $1;
uf_uses_dbx = $2; uf_has_dbx = $2;
uf_uses_browser = $4; uf_has_browser = $4;
uf_in_library = $8; uf_in_library = $8;
uf_shared_library = $10; uf_shared_library = $10;
uf_big_endian = $20; uf_big_endian = $20;
@ -945,7 +945,12 @@ unit files;
end. end.
{ {
$Log$ $Log$
Revision 1.20 1998-06-12 14:50:48 peter Revision 1.21 1998-06-13 00:10:05 peter
* working browser and newppu
* some small fixes against crashes which occured in bp7 (but not in
fpc?!)
Revision 1.20 1998/06/12 14:50:48 peter
* removed the tree dependency to types.pas * removed the tree dependency to types.pas
* long_fil.pas support (not fully tested yet) * long_fil.pas support (not fully tested yet)

View File

@ -36,6 +36,9 @@ unit parser;
systems,cobjects,globals,verbose, systems,cobjects,globals,verbose,
symtable,files,aasm,hcodegen, symtable,files,aasm,hcodegen,
assemble,link,script,gendef, assemble,link,script,gendef,
{$ifdef UseBrowser}
browser,
{$endif UseBrowser}
scanner,pbase,pdecl,psystem,pmodules; scanner,pbase,pdecl,psystem,pmodules;
@ -82,6 +85,7 @@ unit parser;
oldpreprocstack : ppreprocstack; oldpreprocstack : ppreprocstack;
oldorgpattern,oldprocprefix : string; oldorgpattern,oldprocprefix : string;
old_block_type : tblock_type; old_block_type : tblock_type;
oldlastlinepos,
oldinputbuffer, oldinputbuffer,
oldinputpointer : pchar; oldinputpointer : pchar;
olds_point,oldparse_only : boolean; olds_point,oldparse_only : boolean;
@ -196,6 +200,7 @@ unit parser;
oldinputbuffer:=inputbuffer; oldinputbuffer:=inputbuffer;
oldinputpointer:=inputpointer; oldinputpointer:=inputpointer;
oldlastlinepos:=lastlinepos;
olds_point:=s_point; olds_point:=s_point;
oldc:=c; oldc:=c;
oldcomment_level:=comment_level; oldcomment_level:=comment_level;
@ -235,30 +240,38 @@ unit parser;
aktoptprocessor:=initoptprocessor; aktoptprocessor:=initoptprocessor;
aktasmmode:=initasmmode; aktasmmode:=initasmmode;
{ we need this to make the system unit } { we need this to make the system unit }
if compile_system then if compile_system then
aktswitches:=aktswitches+[cs_compilesystem]; aktswitches:=aktswitches+[cs_compilesystem];
{ macros } { macros }
macros:=new(psymtable,init(macrosymtable)); macros:=new(psymtable,init(macrosymtable));
macros^.name:=stringdup('Conditionals for '+filename); macros^.name:=stringdup('Conditionals for '+filename);
define_macros; define_macros;
{ startup scanner } { startup scanner }
token:=yylex; token:=yylex;
{ init code generator for a new module } { init code generator for a new module }
codegen_newmodule; codegen_newmodule;
{$ifdef GDB} {$ifdef GDB}
reset_gdb_info; reset_gdb_info;
{$endif GDB} {$endif GDB}
{ global switches are read, so further changes aren't allowed } { global switches are read, so further changes aren't allowed }
current_module^.in_main:=true; current_module^.in_main:=true;
{ open assembler response } { Handle things which need to be once }
if (compile_level=1) then if (compile_level=1) then
AsmRes.Init('ppas'); begin
{ open assembler response }
AsmRes.Init('ppas');
{$ifdef UseBrowser}
{ open browser if set }
if cs_browser in initswitches then
Browse.CreateLog;
{$endif UseBrowser}
end;
{ if the current file isn't a system unit } { if the current file isn't a system unit }
{ the the system unit will be loaded } { the the system unit will be loaded }
@ -339,7 +352,6 @@ unit parser;
Linker.MakeExecutable; Linker.MakeExecutable;
end; end;
end; end;
end end
else else
Message1(unit_f_errors_in_unit,tostr(status.errorcount)); Message1(unit_f_errors_in_unit,tostr(status.errorcount));
@ -373,11 +385,14 @@ done:
procprefix:=oldprocprefix; procprefix:=oldprocprefix;
{ close the inputfiles }
{$ifdef UseBrowser} {$ifdef UseBrowser}
{ we need the names for the browser ! } { close input files, but dont remove if we use the browser ! }
current_module^.sourcefiles.close_all; if cs_browser in initswitches then
current_module^.sourcefiles.close_all
else
current_module^.sourcefiles.done;
{$else UseBrowser} {$else UseBrowser}
{ close the inputfiles }
current_module^.sourcefiles.done; current_module^.sourcefiles.done;
{$endif not UseBrowser} {$endif not UseBrowser}
{ restore scanner state } { restore scanner state }
@ -398,6 +413,7 @@ done:
preprocstack:=oldpreprocstack; preprocstack:=oldpreprocstack;
inputbuffer:=oldinputbuffer; inputbuffer:=oldinputbuffer;
inputpointer:=oldinputpointer; inputpointer:=oldinputpointer;
lastlinepos:=oldlastlinepos;
s_point:=olds_point; s_point:=olds_point;
c:=oldc; c:=oldc;
comment_level:=oldcomment_level; comment_level:=oldcomment_level;
@ -417,6 +433,7 @@ done:
importssection:=oldimports; importssection:=oldimports;
exportssection:=oldexports; exportssection:=oldexports;
resourcesection:=oldresource; resourcesection:=oldresource;
rttilist:=oldrttilist;
{ restore current state } { restore current state }
aktswitches:=oldswitches; aktswitches:=oldswitches;
@ -425,13 +442,23 @@ done:
aktoptprocessor:=oldoptprocessor; aktoptprocessor:=oldoptprocessor;
aktasmmode:=oldasmmode; aktasmmode:=oldasmmode;
{ Shut down things when the last file is compiled }
if (compile_level=1) then if (compile_level=1) then
begin begin
{ Close script }
if (not AsmRes.Empty) then if (not AsmRes.Empty) then
begin begin
Message1(exec_i_closing_script,AsmRes.Fn); Message1(exec_i_closing_script,AsmRes.Fn);
AsmRes.WriteToDisk; AsmRes.WriteToDisk;
end; end;
{$ifdef UseBrowser}
{ Write Browser }
if cs_browser in initswitches then
begin
Comment(V_Info,'Writing Browser '+Browse.Fname);
write_browser_log;
end;
{$endif UseBrowser}
end; end;
dec(compile_level); dec(compile_level);
end; end;
@ -439,7 +466,12 @@ done:
end. end.
{ {
$Log$ $Log$
Revision 1.23 1998-06-08 22:59:48 peter Revision 1.24 1998-06-13 00:10:08 peter
* working browser and newppu
* some small fixes against crashes which occured in bp7 (but not in
fpc?!)
Revision 1.23 1998/06/08 22:59:48 peter
* smartlinking works for win32 * smartlinking works for win32
* some defines to exclude some compiler parts * some defines to exclude some compiler parts

View File

@ -171,7 +171,7 @@ unit pass_1;
end; end;
function is_assignment_overloaded(from_def,to_def : pdef) : boolean;forward; function is_assignment_overloaded(from_def,to_def : pdef) : boolean;forward;
function isconvertable(def_from,def_to : pdef; function isconvertable(def_from,def_to : pdef;
var doconv : tconverttype;fromtreetype : ttreetyp; var doconv : tconverttype;fromtreetype : ttreetyp;
explicit : boolean) : boolean; explicit : boolean) : boolean;
@ -2589,7 +2589,7 @@ unit pass_1;
overloaded function overloaded function
this is the reason why it is not in the parser this is the reason why it is not in the parser
PM } PM }
procedure test_protected_sym(sym : psym); procedure test_protected_sym(sym : psym);
begin begin
@ -2599,7 +2599,7 @@ unit pass_1;
(pobjectdef(sym^.owner^.defowner)^.owner^.symtabletype=unitsymtable))) then (pobjectdef(sym^.owner^.defowner)^.owner^.symtabletype=unitsymtable))) then
Message(parser_e_cant_access_protected_member); Message(parser_e_cant_access_protected_member);
end; end;
procedure test_protected(p : ptree); procedure test_protected(p : ptree);
begin begin
@ -2623,7 +2623,7 @@ unit pass_1;
test_protected_sym(p^.vs); test_protected_sym(p^.vs);
end; end;
end; end;
procedure firstcallparan(var p : ptree;defcoll : pdefcoll); procedure firstcallparan(var p : ptree;defcoll : pdefcoll);
var store_valid : boolean; var store_valid : boolean;
@ -3210,7 +3210,7 @@ unit pass_1;
if make_ref then if make_ref then
begin begin
get_cur_file_pos(curtokenpos); get_cur_file_pos(curtokenpos);
add_new_ref(procs^.data^.lastref,@curtokenpos); procs^.data^.lastref:=new(pref,init(procs^.data^.lastref,@curtokenpos));
end; end;
{$endif UseBrowser} {$endif UseBrowser}
@ -5012,7 +5012,12 @@ unit pass_1;
end. end.
{ {
$Log$ $Log$
Revision 1.30 1998-06-12 10:32:28 pierre Revision 1.31 1998-06-13 00:10:09 peter
* working browser and newppu
* some small fixes against crashes which occured in bp7 (but not in
fpc?!)
Revision 1.30 1998/06/12 10:32:28 pierre
* column problem hopefully solved * column problem hopefully solved
+ C vars declaration changed + C vars declaration changed

View File

@ -203,10 +203,12 @@ unit pmodules;
{ ok, now load the unit } { ok, now load the unit }
hp^.symtable:=new(punitsymtable,load(hp)); hp^.symtable:=new(punitsymtable,load(hp));
{ if this is the system unit insert the intern symbols } { if this is the system unit insert the intern symbols }
make_ref:=false;
if compile_system then if compile_system then
insertinternsyms(psymtable(hp^.symtable)); begin
make_ref:=true; make_ref:=false;
insertinternsyms(psymtable(hp^.symtable));
make_ref:=true;
end;
end; end;
{ now only read the implementation part } { now only read the implementation part }
hp^.in_implementation:=true; hp^.in_implementation:=true;
@ -715,10 +717,12 @@ unit pmodules;
p:=new(punitsymtable,init(staticsymtable,current_module^.modulename^)); p:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
{Generate a procsym.} {Generate a procsym.}
make_ref:=false;
aktprocsym:=new(Pprocsym,init(current_module^.modulename^+'_init')); aktprocsym:=new(Pprocsym,init(current_module^.modulename^+'_init'));
aktprocsym^.definition:=new(Pprocdef,init); aktprocsym^.definition:=new(Pprocdef,init);
aktprocsym^.definition^.options:=aktprocsym^.definition^.options or pounitinit; aktprocsym^.definition^.options:=aktprocsym^.definition^.options or pounitinit;
aktprocsym^.definition^.setmangledname(current_module^.modulename^+'_init'); aktprocsym^.definition^.setmangledname(current_module^.modulename^+'_init');
make_ref:=true;
{The generated procsym has a local symtable. Discard it and turn {The generated procsym has a local symtable. Discard it and turn
it into the static one.} it into the static one.}
@ -879,10 +883,12 @@ unit pmodules;
st:=new(punitsymtable,init(staticsymtable,current_module^.modulename^)); st:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
{Generate a procsym.} {Generate a procsym.}
make_ref:=false;
aktprocsym:=new(Pprocsym,init('main')); aktprocsym:=new(Pprocsym,init('main'));
aktprocsym^.definition:=new(Pprocdef,init); aktprocsym^.definition:=new(Pprocdef,init);
aktprocsym^.definition^.options:=aktprocsym^.definition^.options or poproginit; aktprocsym^.definition^.options:=aktprocsym^.definition^.options or poproginit;
aktprocsym^.definition^.setmangledname(target_os.Cprefix+'main'); aktprocsym^.definition^.setmangledname(target_os.Cprefix+'main');
make_ref:=true;
{The localst is a local symtable. Change it into the static {The localst is a local symtable. Change it into the static
symtable.} symtable.}
dispose(aktprocsym^.definition^.localst,done); dispose(aktprocsym^.definition^.localst,done);
@ -962,7 +968,12 @@ unit pmodules;
end. end.
{ {
$Log$ $Log$
Revision 1.27 1998-06-11 13:58:08 peter Revision 1.28 1998-06-13 00:10:10 peter
* working browser and newppu
* some small fixes against crashes which occured in bp7 (but not in
fpc?!)
Revision 1.27 1998/06/11 13:58:08 peter
* small fix to let newppu compile * small fix to let newppu compile
Revision 1.26 1998/06/09 16:01:47 pierre Revision 1.26 1998/06/09 16:01:47 pierre

View File

@ -1,4 +1,4 @@
{ {
$Id$ $Id$
Copyright (c) 1993-98 by Florian Klaempfl Copyright (c) 1993-98 by Florian Klaempfl
@ -195,13 +195,6 @@ var
procedure myexit;{$ifndef FPC}far;{$endif} procedure myexit;{$ifndef FPC}far;{$endif}
begin begin
exitproc:=oldexit; exitproc:=oldexit;
{$ifdef UseBrowser}
if browser_file_open then
begin
close(browserfile);
browser_file_open:=false;
end;
{$endif UseBrowser}
{$ifdef tp} {$ifdef tp}
if use_big then if use_big then
symbolstream.done; symbolstream.done;
@ -217,6 +210,11 @@ begin
erroraddr:=nil; erroraddr:=nil;
Writeln('Error: Out of memory'); Writeln('Error: Out of memory');
end; end;
else
begin
erroraddr:=nil;
Writeln('Error: Runtime Error ',exitcode);
end;
end; end;
{when the module is assigned, then the messagefile is also loaded} {when the module is assigned, then the messagefile is also loaded}
if assigned(current_module) and assigned(current_module^.current_inputfile) then if assigned(current_module) and assigned(current_module^.current_inputfile) then
@ -338,6 +336,9 @@ begin
{$ifdef linux} {$ifdef linux}
Message1(general_u_gcclibpath,Linker.librarysearchpath); Message1(general_u_gcclibpath,Linker.librarysearchpath);
{$endif} {$endif}
{$ifdef TP}
Comment(V_Info,'Memory: '+tostr(MemAvail)+' Bytes Free');
{$endif}
start:=getrealtime; start:=getrealtime;
compile(inputdir+inputfile+inputextension,false); compile(inputdir+inputfile+inputextension,false);
@ -349,6 +350,9 @@ begin
clearnodes; clearnodes;
done_symtable; done_symtable;
{$ifdef TP}
Comment(V_Info,'Memory: '+tostr(MemAvail)+' Bytes Free');
{$endif}
{$ifdef EXTDEBUG} {$ifdef EXTDEBUG}
Comment(V_Info,'Memory lost = '+tostr(EntryMemAvail-MemAvail)); Comment(V_Info,'Memory lost = '+tostr(EntryMemAvail-MemAvail));
{$endif EXTDEBUG} {$endif EXTDEBUG}
@ -360,7 +364,12 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.12 1998-05-23 01:21:23 peter Revision 1.13 1998-06-13 00:10:11 peter
* working browser and newppu
* some small fixes against crashes which occured in bp7 (but not in
fpc?!)
Revision 1.12 1998/05/23 01:21:23 peter
+ aktasmmode, aktoptprocessor, aktoutputformat + aktasmmode, aktoptprocessor, aktoutputformat
+ smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+ $LIBNAME to set the library name where the unit will be put in + $LIBNAME to set the library name where the unit will be put in

View File

@ -36,13 +36,15 @@ const
{$endif} {$endif}
{ppu entries} {ppu entries}
mainentryid = 1;
subentryid = 2;
{special} {special}
iberror = 0; iberror = 0;
ibenddefs = 250; ibenddefs = 250;
ibendsyms = 251; ibendsyms = 251;
ibendinterface = 252; ibendinterface = 252;
ibendimplementation = 253; ibendimplementation = 253;
ibentry = 254; ibendbrowser = 254;
ibend = 255; ibend = 255;
{general} {general}
ibmodulename = 1; ibmodulename = 1;
@ -54,7 +56,8 @@ const
iblinksharedlibs = 7; iblinksharedlibs = 7;
iblinkstaticlibs = 8; iblinkstaticlibs = 8;
ibdbxcount = 9; ibdbxcount = 9;
ibref = 10; ibsymref = 10;
ibdefref = 11;
{syms} {syms}
ibtypesym = 20; ibtypesym = 20;
ibprocsym = 21; ibprocsym = 21;
@ -65,7 +68,6 @@ const
ibabsolutesym = 26; ibabsolutesym = 26;
ibpropertysym = 27; ibpropertysym = 27;
ibvarsym_C = 28; ibvarsym_C = 28;
{defenitions} {defenitions}
iborddef = 40; iborddef = 40;
ibpointerdef = 41; ibpointerdef = 41;
@ -89,8 +91,8 @@ const
{ unit flags } { unit flags }
uf_init = $1; uf_init = $1;
uf_uses_dbx = $2; uf_has_dbx = $2;
uf_uses_browser = $4; uf_has_browser = $4;
uf_big_endian = $8; uf_big_endian = $8;
uf_in_library = $10; uf_in_library = $10;
uf_shared_library = $20; uf_shared_library = $20;
@ -113,7 +115,7 @@ type
tppuentry=packed record tppuentry=packed record
id : byte; id : byte;
nr : byte; nr : byte;
size : word; size : longint;
end; end;
pppufile=^tppufile; pppufile=^tppufile;
@ -133,10 +135,11 @@ type
bufstart, bufstart,
bufsize, bufsize,
bufidx : longint; bufidx : longint;
entry : tppuentry;
entrybufstart, entrybufstart,
entrystart, entrystart,
entryidx : longint; entryidx : longint;
entry : tppuentry;
entrytyp : byte;
constructor init(fn:string); constructor init(fn:string);
destructor done; destructor done;
@ -153,12 +156,14 @@ type
procedure skipdata(len:longint); procedure skipdata(len:longint);
function readentry:byte; function readentry:byte;
function EndOfEntry:boolean; function EndOfEntry:boolean;
procedure getdatabuf(var b;len:longint;var result:longint);
procedure getdata(var b;len:longint); procedure getdata(var b;len:longint);
function getbyte:byte; function getbyte:byte;
function getword:word; function getword:word;
function getlongint:longint; function getlongint:longint;
function getdouble:double; function getdouble:double;
function getstring:string; function getstring:string;
function skipuntilentry(untilb:byte):boolean;
{write} {write}
function create:boolean; function create:boolean;
procedure writeheader; procedure writeheader;
@ -352,6 +357,9 @@ begin
bufidx:=0; bufidx:=0;
Mode:=1; Mode:=1;
FillChar(entry,sizeof(tppuentry),0); FillChar(entry,sizeof(tppuentry),0);
entryidx:=0;
entrystart:=0;
entrybufstart:=0;
Error:=false; Error:=false;
open:=true; open:=true;
end; end;
@ -432,8 +440,9 @@ begin
if entryidx<entry.size then if entryidx<entry.size then
skipdata(entry.size-entryidx); skipdata(entry.size-entryidx);
readdata(entry,sizeof(tppuentry)); readdata(entry,sizeof(tppuentry));
entrystart:=bufstart+bufidx;
entryidx:=0; entryidx:=0;
if entry.id<>ibentry then if not entry.id in [mainentryid,subentryid] then
begin begin
readentry:=iberror; readentry:=iberror;
error:=true; error:=true;
@ -449,6 +458,17 @@ begin
end; end;
procedure tppufile.getdatabuf(var b;len:longint;var result:longint);
begin
if entryidx+len>entry.size then
result:=entry.size-entryidx
else
result:=len;
readdata(b,result);
inc(entryidx,result);
end;
procedure tppufile.getdata(var b;len:longint); procedure tppufile.getdata(var b;len:longint);
begin begin
if entryidx+len>entry.size then if entryidx+len>entry.size then
@ -470,9 +490,6 @@ begin
error:=true; error:=true;
exit; exit;
end; end;
{ if bufidx+1>bufsize then
getbyte:=ord(buf[bufidx]);
inc(bufidx);}
readdata(b,1); readdata(b,1);
getbyte:=b; getbyte:=b;
inc(entryidx); inc(entryidx);
@ -490,7 +507,6 @@ begin
error:=true; error:=true;
exit; exit;
end; end;
{ getword:=pword(@entrybuf[entrybufidx])^;}
readdata(w,2); readdata(w,2);
getword:=w; getword:=w;
inc(entryidx,2); inc(entryidx,2);
@ -510,8 +526,6 @@ begin
end; end;
readdata(l,4); readdata(l,4);
getlongint:=l; getlongint:=l;
{
getlongint:=plongint(@entrybuf[entrybufidx])^;}
inc(entryidx,4); inc(entryidx,4);
end; end;
@ -529,8 +543,6 @@ begin
end; end;
readdata(d,sizeof(double)); readdata(d,sizeof(double));
getdouble:=d; getdouble:=d;
{
getlongint:=plongint(@entrybuf[entrybufidx])^;}
inc(entryidx,sizeof(double)); inc(entryidx,sizeof(double));
end; end;
@ -547,11 +559,20 @@ begin
end; end;
ReadData(s[1],length(s)); ReadData(s[1],length(s));
getstring:=s; getstring:=s;
{ move(entrybuf[entrybufidx],s[1],length(s));}
inc(entryidx,length(s)); inc(entryidx,length(s));
end; end;
function tppufile.skipuntilentry(untilb:byte):boolean;
var
b : byte;
begin
repeat
b:=readentry;
until (b in [ibend,iberror]) or ((b=untilb) and (entry.id=mainentryid));
skipuntilentry:=(b=untilb);
end;
{***************************************************************************** {*****************************************************************************
TPPUFile Writing TPPUFile Writing
*****************************************************************************} *****************************************************************************}
@ -576,6 +597,7 @@ begin
Error:=false; Error:=false;
do_crc:=true; do_crc:=true;
size:=0; size:=0;
entrytyp:=mainentryid;
{start} {start}
NewEntry; NewEntry;
create:=true; create:=true;
@ -600,8 +622,6 @@ end;
procedure tppufile.writebuf; procedure tppufile.writebuf;
begin begin
if do_crc then
UpdateCrc32(crc,buf,bufidx);
blockwrite(f,buf^,bufidx); blockwrite(f,buf^,bufidx);
inc(bufstart,bufidx); inc(bufstart,bufidx);
bufidx:=0; bufidx:=0;
@ -641,7 +661,7 @@ procedure tppufile.NewEntry;
begin begin
with entry do with entry do
begin begin
id:=ibentry; id:=entrytyp;
nr:=ibend; nr:=ibend;
size:=0; size:=0;
end; end;
@ -659,15 +679,14 @@ var
opos : longint; opos : longint;
begin begin
{create entry} {create entry}
entry.id:=ibentry; entry.id:=entrytyp;
entry.nr:=ibnr; entry.nr:=ibnr;
entry.size:=entryidx; entry.size:=entryidx;
{it's already been sent to disk ?} {it's already been sent to disk ?}
if entrybufstart<>bufstart then if entrybufstart<>bufstart then
begin begin
{flush when the entry is partly in the new buffer} {flush to be sure}
if entrybufstart+sizeof(entry)>bufstart then WriteBuf;
WriteBuf;
{write entry} {write entry}
opos:=filepos(f); opos:=filepos(f);
seek(f,entrystart); seek(f,entrystart);
@ -685,6 +704,8 @@ end;
procedure tppufile.putdata(var b;len:longint); procedure tppufile.putdata(var b;len:longint);
begin begin
if do_crc then
crc:=UpdateCrc32(crc,b,len);
writedata(b,len); writedata(b,len);
inc(entryidx,len); inc(entryidx,len);
end; end;
@ -694,57 +715,47 @@ end;
procedure tppufile.putbyte(b:byte); procedure tppufile.putbyte(b:byte);
begin begin
writedata(b,1); writedata(b,1);
{
entrybuf[entrybufidx]:=chr(b);}
inc(entryidx); inc(entryidx);
end; end;
procedure tppufile.putword(w:word); procedure tppufile.putword(w:word);
type
pword = ^word;
begin begin
if change_endian then if change_endian then
w:=swap(w); w:=swap(w);
{ pword(@entrybuf[entrybufidx])^:=w;} putdata(w,2);
writedata(w,2);
inc(entryidx,2);
end; end;
procedure tppufile.putlongint(l:longint); procedure tppufile.putlongint(l:longint);
type
plongint = ^longint;
begin begin
{ plongint(@entrybuf[entrybufidx])^:=l;}
if change_endian then if change_endian then
l:=swap(l shr 16) or (longint(swap(l and $ffff)) shl 16); l:=swap(l shr 16) or (longint(swap(l and $ffff)) shl 16);
writedata(l,4); putdata(l,4);
inc(entryidx,4);
end; end;
procedure tppufile.putdouble(d:double); procedure tppufile.putdouble(d:double);
type
pdouble = ^double;
begin begin
{ plongint(@entrybuf[entrybufidx])^:=l;} putdata(d,sizeof(double));
writedata(d,sizeof(double));
inc(entryidx,sizeof(double));
end; end;
procedure tppufile.putstring(s:string); procedure tppufile.putstring(s:string);
begin begin
writedata(s,length(s)+1); putdata(s,length(s)+1);
{ move(s,entrybuf[entrybufidx],length(s)+1);}
inc(entryidx,length(s)+1);
end; end;
end. end.
{ {
$Log$ $Log$
Revision 1.4 1998-06-09 16:01:48 pierre Revision 1.5 1998-06-13 00:10:12 peter
* working browser and newppu
* some small fixes against crashes which occured in bp7 (but not in
fpc?!)
Revision 1.4 1998/06/09 16:01:48 pierre
+ added procedure directive parsing for procvars + added procedure directive parsing for procvars
(accepted are popstack cdecl and pascal) (accepted are popstack cdecl and pascal)
+ added C vars with the following syntax + added C vars with the following syntax

View File

@ -146,12 +146,11 @@ unit scanner;
c : char; c : char;
orgpattern, orgpattern,
pattern : string; pattern : string;
macrobuffer : ^tmacrobuffer; macrobuffer : pmacrobuffer;
lastlinepos, lastlinepos,
lasttokenpos, lasttokenpos,
inputbuffer, inputbuffer,
inputpointer : pchar; inputpointer : pchar;
{ parse_types, } { true, if type declarations are parsed }
s_point : boolean; s_point : boolean;
comment_level, comment_level,
yylexcount, yylexcount,
@ -263,19 +262,10 @@ unit scanner;
begin begin
get_current_col:=current_column; get_current_col:=current_column;
end; end;
function get_file_col : longint; function get_file_col : longint;
begin begin
(* how was expecting files larger than 2Go ??? get_file_col:=lasttokenpos-lastlinepos;
{$ifdef TP}
if lastlinepos<=lasttokenpos then
get_file_col:=longint(lasttokenpos)-longint(lastlinepos)
else
get_file_col:=longint(lastlinepos)-longint(lasttokenpos);
{$else}
get_file_col:=cardinal(lasttokenpos)-cardinal(lastlinepos);
{$endif} *)
get_file_col:=longint(lasttokenpos)-longint(lastlinepos);
end; end;
@ -346,6 +336,7 @@ unit scanner;
end; end;
inputbuffer[readsize]:=#0; inputbuffer[readsize]:=#0;
inputpointer:=inputbuffer; inputpointer:=inputbuffer;
lastlinepos:=inputpointer;
{ Set EOF when main source and at endoffile } { Set EOF when main source and at endoffile }
if eof(current_module^.current_inputfile^.f) then if eof(current_module^.current_inputfile^.f) then
begin begin
@ -363,6 +354,7 @@ unit scanner;
status.currentsource:=current_module^.current_inputfile^.name^+current_module^.current_inputfile^.ext^; status.currentsource:=current_module^.current_inputfile^.name^+current_module^.current_inputfile^.ext^;
inputbuffer:=current_module^.current_inputfile^.buf; inputbuffer:=current_module^.current_inputfile^.buf;
inputpointer:=inputbuffer+current_module^.current_inputfile^.bufpos; inputpointer:=inputbuffer+current_module^.current_inputfile^.bufpos;
lastlinepos:=inputpointer;
end; end;
{ load next char } { load next char }
c:=inputpointer^; c:=inputpointer^;
@ -522,7 +514,6 @@ unit scanner;
end; end;
end; end;
end; end;
{ readchar; }
c:=inputpointer^; c:=inputpointer^;
if c=#0 then if c=#0 then
reload reload
@ -539,7 +530,6 @@ unit scanner;
begin begin
while c in [' ',#9..#13] do while c in [' ',#9..#13] do
begin begin
{ readchar; }
c:=inputpointer^; c:=inputpointer^;
if c=#0 then if c=#0 then
reload reload
@ -576,7 +566,6 @@ unit scanner;
else else
found:=0; found:=0;
end; end;
{ readchar;}
c:=inputpointer^; c:=inputpointer^;
if c=#0 then if c=#0 then
reload reload
@ -584,7 +573,6 @@ unit scanner;
inc(longint(inputpointer)); inc(longint(inputpointer));
if c in [#10,#13] then if c in [#10,#13] then
linebreak; linebreak;
until (found=2); until (found=2);
end; end;
@ -605,7 +593,6 @@ unit scanner;
'}' : dec_comment_level; '}' : dec_comment_level;
#26 : Message(scan_f_end_of_file); #26 : Message(scan_f_end_of_file);
end; end;
{ readchar; }
c:=inputpointer^; c:=inputpointer^;
if c=#0 then if c=#0 then
reload reload
@ -669,7 +656,6 @@ unit scanner;
else else
found:=0; found:=0;
end; end;
{ readchar; }
c:=inputpointer^; c:=inputpointer^;
if c=#0 then if c=#0 then
reload reload
@ -728,9 +714,7 @@ unit scanner;
tokenpos.column:=get_file_col; tokenpos.column:=get_file_col;
tokenpos.fileindex:=current_module^.current_index; tokenpos.fileindex:=current_module^.current_index;
{ Check first for a identifier/keyword, this is 20+% faster (PFV) } { Check first for a identifier/keyword, this is 20+% faster (PFV) }
if c in ['_','A'..'Z','a'..'z'] then if c in ['_','A'..'Z','a'..'z'] then
begin begin
orgpattern:=readstring; orgpattern:=readstring;
@ -865,11 +849,11 @@ unit scanner;
if c='*' then if c='*' then
begin begin
skipoldtpcomment; skipoldtpcomment;
{$ifndef TP} {$ifndef TP}
yylex:=yylex(); yylex:=yylex();
{$else TP} {$else}
yylex:=yylex; yylex:=yylex;
{$endif TP} {$endif}
exit; exit;
end; end;
yylex:=LKLAMMER; yylex:=LKLAMMER;
@ -941,11 +925,11 @@ unit scanner;
end; end;
'/' : begin '/' : begin
skipdelphicomment; skipdelphicomment;
{$ifndef TP} {$ifndef TP}
yylex:=yylex(); yylex:=yylex();
{$else TP} {$else TP}
yylex:=yylex; yylex:=yylex;
{$endif TP} {$endif TP}
exit; exit;
end; end;
end; end;
@ -1199,8 +1183,6 @@ unit scanner;
with fileinfo do with fileinfo do
begin begin
line:=current_module^.current_inputfile^.line_no; line:=current_module^.current_inputfile^.line_no;
{fileinfo.fileindex:=current_module^.current_inputfile^.ref_index;}
{ should allways be the same !! }
fileindex:=current_module^.current_index; fileindex:=current_module^.current_index;
column:=get_current_col; column:=get_current_col;
end; end;
@ -1281,7 +1263,12 @@ unit scanner;
end. end.
{ {
$Log$ $Log$
Revision 1.24 1998-06-12 10:32:36 pierre Revision 1.25 1998-06-13 00:10:15 peter
* working browser and newppu
* some small fixes against crashes which occured in bp7 (but not in
fpc?!)
Revision 1.24 1998/06/12 10:32:36 pierre
* column problem hopefully solved * column problem hopefully solved
+ C vars declaration changed + C vars declaration changed

View File

@ -29,7 +29,8 @@
deftype:=abstractdef; deftype:=abstractdef;
owner := nil; owner := nil;
next := nil; next := nil;
number := 0; sym := nil;
indexnb := 0;
if registerdef then if registerdef then
symtablestack^.registerdef(@self); symtablestack^.registerdef(@self);
has_rtti:=false; has_rtti:=false;
@ -48,20 +49,19 @@
end; end;
lastglobaldef := @self; lastglobaldef := @self;
nextglobal := nil; nextglobal := nil;
sym := nil;
{$endif GDB} {$endif GDB}
end; end;
constructor tdef.load; constructor tdef.load;
begin begin
{$ifdef GDB}
deftype:=abstractdef; deftype:=abstractdef;
is_def_stab_written := false; indexnb := 0;
number := 0;
sym := nil; sym := nil;
owner := nil; owner := nil;
next := nil; next := nil;
has_rtti:=false; has_rtti:=false;
{$ifdef GDB}
is_def_stab_written := false;
globalnb := 0; globalnb := 0;
if assigned(lastglobaldef) then if assigned(lastglobaldef) then
begin begin
@ -580,7 +580,7 @@
constructor torddef.init(t : tbasetype;v,b : longint); constructor torddef.init(t : tbasetype;v,b : longint);
begin begin
tdef.init; inherited init;
deftype:=orddef; deftype:=orddef;
low:=v; low:=v;
high:=b; high:=b;
@ -590,7 +590,7 @@
constructor torddef.load; constructor torddef.load;
begin begin
tdef.load; inherited load;
deftype:=orddef; deftype:=orddef;
typ:=tbasetype(readbyte); typ:=tbasetype(readbyte);
low:=readlong; low:=readlong;
@ -910,7 +910,7 @@
_private : array[1..26] of byte; _private : array[1..26] of byte;
userdata : array[1..16] of byte; userdata : array[1..16] of byte;
name : string[79 or 255 for linux]; } name : string[79 or 255 for linux]; }
{$ifdef i386} {$ifdef i386}
if (target_info.target=target_GO32V1) or if (target_info.target=target_GO32V1) or
(target_info.target=target_GO32V2) then (target_info.target=target_GO32V2) then
@ -1356,13 +1356,11 @@
end; end;
function tarraydef.needs_rtti : boolean; function tarraydef.needs_rtti : boolean;
begin begin
needs_rtti:=definition^.needs_rtti; needs_rtti:=definition^.needs_rtti;
end; end;
procedure tarraydef.generate_rtti; procedure tarraydef.generate_rtti;
begin begin
{ first, generate the rtti of the element type, else we get mixed } { first, generate the rtti of the element type, else we get mixed }
{ up because the rtti would be mixed } { up because the rtti would be mixed }
@ -1797,14 +1795,16 @@
localst^.next:=parast; localst^.next:=parast;
{$ifdef UseBrowser} {$ifdef UseBrowser}
defref:=nil; defref:=nil;
if make_ref then
add_new_ref(defref,@tokenpos);
lastref:=defref;
lastwritten:=nil; lastwritten:=nil;
refcount:=1; refcount:=0;
if (cs_browser in aktswitches) and make_ref then
begin
defref:=new(pref,init(defref,@tokenpos));
inc(refcount);
end;
lastref:=defref;
{$endif UseBrowser} {$endif UseBrowser}
{ first, we assume, that all registers are used }
{ first, we assume, that all registers are used }
{$ifdef i386} {$ifdef i386}
usedregisters:=$ff; usedregisters:=$ff;
{$endif i386} {$endif i386}
@ -1821,10 +1821,8 @@
end; end;
constructor tprocdef.load; constructor tprocdef.load;
var var
s : string; s : string;
begin begin
{ deftype:=procdef; this is at the wrong place !! } { deftype:=procdef; this is at the wrong place !! }
inherited load; inherited load;
@ -1854,47 +1852,78 @@
localst:=nil; localst:=nil;
forwarddef:=false; forwarddef:=false;
{$ifdef UseBrowser} {$ifdef UseBrowser}
if (current_module^.flags and uf_uses_browser)<>0 then lastref:=nil;
load_references lastwritten:=nil;
else defref:=nil;
begin refcount:=0;
lastref:=nil; if (current_module^.flags and uf_has_browser)<>0 then
lastwritten:=nil; load_references;
defref:=nil;
refcount:=0;
end;
{$endif UseBrowser} {$endif UseBrowser}
end; end;
{$ifdef UseBrowser} {$ifdef UseBrowser}
{$ifdef NEWPPU}
procedure tprocdef.load_references; procedure tprocdef.load_references;
var
pos : tfileposinfo;
begin
while (not ppufile^.endofentry) do
begin
readposinfo(pos);
inc(refcount);
lastref:=new(pref,init(lastref,@pos));
if refcount=1 then
defref:=lastref;
end;
end;
var fileindex : word;
b : byte;
l,c : longint;
procedure tprocdef.write_references;
var
ref : pref;
begin
if lastwritten=lastref then
exit;
{ write address of this symbol }
writedefref(@self);
{ write refs }
if assigned(lastwritten) then
ref:=lastwritten
else
ref:=defref;
while assigned(ref) do
begin
writeposinfo(ref^.posinfo);
ref:=ref^.nextref;
end;
ppufile^.writeentry(ibdefref);
lastwritten:=lastref;
end;
{$else NEWPPU}
procedure tprocdef.load_references;
var
pos : tfileposinfo;
b : byte;
begin begin
b:=readbyte; b:=readbyte;
refcount:=0;
lastref:=nil;
lastwritten:=nil;
defref:=nil;
while b=ibref do while b=ibref do
begin begin
fileindex:=readword; readposinfo(pos);
l:=readlong;
c:=readword;
inc(refcount); inc(refcount);
lastref:=new(pref,load(lastref,fileindex,l,c)); lastref:=new(pref,init(lastref,@pos));
if refcount=1 then defref:=lastref; if refcount=1 then
defref:=lastref;
b:=readbyte; b:=readbyte;
end; end;
if b <> ibend then if b <> ibend then
{ Message(unit_f_ppu_read); Comment(V_fatal,'error in load_reference');
message disappeared ?? }
Comment(V_fatal,'error in load_reference');
end; end;
procedure tprocdef.write_references; procedure tprocdef.write_references;
var ref : pref; var ref : pref;
@ -1911,9 +1940,7 @@
while assigned(ref) do while assigned(ref) do
begin begin
writebyte(ibref); writebyte(ibref);
writeword(ref^.posinfo.fileindex); writeposinfo(ref^.posinfo);
writelong(ref^.posinfo.line);
writeword(ref^.posinfo.column);
ref:=ref^.nextref; ref:=ref^.nextref;
end; end;
lastwritten:=lastref; lastwritten:=lastref;
@ -1937,44 +1964,34 @@
while assigned(ref) do while assigned(ref) do
begin begin
writebyte(ibref); writebyte(ibref);
writeword(ref^.posinfo.fileindex); writeposinfo(ref^.posinfo);
writelong(ref^.posinfo.line);
writeword(ref^.posinfo.column);
ref:=ref^.nextref; ref:=ref^.nextref;
end; end;
lastwritten:=lastref; lastwritten:=lastref;
writebyte(ibend); writebyte(ibend);
ppufile.do_crc:=true; ppufile.do_crc:=false;
end; end;
procedure tprocdef.write_ref_to_file(var f : text);
var ref : pref; {$endif NEWPPU}
i : longint;
procedure tprocdef.add_to_browserlog;
begin begin
ref:=defref; if assigned(defref) then
if assigned(ref) then begin
begin Browse.AddLog('***'+mangledname);
for i:=1 to reffile_indent do Browse.AddLogRefs(defref);
system.write(f,' '); end;
writeln(f,'***',mangledname);
end;
inc(reffile_indent,2);
while assigned(ref) do
begin
for i:=1 to reffile_indent do
system.write(f,' ');
writeln(f,ref^.get_file_line);
ref:=ref^.nextref;
end;
dec(reffile_indent,2);
end; end;
{$endif UseBrowser} {$endif UseBrowser}
destructor tprocdef.done; destructor tprocdef.done;
begin begin
{$ifdef UseBrowser}
if assigned(defref) then
dispose(defref,done);
{$endif UseBrowser}
if assigned(parast) then if assigned(parast) then
dispose(parast,done); dispose(parast,done);
if assigned(localst) then if assigned(localst) then
@ -1983,13 +2000,12 @@
{$ifdef tp} {$ifdef tp}
not(use_big) and not(use_big) and
{$endif} {$endif}
assigned(_mangledname) then assigned(_mangledname) then
strdispose(_mangledname); strdispose(_mangledname);
inherited done; inherited done;
end; end;
procedure tprocdef.write; procedure tprocdef.write;
begin begin
{$ifndef NEWPPU} {$ifndef NEWPPU}
writebyte(ibprocdef); writebyte(ibprocdef);
@ -2019,14 +2035,9 @@
writeptree(ptree(code)); writeptree(ptree(code));
} }
end; end;
{$ifdef NEWPPU} {$ifdef NEWPPU}
ppufile^.writeentry(ibprocdef); ppufile^.writeentry(ibprocdef);
{$endif} {$endif}
{$ifdef UseBrowser}
if (current_module^.flags and uf_uses_browser)<>0 then
write_references;
{$endif UseBrowser}
end; end;
{$ifdef GDB} {$ifdef GDB}
@ -2620,7 +2631,12 @@
{ {
$Log$ $Log$
Revision 1.9 1998-06-12 14:10:37 michael Revision 1.10 1998-06-13 00:10:16 peter
* working browser and newppu
* some small fixes against crashes which occured in bp7 (but not in
fpc?!)
Revision 1.9 1998/06/12 14:10:37 michael
* Fixed wrong code for ansistring * Fixed wrong code for ansistring
Revision 1.8 1998/06/11 10:11:58 peter Revision 1.8 1998/06/11 10:11:58 peter
@ -2640,9 +2656,8 @@
for win32 for win32
Revision 1.4 1998/06/04 09:55:45 pierre Revision 1.4 1998/06/04 09:55:45 pierre
* demangled name of procsym reworked to become independant of the mangling scheme * demangled name of procsym reworked to become independant of the mangling
scheme
Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
Revision 1.3 1998/06/03 22:49:03 peter Revision 1.3 1998/06/03 22:49:03 peter
+ wordbool,longbool + wordbool,longbool
@ -2660,4 +2675,4 @@
* symtable adapted for $ifdef NEWPPU * symtable adapted for $ifdef NEWPPU
} }

View File

@ -42,31 +42,37 @@
ppufile^.putbyte(b); ppufile^.putbyte(b);
end; end;
procedure writeword(w:word); procedure writeword(w:word);
begin begin
ppufile^.putword(w); ppufile^.putword(w);
end; end;
procedure writelong(l:longint); procedure writelong(l:longint);
begin begin
ppufile^.putlongint(l); ppufile^.putlongint(l);
end; end;
procedure writedouble(d:double); procedure writedouble(d:double);
begin begin
ppufile^.putdata(d,sizeof(double)); ppufile^.putdata(d,sizeof(double));
end; end;
procedure writestring(const s:string); procedure writestring(const s:string);
begin begin
ppufile^.putstring(s); ppufile^.putstring(s);
end; end;
procedure writeset(var s); {You cannot pass an array[0..31] of byte!} procedure writeset(var s); {You cannot pass an array[0..31] of byte!}
begin begin
ppufile^.putdata(s,32); ppufile^.putdata(s,32);
end; end;
procedure writecontainer(var p:tstringcontainer;id:byte;hold:boolean); procedure writecontainer(var p:tstringcontainer;id:byte;hold:boolean);
var var
hcontainer : tstringcontainer; hcontainer : tstringcontainer;
@ -86,6 +92,7 @@
p:=hcontainer; p:=hcontainer;
end; end;
procedure writeposinfo(const p:tfileposinfo); procedure writeposinfo(const p:tfileposinfo);
begin begin
writeword(p.fileindex); writeword(p.fileindex);
@ -93,6 +100,7 @@
writeword(p.column); writeword(p.column);
end; end;
procedure writedefref(p : pdef); procedure writedefref(p : pdef);
begin begin
if p=nil then if p=nil then
@ -103,12 +111,11 @@
ppufile^.putword($ffff) ppufile^.putword($ffff)
else else
ppufile^.putword(p^.owner^.unitid); ppufile^.putword(p^.owner^.unitid);
ppufile^.putword(p^.number); ppufile^.putword(p^.indexnb);
end; end;
end; end;
{$ifdef UseBrowser}
procedure writesymref(p : psym); procedure writesymref(p : psym);
begin begin
if p=nil then if p=nil then
@ -122,13 +129,9 @@
writeword(p^.indexnb); writeword(p^.indexnb);
end; end;
end; end;
{$endif UseBrowser}
procedure writeunitas(const s : string;unit_symtable : punitsymtable);
{$ifdef UseBrowser} procedure writeunitas(const s : string;unittable : punitsymtable);
var
pus : punitsymtable;
{$endif UseBrowser}
begin begin
Message1(unit_u_ppu_write,s); Message1(unit_u_ppu_write,s);
@ -142,31 +145,25 @@
flags:=flags or uf_in_library; flags:=flags or uf_in_library;
end; end;
if use_dbx then if use_dbx then
flags:=flags or uf_uses_dbx; flags:=flags or uf_has_dbx;
if target_os.endian=en_big_endian then if target_os.endian=en_big_endian then
flags:=flags or uf_big_endian; flags:=flags or uf_big_endian;
{$ifdef UseBrowser} {$ifdef UseBrowser}
if use_browser then if cs_browser in aktswitches then
flags:=flags or uf_uses_browser; flags:=flags or uf_has_browser;
{$endif UseBrowser} {$endif UseBrowser}
end; end;
{ open ppufile }
ppufile:=new(pppufile,init(s)); ppufile:=new(pppufile,init(s));
ppufile^.change_endian:=source_os.endian<>target_os.endian; ppufile^.change_endian:=source_os.endian<>target_os.endian;
if not ppufile^.create then if not ppufile^.create then
Message(unit_f_ppu_cannot_write); Message(unit_f_ppu_cannot_write);
unit_symtable^.writeasunit;
{$ifdef UseBrowser} { write symbols and definitions }
{ write all new references to old unit elements } unittable^.writeasunit;
pus:=punitsymtable(unit_symtable^.next);
if use_browser then { flush to be sure }
while assigned(pus) do
begin
if pus^.symtabletype = unitsymtable then
pus^.write_external_references;
pus:=punitsymtable(pus^.next);
end;
{$endif UseBrowser}
ppufile^.flush; ppufile^.flush;
{ create and write header } { create and write header }
ppufile^.header.size:=ppufile^.size; ppufile^.header.size:=ppufile^.size;
@ -234,6 +231,7 @@
p:=hcontainer; p:=hcontainer;
end; end;
procedure writeposinfo(const p:tfileposinfo); procedure writeposinfo(const p:tfileposinfo);
begin begin
writeword(p.fileindex); writeword(p.fileindex);
@ -251,12 +249,10 @@
writeword($ffff) writeword($ffff)
else else
writeword(p^.owner^.unitid); writeword(p^.owner^.unitid);
writeword(p^.number); writeword(p^.indexnb);
end; end;
end; end;
{$ifdef UseBrowser}
procedure writesymref(p : psym); procedure writesymref(p : psym);
begin begin
if p=nil then if p=nil then
@ -270,10 +266,8 @@
writeword(p^.indexnb); writeword(p^.indexnb);
end; end;
end; end;
{$endif UseBrowser}
procedure writeunitas(const s : string;unittable : punitsymtable);
procedure writeunitas(const s : string;unit_symtable : punitsymtable);
{$ifdef UseBrowser} {$ifdef UseBrowser}
var var
pus : punitsymtable; pus : punitsymtable;
@ -291,7 +285,7 @@
flags:=flags or uf_in_library; flags:=flags or uf_in_library;
end; end;
if use_dbx then if use_dbx then
flags:=flags or uf_uses_dbx; flags:=flags or uf_has_dbx;
if target_os.endian=en_big_endian then if target_os.endian=en_big_endian then
flags:=flags or uf_big_endian; flags:=flags or uf_big_endian;
{$ifdef UseBrowser} {$ifdef UseBrowser}
@ -312,12 +306,12 @@
ppufile.write_data(unitheader,sizeof(unitheader)); ppufile.write_data(unitheader,sizeof(unitheader));
ppufile.clear_crc; ppufile.clear_crc;
ppufile.do_crc:=true; ppufile.do_crc:=true;
unit_symtable^.writeasunit; unittable^.writeasunit;
ppufile.flush; ppufile.flush;
ppufile.do_crc:=false; ppufile.do_crc:=false;
{$ifdef UseBrowser} {$ifdef UseBrowser}
{ write all new references to old unit elements } { write all new references to old unit elements }
pus:=punitsymtable(unit_symtable^.next); pus:=punitsymtable(unittable^.next);
if use_browser then if use_browser then
while assigned(pus) do while assigned(pus) do
begin begin
@ -532,7 +526,12 @@
{ {
$Log$ $Log$
Revision 1.2 1998-05-28 14:40:28 peter Revision 1.3 1998-06-13 00:10:17 peter
* working browser and newppu
* some small fixes against crashes which occured in bp7 (but not in
fpc?!)
Revision 1.2 1998/05/28 14:40:28 peter
* fixes for newppu, remake3 works now with it * fixes for newppu, remake3 works now with it
Revision 1.1 1998/05/27 19:45:09 peter Revision 1.1 1998/05/27 19:45:09 peter
@ -540,4 +539,4 @@
* symtable adapted for $ifdef NEWPPU * symtable adapted for $ifdef NEWPPU
} }

View File

@ -41,10 +41,13 @@
{$ifdef UseBrowser} {$ifdef UseBrowser}
defref:=nil; defref:=nil;
lastwritten:=nil; lastwritten:=nil;
if make_ref then refcount:=0;
add_new_ref(defref,@tokenpos); if (cs_browser in aktswitches) and make_ref then
begin
defref:=new(pref,init(defref,@tokenpos));
inc(refcount);
end;
lastref:=defref; lastref:=defref;
refcount:=1;
{$endif UseBrowser} {$endif UseBrowser}
end; end;
@ -55,6 +58,7 @@
right:=nil; right:=nil;
setname(readstring); setname(readstring);
typ:=abstractsym; typ:=abstractsym;
line_no:=0;
if object_options then if object_options then
properties:=symprop(readbyte) properties:=symprop(readbyte)
else else
@ -64,16 +68,10 @@
defref:=nil; defref:=nil;
lastwritten:=nil; lastwritten:=nil;
refcount:=0; refcount:=0;
if (current_module^.flags and uf_uses_browser)<>0 then
{ references do not change the ppu caracteristics }
{ this only save the references to variables/functions }
{ defined in the unit what about the others }
load_references;
{$endif UseBrowser} {$endif UseBrowser}
{$ifdef GDB} {$ifdef GDB}
isstabwritten := false; isstabwritten := false;
{$endif GDB} {$endif GDB}
line_no:=0;
end; end;
{$ifdef UseBrowser} {$ifdef UseBrowser}
@ -82,98 +80,51 @@
procedure tsym.load_references; procedure tsym.load_references;
var var
fileindex : word; pos : tfileposinfo;
b : byte;
l,c : longint;
begin begin
b:=readentry; while (not ppufile^.endofentry) do
if b=ibref then begin
begin readposinfo(pos);
while (not ppufile^.endofentry) do inc(refcount);
begin lastref:=new(pref,init(lastref,@pos));
fileindex:=readword; if refcount=1 then
l:=readlong; defref:=lastref;
c:=readword; end;
inc(refcount); lastwritten:=lastref;
lastref:=new(pref,load(lastref,fileindex,l,c));
if refcount=1 then
defref:=lastref;
end;
end
else
Message(unit_f_ppu_read_error);
lastwritten:=lastref;
end; end;
procedure tsym.write_references; procedure tsym.write_references;
var var
ref : pref; ref : pref;
prdef : pdef;
begin begin
{ references do not change the ppu caracteristics } if lastwritten=lastref then
{ this only save the references to variables/functions } exit;
{ defined in the unit what about the others } { write address to this symbol }
ppufile^.do_crc:=false; writesymref(@self);
if assigned(lastwritten) then { write symbol refs }
ref:=lastwritten if assigned(lastwritten) then
else ref:=lastwritten
ref:=defref;
while assigned(ref) do
begin
writeposinfo(ref^.posinfo);
ref:=ref^.nextref;
end;
lastwritten:=lastref;
ppufile^.writeentry(ibref);
ppufile^.do_crc:=true;
end;
procedure load_external_references;
var b : byte;
sym : psym;
prdef : pdef;
begin
b:=readentry;
if b=ibextsymref then
begin
sym:=readsymref;
resolvesym(sym);
sym^.load_references;
end;
ibextdefref : begin
prdef:=readdefref;
resolvedef(prdef);
if prdef^.deftype<>procdef then
Message(unit_f_ppu_read_error);
pprocdef(prdef)^.load_references;
end;
else else
Message(unit_f_ppu_read_error); ref:=defref;
end; while assigned(ref) do
end; begin
writeposinfo(ref^.posinfo);
procedure tsym.write_external_references; ref:=ref^.nextref;
var ref : pref; end;
prdef : pdef; lastwritten:=lastref;
begin ppufile^.writeentry(ibsymref);
ppufile^.do_crc:=false; { when it's a procsym then write also the refs to the definition
if lastwritten=lastref then due the overloading }
exit; if typ=procsym then
writesymref(@self); begin
writeentry(ibextsymref); prdef:=pprocsym(@self)^.definition;
while assigned(prdef) do
write_references; begin
pprocdef(prdef)^.write_references;
if typ=procsym then prdef:=pprocdef(prdef)^.nextoverloaded;
begin end;
prdef:=pprocsym(@self)^.definition; end;
while assigned(prdef) do
begin
pprocdef(prdef)^.write_external_references;
prdef:=pprocdef(prdef)^.nextoverloaded;
end;
end;
ppufile^.do_crc:=true;
end; end;
{$else NEWPPU} {$else NEWPPU}
@ -228,37 +179,6 @@
end; end;
procedure load_external_references;
var b : byte;
sym : psym;
prdef : pdef;
begin
b:=readbyte;
while (b=ibextsymref) or (b=ibextdefref) do
begin
if b=ibextsymref then
begin
sym:=readsymref;
resolvesym(sym);
sym^.load_references;
b:=readbyte;
end
else
if b=ibextdefref then
begin
prdef:=readdefref;
resolvedef(prdef);
if prdef^.deftype<>procdef then
Message(unit_f_ppu_read_error);
pprocdef(prdef)^.load_references;
b:=readbyte;
end;
end;
if b <> ibend then
Message(unit_f_ppu_read_error);
end;
procedure tsym.write_external_references; procedure tsym.write_external_references;
var ref : pref; var ref : pref;
prdef : pdef; prdef : pdef;
@ -296,44 +216,48 @@
{$endif NEWPPU} {$endif NEWPPU}
procedure tsym.write_ref_to_file(var f : text); procedure tsym.add_to_browserlog;
var
var ref : pref; prdef : pprocdef;
i : longint;
begin begin
ref:=defref; if assigned(defref) then
if assigned(ref) then begin
begin Browse.AddLog('***'+name+'***');
for i:=1 to reffile_indent do Browse.AddLogRefs(defref);
system.write(f,' '); end;
writeln(f,'***',name,'***'); { when it's a procsym then write also the refs to the definition
end; due the overloading }
inc(reffile_indent,2); if typ=procsym then
while assigned(ref) do begin
begin prdef:=pprocsym(@self)^.definition;
for i:=1 to reffile_indent do while assigned(prdef) do
system.write(f,' '); begin
writeln(f,ref^.get_file_line); pprocdef(prdef)^.add_to_browserlog;
ref:=ref^.nextref; prdef:=pprocdef(prdef)^.nextoverloaded;
end; end;
dec(reffile_indent,2); end;
end; end;
{$endif UseBrowser} {$endif UseBrowser}
destructor tsym.done;
destructor tsym.done;
begin begin
{$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 dispose(left,done); {$ifdef UseBrowser}
if assigned(right) then dispose(right,done); if assigned(defref) then
dispose(defref,done);
{$endif UseBrowser}
if assigned(left) then
dispose(left,done);
if assigned(right) then
dispose(right,done);
end; end;
destructor tsym.single_done;
destructor tsym.single_done;
begin begin
{$ifdef tp} {$ifdef tp}
if not(use_big) then if not(use_big) then
@ -348,8 +272,8 @@
if object_options then if object_options then
writebyte(byte(properties)); writebyte(byte(properties));
{$ifdef UseBrowser} {$ifdef UseBrowser}
if (current_module^.flags and uf_uses_browser)<>0 then { if cs_browser in aktswitches then
write_references; write_references; }
{$endif UseBrowser} {$endif UseBrowser}
end; end;
@ -462,9 +386,13 @@
****************************************************************************} ****************************************************************************}
constructor tunitsym.init(const n : string;ref : punitsymtable); constructor tunitsym.init(const n : string;ref : punitsymtable);
var
old_make_ref : boolean;
begin begin
tsym.init(n); old_make_ref:=make_ref;
make_ref:=false;
inherited init(n);
make_ref:=old_make_ref;
typ:=unitsym; typ:=unitsym;
unitsymtable:=ref; unitsymtable:=ref;
prevsym:=ref^.unitsym; prevsym:=ref^.unitsym;
@ -627,8 +555,8 @@
constructor tprogramsym.init(const n : string); constructor tprogramsym.init(const n : string);
begin begin
tsym.init(n); inherited init(n);
typ:=programsym; typ:=programsym;
end; end;
{**************************************************************************** {****************************************************************************
@ -637,8 +565,8 @@
constructor terrorsym.init; constructor terrorsym.init;
begin begin
tsym.init(''); inherited init('');
typ:=errorsym; typ:=errorsym;
end; end;
{**************************************************************************** {****************************************************************************
@ -877,12 +805,12 @@
address:=0; address:=0;
refs:=0; refs:=0;
is_valid := 1; is_valid := 1;
var_options:=0;
{ can we load the value into a register ? } { can we load the value into a register ? }
case p^.deftype of case p^.deftype of
pointerdef, pointerdef,
enumdef, enumdef,
procvardef : procvardef : var_options:=var_options or vo_regable;
var_options:=var_options or vo_regable;
orddef : case porddef(p)^.typ of orddef : case porddef(p)^.typ of
u8bit,u16bit,u32bit, u8bit,u16bit,u32bit,
bool8bit,bool16bit,bool32bit, bool8bit,bool16bit,bool32bit,
@ -906,7 +834,8 @@
varspez:=tvarspez(readbyte); varspez:=tvarspez(readbyte);
if read_member then if read_member then
address:=readlong address:=readlong
else address:=0; else
address:=0;
definition:=readdefref; definition:=readdefref;
refs := 0; refs := 0;
is_valid := 1; is_valid := 1;
@ -923,7 +852,7 @@
var_options:=var_options or vo_is_C_var; var_options:=var_options or vo_is_C_var;
_mangledname:=strpnew(target_os.Cprefix+mangled); _mangledname:=strpnew(target_os.Cprefix+mangled);
end; end;
constructor tvarsym.load_C; constructor tvarsym.load_C;
begin begin
@ -1248,7 +1177,7 @@
strdispose(_mangledname); strdispose(_mangledname);
inherited done; inherited done;
end; end;
{**************************************************************************** {****************************************************************************
TTYPEDCONSTSYM TTYPEDCONSTSYM
@ -1742,7 +1671,12 @@
{ {
$Log$ $Log$
Revision 1.9 1998-06-12 16:15:35 pierre Revision 1.10 1998-06-13 00:10:18 peter
* working browser and newppu
* some small fixes against crashes which occured in bp7 (but not in
fpc?!)
Revision 1.9 1998/06/12 16:15:35 pierre
* external name 'C_var'; * external name 'C_var';
export name 'intern_C_var'; export name 'intern_C_var';
cdecl; cdecl;