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.
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.
15 ; These tools don't have to be particularily efficient (within reason).
16 ; It's more important that they be simple and clear.
18 ; Some tools require ifmt-compute! to be run.
19 ; They will run it if necessary.
23 ; pgmr-pretty-print-insn-format
24 ; cgen debugging tool, pretty prints the iformat of an <insn> object
26 ; pgmr-pretty-print-insn-value
27 ; break out an instruction's value into its component fields
30 ; given a random bit pattern for an instruction, lookup the insn and return
33 ; Pretty print the instruction's opcode value, for debugging.
34 ; INSN is an <insn> object.
36 (define (pgmr-pretty-print-insn-format insn)
38 (define (to-width width n-str)
39 (string-take-with-filler (- width)
43 (define (dump-insn-mask mask insn-length)
44 (string-append "0x" (to-width (quotient insn-length 4)
45 (number->string mask 16))
49 (string-append " " (to-width 4 (number->string n 2))))
51 (split-bits (make-list (quotient insn-length 4) 4)
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))
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)))))
69 (split-bits (make-list (quotient insn-length 4) 4)
72 (split-bits (make-list (quotient insn-length 4) 4)
75 (define (dump-ifield f)
76 (string-append " Name: "
81 (+ (bitrange-word-offset (-ifld-bitrange f))
82 (bitrange-start (-ifld-bitrange f))))
85 (number->string (ifld-length f))
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)))
95 "Instruction: " (obj:name insn)
101 (string-map dump-ifield iflds)
102 "Instruction length (computed from ifield list): "
103 (number->string (apply + (map ifld-length iflds)))
106 (dump-insn-mask mask mask-length)
109 (let ((value (apply +
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.
120 ; Pretty print an instruction's value.
122 (define (pgmr-pretty-print-insn-value insn value)
123 (define (dump-ifield ifld value name-width)
125 (string-take name-width (obj:str-name ifld))
127 (number->string value)
132 (let ((ifld-values (map (lambda (ifld)
133 (ifld-extract ifld insn value))
135 (max-name-length (apply max
138 (insn-iflds insn)))))
143 "Instruction: " (obj:name insn)
146 (string-map (lambda (ifld value)
147 (dump-ifield ifld value max-name-length))
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.
158 (define (pgmr-lookup-insn length value)
159 (arch-analyze-insns! CURRENT-ARCH
161 #f) ; don't need to analyze semantics
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)))
170 (define (match-rest value insn)
173 (let ((base (if (list? value) (car value) value)))
174 (let loop ((insns (current-insn-list)))
177 (let ((insn (car insns)))
178 (if (and (= length (insn-length insn))
179 (match-base base insn)
180 (match-rest value insn))
182 (loop (cdr insns)))))))