src/lib.4th

   1 : \ IMMEDIATE
   2         #TIB @ >IN !
   3 ; \ We can now comment!
   4
   5 \ BASIC DEFINITIONS  ----------------------------------------------------------------------
   6
   7 : / /MOD SWAP DROP ;
   8 : MOD /MOD DROP ;
   9 : */ -ROT * SWAP / ;
  10
  11 : NEGATE 0 SWAP - ;
  12
  13 : TRUE -1 ;
  14 : FALSE 0 ;
  15 : NOT 0= ;
  16
  17 \ Translate a number of cells into memory units
  18 \ (in our case 1 cell = 1 memory unit)
  19 : CELLS ;
  20
  21 \ Since the smallest unit of memory in our system is 64 bits and since strings
  22 \ are stored as arrays of 64 bit integers, the character store/fetch words are
  23 \ just aliases of the standard store/fetch words.
  24 : C! ! ;
  25 : C@ @ ;
  26 : C, , ;
  27
  28 : DEPTH PSP@ PSP0 - ;
  29
  30 : '\n' 10 ;
  31 : BL 32 ;
  32
  33 : LITERAL IMMEDIATE ['] LIT , , ;
  34
  35 : ' BL WORD FIND DROP ;
  36
  37 : CHAR BL WORD 1+ @ ;
  38 : [CHAR] IMMEDIATE
  39     CHAR
  40     ['] LIT , ,
  41 ;
  42
  43 : CR '\n' emit ;
  44 : SPACE BL emit ;
  45
  46 : [COMPILE] IMMEDIATE
  47         BL WORD         \ get the next word
  48         FIND DROP       \ find it in the dictionary
  49         ,               \ and compile that
  50 ;
  51
  52 : RECURSE IMMEDIATE
  53         LATEST @        \ LATEST points to the word being compiled at the moment
  54         >CFA            \ get the codeword
  55         ,               \ compile it
  56 ;
  57
  58 \ CONTROL STRUCTURES ----------------------------------------------------------------------
  59
  60 : IF IMMEDIATE
  61         ['] 0BRANCH ,     \ compile 0BRANCH
  62         HERE          \ save location of the offset on the stack
  63         0 ,             \ compile a dummy offset
  64 ;
  65
  66 : THEN IMMEDIATE
  67         DUP
  68         HERE SWAP -   \ calculate the offset from the address saved on the stack
  69         SWAP !          \ store the offset in the back-filled location
  70 ;
  71
  72 : ELSE IMMEDIATE
  73         ['] BRANCH ,      \ definite branch to just over the false-part
  74         HERE          \ save location of the offset on the stack
  75         0 ,             \ compile a dummy offset
  76         SWAP            \ now back-fill the original (IF) offset
  77         DUP             \ same as for THEN word above
  78         HERE SWAP -
  79         SWAP !
  80 ;
  81
  82 : BEGIN IMMEDIATE
  83         HERE          \ save location on the stack
  84 ;
  85
  86 : UNTIL IMMEDIATE
  87         ['] 0BRANCH ,     \ compile 0BRANCH
  88         HERE -        \ calculate the offset from the address saved on the stack
  89         ,               \ compile the offset here
  90 ;
  91
  92 : AGAIN IMMEDIATE
  93         ['] BRANCH ,      \ compile BRANCH
  94         HERE -        \ calculate the offset back
  95         ,               \ compile the offset here
  96 ;
  97
  98 : WHILE IMMEDIATE
  99         ['] 0BRANCH ,     \ compile 0BRANCH
 100         HERE          \ save location of the offset2 on the stack
 101         0 ,             \ compile a dummy offset2
 102 ;
 103
 104 : REPEAT IMMEDIATE
 105         ['] BRANCH ,      \ compile BRANCH
 106         SWAP            \ get the original offset (from BEGIN)
 107         HERE - ,      \ and compile it after BRANCH
 108         DUP
 109         HERE SWAP -   \ calculate the offset2
 110         SWAP !          \ and back-fill it in the original location
 111 ;
 112
 113 : UNLESS IMMEDIATE
 114         ['] NOT ,         \ compile NOT (to reverse the test)
 115         [COMPILE] IF    \ continue by calling the normal IF
 116 ;
 117
 118 : DO IMMEDIATE
 119         ['] LIT , -1 , [COMPILE] IF
 120         ['] >R , ['] >R ,
 121         ['] LIT , HERE 0 , ['] >R ,
 122         HERE
 123 ;
 124
 125 : ?DO IMMEDIATE
 126         ['] 2DUP , ['] - , [COMPILE] IF
 127         ['] >R , ['] >R ,
 128         ['] LIT , HERE 0 , ['] >R ,
 129         HERE
 130 ;
 131
 132 : I RSP@ 3 - @ ;
 133
 134 : J RSP@ 6 - @ ;
 135
 136 : ?LEAVE IMMEDIATE
 137         ['] 0BRANCH , 13 ,
 138         ['] R> , ['] RDROP , ['] RDROP ,
 139         ['] LIT ,  HERE 7 + , ['] DUP , ['] -ROT , ['] - , ['] SWAP , ['] ! ,
 140         ['] BRANCH ,
 141         0 ,
 142 ;
 143
 144 : LEAVE IMMEDIATE
 145         ['] LIT , -1 ,
 146         [COMPILE] ?LEAVE
 147 ;
 148
 149 : +LOOP IMMEDIATE
 150
 151         ['] DUP , \ Store copy of increment
 152
 153         ['] R> , ['] SWAP , ['] R> , ['] SWAP , ['] R> , ['] SWAP , ['] + , ['] 2DUP , ['] - ,
 154         ['] SWAP , ['] >R , ['] SWAP , ['] >R , ['] SWAP , ['] >R ,
 155
 156         \ Condition differently depending on sign of increment
 157         ['] SWAP , ['] 0>= , [COMPILE] IF
 158             ['] 0<= ,
 159         [COMPILE] ELSE
 160             ['] 0> ,
 161         [COMPILE] THEN
 162
 163         \ Branch back to begining of loop kernel
 164         ['] 0BRANCH , HERE - ,
 165
 166         \ Clean up
 167         ['] RDROP , ['] RDROP , ['] RDROP ,
 168
 169         \ Record address of loop end for any LEAVEs to use
 170         HERE SWAP !
 171
 172         [COMPILE] ELSE
 173             ['] 2DROP , \ Clean up if loop was entirely skipped (?DO)
 174         [COMPILE] THEN
 175 ;
 176
 177 : LOOP IMMEDIATE
 178         ['] LIT , 1 ,
 179         [COMPILE] +LOOP
 180 ;
 181
 182
 183 \ CASE ------------------------------------------------------------------------
 184
 185 : CASE IMMEDIATE
 186         0               \ push 0 to mark the bottom of the stack
 187 ;
 188
 189 : OF IMMEDIATE
 190         ['] OVER ,        \ compile OVER
 191         ['] = ,           \ compile =
 192         [COMPILE] IF      \ compile IF
 193         ['] DROP ,        \ compile DROP
 194 ;
 195
 196 : ENDOF IMMEDIATE
 197         [COMPILE] ELSE    \ ENDOF is the same as ELSE
 198 ;
 199
 200 : ENDCASE IMMEDIATE
 201         ['] DROP ,        \ compile DROP
 202
 203         \ keep compiling THEN until we get to our zero marker
 204         BEGIN
 205                 ?DUP
 206         WHILE
 207                 [COMPILE] THEN
 208         REPEAT
 209 ;
 210
 211
 212 \ COMMENTS ----------------------------------------------------------------------
 213
 214 : ( IMMEDIATE
 215         1               \ allowed nested parens by keeping track of depth
 216         BEGIN
 217                 >IN @ #TIB @ >= IF      \ End of TIB?
 218                         QUERY       \ Get next line
 219                 THEN
 220
 221                 TIB >IN @ + @ 1 >IN +!
 222                 DUP [CHAR] ( = IF    \ open paren?
 223                         DROP            \ drop the open paren
 224                         1+              \ depth increases
 225                 ELSE
 226                         [CHAR] ) = IF        \ close paren?
 227                                 1-              \ depth decreases
 228                         THEN
 229                 THEN
 230         DUP 0= UNTIL            \ continue until we reach matching close paren, depth 0
 231         DROP            \ drop the depth counter
 232 ;
 233
 234 ( Some more complicated stack examples, showing the stack notation. )
 235 : NIP ( x y -- y ) SWAP DROP ;
 236 : TUCK ( x y -- y x y ) DUP -ROT ;
 237 : PICK ( x_u ... x_1 x_0 u -- x_u ... x_1 x_0 x_u )
 238         1+              ( add one because of 'u' on the stack )
 239         PSP@ SWAP -     ( add to the stack pointer )
 240         @               ( and fetch )
 241 ;
 242 : ROLL ( x_u x_u-1... x_0 u -- x_u-1 ... x_0 x_u )
 243         1+ DUP PICK SWAP    ( x_u x_u-1 ... x_0 x_u u+1 )
 244         PSP@ 1- SWAP - PSP@ 2- SWAP
 245         DO
 246             i 1+ @ i !
 247         LOOP
 248         SWAP DROP
 249 ;
 250
 251 ( With the looping constructs, we can now write SPACES, which writes n spaces to stdout. )
 252 : SPACES        ( n -- )
 253         DUP 0> IF
 254             0 DO SPACE LOOP
 255         ELSE
 256             DROP
 257         THEN
 258 ;
 259
 260 ( Standard words for manipulating BASE. )
 261 : DECIMAL ( -- ) 10 BASE ! ;
 262 : HEX ( -- ) 16 BASE ! ;
 263
 264 ( Compute absolute value. )
 265 : ABS           ( n -- |n| )
 266         dup 0< if
 267                 negate
 268         then
 269 ;
 270
 271 : MAX           ( n m -- max )
 272         2dup - 0< if
 273                 swap drop
 274         else
 275                 drop
 276         then
 277 ;
 278
 279 : MIN           ( n m -- max )
 280         2dup - 0> if
 281                 swap drop
 282         else
 283                 drop
 284         then
 285 ;
 286
 287 ( PRINTING NUMBERS ---------------------------------------------------------------------- )
 288
 289 ( This is the underlying recursive definition of U. )
 290 : U.            ( u -- )
 291         BASE @ /MOD     ( width rem quot )
 292         ?DUP IF                 ( if quotient <> 0 then )
 293                 RECURSE         ( print the quotient )
 294         THEN
 295
 296         ( print the remainder )
 297         DUP 10 < IF
 298                 [CHAR] 0             ( decimal digits 0..9 )
 299         ELSE
 300                 10 -            ( hex and beyond digits A..Z )
 301                 [CHAR] A
 302         THEN
 303         +
 304         EMIT
 305 ;
 306
 307 ( This word returns the width (in characters) of an unsigned number in the current base )
 308 : UWIDTH        ( u -- width )
 309         BASE @ /        ( rem quot )
 310         ?DUP IF         ( if quotient <> 0 then )
 311                 RECURSE 1+      ( return 1+recursive call )
 312         ELSE
 313                 1               ( return 1 )
 314         THEN
 315 ;
 316
 317 : U.R           ( u width -- )
 318         SWAP            ( width u )
 319         DUP             ( width u u )
 320         UWIDTH          ( width u uwidth )
 321         ROT            ( u uwidth width )
 322         SWAP -          ( u width-uwidth )
 323         ( At this point if the requested width is narrower, we'll have a negative number on the stack.
 324           Otherwise the number on the stack is the number of spaces to print.  But SPACES won't print
 325           a negative number of spaces anyway, so it's now safe to call SPACES ... )
 326         SPACES
 327         ( ... and then call the underlying implementation of U. )
 328         U.
 329 ;
 330
 331 : .R            ( n width -- )
 332         SWAP            ( width n )
 333         DUP 0< IF
 334                 NEGATE          ( width u )
 335                 1               ( save a flag to remember that it was negative | width n 1 )
 336                 -ROT             ( 1 width u )
 337                 SWAP            ( 1 u width )
 338                 1-              ( 1 u width-1 )
 339         ELSE
 340                 0               ( width u 0 )
 341                 -ROT             ( 0 width u )
 342                 SWAP            ( 0 u width )
 343         THEN
 344         SWAP            ( flag width u )
 345         DUP             ( flag width u u )
 346         UWIDTH          ( flag width u uwidth )
 347         ROT            ( flag u uwidth width )
 348         SWAP -          ( flag u width-uwidth )
 349
 350         SPACES          ( flag u )
 351         SWAP            ( u flag )
 352
 353         IF                      ( was it negative? print the - character )
 354                 [CHAR] - EMIT
 355         THEN
 356
 357         U.
 358 ;
 359
 360 : . 0 .R SPACE ;
 361
 362 : .S            ( -- )
 363         [CHAR] < EMIT DEPTH U. [CHAR] > EMIT SPACE
 364         PSP0 1+
 365         BEGIN
 366                 DUP PSP@ 2 - <=
 367         WHILE
 368                 DUP @ .
 369                 1+
 370         REPEAT
 371         DROP
 372 ;
 373
 374 : U. U. SPACE ;
 375
 376 ( ? fetches the integer at an address and prints it. )
 377 : ? ( addr -- ) @ . ;
 378
 379 ( c a b WITHIN returns true if a <= c and c < b )
 380 : WITHIN
 381         -ROT             ( b c a )
 382         OVER            ( b c a c )
 383         <= IF
 384                 > IF            ( b c -- )
 385                         TRUE
 386                 ELSE
 387                         FALSE
 388                 THEN
 389         ELSE
 390                 2DROP           ( b c -- )
 391                 FALSE
 392         THEN
 393 ;
 394
 395
 396 ( STRINGS ---------------------------------------------------------------------- )
 397
 398
 399 ( Block copy, however, is important and novel: )
 400 : CMOVE ( src dest length -- )
 401
 402         DUP 0<= IF
 403                 EXIT
 404         THEN
 405
 406         -ROT OVER -         ( length src (dest-src) )
 407         -ROT DUP ROT + SWAP ( (dest-src) (src+length) src )
 408
 409         DO
 410                 I @         ( (dest-src) i@ )
 411                 OVER I +    ( (dest-src) i@ (dest-src+i) )
 412                 !           ( (dest-src) )
 413         LOOP
 414
 415         DROP
 416 ;
 417
 418 ( C, appends a byte to the current compiled word. )
 419 : C,
 420         HERE C!
 421         1 H +!
 422 ;
 423
 424 : S" IMMEDIATE          ( -- addr len )
 425         STATE @ IF      ( compiling? )
 426                 ['] LITSTRING ,   ( compile LITSTRING )
 427                 HERE          ( save the address of the length word on the stack )
 428                 0 ,             ( dummy length - we don't know what it is yet )
 429
 430                 BEGIN
 431                         >IN @ #TIB @ >= IF      \ End of TIB?
 432                                 QUERY           \ Get next line
 433                         THEN
 434
 435                         TIB >IN @ + @ 1 >IN +!  \ Get char from TIB
 436
 437                         DUP [CHAR] " <>
 438                 WHILE
 439                         C,              ( copy character )
 440                 REPEAT
 441                 DROP            ( drop the double quote character at the end )
 442                 DUP             ( get the saved address of the length word )
 443                 HERE SWAP -   ( calculate the length )
 444                 1-              ( subtract 1 (because we measured from the start of the length word) )
 445                 SWAP !          ( and back-fill the length location )
 446         ELSE            ( immediate mode )
 447                 HERE          ( get the start address of the temporary space )
 448
 449                 BEGIN
 450                         >IN @ #TIB @ >= IF      \ End of TIB?
 451                                 QUERY           \ Get next line
 452                         THEN
 453
 454                         TIB >IN @ + @ 1 >IN +!  \ Get char from TIB
 455
 456                         DUP [CHAR] " <>
 457                 WHILE
 458                         OVER C!         ( save next character )
 459                         1+              ( increment address )
 460                 REPEAT
 461                 DROP            ( drop the final " character )
 462                 HERE -        ( calculate the length )
 463                 HERE          ( push the start address )
 464                 SWAP            ( addr len )
 465         THEN
 466 ;
 467
 468 : ." IMMEDIATE          ( -- )
 469         [COMPILE] S"    ( read the string, and compile LITSTRING, etc. )
 470         ['] TYPE ,      ( compile the final TYPE )
 471 ;
 472
 473 : .(
 474         BEGIN
 475                 >IN @ #TIB @ >= IF      \ End of TIB?
 476                         QUERY           \ Get next line
 477                 THEN
 478
 479                 TIB >IN @ + @ 1 >IN +!  \ Get char from TIB
 480
 481                 DUP [CHAR] ) = IF
 482                         DROP    ( drop the double quote character )
 483                         EXIT    ( return from this function )
 484                 THEN
 485                 EMIT
 486         AGAIN
 487 ;
 488
 489 ( Converts address of counted string into address of
 490   start of string and length of string. )
 491 : COUNT ( addr1 -- addr2 n )
 492         DUP 1+ SWAP @ ;
 493
 494
 495 ( CONSTANTS AND VARIABLES ------------------------------------------------------ )
 496
 497 : CONSTANT
 498         CREATE ,
 499 DOES>   @
 500 ;
 501
 502 : ALLOT         ( n -- )
 503         H +!         ( adds n to H, after this the old value of H is still on the stack )
 504 ;
 505
 506 : VARIABLE
 507         CREATE
 508         1 CELLS ALLOT   ( allocate 1 cell of memory, push the pointer to this memory )
 509 ;
 510
 511 : VALUE         ( n -- )
 512         CREATE ,
 513 DOES>   @
 514 ;
 515
 516 : TO IMMEDIATE  ( n -- )
 517         BL WORD         ( get the name of the value )
 518         FIND DROP       ( look it up in the dictionary )
 519         >BODY           ( get a pointer to the first data field (the 'LIT') )
 520         STATE @ IF      ( compiling? )
 521                 ['] LIT ,         ( compile LIT )
 522                 ,               ( compile the address of the value )
 523                 ['] ! ,           ( compile ! )
 524         ELSE            ( immediate mode )
 525                 !               ( update it straightaway )
 526         THEN
 527 ;
 528
 529 ( x +TO VAL adds x to VAL )
 530 : +TO IMMEDIATE
 531         BL WORD         ( get the name of the value )
 532         FIND DROP       ( look it up in the dictionary )
 533         >BODY           ( get a pointer to the first data field (the 'LIT') )
 534         STATE @ IF      ( compiling? )
 535                 ['] LIT ,         ( compile LIT )
 536                 ,               ( compile the address of the value )
 537                 ['] +! ,          ( compile +! )
 538         ELSE            ( immediate mode )
 539                 +!              ( update it straightaway )
 540         THEN
 541 ;
 542
 543 ( Fill u ints, starting at a, with the value b )
 544 : FILL          ( a u b -- )
 545         -ROT OVER + SWAP ?DO
 546                 DUP I !
 547         LOOP
 548         DROP
 549 ;
 550
 551 : ERASE         ( a u -- )
 552         0 FILL
 553 ;
 554
 555 ( PRINTING THE DICTIONARY ------------------------------------------------------ )
 556
 557 : .NAME
 558         DUP @           ( get the flags/length byte )
 559         F_LENMASK AND   ( mask out the flags - just want the length )
 560
 561         BEGIN
 562                 DUP 0>          ( length > 0? )
 563         WHILE
 564                 SWAP 1+         ( addr len -- len addr+1 )
 565                 DUP @           ( len addr -- len addr char | get the next character)
 566                 DUP 32 >= OVER 127 <= AND IF
 567                         EMIT    ( len addr char -- len addr | and print it)
 568                 ELSE
 569                         BASE @ SWAP HEX
 570                         ." \x" 0 .R
 571                         BASE !
 572                 THEN
 573                 SWAP 1-         ( len addr -- addr len-1    | subtract one from length )
 574         REPEAT
 575         2DROP           ( len addr -- )
 576 ;
 577
 578 : ?HIDDEN
 579         1+              ( skip over the link pointer )
 580         @               ( get the flags/length byte )
 581         F_HIDDEN AND    ( mask the F_HIDDEN flag and return it (as a truth value) )
 582 ;
 583 : ?IMMEDIATE
 584         1+              ( skip over the link pointer )
 585         @               ( get the flags/length byte )
 586         F_IMMED AND     ( mask the F_IMMED flag and return it (as a truth value) )
 587 ;
 588
 589 : WORDS
 590         CR
 591         LATEST @        ( start at LATEST dictionary entry )
 592         BEGIN
 593                 ?DUP            ( while link pointer is not null )
 594         WHILE
 595                 DUP ?HIDDEN NOT IF      ( ignore hidden words )
 596                         DUP 1+ .NAME         ( but if not hidden, print the word )
 597                         SPACE
 598                 THEN
 599                 @               ( dereference the link pointer - go to previous word )
 600         REPEAT
 601         CR
 602 ;
 603
 604 ( DUMP ------------------------------------------------------------------------ )
 605
 606 \ TODO!
 607
 608
 609 ( DECOMPILER ------------------------------------------------------------------ )
 610
 611 : >NAME
 612         BEGIN
 613                 1- DUP @
 614                 NFA_MARK AND
 615         NFA_MARK = UNTIL
 616 ;
 617
 618 : >LFA  >NAME 1- ;
 619
 620 : SEE
 621         BL WORD FIND    ( find the dictionary entry to decompile )
 622
 623         CR
 624
 625         0= IF
 626                 ." Word '" COUNT TYPE ." ' not found in dictionary."
 627                 EXIT
 628         THEN
 629
 630         >LFA
 631
 632         ( Now we search again, looking for the next word in the dictionary.  This gives us
 633           the length of the word that we will be decompiling.  (Well, mostly it does). )
 634         HERE          ( address of the end of the last compiled word )
 635         LATEST @        ( word last curr )
 636         BEGIN
 637                 2 PICK          ( word last curr word )
 638                 OVER            ( word last curr word curr )
 639                 <>              ( word last curr word<>curr? )
 640         WHILE                   ( word last curr )
 641                 NIP             ( word curr )
 642                 DUP @           ( word curr prev (which becomes: word last curr) )
 643         REPEAT
 644
 645         DROP            ( at this point, the stack is: start-of-word end-of-word )
 646         SWAP            ( end-of-word start-of-word )
 647
 648         DUP >CFA @ CASE
 649                 DOCOL OF
 650                         \ Colon definition
 651                         [CHAR] : EMIT SPACE DUP 1+ .NAME SPACE
 652                         DUP ?IMMEDIATE IF ." IMMEDIATE " THEN CR
 653                 ENDOF
 654                 DOVAR OF
 655                         \ Variable definition
 656                         ." Variable " DUP 1+ .NAME CR
 657                         2DROP EXIT
 658                 ENDOF
 659                 DOCON OF
 660                         \ Constant definition
 661                         ." Constant " DUP 1+ .NAME CR
 662                         2DROP EXIT
 663                 ENDOF
 664
 665                 \ Unknown codeword
 666                 ." Primitive or word with unrecognized codeword." CR
 667                 DROP 2DROP EXIT
 668         ENDCASE
 669
 670         4 SPACES
 671
 672         >CFA >BODY            ( get the data address, ie. points after DOCOL | end-of-word start-of-data )
 673
 674         ( now we start decompiling until we hit the end of the word )
 675         BEGIN           ( end start )
 676                 2DUP >
 677         WHILE
 678                 DUP @           ( end start codeword )
 679
 680                 CASE
 681                 ['] LIT OF                ( is it LIT ? )
 682                         1+ DUP @                ( get next word which is the integer constant )
 683                         .                       ( and print it )
 684                 ENDOF
 685                 ['] LITSTRING OF          ( is it LITSTRING ? )
 686                         [CHAR] S EMIT [CHAR] " EMIT SPACE ( print S"<space> )
 687                         1+ DUP @                ( get the length word )
 688                         SWAP 1+ SWAP            ( end start+1 length )
 689                         2DUP TYPE               ( print the string )
 690                         [CHAR] " EMIT SPACE          ( finish the string with a final quote )
 691                         +                       ( end start+1+len, aligned )
 692                         1-                     ( because we're about to add 4 below )
 693                 ENDOF
 694                 ['] 0BRANCH OF            ( is it 0BRANCH ? )
 695                         ." 0BRANCH ( "
 696                         1+ DUP @               ( print the offset )
 697                         .
 698                         ." ) "
 699                 ENDOF
 700                 ['] BRANCH OF             ( is it BRANCH ? )
 701                         ." BRANCH ( "
 702                         1+ DUP @               ( print the offset )
 703                         .
 704                         ." ) "
 705                 ENDOF
 706                 ['] ['] OF                  ( is it ['] ? )
 707                         ." ['] "
 708                         1+ DUP @               ( get the next codeword )
 709                         >NAME                    ( and force it to be printed as a dictionary entry )
 710                         .NAME SPACE
 711                 ENDOF
 712                 ['] EXIT OF               ( is it EXIT? )
 713                         ( We expect the last word to be EXIT, and if it is then we don't print it
 714                           because EXIT is normally implied by ;.  EXIT can also appear in the middle
 715                           of words, and then it needs to be printed. )
 716                         2DUP                    ( end start end start )
 717                         1+                     ( end start end start+1 )
 718                         <> IF                   ( end start | we're not at the end )
 719                                 ." EXIT "
 720                         THEN
 721                 ENDOF
 722                                         ( default case: )
 723                         DUP                     ( in the default case we always need to DUP before using )
 724                         >NAME                    ( look up the codeword to get the dictionary entry )
 725                         .NAME SPACE               ( and print it )
 726                 ENDCASE
 727
 728                 1+             ( end start+1 )
 729         REPEAT
 730
 731         [CHAR] ; EMIT CR
 732
 733         2DROP           ( restore stack )
 734 ;
 735
 736
 737 ( FORGET and HIDE ------------------------------------------------------------ )
 738
 739 : FORGET
 740         BL WORD FIND >LFA   ( find the word, gets the dictionary entry address )
 741         DUP @ LATEST !      ( set LATEST to point to the previous word )
 742         H !                 ( and store H with the dictionary address )
 743 ;
 744
 745 : HIDE
 746         BL WORD FIND DROP >NAME
 747         DUP @ F_HIDDEN OR SWAP !
 748 ;
 749
 750 ( MEMORY  ------------------------------------------------------------------ )
 751
 752 : UNUSED  ( -- cells )
 753         MEMSIZE HERE - ;