Compare commits

..

16 Commits

4 changed files with 374 additions and 35 deletions

View File

@@ -46,3 +46,12 @@ registers: `xBUF`, `xHEAD` and `xTAIL`:
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 | Offset | Size / B | Access |
|----------|--------|----------|--------------|
| SYSREADY | 68 | 1 | atomic write |
The `SYSREADY` register is used to indicate when the system has booted
up and is ready for user input.

29
emu.js
View File

@@ -4,10 +4,11 @@ const TXHEAD = 64;
const TXTAIL = 65;
const RXHEAD = 66;
const RXTAIL = 67;
const SYSREADY = 68;
const TXBUF_SIZE = 32;
const RXBUF_SIZE = 32;
const PERIPHS_SIZE = 68;
const PERIPHS_SIZE = 69; // Nice
const POLL_INTERVAL_MS = 20;
@@ -44,13 +45,18 @@ class Emulator {
end: { x: 0, y: 0 }
};
this.idle_timer = null;
this.input_enable = false;
document.addEventListener('keydown', (e) => this.handle_keydown(e));
this.flush_output();
document.getElementById('cursor').classList.add('blinking');
this.worker = new Worker('boot.js');
this.worker.postMessage(this.mem);
fetch('prelude.f')
.then(res => res.text())
.then(text => {
for (const cu of this.encoder.encode(text))
this.rx_queue.push(cu);
});
}
poll() {
@@ -65,6 +71,15 @@ 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) {
this.input_enable = true;
this.flush_output();
document.getElementById('cursor').classList.add('blinking');
}
}
}
fifo_next(idx) {
@@ -118,6 +133,9 @@ 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;
@@ -239,7 +257,8 @@ 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
&& x == this.cursor.x && y == this.cursor.y)
return '<span id="cursor">' + ec + '</span>';
else
return ec;

270
prelude.f Normal file
View File

