Added Cowgol Disk Image

- Credit and thanks to Ladislau Szilagyi.

Co-Authored-By: ladislau szilagyi <87603175+laci1953@users.noreply.github.com>

Source/Doc/ReadMe.md

@@ -214,6 +214,12 @@ please let me know if I missed you!
 * Bill Shen has contributed boot loaders for several of his
   systems.
 
+* Laszlo Szolnoki has contributed an EF9345 video display
+  controller driver.
+
+* Ladislau Szilagyi has contributed an enhanced version of
+  CP/M Cowgol that leverages RomWBW memory banking.
+
 Contributions of all kinds to RomWBW are very welcome.
 
 # Licensing

Source/Doc/UserGuide.md

@@ -4017,6 +4017,12 @@ please let me know if I missed you!
 * Bill Shen has contributed boot loaders for several of his
   systems.
 
+* Laszlo Szolnoki has contributed an EF9345 video display
+  controller driver.
+
+* Ladislau Szilagyi has contributed an enhanced version of
+  CP/M Cowgol that leverages RomWBW memory banking.
+
 Contributions of all kinds to RomWBW are very welcome.
 
 # Licensing

Source/Images/Build.cmd

@@ -22,6 +22,8 @@ call BuildDisk.cmd tpascal hd wbw_fd144 || exit /b
 call BuildDisk.cmd bascomp hd wbw_fd144 || exit /b
 call BuildDisk.cmd fortran hd wbw_fd144 || exit /b
 call BuildDisk.cmd games hd wbw_fd144 || exit /b
+call BuildDisk.cmd cowgol hd wbw_fd144 || exit /b
+
 
 echo.
 echo Building Hard Disk Images (512 directory entry format)...
@@ -42,6 +44,7 @@ call BuildDisk.cmd tpascal hd wbw_hd512 || exit /b
 call BuildDisk.cmd bascomp hd wbw_hd512 || exit /b
 call BuildDisk.cmd fortran hd wbw_hd512 || exit /b
 call BuildDisk.cmd games hd wbw_hd512 || exit /b
+call BuildDisk.cmd cowgol hd wbw_hd512 || exit /b
 
 echo.
 echo Building Combo Disk (512 directory entry format) Image...
@@ -65,6 +68,7 @@ call BuildDisk.cmd tpascal hd wbw_hd1k || exit /b
 call BuildDisk.cmd bascomp hd wbw_hd1k || exit /b
 call BuildDisk.cmd fortran hd wbw_hd1k || exit /b
 call BuildDisk.cmd games hd wbw_hd1k || exit /b
+call BuildDisk.cmd cowgol hd wbw_hd1k || exit /b
 
 if exist ..\BPBIOS\bp*.rel call BuildDisk.cmd bp hd wbw_hd1k ..\zsdos\zsys_wbw.sys || exit /b
 

Source/Images/Makefile

@@ -7,18 +7,19 @@ FDIMGS = fd144_cpm22.img fd144_zsdos.img fd144_nzcom.img \
 	fd144_cpm3.img fd144_zpm3.img fd144_ws4.img fd144_qpm.img \
 	fd144_z80asm.img fd144_aztecc.img fd144_hitechc.img \
 	fd144_bascomp.img fd144_fortran.img fd144_games.img \
-	fd144_tpascal.img
+	fd144_tpascal.img fd144_cowgol.img
 HD512IMGS = hd512_cpm22.img hd512_zsdos.img hd512_nzcom.img \
 	hd512_cpm3.img hd512_zpm3.img hd512_ws4.img
 HD512XIMGS = hd512_z80asm.img hd512_aztecc.img hd512_hitechc.img \
 	hd512_bascomp.img hd512_fortran.img hd512_games.img \
-	hd512_tpascal.img hd512_dos65.img hd512_qpm.img hd512_blank.img
-# HDIMGS += hd512_bp.img
+	hd512_tpascal.img hd512_dos65.img hd512_qpm.img \
+	hd512_cowgol.img hd512_blank.img
 HD1KIMGS = hd1k_cpm22.img hd1k_zsdos.img hd1k_nzcom.img \
 	hd1k_cpm3.img hd1k_zpm3.img hd1k_ws4.img
 HD1KXIMGS = hd1k_z80asm.img hd1k_aztecc.img hd1k_hitechc.img \
 	hd1k_bascomp.img hd1k_fortran.img hd1k_games.img \
-	hd1k_tpascal.img hd1k_qpm.img hd1k_blank.img
+	hd1k_tpascal.img hd1k_qpm.img \
+	hd1k_cowgol.img hd1k_blank.img
 HD1KXIMGS += hd1k_bp.img
 
 HD512PREFIX =

Source/Images/d_cowgol/Readme.txt

@@ -0,0 +1,45 @@
+===== Cowgol 2.0 for CP/M =====
+
+This disk contains the Cowgol 2.0 compiler and related tools.
+These files were provided by Ladislau Szilagyi and were sourced
+from his GitHub repository at https://github.com/Laci1953/Cowgol_on_CP_M.
+
+The COWFE program included here is the RomWBW-specific version that
+is tailored to RomWBW memory management.
+
+The primary distribution site for Cowgol 2.0 is at
+https://github.com/davidgiven/cowgol.
+
+The Hi-Tech C compiler components were sourced from the updated
+version by Tony Nicholson at https://github.com/agn453/HI-TECH-Z80-C.
+However, the CPP.COM component was sourced from Ladislau Szilagyi's
+enhanced Hi-Tech C at https://github.com/Laci1953/HiTech-C-compiler-enhanced.
+
+Note that only the minimum required Hi-Tech C compiler components
+are provided.  Additional components from Hi-Tech C may be required
+depending on your needs.
+
+There are two example Cowgol applications included:
+
+- HEXDUMP is a simple hex dump utility and is purely a Cowgol
+  application (no assembler or C components).  The command
+  line to build the application is:
+
+    COWGOL HEXDUMP.COW
+
+- DYNMSORT demonstrates a sort algorithm and is composed of
+  Cowgol, C, and assembler components.  The command line to
+  build the application is:
+
+    COWGOL -LC DYNMSORT.COW MERGES.C RAND.AS
+
+There are also SUBMIT files provided to build the example
+applications which can be used as follows:
+
+    SUBMIT HEXDUMP
+    SUBMIT DYNMSORT
+
+-- WBW 12:38 PM 2/10/2024    
+
+    
+

