* Another set of native functions.

This commit is contained in:
yuri 2003-10-06 16:58:27 +00:00
parent ba620e2d1f
commit e3a2162c76

View File

@ -163,6 +163,9 @@ external 'DOSCALLS' index 382;
function DosSetCurrentDir (Name:PChar): longint; cdecl; function DosSetCurrentDir (Name:PChar): longint; cdecl;
external 'DOSCALLS' index 255; external 'DOSCALLS' index 255;
procedure DosQueryCurrentDisk(var DiskNum:longint;var Logical:longint); cdecl;
external 'DOSCALLS' index 275;
function DosSetDefaultDisk (DiskNum:longint): longint; cdecl; function DosSetDefaultDisk (DiskNum:longint): longint; cdecl;
external 'DOSCALLS' index 220; external 'DOSCALLS' index 220;
@ -175,17 +178,22 @@ external 'DOSCALLS' index 270;
function DosDeleteDir( Name : pchar) : longint; cdecl; function DosDeleteDir( Name : pchar) : longint; cdecl;
external 'DOSCALLS' index 226; external 'DOSCALLS' index 226;
function DosQueryCurrentDir(DiskNum:longint;var Buffer;
var BufLen:longint):longint; cdecl;
external 'DOSCALLS' index 274;
function DosMove(OldFile,NewFile:PChar):longint; cdecl;
external 'DOSCALLS' index 271;
function DosDelete(FileName:PChar):longint; cdecl;
external 'DOSCALLS' index 259;
procedure DosExit(Action, Result: longint); cdecl;
external 'DOSCALLS' index 234;
{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';
{
procedure syscall; external 'EMX' index 2;
procedure emx_init; external 'EMX' index 1;
}
{ converts an OS/2 error code to a TP compatible error } { converts an OS/2 error code to a TP compatible error }
{ code. Same thing exists under most other supported } { code. Same thing exists under most other supported }
{ systems. } { systems. }
@ -371,28 +379,23 @@ Fatal Signal Exceptions
****************************************************************************} ****************************************************************************}
{$asmmode intel} procedure system_exit;
procedure system_exit; assembler; begin
asm DosExit(1{process}, exitcode);
mov ah, 04ch end;
mov al, byte ptr exitcode
call syscall
end ['EAX'];
{$ASMMODE ATT} {$ASMMODE ATT}
function paramcount:longint;assembler; function paramcount:longint;assembler;
asm asm
movl argc,%eax movl argc,%eax
decl %eax decl %eax
end ['EAX']; end ['EAX'];
function args:pointer;assembler; function args:pointer;assembler;
asm
asm movl argv,%eax
movl argv,%eax end ['EAX'];
end ['EAX'];
function paramstr(l:longint):string; function paramstr(l:longint):string;
@ -521,35 +524,16 @@ begin
end; end;
procedure do_erase(p:Pchar); procedure do_erase(p:Pchar);
begin begin
allowslash(p); allowslash(p);
asm inoutres:=DosDelete(p);
movl P,%edx
movb $0x41,%ah
call syscall
jnc .LERASE1
movw %ax,inoutres;
.LERASE1:
end;
end; end;
procedure do_rename(p1,p2:Pchar); procedure do_rename(p1,p2:Pchar);
begin begin
allowslash(p1); allowslash(p1);
allowslash(p2); allowslash(p2);
asm inoutres:=DosMove(p1, p2);
pushl %edi
movl P1, %edx
movl P2, %edi
movb $0x56,%ah
call syscall
jnc .LRENAME1
movw %ax,inoutres;
.LRENAME1:
popl %edi
end;
end; end;
function do_read(h,addr,len:longint):longint; assembler; function do_read(h,addr,len:longint):longint; assembler;
@ -830,10 +814,8 @@ 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;
Rc : word; Rc : word;
begin begin
If (s='') or (InOutRes <> 0) then If (s='') or (InOutRes <> 0) then
exit; exit;
@ -911,12 +893,10 @@ end;
{$ASMMODE ATT} {$ASMMODE ATT}
procedure GetDir (DriveNr: byte; var Dir: ShortString); procedure GetDir (DriveNr: byte; var Dir: ShortString);
{Written by Michael Van Canneyt.} {Written by Michael Van Canneyt.}
var sof: Pchar;
var sof:Pchar;
i:byte; i:byte;
l, l2: Longint;
begin begin
Dir [4] := #0; Dir [4] := #0;
{ Used in case the specified drive isn't available } { Used in case the specified drive isn't available }
@ -925,15 +905,8 @@ begin
{ supplied by DOS, so we let dos string start at } { supplied by DOS, so we let dos string start at }
{ dir[4] } { dir[4] }
{ Get dir from drivenr : 0=default, 1=A etc... } { Get dir from drivenr : 0=default, 1=A etc... }
asm l:=255-3;
movb drivenr,%dl InOutRes:=DosQueryCurrentDir(DriveNr, sof^, l);
movl sof,%esi
mov $0x47,%ah
call syscall
jnc .LGetDir
movw %ax, InOutRes
.LGetDir:
end [ 'eax','edx','esi'];
{ Now Dir should be filled with directory in ASCIIZ, } { Now Dir should be filled with directory in ASCIIZ, }
{ starting from dir[4] } { starting from dir[4] }
dir[0]:=#3; dir[0]:=#3;
@ -956,13 +929,8 @@ begin
begin begin
{ We need to get the current drive from DOS function 19H } { We need to get the current drive from DOS function 19H }
{ because the drive was the default, which can be unknown } { because the drive was the default, which can be unknown }
asm DosQueryCurrentDisk(l, l2);
movb $0x19,%ah dir[1]:=chr(64+l);
call syscall
addb $65,%al
movb %al,i
end;
dir[1]:=char(i);
end; end;
if not (FileNameCaseSensitive) then dir:=upcase(dir); if not (FileNameCaseSensitive) then dir:=upcase(dir);
end; end;
@ -1123,21 +1091,11 @@ var TIB: PThreadInfoBlock;
begin begin
IsLibrary := FALSE; IsLibrary := FALSE;
{Determine the operating system we are running on.} os_mode:=OsOs2;
{$ASMMODE INTEL} {$ASMMODE INTEL}
asm asm
push ebx push ebx
mov os_mode, 0
mov eax, 7F0Ah
call syscall
test bx, 512 {Bit 9 is OS/2 flag.}
setne byte ptr os_mode
test bx, 4096
jz @noRSX
mov os_mode, 2
@noRSX:
{Enable the brk area by initializing it with the initial heap size.} {Enable the brk area by initializing it with the initial heap size.}
mov eax, 7F01h mov eax, 7F01h
mov edx, heap_brk mov edx, heap_brk
add edx, heap_base add edx, heap_base
@ -1169,7 +1127,7 @@ begin
{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.}
(* Initialize the amount of file handles *) (* Initialize the amount of file handles *)
FileHandleCount := GetFileHandleCount; FileHandleCount := GetFileHandleCount;
DosGetInfoBlocks (@TIB, @PIB); DosGetInfoBlocks (@TIB, @PIB);
StackBottom := cardinal (TIB^.Stack); StackBottom := cardinal (TIB^.Stack);
Environment := pointer (PIB^.Env); Environment := pointer (PIB^.Env);
@ -1202,7 +1160,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.38 2003-10-06 14:22:40 yuri Revision 1.39 2003-10-06 16:58:27 yuri
* Another set of native functions.
Revision 1.38 2003/10/06 14:22:40 yuri
* Some emx code removed. Now withous so stupid error as with dos ;) * Some emx code removed. Now withous so stupid error as with dos ;)
Revision 1.37 2003/10/04 08:30:59 yuri Revision 1.37 2003/10/04 08:30:59 yuri