Files
LithosAnanake/v4/capsule/core.v4
T
rajamesandClaude Opus 5.5 dc7e37ba5c feat(v4.0.0): every error is raised and ends the line (D-18)
Ruled 2026-10-04: guard all errors.  The errors that set NODE-ERROR and
let the line run on now stop it at once, with a message.

- A store of a non-zero code to NODE-ERROR is a trap, a sixth kind of
  fault: nothing after it executes, the return stack is emptied, and the
  data stack is left as the word left it.  Not attached, NODE-ERROR is
  plain memory, as the tests below the prompt use it.
- The capsule's words store a code where they stored -1, and the prompt's
  (RAISED) prints its message: Negative count, Not a number, Number too
  long, Not a character, Dictionary full, Name missing, Control structure
  mismatch, Control structures too deep.
- ' and COMPILE and [COMPILE] of a word that is not there say
  UNKNOWN WORD: 'xxx', as the interpreter does.
- tests: the trap in test_exec.c; every message from the prompt, with the
  rest of the line not run and the stack kept, in test_host_quit.c.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-10-04 20:13:23 -04:00

120 lines
4.4 KiB
Plaintext

\ core.v4 -- the core words the host-node capsules rest on.
\
\ Each is the definition DECOMPOSITION.md gives and the golden-model tests
\ execute (test_foundation.c, test_strings.c, test_terminal.c, test_pictured.c),
\ written here as text for the text assembler (v4/include/v4/text.h).
\
\ Constants the loader supplies: N-1 (cell bits - 1), NODE-ERROR, CONSOLE-TX,
\ CONSOLE-RX, CONSOLE-STATUS, BASE.
\
\ ERRORS (D-18). A word that finds an error takes its arguments off the stack
\ and stores a code in NODE-ERROR. On a node with a prompt that store is a
\ trap: the word goes no further, and the prompt prints the message for the
\ code and ERROR (quit.v4, (RAISED)). The codes:
\ 1 Negative count 2 Not a number 3 Number too long
\ 4 Not a character 5 Dictionary full 6 Name missing
\ 7 Control structure mismatch 8 Control structures too deep
\ -1 the word has printed its own message
macro SWAP over push push drop pop pop endmacro
macro - push inv pop + inv endmacro \ x y -- x-y
macro NEGATE inv 1 + endmacro
macro NIP push drop pop endmacro
\ ---- section 4: multiply ------------------------------------------------
header UM*
: UM* ( u1 u2 -- ulo uhi )
over 1 and inv 1 + over 2/ and \ u1 u2 t0 t0 = u2 2/ if u1 odd
over a! N-1 push \ A: u2 R: loop count
push over 2/ pop \ u1 u2 s t0 s = u1 2/
L: +* unext \ u1 u2 s hi A: lo
push drop pop \ u1 u2 hi
2* a -if L0 drop 1 + jump L1 L0: drop L1: push
over -if L2 drop dup jump L3 L2: drop 0 L3: push
dup -if L4 drop over 1 and jump L5 L4: drop 0 L5:
pop + pop + push
and 1 and a 2* + pop ;
\ ---- section 5.7: doubles ------------------------------------------------
header D+
: D+ ( d1 d2 -- d3 )
push over push push drop pop \ al bl R: bh ah
over over xor -if L1
drop + -if C1 jump C0
L1: drop over -if L2
drop + jump C1
L2: drop +
C0: pop pop + ;
C1: pop pop + 1 + ;
header DNEGATE
: DNEGATE ( d -- -d )
inv over if L1 drop push inv 1 + pop ;
L1: drop 1 + ;
\ ---- section 5.3: bytes --------------------------------------------------
\ The shifts are written out, eight to a line, where DECOMPOSITION.md 5.3 has
\ a FOR ... UNEXT loop: a loop keeps its count on the return stack, and C@ and
\ C! are at the bottom of every chain of calls in the compiler capsule, where
\ there is not an entry to spare (D-2). The result is the same.
macro 8/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ endmacro
macro 8* 2* 2* 2* 2* 2* 2* 2* 2* endmacro
header C@
: C@ ( baddr -- c )
dup 2/ 2/ a! 3 and
if K0 -1 + if K1 -1 + if K2
drop @ 8/ 8/ 8/ 255 and ;
K2: drop @ 8/ 8/ 255 and ;
K1: drop @ 8/ 255 and ;
K0: drop @ 255 and ;
header C!
: C! ( c baddr -- )
dup 2/ 2/ a! 3 and
if K0 -1 + if K1 -1 + if K2
drop 8* 8* 8* 4278190080 and @ 4278190080 inv and + ! ;
K2: drop 8* 8* 16711680 and @ -16711681 and + ! ;
K1: drop 8* 65280 and @ -65281 and + ! ;
K0: drop 255 and @ -256 and + ! ;
\ ---- section 5.9: strings ------------------------------------------------
header CMOVE
: CMOVE ( src dst u -- )
-if OK drop drop drop NODE-ERROR b! 1 !b ;
OK: if DONE push
over C@ over C! 1 + push 1 + pop pop -1 + jump OK
DONE: drop drop drop ;
\ ---- section 5.10: the console -------------------------------------------
header EMIT
: EMIT ( c -- ) CONSOLE-TX b! !b ;
header KEY
: KEY ( -- c )
L: CONSOLE-STATUS b! @b if WAIT drop CONSOLE-RX b! @b ;
WAIT: drop jump L
header CR
: CR ( -- ) 10 jump EMIT
header SPACE
: SPACE ( -- ) 32 jump EMIT
header COUNT
: COUNT ( baddr -- baddr+1 c ) dup C@ push 1 + pop ;
header TYPE
: TYPE ( baddr u -- )
-if OK drop drop NODE-ERROR b! 1 !b ;
OK: if DONE over C@ EMIT push 1 + pop -1 + jump OK
DONE: drop drop ;
\ ( x -- ) up to four characters packed in one cell, the first in the low
\ byte: how the capsule prints its own short messages, a literal at a time.
: (EMIT4)
L: if DONE dup EMIT 8/ jump L
DONE: drop ;
\ ---- section 5.8: the number base ----------------------------------------
: (BASE) ( -- b ) \ BASE, or 10 when it is outside 2 .. 36
BASE b! @b dup -2 + -if L1 drop drop 10 ;
L1: drop dup -37 + -if L2 drop ;
L2: drop drop 10 ;