paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-29 08:10:56 +01:00
Code Issues Packages Projects Releases Wiki Activity

* patch by Mattias Gaertner to allow to override how the compiler reads source/ppu files, resolves #18740

Browse Source 
git-svn-id: trunk@17255 -
This commit is contained in:
florian 2011-04-05 20:10:09 +00:00
parent 00768bea47
commit 0c62133d38
7 changed files with 100 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
compiler/comprsrc.pas
View File

@ -377,18 +377,18 @@ end;
function CopyResFile(inf,outf : TCmdStr) : boolean;
var
src,dst : TCFileStream;
src,dst : TCCustomFileStream;
begin
{ Copy .res file to units output dir. }
Result:=false;
src:=TCFileStream.Create(inf,fmOpenRead or fmShareDenyNone);
src:=CFileStreamClass.Create(inf,fmOpenRead or fmShareDenyNone);
if CStreamError<>0 then
begin
Message1(exec_e_cant_open_resource_file, src.FileName);
Include(current_settings.globalswitches, cs_link_nolink);
exit;
end;
dst:=TCFileStream.Create(current_module.outputpath^+outf,fmCreate);
dst:=CFileStreamClass.Create(current_module.outputpath^+outf,fmCreate);
if CStreamError<>0 then
begin
Message1(exec_e_cant_write_resource_file, dst.FileName);

36
compiler/cstreams.pas
View File

@ -100,23 +100,38 @@ type
property Size: Longint read GetSize write SetSize;
end;
{ TCCustomFileStream class }
TCCustomFileStream = class(TCStream)
protected
FFileName : String;
public
constructor Create(const AFileName: string;{shortstring!} Mode: Word); virtual; abstract;
function EOF: boolean; virtual; abstract;
property FileName : String Read FFilename;
end;
{ TFileStream class }
TCFileStream = class(TCStream)
TCFileStream = class(TCCustomFileStream)
Private
FFileName : String;
FHandle: File;
protected
procedure SetSize(NewSize: Longint); override;
public
constructor Create(const AFileName: string; Mode: Word);
constructor Create(const AFileName: string; Mode: Word); override;
destructor Destroy; override;
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
function Seek(Offset: Longint; Origin: Word): Longint; override;
property FileName : String Read FFilename;
function EOF: boolean; override;
end;
TCFileStreamClass = class of TCCustomFileStream;
var
CFileStreamClass: TCFileStreamClass = TCFileStream;
type
{ TCustomMemoryStream abstract class }
TCCustomMemoryStream = class(TCStream)
@ -441,6 +456,11 @@ begin
Result:=l;
end;
function TCFileStream.EOF: boolean;
begin
EOF:=system.eof(FHandle);
end;
{****************************************************************************}
{* TCustomMemoryStream *}
@ -489,11 +509,11 @@ end;
procedure TCCustomMemoryStream.SaveToFile(const FileName: string);
Var S : TCFileStream;
Var S : TCCustomFileStream;
begin
Try
S:=TCFileStream.Create (FileName,fmCreate);
S:=CFileStreamClass.Create (FileName,fmCreate);
SaveToStream(S);
finally
S.free;
@ -574,11 +594,11 @@ end;
procedure TCMemoryStream.LoadFromFile(const FileName: string);
Var S : TCFileStream;
Var S : TCCustomFileStream;
begin
Try
S:=TCFileStream.Create (FileName,fmOpenRead);
S:=CFileStreamClass.Create (FileName,fmOpenRead);
LoadFromStream(S);
finally
S.free;

45
compiler/finput.pas
View File