Source/Images/d_cowgol/u0/ARGV.COH

@@ -0,0 +1,48 @@
+var argv_pointer: [uint8];
+
+sub ArgvInit() is
+	argv_pointer := 0x81 as [uint8];
+	[argv_pointer + [0x80 as [uint8]] as intptr] := 0;
+end sub;
+
+# Returns null is there's no next argument.
+sub ArgvNext(): (arg: [uint8]) is
+	# No more arguments?
+
+	if argv_pointer == (0 as [uint8]) then
+		arg := argv_pointer;
+		return;
+	end if;
+
+	# Skip leading whitespace.
+
+	var c: uint8;
+	loop
+		c := [argv_pointer];
+		if c != ' ' then
+			break;
+		end if;
+		argv_pointer := argv_pointer + 1;
+	end loop;
+
+	arg := argv_pointer;
+
+	# Skip to end of word and terminate.
+
+	loop
+		c := [argv_pointer];
+		if (c == ' ') or (c == '\n') or (c == 0) then
+			break;
+		end if;
+		argv_pointer := argv_pointer + 1;
+	end loop;
+	[argv_pointer] := 0;
+
+	if c == ' ' then
+		argv_pointer := argv_pointer + 1;
+	else
+		argv_pointer := 0 as [uint8];
+	end if;
+end sub;
+
+

Source/Images/d_cowgol/u0/COMMFILE.COH

@@ -0,0 +1,27 @@
+sub FCBPutString(fcb: [FCB], s: [uint8]) is
+	loop
+		var c := [s];
+		if c == 0 then
+			break;
+		end if;
+		FCBPutChar(fcb, c);
+		s := @next s;
+	end loop;
+end sub;
+
+sub FCBGetBlock(fcb: [FCB], buffer: [uint8], length: intptr) is
+	while length != 0 loop;
+		[buffer] := FCBGetChar(fcb);
+		buffer := buffer + 1;
+		length := length - 1;
+	end loop;
+end sub;
+
+sub FCBPutBlock(fcb: [FCB], buffer: [uint8], length: intptr) is
+	while length != 0 loop;
+		FCBPutChar(fcb, [buffer]);
+		buffer := buffer + 1;
+		length := length - 1;
+	end loop;
+end sub;
+

Source/Images/d_cowgol/u0/COMMON.COH

@@ -0,0 +1,150 @@
+sub print(ptr: [uint8]) is
+    loop
+        var c := [ptr];
+        if c == 0 then
+            return;
+        end if;
+        print_char(c);
+        ptr := ptr + 1;
+    end loop;
+end sub;
+
+sub print_nl() is
+	print_char('\n');
+end sub;
+
+sub UIToA(value: uint32, base: uint8, buffer: [uint8]): (ptr: [uint8]) is
+	ptr := buffer;
+	loop
+		var rem := value % (base as uint32);
+		value := value / (base as uint32);
+		if rem < 10 then
+			rem := rem + '0';
+		else
+			rem := rem + ('a' - 10);
+		end if;
+		[ptr] := rem as uint8;
+		ptr := @next ptr;
+
+		if value == 0 then
+			break;
+		end if;
+	end loop;
+
+	var s1 := buffer;
+	var s2 := @prev ptr;
+	while s2 > s1 loop
+		var c := [s1];
+		[s1] := [s2];
+		[s2] := c;
+		s1 := @next s1;
+		s2 := @prev s2;
+	end loop;
+
+	[ptr] := 0;
+end sub;
+
+sub IToA(value: int32, base: uint8, buffer: [uint8]): (ptr: [uint8]) is
+	if value < 0 then
+		[buffer] := '-';
+		buffer := @next buffer;
+		value := -value;
+	end if;
+	ptr := UIToA(value as uint32, base, buffer);
+end sub;
+
+sub print_i32(value: uint32) is
+    var buffer: uint8[12];
+	var pe := UIToA(value, 10, &buffer[0]);
+	print(&buffer[0]);
+end sub;
+
+sub print_i16(value: uint16) is
+    print_i32(value as uint32);
+end sub;
+
+sub print_i8(value: uint8) is
+    print_i32(value as uint32);
+end sub;
+
+sub print_hex_i8(value: uint8) is
+    var i: uint8 := 2;
+    loop
+        var digit := value >> 4;
+        if digit < 10 then
+            digit := digit + '0';
+        else
+            digit := digit + ('a' - 10);
+        end if;
+        print_char(digit);
+        value := value << 4;
+        i := i - 1;
+        if i == 0 then
+            break;
+        end if;
+    end loop;
+end sub;
+
+sub print_hex_i16(value: uint16) is
+    print_hex_i8((value >> 8) as uint8);
+    print_hex_i8(value as uint8);
+end sub;
+
+sub print_hex_i32(value: uint32) is
+    print_hex_i8((value >> 24) as uint8);
+    print_hex_i8((value >> 16) as uint8);
+    print_hex_i8((value >> 8) as uint8);
+    print_hex_i8(value as uint8);
+end sub;
+
+sub AToI(buffer: [uint8]): (result: int32, ptr: [uint8]) is
+	var negative: uint8 := 0;
+	var base: uint8 := 10;
+	ptr := buffer;
+	result := 0;
+	
+	var c := [ptr];
+	if (c == '-') then
+		negative := 1;
+		ptr := ptr + 1;
+		c := [ptr];
+	end if;
+	if (c == '0') then
+		case [ptr+1] is
+			when 'x':  base := 16;
+			when 'o':  base := 8;
+			when 'b':  base := 2;
+			when 'd':  base := 10;
+
+			when else: ptr := ptr - 2;
+		end case;
+		ptr := ptr + 2;
+		c := [ptr];
+	end if;
+
+	loop
+		if c >= 'a' then
+			c := c - 'a' + 10;
+		elseif c >= 'A' then
+			c := c - 'A' + 10;
+		else
+			c := c - '0';
+		end if;
+		if c >= (base as uint8) then
+			break;
+		end if;
+		result := (result * base as int32) + (c as int32);
+
+		ptr := ptr + 1;
+		c := [ptr];
+	end loop;
+
+	if negative != 0 then
+		result := -result;
+	end if;
+end sub;
+
+sub MemZero(ptr: [uint8], size: intptr) is
+	MemSet(ptr, 0, size);
+end sub;
+

