mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 01:29:29 +02:00
+ Error2InoutRes implemented
* do_read was doing a wrong os call! * do_open was not pushing the right values * DosDir was pushing the wrong params on the stack * do_close would never works, was pushing a longint instead of word
This commit is contained in:
carl
parent
5bac56f11c
commit
1b9ffe21b8
@ -1,7 +1,8 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team.
|
||||
Copyright (c) 1993,98 by Carl Eric Codere
|
||||
member of the Free Pascal development team
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
@ -14,9 +15,14 @@
|
||||
{$define ATARI}
|
||||
unit sysatari;
|
||||
|
||||
{--------------------------------------------------------------------}
|
||||
{ LEFT TO DO: }
|
||||
{--------------------------------------------------------------------}
|
||||
{ o SBrk }
|
||||
{ o Implement truncate }
|
||||
{ o Implement paramcount and paramstr }
|
||||
{--------------------------------------------------------------------}
|
||||
|
||||
{ Left to do : }
|
||||
{ - Fix DOSError codes to conform to those of DOS (TP) }
|
||||
|
||||
{$I os.inc}
|
||||
|
||||
@ -33,13 +39,15 @@ const
|
||||
UnusedHandle = $ffff;
|
||||
StdInputHandle = 0;
|
||||
StdOutputHandle = 1;
|
||||
StdErrorHandle = $ffff;
|
||||
StdErrorHandle = $ffff;
|
||||
|
||||
implementation
|
||||
|
||||
{$I system.inc}
|
||||
{$I lowmath.inc}
|
||||
|
||||
var
|
||||
errno : integer;
|
||||
type
|
||||
plongint = ^longint;
|
||||
|
||||
@ -59,6 +67,34 @@ const
|
||||
end;
|
||||
|
||||
|
||||
Procedure Error2InOut;
|
||||
Begin
|
||||
if (errno <= -2) and (errno >= -11) then
|
||||
InOutRes:=150-errno { 150+errno }
|
||||
else
|
||||
Begin
|
||||
case errno of
|
||||
-32 : InOutRes:=1;
|
||||
-33 : InOutRes:=2;
|
||||
-34 : InOutRes:=3;
|
||||
-35 : InOutRes:=4;
|
||||
-36 : InOutRes:=5;
|
||||
-37 : InOutRes:=8;
|
||||
-39 : InOutRes:=8;
|
||||
-40 : InOutRes:=9;
|
||||
-46 : InOutRes:=15;
|
||||
-67..-64 : InOutRes:=153;
|
||||
-15 : InOutRes:=151;
|
||||
-13 : InOutRes:=150;
|
||||
else
|
||||
InOutres := word(errno);
|
||||
end;
|
||||
end;
|
||||
errno:=0;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure halt(errnum : byte);
|
||||
|
||||
begin
|
||||
@ -146,7 +182,8 @@ procedure do_close(h : longint);
|
||||
begin
|
||||
asm
|
||||
movem.l d2/d3/a2/a3,-(sp)
|
||||
move.l h,-(sp)
|
||||
move.l h,d0
|
||||
move.w d0,-(sp)
|
||||
move.w #$3e,-(sp)
|
||||
trap #1
|
||||
add.l #4,sp { restore stack ... }
|
||||
@ -169,9 +206,11 @@ begin
|
||||
movem.l (sp)+,d3/a2/a3
|
||||
tst.w d0
|
||||
beq @doserend
|
||||
move.w d0,InOutRes
|
||||
move.w d0,errno
|
||||
@doserend:
|
||||
end;
|
||||
if errno <> 0 then
|
||||
Error2InOut;
|
||||
end;
|
||||
|
||||
|
||||
@ -192,16 +231,18 @@ begin
|
||||
movem.l (sp)+,d3/a2/a3
|
||||
tst.w d0
|
||||
beq @dosreend
|
||||
move.w d0,InOutRes { error ... }
|
||||
move.w d0,errno { error ... }
|
||||
@dosreend:
|
||||
end;
|
||||
if errno <> 0 then
|
||||
Error2InOut;
|
||||
end;
|
||||
|
||||
function do_isdevice(handle:longint):boolean;
|
||||
function do_isdevice(handle:word):boolean;
|
||||
begin
|
||||
if (handle=stdoutputhandle) or (handle=stdinputhandle) or
|
||||
(handle=stderrorhandle) then
|
||||
do_isdevice:=FALSE;
|
||||
do_isdevice:=FALSE
|
||||
else
|
||||
do_isdevice:=TRUE;
|
||||
end;
|
||||
@ -214,7 +255,8 @@ begin
|
||||
movem.l d3/a2/a3,-(sp)
|
||||
move.l addr,-(sp)
|
||||
move.l len,-(sp)
|
||||
move.w h,-(sp)
|
||||
move.l h,d0
|
||||
move.w d0,-(sp)
|
||||
move.w #$40,-(sp)
|
||||
trap #1
|
||||
lea 12(sp),sp
|
||||
@ -222,10 +264,12 @@ begin
|
||||
movem.l (sp)+,d3/a2/a3
|
||||
tst.l d0
|
||||
bpl @doswrend
|
||||
move.w d0,InOutRes { error ... }
|
||||
move.w d0,errno { error ... }
|
||||
@doswrend:
|
||||
move.l d0,@RESULT
|
||||
end;
|
||||
if errno <> 0 then
|
||||
Error2InOut;
|
||||
end;
|
||||
|
||||
|
||||
@ -236,18 +280,21 @@ begin
|
||||
movem.l d3/a2/a3,-(sp)
|
||||
move.l addr,-(sp)
|
||||
move.l len,-(sp)
|
||||
move.w h,-(sp)
|
||||
move.w #$40,-(sp)
|
||||
move.l h,d0
|
||||
move.w d0,-(sp)
|
||||
move.w #$3f,-(sp)
|
||||
trap #1
|
||||
lea 12(sp),sp
|
||||
move.l d6,d2 { restore d2 }
|
||||
movem.l (sp)+,d3/a2/a3
|
||||
tst.l d0
|
||||
bpl @dosrdend
|
||||
move.w d0,InOutRes { error ... }
|
||||
move.w d0,errno { error ... }
|
||||
@dosrdend:
|
||||
move.l d0,@Result
|
||||
end;
|
||||
if errno <> 0 then
|
||||
Error2InOut;
|
||||
end;
|
||||
|
||||
|
||||
@ -257,7 +304,8 @@ begin
|
||||
move.l d2,d6 { save d2 }
|
||||
movem.l d3/a2/a3,-(sp)
|
||||
move.w #1,-(sp) { seek from current position }
|
||||
move.w handle,-(sp)
|
||||
move.l handle,d0
|
||||
move.w d0,-(sp)
|
||||
move.l #0,-(sp) { with a seek offset of zero }
|
||||
move.w #$42,-(sp)
|
||||
trap #1
|
||||
@ -275,7 +323,8 @@ begin
|
||||
move.l d2,d6 { save d2 }
|
||||
movem.l d3/a2/a3,-(sp)
|
||||
move.w #0,-(sp) { seek from start of file }
|
||||
move.w handle,-(sp)
|
||||
move.l handle,d0
|
||||
move.w d0,-(sp)
|
||||
move.l pos,-(sp)
|
||||
move.w #$42,-(sp)
|
||||
trap #1
|
||||
@ -294,7 +343,8 @@ begin
|
||||
move.l d2,d6 { save d2 }
|
||||
movem.l d3/a2/a3,-(sp)
|
||||
move.w #2,-(sp) { seek from end of file }
|
||||
move.w handle,-(sp)
|
||||
move.l handle,d0
|
||||
move.w d0,-(sp)
|
||||
move.l #0,-(sp) { with an offset of 0 from end }
|
||||
move.w #$42,-(sp)
|
||||
trap #1
|
||||
@ -333,7 +383,7 @@ procedure do_open(var f;p:pchar;flags:longint);
|
||||
when (flags and $1000) there is no check for close (needed for textfiles)
|
||||
}
|
||||
var
|
||||
i : longint;
|
||||
i : word;
|
||||
oflags: longint;
|
||||
begin
|
||||
AllowSlash(p);
|
||||
@ -352,12 +402,12 @@ begin
|
||||
end;
|
||||
{ reset file handle }
|
||||
filerec(f).handle:=UnusedHandle;
|
||||
oflags:=$04;
|
||||
oflags:=$02; { read/write mode }
|
||||
{ convert filemode to filerec modes }
|
||||
case (flags and 3) of
|
||||
0 : begin
|
||||
filerec(f).mode:=fminput;
|
||||
oflags:=$01;
|
||||
oflags:=$00; { read mode only }
|
||||
end;
|
||||
1 : filerec(f).mode:=fmoutput;
|
||||
2 : filerec(f).mode:=fminout;
|
||||
@ -365,13 +415,13 @@ begin
|
||||
if (flags and $100)<>0 then
|
||||
begin
|
||||
filerec(f).mode:=fmoutput;
|
||||
oflags:=$02;
|
||||
oflags:=$04; { read/write with create }
|
||||
end
|
||||
else
|
||||
if (flags and $10)<>0 then
|
||||
begin
|
||||
filerec(f).mode:=fmoutput;
|
||||
oflags:=$04;
|
||||
oflags:=$02; { read/write }
|
||||
end;
|
||||
{ empty name is special }
|
||||
if p[0]=#0 then
|
||||
@ -389,28 +439,42 @@ begin
|
||||
asm
|
||||
movem.l d2/d3/a2/a3,-(sp) { save used registers }
|
||||
|
||||
cmp.l #4,oflags { check if append mode ... }
|
||||
cmp.l #4,oflags { check if rewrite mode ... }
|
||||
bne @opencont2
|
||||
move.w #2,d0 { append mode... r/w open }
|
||||
bra @opencont1
|
||||
{ rewrite mode - create new file }
|
||||
move.w #0,-(sp)
|
||||
move.l p,-(sp)
|
||||
move.w #$3c,-(sp)
|
||||
trap #1
|
||||
add.l #8,sp { restore stack of os call }
|
||||
bra @end
|
||||
{ reset - open existing files }
|
||||
@opencont2:
|
||||
move.l oflags,d0 { use flag as source ... }
|
||||
@opencont1:
|
||||
move.w d0,-(sp)
|
||||
pea p
|
||||
move.l p,-(sp)
|
||||
move.w #$3d,-(sp)
|
||||
trap #1
|
||||
add.l #8,sp { restore stack of os call }
|
||||
|
||||
@end:
|
||||
movem.l (sp)+,d2/d3/a2/a3
|
||||
|
||||
tst.l d0
|
||||
bpl @opennoerr
|
||||
move.w d0,InOutRes
|
||||
tst.w d0
|
||||
bpl @opennoerr { if positive return values then ok }
|
||||
cmp.w #-1,d0 { if handle is -1 CON: }
|
||||
beq @opennoerr
|
||||
cmp.w #-2,d0 { if handle is -2 AUX: }
|
||||
beq @opennoerr
|
||||
cmp.w #-3,d0 { if handle is -3 PRN: }
|
||||
beq @opennoerr
|
||||
move.w d0,errno { otherwise normal error }
|
||||
@opennoerr:
|
||||
move.l d0,i { get handle ... }
|
||||
move.w d0,i { get handle as SIGNED VALUE... }
|
||||
end;
|
||||
filerec(f).handle:=i;
|
||||
if errno <> 0 then
|
||||
Error2InOut;
|
||||
filerec(f).handle:=i;
|
||||
if (flags and $10)<>0 then
|
||||
do_seekend(filerec(f).handle);
|
||||
end;
|
||||
@ -440,24 +504,28 @@ end;
|
||||
procedure DosDir(func:byte;const s:string);
|
||||
var
|
||||
buffer : array[0..255] of char;
|
||||
c : word;
|
||||
begin
|
||||
move(s[1],buffer,length(s));
|
||||
buffer[length(s)]:=#0;
|
||||
AllowSlash(pchar(@buffer));
|
||||
c:=word(func);
|
||||
asm
|
||||
move.l d2,d6 { save d2 }
|
||||
movem.l d3/a2/a3,-(sp)
|
||||
pea buffer
|
||||
move.b func,-(sp)
|
||||
move.w c,-(sp)
|
||||
trap #1
|
||||
add.l #6,sp
|
||||
move.l d6,d2 { restore d2 }
|
||||
movem.l (sp)+,d3/a2/a3
|
||||
tst.w d0
|
||||
beq @dosdirend
|
||||
move.w d0,InOutRes
|
||||
move.w d0,errno
|
||||
@dosdirend:
|
||||
end;
|
||||
if errno <> 0 then
|
||||
Error2InOut;
|
||||
end;
|
||||
|
||||
|
||||
@ -485,19 +553,21 @@ end;
|
||||
procedure getdir(drivenr : byte;var dir : string);
|
||||
var
|
||||
temp : array[0..255] of char;
|
||||
sof : pchar;
|
||||
i : longint;
|
||||
j: byte;
|
||||
drv: word;
|
||||
begin
|
||||
sof:=pchar(@dir[4]);
|
||||
drv:=word(drivenr);
|
||||
asm
|
||||
move.l d2,d6 { save d2 }
|
||||
movem.l d3/a2/a3,-(sp)
|
||||
|
||||
{ Get dir from drivenr : 0=default, 1=A etc... }
|
||||
move.w drivenr,-(sp)
|
||||
move.w drv,-(sp)
|
||||
|
||||
{ put (previously saved) offset in si }
|
||||
pea dir
|
||||
{ move.l temp,-(sp)}
|
||||
pea temp
|
||||
|
||||
{ call attos function 47H : Get dir }
|
||||
move.w #$47,-(sp)
|
||||
@ -509,21 +579,18 @@ begin
|
||||
move.l d6,d2 { restore d2 }
|
||||
movem.l (sp)+,d3/a2/a3
|
||||
end;
|
||||
{ Now Dir should be filled with directory in ASCIIZ, }
|
||||
{ starting from dir[4] }
|
||||
dir[0]:=#3;
|
||||
dir[2]:=':';
|
||||
dir[3]:='\';
|
||||
i:=4;
|
||||
{ conversation to Pascal string }
|
||||
while (dir[i]<>#0) do
|
||||
{ conversion to pascal string }
|
||||
i:=0;
|
||||
while (temp[i]<>#0) do
|
||||
begin
|
||||
{ convert path name to DOS }
|
||||
if dir[i]='/' then
|
||||
dir[i]:='\';
|
||||
dir[0]:=chr(i);
|
||||
if temp[i]='/' then
|
||||
temp[i]:='\';
|
||||
dir[i+3]:=temp[i];
|
||||
inc(i);
|
||||
end;
|
||||
dir[2]:=':';
|
||||
dir[3]:='\';
|
||||
dir[0]:=char(i+2);
|
||||
{ upcase the string (FPKPascal function) }
|
||||
dir:=upcase(dir);
|
||||
if drivenr<>0 then { Drive was supplied. We know it }
|
||||
@ -536,14 +603,15 @@ begin
|
||||
move.w #$19,-(sp)
|
||||
trap #1
|
||||
add.l #2,sp
|
||||
move.w d0,drv
|
||||
move.l d6,d2 { restore d2 }
|
||||
movem.l (sp)+,d3/a2/a3
|
||||
end;
|
||||
dir[1]:=chr(i);
|
||||
dir[1]:=chr(byte(drv)+ord('A'));
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
SystemUnit Initialization
|
||||
*****************************************************************************}
|
||||
@ -562,11 +630,19 @@ begin
|
||||
OpenStdIO(StdErr,fmOutput,StdErrorHandle);
|
||||
{ Reset IO Error }
|
||||
InOutRes:=0;
|
||||
errno := 0;
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 1998-07-02 12:39:27 carl
|
||||
Revision 1.5 1998-07-13 12:34:13 carl
|
||||
+ Error2InoutRes implemented
|
||||
* do_read was doing a wrong os call!
|
||||
* do_open was not pushing the right values
|
||||
* DosDir was pushing the wrong params on the stack
|
||||
* do_close would never works, was pushing a longint instead of word
|
||||
|
||||
Revision 1.4 1998/07/02 12:39:27 carl
|
||||
* IOCheck for mkdir,chdir and rmdir, just like in TP
|
||||
|
||||
Revision 1.3 1998/07/01 14:40:20 carl
|
||||
|
||||
Loading…
Reference in New Issue
Block a user