human68k: RTL works enough now to run a hello, world!

rtl/human68k/README.md

@@ -3,3 +3,8 @@
 This directory contains support for Human68k, which is an MSDOS-like OS
 developed by Hudson Soft, running on the Sharp X68000 series of computers
 sometimes called the "Japanese Amiga".
+
+RTL code is based on the code and information found in the GCC and newlib
+ports for Human68k by Lyderic "Lydux" Maillet, and is available at:
+
+https://github.com/Lydux

rtl/human68k/h68kdos.inc

@@ -0,0 +1,56 @@
+{
+    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.
+
+ **********************************************************************}
+
+type
+  h68kdos_comline = record
+    case boolean of
+      true: ( len: byte; buffer: array[0..255] of char; );
+      false: ( pstr: shortstring; )
+  end;
+
+type
+  h68kdos_psp = record
+    env: pchar;
+    _exit: pointer;
+    ctrlc: pointer;
+    errexit: pointer;
+    comline: ^h68kdos_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;
+
+procedure h68kdos_exit; noreturn; syscall $ff00;
+function h68kdos_write(fileno: word; buffer: pointer; len: longint): longint; syscall $ff40;
+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;

rtl/human68k/si_prc.pp

@@ -19,25 +19,56 @@ interface
 
 implementation
 
+{$include h68kdos.inc}
+
 var
   stacktop: pointer; public name '__stktop';
   stklen: longint; external name '__stklen';
 
+type
+  Th68k_startup = record
+    mcb: pbyte;
+    bss_end: pbyte;
+    comm: pbyte;
+    environ: pbyte;
+    entry: pbyte;
+    intr: pbyte;
+  end;
+  Ph68k_startup = ^Th68k_startup;
 
-procedure PascalMain; external name 'PASCALMAIN';
+var
+  h68k_startup: Th68k_startup; public name '_h68k_startup';
 
+procedure PascalMain; external name 'PASCALMAIN';
+procedure PascalStart(const startparams: Ph68k_startup); noreturn; forward;
 
 { this function must be the first in this unit which contains code }
-{$OPTIMIZATION OFF}
-procedure _FPC_proc_start; cdecl; public name '_start';
+procedure _FPC_proc_start; assembler; nostackframe; noreturn; public name '_start';
+asm
+  movem.l a0-a5,-(sp)
+  move.l sp,a0
+  jbsr PascalStart
+end;
+
+procedure PascalStart(const startparams: Ph68k_startup); noreturn;
+var
+  bss_start: pbyte;
 begin
+  with startparams^ do
+    begin
+      { clear BSS }
+      bss_start:=pbyte(pdword(@mcb[30])^);
+      fillchar(bss_start^,bss_end-bss_start,0);
+    end;
+
+  h68k_startup:=startparams^;
+
   PASCALMAIN;
 end;
 
-procedure _FPC_proc_halt(_ExitCode: longint); cdecl; assembler public name '_haltproc';
-asm
-  dc.w $ff00  { _EXIT }
+procedure _FPC_proc_halt(_ExitCode: longint); noreturn; public name '_haltproc';
+begin
+  h68kdos_exit2(_ExitCode);
 end;
 
-
 end.

rtl/human68k/sysfile.inc

@@ -36,8 +36,20 @@ end;
 
 
 function do_write(h: longint; addr: pointer; len: longint) : longint;
+var
+  dosResult: longint;
 begin
-  do_write:=-1;
+  do_write:=0;
+  if (len<=0) or (h=-1) then
+    exit;
+
+  dosResult:=h68kdos_write(h, addr, len);
+  if dosResult < 0 then
+    begin
+      Error2InOutRes(dosResult);
+    end
+  else
+    do_write:=dosResult;
 end;
 
 

rtl/human68k/sysheap.inc

@@ -20,10 +20,12 @@
 
 function SysOSAlloc(size: ptruint): pointer;
 begin
+  SysOSAlloc:=h68kdos_malloc(size);
 end;
 
 {$define HAS_SYSOSFREE}
 
 procedure SysOSFree(p: pointer; size: ptruint);
 begin
+  h68kdos_mfree(p);
 end;

rtl/human68k/sysos.inc

@@ -15,6 +15,8 @@
 
  **********************************************************************}
 
+{$include h68kdos.inc}
+
 procedure Error2InOutRes(errno: longint);
 begin
 end;

rtl/human68k/system.pp

@@ -19,6 +19,7 @@ interface
 {$define FPC_IS_SYSTEM}
 {$define FPC_STDOUT_TRUE_ALIAS}
 {$define FPC_ANSI_TEXTFILEREC}
+{$define FPC_SYSTEM_EXIT_NO_RETURN}
 {$define FPC_HUMAN68K_USE_TINYHEAP}
 
 {$ifdef FPC_HUMAN68K_USE_TINYHEAP}
@@ -52,9 +53,9 @@ const
 
 const
     UnusedHandle    = -1;
-    StdInputHandle: longint = UnusedHandle;
-    StdOutputHandle: longint = UnusedHandle;
-    StdErrorHandle: longint = UnusedHandle;
+    StdInputHandle: longint = 0;
+    StdOutputHandle: longint = 1;
+    StdErrorHandle: longint = 2;
 
 var
     args: PChar;
@@ -138,10 +139,14 @@ end;
 {*****************************************************************************
                          System Dependent Exit code
 *****************************************************************************}
-procedure system_exit;
+procedure haltproc(e:longint); noreturn; external name '_haltproc';
+
+Procedure system_exit; noreturn;
 begin
+  haltproc(ExitCode);
 end;
 
+
 {*****************************************************************************
                          System Unit Initialization
 *****************************************************************************}