@@ -0,0 +1,270 @@
76 EMIT 111 EMIT 97 EMIT 100 EMIT 105 EMIT 110 EMIT 103 EMIT 32 EMIT
112 EMIT 114 EMIT 101 EMIT 108 EMIT 117 EMIT 100 EMIT 101 EMIT 32 EMIT
: \ KEY 10 = 0BRANCH [ -20 , ] ; IMMEDIATE \ Now we have line comments :)
\ We'll periodically sprinkle these in so that it's clear to the user
\ that things are happening.
46 EMIT
\ Conditionals
: IF
LIT 0BRANCH ,
HERE @ 0 ,
; IMMEDIATE
: THEN
DUP HERE @ SWAP -
SWAP !
; IMMEDIATE
: ELSE
LIT BRANCH ,
HERE @ 0 ,
SWAP
DUP HERE @ SWAP -
SWAP !
; IMMEDIATE
46 EMIT
\ Loops
: BEGIN HERE @ ; IMMEDIATE
: UNTIL
LIT 0BRANCH ,
HERE @ - ,
; IMMEDIATE
: AGAIN
LIT BRANCH ,
HERE @ - ,
; IMMEDIATE
46 EMIT
\ Recursive calls
: RECURSE LATEST @ >CFA , ; IMMEDIATE
\ Block comments (with nesting)
: (
BEGIN
KEY DUP
40 = IF RECURSE THEN
41 =
UNTIL
; IMMEDIATE
( ( Take that, C ) )
46 EMIT
\ Peripheral register addresses
: TXBUF 0 ;
: RXBUF 32 ;
: TXHEAD 64 ;
: TXTAIL 65 ;
: RXHEAD 66 ;
: RXTAIL 67 ;
: SYSREADY 68 ;
46 EMIT
\ 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 CHAR A THEN
+ EMIT
;
CHAR . 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 @ / 0= UNTIL
THEN
2DROP
;
CHAR . EMIT
: TYPE ( addr len -- )
BEGIN
DUP 0= IF 2DROP EXIT THEN
SWAP DUP C@ EMIT 1+
SWAP 1-
AGAIN
;
CHAR . EMIT
: 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
CHAR . EMIT
\ Misc utilities
: NIP SWAP DROP ;
: '
WORD FIND DUP 0<> IF
>CFA
ELSE
DROP WNFHOOK EXECUTE
THEN
;
: [COMPILE] ' , ; IMMEDIATE
CHAR . EMIT
\ 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
CHAR . EMIT
\ 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
CHAR . EMIT
\ Version number
: VERSION-MAJOR 0 ;
: VERSION-MINOR 1 ;
: VERSION-PATCH 0 ;
: VERSION-PRINT
." v" VERSION-MAJOR .
." ." VERSION-MINOR .
." ." VERSION-PATCH .
;
CHAR . EMIT
\ Welcome banner
: BANNER
." _ __ " CR
." _ __(_)__ ___ / / " CR
." | |/|/ / / _ \_ (_-./ _ \" CR
." |__,__/_/ .__(_)___/_//_/" CR
." /_/ " CR
CR
." Wipforth " VERSION-PRINT CR
CR
;
." done" CR
BANNER
\ Set SYSREADY high to indicate prelude has finished and enable user
\ input on the JS side.
1 SYSREADY AC!

View File

@@ -96,7 +96,7 @@
call $next)
(func $doconst
(func $doval
global.get $cfa
i32.const 4
i32.add
@@ -720,7 +720,7 @@
;; dictionary entries so that the definition of the index isn't too
;; far from its use.
;;
;; The exceptions are the special inner interpreters, DOCOL, DOCONST
;; The exceptions are the special inner interpreters, DOCOL, DOVAL
;; and DOVAR, which I've put here in indices 0, 1 and 2 for
;; convenience.
@@ -728,7 +728,7 @@
(table $codewords 100 funcref)
(elem (i32.const 0x00) $docol)
(elem (i32.const 0x01) $doconst)
(elem (i32.const 0x01) $doval)
(elem (i32.const 0x02) $dovar)
;; Dictionary time D:
@@ -1053,7 +1053,7 @@
"\070BRANCH"
"\37\00\00\00")
;; Built-in constants and variables
;; Built-in values and variables
(data (i32.const 0x04b8)
"\a8\04\00\00"
@@ -1063,7 +1063,7 @@
(data (i32.const 0x04cc)
"\b8\04\00\00"
"\07DOCONST"
"\05DOVAL\00\00"
"\01\00\00\00"
"\01\00\00\00")
@@ -1119,13 +1119,13 @@
"\64\05\00\00"
"\04HERE\00\00\00"
"\02\00\00\00"
"\e0\0d\00\00")
"\60\0e\00\00")
(data (i32.const 0x058c)
"\78\05\00\00"
"\06LATEST\00"
"\02\00\00\00"
"\b4\0d\00\00")
"\30\0e\00\00")
(data (i32.const 0x05a0)
"\8c\05\00\00"
@@ -1136,9 +1136,9 @@
(data (i32.const 0x05d0)
"\a0\05\00\00"
"\05ERROR\00\00"
"\02\00\00\00"
"\00\00\00\00")
"\07WNFHOOK"
"\01\00\00\00"
"\f0\0d\00\00")
;; And now, it's time for some hand-compiled colon words. It
;; probably would have made more sense to write most of these
@@ -1287,11 +1287,7 @@
;; => 0x78 bytes
;; : NAME-LEN 4+ C@ 63 AND ;
;; The 0x3f mask we use here includes the hidden flag, so that FIND
;; never matches a hidden entry as its length will appear to be
;; greater than the maximum length returned by WORD.
;; : NAME-LEN 4+ C@ 31 AND ;
(data (i32.const 0x0760)
"\e8\06\00\00"
@@ -1300,7 +1296,7 @@
"\a8\02\00\00" ;; 4+
"\fc\03\00\00" ;; C@
"\18\04\00\00" ;; LIT
"\3f\00\00\00" ;; 63
"\1f\00\00\00" ;; 31
"\8c\03\00\00" ;; AND
"\0c\04\00\00") ;; EXIT
@@ -1309,7 +1305,7 @@
;; : FIND ( len -- entry )
;; LATEST @ \ Initial entry
;;
;; TUCK NAME-LEN \ Get name length
;; TUCK FIND-NAME-LEN \ Get name length
;; OVER = 0BRANCH [52] \ Check for length mismatch
;; OVER 5 + \ Get name address
;; OVER SWAP WORDBUF STRING= \ Check if name matches
@@ -1329,7 +1325,7 @@
"\98\05\00\00" ;; LATEST
"\cc\03\00\00" ;; @
"\f0\05\00\00" ;; TUCK
"\70\07\00\00" ;; NAME-LEN
"\44\0e\00\00" ;; FIND-NAME-LEN
"\54\02\00\00" ;; OVER
"\fc\02\00\00" ;; =
"\b4\04\00\00" ;; 0BRANCH
@@ -1637,11 +1633,8 @@
;; LIT-CFA , , \ If compiling, append LIT and the value
;; EXIT
;;
;; \ Word was not found and also not a number. Ideally we'd print the
;; \ word that wasn't found here but I haven't implemented such things
;; \ yet so for now we'll just discard the word's length, set ERROR to
;; \ 1 and exit.
;; DROP 1 ERROR !
;; \ Word was not found
;; WNFHOOK EXECUTE
;; ;
(data (i32.const 0x0ac0)
@@ -1686,14 +1679,15 @@
"\5c\0a\00\00" ;; ,
"\5c\0a\00\00" ;; ,
"\0c\04\00\00" ;; EXIT
"\18\02\00\00" ;; DROP
"\18\04\00\00" ;; LIT
"\01\00\00\00" ;; 1
"\dc\05\00\00" ;; ERROR
"\c0\03\00\00" ;; !
"\dc\05\00\00" ;; WNFHOOK
"\bc\0b\00\00" ;; EXECUTE
"\0c\04\00\00") ;; EXIT
;; => 0xc4 bytes
;; => 0xb8 bytes
;; The previous version of INTERPRET was 0xc4 bytes, so we have 12
;; unused bytes here. Could fit an extra codeword definition in
;; here, if the name is less than 4 bytes long.
;; : QUIT R0 RSP! INTERPRET BRANCH [-8] ;
@@ -1928,7 +1922,7 @@
;; [
;; ; IMMEDIATE
(data (i32.const 0xdb4)
(data (i32.const 0x0db4)
"\78\0d\00\00"
"\81;\00\00"
"\00\00\00\00"
@@ -1943,6 +1937,53 @@
;; => 0x2c bytes
;; : WNF-HANDLER
;; DROP \ Discard word length
;; 87 EMIT 78 EMIT 70 EMIT 10 EMIT \ Print WNF
;; QUIT \ Reset return stack
;; ;
(data (i32.const 0x0de0)
"\b4\0d\00\00"
"\0bWNF-HANDLER"
"\00\00\00\00"
"\18\02\00\00" ;; DROP
"\18\04\00\00" ;; LIT
"\57\00\00\00" ;; 87
"\94\04\00\00" ;; EMIT
"\18\04\00\00" ;; LIT
"\4e\00\00\00" ;; 78
"\94\04\00\00" ;; EMIT
"\18\04\00\00" ;; LIT
"\46\00\00\00" ;; 70
"\94\04\00\00" ;; EMIT
"\18\04\00\00" ;; LIT
"\0a\00\00\00" ;; 10
"\94\04\00\00" ;; EMIT
"\90\0b\00\00" ;; QUIT
"\0c\04\00\00") ;; EXIT
;; => 0x50 bytes
;; : FIND-NAME-LEN 4+ C@ 63 AND ;
;; The 0x3f mask we use here includes the hidden flag, so that FIND
;; never matches a hidden entry as its length will appear to be
;; greater than the maximum length returned by WORD.
(data (i32.const 0x0e30)
"\e0\0d\00\00"
"\0dFIND-NAME-LEN\00\00"
"\00\00\00\00"
"\a8\02\00\00" ;; 4+
"\fc\03\00\00" ;; C@
"\18\04\00\00" ;; LIT
"\3f\00\00\00" ;; 63
"\8c\03\00\00" ;; AND
"\0c\04\00\00") ;; EXIT
;; => 0x30 bytes
;; The trampoline is a workaround for WebAssembly's lack of indirect
;; jumps and code addresses. Instead of jumping into the next
;; codeword, NEXT sets the $fn global to the function index of the