jonesforth.f

   1 \ -*- text -*-
   2 \       A sometimes minimal FORTH compiler and tutorial for Linux / i386 systems. -*- asm -*-
   3 \       By Richard W.M. Jones <rich@annexia.org> http://annexia.org/forth
   4 \       This is PUBLIC DOMAIN (see public domain release statement below).
   5 \       $Id: jonesforth.f,v 1.9 2007-09-28 20:22:41 rich Exp $
   6 \
   7 \       The first part of this tutorial is in jonesforth.S.  Get if from http://annexia.org/forth
   8 \
   9 \       PUBLIC DOMAIN ----------------------------------------------------------------------
  10 \
  11 \       I, the copyright holder of this work, hereby release it into the public domain. This applies worldwide.
  12 \
  13 \       In case this is not legally possible, I grant any entity the right to use this work for any purpose,
  14 \       without any conditions, unless such conditions are required by law.
  15 \
  16 \       SETTING UP ----------------------------------------------------------------------
  17 \
  18 \       Let's get a few housekeeping things out of the way.  Firstly because I need to draw lots of
  19 \       ASCII-art diagrams to explain concepts, the best way to look at this is using a window which
  20 \       uses a fixed width font and is at least this wide:
  21 \
  22 \<------------------------------------------------------------------------------------------------------------------------>
  23 \
  24 \       Secondly make sure TABS are set to 8 characters.  The following should be a vertical
  25 \       line.  If not, sort out your tabs.
  26 \
  27 \       |
  28 \       |
  29 \       |
  30 \
  31 \       Thirdly I assume that your screen is at least 50 characters high.
  32 \
  33 \       START OF FORTH CODE ----------------------------------------------------------------------
  34 \
  35 \       We've now reached the stage where the FORTH system is running and self-hosting.  All further
  36 \       words can be written as FORTH itself, including words like IF, THEN, .", etc which in most
  37 \       languages would be considered rather fundamental.
  38 \
  39 \       Some notes about the code:
  40 \
  41 \       I use indenting to show structure.  The amount of whitespace has no meaning to FORTH however
  42 \       except that you must use at least one whitespace character between words, and words themselves
  43 \       cannot contain whitespace.
  44 \
  45 \       FORTH is case-sensitive.  Use capslock!
  46
  47 \ The primitive word /MOD (DIVMOD) leaves both the quotient and the remainder on the stack.  (On
  48 \ i386, the idivl instruction gives both anyway).  Now we can define the / and MOD in terms of /MOD
  49 \ and a few other primitives.
  50 : / /MOD SWAP DROP ;
  51 : MOD /MOD DROP ;
  52
  53 \ Define some character constants
  54 : '\n'   10 ;
  55 : 'SPACE' 32 ;
  56
  57 \ CR prints a carriage return
  58 : CR '\n' EMIT ;
  59
  60 \ SPACE prints a space
  61 : SPACE 'SPACE' EMIT ;
  62
  63 \ DUP, DROP are defined in assembly for speed, but this is how you might define them
  64 \ in FORTH.  Notice use of the scratch variables _X and _Y.
  65 \ : DUP _X ! _X @ _X @ ;
  66 \ : DROP _X ! ;
  67
  68 \ The 2... versions of the standard operators work on pairs of stack entries.  They're not used
  69 \ very commonly so not really worth writing in assembler.  Here is how they are defined in FORTH.
  70 : 2DUP OVER OVER ;
  71 : 2DROP DROP DROP ;
  72
  73 \ More standard FORTH words.
  74 : 2* 2 * ;
  75 : 2/ 2 / ;
  76
  77 \ NEGATE leaves the negative of a number on the stack.
  78 : NEGATE 0 SWAP - ;
  79
  80 \ Standard words for booleans.
  81 : TRUE  1 ;
  82 : FALSE 0 ;
  83 : NOT   0= ;
  84
  85 \ LITERAL takes whatever is on the stack and compiles LIT <foo>
  86 : LITERAL IMMEDIATE
  87         ' LIT ,         \ compile LIT
  88         ,               \ compile the literal itself (from the stack)
  89         ;
  90
  91 \ Now we can use [ and ] to insert literals which are calculated at compile time.  (Recall that
  92 \ [ and ] are the FORTH words which switch into and out of immediate mode.)
  93 \ Within definitions, use [ ... ] LITERAL anywhere that '...' is a constant expression which you
  94 \ would rather only compute once (at compile time, rather than calculating it each time your word runs).
  95 : ':'
  96         [               \ go into immediate mode (temporarily)
  97         CHAR :          \ push the number 58 (ASCII code of colon) on the parameter stack
  98         ]               \ go back to compile mode
  99         LITERAL         \ compile LIT 58 as the definition of ':' word
 100 ;
 101
 102 \ A few more character constants defined the same way as above.
 103 : ';' [ CHAR ; ] LITERAL ;
 104 : '(' [ CHAR ( ] LITERAL ;
 105 : ')' [ CHAR ) ] LITERAL ;
 106 : '"' [ CHAR " ] LITERAL ;
 107 : 'A' [ CHAR A ] LITERAL ;
 108 : '0' [ CHAR 0 ] LITERAL ;
 109 : '-' [ CHAR - ] LITERAL ;
 110 : '.' [ CHAR . ] LITERAL ;
 111
 112 \ While compiling, '[COMPILE] word' compiles 'word' if it would otherwise be IMMEDIATE.
 113 : [COMPILE] IMMEDIATE
 114         WORD            \ get the next word
 115         FIND            \ find it in the dictionary
 116         >CFA            \ get its codeword
 117         ,               \ and compile that
 118 ;
 119
 120 \ RECURSE makes a recursive call to the current word that is being compiled.
 121 \
 122 \ Normally while a word is being compiled, it is marked HIDDEN so that references to the
 123 \ same word within are calls to the previous definition of the word.  However we still have
 124 \ access to the word which we are currently compiling through the LATEST pointer so we
 125 \ can use that to compile a recursive call.
 126 : RECURSE IMMEDIATE
 127         LATEST @        \ LATEST points to the word being compiled at the moment
 128         >CFA            \ get the codeword
 129         ,               \ compile it
 130 ;
 131
 132 \ So far we have defined only very simple definitions.  Before we can go further, we really need to
 133 \ make some control structures, like IF ... THEN and loops.  Luckily we can define arbitrary control
 134 \ structures directly in FORTH.
 135 \
 136 \ Please note that the control structures as I have defined them here will only work inside compiled
 137 \ words.  If you try to type in expressions using IF, etc. in immediate mode, then they won't work.
 138 \ Making these work in immediate mode is left as an exercise for the reader.
 139
 140 \ condition IF true-part THEN rest
 141 \       -- compiles to: --> condition 0BRANCH OFFSET true-part rest
 142 \       where OFFSET is the offset of 'rest'
 143 \ condition IF true-part ELSE false-part THEN
 144 \       -- compiles to: --> condition 0BRANCH OFFSET true-part BRANCH OFFSET2 false-part rest
 145 \       where OFFSET if the offset of false-part and OFFSET2 is the offset of rest
 146
 147 \ IF is an IMMEDIATE word which compiles 0BRANCH followed by a dummy offset, and places
 148 \ the address of the 0BRANCH on the stack.  Later when we see THEN, we pop that address
 149 \ off the stack, calculate the offset, and back-fill the offset.
 150 : IF IMMEDIATE
 151         ' 0BRANCH ,     \ compile 0BRANCH
 152         HERE @          \ save location of the offset on the stack
 153         0 ,             \ compile a dummy offset
 154 ;
 155
 156 : THEN IMMEDIATE
 157         DUP
 158         HERE @ SWAP -   \ calculate the offset from the address saved on the stack
 159         SWAP !          \ store the offset in the back-filled location
 160 ;
 161
 162 : ELSE IMMEDIATE
 163         ' BRANCH ,      \ definite branch to just over the false-part
 164         HERE @          \ save location of the offset on the stack
 165         0 ,             \ compile a dummy offset
 166         SWAP            \ now back-fill the original (IF) offset
 167         DUP             \ same as for THEN word above
 168         HERE @ SWAP -
 169         SWAP !
 170 ;
 171
 172 \ BEGIN loop-part condition UNTIL
 173 \       -- compiles to: --> loop-part condition 0BRANCH OFFSET
 174 \       where OFFSET points back to the loop-part
 175 \ This is like do { loop-part } while (condition) in the C language
 176 : BEGIN IMMEDIATE
 177         HERE @          \ save location on the stack
 178 ;
 179
 180 : UNTIL IMMEDIATE
 181         ' 0BRANCH ,     \ compile 0BRANCH
 182         HERE @ -        \ calculate the offset from the address saved on the stack
 183         ,               \ compile the offset here
 184 ;
 185
 186 \ BEGIN loop-part AGAIN
 187 \       -- compiles to: --> loop-part BRANCH OFFSET
 188 \       where OFFSET points back to the loop-part
 189 \ In other words, an infinite loop which can only be returned from with EXIT
 190 : AGAIN IMMEDIATE
 191         ' BRANCH ,      \ compile BRANCH
 192         HERE @ -        \ calculate the offset back
 193         ,               \ compile the offset here
 194 ;
 195
 196 \ BEGIN condition WHILE loop-part REPEAT
 197 \       -- compiles to: --> condition 0BRANCH OFFSET2 loop-part BRANCH OFFSET
 198 \       where OFFSET points back to condition (the beginning) and OFFSET2 points to after the whole piece of code
 199 \ So this is like a while (condition) { loop-part } loop in the C language
 200 : WHILE IMMEDIATE
 201         ' 0BRANCH ,     \ compile 0BRANCH
 202         HERE @          \ save location of the offset2 on the stack
 203         0 ,             \ compile a dummy offset2
 204 ;
 205
 206 : REPEAT IMMEDIATE
 207         ' BRANCH ,      \ compile BRANCH
 208         SWAP            \ get the original offset (from BEGIN)
 209         HERE @ - ,      \ and compile it after BRANCH
 210         DUP
 211         HERE @ SWAP -   \ calculate the offset2
 212         SWAP !          \ and back-fill it in the original location
 213 ;
 214
 215 \ FORTH allows ( ... ) as comments within function definitions.  This works by having an IMMEDIATE
 216 \ word called ( which just drops input characters until it hits the corresponding ).
 217 : ( IMMEDIATE
 218         1               \ allowed nested parens by keeping track of depth
 219         BEGIN
 220                 KEY             \ read next character
 221                 DUP '(' = IF    \ open paren?
 222                         DROP            \ drop the open paren
 223                         1+              \ depth increases
 224                 ELSE
 225                         ')' = IF        \ close paren?
 226                                 1-              \ depth decreases
 227                         THEN
 228                 THEN
 229         DUP 0= UNTIL            \ continue until we reach matching close paren, depth 0
 230         DROP            \ drop the depth counter
 231 ;
 232
 233 (
 234         From now on we can use ( ... ) for comments.
 235
 236         In FORTH style we can also use ( ... -- ... ) to show the effects that a word has on the
 237         parameter stack.  For example:
 238
 239         ( n -- )        means that the word consumes an integer (n) from the parameter stack.
 240         ( b a -- c )    means that the word uses two integers (a and b, where a is at the top of stack)
 241                                 and returns a single integer (c).
 242         ( -- )          means the word has no effect on the stack
 243 )
 244
 245 ( Some more complicated stack examples, showing the stack notation. )
 246 : NIP ( x y -- y ) SWAP DROP ;
 247 : TUCK ( x y -- y x y ) DUP ROT ;
 248 : PICK ( x_u ... x_1 x_0 u -- x_u ... x_1 x_0 x_u )
 249         1+              ( add one because of 'u' on the stack )
 250         4 *             ( multiply by the word size )
 251         DSP@ +          ( add to the stack pointer )
 252         @               ( and fetch )
 253 ;
 254
 255 ( With the looping constructs, we can now write SPACES, which writes n spaces to stdout. )
 256 : SPACES        ( n -- )
 257         BEGIN
 258                 DUP 0>          ( while n > 0 )
 259         WHILE
 260                 SPACE           ( print a space )
 261                 1-              ( until we count down to 0 )
 262         REPEAT
 263         DROP
 264 ;
 265
 266 ( Standard words for manipulating BASE. )
 267 : DECIMAL ( -- ) 10 BASE ! ;
 268 : HEX ( -- ) 16 BASE ! ;
 269
 270 (
 271         The standard FORTH word . (DOT) is very important.  It takes the number at the top
 272         of the stack and prints it out.  However first I'm going to implement some lower-level
 273         FORTH words:
 274
 275         U.R     ( u width -- )  which prints an unsigned number, padded to a certain width
 276         U.      ( u -- )        which prints an unsigned number
 277         .R      ( n width -- )  which prints a signed number, padded to a certain width.
 278
 279         For example:
 280                 -123 6 .R
 281         will print out these characters:
 282                 <space> <space> - 1 2 3
 283
 284         In other words, the number padded left to a certain number of characters.
 285
 286         The full number is printed even if it is wider than width, and this is what allows us to
 287         define the ordinary functions U. and . (we just set width to zero knowing that the full
 288         number will be printed anyway).
 289
 290         Another wrinkle of . and friends is that they obey the current base in the variable BASE.
 291         BASE can be anything in the range 2 to 36.
 292
 293         While we're defining . &c we can also define .S which is a useful debugging tool.  This
 294         word prints the current stack (non-destructively) from top to bottom.
 295 )
 296
 297 ( This is the underlying recursive definition of U. )
 298 : U.            ( u -- )
 299         BASE @ /MOD     ( width rem quot )
 300         DUP 0<> IF      ( if quotient <> 0 then )
 301                 RECURSE         ( print the quotient )
 302         ELSE
 303                 DROP            ( drop the zero quotient )
 304         THEN
 305
 306         ( print the remainder )
 307         DUP 10 < IF
 308                 '0'             ( decimal digits 0..9 )
 309         ELSE
 310                 10 -            ( hex and beyond digits A..Z )
 311                 'A'
 312         THEN
 313         +
 314         EMIT
 315 ;
 316
 317 (
 318         FORTH word .S prints the contents of the stack.  It doesn't alter the stack.
 319         Very useful for debugging.
 320 )
 321 : .S            ( -- )
 322         DSP@            ( get current stack pointer )
 323         BEGIN
 324                 DUP S0 @ <
 325         WHILE
 326                 DUP @ U.        ( print the stack element )
 327                 SPACE
 328                 4+              ( move up )
 329         REPEAT
 330         DROP
 331 ;
 332
 333 ( This word returns the width (in characters) of an unsigned number in the current base )
 334 : UWIDTH        ( u -- width )
 335         BASE @ /        ( rem quot )
 336         DUP 0<> IF      ( if quotient <> 0 then )
 337                 RECURSE 1+      ( return 1+recursive call )
 338         ELSE
 339                 DROP            ( drop the zero quotient )
 340                 1               ( return 1 )
 341         THEN
 342 ;
 343
 344 : U.R           ( u width -- )
 345         SWAP            ( width u )
 346         DUP             ( width u u )
 347         UWIDTH          ( width u uwidth )
 348         -ROT            ( u uwidth width )
 349         SWAP -          ( u width-uwidth )
 350         ( At this point if the requested width is narrower, we'll have a negative number on the stack.
 351           Otherwise the number on the stack is the number of spaces to print.  But SPACES won't print
 352           a negative number of spaces anyway, so it's now safe to call SPACES ... )
 353         SPACES
 354         ( ... and then call the underlying implementation of U. )
 355         U.
 356 ;
 357
 358 (
 359         .R prints a signed number, padded to a certain width.  We can't just print the sign
 360         and call U.R because we want the sign to be next to the number ('-123' instead of '-  123').
 361 )
 362 : .R            ( n width -- )
 363         SWAP            ( width n )
 364         DUP 0< IF
 365                 NEGATE          ( width u )
 366                 1               ( save a flag to remember that it was negative | width n 1 )
 367                 ROT             ( 1 width u )
 368                 SWAP            ( 1 u width )
 369                 1-              ( 1 u width-1 )
 370         ELSE
 371                 0               ( width u 0 )
 372                 ROT             ( 0 width u )
 373                 SWAP            ( 0 u width )
 374         THEN
 375         SWAP            ( flag width u )
 376         DUP             ( flag width u u )
 377         UWIDTH          ( flag width u uwidth )
 378         -ROT            ( flag u uwidth width )
 379         SWAP -          ( flag u width-uwidth )
 380
 381         SPACES          ( flag u )
 382         SWAP            ( u flag )
 383
 384         IF                      ( was it negative? print the - character )
 385                 '-' EMIT
 386         THEN
 387
 388         U.
 389 ;
 390
 391 ( Finally we can define word . in terms of .R, with a trailing space. )
 392 : . 0 .R SPACE ;
 393
 394 ( The real U., note the trailing space. )
 395 : U. U. SPACE ;
 396
 397 ( ? fetches the integer at an address and prints it. )
 398 : ? ( addr -- ) @ . ;
 399
 400 ( c a b WITHIN returns true if a <= c and c < b )
 401 : WITHIN
 402         ROT             ( b c a )
 403         OVER            ( b c a c )
 404         <= IF
 405                 > IF            ( b c -- )
 406                         TRUE
 407                 ELSE
 408                         FALSE
 409                 THEN
 410         ELSE
 411                 2DROP           ( b c -- )
 412                 FALSE
 413         THEN
 414 ;
 415
 416 ( DEPTH returns the depth of the stack. )
 417 : DEPTH         ( -- n )
 418         S0 @ DSP@ -
 419         4-                      ( adjust because S0 was on the stack when we pushed DSP )
 420 ;
 421
 422 (
 423         ALIGNED takes an address and rounds it up (aligns it) to the next 4 byte boundary.
 424 )
 425 : ALIGNED       ( addr -- addr )
 426         3 + 3 INVERT AND        ( (addr+3) & ~3 )
 427 ;
 428
 429 (
 430         ALIGN aligns the HERE pointer, so the next word appended will be aligned properly.
 431 )
 432 : ALIGN HERE @ ALIGNED HERE ! ;
 433
 434 (
 435         S" string" is used in FORTH to define strings.  It leaves the address of the string and
 436         its length on the stack, (length at the top of stack).  The space following S" is the normal
 437         space between FORTH words and is not a part of the string.
 438
 439         This is tricky to define because it has to do different things depending on whether
 440         we are compiling or in immediate mode.  (Thus the word is marked IMMEDIATE so it can
 441         detect this and do different things).
 442
 443         In compile mode we append
 444                 LITSTRING <string length> <string rounded up 4 bytes>
 445         to the current word.  The primitive LITSTRING does the right thing when the current
 446         word is executed.
 447
 448         In immediate mode there isn't a particularly good place to put the string, but in this
 449         case we put the string at HERE (but we _don't_ change HERE).  This is meant as a temporary
 450         location, likely to be overwritten soon after.
 451 )
 452 : S" IMMEDIATE          ( -- addr len )
 453         STATE @ IF      ( compiling? )
 454                 ' LITSTRING ,   ( compile LITSTRING )
 455                 HERE @          ( save the address of the length word on the stack )
 456                 0 ,             ( dummy length - we don't know what it is yet )
 457                 BEGIN
 458                         KEY             ( get next character of the string )
 459                         DUP '"' <>
 460                 WHILE
 461                         HERE @ C!       ( store the character in the compiled image )
 462                         1 HERE +!       ( increment HERE pointer by 1 byte )
 463                 REPEAT
 464                 DROP            ( drop the double quote character at the end )
 465                 DUP             ( get the saved address of the length word )
 466                 HERE @ SWAP -   ( calculate the length )
 467                 4-              ( subtract 4 (because we measured from the start of the length word) )
 468                 SWAP !          ( and back-fill the length location )
 469                 ALIGN           ( round up to next multiple of 4 bytes for the remaining code )
 470         ELSE            ( immediate mode )
 471                 HERE @          ( get the start address of the temporary space )
 472                 BEGIN
 473                         KEY
 474                         DUP '"' <>
 475                 WHILE
 476                         OVER C!         ( save next character )
 477                         1+              ( increment address )
 478                 REPEAT
 479                 DROP            ( drop the final " character )
 480                 HERE @ -        ( calculate the length )
 481                 HERE @          ( push the start address )
 482                 SWAP            ( addr len )
 483         THEN
 484 ;
 485
 486 (
 487         ." is the print string operator in FORTH.  Example: ." Something to print"
 488         The space after the operator is the ordinary space required between words and is not
 489         a part of what is printed.
 490
 491         In immediate mode we just keep reading characters and printing them until we get to
 492         the next double quote.
 493
 494         In compile mode we use S" to store the string, then add TELL afterwards:
 495                 LITSTRING <string length> <string rounded up to 4 bytes> TELL
 496
 497         It may be interesting to note the use of [COMPILE] to turn the call to the immediate
 498         word S" into compilation of that word.  It compiles it into the definition of .",
 499         not into the definition of the word being compiled when this is running (complicated
 500         enough for you?)
 501 )
 502 : ." IMMEDIATE          ( -- )
 503         STATE @ IF      ( compiling? )
 504                 [COMPILE] S"    ( read the string, and compile LITSTRING, etc. )
 505                 ' TELL ,        ( compile the final TELL )
 506         ELSE
 507                 ( In immediate mode, just read characters and print them until we get
 508                   to the ending double quote. )
 509                 BEGIN
 510                         KEY
 511                         DUP '"' = IF
 512                                 DROP    ( drop the double quote character )
 513                                 EXIT    ( return from this function )
 514                         THEN
 515                         EMIT
 516                 AGAIN
 517         THEN
 518 ;
 519
 520 (
 521         In FORTH, global constants and variables are defined like this:
 522
 523         10 CONSTANT TEN         when TEN is executed, it leaves the integer 10 on the stack
 524         VARIABLE VAR            when VAR is executed, it leaves the address of VAR on the stack
 525
 526         Constants can be read but not written, eg:
 527
 528         TEN . CR                prints 10
 529
 530         You can read a variable (in this example called VAR) by doing:
 531
 532         VAR @                   leaves the value of VAR on the stack
 533         VAR @ . CR              prints the value of VAR
 534         VAR ? CR                same as above, since ? is the same as @ .
 535
 536         and update the variable by doing:
 537
 538         20 VAR !                sets VAR to 20
 539
 540         Note that variables are uninitialised (but see VALUE later on which provides initialised
 541         variables with a slightly simpler syntax).
 542
 543         How can we define the words CONSTANT and VARIABLE?
 544
 545         The trick is to define a new word for the variable itself (eg. if the variable was called
 546         'VAR' then we would define a new word called VAR).  This is easy to do because we exposed
 547         dictionary entry creation through the CREATE word (part of the definition of : above).
 548         A call to CREATE TEN leaves the dictionary entry:
 549
 550                                    +--- HERE
 551                                    |
 552                                    V
 553         +---------+---+---+---+---+
 554         | LINK    | 3 | T | E | N |
 555         +---------+---+---+---+---+
 556                    len
 557
 558         For CONSTANT we can continue by appending DOCOL (the codeword), then LIT followed by
 559         the constant itself and then EXIT, forming a little word definition that returns the
 560         constant:
 561
 562         +---------+---+---+---+---+------------+------------+------------+------------+
 563         | LINK    | 3 | T | E | N | DOCOL      | LIT        | 10         | EXIT       |
 564         +---------+---+---+---+---+------------+------------+------------+------------+
 565                    len              codeword
 566
 567         Notice that this word definition is exactly the same as you would have got if you had
 568         written : TEN 10 ;
 569
 570         Note for people reading the code below: DOCOL is a constant word which we defined in the
 571         assembler part which returns the value of the assembler symbol of the same name.
 572 )
 573 : CONSTANT
 574         CREATE          ( make the dictionary entry (the name follows CONSTANT) )
 575         DOCOL ,         ( append DOCOL (the codeword field of this word) )
 576         ' LIT ,         ( append the codeword LIT )
 577         ,               ( append the value on the top of the stack )
 578         ' EXIT ,        ( append the codeword EXIT )
 579 ;
 580
 581 (
 582         VARIABLE is a little bit harder because we need somewhere to put the variable.  There is
 583         nothing particularly special about the 'user definitions area' (the area of memory pointed
 584         to by HERE where we have previously just stored new word definitions).  We can slice off
 585         bits of this memory area to store anything we want, so one possible definition of
 586         VARIABLE might create this:
 587
 588            +--------------------------------------------------------------+
 589            |                                                              |
 590            V                                                              |
 591         +---------+---------+---+---+---+---+------------+------------+---|--------+------------+
 592         | <var>   | LINK    | 3 | V | A | R | DOCOL      | LIT        | <addr var> | EXIT       |
 593         +---------+---------+---+---+---+---+------------+------------+------------+------------+
 594                              len              codeword
 595
 596         where <var> is the place to store the variable, and <addr var> points back to it.
 597
 598         To make this more general let's define a couple of words which we can use to allocate
 599         arbitrary memory from the user definitions area.
 600
 601         First ALLOT, where n ALLOT allocates n bytes of memory.  (Note when calling this that
 602         it's a very good idea to make sure that n is a multiple of 4, or at least that next time
 603         a word is compiled that HERE has been left as a multiple of 4).
 604 )
 605 : ALLOT         ( n -- addr )
 606         HERE @ SWAP     ( here n )
 607         HERE +!         ( adds n to HERE, after this the old value of HERE is still on the stack )
 608 ;
 609
 610 (
 611         Second, CELLS.  In FORTH the phrase 'n CELLS ALLOT' means allocate n integers of whatever size
 612         is the natural size for integers on this machine architecture.  On this 32 bit machine therefore
 613         CELLS just multiplies the top of stack by 4.
 614 )
 615 : CELLS ( n -- n ) 4* ;
 616
 617 (
 618         So now we can define VARIABLE easily in much the same way as CONSTANT above.  Refer to the
 619         diagram above to see what the word that this creates will look like.
 620 )
 621 : VARIABLE
 622         1 CELLS ALLOT   ( allocate 1 cell of memory, push the pointer to this memory )
 623         CREATE          ( make the dictionary entry (the name follows VARIABLE) )
 624         DOCOL ,         ( append DOCOL (the codeword field of this word) )
 625         ' LIT ,         ( append the codeword LIT )
 626         ,               ( append the pointer to the new memory )
 627         ' EXIT ,        ( append the codeword EXIT )
 628 ;
 629
 630 (
 631         VALUEs are like VARIABLEs but with a simpler syntax.  You would generally use them when you
 632         want a variable which is read often, and written infrequently.
 633
 634         20 VALUE VAL    creates VAL with initial value 20
 635         VAL             pushes the value directly on the stack
 636         30 TO VAL       updates VAL, setting it to 30
 637
 638         Notice that 'VAL' on its own doesn't return the address of the value, but the value itself,
 639         making values simpler and more obvious to use than variables (no indirection through '@').
 640         The price is a more complicated implementation, although despite the complexity there is no
 641         performance penalty at runtime.
 642
 643         A naive implementation of 'TO' would be quite slow, involving a dictionary search each time.
 644         But because this is FORTH we have complete control of the compiler so we can compile TO more
 645         efficiently, turning:
 646                 TO VAL
 647         into:
 648                 LIT <addr> !
 649         and calculating <addr> (the address of the value) at compile time.
 650
 651         Now this is the clever bit.  We'll compile our value like this:
 652
 653         +---------+---+---+---+---+------------+------------+------------+------------+
 654         | LINK    | 3 | V | A | L | DOCOL      | LIT        | <value>    | EXIT       |
 655         +---------+---+---+---+---+------------+------------+------------+------------+
 656                    len              codeword
 657
 658         where <value> is the actual value itself.  Note that when VAL executes, it will push the
 659         value on the stack, which is what we want.
 660
 661         But what will TO use for the address <addr>?  Why of course a pointer to that <value>:
 662
 663                 code compiled   - - - - --+------------+------------+------------+-- - - - -
 664                 by TO VAL                 | LIT        | <addr>     | !          |
 665                                 - - - - --+------------+-----|------+------------+-- - - - -
 666                                                              |
 667                                                              V
 668         +---------+---+---+---+---+------------+------------+------------+------------+
 669         | LINK    | 3 | V | A | L | DOCOL      | LIT        | <value>    | EXIT       |
 670         +---------+---+---+---+---+------------+------------+------------+------------+
 671                    len              codeword
 672
 673         In other words, this is a kind of self-modifying code.
 674
 675         (Note to the people who want to modify this FORTH to add inlining: values defined this
 676         way cannot be inlined).
 677 )
 678 : VALUE         ( n -- )
 679         CREATE          ( make the dictionary entry (the name follows VALUE) )
 680         DOCOL ,         ( append DOCOL )
 681         ' LIT ,         ( append the codeword LIT )
 682         ,               ( append the initial value )
 683         ' EXIT ,        ( append the codeword EXIT )
 684 ;
 685
 686 : TO IMMEDIATE  ( n -- )
 687         WORD            ( get the name of the value )
 688         FIND            ( look it up in the dictionary )
 689         >DFA            ( get a pointer to the first data field (the 'LIT') )
 690         4+              ( increment to point at the value )
 691         STATE @ IF      ( compiling? )
 692                 ' LIT ,         ( compile LIT )
 693                 ,               ( compile the address of the value )
 694                 ' ! ,           ( compile ! )
 695         ELSE            ( immediate mode )
 696                 !               ( update it straightaway )
 697         THEN
 698 ;
 699
 700 ( x +TO VAL adds x to VAL )
 701 : +TO IMMEDIATE
 702         WORD            ( get the name of the value )
 703         FIND            ( look it up in the dictionary )
 704         >DFA            ( get a pointer to the first data field (the 'LIT') )
 705         4+              ( increment to point at the value )
 706         STATE @ IF      ( compiling? )
 707                 ' LIT ,         ( compile LIT )
 708                 ,               ( compile the address of the value )
 709                 ' +! ,          ( compile +! )
 710         ELSE            ( immediate mode )
 711                 +!              ( update it straightaway )
 712         THEN
 713 ;
 714
 715 (
 716         ID. takes an address of a dictionary entry and prints the word's name.
 717
 718         For example: LATEST @ ID. would print the name of the last word that was defined.
 719 )
 720 : ID.
 721         4+              ( skip over the link pointer )
 722         DUP C@          ( get the flags/length byte )
 723         F_LENMASK AND   ( mask out the flags - just want the length )
 724
 725         BEGIN
 726                 DUP 0>          ( length > 0? )
 727         WHILE
 728                 SWAP 1+         ( addr len -- len addr+1 )
 729                 DUP C@          ( len addr -- len addr char | get the next character)
 730                 EMIT            ( len addr char -- len addr | and print it)
 731                 SWAP 1-         ( len addr -- addr len-1    | subtract one from length )
 732         REPEAT
 733         2DROP           ( len addr -- )
 734 ;
 735
 736 (
 737         'WORD word FIND ?HIDDEN' returns true if 'word' is flagged as hidden.
 738
 739         'WORD word FIND ?IMMEDIATE' returns true if 'word' is flagged as immediate.
 740 )
 741 : ?HIDDEN
 742         4+              ( skip over the link pointer )
 743         C@              ( get the flags/length byte )
 744         F_HIDDEN AND    ( mask the F_HIDDEN flag and return it (as a truth value) )
 745 ;
 746 : ?IMMEDIATE
 747         4+              ( skip over the link pointer )
 748         C@              ( get the flags/length byte )
 749         F_IMMED AND     ( mask the F_IMMED flag and return it (as a truth value) )
 750 ;
 751
 752 (
 753         WORDS prints all the words defined in the dictionary, starting with the word defined most recently.
 754         However it doesn't print hidden words.
 755
 756         The implementation simply iterates backwards from LATEST using the link pointers.
 757 )
 758 : WORDS
 759         LATEST @        ( start at LATEST dictionary entry )
 760         BEGIN
 761                 DUP 0<>         ( while link pointer is not null )
 762         WHILE
 763                 DUP ?HIDDEN NOT IF      ( ignore hidden words )
 764                         DUP ID.         ( but if not hidden, print the word )
 765                 THEN
 766                 SPACE
 767                 @               ( dereference the link pointer - go to previous word )
 768         REPEAT
 769         DROP
 770         CR
 771 ;
 772
 773 (
 774         So far we have only allocated words and memory.  FORTH provides a rather primitive method
 775         to deallocate.
 776
 777         'FORGET word' deletes the definition of 'word' from the dictionary and everything defined
 778         after it, including any variables and other memory allocated after.
 779
 780         The implementation is very simple - we look up the word (which returns the dictionary entry
 781         address).  Then we set HERE to point to that address, so in effect all future allocations
 782         and definitions will overwrite memory starting at the word.  We also need to set LATEST to
 783         point to the previous word.
 784
 785         Note that you cannot FORGET built-in words (well, you can try but it will probably cause
 786         a segfault).
 787
 788         XXX: Because we wrote VARIABLE to store the variable in memory allocated before the word,
 789         in the current implementation VARIABLE FOO FORGET FOO will leak 1 cell of memory.
 790 )
 791 : FORGET
 792         WORD FIND       ( find the word, gets the dictionary entry address )
 793         DUP @ LATEST !  ( set LATEST to point to the previous word )
 794         HERE !          ( and store HERE with the dictionary address )
 795 ;
 796
 797 (
 798         DUMP is used to dump out the contents of memory, in the 'traditional' hexdump format.
 799
 800         Notice that the parameters to DUMP (address, length) are compatible with string words
 801         such as WORD and S".
 802 )
 803 : DUMP          ( addr len -- )
 804         BASE @ ROT              ( save the current BASE at the bottom of the stack )
 805         HEX                     ( and switch the hexadecimal mode )
 806
 807         BEGIN
 808                 DUP 0>          ( while len > 0 )
 809         WHILE
 810                 OVER 8 .R       ( print the address )
 811                 SPACE
 812
 813                 ( print up to 16 words on this line )
 814                 2DUP            ( addr len addr len )
 815                 1- 15 AND 1+    ( addr len addr linelen )
 816                 BEGIN
 817                         DUP 0>          ( while linelen > 0 )
 818                 WHILE
 819                         SWAP            ( addr len linelen addr )
 820                         DUP C@          ( addr len linelen addr byte )
 821                         2 .R SPACE      ( print the byte )
 822                         1+ SWAP 1-      ( addr len linelen addr -- addr len addr+1 linelen-1 )
 823                 REPEAT
 824                 2DROP           ( addr len )
 825
 826                 ( print the ASCII equivalents )
 827                 2DUP 1- 15 AND 1+ ( addr len addr linelen )
 828                 BEGIN
 829                         DUP 0>          ( while linelen > 0)
 830                 WHILE
 831                         SWAP            ( addr len linelen addr )
 832                         DUP C@          ( addr len linelen addr byte )
 833                         DUP 32 128 WITHIN IF    ( 32 <= c < 128? )
 834                                 EMIT
 835                         ELSE
 836                                 DROP '.' EMIT
 837                         THEN
 838                         1+ SWAP 1-      ( addr len linelen addr -- addr len addr+1 linelen-1 )
 839                 REPEAT
 840                 2DROP           ( addr len )
 841                 CR
 842
 843                 DUP 1- 15 AND 1+ ( addr len linelen )
 844                 DUP             ( addr len linelen linelen )
 845                 ROT             ( addr linelen len linelen )
 846                 -               ( addr linelen len-linelen )
 847                 ROT             ( len-linelen addr linelen )
 848                 +               ( len-linelen addr+linelen )
 849                 SWAP            ( addr-linelen len-linelen )
 850         REPEAT
 851
 852         2DROP                   ( restore stack )
 853         BASE !                  ( restore saved BASE )
 854 ;
 855
 856 (
 857         CASE...ENDCASE is how we do switch statements in FORTH.  There is no generally
 858         agreed syntax for this, so I've gone for the syntax mandated by the ISO standard
 859         FORTH (ANS-FORTH).
 860
 861         ( some value on the stack )
 862         CASE
 863         test1 OF ... ENDOF
 864         test2 OF ... ENDOF
 865         testn OF ... ENDOF
 866         ... ( default case )
 867         ENDCASE
 868
 869         The CASE statement tests the value on the stack by comparing it for equality with
 870         test1, test2, ..., testn and executes the matching piece of code within OF ... ENDOF.
 871         If none of the test values match then the default case is executed.  Inside the ... of
 872         the default case, the value is still at the top of stack (it is implicitly DROP-ed
 873         by ENDCASE).  When ENDOF is executed it jumps after ENDCASE (ie. there is no "fall-through"
 874         and no need for a break statement like in C).
 875
 876         The default case may be omitted.  In fact the tests may also be omitted so that you
 877         just have a default case, although this is probably not very useful.
 878
 879         An example (assuming that 'q', etc. are words which push the ASCII value of the letter
 880         on the stack):
 881
 882         0 VALUE QUIT
 883         0 VALUE SLEEP
 884         KEY CASE
 885                 'q' OF 1 TO QUIT ENDOF
 886                 's' OF 1 TO SLEEP ENDOF
 887                 ( default case: )
 888                 ." Sorry, I didn't understand key <" DUP EMIT ." >, try again." CR
 889         ENDCASE
 890
 891         (In some versions of FORTH, more advanced tests are supported, such as ranges, etc.
 892         Other versions of FORTH need you to write OTHERWISE to indicate the default case.
 893         As I said above, this FORTH tries to follow the ANS FORTH standard).
 894
 895         The implementation of CASE...ENDCASE is somewhat non-trivial.  I'm following the
 896         implementations from here:
 897         http://www.uni-giessen.de/faq/archiv/forthfaq.case_endcase/msg00000.html
 898
 899         The general plan is to compile the code as a series of IF statements:
 900
 901         CASE                            (push 0 on the immediate-mode parameter stack)
 902         test1 OF ... ENDOF              test1 OVER = IF DROP ... ELSE
 903         test2 OF ... ENDOF              test2 OVER = IF DROP ... ELSE
 904         testn OF ... ENDOF              testn OVER = IF DROP ... ELSE
 905         ... ( default case )            ...
 906         ENDCASE                         DROP THEN [THEN [THEN ...]]
 907
 908         The CASE statement pushes 0 on the immediate-mode parameter stack, and that number
 909         is used to count how many THEN statements we need when we get to ENDCASE so that each
 910         IF has a matching THEN.  The counting is done implicitly.  If you recall from the
 911         implementation above of IF, each IF pushes a code address on the immediate-mode stack,
 912         and these addresses are non-zero, so by the time we get to ENDCASE the stack contains
 913         some number of non-zeroes, followed by a zero.  The number of non-zeroes is how many
 914         times IF has been called, so how many times we need to match it with THEN.
 915
 916         This code uses [COMPILE] so that we compile calls to IF, ELSE, THEN instead of
 917         actually calling them while we're compiling the words below.
 918
 919         As is the case with all of our control structures, they only work within word
 920         definitions, not in immediate mode.
 921 )
 922 : CASE IMMEDIATE
 923         0               ( push 0 to mark the bottom of the stack )
 924 ;
 925
 926 : OF IMMEDIATE
 927         ' OVER ,        ( compile OVER )
 928         ' = ,           ( compile = )
 929         [COMPILE] IF    ( compile IF )
 930         ' DROP ,        ( compile DROP )
 931 ;
 932
 933 : ENDOF IMMEDIATE
 934         [COMPILE] ELSE  ( ENDOF is the same as ELSE )
 935 ;
 936
 937 : ENDCASE IMMEDIATE
 938         ' DROP ,        ( compile DROP )
 939
 940         ( keep compiling THEN until we get to our zero marker )
 941         BEGIN
 942                 ?DUP
 943         WHILE
 944                 [COMPILE] THEN
 945         REPEAT
 946 ;
 947
 948 (
 949         CFA> is the opposite of >CFA.  It takes a codeword and tries to find the matching
 950         dictionary definition.
 951
 952         In this FORTH this is not so easy.  In fact we have to search through the dictionary
 953         because we don't have a convenient back-pointer (as is often the case in other versions
 954         of FORTH).
 955
 956         This word returns 0 if it doesn't find a match.
 957 )
 958 : CFA>
 959         LATEST @        ( start at LATEST dictionary entry )
 960         BEGIN
 961                 DUP 0<>         ( while link pointer is not null )
 962         WHILE
 963                 DUP >CFA        ( cfa curr curr-cfa )
 964                 2 PICK          ( cfa curr curr-cfa cfa )
 965                 = IF            ( found a match? )
 966                         NIP             ( leave curr dictionary entry on the stack )
 967                         EXIT            ( and return from the function )
 968                 THEN
 969                 @               ( follow link pointer back )
 970         REPEAT
 971         2DROP           ( restore stack )
 972         0               ( sorry, nothing found )
 973 ;
 974
 975 (
 976         SEE disassembles a FORTH word.
 977
 978         We search for the dictionary entry of the word, then search again for the next
 979         word (effectively, the end of the compiled word).  This results in two pointers:
 980
 981         +---------+---+---+---+---+------------+------------+------------+------------+
 982         | LINK    | 3 | T | E | N | DOCOL      | LIT        | 10         | EXIT       |
 983         +---------+---+---+---+---+------------+------------+------------+------------+
 984          ^                                                                             ^
 985          |                                                                             |
 986         Start of word                                                         End of word
 987
 988         With this information we can have a go at decompiling the word.  We need to
 989         recognise "meta-words" like LIT, LITSTRING, BRANCH, etc. and treat those separately.
 990 )
 991 : SEE
 992         WORD FIND       ( find the dictionary entry to decompile )
 993
 994         ( Now we search again, looking for the next word in the dictionary.  This gives us
 995           the length of the word that we will be decompiling.  (Well, mostly it does). )
 996         HERE @          ( address of the end of the last compiled word )
 997         LATEST @        ( word last curr )
 998         BEGIN
 999                 2 PICK          ( word last curr word )
1000                 OVER            ( word last curr word curr )
1001                 <>              ( word last curr word<>curr? )
1002         WHILE                   ( word last curr )
1003                 NIP             ( word curr )
1004                 DUP @           ( word curr prev (which becomes: word last curr) )
1005         REPEAT
1006
1007         DROP            ( at this point, the stack is: start-of-word end-of-word )
1008         SWAP            ( end-of-word start-of-word )
1009
1010         ( begin the definition with : NAME [IMMEDIATE] )
1011         ':' EMIT SPACE DUP ID. SPACE
1012         DUP ?IMMEDIATE IF ." IMMEDIATE " THEN
1013
1014         >DFA            ( get the data address, ie. points after DOCOL | end-of-word start-of-data )
1015
1016         ( now we start decompiling until we hit the end of the word )
1017         BEGIN           ( end start )
1018                 2DUP >
1019         WHILE
1020                 DUP @           ( end start codeword )
1021
1022                 CASE
1023                 ' LIT OF                ( is it LIT ? )
1024                         4 + DUP @               ( get next word which is the integer constant )
1025                         .                       ( and print it )
1026                 ENDOF
1027                 ' LITSTRING OF          ( is it LITSTRING ? )
1028                         [ CHAR S ] LITERAL EMIT '"' EMIT SPACE ( print S"<space> )
1029                         4 + DUP @               ( get the length word )
1030                         SWAP 4 + SWAP           ( end start+4 length )
1031                         2DUP TELL               ( print the string )
1032                         '"' EMIT SPACE          ( finish the string with a final quote )
1033                         + ALIGNED               ( end start+4+len, aligned )
1034                         4 -                     ( because we're about to add 4 below )
1035                 ENDOF
1036                 ' 0BRANCH OF            ( is it 0BRANCH ? )
1037                         ." 0BRANCH ( "
1038                         4 + DUP @               ( print the offset )
1039                         .
1040                         ')' EMIT SPACE
1041                 ENDOF
1042                 ' BRANCH OF             ( is it BRANCH ? )
1043                         ." BRANCH ( "
1044                         4 + DUP @               ( print the offset )
1045                         .
1046                         ')' EMIT SPACE
1047                 ENDOF
1048                 ' ' OF                  ( is it ' (TICK) ? )
1049                         [ CHAR ' ] LITERAL EMIT SPACE
1050                         4 + DUP @               ( get the next codeword )
1051                         CFA>                    ( and force it to be printed as a dictionary entry )
1052                         ID. SPACE
1053                 ENDOF
1054                 ' EXIT OF               ( is it EXIT? )
1055                         ( We expect the last word to be EXIT, and if it is then we don't print it
1056                           because EXIT is normally implied by ;.  EXIT can also appear in the middle
1057                           of words, and then it needs to be printed. )
1058                         2DUP                    ( end start end start )
1059                         4 +                     ( end start end start+4 )
1060                         <> IF                   ( end start | we're not at the end )
1061                                 ." EXIT "
1062                         THEN
1063                 ENDOF
1064                                         ( default case: )
1065                         DUP                     ( in the default case we always need to DUP before using )
1066                         CFA>                    ( look up the codeword to get the dictionary entry )
1067                         ID. SPACE               ( and print it )
1068                 ENDCASE
1069
1070                 4 +             ( end start+4 )
1071         REPEAT
1072
1073         ';' EMIT CR
1074
1075         2DROP           ( restore stack )
1076 ;
1077
1078 ( Finally print the welcome prompt. )
1079 ." JONESFORTH VERSION " VERSION . CR
1080 ." OK "