+ first version (not fully working yet)

rtl/amiga/objinc.inc

@@ -0,0 +1,266 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1993-98 by the Free Pascal development team.
+
+    Includefile for objects.pp implementing OS-dependent file routines
+    for AmigaOS
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+}
+
+    Const
+
+    _LVOFindTask          = -294;
+    _LVOWaitPort          = -384;
+    _LVOGetMsg            = -372;
+    _LVOOpenLibrary       = -552;
+    _LVOCloseLibrary      = -414;
+    _LVOClose             = -36;
+    _LVOOpen              = -30;
+    _LVOIoErr             = -132;
+    _LVOSeek              = -66;
+    _LVODeleteFile        = -72;
+    _LVORename            = -78;
+    _LVOWrite             = -48;
+    _LVORead              = -42;
+    _LVOCreateDir         = -120;
+    _LVOSetCurrentDirName = -558;
+    _LVOGetCurrentDirName = -564;
+    _LVOInput             = -54;
+    _LVOOutput            = -60;
+    _LVOUnLock            = -90;
+    _LVOLock              = -84;
+    _LVOCurrentDir        = -126;
+
+    _LVONameFromLock      = -402;
+    _LVONameFromFH        = -408;
+    _LVOGetProgramName    = -576;
+    _LVOGetProgramDir     = -600;
+    _LVODupLock           =  -96;
+    _LVOExamine           = -102;
+    _LVOParentDir         = -210;
+
+
+
+
+{---------------------------------------------------------------------------}
+{  FileClose -> Platforms AmigaOS          - Not checked                    }
+{---------------------------------------------------------------------------}
+FUNCTION FileClose(Handle: THandle): word;
+begin
+  asm
+            move.l  handle,d1
+            move.l  a6,d6              { save a6 }
+            move.l  _DOSBase,a6
+            jsr     _LVOClose(a6)
+            move.l  d6,a6              { restore a6 }
+  end;
+   FileClose := 0;
+end;
+
+{---------------------------------------------------------------------------}
+{  FileOpen -> Platforms AmigaOS          - Never checked                   }
+{  Returns 0 on failure                                                     }
+{---------------------------------------------------------------------------}
+
+FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
+var
+ oflags : longint;
+ AHandle : THandle;
+begin
+  { On opening reset error code }
+  DosStreamError := 0;
+  if Mode=stCreate then
+      { read/write file with creation of file }
+      oflags := 1006
+  else
+      { read/write access on existing file }
+      oflags := 1005;
+      asm
+             move.l  a6,d6                  { save a6 }
+
+             move.l  FileName,d1
+             move.l  oflags,d2               { MODE_READWRITE }
+             move.l  _DOSBase,a6
+             jsr     _LVOOpen(a6)
+             tst.l   d0
+             bne     @noopenerror           { on zero an error occured }
+             jsr     _LVOIoErr(a6)
+             move.w  d0,DosStreamError
+             bra     @openend
+          @noopenerror:
+             move.l  d6,a6                 { restore a6 }
+             move.l  d0,AHandle            { we need the base pointer to access this variable }
+             bra     @end
+          @openend:
+             move.l  d6,a6                 { restore a6 }
+          @end:
+         end;
+   FileOpen := AHandle;
+end;
+
+
+{***************************************************************************}
+{  DosSetFilePtr -> Platforms AmigaOS      - Not Checked                    }
+{***************************************************************************}
+FUNCTION SetFilePos (Handle: THandle; Pos: LongInt; MoveType: Word;
+Var Actual: LongInt): Word;
+Var
+  Move_typ : longint;
+BEGIN
+  Move_typ := 0;
+  { Move from beginning of file }
+  if MoveType = 0 then
+   Move_typ := -1;
+  { Move from current position of file }
+  If MoveType = 1 then
+   Move_typ := 0;
+  { Move from end of file              }
+  If MoveType = 2 then
+    Move_typ := 1;
+       asm
+             move.l  a6,d6
+
+             move.l  handle,d1
+             move.l  d2,-(sp)
+             move.l  d3,-(sp)              { save registers              }
+
+             move.l  pos,d2
+             move.l  Move_typ,d3           { Setup correct move type     }
+             move.l  _DOSBase,a6
+             jsr    _LVOSeek(a6)
+
+             move.l  (sp)+,d3              { restore registers }
+             move.l  (sp)+,d2
+             cmp.l   #-1,d0                { is there a file access error? }
+             bne     @noerr
+             jsr     _LVOIoErr(a6)
+             move.w  d0,DosStreamError
+             bra     @seekend
+      @noerr:
+      @seekend:
+             move.l  d6,a6                 { restore a6 }
+       end;
+   Actual := pos;
+   SetFilePos := DosStreamError;                   { Return any error }
+END;
+
+
+{---------------------------------------------------------------------------}
+{  FileRead -> Platforms AmigaOS          - Not checked                     }
+{---------------------------------------------------------------------------}
+FUNCTION FileRead (Handle: THandle; Var Buf; Count: Sw_Word;
+Var Actual: Sw_Word): Word;
+BEGIN
+  if Count <= 0 then
+  Begin
+     FileRead:=1;  { Return a non zero error }
+     exit;
+  end;
+  asm
+            move.l  a6,d6
+
+            movem.l d2/d3,-(sp)
+            move.l  handle,d1         { we must set up aparamters BEFORE }
+            move.l  buf,d2            { setting up a6 for the OS call    }
+            move.l  count,d3
+            move.l  _DOSBase,a6
+            jsr     _LVORead(a6)
+            movem.l (sp)+,d2/d3
+
+            cmp.l   #-1,d0
+            bne     @doswrend              { if -1 = error }
+            jsr     _LVOIoErr(a6)
+            move.w  d0,DosStreamError
+            bra     @doswrend2
+          @doswrend:
+            { to store a result for the function  }
+            { we must of course first get back the}
+            { base pointer!                       }
+            move.l  d6,a6
+            move.l  d0,Actual
+            bra     @end
+          @doswrend2:
+            move.l  d6,a6
+          @end:
+  end;
+  Actual:=Count;
+  FileRead:=DosStreamError;
+end;
+
+
+{---------------------------------------------------------------------------}
+{  FileWrite -> Platforms AmigAOS          - Not Checked                    }
+{---------------------------------------------------------------------------}
+FUNCTION FileWrite (Handle: THandle; Var Buf; Count: Sw_Word; Var Actual: Sw_Word): Word;
+BEGIN
+  if Count <= 0 then
+   Begin
+    FileWrite:=1;  { Reaturn a non zero error code }
+    exit;
+   end;
+  asm
+            move.l  a6,d6
+
+            movem.l d2/d3,-(sp)
+            move.l  handle,d1             { we must of course set up the }
+            move.l  buf,d2                { parameters BEFORE getting    }
+            move.l  count,d3              { _DOSBase                     }
+            move.l  _DOSBase,a6
+            jsr     _LVOWrite(a6)
+            movem.l (sp)+,d2/d3
+
+            cmp.l   #-1,d0
+            bne     @doswrend              { if -1 = error }
+            jsr     _LVOIoErr(a6)
+            move.w  d0,DosStreamError
+            bra     @doswrend2
+          @doswrend:
+            { we must restore the base pointer before setting the result }
+            move.l  d6,a6
+            move.l  d0,Actual
+            bra     @end
+          @doswrend2:
+            move.l  d6,a6
+          @end:
+  end;
+   Actual:=Count;
+   FileWrite:=DosStreamError;
+end;
+
+
+{---------------------------------------------------------------------------}
+{  SetFileSize -> Platforms AmigaOS      - Not Checked                      }
+{---------------------------------------------------------------------------}
+FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word;
+VAR Actual, Buf: LongInt;
+BEGIN
+   SetFilePos(Handle,FileSize,0,Actual);
+   If (Actual = FileSize) Then
+    Begin
+      Actual := FileWrite(Handle, Pointer(@Buf), 0,Actual);   { Truncate the file }
+      If (Actual <> -1) Then
+       SetFileSize := 0
+      Else
+       SetFileSize := 103;                            { File truncate error }
+    End
+   Else
+    SetFileSize := 103;                       { File truncate error }
+END;
+
+{
+  $Log$
+  Revision 1.1  1998-07-08 12:03:35  carl
+    + first version (not fully working yet)
+
+
+}
+