atari: rewrote system file functions. no inline assembly, updated to current standards and RTL internals

git-svn-id: trunk@34658 -

rtl/atari/sysfile.inc

@@ -1,8 +1,8 @@
 {
     This file is part of the Free Pascal run time library.
-    Copyright (c) 2005 by Free Pascal development team
+    Copyright (c) 2016 by Free Pascal development team
 
-    Low level file functions
+    Low level file functions for Atari TOS
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -13,219 +13,157 @@
 
  **********************************************************************}
 
-{$asmmode motorola}
 
 {****************************************************************************
-                          Low Level File Routines
- ****************************************************************************}
+                        Low level File Routines
+               All these functions can set InOutRes on errors
+****************************************************************************}
 
-procedure DoDirSeparators(p:pchar);
+{ close a file from the handle value }
+procedure do_close(handle : longint);
 var
-  i : longint;
+  dosResult: longint;
 begin
-{ allow slash as backslash }
-  for i:=0 to strlen(p) do
-   if p[i] in AllowDirectorySeparators then p[i]:=DirectorySeparator;
+  dosResult:=gemdos_fclose(handle);
+  if dosResult < 0 then
+    Error2InOutRes(dosResult);
 end;
 
 
-procedure do_close(h : longint);
+procedure do_erase(p : pchar; pchangeable: boolean);
+var
+  oldp: pchar;
+  dosResult: longint;
 begin
-  asm
-        movem.l d2/d3/a2/a3,-(sp)
-        move.l  h,d0
-        move.w  d0,-(sp)
-        move.w  #$3e,-(sp)
-        trap    #1
-        add.l   #4,sp      { restore stack ... }
-        movem.l (sp)+,d2/d3/a2/a3
-  end;
+  oldp:=p;
+  DoDirSeparators(p,pchangeable);
+  dosResult:=gemdos_fdelete(p);
+  if dosResult <0 then
+    Error2InOutRes(dosResult);
+  if oldp<>p then
+    FreeMem(p);
 end;
 
 
-procedure do_erase(p : pchar);
+procedure do_rename(p1,p2 : pchar; p1changeable, p2changeable: boolean);
+var
+  oldp1, oldp2 : pchar;
+  dosResult: longint;
 begin
-  DoDirSeparators(p);
-  asm
-        move.l  d2,d6            { save d2   }
-        movem.l d3/a2/a3,-(sp)   { save regs }
-        move.l  p,-(sp)
-        move.w #$41,-(sp)
-        trap   #1
-        add.l  #6,sp
-        move.l d6,d2       { restore d2 }
-        movem.l (sp)+,d3/a2/a3
-        tst.w  d0
-        beq    @doserend
-        move.w d0,errno
-        @doserend:
-  end;
-  if errno <> 0 then
-     Error2InOut;
+  oldp1:=p1;
+  oldp2:=p2;
+  DoDirSeparators(p1,p1changeable);
+  DoDirSeparators(p2,p2changeable);
+
+  dosResult:=gemdos_frename(p1,p2);
+  if dosResult < 0 then
+    Error2InOutRes(dosResult);
+
+  if oldp1<>p1 then
+    FreeMem(p1);
+  if oldp2<>p2 then
+    FreeMem(p2);
 end;
 
 
-procedure do_rename(p1,p2 : pchar);
+function do_write(h: longint; addr: pointer; len: longint) : longint;
+var
+  dosResult: longint;
 begin
-  DoDirSeparators(p1);
-  DoDirSeparators(p2);
-  asm
-            move.l  d2,d6      { save d2 }
-            movem.l d3/a2/a3,-(sp)
-            move.l  p1,-(sp)
-            move.l  p2,-(sp)
-            clr.w   -(sp)
-            move.w  #$56,-(sp)
-            trap    #1
-            lea     12(sp),sp
-            move.l  d6,d2       { restore d2 }
-            movem.l (sp)+,d3/a2/a3
-            tst.w   d0
-            beq     @dosreend
-            move.w  d0,errno    { error ... }
-         @dosreend:
-  end;
-  if errno <> 0 then
-     Error2InOut;
-end;
+  do_write:=0;
+  if (len<=0) or (h=-1) then 
+    exit;
 
-function do_isdevice(handle:word):boolean;
-begin
-  if (handle=stdoutputhandle) or (handle=stdinputhandle) or
-  (handle=stderrorhandle) then
-    do_isdevice:=FALSE
+  dosResult:=gemdos_fwrite(h, len, addr);
+  if dosResult < 0 then
+    begin
+      Error2InOutRes(dosResult);
+    end
   else
-    do_isdevice:=TRUE;
+    do_write:=dosResult;
 end;
 
 
