mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-02 09:09:47 +01:00
* IDE patch for stream reading (merged)
This commit is contained in:
peter
parent
2f3239d61c
commit
fac523d7f6
@ -23,6 +23,8 @@
|
||||
unit comphook;
|
||||
interface
|
||||
|
||||
uses files;
|
||||
|
||||
Const
|
||||
{ <$10000 will show file and line }
|
||||
V_None = $0;
|
||||
@ -84,6 +86,8 @@ function def_internalerror(i:longint):boolean;
|
||||
procedure def_initsymbolinfo;
|
||||
procedure def_donesymbolinfo;
|
||||
procedure def_extractsymbolinfo;
|
||||
function def_openinputfile(const filename: string): pinputfile;
|
||||
Function def_getnamedfiletime(Const F : String) : Longint;
|
||||
{$ifdef DEBUG}
|
||||
{ allow easy stopping in GDB
|
||||
using
|
||||
@ -102,6 +106,9 @@ type
|
||||
tinitsymbolinfoproc = procedure;
|
||||
tdonesymbolinfoproc = procedure;
|
||||
textractsymbolinfoproc = procedure;
|
||||
topeninputfilefunc = function(const filename: string): pinputfile;
|
||||
tgetnamedfiletimefunc = function(const filename: string): longint;
|
||||
|
||||
const
|
||||
do_stop : tstopprocedure = def_stop;
|
||||
do_halt : thaltprocedure = def_halt;
|
||||
@ -113,11 +120,19 @@ const
|
||||
do_donesymbolinfo : tdonesymbolinfoproc = def_donesymbolinfo;
|
||||
do_extractsymbolinfo : textractsymbolinfoproc = def_extractsymbolinfo;
|
||||
|
||||
do_openinputfile : topeninputfilefunc = def_openinputfile;
|
||||
do_getnamedfiletime : tgetnamedfiletimefunc = def_getnamedfiletime;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
{$ifdef USEEXCEPT}
|
||||
uses tpexcept;
|
||||
tpexcept,
|
||||
{$endif USEEXCEPT}
|
||||
{$ifdef Linux}
|
||||
linux,
|
||||
{$endif}
|
||||
dos;
|
||||
|
||||
{****************************************************************************
|
||||
Helper Routines
|
||||
@ -315,10 +330,50 @@ procedure def_extractsymbolinfo;
|
||||
begin
|
||||
end;
|
||||
|
||||
function def_openinputfile(const filename: string): pinputfile;
|
||||
begin
|
||||
def_openinputfile:=new(pdosinputfile, init(filename));
|
||||
end;
|
||||
|
||||
Function def_GetNamedFileTime (Const F : String) : Longint;
|
||||
var
|
||||
L : Longint;
|
||||
{$ifndef linux}
|
||||
info : SearchRec;
|
||||
{$else}
|
||||
info : stat;
|
||||
{$endif}
|
||||
begin
|
||||
l:=-1;
|
||||
{$ifdef linux}
|
||||
if FStat (F,Info) then
|
||||
L:=info.mtime;
|
||||
{$else}
|
||||
{$ifdef delphi}
|
||||
dmisc.FindFirst (F,archive+readonly+hidden,info);
|
||||
{$else delphi}
|
||||
FindFirst (F,archive+readonly+hidden,info);
|
||||
{$endif delphi}
|
||||
if DosError=0 then
|
||||
l:=info.time;
|
||||
{$ifdef Linux}
|
||||
FindClose(info);
|
||||
{$endif}
|
||||
{$ifdef Win32}
|
||||
FindClose(info);
|
||||
{$endif}
|
||||
{$endif}
|
||||
def_GetNamedFileTime:=l;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2000-07-13 11:32:38 michael
|
||||
Revision 1.3 2000-08-12 15:30:45 peter
|
||||
* IDE patch for stream reading (merged)
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:38 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
|
||||
@ -76,7 +76,6 @@ unit files;
|
||||
path,name : pstring; { path and filename }
|
||||
next : pinputfile; { next file for reading }
|
||||
|
||||
f : file; { current file handle }
|
||||
is_macro,
|
||||
endoffile, { still bytes left to read }
|
||||
closed : boolean; { is the file closed }
|
||||
@ -109,6 +108,24 @@ unit files;
|
||||
procedure setmacro(p:pchar;len:longint);
|
||||
procedure setline(line,linepos:longint);
|
||||
function getlinestr(l:longint):string;
|
||||
{$ifdef FPC}protected{$else}public{$endif}
|
||||
function fileopen(const filename: string): boolean; virtual;
|
||||
function fileseek(pos: longint): boolean; virtual;
|
||||
function fileread(var databuf; maxsize: longint): longint; virtual;
|
||||
function fileeof: boolean; virtual;
|
||||
function fileclose: boolean; virtual;
|
||||
end;
|
||||
|
||||
pdosinputfile = ^tdosinputfile;
|
||||
tdosinputfile = object(tinputfile)
|
||||
{$ifdef FPC}protected{$else}public{$endif}
|
||||
function fileopen(const filename: string): boolean; virtual;
|
||||
function fileseek(pos: longint): boolean; virtual;
|
||||
function fileread(var databuf; maxsize: longint): longint; virtual;
|
||||
function fileeof: boolean; virtual;
|
||||
function fileclose: boolean; virtual;
|
||||
private
|
||||
f : file; { current file handle }
|
||||
end;
|
||||
|
||||
pfilemanager = ^tfilemanager;
|
||||
@ -355,49 +372,31 @@ uses
|
||||
begin
|
||||
if closed then
|
||||
exit;
|
||||
seek(f,fpos);
|
||||
fileseek(fpos);
|
||||
bufstart:=fpos;
|
||||
bufsize:=0;
|
||||
end;
|
||||
|
||||
|
||||
procedure tinputfile.readbuf;
|
||||
{$ifdef TP}
|
||||
var
|
||||
w : word;
|
||||
{$endif}
|
||||
begin
|
||||
if is_macro then
|
||||
endoffile:=true;
|
||||
if closed then
|
||||
exit;
|
||||
inc(bufstart,bufsize);
|
||||
{$ifdef VER70}
|
||||
blockread(f,buf^,maxbufsize-1,w);
|
||||
bufsize:=w;
|
||||
{$else}
|
||||
blockread(f,buf^,maxbufsize-1,bufsize);
|
||||
{$endif}
|
||||
bufsize:=fileread(buf^,maxbufsize-1);
|
||||
buf[bufsize]:=#0;
|
||||
endoffile:=eof(f);
|
||||
endoffile:=fileeof;
|
||||
end;
|
||||
|
||||
|
||||
function tinputfile.open:boolean;
|
||||
var
|
||||
ofm : byte;
|
||||
begin
|
||||
open:=false;
|
||||
if not closed then
|
||||
Close;
|
||||
ofm:=filemode;
|
||||
filemode:=0;
|
||||
Assign(f,path^+name^);
|
||||
{$I-}
|
||||
reset(f,1);
|
||||
{$I+}
|
||||
filemode:=ofm;
|
||||
if ioresult<>0 then
|
||||
if not fileopen(path^+name^) then
|
||||
exit;
|
||||
{ file }
|
||||
endoffile:=false;
|
||||
@ -423,10 +422,7 @@ uses
|
||||
end;
|
||||
if not closed then
|
||||
begin
|
||||
{$I-}
|
||||
system.close(f);
|
||||
{$I+}
|
||||
if ioresult<>0 then;
|
||||
if fileclose then;
|
||||
closed:=true;
|
||||
end;
|
||||
if assigned(buf) then
|
||||
@ -444,20 +440,14 @@ uses
|
||||
exit;
|
||||
if not closed then
|
||||
begin
|
||||
{$I-}
|
||||
system.close(f);
|
||||
{$I+}
|
||||
if ioresult<>0 then;
|
||||
if fileclose then;
|
||||
Freemem(buf,maxbufsize);
|
||||
buf:=nil;
|
||||
closed:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function tinputfile.tempopen:boolean;
|
||||
var
|
||||
ofm : byte;
|
||||
begin
|
||||
tempopen:=false;
|
||||
if is_macro then
|
||||
@ -473,20 +463,13 @@ uses
|
||||
end;
|
||||
if not closed then
|
||||
exit;
|
||||
ofm:=filemode;
|
||||
filemode:=0;
|
||||
Assign(f,path^+name^);
|
||||
{$I-}
|
||||
reset(f,1);
|
||||
{$I+}
|
||||
filemode:=ofm;
|
||||
if ioresult<>0 then
|
||||
if not fileopen(path^+name^) then
|
||||
exit;
|
||||
closed:=false;
|
||||
{ get new mem }
|
||||
Getmem(buf,maxbufsize);
|
||||
{ restore state }
|
||||
seek(f,BufStart);
|
||||
fileseek(BufStart);
|
||||
bufsize:=0;
|
||||
readbuf;
|
||||
tempopen:=true;
|
||||
@ -587,6 +570,92 @@ uses
|
||||
end;
|
||||
|
||||
|
||||
function tinputfile.fileopen(const filename: string): boolean;
|
||||
begin
|
||||
abstract;
|
||||
fileopen:=false;
|
||||
end;
|
||||
|
||||
|
||||
function tinputfile.fileseek(pos: longint): boolean;
|
||||
begin
|
||||
abstract;
|
||||
fileseek:=false;
|
||||
end;
|
||||
|
||||
|
||||
function tinputfile.fileread(var databuf; maxsize: longint): longint;
|
||||
begin
|
||||
abstract;
|
||||
fileread:=0;
|
||||
end;
|
||||
|
||||
|
||||
function tinputfile.fileeof: boolean;
|
||||
begin
|
||||
abstract;
|
||||
fileeof:=false;
|
||||
end;
|
||||
|
||||
|
||||
function tinputfile.fileclose: boolean;
|
||||
begin
|
||||
abstract;
|
||||
fileclose:=false;
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
TDOSINPUTFILE
|
||||
****************************************************************************}
|
||||
|
||||
function tdosinputfile.fileopen(const filename: string): boolean;
|
||||
var
|
||||
ofm : byte;
|
||||
begin
|
||||
ofm:=filemode;
|
||||
filemode:=0;
|
||||
Assign(f,filename);
|
||||
{$I-}
|
||||
reset(f,1);
|
||||
{$I+}
|
||||
filemode:=ofm;
|
||||
fileopen:=(ioresult=0);
|
||||
end;
|
||||
|
||||
|
||||
function tdosinputfile.fileseek(pos: longint): boolean;
|
||||
begin
|
||||
{$I-}
|
||||
seek(f,BufStart);
|
||||
{$I+}
|
||||
fileseek:=(ioresult=0);
|
||||
end;
|
||||
|
||||
|
||||
function tdosinputfile.fileread(var databuf; maxsize: longint): longint;
|
||||
var w: {$ifdef TP}word{$else}longint{$endif};
|
||||
begin
|
||||
blockread(f,databuf,maxsize,w);
|
||||
fileread:=w;
|
||||
end;
|
||||
|
||||
|
||||
function tdosinputfile.fileeof: boolean;
|
||||
begin
|
||||
fileeof:=eof(f);
|
||||
end;
|
||||
|
||||
|
||||
function tdosinputfile.fileclose: boolean;
|
||||
begin
|
||||
{$I-}
|
||||
system.close(f);
|
||||
{$I+}
|
||||
fileclose:=(ioresult=0);
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
TFILEMANAGER
|
||||
****************************************************************************}
|
||||
@ -1408,7 +1477,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2000-07-13 11:32:41 michael
|
||||
Revision 1.3 2000-08-12 15:30:44 peter
|
||||
* IDE patch for stream reading (merged)
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:41 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
|
||||
@ -1266,34 +1266,8 @@ implementation
|
||||
|
||||
|
||||
Function GetNamedFileTime (Const F : String) : Longint;
|
||||
var
|
||||
L : Longint;
|
||||
{$ifndef linux}
|
||||
info : SearchRec;
|
||||
{$else}
|
||||
info : stat;
|
||||
{$endif}
|
||||
begin
|
||||
l:=-1;
|
||||
{$ifdef linux}
|
||||
if FStat (F,Info) then
|
||||
L:=info.mtime;
|
||||
{$else}
|
||||
{$ifdef delphi}
|
||||
dmisc.FindFirst (F,archive+readonly+hidden,info);
|
||||
{$else delphi}
|
||||
FindFirst (F,archive+readonly+hidden,info);
|
||||
{$endif delphi}
|
||||
if DosError=0 then
|
||||
l:=info.time;
|
||||
{$ifdef Linux}
|
||||
FindClose(info);
|
||||
{$endif}
|
||||
{$ifdef Win32}
|
||||
FindClose(info);
|
||||
{$endif}
|
||||
{$endif}
|
||||
GetNamedFileTime:=l;
|
||||
GetNamedFileTime:=do_getnamedfiletime(F);
|
||||
end;
|
||||
|
||||
|
||||
@ -1588,7 +1562,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2000-08-02 19:49:59 peter
|
||||
Revision 1.5 2000-08-12 15:30:44 peter
|
||||
* IDE patch for stream reading (merged)
|
||||
|
||||
Revision 1.4 2000/08/02 19:49:59 peter
|
||||
* first things for default parameters
|
||||
|
||||
Revision 1.3 2000/07/13 12:08:25 michael
|
||||
|
||||
@ -671,7 +671,7 @@ const
|
||||
{ shutdown current file }
|
||||
current_scanner^.tempcloseinputfile;
|
||||
{ load new file }
|
||||
hp:=new(pinputfile,init(path+name+ext));
|
||||
hp:=do_openinputfile(path+name+ext);
|
||||
current_scanner^.addfile(hp);
|
||||
if not current_scanner^.openinputfile then
|
||||
Message1(scan_f_cannot_open_includefile,hs);
|
||||
@ -1432,11 +1432,14 @@ const
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2000-08-08 19:28:57 peter
|
||||
Revision 1.4 2000-08-12 15:30:44 peter
|
||||
* IDE patch for stream reading (merged)
|
||||
|
||||
Revision 1.3 2000/08/08 19:28:57 peter
|
||||
* memdebug/memory patches (merged)
|
||||
* only once illegal directive (merged)
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:49 michael
|
||||
+ removed logs
|
||||
|
||||
|
||||
}
|
||||
|
||||
@ -270,7 +270,7 @@ implementation
|
||||
|
||||
constructor tscannerfile.init(const fn:string);
|
||||
begin
|
||||
inputfile:=new(pinputfile,init(fn));
|
||||
inputfile:=do_openinputfile(fn);
|
||||
if assigned(current_module) then
|
||||
current_module^.sourcefiles^.register_file(inputfile);
|
||||
{ reset localinput }
|
||||
@ -492,7 +492,7 @@ implementation
|
||||
tempcloseinputfile;
|
||||
{ create macro 'file' }
|
||||
{ use special name to dispose after !! }
|
||||
hp:=new(pinputfile,init('_Macro_.'+macname));
|
||||
hp:=do_openinputfile('_Macro_.'+macname);
|
||||
addfile(hp);
|
||||
with inputfile^ do
|
||||
begin
|
||||
@ -1837,7 +1837,10 @@ exit_label:
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2000-08-08 19:28:57 peter
|
||||
Revision 1.4 2000-08-12 15:30:44 peter
|
||||
* IDE patch for stream reading (merged)
|
||||
|
||||
Revision 1.3 2000/08/08 19:28:57 peter
|
||||
* memdebug/memory patches (merged)
|
||||
* only once illegal directive (merged)
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user