/*
proof of concept code...
direct subroutine-threaded forth
note that this is not the same as subroutine-threaded,
which would be the equivalent of a C program...
the only difference between this and direct threading is that
it uses 'call' instead of 'jmp'
*/
 .equ cellsize, 4
docol:
 popl %eax /* return address will point to the highlevel forth code... */
 pushl %esi /* save any existing codestream address */
 movl %eax,%esi /* use new one */
 /* falls through to next - don't put anything in between! */
next:
 lodsl /* of which we get the first word */
 call *%eax /* and call it... */
 jmp next
unnest: /* ;s or semis, gets you out of the endless NEXT loop */
 popl %esi /* throwaway the return address to 'jmp next' */
 popl %esi /* get previous codestream address */
 ret /* to the previous 'jmp next' */
/*
now how does this work? say you have a function ave that averages 2 numbers;
it calls function + to add them, and then 2 / to get the average. so,
 : AVE ' + , 10# 2 LIT, ' / , ;
in memory it will be the 'call docol', then the code address of +, the code
address of LIT, the number 2, the code address of /, and the code address of
semis, or unnest. let's also assume, for the sake of simplicity, that this is
the only thing your program does, so that right after coldstart this is what
is called. now let's define the other words so we can follow the action:
*/
plus: /* + */
 subl $cellsize,%edi
 movl (%edi),%eax
 addl %eax,-cellsize(%edi)
 ret
lit:
 lodsl /* get next number out of instruction stream */
 stosl /* place it on the data stack */
 ret
divide: /* / */
 movl -cellsize*2(%edi),%eax /* get divisor off data stack */
 movl -cellsize(%edi),%ebx /* dividend from top of stack */
 subl $cellsize*2,%edi /* adjust data stack pointer */
 clrl %edx
 divl %ebx
 stosl /* quotient on data stack */
 ret
/*
ok, so here we go, the data stack has on it a 4 and an 8, (presumably put there
during coldstart from argv) and ave is called (or jumped to) from coldstart.
let's assume it's been called, so that the return stack (the actual machine
stack of the x86) has on it the pointer to the end of the coldstart routine,
which would probably be a 'RET' to the operating system (yes, that works with
windows xp, and eax will go into errorlevel).
the next thing that happens is that DOCOL is called, and we are launched into
the endless NEXT loop.
hmm, wait a minute. these are all lowlevel words except for AVE itself. that
means that this proof-of-concept won't actually prove this interpreter will
work correctly; let's make another highlevel word to be incorporated into AVE:
 : NOP ; # this will just compile into a call to docol followed by unnest...
...but that's good enough for our purposes. we'll insert the NOP into the
definition for AVE right from the get-go:
 : AVE ' NOP , ' + , 10# 2 LIT, ' / , ;
so now here we are that NEXT has just called the first highlevel word it
found in AVE, which is of course NOP; since NOP in turn calls DOCOL as its
first action, you'll see the interaction of the return stack (%esp functions
as both the machine stack and the highlevel return stack), the data stream
(pointed to by %esi) and the data stack (pointed to by %edi). use 'gdb proof_s'
to observe what happens; .gdbinit should already be present in this directory.
*/
nop:
 call docol
 .long unnest
ave:
 call docol
 .long nop,plus,lit,2,divide,unnest
cold:
 movl $data,%edi
 /* for speed comparisons, enable this following line (and below) */
 .ifdef REPS
 mov $REPS,%ecx /* repeat count */
 .endif
10:
 movl $4,%eax
 stosl
 movl $8,%eax
 stosl
 call ave
 /* return the average in errorlevel */
 movl -cellsize(%edi),%eax
 subl $cellsize,%edi
 /* for speed comparisons, enable this following line (and above) */
 .ifdef REPS
 loop 10b
 .endif
 .ifeq OS-1
 mov %eax,%ebx
 mov $1,%eax /* Unix exit call */
 int $0x80
 .else
 ret
 .endif
 .bss
data:
 .skip 1024, 0  /* make sure at least this much return stack space */
 .ifeq OS-2
 imagebase = 0x400000  /* surely there's a better way? */
 .section .idata
 /* w2k seems to require a valid import descriptor
    whether you want one or not... XP doesn't seem to care
 */
 .long 0, 0, 0, 1f-imagebase, 2f-imagebase
 .long 0, 0, 0, 0, 0  /* null array ends table */
1:
 .asciz "KERNEL32.DLL"
2:
 .long 3f-imagebase, 0
3:
 .word 0
 .asciz "ExitProcess"
 .endif
 .global _mainCRTStartup, _start
 .equ _mainCRTStartup, cold /* for windows */
 .equ _start, cold /* for linux */