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;
         if LFNSupport then
           begin
             if (mode = stCreate) then
               begin
                 regs.realeax := $716C;
                 regs.realesi:=tb mod 16;
                 regs.realebx:=$2002;
                 regs.realecx:=$20;
                 regs.realedi:=0;
                 regs.realedx:=$12;
               end
             else if (mode = stOpenRead) then
               begin
                 regs.realeax := $716C;
                 regs.realesi:=tb mod 16;
                 regs.realebx:=$2000;
                 regs.realecx:=$20;
                 regs.realedi:=0;
                 regs.realedx:=$1;
               end
             else if (mode = stOpenWrite) then
               begin
                 regs.realeax := $716C;
                 regs.realesi:=tb mod 16;
                 regs.realebx:=$2001;
                 regs.realecx:=$20;
                 regs.realedi:=0;
                 regs.realedx:=$11;
               end
             else if (mode = stOpen) then
               begin
                 regs.realeax := $716C;
                 regs.realesi:=tb mod 16;
                 regs.realebx:=$2002;
                 regs.realecx:=$20;
                 regs.realedi:=0;
                 regs.realedx:=$11;
               end
             else
               regs.realeax := Mode;
           end
         else
           regs.realeax := Mode;
         regs.realecx:=0;
         sysrealintr($21,regs);
         if (regs.realflags and 1) <> 0 then
           begin
             DosStreamError:=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;
Var
  StoreInOutRes : word;
BEGIN
  StoreInOutRes:=InOutRes;
  InOutRes:=0;
  Actual:=system.do_read(longint(Handle),longint(@Buf),Count);
  DosStreamError:=InOutRes;
  InOutRes:=StoreInOutRes;
  FileRead:=DosStreamError;
End;


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


{---------------------------------------------------------------------------}
{  SetFileSize -> Platforms DOS          - Not Checked                      }
{---------------------------------------------------------------------------}
FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word;
VAR Actual: LongInt;
  regs : trealregs;
const
 CarryFlag = $001;
BEGIN
   SetFilePos(Handle,FileSize,0,Actual);
   If (Actual = FileSize) Then
    Begin
      regs.realecx:=0;
      regs.realedx:=tb mod 16;
      regs.realds:=tb div 16;
      regs.realebx:=handle;
      regs.realeax:=$4000;
      sysrealintr($21,regs);
      if (regs.RealFlags and CarryFlag = 0) then { no error }
       SetFileSize := 0
      Else
       SetFileSize := 103;                            { File truncate error }
    End
   Else
    SetFileSize := 103;                       { File truncate error }
END;

{
  $Log$
  Revision 1.4  2002-09-07 16:01:18  peter
    * old logs removed and tabs fixed

  Revision 1.3  2002/05/09 08:42:24  carl
  * Merges from Fixes branch

  Revision 1.1.2.1  2002/04/12 08:08:08  pierre
   * avoid that objects unit is sensitive to or changes system.InOutRes value

}