;; This defines some assembler macros, including the macro
;; 'instruction-set' which generates generates symbolic <-> binary
;; translators from an instruction set specification.

#lang scheme/base


(require 
 "tools.ss"
 "dictionary.ss"
 "pointers.ss"
 "../tools.ss"
 (for-syntax
  scheme/base
  "asmgen-tx.ss"))

(provide
 instruction-set
 pseudo-ops)

;; Additional pseudo ops not part of instruction set.
(define-syntax  pseudo-ops
  (syntax-rules (assemblers:)
    ((_ (assemblers: uses ...)
        (name proto body) ...)
     (let ((uses (asm-find 'uses)) ...)
       (begin
         (define-asm (name . proto) body) ...)))))


;; See asmgen-tx.ss for factored out referentially transparent part
;; of the syntax transformer.

(define-syntax (iset stx)
  (syntax-case stx ()
    ((_ asm! dasm! instructions ...)
     (instruction-set-tx #'asm!
                         #'dasm!
                         #'(instructions ...)))))

(define-sr (instruction-set ins ...)
  (iset asm-register!
        dasm-register!
        ins ...))

;; Test instruction-set-tx transformer by generating and testing a
;; representative asm/dasm pair.

(check-set-mode! 'report-failed)
(let ((asm  #f)
      (dasm #f))
  (let ((asm!  (lambda (name fn)     (set! asm fn)))
        (dasm! (lambda (opc bits fn) (set! dasm fn))))
    (iset asm! dasm!
     (testopc (a b R) "1010 RRRR aaaa bbbb"))
    (parameterize
        ((current-pointers #hasheq((code . (-1)))))
      (check (asm  4 2 -1) => '(#xAF42))
      (check (dasm #xAF42) => '(testopc (a . 4) (b . 2) (R . -1)))
      (void))))