Files
LithosAnanake/capsules/v4/rom/dir.f18
T
rajamesandClaude Opus 5.5 a28b5f2230 fix(v4): the final review's six minors in the ROM boot
- Text after start is refused, as text.c refuses it: before it jumps, the
  ROM reads on to the end of the source; blanks, comments and the ends of
  blobs may follow, a token is ERR-AFTER (26), "text after start".
- A token too long where a name, a target or a value is wanted is "name
  too long", as text.c says: (MISSING) reports "missing" only when no error
  came first.  `", keeps "missing", which is text.c's word for both.
- text.c's "address out of range" names the address, not the value.
- The system's source files are one list, v4/sys_files.h: boot.c, the
  harness and the nucleus test are made from it.
- The ROM's error codes and words are one list, v4/rom_errors.h: boot.c's
  messages, host_map.h's ROM_ERR_* and mkmap's ERR-* are made from it.
- node.h says what v4_node_store does with a ROM address (nothing, as for
  any address outside RAM, D-14); test_host_rom_range pins it.

ROM: 2095 words, rom_hash 0x06d0dcb7a0cb41a1.  dict_hash unchanged,
0xe5a57f3eb72ff94a.  make -C v4 test test-32 hosted-check pass.  QEMU:
amd64, aarch64, riscv64 to ok>, POST 538/538, POST: PASSED.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-10-15 17:10:45 -04:00

146 lines
4.5 KiB
Plaintext

\ dir.f18 -- the ROM's directives, and the end of the system's source.
\
\ What the prebuilt nucleus's mkimage.c (gone) and text.c's header did in C
\ is said in the source with
\ these (MACHINE.md, the ROM's language). Each is a machine notion -- an
\ address, a cell, a value -- and none is FORTH.
\ constant NAME VALUE NAME is the number VALUE
\ set NAME VALUE an assembler variable: may be set again
\ #, VALUE one cell of data at the next word address
\ ", TOKEN TOKEN, whatever its characters, as a counted string
\ store ADDR VALUE ADDR := VALUE, anywhere in RAM
\ start NAME the end: every branch must have its target; the
\ tables the ROM used are cleared; then NAME runs
\ A VALUE is a number, a constant, a set variable, CONST+N, here (the next
\ word address) or &NAME of a word already defined.
\ ( -- v 1 | 0 0 ) the token as a VALUE; "not a value" if it is none
: (VALUE)
(NUMBER) if NN
-if NUMOK drop drop ERR-BIG (FAIL) 0 0 ;
NUMOK: drop 1 ;
NN: drop drop
&(RESERVED) (WALK) 8 xor if HR drop
0 (CHAR@) 38 xor if AMPV drop
(FIND) if NOSYM
dup 2 + a! @ 2 xor if CV drop
dup 2 + a! @ 4 xor if CV drop
drop jump BAD
CV: drop 3 + a! @ 1 ;
NOSYM: drop
(CONST+N) if BAD0 ;
BAD0: drop drop
BAD: ERR-VALUE (FAIL) 0 0 ;
HR: drop (LABEL) 1 ;
AMPV: drop (TOKN) a! @ -1 + if ONEV drop
(TOK-SAVE) 1 (MLEN) a! @ -1 + (TOK-SUB)
(FIND) if BADA
dup 2 + a! @ 1 xor if OKA drop drop jump BADA0
OKA: drop 3 + a! @ 1 ;
BADA: drop
BADA0: ERR-AMP (FAIL) 0 0 ;
ONEV: drop jump BAD
\ ( -- v 1 | 0 0 ) the next token as a VALUE
: (NEXT-VALUE)
(NEXT-TOKEN) if MISS drop jump (VALUE)
MISS: drop (MISSING) 0 0 ;
: (H-CONSTANT)
(IN-MACRO?) if OK drop ;
OK: drop
(NEXT-TOKEN) if MISS drop
(TOK) (TSAVE) 16 (COPY)
(NEXT-TOKEN) if MISS drop
(NUMBER) if NAN
-if NUM drop drop ERR-BIG jump (FAIL)
NUM: drop (NAME-BACK) 2 jump (DEFINE)
NAN: drop drop ERR-VALUE jump (FAIL)
MISS: drop jump (MISSING)
: (H-SET)
(IN-MACRO?) if OK drop ;
OK: drop
(NEXT-TOKEN) if MISS drop
(TOK) (TSAVE) 16 (COPY)
(NEXT-VALUE) if BADV drop
(NAME-BACK) 4 jump (DEFINE)
BADV: drop drop ;
MISS: drop jump (MISSING)
\ here alone is not something to assemble: only a VALUE
: (H-HERE) ERR-TARGET jump (FAIL)
: (H-CELL)
(IN-MACRO?) if OK drop ;
OK: drop
(NEXT-VALUE) if BADV drop
(LABEL) drop jump (EMIT)
BADV: drop drop ;
: (H-STRING)
(IN-MACRO?) if OK drop ;
OK: drop
(RAW-TOKEN) if MISS drop
(LABEL) drop
(TOKN) a! @ 4 + 2/ 2/ (T1) a! ! 0 (T2) a! !
L: (T2) a! @ (T1) a! @ xor if D drop
(T2) a! @ (TOK) + a! @ (EMIT)
(T2) a! @ 1 + ! jump L
D: drop ;
\ text.c says "without a string, or one too long" for both: missing
MISS: drop ERR-MISSING jump (FAIL)
\ store ADDR VALUE: ADDR must be in RAM, as text.c requires
: (H-STORE)
(IN-MACRO?) if OK drop ;
OK: drop
(NEXT-VALUE) if BADV drop (T1) a! !
(NEXT-VALUE) if BADV drop
(T1) a! @ -if LO
drop drop ERR-RANGE jump (FAIL)
LO: RAM-WORDS inv 1 + + -if HI
drop (T1) a! @ b! !b ;
HI: drop drop ERR-RANGE jump (FAIL)
BADV: drop drop ;
\ ( -- ) clear the tables the ROM uses only while it assembles: the symbol
\ table in dictionary space, the branches, labels and names in the block
\ window, the saved token and macro body in the text input buffer
: (CLEAR)
DICT-W a! DICT-END DICT-W inv 1 + + -1 + FOR 0 !+ NEXT
BUF0 a! 1023 FOR 0 !+ NEXT
TIB-W a! 259 FOR 0 !+ NEXT
0 (RECN) a! ! 0 (POOLN) a! ! 0 (NREF) a! ! 0 (NLAB) a! !
0 (WNP) a! ! 0 (NFOR) a! ! 0 (RDEPTH) a! ! ;
\ start NAME: the system's source has ended; NAME, a word, is where it starts
: (H-START)
(IN-MACRO?) if OK drop ;
OK: drop
(NEXT-TOKEN) if MISS drop
(TOK) (TSAVE) 16 (COPY)
(END-WORD)
(FAILED) a! @ if F0 drop ;
F0: drop
(NREF) a! @ if NOREF drop
ERR-UNDEFINED (FAIL) (REFS) 1 + a! @ (ERRLINE) a! ! ;
NOREF: drop
(LABEL) drop
(NAME-BACK)
(FIND) if NOTW
dup 2 + a! @ 1 xor if ISW drop drop jump NOTW0
ISW: drop 3 + a! @ (T1) a! !
\ nothing may follow start but blanks, comments and the ends of blobs,
\ up to the end of all
A1: (TOKEN) if A2
drop ERR-AFTER jump (FAIL)
A2: drop (FAILED) a! @ if A3 drop ;
A3: drop (EOF) a! @ if A1 drop
(CLEAR)
0 DSTACK-REG a! ! 0 RSTACK-REG a! !
(T1) a! @ push ;
NOTW: drop
NOTW0: ERR-START jump (FAIL)
MISS: drop jump (MISSING)