urflibs/debugger.f

   1 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; and now for something completely different...
   3 ;; UrForth/C Forth Engine!
   4 ;; Copyright (C) 2023 Ketmar Dark // Invisible Vector
   5 ;; GPLv3 ONLY
   6 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   7 ;; interactive debugger
   8 ;; optional; not included by default
   9 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11
  12 $INCLUDE-ONCE <linore.f>
  13
  14 VOCABULARY DEBUGGER
  15 ALSO-DEFS: DEBUGGER
  16
  17 ;; debugger task id
  18 0 VALUE debugger-task
  19 ;; task the we're debugging now
  20 0 VALUE debuggee-stid
  21
  22 ;; source file
  23 0 VALUE source-stx
  24 ;; source file name
  25 0 VALUE source-name-stx
  26
  27 FALSE VALUE ACTIVE?
  28
  29 ;; are we on the alt (debugger) screen now?
  30 FALSE VALUE ALT-SCR?
  31 TRUE VALUE ALT-CLEAR
  32
  33 ;; show keycodes?
  34 FALSE VALUE DEBUG-SHOW-KEYS
  35
  36
  37 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  38 ;; TTY helpers
  39 ;;
  40
  41 ;; switch to alternative screen
  42 : TO-ALT-SCR  ( -- )
  43   ALT-SCR? IFNOT
  44     FLUSH-EMIT
  45     ALT-CLEAR IF
  46       " \e[?1049h"
  47     ELSE
  48       " \e[?1048h\e[?47h"
  49     ENDIF
  50     TTY:RAW-TYPE \ TTY:RAW-FLUSH
  51     TRUE TO ALT-SCR?
  52   ENDIF
  53 ;
  54
  55 ;; switch to main screen
  56 : TO-MAIN-SCR  ( -- )
  57   ALT-SCR? IF
  58     ALT-CLEAR IF
  59       " \e[?1049l"
  60     ELSE
  61       " \e[?47l\e[?1048l"
  62     ENDIF
  63     TTY:RAW-TYPE TTY:RAW-FLUSH
  64     FALSE TO ALT-SCR?
  65   ENDIF
  66 ;
  67
  68
  69 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  70 ;; replace standard emit
  71 ;;
  72
  73 : (NEW-NORM-EMIT-CHAR)  ( ch -- ch )
  74   0xff AND ALT-SCR? IFNOT
  75     DUP 32 < IF
  76       CASE
  77         9 OF 9 ENDOF
  78         10 OF 10 ENDOF
  79         13 OF 13 ENDOF
  80         OTHERWISE DROP [CHAR] ?
  81       ENDCASE
  82     ELSE DUP 127 = IF DROP [CHAR] ? ENDIF
  83     ENDIF
  84   ENDIF
  85 ;
  86
  87 DEBUG:REPLACE (NORM-EMIT-CHAR) (NEW-NORM-EMIT-CHAR)
  88
  89
  90 : (DEBUG-EMIT)  ( ch -- )
  91   ;; for alt-screen, prepend CR to LF
  92   ALT-SCR? IF
  93     DUP NL = IF 13 TTY:RAW-EMIT ENDIF
  94   ENDIF
  95   DUP TTY:RAW-EMIT
  96   DUP NL = LASTCR!
  97   ;; for main screen, flush on CR or LF
  98   ALT-SCR? IFNOT
  99     DUP NL = SWAP 10 = OR IF TTY:RAW-FLUSH ENDIF
 100   ELSE DROP
 101   ENDIF
 102 ;
 103
 104 DEBUG:REPLACE (EMIT) (DEBUG-EMIT)
 105
 106
 107 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 108 ;; load source code
 109 ;;
 110
 111 : SAME-SOURCE?  ( addr count -- bool )
 112   0 MAX
 113   source-name-stx IF source-name-stx COUNT STRING:=
 114   ELSE 2DROP FALSE
 115   ENDIF
 116 ;
 117
 118 : FREE-SOURCE  ( -- )
 119   source-stx HANDLE:FREE 0-TO source-stx
 120   source-name-stx HANDLE:FREE 0-TO source-name-stx
 121 ;
 122
 123 : LOAD-SOURCE-FILE  ( addr count -- )
 124   FREE-SOURCE
 125   2DUP HANDLE:LOAD-FILE DUP TO source-stx
 126   IF
 127     0 HANDLE:NEW TO source-name-stx
 128     DUP 8 + source-name-stx HANDLE:SIZE!
 129     DUP source-name-stx !  ;; counter
 130     source-name-stx CELL+ SWAP MOVE
 131   ELSE 2DROP
 132   ENDIF
 133 ;
 134
 135 : LOAD-SOURCE  ( addr count -- )
 136   2DUP SAME-SOURCE? IF 2DROP
 137   ELSE DUP 0> IF LOAD-SOURCE-FILE ELSE 2DROP ENDIF
 138   ENDIF
 139 ;
 140
 141
 142 : SOURCE-C@  ( ofs -- char )
 143   source-stx IF
 144     DUP source-stx HANDLE:SIZE@ U< IF
 145       source-stx HANDLE:C@
 146       ?DUP IFNOT BL ENDIF
 147     ELSE DROP 0
 148     ENDIF
 149   ELSE DROP 0
 150   ENDIF
 151 ;
 152
 153
 154 : NORM-SOURCE-OFS  ( ofs -- ofs )
 155   source-stx IF 0 MAX source-stx HANDLE:SIZE@ MIN
 156   ELSE DROP 0
 157   ENDIF
 158 ;
 159
 160 : SOURCE-TO-BOL  ( ofs -- ofs )
 161   BEGIN
 162     DUP 1- + SOURCE-C@ DUP 0= SWAP NL = OR
 163   NOT-WHILE
 164     1-
 165   REPEAT
 166 ;
 167
 168 : SOURCE-TO-EOL  ( ofs -- ofs )
 169   BEGIN
 170     DUP SOURCE-C@ DUP 0= SWAP NL = OR
 171   NOT-WHILE
 172     1+
 173   REPEAT
 174 ;
 175
 176 ;; `ofs` is BOL
 177 : SOURCE-PREV-LINE  ( ofs -- ofs )
 178   1- SOURCE-TO-BOL NORM-SOURCE-OFS
 179 ;
 180
 181 ;; `ofs` is BOL
 182 : SOURCE-NEXT-LINE  ( ofs -- ofs )
 183   SOURCE-TO-EOL 1+ NORM-SOURCE-OFS
 184 ;
 185
 186 : FIND-SOURCE-LINE  ( line -- ofs )
 187   0 SWAP 1- FOR SOURCE-NEXT-LINE ENDFOR
 188 ;
 189
 190 : .-SOURCE-LINE  ( ofs -- next-line-ofs )
 191   DUP SOURCE-C@ IF
 192     BEGIN
 193       DUP SOURCE-C@ DUP 0= OVER NL = OR
 194     NOT-WHILE
 195       XEMIT 1+
 196     REPEAT DROP
 197     1+ CR
 198   ENDIF
 199 ;
 200
 201 : SHOW-SOURCE-LINE  ( addr count line -- )
 202   >R LOAD-SOURCE
 203   source-stx IF
 204     R@ 8 - FIND-SOURCE-LINE
 205     8 FOR .-SOURCE-LINE ENDFOR
 206     ." \e[0;1m" .-SOURCE-LINE ." \e[0m"
 207     8 FOR .-SOURCE-LINE ENDFOR
 208     DROP
 209   ENDIF
 210   RDROP
 211 ;
 212
 213
 214 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 215 ;; M-F5 to show main screen
 216 ;;
 217
 218 ALSO-DEFS: LINORE:OSC-ACTIONS
 219
 220 // M-F5
 221 : 15;3~  ( -- )
 222   ALT-SCR? IF TO-MAIN-SCR ELSE TO-ALT-SCR ENDIF
 223 ;
 224
 225 // F12
 226 // switch "show keys" mode
 227 : 24~  ( -- )
 228   DEBUG-SHOW-KEYS NOT TO DEBUG-SHOW-KEYS
 229 ;
 230
 231 PREV-DEFS
 232
 233
 234 DEFER (LINORE-DRAW-PROMPT)
 235
 236 ;; return TRUE if key should be eaten
 237 : (CHECK-KEY-ALT)  ( flag -- FALSE / TRUE )
 238   DROP ALT-SCR? IFNOT TO-ALT-SCR TRUE ELSE FALSE ENDIF
 239 ;
 240
 241 : (SHOW-KEYCODE)  ( ch -- )
 242   DUP 0< IF
 243     DEBUG-SHOW-KEYS IF
 244       CR
 245       ." KEY: code: " DUP .
 246       DUP 33 127 WITHIN IF ."  char: " DUP XEMIT ENDIF
 247       CR
 248     ENDIF
 249   ENDIF
 250   DROP
 251 ;
 252
 253 : (SHOW-OSC)  ( addr count -- )
 254   DEBUG-SHOW-KEYS IF
 255     CR
 256     ." OSC-KEY(" DUP 0 U.R ." ): "
 257     XTYPE
 258     CR
 259   ELSE 2DROP
 260   ENDIF
 261 ;
 262
 263 ..: LINORE:KEY-PROCESSOR  ( ch FALSE -- ch FALSE / TRUE )
 264   ACTIVE? IF
 265     DUP IFNOT
 266       (CHECK-KEY-ALT) IF DROP TRUE ELSE FALSE ENDIF
 267       DUP IFNOT >R DUP (SHOW-KEYCODE) R> ENDIF
 268     ENDIF
 269   ENDIF
 270 ;..
 271
 272 ..: LINORE:OSC-KEY-PROCESSOR  ( addr count FALSE -- addr count FALSE / TRUE )
 273   ACTIVE? IF
 274     DUP IFNOT
 275       (CHECK-KEY-ALT) IF 2DROP TRUE ELSE FALSE ENDIF
 276       DUP IFNOT >R 2DUP (SHOW-OSC) R> ENDIF
 277     ENDIF
 278   ENDIF
 279 ;..
 280
 281 ..: LINORE:ON-BEFORE-DRAW  ( FALSE -- FALSE / TRUE )
 282   ACTIVE? IF
 283     DUP IFNOT
 284       DROP ALT-SCR? NOT
 285       DUP IFNOT (LINORE-DRAW-PROMPT) ENDIF
 286     ENDIF
 287   ENDIF
 288 ;..
 289
 290
 291 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 292 ;; debugger helpers
 293 ;;
 294
 295 : DO-RESUME  ( -- )
 296   FALSE TO ACTIVE?
 297   debuggee-stid MTASK:DEBUGGER-RESUME
 298 ;
 299
 300 : DO-SSTEP  ( -- )
 301   FALSE TO ACTIVE?
 302   debuggee-stid MTASK:DEBUGGER-SINGLE-STEP
 303 ;
 304
 305
 306 : SHOW-CURRENT-WORD  ( -- )
 307   ." \r*** CURRENT WORD: "
 308   debuggee-stid MTASK:STATE-IP@ DEBUG:IP->NFA ID-COUNT XTYPE CR
 309   debuggee-stid MTASK:STATE-IP@ 6 U.R ." : "
 310   debuggee-stid MTASK:STATE-IP@ @ ." [" 4 U.R ." ]: "
 311   debuggee-stid MTASK:STATE-IP@ @ CFA->NFA ID-COUNT XTYPE CR
 312
 313   debuggee-stid MTASK:STATE-IP@ DEBUG:IP->FILE/LINE
 314   ( ip -- addr count line TRUE / FALSE )
 315   IF
 316     >R 2DUP R@ SHOW-SOURCE-LINE R>
 317     ." line " . ."  in `" XTYPE ." `" CR
 318   ENDIF
 319 ;
 320
 321 : PROCESS-TASK-SWITCH  ( action old-stid -- )
 322   TO debuggee-stid DROP  ;; drop action id
 323   FLUSH-EMIT
 324   TRUE TO ACTIVE?
 325   (*
 326   CASE
 327     -1 OF ." yay, a breakpoint!" CR ENDOF
 328     -2 OF ." yay, a single-step!" CR ENDOF
 329     OTHERWISE " wutafuck?!" ERROR
 330   ENDCASE
 331   *)
 332   BASE @ 10 <> " ass!" ?ERROR
 333   STATE @ " hole!" ?ERROR
 334   TRUE TO ALT-CLEAR TO-ALT-SCR FALSE TO ALT-CLEAR
 335   SHOW-CURRENT-WORD
 336 ;
 337
 338
 339 ;; used in step-line
 340 0 VALUE STEP-FROM-LINE
 341 0 VALUE STEP-FROM-FILE-HASH
 342 0 VALUE STEP-FROM-FILE-NLEN
 343 ;; used in step-l-over
 344 0 VALUE STEP-CURR-NFA
 345 0 VALUE STEP-OVER-LOOPS
 346
 347
 348 ;; call before various dumps
 349 : (NEWLINE)  ( -- )
 350   FLUSH-EMIT CR TTY:RAW-FLUSH
 351 ;
 352
 353 : (.PUSH-ONE)  ( n -- )
 354   debuggee-stid MTASK:STATE-SP@ 1+ debuggee-stid MTASK:STATE-SP!
 355   0 debuggee-stid MTASK:STATE-DS!
 356 ;
 357
 358
 359 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 360 ;; debugger commands
 361 ;;
 362
 363 SIMPLE-VOCABULARY COMMANDS
 364 ALSO-DEFS: COMMANDS
 365
 366 : .source  ( -- )
 367   SHOW-CURRENT-WORD
 368 ;
 369 ALIAS .source ?
 370
 371 ;; dump data stack
 372 : .stack  ( -- )
 373   debuggee-stid DEBUG:DUMP-STACK-TASK
 374 ;
 375 ALIAS .stack .s
 376
 377 ;; dump data stack
 378 : .rstack  ( -- )
 379   debuggee-stid DEBUG:DUMP-RSTACK-TASK
 380 ;
 381 ALIAS .rstack .r
 382
 383 ;; backtrace
 384 : bt  ( -- )
 385    debuggee-stid DEBUG:BACKTRACE-TASK
 386 ;
 387
 388 ;; drop value from the debuggee stack
 389 : .drop  ( -- )
 390   debuggee-stid MTASK:STATE-SP@ DUP IF
 391     1- debuggee-stid MTASK:STATE-SP!
 392     debuggee-stid DEBUG:DUMP-STACK-TASK
 393   ELSE DROP ." ERROR: debuggee stack is empty!" CR
 394   ENDIF
 395 ;
 396
 397 ;; push value(s) to the debuggee stack
 398 : .push  ( ... -- )
 399   DEPTH IF
 400     ;; reserve room
 401     DEPTH debuggee-stid MTASK:STATE-SP@ + debuggee-stid MTASK:STATE-SP!
 402     ;; move values
 403     DEPTH FOR I debuggee-stid MTASK:STATE-DS! ENDFOR
 404     debuggee-stid DEBUG:DUMP-STACK-TASK
 405   ELSE ." ERROR: push what?" CR
 406   ENDIF
 407 ;
 408
 409 ;; clear debugger data stack
 410 : .dclear  ( -- )
 411   SP0!
 412 ;
 413
 414 ;; debugger data stack depth
 415 : .depth  ( -- )
 416   ." debugger stack depth: " DEPTH . CR
 417 ;
 418
 419 : continue  ( -- )
 420   TO-MAIN-SCR TTY:RAW-FLUSH
 421   DO-RESUME
 422   PROCESS-TASK-SWITCH
 423 ;
 424 ALIAS continue c
 425
 426 : step  ( -- )
 427   TO-MAIN-SCR TTY:RAW-FLUSH
 428   DO-SSTEP
 429   PROCESS-TASK-SWITCH
 430 ;
 431 ALIAS step s
 432
 433 : quit  ( -- )
 434   TO-MAIN-SCR TTY:RAW-FLUSH
 435   ABORT
 436 ;
 437 ALIAS quit q
 438
 439 ;; run current line, stop when it changed
 440 : step-line  ( -- )
 441   debuggee-stid MTASK:STATE-IP@ DEBUG:IP->FILE-HASH/LINE
 442   // ( ip -- len hash line TRUE / FALSE )
 443   IF
 444     TO STEP-FROM-LINE
 445     TO STEP-FROM-FILE-HASH
 446     TO STEP-FROM-FILE-NLEN
 447     ;; now single-step until everything is the same
 448     TO-MAIN-SCR TTY:RAW-FLUSH
 449     TTY:SET-COOKED DROP
 450     (*
 451       ." line: " STEP-FROM-LINE .
 452       ." hash: " STEP-FROM-FILE-HASH .
 453       ." nlen: " STEP-FROM-FILE-NLEN .
 454       ."   ip: " debuggee-stid MTASK:STATE-IP@ .
 455       CR
 456     *)
 457     FALSE TO ACTIVE?
 458     BEGIN
 459       debuggee-stid MTASK:DEBUGGER-SINGLE-STEP
 460       TO debuggee-stid DROP  ;; drop action id
 461       debuggee-stid MTASK:STATE-IP@ DEBUG:IP->FILE-HASH/LINE
 462       IF
 463         (*
 464           >R 2DUP R@
 465           ." new-line: " .
 466           ." new-hash: " .
 467           ." new-nlen: " .
 468           ."   new-ip: " debuggee-stid MTASK:STATE-IP@ .
 469           CR R>
 470         *)
 471         STEP-FROM-LINE =
 472         SWAP STEP-FROM-FILE-HASH = AND
 473         SWAP STEP-FROM-FILE-NLEN = AND
 474         IFNOT BREAK ENDIF
 475       ENDIF
 476     AGAIN
 477     FLUSH-EMIT
 478     -3 debuggee-stid  ;; for PROCESS-TASK-SWITCH
 479     TTY:SET-RAW DROP
 480     PROCESS-TASK-SWITCH
 481   ENDIF
 482 ;
 483
 484 ;; run current line, stop when we returned to the current word
 485 : step-l-over  ( over-loops -- )
 486   TO STEP-OVER-LOOPS
 487   ;; HACK: check for FORTH:(EXIT)
 488   debuggee-stid MTASK:STATE-IP@ @
 489   ['] FORTH:(EXIT) = IF step EXIT ENDIF
 490   debuggee-stid MTASK:STATE-IP@ DEBUG:IP->FILE-HASH/LINE
 491   // ( ip -- len hash line TRUE / FALSE )
 492   IF
 493     TO STEP-FROM-LINE
 494     TO STEP-FROM-FILE-HASH
 495     TO STEP-FROM-FILE-NLEN
 496     debuggee-stid MTASK:STATE-IP@ DEBUG:IP->NFA TO STEP-CURR-NFA
 497     ;; now single-step until everything is the same
 498     TO-MAIN-SCR TTY:RAW-FLUSH
 499     TTY:SET-COOKED DROP
 500     FALSE TO ACTIVE?
 501     BEGIN
 502       debuggee-stid MTASK:DEBUGGER-SINGLE-STEP
 503       TO debuggee-stid DROP  ;; drop action id
 504       debuggee-stid MTASK:STATE-IP@ DEBUG:IP->NFA
 505       STEP-CURR-NFA =
 506       IF
 507         debuggee-stid MTASK:STATE-IP@ DEBUG:IP->FILE-HASH/LINE
 508         IF
 509           STEP-OVER-LOOPS IF
 510             STEP-FROM-LINE <=
 511           ELSE
 512             STEP-FROM-LINE =
 513           ENDIF
 514           SWAP STEP-FROM-FILE-HASH = AND
 515           SWAP STEP-FROM-FILE-NLEN = AND
 516           IFNOT BREAK ENDIF
 517         ENDIF
 518       ENDIF
 519     AGAIN
 520     FLUSH-EMIT
 521     -3 debuggee-stid  ;; for PROCESS-TASK-SWITCH
 522     TTY:SET-RAW DROP
 523     PROCESS-TASK-SWITCH
 524   ENDIF
 525 ;
 526
 527 ;; run one forth instruction, step when it changed
 528 : step-over  ( -- )
 529   ;; HACK: check for FORTH:(EXIT)
 530   debuggee-stid MTASK:STATE-IP@ @
 531   ['] FORTH:(EXIT) = IF step EXIT ENDIF
 532   debuggee-stid MTASK:STATE-IP@ DEBUG:IP->NFA TO STEP-CURR-NFA
 533   ;; now single-step
 534   TO-MAIN-SCR TTY:RAW-FLUSH
 535   TTY:SET-COOKED DROP
 536   FALSE TO ACTIVE?
 537   BEGIN
 538     debuggee-stid MTASK:DEBUGGER-SINGLE-STEP
 539     TO debuggee-stid DROP  ;; drop action id
 540     debuggee-stid MTASK:STATE-IP@ DEBUG:IP->NFA
 541     STEP-CURR-NFA =
 542   UNTIL
 543   FLUSH-EMIT
 544   -3 debuggee-stid  ;; for PROCESS-TASK-SWITCH
 545   TTY:SET-RAW DROP
 546   PROCESS-TASK-SWITCH
 547 ;
 548 ALIAS step-over o
 549
 550 : .help  ( -- )
 551   ."  ? .source     -- show source code (also enter)" CR
 552   ." .s .stack      -- dump debuggee data stack" CR
 553   ." .r .rstack     -- dump debuggee return stack" CR
 554   ."    bt          -- show backtrace" CR
 555   ."    .drop       -- drop value from debuggee data stack" CR
 556   ."    .push       -- push values to debuggee data stack (use `:` to exec Forth in dbg)" CR
 557   ."    .dclear     -- clear *debugger* data stack" CR
 558   ."    .depth      -- print *debugger* data stack depth" CR
 559   ." c  continue    -- leave debugger, continue program execution" CR
 560   ." s  step        -- single-step (execute once Forth instruction)" CR
 561   ." o  step-over   -- execute over once forth instruction (rstack check)" CR
 562   ." q  quit        -- quit application" CR
 563   ."    step-line   -- step over the current line (enter subroutines)" CR
 564   ."    step-l-over -- ( over-loops ) step over the current line (skip subroutines)" CR
 565 ;
 566 ALIAS .help .h
 567
 568 PREV-DEFS
 569
 570
 571 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 572 ;; more LINORE hotkeys
 573 ;;
 574
 575 ALSO-DEFS: LINORE:OSC-ACTIONS
 576
 577 // F7
 578 : 18~  ( -- )  COMMANDS:step-line ;
 579 // F8
 580 : 19~  ( -- )  FALSE COMMANDS:step-over ;
 581 // S-F8
 582 : 32~  ( -- )  TRUE COMMANDS:step-over ;
 583
 584 PREV-DEFS
 585
 586
 587 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 588 ;; working with breakpoints
 589 ;; UNFINISHED!
 590 ;;
 591
 592 ;; breakpoint info in user buffer
 593 16384 FORTH:(ADDR-TEMP-BIT) + CONSTANT BP-AREA
 594 0 VALUE BP-USED
 595 (*
 596   breakpoint format:
 597     dd  address    ; 0: unused slot
 598     dd  old-value  ; original value  (~0: BP not set)
 599 *)
 600
 601 : (BP-REC)  ( idx -- addr )
 602   2 CELLS BP-AREA +
 603 ;
 604
 605
 606 : BP-ADDR@  ( bpinfo -- addr )  @ ;
 607 : BP-ADDR!  ( value bpinfo -- )  ! ;
 608
 609 : BP-OLDVAL@  ( bpinfo -- oldval )  CELL+ @ ;
 610 : BP-OLDVAL!  ( value bpinfo -- )  CELL+ ! ;
 611
 612
 613 : BP-ALLOC  ( -- bpinfo )
 614   BP-USED FOR
 615     I (BP-REC) @ IFNOT I (BP-REC) (UNLOOP) EXIT ENDIF
 616   ENDFOR
 617   BP-USED (BP-REC) +1-TO BP-USED
 618 ;
 619
 620 : BP-FIND  ( addr -- bpinfo / FALSE )
 621   BP-USED FOR
 622     DUP I (BP-REC) @ = IF DROP I (BP-REC) (UNLOOP) EXIT ENDIF
 623   ENDFOR DROP FALSE
 624 ;
 625
 626 ;; add new breakpoint
 627 : BP-SET  ( addr -- )
 628   DUP BP-FIND IFNOT  ;; create new breakpoint
 629     BP-ALLOC 2DUP BP-ADDR!  0 BITNOT OVER BP-OLDVAL!
 630   ELSE NIP
 631   ENDIF  ( bpinfo )
 632   DUP BP-OLDVAL@ 0 BITNOT = IFNOT  ;; not set yet
 633     DUP BP-ADDR@ @ OVER BP-OLDVAL! ;; save old value
 634     ['] DEBUG:(BP) SWAP BP-ADDR@ ! ;; and patch the code
 635   ELSE DROP
 636   ENDIF
 637 ;
 638
 639
 640 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 641 ;; main loop
 642 ;;
 643
 644 : debugger-draw-prompt  ( -- )
 645   " \r\e[0;1;5m>\e[0m" TTY:RAW-TYPE
 646 ;
 647
 648 ' debugger-draw-prompt TO (LINORE-DRAW-PROMPT)
 649
 650 0 VALUE run-forth-ret-addr
 651
 652 : run-forth-done  ( -- )
 653   \ ." FORTH DONE!" CR
 654   ENDCR TTY:RAW-FLUSH
 655   STATE 0!
 656   LINORE:RESET
 657   RP0! run-forth-ret-addr >R
 658 ;
 659
 660 ;; do not allow debugger to abort on bad forth word
 661 ..: FORTH:(INTERPRET-WORD-NOT-FOUND)  ( addr count FALSE -- addr count FALSE / TRUE )
 662   ACTIVE? IF
 663     DROP SPACE XTYPE ." ? -- wut?!" CR
 664     run-forth-done
 665   ENDIF
 666 ;..
 667
 668
 669 ;; run Forth code in debugger context.
 670 ;; this is used to execute all debugger commands, yay!
 671 : run-forth  ( ... )
 672   ;; set TIB and run one line
 673   0 LINORE:LINE + C!  ;; finish TIB with 0 byte
 674   LINORE:LINE DROP TIB ! >IN 0!  ;; setup TIB
 675   ['] run-forth-done (USER-INTERPRET-NEXT-LINE) !
 676   R@ TO run-forth-ret-addr
 677   (NEWLINE)
 678   $IF 0
 679     TIB @ >A BEGIN C@A WHILE C@A XEMIT +1>A REPEAT CR
 680     ." ---" CR
 681   $ENDIF
 682   TTY:RAW-FLUSH
 683   INTERPRET
 684   run-forth-done
 685 ;
 686
 687
 688 : debugger-main-loop ( -- )
 689   PROCESS-TASK-SWITCH
 690   SP0! RP0!
 691   BEGIN
 692     1 TO LINORE:START-X
 693     TTY:SIZE DROP TO LINORE:DRAW-WIDTH
 694       \ LINORE:VISIBLE-AMOUNT 2* TO LINORE:DRAW-WIDTH
 695     FLUSH-EMIT LINORE:EDIT-LINE
 696     LINORE:ACCEPT-RESULT 0<
 697     IF
 698       LINORE:ACCEPT-RESULT LINORE:RESULT-ESC <> IF
 699         COMMANDS:continue
 700       ENDIF
 701     ELSE
 702       LINORE:LINE NIP 0= IF " .source" LINORE:LINE! ENDIF
 703       ONLY FORTH DEFINITIONS ALSO COMMANDS
 704       run-forth
 705     ENDIF
 706   AGAIN
 707 ;
 708
 709 : debugger-startup  \ multitask entry point
 710   \ ." yay, we are in debugger!" cr
 711   \ ." debugger stid: " MTASK:ACTIVE-STATE . cr
 712   ( ... argc old-stid )
 713   SWAP " wuta?!" ?ERROR   ;; there should be no args
 714   MTASK:SET-SELF-AS-DEBUGGER
 715   0 SWAP MTASK:YIELD-TO   ;; return to the caller
 716   ['] debugger-main-loop EXECUTE-TAIL
 717 ;
 718
 719
 720 : setup-debugger  ( -- )
 721   ['] debugger-startup MTASK:NEW-STATE TO debugger-task
 722   0 debugger-task MTASK:YIELD-TO  ;; init it
 723   debugger-task <> " shit!" ?ERROR
 724   " fuck!" ?ERROR  ;; check number of args
 725 ;
 726
 727
 728 PREV-DEFS
 729
 730 DEBUGGER:setup-debugger