(define *codefile* (open-input-file (vector-ref (current-command-line-arguments) 0) 'binary)) (define *stack* '()) (require (lib "defmacro.ss")) (define-macro make-handler (lambda (func arglist . body) `(let (,@(do ((args arglist (cdr args)) (lets '() (cons (list (car args) (list func)) lets))) ((null? args) lets))) ,@body))) (define push (lambda (x) (set! *stack* (cons x *stack*)))) (define pop (lambda () (if (null? (car *stack*)) (error "Attempt to pop from empty stack") (let ((x (car *stack*))) (set! *stack* (cdr *stack*)) x)))) (define peek (lambda () (let ((x (car *stack*))) (if (null? x) (error "Attempt to peek on empty stack") x)))) (define read-op (lambda () (read-byte *codefile*))) (define safe-read-op (lambda () (let ((op (read-op))) (if (eof-object? op) (error "EOF while reading from file") op)))) ; Opcodes: ; 0x1 - Push ; 0x2 - Add ; 0x3 - Print ; 0x4 - Sub ; 0x5 - Mul ; 0x6 - Div (do ((opcode (read-op) (read-op)) (done #f)) ((or (eof-object? opcode) done)) (case opcode ((0) (set! done #t)) ((1) (make-handler safe-read-op (x) (push x))) ((2) (make-handler pop (x y) (push (+ x y)) (display (format "~A + ~A " x y)))) ((3) (make-handler peek (x) (display (format "~A" x)) (newline))) ((4) (make-handler pop (x y) (push (- x y)) (display (format "~A - ~A " x y)))) ((5) (make-handler pop (x y) (push (* x y)) (display (format "~A - ~A " x y)))) ((6) (make-handler pop (x y) (push (/ x y)) (display (format "~A - ~A " x y)))) (else (error (format "Unknown opcode ~A" opcode)))))