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