Anonymous

#!/usr/bin/mzscheme -r

(define *codefile*
  (open-input-file
   (vector-ref (current-command-line-arguments) 0)
   'binary))

(define *stack* '())

(define *handlers* (make-vector 256 #f))

(define (push x)
    (set! *stack* (cons x *stack*)))

(define (pop)
    (if (null? (car *stack*))
        (error "Attempt to pop from empty stack")
        (let ((x (car *stack*)))
          (set! *stack* (cdr *stack*))
          x)))

(define (peek)
    (let ((x (car *stack*)))
      (if (null? x)
          (error "Attempt to peek on empty stack")
          x)))

(define (read-op)
    (read-byte *codefile*))

(define (safe-read-op)
    (let ((op (read-op)))
      (if (eof-object? op)
          (error "EOF while reading from file")
          op)))

(define-syntax define-instruction
  (syntax-rules ()
    ((define-instruction op (name) (handler ...) ...)
     (begin
       (define (name)
         (handler ...) ...)
       (set-handler op name)))
    ((define-instruction op (name args ...) formhandler (handler ...) ...)
     (begin
       (define (name)
         (apply (lambda (args ...) (handler ...) ...) (formhandler)))
       (set-handler op name)))))

(define (call-handler op)
  (let ((handler (vector-ref *handlers* op)))
    (if (not handler)
        (error "Unknown opcode")
        (handler))))

(define (set-handler op name)
  (vector-set! *handlers* op name))

(define-syntax arithmetic
  (syntax-rules ()
    ((arithmetic operator)
     (push (operator (pop) (pop))))))

(define (push_form)
  (list (safe-read-op)))

(define-instruction 0 (quit_h)
  (error "DONE!"))

(define-instruction 1 (push_h x) push_form
  (push x))

(define-instruction 2 (add_h)
  (arithmetic +))

(define-instruction 3 (print_h)
  (display (format "~A" (peek)))
  (newline))

(define-instruction 4 (sub_h)
  (arithmetic -))

(define-instruction 5 (mul_h)
  (arithmetic *))

(define-instruction 6 (div_h)
  (arithmetic /))

; 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))
  (call-handler opcode))