Add driver
This commit is contained in:
parent
f8a868bb23
commit
422c675981
37
scmvm.scm
Executable file
37
scmvm.scm
Executable file
@ -0,0 +1,37 @@
|
|||||||
|
#! /bin/sh
|
||||||
|
exec guile -L . -e main -s "$0" "$@"
|
||||||
|
!#
|
||||||
|
(use-modules (ice-9 getopt-long)
|
||||||
|
(scmvm vm))
|
||||||
|
|
||||||
|
(define *options-spec*
|
||||||
|
'((output (single-char #\o)
|
||||||
|
(value #t))
|
||||||
|
(help (single-char #\h)
|
||||||
|
(value #f))
|
||||||
|
(stack-size (value #t))
|
||||||
|
(memory-size (value #t))))
|
||||||
|
|
||||||
|
(define parse-options
|
||||||
|
(lambda (options)
|
||||||
|
(getopt-long options *options-spec*)))
|
||||||
|
|
||||||
|
(define (usage)
|
||||||
|
(format #t "Usage: scmvm.scm [-o outfile] mode infile
|
||||||
|
Compile or run Scheme programs
|
||||||
|
|
||||||
|
Commands:
|
||||||
|
\tcompile\t Compile the source into an object file
|
||||||
|
\trun\t Run the object file
|
||||||
|
|
||||||
|
Yes the VM runs on Scheme, no that doesn't make any sense\n")
|
||||||
|
(exit))
|
||||||
|
|
||||||
|
(define* (main #:optional args)
|
||||||
|
(define options (parse-options args))
|
||||||
|
(when (option-ref options 'help #f)
|
||||||
|
(usage)))
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; mode: scheme
|
||||||
|
;; End:
|
@ -8,7 +8,7 @@
|
|||||||
*instruction-set* instruction-type instruction-code))
|
*instruction-set* instruction-type instruction-code))
|
||||||
|
|
||||||
;;; Data Structures
|
;;; Data Structures
|
||||||
(define *stack-size* 1000)
|
(define *stack-size* 512)
|
||||||
(define *memory-size* 2048)
|
(define *memory-size* 2048)
|
||||||
|
|
||||||
(define* (make-stack #:optional (stack-size *stack-size*))
|
(define* (make-stack #:optional (stack-size *stack-size*))
|
||||||
@ -79,7 +79,7 @@
|
|||||||
(let ([bv (read-bytevector 4)])
|
(let ([bv (read-bytevector 4)])
|
||||||
(bytevector-s32-ref bv 0 (native-endianness))))
|
(bytevector-s32-ref bv 0 (native-endianness))))
|
||||||
|
|
||||||
;;; Program execution
|
;;; Instructions
|
||||||
(define *instruction-set*
|
(define *instruction-set*
|
||||||
'((push #x01 i)
|
'((push #x01 i)
|
||||||
(pop #x02 o)
|
(pop #x02 o)
|
||||||
@ -126,6 +126,8 @@
|
|||||||
[(<) <]
|
[(<) <]
|
||||||
[(=) =]))
|
[(=) =]))
|
||||||
|
|
||||||
|
|
||||||
|
;;; Execution
|
||||||
(define (jump addr)
|
(define (jump addr)
|
||||||
(seek (current-input-port) addr SEEK_SET))
|
(seek (current-input-port) addr SEEK_SET))
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user