paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-31 02:31:49 +01:00
Code Issues Packages Projects Releases Wiki Activity

* lots of fixes (regcall, THandle, string operations in sysutils, longint2cardinal according to OS/2 docs, dosh.inc, ...)

Browse Source
This commit is contained in:
Tomas Hajny 2004-02-22 15:01:49 +00:00
parent 4c96b2777e
commit 09fd537acf
5 changed files with 305 additions and 243 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
rtl/emx/dos.pas
View File

@ -94,9 +94,6 @@ Type
{OS/2 specific functions} {OS/2 specific functions}
function exec(path:pathstr;runflags:execrunflags;winflags:execwinflags;
const comline:comstr):longint;
function GetEnvPChar (EnvVar: string): PChar; function GetEnvPChar (EnvVar: string): PChar;
@ -962,8 +959,7 @@ begin
end; end;
{$ASMMODE ATT} {$ASMMODE ATT}
function GetEnv (const EnvVar: string): string; function GetEnv (EnvVar: string): string;
(* The assembler version is more than three times as fast as Pascal. *)
begin begin
GetEnv := StrPas (GetEnvPChar (EnvVar)); GetEnv := StrPas (GetEnvPChar (EnvVar));
end; end;
@ -1201,6 +1197,16 @@ procedure SetIntVec (IntNo: byte; Vector: pointer);
begin begin
end; end;
function GetShortName(var p : String) : boolean;
begin
GetShortName:=true;
end;
function GetLongName(var p : String) : boolean;
begin
GetLongName:=true;
end;
begin begin
@ -1211,7 +1217,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.12 2004-02-17 17:37:26 daniel Revision 1.13 2004-02-22 15:01:49 hajny
* lots of fixes (regcall, THandle, string operations in sysutils, longint2cardinal according to OS/2 docs, dosh.inc, ...)
Revision 1.12 2004/02/17 17:37:26 daniel
* Enable threadvars again * Enable threadvars again
Revision 1.11 2004/02/16 22:16:58 hajny Revision 1.11 2004/02/16 22:16:58 hajny

338
rtl/emx/sysutils.pp
View File

