1\ SEE.FS highend SEE for ANSforth 16may93jaw 2 3\ Copyright (C) 1995,2000,2003,2004,2006,2007,2008 Free Software Foundation, Inc. 4 5\ This file is part of Gforth. 6 7\ Gforth is free software; you can redistribute it and/or 8\ modify it under the terms of the GNU General Public License 9\ as published by the Free Software Foundation, either version 3 10\ of the License, or (at your option) any later version. 11 12\ This program is distributed in the hope that it will be useful, 13\ but WITHOUT ANY WARRANTY; without even the implied warranty of 14\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15\ GNU General Public License for more details. 16 17\ You should have received a copy of the GNU General Public License 18\ along with this program. If not, see http://www.gnu.org/licenses/. 19 20 21\ May be cross-compiled 22 23\ I'm sorry. This is really not "forthy" enough. 24 25\ Ideas: Level should be a stack 26 27require look.fs 28require termsize.fs 29require wordinfo.fs 30 31decimal 32 33\ Screen format words 16may93jaw 34 35VARIABLE C-Output 1 C-Output ! 36VARIABLE C-Formated 1 C-Formated ! 37VARIABLE C-Highlight 0 C-Highlight ! 38VARIABLE C-Clearline 0 C-Clearline ! 39 40VARIABLE XPos 41VARIABLE YPos 42VARIABLE Level 43 44: Format C-Formated @ C-Output @ and 45 IF dup spaces XPos +! ELSE drop THEN ; 46 47: level+ 7 Level +! 48 Level @ XPos @ - 49 dup 0> IF Format ELSE drop THEN ; 50 51: level- -7 Level +! ; 52 53VARIABLE nlflag 54VARIABLE uppercase \ structure words are in uppercase 55 56DEFER nlcount ' noop IS nlcount 57 58: nl nlflag on ; 59: (nl) nlcount 60 XPos @ Level @ = IF EXIT THEN \ ?Exit 61 C-Formated @ IF 62 C-Output @ 63 IF C-Clearline @ IF cols XPos @ - spaces 64 ELSE cr THEN 65 1 YPos +! 0 XPos ! 66 Level @ spaces 67 THEN Level @ XPos ! THEN ; 68 69: warp? ( len -- len ) 70 nlflag @ IF (nl) nlflag off THEN 71 XPos @ over + cols u>= IF (nl) THEN ; 72 73: ctype ( adr len -- ) 74 warp? dup XPos +! C-Output @ 75 IF uppercase @ IF bounds ?DO i c@ toupper emit LOOP 76 uppercase off ELSE type THEN 77 ELSE 2drop THEN ; 78 79: cemit 1 warp? 80 over bl = Level @ XPos @ = and 81 IF 2drop ELSE XPos +! C-Output @ IF emit ELSE drop THEN 82 THEN ; 83 84DEFER .string ( c-addr u n -- ) 85 86[IFDEF] Green 87VARIABLE Colors Colors on 88 89: (.string) ( c-addr u n -- ) 90 over warp? drop 91 Colors @ 92 IF C-Highlight @ ?dup 93 IF CT@ swap CT@ or 94 ELSE CT@ 95 THEN 96 attr! ELSE drop THEN 97 ctype ct @ attr! ; 98[ELSE] 99: (.string) ( c-addr u n -- ) 100 drop ctype ; 101[THEN] 102 103' (.string) IS .string 104 105: c-\type ( c-addr u -- ) 106 \ type string in \-escaped form 107 begin 108 dup while 109 2dup newline string-prefix? if 110 '\ cemit 'n cemit 111 newline nip /string 112 else 113 over c@ 114 dup '" = over '\ = or if 115 '\ cemit cemit 116 else 117 dup bl 127 within if 118 cemit 119 else 120 base @ >r try 121 8 base ! 0 <<# # # # '\ hold #> ctype #>> 0 122 restore 123 r@ base ! 124 endtry 125 rdrop throw 126 endif 127 endif 128 1 /string 129 endif 130 repeat 131 2drop ; 132 133: .struc 134 uppercase on Str# .string ; 135 136\ CODES (Branchtypes) 15may93jaw 137 13821 CONSTANT RepeatCode 13922 CONSTANT AgainCode 14023 CONSTANT UntilCode 141\ 09 CONSTANT WhileCode 14210 CONSTANT ElseCode 14311 CONSTANT AheadCode 14413 CONSTANT WhileCode2 14514 CONSTANT Disable 14615 CONSTANT LeaveCode 147 148 149\ FORMAT WORDS 13jun93jaw 150 151VARIABLE C-Stop 152VARIABLE Branches 153 154VARIABLE BranchPointer \ point to the end of branch table 155VARIABLE SearchPointer 156 157\ The branchtable consists of three entrys: 158\ address of branch , branch destination , branch type 159 160CREATE BranchTable 128 cells allot 161here 3 cells - 162ACONSTANT MaxTable 163 164: FirstBranch BranchTable cell+ SearchPointer ! ; 165 166: (BranchAddr?) ( a-addr1 -- a-addr2 true | false ) 167\ searches a branch with destination a-addr1 168\ a-addr1: branch destination 169\ a-addr2: pointer in branch table 170 SearchPointer @ 171 BEGIN dup BranchPointer @ u< 172 WHILE 173 dup @ 2 pick <> 174 WHILE 3 cells + 175 REPEAT 176 nip dup 3 cells + SearchPointer ! true 177 ELSE 178 2drop false 179 THEN ; 180 181: BranchAddr? 182 FirstBranch (BranchAddr?) ; 183 184' (BranchAddr?) ALIAS MoreBranchAddr? 185 186: CheckEnd ( a-addr -- true | false ) 187 BranchTable cell+ 188 BEGIN dup BranchPointer @ u< 189 WHILE 190 dup @ 2 pick u<= 191 WHILE 3 cells + 192 REPEAT 193 2drop false 194 ELSE 195 2drop true 196 THEN ; 197 198: MyBranch ( a-addr -- a-addr a-addr2 ) 199\ finds branch table entry for branch at a-addr 200 dup @ 201 BranchAddr? 202 BEGIN 203 WHILE 1 cells - @ 204 over <> 205 WHILE dup @ 206 MoreBranchAddr? 207 REPEAT 208 SearchPointer @ 3 cells - 209 ELSE true ABORT" SEE: Table failure" 210 THEN ; 211 212\ 213\ addrw addrt 214\ BEGIN ... WHILE ... AGAIN ... THEN 215\ ^ ! ! ^ 216\ ----------+--------+ ! 217\ ! ! 218\ +-------------------+ 219\ 220\ 221 222: CheckWhile ( a-addrw a-addrt -- true | false ) 223 BranchTable 224 BEGIN dup BranchPointer @ u< 225 WHILE dup @ 3 pick u> 226 over @ 3 pick u< and 227 IF dup cell+ @ 3 pick u< 228 IF 2drop drop true EXIT THEN 229 THEN 230 3 cells + 231 REPEAT 232 2drop drop false ; 233 234: ,Branch ( a-addr -- ) 235 BranchPointer @ dup MaxTable u> ABORT" SEE: Table overflow" 236 ! 237 1 cells BranchPointer +! ; 238 239: Type! ( u -- ) 240 BranchPointer @ 1 cells - ! ; 241 242: Branch! ( a-addr rel -- a-addr ) 243 over ,Branch ,Branch 0 ,Branch ; 244\ over + over ,Branch ,Branch 0 ,Branch ; 245 246\ DEFER CheckUntil 247VARIABLE NoOutput 248VARIABLE C-Pass 249 2500 CONSTANT ScanMode 2511 CONSTANT DisplayMode 2522 CONSTANT DebugMode 253 254: Scan? ( -- flag ) C-Pass @ 0= ; 255: Display? ( -- flag ) C-Pass @ 1 = ; 256: Debug? ( -- flag ) C-Pass @ 2 = ; 257 258: back? ( addr target -- addr flag ) 259 over u< ; 260 261: .word ( addr x -- addr ) 262 \ print x as a word if possible 263 dup look 0= IF 264 drop dup threaded>name dup 0= if 265 drop over 1 cells - @ dup body> look 266 IF 267 nip nip dup ." <" name>string rot wordinfo .string ." > " 268 ELSE 269 2drop ." <" 0 .r ." > " 270 THEN 271 EXIT 272 then 273 THEN 274 nip dup cell+ @ immediate-mask and 275 IF 276 bl cemit ." POSTPONE " 277 THEN 278 dup name>string rot wordinfo .string 279 ; 280 281: c-call ( addr1 -- addr2 ) 282 Display? IF 283 dup @ body> .word bl cemit 284 THEN 285 cell+ ; 286 287: c-callxt ( addr1 -- addr2 ) 288 Display? IF 289 dup @ .word bl cemit 290 THEN 291 cell+ ; 292 293\ here docon: , docol: , dovar: , douser: , dodefer: , dofield: , 294\ here over - 2constant doers 295 296: c-lit ( addr1 -- addr2 ) 297 Display? IF 298 dup @ dup body> dup cfaligned over = swap in-dictionary? and if 299 ( addr1 addr1@ ) 300 dup body> @ dovar: = if 301 drop c-call EXIT 302 endif 303 endif 304 \ !! test for cfa here, and print "['] ..." 305 dup abs 0 <# #S rot sign #> 0 .string bl cemit 306 endif 307 cell+ ; 308 309: c-lit+ ( addr1 -- addr2 ) 310 Display? if 311 dup @ dup abs 0 <# #S rot sign #> 0 .string bl cemit 312 s" + " 0 .string 313 endif 314 cell+ ; 315 316: .name-without ( addr -- addr ) 317 \ !! the stack effect cannot be correct 318 \ prints a name without a() e.g. a(+LOOP) or (s") 319 dup 1 cells - @ threaded>name dup IF 320 name>string over c@ 'a = IF 321 1 /string 322 THEN 323 over c@ '( = IF 324 1 /string 325 THEN 326 2dup + 1- c@ ') = IF 1- THEN .struc ELSE drop 327 THEN ; 328 329[ifdef] (s") 330: c-c" 331 Display? IF nl .name-without THEN 332 count 2dup + aligned -rot 333 Display? 334 IF bl cemit 0 .string 335 [char] " cemit bl cemit 336 ELSE 2drop 337 THEN ; 338[endif] 339 340: c-string? ( addr1 -- addr2 f ) 341 \ f is true if a string was found and decompiled. 342 \ if f is false, addr2=addr1 343 \ recognizes the following patterns: 344 \ c": ahead X: len string then lit X 345 \ flit: ahead X: float then lit X f@ 346 \ s\": ahead X: string then lit X lit len 347 \ .\": ahead X: string then lit X lit len type 348 \ !! not recognized anywhere: 349 \ abort": if ahead X: len string then lit X c(abort") then 350 dup @ back? if false exit endif 351 dup @ >r 352 r@ @ decompile-prim ['] lit xt>threaded <> if rdrop false exit endif 353 r@ cell+ @ over cell+ <> if rdrop false exit endif 354 \ we have at least C" 355 r@ 2 cells + @ decompile-prim dup ['] lit xt>threaded = if 356 drop r@ 3 cells + @ over cell+ + aligned r@ = if 357 \ we have at least s" 358 r@ 4 cells + @ decompile-prim ['] lit-perform xt>threaded = 359 r@ 5 cells + @ ['] type >body = and if 360 6 s\" .\\\" " 361 else 362 4 s\" s\\\" " 363 endif 364 \ !! make newline if string too long? 365 display? if 366 0 .string r@ cell+ @ r@ 3 cells + @ c-\type '" cemit bl cemit 367 else 368 2drop 369 endif 370 nip cells r> + true exit 371 endif 372 endif 373 ['] f@ xt>threaded = if 374 display? if 375 r@ cell+ @ f@ 10 8 16 f>str-rdp 0 .string bl cemit 376 endif 377 drop r> 3 cells + true exit 378 endif 379 \ !! check if count matches space? 380 display? if 381 s\" c\" " 0 .string r@ cell+ @ count 0 .string '" cemit bl cemit 382 endif 383 drop r> 2 cells + true ; 384 385: Forward? ( a-addr true | false -- a-addr true | false ) 386 \ a-addr is pointer into branch table 387 \ returns true when jump is a forward jump 388 IF 389 dup dup @ swap 1 cells - @ u> IF 390 true 391 ELSE 392 drop false 393 THEN 394 \ only if forward jump 395 ELSE 396 false 397 THEN ; 398 399: RepeatCheck ( a-addr1 a-addr2 true | false -- false ) 400 IF BEGIN 2dup 401 1 cells - @ swap @ 402 u<= 403 WHILE drop dup cell+ 404 MoreBranchAddr? 0= 405 UNTIL false 406 ELSE true 407 THEN 408 ELSE false 409 THEN ; 410 411: c-branch ( addr1 -- addr2 ) 412 c-string? ?exit 413 Scan? 414 IF dup @ Branch! 415 dup @ back? 416 IF \ might be: AGAIN, REPEAT 417 dup cell+ BranchAddr? Forward? 418 RepeatCheck 419 IF RepeatCode Type! 420 cell+ Disable swap ! 421 ELSE AgainCode Type! 422 THEN 423 ELSE dup cell+ BranchAddr? Forward? 424 IF ElseCode Type! drop 425 ELSE AheadCode Type! 426 THEN 427 THEN 428 THEN 429 Display? 430 IF 431 dup @ back? 432 IF \ might be: AGAIN, REPEAT 433 level- nl 434 dup cell+ BranchAddr? Forward? 435 RepeatCheck 436 IF drop S" REPEAT " .struc nl 437 ELSE S" AGAIN " .struc nl 438 THEN 439 ELSE MyBranch cell+ @ LeaveCode = 440 IF S" LEAVE " .struc 441 ELSE 442 dup cell+ BranchAddr? Forward? 443 IF dup cell+ @ WhileCode2 = 444 IF nl S" ELSE" .struc level+ 445 ELSE level- nl S" ELSE" .struc level+ THEN 446 cell+ Disable swap ! 447 ELSE S" AHEAD" .struc level+ 448 THEN 449 THEN 450 THEN 451 THEN 452 Debug? 453 IF @ \ !!! cross-interacts with debugger !!! 454 ELSE cell+ 455 THEN ; 456 457: DebugBranch 458 Debug? 459 IF dup @ swap THEN ; \ return 2 different addresses 460 461: c-?branch 462 Scan? 463 IF dup @ Branch! 464 dup @ Back? 465 IF UntilCode Type! THEN 466 THEN 467 Display? 468 IF dup @ Back? 469 IF level- nl S" UNTIL " .struc nl 470 ELSE dup dup @ over + 471 CheckWhile 472 IF MyBranch 473 cell+ dup @ 0= 474 IF WhileCode2 swap ! 475 ELSE drop THEN 476 level- nl 477 S" WHILE " .struc 478 level+ 479 ELSE MyBranch cell+ @ LeaveCode = 480 IF s" 0= ?LEAVE " .struc 481 ELSE nl S" IF " .struc level+ 482 THEN 483 THEN 484 THEN 485 THEN 486 DebugBranch 487 cell+ ; 488 489: c-for 490 Display? IF nl S" FOR" .struc level+ THEN ; 491 492: c-loop 493 Display? IF level- nl .name-without nl bl cemit THEN 494 DebugBranch cell+ 495 Scan? 496 IF dup BranchAddr? 497 BEGIN WHILE cell+ LeaveCode swap ! 498 dup MoreBranchAddr? 499 REPEAT 500 THEN 501 cell+ ; 502 503: c-do 504 Display? IF nl .name-without level+ THEN ; 505 506: c-?do ( addr1 -- addr2 ) 507 Display? IF 508 nl .name-without level+ 509 THEN 510 DebugBranch cell+ ; 511 512: c-exit ( addr1 -- addr2 ) 513 dup 1 cells - 514 CheckEnd 515 IF 516 Display? IF nlflag off S" ;" Com# .string THEN 517 C-Stop on 518 ELSE 519 Display? IF S" EXIT " .struc THEN 520 THEN 521 Debug? IF drop THEN ; \ !!! cross-interacts with debugger !!! 522 523: c-abort" 524 count 2dup + aligned -rot 525 Display? 526 IF S" ABORT" .struc 527 [char] " cemit bl cemit 0 .string 528 [char] " cemit bl cemit 529 ELSE 2drop 530 THEN ; 531 532[IFDEF] (does>) 533: c-does> \ end of create part 534 Display? IF S" DOES> " Com# .string THEN 535 maxaligned /does-handler + ; 536[THEN] 537 538[IFDEF] (compile) 539: c-(compile) 540 Display? 541 IF 542 s" POSTPONE " Com# .string 543 dup @ look 0= ABORT" SEE: No valid XT" 544 name>string 0 .string bl cemit 545 THEN 546 cell+ ; 547[THEN] 548 549CREATE C-Table 550 ' lit A, ' c-lit A, 551 ' does-exec A, ' c-callxt A, 552 ' lit@ A, ' c-call A, 553[IFDEF] call ' call A, ' c-call A, [THEN] 554\ ' useraddr A, .... 555 ' lit-perform A, ' c-call A, 556 ' lit+ A, ' c-lit+ A, 557[IFDEF] (s") ' (s") A, ' c-c" A, [THEN] 558[IFDEF] (.") ' (.") A, ' c-c" A, [THEN] 559[IFDEF] "lit ' "lit A, ' c-c" A, [THEN] 560[IFDEF] (c") ' (c") A, ' c-c" A, [THEN] 561 ' (do) A, ' c-do A, 562[IFDEF] (+do) ' (+do) A, ' c-?do A, [THEN] 563[IFDEF] (u+do) ' (u+do) A, ' c-?do A, [THEN] 564[IFDEF] (-do) ' (-do) A, ' c-?do A, [THEN] 565[IFDEF] (u-do) ' (u-do) A, ' c-?do A, [THEN] 566 ' (?do) A, ' c-?do A, 567 ' (for) A, ' c-for A, 568 ' ?branch A, ' c-?branch A, 569 ' branch A, ' c-branch A, 570 ' (loop) A, ' c-loop A, 571 ' (+loop) A, ' c-loop A, 572[IFDEF] (s+loop) ' (s+loop) A, ' c-loop A, [THEN] 573[IFDEF] (-loop) ' (-loop) A, ' c-loop A, [THEN] 574 ' (next) A, ' c-loop A, 575 ' ;s A, ' c-exit A, 576[IFDEF] (abort") ' (abort") A, ' c-abort" A, [THEN] 577\ only defined if compiler is loaded 578[IFDEF] (compile) ' (compile) A, ' c-(compile) A, [THEN] 579[IFDEF] (does>) ' (does>) A, ' c-does> A, [THEN] 580 0 , here 0 , 581 582avariable c-extender 583c-extender ! 584 585\ DOTABLE 15may93jaw 586 587: DoTable ( ca/cfa -- flag ) 588 decompile-prim C-Table BEGIN ( cfa table-entry ) 589 dup @ dup 0= IF 590 drop cell+ @ dup IF ( next table!) 591 dup @ 592 ELSE ( end!) 593 2drop false EXIT 594 THEN 595 THEN 596 \ jump over to extender, if any 26jan97jaw 597 xt>threaded 2 pick <> 598 WHILE 599 2 cells + 600 REPEAT 601 nip cell+ perform 602 true 603; 604 605: BranchTo? ( a-addr -- a-addr ) 606 Display? IF dup BranchAddr? 607 IF 608 BEGIN cell+ @ dup 20 u> 609 IF drop nl S" BEGIN " .struc level+ 610 ELSE 611 dup Disable <> over LeaveCode <> and 612 IF WhileCode2 = 613 IF nl S" THEN " .struc nl ELSE 614 level- nl S" THEN " .struc nl THEN 615 ELSE drop THEN 616 THEN 617 dup MoreBranchAddr? 0= 618 UNTIL 619 THEN 620 THEN ; 621 622: analyse ( a-addr1 -- a-addr2 ) 623 Branches @ IF BranchTo? THEN 624 dup cell+ swap @ 625 dup >r DoTable r> swap IF drop EXIT THEN 626 Display? 627 IF 628 .word bl cemit 629 ELSE 630 drop 631 THEN ; 632 633: c-init 634 0 YPos ! 0 XPos ! 635 0 Level ! nlflag off 636 BranchTable BranchPointer ! 637 c-stop off 638 Branches on ; 639 640: makepass ( a-addr -- ) 641 c-stop off 642 BEGIN 643 analyse 644 c-stop @ 645 UNTIL drop ; 646 647Defer xt-see-xt ( xt -- ) 648\ this one is just a forward declaration for indirect recursion 649 650: .defname ( xt c-addr u -- ) 651 rot look 652 if ( c-addr u nfa ) 653 -rot type space .name 654 else 655 drop ." noname " type 656 then 657 space ; 658 659Defer discode ( addr u -- ) \ gforth 660\G hook for the disassembler: disassemble code at addr of length u 661' dump IS discode 662 663: next-head ( addr1 -- addr2 ) \ gforth 664 \G find the next header starting after addr1, up to here (unreliable). 665 here swap u+do 666 i head? -2 and if 667 i unloop exit 668 then 669 cell +loop 670 here ; 671 672[ifundef] umin \ !! bootstrapping help 673: umin ( u1 u2 -- u ) 674 2dup u> 675 if 676 swap 677 then 678 drop ; 679[then] 680 681: next-prim ( addr1 -- addr2 ) \ gforth 682 \G find the next primitive after addr1 (unreliable) 683 1+ >r -1 primstart 684 begin ( umin head R: boundary ) 685 @ dup 686 while 687 tuck name>int >code-address ( head1 umin ca R: boundary ) 688 r@ - umin 689 swap 690 repeat 691 drop dup r@ negate u>= 692 \ "umin+boundary within [0,boundary)" = "umin within [-boundary,0)" 693 if ( umin R: boundary ) \ no primitive found behind -> use a default length 694 drop 31 695 then 696 r> + ; 697 698: seecode ( xt -- ) 699 dup s" Code" .defname 700 >code-address 701 dup in-dictionary? \ user-defined code word? 702 if 703 dup next-head 704 else 705 dup next-prim 706 then 707 over - discode 708 ." end-code" cr ; 709: seevar ( xt -- ) 710 s" Variable" .defname cr ; 711: seeuser ( xt -- ) 712 s" User" .defname cr ; 713: seecon ( xt -- ) 714 dup >body ? 715 s" Constant" .defname cr ; 716: seevalue ( xt -- ) 717 dup >body ? 718 s" Value" .defname cr ; 719: seedefer ( xt -- ) 720 dup >body @ xt-see-xt cr 721 dup s" Defer" .defname cr 722 >name ?dup-if 723 ." IS " .name cr 724 else 725 ." latestxt >body !" 726 then ; 727: see-threaded ( addr -- ) 728 C-Pass @ DebugMode = IF 729 ScanMode c-pass ! 730 EXIT 731 THEN 732 ScanMode c-pass ! dup makepass 733 DisplayMode c-pass ! makepass ; 734: seedoes ( xt -- ) 735 dup s" create" .defname cr 736 S" DOES> " Com# .string XPos @ Level ! 737 >does-code see-threaded ; 738: seecol ( xt -- ) 739 dup s" :" .defname nl 740 2 Level ! 741 >body see-threaded ; 742: seefield ( xt -- ) 743 dup >body ." 0 " ? ." 0 0 " 744 s" Field" .defname cr ; 745 746: xt-see ( xt -- ) \ gforth 747 \G Decompile the definition represented by @i{xt}. 748 cr c-init 749 dup >does-code 750 if 751 seedoes EXIT 752 then 753 dup xtprim? 754 if 755 seecode EXIT 756 then 757 dup >code-address 758 CASE 759 docon: of seecon endof 760[IFDEF] dovalue: 761 dovalue: of seevalue endof 762[THEN] 763 docol: of seecol endof 764 dovar: of seevar endof 765[IFDEF] douser: 766 douser: of seeuser endof 767[THEN] 768[IFDEF] dodefer: 769 dodefer: of seedefer endof 770[THEN] 771[IFDEF] dofield: 772 dofield: of seefield endof 773[THEN] 774 over of seecode endof \ direct threaded code words 775 over >body of seecode endof \ indirect threaded code words 776 2drop abort" unknown word type" 777 ENDCASE ; 778 779: (xt-see-xt) ( xt -- ) 780 xt-see cr ." latestxt" ; 781' (xt-see-xt) is xt-see-xt 782 783: (.immediate) ( xt -- ) 784 ['] execute = if 785 ." immediate" 786 then ; 787 788: name-see ( nfa -- ) 789 dup name>int >r 790 dup name>comp 791 over r@ = 792 if \ normal or immediate word 793 swap xt-see (.immediate) 794 else 795 r@ ['] ticking-compile-only-error = 796 if \ compile-only word 797 swap xt-see (.immediate) ." compile-only" 798 else \ interpret/compile word 799 r@ xt-see-xt cr 800 swap xt-see-xt cr 801 ." interpret/compile: " over .name drop 802 then 803 then 804 rdrop drop ; 805 806: see ( "<spaces>name" -- ) \ tools 807 \G Locate @var{name} using the current search order. Display the 808 \G definition of @var{name}. Since this is achieved by decompiling 809 \G the definition, the formatting is mechanised and some source 810 \G information (comments, interpreted sequences within definitions 811 \G etc.) is lost. 812 name find-name dup 0= 813 IF 814 drop -&13 throw 815 THEN 816 name-see ; 817 818 819