Source/Images/d_cowgol/u0/COWGOL.COH

@@ -0,0 +1,52 @@
+var LOMEM: [uint8];
+@asm "ld hl, LOMEM";
+@asm "ld (", LOMEM, "), hl";
+
+var HIMEM: [uint8];
+@asm "ld hl, (6)";
+@asm "ld (", HIMEM, "), hl";
+
+sub Exit() is
+	@asm "rst 0";
+end sub;
+
+sub ExitWithError() is
+	@asm "rst 0";
+end sub;
+
+sub AlignUp(in: intptr): (out: intptr) is
+	out := in;
+end sub;
+
+sub get_char(): (c: uint8) is
+	@asm "ld c, 1";
+	@asm "call 5";
+	@asm "ld (", c, "), a";
+end sub;
+
+sub print_char(c: uint8) is
+	if c == 10 then
+		@asm "ld e, 13";
+		@asm "ld c, 2";
+		@asm "call 5";
+	end if;
+	@asm "ld a, (", c, ")";
+	@asm "ld e, a";
+	@asm "ld c, 2";
+	@asm "call 5";
+end sub;
+
+sub MemSet(buf: [uint8], byte: uint8, len: uint16) is
+	var bufend := buf + len;
+	loop
+		if buf == bufend then
+			return;
+		end if;
+		[buf] := byte;
+		buf := buf + 1;
+	end loop;
+end sub;
+
+include "common.coh";
+
+

Source/Images/d_cowgol/u0/COWGOLC.COH

@@ -0,0 +1,52 @@
+var LOMEM: [uint8];
+@asm "ld hl, __Hbss";
+@asm "ld (", LOMEM, "), hl";
+
+var HIMEM: [uint8];
+@asm "ld hl, (6)";
+@asm "ld (", HIMEM, "), hl";
+
+sub Exit() is
+	@asm "rst 0";
+end sub;
+
+sub ExitWithError() is
+	@asm "rst 0";
+end sub;
+
+sub AlignUp(in: intptr): (out: intptr) is
+	out := in;
+end sub;
+
+sub get_char(): (c: uint8) is
+	@asm "ld c, 1";
+	@asm "call 5";
+	@asm "ld (", c, "), a";
+end sub;
+
+sub print_char(c: uint8) is
+	if c == 10 then
+		@asm "ld e, 13";
+		@asm "ld c, 2";
+		@asm "call 5";
+	end if;
+	@asm "ld a, (", c, ")";
+	@asm "ld e, a";
+	@asm "ld c, 2";
+	@asm "call 5";
+end sub;
+
+sub MemSet(buf: [uint8], byte: uint8, len: uint16) is
+	var bufend := buf + len;
+	loop
+		if buf == bufend then
+			return;
+		end if;
+		[buf] := byte;
+		buf := buf + 1;
+	end loop;
+end sub;
+
+include "common.coh";
+
+

Source/Images/d_cowgol/u0/DYNMSORT.COW

@@ -0,0 +1,78 @@
+################################
+#        Cowgol program        #
+#                              #
+# Sorting 1000 random integers #
+# stored in a vector allocated #
+# using Cowgol's Alloc         #
+#                              #
+# calls:                       #
+#  assembler routine xrndseed  #
+#  assembler routine xrnd      #
+#  C routine mergeSort         #
+#                              #
+# Ladislau Szilagyi, Nov. 2023 #
+################################
+
+include "cowgolc.coh";
+include "strings.coh";
+include "malloc.coh";
+
+typedef intstring is [uint16];
+
+var Unsorted: intstring;
+var size: uint16 := 999;
+ 
+sub random(): (n: uint16) is
+  @asm "call _xrnd"; 			#calls assembler routine
+  @asm "ld (", n, "),hl";
+end sub;
+
+sub PrintArray(array: intstring) is
+  var i: uint16 := 0;
+  var p := array;
+  print("\r\nArray:\r\n");
+  while i != 1000 loop
+    print_i16([p]);
+    print(",");
+    p := p + 2;
+    i := i + 1;
+  end loop;
+end sub;
+
+sub PopulateArray(array: intstring) is
+  var i: uint16 := 0;
+  var p := array;
+  while i != 1000 loop
+    [p] := random();
+    p := p + 2;
+    i := i + 1;
+  end loop;
+end sub;
+
+sub RandSeed() is
+  @asm "call _xrndseed"; 		#calls assembler routine
+end sub;
+
+sub MergeSort() is
+  print("\r\nSorting...\r\n");
+  @asm "ld hl,(", size, ")";
+  @asm "push hl";			# r on stack as param # 3
+  @asm "ld hl,0";
+  @asm "push hl";			# l on stack as param # 2
+  @asm "ld hl,(", Unsorted, ")";
+  @asm "push hl";			# vector addr on stack as param # 1
+  @asm "call _mergeSort";		# calls C routine msort(int* array, int l, int r)
+  @asm "pop bc";			# drops C routine params
+  @asm "pop bc";			# drops C routine params
+  @asm "pop bc";			# drops C routine params
+end sub;
+
+### start ###
+
+RandSeed();
+Unsorted := Alloc(2000) as intstring;
+PopulateArray(Unsorted);
+PrintArray(Unsorted);
+MergeSort();
+PrintArray(Unsorted); # now is sorted !
+Exit();

Source/Images/d_cowgol/u0/DYNMSORT.SUB

