Ported last of relevant jonesforth library code.

[forth.jl.git] / src / lib.4th

diff --git a/src/lib.4th b/src/lib.4th
index d806cb8..eae7a5d 100644 (file)
--- a/src/lib.4th
+++ b/src/lib.4th
@@ -448,6 +448,59 @@
         ' EXIT ,        ( append the codeword EXIT )
 ;
 
+: ALLOT         ( n -- addr )
+        HERE @ SWAP     ( here n )
+        HERE +!         ( adds n to HERE, after this the old value of HERE is still on the stack )
+;
+
+: VARIABLE
+        1 CELLS ALLOT   ( allocate 1 cell of memory, push the pointer to this memory )
+        WORD CREATE     ( make the dictionary entry (the name follows VARIABLE) )
+        DOCOL ,         ( append DOCOL (the codeword field of this word) )
+        ' LIT ,         ( append the codeword LIT )
+        ,               ( append the pointer to the new memory )
+        ' EXIT ,        ( append the codeword EXIT )
+;
+
+
+: VALUE         ( n -- )
+        WORD CREATE     ( 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
+;
+
+
 ( PRINTING THE DICTIONARY ------------------------------------------------------ )
 
 : ID.
@@ -572,7 +625,6 @@
         ( begin the definition with : NAME [IMMEDIATE] )
         ':' EMIT SPACE DUP ID. SPACE
         DUP ?IMMEDIATE IF ." IMMEDIATE " THEN
-        CR 8 SPACES
 
         >DFA            ( get the data address, ie. points after DOCOL | end-of-word start-of-data )
 
@@ -580,9 +632,7 @@
         BEGIN           ( end start )
                 2DUP >
         WHILE
-                DUP @ CFA> ID. SPACE
-                1+
-(                DUP @           ( end start codeword )
+                DUP @           ( end start codeword )
 
                 CASE
                 ' LIT OF                ( is it LIT ? )
@@ -596,7 +646,7 @@
                         2DUP TELL               ( print the string )
                         '"' EMIT SPACE          ( finish the string with a final quote )
                         +                       ( end start+1+len, aligned )
-                        1-                     ( because we're about to add 1 below )
+                        1-                     ( because we're about to add 4 below )
                 ENDOF
                 ' 0BRANCH OF            ( is it 0BRANCH ? )
                         ." 0BRANCH ( "
@@ -633,7 +683,6 @@
                 ENDCASE
 
                 1+             ( end start+1 )
-)
         REPEAT
 
         ';' EMIT CR