h68units: new package with and for Human68k support units

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'));

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

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

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}

packages/h68units/namespaced/Human68kApi.DOS.pas

@@ -0,0 +1,3 @@
+unit Human68kApi.DOS;
+{$DEFINE FPC_DOTTEDUNITS}
+{$i human68k.pas}

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;

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.