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>
73 lines
3.3 KiB
Plaintext
73 lines
3.3 KiB
Plaintext
\ log.v4 -- logging, as v3: a message has a level, and is printed if the
|
|
\ level is at or below LOG-LEVEL.
|
|
\
|
|
\ DECOMPOSITION.md 5.25: the level constants LOG-ERROR LOG-WARN LOG-INFO
|
|
\ LOG-TEST LOG-DEBUG (0 .. 4), LOG-LEVEL! LOG-LEVEL@, LOG-ERROR" ... LOG-DEBUG"
|
|
\ and LOG-ERROR-STR ... LOG-DEBUG-STR. Part of the compiler capsule; rests
|
|
\ on core.v4, codegen.v4 and quit.v4.
|
|
\
|
|
\ WHAT IS PRINTED is v3's line without its time of day, which a node has
|
|
\ not got: the level's colour, the level's name and a colon, the colour off,
|
|
\ the text, a new line --
|
|
\ ESC [32m INFO: ESC [0m text
|
|
\ On the mesh a message will go to the recorder's log ring (5.25); until
|
|
\ then it goes to the console.
|
|
\
|
|
\ Constants the loader supplies:
|
|
\ (LOG-LEVEL) word address of the variable: 2, LOG-INFO, at switch-on
|
|
|
|
header LOG-ERROR inline : LOG-ERROR 0 ;
|
|
header LOG-WARN inline : LOG-WARN 1 ;
|
|
header LOG-INFO inline : LOG-INFO 2 ;
|
|
header LOG-TEST inline : LOG-TEST 3 ;
|
|
header LOG-DEBUG inline : LOG-DEBUG 4 ;
|
|
|
|
header LOG-LEVEL@
|
|
: LOG-LEVEL@ ( -- n ) (LOG-LEVEL) a! @ ;
|
|
\ ( n -- ) as v3: a level below 0 is 0, one above 4 is 4
|
|
header LOG-LEVEL!
|
|
: LOG-LEVEL!
|
|
-if POS drop 0 jump SET
|
|
POS: dup -5 + -if BIG drop jump SET
|
|
BIG: drop drop 4
|
|
SET: (LOG-LEVEL) a! ! ;
|
|
|
|
\ ( baddr u level -- ) the message, if the level is at or below LOG-LEVEL
|
|
: (LOG)
|
|
dup inv (LOG-LEVEL) a! @ + 1 + -if SHOW drop drop drop drop ; \ LOG-LEVEL - level
|
|
SHOW: drop
|
|
if P0 -1 + if P1 -1 + if P2 -1 + if P3 -1 + if P4
|
|
drop jump OUT
|
|
P0: drop $31335B1B (EMIT4) $6D (EMIT4) $4F525245 (EMIT4) $203A52 (EMIT4) $6D305B1B (EMIT4) jump OUT
|
|
P1: drop $33335B1B (EMIT4) $6D (EMIT4) $4E524157 (EMIT4) $203A (EMIT4) $6D305B1B (EMIT4) jump OUT
|
|
P2: drop $32335B1B (EMIT4) $6D (EMIT4) $4F464E49 (EMIT4) $203A (EMIT4) $6D305B1B (EMIT4) jump OUT
|
|
P3: drop $35335B1B (EMIT4) $6D (EMIT4) $54534554 (EMIT4) $203A (EMIT4) $6D305B1B (EMIT4) jump OUT
|
|
P4: drop $34335B1B (EMIT4) $6D (EMIT4) $55424544 (EMIT4) $203A47 (EMIT4) $6D305B1B (EMIT4) jump OUT
|
|
OUT: TYPE jump CR
|
|
|
|
header LOG-ERROR-STR : LOG-ERROR-STR ( baddr u -- ) 0 jump (LOG)
|
|
header LOG-WARN-STR : LOG-WARN-STR ( baddr u -- ) 1 jump (LOG)
|
|
header LOG-INFO-STR : LOG-INFO-STR ( baddr u -- ) 2 jump (LOG)
|
|
header LOG-TEST-STR : LOG-TEST-STR ( baddr u -- ) 3 jump (LOG)
|
|
header LOG-DEBUG-STR : LOG-DEBUG-STR ( baddr u -- ) 4 jump (LOG)
|
|
|
|
\ ( level -- ) the run time of LOG-xxx" : the text is after the call, as
|
|
\ for ." ; log it at that level and go on after it.
|
|
header (LOG") compile-only
|
|
: (LOG")
|
|
pop 4* dup C@ over + 4/ 1 + push \ level baddr R: the cell after the text
|
|
COUNT ROT jump (LOG)
|
|
|
|
\ ( level -- ) LOG-xxx" text" logs the text -- now, if interpreting; when
|
|
\ the word it is compiled into runs, if compiling. (Q)+3 holds the level.
|
|
: (LOG-QUOTE)
|
|
(Q)+3 a! ! 34 (PARSE) drop
|
|
STATE a! @ if NOW
|
|
drop (Q)+3 a! @ (LIT,) &(LOG") (CALL,) jump (STRING,)
|
|
NOW: drop WBUF COUNT (Q)+3 a! @ jump (LOG)
|
|
header LOG-ERROR" immediate : LOG-ERROR-QUOTE 0 jump (LOG-QUOTE)
|
|
header LOG-WARN" immediate : LOG-WARN-QUOTE 1 jump (LOG-QUOTE)
|
|
header LOG-INFO" immediate : LOG-INFO-QUOTE 2 jump (LOG-QUOTE)
|
|
header LOG-TEST" immediate : LOG-TEST-QUOTE 3 jump (LOG-QUOTE)
|
|
header LOG-DEBUG" immediate : LOG-DEBUG-QUOTE 4 jump (LOG-QUOTE)
|