paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-30 17:40:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

* FileHandleCount handling for OS/2 added

Browse Source
This commit is contained in:
Tomas Hajny 2000-06-05 18:53:30 +00:00
parent 0baf0745bc
commit 85c76dc528
1 changed files with 140 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

281
rtl/os2/sysos2.pas
View File

@ -2,7 +2,7 @@
Free Pascal -- OS/2 runtime library Free Pascal -- OS/2 runtime library
Copyright (c) 1999-2000 by Florian Kl„mpfl Copyright (c) 1999-2000 by Florian Klaempfl
Copyright (c) 1999-2000 by Daniel Mantione Copyright (c) 1999-2000 by Daniel Mantione
Free Pascal is distributed under the GNU Public License v2. So is this unit. Free Pascal is distributed under the GNU Public License v2. So is this unit.
@ -111,12 +111,15 @@ implementation
{$I SYSTEM.INC} {$I SYSTEM.INC}
procedure dosgetinfoblocks(var Atib:Pthreadinfoblock; procedure DosGetInfoBlocks (var Atib: PThreadInfoBlock;
var Apib:Pprocessinfoblock); cdecl; var Apib: PProcessInfoBlock); cdecl;
external 'DOSCALLS' index 312; external 'DOSCALLS' index 312;
function DosSetRelMaxFH (var ReqCount, CurMaxFH: longint): longint; cdecl;
external 'DOSCALLS' index 382;
{This is the correct way to call external assembler procedures.} {This is the correct way to call external assembler procedures.}
procedure syscall;external name '___SYSCALL'; procedure syscall; external name '___SYSCALL';
{*************************************************************************** {***************************************************************************
@ -169,13 +172,11 @@ end;
****************************************************************************} ****************************************************************************}
procedure system_exit; procedure system_exit; assembler;
begin asm
asm movb $0x4c,%ah
movb $0x4c,%ah movb exitcode,%al
movb exitcode,%al call syscall
call syscall
end;
end; end;
@ -232,15 +233,11 @@ end;
{ this function allows to extend the heap by calling { this function allows to extend the heap by calling
syscall $7f00 resizes the brk area} syscall $7f00 resizes the brk area}
function sbrk(size:longint):longint; function sbrk(size:longint):longint; assembler;
asm
begin movl size,%edx
asm movw $0x7f00,%ax
movl size,%edx call syscall
movw $0x7f00,%ax
call syscall
movl %eax,__RESULT
end;
end; end;
{$ASMMODE direct} {$ASMMODE direct}
@ -295,7 +292,7 @@ procedure do_erase(p:Pchar);
begin begin
allowslash(p); allowslash(p);
asm asm
movl 8(%ebp),%edx movl P,%edx
movb $0x41,%ah movb $0x41,%ah
call syscall call syscall
jnc .LERASE1 jnc .LERASE1
@ -310,8 +307,8 @@ begin
allowslash(p1); allowslash(p1);
allowslash(p2); allowslash(p2);
asm asm
movl 8(%ebp),%edx movl P1, %edx
movl 12(%ebp),%edi movl P2, %edi
movb $0x56,%ah movb $0x56,%ah
call syscall call syscall
jnc .LRENAME1 jnc .LRENAME1
@ -320,88 +317,64 @@ begin
end; end;
end; end;
function do_read(h,addr,len:longint):longint; function do_read(h,addr,len:longint):longint; assembler;
asm
begin movl len,%ecx
asm movl addr,%edx
movl 16(%ebp),%ecx movl h,%ebx
movl 12(%ebp),%edx movb $0x3f,%ah
movl 8(%ebp),%ebx call syscall
movb $0x3f,%ah jnc .LDOSREAD1
call syscall movw %ax,inoutres;
jnc .LDOSREAD1 xorl %eax,%eax
movw %ax,inoutres; .LDOSREAD1:
xorl %eax,%eax
.LDOSREAD1:
leave
ret $12
end;
end; end;
function do_write(h,addr,len:longint) : longint; function do_write(h,addr,len:longint) : longint; assembler;
asm
begin movl len,%ecx
asm movl addr,%edx
movl 16(%ebp),%ecx movl h,%ebx
movl 12(%ebp),%edx movb $0x40,%ah
movl 8(%ebp),%ebx call syscall
movb $0x40,%ah jnc .LDOSWRITE1
call syscall movw %ax,inoutres;
jnc .LDOSWRITE1 .LDOSWRITE1:
movw %ax,inoutres;
.LDOSWRITE1:
movl %eax,-4(%ebp)
end;
end; end;
function do_filepos(handle:longint):longint; function do_filepos(handle:longint): longint; assembler;
asm
begin movw $0x4201,%ax
asm movl handle,%ebx
movw $0x4201,%ax xorl %edx,%edx
movl 8(%ebp),%ebx call syscall
xorl %edx,%edx jnc .LDOSFILEPOS
call syscall movw %ax,inoutres;
jnc .LDOSFILEPOS xorl %eax,%eax
movw %ax,inoutres; .LDOSFILEPOS:
xorl %eax,%eax
.LDOSFILEPOS:
leave
ret $4
end;
end; end;
procedure do_seek(handle,pos:longint); procedure do_seek(handle,pos:longint); assembler;
asm
begin movw $0x4200,%ax
asm movl handle,%ebx
movw $0x4200,%ax movl pos,%edx
movl 8(%ebp),%ebx call syscall
movl 12(%ebp),%edx jnc .LDOSSEEK1
call syscall movw %ax,inoutres;
jnc .LDOSSEEK1 .LDOSSEEK1:
movw %ax,inoutres;
.LDOSSEEK1:
leave
ret $8
end;
end; end;
function do_seekend(handle:longint):longint; function do_seekend(handle:longint):longint; assembler;
asm
begin movw $0x4202,%ax
asm movl handle,%ebx
movw $0x4202,%ax xorl %edx,%edx
movl 8(%ebp),%ebx call syscall
xorl %edx,%edx jnc .Lset_at_end1
call syscall movw %ax,inoutres;
jnc .Lset_at_end1 xorl %eax,%eax
movw %ax,inoutres; .Lset_at_end1:
xorl %eax,%eax
.Lset_at_end1:
leave
ret $4
end;
end; end;
function do_filesize(handle:longint):longint; function do_filesize(handle:longint):longint;
@ -414,10 +387,8 @@ begin
do_seek(handle,aktfilepos); do_seek(handle,aktfilepos);
end; end;
procedure do_truncate(handle,pos:longint); procedure do_truncate(handle,pos:longint); assembler;
asm
begin
asm
(* DOS function 40h isn't safe for this according to EMX documentation (* DOS function 40h isn't safe for this according to EMX documentation
movl $0x4200,%eax movl $0x4200,%eax
movl 8(%ebp),%ebx movl 8(%ebp),%ebx
@ -431,25 +402,22 @@ begin
movb $0x40,%ah movb $0x40,%ah
call syscall call syscall
*) *)
movl $0x7F25,%eax movl $0x7F25,%eax
movl Handle,%ebx movl Handle,%ebx
movl Pos,%edx movl Pos,%edx
call syscall call syscall
inc %eax inc %eax
movl %ecx, %eax movl %ecx, %eax
jnz .LTruncate1 jnz .LTruncate1
(* File position is undefined after truncation, move to the end. *) (* File position is undefined after truncation, move to the end. *)
movl $0x4202,%eax movl $0x4202,%eax
movl Handle,%ebx movl Handle,%ebx
movl $0,%edx movl $0,%edx
call syscall call syscall
jnc .LTruncate2 jnc .LTruncate2
.LTruncate1: .LTruncate1:
movw %ax,inoutres; movw %ax,inoutres;
.LTruncate2: .LTruncate2:
leave
ret $8
end;
end; end;
const const
@ -457,24 +425,41 @@ const
function Increase_File_Handle_Count: boolean; function Increase_File_Handle_Count: boolean;
var Err: word; var Err: word;
L1, L2: longint;
begin begin
Inc (FileHandleCount, 10); if os_mode = osOS2 then
Err := 0;
asm
movl $0x6700, %eax
movl FileHandleCount, %ebx
call syscall
jnc .LIncFHandles
movw %ax, Err
.LIncFHandles:
end;
if Err <> 0 then
begin begin
Increase_File_Handle_Count := false; L1 := 10;
Dec (FileHandleCount, 10); if DosSetRelMaxFH (L1, L2) <> 0 then
Increase_File_Handle_Count := false
else
if L2 > FileHandleCount then
begin
FileHandleCount := L2;
Increase_File_Handle_Count := true;
end
else
Increase_File_Handle_Count := false;
end end
else else
Increase_File_Handle_Count := true; begin
Inc (FileHandleCount, 10);
Err := 0;
asm
movl $0x6700, %eax
movl FileHandleCount, %ebx
call syscall
jnc .LIncFHandles
movw %ax, Err
.LIncFHandles:
end;
if Err <> 0 then
begin
Increase_File_Handle_Count := false;
Dec (FileHandleCount, 10);
end
else
Increase_File_Handle_Count := true;
end; end;
procedure do_open(var f;p:pchar;flags:longint); procedure do_open(var f;p:pchar;flags:longint);
@ -560,8 +545,7 @@ begin
movl f,%edx movl f,%edx
movw %ax,(%edx) movw %ax,(%edx)
end; end;
if (os_mode <> osOS2) and (InOutRes = 4) and Increase_File_Handle_Count if (InOutRes = 4) and Increase_File_Handle_Count then
then
(* Trying again after increasing amount of file handles *) (* Trying again after increasing amount of file handles *)
asm asm
movl $0x7f2b, %eax movl $0x7f2b, %eax
@ -605,7 +589,7 @@ begin
movw %ax,(%edx) movw %ax,(%edx)
end; end;
*) *)
{ for systems that have more then 20 by default ! } { for systems that have more handles }
if FileRec (F).Handle > FileHandleCount then if FileRec (F).Handle > FileHandleCount then
FileHandleCount := FileRec (F).Handle; FileHandleCount := FileRec (F).Handle;
if (flags and $100)<>0 then if (flags and $100)<>0 then
@ -681,7 +665,7 @@ begin
allowslash(Pchar(@buffer)); allowslash(Pchar(@buffer));
asm asm
leal buffer,%edx leal buffer,%edx
movb 8(%ebp),%ah movb func,%ah
call syscall call syscall
jnc .LDOS_DIRS1 jnc .LDOS_DIRS1
movw %ax,inoutres; movw %ax,inoutres;
@ -770,6 +754,14 @@ end;
****************************************************************************} ****************************************************************************}
function GetFileHandleCount: longint;
var L1, L2: longint;
begin
L1 := 0; (* Don't change the amount, just check. *)
if DosSetRelMaxFH (L1, L2) <> 0 then GetFileHandleCount := 50
else GetFileHandleCount := L2;
end;
var pib:Pprocessinfoblock; var pib:Pprocessinfoblock;
tib:Pthreadinfoblock; tib:Pthreadinfoblock;
@ -779,7 +771,7 @@ begin
movl $0,os_mode movl $0,os_mode
movw $0x7f0a,%ax movw $0x7f0a,%ax
call syscall call syscall
testw$512,%bx {Bit 9 is OS/2 flag.} testw $512,%bx {Bit 9 is OS/2 flag.}
setnzb os_mode setnzb os_mode
testw $4096,%bx testw $4096,%bx
jz .LnoRSX jz .LnoRSX
@ -814,7 +806,11 @@ begin
movl %eax,first_meg movl %eax,first_meg
end end
else else
first_meg:=nil; begin
first_meg := nil;
(* Initialize the amount of file handles *)
FileHandleCount := GetFileHandleCount;
end;
{At 0.9.2, case for enumeration does not work.} {At 0.9.2, case for enumeration does not work.}
case os_mode of case os_mode of
osDOS: osDOS:
@ -850,7 +846,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.30 2000-06-04 14:14:01 hajny Revision 1.31 2000-06-05 18:53:30 hajny
* FileHandleCount handling for OS/2 added
Revision 1.30 2000/06/04 14:14:01 hajny
* do_truncate corrected, do_open might work under W9x now * do_truncate corrected, do_open might work under W9x now
Revision 1.29 2000/05/28 18:17:39 hajny Revision 1.29 2000/05/28 18:17:39 hajny