@@ -0,0 +1,2 @@
+COWGOL -LC DYNMSORT.COW MERGES.C RAND.AS
+

Source/Images/d_cowgol/u0/FILE.COH

@@ -0,0 +1,200 @@
+# vim: ts=4 sw=4 et
+
+record CpmFCB is
+	dr: uint8;
+	f: uint8[11];
+	ex: uint8;
+	s1: uint8;
+	s2: uint8;
+	rc: uint8;
+	d: uint8[16];
+	cr: uint8;
+	r: uint16;
+	r2: uint8;
+end record;
+
+record FCB is
+	bufferptr: uint8; # byte just read
+	dirty: uint8;
+	cpm: CpmFCB;
+	buffer: uint8[128];
+end record;
+
+sub file_i_init(fcb: [FCB], filename: [uint8]) is
+	sub fill(dest: [uint8], src: [uint8], len: uint8): (srcout: [uint8]) is
+		loop
+			var c := [src];
+			if (c < 32) or (c == '.') then
+				c := ' ';
+			elseif (c == '*') then
+				c := '?';
+			else
+				src := src + 1;
+			end if;
+			if (c >= 'a') and (c <= 'z') then
+				c := c - ('a' - 'A');
+			end if;
+			[dest] := c;
+			dest := dest + 1;
+
+			len := len - 1;
+			if len == 0 then
+				break;
+			end if;
+		end loop;
+		srcout := src;
+	end sub;
+
+	MemSet(fcb as [uint8], 0, @bytesof FCB);
+	MemSet(&fcb.cpm.f[0] as [uint8], ' ', 11);
+	filename := fill(&fcb.cpm.f[0], filename, 8);
+
+	var c: uint8;
+	loop
+		c := [filename];
+		if (c < 32) or (c == '.') then
+			break;
+		end if;
+		filename := filename + 1;
+	end loop;
+
+	if c == '.' then
+		filename := fill(&fcb.cpm.f[8], filename+1, 3);
+	end if;
+
+	fcb.cpm.r := 0xffff;
+	fcb.bufferptr := 127;
+end sub;
+
+sub fcb_i_gbpb(fcb: [FCB], c: uint8) is
+	var cpmfcb := &fcb.cpm;
+	var dma := &fcb.buffer[0];
+
+	@asm "ld c, 26"; # SET DMA
+	@asm "ld de, (", dma, ")";
+	@asm "call 5";
+
+	@asm "ld a, (", c, ")";
+	@asm "ld c, a";
+	@asm "ld de, (", cpmfcb, ")";
+	@asm "call 5";
+end sub;
+
+sub fcb_i_blockin(fcb: [FCB]) is
+	MemSet(&fcb.buffer[0], 0, 128);
+	fcb_i_gbpb(fcb, 33); # READ RANDOM
+	fcb.dirty := 0;
+end sub;
+
+sub fcb_i_blockout(fcb: [FCB]) is
+	if fcb.dirty != 0 then
+		fcb_i_gbpb(fcb, 34); # WRITE RANDOM
+		fcb.dirty := 0;
+	end if;
+end sub;
+
+sub fcb_i_changeblock(fcb: [FCB], newblock: uint16) is
+	if newblock != fcb.cpm.r then
+		fcb_i_blockout(fcb);
+		fcb.cpm.r := newblock;
+		fcb_i_blockin(fcb);
+	end if;
+end sub;
+
+sub fcb_i_convert_a_to_error() is
+	@asm "cp 0xff";
+	@asm "ld a, 0";
+	@asm "ret nz";
+	@asm "inc a";
+end sub;
+
+sub FCBOpenIn(fcb: [FCB], filename: [uint8]): (errno: uint8) is
+	file_i_init(fcb, filename);
+
+	var cpmfcb := &fcb.cpm;
+	@asm "ld c, 15"; # OPEN_FILE
+	@asm "ld de, (", cpmfcb, ")";
+	@asm "call 5";
+	@asm "call", fcb_i_convert_a_to_error;
+	@asm "ld (", errno, "), a";
+end sub;
+
+sub FCBOpenUp(fcb: [FCB], filename: [uint8]): (errno: uint8) is
+	(errno) := FCBOpenIn(fcb, filename);
+end sub;
+
+sub FCBOpenOut(fcb: [FCB], filename: [uint8]): (errno: uint8) is
+	file_i_init(fcb, filename);
+
+	var cpmfcb := &fcb.cpm;
+	@asm "ld c, 19"; # DELETE_FILE
+	@asm "ld de, (", cpmfcb, ")";
+	@asm "call 5";
+
+	@asm "ld c, 22"; # CREATE_FILE
+	@asm "ld de, (", cpmfcb, ")";
+	@asm "call 5";
+	@asm "call", fcb_i_convert_a_to_error;
+	@asm "ld (", errno, "), a";
+end sub;
+	
+sub FCBClose(fcb: [FCB]): (errno: uint8) is
+	fcb_i_blockout(fcb);
+
+	var cpmfcb := &fcb.cpm;
+	@asm "ld c, 16"; # CLOSE_FILE
+	@asm "ld de, (", cpmfcb, ")";
+	@asm "call 5";
+	@asm "call", fcb_i_convert_a_to_error;
+	@asm "ld (", errno, "), a";
+end sub;
+
+sub FCBSeek(fcb: [FCB], pos: uint32) is
+	pos := pos - 1; # seek to *previous* character
+	var newblock := (pos >> 7) as uint16;
+	var newptr := (pos as uint8) & 127;
+	fcb_i_changeblock(fcb, newblock);
+	fcb.bufferptr := newptr;
+end sub;
+
+sub FCBPos(fcb: [FCB]): (pos: uint32) is
+	pos := (((fcb.cpm.r as uint32) << 7) | (fcb.bufferptr as uint32)) + 1;
+end sub;
+
+sub FCBExt(fcb: [FCB]): (len: uint32) is
+	var oldblock := fcb.cpm.r;
+	var cpmfcb := &fcb.cpm;
+
+	@asm "ld c, 16"; # CLOSE_FILE (actually flushing it to disk)
+	@asm "ld de, (", cpmfcb, ")";
+	@asm "call 5";
+
+	@asm "ld c, 35"; # COMPUTE FILE SIZE
+	@asm "ld de, (", cpmfcb, ")";
+	@asm "call 5";
+
+	len := ([&fcb.cpm.r as [uint32]] & 0x00ffffff) << 7;
+	fcb.cpm.r := oldblock;
+end sub;
+
+sub fcb_i_nextchar(fcb: [FCB]) is
+	fcb.bufferptr := fcb.bufferptr + 1;
+	if fcb.bufferptr == 128 then
+		fcb_i_changeblock(fcb, fcb.cpm.r + 1);
+		fcb.bufferptr := 0;
+	end if;
+end sub;
+
+sub FCBGetChar(fcb: [FCB]): (c: uint8) is
+	fcb_i_nextchar(fcb);
+	c := fcb.buffer[fcb.bufferptr];
+end sub;
+
+sub FCBPutChar(fcb: [FCB], c: uint8) is
+	fcb_i_nextchar(fcb);
+	fcb.buffer[fcb.bufferptr] := c;
+	fcb.dirty := 1;
+end sub;
+
+include "commfile.coh";
+

