codepad

Language:

; assembler, part 2

(define labels (list))

(define opcodes '(("const" . 0) ("get" . 1) ("put" . 2)
        ("ld" . 3) ("st" . 4) ("add" . 5) ("sub" . 6)
        ("jpos" . 7) ("jz" . 8) ("j" . 9) ("halt" . 10)))

(define (split line)
  (define (skip-blanks)
    (let loop ()
      (if (or (null? line) (not (char-whitespace? (car line)))) #f
        (begin (set! line (cdr line)) (loop)))))
  (define (get-string)
    (let loop ((str (list)))
      (if (or (null? line) (char-whitespace? (car line)))
          (list->string (reverse str))
          (let ((c (car line)))
            (set! line (cdr line))
            (loop (cons c str))))))
  (let* ((lbl (get-string)) (_ (skip-blanks))
         (opc (get-string)) (_ (skip-blanks))
         (obj (get-string)) (_ (skip-blanks)))
    (values lbl opc obj (list->string line))))

(define (asm1 file-name) ; first-pass
  (set! labels (list))
  (with-input-from-file file-name (lambda ()
    (let loop ((k 0) (line (read-line)) (lines (list)))
      (if (eof-object? line) (reverse lines)
        (if (or (string=? line "") (char=? (string-ref line 0) #\#))
           (loop k (read-line) lines)
            (call-with-values
              (lambda () (split (string->list line)))
              (lambda (lbl opc obj cmt)
                (when (not (string=? lbl ""))
                  (set! labels (cons (cons lbl k) labels)))
                (loop (+ k 1) (read-line)
                      (cons (vector k lbl opc obj cmt) lines))))))))))

(define (asm2 lines) ; second pass
  (let ((mem (make-vector 1000 0)))
    (do ((lines lines (cdr lines))) ((null? lines) mem)
      (let ((num (vector-ref (car lines) 0))
            (opc (vector-ref (car lines) 2))
            (obj (vector-ref (car lines) 3)))
        (vector-set! mem num (+ (* (cdr (assoc opc opcodes)) 1000)
          (if (assoc obj labels) (cdr (assoc obj labels))
            (if (not (string=? obj "")) (string->number obj)
              0))))))))

(define (sim mem)
  (let loop ((pc 0) (acc 0))
    (let ((addr (modulo (vector-ref mem pc) 1000))
          (code (quotient (vector-ref mem pc) 1000)))
      (case code
      ((1) (loop (+ pc 1) (read))) ; get
      ((2) (display acc) (newline) (loop (+ pc 1) acc)) ; put
      ((3) (loop (+ pc 1) (vector-ref mem addr))) ; ld
      ((4) (vector-set! mem addr acc) (loop (+ pc 1) acc)) ; st
      ((5) (loop (+ pc 1) (+ acc (vector-ref mem addr)))) ; add
      ((6) (loop (+ pc 1) (- acc (vector-ref mem addr)))) ; sub
      ((7) (loop (if (positive? acc) addr (+ pc 1)) acc)) ; jpos
      ((8) (loop (if (zero? acc) addr (+ pc 1)) acc)) ; jz
      ((9) (loop addr acc)) ; j
      ((10) (if #f #f)) ; halt
      (else (error 'sim "unrecognized command"))))))

(sim (asm2 (asm1 "program.asm")))

Private [?]

Run code