/* A minimal FORTH interpreter for Linux / i386 systems. -*- asm -*- * By Richard W.M. Jones * * gcc -m32 -nostdlib -static -Wl,-Ttext,0 -o jonesforth jonesforth.S */ #include /* 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