mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 21:19:31 +02:00
* fixes handling of typed files in iso mode
git-svn-id: trunk@26436 -
This commit is contained in:
florian
parent
e6a9e385d3
commit
e841027a48
@ -1044,7 +1044,8 @@ implementation
|
||||
|
||||
{Read/write for typed files.}
|
||||
|
||||
const procprefixes:array[boolean] of string[15]=('fpc_typed_write','fpc_typed_read');
|
||||
const procprefixes:array[boolean,boolean] of string[19]=(('fpc_typed_write','fpc_typed_read'),
|
||||
('fpc_typed_write','fpc_typed_read_iso'));
|
||||
procnamesdisplay:array[boolean,boolean] of string[8] = (('Write','Read'),('WriteStr','ReadStr'));
|
||||
|
||||
var found_error,do_read,is_rwstr:boolean;
|
||||
@ -1134,7 +1135,7 @@ implementation
|
||||
{ since the parameters are in the correct order, we have to insert }
|
||||
{ the statements always at the end of the current block }
|
||||
addstatement(Tstatementnode(newstatement),
|
||||
Ccallnode.createintern(procprefixes[do_read],para
|
||||
Ccallnode.createintern(procprefixes[m_iso in current_settings.modeswitches,do_read],para
|
||||
));
|
||||
|
||||
{ if we used a temp, free it }
|
||||
|
||||
@ -1781,11 +1781,21 @@ implementation
|
||||
|
||||
{ iso file buf access? }
|
||||
if (m_iso in current_settings.modeswitches) and
|
||||
(p1.resultdef.typ=filedef) and
|
||||
(tfiledef(p1.resultdef).filetyp=ft_text) then
|
||||
(p1.resultdef.typ=filedef) then
|
||||
begin
|
||||
p1:=cderefnode.create(ccallnode.createintern('fpc_getbuf',ccallparanode.create(p1,nil)));
|
||||
typecheckpass(p1);
|
||||
case tfiledef(p1.resultdef).filetyp of
|
||||
ft_text:
|
||||
begin
|
||||
p1:=cderefnode.create(ccallnode.createintern('fpc_getbuf_text',ccallparanode.create(p1,nil)));
|
||||
typecheckpass(p1);
|
||||
end;
|
||||
ft_typed:
|
||||
begin
|
||||
p1:=cderefnode.create(ctypeconvnode.create_internal(ccallnode.createintern('fpc_getbuf_typedfile',ccallparanode.create(p1,nil)),
|
||||
getpointerdef(tfiledef(p1.resultdef).typedfiledef)));
|
||||
typecheckpass(p1);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else if (p1.resultdef.typ<>pointerdef) then
|
||||
begin
|
||||
|
||||
@ -2824,13 +2824,19 @@ implementation
|
||||
procedure tfiledef.setsize;
|
||||
begin
|
||||
case filetyp of
|
||||
ft_text :
|
||||
ft_text:
|
||||
savesize:=search_system_type('TEXTREC').typedef.size;
|
||||
ft_typed,
|
||||
ft_untyped :
|
||||
ft_typed:
|
||||
begin
|
||||
savesize:=search_system_type('FILEREC').typedef.size;
|
||||
{ allocate put/get buffer in iso mode }
|
||||
if m_iso in current_settings.modeswitches then
|
||||
inc(savesize,typedfiledef.size);
|
||||
end;
|
||||
ft_untyped:
|
||||
savesize:=search_system_type('FILEREC').typedef.size;
|
||||
else
|
||||
internalerror(2013113001);
|
||||
else
|
||||
internalerror(2013113001);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -511,7 +511,8 @@ procedure fpc_Read_Text_Int64_Iso(var f : text; out i : int64); compilerproc;
|
||||
Procedure fpc_Read_Text_LongWord(var f : text; out q : longword); compilerproc;
|
||||
Procedure fpc_Read_Text_LongInt(var f : text; out i : longint); compilerproc;
|
||||
{$endif CPU16 or CPU8}
|
||||
function fpc_GetBuf(var f : Text) : pchar; compilerproc;
|
||||
function fpc_GetBuf_Text(var f : Text) : pchar; compilerproc;
|
||||
function fpc_GetBuf_TypedFile(var f : TypedFile) : pointer; compilerproc;
|
||||
{$endif FPC_HAS_FEATURE_TEXTIO}
|
||||
|
||||
{$ifdef FPC_INCLUDE_SOFTWARE_MOD_DIV}
|
||||
@ -690,6 +691,7 @@ Procedure fpc_reset_typed_iso(var f : TypedFile;Size : Longint); compilerproc;
|
||||
Procedure fpc_rewrite_typed_iso(var f : TypedFile;Size : Longint); compilerproc;
|
||||
Procedure fpc_typed_write(TypeSize : Longint;var f : TypedFile;const Buf); compilerproc;
|
||||
Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;out Buf); compilerproc;
|
||||
Procedure fpc_typed_read_iso(TypeSize : Longint;var f : TypedFile;out Buf); compilerproc;
|
||||
{$endif FPC_HAS_FEATURE_FILEIO}
|
||||
|
||||
{$ifdef FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
|
||||
|
||||
@ -40,6 +40,9 @@ unit iso7185;
|
||||
Procedure Get(Var t: Text);
|
||||
Procedure Put(Var t: Text);
|
||||
|
||||
Procedure Get(Var f: TypedFile);
|
||||
Procedure Put(Var f: TypedFile);
|
||||
|
||||
Function Eof(var f:TypedFile): Boolean;
|
||||
|
||||
implementation
|
||||
@ -79,10 +82,17 @@ unit iso7185;
|
||||
var
|
||||
OldCtrlZMarksEof : Boolean;
|
||||
Begin
|
||||
OldCtrlZMarksEof:=CtrlZMarksEOF;
|
||||
CtrlZMarksEof:=false;
|
||||
Eof:=System.Eof(t);
|
||||
CtrlZMarksEof:=OldCtrlZMarksEOF;
|
||||
{ not sure if this is correct, but we are always at eof when
|
||||
writing to a file }
|
||||
if TextRec(t).mode=fmOutput then
|
||||
Eof:=true
|
||||
else
|
||||
begin
|
||||
OldCtrlZMarksEof:=CtrlZMarksEOF;
|
||||
CtrlZMarksEof:=false;
|
||||
Eof:=System.Eof(t);
|
||||
CtrlZMarksEof:=OldCtrlZMarksEOF;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -109,19 +119,19 @@ unit iso7185;
|
||||
End;
|
||||
|
||||
|
||||
Procedure Page;
|
||||
Procedure Page;[IOCheck];
|
||||
begin
|
||||
Page(Output);
|
||||
end;
|
||||
|
||||
|
||||
Procedure Page(var t : Text);
|
||||
Procedure Page(var t : Text);[IOCheck];
|
||||
Begin
|
||||
write(#12);
|
||||
End;
|
||||
|
||||
|
||||
procedure Get(var t : Text);
|
||||
procedure Get(var t : Text);[IOCheck];
|
||||
var
|
||||
c : char;
|
||||
Begin
|
||||
@ -129,7 +139,7 @@ unit iso7185;
|
||||
End;
|
||||
|
||||
|
||||
Procedure Put(var t : Text);
|
||||
Procedure Put(var t : Text);[IOCheck];
|
||||
type
|
||||
FileFunc = Procedure(var t : TextRec);
|
||||
begin
|
||||
@ -139,7 +149,20 @@ unit iso7185;
|
||||
end;
|
||||
|
||||
|
||||
Function Eof(var f:TypedFile): Boolean;
|
||||
procedure Get(var f:TypedFile);[IOCheck];
|
||||
Begin
|
||||
if not(eof(f)) then
|
||||
BlockRead(f,(pbyte(@f)+sizeof(FileRec))^,1)
|
||||
End;
|
||||
|
||||
|
||||
Procedure Put(var f:TypedFile);[IOCheck];
|
||||
begin
|
||||
BlockWrite(f,(pbyte(@f)+sizeof(FileRec))^,1)
|
||||
end;
|
||||
|
||||
|
||||
Function Eof(var f:TypedFile): Boolean;[IOCheck];
|
||||
Type
|
||||
UnTypedFile = File;
|
||||
Begin
|
||||
@ -150,8 +173,7 @@ begin
|
||||
{ we shouldn't do this because it might confuse user programs, but for now it
|
||||
is good enough to get pretty unique tmp file names }
|
||||
Randomize;
|
||||
{ reset opens with read-only }
|
||||
Filemode:=0;
|
||||
end.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1724,7 +1724,7 @@ end;
|
||||
procedure fpc_Read_Text_Char_intern(var f : Text; out c: char); iocheck; [external name 'FPC_READ_TEXT_CHAR'];
|
||||
|
||||
|
||||
function fpc_GetBuf(var f : Text) : pchar; iocheck; compilerproc;
|
||||
function fpc_GetBuf_Text(var f : Text) : pchar; iocheck; compilerproc;
|
||||
Begin
|
||||
Result:=@TextRec(f).Bufptr^[TextRec(f).BufEnd];
|
||||
If not CheckRead(f) then
|
||||
|
||||
@ -97,6 +97,7 @@ Begin
|
||||
DoAssign(f);
|
||||
|
||||
Reset(UnTypedFile(f),Size);
|
||||
BlockRead(UntypedFile(f),(pbyte(@f)+sizeof(FileRec))^,1);
|
||||
End;
|
||||
|
||||
|
||||
@ -143,3 +144,19 @@ Begin
|
||||
end;
|
||||
End;
|
||||
|
||||
|
||||
Procedure fpc_typed_read_iso(TypeSize : Longint;var f : TypedFile;out Buf);[IOCheck, Public, Alias :'FPC_TYPED_READ_ISO']; compilerproc;
|
||||
var
|
||||
Result : Longint;
|
||||
Begin
|
||||
move((pbyte(@f)+sizeof(TypedFile))^,Buf,TypeSize);
|
||||
if not(eof(f)) then
|
||||
BlockRead(f,(pbyte(@f)+sizeof(FileRec))^,1)
|
||||
End;
|
||||
|
||||
|
||||
function fpc_GetBuf_TypedFile(var f : TypedFile) : pointer; [IOCheck]; compilerproc;
|
||||
Begin
|
||||
Result:=pbyte(@f)+sizeof(TypedFile);
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user