+++ /dev/null
-/* A minimal FORTH interpreter for Linux / i386 systems. -*- asm -*-
- * By Richard W.M. Jones <rich@annexia.org>
- *
- * gcc -m32 -nostdlib -static -Wl,-Ttext,0 -o jonesforth jonesforth.S
- */
-
-#include <asm-i386/unistd.h>
-
-/* NEXT macro. */
- .macro NEXT
- lodsl
- jmp *(%eax)
- .endm
-
-/* Macros to deal with the return stack. */
- .macro PUSHRSP reg
- .endm
-
- .macro POPRSP reg
- .endm
-
-/* ELF entry point. */
- .text
- .globl _start
-_start:
- cld
- mov $return_stack,%ebp // Initialise the return stack.
-
- mov $cold_start,%esi // Initialise interpreter.
- NEXT // Run interpreter!
-
- .section .rodata
-cold_start: // High-level code without a codeword.
- .int COLD
-
-/* DOCOL - the interpreter! */
- .text
- .align 4
-DOCOL:
- lea -4(%ebp),%ebp // push %esi on to the return stack
- movl %esi,(%ebp)
-
- addl $4,%eax // %eax points to codeword, so make
- movl %eax,%esi // %esi point to first data word
- NEXT
-
-/*----------------------------------------------------------------------
- * Fixed sized buffers for everything.
- */
- .bss
-
-/* FORTH return stack. */
-#define RETURN_STACK_SIZE 8192
- .align 4096
- .space RETURN_STACK_SIZE
-return_stack:
-
-/* Space for user-defined words. */
-#define USER_DEFS_SIZE 16384
- .align 4096
-user_defs_start:
- .space USER_DEFS_SIZE
-
-
-
-
-
-
-/*----------------------------------------------------------------------
- * Built-in words defined the long way.
- */
-#define F_IMMED 0x80
-#define F_HIDDEN 0x40
-
- // Store the chain of links.
- .set link,0
-
- .macro defcode name, namelen, flags=0, label
- .section .rodata
-N_\label :
- .align 4
- .byte \flags+\namelen // flags + length byte
- .ascii "\name" // the name
- .align 4
- .int link // link
- .set link,N_\label
-\label :
- .int 1f // codeword
- .text
- .align 4
-1: // assembler code follows
- .endm
-
- .macro defword name, namelen, flags=0, label
- .section .rodata
-N_\label :
- .align 4
- .byte \flags+\namelen // flags + length byte
- .ascii "\name" // the name
- .align 4
- .int link // link
- .set link,N_\label
-\label :
- .int DOCOL // codeword - the interpreter
- // list of word pointers follow
- .endm
-
- /* COLD must not return (ie. must not call EXIT). */
- defword "COLD",4,,COLD
- .int KEY,ECHO,RDROP,COLD
-
- defcode "EXIT",4,,EXIT
- movl (%ebp),%esi // pop return stack into %esi
- lea 4(%ebp),%ebp
- NEXT
-
- defcode "!",1,,STORE
- pop %ebx // address to store at
- pop %eax // data to store there
- mov %eax,(%ebx) // store it
- NEXT
-
- defcode "@",1,,FETCH
- pop %ebx // address to fetch
- mov (%ebx),%eax // fetch it
- push %eax // push value onto stack
- NEXT
-
- defcode "STATE",5,,STATE
- push $v_state
- NEXT
-
- defcode "HERE",4,,HERE
- push $v_here
- NEXT
-
- defcode "LATEST",6,,LATEST
- push $v_latest
- NEXT
-
- defcode ">R",2,,TOR
- pop %eax // pop parameter stack into %eax
- lea -4(%ebp),%ebp // push %eax on to return stack
- movl %eax,(%ebp)
- NEXT
-
- defcode "R>",2,,FROMR
- mov (%ebp),%eax // pop top of return stack to %eax
- lea 4(%ebp),%ebp
- push %eax // and push on to parameter stack
- NEXT
-
-#if 0 /* This definition is wrong. */
- defcode "R",1,,R
- mov %(ebp),%eax // copy (don't pop) top of return stack to %eax
- push %eax // and push on to parameter stack
- NEXT
-#endif
-
- defcode "RSP@",4,,RSPFETCH
- push %ebp
- NEXT
-
- defcode "RSP!",4,,RSPSTORE
- pop %ebp
- NEXT
-
- defcode "RDROP",5,,RDROP
- lea 4(%ebp),%ebp // pop the return stack
- NEXT
-
- defcode "KEY",3,,KEY
- mov (currkey),%ebx
- cmp (bufftop),%ebx
- jge 1f
- xor %eax,%eax
- mov (%ebx),%al
- push %eax
- inc %ebx
- mov %ebx,(currkey)
- NEXT
-1:
- mov $0,%ebx // out of input, exit (0)
- mov $__NR_exit,%eax
- int $0x80
-
- defcode "ECHO",4,,ECHO
- mov $1,%ebx // 1st param: stdout
-
- // write needs the address of the byte to write
- pop %eax
- mov %al,(2f)
- mov $2f,%ecx // 2nd param: address
-
- mov $1,%edx // 3rd param: nbytes = 1
-
- mov $__NR_write,%eax // write syscall
- int $0x80
-
- NEXT
-
- .bss
-2: .space 1 // scratch used by ECHO
-
- defcode "DUP",3,,DUP
- pop %eax // duplicate top of stack
- push %eax
- push %eax
- NEXT
-
- defcode "DROP",3,,DROP
- pop %eax // drop top of stack
- NEXT
-
- defcode "SWAP",4,,SWAP
- pop %eax // swap top of stack
- pop %ebx
- push %eax
- push %ebx
- NEXT
-
-#if 0
- defcode ":",1,,COLON
- call nextword // get next word, the procedure name
- // The next word is returned in %ebx and has length %ecx bytes.
-
- // Save the current value of VOCAB.
- mov v_vocab,%eax
- push %eax
-
- // Change VOCAB to point to our new word's header (at LATEST).
- mov v_latest,%edi
- mov %edi,v_vocab
-
- // We'll start by writing the word's header at LATEST; the header
- // is just length byte, the word itself, link pointer.
- mov %ecx,(%edi) // Length byte
- inc %edi
- mov %ebx,%esi // Copy the string.
- rep movsb
- // Round up to the next multiple of 4 so that the link pointer
- // is aligned.
- or $3,%edi
- inc %edi
- pop %eax // Link pointer, points to old VOCAB.
- mov %eax,(%edi)
- add $4,%edi
- // Write the codeword, which for user-defined words is always a
- // pointer to the FORTH indirect threaded interpreter.
- movl $DOCOL,(%edi)
- add $4,%edi
-
- // Finally, update LATEST. As we go along compiling, we'll be
- // writing compiled codewords to the LATEST pointer (and moving
- // it along each time).
- mov %edi,v_latest
-
- movl $1,v_state // go into compiling mode
- ret
-
- defcode ";",1,F_IMMED,SEMICOLON
- // XXX
-
-#endif
-
- defcode SYSEXIT,7,,SYSEXIT
- pop %ebx
- mov $__NR_exit,%eax
- int $0x80
-
-/*----------------------------------------------------------------------
- * Variables containing the interpreter's state.
- */
- .data
-
- .align 4
-v_state:
- .int 0 // 0 = immediate, non-zero = compiling
-v_latest:
- .int N_SYSEXIT // last word in the dictionary
-v_here:
- .int user_defs_start // pointer to next space for user definition or current compiled def
-
-/*----------------------------------------------------------------------
- * Input buffer & initial input.
- */
- .data
- .align 4096
-buffer:
- .ascii " \n\
-\\ Define some constants \n\
-: '\\n' 10 ; \n\
-: ')' 41 ; \n\
-: 'space' 32 ; \n\
-: '\"' 34 ; \n\
-: '-' 45 ; \n\
-: '0' 48 ; \n\
- \n\
-\\ CR command \n\
-: CR '\\n' ECHO ; \n\
-"
-
-_initbufftop:
- .align 4096
-buffend:
-
-currkey:
- .int buffer
-bufftop:
- .int _initbufftop