/* A sometimes minimal FORTH compiler and tutorial for Linux / i386 systems. -*- asm -*-
By Richard W.M. Jones <rich@annexia.org> http://annexia.org/forth
This is PUBLIC DOMAIN (see public domain release statement below).
- $Id: jonesforth.S,v 1.35 2007-09-26 22:55:50 rich Exp $
+ $Id: jonesforth.S,v 1.40 2007-09-29 22:12:07 rich Exp $
gcc -m32 -nostdlib -static -Wl,-Ttext,0 -o jonesforth jonesforth.S
*/
- .set JONES_VERSION,35
+ .set JONES_VERSION,39
/*
INTRODUCTION ----------------------------------------------------------------------
push %ecx
NEXT
+ defcode "?DUP",4,,QDUP // duplicate top of stack if non-zero
+ pop %eax
+ test %eax,%eax
+ jz 1f
+ push %eax
+1: push %eax
+ NEXT
+
defcode "1+",2,,INCR
incl (%esp) // increment top of stack
NEXT
/*
In this FORTH, only /MOD is primitive. Later we will define the / and MOD words in
- terms of the primitive /MOD.
+ terms of the primitive /MOD. The design of the i386 assembly instruction idiv which
+ leaves both quotient and remainder makes this obvious choice.
*/
defcode "/MOD",4,,DIVMOD
*/
defvar "STATE",5,,STATE
defvar "HERE",4,,HERE,user_defs_start
- defvar "LATEST",6,,LATEST,name_SYSEXIT // SYSEXIT must be last in built-in dictionary
+ defvar "LATEST",6,,LATEST,name_SYSCALL3 // SYSCALL3 must be last in built-in dictionary
defvar "_X",2,,TX
defvar "_Y",2,,TY
defvar "_Z",2,,TZ
F_IMMED The IMMEDIATE flag's actual value.
F_HIDDEN The HIDDEN flag's actual value.
F_LENMASK The length mask in the flags/len byte.
+
+ SYS_* and the numeric codes of various Linux syscalls (from <asm/unistd.h>)
*/
+//#include <asm-i386/unistd.h> // you might need this instead
+#include <asm/unistd.h>
+
.macro defconst name, namelen, flags=0, label, value
defcode \name,\namelen,\flags,\label
push $\value
defconst "F_HIDDEN",8,,__F_HIDDEN,F_HIDDEN
defconst "F_LENMASK",9,,__F_LENMASK,F_LENMASK
+ defconst "SYS_EXIT",8,,SYS_EXIT,__NR_exit
+ defconst "SYS_OPEN",8,,SYS_OPEN,__NR_open
+ defconst "SYS_CLOSE",9,,SYS_CLOSE,__NR_close
+ defconst "SYS_READ",8,,SYS_READ,__NR_read
+ defconst "SYS_WRITE",9,,SYS_WRITE,__NR_write
+ defconst "SYS_CREAT",9,,SYS_CREAT,__NR_creat
+
/*
RETURN STACK ----------------------------------------------------------------------
exits the program, which is why when you hit ^D the FORTH system cleanly exits.
*/
-#include <asm-i386/unistd.h>
-
defcode "KEY",3,,KEY
call _KEY
push %eax // push return value on stack
What it does in detail is that it first skips any blanks (spaces, tabs, newlines and so on).
Then it calls KEY to read characters into an internal buffer until it hits a blank. Then it
calculates the length of the word it read and returns the address and the length as
- two words on the stack (with address at the top).
+ two words on the stack (with the length at the top of stack).
Notice that WORD has a single internal buffer which it overwrites each time (rather like
a static C string). Also notice that WORD's internal buffer is just 32 bytes long and
defcode "WORD",4,,WORD
call _WORD
- push %ecx // push length
push %edi // push base address
+ push %ecx // push length
NEXT
_WORD:
*/
defcode "FIND",4,,FIND
- pop %edi // %edi = address
pop %ecx // %ecx = length
+ pop %edi // %edi = address
call _FIND
- push %eax
+ push %eax // %eax = address of dictionary entry (or NULL)
NEXT
_FIND:
NEXT
/*
- PRINTING STRINGS ----------------------------------------------------------------------
+ LITERAL STRINGS ----------------------------------------------------------------------
+
+ LITSTRING is a primitive used to implement the ." and S" operators (which are written in
+ FORTH). See the definition of those operators later.
- LITSTRING and EMITSTRING are primitives used to implement the ." and S" operators
- (which are written in FORTH). See the definition of those operators below.
+ TELL just prints a string. It's more efficient to define this in assembly because we
+ can make it a single Linux syscall.
*/
defcode "LITSTRING",9,,LITSTRING
lodsl // get the length of the string
- push %eax // push it on the stack
push %esi // push the address of the start of the string
+ push %eax // push it on the stack
addl %eax,%esi // skip past the string
addl $3,%esi // but round up to next 4 byte boundary
andl $~3,%esi
NEXT
- defcode "EMITSTRING",10,,EMITSTRING
+ defcode "TELL",4,,TELL
mov $1,%ebx // 1st param: stdout
- pop %ecx // 2nd param: address of string
pop %edx // 3rd param: length of string
+ pop %ecx // 2nd param: address of string
mov $__NR_write,%eax // write syscall
int $0x80
NEXT
// COLD must not return (ie. must not call EXIT).
defword "COLD",4,,COLD
.int INTERPRETER // call the interpreter loop (never returns)
- .int LIT,1,SYSEXIT // hmmm, but in case it does, exit(1).
/* This interpreter is pretty simple, but remember that in FORTH you can always override
* it later with a more powerful one!
CHAR puts the ASCII code of the first character of the following word on the stack. For example
CHAR A puts 65 on the stack.
- SYSEXIT exits the process using Linux exit syscall.
+ SYSCALL3 makes a standard Linux system call. (See <asm/unistd.h> for a list of system call
+ numbers). This is the form to use when the function takes up to three parameters.
- In this FORTH, SYSEXIT must be the last word in the built-in (assembler) dictionary because we
+ In this FORTH, SYSCALL3 must be the last word in the built-in (assembler) dictionary because we
initialise the LATEST variable to point to it. This means that if you want to extend the assembler
- part, you must put new words before SYSEXIT, or else change how LATEST is initialised.
+ part, you must put new words before SYSCALL3, or else change how LATEST is initialised.
*/
defcode "CHAR",4,,CHAR
push %eax // Push it onto the stack.
NEXT
- // NB: SYSEXIT must be the last entry in the built-in dictionary.
- defcode SYSEXIT,7,,SYSEXIT
- pop %ebx
- mov $__NR_exit,%eax
+ defcode "SYSCALL3",8,,SYSCALL3
+ pop %eax // System call number (see <asm/unistd.h>)
+ pop %ebx // First parameter.
+ pop %ecx // Second parameter
+ pop %edx // Third parameter
int $0x80
+ push %eax // Result (negative for -errno)
+ NEXT
/*
START OF FORTH CODE ----------------------------------------------------------------------