Source/Images/d_cowgol/u0/FILEIO.COH

@@ -0,0 +1,121 @@
+const FCB_FLAG_ERROR := 1<<0;
+const FCB_FLAG_READ := 1<<1;
+const FCB_FLAG_WRITE := 1<<2;
+
+record FCB: RawFCB is
+	pos: uint32;
+	buflen: FCBIndexType;
+	index: FCBIndexType;
+	buffer: uint8[FCB_BUFFER_SIZE];
+	flags: uint8;
+end record;
+
+@decl sub FCBRawRead(fcb: [FCB], pos: uint32, len: FCBIndexType): (amount: FCBIndexType);
+@decl sub FCBRawWrite(fcb: [FCB], pos: uint32, len: FCBIndexType);
+
+sub _fcb_init(fcb: [FCB]) is
+	fcb.pos := 0;
+	fcb.buflen := 0;
+	fcb.index := 0;
+	fcb.flags := 0;
+end sub;
+
+sub _fcb_advance(fcb: [FCB]) is
+	fcb.index := fcb.index + 1;
+end sub;
+
+sub _fcb_fillbuffer(fcb: [FCB]): (b: uint8) is
+	var bufpos := fcb.pos + (fcb.index as uint32);
+	fcb.buflen := FCBRawRead(fcb, bufpos, FCB_BUFFER_SIZE);
+	b := 0;
+	if (fcb.flags  & FCB_FLAG_ERROR) != 0 then
+		return;
+	end if;
+	fcb.flags := FCB_FLAG_READ;
+	fcb.pos := bufpos;
+	fcb.index := 0;
+	if fcb.buflen != 0 then
+		b := fcb.buffer[0];
+		_fcb_advance(fcb);
+	end if;
+end sub;
+
+sub FCBFlush(fcb: [FCB]) is
+	var bufpos := fcb.pos;
+	if (fcb.flags & FCB_FLAG_WRITE) != 0 then
+		FCBRawWrite(fcb, bufpos, fcb.index);
+		if (fcb.flags & FCB_FLAG_ERROR) != 0 then
+			return;
+		end if;
+	end if;
+	fcb.pos := bufpos + (fcb.index as uint32);
+	fcb.flags := 0;
+	fcb.index := 0;
+	fcb.buflen := 0;
+end sub;
+
+sub _fcb_flushbuffer(fcb: [FCB], b: uint8) is
+	FCBFlush(fcb);
+	if (fcb.flags  & FCB_FLAG_ERROR) != 0 then
+		return;
+	end if;
+	fcb.flags := FCB_FLAG_WRITE;
+	fcb.buffer[0] := b;
+	_fcb_advance(fcb);
+end sub;
+
+sub FCBGetChar(fcb: [FCB]): (b: uint8) is
+	if (fcb.flags & FCB_FLAG_WRITE) != 0 then
+		FCBFlush(fcb);
+	end if;
+	var i := fcb.index;
+	if i == fcb.buflen then
+		b := _fcb_fillbuffer(fcb);
+	else
+		b := fcb.buffer[i];
+		_fcb_advance(fcb);
+	end if;
+end sub;
+
+sub FCBPutChar(fcb: [FCB], b: uint8) is
+	if (fcb.flags & FCB_FLAG_READ) != 0 then
+		FCBFlush(fcb);
+	end if;
+	var i := fcb.index;
+	if i == FCB_BUFFER_SIZE then
+		_fcb_flushbuffer(fcb, b);
+	else
+		fcb.buffer[i] := b;
+		_fcb_advance(fcb);
+	end if;
+	fcb.flags := fcb.flags | FCB_FLAG_WRITE;
+end sub;
+
+sub FCBPos(fcb: [FCB]): (pos: uint32) is
+	pos := fcb.pos + (fcb.index as uint32);
+end sub;
+
+sub FCBError(fcb: [FCB]): (e: uint8) is
+	e := 0;
+	if (fcb.flags & FCB_FLAG_ERROR) != 0 then
+		e := 1;
+	end if;
+end sub;
+
+sub FCBSeek(fcb: [FCB], pos: uint32) is
+	var delta := pos - fcb.pos;
+	if (fcb.flags & FCB_FLAG_READ) != 0 then
+		if delta < (fcb.buflen as uint32) then
+			fcb.index := delta as FCBIndexType;
+			return;
+		end if;
+	elseif (fcb.flags & FCB_FLAG_WRITE) != 0 then
+		if delta <= (fcb.index as uint32) then
+			fcb.index := delta as FCBIndexType;
+			return;
+		end if;
+	end if;
+	FCBFlush(fcb);
+	fcb.pos := pos;
+end sub;
+

Source/Images/d_cowgol/u0/HEXDUMP.COW

