~nch/onward

d5b722f4e590d70b7c02cb40bb9fedd8a6550d07 — nc 4 years ago fba7b21 master
wrote getword routine, and fixed data/return stack
1 files changed, 109 insertions(+), 29 deletions(-)

M onward.s
M onward.s => onward.s +109 -29
@@ 3,10 3,12 @@ use64
format ELF64
public start as '_start'

; RSP = data stack
; RSP = return stack
; RBP = data stack
; RSI = virtual instruction stream

;; system calls
SYS_READ = 0
SYS_WRITE = 1
SYS_EXIT = 60



@@ 14,30 16,35 @@ SYS_EXIT = 60
STDIN = 0
STDOUT = 1

DEBUG = 1

;;

ADDR_SIZE = 8

macro defcode name {
    align ADDR_SIZE
    public name
    align ADDR_SIZE ; not sure if i need this
name:
}

macro defword wordname {
    align ADDR_SIZE
    public wordname
    align ADDR_SIZE ; or this...
wordname:
    jmp docol
}

;; push/pop data stack
macro pushd r {
    lea rsp, [rsp + ADDR_SIZE]
    mov [rsp], r
    lea rbp, [rbp + ADDR_SIZE]
    mov [rbp], r
}

; TODO: add safety check
macro popd r {
    mov r, [rsp]
    lea rsp, [rsp - ADDR_SIZE]
    mov r, [rbp]
    lea rbp, [rbp - ADDR_SIZE]
}

;; interpret next instruction pointed to by RSI


@@ 49,7 56,9 @@ macro next {

IMMEDIATE = 0
COMPILE = 1
var_STATE: db IMMEDIATE
STATE: db IMMEDIATE

KEY: db 0

section '.text' ; readable executable



@@ 59,97 68,168 @@ docol:
    mov rsi, rax
    next

    defcode drop
defcode drop
    popd rax
    next

    defcode exitword
defcode exitword
    pop rsi
    next

    defcode swap
defcode swap
    popd rax
    popd rbx
    pushd rbx
    pushd rax
    next

    defcode sdup
defcode sdup
    popd rax
    pushd rax
    pushd rax
    next

    defcode lit
defcode lit
    mov rax, [rsi]
    pushd rax
    lea rsi, [rsi + ADDR_SIZE]
    next

    defcode lbrac
    mov [var_STATE], byte IMMEDIATE
defcode lbrac
    mov [STATE], byte IMMEDIATE
    next

    defcode rbrac
    mov [var_STATE], byte COMPILE
defcode rbrac
    mov [STATE], byte COMPILE
    next

    defcode emit
defcode emit
    mov r8, rsi ; backup rsi since we'll clobber it
    mov rax, SYS_WRITE
    mov rdi, STDOUT
    lea rsi, [rsp]
    lea rsi, [rbp]
    mov rdx, 1
    syscall
    popd rax
    mov rsi, r8 ; restore rsi
    next

    defcode mstore
defcode mstore
    popd rbx ; addr to store at
    popd rax ; value to store at addr
    mov [rbx], rax
    next

    defcode mfetch
defcode mfetch
    popd rbx
    mov rax, [rbx]
    pushd rax
    next

    defcode mstoreb
defcode mstoreb
    popd rbx
    popd rax
    mov [ebx], byte al
    next

    defcode mfetchb
defcode mfetchb
    popd rbx
    xor rax, rax
    mov al, byte [ebx]
    pushd rax
    next

    defcode exit
defcode exit ; clean exit
    mov rax, SYS_EXIT
    mov rdi, 0
    syscall

    defcode branch
defcode exit2 ; exit with error code
    mov rax, SYS_EXIT
    popd rdi
    syscall

defcode branch
    add esi, [esi]
    next

; TODO: make this more compact
defcode zbranch ; 0BRANCH
    popd rax
    cmp rax, 0
    jnz continue
    add esi, [esi]
    next
continue:
    lea esi, [esi + ADDR_SIZE]
    next

defcode equa
    popd rax
    popd rbx
    cmp rax, rbx
    sete al
    pushd rax
    next

defcode key
    mov r8, rsi ; backup rsi since we'll clobber it
    mov rax, SYS_READ
    mov rdi, STDIN
    mov rsi, KEY
    mov rdx, 1
    syscall
    mov rsi, r8 ; restore rsi

    cmp rdx, 0 ; exit if ^D (zero length string)
    jz exit

    mov al, byte [KEY]
    pushd rax
    next

defcode inv ; not
    popd rax
    test rax, rax
    je tru
    mov rax, 0
    pushd rax
    next
tru:
    mov rax, 1
    pushd rax
    next

defword getword ; : WORD ( -- wordlen chars ... ) KEY DUP ' ' = 0BRANCH -48 ;
    dq key
    dq sdup
    dq lit, ' '
    dq equa
    dq zbranch, -48
    dq drop
    dq drop
    dq exitword

    defword starloop
; a little test word
defword starloop
    dq lit, '*'
    dq emit
    dq branch, -32
    dq exitword

defword atest
    dq lit, '*'
    dq lit, 'a'
    dq emit
    dq exitword

start:
    cld
    mov rbp, rsp ; allocate data stack
    add rsp, ADDR_SIZE * 256 ; make it 256 words
    mov rsi, instrs
    next

instrs:
    dq starloop
    dq exit
    dq getword
    dq getword
    dq exit2