diff --git a/packages/fpmake_add.inc b/packages/fpmake_add.inc index a05ee1dda8..394e8bda6a 100644 --- a/packages/fpmake_add.inc +++ b/packages/fpmake_add.inc @@ -48,6 +48,7 @@ add_graph(ADirectory+IncludeTrailingPathDelimiter('graph')); add_gtk1(ADirectory+IncludeTrailingPathDelimiter('gtk1')); add_gtk2(ADirectory+IncludeTrailingPathDelimiter('gtk2')); + add_h68units(ADirectory+IncludeTrailingPathDelimiter('h68units')); add_hash(ADirectory+IncludeTrailingPathDelimiter('hash')); add_hermes(ADirectory+IncludeTrailingPathDelimiter('hermes')); add_httpd13(ADirectory+IncludeTrailingPathDelimiter('httpd13')); diff --git a/packages/fpmake_proc.inc b/packages/fpmake_proc.inc index 78260e4d80..3ee4e89702 100644 --- a/packages/fpmake_proc.inc +++ b/packages/fpmake_proc.inc @@ -280,6 +280,12 @@ begin {$include gtk2/fpmake.pp} end; +procedure add_h68units(const ADirectory: string); +begin + with Installer do +{$include h68units/fpmake.pp} +end; + procedure add_hash(const ADirectory: string); begin with Installer do diff --git a/packages/h68units/README.md b/packages/h68units/README.md new file mode 100644 index 0000000000..6bdc78e968 --- /dev/null +++ b/packages/h68units/README.md @@ -0,0 +1,15 @@ +# Human 68k Units + +This directory contains OS API units for Human68k, which is an MSDOS-alike +operating system developed by Hudson Soft, running on the Sharp X68000 +series of computers. They're sometimes called the "Japanese Amiga", due +to their Motorola 68000 processor and strong custom chipset for graphics. + +This package is named "h68units" instead of "h68kunits" due to the 8.3 +limitations of the original platform. + +The code in this package is based on code and information found in the GCC +and newlib ports for Human68k by Lyderic "Lydux" Maillet, and is available +at: + +https://github.com/Lydux diff --git a/packages/h68units/fpmake.pp b/packages/h68units/fpmake.pp new file mode 100644 index 0000000000..4562838e1a --- /dev/null +++ b/packages/h68units/fpmake.pp @@ -0,0 +1,46 @@ +{$ifndef ALLPACKAGES} +{$mode objfpc}{$H+} +program fpmake; + +uses {$ifdef unix}cthreads,{$endif} fpmkunit; + +Var + P : TPackage; + T : TTarget; +begin + With Installer do + begin +{$endif ALLPACKAGES} + + P:=AddPackage('h68units'); + P.ShortName := 'h68'; + + P.Author := 'FPC core team'; + P.License := 'LGPL with modification'; + P.HomepageURL := 'www.freepascal.org'; + P.Description := 'h68units, OS interface units for Human 68k/Sharp X68000'; + +{$ifdef ALLPACKAGES} + P.Directory:=ADirectory; +{$endif ALLPACKAGES} + P.Version:='3.3.1'; + P.SourcePath.Add('src'); + P.IncludePath.Add('src'); + + P.OSes:=[human68k]; + + T:=P.Targets.AddUnit('h68kdos.pas'); + with T.Dependencies do + begin + AddInclude('h68kdos.inc'); + end; + + P.Sources.AddDoc('README.md'); + + P.NamespaceMap:='namespaces.lst'; + +{$ifndef ALLPACKAGES} + Run; + end; +end. +{$endif ALLPACKAGES} diff --git a/packages/h68units/namespaced/Human68kApi.DOS.pas b/packages/h68units/namespaced/Human68kApi.DOS.pas new file mode 100644 index 0000000000..0792ebbb08 --- /dev/null +++ b/packages/h68units/namespaced/Human68kApi.DOS.pas @@ -0,0 +1,3 @@ +unit Human68kApi.DOS; +{$DEFINE FPC_DOTTEDUNITS} +{$i human68k.pas} diff --git a/packages/h68units/src/h68kdos.inc b/packages/h68units/src/h68kdos.inc new file mode 100644 index 0000000000..a745927cf6 --- /dev/null +++ b/packages/h68units/src/h68kdos.inc @@ -0,0 +1,182 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2023 by Free Pascal development team + + DOS related defines for Human 68k (Sharp X68000) + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +const + DOSE_ILGFNC = -1; { Invalid function code executed } + DOSE_NOENT = -2; { File not found } + DOSE_NODIR = -3; { Directory not found } + DOSE_MFILE = -4; { Too many open files } + DOSE_ISDIR = -5; { Directory and volume label inaccessible } + DOSE_BADF = -6; { The specified handle is not open } + DOSE_BROKNMEM = -7; { The memory management area was destroyed } + DOSE_NOMEM = -8; { Not enough memory for execution } + DOSE_ILGMPTR = -9; { Invalid memory management pointer specified } + DOSE_ILGENV = -10; { Illegal environment specified } + DOSE_ILGFMT = -11; { Abnormal executable file format } + DOSE_ILGARG = -12; { Abnormal open access mode } + DOSE_ILGFNAME = -13; { Invalid file name } + DOSE_ILGPARM = -14; { Called with invalid parameter } + DOSE_ILGDRV = -15; { Invalid drive specified } + DOSE_ISCURDIR = -16; { Current directory can't be deleted } + DOSE_CANTIOC = -17; { ioctrl can not be used } + DOSE_NOMORE = -18; { No more files found } + DOSE_RDONLY = -19; { The file can't be written } + DOSE_EXISTDIR = -20; { The directory already exists } + DOSE_NOTEMPTY = -21; { File can't be deleted } + DOSE_CANTREN = -22; { File can't be renamed } + DOSE_DISKFULL = -23; { File can't be created because disk is full } + DOSE_DIRFULL = -24; { File can't be created because folder is full } + DOSE_CANTSEEK = -25; { Can't seek to the specified position } + DOSE_SUPER = -26; { Supervisor mode require while in supervisor mode } + DOSE_DUPTHNAM = -27; { Thread name exists } + DOSE_CANTSEND = -28; { IPC buffer is write protected } + DOSE_THFULL = -29; { Can't start any more background processes } + DOSE_LCKFULL = -32; { Insufficient lock space } + DOSE_LCKERR = -33; { File is locked and can't be accessed } + DOSE_BUSYDRV = -34; { The drive has a handler open } + DOSE_SYMLOOP = -35; { Symbolic link nest exceeded 16 links(lndrv) } + DOSE_EXISTFILE = -80; { File exists } + + +type + Th68kdos_comline = record + case boolean of + true: ( len: byte; buffer: array[0..255] of char; ); + false: ( pstr: shortstring; ) + end; + Ph68kdos_comline = ^Th68kdos_comline; + +type + Th68kdos_psp = record + env: pchar; + _exit: pointer; + ctrlc: pointer; + errexit: pointer; + comline: Ph68kdos_comline; + handle: array[0..11] of byte; + bss: pointer; + heap: pointer; + stack: pointer; + usp: pointer; + ssp: pointer; + sr: word; + abort_sr: word; + abort_ssp: pointer; + trap10: pointer; + trap11: pointer; + trap12: pointer; + trap13: pointer; + trap14: pointer; + osflg: dword; + reserve_1: array[0..27] of byte; + exe_path: array[0..67] of char; + exe_name: array[0..23] of char; + reserve_2: array[0..35] of byte; + end; + Ph68kdos_psp = ^Th68kdos_psp; + +// register contents on startup, a0-a5 respectively +type + Th68kdos_startup = record + mcb: pbyte; + bss_end: pbyte; + comm: ph68kdos_comline; + environ: pbyte; + entry: pbyte; + intr: pbyte; + end; + Ph68kdos_startup = ^Th68kdos_startup; + +type + Th68kdos_freeinfo = record + free: word; + max: word; + sectors: word; + bytes: word; + end; + Ph68kdos_freeinfo = ^Th68kdos_freeinfo; + +type + Th68kdos_filbuf = record + searchatr: byte; + driveno: byte; + dirsec: dword; + dirlft: word; + dirpos: word; + filename: array[0..7] of char; + ext: array[0..2] of char; + atr: byte; + time: word; + date: word; + filelen: dword; + name: array[0..22] of char; + end; + Ph68kdos_filbuf = ^Th68kdos_filbuf; + +type + Th68kdos_exfilbuf = record + searchatr: byte; + driveno: byte; + dirsec: dword; + dirlft: word; + dirpos: word; + filename: array[0..7] of char; + ext: array[0..2] of char; + atr: byte; + time: word; + date: word; + filelen: dword; + name: array[0..22] of char; + drive: array[0..2] of char; + path: array[0..64] of char; + unused: array[0..20] of byte; + end; + Ph68kdos_exfilbuf = ^Th68kdos_exfilbuf; + +// as used by seek +const + SEEK_FROM_START = 0; + SEEK_FROM_CURRENT = 1; + SEEK_FROM_END = 2; + +procedure h68kdos_exit; noreturn; syscall $ff00; +function h68kdos_chgdrv(newdrv: word): longint; syscall $ff0e; +function h68kdos_curdrv: longint; syscall $ff17; +function h68kdos_gettim2: longint; syscall $ff27; +function h68kdos_vernum: longint; syscall $ff30; +function h68kdos_dskfre(drive: word; buffer: Ph68kdos_freeinfo): longint; syscall $ff36; +function h68kdos_mkdir(name: pchar): longint; syscall $ff39; +function h68kdos_rmdir(name: pchar): longint; syscall $ff3a; +function h68kdos_chdir(name: pchar): longint; syscall $ff3b; +function h68kdos_create(name: pchar; attr: word): longint; syscall $ff3c; +function h68kdos_open(name: pchar; mode: word): longint; syscall $ff3d; +function h68kdos_close(fileno: word): longint; syscall $ff3e; +function h68kdos_read(fileno: word; buffer: pointer; len: longint): longint; syscall $ff3f; +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; +procedure h68kdos_exit2(code: smallint); noreturn; syscall $ff4c; +function h68kdos_files(filbuf: Ph68kdos_filbuf; name: pchar; atr: word): longint; syscall $ff4e; +function h68kdos_nfiles(filbuf: Ph68kdos_filbuf): longint; syscall $ff4f; + +{ * human68k v2 only calls * } +function h68kdos_rename_v2(oldname: PChar; newname: PChar): longint; syscall $ff56; + +{ * human68k v3 only calls * } +function h68kdos_rename_v3(oldname: PChar; newname: PChar): longint; syscall $ff86; diff --git a/packages/h68units/src/h68kdos.pas b/packages/h68units/src/h68kdos.pas new file mode 100644 index 0000000000..c1a61bda89 --- /dev/null +++ b/packages/h68units/src/h68kdos.pas @@ -0,0 +1,46 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2023 by Free Pascal development team + + DOS API unit for Human 68k (Sharp X68000) + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +unit h68kdos; + +interface + +{$i h68kdos.inc} + +function h68kdos_rename(oldname: PChar; newname: PChar): longint; +function h68kdos_exfiles(filbuf: Ph68kdos_exfilbuf; name: pchar; atr: word): longint; +function h68kdos_exnfiles(filbuf: Ph68kdos_exfilbuf): longint; + +implementation + +function h68kdos_rename(oldname: PChar; newname: PChar): longint; +begin + if hi(human68k_vernum) <= 2 then + h68kdos_rename:=h68kdos_rename_v2(oldname,newname) + else + h68kdos_rename:=h68kdos_rename_v3(oldname,newname); +end; + +function h68kdos_exfiles(filbuf: Ph68kdos_exfilbuf; name: pchar; atr: word): longint; +begin + h68kdos_exfiles:=h68kdos_files(Ph68kdos_filbuf(ptruint(filbuf) or $80000000),name,atr); +end; + +function h68kdos_exnfiles(filbuf: Ph68kdos_exfilbuf): longint; +begin + h68kdos_exnfiles:=h68kdos_nfiles(Ph68kdos_filbuf(ptruint(filbuf) or $80000000)); +end; + +end.