dane/scm-to-vm
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Compare commits

base: dane:33f16189158b2eeea08790322f365b2a254c24d1
Branches Tags
dane:master
...
compare: dane:1c84a9c86247ab5222d1c8158a10089aa63aa583
Branches Tags
dane:master

2 Commits
33f1618915 ... 1c84a9c862

Author SHA1 Message Date
Dane Johnson
1c84a9c862 Some bugfixes to runtime code, probably need to implement stepping debugger 2025-08-25 12:34:46 -05:00
Dane Johnson
d0d0ca23ec More useful error messages, assume unsigned ints 2025-08-25 12:34:08 -05:00
3 changed files with 19 additions and 13 deletions
Show Stats Expand all files Collapse all files

8
asm/runtime.scm
View File

@ -1,3 +1,6 @@
(push main)
(jmp)
;; Note that this is scheme syntax wrapping asm for a stack machine ;; Note that this is scheme syntax wrapping asm for a stack machine
(variable eol 0) (variable eol 0)
(variable scan 0) (variable scan 0)
@ -8,9 +11,6 @@
(variable new 0) (variable new 0)
(variable root 0) (variable root 0)
(push main)
(jmp)
alloc ;; ( -- p) alloc ;; ( -- p)
;; Test if free will go beyond eom ;; Test if free will go beyond eom
(ref free) (ref free)
@ -129,7 +129,7 @@ gc-loop
(<) (<)
(branch gc-loop-done) (branch gc-loop-done)
(ref scan) (ref scan)
(relocate-reg) (push relocate-reg)
(push gc-loop) (push gc-loop)
(jmp) (jmp)
gc-loop-done gc-loop-done

2
scmvm/assembler.scm
View File

@ -49,7 +49,7 @@
(define (write-word word) (define (write-word word)
(define bv (make-bytevector 4)) (define bv (make-bytevector 4))
(bytevector-s32-native-set! bv 0 word) (bytevector-u32-native-set! bv 0 word)
(write-bytevector bv)) (write-bytevector bv))
(define (assembly-pass seq labels) (define (assembly-pass seq labels)

22
scmvm/vm.scm
View File

@ -6,13 +6,14 @@
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-43) #:use-module (srfi srfi-43)
#:use-module (ice-9 format)
#:export (make-stack (push . stack-push) (pop . stack-pop) (peek . stack-peek) stack-ref stack->list #:export (make-stack (push . stack-push) (pop . stack-pop) (peek . stack-peek) stack-ref stack->list
(make-vm* . make-vm) run-vm (make-vm* . make-vm) run-vm
vm-memory-ref vm-memory-byte-ref vm-memory-set! vm-memory vm-load-program! vm-memory-ref vm-memory-byte-ref vm-memory-set! vm-memory vm-load-program!
vm-data-stack vm-ret-stack vm-data-stack vm-ret-stack
vm-debugger vm-debugger-set! vm-debugger vm-debugger-set!
vm-pc vm-pc-set! vm-pc vm-pc-set!
*instruction-set* instruction-type instruction-code)) *instruction-set* instruction-type instruction-code))
;;; Data Structures ;;; Data Structures
(define *stack-size* 512) (define *stack-size* 512)
@ -114,12 +115,16 @@
(swap #x17) (swap #x17)
(rot #x18) (rot #x18)
(over #x19) (over #x19)
(not #x1a)
(bye #xff))) (bye #xff)))
(define instruction-code cadr) (define instruction-code cadr)
(define (op-lookup code) (define (op-lookup code)
(car (find (lambda (x) (= (instruction-code x) code)) *instruction-set*))) (let ([op (find (lambda (x) (= (instruction-code x) code)) *instruction-set*)])
(if op
(car op)
(error (format #f "tried to execute non-existant instruction ~x" code)))))
(define (binop-lookup op) (define (binop-lookup op)
(case (op-lookup op) (case (op-lookup op)
@ -129,7 +134,8 @@
[(or) logior] [(or) logior]
[(nand) (compose lognot logand)] [(nand) (compose lognot logand)]
[(nor) (compose lognot logior)] [(nor) (compose lognot logior)]
[(xor) logxor])) [(xor) logxor]
[(not) lognot]))
(define (relop-lookup op) (define (relop-lookup op)
(case (op-lookup op) (case (op-lookup op)