@@ -0,0 +1,115 @@
+#
+# Copyright (c) 2020 Brian Callahan <bcallah@openbsd.org>
+#
+# Permission to use, copy, modify, and distribute this software for any
+# purpose with or without fee is hereby granted, provided that the above
+# copyright notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+#
+
+# Clone of Unix hexdump -C
+# Should work on all Cowgol systems
+
+include "stdcow.coh";
+include "argv.coh";
+
+var InputFile: FCB;
+
+var addr: uint32;
+var len: uint32;
+
+sub Hexdump() is
+	var buf: uint8[16];
+	var i: uint8;
+	var j: uint8;
+
+	print_hex_i32(addr);
+	print("  ");
+
+	i := 0;
+
+	loop
+		var c: uint8 := FCBGetChar(&InputFile);
+
+		buf[i] := c;
+		print_hex_i8(c);
+		print(" ");
+		if i == 7 then
+			print(" ");
+		end if;
+
+		i := i + 1;
+		len := len - 1;
+
+		if len == 0 or i > 15 then
+			break;
+		end if;
+	end loop;
+
+	addr := addr + (i as uint32);
+
+	var k: uint8 := i;
+	if len == 0 then
+		if i < 8 then
+			print(" ");
+		end if;
+
+		while i < 16 loop
+			print("   ");
+			buf[i] := ' ';
+			i := i + 1;
+		end loop;
+	end if;
+
+	print(" |");
+
+	j := 0;
+
+	while j < k loop
+		if buf[j] >= 0x20 and buf[j] <= 0x7e then
+			print_char(buf[j]);
+		else
+			print_char('.');
+		end if;
+
+		j := j + 1;
+	end loop;
+
+	print("|\n");
+end sub;
+
+ArgvInit();
+
+var FileName: [uint8] := ArgvNext();
+
+if FileName == (0 as [uint8]) then
+	print("usage: hexdump file\n");
+	ExitWithError();
+end if;
+
+if FCBOpenIn(&InputFile, FileName) != 0 then
+	print("hexdump: cannot open ");
+	print(FileName);
+	print("\n");
+	ExitWithError();
+end if;
+
+addr := 0;
+len := FCBExt(&InputFile);
+while len > 0 loop 
+	Hexdump();
+end loop;
+
+print_hex_i32(addr);
+print("\n");
+
+if FCBClose(&InputFile) != 0 then
+	ExitWithError();
+end if;

Source/Images/d_cowgol/u0/HEXDUMP.SUB

@@ -0,0 +1,2 @@
+COWGOL HEXDUMP.COW
+

Source/Images/d_cowgol/u0/MALLOC.COH

