;; ASM / DASM SUPPORT #lang scheme/base (require "../tools.ss" "../target.ss" "decoder.ss" "dictionary.ss" "pointers.ss" (lib "match.ss")) (provide ;; operand assemblers pc-relative ignore-overflow ;; misc asm routines chain dasm-step asm-fits? operand:signed operand:unsigned ;; misc dasm routines disassemble->word ) ;; For the imperative algos, use a hash table data structure. ;(define get hash-table-get) ;(define put! hash-table-put!) ;(define table alist->hash-table) ;(define table->alist hash-table->alist) ;; *** ASM GEN SUPPORT *** ;; The current PC. ;; data flow macro: parallel data is passed as lists, which is ;; appended to other arguments before applying. this is an alternative ;; to folding, in case the number of elements to fold is known in ;; advance. i use this in the (dis)assembler. (define-syntax chain (syntax-rules () ((_ input (fn args ...)) (apply fn (append (list args ...) input))) ((_ input (fn args ...) more ...) (chain (chain input (fn args ...)) more ...)))) ;; (chain `(,257 ()) (dasm 4) (dasm 4) (dasm 4)) ;; now, a similar thing with fold. convert a tree: ;; IN1 IN2 IN3 ;; | | | ;; S0---x---x---x-| ;; ;; into an invocation of a single function ;; (define (fold-chain fn init-state inputs) ;; (fold (lambda (input state) ;; (apply fn (append input state))) ;; init-state ;; inputs)) ; --- assembler --- ;; assemble chunk: ;; (bits value) ... ;; | | ;; V V ;; opcode -> [asm] -> [asm] -> ... -> instruction ;; (asm 1 8 (asm 1 8 0)) ;=> 257 ;; To check overflow, we need to know wether the byte is signed or ;; unsigned. For a word of b bits, we inspect the bits left of the ;; first b-1 bits. ;; Type is 1 for unsigned and -1 for signed. (define operand:signed -1) (define operand:unsigned 1) (define (operand-type type) (cond ((eq? type operand:unsigned) 'unsigned) ((eq? type operand:signed) 'signed) (error 'no-sign-type "~a" type))) (define (asm-fits? value bits type) (let ((rest (>>> value (- bits 1)))) (or (zero? rest) ;; always correct: fits in both signed and unsigned rep. (eq? rest type) ;; the other legal value is 1 for unsigned and -1 for signed. ))) ;; Operand assemblers: called depending on operand type (see ;; asmgen-tx.ss paramclass->asm) (define (ignore-overflow value bits acc) (bitwise-ior (bitwise-and (int value) (bitmask bits)) (arithmetic-shift acc bits))) (define (catch-overflow type value bits acc) (unless (or (> (asm-phase) 0) ;; ignore overflows in phase 0 (asm-fits? value bits type)) ;; (printf "WARNING: ~a overflow val:~a bits:~a\n" (asm-phase) value bits) ((asm-error) 'overflow (operand-type type) value bits) ) (ignore-overflow value bits acc)) (define (unsigned . a) (apply catch-overflow operand:unsigned a)) (define (signed . a) (apply catch-overflow operand:signed a)) (define (pc-relative value . a) (apply signed ((asm-offset) value) a)) ;; Offset computation for relative addressing. The following seems to ;; be a standard: relative to the PC after the jump instruction. (define asm-offset (make-parameter (lambda (addr) (let ((here (pointer-get 'code))) ;; (printf "OFFSET: ~a ~a ~a ~a\n" ;; (let ((c (asm-current-chain))) ;; (and c (target-word-name c))) ;; (instruction->string (asm-current-instruction)) ;; here addr) (- addr (+ here 1)))))) ;; --- disassembler --- ;; dasm is just asm run in reverse. ;; bits bits ;; | | ;; V V ;; opcode <- [asm] <- [asm] <- ... <- instruction ;; | | ;; V V ;; value value ;; it's probably easiest if the values are propagated to the left ;; together with the instruction. the asm doesn't have this topology ;; because for list input we can use parameter names. (see the ;; instruction-set macro) ;; (define (dasm-resolve thing) ;; (let ((name (dasm-constant-find thing))) ;; (if name name thing))) ;; (define (sign-extend unsigned bits) ;; (let ((signmask (<<< 1 (- bits 1)))) ;; (- (bxor unsigned signmask) signmask))) (define (extract-bitfield num bits signed) (let ((unsigned (bitwise-and num (bitmask bits)))) (if signed (sign-extend unsigned bits) unsigned))) ;; Upper case parameter names are signed. (define (signed? sym) (char-upper-case? (car (string->list (symbol->string sym))))) (define (dasm-step name bits in out) (list (>>> in bits) (cons (cons name (extract-bitfield in bits (signed? name))) out))) ;; Note that this is for RISC instruction sets only. All instructions ;; have the same size and are word-addressed. Any mult-word ;; instructions need to be parsed in a later step. (This works well ;; for PIC18 because the 2nd word is a valid NOP instruction, but ;; might need some reworking). (define (disassemble->word binary address wordsize ;; + 1 because base is AFTER instruction. i think ;; this is as good as universal, so hardcoded here. [resolve (lambda (x) x)] [rel->abs (lambda (addr rel) (+ 1 (+ addr rel)))]) (define *bin* '()) (define *code* '()) (define (dasm addr ins) (match ((dasm-find ins wordsize) ins) ((rator . rands) (cons rator (map (match-lambda ((type . value) (case type ((R) (resolve (rel->abs addr value))) (else value)))) rands))))) (for ((a (in-naturals address)) (b binary)) (push! *bin* (list b)) (push! *code* (dasm a b))) (new-target-word #:realm 'code #:address address #:code *code* #:bin *bin*))