jonesforth.S.6

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