jonesforth.S.8

   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 .... */
 137         defcode "DUP",3,,DUP
 138         pop %eax                // duplicate top of stack
 139         push %eax
 140         push %eax
 141         NEXT
 142
 143         defcode "DROP",4,,DROP
 144         pop %eax                // drop top of stack
 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         // COLD must not return (ie. must not call EXIT).
 160         defword "COLD",4,,COLD
 161         // XXX reinitialisation of the interpreter
 162         .int INTERPRETER        // call the interpreter loop (never returns)
 163         .int LIT,1,SYSEXIT      // hmmm, but in case it does, exit(1).
 164
 165         defcode "EXIT",4,,EXIT
 166         POPRSP %esi             // pop return stack into %esi
 167         NEXT
 168
 169         defcode "LIT",3,,LIT
 170         // %esi points to the next command, but in this case it points to the next
 171         // literal 32 bit integer.  Get that literal into %eax and increment %esi.
 172         // On x86, it's a convenient single byte instruction!  (cf. NEXT macro)
 173         lodsl
 174         push %eax               // push %eax on to stack
 175         NEXT
 176
 177         defcode "0SKIP",5,,ZSKIP
 178         // If the top of stack is zero, skip the next instruction.
 179         pop %eax
 180         test %eax,%eax
 181         jnz 1f
 182         lodsl                   // this does the skip
 183 1:      NEXT
 184
 185         defcode "!",1,,STORE
 186         pop %ebx                // address to store at
 187         pop %eax                // data to store there
 188         mov %eax,(%ebx)         // store it
 189         NEXT
 190
 191         defcode "@",1,,FETCH
 192         pop %ebx                // address to fetch
 193         mov (%ebx),%eax         // fetch it
 194         push %eax               // push value onto stack
 195         NEXT
 196
 197         // The STATE variable is 0 for execute mode, != 0 for compile mode
 198         defvar "STATE",5,,STATE
 199
 200         // This points to where compiled words go.
 201         defvar "HERE",4,,HERE,user_defs_start
 202
 203         // This is the last definition in the dictionary.
 204         defvar "LATEST",6,,LATEST,name_SYSEXIT // SYSEXIT must be last in built-in dictionary
 205
 206         defcode ">R",2,,TOR
 207         pop %eax                // pop parameter stack into %eax
 208         PUSHRSP %eax            // push it on to the return stack
 209         NEXT
 210
 211         defcode "R>",2,,FROMR
 212         POPRSP %eax             // pop return stack on to %eax
 213         push %eax               // and push on to parameter stack
 214         NEXT
 215
 216 #if 0 /* This definition is wrong. */
 217         defcode "R",1,,R
 218         mov %(ebp),%eax         // copy (don't pop) top of return stack to %eax
 219         push %eax               // and push on to parameter stack
 220         NEXT
 221 #endif
 222
 223         defcode "RSP@",4,,RSPFETCH
 224         push %ebp
 225         NEXT
 226
 227         defcode "RSP!",4,,RSPSTORE
 228         pop %ebp
 229         NEXT
 230
 231         defcode "RDROP",5,,RDROP
 232         lea 4(%ebp),%ebp        // pop return stack and throw away
 233         NEXT
 234
 235         defcode "KEY",3,,KEY
 236         call _KEY
 237         push %eax               // push return value on stack
 238         NEXT
 239 _KEY:
 240         mov (currkey),%ebx
 241         cmp (bufftop),%ebx
 242         jge 1f
 243         xor %eax,%eax
 244         mov (%ebx),%al
 245         inc %ebx
 246         mov %ebx,(currkey)
 247         ret
 248 1:
 249         mov $0,%ebx             // out of input, exit (0)
 250         mov $__NR_exit,%eax
 251         int $0x80
 252
 253         defcode "EMIT",4,,EMIT
 254         pop %eax
 255         call _EMIT
 256         NEXT
 257 _EMIT:
 258         mov $1,%ebx             // 1st param: stdout
 259
 260         // write needs the address of the byte to write
 261         mov %al,(2f)
 262         mov $2f,%ecx            // 2nd param: address
 263
 264         mov $1,%edx             // 3rd param: nbytes = 1
 265
 266         mov $__NR_write,%eax    // write syscall
 267         int $0x80
 268         ret
 269
 270         .bss
 271 2:      .space 1                // scratch used by EMIT
 272
 273         defcode "WORD",4,,WORD
 274         call _WORD
 275         push %ecx               // push length
 276         push %edi               // push base address
 277         NEXT
 278
 279 _WORD:
 280         /* Search for first non-blank character.  Also skip \ comments. */
 281 1:
 282         call _KEY               // get next key, returned in %eax
 283         cmpb $'\\',%al          // start of a comment?
 284         je 3f                   // if so, skip the comment
 285         cmpb $' ',%al
 286         jbe 1b                  // if so, keep looking
 287
 288         /* Search for the end of the word, storing chars as we go. */
 289         mov $5f,%edi            // pointer to return buffer
 290 2:
 291         stosb                   // add character to return buffer
 292         call _KEY               // get next key, returned in %al
 293         cmpb $' ',%al           // is blank?
 294         ja 2b                   // if not, keep looping
 295
 296         /* Return the word (well, the static buffer) and length. */
 297         sub $5f,%edi
 298         mov %edi,%ecx           // return length of the word
 299         mov $5f,%edi            // return address of the word
 300         ret
 301
 302         /* Code to skip \ comments to end of the current line. */
 303 3:
 304         call _KEY
 305         cmpb $'\n',%al          // end of line yet?
 306         jne 3b
 307         jmp 1b
 308
 309         .bss
 310         // A static buffer where WORD returns.  Subsequent calls
 311         // overwrite this buffer.  Maximum word length is 32 chars.
 312 5:      .space 32
 313
 314         defcode "EMITWORD",8,,EMITWORD
 315         mov $1,%ebx             // 1st param: stdout
 316         pop %ecx                // 2nd param: address of string
 317         pop %edx                // 3rd param: length of string
 318
 319         mov $__NR_write,%eax    // write syscall
 320         int $0x80
 321
 322         NEXT
 323
 324         defcode ".",1,,DOT
 325         pop %eax                // Get the number to print into %eax
 326         call _DOT               // Easier to do this recursively ...
 327         NEXT
 328 _DOT:
 329         mov $10,%ecx            // Base 10
 330         cmp %ecx,%eax
 331         jb 1f
 332         pushl %eax
 333         xor %edx,%edx
 334         idivl %ecx
 335         call _DOT
 336         popl %eax
 337 1:
 338         aam $10
 339         cbw
 340         cwde
 341         addl $'0',%eax
 342         call _EMIT
 343         ret
 344
 345         // Parse a number from a string on the stack -- almost the opposite of . (DOT)
 346         // Note that there is absolutely no error checking.  In particular the length of the
 347         // string must be >= 1 bytes.
 348         defcode "SNUMBER",7,,SNUMBER
 349         pop %edi
 350         pop %ecx
 351         call _SNUMBER
 352         push %eax
 353         NEXT
 354 _SNUMBER:
 355         xor %eax,%eax
 356         xor %ebx,%ebx
 357 1:
 358         imull $10,%eax          // %eax *= 10
 359         movb (%edi),%bl
 360         inc %edi
 361         subb $'0',%bl           // ASCII -> digit
 362         add %ebx,%eax
 363         dec %ecx
 364         jnz 1b
 365         ret
 366
 367         defcode "FIND",4,,FIND
 368         pop %edi                // %edi = address
 369         pop %ecx                // %ecx = length
 370         call _FIND
 371         push %eax
 372         NEXT
 373
 374 _FIND:
 375         push %esi               // Save %esi so we can use it in string comparison.
 376
 377         // Now we start searching backwards through the dictionary for this word.
 378         mov var_LATEST,%edx     // LATEST points to name header of the latest word in the dictionary
 379 1:
 380         test %edx,%edx          // NULL pointer?  (end of the linked list)
 381         je 4f
 382
 383         // Compare the length expected and the length of the word.
 384         // Note that if the F_HIDDEN flag is set on the word, then by a bit of trickery
 385         // this won't pick the word (the length will appear to be wrong).
 386         xor %eax,%eax
 387         movb 4(%edx),%al        // %al = flags+length field
 388         andb $(F_HIDDEN|0x1f),%al // %al = name length
 389         cmpb %cl,%al            // Length is the same?
 390         jne 2f
 391
 392         // Compare the strings in detail.
 393         push %ecx               // Save the length
 394         push %edi               // Save the address (repe cmpsb will move this pointer)
 395         lea 5(%edx),%esi        // Dictionary string we are checking against.
 396         repe cmpsb              // Compare the strings.
 397         pop %edi
 398         pop %ecx
 399         jne 2f                  // Not the same.
 400
 401         // The strings are the same - return the header pointer in %eax
 402         pop %esi
 403         mov %edx,%eax
 404         ret
 405
 406 2:
 407         mov (%edx),%edx         // Move back through the link field to the previous word
 408         jmp 1b                  // .. and loop.
 409
 410 4:      // Not found.
 411         pop %esi
 412         xor %eax,%eax           // Return zero to indicate not found.
 413         ret
 414
 415         defcode ">CFA",4,,TCFA  // DEA -> Codeword address
 416         pop %edi
 417         call _TCFA
 418         push %edi
 419         NEXT
 420 _TCFA:
 421         xor %eax,%eax
 422         add $4,%edi             // Skip link pointer.
 423         movb (%edi),%al         // Load flags+len into %al.
 424         inc %edi                // Skip flags+len byte.
 425         andb $0x1f,%al          // Just the length, not the flags.
 426         add %eax,%edi           // Skip the name.
 427         orl $3,%edi             // The codeword is 4-byte aligned.
 428         inc %edi
 429         ret
 430
 431         defword "'",1,,TICK
 432         .int WORD               // Get the following word.
 433         .int FIND               // Look it up in the dictionary.
 434         .int DUP                // If not found, skip >CFA (TCFA) instruction.
 435         .int ZSKIP
 436         .int TCFA               // Convert to a codeword pointer.
 437         .int EXIT               // Return.
 438
 439         defcode ":",1,,COLON
 440
 441         // Get the word and create a dictionary entry header for it.
 442         call _WORD              // Returns %ecx = length, %edi = pointer to word.
 443         mov %edi,%ebx           // %ebx = address of the word
 444
 445         movl var_HERE,%edi      // %edi is the address of the header
 446         movl var_LATEST,%eax    // Get link pointer
 447         stosl                   // and store it in the header.
 448
 449         mov %cl,%al             // Get the length.
 450         orb $F_HIDDEN,%al       // Set the HIDDEN flag on this entry.
 451         stosb                   // Store the length/flags byte.
 452         push %esi
 453         mov %ebx,%esi           // %esi = word
 454         rep movsb               // Copy the word
 455         pop %esi
 456         orl $3,%edi             // Align to next 4 byte boundary.
 457         inc %edi
 458
 459         movl $DOCOL,%eax        // The codeword for user-created words is always DOCOL (the interpreter)
 460         stosl
 461
 462         // Header built, so now update LATEST and HERE.
 463         // We'll be compiling words and putting them HERE.
 464         movl var_HERE,%eax
 465         movl %eax,var_LATEST
 466         movl %edi,var_HERE
 467
 468         // And go into compile mode by setting STATE to 1.
 469         xor %eax,%eax
 470         inc %eax
 471         mov %eax,var_STATE
 472         NEXT
 473
 474         defcode ",",1,,COMMA
 475         pop %eax                // Code pointer to store.
 476         call _COMMA
 477         NEXT
 478 _COMMA:
 479         movl var_HERE,%edi      // HERE
 480         stosl                   // Store it.
 481         movl %edi,var_HERE      // Update HERE (incremented)
 482         ret
 483
 484         defcode "HIDDEN",6,,HIDDEN
 485         call _HIDDEN
 486         NEXT
 487 _HIDDEN:
 488         movl var_LATEST,%edi    // LATEST word.
 489         addl $4,%edi            // Point to name/flags byte.
 490         xorb $F_HIDDEN,(%edi)   // Toggle the HIDDEN bit.
 491         ret
 492
 493         defcode "IMMEDIATE",9,F_IMMED,IMMEDIATE
 494         call _IMMEDIATE
 495         NEXT
 496 _IMMEDIATE:
 497         movl var_LATEST,%edi    // LATEST word.
 498         addl $4,%edi            // Point to name/flags byte.
 499         xorb $F_IMMED,(%edi)    // Toggle the IMMED bit.
 500         ret
 501
 502         defcode ";",1,F_IMMED,SEMICOLON
 503         movl $EXIT,%eax         // EXIT is the final codeword in compiled words.
 504         call _COMMA             // Store it.
 505         call _HIDDEN            // Toggle the HIDDEN flag (unhides the new word).
 506         xor %eax,%eax           // Set STATE to 0 (back to execute mode).
 507         movl %eax,var_STATE
 508         NEXT
 509
 510 /* This interpreter is pretty simple, but remember that in FORTH you can always override
 511  * it later with a more powerful one!
 512  */
 513         defword "INTERPRETER",11,,INTERPRETER
 514         .int INTERPRET,RDROP,INTERPRETER
 515
 516         defcode "INTERPRET",9,,INTERPRET
 517         call _WORD              // Returns %ecx = length, %edi = pointer to word.
 518
 519         // Is it in the dictionary?
 520         call _FIND              // Returns %eax = pointer to header or 0 if not found.
 521         test %eax,%eax          // Found?
 522         jz 1f
 523
 524         // In the dictionary.  Is it an IMMEDIATE codeword?
 525         mov %eax,%edi           // %edi = dictionary entry
 526         movb 4(%edi),%al        // Get name+flags.
 527         push %ax                // Just save it for now.
 528         call _TCFA              // Convert dictionary entry (in %edi) to codeword pointer.
 529         pop %ax
 530         andb $F_IMMED,%al       // Is IMMED flag set?
 531         mov %edi,%eax
 532         jnz 3f                  // If IMMED, jump straight to executing.
 533
 534         jmp 2f
 535
 536 1:      // Not in the dictionary (not a word) so assume it's a number.
 537         call _SNUMBER           // Returns the parsed number in %eax
 538         mov %eax,%ebx
 539         mov $LIT,%eax           // The word is LIT
 540
 541 2:      // Are we compiling or executing?
 542         movl var_STATE,%edx
 543         test %edx,%edx
 544         jz 3f                   // Jump if executing.
 545
 546         // Compiling - just append the word to the current dictionary definition.
 547         call _COMMA
 548         cmp $LIT,%eax           // Was it LIT?
 549         jne 4f
 550         mov %ebx,%eax           // Yes, so LIT is followed by a number.
 551         call _COMMA
 552         NEXT
 553
 554 3:      // Executing - run it!
 555         cmp $LIT,%eax           // Literal?
 556         je 4f
 557         // Not a literal, execute it now.  This never returns, but the codeword will
 558         // eventually call NEXT which will reenter the loop in INTERPRETER.
 559         jmp *(%eax)
 560
 561 4:      // Executing a literal, which means push it on the stack.
 562         push %ebx
 563         NEXT
 564
 565         // NB: SYSEXIT must be the last entry in the built-in dictionary.
 566         defcode SYSEXIT,7,,SYSEXIT
 567         pop %ebx
 568         mov $__NR_exit,%eax
 569         int $0x80
 570
 571 /*----------------------------------------------------------------------
 572  * Input buffer & initial input.
 573  */
 574         .data
 575         .align 4096
 576 buffer:
 577         .ascii "\n\
 578 : '\\n'   10 ;                  \n\
 579 : ')'     41 ;                  \n\
 580 : 'space' 32 ;                  \n\
 581 : '\"'    34 ;                  \n\
 582 : '-'     45 ;                  \n\
 583 : '0'     48 ;                  \n\
 584                                 \n\
 585 \\ CR command                   \n\
 586 : CR '\\n' EMIT ;               \n\
 587                                 \n\
 588 CR CR '0' EMIT CR CR            \n\
 589 "
 590
 591 _initbufftop:
 592         .align 4096
 593 buffend:
 594
 595 currkey:
 596         .int buffer
 597 bufftop:
 598         .int _initbufftop