Miscellany

(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)))))