codepad

Language:

; assembler, part 1

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

(display (asm2 (asm1 "program.asm"))) (newline)

Private [?]

Run code