@ -26,7 +26,7 @@ unit finput;
interface
uses
cutils,cclasses;
cutils,cclasses,cstreams;
const
InputFileBufSize=32*1024+1;
@ -91,7 +91,7 @@ interface
function fileclose: boolean; override;
procedure filegettime; override;
private
f : file; { current file handle }
f : TCCustomFileStream; { current file handle }
end;
tinputfilemanager = class
@ -457,47 +457,46 @@ uses
exit;
end;
{ Open file }
ofm:=filemode;
filemode:=0;
Assign(f,filename);
{$I-}
reset(f,1);
{$I+}
filemode:=ofm;
fileopen:=(ioresult=0);
fileopen:=false;
try
f:=CFileStreamClass.Create(filename,fmOpenRead);
fileopen:=true;
except
end;
end;
function tdosinputfile.fileseek(pos: longint): boolean;
begin
{$I-}
seek(f,Pos);
{$I+}
fileseek:=(ioresult=0);
fileseek:=false;
try
f.position:=Pos;
fileseek:=true;
except
end;
end;
function tdosinputfile.fileread(var databuf; maxsize: longint): longint;
var
w : longint;
begin
blockread(f,databuf,maxsize,w);
fileread:=w;
fileread:=f.Read(databuf,maxsize);
end;
function tdosinputfile.fileeof: boolean;
begin
fileeof:=eof(f);
fileeof:=f.eof();
end;
function tdosinputfile.fileclose: boolean;
begin
{$I-}
system.close(f);
{$I+}
fileclose:=(ioresult=0);
fileclose:=false;
try
f.Free;
fileclose:=true;
except
end;
end;

2
compiler/link.pas
View File

@ -150,7 +150,7 @@ Implementation
begin
result:=0;
bufsize:=64*1024;
fs:=TCFileStream.Create(fn,fmOpenRead or fmShareDenyNone);
fs:=CFileStreamClass.Create(fn,fmOpenRead or fmShareDenyNone);
if CStreamError<>0 then
begin
fs.Free;

4
compiler/owar.pas
View File

@ -262,11 +262,11 @@ implementation
procedure tarobjectwriter.writear;
var
arf : TCFileStream;
arf : TCCustomFileStream;
fixup,l,
relocs,i : longint;
begin
arf:=TCFileStream.Create(arfn,fmCreate);
arf:=CFileStreamClass.Create(arfn,fmCreate);
if CStreamError<>0 then
begin
Message1(exec_e_cant_create_archivefile,arfn);

8
compiler/owbase.pas
View File

@ -31,7 +31,7 @@ uses
type
tobjectwriter=class
private
f : TCFileStream;
f : TCCustomFileStream;
opened : boolean;
buf : pchar;
bufidx : longword;
@ -54,7 +54,7 @@ type
tobjectreader=class
private
f : TCFileStream;
f : TCCustomFileStream;
opened : boolean;
buf : pchar;
ffilename : string;
@ -108,7 +108,7 @@ end;
function tobjectwriter.createfile(const fn:string):boolean;
begin
createfile:=false;
f:=TCFileStream.Create(fn,fmCreate);
f:=CFileStreamClass.Create(fn,fmCreate);
if CStreamError<>0 then
begin
Message1(exec_e_cant_create_objectfile,fn);
@ -233,7 +233,7 @@ end;
function tobjectreader.openfile(const fn:string):boolean;
begin
openfile:=false;
f:=TCFileStream.Create(fn,fmOpenRead);
f:=CFileStreamClass.Create(fn,fmOpenRead);
if CStreamError<>0 then
begin
Comment(V_Error,'Can''t open object file: '+fn);

81
compiler/ppu.pas
View File

