1 /* A minimal FORTH interpreter for Linux / i386 systems. -*- asm -*-
2 * By Richard W.M. Jones <rich@annexia.org>
4 * gcc -m32 -nostdlib -static -Wl,-Ttext,0 -o jonesforth jonesforth.S
7 #include <asm-i386/unistd.h>
9 /* NOTES----------------------------------------------------------------------
11 Need to say something about $ before constants.
13 And about je/jne/ja/jb/jbe/etc
26 /* Macros to deal with the return stack. */
28 lea -4(%ebp),%ebp // push reg on to return stack
33 mov (%ebp),\reg // pop top of return stack to reg
37 /* ELF entry point. */
42 mov $return_stack,%ebp // Initialise the return stack.
44 mov $cold_start,%esi // Initialise interpreter.
45 NEXT // Run interpreter!
48 cold_start: // High-level code without a codeword.
51 /* DOCOL - the interpreter! */
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
60 /*----------------------------------------------------------------------
61 * Fixed sized buffers for everything.
65 /* FORTH return stack. */
66 #define RETURN_STACK_SIZE 8192
68 .space RETURN_STACK_SIZE
71 /* Space for user-defined words. */
72 #define USER_DEFS_SIZE 16384
82 /*----------------------------------------------------------------------
83 * Built-in words defined the long way.
88 // Store the chain of links.
91 .macro defcode name, namelen, flags=0, label
98 .byte \flags+\namelen // flags + length byte
99 .ascii "\name" // the name
103 .int code_\label // codeword
107 code_\label : // assembler code follows
110 .macro defword name, namelen, flags=0, label
116 .set link,name_\label
117 .byte \flags+\namelen // flags + length byte
118 .ascii "\name" // the name
122 .int DOCOL // codeword - the interpreter
123 // list of word pointers follow
126 /* Some easy ones .... */
128 pop %eax // duplicate top of stack
133 defcode "DROP",4,,DROP
134 pop %eax // drop top of stack
137 defcode "SWAP",4,,SWAP
138 pop %eax // swap top of stack
144 defcode "OVER",4,,OVER
145 mov 4(%esp),%eax // get the second element of stack
146 push %eax // and push it on top
149 /* COLD must not return (ie. must not call EXIT). */
150 defword "COLD",4,,COLD
152 .int WORD,OVER,OVER,ECHOWORD,LIT,'=',ECHO,FIND,DOT
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
163 defcode "EXIT",4,,EXIT
164 POPRSP %esi // pop return stack into %esi
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)
172 push %eax // push %eax on to stack
176 pop %ebx // address to store at
177 pop %eax // data to store there
178 mov %eax,(%ebx) // store it
182 pop %ebx // address to fetch
183 mov (%ebx),%eax // fetch it
184 push %eax // push value onto stack
187 defcode "STATE",5,,STATE
191 defcode "HERE",4,,HERE
195 defcode "LATEST",6,,LATEST
200 pop %eax // pop parameter stack into %eax
201 PUSHRSP %eax // push it on to the return stack
204 defcode "R>",2,,FROMR
205 POPRSP %eax // pop return stack on to %eax
206 push %eax // and push on to parameter stack
209 #if 0 /* This definition is wrong. */
211 mov %(ebp),%eax // copy (don't pop) top of return stack to %eax
212 push %eax // and push on to parameter stack
216 defcode "RSP@",4,,RSPFETCH
220 defcode "RSP!",4,,RSPSTORE
224 defcode "RDROP",5,,RDROP
225 lea 4(%ebp),%ebp // pop return stack and throw away
230 push %eax // push return value on stack
242 mov $0,%ebx // out of input, exit (0)
246 defcode "ECHO",4,,ECHO
251 mov $1,%ebx // 1st param: stdout
253 // write needs the address of the byte to write
255 mov $2f,%ecx // 2nd param: address
257 mov $1,%edx // 3rd param: nbytes = 1
259 mov $__NR_write,%eax // write syscall
264 2: .space 1 // scratch used by ECHO
266 defcode "WORD",4,,WORD
268 push %eax // push length
269 push %ebx // push base address
273 /* Search for first non-blank character. Also skip \ comments. */
275 call _KEY // get next key, returned in %eax
276 cmpb $'\\',%al // start of a comment?
277 je 3f // if so, skip the comment
279 jbe 1b // if so, keep looking
281 /* Search for the end of the word, storing chars as we go. */
282 mov $5f,%edi // pointer to return buffer
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
289 /* Return the word (well, the static buffer) and length. */
291 mov %edi,%eax // return length of the word
292 mov $5f,%ebx // return address of the word
295 /* Code to skip \ comments to end of the current line. */
298 cmpb $'\n',%al // end of line yet?
303 // A static buffer where WORD returns. Subsequent calls
304 // overwrite this buffer. Maximum word length is 32 chars.
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
312 mov $__NR_write,%eax // write syscall
318 pop %eax // Get the number to print into %eax
319 call _DOT // Easier to do this recursively ...
322 /* if eax >= 10 then print (eax / 10)
326 mov $10,%ecx // Base 10
342 defcode "FIND",4,,FIND
343 pop %edi // %edi = address
344 pop %ecx // %ecx = length
346 push %esi // Save %esi so we can use it in string comparison.
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
351 test %edx,%edx // NULL pointer? (end of the linked list)
355 movb 4(%edx),%al // %al = flags+length field
356 andb $0x1f,%al // %al = name length
357 cmpb %cl,%al // Length is the same?
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.
367 jne 2f // Not the same.
369 // The strings are the same - return the header pointer on the stack.
375 mov (%edx),%edx // Move back through the link field to the previous word
376 jmp 1b // .. and loop.
380 xor %eax,%eax // Push zero on to the stack to indicate not found.
386 call nextword // get next word, the procedure name
387 // The next word is returned in %ebx and has length %ecx bytes.
389 // Save the current value of VOCAB.
393 // Change VOCAB to point to our new word's header (at LATEST).
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
401 mov %ebx,%esi // Copy the string.
403 // Round up to the next multiple of 4 so that the link pointer
407 pop %eax // Link pointer, points to old VOCAB.
410 // Write the codeword, which for user-defined words is always a
411 // pointer to the FORTH indirect threaded interpreter.
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).
420 movl $1,v_state // go into compiling mode
423 defcode ";",1,F_IMMED,SEMICOLON
428 defcode SYSEXIT,7,,SYSEXIT
433 /*----------------------------------------------------------------------
434 * Variables containing the interpreter's state.
440 .int 0 // 0 = immediate, non-zero = compiling
442 // XXX should use 'link', but how to join it with name_?
443 .int name_SYSEXIT // last word in the dictionary
445 .int user_defs_start // pointer to next space for user definition or current compiled def
447 /*----------------------------------------------------------------------
448 * Input buffer & initial input.
454 \\ Define some constants \n\
463 : CR '\\n' ECHO ; \n\
465 ECHO DUP DROP OVER \n\