sys.f

   1 S" :" CREATE ] DOCOL
   2   READ-WORD CREATE
   3   LIT DOCOL ,
   4   ]
   5 EXIT [
   6
   7 : ;
   8   LIT EXIT ,
   9   [ S" [" FIND >CFA , ]
  10   EXIT
  11 [ IMMEDIATE
  12
  13 : IF IMMEDIATE
  14   ' 0BRANCH ,
  15   HERE @
  16   0 ,
  17 ;
  18
  19 : THEN IMMEDIATE
  20   DUP
  21   HERE @ SWAP -
  22   SWAP !
  23 ;
  24
  25 : ELSE IMMEDIATE
  26   ' BRANCH ,
  27   HERE @
  28   0 ,
  29   SWAP DUP HERE @ SWAP - SWAP !
  30 ;
  31
  32 : BEGIN IMMEDIATE
  33   HERE @
  34 ;
  35
  36 : AGAIN IMMEDIATE
  37   ' BRANCH ,
  38   HERE @ - , ;
  39
  40 : ( IMMEDIATE
  41   BEGIN
  42     READ-WORD
  43     1 = IF
  44       C@ 41 = IF
  45         EXIT
  46       THEN
  47     ELSE
  48       DROP
  49     THEN
  50   AGAIN ;
  51
  52 : UNTIL IMMEDIATE
  53   ' 0BRANCH ,
  54   HERE @ - ,
  55 ;
  56
  57 ( Compile a literal value into the current word. )
  58 : LIT, IMMEDIATE ( x -- )
  59   ' LIT , , ;
  60
  61 : / /MOD DROP ;
  62 : MOD /MOD SWAP DROP ;
  63 : NEG 0 SWAP - ;
  64
  65 : FIB ( n -- Fn )
  66   0 1                            ( n a b )
  67   0                              ( n a b i )
  68   BEGIN
  69     ROT                          ( n i a b )
  70     DUP ROT +                    ( n i b a+b )
  71     ROT ROT                      ( n b a+b i )
  72
  73     1 +                          ( n b a+b i+1 )
  74   DUP 4 PICK = UNTIL
  75   DROP SWAP DROP SWAP DROP ;     ( a+b )
  76
  77 : C,
  78   HERE @ C!
  79   HERE @ 1 +
  80   HERE ! ;
  81
  82 : OVER ( a b -- a b a ) SWAP DUP ROT ;
  83
  84 ( Compile the given string into the current word directly. )
  85 : STORE-STRING ( str len -- )
  86   BEGIN
  87     OVER C@ C,
  88     SWAP 1 + SWAP
  89   1 - DUP 0 = UNTIL
  90   DROP DROP ;
  91
  92 S" HELLO-ADDR" CREATE
  93 S" Hello!" DUP ROT
  94 STORE-STRING
  95 : HELLO
  96   ' HELLO-ADDR LIT, TELL NEWLINE ;
  97
  98 HELLO
  99
 100 S" 10 FIB = " TELL
 101 10 FIB .U
 102 S"  (Expected: 59)" TELL NEWLINE
 103
 104 TERMINATE