paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 20:28:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

rtl/atari: fix readln from console

Browse Source
This commit is contained in:
Thorsten Otto 2022-02-06 17:29:28 +01:00 committed by Charlie Balogh
parent 685f72ca2f
commit 46ab8d79a2
2 changed files with 47 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
rtl/atari/sysfile.inc
View File

@ -245,10 +245,10 @@ end;
function do_isdevice(handle: thandle): boolean;
var pos, newpos: longint;
begin
if (handle=StdOutputHandle) or (handle=StdInputHandle) or
(handle=StdErrorHandle) then
do_isdevice:=True
else
do_isdevice:=False;
pos := gemdos_fseek(0, handle, SEEK_FROM_CURRENT);
newpos := gemdos_fseek(1, handle, SEEK_FROM_START);
gemdos_fseek(pos, handle, SEEK_FROM_START);
do_isdevice := (newpos=0) or (pos=ESPIPE);
end;

47
rtl/atari/system.pp
View File

@ -145,14 +145,51 @@ end;
SystemUnit Initialization
*****************************************************************************}
Procedure ConsoleRead(var t:TextRec);
var
dosResult: longint;
Begin
dosResult:=gemdos_fread(t.Handle,t.BufSize,t.Bufptr);
t.BufPos:=0;
{ Reading from console on TOS does not include the terminating CR/LF }
if (dosResult >= 0) then
begin
t.BufEnd := dosResult;
if (dosResult>=1) and (t.Bufptr^[dosResult-1] = #10) then
begin end
else
if (t.BufEnd < t.BufSize) then
begin
t.BufPtr^[t.BufEnd] := #13;
inc(t.BufEnd);
end;
if (t.BufEnd < t.BufSize) then
begin
t.BufPtr^[t.BufEnd] := #10;
inc(t.BufEnd);
end;
end
else
Error2InOutRes(dosResult);
End;
procedure myOpenStdIO(var f:text;mode:longint;hdl:thandle);
begin
OpenStdIO(f, mode, hdl);
if (InOutRes=0) and (Mode=fmInput) and Do_Isdevice(hdl) then
begin
TextRec(f).InOutFunc:=@ConsoleRead;
end;
end;
procedure SysInitStdIO;
begin
OpenStdIO(Input,fmInput,StdInputHandle);
OpenStdIO(Output,fmOutput,StdOutputHandle);
OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
myOpenStdIO(Input,fmInput,StdInputHandle);
myOpenStdIO(Output,fmOutput,StdOutputHandle);
myOpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
{$ifndef FPC_STDOUT_TRUE_ALIAS}
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
OpenStdIO(StdErr,fmOutput,StdErrorHandle);
myOpenStdIO(StdOut,fmOutput,StdOutputHandle);
myOpenStdIO(StdErr,fmOutput,StdErrorHandle);
{$endif FPC_STDOUT_TRUE_ALIAS}
end;