/* 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.23 2007-09-23 20:00:58 rich Exp $
+ $Id: jonesforth.S,v 1.26 2007-09-23 23:17:56 rich Exp $
gcc -m32 -nostdlib -static -Wl,-Ttext,0 -o jonesforth jonesforth.S
*/
- .set JONES_VERSION,23
+ .set JONES_VERSION,26
/*
INTRODUCTION ----------------------------------------------------------------------
return_stack: // Initial top of return stack.
/* The user definitions area: space for user-defined words and general memory allocations. */
- .set USER_DEFS_SIZE,16384
+ .set USER_DEFS_SIZE,65536
.align 4096
user_defs_start:
.space USER_DEFS_SIZE
xorl %eax,(%esp)
NEXT
- defcode "INVERT",6,,INVERT // this is the FORTH "NOT" function
+ defcode "INVERT",6,,INVERT // this is the FORTH bitwise "NOT" function
notl (%esp)
NEXT
_Y
_Z
S0 Stores the address of the top of the parameter stack.
+ BASE The current base for printing and reading numbers.
*/
defvar "STATE",5,,STATE
defvar "_Y",2,,TY
defvar "_Z",2,,TZ
defvar "S0",2,,SZ
+ defvar "BASE",4,,BASE,10
/*
BUILT-IN CONSTANTS ----------------------------------------------------------------------
5: .space 32
/*
- . (also called DOT) prints the top of the stack as an integer. In real FORTH implementations
- it should print it in the current base, but this assembler version is simpler and can only
- print in base 10.
-
- Remember that you can override even built-in FORTH words easily, so if you want to write a
- more advanced DOT then you can do so easily at a later point, and probably in FORTH.
+ . (also called DOT) prints the top of the stack as an integer in the current BASE.
*/
defcode ".",1,,DOT
call _DOT // Easier to do this recursively ...
NEXT
_DOT:
- mov $10,%ecx // Base 10
+ mov var_BASE,%ecx // Get current BASE
1:
- cmp %ecx,%eax
+ cmp %ecx,%eax // %eax < BASE? If so jump to print immediately.
jb 2f
xor %edx,%edx // %edx:%eax / %ecx -> quotient %eax, remainder %edx
idivl %ecx
- pushl %edx
+ pushl %edx // Print quotient (top half) first ...
call _DOT
- popl %eax
+ popl %eax // ... then loop to print remainder
jmp 1b
-2:
- xor %ah,%ah
- aam $10
- cwde
- addl $'0',%eax
+2: // %eax < BASE so print immediately.
+ movl $digits,%edx
+ addl %eax,%edx
+ movb (%edx),%al // Note top bits are already zero.
call _EMIT
ret
+ .section .rodata
+digits: .ascii "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
/*
Almost the opposite of DOT (but not quite), SNUMBER parses a numeric string such as one returned
defword ":",1,,COLON
.int CREATE // CREATE the dictionary entry / header
.int LIT, DOCOL, COMMA // Append DOCOL (the codeword).
- .int HIDDEN // Make the word hidden (see below for definition).
+ .int LATEST, FETCH, HIDDEN // Make the word hidden (see below for definition).
.int RBRAC // Go into compile mode.
.int EXIT // Return from the function.
defword ";",1,F_IMMED,SEMICOLON
.int LIT, EXIT, COMMA // Append EXIT (so the word will return).
- .int HIDDEN // Toggle hidden flag -- unhide the word (see below for definition).
+ .int LATEST, FETCH, HIDDEN // Toggle hidden flag -- unhide the word (see below for definition).
.int LBRAC // Go back to IMMEDIATE mode.
.int EXIT // Return from the function.
NEXT
/*
- HIDDEN toggles the other flag, F_HIDDEN, of the latest word. Note that words flagged
- as hidden are defined but cannot be called, so this is only used when you are trying to
- hide the word as it is being defined.
+ 'addr HIDDEN' toggles the hidden flag (F_HIDDEN) of the word defined at addr. To hide the
+ most recently defined word (used above in : and ; definitions) you would do:
+
+ LATEST @ HIDDEN
+
+ Setting this flag stops the word from being found by FIND, and so can be used to make 'private'
+ words. For example, to break up a large word into smaller parts you might do:
+
+ : SUB1 ... subword ... ;
+ : SUB2 ... subword ... ;
+ : SUB3 ... subword ... ;
+ : MAIN ... defined in terms of SUB1, SUB2, SUB3 ... ;
+ WORD SUB1 FIND HIDDEN \ Hide SUB1
+ WORD SUB2 FIND HIDDEN \ Hide SUB2
+ WORD SUB3 FIND HIDDEN \ Hide SUB3
+
+ After this, only MAIN is 'exported' or seen by the rest of the program.
*/
defcode "HIDDEN",6,,HIDDEN
- movl var_LATEST,%edi // LATEST word.
+ pop %edi // Dictionary entry.
addl $4,%edi // Point to name/flags byte.
xorb $F_HIDDEN,(%edi) // Toggle the HIDDEN bit.
NEXT
/*
PRINTING STRINGS ----------------------------------------------------------------------
- LITSTRING and EMITSTRING are primitives used to implement the ." operator (which is
- written in FORTH). See the definition of that operator below.
+ LITSTRING and EMITSTRING are primitives used to implement the ." and S" operators
+ (which are written in FORTH). See the definition of those operators below.
*/
defcode "LITSTRING",9,,LITSTRING
\\ : DUP _X ! _X @ _X @ ;
\\ : DROP _X ! ;
+\\ The built-in . (DOT) function doesn't print a space after the number (unlike the real FORTH word).
+\\ However this is very easily fixed by redefining . (DOT). Any built-in word can be redefined.
+: .
+ . \\ this refers back to the previous definition (but see also RECURSE below)
+ SPACE
+;
+
\\ The 2... versions of the standard operators work on pairs of stack entries. They're not used
\\ very commonly so not really worth writing in assembler. Here is how they are defined in FORTH.
: 2DUP OVER OVER ;
: 2* 2 * ;
: 2/ 2 / ;
-\\ The primitive . (DOT) function doesn't follow with a blank, so redefine it to behave like FORTH.
-\\ Notice how we can trivially redefine existing words. Word definitions are not recursive by
-\\ default, but see below for the RECURSE word.
-: .
- . SPACE \\ call built-in DOT, then print a space.
-;
+\\ Standard words for manipulating BASE.
+: DECIMAL 10 BASE ! ;
+: HEX 16 BASE ! ;
+
+\\ Standard words for booleans.
+: TRUE 1 ;
+: FALSE 0 ;
+: NOT 0= ;
\\ LITERAL takes whatever is on the stack and compiles LIT <foo>
: LITERAL IMMEDIATE
DROP
;
+( c a b WITHIN returns true if a <= c and c < b )
+: WITHIN
+ ROT ( b c a )
+ OVER ( b c a c )
+ <= IF
+ > IF ( b c -- )
+ TRUE
+ ELSE
+ FALSE
+ THEN
+ ELSE
+ 2DROP ( b c -- )
+ FALSE
+ THEN
+;
+
( .S prints the contents of the stack. Very useful for debugging. )
: .S ( -- )
DSP@ ( get current stack pointer )
[NB. The following may be a bit confusing because of the need to use backslash before
each double quote character. The backslashes are there to keep the assembler happy.
They are NOT part of the final output. So here we are defining a function called
- 'dot double-quote' (not 'dot backslash double-quote').]
+ 'S double-quote' (not 'S backslash double-quote').]
+
+ S\" string\" is used in FORTH to define strings. It leaves the address of the string and
+ its length on the stack with the address at the top.
+
+ In compile mode we append
+ LITSTRING <string length> <string rounded up 4 bytes>
+ to the current word. The primitive LITSTRING does the right thing when the current
+ word is executed.
+ In immediate mode there isn't a particularly good place to put the string, but in this
+ case we put the string at HERE (but we _don't_ change HERE). This is meant as a temporary
+ location, likely to be overwritten soon after.
+)
+: S\" IMMEDIATE ( -- len addr )
+ STATE @ IF ( compiling? )
+ ' LITSTRING , ( compile LITSTRING )
+ HERE @ ( save the address of the length word on the stack )
+ 0 , ( dummy length - we don't know what it is yet )
+ BEGIN
+ KEY ( get next character of the string )
+ DUP '\"' <>
+ WHILE
+ HERE @ !b ( store the character in the compiled image )
+ 1 HERE +! ( increment HERE pointer by 1 byte )
+ REPEAT
+ DROP ( drop the double quote character at the end )
+ DUP ( get the saved address of the length word )
+ HERE @ SWAP - ( calculate the length )
+ 4- ( subtract 4 (because we measured from the start of the length word) )
+ SWAP ! ( and back-fill the length location )
+ HERE @ ( round up to next multiple of 4 bytes for the remaining code )
+ 3 +
+ 3 INVERT AND
+ HERE !
+ ELSE ( immediate mode )
+ HERE @ ( get the start address of the temporary space )
+ BEGIN
+ KEY
+ DUP '\"' <>
+ WHILE
+ OVER !b ( save next character )
+ 1+ ( increment address )
+ REPEAT
+ HERE @ - ( calculate the length )
+ HERE @ ( push the start address )
+ THEN
+;
+
+(
.\" is the print string operator in FORTH. Example: .\" Something to print\"
The space after the operator is the ordinary space required between words.
is the natural size for integers on this machine architecture. On this 32 bit machine therefore
CELLS just multiplies the top of stack by 4.
)
-: CELLS 4 * ;
+: CELLS ( n -- n ) 4 * ;
(
So now we can define VARIABLE easily in much the same way as CONSTANT above. Refer to the
THEN
;
+( x +TO VAL adds x to VAL )
+: +TO IMMEDIATE
+ WORD ( get the name of the value )
+ FIND ( look it up in the dictionary )
+ >DFA ( get a pointer to the first data field (the 'LIT') )
+ 4+ ( increment to point at the value )
+ STATE @ IF ( compiling? )
+ ' LIT , ( compile LIT )
+ , ( compile the address of the value )
+ ' +! , ( compile +! )
+ ELSE ( immediate mode )
+ +! ( update it straightaway )
+ THEN
+;
+
(
ID. takes an address of a dictionary entry and prints the word's name.
EMIT ( len addr char -- len addr | and print it)
SWAP 1- ( len addr -- addr len-1 | subtract one from length )
REPEAT
- DROP DROP ( len addr -- )
+ 2DROP ( len addr -- )
+;
+
+(
+ 'WORD word FIND ?HIDDEN' returns true if 'word' is flagged as hidden.
+
+ 'WORD word FIND ?IMMEDIATE' returns true if 'word' is flagged as immediate.
+)
+: ?HIDDEN
+ 4+ ( skip over the link pointer )
+ @b ( get the flags/length byte )
+ F_HIDDEN AND ( mask the F_HIDDEN flag and return it (as a truth value) )
+;
+: ?IMMEDIATE
+ 4+ ( skip over the link pointer )
+ @b ( get the flags/length byte )
+ F_IMMED AND ( mask the F_IMMED flag and return it (as a truth value) )
;
(
WORDS prints all the words defined in the dictionary, starting with the word defined most recently.
+ However it doesn't print hidden words.
The implementation simply iterates backwards from LATEST using the link pointers.
)
BEGIN
DUP 0<> ( while link pointer is not null )
WHILE
- DUP ID. ( print the word )
+ DUP ?HIDDEN NOT IF
+ DUP ID. ( print the word )
+ THEN
SPACE
@ ( dereference the link pointer - go to previous word )
REPEAT
XXX: Because we wrote VARIABLE to store the variable in memory allocated before the word,
in the current implementation VARIABLE FOO FORGET FOO will leak 1 cell of memory.
)
-\\: FORGET
-
-
+: FORGET
+ WORD FIND ( find the word, gets the dictionary entry address )
+ DUP @ LATEST ! ( set LATEST to point to the previous word )
+ HERE ! ( and store HERE with the dictionary address )
+;
-( While compiling, [COMPILE] WORD compiles WORD if it would otherwise be IMMEDIATE. )
+(
+ While compiling, '[COMPILE] word' compiles 'word' if it would otherwise be IMMEDIATE.
+)
: [COMPILE] IMMEDIATE
WORD ( get the next word )
FIND ( find it in the dictionary )
, ( compile it )
;
+(
+ DUMP is used to dump out the contents of memory, in the 'traditional' hexdump format.
+)
+: DUMP ( addr len -- )
+ BASE @ ROT ( save the current BASE at the bottom of the stack )
+ HEX ( and switch the hexadecimal mode )
+
+ BEGIN
+ DUP 0> ( while len > 0 )
+ WHILE
+ OVER . ( print the address )
+ SPACE
+
+ ( print up to 16 words on this line )
+ 2DUP ( addr len addr len )
+ 1- 15 AND 1+ ( addr len addr linelen )
+ BEGIN
+ DUP 0> ( while linelen > 0 )
+ WHILE
+ SWAP ( addr len linelen addr )
+ DUP @b ( addr len linelen addr byte )
+ . SPACE ( print the byte )
+ 1+ SWAP 1- ( addr len linelen addr -- addr len addr+1 linelen-1 )
+ REPEAT
+ 2DROP ( addr len )
+
+ ( print the ASCII equivalents )
+ 2DUP 1- 15 AND 1+ ( addr len addr linelen )
+ BEGIN
+ DUP 0> ( while linelen > 0)
+ WHILE
+ SWAP ( addr len linelen addr )
+ DUP @b ( addr len linelen addr byte )
+ DUP 32 128 WITHIN IF ( 32 <= c < 128? )
+ EMIT
+ ELSE
+ DROP [ CHAR ? ] LITERAL EMIT
+ THEN
+ 1+ SWAP 1- ( addr len linelen addr -- addr len addr+1 linelen-1 )
+ REPEAT
+ 2DROP ( addr len )
+ CR
+
+ DUP 1- 15 AND 1+ ( addr len linelen )
+ DUP ( addr len linelen linelen )
+ ROT ( addr linelen len linelen )
+ - ( addr linelen len-linelen )
+ ROT ( len-linelen addr linelen )
+ + ( len-linelen addr+linelen )
+ SWAP ( addr-linelen len-linelen )
+ REPEAT
+
+ 2DROP ( restore stack )
+ BASE ! ( restore saved BASE )
+;
+
( Finally print the welcome prompt. )
.\" JONESFORTH VERSION \" VERSION . CR
.\" OK \"
git.annexia.org / jonesforth.git / blobdiff