@@ -0,0 +1,237 @@
+record MallocFreeBlock is
+	next: [MallocFreeBlock];
+	size: intptr; # bytes
+end record;
+
+record MallocUsedBlock is
+	size: intptr; # bytes
+end record;
+
+var freeList: [MallocFreeBlock] := LOMEM as [MallocFreeBlock];
+freeList.next := 0 as [MallocFreeBlock];
+freeList.size := HIMEM - LOMEM;
+
+sub DumpBlocks() is
+	var p := freeList;
+	var bytes: intptr := 0;
+	print("* freelist: ");
+	print_hex_i32(p as intptr as uint32);
+	print_nl();
+	while p != (0 as [MallocFreeBlock]) loop
+		print("* block @");
+		print_hex_i32(p as intptr as uint32);
+		print("+");
+		print_hex_i32(p.size as intptr as uint32);
+		print("=");
+		print_hex_i32((p+p.size) as intptr as uint32);
+		print(" -> ");
+		print_hex_i32(p.next as intptr as uint32);
+		print_nl();
+
+		bytes := bytes + p.size;
+		p := p.next;
+	end loop;
+	print("* free bytes: ");
+	print_i32(bytes as intptr as uint32);
+	print_nl();
+	print_nl();
+end sub;
+
+sub CheckMemoryChain() is
+	var p := freeList;
+	while p != (0 as [MallocFreeBlock]) loop
+		var next := p.next;
+		if next == (0 as [MallocFreeBlock]) then
+			break;
+		end if;
+		if next <= p then
+			DumpBlocks();
+			print("bad chain: block ");
+			print_hex_i32(p as intptr as uint32);
+			print(" points at prior block ");
+			print_hex_i32(next as intptr as uint32);
+			print_nl();
+			ExitWithError();
+		end if;
+
+		p := p.next;
+	end loop;
+end sub;
+
+sub RawAlloc(length: intptr): (block: [uint8]) is
+	var totallength := AlignUp(length + @bytesof MallocUsedBlock);
+	if totallength < @bytesof MallocFreeBlock then
+		totallength := @bytesof MallocFreeBlock;
+	end if;
+
+	# Make sure everything's rounded to 8 bytes to try and reduce
+	# fragmentation.
+	totallength := (totallength + 7) & ~7;
+
+	# Fragmentation is a killer on small systems, so we use best fit.
+
+	var p := freeList;
+	var prev: [MallocFreeBlock] := 0 as [MallocFreeBlock];
+	var candidate: [MallocFreeBlock] := 0 as [MallocFreeBlock];
+	var cprev: [MallocFreeBlock] := 0 as [MallocFreeBlock];
+	var csize: intptr := -1;
+
+	# Try to find the smallest block which will fit.
+	while p != (0 as [MallocFreeBlock]) loop
+		var s := p.size;
+		if (s >= totallength) and (s < csize) then
+			candidate := p;
+			csize := s;
+			cprev := prev;
+			if csize == totallength then
+				# This is an exact fit. We can't do better than this, so stop here.
+				break;
+			end if;
+		end if;
+		prev := p;
+		p := p.next;
+	end loop;
+	if candidate == (0 as [MallocFreeBlock]) then
+		# Nothing was found.
+		block := 0 as [uint8];
+		return;
+	end if;
+
+	var delta := csize - totallength;
+	if delta < @bytesof MallocFreeBlock then
+		# Consume the entire block.
+		if cprev != (0 as [MallocFreeBlock]) then
+			cprev.next := candidate.next;
+		else
+			freeList := candidate.next;
+		end if;
+		totallength := csize;
+	else
+		# We found a hole bigger than we need. We shrink the hole and return
+		# what's left.
+		candidate.size := delta;
+		candidate := candidate + candidate.size;
+	end if;
+
+	#print("malloc ");
+	#print_hex_i32(candidate as intptr as uint32);
+	#print("+");
+	#print_hex_i32(totallength as uint32);
+	#print_nl();
+
+	var usedblock := candidate as [MallocUsedBlock];
+	usedblock.size := totallength;
+	block := (@next usedblock) as [uint8];
+
+	#print("malloc ");
+	#print_hex_i32(block as intptr as uint32);
+	#print("+");
+	#print_hex_i32(length as uint32);
+	#print_nl();
+
+	MemSet(block, 0, totallength - @bytesof MallocUsedBlock);
+	#CheckMemoryChain();
+end sub;
+
+sub Alloc(length: intptr): (block: [uint8]) is
+	block := RawAlloc(length);
+	if block == (0 as [uint8]) then
+		print("Out of memory");
+		ExitWithError();
+	end if;
+end sub;
+
+sub AddFreeBlock(start: [uint8], length: intptr) is
+	#print("free ");
+	#print_hex_i32(start as intptr as uint32);
+	#print("+");
+	#print_hex_i32(length as uint32);
+	#print_nl();
+
+	MemSet(start, 0xaa, length);
+
+	var h := start as [MallocFreeBlock];
+	h.size := length;
+
+	# freeList points at an ordered list of free blocks. First, we run
+	# through the list until we find the last block *before* this one.
+
+	var p := freeList;
+	if h < p then
+		# Special case: the new block will become the new *first* block.
+
+		if (h + h.size) == p then
+			h.size := length + p.size;
+			h.next := p.next;
+		else
+			h.next := p;
+		end if;
+		freeList := h;
+	else
+		# Otherwise, work through the list and find the block immediately
+		# preceding the one we're going to insert.
+
+		loop
+			# Is this the last block?
+
+			if p.next == (0 as [MallocFreeBlock]) then
+				# Insert the new block after it.
+
+				p.next := h;
+				h.next := 0 as [MallocFreeBlock];
+				break;
+			end if;
+
+			# We know that h cannot be before p, so if h is before the
+			# *next* block, then this must be the block preceding it.
+
+			if h < p.next then
+				# Try to merge the next block onto the end of h.
+
+				if (h + length) == p.next then
+					h.size := length + p.next.size;
+					h.next := p.next.next;
+				else
+					h.next := p.next;
+				end if;
+				p.next := h;
+				break;
+			end if;
+
+			p := p.next;
+		end loop;
+
+		# p now points at the preceding block. Try to merge h onto the
+		# end of it.
+
+		if (p + p.size) == h then
+			p.size := p.size + h.size;
+			p.next := h.next;
+		end if;
+	end if;
+
+	#CheckMemoryChain();
+end sub;
+
+sub Free(start: [uint8]) is
+	if start != (0 as [uint8]) then
+		var usedblock := @prev (start as [MallocUsedBlock]);
+		AddFreeBlock(usedblock as [uint8], usedblock.size);
+	end if;
+end sub;
+
+sub GetFreeMemory(): (bytes: intptr) is
+	bytes := 0;
+	var p := freeList;
+	while p != (0 as [MallocFreeBlock]) loop
+		bytes := bytes + p.size;
+		p := p.next;
+	end loop;
+end sub;
+
+sub StrDup(s: [uint8]): (news: [uint8]) is
+	var len := StrLen(s) + 1;
+	news := Alloc(len);
+	MemCopy(s, len, news);
+end sub;
+

Source/Images/d_cowgol/u0/MERGES.C

@@ -0,0 +1,78 @@
+ 
+int L[500], R[500];
+
+// Merges two subarrays of arr[].
+// First subarray is arr[l..m]
+// Second subarray is arr[m+1..r]
+void merge(int arr[], int l, int m, int r)
+{
+    int i, j, k;
+    int n1 = m - l + 1;
+    int n2 = r - m;
+ 
+    // Copy data to temp arrays L[] and R[]
+    for (i = 0; i < n1; i++)
+        L[i] = arr[l + i];
+
+    for (j = 0; j < n2; j++)
+        R[j] = arr[m + 1 + j];
+ 
+    // Merge the temp arrays back into arr[l..r
+    i = 0;
+    j = 0;
+    k = l;
+
+    while (i < n1 && j < n2) 
+    {
+        if (L[i] <= R[j]) 
+        {
+            arr[k] = L[i];
+            i++;
+        }
+        else
+        {
+            arr[k] = R[j];
+            j++;
+        }
+
+        k++;
+    }
+ 
+    // Copy the remaining elements of L[],
+    // if there are any
+    while (i < n1) 
+    {
+        arr[k] = L[i];
+        i++;
+        k++;
+    }
+ 
+    // Copy the remaining elements of R[],
+    // if there are any
+    while (j < n2) 
+    {
+        arr[k] = R[j];
+        j++;
+        k++;
+    }
+}
+ 
+// l is for left index and r is right index of the
+// sub-array of arr to be sorted
+// first call with l = 0, r = sizeof(arr) - 1
+void mergeSort(int arr[], int l, int r)
+{
+    int m;
+
+    if (l < r) 
+    {
+        m = l + (r - l) / 2;
+ 
+        // Sort first and second halves
+        mergeSort(arr, l, m);
+        mergeSort(arr, m + 1, r);
+ 
+        merge(arr, l, m, r);
+    }
+}
+

Source/Images/d_cowgol/u0/RAND.AS

