feat(v4.0.0): the editor, redone in FORTH; COLD WARM PAGE VERSION DEFER
- capsule/editor.fth: the block editor as FORTH source, which the node compiles itself. It is a vocabulary, EDITOR, used at the ordinary prompt: n EDIT, then L N B T P E D S H R I WIPE DONE. v3's EDIT, a shell of its own, is not carried over (ruled 2026-10-05); v3's L S and SHOW are kept in FORTH as they were, with COPY. - system.v4: COLD (the system as the loader left it), WARM, PAGE, VERSION, 79-STANDARD (FORTH-79: silent), and DEFER IS DEFER@ as v3. - input.v4: where words are split at blanks a zero byte reads as a blank, so a block never written, or filled a line at a time, loads cleanly. - tests/test_host_quit.c: the editor's source fed to the prompt line by line, every command on empty and full screens, what reaches storage; the system words; deferred words. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
c8dc14897c
commit
a1afb44598
@@ -17,6 +17,7 @@
|
||||
\ 9 Shift count out of range 10 Protected word
|
||||
\ 11 Division by zero (Q./) 12 Argument out of range
|
||||
\ 13 Block out of range 14 No block is being loaded
|
||||
\ 15 Deferred word not set
|
||||
\ -1 the word has printed its own message
|
||||
|
||||
macro SWAP over push push drop pop pop endmacro
|
||||
|
||||
@@ -0,0 +1,68 @@
|
||||
\ editor.fth -- the block editor, in FORTH.
|
||||
\
|
||||
\ This file is FORTH source: the node compiles it itself, a line at a time,
|
||||
\ as if it were typed. No line is longer than 79 characters.
|
||||
\
|
||||
\ A block is a screen of 16 lines of 64 characters. SCR is the screen being
|
||||
\ edited. The editor is a vocabulary, EDITOR: its words are ordinary FORTH
|
||||
\ words used at the ordinary prompt, so everything else is there as well.
|
||||
\
|
||||
\ n EDIT edit screen n: list it and make EDITOR the CONTEXT vocabulary
|
||||
\ L list the screen N B the next, the one before
|
||||
\ n T type line n
|
||||
\ n P text put the rest of the input line on line n
|
||||
\ n E erase line n WIPE blank the whole screen
|
||||
\ n D delete line n; the lines below move up; it is held in PAD
|
||||
\ n S spread: a blank line at n; the lines from n move down
|
||||
\ n H hold line n in PAD n R replace line n from PAD
|
||||
\ n I insert PAD's line at n
|
||||
\ DONE write what has changed and go back to FORTH
|
||||
\ a b COPY copy screen a to screen b (in FORTH)
|
||||
\
|
||||
\ Every change is UPDATEd; nothing reaches storage until FLUSH or DONE, or
|
||||
\ until the buffer is wanted for another block.
|
||||
|
||||
FORTH DEFINITIONS
|
||||
|
||||
\ ( baddr -- ) 64 characters; a zero shows as a blank, others as a dot
|
||||
: (.LINE)
|
||||
64 0 DO DUP I + C@
|
||||
DUP 0= IF DROP 32 THEN DUP 32 < OVER 126 > OR IF DROP 46 THEN EMIT
|
||||
LOOP DROP ;
|
||||
\ ( n -- baddr ) where line n of screen SCR is
|
||||
: (LINE)
|
||||
DUP 0< OVER 15 > OR ABORT" Line out of range" 64 * SCR @ BLOCK + ;
|
||||
|
||||
\ v3's three: a line shown, a line set from a string, the screen shown
|
||||
: L ( n -- ) (LINE) (.LINE) CR ;
|
||||
: S ( baddr u n -- )
|
||||
(LINE) DUP 64 BLANK SWAP 0 MAX 64 MIN CMOVE UPDATE ;
|
||||
: SHOW ( -- )
|
||||
." Screen " SCR @ 0 .R ." :" CR
|
||||
16 0 DO I 2 .R ." : " I (LINE) (.LINE) CR LOOP ;
|
||||
|
||||
: COPY ( from to -- ) SWAP BLOCK SWAP BUFFER 1024 CMOVE UPDATE ;
|
||||
|
||||
VOCABULARY EDITOR EDITOR DEFINITIONS
|
||||
|
||||
: T ( n -- ) DUP (LINE) SWAP 2 .R ." : " (.LINE) CR ;
|
||||
: L ( -- ) SHOW ;
|
||||
: E ( n -- ) (LINE) 64 BLANK UPDATE ;
|
||||
: P ( n -- ) (LINE) DUP 64 BLANK 0 WORD COUNT 64 MIN ROT SWAP CMOVE UPDATE ;
|
||||
: H ( n -- ) (LINE) PAD 64 CMOVE ;
|
||||
: R ( n -- ) PAD SWAP (LINE) 64 CMOVE UPDATE ;
|
||||
: D ( n -- )
|
||||
DUP H DUP 15 < IF
|
||||
DUP 1+ (LINE) OVER (LINE) ROT 15 SWAP - 64 * CMOVE
|
||||
ELSE DROP THEN 15 E ;
|
||||
: S ( n -- )
|
||||
DUP 15 < IF DUP (LINE) OVER 1+ (LINE) 3 PICK 15 SWAP - 64 * CMOVE> THEN E ;
|
||||
: I ( n -- ) DUP S R ;
|
||||
: WIPE ( -- ) SCR @ BLOCK 1024 BLANK UPDATE ;
|
||||
: N ( -- ) 1 SCR +! L ;
|
||||
: B ( -- ) -1 SCR +! L ;
|
||||
: DONE ( -- ) FLUSH [COMPILE] FORTH ;
|
||||
|
||||
FORTH DEFINITIONS
|
||||
|
||||
: EDIT ( n -- ) DUP BLOCK DROP SCR ! EDITOR [ EDITOR ] L [ FORTH ] ;
|
||||
+9
-1
@@ -71,9 +71,17 @@ header QUERY
|
||||
\ (CONVERT and NUMBER use (P)+2 .. (P)+5; they and WORD never run inside
|
||||
\ each other.)
|
||||
|
||||
\ ( -- c ) the character WORD is at. A zero reads as a blank when words
|
||||
\ are being split at blanks: a block that has never been written is all
|
||||
\ zeros, and so is the end of one whose lines were put there one at a time.
|
||||
: (SRC@)
|
||||
(P)+6 a! @ (SRC) a! @ + C@ if Z ;
|
||||
Z: drop (P) a! @ -32 + if B drop 0 ;
|
||||
B: drop 32 ;
|
||||
|
||||
\ In line, not called: WORD may have only a few return entries to spare.
|
||||
macro (LEFT) (P)+6 a! @ (P)+1 a! @ - endmacro \ ( -- d ) d < 0 while inside the text
|
||||
macro (CH) (P)+6 a! @ (SRC) a! @ + C@ (P) a! @ xor endmacro \ ( -- x ) x = 0 at a delimiter
|
||||
macro (CH) (SRC@) (P) a! @ xor endmacro \ ( -- x ) x = 0 at a delimiter
|
||||
macro (STEP) (P)+6 a! @ 1 + ! endmacro
|
||||
|
||||
\ ( c -- baddr ) FORTH-79: characters are taken from TIB until the
|
||||
|
||||
@@ -99,6 +99,7 @@ header ABORT
|
||||
POS: -1 + if M1 -1 + if M2 -1 + if M3 -1 + if M4
|
||||
-1 + if M5 -1 + if M6 -1 + if M7 -1 + if M8 -1 + if M9
|
||||
-1 + if M10 -1 + if M11 -1 + if M12 -1 + if M13 -1 + if M14
|
||||
-1 + if M15
|
||||
drop 2 jump (REPL)
|
||||
M1: drop $6167654E (EMIT4) $65766974 (EMIT4) $756F6320 (EMIT4) $746E (EMIT4) CR 2 jump (REPL)
|
||||
M2: drop $20746F4E (EMIT4) $756E2061 (EMIT4) $7265626D (EMIT4) CR 2 jump (REPL)
|
||||
@@ -114,6 +115,7 @@ header ABORT
|
||||
M12: drop $75677241 (EMIT4) $746E656D (EMIT4) $74756F20 (EMIT4) $20666F20 (EMIT4) $676E6172 (EMIT4) $65 (EMIT4) CR 2 jump (REPL)
|
||||
M13: drop $636F6C42 (EMIT4) $756F206B (EMIT4) $666F2074 (EMIT4) $6E617220 (EMIT4) $6567 (EMIT4) CR 2 jump (REPL)
|
||||
M14: drop $62206F4E (EMIT4) $6B636F6C (EMIT4) $20736920 (EMIT4) $6E696562 (EMIT4) $6F6C2067 (EMIT4) $64656461 (EMIT4) CR 2 jump (REPL)
|
||||
M15: drop $65666544 (EMIT4) $64657272 (EMIT4) $726F7720 (EMIT4) $6F6E2064 (EMIT4) $65732074 (EMIT4) $74 (EMIT4) CR 2 jump (REPL)
|
||||
|
||||
\ The table the loader gives the node: six words, one for each kind of
|
||||
\ fault in the node's order, each a jump. A jump fills its word, so they
|
||||
|
||||
@@ -7,6 +7,7 @@
|
||||
\ FENCE word address of the variable: FORGET will not remove an entry
|
||||
\ that starts below the address it holds
|
||||
\ VOC-LINK word address of the variable: the newest vocabulary, or 0
|
||||
\ (BOOT) word address of two cells: DP and (LATEST) as the loader left them
|
||||
|
||||
header FENCE inline : FENCE' FENCE ;
|
||||
|
||||
@@ -104,3 +105,64 @@ header FORGET
|
||||
C2: CURRENT a! @ (Q) a! @ inv + 1 + -if C3 drop ;
|
||||
C3: drop (LATEST) CURRENT a! ! ;
|
||||
MISSING: drop (UNKNOWN) drop ;
|
||||
|
||||
\ ---- the system as a whole -------------------------------------------------------
|
||||
\ (BOOT) is two cells the loader fills when the capsule is in place: DP and
|
||||
\ the newest FORTH entry as they then are. COLD goes back to them.
|
||||
|
||||
\ FORTH-79: execute to be sure a FORTH-79 system is there. It is: nothing
|
||||
\ happens. (v3's prints two lines and leaves a flag.)
|
||||
header 79-STANDARD
|
||||
: 79-STANDARD ;
|
||||
|
||||
\ ( -- ) which system this is, and its cell width
|
||||
header VERSION
|
||||
: VERSION
|
||||
$72617453 (EMIT4) $74726F46 (EMIT4) $34762068 (EMIT4) $302E302E (EMIT4) $38314620 (EMIT4) $20 (EMIT4)
|
||||
N-1 1 + 0 U-DOT-R $7469622D (EMIT4) CR ;
|
||||
|
||||
\ ( -- ) clear the screen and put the cursor at the top, as v3: ESC [2J ESC [H
|
||||
header PAGE
|
||||
: PAGE 27 EMIT 91 EMIT 50 EMIT 74 EMIT 27 EMIT 91 EMIT 72 jump EMIT
|
||||
|
||||
\ ( -- ) as v3's message, and then ABORT: both stacks emptied, the prompt
|
||||
header WARM
|
||||
: WARM
|
||||
$54524F46 (EMIT4) $39372D48 (EMIT4) $72615720 (EMIT4) $7453206D (EMIT4) $747261 (EMIT4) CR
|
||||
$74737953 (EMIT4) $72206D65 (EMIT4) $61747365 (EMIT4) $64657472 (EMIT4) $2E (EMIT4) CR
|
||||
jump ABORT
|
||||
|
||||
\ ( -- ) the system as it was when the capsule had just been loaded:
|
||||
\ everything defined since is gone, there is one vocabulary, numbers are
|
||||
\ decimal, the block buffers are empty. Then as WARM.
|
||||
header COLD
|
||||
: COLD
|
||||
(BOOT) a! @ DP a! !
|
||||
(BOOT)+1 a! @ (LATEST) a! !
|
||||
(BOOT) a! @ 2/ 2/ FENCE a! !
|
||||
(LATEST) CONTEXT a! ! (LATEST) CURRENT a! ! 0 VOC-LINK a! !
|
||||
10 BASE a! ! 0 SCR a! ! EMPTY-BUFFERS
|
||||
$54524F46 (EMIT4) $39372D48 (EMIT4) $6C6F4320 (EMIT4) $74532064 (EMIT4) $747261 (EMIT4) CR
|
||||
$74737953 (EMIT4) $69206D65 (EMIT4) $6974696E (EMIT4) $7A696C61 (EMIT4) $2E6465 (EMIT4) CR
|
||||
jump ABORT
|
||||
|
||||
\ ---- deferred words (as v3) -------------------------------------------------------
|
||||
\ DEFER xxx makes xxx, which does whatever word it has been given:
|
||||
\ ' yyy IS xxx gives it one; DEFER@ xxx leaves the one it has. A deferred
|
||||
\ word with none is an error (code 15, "Deferred word not set").
|
||||
: (DODEFER)
|
||||
pop a! @ if UNSET push ; \ go to it: it returns to xxx's caller
|
||||
UNSET: drop NODE-ERROR b! 15 !b ;
|
||||
header DEFER
|
||||
: DEFER &(DODEFER) (C)+3 a! ! (DATA) (C)+8 a! @ if NONE drop 0 jump , NONE: drop ;
|
||||
: (is!) a! ! ;
|
||||
: (defer@) a! @ ;
|
||||
header IS immediate
|
||||
: IS
|
||||
(') STATE a! @ if NOW drop (LIT,) &(is!) jump (CALL,)
|
||||
NOW: drop jump (is!)
|
||||
header DEFER@ immediate
|
||||
: DEFER@
|
||||
(') STATE a! @ if NOW drop (LIT,) &(defer@) jump (CALL,)
|
||||
NOW: drop jump (defer@)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user