jonesforth.S.7

   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 0x40
  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         /* Some easy ones .... */
 127         defcode "DUP",3,,DUP
 128         pop %eax                // duplicate top of stack
 129         push %eax
 130         push %eax
 131         NEXT
 132
 133         defcode "DROP",4,,DROP
 134         pop %eax                // drop top of stack
 135         NEXT
 136
 137         defcode "SWAP",4,,SWAP
 138         pop %eax                // swap top of stack
 139         pop %ebx
 140         push %eax
 141         push %ebx
 142         NEXT
 143
 144         defcode "OVER",4,,OVER
 145         mov 4(%esp),%eax        // get the second element of stack
 146         push %eax               // and push it on top
 147         NEXT
 148
 149         /* COLD must not return (ie. must not call EXIT). */
 150         defword "COLD",4,,COLD
 151         .int LIT,'<',ECHO
 152         .int WORD,OVER,OVER,ECHOWORD,LIT,'=',ECHO,FIND,DOT
 153         .int LIT,'>',ECHO
 154         .int LIT,10,ECHO
 155         .int RDROP,COLD
 156
 157 /*
 158 This prints out each word in the input as <word>\n
 159         defword "COLD",4,,COLD
 160         .int LIT,'<',ECHO,WORD,ECHOWORD,LIT,'>',ECHO,LIT,10,ECHO,RDROP,COLD
 161 */
 162
 163         defcode "EXIT",4,,EXIT
 164         POPRSP %esi             // pop return stack into %esi
 165         NEXT
 166
 167         defcode "LIT",3,,LIT
 168         // %esi points to the next command, but in this case it points to the next
 169         // literal 32 bit integer.  Get that literal into %eax and increment %esi.
 170         // On x86, it's a convenient single byte instruction!  (cf. NEXT macro)
 171         lodsl
 172         push %eax               // push %eax on to stack
 173         NEXT
 174
 175         defcode "!",1,,STORE
 176         pop %ebx                // address to store at
 177         pop %eax                // data to store there
 178         mov %eax,(%ebx)         // store it
 179         NEXT
 180
 181         defcode "@",1,,FETCH
 182         pop %ebx                // address to fetch
 183         mov (%ebx),%eax         // fetch it
 184         push %eax               // push value onto stack
 185         NEXT
 186
 187         defcode "STATE",5,,STATE
 188         push $v_state
 189         NEXT
 190
 191         defcode "HERE",4,,HERE
 192         push $v_here
 193         NEXT
 194
 195         defcode "LATEST",6,,LATEST
 196         push $v_latest
 197         NEXT
 198
 199         defcode ">R",2,,TOR
 200         pop %eax                // pop parameter stack into %eax
 201         PUSHRSP %eax            // push it on to the return stack
 202         NEXT
 203
 204         defcode "R>",2,,FROMR
 205         POPRSP %eax             // pop return stack on to %eax
 206         push %eax               // and push on to parameter stack
 207         NEXT
 208
 209 #if 0 /* This definition is wrong. */
 210         defcode "R",1,,R
 211         mov %(ebp),%eax         // copy (don't pop) top of return stack to %eax
 212         push %eax               // and push on to parameter stack
 213         NEXT
 214 #endif
 215
 216         defcode "RSP@",4,,RSPFETCH
 217         push %ebp
 218         NEXT
 219
 220         defcode "RSP!",4,,RSPSTORE
 221         pop %ebp
 222         NEXT
 223
 224         defcode "RDROP",5,,RDROP
 225         lea 4(%ebp),%ebp        // pop return stack and throw away
 226         NEXT
 227
 228         defcode "KEY",3,,KEY
 229         call _KEY
 230         push %eax               // push return value on stack
 231         NEXT
 232 _KEY:
 233         mov (currkey),%ebx
 234         cmp (bufftop),%ebx
 235         jge 1f
 236         xor %eax,%eax
 237         mov (%ebx),%al
 238         inc %ebx
 239         mov %ebx,(currkey)
 240         ret
 241 1:
 242         mov $0,%ebx             // out of input, exit (0)
 243         mov $__NR_exit,%eax
 244         int $0x80
 245
 246         defcode "ECHO",4,,ECHO
 247         pop %eax
 248         call _ECHO
 249         NEXT
 250 _ECHO:
 251         mov $1,%ebx             // 1st param: stdout
 252
 253         // write needs the address of the byte to write
 254         mov %al,(2f)
 255         mov $2f,%ecx            // 2nd param: address
 256
 257         mov $1,%edx             // 3rd param: nbytes = 1
 258
 259         mov $__NR_write,%eax    // write syscall
 260         int $0x80
 261         ret
 262
 263         .bss
 264 2:      .space 1                // scratch used by ECHO
 265
 266         defcode "WORD",4,,WORD
 267         call _WORD
 268         push %eax               // push length
 269         push %ebx               // push base address
 270         NEXT
 271
 272 _WORD:
 273         /* Search for first non-blank character.  Also skip \ comments. */
 274 1:
 275         call _KEY               // get next key, returned in %eax
 276         cmpb $'\\',%al          // start of a comment?
 277         je 3f                   // if so, skip the comment
 278         cmpb $' ',%al
 279         jbe 1b                  // if so, keep looking
 280
 281         /* Search for the end of the word, storing chars as we go. */
 282         mov $5f,%edi            // pointer to return buffer
 283 2:
 284         stosb                   // add character to return buffer
 285         call _KEY               // get next key, returned in %al
 286         cmpb $' ',%al           // is blank?
 287         ja 2b                   // if not, keep looping
 288
 289         /* Return the word (well, the static buffer) and length. */
 290         sub $5f,%edi
 291         mov %edi,%eax           // return length of the word
 292         mov $5f,%ebx            // return address of the word
 293         ret
 294
 295         /* Code to skip \ comments to end of the current line. */
 296 3:
 297         call _KEY
 298         cmpb $'\n',%al          // end of line yet?
 299         jne 3b
 300         jmp 1b
 301
 302         .bss
 303         // A static buffer where WORD returns.  Subsequent calls
 304         // overwrite this buffer.  Maximum word length is 32 chars.
 305 5:      .space 32
 306
 307         defcode "ECHOWORD",8,,ECHOWORD
 308         mov $1,%ebx             // 1st param: stdout
 309         pop %ecx                // 2nd param: address of string
 310         pop %edx                // 3rd param: length of string
 311
 312         mov $__NR_write,%eax    // write syscall
 313         int $0x80
 314
 315         NEXT
 316
 317         defcode ".",1,,DOT
 318         pop %eax                // Get the number to print into %eax
 319         call _DOT               // Easier to do this recursively ...
 320         NEXT
 321
 322 /*      if eax >= 10 then print (eax / 10)
 323         r = eax mod 10
 324         echo r */
 325 _DOT:
 326         mov $10,%ecx            // Base 10
 327         cmp %ecx,%eax
 328         jb 1f
 329         pushl %eax
 330         xor %edx,%edx
 331         idivl %ecx
 332         call _DOT
 333         popl %eax
 334 1:
 335         aam $10
 336         cbw
 337         cwde
 338         addl $'0',%eax
 339         call _ECHO
 340         ret
 341
 342         defcode "FIND",4,,FIND
 343         pop %edi                // %edi = address
 344         pop %ecx                // %ecx = length
 345
 346         push %esi               // Save %esi so we can use it in string comparison.
 347
 348         // Now we start searching backwards through the dictionary for this word.
 349         mov v_latest,%edx       // LATEST points to name header of the latest word in the dictionary
 350 1:
 351         test %edx,%edx          // NULL pointer?  (end of the linked list)
 352         je 4f
 353
 354         xor %eax,%eax
 355         movb 4(%edx),%al        // %al = flags+length field
 356         andb $0x1f,%al          // %al = name length
 357         cmpb %cl,%al            // Length is the same?
 358         jne 2f
 359
 360         // Compare the strings in detail.
 361         push %ecx               // Save the length
 362         push %edi               // Save the address (repe cmpsb will move this pointer)
 363         lea 5(%edx),%esi        // Dictionary string we are checking against.
 364         repe cmpsb              // Compare the strings.
 365         pop %edi
 366         pop %ecx
 367         jne 2f                  // Not the same.
 368
 369         // The strings are the same - return the header pointer on the stack.
 370         pop %esi
 371         push %edx
 372         NEXT
 373
 374 2:
 375         mov (%edx),%edx         // Move back through the link field to the previous word
 376         jmp 1b                  // .. and loop.
 377
 378 4:      // Not found.
 379         pop %esi
 380         xor %eax,%eax           // Push zero on to the stack to indicate not found.
 381         push %eax
 382         NEXT
 383
 384 #if 0
 385         defcode ":",1,,COLON
 386         call nextword           // get next word, the procedure name
 387         // The next word is returned in %ebx and has length %ecx bytes.
 388
 389         // Save the current value of VOCAB.
 390         mov v_vocab,%eax
 391         push %eax
 392
 393         // Change VOCAB to point to our new word's header (at LATEST).
 394         mov v_latest,%edi
 395         mov %edi,v_vocab
 396
 397         // We'll start by writing the word's header at LATEST; the header
 398         // is just length byte, the word itself, link pointer.
 399         mov %ecx,(%edi)         // Length byte
 400         inc %edi
 401         mov %ebx,%esi           // Copy the string.
 402         rep movsb
 403         // Round up to the next multiple of 4 so that the link pointer
 404         // is aligned.
 405         or $3,%edi
 406         inc %edi
 407         pop %eax                // Link pointer, points to old VOCAB.
 408         mov %eax,(%edi)
 409         add $4,%edi
 410         // Write the codeword, which for user-defined words is always a
 411         // pointer to the FORTH indirect threaded interpreter.
 412         movl $DOCOL,(%edi)
 413         add $4,%edi
 414
 415         // Finally, update LATEST.  As we go along compiling, we'll be
 416         // writing compiled codewords to the LATEST pointer (and moving
 417         // it along each time).
 418         mov %edi,v_latest
 419
 420         movl $1,v_state         // go into compiling mode
 421         ret
 422
 423         defcode ";",1,F_IMMED,SEMICOLON
 424         // XXX
 425
 426 #endif
 427
 428         defcode SYSEXIT,7,,SYSEXIT
 429         pop %ebx
 430         mov $__NR_exit,%eax
 431         int $0x80
 432
 433 /*----------------------------------------------------------------------
 434  * Variables containing the interpreter's state.
 435  */
 436         .data
 437
 438         .align 4
 439 v_state:
 440         .int 0                  // 0 = immediate, non-zero = compiling
 441 v_latest:
 442                                 // XXX should use 'link', but how to join it with name_?
 443         .int name_SYSEXIT       // last word in the dictionary
 444 v_here:
 445         .int user_defs_start    // pointer to next space for user definition or current compiled def
 446
 447 /*----------------------------------------------------------------------
 448  * Input buffer & initial input.
 449  */
 450         .data
 451         .align 4096
 452 buffer:
 453         .ascii "                \n\
 454 \\ Define some constants        \n\
 455 : '\\n'   10 ;                  \n\
 456 : ')'     41 ;                  \n\
 457 : 'space' 32 ;                  \n\
 458 : '\"'    34 ;                  \n\
 459 : '-'     45 ;                  \n\
 460 : '0'     48 ;                  \n\
 461                                 \n\
 462 \\ CR command                   \n\
 463 : CR '\\n' ECHO ;               \n\
 464                                 \n\
 465 ECHO DUP DROP OVER              \n\
 466 "
 467
 468 _initbufftop:
 469         .align 4096
 470 buffend:
 471
 472 currkey:
 473         .int buffer
 474 bufftop:
 475         .int _initbufftop