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

* Some emx code removed. Now withous so stupid error as with dos ;)

Browse Source
This commit is contained in:
yuri 2003-10-06 14:22:40 +00:00
parent 1bcce4c618
commit cb457e1a34
1 changed files with 69 additions and 290 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

359
rtl/os2/system.pas
View File

@ -65,7 +65,6 @@ const
type Tos=(osDOS,osOS2,osDPMI); type Tos=(osDOS,osOS2,osDPMI);
var os_mode:Tos; var os_mode:Tos;
first_meg:pointer;
type TByteArray = array [0..$ffff] of byte; type TByteArray = array [0..$ffff] of byte;
PByteArray = ^TByteArray; PByteArray = ^TByteArray;
@ -401,38 +400,27 @@ function paramstr(l:longint):string;
var p:^Pchar; var p:^Pchar;
begin begin
{ There seems to be a problem with EMX for DOS when trying to } if L = 0 then
{ access paramstr(0), and to avoid problems between DOS and } begin
{ OS/2 they have been separated. } GetMem (P, 260);
if os_Mode = OsOs2 then p[0] := #0; { in case of error, initialize to empty string }
begin
if L = 0 then
begin
GetMem (P, 260);
p[0] := #0; { in case of error, initialize to empty string }
{$ASMMODE INTEL} {$ASMMODE INTEL}
asm asm
mov edx, P mov edx, P
mov ecx, 260 mov ecx, 260
mov eax, 7F33h mov eax, 7F33h
call syscall { error handle already with empty string } call syscall { error handle already with empty string }
end; end;
ParamStr := StrPas (PChar (P)); ParamStr := StrPas (PChar (P));
FreeMem (P, 260); FreeMem (P, 260);
end end
else else
if (l>0) and (l<=paramcount) then if (l>0) and (l<=paramcount) then
begin
p:=args;
paramstr:=strpas(p[l]);
end
else paramstr:='';
end
else
begin begin
p:=args; p:=args;
paramstr:=strpas(p[l]); paramstr:=strpas(p[l]);
end; end
else paramstr:='';
end; end;
@ -517,8 +505,7 @@ procedure do_close(h:longint);
begin begin
{ Only three standard handles under real OS/2 } { Only three standard handles under real OS/2 }
if (h > 4) or if h>2 then
((os_MODE = osOS2) and (h > 2)) then
begin begin
asm asm
pushl %ebx pushl %ebx
@ -678,42 +665,17 @@ function Increase_File_Handle_Count: boolean;
var Err: word; var Err: word;
L1, L2: longint; L1, L2: longint;
begin begin
if os_mode = osOS2 then L1 := 10;
begin if DosSetRelMaxFH (L1, L2) <> 0 then
L1 := 10; Increase_File_Handle_Count := false
if DosSetRelMaxFH (L1, L2) <> 0 then else
Increase_File_Handle_Count := false if L2 > FileHandleCount then
else begin
if L2 > FileHandleCount then FileHandleCount := L2;
begin Increase_File_Handle_Count := true;
FileHandleCount := L2; end
Increase_File_Handle_Count := true;
end
else
Increase_File_Handle_Count := false;
end
else else
begin Increase_File_Handle_Count := false;
Inc (FileHandleCount, 10);
Err := 0;
asm
pushl %ebx
movl $0x6700, %eax
movl FileHandleCount, %ebx
call syscall
jnc .LIncFHandles
movw %ax, Err
.LIncFHandles:
popl %ebx
end;
if Err <> 0 then
begin
Increase_File_Handle_Count := false;
Dec (FileHandleCount, 10);
end
else
Increase_File_Handle_Count := true;
end;
end; end;
procedure do_open(var f;p:pchar;flags:longint); procedure do_open(var f;p:pchar;flags:longint);
@ -819,11 +781,7 @@ function do_isdevice (Handle: longint): boolean; assembler;
(* (*
var HT, Attr: longint; var HT, Attr: longint;
begin begin
if os_mode = osOS2 then if DosQueryHType (Handle, HT, Attr) <> 0 then HT := 1;
begin
if DosQueryHType (Handle, HT, Attr) <> 0 then HT := 1;
end
else
*) *)
asm asm
push ebx push ebx
@ -871,26 +829,6 @@ end;
Directory Handling Directory Handling
*****************************************************************************} *****************************************************************************}
procedure dosdir(func:byte;const s:string);
var buffer:array[0..255] of char;
begin
move(s[1],buffer,length(s));
buffer[length(s)]:=#0;
allowslash(Pchar(@buffer));
asm
leal buffer,%edx
movb func,%ah
call syscall
jnc .LDOS_DIRS1
movw %ax,inoutres
.LDOS_DIRS1:
end;
end;
procedure MkDir (const S: string);[IOCHECK]; procedure MkDir (const S: string);[IOCHECK];
var buffer:array[0..255] of char; var buffer:array[0..255] of char;
@ -899,8 +837,6 @@ var buffer:array[0..255] of char;
begin begin
If (s='') or (InOutRes <> 0) then If (s='') or (InOutRes <> 0) then
exit; exit;
if os_mode = osOs2 then
begin
move(s[1],buffer,length(s)); move(s[1],buffer,length(s));
buffer[length(s)]:=#0; buffer[length(s)]:=#0;
allowslash(Pchar(@buffer)); allowslash(Pchar(@buffer));
@ -910,14 +846,6 @@ begin
InOutRes := Rc; InOutRes := Rc;
Errno2Inoutres; Errno2Inoutres;
end; end;
end
else
begin
{ Under EMX 0.9d DOS this routine call may sometimes fail }
{ The syscall documentation indicates clearly that this }
{ routine was NOT tested. }
DosDir ($39, S);
end;
end; end;
@ -929,8 +857,6 @@ begin
InOutRes := 16; InOutRes := 16;
If (s='') or (InOutRes <> 0) then If (s='') or (InOutRes <> 0) then
exit; exit;
if os_mode = osOs2 then
begin
move(s[1],buffer,length(s)); move(s[1],buffer,length(s));
buffer[length(s)]:=#0; buffer[length(s)]:=#0;
allowslash(Pchar(@buffer)); allowslash(Pchar(@buffer));
@ -940,14 +866,6 @@ begin
InOutRes := Rc; InOutRes := Rc;
Errno2Inoutres; Errno2Inoutres;
end; end;
end
else
begin
{ Under EMX 0.9d DOS this routine call may sometimes fail }
{ The syscall documentation indicates clearly that this }
{ routine was NOT tested. }
DosDir ($3A, S);
end;
end; end;
{$ASMMODE INTEL} {$ASMMODE INTEL}
@ -958,72 +876,36 @@ var RC: longint;
Buffer: array [0..255] of char; Buffer: array [0..255] of char;
begin begin
If (s='') or (InOutRes <> 0) then If (s='') or (InOutRes <> 0) then exit;
exit; if (Length (S) >= 2) and (S [2] = ':') then
(* According to EMX documentation, EMX has only one current directory begin
for all processes, so we'll use native calls under OS/2. *) RC := DosSetDefaultDisk ((Ord (S [1]) and not ($20)) - $40);
if os_Mode = osOS2 then if RC <> 0 then
begin InOutRes := RC
if (Length (S) >= 2) and (S [2] = ':') then else
begin if Length (S) > 2 then
RC := DosSetDefaultDisk ((Ord (S [1]) and begin
not ($20)) - $40); Move (S [1], Buffer, Length (S));
if RC <> 0 then Buffer [Length (S)] := #0;
InOutRes := RC AllowSlash (PChar (@Buffer));
else RC := DosSetCurrentDir (@Buffer);
if Length (S) > 2 then if RC <> 0 then
begin begin
Move (S [1], Buffer, Length (S)); InOutRes := RC;
Buffer [Length (S)] := #0; Errno2InOutRes;
AllowSlash (PChar (@Buffer)); end;
RC := DosSetCurrentDir (@Buffer); end;
if RC <> 0 then end else begin
begin Move (S [1], Buffer, Length (S));
InOutRes := RC; Buffer [Length (S)] := #0;
Errno2InOutRes; AllowSlash (PChar (@Buffer));
end; RC := DosSetCurrentDir (@Buffer);
end; if RC <> 0 then
end begin
else InOutRes:= RC;
begin Errno2InOutRes;
Move (S [1], Buffer, Length (S)); end;
Buffer [Length (S)] := #0; end;
AllowSlash (PChar (@Buffer));
RC := DosSetCurrentDir (@Buffer);
if RC <> 0 then
begin
InOutRes:= RC;
Errno2InOutRes;
end;
end;
end
else
if (Length (S) >= 2) and (S [2] = ':') then
begin
asm
mov esi, S
mov al, [esi + 1]
and al, not (20h)
sub al, 41h
mov edx, eax
mov ah, 0Eh
call syscall
mov ah, 19h
call syscall
cmp al, dl
jz @LCHDIR
mov InOutRes, 15
@LCHDIR:
end ['eax','edx','esi'];
if (Length (S) > 2) and (InOutRes <> 0) then
{ Under EMX 0.9d DOS this routine may sometime }
{ fail or crash the system. }
DosDir ($3B, S);
end
else
{ Under EMX 0.9d DOS this routine may sometime }
{ fail or crash the system. }
DosDir ($3B, S);
end; end;
{$ASMMODE ATT} {$ASMMODE ATT}
@ -1185,71 +1067,6 @@ begin
Rewrite (T); Rewrite (T);
end; end;
procedure DosEnvInit;
var
Q: PPChar;
I: cardinal;
begin
(* It's a hack, in fact - DOS stores the environment the same way as OS/2 does,
but I don't know how to find Program Segment Prefix and thus the environment
address under EMX, so I'm recreating this structure using EnvP pointer. *)
{$ASMMODE INTEL}
asm
cld
mov ecx, EnvC
mov esi, EnvP
xor eax, eax
xor edx, edx
@L1:
xchg eax, edx
push ecx
mov ecx, -1
mov edi, [esi]
repne
scasb
neg ecx
dec ecx
xchg eax, edx
add eax, ecx
pop ecx
dec ecx
jecxz @Stop
inc esi
inc esi
inc esi
inc esi
jmp @L1
@Stop:
inc eax
mov EnvSize, eax
end ['eax','ecx','edx','esi','edi'];
Environment := GetMem (EnvSize);
asm
cld
mov ecx, EnvC
mov edx, EnvP
mov edi, Environment
@L2:
mov esi, [edx]
@Copying:
lodsb
stosb
or al, al
jnz @Copying
dec ecx
jecxz @Stop2
inc edx
inc edx
inc edx
inc edx
jmp @L2
@Stop2:
stosb
end ['eax','ecx','edx','esi','edi'];
end;
procedure SysInitStdIO; procedure SysInitStdIO;
begin begin
{ Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be { Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
@ -1349,56 +1166,15 @@ begin
pop ebx pop ebx
end; end;
{ in OS/2 this will always be nil, but in DOS mode }
{ this can be changed. }
first_meg := nil;
{Now request, if we are running under DOS, {Now request, if we are running under DOS,
read-access to the first meg. of memory.} read-access to the first meg. of memory.}
if os_mode in [osDOS,osDPMI] then
asm
push ebx
mov eax, 7F13h
xor ebx, ebx
mov ecx, 0FFFh
xor edx, edx
call syscall
jc @endmem
mov first_meg, eax
@endmem:
pop ebx
end
else
begin
(* Initialize the amount of file handles *) (* Initialize the amount of file handles *)
FileHandleCount := GetFileHandleCount; FileHandleCount := GetFileHandleCount;
end; DosGetInfoBlocks (@TIB, @PIB);
{At 0.9.2, case for enumeration does not work.} StackBottom := cardinal (TIB^.Stack);
case os_mode of Environment := pointer (PIB^.Env);
osDOS: ApplicationType := PIB^.ProcType;
begin IsConsole := ApplicationType <> 3;
stackbottom:=cardinal(heap_brk); {In DOS mode, heap_brk is
also the stack bottom.}
ApplicationType := 1; (* Running under DOS. *)
IsConsole := true;
DosEnvInit;
end;
osOS2:
begin
DosGetInfoBlocks (@TIB, @PIB);
StackBottom := cardinal (TIB^.Stack);
Environment := pointer (PIB^.Env);
ApplicationType := PIB^.ProcType;
IsConsole := ApplicationType <> 3;
end;
osDPMI:
begin
stackbottom:=0; {Not sure how to get it, but seems to be
always zero.}
ApplicationType := 1; (* Running under DOS. *)
IsConsole := true;
DosEnvInit;
end;
end;
exitproc:=nil; exitproc:=nil;
{Initialize the heap.} {Initialize the heap.}
@ -1426,7 +1202,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.37 2003-10-04 08:30:59 yuri Revision 1.38 2003-10-06 14:22:40 yuri
* Some emx code removed. Now withous so stupid error as with dos ;)
Revision 1.37 2003/10/04 08:30:59 yuri
* at&t syntax instead of intel syntax was used * at&t syntax instead of intel syntax was used
Revision 1.36 2003/10/03 21:46:41 peter Revision 1.36 2003/10/03 21:46:41 peter