Problem is with lines >80 chars long.
[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                 KEY DROP
431                 BEGIN
432                         KEY             ( get next character of the string )
433                         DUP [CHAR] " <>
434                 WHILE
435                         C,              ( copy character )
436                 REPEAT
437                 DROP            ( drop the double quote character at the end )
438                 DUP             ( get the saved address of the length word )
439                 HERE @ SWAP -   ( calculate the length )
440                 1-              ( subtract 1 (because we measured from the start of the length word) )
441                 SWAP !          ( and back-fill the length location )
442         ELSE            ( immediate mode )
443                 HERE @          ( get the start address of the temporary space )
444                 KEY DROP
445                 BEGIN
446                         KEY
447                         DUP [CHAR] " <>
448                 WHILE
449                         OVER C!         ( save next character )
450                         1+              ( increment address )
451                 REPEAT
452                 DROP            ( drop the final " character )
453                 HERE @ -        ( calculate the length )
454                 HERE @          ( push the start address )
455                 SWAP            ( addr len )
456         THEN
457 ;
458
459 : ." IMMEDIATE          ( -- )
460         [COMPILE] S"    ( read the string, and compile LITSTRING, etc. )
461         ['] TYPE ,      ( compile the final TYPE )
462 ;
463
464 : .( 
465         KEY DROP
466         BEGIN
467                 KEY
468                 DUP [CHAR] ) = IF
469                         DROP    ( drop the double quote character )
470                         EXIT    ( return from this function )
471                 THEN
472                 EMIT
473         AGAIN
474 ;
475
476 ( Converts address of counted string into address of
477   start of string and length of string. )
478 : COUNT ( addr1 -- addr2 n )
479         DUP 1+ SWAP @ ;
480
481
482 ( CONSTANTS AND VARIABLES ------------------------------------------------------ )
483
484 : CONSTANT
485         BL WORD HEADER  ( make dictionary entry (the name follows CONSTANT) )
486         DOCOL ,         ( append DOCOL (the codeword field of this word) )
487         ['] LIT ,       ( append the codeword LIT )
488         ,               ( append the value on the top of the stack )
489         ['] EXIT ,      ( append the codeword EXIT )
490 ;
491
492 : ALLOT         ( n -- )
493         HERE +!         ( adds n to HERE, after this the old value of HERE is still on the stack )
494 ;
495
496 : VARIABLE
497         CREATE
498         1 CELLS ALLOT   ( allocate 1 cell of memory, push the pointer to this memory )
499 ;
500
501
502 : VALUE         ( n -- )
503         BL WORD HEADER  ( make the dictionary entry (the name follows VALUE) )
504         DOCOL ,         ( append DOCOL )
505         ['] LIT ,       ( append the codeword LIT )
506         ,               ( append the initial value )
507         ['] EXIT ,      ( append the codeword EXIT )
508 ;
509
510 : TO IMMEDIATE  ( n -- )
511         BL WORD         ( get the name of the value )
512         FIND            ( look it up in the dictionary )
513         >PFA            ( get a pointer to the first data field (the 'LIT') )
514         1+              ( increment to point at the value )
515         STATE @ IF      ( compiling? )
516                 ['] LIT ,         ( compile LIT )
517                 ,               ( compile the address of the value )
518                 ['] ! ,           ( compile ! )
519         ELSE            ( immediate mode )
520                 !               ( update it straightaway )
521         THEN
522 ;
523
524 ( x +TO VAL adds x to VAL )
525 : +TO IMMEDIATE
526         BL WORD         ( get the name of the value )
527         FIND            ( look it up in the dictionary )
528         >PFA            ( get a pointer to the first data field (the 'LIT') )
529         1+              ( increment to point at the value )
530         STATE @ IF      ( compiling? )
531                 ['] LIT ,         ( compile LIT )
532                 ,               ( compile the address of the value )
533                 ['] +! ,          ( compile +! )
534         ELSE            ( immediate mode )
535                 +!              ( update it straightaway )
536         THEN
537 ;
538
539 ( Fill u ints, starting at a, with the value b )
540 : FILL          ( a u b -- )
541         -ROT OVER + SWAP ?DO
542                 DUP I !
543         LOOP
544         DROP
545 ;
546
547 : ERASE         ( a u -- )
548         0 FILL
549 ;
550
551 ( PRINTING THE DICTIONARY ------------------------------------------------------ )
552
553 : ID.
554         1+              ( skip over the link pointer )
555         DUP @           ( get the flags/length byte )
556         F_LENMASK AND   ( mask out the flags - just want the length )
557
558         BEGIN
559                 DUP 0>          ( length > 0? )
560         WHILE
561                 SWAP 1+         ( addr len -- len addr+1 )
562                 DUP @           ( len addr -- len addr char | get the next character)
563                 DUP 32 >= OVER 127 <= AND IF
564                         EMIT    ( len addr char -- len addr | and print it)
565                 ELSE
566                         BASE @ SWAP HEX
567                         ." \x" 0 .R
568                         BASE !
569                 THEN
570                 SWAP 1-         ( len addr -- addr len-1    | subtract one from length )
571         REPEAT
572         2DROP           ( len addr -- )
573 ;
574
575 : ?HIDDEN
576         1+              ( skip over the link pointer )
577         @               ( get the flags/length byte )
578         F_HIDDEN AND    ( mask the F_HIDDEN flag and return it (as a truth value) )
579 ;
580 : ?IMMEDIATE
581         1+              ( skip over the link pointer )
582         @               ( get the flags/length byte )
583         F_IMMED AND     ( mask the F_IMMED flag and return it (as a truth value) )
584 ;
585
586 : WORDS
587         LATEST @        ( start at LATEST dictionary entry )
588         BEGIN
589                 ?DUP            ( while link pointer is not null )
590         WHILE
591                 DUP ?HIDDEN NOT IF      ( ignore hidden words )
592                         DUP ID.         ( but if not hidden, print the word )
593                         SPACE
594                 THEN
595                 @               ( dereference the link pointer - go to previous word )
596         REPEAT
597         CR
598 ;
599
600
601 ( FORGET ---------------------------------------------------------------------- )
602
603 : FORGET
604         BL WORD FIND    ( find the word, gets the dictionary entry address )
605         DUP @ LATEST !  ( set LATEST to point to the previous word )
606         HERE !          ( and store HERE with the dictionary address )
607 ;
608
609 ( DUMP ------------------------------------------------------------------------ )
610
611 \ TODO!
612
613
614 ( DECOMPILER ------------------------------------------------------------------ )
615
616 : CFA>
617         LATEST @        ( start at LATEST dictionary entry )
618         BEGIN
619                 ?DUP            ( while link pointer is not null )
620         WHILE
621                 2DUP SWAP       ( cfa curr curr cfa )
622                 < IF            ( current dictionary entry < cfa? )
623                         NIP             ( leave curr dictionary entry on the stack )
624                         EXIT
625                 THEN
626                 @               ( follow link pointer back )
627         REPEAT
628         DROP            ( restore stack )
629         0               ( sorry, nothing found )
630 ;
631
632 : SEE
633         BL WORD 2DUP FIND     ( find the dictionary entry to decompile )
634
635         ?DUP 0= IF
636                 ." Word '" TYPE ." ' not found in dictionary."
637                 EXIT
638         THEN
639
640         -ROT 2DROP
641
642         ( Now we search again, looking for the next word in the dictionary.  This gives us
643           the length of the word that we will be decompiling.  (Well, mostly it does). )
644         HERE @          ( address of the end of the last compiled word )
645         LATEST @        ( word last curr )
646         BEGIN
647                 2 PICK          ( word last curr word )
648                 OVER            ( word last curr word curr )
649                 <>              ( word last curr word<>curr? )
650         WHILE                   ( word last curr )
651                 NIP             ( word curr )
652                 DUP @           ( word curr prev (which becomes: word last curr) )
653         REPEAT
654
655         DROP            ( at this point, the stack is: start-of-word end-of-word )
656         SWAP            ( end-of-word start-of-word )
657
658         DUP >CFA @ CASE
659                 DOCOL OF
660                         \ Colon definition
661                         [CHAR] : EMIT SPACE DUP ID. SPACE
662                         DUP ?IMMEDIATE IF ." IMMEDIATE " THEN CR
663                 ENDOF
664                 DOVAR OF
665                         \ Variable definition
666                         ." Variable " DUP ID. CR
667                         2DROP EXIT
668                 ENDOF
669                 DOCON OF
670                         \ Constant definition
671                         ." Constant " DUP ID. CR
672                         2DROP EXIT
673                 ENDOF
674
675                 \ Unknown codeword
676                 ." Primitive or word with unrecognized codeword." CR 
677                 DROP 2DROP EXIT
678         ENDCASE
679
680         ( begin the definition with : NAME [IMMEDIATE] )
681         ( [CHAR] : EMIT SPACE DUP ID. SPACE
682         DUP ?IMMEDIATE IF ." IMMEDIATE " THEN CR 4 )
683
684         4 SPACES
685
686         >PFA            ( get the data address, ie. points after DOCOL | end-of-word start-of-data )
687
688         ( now we start decompiling until we hit the end of the word )
689         BEGIN           ( end start )
690                 2DUP >
691         WHILE
692                 DUP @           ( end start codeword )
693
694                 CASE
695                 ['] LIT OF                ( is it LIT ? )
696                         1+ DUP @                ( get next word which is the integer constant )
697                         .                       ( and print it )
698                 ENDOF
699                 ['] LITSTRING OF          ( is it LITSTRING ? )
700                         [CHAR] S EMIT [CHAR] " EMIT SPACE ( print S"<space> )
701                         1+ DUP @                ( get the length word )
702                         SWAP 1+ SWAP            ( end start+1 length )
703                         2DUP TYPE               ( print the string )
704                         [CHAR] " EMIT SPACE          ( finish the string with a final quote )
705                         +                       ( end start+1+len, aligned )
706                         1-                     ( because we're about to add 4 below )
707                 ENDOF
708                 ['] 0BRANCH OF            ( is it 0BRANCH ? )
709                         ." 0BRANCH ( "
710                         1+ DUP @               ( print the offset )
711                         .
712                         ." ) "
713                 ENDOF
714                 ['] BRANCH OF             ( is it BRANCH ? )
715                         ." BRANCH ( "
716                         1+ DUP @               ( print the offset )
717                         .
718                         ." ) "
719                 ENDOF
720                 ['] ['] OF                  ( is it ['] ? )
721                         ." ['] "
722                         1+ DUP @               ( get the next codeword )
723                         CFA>                    ( and force it to be printed as a dictionary entry )
724                         ID. SPACE
725                 ENDOF
726                 ['] EXIT OF               ( is it EXIT? )
727                         ( We expect the last word to be EXIT, and if it is then we don't print it
728                           because EXIT is normally implied by ;.  EXIT can also appear in the middle
729                           of words, and then it needs to be printed. )
730                         2DUP                    ( end start end start )
731                         1+                     ( end start end start+1 )
732                         <> IF                   ( end start | we're not at the end )
733                                 ." EXIT "
734                         THEN
735                 ENDOF
736                                         ( default case: )
737                         DUP                     ( in the default case we always need to DUP before using )
738                         CFA>                    ( look up the codeword to get the dictionary entry )
739                         ID. SPACE               ( and print it )
740                 ENDCASE
741
742                 1+             ( end start+1 )
743         REPEAT
744
745         [CHAR] ; EMIT CR
746
747         2DROP           ( restore stack )
748 ;
749
750
751 ( MEMORY  ------------------------------------------------------------------ )
752
753 : UNUSED  ( -- cells )
754         MEMSIZE HERE @ - ;