-function do_write(h,addr,len : longint) : longint;
+function do_read(h: longint; addr: pointer; len: longint) : longint;
+var
+  dosResult: longint;
 begin
-  asm
-            move.l  d2,d6      { save d2 }
-            movem.l d3/a2/a3,-(sp)
-            move.l  addr,-(sp)
-            move.l  len,-(sp)
-            move.l  h,d0
-            move.w  d0,-(sp)
-            move.w  #$40,-(sp)
-            trap    #1
-            lea     12(sp),sp
-            move.l d6,d2       { restore d2 }
-            movem.l (sp)+,d3/a2/a3
-            tst.l   d0
-            bpl     @doswrend
-            move.w  d0,errno    { error ... }
-          @doswrend:
-            move.l  d0,@RESULT
-  end;
-  if errno <> 0 then
-     Error2InOut;
-end;
-
+  do_read:=0;
+  if (len<=0) or (h=-1) then exit;
 
-function do_read(h,addr,len : longint) : longint;
-begin
-  asm
-            move.l  d2,d6      { save d2 }
-            movem.l d3/a2/a3,-(sp)
-            move.l addr,-(sp)
-            move.l len,-(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,errno    { error ... }
-          @dosrdend:
-            move.l  d0,@Result
-  end;
-  if errno <> 0 then
-     Error2InOut;
+  dosResult:=gemdos_fread(h, len, addr);
+  if dosResult<0 then 
+    begin
+      Error2InOutRes(dosResult);
+    end 
+  else
+    do_read:=dosResult;
 end;
 
 
-function do_filepos(handle : longint) : longint;
+function do_filepos(handle: longint) : longint;
+var
+  dosResult: longint;
 begin
-  asm
-            move.l  d2,d6      { save d2 }
-            movem.l d3/a2/a3,-(sp)
-            move.w #1,-(sp)     { seek from current position }
-            move.l handle,d0
-            move.w d0,-(sp)
-            move.l #0,-(sp)     { with a seek offset of zero }
-            move.w #$42,-(sp)
-            trap   #1
-            lea    10(sp),sp
-            move.l d6,d2       { restore d2 }
-            movem.l (sp)+,d3/a2/a3
-            move.l d0,@Result
-  end;
+  do_filepos:=-1;
+  dosResult:=gemdos_fseek(0, handle, SEEK_FROM_CURRENT);
+  if dosResult < 0 then
+    begin
+      Error2InOutRes(dosResult);
+    end
+  else
+    do_filepos:=dosResult;
 end;
 
 
-procedure do_seek(handle,pos : longint);
+procedure do_seek(handle, pos: longint);
+var
+  dosResult: longint;
 begin
-  asm
-            move.l  d2,d6      { save d2 }
-            movem.l d3/a2/a3,-(sp)
-            move.w #0,-(sp)     { seek from start of file    }
-            move.l handle,d0
-            move.w d0,-(sp)
-            move.l pos,-(sp)
-            move.w #$42,-(sp)
-            trap   #1
-            lea    10(sp),sp
-            move.l d6,d2       { restore d2 }
-            movem.l (sp)+,d3/a2/a3
-  end;
+  dosResult:=gemdos_fseek(pos, handle, SEEK_FROM_START);
+  if dosResult < 0 then
+    Error2InOutRes(dosResult);
 end;
 
 
-function do_seekend(handle:longint):longint;
+function do_seekend(handle: longint):longint;
 var
- t: longint;
+  dosResult: longint;
 begin
-  asm
-            move.l  d2,d6      { save d2 }
-            movem.l d3/a2/a3,-(sp)
-            move.w #2,-(sp)     { seek from end of file        }
-            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
-            lea    10(sp),sp
-            move.l d6,d2       { restore d2 }
-            movem.l (sp)+,d3/a2/a3
-            move.l d0,t
-  end;
-   do_seekend:=t;
+  do_seekend:=-1;
+
+  dosResult:=gemdos_fseek(0, handle, SEEK_FROM_END);
+  if dosResult < 0 then
+    begin
+      Error2InOutRes(dosResult);
+    end
+  else
+    do_seekend:=dosResult;
 end;
 
 
-function do_filesize(handle : longint) : longint;
+function do_filesize(handle : THandle) : longint;
 var
-   aktfilepos : longint;
+  currfilepos: longint;
 begin
-   aktfilepos:=do_filepos(handle);
-   do_filesize:=do_seekend(handle);
-   do_seek(handle,aktfilepos);
+  do_filesize:=-1;
+  currfilepos:=do_filepos(handle);
+  if currfilepos >= 0 then
+    begin
+      do_filesize:=do_seekend(handle);
+    end;
+  do_seek(handle,currfilepos);
 end;
 
 
-procedure do_truncate (handle,pos:longint);
+{ truncate at a given position }
+procedure do_truncate(handle, pos: longint);
 begin
-  do_seek(handle,pos);
-  {!!!!!!!!!!!!}
+  { TODO: }
 end;
 
 
-procedure do_open(var f;p:pchar;flags:longint);
+procedure do_open(var f;p:pchar;flags:longint; pchangeable: boolean);
 {
   filerec and textrec have both handle and mode as the first items so
   they could use the same routine for opening/creating.
@@ -234,102 +172,78 @@ procedure do_open(var f;p:pchar;flags:longint);
   when (flags and $10000) there is no check for close (needed for textfiles)
 }
 var
-  i : word;
-  oflags: longint;
+  oldp     : pchar;
+  handle   : longint;
+  dosResult: longint;
 begin
-  DoDirSeparators(p);
- { close first if opened }
+{ close first if opened }
   if ((flags and $10000)=0) then
    begin
      case filerec(f).mode of
-      fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
-      fmclosed : ;
+       fmInput, fmOutput, fmInout:
+         do_close(filerec(f).handle);
+       fmClosed: ;
      else
-      begin
-        inoutres:=102; {not assigned}
-        exit;
-      end;
+       begin
+         InOutRes:=102; {not assigned}
+         exit;
+       end;
      end;
    end;
+
 { reset file handle }
   filerec(f).handle:=UnusedHandle;
-  oflags:=$02; { read/write mode }
-{ convert filemode to filerec modes }
+
+  { convert filemode to filerec modes }
   case (flags and 3) of
-   0 : begin
-         filerec(f).mode:=fminput;
-         oflags:=$00; { read mode only }
-       end;
-   1 : filerec(f).mode:=fmoutput;
-   2 : filerec(f).mode:=fminout;
+    0 : filerec(f).mode:=fmInput;
+    1 : filerec(f).mode:=fmOutput;
+    2 : filerec(f).mode:=fmInout;
   end;
-  if (flags and $1000)<>0 then
-   begin
-     filerec(f).mode:=fmoutput;
-     oflags:=$04;  { read/write with create }
-   end
-  else
-   if (flags and $100)<>0 then
-    begin
-      filerec(f).mode:=fmoutput;
-      oflags:=$02;  { read/write             }
-    end;
-{ empty name is special }
-  if p[0]=#0 then
-   begin
-     case filerec(f).mode of
-       fminput : filerec(f).handle:=StdInputHandle;
+
+  { empty name is special }
+  if p[0]=#0 then begin
+    case filerec(f).mode of
+      fminput :
+        filerec(f).handle:=StdInputHandle;
       fmappend,
       fmoutput : begin
-                   filerec(f).handle:=StdOutputHandle;
-                   filerec(f).mode:=fmoutput; {fool fmappend}
-                 end;
-     end;
-     exit;
-   end;
-   asm
-      movem.l d2/d3/a2/a3,-(sp)    { save used registers }
-
-      cmp.l   #4,oflags    { check if rewrite mode ... }
-      bne     @opencont2
-      { 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)
-      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.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.w  d0,i        { get handle as SIGNED VALUE...     }
-    end;
-  if errno <> 0 then
-    begin
-     Error2InOut;
-     FileRec(f).mode:=fmclosed;
+        filerec(f).handle:=StdOutputHandle;
+        filerec(f).mode:=fmOutput; {fool fmappend}
+      end;
     end;
-  filerec(f).handle:=i;
-  if ((flags and $100) <> 0) and
-       (FileRec (F).Handle <> UnusedHandle) then
-   do_seekend(filerec(f).handle);
+    exit;
+  end;
+
+  oldp:=p;
+  DoDirSeparators(p);
+
+  { rewrite (create a new file) }
+  if (flags and $1000)<>0 then
+    dosResult:=gemdos_fcreate(p,0)
+  else
+    dosResult:=gemdos_fopen(p,filerec(f).mode);
+
+  if oldp<>p then
+    freemem(p);
+
+  if dosResult < 0 then
+    Error2InOutRes(dosResult);
+
+  { append mode }
+  if ((Flags and $100)<>0) and
+      (FileRec(F).Handle<>UnusedHandle) then begin
+    do_seekend(filerec(f).handle);
+    filerec(f).mode:=fmOutput; {fool fmappend}
+  end;
+end;
+
+
+function do_isdevice(handle: thandle): boolean;
+begin
+  if (handle=StdOutputHandle) or (handle=StdInputHandle) or
+     (handle=StdErrorHandle) then
+    do_isdevice:=True
+  else
+    do_isdevice:=False;
 end;