paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 07:26:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed scannerfiles for macros

Browse Source 
+ $I %<environment>%
This commit is contained in:
peter 1998-08-26 15:35:30 +00:00
parent 23225bea44
commit 547dca7111
4 changed files with 375 additions and 247 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
compiler/files.pas
View File

@ -31,36 +31,43 @@ unit files;
const const
{$ifdef FPC} {$ifdef FPC}
maxunits = 1024; maxunits = 1024;
extbufsize = 65535; InputFileBufSize=32*1024;
{$else} {$else}
maxunits = 128; maxunits = 128;
extbufsize=1024; InputFileBufSize=1024;
{$endif} {$endif}
type type
pinputfile = ^tinputfile; pinputfile = ^tinputfile;
tinputfile = object tinputfile = object
path,name : pstring; { path and filename } path,name : pstring; { path and filename }
next : pinputfile; { next file for reading } next : pinputfile; { next file for reading }
savebufstart, { save fields for scanner } f : file; { current file handle }
savebufsize, is_macro,
savelastlinepos, endoffile, { still bytes left to read }
saveline_no : longint; closed : boolean; { is the file closed }
saveinputbuffer, inputbufsize : longint; { max size of the input buffer }
saveinputpointer : pchar;
linebuf : plongint; { line buffer to retrieve lines } savebufstart, { save fields for scanner }
maxlinebuf : longint; savebufsize,
savelastlinepos,
saveline_no : longint;
ref_count : longint; { to handle the browser refs } saveinputbuffer,
ref_index : longint; saveinputpointer : pchar;
ref_next : pinputfile;
constructor init(const fn:string); linebuf : plongint; { line buffer to retrieve lines }
destructor done; maxlinebuf : longint;
ref_count : longint; { to handle the browser refs }
ref_index : longint;
ref_next : pinputfile;
constructor init(const fn:string);
destructor done;
{$ifdef SourceLine} {$ifdef SourceLine}
function getlinestr(l:longint):string; function getlinestr(l:longint):string;
{$endif SourceLine} {$endif SourceLine}
end; end;
@ -172,6 +179,17 @@ unit files;
name:=stringdup(n+e); name:=stringdup(n+e);
path:=stringdup(p); path:=stringdup(p);
next:=nil; next:=nil;
{ file info }
is_macro:=false;
endoffile:=false;
closed:=true;
inputbufsize:=InputFileBufSize;
saveinputbuffer:=nil;
saveinputpointer:=nil;
savebufstart:=0;
savebufsize:=0;
saveline_no:=0;
savelastlinepos:=0;
{ indexing refs } { indexing refs }
ref_next:=nil; ref_next:=nil;
ref_count:=0; ref_count:=0;
@ -647,7 +665,11 @@ unit files;
end. end.
{ {
$Log$ $Log$
Revision 1.40 1998-08-26 10:08:48 peter Revision 1.41 1998-08-26 15:35:30 peter
* fixed scannerfiles for macros
+ $I %<environment>%
Revision 1.40 1998/08/26 10:08:48 peter
* fixed problem with libprefix at the wrong place * fixed problem with libprefix at the wrong place
* fixed lib generation with smartlinking and no -CS used * fixed lib generation with smartlinking and no -CS used

10
compiler/pmodules.pas
View File

@ -274,10 +274,10 @@ unit pmodules;
Message1(unit_f_cant_compile_unit,current_module^.modulename^) Message1(unit_f_cant_compile_unit,current_module^.modulename^)
else else
begin begin
current_scanner^.close; current_scanner^.tempclose;
compile(current_module^.mainsource^,compile_system); compile(current_module^.mainsource^,compile_system);
if (not old_current_module^.compiled) then if (not old_current_module^.compiled) then
current_scanner^.reopen; current_scanner^.tempopen;
end; end;
end end
else else
@ -901,7 +901,11 @@ unit pmodules;
end. end.
{ {
$Log$ $Log$
Revision 1.43 1998-08-26 10:08:47 peter Revision 1.44 1998-08-26 15:35:33 peter
* fixed scannerfiles for macros
+ $I %<environment>%
Revision 1.43 1998/08/26 10:08:47 peter
* fixed problem with libprefix at the wrong place * fixed problem with libprefix at the wrong place
* fixed lib generation with smartlinking and no -CS used * fixed lib generation with smartlinking and no -CS used

74
compiler/scandir.inc
View File

@ -500,22 +500,58 @@ const
hs:=current_scanner^.readcomment; hs:=current_scanner^.readcomment;
while (hs<>'') and (hs[length(hs)]=' ') do while (hs<>'') and (hs[length(hs)]=' ') do
dec(byte(hs[0])); dec(byte(hs[0]));
hs:=FixFileName(hs); if hs='' then
fsplit(hs,path,name,ext); exit;
{ first look in the path of _d then currentmodule } if (hs[1]='%') then
path:=search(name+ext,path+';'+current_scanner^.inputfile^.path^+';'+includesearchpath,found); begin
{ shutdown current file } { save old }
current_scanner^.close; path:=hs;
{ load new file } { remove %'s }
hp:=new(pinputfile,init(path+name+ext)); Delete(hs,1,1);
current_scanner^.addfile(hp); if hs[length(hs)]='%' then
if not current_scanner^.open then Delete(hs,length(hs),1);
Message1(scan_f_cannot_open_includefile,hs); { first check for internal macros }
Message1(scan_u_start_include_file,current_scanner^.inputfile^.path^+current_scanner^.inputfile^.name^); if hs='TIME' then
current_scanner^.reload; hs:=gettimestr
{ register for refs } else
current_module^.sourcefiles.register_file(hp); if hs='DATE' then
current_module^.current_index:=hp^.ref_index; hs:=getdatestr
else
if hs='FPCVERSION' then
hs:=version_string
else
if hs='FPCTARGET' then
hs:=target_string
else
hs:=getenv(hs);
if hs='' then
Comment(V_Warning,'Include environment '+path+' not found in environment')
else
begin
{ make it a stringconst }
hs:=''''+hs+'''';
current_scanner^.insertmacro(@hs[1],length(hs));
end;
end
else
begin
hs:=FixFileName(hs);
fsplit(hs,path,name,ext);
{ first look in the path of _d then currentmodule }
path:=search(name+ext,path+';'+current_scanner^.inputfile^.path^+';'+includesearchpath,found);
{ shutdown current file }
current_scanner^.tempclose;
{ load new file }
hp:=new(pinputfile,init(path+name+ext));
current_scanner^.addfile(hp);
if not current_scanner^.open then
Message1(scan_f_cannot_open_includefile,hs);
Message1(scan_u_start_include_file,current_scanner^.inputfile^.path^+current_scanner^.inputfile^.name^);
current_scanner^.reload;
{ register for refs }
current_module^.sourcefiles.register_file(hp);
current_module^.current_index:=hp^.ref_index;
end;
end; end;
@ -732,7 +768,11 @@ const
{ {
$Log$ $Log$
Revision 1.22 1998-08-19 14:57:50 peter Revision 1.23 1998-08-26 15:35:34 peter
* fixed scannerfiles for macros
+ $I %<environment>%
Revision 1.22 1998/08/19 14:57:50 peter
* small fix for aktfilepos * small fix for aktfilepos
Revision 1.20 1998/08/18 15:11:52 peter Revision 1.20 1998/08/18 15:11:52 peter

478
compiler/scanner.pas
View File

@ -33,11 +33,9 @@ unit scanner;
const const
{$ifdef TP} {$ifdef TP}
maxmacrolen=1024; maxmacrolen=1024;
InputFileBufSize=1024;
linebufincrease=64; linebufincrease=64;
{$else} {$else}
maxmacrolen=16*1024; maxmacrolen=16*1024;
InputFileBufSize=32*1024;
linebufincrease=512; linebufincrease=512;
{$endif} {$endif}
@ -148,26 +146,18 @@ unit scanner;
tscannerfile = object tscannerfile = object
inputfile : pinputfile; { current inputfile list } inputfile : pinputfile; { current inputfile list }
f : file; { current file handle } { these fields are called save* in inputfile, and are here
filenotatend, { still bytes left to read } for speed reasons (PFV) }
closed : boolean; { is the file closed } bufstart,
bufsize,
inputbufsize : longint; { max size of the input buffer } line_no,
lastlinepos : longint;
inputbuffer, inputbuffer,
inputpointer : pchar; inputpointer : pchar;
bufstart, lasttokenpos : longint;
bufsize : longint;
line_no,
lasttokenpos,
lastlinepos : longint;
lasttoken : ttoken; lasttoken : ttoken;
maxlinebuf : longint;
linebuf : plongint;
do_special, { 1=point after nr, 2=caret after id } do_special, { 1=point after nr, 2=caret after id }
comment_level, comment_level,
yylexcount : longint; yylexcount : longint;
@ -179,7 +169,8 @@ unit scanner;
{ File buffer things } { File buffer things }
function open:boolean; function open:boolean;
procedure close; procedure close;
function reopen:boolean; procedure tempclose;
function tempopen:boolean;
procedure seekbuf(fpos:longint); procedure seekbuf(fpos:longint);
procedure readbuf; procedure readbuf;
procedure saveinputfile; procedure saveinputfile;
@ -188,6 +179,7 @@ unit scanner;
procedure addfile(hp:pinputfile); procedure addfile(hp:pinputfile);
procedure reload; procedure reload;
procedure setbuf(p:pchar;l:longint); procedure setbuf(p:pchar;l:longint);
procedure insertmacro(p:pchar;len:longint);
{ Scanner things } { Scanner things }
procedure gettokenpos; procedure gettokenpos;
procedure inc_comment_level; procedure inc_comment_level;
@ -314,25 +306,14 @@ implementation
inputfile:=new(pinputfile,init(fn)); inputfile:=new(pinputfile,init(fn));
current_module^.sourcefiles.register_file(inputfile); current_module^.sourcefiles.register_file(inputfile);
current_module^.current_index:=inputfile^.ref_index; current_module^.current_index:=inputfile^.ref_index;
{ load inputfile values }
restoreinputfile;
{ reset scanner } { reset scanner }
preprocstack:=nil; preprocstack:=nil;
comment_level:=0; comment_level:=0;
do_special:=0; do_special:=0;
block_type:=bt_general; block_type:=bt_general;
{ reset buf }
closed:=true;
filenotatend:=true;
inputbufsize:=InputFileBufSize;
inputbuffer:=nil;
inputpointer:=nil;
bufstart:=0;
bufsize:=0;
{ line }
line_no:=0;
lastlinepos:=0;
lasttokenpos:=0; lasttokenpos:=0;
linebuf:=nil;
maxlinebuf:=0;
{ load block } { load block }
if not open then if not open then
Message1(scan_f_cannot_open_input,fn); Message1(scan_f_cannot_open_input,fn);
@ -344,18 +325,21 @@ implementation
begin begin
checkpreprocstack; checkpreprocstack;
{ close file } { close file }
if not closed then if not inputfile^.closed then
close; close;
end; end;
procedure tscannerfile.seekbuf(fpos:longint); procedure tscannerfile.seekbuf(fpos:longint);
begin begin
if closed then with inputfile^ do
exit; begin
seek(f,fpos); if closed then
bufstart:=fpos; exit;
bufsize:=0; seek(f,fpos);
bufstart:=fpos;
bufsize:=0;
end;
end; end;
@ -365,17 +349,22 @@ implementation
w : word; w : word;
{$endif} {$endif}
begin begin
if closed then with inputfile^ do
exit; begin
inc(bufstart,bufsize); if is_macro then
{$ifdef TP} endoffile:=true;
blockread(f,inputbuffer^,inputbufsize-1,w); if closed then
bufsize:=w; exit;
{$else} inc(bufstart,bufsize);
blockread(f,inputbuffer^,inputbufsize-1,bufsize); {$ifdef TP}
{$endif} blockread(f,inputbuffer^,inputbufsize-1,w);
inputbuffer[bufsize]:=#0; bufsize:=w;
Filenotatend:=(bufsize=inputbufsize-1); {$else}
blockread(f,inputbuffer^,inputbufsize-1,bufsize);
{$endif}
inputbuffer[bufsize]:=#0;
endoffile:=not(bufsize=inputbufsize-1);
end;
end; end;
@ -383,30 +372,33 @@ implementation
var var
ofm : byte; ofm : byte;
begin begin
open:=false; with inputfile^ do
if not closed then begin
Close; open:=false;
ofm:=filemode; if not closed then
filemode:=0; Close;
Assign(f,inputfile^.path^+inputfile^.name^); ofm:=filemode;
{$I-} filemode:=0;
reset(f,1); Assign(f,inputfile^.path^+inputfile^.name^);
{$I+} {$I-}
filemode:=ofm; reset(f,1);
if ioresult<>0 then {$I+}
exit; filemode:=ofm;
{ file } if ioresult<>0 then
closed:=false; exit;
filenotatend:=true; { file }
Getmem(inputbuffer,inputbufsize); endoffile:=false;
inputpointer:=inputbuffer; closed:=false;
bufstart:=0; Getmem(inputbuffer,inputbufsize);
bufsize:=0; inputpointer:=inputbuffer;
{ line } bufstart:=0;
line_no:=0; bufsize:=0;
lastlinepos:=0; { line }
lasttokenpos:=0; line_no:=0;
open:=true; lastlinepos:=0;
lasttokenpos:=0;
open:=true;
end;
end; end;
@ -414,46 +406,89 @@ implementation
var var
i : word; i : word;
begin begin
inc(bufstart,inputpointer-inputbuffer); with inputfile^ do
if not closed then
begin begin
{$I-} if is_macro then
system.close(f); begin
{$I+} Freemem(inputbuffer,InputFileBufSize);
i:=ioresult; is_macro:=false;
Freemem(inputbuffer,InputFileBufSize); inputbuffer:=nil;
inputbuffer:=nil; inputpointer:=nil;
inputpointer:=nil; closed:=true;
closed:=true; exit;
end;
if not closed then
begin
{$I-}
system.close(f);
{$I+}
i:=ioresult;
Freemem(inputbuffer,InputFileBufSize);
inputbuffer:=nil;
inputpointer:=nil;
closed:=true;
end;
end; end;
end; end;
function tscannerfile.reopen:boolean; procedure tscannerfile.tempclose;
var
i : word;
begin
with inputfile^ do
begin
inc(bufstart,inputpointer-inputbuffer);
if is_macro then
exit;
if not closed then
begin
{$I-}
system.close(f);
{$I+}
i:=ioresult;
Freemem(inputbuffer,InputFileBufSize);
inputbuffer:=nil;
inputpointer:=nil;
closed:=true;
end;
end;
end;
function tscannerfile.tempopen:boolean;
var var
ofm : byte; ofm : byte;
begin begin
reopen:=false; with inputfile^ do
if not closed then begin
exit; tempopen:=false;
ofm:=filemode; if is_macro then
filemode:=0; begin
Assign(f,inputfile^.path^+inputfile^.name^); tempopen:=true;
{$I-} exit;
reset(f,1); end;
{$I+} if not closed then
filemode:=ofm; exit;
if ioresult<>0 then ofm:=filemode;
exit; filemode:=0;
closed:=false; Assign(f,inputfile^.path^+inputfile^.name^);
{ get new mem } {$I-}
Getmem(inputbuffer,inputbufsize); reset(f,1);
inputpointer:=inputbuffer; {$I+}
{ restore state } filemode:=ofm;
seek(f,BufStart); if ioresult<>0 then
bufsize:=0; exit;
readbuf; closed:=false;
reopen:=true; { get new mem }
Getmem(inputbuffer,inputbufsize);
inputpointer:=inputbuffer;
{ restore state }
seek(f,BufStart);
bufsize:=0;
readbuf;
tempopen:=true;
end;
end; end;
@ -461,12 +496,10 @@ implementation
begin begin
inputfile^.savebufstart:=bufstart; inputfile^.savebufstart:=bufstart;
inputfile^.savebufsize:=bufsize; inputfile^.savebufsize:=bufsize;
inputfile^.savelastlinepos:=lastlinepos;
inputfile^.saveline_no:=line_no;
inputfile^.saveinputbuffer:=inputbuffer; inputfile^.saveinputbuffer:=inputbuffer;
inputfile^.saveinputpointer:=inputpointer; inputfile^.saveinputpointer:=inputpointer;
inputfile^.linebuf:=linebuf; inputfile^.savelastlinepos:=lastlinepos;
inputfile^.maxlinebuf:=maxlinebuf; inputfile^.saveline_no:=line_no;
end; end;
@ -478,8 +511,6 @@ implementation
line_no:=inputfile^.saveline_no; line_no:=inputfile^.saveline_no;
inputbuffer:=inputfile^.saveinputbuffer; inputbuffer:=inputfile^.saveinputbuffer;
inputpointer:=inputfile^.saveinputpointer; inputpointer:=inputfile^.saveinputpointer;
linebuf:=inputfile^.linebuf;
maxlinebuf:=inputfile^.maxlinebuf;
end; end;
@ -506,55 +537,94 @@ implementation
procedure tscannerfile.reload; procedure tscannerfile.reload;
begin begin
{ safety check } with inputfile^ do
if closed then begin
exit; repeat
repeat { still more to read?, then change the #0 to a space so its seen
{ still more to read?, then change the #0 to a space so its seen as a seperator }
as a seperator } if (bufsize>0) and (inputpointer-inputbuffer<bufsize) then
if (bufsize>0) and (inputpointer-inputbuffer<bufsize) then
begin
c:=' ';
inc(longint(inputpointer));
exit;
end;
{ can we read more from this file ? }
if filenotatend then
begin
readbuf;
if line_no=0 then
line_no:=1;
inputpointer:=inputbuffer;
end
else
begin
close;
{ no next module, than EOF }
if not assigned(inputfile^.next) then
begin begin
c:=#26; c:=' ';
inc(longint(inputpointer));
exit; exit;
end; end;
{ load next file and reopen it } { can we read more from this file ? }
nextfile; if not endoffile then
reopen; begin
{ status } readbuf;
Message1(scan_d_back_in,inputfile^.name^); if line_no=0 then
{ load some current_module fields } line_no:=1;
current_module^.current_index:=inputfile^.ref_index; inputpointer:=inputbuffer;
end; end
{ load next char } else
c:=inputpointer^; begin
inc(longint(inputpointer)); close;
until c<>#0; { if also end, then reload again } { no next module, than EOF }
if not assigned(inputfile^.next) then
begin
c:=#26;
exit;
end;
{ load next file and reopen it }
nextfile;
tempopen;
{ status }
Message1(scan_d_back_in,inputfile^.name^);
{ load some current_module fields }
current_module^.current_index:=inputfile^.ref_index;
end;
{ load next char }
c:=inputpointer^;
inc(longint(inputpointer));
until c<>#0; { if also end, then reload again }
end;
end; end;
procedure tscannerfile.setbuf(p:pchar;l:longint); procedure tscannerfile.setbuf(p:pchar;l:longint);
begin begin
inputbuffer:=p; with inputfile^ do
inputbufsize:=l; begin
inputpointer:=inputbuffer; inputbufsize:=l;
inputbuffer:=p;
inputpointer:=p;
end;
end;
procedure tscannerfile.insertmacro(p:pchar;len:longint);
{ load the values of tokenpos and lasttokenpos }
var
macbuf : pchar;
hp : pinputfile;
begin
{ save old postion }
dec(longint(inputpointer));
current_scanner^.tempclose;
{ create macro 'file' }
hp:=new(pinputfile,init('Macro'));
addfile(hp);
getmem(macbuf,len+1);
setbuf(macbuf,len+1);
{ fill buffer }
with inputfile^ do
begin
move(p^,inputbuffer^,len);
inputbuffer[len]:=#0;
{ reset }
inputpointer:=inputbuffer;
bufstart:=0;
bufsize:=len;
line_no:=0;
lastlinepos:=0;
lasttokenpos:=0;
is_macro:=true;
endoffile:=true;
closed:=true;
{ load new c }
c:=inputpointer^;
inc(longint(inputpointer));
end;
end; end;
@ -602,50 +672,52 @@ implementation
{$endif SourceLine} {$endif SourceLine}
oldtokenpos,oldaktfilepos : tfileposinfo; oldtokenpos,oldaktfilepos : tfileposinfo;
begin begin
if (byte(inputpointer^)=0) and with inputfile^ do
filenotatend then
begin
cur:=c;
reload;
if byte(cur)+byte(c)<>23 then
dec(longint(inputpointer));
end
else
begin begin
{ Fix linebreak to be only newline (=#10) for all types of linebreaks } if (byte(inputpointer^)=0) and not(endoffile) then
if (byte(inputpointer^)+byte(c)=23) then
inc(longint(inputpointer));
end;
c:=newline;
{ increase line counters }
lastlinepos:=bufstart+(inputpointer-inputbuffer);
inc(line_no);
{ update linebuffer }
{$ifdef SourceLine}
if line_no>maxlinebuf then
begin
{ create new linebuf and move old info }
getmem(hp,maxlinebuf+linebufincrease);
if assigned(linebuf) then
begin begin
move(linebuf^,hp^,maxlinebuf shl 2); cur:=c;
freemem(linebuf,maxlinebuf); reload;
if byte(cur)+byte(c)<>23 then
dec(longint(inputpointer));
end
else
begin
{ Fix linebreak to be only newline (=#10) for all types of linebreaks }
if (byte(inputpointer^)+byte(c)=23) then
inc(longint(inputpointer));
end; end;
{ set new linebuf } c:=newline;
linebuf:=hp; { increase line counters }
inc(maxlinebuf,linebufincrease); lastlinepos:=bufstart+(inputpointer-inputbuffer);
inc(line_no);
{ update linebuffer }
{$ifdef SourceLine}
if line_no>maxlinebuf then
begin
{ create new linebuf and move old info }
getmem(hp,maxlinebuf+linebufincrease);
if assigned(linebuf) then
begin
move(linebuf^,hp^,maxlinebuf shl 2);
freemem(linebuf,maxlinebuf);
end;
{ set new linebuf }
linebuf:=hp;
inc(maxlinebuf,linebufincrease);
end;
plongint(longint(linebuf)+line_no*2)^:=lastlinepos;
{$endif SourceLine}
{ update for status and call the show status routine,
but don't touch aktfilepos ! }
oldaktfilepos:=aktfilepos;
oldtokenpos:=tokenpos;
gettokenpos; { update for v_status }
inc(status.compiledlines);
ShowStatus;
aktfilepos:=oldaktfilepos;
tokenpos:=oldtokenpos;
end; end;
plongint(longint(linebuf)+line_no*2)^:=lastlinepos;
{$endif SourceLine}
{ update for status and call the show status routine,
but don't touch aktfilepos ! }
oldaktfilepos:=aktfilepos;
oldtokenpos:=tokenpos;
gettokenpos; { update for v_status }
inc(status.compiledlines);
ShowStatus;
aktfilepos:=oldaktfilepos;
tokenpos:=oldtokenpos;
end; end;
@ -1004,8 +1076,6 @@ implementation
code : word; code : word;
l : longint; l : longint;
mac : pmacrosym; mac : pmacrosym;
hp : pinputfile;
macbuf : pchar;
asciinr : string[3]; asciinr : string[3];
label label
exit_label; exit_label;
@ -1064,19 +1134,7 @@ implementation
mac:=pmacrosym(macros^.search(pattern)); mac:=pmacrosym(macros^.search(pattern));
if assigned(mac) and (assigned(mac^.buftext)) then if assigned(mac) and (assigned(mac^.buftext)) then
begin begin
{ don't forget the last char } insertmacro(mac^.buftext,mac^.buflen);
dec(longint(inputpointer));
hp:=new(pinputfile,init('Macro '+pattern));
addfile(hp);
getmem(macbuf,mac^.buflen+1);
setbuf(macbuf,mac^.buflen+1);
{ copy text }
move(mac^.buftext^,inputbuffer^,mac^.buflen);
{ put end sign }
inputbuffer[mac^.buflen+1]:=#0;
{ load c }
c:=inputbuffer^;
inputpointer:=inputbuffer+1;
{ handle empty macros } { handle empty macros }
if c=#0 then if c=#0 then
reload; reload;
@ -1561,7 +1619,11 @@ exit_label:
end. end.
{ {
$Log$ $Log$
Revision 1.44 1998-08-20 16:09:55 pierre Revision 1.45 1998-08-26 15:35:35 peter
* fixed scannerfiles for macros
+ $I %<environment>%
Revision 1.44 1998/08/20 16:09:55 pierre
* tokenpos has to be restored also after * tokenpos has to be restored also after
printstatus printstatus