Artifact ecf2e634ab7f2082a110b1a22f2134899d5c3213:

• File debugging.fs — part of check-in [b9cb7d1176] at 2019-05-04 10:11:33 on branch trunk — Use dummy-dict to create dummy local (user: bernd size: 5664)

\ debugging aids

false [IF]
    : debug: ( -- )  Create immediate false ,
      DOES>
	@ IF  ['] noop assert-canary
	ELSE  postpone (  THEN ;
    : )else(  ]] ) ( [[ ; immediate \ )
[THEN]

: nodebug: ['] ( Alias immediate ;

require xtype.fs
require base64.fs
require base85.fs

: .nnb ( addr n -- )  85type ;
: .64b ( addr -- ) 64 .nnb ;

synonym \U \G \ comment for help
synonym \O \G \ comment for help

\ debugging switches

debug: timing(
debug: bursts(
debug: resend(
debug: track(
debug: cmd(
debug: cmd0(
debug: msg(
debug: timeout(
debug: wait(
debug: ack(
debug: acks(
debug: crypt(
debug: noens(
debug: key( \ key stuff
debug: vkey( \ vault key stuff
debug: genkey( \ See generated keys - never let this go to a log file!
debug: mykey( \ debug mykey things
debug: cookie( 
debug: tag(
debug: flush(
debug: address(
debug: trace(
debug: header(
debug: sender( \ extra sender task
debug: dht( \ debugging for dht functions
debug: file( \ file read/write debugging
debug: file1( \ simple file read/write debugging
debug: nat( \ NAT traversal stuff
debug: netlink( \ Netlink changes
debug: route( \ do routing
debug: ipv6( \ use ipv6
debug: ipv4( \ use ipv4
debug: request( \ track requests
debug: beacon( \ debug sending beacons
debug: invalid( \ print invalid packets
debug: regen( \ regenerate keys
debug: recvfrom(
debug: sendto(
debug: avalanche( \ distribution tree
debug: adjust-timer( \ adjust timer
debug: reply( \ test replies
debug: connect( \ connect debugging messages
debug: reveal( \ reveal secrets
debug: reconnect( \ reconnect
debug: tweak( \ tweaked key
debug: ivs( \ IVS regen
debug: rtd( \ round trip delay related stuff
debug: no0key( \ generate 0key, default off for now
debug: dvcs( \ print debugging for dvcs
debug: dvcsfiles( \ print debugging for dvcs
debug: rate( \ print debugging for rate settings
debug: health( \ print that a health check passed
debug: verbose( \ print more verbose messages
debug: quicksig( \ quick check for sigs
debug: slurp( \ debug slurp&spit
debug: wallet( \ debug wallet stuff
debug: qr( \ qr code stuff
debug: deprecated( \ deprecated stuff
debug: unhandled( \ unhandled commands
debug: syncfile( \ synchronous file operations

-db profile( \ don't profile by default )
+db ipv6( \ ipv6 should be on by default )
+db ipv4( \ ipv4 should be on by default )
+db syncfile( \ disable async file operations for now )

\ key debugging task

: toggle ( addr -- )  dup @ 0= swap ! ;

0 Value debug-task
: new-debug-task ( -- ) debug-task ?EXIT
    stacksize4 NewTask4 dup to debug-task activate
    BEGIN  case key
	    'c' of  ['] cmd( >body toggle  endof
	    'm' of  ['] msg( >body toggle  endof
	    'r' of  ['] resend( >body toggle  endof
	    'f' of  ['] file( >body toggle  endof
	    't' of  ['] timeout( >body toggle  endof
	endcase
    AGAIN ;

\ timing ticks

false [IF]
    ' noop alias init-timer
    ' noop alias .times
    : timer: ['] noop alias immediate ;
[THEN]

timer: +file
timer: +send-cmd
timer: +sendX2
timer: +sendX
timer: +chunk
timer: +desta
timer: +inmove
timer: +next
timer: +reset
timer: +event
timer: +calc
timer: +cryptsu
timer: +enc
timer: +rec
timer: +send
timer: +wait
timer: +cmd
timer: +dest
timer: +ack

\ buffered typing

Ustack b$

[IFUNDEF] inskey
    : inskey ( key -- )  key-buffer c$+! ;
[THEN]

up@ Value main-up@

:noname defers 'cold up@ to main-up@ ; is 'cold

Variable edit-restart
:noname ( span addr u -- )
    2 pick 0= IF  0 edit-restart !@ ?dup-IF  wake  THEN  THEN
    defers edit-update ; is edit-update

event: :>type ( $string -- ) { w^ x } x $@ type x $free ;
event: :>hide ( -- ) ctrl Z unkey ;
: <hide> ( task -- ) up@ edit-restart ! <event :>hide event>
    #30000000 stop-ns  edit-restart off ;
: btype  b$ $+! ;
: bemit  b$ c$+! ;
: bflush ( -- )
    [IFUNDEF] gl-emit      b$ $@ defers type b$ $off
    [ELSE]
	up@ main-up@ = IF  b$ $@ defers type b$ $off  EXIT  THEN
	0 b$ !@ <event elit, :>type main-up@ event>
    [THEN] ;
: bcr    #lf bemit bflush ;
: bat-deltaxy ( dx dy -- ) drop
    dup 0> IF  0 ?DO  bl bemit  LOOP
    ELSE  >r  b$ dup $@len r@ + r> negate $del  THEN ;

' btype ' bemit ' bcr ' form output: b-out
op-vector @
b-out
[IFUNDEF] gl-emit ' (attr!) is attr! [THEN] \ no color on android
' bat-deltaxy is at-deltaxy
op-vector !
\ ' noop alias b-out

:noname defers DoError bflush ; is DoError
:noname defers .debugline bflush ; is .debugline

\ misc

[IFUNDEF] do-debug
    : do-debug ( xt -- )
	op-vector @ { oldout }
	debug-vector @ op-vector !
	catch oldout op-vector ! throw ;
[THEN]

: etype ( addr u -- ) >stderr type ;
: $err ( xt -- )  $tmp stderr write-file throw ;
\ : $err ( xt -- ) execute ;

\ extra hints for last word executed

false [IF]
    User last-exe-xt
    : .exe ( -- ) last-exe-xt @ .name ;
    : : ( "name" -- colon-sys )
	: lastxt ]]L last-exe-xt ! [[ ;
[ELSE]
    : .exe ;
[THEN]

\ more phony throw stuff, only for debugging engine

debugging-method [defined] record-locs and [IF] record-locs [THEN]
debugging-method drop false [IF]
:noname  ." Store backtrace..." cr defers store-backtrace
    dobacktrace ; is store-backtrace

:noname  ?dup-IF  ." Throw directly " dup . cr dobacktrace
	defers throw  THEN ; is throw
[THEN]

\ Emacs fontlock mode: Highlight more stuff

\\\
Local Variables:
forth-local-words:
    (
     (("debug:" "timer:")
      non-immediate (font-lock-type-face . 2)
      "[ \t\n]" t name (font-lock-variable-name-face . 3))
     ("[a-z]+(" immediate (font-lock-comment-face . 1)
      ")" nil comment (font-lock-comment-face . 1))
     (("[:") definition-starter (font-lock-keyword-face . 1))
     ((";]") definition-ender (font-lock-keyword-face . 1))
    )
End:
[THEN]