Moved some input stream words to library.
[forth.jl.git] / src / lib_7_variables.4th
1 \ Remaining field address conversion words
2
3 : >NAME
4         BEGIN
5                 1- DUP @
6                 NFA_MARK AND
7         NFA_MARK = UNTIL
8 ;
9
10 : NAME> 1- LINK> ;
11
12 : >LINK  >NAME 1- ;
13
14 : >BODY 1+ ;
15
16 : BODY> 1- ;
17
18 \ Constants and Variables
19
20 : CONSTANT
21         CREATE ,
22 DOES>   @
23 ;
24
25 : ALLOT         ( n -- )
26         H +!         ( adds n to H, after this the old value of H is still on the stack )
27 ;
28
29 : VARIABLE
30         CREATE
31         1 CELLS ALLOT   ( allocate 1 cell of memory, push the pointer to this memory )
32 ;
33
34 : VALUE         ( n -- )
35         CREATE ,
36 DOES>   @
37 ;
38
39 : TO IMMEDIATE  ( n -- )
40         BL WORD         ( get the name of the value )
41         FIND DROP       ( look it up in the dictionary )
42         >BODY           ( get a pointer to the first data field (the 'LIT') )
43         STATE @ IF      ( compiling? )
44                 ['] LIT ,         ( compile LIT )
45                 ,               ( compile the address of the value )
46                 ['] ! ,           ( compile ! )
47         ELSE            ( immediate mode )
48                 !               ( update it straightaway )
49         THEN
50 ;
51
52 ( x +TO VAL adds x to VAL )
53 : +TO IMMEDIATE
54         BL WORD         ( get the name of the value )
55         FIND DROP       ( look it up in the dictionary )
56         >BODY           ( get a pointer to the first data field (the 'LIT') )
57         STATE @ IF      ( compiling? )
58                 ['] LIT ,         ( compile LIT )
59                 ,               ( compile the address of the value )
60                 ['] +! ,          ( compile +! )
61         ELSE            ( immediate mode )
62                 +!              ( update it straightaway )
63         THEN
64 ;
65
66 ( Fill u ints, starting at a, with the value b )
67 : FILL          ( a u b -- )
68         -ROT OVER + SWAP ?DO
69                 DUP I !
70         LOOP
71         DROP
72 ;
73
74 : ERASE         ( a u -- )
75         0 FILL
76 ;