paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-21 11:39:27 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ go32v2 include for objects unit

Browse Source
This commit is contained in:
carl 1998-05-21 12:15:10 +00:00
parent 0079d9b9d2
commit 1b3fd9e8cf
1 changed files with 111 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

111
rtl/dos/go32v2/objinc.inc Normal file
View File

@ -0,0 +1,111 @@
{---------------------------------------------------------------------------}
{ 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
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;
{---------------------------------------------------------------------------}
{ 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
If (Actual = FileSize) Then Begin { No position error }
Actual := FileWrite(Handle, Pointer(@Buf), 0,Actual); { Truncate the file }
If (Actual <> -1) Then SetFileSize := 0 Else { No truncate error }
SetFileSize := 103; { File truncate error }
End Else SetFileSize := 103; { File truncate 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;
{***************************************************************************}
{ DosSetFilePtr -> Platforms DOS - Checked 05May1998 CEC }
{***************************************************************************}
{=DosSetFilePtr======================================================
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.
-> Platforms DOS/DPMI/WIN - Checked 16May96 LdB}
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.realah := $42;
regs.realal := 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;