rajamesandClaude Opus 5.5
384a6c1cd2
- capsule/log.v4: the level constants LOG-ERROR .. LOG-DEBUG, LOG-LEVEL! and LOG-LEVEL@, LOG-ERROR" .. LOG-DEBUG" and LOG-ERROR-STR .. LOG-DEBUG-STR. A message is printed if its level is at or below LOG-LEVEL, as v3's line -- colour, level, text -- without the time of day, which a node has not got. - LOG-xxx" compiles like ." : the level, a call to (LOG"), the text. SEE shows it as text. COLD puts LOG-LEVEL back to LOG-INFO. - tests/test_host_quit.c: ten transcripts of the v3 binary, every level at every setting. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
83 lines
3.2 KiB
Forth
83 lines
3.2 KiB
Forth
\ tools.fth -- SEE, in FORTH.
|
|
\
|
|
\ This file is FORTH source, compiled by the node a line at a time; no line
|
|
\ is longer than 79 characters.
|
|
\
|
|
\ v4 code is native: a definition is instruction words, six five-bit opcodes
|
|
\ to a word, so SEE is a disassembler. It prints the name, then each
|
|
\ instruction word on a line: the opcodes by name, a literal's value after
|
|
\ its @p, and after a call or a branch the name of the word it goes to, or
|
|
\ the address if that is not a word. Text compiled by ." S" or ABORT" is
|
|
\ shown in quotes after the call it follows. Padding (nop) is not shown.
|
|
\ It stops at the first ; ex or jump that no earlier branch goes past.
|
|
|
|
FORTH DEFINITIONS
|
|
|
|
\ the opcode names, five characters each, in the order of their numbers
|
|
: (OPS1) S" ; ex jump call unextnext if -if @p @+ @b @ " ;
|
|
: (OPS2) S" !p !+ !b ! +* 2* 2/ inv + and xor drop " ;
|
|
: (OPS3) S" dup pop over a nop push b! a! " ;
|
|
: (.OP) ( op -- )
|
|
DUP 12 < IF (OPS1) ELSE DUP 24 < IF 12 - (OPS2) ELSE 24 - (OPS3) THEN THEN
|
|
DROP SWAP 5 * + 5 -TRAILING TYPE ;
|
|
|
|
VARIABLE (SP) \ the address after the instruction word being shown
|
|
VARIABLE (SW) \ that word
|
|
VARIABLE (SK) \ the slot
|
|
VARIABLE (SOP) \ the opcode last shown
|
|
VARIABLE (SLITS) \ how many literals the word has had so far
|
|
VARIABLE (SEND) \ the furthest a branch has gone forward
|
|
VARIABLE (SN) \ how many lines
|
|
|
|
\ ( -- xt ) the newest word of FORTH
|
|
: (HEAD) CONTEXT @ >R [COMPILE] FORTH CONTEXT @ @ R> CONTEXT ! ;
|
|
\ ( addr xt -- baddr | 0 ) the name of the word at addr, in the list from xt
|
|
: (IN-LIST)
|
|
BEGIN DUP WHILE 2DUP = IF SWAP DROP >NAME EXIT THEN >LINK @ REPEAT
|
|
SWAP DROP ;
|
|
\ ( addr -- ) its name if it is a word, else the number
|
|
: (.ADDR)
|
|
DUP CONTEXT @ @ (IN-LIST) ?DUP 0= IF DUP (HEAD) (IN-LIST) THEN
|
|
?DUP IF COUNT 31 AND TYPE DROP ELSE 0 .R THEN ;
|
|
\ ( -- addr ) where the branch in this slot goes
|
|
: (TARGET)
|
|
1 27 (SK) @ 5 * - LSHIFT 1-
|
|
DUP INVERT (SP) @ AND SWAP (SW) @ AND OR ;
|
|
\ ( addr -- ) after a call to addr: if it is one of the words that are
|
|
\ followed by text, show the text and count its cells with the literals
|
|
: (TEXT?)
|
|
DUP ['] (.") = OVER ['] (ABORT") = OR OVER ['] (LOG") = OR
|
|
SWAP ['] (S") = OR IF
|
|
(SP) @ (SLITS) @ + 4 * COUNT 34 EMIT 2DUP TYPE 34 EMIT SPACE
|
|
SWAP DROP 4 + 4 / (SLITS) +!
|
|
THEN ;
|
|
\ ( -- flag ) show this slot; true if the instruction word ends with it
|
|
: (SLOT)
|
|
(SW) @ 27 (SK) @ 5 * - RSHIFT 31 AND
|
|
DUP 28 = IF DROP 0 EXIT THEN
|
|
DUP (SOP) ! DUP (.OP) SPACE
|
|
DUP 8 = IF (SP) @ (SLITS) @ + @ . 1 (SLITS) +! THEN
|
|
DUP 2 = OVER 3 = OR OVER 5 = OR OVER 6 = OR OVER 7 = OR IF
|
|
(TARGET) DUP (.ADDR) SPACE
|
|
SWAP 3 = IF (TEXT?) ELSE (SEND) @ MAX (SEND) ! THEN
|
|
-1 EXIT
|
|
THEN
|
|
2 < ;
|
|
: (SEE-LINE) ( -- )
|
|
(SP) @ @ (SW) ! 1 (SP) +! 0 (SLITS) ! 0 (SK) ! 28 (SOP) !
|
|
2 SPACES
|
|
BEGIN (SLOT) IF -1 ELSE 1 (SK) +! (SK) @ 6 = THEN UNTIL
|
|
CR (SLITS) @ (SP) +! ;
|
|
: (SEE-CODE) ( xt -- )
|
|
DUP (SP) ! (SEND) ! 0 (SN) !
|
|
BEGIN (SEE-LINE) 1 (SN) +!
|
|
(SOP) @ 3 < (SP) @ (SEND) @ > AND (SN) @ 63 > OR
|
|
UNTIL ;
|
|
|
|
\ SEE xxx show the word xxx
|
|
: SEE
|
|
FIND DUP 0= ABORT" SEE: not found"
|
|
." : " DUP >NAME COUNT 31 AND TYPE CR
|
|
DUP 3 - @ 4 AND IF ." data: " DUP 1+ @ . CR ELSE DUP (SEE-CODE) THEN
|
|
3 - @ 1 AND IF ." IMMEDIATE" CR THEN ;
|