checked in start of forth implementation

diff --git a/onward/build.sh b/onward/build.sh
new file mode 100755 (executable)
index 0000000..ecbec0e
--- /dev/null
+++ b/onward/build.sh
@@ -0,0 +1,6 @@
+#!/bin/sh
+
+as -o start.o start.s && \
+as -o onward.o onward.s && \
+ld -o onward start.o onward.o && \
+./onward
\ No newline at end of file

diff --git a/onward/onward.s b/onward/onward.s
new file mode 100644 (file)
index 0000000..5eb7976
--- /dev/null
+++ b/onward/onward.s
@@ -0,0 +1,212 @@
+#-------------------------------------------------
+# External Routine Definitions
+#-------------------------------------------------
+.globl SYS_exit
+.globl SYS_read_byte
+.globl START
+
+#-------------------------------------------------
+# Register Definitions
+#-------------------------------------------------
+.set PC,  %rsi # Program Counter
+.set DSP, %rsp # Stack Pointer
+.set RSP, %rbp # Frame Pointer
+.set ACC, %rax # Accumulator Register
+.set TMP, %rbx # Temporary Register
+
+#-------------------------------------------------
+# Macro Definitions
+#-------------------------------------------------
+.macro PUSHRSP reg
+    lea     -8(RSP), RSP   # push reg on to return stack
+    movq    \reg, (RSP)
+.endm
+
+.macro POPRSP reg
+    movq    (RSP), \reg    # pop top of return stack to reg
+    lea     8(RSP), RSP
+.endm
+
+# Execute next instruction
+.macro NEXT
+    lodsq
+    jmpq       *(ACC)
+.endm
+
+.set F_IMMED,   0x80
+.set F_HIDDEN,  0x20
+.set F_LENMASK, 0x1f
+
+.set link, 0
+
+.macro defconst name, namelen, flags=0, label, value
+defcode \name,\namelen,\flags,\label
+    push $\value
+    NEXT
+.endm
+
+.macro defvar name, namelen, flags=0, label, initial=0
+defcode \name,\namelen,\flags,\label
+    push $var_\name
+    NEXT
+    .data
+    .align 8
+var_\name :
+    .quad \initial
+.endm
+
+# Define a native word
+.macro defcode name, namelen, flags=0, label
+    .data
+    .align 8
+    .globl name_\label
+name_\label :
+    .quad link
+    .set link, name_\label
+    .byte \flags + \namelen
+    .ascii "\name"
+    .globl \label
+\label :
+    .quad code_\label
+    .text
+    .p2align 4, 0x90
+    .globl code_\label
+code_\label :
+    # ... the code goes here ...
+.endm
+
+# Define an interpreted word
+.macro defword name, namelen, flags=0, label
+       .data
+       .align 8
+       .globl name_\label
+name_\label :
+       .quad link
+       .set link, name_\label
+       .byte \flags + \namelen
+       .ascii "\name"
+       .align 8
+       .globl \label
+\label :
+       .quad DOCOL
+    # ...the code goes here...
+.endm
+
+#-------------------------------------------------
+# Global Data
+#-------------------------------------------------
+       .bss
+       .align 4096
+return_stack:
+       .space 8192
+return_stack_top:
+
+#-------------------------------------------------
+# Core Routines
+#-------------------------------------------------
+
+# Main Interpreter Definition
+    .text
+    .globl DOCOL
+    .p2align 4, 0x90
+DOCOL:
+    PUSHRSP PC
+    add ACC, 8
+    mov PC, ACC
+    NEXT
+
+START:
+    cld
+#    mov %rsp, var_S0
+    mov $return_stack_top, RSP
+#    call setup_data_segment
+    mov $COLD_START, PC
+    NEXT
+
+    .data
+    .align 8
+COLD_START:
+    .quad exit
+
+#-------------------------------------------------
+# Builtin Words
+#-------------------------------------------------
+defconst "R0",2,,R0,return_stack_top
+defconst "DOCOL",5,,__DOCOL,DOCOL
+
+defcode "exit",4,,exit
+    call SYS_exit
+
+defword "quit",4,,quit
+       .int R0, rsp_store # R0 RSP!, clear the return stack
+       .int interp        # interpret the next word
+       .int branch, -16   # and loop (indefinitely)
+
+defcode "interp",6,,interp
+    NEXT
+
+#-------------------------------------------------
+# Return Stack Operations
+#-------------------------------------------------
+defcode ">R",2,,to_R
+    pop ACC         # pop parameter stack into %eax
+    PUSHRSP ACC     # push it on to the return stack
+    NEXT
+
+defcode "R>",2,,from_R
+    POPRSP ACC      # pop return stack on to %eax
+    push ACC        # and push on to parameter stack
+    NEXT
+
+defcode "RSP@",4,,rsp_fetch
+    push RSP
+    NEXT
+
+defcode "RSP!",4,,rsp_store
+    pop RSP
+    NEXT
+
+defcode "RDROP",5,,rdrop
+    addq $8, RSP
+    NEXT
+
+
+#-------------------------------------------------
+# Data Stack Operations
+#-------------------------------------------------
+
+defcode "DSP@",4,,dsp_fetch
+    mov DSP, ACC
+    push ACC
+    NEXT
+
+defcode "DSP!",4,,dsp_store
+    pop DSP
+    NEXT
+
+#-------------------------------------------------
+# Branch Operations
+#-------------------------------------------------
+defcode "branch",6,,branch
+       add (PC), PC
+       NEXT
+
+defcode "0branch",7,,zbranch
+       pop ACC
+       test ACC, ACC
+       jz code_branch
+       lodsq
+       NEXT
+
+#-------------------------------------------------
+# Input/Output
+#-------------------------------------------------
+defcode "key",3,,key
+       call SYS_read_byte
+       push ACC
+       NEXT
+
+defcode "emit",4,,emit
+       pop ACC
+       call SYS_write_byte
+       NEXT
\ No newline at end of file

diff --git a/onward/start.s b/onward/start.s
new file mode 100644 (file)
index 0000000..8791c97
--- /dev/null
+++ b/onward/start.s
@@ -0,0 +1,50 @@
+#-------------------------------------------------
+# External Routine Definitions
+#-------------------------------------------------
+.globl SYS_exit
+.globl SYS_read_byte
+.globl SYS_write_byte
+.globl START
+
+#-------------------------------------------------
+# Global Data
+#-------------------------------------------------
+    .data
+    .align 8
+read_dat:
+    .byte 0
+write_dat:
+    .byte 0
+
+#-------------------------------------------------
+# Function Definitions
+#-------------------------------------------------
+    .text
+SYS_read_byte:
+    mov     $0, %rax                # system call 0 is read
+    mov     $0, %rdi                # file handle 0 is stdin
+    mov     $read_dat, %rsi         # address of byte to read
+    mov     $1, %rdx                # number of bytes (1)
+    syscall                         # invoke operating system to do the read
+    ret
+
+SYS_write_byte:
+    mov     $1, %rax                # system call 1 is write
+    mov     $1, %rdi                # file handle 1 is stdout
+    mov     $write_dat, %rsi        # address of byte to write
+    mov     $1, %rdx                # number of bytes (1)
+    syscall                         # invoke operating system to do the write
+    ret
+
+SYS_exit:
+    mov     $60, %rax               # system call 60 is exit
+    xor     %rdi, %rdi              # we want return code 0
+    syscall                         # invoke operating system to exit
+
+    .global _start
+_start:
+    call SYS_read_byte
+    movzbl  read_dat(%rip), %eax
+    movb    %al, write_dat(%rip)
+    call SYS_write_byte
+    jmp START