@ -82,7 +82,7 @@ type
FileAlloc:cardinal; {Amount of space the file really FileAlloc:cardinal; {Amount of space the file really
occupies on disk.} occupies on disk.}
AttrFile:cardinal; {Attributes of file.} AttrFile:cardinal; {Attributes of file.}
Name:string; {Also possible to use as ASCIIZ. Name:shortstring; {Also possible to use as ASCIIZ.
The byte following the last string The byte following the last string
character is always zero.} character is always zero.}
end; end;
@ -101,7 +101,7 @@ type
occupies on disk.} occupies on disk.}
AttrFile:cardinal; {Attributes of file.} AttrFile:cardinal; {Attributes of file.}
cbList:longint; {Size of the file's extended attributes.} cbList:longint; {Size of the file's extended attributes.}
Name:string; {Also possible to use as ASCIIZ. Name:shortstring; {Also possible to use as ASCIIZ.
The byte following the last string The byte following the last string
character is always zero.} character is always zero.}
end; end;
@ -393,15 +393,19 @@ const
function FileOpen (const FileName: string; Mode: integer): longint; assembler; function FileOpen (const FileName: string; Mode: integer): longint; assembler;
asm asm
push ebx push ebx
mov eax, Mode {$IFDEF REGCALL}
(* DenyAll if sharing not specified. *) mov ecx, edx
test eax, 112 mov edx, eax
jnz @FOpen1 {$ELSE REGCALL}
or eax, 16 mov ecx, Mode
@FOpen1:
mov ecx, eax
mov eax, 7F2Bh
mov edx, FileName mov edx, FileName
{$ENDIF REGCALL}
(* DenyAll if sharing not specified. *)
test ecx, 112
jnz @FOpen1
or ecx, 16
@FOpen1:
mov eax, 7F2Bh
call syscall call syscall
pop ebx pop ebx
end {['eax', 'ebx', 'ecx', 'edx']}; end {['eax', 'ebx', 'ecx', 'edx']};
@ -410,9 +414,13 @@ end {['eax', 'ebx', 'ecx', 'edx']};
function FileCreate (const FileName: string): longint; assembler; function FileCreate (const FileName: string): longint; assembler;
asm asm
push ebx push ebx
mov eax, 7F2Bh {$IFDEF REGCALL}
mov ecx, ofReadWrite or faCreate or doDenyRW (* Sharing to DenyAll *) mov edx, eax
{$ELSE REGCALL}
mov edx, FileName mov edx, FileName
{$ENDIF REGCALL}
mov eax, 7F2Bh
mov ecx, ofReadWrite or faCreate or doDenyRW (* Sharing to DenyAll *)
call syscall call syscall
pop ebx pop ebx
end {['eax', 'ebx', 'ecx', 'edx']}; end {['eax', 'ebx', 'ecx', 'edx']};
@ -428,13 +436,17 @@ function FileRead (Handle: longint; var Buffer; Count: longint): longint;
assembler; assembler;
asm asm
push ebx push ebx
mov eax, 3F00h {$IFDEF REGCALL}
mov ebx, Handle mov ebx, eax
mov ecx, Count {$ELSE REGCALL}
mov edx, Buffer mov ebx, Handle
call syscall mov ecx, Count
jnc @FReadEnd mov edx, Buffer
mov eax, -1 {$ENDIF REGCALL}
mov eax, 3F00h
call syscall
jnc @FReadEnd
mov eax, -1
@FReadEnd: @FReadEnd:
pop ebx pop ebx
end {['eax', 'ebx', 'ecx', 'edx']}; end {['eax', 'ebx', 'ecx', 'edx']};
@ -444,13 +456,17 @@ function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
assembler; assembler;
asm asm
push ebx push ebx
mov eax, 4000h {$IFDEF REGCALL}
mov ebx, Handle mov ebx, eax
mov ecx, Count {$ELSE REGCALL}
mov edx, Buffer mov ebx, Handle
call syscall mov ecx, Count
jnc @FWriteEnd mov edx, Buffer
mov eax, -1 {$ENDIF REGCALL}
mov eax, 4000h
call syscall
jnc @FWriteEnd
mov eax, -1
@FWriteEnd: @FWriteEnd:
pop ebx pop ebx
end {['eax', 'ebx', 'ecx', 'edx']}; end {['eax', 'ebx', 'ecx', 'edx']};
@ -459,13 +475,18 @@ end {['eax', 'ebx', 'ecx', 'edx']};
function FileSeek (Handle, FOffset, Origin: longint): longint; assembler; function FileSeek (Handle, FOffset, Origin: longint): longint; assembler;
asm asm
push ebx push ebx
mov eax, Origin {$IFDEF REGCALL}
mov ah, 42h mov ebx, eax
mov ebx, Handle mov eax, ecx
mov edx, FOffset {$ELSE REGCALL}
call syscall mov ebx, Handle
jnc @FSeekEnd mov eax, Origin
mov eax, -1 mov edx, FOffset
{$ENDIF REGCALL}
mov ah, 42h
call syscall
jnc @FSeekEnd
mov eax, -1
@FSeekEnd: @FSeekEnd:
pop ebx pop ebx
end {['eax', 'ebx', 'edx']}; end {['eax', 'ebx', 'edx']};
@ -492,18 +513,23 @@ end;
function FileTruncate (Handle, Size: longint): boolean; assembler; function FileTruncate (Handle, Size: longint): boolean; assembler;
asm asm
push ebx push ebx
mov eax, 7F25h {$IFDEF REGCALL}
mov ebx, Handle mov ebx, eax
mov edx, Size {$ELSE REGCALL}
call syscall mov ebx, Handle
jc @FTruncEnd mov edx, Size
mov eax, 4202h {$ENDIF REGCALL}
mov ebx, Handle mov eax, 7F25h
mov edx, 0 push ebx
call syscall call syscall
mov eax, 0 pop ebx
jnc @FTruncEnd jc @FTruncEnd
dec eax mov eax, 4202h
mov edx, 0
call syscall
mov eax, 0
jnc @FTruncEnd
dec eax
@FTruncEnd: @FTruncEnd:
pop ebx pop ebx
end {['eax', 'ebx', 'ecx', 'edx']}; end {['eax', 'ebx', 'ecx', 'edx']};
@ -525,14 +551,18 @@ end;
function FileExists (const FileName: string): boolean; assembler; function FileExists (const FileName: string): boolean; assembler;
asm asm
mov ax, 4300h {$IFDEF REGCALL}
mov edx, eax
{$ELSE REGCALL}
mov edx, FileName mov edx, FileName
call syscall {$ENDIF REGCALL}
mov eax, 0 mov ax, 4300h
jc @FExistsEnd call syscall
test cx, 18h mov eax, 0
jnz @FExistsEnd jc @FExistsEnd
inc eax test cx, 18h
jnz @FExistsEnd
inc eax
@FExistsEnd: @FExistsEnd:
end {['eax', 'ecx', 'edx']}; end {['eax', 'ecx', 'edx']};
@ -551,25 +581,25 @@ var SR: PSearchRec;
begin begin
if os_mode = osOS2 then if os_mode = osOS2 then
begin begin
New (FStat); New (FStat);
Rslt.FindHandle := $FFFFFFFF; Rslt.FindHandle := $FFFFFFFF;
Count := 1; Count := 1;
Err := DosFindFirst (PChar (Path), Rslt.FindHandle, Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, Attr and FindResvdMask, FStat, SizeOf (FStat^), Count,
ilStandard); ilStandard);
if (Err = 0) and (Count = 0) then Err := 18; if (Err = 0) and (Count = 0) then Err := 18;
FindFirst := -Err; FindFirst := -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
else else
begin begin
@ -600,7 +630,7 @@ var SR: PSearchRec;
begin begin
if os_mode = osOS2 then if os_mode = osOS2 then
begin begin
New (FStat); New (FStat);
Count := 1; Count := 1;
Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^), Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^),
@ -645,7 +675,7 @@ var SR: PSearchRec;
begin begin
if os_mode = osOS2 then if os_mode = osOS2 then
begin begin
DosFindClose (F.FindHandle); DosFindClose (F.FindHandle);
end end
else else
begin begin
@ -660,13 +690,17 @@ end;
function FileGetDate (Handle: longint): longint; assembler; function FileGetDate (Handle: longint): longint; assembler;
asm asm
push ebx push ebx
mov ax, 5700h {$IFDEF REGCALL}
mov ebx, Handle mov ebx, eax
call syscall {$ELSE REGCALL}
mov eax, -1 mov ebx, Handle
jc @FGetDateEnd {$ENDIF REGCALL}
mov ax, dx mov ax, 5700h
shld eax, ecx, 16 call syscall
mov eax, -1
jc @FGetDateEnd
mov ax, dx
shld eax, ecx, 16
@FGetDateEnd: @FGetDateEnd:
pop ebx pop ebx
end {['eax', 'ebx', 'ecx', 'edx']}; end {['eax', 'ebx', 'ecx', 'edx']};
@ -717,36 +751,49 @@ end;
function FileGetAttr (const FileName: string): longint; assembler; function FileGetAttr (const FileName: string): longint; assembler;
asm asm
mov ax, 4300h {$IFDEF REGCALL}
mov edx, eax
{$ELSE REGCALL}
mov edx, FileName mov edx, FileName
call syscall {$ENDIF REGCALL}
jnc @FGetAttrEnd mov ax, 4300h
mov eax, -1 call syscall
jnc @FGetAttrEnd
mov eax, -1
@FGetAttrEnd: @FGetAttrEnd:
end {['eax', 'edx']}; end {['eax', 'edx']};
function FileSetAttr (const Filename: string; Attr: longint): longint; assembler; function FileSetAttr (const Filename: string; Attr: longint): longint; assembler;
asm asm
mov ax, 4301h {$IFDEF REGCALL}
mov ecx, Attr mov ecx, edx
mov edx, eax
{$ELSE REGCALL}
mov ecx, Attr
mov edx, FileName mov edx, FileName
call syscall {$ENDIF REGCALL}
mov eax, 0 mov ax, 4301h
jnc @FSetAttrEnd call syscall
mov eax, -1 mov eax, 0
jnc @FSetAttrEnd
mov eax, -1
@FSetAttrEnd: @FSetAttrEnd:
end {['eax', 'ecx', 'edx']}; end {['eax', 'ecx', 'edx']};
function DeleteFile (const FileName: string): boolean; assembler; function DeleteFile (const FileName: string): boolean; assembler;
asm asm
mov ax, 4100h {$IFDEF REGCALL}
mov edx, eax
{$ELSE REGCALL}
mov edx, FileName mov edx, FileName
call syscall {$ENDIF REGCALL}
mov eax, 0 mov ax, 4100h
jc @FDeleteEnd call syscall
inc eax mov eax, 0
jc @FDeleteEnd
inc eax
@FDeleteEnd: @FDeleteEnd:
end {['eax', 'edx']}; end {['eax', 'edx']};
@ -754,13 +801,18 @@ end {['eax', 'edx']};
function RenameFile (const OldName, NewName: string): boolean; assembler; function RenameFile (const OldName, NewName: string): boolean; assembler;
asm asm
push edi push edi
mov ax, 5600h {$IFDEF REGCALL}
mov edx, OldName mov edx, eax
mov edi, NewName mov edi, edx
call syscall {$ELSE REGCALL}
mov eax, 0 mov edx, OldName
jc @FRenameEnd mov edi, NewName
inc eax {$ENDIF REGCALL}
mov ax, 5600h
call syscall
mov eax, 0
jc @FRenameEnd
inc eax
@FRenameEnd: @FRenameEnd:
pop edi pop edi
end {['eax', 'edx', 'edi']}; end {['eax', 'edx', 'edi']};
@ -810,7 +862,7 @@ begin
int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector) int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
else else
DiskFree := -1; DiskFree := -1;
end; end;
end; end;
function DiskSize (Drive: byte): int64; function DiskSize (Drive: byte): int64;
@ -852,7 +904,7 @@ begin
int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector) int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
else else
DiskSize := -1; DiskSize := -1;
end; end;
end; end;
@ -892,14 +944,18 @@ end;
{$ASMMODE INTEL} {$ASMMODE INTEL}
function DirectoryExists (const Directory: string): boolean; assembler; function DirectoryExists (const Directory: string): boolean; assembler;
asm asm
{$IFDEF REGCALL}
mov edx, eax
{$ELSE REGCALL}
mov edx, Directory
{$ENDIF REGCALL}
mov ax, 4300h mov ax, 4300h
mov edx, Directory call syscall
call syscall mov eax, 0
mov eax, 0 jc @FExistsEnd
jc @FExistsEnd test cx, 10h
test cx, 10h jz @FExistsEnd
jz @FExistsEnd inc eax
inc eax
@FExistsEnd: @FExistsEnd:
end {['eax', 'ecx', 'edx']}; end {['eax', 'ecx', 'edx']};
@ -912,30 +968,37 @@ procedure GetLocalTime (var SystemTime: TSystemTime); assembler;
asm asm
(* Expects the default record alignment (word)!!! *) (* Expects the default record alignment (word)!!! *)
push edi push edi
mov ah, 2Ah {$IFDEF REGCALL}
call syscall push eax
mov edi, SystemTime {$ENDIF REGCALL}
mov ax, cx mov ah, 2Ah
stosw call syscall
xor eax, eax {$IFDEF REGCALL}
mov al, 10 pop eax
mul dl {$ELSE REGCALL}
shl eax, 16 mov edi, SystemTime
mov al, dh {$ENDIF REGCALL}
stosd mov ax, cx
push edi stosw
mov ah, 2Ch xor eax, eax
call syscall mov al, 10
pop edi mul dl
xor eax, eax shl eax, 16
mov al, cl mov al, dh
shl eax, 16 stosd
mov al, ch push edi
stosd mov ah, 2Ch
mov al, dl call syscall
shl eax, 16 pop edi
mov al, dh xor eax, eax
stosd mov al, cl
shl eax, 16
mov al, ch
stosd
mov al, dl
shl eax, 16
mov al, dh
stosd
pop edi pop edi
end {['eax', 'ecx', 'edx', 'edi']}; end {['eax', 'ecx', 'edx', 'edi']};
{$asmmode default} {$asmmode default}
@ -1144,7 +1207,10 @@ end.
{ {
$Log$ $Log$
Revision 1.15 2004-02-15 21:26:37 hajny Revision 1.16 2004-02-22 15:01:49 hajny
* lots of fixes (regcall, THandle, string operations in sysutils, longint2cardinal according to OS/2 docs, dosh.inc, ...)
Revision 1.15 2004/02/15 21:26:37 hajny
* overloaded ExecuteProcess added, EnvStr param changed to longint * overloaded ExecuteProcess added, EnvStr param changed to longint
Revision 1.14 2004/01/20 23:05:31 hajny Revision 1.14 2004/01/20 23:05:31 hajny

8
rtl/os2/dos.pas
View File

@ -669,12 +669,13 @@ end;
function GetShortName(var p : String) : boolean; function GetShortName(var p : String) : boolean;
begin begin
GetShortName:=true; GetShortName:=true;
{$WARNING EA .shortname support (see FAT32 driver) should be probably added here!}
end; end;
function GetLongName(var p : String) : boolean; function GetLongName(var p : String) : boolean;
begin begin
GetLongName:=true; GetLongName:=true;
{$WARNING EA .longname support should be probably added here} {$WARNING EA .longname support should be probably added here!}
end; end;
@ -684,7 +685,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.38 2004-02-17 17:37:26 daniel Revision 1.39 2004-02-22 15:01:49 hajny
* lots of fixes (regcall, THandle, string operations in sysutils, longint2cardinal according to OS/2 docs, dosh.inc, ...)
Revision 1.38 2004/02/17 17:37:26 daniel
* Enable threadvars again * Enable threadvars again
Revision 1.37 2004/02/16 22:16:59 hajny Revision 1.37 2004/02/16 22:16:59 hajny

57
rtl/os2/system.pas
View File

@ -187,31 +187,31 @@ procedure DosExit(Action, Result: cardinal); cdecl;
external 'DOSCALLS' index 234; external 'DOSCALLS' index 234;
// EAs not used in System unit // EAs not used in System unit
function DosOpen(FileName:PChar;var Handle:longint;var Action:cardinal; function DosOpen(FileName:PChar;var Handle: THandle;var Action:cardinal;
InitSize,Attrib,OpenFlags,FileMode:cardinal; InitSize,Attrib,OpenFlags,FileMode:cardinal;
EA:Pointer):longint; cdecl; EA:Pointer): cardinal; cdecl;
external 'DOSCALLS' index 273; external 'DOSCALLS' index 273;
function DosClose(Handle:longint): longint; cdecl; function DosClose(Handle: THandle): cardinal; cdecl;
external 'DOSCALLS' index 257; external 'DOSCALLS' index 257;
function DosRead(Handle:longint; Buffer: Pointer;Count:longint; function DosRead(Handle: THandle; Buffer: Pointer; Count: cardinal;
var ActCount:longint):longint; cdecl; var ActCount: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 281; external 'DOSCALLS' index 281;
function DosWrite(Handle:longint; Buffer: Pointer;Count:longint; function DosWrite(Handle: THandle; Buffer: Pointer;Count: cardinal;
var ActCount:longint):longint; cdecl; var ActCount: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 282; external 'DOSCALLS' index 282;
function DosSetFilePtr(Handle:longint;Pos:longint;Method:cardinal; function DosSetFilePtr(Handle: THandle; Pos:longint; Method:cardinal;
var PosActual:longint):longint; cdecl; var PosActual: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 256; external 'DOSCALLS' index 256;
function DosSetFileSize(Handle:longint;Size:cardinal):longint; cdecl; function DosSetFileSize(Handle: THandle; Size: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 272; external 'DOSCALLS' index 272;
function DosQueryHType(Handle:longint;var HandType:longint; function DosQueryHType(Handle: THandle; var HandType: cardinal;
var Attr:longint):longint; cdecl; var Attr: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 224; external 'DOSCALLS' index 224;
type type
@ -227,7 +227,7 @@ type
WeekDay: byte; WeekDay: byte;
end; end;
function DosGetDateTime(var Buf:TSysDateTime):longint; cdecl; function DosGetDateTime(var Buf:TSysDateTime): cardinal; cdecl;
external 'DOSCALLS' index 230; external 'DOSCALLS' index 230;
{ converts an OS/2 error code to a TP compatible error } { converts an OS/2 error code to a TP compatible error }
@ -480,10 +480,10 @@ end;
versions of OS/2. versions of OS/2.
Flags = One or more of the mfXXXX constants.} Flags = One or more of the mfXXXX constants.}
function DosAllocMem(var P:pointer;Size,Flag:cardinal):longint; cdecl; function DosAllocMem(var P:pointer;Size,Flag:cardinal): cardinal; cdecl;
external 'DOSCALLS' index 299; external 'DOSCALLS' index 299;
function DosSetMem(P:pointer;Size,Flag:cardinal):longint; cdecl; function DosSetMem(P:pointer;Size,Flag:cardinal): cardinal; cdecl;
external 'DOSCALLS' index 305; external 'DOSCALLS' index 305;
var var
@ -584,13 +584,13 @@ end;
function do_read(h,addr,len:longint):longint; function do_read(h,addr,len:longint):longint;
Var Var
T: Longint; T: cardinal;
begin begin
{$ifdef IODEBUG} {$ifdef IODEBUG}
write('do_read: handle=', h, ', addr=', addr, ', length=', len); write('do_read: handle=', h, ', addr=', addr, ', length=', len);
{$endif} {$endif}
InOutRes:=DosRead(H, Pointer(Addr), Len, T); InOutRes:=DosRead(H, Pointer(Addr), Len, T);
do_read:=T; do_read:= longint (T);
{$ifdef IODEBUG} {$ifdef IODEBUG}
writeln(', actual_len=', t, ', InOutRes=', InOutRes); writeln(', actual_len=', t, ', InOutRes=', InOutRes);
{$endif} {$endif}
@ -598,13 +598,13 @@ end;
function do_write(h,addr,len:longint) : longint; function do_write(h,addr,len:longint) : longint;
Var Var
T: Longint; T: cardinal;
begin begin
{$ifdef IODEBUG} {$ifdef IODEBUG}
write('do_write: handle=', h, ', addr=', addr, ', length=', len); write('do_write: handle=', h, ', addr=', addr, ', length=', len);
{$endif} {$endif}
InOutRes:=DosWrite(H, Pointer(Addr), Len, T); InOutRes:=DosWrite(H, Pointer(Addr), Len, T);
do_write:=T; do_write:= longint (T);
{$ifdef IODEBUG} {$ifdef IODEBUG}
writeln(', actual_len=', t, ', InOutRes=', InOutRes); writeln(', actual_len=', t, ', InOutRes=', InOutRes);
{$endif} {$endif}
@ -612,10 +612,10 @@ end;
function do_filepos(handle:longint): longint; function do_filepos(handle:longint): longint;
var var
PosActual: Longint; PosActual: cardinal;
begin begin
InOutRes:=DosSetFilePtr(Handle, 0, 1, PosActual); InOutRes:=DosSetFilePtr(Handle, 0, 1, PosActual);
do_filepos:=PosActual; do_filepos:=longint (PosActual);
{$ifdef IODEBUG} {$ifdef IODEBUG}
writeln('do_filepos: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes); writeln('do_filepos: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
{$endif} {$endif}
@ -623,7 +623,7 @@ end;
procedure do_seek(handle,pos:longint); procedure do_seek(handle,pos:longint);
var var
PosActual: Longint; PosActual: cardinal;
begin begin
InOutRes:=DosSetFilePtr(Handle, Pos, 0 {ZeroBased}, PosActual); InOutRes:=DosSetFilePtr(Handle, Pos, 0 {ZeroBased}, PosActual);
{$ifdef IODEBUG} {$ifdef IODEBUG}
@ -633,17 +633,17 @@ end;
function do_seekend(handle:longint):longint; function do_seekend(handle:longint):longint;
var var
PosActual: Longint; PosActual: cardinal;
begin begin
InOutRes:=DosSetFilePtr(Handle, 0, 2 {EndBased}, PosActual); InOutRes:=DosSetFilePtr(Handle, 0, 2 {EndBased}, PosActual);
do_seekend:=PosActual; do_seekend:=longint (PosActual);
{$ifdef IODEBUG} {$ifdef IODEBUG}
writeln('do_seekend: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes); writeln('do_seekend: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
{$endif} {$endif}
end; end;
function do_filesize(handle:longint):longint; function do_filesize(handle:longint):longint;
var aktfilepos:longint; var aktfilepos: cardinal;
begin begin
aktfilepos:=do_filepos(handle); aktfilepos:=do_filepos(handle);
do_filesize:=do_seekend(handle); do_filesize:=do_seekend(handle);
@ -778,7 +778,7 @@ end;
function do_isdevice (Handle: longint): boolean; function do_isdevice (Handle: longint): boolean;
var var
HT, Attr: longint; HT, Attr: cardinal;
begin begin
do_isdevice:=false; do_isdevice:=false;
If DosQueryHType(Handle, HT, Attr)<>0 then exit; If DosQueryHType(Handle, HT, Attr)<>0 then exit;
@ -1471,7 +1471,10 @@ the compiler, of course, but more should get allocated dynamically on demand.
end. end.
{ {
$Log$ $Log$
Revision 1.66 2004-02-16 22:18:44 hajny Revision 1.67 2004-02-22 15:01:49 hajny
* lots of fixes (regcall, THandle, string operations in sysutils, longint2cardinal according to OS/2 docs, dosh.inc, ...)
Revision 1.66 2004/02/16 22:18:44 hajny
* LastDosExitCode changed back from threadvar temporarily * LastDosExitCode changed back from threadvar temporarily
Revision 1.65 2004/02/02 03:24:09 yuri Revision 1.65 2004/02/02 03:24:09 yuri

124
rtl/os2/sysutils.pp
View File

@ -82,7 +82,7 @@ type
FileAlloc:cardinal; {Amount of space the file really FileAlloc:cardinal; {Amount of space the file really
occupies on disk.} occupies on disk.}
AttrFile:cardinal; {Attributes of file.} AttrFile:cardinal; {Attributes of file.}
Name:string; {Also possible to use as ASCIIZ. Name:shortstring; {Also possible to use as ASCIIZ.
The byte following the last string The byte following the last string
character is always zero.} character is always zero.}
end; end;
@ -101,7 +101,7 @@ type
occupies on disk.} occupies on disk.}
AttrFile:cardinal; {Attributes of file.} AttrFile:cardinal; {Attributes of file.}
cbList:longint; {Size of the file's extended attributes.} cbList:longint; {Size of the file's extended attributes.}
Name:string; {Also possible to use as ASCIIZ. Name:shortstring; {Also possible to use as ASCIIZ.
The byte following the last string The byte following the last string
character is always zero.} character is always zero.}
end; end;
@ -316,29 +316,29 @@ const
the size and placement.} the size and placement.}
function DosSetFileInfo (Handle: longint; InfoLevel: cardinal; AFileStatus: PFileStatus; function DosSetFileInfo (Handle: THandle; InfoLevel: cardinal; AFileStatus: PFileStatus;
FileStatusLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 218; FileStatusLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 218;
function DosQueryFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSInfo; function DosQueryFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSInfo;
BufLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 278; BufLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 278;
function DosQueryFileInfo (Handle: longint; InfoLevel: cardinal; function DosQueryFileInfo (Handle: THandle; InfoLevel: cardinal;
AFileStatus: PFileStatus; FileStatusLen: cardinal): cardinal; cdecl; AFileStatus: PFileStatus; FileStatusLen: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 279; external 'DOSCALLS' index 279;
function DosScanEnv (Name: PChar; var Value: PChar): cardinal; cdecl; function DosScanEnv (Name: PChar; var Value: PChar): cardinal; cdecl;
external 'DOSCALLS' index 227; external 'DOSCALLS' index 227;
function DosFindFirst (FileMask: PChar; var Handle: longint; Attrib: cardinal; function DosFindFirst (FileMask: PChar; var Handle: THandle; Attrib: cardinal;
AFileStatus: PFileStatus; FileStatusLen: cardinal; AFileStatus: PFileStatus; FileStatusLen: cardinal;
var Count: cardinal; InfoLevel: cardinal): cardinal; cdecl; var Count: cardinal; InfoLevel: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 264; external 'DOSCALLS' index 264;
function DosFindNext (Handle: longint; AFileStatus: PFileStatus; function DosFindNext (Handle: THandle; AFileStatus: PFileStatus;
FileStatusLen: cardinal; var Count: cardinal): cardinal; cdecl; FileStatusLen: cardinal; var Count: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 265; external 'DOSCALLS' index 265;
function DosFindClose (Handle: longint): cardinal; cdecl; function DosFindClose (Handle: THandle): cardinal; cdecl;
external 'DOSCALLS' index 263; external 'DOSCALLS' index 263;
function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode; function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
@ -348,42 +348,42 @@ function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
function DosMapCase (Size: cardinal; var Country: TCountryCode; function DosMapCase (Size: cardinal; var Country: TCountryCode;
AString: PChar): cardinal; cdecl; external 'NLS' index 7; AString: PChar): cardinal; cdecl; external 'NLS' index 7;
function DosDelete(FileName:PChar): Longint; cdecl; function DosDelete(FileName:PChar): cardinal; cdecl;
external 'DOSCALLS' index 259; external 'DOSCALLS' index 259;
function DosMove(OldFile, NewFile:PChar): Longint; cdecl; function DosMove(OldFile, NewFile:PChar): cardinal; cdecl;
external 'DOSCALLS' index 271; external 'DOSCALLS' index 271;
function DosQueryPathInfo(FileName:PChar;InfoLevel:cardinal; function DosQueryPathInfo(FileName:PChar;InfoLevel:cardinal;
AFileStatus:PFileStatus;FileStatusLen:cardinal): Longint; cdecl; AFileStatus:PFileStatus;FileStatusLen:cardinal): cardinal; cdecl;
external 'DOSCALLS' index 223; external 'DOSCALLS' index 223;
function DosSetPathInfo(FileName:PChar;InfoLevel:longint; function DosSetPathInfo(FileName:PChar;InfoLevel:cardinal;
AFileStatus:PFileStatus;FileStatusLen, AFileStatus:PFileStatus;FileStatusLen,
Options:longint):longint; cdecl; Options:cardinal):cardinal; cdecl;
external 'DOSCALLS' index 219; external 'DOSCALLS' index 219;
function DosOpen(FileName:PChar;var Handle:longint;var Action: Longint; function DosOpen(FileName:PChar;var Handle: THandle; var Action: cardinal;
InitSize,Attrib,OpenFlags,FileMode:cardinal; InitSize,Attrib,OpenFlags,FileMode:cardinal;
EA:Pointer):longint; cdecl; EA:Pointer):cardinal; cdecl;
external 'DOSCALLS' index 273; external 'DOSCALLS' index 273;
function DosClose(Handle:longint): longint; cdecl; function DosClose(Handle: THandle): cardinal; cdecl;
external 'DOSCALLS' index 257; external 'DOSCALLS' index 257;
function DosRead(Handle:longint; var Buffer; Count:longint; function DosRead(Handle:THandle; var Buffer; Count: cardinal;
var ActCount:longint):longint; cdecl; var ActCount: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 281; external 'DOSCALLS' index 281;
function DosWrite(Handle:longint; Buffer: pointer; Count:longint; function DosWrite(Handle: THandle; Buffer: pointer; Count: cardinal;
var ActCount:longint):longint; cdecl; var ActCount: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 282; external 'DOSCALLS' index 282;
function DosSetFilePtr(Handle:longint;Pos:longint;Method:cardinal; function DosSetFilePtr(Handle: THandle; Pos: longint; Method: cardinal;
var PosActual:longint):longint; cdecl; var PosActual: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 256; external 'DOSCALLS' index 256;
function DosSetFileSize(Handle:longint;Size:cardinal):longint; cdecl; function DosSetFileSize (Handle: THandle; Size: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 272; external 'DOSCALLS' index 272;
procedure DosSleep (MSec: cardinal); cdecl; external 'DOSCALLS' index 229; procedure DosSleep (MSec: cardinal); cdecl; external 'DOSCALLS' index 229;
@ -421,7 +421,7 @@ type
WeekDay: byte; WeekDay: byte;
end; end;
function DosGetDateTime(var Buf: TDT):longint; cdecl; function DosGetDateTime(var Buf: TDT): cardinal; cdecl;
external 'DOSCALLS' index 230; external 'DOSCALLS' index 230;
@ -443,15 +443,12 @@ const
function FileOpen (const FileName: string; Mode: integer): longint; function FileOpen (const FileName: string; Mode: integer): longint;
Var Var
Rc, Action, Handle: Longint; Handle: THandle;
P: PChar; Rc, Action: cardinal;
begin begin
P:=StrAlloc(length(FileName)+1);
StrPCopy(P, FileName);
(* DenyNone if sharing not specified. *) (* DenyNone if sharing not specified. *)
if Mode and 112 = 0 then Mode:=Mode or 64; if Mode and 112 = 0 then Mode:=Mode or 64;
Rc:=DosOpen(P, Handle, Action, 0, 0, 1, Mode, nil); Rc:=DosOpen(PChar (FileName), Handle, Action, 0, 0, 1, Mode, nil);
StrDispose(P);
If Rc=0 then If Rc=0 then
FileOpen:=Handle FileOpen:=Handle
else else
@ -462,13 +459,10 @@ function FileCreate (const FileName: string): longint;
Const Const
Mode = ofReadWrite or faCreate or doDenyRW; (* Sharing to DenyAll *) Mode = ofReadWrite or faCreate or doDenyRW; (* Sharing to DenyAll *)
Var Var
RC, Action, Handle: Longint; Handle: THandle;
P: PChar; RC, Action: cardinal;
Begin Begin
P:=StrAlloc(length(FileName)+1); RC:=DosOpen(PChar (FileName), Handle, Action, 0, 0, $12, Mode, Nil);
StrPCopy(P, FileName);
RC:=DosOpen(P, Handle, Action, 0, 0, $12, Mode, Nil);
StrDispose(P);
If RC=0 then If RC=0 then
FileCreate:=Handle FileCreate:=Handle
else else
@ -483,26 +477,26 @@ end;
function FileRead (Handle: longint; var Buffer; Count: longint): longint; function FileRead (Handle: longint; var Buffer; Count: longint): longint;
Var Var
T: Longint; T: cardinal;
begin begin
DosRead(Handle, Buffer, Count, T); DosRead(Handle, Buffer, Count, T);
FileRead:=T; FileRead := longint (T);
end; end;
function FileWrite (Handle: longint; const Buffer; Count: longint): longint; function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
Var Var
T: Longint; T: cardinal;
begin begin
DosWrite (Handle, @Buffer, Count, T); DosWrite (Handle, @Buffer, Count, T);
FileWrite:=T; FileWrite := longint (T);
end; end;
function FileSeek (Handle, FOffset, Origin: longint): longint; function FileSeek (Handle, FOffset, Origin: longint): longint;
var var
npos: longint; npos: cardinal;
begin begin
if DosSetFilePtr(Handle, FOffset, Origin, npos)=0 Then if DosSetFilePtr (Handle, FOffset, Origin, npos) = 0 Then
FileSeek:=npos FileSeek:= longint (npos)
else else
FileSeek:=-1; FileSeek:=-1;
end; end;
@ -541,9 +535,10 @@ end;
function FileExists (const FileName: string): boolean; function FileExists (const FileName: string): boolean;
var var
SR: TSearchRec; SR: TSearchRec;
RC: longint;
begin begin
FileExists:=False; FileExists:=False;
if FindFirst(FileName, faAnyFile, SR)=0 then FileExists:=True; if FindFirst (FileName, faAnyFile, SR)=0 then FileExists:=True;
FindClose(SR); FindClose(SR);
end; end;
@ -558,14 +553,14 @@ var SR: PSearchRec;
FStat: PFileFindBuf3; FStat: PFileFindBuf3;
Count: cardinal; Count: cardinal;
Err: cardinal; Err: cardinal;
I: cardinal;
begin begin
New (FStat); New (FStat);
Rslt.FindHandle := $FFFFFFFF; Rslt.FindHandle := $FFFFFFFF;
Count := 1; Count := 1;
Err := DosFindFirst (PChar (Path), Rslt.FindHandle, Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandard);
ilStandard);
if (Err = 0) and (Count = 0) then Err := 18; if (Err = 0) and (Count = 0) then Err := 18;
FindFirst := -Err; FindFirst := -Err;
if Err = 0 then if Err = 0 then
@ -658,13 +653,9 @@ end;
function FileGetAttr (const FileName: string): longint; function FileGetAttr (const FileName: string): longint;
var var
FS: PFileStatus3; FS: PFileStatus3;
S: PChar;
begin begin
New(FS); New(FS);
S:=StrAlloc(length(FileName)+1); Result:=-DosQueryPathInfo(PChar (FileName), ilStandard, FS, SizeOf(FS^));
StrPCopy(S, FileName);
Result:=-DosQueryPathInfo(S, ilStandard, FS, SizeOf(FS^));
StrDispose(S);
If Result=0 Then Result:=FS^.attrFile; If Result=0 Then Result:=FS^.attrFile;
Dispose(FS); Dispose(FS);
end; end;
@ -672,40 +663,23 @@ end;
function FileSetAttr (const Filename: string; Attr: longint): longint; function FileSetAttr (const Filename: string; Attr: longint): longint;
Var Var
FS: PFileStatus3; FS: PFileStatus3;
S: PChar;
Begin Begin
New(FS); New(FS);
FillChar(FS, SizeOf(FS^), 0); FillChar(FS, SizeOf(FS^), 0);
FS^.attrFile:=Attr; FS^.AttrFile:=Attr;
S:=StrAlloc(length(FileName)+1); Result:=-DosSetPathInfo(PChar (FileName), ilStandard, FS, SizeOf(FS^), 0);
StrPCopy(S, FileName);
Result:=-DosSetPathInfo(S, ilStandard, FS, SizeOf(FS^), 0);
StrDispose(S);
Dispose(FS); Dispose(FS);
end; end;
function DeleteFile (const FileName: string): boolean; function DeleteFile (const FileName: string): boolean;
Var
S: PChar;
Begin Begin
S:=StrAlloc(length(FileName)+1); Result:=(DosDelete(PChar (FileName))=0);
StrPCopy(S, FileName);
Result:=(DosDelete(S)=0);
StrDispose(S);
End; End;
function RenameFile (const OldName, NewName: string): boolean; function RenameFile (const OldName, NewName: string): boolean;
Var
S1, S2: PChar;
Begin Begin
S1:=StrAlloc(length(OldName)+1); Result:=(DosMove(PChar (OldName), PChar (NewName))=0);
StrPCopy(S1, OldName);
S2:=StrAlloc(length(NewName)+1);
StrPCopy(S2, NewName);
Result:=(DosMove(S1, S2)=0);
StrDispose(S1);
StrDispose(S2);
End; End;
{**************************************************************************** {****************************************************************************
@ -752,6 +726,7 @@ end;
function SetCurrentDir (const NewDir: string): boolean; function SetCurrentDir (const NewDir: string): boolean;
begin begin
{$I-} {$I-}
{$WARNING Should be rewritten to avoid unit dos dependancy!}
ChDir (NewDir); ChDir (NewDir);
Result := (IOResult = 0); Result := (IOResult = 0);
{$I+} {$I+}
@ -761,6 +736,7 @@ end;
function CreateDir (const NewDir: string): boolean; function CreateDir (const NewDir: string): boolean;
begin begin
{$I-} {$I-}
{$WARNING Should be rewritten to avoid unit dos dependancy!}
MkDir (NewDir); MkDir (NewDir);
Result := (IOResult = 0); Result := (IOResult = 0);
{$I+} {$I+}
@ -770,6 +746,7 @@ end;
function RemoveDir (const Dir: string): boolean; function RemoveDir (const Dir: string): boolean;
begin begin
{$I-} {$I-}
{$WARNING Should be rewritten to avoid unit dos dependancy!}
RmDir (Dir); RmDir (Dir);
Result := (IOResult = 0); Result := (IOResult = 0);
{$I+} {$I+}
@ -977,7 +954,10 @@ end.
{ {
$Log$ $Log$
Revision 1.42 2004-02-15 21:36:10 hajny Revision 1.43 2004-02-22 15:01:49 hajny
* lots of fixes (regcall, THandle, string operations in sysutils, longint2cardinal according to OS/2 docs, dosh.inc, ...)
Revision 1.42 2004/02/15 21:36:10 hajny
* overloaded ExecuteProcess added, EnvStr param changed to longint * overloaded ExecuteProcess added, EnvStr param changed to longint
Revision 1.41 2004/02/15 08:02:44 yuri Revision 1.41 2004/02/15 08:02:44 yuri