paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 14:29:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Now native

Browse Source
This commit is contained in:
yuri 2003-11-23 15:50:07 +00:00
parent b00f51317f
commit 0646b94499
1 changed files with 155 additions and 186 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

341
rtl/os2/sysutils.pp
View File

@ -175,9 +175,6 @@ const
ilQueryEAs = 3; ilQueryEAs = 3;
ilQueryFullName = 5; ilQueryFullName = 5;
{This is the correct way to call external assembler procedures.}
procedure syscall;external name '___SYSCALL';
function DosSetFileInfo (Handle: longint; InfoLevel: cardinal; AFileStatus: PFileStatus; function DosSetFileInfo (Handle: longint; InfoLevel: cardinal; AFileStatus: PFileStatus;
FileStatusLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 218; FileStatusLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 218;
@ -225,6 +222,28 @@ function DosSetPathInfo(FileName:PChar;InfoLevel:longint;
Options:longint):longint; cdecl; Options:longint):longint; cdecl;
external 'DOSCALLS' index 219; external 'DOSCALLS' index 219;
function DosOpen(FileName:PChar;var Handle:longint;var Action: Longint;
InitSize,Attrib,OpenFlags,FileMode:cardinal;
EA:Pointer):longint; cdecl;
external 'DOSCALLS' index 273;
function DosClose(Handle:longint): longint; cdecl;
external 'DOSCALLS' index 257;
function DosRead(Handle:longint; var Buffer; Count:longint;
var ActCount:longint):longint; cdecl;
external 'DOSCALLS' index 281;
function DosWrite(Handle:longint; const Buffer; Count:longint;
var ActCount:longint):longint; cdecl;
external 'DOSCALLS' index 282;
function DosSetFilePtr(Handle:longint;Pos:longint;Method:cardinal;
var PosActual:longint):longint; cdecl;
external 'DOSCALLS' index 256;
function DosSetFileSize(Handle:longint;Size:cardinal):longint; cdecl;
external 'DOSCALLS' index 272;
type type
TDT=packed record TDT=packed record
Hour, Hour,
@ -258,34 +277,39 @@ const
FindResvdMask = $00003737; {Allowed bits in attribute FindResvdMask = $00003737; {Allowed bits in attribute
specification for DosFindFirst call.} specification for DosFindFirst call.}
{$ASMMODE INTEL} function FileOpen (const FileName: string; Mode: integer): longint;
function FileOpen (const FileName: string; Mode: integer): longint; assembler; Var
asm Rc, Action, Handle: Longint;
push ebx P: PChar;
mov eax, Mode begin
(* DenyAll if sharing not specified. *) P:=StrAlloc(length(FileName)+1);
test eax, 112 StrPCopy(P, FileName);
jnz @FOpen1 (* DenyNone if sharing not specified. *)
or eax, 16 if Mode and 112 = 0 then Mode:=Mode or 64;
@FOpen1: Rc:=DosOpen(P, Handle, Action, 0, 0, 1, Mode, nil);
mov ecx, eax StrDispose(P);
mov eax, 7F2Bh If Rc=0 then
mov edx, FileName FileOpen:=Handle
call syscall else
pop ebx FileOpen:=-RC;
end {['eax', 'ebx', 'ecx', 'edx']}; end;
function FileCreate (const FileName: string): longint; assembler;
asm
push ebx
mov eax, 7F2Bh
mov ecx, ofReadWrite or faCreate or doDenyRW (* Sharing to DenyAll *)
mov edx, FileName
call syscall
pop ebx
end {['eax', 'ebx', 'ecx', 'edx']};
function FileCreate (const FileName: string): longint;
Const
Mode = ofReadWrite or faCreate or doDenyRW; (* Sharing to DenyAll *)
Var
RC, Action, Handle: Longint;
P: PChar;
Begin
P:=StrAlloc(length(FileName)+1);
StrPCopy(P, FileName);
RC:=DosOpen(P, Handle, Action, 0, 0, $12, Mode, Nil);
StrDispose(P);
If RC=0 then
FileCreate:=Handle
else
FileCreate:=-RC;
End;
function FileCreate (const FileName: string; Mode: longint): longint; function FileCreate (const FileName: string; Mode: longint): longint;
begin begin
@ -294,50 +318,30 @@ end;
function FileRead (Handle: longint; var Buffer; Count: longint): longint; function FileRead (Handle: longint; var Buffer; Count: longint): longint;
assembler; Var
asm T: Longint;
push ebx begin
mov eax, 3F00h DosRead(Handle, Buffer, Count, T);
mov ebx, Handle FileRead:=T;
mov ecx, Count end;
mov edx, Buffer
call syscall
jnc @FReadEnd
mov eax, -1
@FReadEnd:
pop ebx
end {['eax', 'ebx', 'ecx', 'edx']};
function FileWrite (Handle: longint; const Buffer; Count: longint): longint; function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
assembler; Var
asm T: Longint;
push ebx begin
mov eax, 4000h DosWrite(Handle, Buffer, Count, T);
mov ebx, Handle FileWrite:=T;
mov ecx, Count end;
mov edx, Buffer
call syscall
jnc @FWriteEnd
mov eax, -1
@FWriteEnd:
pop ebx
end {['eax', 'ebx', 'ecx', 'edx']};
function FileSeek (Handle, FOffset, Origin: longint): longint;
function FileSeek (Handle, FOffset, Origin: longint): longint; assembler; var
asm npos: longint;
push ebx begin
mov eax, Origin if DosSetFilePtr(Handle, FOffset, Origin, npos)=0 Then
mov ah, 42h FileSeek:=npos
mov ebx, Handle else
mov edx, FOffset FileSeek:=-1;
call syscall end;
jnc @FSeekEnd
mov eax, -1
@FSeekEnd:
pop ebx
end {['eax', 'ebx', 'edx']};
function FileSeek (Handle: longint; FOffset, Origin: Int64): Int64; function FileSeek (Handle: longint; FOffset, Origin: Int64): Int64;
begin begin
@ -345,39 +349,16 @@ begin
Result:=FileSeek(Handle,Longint(Foffset),Longint(Origin)); Result:=FileSeek(Handle,Longint(Foffset),Longint(Origin));
end; end;
procedure FileClose (Handle: longint); assembler; procedure FileClose (Handle: longint);
asm begin
push ebx DosClose(Handle);
mov eax, Handle end;
cmp eax, 2
jbe @FCloseEnd
mov ebx, eax
mov eax, 3E00h
call syscall
@FCloseEnd:
pop ebx
end {['eax', 'ebx']};
function FileTruncate (Handle, Size: longint): boolean; assembler;
asm
push ebx
mov eax, 7F25h
mov ebx, Handle
mov edx, Size
call syscall
jc @FTruncEnd
mov eax, 4202h
mov ebx, Handle
mov edx, 0
call syscall
mov eax, 0
jnc @FTruncEnd
dec eax
@FTruncEnd:
pop ebx
end {['eax', 'ebx', 'ecx', 'edx']};
function FileTruncate (Handle, Size: longint): boolean;
begin
FileTruncate:=DosSetFileSize(Handle, Size)=0;
FileSeek(Handle, 0, 2);
end;
function FileAge (const FileName: string): longint; function FileAge (const FileName: string): longint;
var Handle: longint; var Handle: longint;
@ -437,83 +418,79 @@ end;
function FindNext (var Rslt: TSearchRec): longint; function FindNext (var Rslt: TSearchRec): longint;
var
var SR: PSearchRec; SR: PSearchRec;
FStat: PFileFindBuf3; FStat: PFileFindBuf3;
Count: cardinal; Count: cardinal;
Err: cardinal; Err: cardinal;
begin begin
New (FStat); New (FStat);
Count := 1; Count := 1;
Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^), Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^),
Count); Count);
if (Err = 0) and (Count = 0) then Err := 18; if (Err = 0) and (Count = 0) then Err := 18;
FindNext := -Err; FindNext := -Err;
if Err = 0 then if Err = 0 then
begin begin
Rslt.Name := FStat^.Name; Rslt.Name := FStat^.Name;
Rslt.Size := FStat^.FileSize; Rslt.Size := FStat^.FileSize;
Rslt.Attr := FStat^.AttrFile; Rslt.Attr := FStat^.AttrFile;
Rslt.ExcludeAttr := 0; Rslt.ExcludeAttr := 0;
TRec (Rslt.Time).T := FStat^.TimeLastWrite; TRec (Rslt.Time).T := FStat^.TimeLastWrite;
TRec (Rslt.Time).D := FStat^.DateLastWrite; TRec (Rslt.Time).D := FStat^.DateLastWrite;
end; end;
Dispose (FStat); Dispose (FStat);
end; end;
procedure FindClose (var F: TSearchrec); procedure FindClose (var F: TSearchrec);
var
var SR: PSearchRec; SR: PSearchRec;
begin begin
DosFindClose (F.FindHandle); DosFindClose (F.FindHandle);
F.FindHandle := 0; F.FindHandle := 0;
end; end;
function FileGetDate (Handle: longint): longint;
function FileGetDate (Handle: longint): longint; assembler; var
asm FStat: TFileStatus3;
push ebx Time: Longint;
mov ax, 5700h begin
mov ebx, Handle DosError := DosQueryFileInfo(Handle, ilStandard, @FStat, SizeOf(FStat));
call syscall if DosError=0 then
mov eax, -1 begin
jc @FGetDateEnd Time := FStat.TimeLastWrite + longint (FStat.DateLastWrite) shl 16;
mov ax, dx if Time = 0 then
shld eax, ecx, 16 Time := FStat.TimeCreation + longint (FStat.DateCreation) shl 16;
@FGetDateEnd: end else
pop ebx Time:=0;
end {['eax', 'ebx', 'ecx', 'edx']}; FileGetDate:=Time;
end;
function FileSetDate (Handle, Age: longint): longint; function FileSetDate (Handle, Age: longint): longint;
var FStat: PFileStatus0; var
RC: cardinal; FStat: PFileStatus0;
RC: cardinal;
begin begin
New (FStat); New (FStat);
RC := DosQueryFileInfo (Handle, ilStandard, FStat, RC := DosQueryFileInfo (Handle, ilStandard, FStat, SizeOf (FStat^));
SizeOf (FStat^)); if RC <> 0 then
if RC <> 0 then FileSetDate := -1
FileSetDate := -1 else
else begin
begin FStat^.DateLastAccess := Hi (Age);
FStat^.DateLastAccess := Hi (Age); FStat^.DateLastWrite := Hi (Age);
FStat^.DateLastWrite := Hi (Age); FStat^.TimeLastAccess := Lo (Age);
FStat^.TimeLastAccess := Lo (Age); FStat^.TimeLastWrite := Lo (Age);
FStat^.TimeLastWrite := Lo (Age); RC := DosSetFileInfo (Handle, ilStandard, FStat, SizeOf (FStat^));
RC := DosSetFileInfo (Handle, ilStandard, FStat, if RC <> 0 then
SizeOf (FStat^)); FileSetDate := -1
if RC <> 0 then else
FileSetDate := -1 FileSetDate := 0;
else end;
FileSetDate := 0; Dispose (FStat);
end;
Dispose (FStat);
end; end;
function FileGetAttr (const FileName: string): longint; function FileGetAttr (const FileName: string): longint;
var var
FS: PFileStatus3; FS: PFileStatus3;
@ -571,8 +548,6 @@ End;
Disk Functions Disk Functions
****************************************************************************} ****************************************************************************}
{$ASMMODE ATT}
function DiskFree (Drive: byte): int64; function DiskFree (Drive: byte): int64;
var FI: TFSinfo; var FI: TFSinfo;
@ -637,20 +612,13 @@ begin
end; end;
{$ASMMODE INTEL} function DirectoryExists (const Directory: string): boolean;
function DirectoryExists (const Directory: string): boolean; assembler; var
asm SR: TSearchRec;
mov ax, 4300h begin
mov edx, Directory DirectoryExists:=FindFirst(Directory, faDirectory, SR)=0;
call syscall FindClose(SR);
mov eax, 0 end;
jc @FExistsEnd
test cx, 10h
jz @FExistsEnd
inc eax
@FExistsEnd:
end {['eax', 'ecx', 'edx']};
{**************************************************************************** {****************************************************************************
Time Functions Time Functions
@ -673,8 +641,6 @@ begin
end; end;
end; end;
{$asmmode default}
{**************************************************************************** {****************************************************************************
Misc Functions Misc Functions
****************************************************************************} ****************************************************************************}
@ -770,7 +736,10 @@ end.
{ {
$Log$ $Log$
Revision 1.37 2003-11-05 09:14:00 yuri Revision 1.38 2003-11-23 15:50:07 yuri
* Now native
Revision 1.37 2003/11/05 09:14:00 yuri
* exec fix * exec fix
* unused units removed * unused units removed