Interpretador de assembly em Scheme

Dando continuidade à série de programas inúteis que só servem para alimentar a procrastinação, a seguir estão a descrição e implementação (em Chicken Scheme) de um pequeno interpretador de uma linguagem assembly bem simples.

A linguagem possui apenas seis instruções e opera somente com números:

• add <reg> <number | reg>: Soma um número ou o conteúdo do registrador usado como segundo argumento com o conteúdo do registrador usado como primeiro argumento. O resultado é armazenado no registrador usado como primeiro argumento.


• mov <reg> <number | reg>: Armazena o número ou o conteúdo do registrador usado como segundo argumento no registrador usado como primeiro argumento.


• lbl <label>: Associa um endereço de memória a um rótulo, o qual pode ser referenciado no programa pelas instruções jmp e jnz.


• jmp <label>: Desvia o fluxo de execução para <label> (uma marca determinada através da instrução lbl).


• jnz <reg> <label>: Desvia o fluxo de execução para <label> se o conteúdo do registrador usado como primeiro argumento for diferente de zero.


• out <number | reg>: Imprime o número ou conteúdo do registrador usado como argumento.

A arquitetura hipotética considerada possui 8 registradores para leitura e escrita (r1 a r8), nenhum deles com função específica. Há também um registrador somente para leitura (ip) que armazena o endereço de memória da última instrução executada.

Por simplicidade, a sintaxe das instruções é semelhante à sintaxe de Scheme, ou seja, usa parênteses. Por exemplo:

(mov r1 3)

O código do interpretador está a seguir (tiny-assembly.scm):

;; Instrucoes:
;;     add <reg> <number | reg>
;;     mov <reg> <number | reg>
;;     jmp <label>
;;     jnz <reg> <label>
;;     lbl <label>
;;     out <number | reg>
;;
;; Registradores: r1..r8
;; Registrador "read-only": ip

(use srfi-1)

(define (run code)
  (define memory (map cons (iota (length code)) code))
  (define labels '())
  (define registers
    '((r1 . 0) (r2 . 0) (r3 . 0) (r4 . 0)
      (r5 . 0) (r6 . 0) (r7 . 0) (r8 . 0)))
  (define ip 0)
  (define code-len (length code))

  (define (die . msg)
    (print "Error: "
           (string-intersperse (map ->string msg) ""))
    (exit 1))

  (define (next-ip)
    (set! ip (add1 ip)))

  (define (reg-get register)
    (alist-ref register registers))

  (define (val-get thing)
    (if (eq? thing 'ip)
        ip
        (if (number? thing)
            thing
            (reg-get thing))))

  (define (reg-set! reg val)
    (set! registers
          (alist-update! reg (val-get val) registers)))

  (define (label-address label)
    (alist-ref label labels))

  (define (add reg val)
    (reg-set! reg (+ (reg-get reg) (val-get val))))

  (define (mov reg val)
    (reg-set! reg (val-get val)))

  (define (jmp label)
    (let ((address (or (reg-get label)
                       (label-address label))))
      (if address
          (set! ip address)
          (die "label " label " not found."))))

  (define (jnz reg label)
    (if (zero? (reg-get reg))
        (next-ip)
        (jmp label)))

  (define (lbl label)
    (set! labels (alist-update! label ip labels)))

  (define (finished? ip) (>= ip code-len))

  (set! labels
        (map (lambda (label)
               (cons (caddr label) (car label)))
             (filter (lambda (expr)
                       (eq? (cadr expr) 'lbl))
                     memory)))
  (let loop ()
    (if (finished? ip)
        (exit)
        (begin
          (let* ((expr (alist-ref ip memory))
                 (op (car expr))
                 (arg1 (cadr expr))
                 (arg2 (and (not (null? (cddr expr)))
                            (caddr expr))))
            (case op
              ((mov) (mov arg1 arg2))
              ((add) (add arg1 arg2))
              ((jmp) (jmp arg1))
              ((jnz) (jnz arg1 arg2))
              ((lbl) (noop))
              ((out) (print
                      (or (reg-get arg1)
                          (if (eq? arg1 'ip)
                              ip
                              arg1))))
              (else (die op ": unknown command.")))
            (unless (memq op '(jmp jnz))
              (next-ip)))
          (loop)))))

;;; Command line parser
(let ((args (command-line-arguments)))
  (when (null? args)
    (print "Usage: " (program-name) " <input-file>")
    (exit 1))
  (let ((file (car args)))
    (unless (file-exists? file)
      (print "Could not open " file)
      (exit 1))
    (run (handle-exceptions
          exn
          (die "parse error.")
          (with-input-from-file file read-file)))))

A seguir estão alguns exemplos de código assembly e uso com o interpretador:

Multiplicação

A linguagem não possui uma instrução para multiplicação. Abaixo está a implementação de uma rotina para multiplicar dois números (7 x 4):

(mov r1 7)
(mov r2 4)
(mov r4 ip)
(jmp mul)
(jmp end)

;; Multiplicacao (x * y)
;; x -> r1
;; y -> r2
;; produto -> r3
;; endereco de retorno -> r4
(lbl mul)
(jnz r1 not-zero)
(jmp end)
(lbl not-zero)
(mov r3 0)
(lbl loopmul)
(add r3 r2)
(add r1 -1)
(jnz r1 loopmul)
(add r4 2)
(jmp r4)

(lbl end)
(out r3)

$ csi -s tiny-assembly.scm multiplicacao.asm
28

Fatorial

Toda e qualquer implementação de linguagem inútil deve mostrar uma implementação de fatorial como exemplo. Abaixo está a implementação usando o assembly descrito neste texto (where's your god now?!):

(mov r5 7) ;; entrada de dados

;; Fatorial
;;     entrada -> r5
;;     resultado -> r6
(lbl fatorial)
(mov r6 1)
(lbl fat-loop)
(jnz r5 fat-not-0)
(jmp end)
(lbl fat-not-0)
(add r5 -1)
(jnz r5 fat-not-1)
(jmp end)
(lbl fat-not-1)
(add r5 1)
(mov r1 r6)
(mov r2 r5)
(mov r4 ip)
(jmp mul)
(mov r6 r3)
(add r5 -1)
(jmp fat-loop)

;; Multiplicacao (x * y)
;;     x -> r1
;;     y -> r2
;;     produto -> r3
;;     endereco de retorno -> r4
(lbl mul)
(jnz r1 mul-not-0)
(jmp end)
(lbl mul-not-0)
(mov r3 0)
(lbl loopmul)
(add r3 r2)
(add r1 -1)
(jnz r1 loopmul)
(add r4 2)
(jmp r4)

(lbl end)
(out r6) ;; imprime o resultado

$ csi -s tiny-assembly.scm fatorial.asm
5040