jonesforth.S.5

   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 /* NEXT macro. */
  10         .macro NEXT
  11         lodsl
  12         jmp *(%eax)
  13         .endm
  14
  15 /* Macros to deal with the return stack. */
  16         .macro PUSHRSP reg
  17         lea -4(%ebp),%ebp       // push reg on to return stack
  18         movl \reg,(%ebp)
  19         .endm
  20
  21         .macro POPRSP reg
  22         mov (%ebp),\reg         // pop top of return stack to reg
  23         lea 4(%ebp),%ebp
  24         .endm
  25
  26 /* ELF entry point. */
  27         .text
  28         .globl _start
  29 _start:
  30         cld
  31         mov $return_stack,%ebp  // Initialise the return stack.
  32
  33         mov $cold_start,%esi    // Initialise interpreter.
  34         NEXT                    // Run interpreter!
  35
  36         .section .rodata
  37 cold_start:                     // High-level code without a codeword.
  38         .int COLD
  39
  40 /* DOCOL - the interpreter! */
  41         .text
  42         .align 4
  43 DOCOL:
  44         PUSHRSP %esi            // push %esi on to the return stack
  45         addl $4,%eax            // %eax points to codeword, so make
  46         movl %eax,%esi          // %esi point to first data word
  47         NEXT
  48
  49 /*----------------------------------------------------------------------
  50  * Fixed sized buffers for everything.
  51  */
  52         .bss
  53
  54 /* FORTH return stack. */
  55 #define RETURN_STACK_SIZE 8192
  56         .align 4096
  57         .space RETURN_STACK_SIZE
  58 return_stack:
  59
  60 /* Space for user-defined words. */
  61 #define USER_DEFS_SIZE 16384
  62         .align 4096
  63 user_defs_start:
  64         .space USER_DEFS_SIZE
  65
  66
  67
  68
  69
  70
  71 /*----------------------------------------------------------------------
  72  * Built-in words defined the long way.
  73  */
  74 #define F_IMMED 0x80
  75 #define F_HIDDEN 0x40
  76
  77         // Store the chain of links.
  78         .set link,0
  79
  80         .macro defcode name, namelen, flags=0, label
  81         .section .rodata
  82         .globl name_\label
  83 name_\label :
  84         .align 4
  85         .byte \flags+\namelen   // flags + length byte
  86         .ascii "\name"          // the name
  87         .align 4
  88         .int link               // link
  89         .set link,name_\label
  90         .globl \label
  91 \label :
  92         .int code_\label        // codeword
  93         .text
  94         .align 4
  95         .globl code_\label
  96 code_\label :                   // assembler code follows
  97         .endm
  98
  99         .macro defword name, namelen, flags=0, label
 100         .section .rodata
 101         .globl name_\label
 102 name_\label :
 103         .align 4
 104         .byte \flags+\namelen   // flags + length byte
 105         .ascii "\name"          // the name
 106         .align 4
 107         .int link               // link
 108         .set link,name_\label
 109         .globl \label
 110 \label :
 111         .int DOCOL              // codeword - the interpreter
 112         // list of word pointers follow
 113         .endm
 114
 115         /* COLD must not return (ie. must not call EXIT). */
 116         defword "COLD",4,,COLD
 117         .int LIT,'<',ECHO,WORD,ECHOWORD,LIT,'>',ECHO,LIT,10,ECHO,RDROP,COLD
 118
 119         defcode "EXIT",4,,EXIT
 120         POPRSP %esi             // pop return stack into %esi
 121         NEXT
 122
 123         defcode "LIT",3,,LIT
 124         // %esi points to the next command, but in this case it points to the next
 125         // literal 32 bit integer.  Get that literal into %eax and increment %esi.
 126         // On x86, it's a convenient single byte instruction!  (cf. NEXT macro)
 127         lodsl
 128         push %eax               // push %eax on to stack
 129         NEXT
 130
 131         defcode "!",1,,STORE
 132         pop %ebx                // address to store at
 133         pop %eax                // data to store there
 134         mov %eax,(%ebx)         // store it
 135         NEXT
 136
 137         defcode "@",1,,FETCH
 138         pop %ebx                // address to fetch
 139         mov (%ebx),%eax         // fetch it
 140         push %eax               // push value onto stack
 141         NEXT
 142
 143         defcode "STATE",5,,STATE
 144         push $v_state
 145         NEXT
 146
 147         defcode "HERE",4,,HERE
 148         push $v_here
 149         NEXT
 150
 151         defcode "LATEST",6,,LATEST
 152         push $v_latest
 153         NEXT
 154
 155         defcode ">R",2,,TOR
 156         pop %eax                // pop parameter stack into %eax
 157         PUSHRSP %eax            // push it on to the return stack
 158         NEXT
 159
 160         defcode "R>",2,,FROMR
 161         POPRSP %eax             // pop return stack on to %eax
 162         push %eax               // and push on to parameter stack
 163         NEXT
 164
 165 #if 0 /* This definition is wrong. */
 166         defcode "R",1,,R
 167         mov %(ebp),%eax         // copy (don't pop) top of return stack to %eax
 168         push %eax               // and push on to parameter stack
 169         NEXT
 170 #endif
 171
 172         defcode "RSP@",4,,RSPFETCH
 173         push %ebp
 174         NEXT
 175
 176         defcode "RSP!",4,,RSPSTORE
 177         pop %ebp
 178         NEXT
 179
 180         defcode "RDROP",5,,RDROP
 181         lea 4(%ebp),%ebp        // pop return stack and throw away
 182         NEXT
 183
 184         defcode "KEY",3,,KEY
 185         call _KEY
 186         push %eax               // push return value on stack
 187         NEXT
 188 _KEY:
 189         mov (currkey),%ebx
 190         cmp (bufftop),%ebx
 191         jge 1f
 192         xor %eax,%eax
 193         mov (%ebx),%al
 194         inc %ebx
 195         mov %ebx,(currkey)
 196         ret
 197 1:
 198         mov $0,%ebx             // out of input, exit (0)
 199         mov $__NR_exit,%eax
 200         int $0x80
 201
 202         defcode "WORD",4,,WORD
 203         /* Search for first non-blank character.  Also skip \ comments. */
 204 1:
 205         call _KEY               // get next key, returned in %eax
 206         cmpb $'\\',%al          // start of a comment?
 207         je 3f                   // if so, skip the comment
 208         cmpb $' ',%al
 209         jbe 1b                  // if so, keep looking
 210
 211         /* Search for the end of the word, storing chars as we go. */
 212         mov $5f,%edi            // pointer to return buffer
 213 2:
 214         stosb                   // add character to return buffer
 215         call _KEY               // get next key, returned in %al
 216         cmpb $' ',%al           // is blank?
 217         ja 2b                   // if not, keep looping
 218
 219         /* Return the word (well, the static buffer) and length. */
 220         sub $5f,%edi
 221         push %edi               // push length
 222         push $5f                // push base address
 223         NEXT
 224
 225         /* Code to skip \ comments to end of the current line. */
 226 3:
 227         call _KEY
 228         cmpb $'\n',%al          // end of line yet?
 229         jne 3b
 230         jmp 1b
 231
 232         .bss
 233         // A static buffer where WORD returns.  Subsequent calls
 234         // overwrite this buffer.  Maximum word length is 32 chars.
 235 5:      .space 32
 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 "ECHOWORD",8,,ECHOWORD
 256         mov $1,%ebx             // 1st param: stdout
 257         pop %ecx                // 2nd param: address of string
 258         pop %edx                // 3rd param: length of string
 259
 260         mov $__NR_write,%eax    // write syscall
 261         int $0x80
 262
 263         NEXT
 264
 265         defcode "DUP",3,,DUP
 266         pop %eax                // duplicate top of stack
 267         push %eax
 268         push %eax
 269         NEXT
 270
 271         defcode "DROP",3,,DROP
 272         pop %eax                // drop top of stack
 273         NEXT
 274
 275         defcode "SWAP",4,,SWAP
 276         pop %eax                // swap top of stack
 277         pop %ebx
 278         push %eax
 279         push %ebx
 280         NEXT
 281
 282 #if 0
 283         defcode ":",1,,COLON
 284         call nextword           // get next word, the procedure name
 285         // The next word is returned in %ebx and has length %ecx bytes.
 286
 287         // Save the current value of VOCAB.
 288         mov v_vocab,%eax
 289         push %eax
 290
 291         // Change VOCAB to point to our new word's header (at LATEST).
 292         mov v_latest,%edi
 293         mov %edi,v_vocab
 294
 295         // We'll start by writing the word's header at LATEST; the header
 296         // is just length byte, the word itself, link pointer.
 297         mov %ecx,(%edi)         // Length byte
 298         inc %edi
 299         mov %ebx,%esi           // Copy the string.
 300         rep movsb
 301         // Round up to the next multiple of 4 so that the link pointer
 302         // is aligned.
 303         or $3,%edi
 304         inc %edi
 305         pop %eax                // Link pointer, points to old VOCAB.
 306         mov %eax,(%edi)
 307         add $4,%edi
 308         // Write the codeword, which for user-defined words is always a
 309         // pointer to the FORTH indirect threaded interpreter.
 310         movl $DOCOL,(%edi)
 311         add $4,%edi
 312
 313         // Finally, update LATEST.  As we go along compiling, we'll be
 314         // writing compiled codewords to the LATEST pointer (and moving
 315         // it along each time).
 316         mov %edi,v_latest
 317
 318         movl $1,v_state         // go into compiling mode
 319         ret
 320
 321         defcode ";",1,F_IMMED,SEMICOLON
 322         // XXX
 323
 324 #endif
 325
 326         defcode SYSEXIT,7,,SYSEXIT
 327         pop %ebx
 328         mov $__NR_exit,%eax
 329         int $0x80
 330
 331 /*----------------------------------------------------------------------
 332  * Variables containing the interpreter's state.
 333  */
 334         .data
 335
 336         .align 4
 337 v_state:
 338         .int 0                  // 0 = immediate, non-zero = compiling
 339 v_latest:
 340         .int name_SYSEXIT       // last word in the dictionary
 341 v_here:
 342         .int user_defs_start    // pointer to next space for user definition or current compiled def
 343
 344 /*----------------------------------------------------------------------
 345  * Input buffer & initial input.
 346  */
 347         .data
 348         .align 4096
 349 buffer:
 350         .ascii "                \n\
 351 \\ Define some constants        \n\
 352 : '\\n'   10 ;                  \n\
 353 : ')'     41 ;                  \n\
 354 : 'space' 32 ;                  \n\
 355 : '\"'    34 ;                  \n\
 356 : '-'     45 ;                  \n\
 357 : '0'     48 ;                  \n\
 358                                 \n\
 359 \\ CR command                   \n\
 360 : CR '\\n' ECHO ;               \n\
 361 "
 362
 363 _initbufftop:
 364         .align 4096
 365 buffend:
 366
 367 currkey:
 368         .int buffer
 369 bufftop:
 370         .int _initbufftop