feat(v4.0.0): reading a line and splitting it into words and numbers
The first layer of the compiler capsule, on the host node: TIB >IN SPAN SOURCE BL EXPECT QUERY WORD ENCLOSE CONVERT NUMBER and the comment words. The definitions are text, v4/capsule/core.v4 (the core words they rest on) and v4/capsule/input.v4, assembled by the text assembler, which can now read a file. EXPECT, QUERY, WORD and ENCLOSE behave as v3's. CONVERT and NUMBER are FORTH-79 (ruled 2026-10-04): any BASE, a double in the standard order, and NUMBER returns a signed double or sets NODE-ERROR. Executed at both cell widths against C and against values recorded from the v3 binary. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
co-authored by
Claude Opus 5.5
parent
31fcdcd0a3
commit
443439c3d2
@@ -566,11 +566,11 @@ width and print a flood of spaces.
|
|||||||
| `SEARCH` | CAP | `( a1 u1 a2 u2 -- a3 u3 flag )`: the rest of string 1 from the first place string 2 occurs and `-1`, or string 1 and `0`; an empty string 2 is found at the start. See below; the inner comparison is in line, not a call to `COMPARE`. Same notes. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 3 data cells and 5 return entries. Clobbers `A` and `B`. |
|
| `SEARCH` | CAP | `( a1 u1 a2 u2 -- a3 u3 flag )`: the rest of string 1 from the first place string 2 occurs and `-1`, or string 1 and `0`; an empty string 2 is found at the start. See below; the inner comparison is in line, not a call to `COMPARE`. Same notes. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 3 data cells and 5 return entries. Clobbers `A` and `B`. |
|
||||||
| `SCAN` `SKIP` | CAP | `( baddr u c -- baddr' u' )`: `SCAN` stops at the first byte equal to the low byte of `c` (or at the end, with `u' = 0`); `SKIP` stops at the first byte not equal to it. See below. A negative count reads as 0, as v3. v3's counted-string auto-detection is not kept. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Each leaves its caller 5 data cells and 5 return entries. Clobber `A`. |
|
| `SCAN` `SKIP` | CAP | `( baddr u c -- baddr' u' )`: `SCAN` stops at the first byte equal to the low byte of `c` (or at the end, with `u' = 0`); `SKIP` stops at the first byte not equal to it. See below. A negative count reads as 0, as v3. v3's counted-string auto-detection is not kept. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Each leaves its caller 5 data cells and 5 return entries. Clobber `A`. |
|
||||||
| `(S)` | CAP | Variable, 4 cells: `COMPARE`'s two lengths; `SEARCH`'s string 2 and the whole of string 1. |
|
| `(S)` | CAP | Variable, 4 cells: `COMPARE`'s two lengths; `SEARCH`'s string 2 and the whole of string 1. |
|
||||||
| `BL` | IN | `32` |
|
| `BL` | IN | `32` — executed on the golden model (2026-10-04). |
|
||||||
| `EXPECT` `QUERY` | CC | Built on `KEY` (DEV). |
|
| `EXPECT` `QUERY` | CC | Built on `KEY` (DEV); source in `v4/capsule/input.v4`. `EXPECT ( baddr u -- )` as v3's `fgets`: at most `u-1` characters, stopping after a new-line (taken, not stored), then a zero; `SPAN` is the count; a line that does not fit leaves its tail to be read next; `u < 0` does nothing and sets `NODE-ERROR`. `QUERY` is `TIB #TIB EXPECT 0 >IN !` with `#TIB` 1025, as v3. Executed on the golden model's host node (2026-10-04), including results recorded from the v3 binary. Both part from FORTH-79, which takes up to `u` characters in `EXPECT` and 80 in `QUERY`: reported 2026-10-04, awaiting a ruling. `EXPECT` leaves its caller 6 data cells and 4 return entries. |
|
||||||
| `SPAN` `TIB` `>IN` `SOURCE` | CC | Interpreter state on the host node. |
|
| `SPAN` `TIB` `>IN` `SOURCE` | CC | Interpreter state on the host node. `TIB` is the buffer's byte address and `>IN` and `SPAN` their variables' word addresses, all in line; `SOURCE ( -- baddr u )` is `TIB` and `SPAN @`, a negative `SPAN` read as 0. Executed on the golden model's host node (2026-10-04). |
|
||||||
| `WORD` `ENCLOSE` | CC | Parser. |
|
| `WORD` `ENCLOSE` | CC | Parser; source in `v4/capsule/input.v4`. `WORD ( c -- baddr )`, as v3: the next word of `TIB` delimited by `c`, as a counted string in a 64-byte buffer with a zero after it; delimiters before it are skipped and so are all those after it; a longer word is cut to 62 characters; at the end of the line the count is 0. `ENCLOSE ( baddr c -- baddr n1 n2 n3 )` on a zero-terminated string. Executed on the golden model's host node (2026-10-04) against C and the counts and `>IN` values recorded from the v3 binary (the text in v3's own buffer was corrupt in those runs: `hello` came back as `hlllo`). `WORD` parts from FORTH-79 in skipping every trailing delimiter, storing a zero where the standard stores the delimiter, and cutting at 62: reported 2026-10-04, awaiting a ruling. `WORD` leaves its caller 4 data cells and 3 return entries. |
|
||||||
| `NUMBER` `CONVERT` | CC | Rewritten to honour `BASE` (v3's `NUMBER` is base 10 only). |
|
| `NUMBER` `CONVERT` | CC | FORTH-79, not v3 (ruled 2026-10-04); source in `v4/capsule/input.v4`. `CONVERT ( d1 baddr1 -- d2 baddr2 )` takes the characters from `baddr1 + 1` on as digits in the current `BASE`, in either case, accumulating each into the double after multiplying it by `BASE`, and stops at the first that is not one; the double is `( lo hi )`. v3's was base 10 only, started at `baddr1`, and took the double low cell on top. `NUMBER ( baddr -- d )` is the counted string as a signed double in the current `BASE`, with an optional leading minus; anything else gives 0 and sets `NODE-ERROR`. v3's returned `( n flag )` in base 10. Executed on the golden model's host node (2026-10-04) against C in eight bases, including a digit that carries out of the low cell. `NUMBER` leaves its caller 3 data cells and 3 return entries. |
|
||||||
| `S"` `(s")` `[']` | CC | Compiler words. |
|
| `S"` `(s")` `[']` | CC | Compiler words. |
|
||||||
| `LITERAL` `[LITERAL]` (placeholders) | RET | The working `LITERAL` is in §5.17. |
|
| `LITERAL` `[LITERAL]` (placeholders) | RET | The working `LITERAL` is in §5.17. |
|
||||||
|
|
||||||
@@ -690,7 +690,7 @@ The storage service belongs to the Artemis role, now a device node.
|
|||||||
|
|
||||||
| Word | Fate | Notes |
|
| Word | Fate | Notes |
|
||||||
| --- | --- | --- |
|
| --- | --- | --- |
|
||||||
| `(` `\` | CC | |
|
| `(` `\` | CC | `(` is `41 WORD drop`; `\` is `SPAN @ >IN !`. In `v4/capsule/input.v4` under the names `PAREN` and `BACKSLASH`. Executed on the golden model's host node (2026-10-04). |
|
||||||
| `EXECUTE` | CAP | `push ;` (tail-jumps to the xt; the xt returns to `EXECUTE`'s caller) |
|
| `EXECUTE` | CAP | `push ;` (tail-jumps to the xt; the xt returns to `EXECUTE`'s caller) |
|
||||||
| `NOP` | OP | `nop` |
|
| `NOP` | OP | `nop` |
|
||||||
| `QUIT` `ABORT` `ABORT"` `(ABORT")` `COLD` `WARM` | CC | |
|
| `QUIT` `ABORT` `ABORT"` `(ABORT")` `COLD` `WARM` | CC | |
|
||||||
|
|||||||
+9
-3
@@ -43,6 +43,12 @@ BINDIR := $(HERE)/build
|
|||||||
HOST_WORDS := 16384
|
HOST_WORDS := 16384
|
||||||
node_size = $(if $(findstring /test_host_,$(1)),-DV4_NODE_WORDS=$(HOST_WORDS))
|
node_size = $(if $(findstring /test_host_,$(1)),-DV4_NODE_WORDS=$(HOST_WORDS))
|
||||||
|
|
||||||
|
# The capsule sources: definitions as text (include/v4/text.h), which tests
|
||||||
|
# assemble onto a node. The directory is passed to the tests so that they
|
||||||
|
# find the files whatever directory make was run from.
|
||||||
|
CAPSULES := $(wildcard $(HERE)/capsule/*.v4)
|
||||||
|
capsule_dir := -DV4_CAPSULE_DIR='"$(HERE)/capsule"'
|
||||||
|
|
||||||
.PHONY: all test sanitize clean $(addprefix test-,$(WIDTHS))
|
.PHONY: all test sanitize clean $(addprefix test-,$(WIDTHS))
|
||||||
|
|
||||||
all: test
|
all: test
|
||||||
@@ -71,13 +77,13 @@ endif
|
|||||||
define TEST_RULE
|
define TEST_RULE
|
||||||
$(BINDIR)/$(1)-$(notdir $(2)): $(2) $$(SRCS) $$(wildcard $(HERE)/include/v4/*.h) $(HERE)/Makefile
|
$(BINDIR)/$(1)-$(notdir $(2)): $(2) $$(SRCS) $$(wildcard $(HERE)/include/v4/*.h) $(HERE)/Makefile
|
||||||
@mkdir -p $(BINDIR)
|
@mkdir -p $(BINDIR)
|
||||||
$$(CC) $$(CFLAGS) -I$(HERE)/include -DV4_CELL_BITS=$(1) $(call node_size,$(2)) \
|
$$(CC) $$(CFLAGS) -I$(HERE)/include -DV4_CELL_BITS=$(1) $(call node_size,$(2)) $(capsule_dir) \
|
||||||
$(2) $$(SRCS) -o $$@
|
$(2) $$(SRCS) -o $$@
|
||||||
|
|
||||||
$(BINDIR)/san-$(1)-$(notdir $(2)): $(2) $$(SRCS) $$(wildcard $(HERE)/include/v4/*.h) $(HERE)/Makefile
|
$(BINDIR)/san-$(1)-$(notdir $(2)): $(2) $$(SRCS) $$(wildcard $(HERE)/include/v4/*.h) $(HERE)/Makefile
|
||||||
@mkdir -p $(BINDIR)
|
@mkdir -p $(BINDIR)
|
||||||
$$(CC) $$(CSTD) $$(WARN) -O1 -g -fno-omit-frame-pointer \
|
$$(CC) $$(CSTD) $$(WARN) -O1 -g -fno-omit-frame-pointer \
|
||||||
-fsanitize=address,undefined -fno-sanitize-recover=all -I$(HERE)/include -DV4_CELL_BITS=$(1) $(call node_size,$(2)) \
|
-fsanitize=address,undefined -fno-sanitize-recover=all -I$(HERE)/include -DV4_CELL_BITS=$(1) $(call node_size,$(2)) $(capsule_dir) \
|
||||||
$(2) $$(SRCS) -o $$@
|
$(2) $$(SRCS) -o $$@
|
||||||
endef
|
endef
|
||||||
|
|
||||||
@@ -87,7 +93,7 @@ endef
|
|||||||
# that does not survive the define/eval expansion, and a silently-empty loop
|
# that does not survive the define/eval expansion, and a silently-empty loop
|
||||||
# list is exactly the vacuous-pass failure this file already made once.
|
# list is exactly the vacuous-pass failure this file already made once.
|
||||||
define RUN_RULE
|
define RUN_RULE
|
||||||
run-$(1)-$(notdir $(2)): $(BINDIR)/$(1)-$(notdir $(2))
|
run-$(1)-$(notdir $(2)): $(BINDIR)/$(1)-$(notdir $(2)) $$(CAPSULES)
|
||||||
@echo " [V4_CELL_BITS=$(1) $$@]"
|
@echo " [V4_CELL_BITS=$(1) $$@]"
|
||||||
@$(BINDIR)/$(1)-$(notdir $(2))
|
@$(BINDIR)/$(1)-$(notdir $(2))
|
||||||
|
|
||||||
|
|||||||
@@ -0,0 +1,77 @@
|
|||||||
|
\ 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.
|
||||||
|
|
||||||
|
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 ------------------------------------------------
|
||||||
|
: 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 ------------------------------------------------
|
||||||
|
: 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 + ;
|
||||||
|
|
||||||
|
: DNEGATE ( d -- -d )
|
||||||
|
inv over if L1 drop push inv 1 + pop ;
|
||||||
|
L1: drop 1 + ;
|
||||||
|
|
||||||
|
\ ---- section 5.3: bytes --------------------------------------------------
|
||||||
|
: C@ ( baddr -- c )
|
||||||
|
dup 2/ 2/ a! 3 and
|
||||||
|
if K0 -1 + if K1 -1 + if K2
|
||||||
|
drop @ 23 FOR 2/ UNEXT 255 and ;
|
||||||
|
K2: drop @ 15 FOR 2/ UNEXT 255 and ;
|
||||||
|
K1: drop @ 7 FOR 2/ UNEXT 255 and ;
|
||||||
|
K0: drop @ 255 and ;
|
||||||
|
|
||||||
|
: C! ( c baddr -- )
|
||||||
|
dup 2/ 2/ a! 3 and push 255 and pop
|
||||||
|
if K0 -1 + if K1 -1 + if K2
|
||||||
|
drop 23 FOR 2* UNEXT @ 4278190080 inv and + ! ;
|
||||||
|
K2: drop 15 FOR 2* UNEXT @ -16711681 and + ! ;
|
||||||
|
K1: drop 7 FOR 2* UNEXT @ -65281 and + ! ;
|
||||||
|
K0: drop @ -256 and + ! ;
|
||||||
|
|
||||||
|
\ ---- section 5.9: strings ------------------------------------------------
|
||||||
|
: 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 -------------------------------------------
|
||||||
|
: EMIT ( c -- ) CONSOLE-TX b! !b ;
|
||||||
|
: KEY ( -- c )
|
||||||
|
L: CONSOLE-STATUS b! @b if WAIT drop CONSOLE-RX b! @b ;
|
||||||
|
WAIT: drop jump L
|
||||||
|
|
||||||
|
\ ---- 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 ;
|
||||||
@@ -0,0 +1,142 @@
|
|||||||
|
\ input.v4 -- reading a line and splitting it into words and numbers.
|
||||||
|
\
|
||||||
|
\ DECOMPOSITION.md 5.9: TIB >IN SPAN SOURCE BL EXPECT QUERY WORD ENCLOSE
|
||||||
|
\ CONVERT NUMBER, and the comment words ( and \ of 5.15 (named PAREN and
|
||||||
|
\ BACKSLASH here, since the text assembler reads those two characters as its
|
||||||
|
\ own comments; the dictionary will give them their names). Part of the compiler
|
||||||
|
\ capsule: it runs on the host node. Rests on core.v4.
|
||||||
|
\
|
||||||
|
\ Constants the loader supplies:
|
||||||
|
\ TIB byte address of the text input buffer, #TIB bytes long
|
||||||
|
\ #TIB 1025: 1024 characters and a terminating zero, as v3
|
||||||
|
\ >IN word address of the variable: offset in TIB of the next character
|
||||||
|
\ SPAN word address of the variable: how many characters the last
|
||||||
|
\ EXPECT or QUERY read
|
||||||
|
\ WBUF byte address of WORD's buffer, 64 bytes
|
||||||
|
\ (P) word address of six cells of scratch for this file
|
||||||
|
\ TIB >IN SPAN and BL are in-line: written in a definition they are literals.
|
||||||
|
|
||||||
|
macro BL 32 endmacro
|
||||||
|
|
||||||
|
\ ( -- baddr u ) the input buffer and how much of it is in use
|
||||||
|
: SOURCE TIB SPAN a! @ -if P drop 0 P: ;
|
||||||
|
|
||||||
|
\ ( baddr u -- ) read a line into u bytes at baddr, as v3's fgets did: at
|
||||||
|
\ most u-1 characters, stopping after a new-line, which is taken but not
|
||||||
|
\ stored; then a zero. A line of u-1 characters or more leaves what did not
|
||||||
|
\ fit, its new-line included, to be read next. SPAN is the number of characters stored. With u = 0
|
||||||
|
\ nothing is read or stored; u < 0 does nothing and sets NODE-ERROR.
|
||||||
|
: EXPECT
|
||||||
|
-if OK drop drop NODE-ERROR b! -1 !b ;
|
||||||
|
OK: if ZERO
|
||||||
|
over push \ p n R: start
|
||||||
|
L: -1 + if END \ room for the zero only
|
||||||
|
push KEY dup -10 + if NL \ p c x R: start n
|
||||||
|
drop over C! 1 + pop jump L
|
||||||
|
NL: drop drop pop
|
||||||
|
END: drop 0 over C! \ p
|
||||||
|
pop - SPAN a! ! ;
|
||||||
|
ZERO: drop drop 0 SPAN a! ! ;
|
||||||
|
|
||||||
|
\ ( -- ) read a line into TIB and start at its beginning
|
||||||
|
: QUERY TIB #TIB EXPECT 0 >IN a! ! ;
|
||||||
|
|
||||||
|
\ ---- WORD ------------------------------------------------------------------
|
||||||
|
\ (P)+0 the delimiter, (P)+1 the length of the text in TIB.
|
||||||
|
macro (WDELIM) (P) endmacro
|
||||||
|
macro (WLEN) (P) 1 + endmacro
|
||||||
|
|
||||||
|
: (LEFT) ( i -- i d ) dup (WLEN) a! @ - ; \ d < 0 while i is inside the text
|
||||||
|
: (CH) ( i -- i x ) dup TIB + C@ (WDELIM) a! @ xor ; \ x = 0 at a delimiter
|
||||||
|
: (SKIP) ( i -- i' ) \ past delimiters
|
||||||
|
L: (LEFT) -if E drop (CH) if S drop ;
|
||||||
|
S: drop 1 + jump L
|
||||||
|
E: drop ;
|
||||||
|
: (SCAN) ( i -- i' ) \ up to a delimiter
|
||||||
|
L: (LEFT) -if E drop (CH) if E drop 1 + jump L
|
||||||
|
E: drop ;
|
||||||
|
|
||||||
|
\ ( c -- baddr ) the next word of TIB delimited by c, as a counted string
|
||||||
|
\ in WBUF with a zero after it. Leading delimiters are skipped; so, as in
|
||||||
|
\ v3, are all those that follow the word. A word longer than 62 characters
|
||||||
|
\ is cut to 62. At the end of the text the count is 0.
|
||||||
|
: WORD
|
||||||
|
255 and (WDELIM) a! !
|
||||||
|
SPAN a! @ -if A drop 0 A: (WLEN) a! !
|
||||||
|
>IN a! @ -if B drop 0 B:
|
||||||
|
(SKIP) dup push (SCAN) \ end R: start
|
||||||
|
pop over over - \ end start len
|
||||||
|
dup -63 + -if CAP drop jump FITS CAP: drop drop 62 FITS:
|
||||||
|
dup WBUF C!
|
||||||
|
dup push push TIB + WBUF 1 + pop CMOVE \ end R: len
|
||||||
|
0 pop WBUF + 1 + C!
|
||||||
|
(SKIP) >IN a! ! WBUF ;
|
||||||
|
|
||||||
|
\ ---- ENCLOSE ---------------------------------------------------------------
|
||||||
|
\ (P)+0 the delimiter, (P)+1 the string's address.
|
||||||
|
: (E?) ( i -- i k ) \ k: 0 at the end of the string, 1 at a delimiter, else 2
|
||||||
|
dup (WLEN) a! @ + C@ if END (WDELIM) a! @ xor if DEL drop 2 ;
|
||||||
|
DEL: drop 1 ;
|
||||||
|
END: drop 0 ;
|
||||||
|
: (ESKIP) ( i -- i' ) L: (E?) -1 + if S drop ; S: drop 1 + jump L
|
||||||
|
: (ESCAN) ( i -- i' ) L: (E?) -2 + if S drop ; S: drop 1 + jump L
|
||||||
|
|
||||||
|
\ ( baddr c -- baddr n1 n2 n3 ) in the zero-terminated string at baddr:
|
||||||
|
\ n1 the offset of the first character that is not c, n2 the offset of the
|
||||||
|
\ first c after it, n3 the offset of the first character after that run of c.
|
||||||
|
: ENCLOSE
|
||||||
|
255 and (WDELIM) a! ! dup (WLEN) a! !
|
||||||
|
0 (ESKIP) dup (ESCAN) dup (ESKIP) ;
|
||||||
|
|
||||||
|
\ ---- CONVERT and NUMBER ----------------------------------------------------
|
||||||
|
\ ( c -- n ) the value of the digit c, 0 .. 35, in either case; -1 if none
|
||||||
|
: (DIGIT)
|
||||||
|
dup -48 + -if GE0 drop drop -1 ;
|
||||||
|
GE0: drop dup -58 + -if GT9 drop -48 + ;
|
||||||
|
GT9: drop dup -65 + -if GEA drop drop -1 ;
|
||||||
|
GEA: drop dup -91 + -if GTZ drop -55 + ;
|
||||||
|
GTZ: drop dup -97 + -if GEa drop drop -1 ;
|
||||||
|
GEa: drop dup -123 + -if GTz drop -87 + ;
|
||||||
|
GTz: drop drop -1 ;
|
||||||
|
|
||||||
|
\ ( d1 baddr1 -- d2 baddr2 ) FORTH-79: the characters from baddr1 + 1 on are
|
||||||
|
\ taken as digits in the current BASE, each accumulated into the double after
|
||||||
|
\ it is multiplied by BASE, until one is not a digit; baddr2 is its address.
|
||||||
|
\ (P)+2 holds the digit while the double is multiplied and (P)+5 the address,
|
||||||
|
\ so nothing waits on the return stack across the calls.
|
||||||
|
: CONVERT
|
||||||
|
L: 1 + dup (P) 5 + a! ! C@ (DIGIT) \ lo hi n
|
||||||
|
-if DIG drop (P) 5 + a! @ ;
|
||||||
|
DIG: dup (BASE) - -if BIG
|
||||||
|
drop (P) 2 + a! ! \ lo hi
|
||||||
|
(BASE) UM* drop \ lo hi*base
|
||||||
|
SWAP (BASE) UM* \ hi*base plo phi
|
||||||
|
push SWAP pop + \ plo hi'
|
||||||
|
(P) 2 + a! @ 0 D+
|
||||||
|
(P) 5 + a! @ jump L
|
||||||
|
BIG: drop drop (P) 5 + a! @ ;
|
||||||
|
|
||||||
|
\ ( baddr -- d ) FORTH-79: the counted string at baddr as a signed double in
|
||||||
|
\ the current BASE; it may begin with a minus sign. If it is empty, is only
|
||||||
|
\ a sign, or holds anything that is not a digit, the result is 0 and
|
||||||
|
\ NODE-ERROR is set. The character after the string must not be a digit
|
||||||
|
\ (WORD puts a zero there); if it is, that too is reported as an error. (P)+3 the address of its last character, (P)+4 the sign.
|
||||||
|
: NUMBER
|
||||||
|
dup C@ if ERR2
|
||||||
|
over + (P) 3 + a! ! \ baddr
|
||||||
|
dup 1 + C@ -45 + if NEG
|
||||||
|
drop 0 (P) 4 + a! ! jump GO
|
||||||
|
NEG: drop -1 (P) 4 + a! ! 1 +
|
||||||
|
dup (P) 3 + a! @ xor if ERR2 drop
|
||||||
|
GO: push 0 0 pop CONVERT \ lo hi baddr2
|
||||||
|
(P) 3 + a! @ 1 + xor if FINE
|
||||||
|
drop drop drop jump ERR0
|
||||||
|
FINE: drop (P) 4 + a! @ if POS drop jump DNEGATE
|
||||||
|
POS: drop ;
|
||||||
|
ERR2: drop drop
|
||||||
|
ERR0: NODE-ERROR b! -1 !b 0 0 ;
|
||||||
|
|
||||||
|
\ ---- comments (5.15) -------------------------------------------------------
|
||||||
|
\ PAREN skips to the closing parenthesis; BACKSLASH skips the rest of the line.
|
||||||
|
: PAREN 41 WORD drop ;
|
||||||
|
: BACKSLASH SPAN a! @ >IN a! ! ;
|
||||||
@@ -101,7 +101,7 @@ typedef struct {
|
|||||||
|
|
||||||
unsigned line;
|
unsigned line;
|
||||||
int failed;
|
int failed;
|
||||||
char message[160];
|
char message[224];
|
||||||
} v4_text;
|
} v4_text;
|
||||||
|
|
||||||
/* Start assembling at word address `origin` of node `n`. */
|
/* Start assembling at word address `origin` of node `n`. */
|
||||||
@@ -115,6 +115,9 @@ void v4_text_constant(v4_text *t, const char *name, v4_cell value);
|
|||||||
* has been no error. */
|
* has been no error. */
|
||||||
int v4_text_assemble(v4_text *t, const char *source);
|
int v4_text_assemble(v4_text *t, const char *source);
|
||||||
|
|
||||||
|
/* The same for the text in the file at `path`. Its errors name the file. */
|
||||||
|
int v4_text_assemble_file(v4_text *t, const char *path);
|
||||||
|
|
||||||
/* Finish: every branch must have found its target. Returns 1 if there has
|
/* Finish: every branch must have found its target. Returns 1 if there has
|
||||||
* been no error. Assembling may continue afterwards. */
|
* been no error. Assembling may continue afterwards. */
|
||||||
int v4_text_finish(v4_text *t);
|
int v4_text_finish(v4_text *t);
|
||||||
|
|||||||
@@ -394,6 +394,35 @@ int v4_text_assemble(v4_text *t, const char *source)
|
|||||||
return !t->failed;
|
return !t->failed;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
int v4_text_assemble_file(v4_text *t, const char *path)
|
||||||
|
{
|
||||||
|
const char *base = strrchr(path, '/');
|
||||||
|
char *text = NULL, was[sizeof t->message];
|
||||||
|
long size = 0;
|
||||||
|
FILE *f;
|
||||||
|
|
||||||
|
if (t->failed) return 0;
|
||||||
|
base = base ? base + 1 : path;
|
||||||
|
f = fopen(path, "rb");
|
||||||
|
if (f && fseek(f, 0, SEEK_END) == 0 && (size = ftell(f)) >= 0 && fseek(f, 0, SEEK_SET) == 0)
|
||||||
|
text = malloc((size_t)size + 1u);
|
||||||
|
if (!text || fread(text, 1, (size_t)size, f) != (size_t)size) {
|
||||||
|
if (f) fclose(f);
|
||||||
|
free(text);
|
||||||
|
t->line = 0;
|
||||||
|
fail(t, "cannot read", path);
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
fclose(f);
|
||||||
|
text[size] = 0;
|
||||||
|
if (!v4_text_assemble(t, text)) {
|
||||||
|
memcpy(was, t->message, sizeof was);
|
||||||
|
snprintf(t->message, sizeof t->message, "%.40s, %.170s", base, was);
|
||||||
|
}
|
||||||
|
free(text);
|
||||||
|
return !t->failed;
|
||||||
|
}
|
||||||
|
|
||||||
int v4_text_finish(v4_text *t)
|
int v4_text_finish(v4_text *t)
|
||||||
{
|
{
|
||||||
if (t->failed) return 0;
|
if (t->failed) return 0;
|
||||||
|
|||||||
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user