@@ -0,0 +1,52 @@
+; Xorshift is a class of pseudorandom number generators discovered
+; by George Marsaglia and detailed in his 2003 paper, Xorshift RNGs.
+;
+; 16-bit xorshift pseudorandom number generator by John Metcalf
+; returns   hl = pseudorandom number
+; corrupts   a
+
+; generates 16-bit pseudorandom numbers with a period of 65535
+; using the xorshift method:
+
+; hl ^= hl << 7
+; hl ^= hl >> 9
+; hl ^= hl << 8
+
+; some alternative shift triplets which also perform well are:
+; 6, 7, 13; 7, 9, 13; 9, 7, 13.
+
+	psect	text
+
+	GLOBAL	_xrnd, _xrndseed
+
+_xrnd:
+	ld	hl,1		; seed must not be 0
+	ld	a,h
+	rra
+	ld	a,l
+	rra
+	xor	h
+	ld	h,a
+	ld	a,l
+	rra
+	ld	a,h
+	rra
+	xor	l
+	ld	l,a
+	xor	h
+	ld	h,a
+	ld	(_xrnd+1),hl
+	res	7,h		;make-it positive...
+	ret
+
+_xrndseed:
+	ld	a,r
+  	ld	l,a
+	ld	a,r
+	ld	h,a
+  	or	l		; HL must be not NULL
+  	jr	nz,1f
+	inc	hl
+1:
+	ld	(_xrnd+1),hl
+	ret

Source/Images/d_cowgol/u0/STDCOW.COH

@@ -0,0 +1,91 @@
+#
+# Copyright (c) 2020 Brian Callahan <bcallah@openbsd.org>
+#
+# Permission to use, copy, modify, and distribute this software for any
+# purpose with or without fee is hereby granted, provided that the above
+# copyright notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+#
+
+# Cowgol standard library
+
+# Uncomment these if you'd like to abstract the includes away.
+include "cowgol.coh";
+include "file.coh";
+include "strings.coh";
+include "malloc.coh";
+
+# Print a properly formatted 8-bit hex number to a file.
+sub FCBPutHex8(fcb: [FCB], number: uint8) is
+	var i: uint8 := 0;
+	var nibble: uint8;
+
+	while i < 2 loop
+		nibble := number >> 4;
+
+		if nibble < 10 then
+			nibble := nibble + '0';
+		else
+			nibble := nibble + ('A' - 10);
+		end if;
+
+		FCBPutChar(fcb, nibble);
+
+		number := number << 4;
+
+		i := i + 1;
+	end loop;
+end sub;
+
+# Print a properly formatted 16-bit hex number to a file.
+sub FCBPutHex16(fcb: [FCB], number: uint16) is
+	FCBPutHex8(fcb, ((number >> 8) as uint8));
+	FCBPutHex8(fcb, (number as uint8));
+end sub;
+
+# Print a properly formatted 32-bit hex number to a file.
+sub FCBPutHex32(fcb: [FCB], number: uint32) is
+	FCBPutHex16(fcb, ((number >> 16) as uint16));
+	FCBPutHex16(fcb, (number as uint16));
+end sub;
+
+# Print a signed 32-bit integer to the console.
+sub print_d32(value: int32) is
+	var buffer: uint8[12];
+	var pe := IToA(value, 10, &buffer[0]);
+	print(&buffer[0]);
+end sub;
+
+# Read in a string.
+sub GetString(): (s: [uint8]) is
+	var temp: uint8[256];
+	var c: uint8;
+	var i: uint8 := 0;
+
+	while i < 255 loop
+		c := get_char();
+		if c == 10 or c == 13 then
+			break;
+		end if;
+
+		temp[i] := c;
+
+		i := i + 1;
+	end loop;
+	temp[i] := 0;
+
+	if i == 0 then
+		s := (0 as [uint8]);
+		return;
+	end if;
+
+	s := Alloc(((i + 1) as intptr));
+	CopyString(&temp[0], s);
+end sub;

Source/Images/d_cowgol/u0/STRINGS.COH

@@ -0,0 +1,63 @@
+sub StrCmp(s1: [uint8], s2: [uint8]): (res: int8) is
+	loop
+		res := ([s1] - [s2]) as int8;
+		if (res != 0) or ([s1] == 0) then
+			break;
+		end if;
+		s1 := s1 + 1;
+		s2 := s2 + 1;
+	end loop;
+end sub;
+
+sub ToLower(c: uint8): (cc: uint8) is
+	if (c >= 'A') and (c <= 'Z') then
+		cc := c | 32;
+	else
+		cc := c;
+	end if;
+end sub;
+
+sub StrICmp(s1: [uint8], s2: [uint8]): (res: int8) is
+	loop
+		res := (ToLower([s1]) - ToLower([s2])) as int8;
+		if (res != 0) or ([s1] == 0) then
+			break;
+		end if;
+		s1 := s1 + 1;
+		s2 := s2 + 1;
+	end loop;
+end sub;
+
+sub StrLen(s: [uint8]): (size: intptr) is
+	var p := s;
+	loop
+		var c := [p];
+		if c == 0 then
+			break;
+		end if;
+		p := p + 1;
+	end loop;
+	size := p - s;
+end sub;
+
+sub CopyString(src: [uint8], dest: [uint8]) is
+	loop
+		var c := [src];
+		[dest] := c;
+		src := src + 1;
+		dest := dest + 1;
+		if c == 0 then
+			break;
+		end if;
+	end loop;
+end sub;
+
+sub MemCopy(src: [uint8], size: intptr, dest: [uint8]) is
+	while size != 0 loop
+		[dest] := [src];
+		dest := dest + 1;
+		src := src + 1;
+		size := size - 1;
+	end loop;
+end sub;
+

Source/ver.inc

@@ -2,7 +2,7 @@
 #DEFINE	RMN	5
 #DEFINE	RUP	0
 #DEFINE	RTP	0
-#DEFINE BIOSVER	"3.5.0-dev.10"
+#DEFINE BIOSVER	"3.5.0-dev.11"
 #define rmj	RMJ
 #define rmn	RMN
 #define rup	RUP

Source/ver.lib

@@ -3,5 +3,5 @@ rmn	equ	5
 rup	equ	0
 rtp	equ	0
 biosver	macro
-	db	"3.5.0-dev.10"
+	db	"3.5.0-dev.11"
 	endm