Contents of file "f.s"
;# postFORTH - minimal postscript/FORTH bootstrap
;# Copyright (C) 1999 John Comeau <jcomeau@world.std.com>
;#
;# This program is free software; you can redistribute it and/or modify
;# it under the terms of the GNU General Public License as published by
;# the Free Software Foundation; either version 2 of the License, or
;# (at your option) any later version.
;#
;# This program is distributed in the hope that it will be useful,
;# but WITHOUT ANY WARRANTY; without even the implied warranty of
;# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;# GNU General Public License for more details.
;#
;# You should have received a copy of the GNU General Public License
;# along with this program; if not, write to the Free Software
;# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;#
;#Virtual Memory Map:
;#00000000 - 08048000 Reserved
;#08048000 - 08048074 ELF header information
;#08048074 - 0804A000 (Approximately) core dictionary
;#next 4 values dependent on bss_size; they're about right for 0x80000
;#0804A000 - 080816E4 Extensions to dictionary
;#080816E4 - 080C16E4 CAs calculated from hashes of the Forth words
;#080C16E4 - 080C96E8 32K buffer, for block I/O and TIB, followed by null byte
;#080C96E8 - BFFFF604 (Approximately) Reserved (until kernel-assigned stack)
;#BFFFED04 - BFFFF604 Return Stack
;#BFFFF604 - BFFFFE04 Parameter Stack
;#BFFFFE04 - C0000000 Args, environment, other info passed in by Kernel
;#C0000000 - FFFFFFFF Reserved
;#
;#Word structure:
;#Code word LIT starts at 0x8048074:
;# 03 4C 49 54 03 00 00 00 00 81 80 04 08 AD 50 EB 0E
;# 3 L I T 3 00000000 08048081 LODSW;PUSH AX;JMP NEXT
;# Count and word LIT; Back Link; Code Address PFA, runtime LIT code
;#
;#Design goals:
;#1. No more than 400 lines of source, to make it extremely easy to port
;#2. Deferred binding, to make it more like postscript and to allow for
;# top-down design of programs, especially the compiler itself.
;#3. Only the essential words in assembly, meaning that this bootstrap code
;# need not contain any traditional Forth words. As it turns out, it has many.
;#4. No more than 1K compiled size (DOS version).
;#5. Each routine must fit in one DOS EDIT screen, 80*24.
;#6. Self-documenting, making this file the only one necessary.
;#7. Forth words callable in Assembly before coldstart complete.
;# This Forth switches to high level using CALL DOCOL+4; >CODE = back to code
;#8. Optimized for porting ease first, runtime speed second, programming ease
;# third, conformity with standards a distant fourth.
;#
;#Revision History:
;# 8/19/97 could not get it to recognize CRLF as EOL when reading from a file,
;# even after setting cooked mode. So I made the buffer size 4K instead of 1K.
;# 9/14/97 Changed to 32K buffer, made buffersize variable for easier changes.
;# 2000-03-11 now builds dict the right way by pushing all the NFAs on the
;# stack first, then starting at 'LIT'.
;# Count words using the following:
;# grep '^\(create\|constant\|highlevel\|variable\)' f.s | wc
;# 2000-09-29 counted 45, 2 more than I thought!
;#debug=-1 ;#change to zero, or comment out, when debugged.
;#
cellsize=4 ;# 2 for DOS, 4 for linux
const=(cellsize*2)+1 ;# 5 for DOS, 9 for linux
;#
.section .text, "awx", @progbits ;#the 'w' seems to be ignored by ld...
.global _start
.equ _start, cold+cellsize ;# get rid of legacy 'jmp' from FIG-forth
;#All words in this Forth are immediate, and it's stateless,
;# so there's no need for any flag bits or "smudge".
hashbits=15 ;#determines size of dict, (cellsize**hashbits)*2
dictsize=cellsize << hashbits ;#same as (cellsize**hashbits)*2
bitmask=dictsize-1 ;#logical-AND with a number to make it fit dictsize
stacksize=0x800 ;#size for parameter and return stacks
buffersize=0x8000 ;#size of screen/disk block
bss_size = 0x30000 ;#size of data section, must match fixup in Makefile
;#if using Linux stack, leave 0xff00 at end of input buffer for PARSE
buffer=bss_size-buffersize-cellsize ;# add to _edata
9: ;# just so macro doesn't fail on LIT
.macro create label, word
backlink_\label=9b
backlink_lit=0 ;# first word has 0 for backlink
9: .byte 1f-0f
0: .ascii "\word"
1: .byte .-0b
.long backlink_\label
\label: .long .+cellsize ;#primary CA
.endm
;#define how code words will be defined
.macro variable label, word, value ;#variable definition
create \label,\word
call nextword+cellsize ;#leaves address of variable on the stack
.long \value
.endm
.macro constant label, word, value ;#constant definition
create \label, \word
call fetch+cellsize ;#same code as DOCON, so why waste another word?
.long \value
.endm
.macro highlevel label, word ;#colon definition
create \label, \word
call docol+cellsize
.endm
.macro next
jmp nextword+cellsize
.endm
;#
create lit, "LIT"
lodsl ;#get (IP)+
push %eax
next
create nextword, "NEXT" ;#also serves as DOVAR if CALLed
lodsl ;#get CA and advance the pointer
jmp *(%eax) ;#jump to the code procedure that begins every Forth word
create docol, "DOCOL"
sub $cellsize,%ebp ;# make room on return stack
mov %esi,(%ebp) ;#save return address
pop %esi ;#get CA of defined word, most often another DOCOL (!)
next ;#here we go again
create unnest, "\x3bS" ;#high-level return (compiles to ;S aka semis)
mov (%ebp),%esi ;#restore address of caller
add $cellsize,%ebp ;#advance pointer
next
create execute, "EXECUTE"
pop %ebx ;#get address of operation to perform
jmp *(%ebx) ;#go do it
create tocode, ">CODE"
;#( addr -)
mov %esi,%ebx ;#get address of machine code inline with this highlevel word
mov (%ebp),%esi ;#restore address of caller, like ;S
add $cellsize,%ebp ;#adjust return stack
jmp *%ebx ;#jump directly into code routine
create store, "!"
;#( n addr -) ;#store n at addr
pop %ebx
popl (%ebx) ;#get addr into BX, store n at addr
next
create input, "INPUT" ;#similar to Forth EXPECT
mov (bbuf+const),%edx ;#load count and addr from variables
mov (buf+const),%ecx
mov $0x3,%eax ;#sys_READ
xor %ebx,%ebx ;#0 = Standard Input, STDIN
int $0x80 ;#syscall
cmpl $0xfffff001, %eax
jae 1f ;#handle error
or %eax,%eax ;#see if we got anything
jz 1f ;#exit if not
jmp 2f ;#skip to next Forth instruction
1: mov %eax,%ebx ;#exit code
mov $1,%eax ;#_exit syscall
int $0x80 ;#exit
2: next
create count, "COUNT"
;#(cstring - addr count)
pop %ebx ;#get address of counted string
xor %eax,%eax ;#clear count
mov (%ebx),%al ;#get count byte
inc %ebx ;#point past it
push %ebx ;#store address
push %eax
next ;#store count
highlevel index, "INDEX" ;#(cstring - index linkaddr) (index into hashtable)
.long duplicate,count,hash,duplicate,plus,duplicate,plus
.long lit,bitmask,mask,dict,fetch,plus,swap,count,plus,oneplus,unnest
;#hash function uses Andy Lowry's algorithm from Kermit book p.257
create hash, "HASH" ;#(addr count - hash) (hash a counted string)
pop %ecx ;#get count
pop %ebx ;#get address of counted string
xchg %ebx,%esi ;#move it where we can use it best
xor %edi,%edi ;#clear hash accumulator
or %ecx,%ecx ;#can't safely use 16-bit instructions jcxz
jz 2f ;#skip hard part if nothing there
push %ebp ;#save return stack pointer
mov $010201,%ebp ;#use it for multiplier
1: xor %eax,%eax ;#clear MSBs
lodsb ;#get next char
push %eax ;#save it
xor %edi,%eax ;# crc ^ c
and $017,%eax ;# q = (crc ^ c) & 017;
mul %ebp ;# q * 010201
shr $4,%edi ;# crc >> 4
xor %eax,%edi ;# crc = (crc >> 4) ^ (q * 010201);
pop %eax ;#get c back
shr $4,%eax ;#high nybble this time
xor %edi,%eax ;# crc ^ (crc >> 4)
and $017,%eax ;# q = (crc ^ (c >> 4)) & 017;
mul %ebp ;# q * 010201
shr $4,%edi ;# crc >> 4
xor %eax,%edi ;# crc = (crc >> 4) ^ (q * 010201);
loop 1b
pop %ebp ;#restore return stack pointer
2: push %edi
xchg %ebx,%esi
jmp nextword+cellsize
constant buf, "IN", _edata+buffer ;#pointer to input buffer
variable bufptr, ">IN", _edata+buffer ;#offset into buffer, FIG=IN
variable dp, "DP", eod ;#current end of dictionary, HERE
variable latest, "LATEST", enddict ;#NFA of last word defined
variable sp0, "SP0", 0 ;#beginning parameter stack pointer
variable rp0, "RP0", 0 ;#return stack pointer
constant bbuf, "B/BUF", buffersize ;#bytes per block and per screen (same)
constant cell, "CELL", cellsize ;#bytes per word (cell)
constant blank, "S", ' ;#blank, ASCII space character (32, or 20h, forth BL)
constant z, "0", 0 ;#0=stdin
constant one, "1", 1 ;#1=stdout
create oneplus, "1+"
pop %eax ;#get arg to increment
inc %eax ;#do so, then back onto stack
push %eax
next
create fill, "FILL" ;#do NOT make high level, needed by COLD
;# of course that really doesn't matter as long as primary CAs are used
;#(addr n b -)
pop %eax ;# fill character
pop %ecx ;# count
pop %edi ;# start address
rep
stosb ;#fill memory block with fill character
next
create parse, "PARSE" ;#similar to Forth WORD but doesn't need delimiter
;#(- addr) ;#returns address where counted word was stored
mov (bufptr+const),%edi ;#current pointer into buffer space, Forth IN or >IN
mov (blank+const),%al ;# <= space (NUL, TAB, CR, LF, etc) are delimiters
1: scasb ;#go until nondelimiter reached
jnb 1b ;#loop while blank; depends on nonblank before DI wraps around
dec %edi ;#point back to first nondelimiter
cmp $_edata+buffer+buffersize,%edi ;#did we go past buffer?
jb 2f ;#skip if not
mov $_edata+buffer+buffersize,%edi ;#point to null just past buffer
2: mov %edi,%ebx ;#address of string
3: scasb ;#compare to blank
jb 3b ;#loop if nonblank
dec %edi ;#adjust for overshoot
mov %edi,(bufptr+const) ;#update >IN
sub %ebx,%edi ;#calculate byte count...
mov %edi,%eax ;#into AX
mov (dp+const),%edi ;#get HERE location
stosb ;#store count byte
xchg %esi,%ebx ;#save Forth IP while we use SI to store the string
mov %eax,%ecx ;#copy count where it counts
rep
movsb ;#store the string
xchg %esi,%ebx ;#restore IP before we get careless and mess it up
pushl (dp+const) ;#pointer to counted word
next
variable dict, "DICT", _edata+buffer-dictsize ;#buffer for hashes
create cold, "COLD"
mov (sp0+const),%eax ;#check if SP0 already initialized
or %eax,%eax ;#check for 0
jnz 1f ;#skip if already initialized
mov %esp,(sp0+const) ;#save initial SP
mov %esp,%ebp ;#copy into RS pointer
sub $stacksize,%ebp ;#make return stack a safe(?) distance lower
mov %ebp,(rp0+const) ;#save initial return stack pointer
1: mov (sp0+const),%esp ;#set our own stack pointer
mov (rp0+const),%ebp ;#set return stack pointer
movl $0xff00,(__bss_start+bss_size-cellsize) ;#init end of input buffer
call docol+cellsize ;#high level for the next part
.long dict,fetch,lit,dictsize,z,fill ;#init hash table
.long z,latest,fetch ;#push 0 as end marker, start at end of dictionary
2: .long duplicate,zbranch,3f-.,duplicate,index,swap,drop,fetch,branch,2b-.
3: .long drop ;#get rid of null from LIT's backlink
4: .long duplicate,zbranch,5f-. ;#done if reached null
.long index,lit,2*cellsize,plus,swap,store ;#pointer to code in hashtable
.long branch,4b-. ;#loop until null reached
5: .long drop,quit ;#drop the null, launch into query-interpret loop
;# downside to this approach: leaves COLD on return stack
;# upside: now you can redirect QUIT to make a turnkey system
create comma, ","
;#(n - ) ;#compile n at next available location and advance the pointer
mov (dp+const),%ebx ;#next available location into BX
pop (%ebx) ;#store n at HERE
add $cellsize,%ebx ;#advance pointer
mov %ebx,(dp+const) ;#store pointer where it belongs
next
create ccomma, "C,"
;#(b - ) ;# compile byte at next available location and advance pointer
pop %eax ;#get byte to compile
movl (dp+const),%ebx ;#get HERE
mov %al,(%ebx) ;#store the byte
incl (dp+const) ;#update pointer
next
highlevel hexnumber, "16#" ;#input hexadecimal number (as in postscript)
;#( - n) ;#only hexadecimal, 0-9, uppercase A-F
.long parse,tocode
pop %ebx ;#pointer to number
mov (%ebx),%cl ;#get count byte
xor %eax,%eax ;#start off with zero
1: inc %ebx ;#point to next digit
mov (%ebx),%dl ;#grab it
test $0x40,%dl ;#see if letter (assuming only 0-9, A-F)
jz 2f ;#skip if not
sub $7,%dl ;#make "A" = "9" + 1
2: sub $'0,%dl ;#bring it to the correct value
shl $4,%eax ;#will only work on 386 or better
or %dl,%al ;#merge in this digit
loop 1b ;#until done
push %eax
next ;#place converted number on stack
highlevel tick, "'"
;#( - n) ;#take counted string and return number on stack
.long parse ;#count the word and store at end of dictionary
.long index,drop,unnest ;#hash the word and drop the linkword
highlevel quit, "QUIT"
1: .long buf,bbuf,blank,fill ;#clear buffer
.long buf,bufptr,store ;#zero buffer pointer
.long input,interpret,branch,1b-. ;#get and process commands; loop forever
create swap, "SWAP"
;#( n1 n2 - n2 n1) ;#swap top 2 stack items
pop %eax
pop %ebx
push %eax
push %ebx
next
create plus, "+"
;#( n1 n2 - n3) ;#returns n3=n1+n2
pop %ebx
pop %eax
add %ebx,%eax
push %eax
next
create minus, "-"
;#( n1 n2 - n3) ;#returns n3=n1-n2
pop %ebx
pop %eax
sub %ebx,%eax
push %eax
next
create mask, "&"
;#(n1 n2 - n3) ;#returns n3=n1&n2
pop %eax
pop %ebx
and %ebx,%eax
push %eax
next
highlevel interpret, "INTERPRET" ;#stateless, loops forever
1: .long parse,index,drop,execute,branch,1b-. ;#until null or ;S
create null, "\0"
jmp unnest+cellsize
create duplicate, "DUP"
;#( n - n n) ;#duplicate top stack item
pop %eax
push %eax
push %eax
next
create drop, "DROP"
;#( n -) ;#eliminate top stack element
pop %eax
next
create branch, "BRANCH"
add (%esi),%esi ;#update Forth IP
next
create zbranch, "0BRANCH"
pop %eax ;#see if zero on top of stack
or %eax,%eax
jz branch+cellsize ;#if so, join common code with unconditional BRANCH
lodsl ;#else skip the branch offset
next
create fetch, "@"
;#( addr - n)
pop %ebx
pushl (%ebx)
next
create cfetch, "C@"
;#( addr - b)
pop %ebx
xor %eax,%eax ;#clear MSBs
mov (%ebx),%al ;#get byte at pointer
push %eax
next
highlevel here, "HERE"
.long dp, fetch, unnest ;#next compiler location
highlevel bcreate, "[CREATE]" ;#create full header ( - oldCA)
.long here ;#first get current dictionary pointer for LATEST !
.long parse,count,plus,dp,store ;#counted string, first part of header
.long duplicate,count,ccomma,drop ;#store final count byte
.long latest,fetch,comma ;#back pointer to previous word
.long latest,store ;#update latest to point to this word
.long latest,fetch,index,drop,fetch ;#previous CA if any, leave on stack
.long here,lit,cellsize,plus,duplicate,comma ;#first CA
.long latest,fetch,index,drop,store,unnest ;#2nd CA
eod=.
enddict=9b ;#last link in dictionary