fpc/rtl/go32v2/objinc.inc

{
    $Id$
    This file is part of the Free Pascal run time library.
    Copyright (c) 1999-2000 by the Free Pascal development team.

    Includefile for objects.pp implementing OS-dependent file routines
    for Go32V2

    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.

 **********************************************************************
}

{---------------------------------------------------------------------------}
{  FileClose -> Platforms DOS              - Not checked                    }
{---------------------------------------------------------------------------}
FUNCTION FileClose (Handle: THandle): Word;
var
  regs : trealregs;
begin
  regs.realebx:=handle;
  regs.realeax:=$3e00;
  sysrealintr($21,regs);
  FileClose := 0;
end;


{---------------------------------------------------------------------------}
{  FileOpen -> Platforms DOS              - Checked 05May1998 CEC           }
{  Returns 0 on failure                                                     }
{---------------------------------------------------------------------------}
FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
Var
  regs : trealregs;
BEGIN
         DosStreamError:=0;
         syscopytodos(longint(@FileName),256);
         { get linear address from system unit }
         regs.realedx:=tb mod 16;
         regs.realds:=tb div 16;
         regs.realeax := Mode;
         regs.realecx:=0;
         sysrealintr($21,regs);
         if (regs.realflags and 1) <> 0 then
           begin
             InOutRes:=lo(regs.realeax);
             FileOpen:=$0;
             exit;
           end
         else
            { word handle (under DOS) }
            FileOpen:=regs.realeax and $ffff;
END;


{---------------------------------------------------------------------------}
{  SetFilePos -> Platforms DOS             - Checked 05May1998 CEC          }
{---------------------------------------------------------------------------}
{
  Calls the operating system to move the file denoted by the handle to
  to the requested position. The move method can be: 0 = absolute offset;
  1 = offset from present location; 2 = offset from end of file;
  Any error is held in DosErrorStream and returned from the call.
  If the return is zero (ie no error) NewPos contains the new absolute
  file position.
}
FUNCTION SetFilePos (Handle: THandle; Pos: LongInt; MoveType: Word;Var Actual: LongInt): Word;
Var
 regs: Trealregs;
const
 CarryFlag = $001;
BEGIN
  regs.realeax := ($42 shl 8) + Byte(MoveType);
  regs.realedx := pos and $ffff;   { keep low word }
  regs.realecx := pos shr 16;
  regs.realebx := longint(Handle);
  sysrealintr($21,regs);
  if (regs.RealFlags and CarryFlag = 0) then { no error }
     Actual:=(regs.realeax and $ffff) + ((regs.realedx and $ffff) shl 16)
  else
     DosStreamError:=word(regs.realeax);
  SetFilePos := DosStreamError;                   { Return any error }
END;


{---------------------------------------------------------------------------}
{  FileRead -> Platforms DOS              - Checked 05May1998 CEC           }
{---------------------------------------------------------------------------}
FUNCTION FileRead (Handle: THandle; Var Buf; Count: Sw_Word;
Var Actual: Sw_Word): Word;
BEGIN
  Actual:=system.do_read(longint(Handle),longint(@Buf),Count);
  FileRead:=InOutRes;
End;


{---------------------------------------------------------------------------}
{  FileWrite -> Platforms DOS              - Checked 05May1998 CEC          }
{---------------------------------------------------------------------------}
FUNCTION FileWrite (Handle: THandle; Var Buf; Count: Sw_Word; Var Actual: Sw_Word): Word;
BEGIN
 system.do_write(longint(Handle),longint(@Buf),Count);
 Actual:=Count;
 FileWrite:=InOutRes;
End;


{---------------------------------------------------------------------------}
{  SetFileSize -> Platforms DOS          - 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.3  2000-01-07 16:41:32  daniel
    * copyright 2000

  Revision 1.2  2000/01/07 16:32:23  daniel
    * copyright 2000 added

  Revision 1.1  1998/12/21 13:07:03  peter
    * use -FE

  Revision 1.2  1998/05/31 14:18:26  peter
    * force att or direct assembling
    * cleanup of some files

}