jonesforth.S.10

   1 /* A minimal FORTH interpreter for Linux / i386 systems. -*- asm -*-
   2  * By Richard W.M. Jones <rich@annexia.org>
   3  *
   4  * gcc -m32 -nostdlib -static -Wl,-Ttext,0 -o jonesforth jonesforth.S
   5  */
   6
   7 #include <asm-i386/unistd.h>
   8
   9 /* NOTES-------------------------------------------------------------------------------------------------------------------
  10
  11 Need to say something about $ before constants.
  12
  13 And about je/jne/ja/jb/jbe/etc
  14
  15
  16
  17
  18 */
  19
  20 /* NEXT macro. */
  21         .macro NEXT
  22         lodsl
  23         jmp *(%eax)
  24         .endm
  25
  26 /* Macros to deal with the return stack. */
  27         .macro PUSHRSP reg
  28         lea -4(%ebp),%ebp       // push reg on to return stack
  29         movl \reg,(%ebp)
  30         .endm
  31
  32         .macro POPRSP reg
  33         mov (%ebp),\reg         // pop top of return stack to reg
  34         lea 4(%ebp),%ebp
  35         .endm
  36
  37 /* ELF entry point. */
  38         .text
  39         .globl _start
  40 _start:
  41         cld
  42         mov $return_stack,%ebp  // Initialise the return stack.
  43
  44         mov $cold_start,%esi    // Initialise interpreter.
  45         NEXT                    // Run interpreter!
  46
  47         .section .rodata
  48 cold_start:                     // High-level code without a codeword.
  49         .int COLD
  50
  51 /* DOCOL - the interpreter! */
  52         .text
  53         .align 4
  54 DOCOL:
  55         PUSHRSP %esi            // push %esi on to the return stack
  56         addl $4,%eax            // %eax points to codeword, so make
  57         movl %eax,%esi          // %esi point to first data word
  58         NEXT
  59
  60 /*----------------------------------------------------------------------
  61  * Fixed sized buffers for everything.
  62  */
  63         .bss
  64
  65 /* FORTH return stack. */
  66 #define RETURN_STACK_SIZE 8192
  67         .align 4096
  68         .space RETURN_STACK_SIZE
  69 return_stack:
  70
  71 /* Space for user-defined words. */
  72 #define USER_DEFS_SIZE 16384
  73         .align 4096
  74 user_defs_start:
  75         .space USER_DEFS_SIZE
  76
  77
  78
  79
  80
  81
  82 /*----------------------------------------------------------------------
  83  * Built-in words defined the long way.
  84  */
  85 #define F_IMMED 0x80
  86 #define F_HIDDEN 0x20
  87
  88         // Store the chain of links.
  89         .set link,0
  90
  91         .macro defcode name, namelen, flags=0, label
  92         .section .rodata
  93         .align 4
  94         .globl name_\label
  95 name_\label :
  96         .int link               // link
  97         .set link,name_\label
  98         .byte \flags+\namelen   // flags + length byte
  99         .ascii "\name"          // the name
 100         .align 4
 101         .globl \label
 102 \label :
 103         .int code_\label        // codeword
 104         .text
 105         .align 4
 106         .globl code_\label
 107 code_\label :                   // assembler code follows
 108         .endm
 109
 110         .macro defword name, namelen, flags=0, label
 111         .section .rodata
 112         .align 4
 113         .globl name_\label
 114 name_\label :
 115         .int link               // link
 116         .set link,name_\label
 117         .byte \flags+\namelen   // flags + length byte
 118         .ascii "\name"          // the name
 119         .align 4
 120         .globl \label
 121 \label :
 122         .int DOCOL              // codeword - the interpreter
 123         // list of word pointers follow
 124         .endm
 125
 126         .macro defvar name, namelen, flags=0, label, initial=0
 127         defcode \name,\namelen,\flags,\label
 128         push $var_\name
 129         NEXT
 130         .data
 131         .align 4
 132 var_\name :
 133         .int \initial
 134         .endm
 135
 136         // Some easy ones, written in assembly for speed
 137         defcode "DROP",4,,DROP
 138         pop %eax                // drop top of stack
 139         NEXT
 140
 141         defcode "DUP",3,,DUP
 142         pop %eax                // duplicate top of stack
 143         push %eax
 144         push %eax
 145         NEXT
 146
 147         defcode "SWAP",4,,SWAP
 148         pop %eax                // swap top of stack
 149         pop %ebx
 150         push %eax
 151         push %ebx
 152         NEXT
 153
 154         defcode "OVER",4,,OVER
 155         mov 4(%esp),%eax        // get the second element of stack
 156         push %eax               // and push it on top
 157         NEXT
 158
 159         defcode "1+",2,,INCR
 160         incl (%esp)             // increment top of stack
 161         NEXT
 162
 163         defcode "1-",2,,DECR
 164         decl (%esp)             // decrement top of stack
 165         NEXT
 166
 167         defcode "+",1,,ADD
 168         pop %eax
 169         addl %eax,(%esp)
 170         NEXT
 171
 172         defcode "-",1,,SUB
 173         pop %eax
 174         subl %eax,(%esp)
 175         NEXT
 176
 177         defcode "*",1,,MUL
 178         pop %eax
 179         pop %ebx
 180         imull %ebx,%eax
 181         push %eax               // ignore overflow
 182         NEXT
 183
 184         defcode "/",1,,DIV
 185         xor %edx,%edx
 186         pop %ebx
 187         pop %eax
 188         idivl %ebx
 189         push %eax               // push quotient
 190         NEXT
 191
 192         defcode "MOD",3,,MOD
 193         xor %edx,%edx
 194         pop %ebx
 195         pop %eax
 196         idivl %ebx
 197         push %edx               // push remainder
 198         NEXT
 199
 200         // COLD must not return (ie. must not call EXIT).
 201         defword "COLD",4,,COLD
 202         // XXX reinitialisation of the interpreter
 203         .int INTERPRETER        // call the interpreter loop (never returns)
 204         .int LIT,1,SYSEXIT      // hmmm, but in case it does, exit(1).
 205
 206         defcode "EXIT",4,,EXIT
 207         POPRSP %esi             // pop return stack into %esi
 208         NEXT
 209
 210         defcode "LIT",3,,LIT
 211         // %esi points to the next command, but in this case it points to the next
 212         // literal 32 bit integer.  Get that literal into %eax and increment %esi.
 213         // On x86, it's a convenient single byte instruction!  (cf. NEXT macro)
 214         lodsl
 215         push %eax               // push the literal number on to stack
 216         NEXT
 217
 218 #if 0
 219         defcode "0SKIP",5,,ZSKIP
 220         // If the top of stack is zero, skip the next instruction.
 221         pop %eax
 222         test %eax,%eax
 223         jnz 1f
 224         lodsl                   // this does the skip
 225 1:      NEXT
 226 #endif
 227
 228         defcode "!",1,,STORE
 229         pop %ebx                // address to store at
 230         pop %eax                // data to store there
 231         mov %eax,(%ebx)         // store it
 232         NEXT
 233
 234         defcode "@",1,,FETCH
 235         pop %ebx                // address to fetch
 236         mov (%ebx),%eax         // fetch it
 237         push %eax               // push value onto stack
 238         NEXT
 239
 240         // The STATE variable is 0 for execute mode, != 0 for compile mode
 241         defvar "STATE",5,,STATE
 242
 243         // This points to where compiled words go.
 244         defvar "HERE",4,,HERE,user_defs_start
 245
 246         // This is the last definition in the dictionary.
 247         defvar "LATEST",6,,LATEST,name_SYSEXIT // SYSEXIT must be last in built-in dictionary
 248
 249         // _X, _Y and _Z are scratch variables used by standard words.
 250         defvar "_X",2,,TX
 251         defvar "_Y",2,,TY
 252         defvar "_Z",2,,TZ
 253
 254         defcode ">R",2,,TOR
 255         pop %eax                // pop parameter stack into %eax
 256         PUSHRSP %eax            // push it on to the return stack
 257         NEXT
 258
 259         defcode "R>",2,,FROMR
 260         POPRSP %eax             // pop return stack on to %eax
 261         push %eax               // and push on to parameter stack
 262         NEXT
 263
 264         defcode "RSP@",4,,RSPFETCH
 265         push %ebp
 266         NEXT
 267
 268         defcode "RSP!",4,,RSPSTORE
 269         pop %ebp
 270         NEXT
 271
 272         defcode "RDROP",5,,RDROP
 273         lea 4(%ebp),%ebp        // pop return stack and throw away
 274         NEXT
 275
 276         defcode "KEY",3,,KEY
 277         call _KEY
 278         push %eax               // push return value on stack
 279         NEXT
 280 _KEY:
 281         mov (currkey),%ebx
 282         cmp (bufftop),%ebx
 283         jge 1f
 284         xor %eax,%eax
 285         mov (%ebx),%al
 286         inc %ebx
 287         mov %ebx,(currkey)
 288         ret
 289
 290 1:      // out of input; use read(2) to fetch more input from stdin
 291         xor %ebx,%ebx           // 1st param: stdin
 292         mov $buffer,%ecx        // 2nd param: buffer
 293         mov %ecx,currkey
 294         mov $buffend-buffer,%edx // 3rd param: max length
 295         mov $__NR_read,%eax     // syscall: read
 296         int $0x80
 297         test %eax,%eax          // If %eax <= 0, then exit.
 298         jbe 2f
 299         addl %eax,%ecx          // buffer+%eax = bufftop
 300         mov %ecx,bufftop
 301         jmp _KEY
 302
 303 2:      // error or out of input: exit
 304         xor %ebx,%ebx
 305         mov $__NR_exit,%eax     // syscall: exit
 306         int $0x80
 307
 308         defcode "EMIT",4,,EMIT
 309         pop %eax
 310         call _EMIT
 311         NEXT
 312 _EMIT:
 313         mov $1,%ebx             // 1st param: stdout
 314
 315         // write needs the address of the byte to write
 316         mov %al,(2f)
 317         mov $2f,%ecx            // 2nd param: address
 318
 319         mov $1,%edx             // 3rd param: nbytes = 1
 320
 321         mov $__NR_write,%eax    // write syscall
 322         int $0x80
 323         ret
 324
 325         .bss
 326 2:      .space 1                // scratch used by EMIT
 327
 328         defcode "WORD",4,,WORD
 329         call _WORD
 330         push %ecx               // push length
 331         push %edi               // push base address
 332         NEXT
 333
 334 _WORD:
 335         /* Search for first non-blank character.  Also skip \ comments. */
 336 1:
 337         call _KEY               // get next key, returned in %eax
 338         cmpb $'\\',%al          // start of a comment?
 339         je 3f                   // if so, skip the comment
 340         cmpb $' ',%al
 341         jbe 1b                  // if so, keep looking
 342
 343         /* Search for the end of the word, storing chars as we go. */
 344         mov $5f,%edi            // pointer to return buffer
 345 2:
 346         stosb                   // add character to return buffer
 347         call _KEY               // get next key, returned in %al
 348         cmpb $' ',%al           // is blank?
 349         ja 2b                   // if not, keep looping
 350
 351         /* Return the word (well, the static buffer) and length. */
 352         sub $5f,%edi
 353         mov %edi,%ecx           // return length of the word
 354         mov $5f,%edi            // return address of the word
 355         ret
 356
 357         /* Code to skip \ comments to end of the current line. */
 358 3:
 359         call _KEY
 360         cmpb $'\n',%al          // end of line yet?
 361         jne 3b
 362         jmp 1b
 363
 364         .bss
 365         // A static buffer where WORD returns.  Subsequent calls
 366         // overwrite this buffer.  Maximum word length is 32 chars.
 367 5:      .space 32
 368
 369         defcode "EMITWORD",8,,EMITWORD
 370         mov $1,%ebx             // 1st param: stdout
 371         pop %ecx                // 2nd param: address of string
 372         pop %edx                // 3rd param: length of string
 373
 374         mov $__NR_write,%eax    // write syscall
 375         int $0x80
 376
 377         NEXT
 378
 379         defcode ".",1,,DOT
 380         pop %eax                // Get the number to print into %eax
 381         call _DOT               // Easier to do this recursively ...
 382         NEXT
 383 _DOT:
 384         mov $10,%ecx            // Base 10
 385 1:
 386         cmp %ecx,%eax
 387         jb 2f
 388         xor %edx,%edx           // %edx:%eax / %ecx -> quotient %eax, remainder %edx
 389         idivl %ecx
 390         pushl %edx
 391         call _DOT
 392         popl %eax
 393         jmp 1b
 394 2:
 395         xor %ah,%ah
 396         aam $10
 397         cwde
 398         addl $'0',%eax
 399         call _EMIT
 400         ret
 401
 402         // Parse a number from a string on the stack -- almost the opposite of . (DOT)
 403         // Note that there is absolutely no error checking.  In particular the length of the
 404         // string must be >= 1 bytes.
 405         defcode "SNUMBER",7,,SNUMBER
 406         pop %edi
 407         pop %ecx
 408         call _SNUMBER
 409         push %eax
 410         NEXT
 411 _SNUMBER:
 412         xor %eax,%eax
 413         xor %ebx,%ebx
 414 1:
 415         imull $10,%eax          // %eax *= 10
 416         movb (%edi),%bl
 417         inc %edi
 418         subb $'0',%bl           // ASCII -> digit
 419         add %ebx,%eax
 420         dec %ecx
 421         jnz 1b
 422         ret
 423
 424         defcode "FIND",4,,FIND
 425         pop %edi                // %edi = address
 426         pop %ecx                // %ecx = length
 427         call _FIND
 428         push %eax
 429         NEXT
 430
 431 _FIND:
 432         push %esi               // Save %esi so we can use it in string comparison.
 433
 434         // Now we start searching backwards through the dictionary for this word.
 435         mov var_LATEST,%edx     // LATEST points to name header of the latest word in the dictionary
 436 1:
 437         test %edx,%edx          // NULL pointer?  (end of the linked list)
 438         je 4f
 439
 440         // Compare the length expected and the length of the word.
 441         // Note that if the F_HIDDEN flag is set on the word, then by a bit of trickery
 442         // this won't pick the word (the length will appear to be wrong).
 443         xor %eax,%eax
 444         movb 4(%edx),%al        // %al = flags+length field
 445         andb $(F_HIDDEN|0x1f),%al // %al = name length
 446         cmpb %cl,%al            // Length is the same?
 447         jne 2f
 448
 449         // Compare the strings in detail.
 450         push %ecx               // Save the length
 451         push %edi               // Save the address (repe cmpsb will move this pointer)
 452         lea 5(%edx),%esi        // Dictionary string we are checking against.
 453         repe cmpsb              // Compare the strings.
 454         pop %edi
 455         pop %ecx
 456         jne 2f                  // Not the same.
 457
 458         // The strings are the same - return the header pointer in %eax
 459         pop %esi
 460         mov %edx,%eax
 461         ret
 462
 463 2:
 464         mov (%edx),%edx         // Move back through the link field to the previous word
 465         jmp 1b                  // .. and loop.
 466
 467 4:      // Not found.
 468         pop %esi
 469         xor %eax,%eax           // Return zero to indicate not found.
 470         ret
 471
 472         defcode ">CFA",4,,TCFA  // DEA -> Codeword address
 473         pop %edi
 474         call _TCFA
 475         push %edi
 476         NEXT
 477 _TCFA:
 478         xor %eax,%eax
 479         add $4,%edi             // Skip link pointer.
 480         movb (%edi),%al         // Load flags+len into %al.
 481         inc %edi                // Skip flags+len byte.
 482         andb $0x1f,%al          // Just the length, not the flags.
 483         add %eax,%edi           // Skip the name.
 484         addl $3,%edi            // The codeword is 4-byte aligned.
 485         andl $~3,%edi
 486         ret
 487
 488 #if 0
 489         defword "'",1,,TICK
 490         .int WORD               // Get the following word.
 491         .int FIND               // Look it up in the dictionary.
 492         .int DUP                // If not found, skip >CFA (TCFA) instruction.
 493         .int ZSKIP
 494         .int TCFA               // Convert to a codeword pointer.
 495         .int EXIT               // Return.
 496 #endif
 497
 498         defcode ":",1,,COLON
 499
 500         // Get the word and create a dictionary entry header for it.
 501         call _WORD              // Returns %ecx = length, %edi = pointer to word.
 502         mov %edi,%ebx           // %ebx = address of the word
 503
 504         movl var_HERE,%edi      // %edi is the address of the header
 505         movl var_LATEST,%eax    // Get link pointer
 506         stosl                   // and store it in the header.
 507
 508         mov %cl,%al             // Get the length.
 509         orb $F_HIDDEN,%al       // Set the HIDDEN flag on this entry.
 510         stosb                   // Store the length/flags byte.
 511         push %esi
 512         mov %ebx,%esi           // %esi = word
 513         rep movsb               // Copy the word
 514         pop %esi
 515         addl $3,%edi            // Align to next 4 byte boundary.
 516         andl $~3,%edi
 517
 518         movl $DOCOL,%eax        // The codeword for user-created words is always DOCOL (the interpreter)
 519         stosl
 520
 521         // Header built, so now update LATEST and HERE.
 522         // We'll be compiling words and putting them HERE.
 523         movl var_HERE,%eax
 524         movl %eax,var_LATEST
 525         movl %edi,var_HERE
 526
 527         // And go into compile mode by setting STATE to 1.
 528         xor %eax,%eax
 529         inc %eax
 530         mov %eax,var_STATE
 531         NEXT
 532
 533         defcode ",",1,,COMMA
 534         pop %eax                // Code pointer to store.
 535         call _COMMA
 536         NEXT
 537 _COMMA:
 538         movl var_HERE,%edi      // HERE
 539         stosl                   // Store it.
 540         movl %edi,var_HERE      // Update HERE (incremented)
 541         ret
 542
 543         defcode "HIDDEN",6,,HIDDEN
 544         call _HIDDEN
 545         NEXT
 546 _HIDDEN:
 547         movl var_LATEST,%edi    // LATEST word.
 548         addl $4,%edi            // Point to name/flags byte.
 549         xorb $F_HIDDEN,(%edi)   // Toggle the HIDDEN bit.
 550         ret
 551
 552         defcode "IMMEDIATE",9,F_IMMED,IMMEDIATE
 553         call _IMMEDIATE
 554         NEXT
 555 _IMMEDIATE:
 556         movl var_LATEST,%edi    // LATEST word.
 557         addl $4,%edi            // Point to name/flags byte.
 558         xorb $F_IMMED,(%edi)    // Toggle the IMMED bit.
 559         ret
 560
 561         defcode ";",1,F_IMMED,SEMICOLON
 562         movl $EXIT,%eax         // EXIT is the final codeword in compiled words.
 563         call _COMMA             // Store it.
 564         call _HIDDEN            // Toggle the HIDDEN flag (unhides the new word).
 565         xor %eax,%eax           // Set STATE to 0 (back to execute mode).
 566         movl %eax,var_STATE
 567         NEXT
 568
 569 /* This interpreter is pretty simple, but remember that in FORTH you can always override
 570  * it later with a more powerful one!
 571  */
 572         defword "INTERPRETER",11,,INTERPRETER
 573         .int INTERPRET,RDROP,INTERPRETER
 574
 575         defcode "INTERPRET",9,,INTERPRET
 576         call _WORD              // Returns %ecx = length, %edi = pointer to word.
 577
 578         // Is it in the dictionary?
 579         call _FIND              // Returns %eax = pointer to header or 0 if not found.
 580         test %eax,%eax          // Found?
 581         jz 1f
 582
 583         // In the dictionary.  Is it an IMMEDIATE codeword?
 584         mov %eax,%edi           // %edi = dictionary entry
 585         movb 4(%edi),%al        // Get name+flags.
 586         push %ax                // Just save it for now.
 587         call _TCFA              // Convert dictionary entry (in %edi) to codeword pointer.
 588         pop %ax
 589         andb $F_IMMED,%al       // Is IMMED flag set?
 590         mov %edi,%eax
 591         jnz 3f                  // If IMMED, jump straight to executing.
 592
 593         jmp 2f
 594
 595 1:      // Not in the dictionary (not a word) so assume it's a number.
 596         call _SNUMBER           // Returns the parsed number in %eax
 597         mov %eax,%ebx
 598         mov $LIT,%eax           // The word is LIT
 599
 600 2:      // Are we compiling or executing?
 601         movl var_STATE,%edx
 602         test %edx,%edx
 603         jz 3f                   // Jump if executing.
 604
 605         // Compiling - just append the word to the current dictionary definition.
 606         call _COMMA
 607         cmp $LIT,%eax           // Was it LIT?
 608         jne 4f
 609         mov %ebx,%eax           // Yes, so LIT is followed by a number.
 610         call _COMMA
 611         NEXT
 612
 613 3:      // Executing - run it!
 614         cmp $LIT,%eax           // Literal?
 615         je 4f
 616         // Not a literal, execute it now.  This never returns, but the codeword will
 617         // eventually call NEXT which will reenter the loop in INTERPRETER.
 618         jmp *(%eax)
 619
 620 4:      // Executing a literal, which means push it on the stack.
 621         push %ebx
 622         NEXT
 623
 624         // NB: SYSEXIT must be the last entry in the built-in dictionary.
 625         defcode SYSEXIT,7,,SYSEXIT
 626         pop %ebx
 627         mov $__NR_exit,%eax
 628         int $0x80
 629
 630 /*----------------------------------------------------------------------
 631  * Input buffer & initial input.
 632  */
 633         .data
 634         .align 4096
 635 buffer:
 636         // XXX gives 'Warning: unterminated string; newline inserted' messages which you can ignore
 637         .ascii "\
 638 \\ Define some character constants
 639 : '\\n'   10 ;
 640 : 'SPACE' 32 ;
 641 : '\"'    34 ;
 642
 643 \\ CR prints a carriage return
 644 : CR '\\n' EMIT ;
 645
 646 \\ SPACE prints a space
 647 : SPACE 'SPACE' EMIT ;
 648
 649 \\ Primitive . (DOT) function doesn't follow with a blank, so redefine it to behave like FORTH.
 650 \\ Notice how we can trivially redefine existing functions.
 651 : . . SPACE ;
 652
 653 \\ XXX SPACES
 654
 655 \\ DUP, DROP are defined in assembly for speed, but this is how you might define them
 656 \\ in FORTH.  Notice use of the scratch variables _X and _Y.
 657 \\ : DUP _X ! _X @ _X @ ;
 658 \\ : DROP _X ! ;
 659
 660
 661
 662 \\ Finally print the welcome prompt.
 663 79 EMIT 75 EMIT 'SPACE' EMIT
 664 "
 665
 666 _initbufftop:
 667         .align 4096
 668 buffend:
 669
 670 currkey:
 671         .int buffer
 672 bufftop:
 673         .int _initbufftop