+
+ DROP
+;
+
+( C, appends a byte to the current compiled word. )
+: C,
+ HERE @ C!
+ 1 HERE +!
+;
+
+: S" IMMEDIATE ( -- addr len )
+ STATE @ IF ( compiling? )
+ ['] LITSTRING , ( compile LITSTRING )
+ HERE @ ( save the address of the length word on the stack )
+ 0 , ( dummy length - we don't know what it is yet )
+ KEY DROP
+ BEGIN
+ KEY ( get next character of the string )
+ DUP [CHAR] " <>
+ WHILE
+ C, ( copy character )
+ REPEAT
+ DROP ( drop the double quote character at the end )
+ DUP ( get the saved address of the length word )
+ HERE @ SWAP - ( calculate the length )
+ 1- ( subtract 1 (because we measured from the start of the length word) )
+ SWAP ! ( and back-fill the length location )
+ ELSE ( immediate mode )
+ HERE @ ( get the start address of the temporary space )
+ KEY DROP
+ BEGIN
+ KEY
+ DUP [CHAR] " <>
+ WHILE
+ OVER C! ( save next character )
+ 1+ ( increment address )
+ REPEAT
+ DROP ( drop the final " character )
+ HERE @ - ( calculate the length )
+ HERE @ ( push the start address )
+ SWAP ( addr len )
+ THEN
+;
+
+: ." IMMEDIATE ( -- )
+ [COMPILE] S" ( read the string, and compile LITSTRING, etc. )
+ ['] TELL , ( compile the final TELL )
+;
+
+: .(
+ KEY DROP
+ BEGIN
+ KEY
+ DUP [CHAR] ) = IF
+ DROP ( drop the double quote character )
+ EXIT ( return from this function )
+ THEN
+ EMIT
+ AGAIN
+;
+
+
+( CONSTANTS AND VARIABLES ------------------------------------------------------ )
+
+: CONSTANT
+ WORD HEADER ( make dictionary entry (the name follows CONSTANT) )
+ DOCOL , ( append DOCOL (the codeword field of this word) )
+ ['] LIT , ( append the codeword LIT )
+ , ( append the value on the top of the stack )
+ ['] EXIT , ( append the codeword EXIT )
+;
+
+: ALLOT ( n -- )
+ HERE +! ( adds n to HERE, after this the old value of HERE is still on the stack )
+;
+
+: VARIABLE
+ CREATE
+ 1 CELLS ALLOT ( allocate 1 cell of memory, push the pointer to this memory )
+;
+
+
+: VALUE ( n -- )
+ WORD HEADER ( make the dictionary entry (the name follows VALUE) )
+ DOCOL , ( append DOCOL )
+ ['] LIT , ( append the codeword LIT )
+ , ( append the initial value )
+ ['] EXIT , ( append the codeword EXIT )
+;
+
+: TO IMMEDIATE ( n -- )
+ WORD ( get the name of the value )
+ FIND ( look it up in the dictionary )
+ >DFA ( get a pointer to the first data field (the 'LIT') )
+ 1+ ( increment to point at the value )
+ STATE @ IF ( compiling? )
+ ['] LIT , ( compile LIT )
+ , ( compile the address of the value )
+ ['] ! , ( compile ! )
+ ELSE ( immediate mode )
+ ! ( update it straightaway )
+ THEN
+;
+
+( x +TO VAL adds x to VAL )
+: +TO IMMEDIATE
+ WORD ( get the name of the value )
+ FIND ( look it up in the dictionary )
+ >DFA ( get a pointer to the first data field (the 'LIT') )
+ 1+ ( increment to point at the value )
+ STATE @ IF ( compiling? )
+ ['] LIT , ( compile LIT )
+ , ( compile the address of the value )
+ ['] +! , ( compile +! )
+ ELSE ( immediate mode )
+ +! ( update it straightaway )
+ THEN
+;
+
+( Fill u ints, starting at a, with the value b )
+: FILL ( a u b -- )
+ -ROT OVER + SWAP ?DO
+ DUP I !
+ LOOP
+ DROP
+;
+
+: ERASE ( a u -- )
+ 0 FILL
+;
+
+( PRINTING THE DICTIONARY ------------------------------------------------------ )
+
+: ID.
+ 1+ ( skip over the link pointer )
+ DUP @ ( get the flags/length byte )
+ F_LENMASK AND ( mask out the flags - just want the length )
+
+ BEGIN
+ DUP 0> ( length > 0? )
+ WHILE
+ SWAP 1+ ( addr len -- len addr+1 )
+ DUP @ ( len addr -- len addr char | get the next character)
+ DUP 32 >= OVER 127 <= AND IF
+ EMIT ( len addr char -- len addr | and print it)
+ ELSE
+ BASE @ SWAP HEX
+ ." \x" 0 .R
+ BASE !
+ THEN
+ SWAP 1- ( len addr -- addr len-1 | subtract one from length )
+ REPEAT
+ 2DROP ( len addr -- )
+;
+
+: ?HIDDEN
+ 1+ ( skip over the link pointer )
+ @ ( get the flags/length byte )
+ F_HIDDEN AND ( mask the F_HIDDEN flag and return it (as a truth value) )
+;
+: ?IMMEDIATE
+ 1+ ( skip over the link pointer )
+ @ ( get the flags/length byte )
+ F_IMMED AND ( mask the F_IMMED flag and return it (as a truth value) )