@ -26,7 +26,7 @@ unit ppu;
interface
uses
globtype,constexp;
globtype,constexp,cstreams;
{ Also write the ppu if only crc if done, this can be used with ppudump to
see the differences between the intf and implementation }
@ -188,7 +188,7 @@ type
tppufile=class
private
f : file;
f : TCCustomFileStream;
mode : byte; {0 - Closed, 1 - Reading, 2 - Writing}
fname : string;
fsize : integer;
@ -282,8 +282,8 @@ type
procedure putstring(const s:string);
procedure putnormalset(const b);
procedure putsmallset(const b);
procedure tempclose;
function tempopen:boolean;
procedure tempclose; // MG: not used, obsolete?
function tempopen:boolean; // MG: not used, obsolete?
end;
implementation
@ -356,10 +356,7 @@ begin
if Mode<>0 then
begin
Flush;
{$I-}
system.close(f);
{$I+}
if ioresult<>0 then;
f.Free;
Mode:=0;
closed:=true;
end;
@ -415,21 +412,17 @@ var
i : integer;
begin
openfile:=false;
assign(f,fname);
ofmode:=filemode;
filemode:=$0;
{$I-}
reset(f,1);
{$I+}
filemode:=ofmode;
if ioresult<>0 then
exit;
try
f:=CFileStreamClass.Create(fname,fmOpenRead)
except
exit;
end;
closed:=false;
{read ppuheader}
fsize:=filesize(f);
fsize:=f.Size;
if fsize<sizeof(tppuheader) then
exit;
blockread(f,header,sizeof(tppuheader),i);
i:=f.Read(header,sizeof(tppuheader));
{ The header is always stored in little endian order }
{ therefore swap if on a big endian machine }
{$IFDEF ENDIAN_BIG}
@ -478,7 +471,7 @@ end;
procedure tppufile.reloadbuf;
begin
inc(bufstart,bufsize);
blockread(f,buf^,ppubufsize,bufsize);
bufsize:=f.Read(buf^,ppubufsize);
bufidx:=0;
end;
@ -827,6 +820,8 @@ end;
*****************************************************************************}
function tppufile.createfile:boolean;
var
ok: boolean;
begin
createfile:=false;
{$ifdef INTFPPU}
@ -838,24 +833,26 @@ begin
{$endif}
if not crc_only then
begin
assign(f,fname);
{$ifdef MACOS}
{FPas is FreePascal's creator code on MacOS. See systems/mac_crea.txt}
SetDefaultMacOSCreator('FPas');
SetDefaultMacOSFiletype('FPPU');
{$endif}
{$I-}
rewrite(f,1);
{$I+}
ok:=false;
try
f:=CFileStreamClass.Create(fname,fmCreate);
ok:=true;
except
end;
{$ifdef MACOS}
SetDefaultMacOSCreator('MPS ');
SetDefaultMacOSFiletype('TEXT');
{$endif}
if ioresult<>0 then
if not ok then
exit;
Mode:=2;
{write header for sure}
blockwrite(f,header,sizeof(tppuheader));
f.Write(header,sizeof(tppuheader));
end;
bufsize:=ppubufsize;
bufstart:=sizeof(tppuheader);
@ -904,10 +901,10 @@ begin
header.symlistsize:=swapendian(header.symlistsize);
{$endif not FPC_BIG_ENDIAN}
{ write header and restore filepos after it }
opos:=filepos(f);
seek(f,0);
blockwrite(f,header,sizeof(tppuheader));
seek(f,opos);
opos:=f.Position;
f.Position:=0;
f.Write(header,sizeof(tppuheader));
f.Position:=opos;
end;
@ -915,7 +912,7 @@ procedure tppufile.writebuf;
begin
if not crc_only and
(bufidx <> 0) then
blockwrite(f,buf^,bufidx);
f.Write(buf^,bufidx);
inc(bufstart,bufidx);
bufidx:=0;
end;
@ -985,10 +982,10 @@ begin
{flush to be sure}
WriteBuf;
{write entry}
opos:=filepos(f);
seek(f,entrystart);
blockwrite(f,entry,sizeof(tppuentry));
seek(f,opos);
opos:=f.Position;
f.Position:=entrystart;
f.write(entry,sizeof(tppuentry));
f.Position:=opos;
end;
entrybufstart:=bufstart;
end
@ -1152,11 +1149,8 @@ procedure tppufile.tempclose;
begin
if not closed then
begin
closepos:=filepos(f);
{$I-}
system.close(f);
{$I+}
if ioresult<>0 then;
closepos:=f.Position;
f.Free;
closed:=true;
tempclosed:=true;
end;
@ -1170,6 +1164,10 @@ function tppufile.tempopen:boolean;
tempopen:=false;
if not closed or not tempclosed then
exit;
// MG: not sure, if this is correct
f.Position:=0;
(*
ofm:=filemode;
filemode:=0;
{$I-}
@ -1178,11 +1176,12 @@ function tppufile.tempopen:boolean;
filemode:=ofm;
if ioresult<>0 then
exit;
*)
closed:=false;
tempclosed:=false;
{ restore state }
seek(f,closepos);
f.Position:=closepos;
tempopen:=true;
end;