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 ; ( Yay! We now have comments! )
  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 : C,
  66   HERE @ C!
  67   HERE @ 1 +
  68   HERE ! ;
  69
  70 : OVER ( a b -- a b a ) SWAP DUP ROT ;
  71
  72 ( An alternative comment syntax. Reads until the end of the line. )
  73 : \ IMMEDIATE
  74   BEGIN
  75     KEY
  76   10 = UNTIL ;
  77
  78 \ So far, S" has only worked in immediate mode, which is backwards -- actually,
  79 \ the main use-case of this is as a compile-time word. Let's fix that.
  80 : S" IMMEDIATE
  81   ' LITSTRING ,
  82   HERE @ 0 C, \ We will put the length here
  83   0
  84   BEGIN
  85     1 +
  86     KEY DUP C,
  87   34 = UNTIL
  88   \ Remove final "
  89     HERE @ 1 - HERE !
  90     1 -
  91   SWAP C! ;
  92
  93 ( Compile the given string into the current word directly. )
  94 : STORE-STRING ( str len -- )
  95   BEGIN
  96     OVER C@ C,
  97     SWAP 1 + SWAP
  98   1 - DUP 0 = UNTIL
  99   DROP DROP ;
 100
 101 : NEWLINE 10 EMIT ;
 102 : SPACE 32 EMIT ;
 103
 104 ( Read a number from standard input. )
 105 : READ-NUMBER READ-WORD PARSE-NUMBER ;
 106
 107 : RESTART S" Ready." TELL NEWLINE ;
 108 RESTART
 109