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 ;