X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=src%2Flib_6_variables.4th;fp=src%2Flib_6_variables.4th;h=6829c9ccd755b51d0cedc23ed6ad03b39b457947;hb=9da6dc7c0252fdc18aca602928feab518737cc8f;hp=0000000000000000000000000000000000000000;hpb=429b35ca5e2f4832cf904e08339a2b42d171da9d;p=forth.jl.git

diff --git a/src/lib_6_variables.4th b/src/lib_6_variables.4th
new file mode 100644
index 0000000..6829c9c
--- /dev/null
+++ b/src/lib_6_variables.4th
@@ -0,0 +1,59 @@
+\ Constants and Variables
+
+: CONSTANT
+        CREATE ,
+DOES>   @
+;
+
+: ALLOT         ( n -- )
+        H +!         ( adds n to H, after this the old value of H is still on the stack )
+;
+
+: VARIABLE
+        CREATE
+        1 CELLS ALLOT   ( allocate 1 cell of memory, push the pointer to this memory )
+;
+
+: VALUE         ( n -- )
+        CREATE ,
+DOES>   @
+;
+
+: TO IMMEDIATE  ( n -- )
+        BL WORD         ( get the name of the value )
+        FIND DROP       ( look it up in the dictionary )
+        >BODY           ( get a pointer to the first data field (the 'LIT') )
+        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
+        BL WORD         ( get the name of the value )
+        FIND DROP       ( look it up in the dictionary )
+        >BODY           ( get a pointer to the first data field (the 'LIT') )
+        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
+;