paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 03:07:51 +02:00
Code Issues Packages Projects Releases Wiki Activity

human68k: implemented do_getdir (based on the Atari version)

Browse Source
This commit is contained in:
Karoly Balogh 2023-12-05 11:25:03 +01:00
parent 70839bd7f4
commit 14cee4c152
2 changed files with 23 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
rtl/human68k/h68kdos.inc
View File

@ -106,6 +106,7 @@ const
SEEK_FROM_END = 2;
procedure h68kdos_exit; noreturn; syscall $ff00;
function h68kdos_curdrv: longint; syscall $ff17;
function h68kdos_gettim2: longint; syscall $ff27;
function h68kdos_mkdir(name: pchar): longint; syscall $ff39;
function h68kdos_rmdir(name: pchar): longint; syscall $ff3a;
@ -117,6 +118,7 @@ function h68kdos_read(fileno: word; buffer: pointer; len: longint): longint; sys
function h68kdos_write(fileno: word; buffer: pointer; len: longint): longint; syscall $ff40;
function h68kdos_delete(name: pchar): longint; syscall $ff41;
function h68kdos_seek(fileno: word; offset: longint; mode: word): longint; syscall $ff42;
function h68kdos_curdir(driveno: word; buffer: pointer): longint; syscall $ff47;
function h68kdos_malloc(size: longint): pointer; syscall $ff48;
function h68kdos_mfree(ptr: pointer): longint; syscall $ff49;
function h68kdos_setblock(ptr: pointer; size: longint): longint; syscall $ff4a;

21
rtl/human68k/sysdir.inc
View File

@ -55,5 +55,26 @@ end;
procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
var
dosResult: longint;
pathbuf: array[0..259] of AnsiChar;
begin
Dir := '';
dosResult:=h68kdos_curdir(DriveNr,@pathbuf[2]);
if dosResult < 0 then
begin
Error2InOutRes(dosResult);
exit;
end;
if DriveNr = 0 then
DriveNr := h68kdos_curdrv + 1;
{ return a full path, including drive }
pathbuf[0]:=AnsiChar(ord('A') + DriveNr - 1);
pathbuf[1]:=DriveSeparator;
Dir:=pathbuf;
SetCodePage(Dir,DefaultSystemCodePage,false);
end;