mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 16:49:07 +02:00
* Another set of native functions.
This commit is contained in:
parent
ba620e2d1f
commit
e3a2162c76
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user