Add message for when chromium hard reload bug breaks things

I'm planning on adding symbolic constants to the assembler, so I won't
really have much use for immutable globals.

README.md

@@ -1,48 +1,107 @@
 # Wipforth
 
-## Building and Running
+Wipforth is a Forth implementation that runs in the WebAssembly
+virtual machine.  The system is bootstrapped from source on page load:
+the only non-text file is the favicon :)
 
-To run, first compile the WebAssembly module:
+I/O is done via memory-mapped peripherals, which are emulated in
+JavaScript.
+
+- For the Forth kernel, see [wipforth.ws](./wipforth.ws)
+- For the emulator, see [emu.js](./emu.js)
+- For the assembler, see [asm.js](./asm.js)
+- For the prelude (Forth code loaded right after the kernel boots),
+  see [prelude.f](./prelude.f)
+- For a description of the peripherals, see the
+  [Peripherals](#peripherals) section below.
+
+## Building and Running Locally
+
+There's a [Guile](https://www.gnu.org/software/guile/) script in the
+repo you can use for this:
 
 ```
-wat2wasm --enable-threads wipforth.wat
+guile server.scm
-```
-
-Then run the server:
-
-```
-python3 server.py
 ```
 
 You should then be able to open <http://localhost:8080> in a browser
 and use the system from there.
 
-**NOTE**: The server is just a very simple instantiation of Python's
+However, since everything is bootstrapped on the client, basically any
-built-in `http.server.HTTPServer`, configured to set the cross-origin
+HTTP server will do as long as it sets the appropriate response
-headers required for `SharedMemoryBuffer` use.  You could use any HTTP
+headers for `SharedArrayBuffer` use:
-server that sets these headers.
+
+- `Cross-Origin-Opener-Policy: same-origin`
+- `Cross-Origin-Embedder-Policy: require-corp`
+
+So, if you don't have Guile on your system you can use something else
+like Python's `http.server`.
+
+**NOTE**: You should **definitely not** use `server.scm` to serve the
+application on the open internet or anything like that; I just hacked
+it together for testing on localhost during development and it's
+probably hilariously insecure.
+
+## End-to-End Tests
+
+There's a (fairly minimal at the moment) end-to-end test suite defined
+in [tests.scm](./tests.scm).  To run it you'll need:
+
+- [Guile](https://www.gnu.org/software/guile/) again (no substitute
+  this time, sorry)
+- [guile-json](https://github.com/aconchillo/guile-json)
+- Firefox
+
+I'm also pretty sure it won't work on a non-POSIX system, though I
+haven't tried it.
+
+Given that's all sorted, you should be able to run:
+
+```
+guile tests.scm
+```
+
+It will print a JUnit XML report to standard out.  You can
+pretty-print it with `xmllint` if you have it installed:
+
+```
+guile tests.scm | xmllint --format -
+```
 
 ## Peripherals
 
-# Terminal
+### Terminal
 
-| Name   | Offset | Size / B | Access       |
+| Name   | Address | Size / B | Access       |
-|--------|--------|----------|--------------|
+|--------|---------|----------|--------------|
-| TXBUF  | 0      | 32       | write        |
+| TXBUF  | 000h    | 32       | write        |
-| RXBUF  | 32     | 32       | read         |
+| RXBUF  | 080h    | 32       | read         |
-| TXHEAD | 64     | 1        | atomic read  |
+| TXHEAD | 100h    | 4        | atomic read  |
-| TXTAIL | 65     | 1        | atomic write |
+| TXTAIL | 104h    | 4        | atomic write |
-| RXHEAD | 66     | 1        | atomic write |
+| RXHEAD | 108h    | 4        | atomic write |
-| RXTAIL | 67     | 1        | atomic read  |
+| RXTAIL | 10Ch    | 4        | atomic read  |
 
 For both sending (`TX`) and receiving (`RX`), there are three
 registers: `xBUF`, `xHEAD` and `xTAIL`:
 
-- `xBUF` registers are 32-byte FIFO ring buffers used for data
+- `xBUF` registers are 128-byte FIFO ring buffers used for data
 - The `xHEAD` and `xTAIL` registers specify the start and end of data
   in the ring buffer, `xHEAD` being the offset of the first byte of
-  data, and `xTAIL` being the offset of the first byte *after* the data.
+  data, and `xTAIL` being the offset of the first byte *after* the
+  data.
 
 In order to be distinguishable from the empty state, the ring buffers
 must never be completely full -- there must always be *at least one*
 unoccupied byte between the tail and the head.
+
+### System status
+
+| Name     | Address | Size / B | Access       |
+|----------|---------|----------|--------------|
+| SYSREADY | 110h    | 4        | atomic write |
+| SYSINTER | 114h    | 4        | atomic read  |
+
+The `SYSREADY` register is used to indicate when the system has booted
+up and is ready for user input.  `SYSINTER` is set (and notified on)
+once the emulator has enabled user input and the system is
+interactive.

boot.js

@@ -1,7 +1,26 @@
+import { Assembler } from './asm.js';
+
+const assemble = (async () => {
+	const asm = new Assembler();
+	const resp = await fetch('wipforth.ws');
+	for await (const chunk of resp.body) {
+		asm.push(chunk);
+	}
+	return asm.wasm();
+})();
+
 self.onmessage = async (e) => {
-	const exports = { emu: { mem: e.data } };
+	switch (e.data.type) {
-	const mod = await WebAssembly.instantiateStreaming(
+	case "load":
-		fetch('wipforth.wasm'), exports)
+		const exports = { emu: { mem: e.data.mem } };
-	mod.instance.exports.reset();
+		const wasm = await assemble;
+		self.mod = await WebAssembly.instantiate(wasm, exports);
+		await self.postMessage('ready');
+		break;
+
+	case "boot":
+		self.mod.instance.exports.reset();
 		console.log('System halt');
+		break;
+	}
 };

deploy-manifest.conf

@@ -0,0 +1,8 @@
+asm.js
+boot.js
+emu.js
+favicon.png
+index.html
+prelude.f
+styles.css
+wipforth.ws

e2e/marionette.scm

@@ -0,0 +1,139 @@
+(define-module (e2e marionette)
+  #:export (with-marionette
+			start-firefox
+			close-firefox
+			client-setup
+			client-teardown
+			navigate
+			input-line
+			get-display))
+
+(use-modules
+ (json)
+ (scheme base)
+ (srfi srfi-9))
+
+(define-syntax-rule (with-marionette client body ...)
+  (let ((client #f) (pid #f))
+	(dynamic-wind
+	  (lambda ()
+		(set! pid (start-firefox))
+		(set! client (client-setup)))
+	  (lambda () body ...)
+	  (lambda ()
+		(when client (client-teardown client))
+		(when pid (close-firefox pid))))))
+
+(define (start-firefox)
+  (let* ((profile-dir (mkdtemp "/tmp/marionette-XXXXXX"))
+		 (i/o (pipe))
+		 (pid (spawn "firefox"
+					 `("firefox" "--marionette" "--headless"
+					   "--profile" ,profile-dir "about:blank")
+					 #:output (cdr i/o)
+					 #:error (cdr i/o))))
+	(let loop ((line (read-line (car i/o))))
+	  (cond
+	   ((string-contains line "Listening on port") #nil)
+	   ((eof-object? line) (format #t "EOF when starting firefox~%"))
+	   (#t (loop (read-line (car i/o))))))
+	(close-port (car i/o))
+	(close-port (cdr i/o))
+	pid))
+
+(define (close-firefox pid)
+  (kill pid SIGINT)
+  (waitpid pid)
+  *unspecified*)
+
+(define-record-type client
+  (make-client socket msg-num)
+  client?
+  (socket client-socket)
+  (msg-num client-msg-num client-msg-num-set!))
+
+(define (client-msg-num-1+! client)
+  (client-msg-num-set! client (1+ (client-msg-num client))))
+
+(define (open-socket host port)
+  (let ((sock (socket PF_INET SOCK_STREAM 0))
+		(addr (inet-pton AF_INET host)))
+	(connect sock AF_INET addr port)
+	sock))
+
+(define (handle-start-msg client)
+  (let* ((msg (read-msg (client-socket client)))
+		 (protocol (assoc-ref msg "marionetteProtocol")))
+	(unless (= 3 protocol)
+	  (format #t "Unsupported protocol: ~a~%" protocol))))
+
+(define* (client-setup #:key (host "127.0.0.1") (port 2828))
+  (let ((client (make-client (open-socket host port) 0)))
+	(handle-start-msg client)
+	(create-session client)
+	client))
+
+(define (client-teardown client)
+  (close (client-socket client)))
+
+(define (add-digit val digit)
+  (+ (* val 10) (- digit 48)))
+
+(define (read-msg-len sock)
+  (let loop ((len 0) (byte (read-u8 sock)))
+	(if (eq? byte 58)
+		len
+		(loop (add-digit len byte)
+			  (read-u8 sock)))))
+
+(define (read-msg sock)
+  (let ((len (read-msg-len sock)))
+	(json-string->scm (utf8->string (read-bytevector len sock)))))
+
+(define (send-msg sock msg)
+  (let* ((payload (string->utf8 (scm->json-string msg)))
+		 (len (bytevector-length payload)))
+	(write-bytevector (string->utf8 (number->string len)) sock)
+	(write-u8 58 sock)
+	(write-bytevector payload sock)))
+
+(define (send-command client command params)
+  (send-msg (client-socket client)
+			(vector 0 (client-msg-num client) command params))
+  (client-msg-num-1+! client)
+  (let* ((response (read-msg (client-socket client)))
+		 (error (vector-ref response 2))
+		 (result (vector-ref response 3)))
+	(unless (eq? 'null error)
+	  (format #t "Error: ~a~%" (assoc-ref error "message")))
+	(assoc-ref result "value")))
+
+(define (create-session client)
+  (send-command client "WebDriver:NewSession" '())
+  *unspecified*)
+
+(define (navigate client url)
+  (send-command client "WebDriver:Navigate" `(("url" . ,url)))
+  *unspecified*)
+
+(define (find-element client selector)
+  (assoc-ref
+   (send-command client "WebDriver:FindElement"
+				 `(("using" . "css selector")
+				   ("value" . ,selector)))
+   "element-6066-11e4-a52e-4f735466cecf"))
+
+(define (send-keys client text)
+  (let ((id (find-element client "body")))
+	(send-command client "WebDriver:ElementSendKeys"
+				  `(("id" . ,id) ("text" . ,text)))))
+
+(define (get-element-text client selector)
+  (let ((id (find-element client selector)))
+	(send-command client "WebDriver:GetElementText" `(("id" . ,id)))))
+
+(define (input-line client text)
+  (send-keys client (string-append text "\ue007")))
+
+(define (get-display client)
+  (get-element-text client "#output"))

e2e/testing.scm

@@ -0,0 +1,71 @@
+(define-module (e2e testing)
+  #:export (assert define-test run-tests run-tests-with-cleanup))
+
+(use-modules
+ (sxml simple)
+ (srfi srfi-1))
+
+(define *tests* (make-fluid '()))
+
+(define (assert condition . args)
+  (unless condition
+	(let ((msg (if (null? args) "Assertion failed" (car args))))
+	  (raise-exception `(assertion-failed . ,msg)))))
+
+(define-syntax-rule (define-test name body ...)
+  (fluid-set!
+   *tests*
+   (append (fluid-ref *tests*)
+		   (list (cons 'name (lambda () body ...))))))
+
+(define (fail-handler ex)
+  (if (and (pair? ex) (eq? 'assertion-failed (car ex)))
+	  (cons 'fail (cdr ex))
+	  (cons 'error (format #f "~a" ex))))
+
+(define (run-test test)
+  (cons (car test)
+		(with-exception-handler fail-handler
+		  (lambda ()
+			((cdr test))
+			'pass)
+		  #:unwind? #t)))
+
+(define (fail? result)
+  (and (pair? (cdr result))
+	   (eq? 'fail (cadr result))))
+
+(define (error? result)
+  (and (pair? (cdr result))
+	   (eq? 'error (cadr result))))
+
+(define (test-junit-report result)
+  `(testcase
+	(@ (name ,(symbol->string (car result))))
+	,@(cond
+	   ((fail? result) `((failure (@ (message ,(cddr result))))))
+	   ((error? result) `((error (@ (message ,(cddr result))))))
+	   (#t '()))))
+
+(define (junit-report results fails errors)
+  (let ((count (length results)))
+	`(testsuites
+	  (testsuite
+	   (@ (name "wipforth e2e")
+		  (tests ,count)
+		  (failures ,fails)
+		  (errors ,errors))
+	   ,@(map test-junit-report results)))))
+
+(define (run-tests)
+  (let* ((results (map run-test (fluid-ref *tests*)))
+		 (fails (length (filter fail? results)))
+		 (errors (length (filter error? results))))
+	(sxml->xml (junit-report results fails errors))
+	(exit (if (= (+ fails errors) 0) 0 1))))
+
+(define-syntax-rule (run-tests-with-cleanup body ...)
+  (dynamic-wind
+	(lambda () #f)
+	run-tests
+	(lambda () body ...)))

emu.js

@@ -1,18 +1,19 @@
-const TXBUF = 0;
+const TXBUF = 0x000;
-const RXBUF = 32;
+const RXBUF = 0x080;
-const TXHEAD = 64;
+const TXHEAD = 0x100;
-const TXTAIL = 65;
+const TXTAIL = 0x104;
-const RXHEAD = 66;
+const RXHEAD = 0x108;
-const RXTAIL = 67;
+const RXTAIL = 0x10c;
 
-const TXBUF_SIZE = 32;
+const SYSREADY = 0x110;
-const RXBUF_SIZE = 32;
+const SYSINTER = 0x114;
-const PERIPHS_SIZE = 68;
 
-const POLL_INTERVAL_MS = 20;
+const PERIPHS_SIZE = 0x200;
+
+const POLL_INTERVAL_MS = 5;
+const DOT_INTERVAL_MS = 25;
 
 const COLS = 80;
-const ROWS = 36;
 const TAB_WIDTH = 8;
 
 const CURSOR_IDLE_TIME_MS = 1000;
@@ -27,6 +28,7 @@ class Emulator {
 		this.mem_u8 = new Uint8Array(this.mem.buffer);
 		for (let i = 0; i < PERIPHS_SIZE; ++i)
 			this.mem_u8[i] = 0;
+		this.mem_i32 = new Int32Array(this.mem.buffer);
 
 		this.decoder = new TextDecoder('utf-8');
 		this.encoder = new TextEncoder('utf-8');
@@ -35,8 +37,9 @@ class Emulator {
 		this.rx_queue = [];
 		this.timer = setInterval(() => this.poll(), POLL_INTERVAL_MS);
 
+		this.rows = this.max_rows();
 		this.grid = Array.from(
-			{ length: ROWS },
+			{ length: this.rows },
 			() => new Array(COLS).fill(' '));
 		this.cursor = { x: 0, y: 0 };
 		this.range = {
@@ -44,13 +47,30 @@ class Emulator {
 			end: { x: 0, y: 0 }
 		};
 		this.idle_timer = null;
+		this.input_enable = false;
 		document.addEventListener('keydown', (e) => this.handle_keydown(e));
+		window.addEventListener('resize', () => this.handle_resize());
 
-		this.flush_output();
+		this.forth = new Worker('boot.js', { type: 'module' });
-		document.getElementById('cursor').classList.add('blinking');
 
-		this.worker = new Worker('boot.js');
+		this.print("Assembling kernel ");
-		this.worker.postMessage(this.mem);
+		this.dots = setInterval(() => this.print("."), DOT_INTERVAL_MS);
+		this.forth.postMessage({ type: "load", mem: this.mem });
+		this.forth.onmessage = (e) => {
+			clearInterval(this.dots);
+			this.print(" done\n");
+
+			this.print("Loading prelude ");
+			this.forth.postMessage({ type: "boot" });
+			this.dots = setInterval(() => this.print("."), DOT_INTERVAL_MS);
+		};
+
+		fetch('prelude.f')
+			.then(res => res.text())
+			.then(text => {
+				for (const cu of this.encoder.encode(text))
+					this.rx_queue.push(cu);
+			});
 	}
 
 	poll() {
@@ -65,10 +85,25 @@ class Emulator {
 			if (this.fifo_next(rxtail) != rxhead)
 				this.handle_rx_data(rxhead, rxtail);
 		}
+
+		if (!this.input_enable) {
+			const sysready = Atomics.load(this.mem_u8, SYSREADY);
+			if (sysready != 0) {
+				clearInterval(this.dots);
+				this.print(" done\n");
+
+				Atomics.store(this.mem_u8, SYSINTER, 1);
+				Atomics.notify(this.mem_i32, SYSINTER / 4);
+
+				this.input_enable = true;
+				this.blink = true;
+				this.flush_output();
+			}
+		}
 	}
 
 	fifo_next(idx) {
-		return (idx + 1) & 0x1f;
+		return (idx + 1) & 0x7f;
 	}
 
 	handle_tx_data(head, tail) {
@@ -87,6 +122,7 @@ class Emulator {
 			tail = this.fifo_next(tail);
 		} while (this.fifo_next(tail) != head && this.rx_queue.length != 0);
 		Atomics.store(this.mem_u8, RXTAIL, tail);
+		Atomics.notify(this.mem_i32, RXTAIL / 4);
 	}
 
 	print(str) {
@@ -118,12 +154,17 @@ class Emulator {
 	}
 
 	handle_keydown(e) {
+		if (!this.input_enable)
+			return;
+
 		if (e.key.length == 1 && !e.ctrlKey && !e.altKey && !e.metaKey) {
 			this.shift_up(this.cursor);
 			this.grid[this.cursor.y][this.cursor.x] = e.key;
 			this.cursor_move(1, 0);
 		} else if (e.key == 'Enter') {
 			this.cursor.y = this.range.end.y + 1;
+			while (this.cursor.y >= this.rows)
+				this.scroll();
 			this.cursor.x = 0;
 			this.submit_line();
 			Object.assign(this.range.start, this.cursor);
@@ -150,12 +191,14 @@ class Emulator {
 		}
 
 		e.preventDefault();
+		this.blink = false;
 		this.flush_output();
 
 		document.getElementById('cursor').classList.remove('blinking');
 		if (this.idle_timer)
 			clearTimeout(this.idle_timer);
 		this.idle_timer = setTimeout(() => {
+			this.blink = true;
 			document.getElementById('cursor').classList.add('blinking');
 		}, CURSOR_IDLE_TIME_MS);
 	}
@@ -208,7 +251,7 @@ class Emulator {
 	next_cell(cell) {
 		if (cell.x < COLS - 1)
 			return { x: cell.x + 1, y: cell.y };
-		else if (cell.y < ROWS - 1)
+		else if (cell.y < this.rows - 1)
 			return { x: 0, y: cell.y + 1 };
 		else
 			return null;
@@ -221,6 +264,8 @@ class Emulator {
 			this.grid[cell.y][cell.x] = this.grid[prev.y][prev.x];
 			cell = prev;
 		}
+		if (this.next_cell(this.range.end) == null)
+			this.scroll();
 		this.range.end = this.next_cell(this.range.end);
 	}
 
@@ -239,11 +284,14 @@ class Emulator {
 		const html = this.grid.map((row, y) => {
 			return row.map((c, x) => {
 				const ec = this.html_escape(c);
-				if (x == this.cursor.x && y == this.cursor.y)
+				if (this.input_enable
-					return '<span id="cursor">' + ec + '</span>';
+					&& x == this.cursor.x && y == this.cursor.y) {
-				else
+					const cl = this.blink ? 'class="blinking"' : '';
+					return `<span id="cursor" ${cl}>` + ec + '</span>';
+				} else {
 					return ec;
-			}).join('');
+				}
+			}).join('').trimEnd();
 		}).join('\n');
 		this.output.innerHTML = html;
 	}
@@ -264,9 +312,51 @@ class Emulator {
 			return c;
 		}
 	}
+
+	scroll() {
+		this.grid.shift()
+		this.grid.push(new Array(COLS).fill(' '));
+		this.cursor.y -= 1;
+		this.range.start.y -= 1;
+		this.range.end.y -= 1;
+	}
+
+	max_rows() {
+		const style = getComputedStyle(this.output);
+		const line_height = parseFloat(style.lineHeight);
+		const margin_top = parseFloat(style.marginTop);
+		const margin_bottom = parseFloat(style.marginBottom);
+
+		const viewport_height = window.innerHeight;
+		const output_height = viewport_height - margin_top - margin_bottom;
+		return Math.floor(output_height / line_height) - 1;
+	}
+
+	handle_resize() {
+		this.rows = this.max_rows();
+		while (this.grid.length < this.rows)
+			this.grid.push(new Array(COLS).fill(' '));
+		while (this.grid.length > this.rows) {
+			this.grid.shift()
+			this.cursor.y -= 1;
+			this.range.start.y -= 1;
+			this.range.end.y -= 1;
+		}
+		this.flush_output();
+	}
 }
 
 window.addEventListener('DOMContentLoaded', () => {
-	document.getElementById('output').innerText = '';
+	const output = document.getElementById('output');
+	output.innerText = '';
+
+	if (!self.crossOriginIsolated) {
+		output.innerText = "Yeah so there's this thing where Chromium ends "
+			+ "up ignoring COOP/COEP\nheaders after a hard reload "
+			+ "sometimes, and I haven't been able to\nfigure out how to "
+			+ "work around it yet.  If you just wait a little while\nand "
+			+ "then reload normally then hopefully it should work haha";
+	} else {
 		window.emu = new Emulator();
+	}
 });

index.html

@@ -3,11 +3,11 @@
   <head>
 	<title>Wipforth</title>
 	<link rel="stylesheet" type="text/css" href="styles.css"/>
+	<link rel="icon" type="image/png" href="favicon.png"/>
   </head>
   <body>
 	<script type="text/javascript" src="emu.js"></script>
-	<div id="output">I'm afraid you need javascript enabled for this to work :(
+	<div id="output"><noscript>I'm afraid you need javascript enabled for this to work :(
 
-cringe, I know... but I promise there are no frameworks&#8482;</div>
+cringe, I know... but I promise there are no frameworks&#8482;</noscript></div></body>
-  </body>
 </html>

prelude.f

@@ -0,0 +1,254 @@
+: \ KEY 10 = 0BRANCH [ -20 , ] ; IMMEDIATE \ Now we have line comments :)
+
+\ Conditionals
+
+: IF
+  LIT 0BRANCH ,
+  HERE @ 0 ,
+; IMMEDIATE
+
+: THEN
+  DUP HERE @ SWAP -
+  SWAP !
+; IMMEDIATE
+
+: ELSE
+  LIT BRANCH ,
+  HERE @ 0 ,
+  SWAP
+  DUP HERE @ SWAP -
+  SWAP !
+; IMMEDIATE
+
+\ Loops
+
+: BEGIN HERE @ ; IMMEDIATE
+
+: UNTIL
+  LIT 0BRANCH ,
+  HERE @ - ,
+; IMMEDIATE
+
+: AGAIN
+  LIT BRANCH ,
+  HERE @ - ,
+; IMMEDIATE
+
+\ Recursive calls
+
+: RECURSE LATEST @ >CFA , ; IMMEDIATE
+
+\ Block comments (with nesting)
+
+: (
+  BEGIN
+    KEY DUP
+    40 = IF RECURSE THEN
+    41 =
+  UNTIL
+; IMMEDIATE
+
+( ( Take that, C ) )
+
+\ Printing utilities
+
+: CR 10 EMIT ;
+: SPACE 32 EMIT ;
+
+: CHAR
+  KEY
+  STATE @ 0<> IF
+	LIT LIT , , \ Append LIT <key> to definition if compiling
+  THEN
+; IMMEDIATE
+
+: EMIT-DIGIT
+  DUP 10 < IF CHAR 0 ELSE 10 - CHAR A THEN
+  + EMIT
+;
+
+: .
+  \ Handle negatives
+  DUP 0< IF CHAR - EMIT NEGATE THEN
+
+  \ Determine starting place value
+  1 BEGIN BASE @ * 2DUP / 0= UNTIL
+
+  \ Print leading non-zero digits
+  BEGIN
+	BASE @ /
+	2DUP / EMIT-DIGIT
+	TUCK MOD SWAP
+	OVER 0=
+  UNTIL
+
+  \ Print any trailing zeros
+  BASE @ /
+  DUP 0<> IF
+    BEGIN
+      CHAR 0 EMIT
+      BASE @ /
+      DUP 0=
+    UNTIL
+  THEN
+
+  2DROP
+;
+
+: TYPE ( addr len -- )
+  BEGIN
+	DUP 0= IF 2DROP EXIT THEN
+	SWAP DUP C@ EMIT 1+
+	SWAP 1-
+  AGAIN
+;
+
+: C, HERE @ C! 1 HERE +! ;
+
+: ."
+  STATE @ IF
+	LIT BRANCH , \ Compile BRANCH for jumping over string data
+	HERE @ 0 ,   \ Compile placeholder offset and push offset cell address
+	0 BEGIN
+	  KEY
+	  DUP CHAR " = IF
+		DROP
+		HERE @ ALIGN HERE !    \ Pad to alignment
+		SWAP DUP HERE @ SWAP - \ Compute offset
+		OVER !                 \ Update branch offset to skip data
+		4+ LIT LIT , ,         \ Append LIT <addr>
+		LIT LIT , ,            \ Append LIT <len>
+		LIT TYPE ,             \ Append TYPE
+		EXIT
+	  THEN
+	  C, 1+       \ Write byte and increment length
+	AGAIN
+  ELSE
+	BEGIN
+	  KEY
+	  DUP CHAR " = IF DROP EXIT THEN
+	  EMIT
+	AGAIN
+  THEN
+; IMMEDIATE
+
+\ Misc utilities
+
+: NIP SWAP DROP ;
+
+: HEX 16 BASE ! ;
+
+: DECIMAL 10 BASE ! ;
+
+: '
+  WORD FIND DUP 0<> IF
+	>CFA
+  ELSE
+	DROP WNFHOOK EXECUTE
+  THEN
+;
+
+: [COMPILE] ' , ; IMMEDIATE
+
+\ Constants, variables and values
+
+: CONSTANT
+  WORD CREATE
+  DOCOL ,
+  LIT LIT ,
+  ,
+  LIT EXIT ,
+;
+
+: VARIABLE
+  WORD CREATE
+  DOVAR ,
+  0 ,
+;
+
+: VALUE
+  WORD CREATE
+  DOVAL , ,
+;
+
+: TO
+  ' 4+
+  STATE @ IF
+	LIT LIT , ,
+	LIT ! ,
+  ELSE
+	!
+  THEN
+; IMMEDIATE
+
+\ Peripheral register addresses
+
+HEX
+
+000 CONSTANT TXBUF
+080 CONSTANT RXBUF
+100 CONSTANT TXHEAD
+104 CONSTANT TXTAIL
+108 CONSTANT RXHEAD
+10C CONSTANT RXTAIL
+110 CONSTANT SYSREADY
+114 CONSTANT SYSINTER
+
+DECIMAL
+
+\ A better word-not-found handler
+
+: ANY-RX? RXHEAD AC@ RXTAIL AC@ <> ;
+
+: WNF-HANDLER
+  ." Unknown word: "
+  WORDBUF SWAP TYPE CR
+  STATE @ IF
+	\ Remove incomplete definition and switch back to interpret mode
+	LATEST @ HERE !
+	LATEST @ @ LATEST !
+	[COMPILE] [
+  THEN
+  \ We only consume to the next newline if there is RX data available,
+  \ because if the offending word was at the end of the line then the
+  \ newline would have already been consumed by WORD.
+  ANY-RX? IF BEGIN KEY 10 = UNTIL THEN
+  QUIT
+;
+
+' WNF-HANDLER TO WNFHOOK
+
+\ Version number
+
+0 CONSTANT VERSION-MAJOR
+2 CONSTANT VERSION-MINOR
+2 CONSTANT VERSION-PATCH
+
+: PRINT-VERSION
+  CHAR v EMIT VERSION-MAJOR .
+  CHAR . EMIT VERSION-MINOR .
+  CHAR . EMIT VERSION-PATCH .
+;
+
+\ Welcome banner
+
+: BANNER
+  ."          _            __ " CR
+  ."  _    __(_)__    ___ / / " CR
+  ." | |/|/ / / _ \_ (_-./ _ \" CR
+  ." |__,__/_/ .__(_)___/_//_/" CR
+  ."        /_/               " CR
+  CR
+  ." Welcome to Wipforth " PRINT-VERSION  ." !" CR
+  ." Copyright (c) Camden Dixie O'Brien" CR
+  CR
+  ." Wipforth is freely available to use, modify and distribute for personal use" CR
+  ." under the Komorebi license, version 2.0.0." CR
+  CR
+;
+
+\ Set SYSREADY high and wait until interactive
+1 SYSREADY AC!
+SYSINTER WAIT DROP
+
+BANNER

server.py

@@ -1,16 +0,0 @@
-from http.server import HTTPServer, SimpleHTTPRequestHandler
-import sys
-
-class CORSRequestHandler(SimpleHTTPRequestHandler):
-	def end_headers(self):
-		self.send_header(
-			'Cross-Origin-Opener-Policy', 'same-origin')
-		self.send_header(
-			'Cross-Origin-Embedder-Policy', 'require-corp')
-		self.send_header(
-			'Cache-Control', 'no-store, no-cache, must-revalidate')
-		super().end_headers()
-
-if __name__ == '__main__':
-	server = HTTPServer(('localhost', 8080), CORSRequestHandler)
-	server.serve_forever()

server.scm

@@ -0,0 +1,81 @@
+(define-module (server)
+  #:export (run start stop main))
+
+(use-modules
+ (ice-9 atomic)
+ (ice-9 binary-ports)
+ (ice-9 threads)
+ (srfi srfi-9)
+ (web client)
+ (web server)
+ (web request)
+ (web response)
+ (web uri))
+
+(define mime-types
+  '(("html" . (text/html))
+	("css"  . (text/css))
+	("js"   . (application/javascript))
+	("f"    . (text/plain))
+	("ws"   . (text/plain))
+	("png"  . (image/png))))
+
+(define (mime-type path)
+  (let* ((dot (string-rindex path #\.))
+		 (ext (when dot (substring path (1+ dot)))))
+	(or (assoc-ref mime-types ext) "application/octet-stream")))
+
+(define headers
+  '((cross-origin-opener-policy . "same-origin")
+	(cross-origin-embedder-policy . "require-corp")
+	(cache-control . (no-store no-cache must-revalidate))))
+
+(define (is-dir? path)
+  (eq? 'directory (stat:type (stat path))))
+
+(define (request-path request)
+  (let ((path (string-append "." (uri-path (request-uri request)))))
+	(cond ((not (file-exists? path)) #nil)
+		  ((is-dir? path) (string-append path "index.html"))
+		  (#t path))))
+
+(define (file-handler request body)
+  (let ((path (request-path request)))
+	(if path
+		(values (cons `(content-type . ,(mime-type path)) headers)
+				(get-bytevector-all (open-input-file path)))
+		(values (build-response #:code 404) #f))))
+
+(define* (run #:key (port 8080))
+  (run-server file-handler 'http `(#:port ,port)))
+
+(define-record-type <handle>
+  (make-handle close-flag thread port)
+  handle?
+  (close-flag handle-close-flag)
+  (thread handle-thread)
+  (port handle-port))
+
+(define (serve impl server should-close)
+  (let loop ()
+	(unless (atomic-box-ref should-close)
+	  (serve-one-client file-handler impl server '())
+	  (loop)))
+  (close-server impl server))
+
+(define* (start #:key (port 8080))
+  (let* ((impl (lookup-server-impl 'http))
+		 (server (open-server impl `(#:port ,port)))
+		 (should-close (make-atomic-box #f))
+		 (thread
+		  (call-with-new-thread
+		   (lambda () (serve impl server should-close)))))
+	(make-handle should-close thread port)))
+
+(define (stop handle)
+  (atomic-box-set! (handle-close-flag handle) #t)
+  (http-request (format #f "http://localhost:~a/" (handle-port handle)))
+  (join-thread (handle-thread handle)))
+
+(when (string=? (basename (current-filename)) (car (command-line)))
+  (run))

styles.css

@@ -14,6 +14,7 @@ body {
 }
 
 #output {
+	width: 80ch;
 	margin: 1.5em auto;
 	white-space: pre;
 }

tests.scm

@@ -0,0 +1,52 @@
+(add-to-load-path (dirname (current-filename)))
+
+(use-modules
+ (e2e marionette)
+ (e2e testing)
+ (ice-9 regex)
+ ((server) #:prefix server-)
+ (srfi srfi-1))
+
+(define (lines s)
+  (string-split s #\newline))
+
+(define (get-result-line client)
+  (let ((display (get-display client)))
+	(last (lines (string-trim-right display)))))
+
+(define server (server-start))
+(define firefox (start-firefox))
+(define client (client-setup))
+
+(navigate client "http://localhost:8080")
+(sleep 1)
+
+(define-test kernel-assembles-successfully
+  (let* ((display (get-display client))
+		 (line (first (lines display))))
+	(assert (string-match "Assembling kernel \\.+ done" line)
+			(format #f "Kernel assemble line: ~s" line))))
+
+(define-test prelude-loads-successfully
+  (let* ((display (get-display client))
+		 (line (second (lines display))))
+	(assert (string-match "Loading prelude \\.+ done" line)
+			(format #f "Prelude load line: ~s" line))))
+
+(define-test six-seven-times-dot-cr-yields-42
+  (input-line client "6 7 * . CR")
+  (let* ((result-line (get-result-line client)))
+	(assert (string=? "42" result-line)
+			(format #f "Result line: ~s" result-line))))
+
+(define-test define-hello-then-run-hello-prints-message
+  (input-line client ": HELLO .\" Hello, world!\" CR ;")
+  (input-line client "HELLO")
+  (let* ((result-line (get-result-line client)))
+	(assert (string=? "Hello, world!" result-line)
+			(format #f "Result line: ~s" result-line))))
+
+(run-tests-with-cleanup
+ (client-teardown client)
+ (close-firefox firefox)
+ (server-stop server))