cgen/pgmr-tools.scm

   1 ; Programmer development tools.
   2 ; Copyright (C) 2000, 2009 Red Hat, Inc.
   3 ; This file is part of CGEN.
   4 ; See file COPYING.CGEN for details.
   5 ;
   6 ; This file contains a collection of programmer debugging tools.
   7 ; They're mainly intended for using cgen to debug other things,
   8 ; but any kind of debugging tool can go here.
   9 ; All routines require the application independent part of cgen to be loaded
  10 ; and the .cpu file to be loaded.  They do not require any particular
  11 ; application though (opcodes, simulator, etc.).  If they do, that's a bug.
  12 ; It may be that the appication has a generally useful routine that should
  13 ; live elsewhere, but that's it.
  14 ;
  15 ; These tools don't have to be particularily efficient (within reason).
  16 ; It's more important that they be simple and clear.
  17 ;
  18 ; Some tools require ifmt-compute! to be run.
  19 ; They will run it if necessary.
  20 ;
  21 ; Table of contents:
  22 ;
  23 ; pgmr-pretty-print-insn-format
  24 ;   cgen debugging tool, pretty prints the iformat of an <insn> object
  25 ;
  26 ; pgmr-pretty-print-insn-value
  27 ;   break out an instruction's value into its component fields
  28 ;
  29 ; pgmr-lookup-insn
  30 ;   given a random bit pattern for an instruction, lookup the insn and return
  31 ;   its <insn> object
  32 \f
  33 ; Pretty print the instruction's opcode value, for debugging.
  34 ; INSN is an <insn> object.
  35
  36 (define (pgmr-pretty-print-insn-format insn)
  37
  38   (define (to-width width n-str)
  39     (string-take-with-filler (- width)
  40                              n-str
  41                              #\0))
  42
  43   (define (dump-insn-mask mask insn-length)
  44     (string-append "0x" (to-width (quotient insn-length 4)
  45                                   (number->string mask 16))
  46                    ", "
  47                    (string-map
  48                     (lambda (n)
  49                       (string-append " " (to-width 4 (number->string n 2))))
  50                     (reverse
  51                      (split-bits (make-list (quotient insn-length 4) 4)
  52                                  mask)))))
  53
  54   ; Print VALUE with digits not in MASK printed as "X".
  55   (define (dump-insn-value value mask insn-length)
  56     (string-append "0x" (to-width (quotient insn-length 4)
  57                                   (number->string value 16))
  58                    ", "
  59                    (string-map
  60                     (lambda (n mask)
  61                       (string-append
  62                        " "
  63                        (list->string
  64                         (map (lambda (char in-mask?)
  65                                (if in-mask? char #\X))
  66                              (string->list (to-width 4 (number->string n 2)))
  67                              (bits->bools mask 4)))))
  68                     (reverse
  69                      (split-bits (make-list (quotient insn-length 4) 4)
  70                                  value))
  71                     (reverse
  72                      (split-bits (make-list (quotient insn-length 4) 4)
  73                                  mask)))))
  74
  75   (define (dump-ifield f)
  76     (string-append " Name: "
  77                    (obj:name f)
  78                    ", "
  79                    "Start: "
  80                    (number->string
  81                     (+ (bitrange-word-offset (-ifld-bitrange f))
  82                        (bitrange-start (-ifld-bitrange f))))
  83                    ", "
  84                    "Length: "
  85                    (number->string (ifld-length f))
  86                    "\n"))
  87
  88   (let* ((iflds (sort-ifield-list (insn-iflds insn)
  89                                   (not (current-arch-insn-lsb0?))))
  90          (mask (compute-insn-base-mask iflds))
  91          (mask-length (compute-insn-base-mask-length iflds)))
  92
  93     (display
  94      (string-append
  95       "Instruction: " (obj:name insn)
  96       "\n"
  97       "Syntax: "
  98       (insn-syntax insn)
  99       "\n"
 100       "Fields:\n"
 101       (string-map dump-ifield iflds)
 102       "Instruction length (computed from ifield list): "
 103       (number->string (apply + (map ifld-length iflds)))
 104       "\n"
 105       "Mask:  "
 106       (dump-insn-mask mask mask-length)
 107       "\n"
 108       "Value: "
 109       (let ((value (apply +
 110                           (map (lambda (fld)
 111                                  (ifld-value fld mask-length
 112                                              (ifld-get-value fld)))
 113                                (find ifld-constant? (ifields-base-ifields (insn-iflds insn)))))))
 114         (dump-insn-value value mask mask-length))
 115       ; TODO: Print value spaced according to fields.
 116       "\n"
 117       )))
 118 )
 119
 120 ; Pretty print an instruction's value.
 121
 122 (define (pgmr-pretty-print-insn-value insn value)
 123   (define (dump-ifield ifld value name-width)
 124     (string-append
 125      (string-take name-width (obj:str-name ifld))
 126      ": "
 127      (number->string value)
 128      ", 0x"
 129      (number->hex value)
 130      "\n"))
 131
 132   (let ((ifld-values (map (lambda (ifld)
 133                             (ifld-extract ifld insn value))
 134                           (insn-iflds insn)))
 135         (max-name-length (apply max
 136                                 (map string-length
 137                                      (map obj:name
 138                                           (insn-iflds insn)))))
 139         )
 140
 141     (display
 142      (string-append
 143       "Instruction: " (obj:name insn)
 144       "\n"
 145       "Fields:\n"
 146       (string-map (lambda (ifld value)
 147                     (dump-ifield ifld value max-name-length))
 148                   (insn-iflds insn)
 149                   ifld-values)
 150       )))
 151 )
 152 \f
 153 ; Return the <insn> object matching VALUE.
 154 ; VALUE is either a single number of size base-insn-bitsize,
 155 ; or a list of numbers for variable length ISAs.
 156 ; LENGTH is the total length of VALUE in bits.
 157
 158 (define (pgmr-lookup-insn length value)
 159   (arch-analyze-insns! CURRENT-ARCH
 160                        #t ; include aliases
 161                        #f) ; don't need to analyze semantics
 162
 163   ; Return a boolean indicating if BASE matches the base part of <insn> INSN.
 164   (define (match-base base insn)
 165     (let ((mask (compute-insn-base-mask (insn-iflds insn)))
 166           (ivalue (insn-value insn)))
 167       ; return (value & mask) == ivalue
 168       (= (logand base mask) ivalue)))
 169
 170   (define (match-rest value insn)
 171     #t)
 172
 173   (let ((base (if (list? value) (car value) value)))
 174     (let loop ((insns (current-insn-list)))
 175       (if (null? insns)
 176           #f
 177           (let ((insn (car insns)))
 178             (if (and (= length (insn-length insn))
 179                      (match-base base insn)
 180                      (match-rest value insn))
 181                 insn
 182                 (loop (cdr insns)))))))
 183 )