1 ; Generic simulator application utilities.
2 ; Copyright (C) 2000, 2005, 2006, 2009, 2010 Red Hat, Inc.
3 ; This file is part of CGEN.
4 ; See file COPYING.CGEN for details.
6 ; The cache-addr? method.
7 ; Return #t if the hardware element's address is stored in the scache buffer.
8 ; This saves doing the index calculation during semantic processing.
11 <hardware-base> 'cache-addr?
14 (has-attr? self 'CACHE-ADDR)))
17 (define (hw-cache-addr? hw) (send hw 'cache-addr?))
19 ; The needed-iflds method.
20 ; Return list of ifields needed during semantic execution by hardware element
21 ; SELF referenced by <operand> OP in <sformat> SFMT.
24 <hardware-base> 'needed-iflds
25 (lambda (self op sfmt)
26 (list (op-ifield op)))
30 <hw-register> 'needed-iflds
31 (lambda (self op sfmt)
32 (list (op-ifield op)))
33 ; Instead of the following, we now arrange to store the ifield in the
34 ; argbuf, even for CACHE-ADDR operands. This way, the ifield values
35 ; (register numbers, etc.) remain available during semantics tracing.
36 ; (if (hw-cache-addr? self)
38 ; (list (op-ifield op))))
41 ; For addresses this is none because we make our own copy of the ifield
42 ; [because we want to use a special type].
45 <hw-address> 'needed-iflds
46 (lambda (self op sfmt)
50 (define (hw-needed-iflds hw op sfmt) (send hw 'needed-iflds op sfmt))
52 ; Return a list of ifields of <operand> OP that must be recorded in ARGBUF
54 ; ??? At the moment there can only be at most one, but callers must not
57 (define (op-needed-iflds op sfmt)
58 (let ((indx (op:index op)))
59 (logit 4 "op-needed-iflds op=" (obj:name op) " indx=" (obj:name indx)
60 " indx-type=" (hw-index:type indx) " sfmt=" (obj:name sfmt) "\n")
63 (eq? (hw-index:type indx) 'ifield)
64 (not (= (ifld-length (hw-index:value indx)) 0)))
65 (hw-needed-iflds (op:type op) op sfmt))
66 ((eq? (hw-index:type indx) 'derived-ifield)
67 (ifld-needed-iflds indx))
71 ; Operand extraction (ARGBUF) support code.
73 ; Any operand that uses a non-empty ifield needs extraction support.
74 ; Normally we just record the ifield's value. However, in cases where
75 ; hardware elements have CACHE-ADDR specified or where the mode of the
76 ; hardware index isn't compatible with the mode of the decoded ifield
77 ; (this can happen for pc-relative instruction address), we need to record
80 ; Return a boolean indicating if <operand> OP needs any extraction processing.
82 (define (op-extract? op)
83 (let* ((indx (op:index op))
85 (if (derived-operand? op)
86 (any-true? (map op-extract? (derived-args op)))
87 (and (eq? (hw-index:type indx) 'ifield)
88 (not (= (ifld-length (hw-index:value indx)) 0))))))
89 (logit 4 "op-extract? op=" (obj:name op) " =>" extract? "\n")
93 ; Return a list of operands that need special extraction processing.
94 ; SFMT is an <sformat> object.
96 (define (sfmt-extracted-operands sfmt)
97 (let ((in-ops (sfmt-in-ops sfmt))
98 (out-ops (sfmt-out-ops sfmt)))
99 (let ((ops (append (find op-extract? in-ops)
100 (find op-extract? out-ops))))
104 ; Return a list of ifields that are needed by the semantic code.
105 ; SFMT is an <sformat> object.
106 ; ??? This redoes a lot of the calculation that sfmt-extracted-operands does.
108 (define (sfmt-needed-iflds sfmt)
109 (let ((in-ops (sfmt-in-ops sfmt))
110 (out-ops (sfmt-out-ops sfmt)))
111 (let ((ops (append (find op-extract? in-ops)
112 (find op-extract? out-ops))))
113 (nub (apply append (map (lambda (op)
114 (op-needed-iflds op sfmt))
119 ; Sformat argument buffer.
121 ; This contains the details needed to create an argument buffer `fields' union
122 ; entry for the containing sformats.
124 (define <sformat-argbuf>
125 (class-make '<sformat-argbuf>
128 ; - NAME is derived from one of the containing sformats.
130 ; List of structure elements.
131 ; Each element is ("var name" "C type" bitsize).
132 ; The list is sorted by decreasing size, then C type,
139 (define-getters <sformat-argbuf> sbuf (sfmts elms))
141 ; Subroutine of /sfmt-contents to return an ifield element.
142 ; The result is ("var-name" "C-type" bitsize).
144 (define (/sfmt-ifld-elm f sfmt)
145 (let ((real-mode (mode-real-mode (ifld-decode-mode f))))
147 (mode:c-type real-mode)
148 (mode:bits real-mode)))
152 ; The result is ("var-name" "C-type" approx-bitsize) or #f if unneeded.
153 ; For the default case we use the ifield as is, which is computed elsewhere.
156 <hardware-base> 'sbuf-elm
157 (lambda (self op ifmt)
162 <hw-register> 'sbuf-elm
163 (lambda (self op ifmt)
164 (if (hw-cache-addr? self)
165 (list (gen-sym (op:index op))
166 (string-append (gen-type self) "*")
167 ; Use 64 bits for size. Doesn't really matter, just put them
173 ; We want to use ADDR/IADDR in ARGBUF for addresses
176 <hw-address> 'sbuf-elm
177 (lambda (self op ifmt)
178 (list (gen-sym (op:index op))
180 ; Use 64 bits for size. Doesn't really matter, just put them
186 <hw-iaddress> 'sbuf-elm
187 (lambda (self op ifmt)
188 (list (gen-sym (op:index op))
190 ; Use 64 bits for size. Doesn't really matter, just put them
195 ; Subroutine of /sfmt-contents to return an operand element.
196 ; These are in addition (or instead of) the actual ifields.
197 ; This is also used to compute definitions of local vars needed in the
199 ; The result is ("var-name" "C-type" approx-bitsize) or #f if unneeded.
201 (define (sfmt-op-sbuf-elm op sfmt)
202 (send (op:type op) 'sbuf-elm op sfmt)
205 ; Subroutine of compute-sformat-bufs! to compute list of structure elements
206 ; needed by <sformat> SFMT.
208 ; (SFMT ("var-name1" "C-type1" size1) ("var-name2" "C-type2" size2) ...)
209 ; and is sorted by decreasing size, then C type, then variable name
210 ; (as <sformat-argbuf> wants it).
212 (define (/sfmt-contents sfmt)
213 (let ((needed-iflds (sfmt-needed-iflds sfmt))
214 (extracted-ops (sfmt-extracted-operands sfmt))
215 (in-ops (sfmt-in-ops sfmt))
216 (out-ops (sfmt-out-ops sfmt))
217 (sort-elms (lambda (a b)
218 ; Sort by descending size, then ascending C type name,
219 ; then ascending name.
220 (cond ((> (caddr a) (caddr b))
222 ((= (caddr a) (caddr b))
223 (cond ((string<? (cadr a) (cadr b))
225 ((string=? (cadr a) (cadr b))
226 (string<? (car a) (car b)))
233 "/sfmt-contents sfmt=" (obj:name sfmt)
234 " needed-iflds=" (obj-csv-names needed-iflds)
235 " extracted-ops=" (obj-csv-names extracted-ops)
236 " in-ops=" (obj-csv-names in-ops)
237 " out-ops=" (obj-csv-names out-ops)
241 ; Compute list of all things we need to record at extraction time.
243 ; Discard #f entries, they indicate "unneeded".
247 (/sfmt-ifld-elm f sfmt))
250 (sfmt-op-sbuf-elm op sfmt))
252 (cond ((with-any-profile?)
254 ; Profiling support. ??? This stuff is in flux.
256 (sfmt-op-profile-elm op sfmt #f))
257 (find op-profilable? in-ops))
259 (sfmt-op-profile-elm op sfmt #t))
260 (find op-profilable? out-ops))))
266 ; Return #t if ELM-LIST is a subset of SBUF.
267 ; SBUF is an <sformat-argbuf> object.
269 (define (/sbuf-subset? elm-list sbuf)
270 ; We take advantage of the fact that elements in each are already sorted.
271 ; FIXME: Can speed up.
272 (let loop ((elm-list elm-list) (sbuf-elm-list (sbuf-elms sbuf)))
273 (cond ((null? elm-list)
275 ((null? sbuf-elm-list)
277 ((equal? (car elm-list) (car sbuf-elm-list))
278 (loop (cdr elm-list) (cdr sbuf-elm-list)))
280 (loop elm-list (cdr sbuf-elm-list)))))
283 ; Subroutine of compute-sformat-bufs!.
284 ; Lookup ELM-LIST in SBUF-LIST. A match is found if ELM-LIST
285 ; is a subset of one in SBUF-LIST.
286 ; Return the containing <sformat-argbuf> object if found, otherwise return #f.
287 ; SBUF-LIST is a list of <sformat-argbuf> objects.
288 ; ELM-LIST is (elm1 elm2 ...).
290 (define (/sbuf-lookup elm-list sbuf-list)
291 (let loop ((sbuf-list sbuf-list))
292 (cond ((null? sbuf-list)
294 ((/sbuf-subset? elm-list (car sbuf-list))
297 (loop (cdr sbuf-list)))))
300 ; Compute and record the set of <sformat-argbuf> objects needed for SFMT-LIST,
301 ; a list of all sformats.
302 ; The result is the computed list of <sformat-argbuf> objects.
304 ; This is used to further reduce the number of entries in the argument buffer's
305 ; `fields' union. Some sformats have structs with the same contents or one is
306 ; a subset of another's, thus there is no need to distinguish them as far as
307 ; the struct is concerned (there may be other reasons to distinguish them of
309 ; The consequence of this is fewer semantic fragments created in with-sem-frags
312 (define (compute-sformat-argbufs! sfmt-list)
313 (logit 1 "Computing sformat argument buffers ...\n")
316 ; Sort by descending length. This helps building the result: while
317 ; iterating over each element, its sbuf is either a subset of a
318 ; previous entry or requires a new entry.
319 (sort (map /sfmt-contents sfmt-list)
321 (> (length a) (length b)))))
322 ; Build an <sformat-argbuf> object.
323 (build-sbuf (lambda (sfmt-data)
324 (make <sformat-argbuf>
325 (obj:name (car sfmt-data))
330 ; Start off with the first sfmt.
331 ; Also build an empty sbuf. Which sbuf to use for an empty argument list
332 ; is rather arbitrary. Rather than pick one, keep the empty sbuf unto
334 (let ((nub-sbufs (list (build-sbuf (car sfmt-contents))))
335 (empty-sbuf (make <sformat-argbuf>
336 'sfmt-empty "no operands" atlist-empty
339 (sfmt-set-sbuf! (caar sfmt-contents) (car nub-sbufs))
341 ; Now loop over the remaining sfmts.
342 (let loop ((sfmt-contents (cdr sfmt-contents)))
343 (if (not (null? sfmt-contents))
344 (let ((sfmt-data (car sfmt-contents)))
345 (if (null? (cdr sfmt-data))
346 (sfmt-set-sbuf! (car sfmt-data) empty-sbuf)
347 (let ((sbuf (/sbuf-lookup (cdr sfmt-data) nub-sbufs)))
350 (set! sbuf (build-sbuf sfmt-data))
351 (set! nub-sbufs (cons sbuf nub-sbufs))))
352 (sfmt-set-sbuf! (car sfmt-data) sbuf)))
353 (loop (cdr sfmt-contents)))))
356 ; Note that the result will be sorted by ascending number of elements
357 ; (because the search list was sorted by descending length and the result
358 ; is built up in reverse order of that).
359 ; Not that it matters, but that's kinda nice.
360 (cons empty-sbuf nub-sbufs)))
365 ; By default hardware elements are not profilable.
367 (method-make! <hardware-base> 'profilable? (lambda (self) #f))
370 <hw-register> 'profilable?
371 (lambda (self) (has-attr? self 'PROFILE))
374 ; Return boolean indicating if HW is profilable.
376 (define (hw-profilable? hw) (send hw 'profilable?))
378 ; Return a boolean indicating if OP is profilable.
380 (define (op-profilable? op)
381 (hw-profilable? (op:type op))
384 ; sbuf-profile-data method.
385 ; Return a list of C type and size to use in an sformat's argument buffer.
388 <hardware-base> 'sbuf-profile-data
390 (error "sbuf-profile-elm not supported for this hw type"))
394 <hw-register> 'sbuf-profile-data
396 ; Don't unnecessarily bloat size of argument buffer.
397 (if (<= (hw-num-elms self) 255)
398 (list "unsigned char" 8)
399 (list "unsigned short" 16)))
402 ; Utility to return name of variable/structure-member to use to record
403 ; profiling data for SYM.
405 (define (gen-profile-sym sym out?)
406 (string-append (if out? "out_" "in_")
407 (if (symbol? sym) (symbol->string sym) sym))
410 ; Return name of variable/structure-member to use to record data needed for
411 ; profiling operand SELF.
414 <operand> 'sbuf-profile-sym
416 (gen-profile-sym (gen-sym self) out?))
419 ; sbuf-profile-elm method.
420 ; Return the ARGBUF member needed for profiling SELF in <sformat> SFMT.
421 ; The result is (var-name "C-type" approx-bitsize) or #f if unneeded.
424 <operand> 'sbuf-profile-elm
425 (lambda (self sfmt out?)
426 (if (hw-scalar? (op:type self))
428 (cons (send self 'sbuf-profile-sym out?)
429 (send (op:type self) 'sbuf-profile-data))))
432 ; Subroutine of /sfmt-contents to return an operand's profile element.
433 ; The result is (var-name "C-type" approx-bitsize) or #f if unneeded.
435 (define (sfmt-op-profile-elm op sfmt out?)
436 (send op 'sbuf-profile-elm sfmt out?)
439 ; ARGBUF accessor support.
441 ; Define and undefine C macros to tuck away details of instruction format used
442 ; in the extraction and semantic code. Instruction format names can
443 ; change frequently and this can result in unnecessarily large diffs from one
444 ; generated version of the file to the next. Secondly, tucking away details of
445 ; the extracted argument structure from the extraction code is a good thing.
447 ; Name of macro to access fields in ARGBUF.
448 (define c-argbuf-macro "FLD")
450 ; NB: If sfmt is #f, then define the macro to pass through the argument
451 ; symbol. This is appropriate for "simple" (non-scache) simulators
452 ; that have no abuf/scache in the sem.c routines, but rather plain
454 (define (gen-define-argbuf-macro sfmt)
455 (string-append "#define " c-argbuf-macro "(f) "
459 (gen-sym (sfmt-sbuf sfmt))
464 (define (gen-undef-argbuf-macro sfmt)
465 (string-append "#undef " c-argbuf-macro "\n")
468 ; For old code. Delete in time.
469 (define gen-define-field-macro gen-define-argbuf-macro)
470 (define gen-undef-field-macro gen-undef-argbuf-macro)
472 ; Return a C reference to an ARGBUF field value.
474 (define (gen-argbuf-ref name)
475 (string-append c-argbuf-macro " (" name ")")
478 ; Return name of ARGBUF member for extracted <field> F.
480 (define (gen-ifld-argbuf-name f)
484 ; Return the C reference to a cached ifield.
486 (define (gen-ifld-argbuf-ref f)
487 (gen-argbuf-ref (gen-ifld-argbuf-name f))
490 ; Return name of ARGBUF member holding processed from of extracted
491 ; ifield value for <hw-index> index.
493 (define (gen-hw-index-argbuf-name index)
497 ; Return C reference to a processed <hw-index> in ARGBUF.
499 (define (gen-hw-index-argbuf-ref index)
500 (gen-argbuf-ref (gen-hw-index-argbuf-name index))
505 ; Main procedure call tree:
506 ; cgen-decode.{c,cxx}
508 ; gen-decoder [our entry point]
510 ; /gen-decoder-switch
511 ; /gen-decode-table-entry
512 ; /gen-decoder-switch
514 ; decode-build-table is called to construct a tree of "table-guts" elements
515 ; (??? Need better name obviously),
516 ; and then gen-decoder is recursively called on each of these elements.
518 ; Return C/C++ code that fetches the desired decode bits from C value VAL.
519 ; SIZE is the size in bits of val (the MSB is 1 << (size - 1)) which we
521 ; BITNUMS must be monotonically increasing.
522 ; LSB0? is non-#f if bit number 0 is the least significant bit.
523 ; FIXME: START may not be handled right in words beyond first.
525 ; ENTIRE-VAL is passed as a hack for cgen 1.1 which would previously generate
526 ; negative shifts. FIXME: Revisit for 1.2.
528 ; e.g. (/gen-decode-bits '(0 1 2 3 8 9 10 11) 0 16 "insn" #f)
529 ; --> "(((insn >> 8) & 0xf0) | ((insn >> 4) & 0xf))"
530 ; FIXME: The generated code has some inefficiencies in edge cases. Later.
532 (define (/gen-decode-bits bitnums start size val entire-val lsb0?)
534 ; Compute a list of lists of three numbers:
535 ; (first bitnum in group, position in result (0=LSB), bits in result)
538 ; POS = starting bit position of current group.
539 ; COUNT = number of bits in group.
540 ; Work from least to most significant bit so reverse bitnums.
541 (let loop ((result nil) (pos 0) (count 0) (bitnums (reverse bitnums)))
542 ;(display (list result pos count bitnums)) (newline)
545 (if (or (= (length bitnums) 1)
546 ; Are numbers not next to each other?
547 (not (= (- (car bitnums) (if lsb0? -1 1))
549 (loop (cons (list (car bitnums) pos (+ 1 count))
557 ; While we could just always emit "(0" to handle the case of an empty set,
558 ; keeping the code more readable for the normal case is important.
559 (if (< (length groups) 1)
565 (let* ((first (car group))
568 ; Difference between where value is and where
572 (- (+ start size) (+ first bits)))
574 ; FIXME: There should never be a -ve shift here,
575 ; but it can occur on the m32r. Compensate here
576 ; with hack and fix in 1.2.
579 (set! val entire-val)
580 (set! shift (+ shift size))))
583 " | ((" val " >> " (number->string shift)
585 (number->string (- (integer-expt 2 bits) 1))
586 " << " (number->string pos) "))")))
591 ; Return code to set `itype' and branch to the extraction phase.
593 (define (/gen-set-itype-and-extract insn-enum fmt-name fn?)
600 (string-append "@prefix@_extract_" fmt-name
601 " (this, current_cpu, pc, base_insn, entire_insn);"
603 (string-append "goto extract_" fmt-name ";"))
607 ;; Return code to set `itype' and branch to the extraction phase,
608 ;; bracketed in { } and indented by INDENT.
610 (define (/gen-bracketed-set-itype-and-extract indent insn-enum fmt-name fn?)
613 (/gen-set-itype-and-extract insn-enum fmt-name fn?)
617 ; Return code for the default entry of each switch table
619 (define (/gen-decode-default-entry invalid-insn fn?)
620 (/gen-set-itype-and-extract (gen-cpu-insn-enum (current-cpu) invalid-insn)
625 ;; Subroutine of /all-opcode-bits-used? to simplify it.
626 ;; Given TABLE-GUTS-THUS-FAR return the mask of base its that have been
628 ;; TABLE-GUTS-THUS-FAR is a list of dtable-guts objects.
629 ;; PERF: Don't compute this for each insn, but that has to wait on the
630 ;; base-insn-bitsize cleanup (m32r).
632 (define (/table-guts-to-mask table-guts-thus-far base-bitsize lsb0?)
633 ;;(logit 2 "/table-guts-to-mask " (map dtable-guts-bitnums table-guts-thus-far) "\n")
634 (let guts-loop ((mask 0) (guts-list table-guts-thus-far))
635 (if (null? guts-list)
637 (let bits-loop ((mask mask) (bits (dtable-guts-bitnums (car guts-list))))
639 (guts-loop mask (cdr guts-list))
640 (bits-loop (+ mask (word-bit-value (car bits) base-bitsize lsb0?))
644 ;; Subroutine of /gen-decode-insn-entry to simplify it.
645 ;; Return a boolean indicating if all opcode bits of INSN have been
646 ;; examined given TABLE-GUTS-THUS-FAR.
647 ;; FIXME: Examine entire insn's opcode bits.
649 (define (/all-opcode-bits-used? insn table-guts-thus-far lsb0?)
650 (let* ((base-mask (insn-base-mask insn))
651 ;; FIXME: This can go away when base-insn-bitsize is fixed (m32r).
652 (base-bitsize (min (insn-base-mask-length insn) (state-base-insn-bitsize)))
653 (table-guts-base-mask (/table-guts-to-mask table-guts-thus-far
656 (= (cg-logand base-mask table-guts-base-mask) base-mask))
659 ; Return code for one insn entry, ENTRY.
660 ; REST is the remaining entries.
661 ; TABLE-GUTS-THUS-FAR is the list of dtable-guts objects that led to this insn.
663 (define (/gen-decode-insn-entry entry rest table-guts-thus-far
664 indent lsb0? invalid-insn fn?)
665 (assert (eq? 'insn (dtable-entry-type entry)))
666 (logit 3 "Generating decode insn entry for " (obj:name (dtable-entry-value entry)) " ...\n")
668 (let* ((insn (dtable-entry-value entry))
669 (fmt-name (gen-sym (insn-sfmt insn))))
673 ; Leave invalids to the default case.
674 ((eq? (obj:name insn) 'x-invalid)
677 ; If same contents as next case, fall through.
678 ; FIXME: Can reduce more by sorting cases. Much later.
679 ((and (not (null? rest))
681 (eq? 'insn (dtable-entry-type (car rest)))
684 (obj:name (dtable-entry-value (car rest)))))
685 (string-append indent " case "
686 (number->string (dtable-entry-index entry))
687 " : /* fall through */\n"))
690 (let ((consistent-base-insn? (and (equal? APPLICATION 'SID-SIMULATOR)
691 (> (state-base-insn-bitsize)
692 (insn-length insn)))))
693 (string-append indent " case "
694 (number->string (dtable-entry-index entry)) " :"
695 ;; Compensate for base-insn-size > current-insn-size by
696 ;; adjusting entire_insn.
697 ;; Activate this logic only for sid simulators; they are
698 ;; consistent in interpreting base-insn-bitsize this way.
699 (if consistent-base-insn?
702 indent " entire_insn = entire_insn >> "
703 (number->string (- (state-base-insn-bitsize) (insn-length insn)))
706 ;; If necessary, generate code to check that all of the
707 ;; opcode bits for this insn match.
708 (if (/all-opcode-bits-used? insn table-guts-thus-far lsb0?)
710 (if consistent-base-insn?
711 (string-append indent " ")
713 (/gen-set-itype-and-extract (gen-cpu-insn-enum (current-cpu) insn)
717 (if consistent-base-insn?
721 (if (adata-integral-insn? CURRENT-ARCH) "entire_insn" "base_insn")
722 " & " (gen-c-hex-constant (insn-base-mask insn) "CGEN_INSN_LGUINT")
723 ") == " (gen-c-hex-constant (insn-value insn) "CGEN_INSN_LGUINT") ")\n"
724 (/gen-bracketed-set-itype-and-extract (string-append indent " ")
725 (gen-cpu-insn-enum (current-cpu) insn)
728 (/gen-decode-default-entry invalid-insn fn?)
732 ; Subroutine of /decode-expr-ifield-tracking.
733 ; Return a list of all possible values for ifield IFLD-NAME.
734 ; FIXME: Quick-n-dirty implementation. Should use bit arrays.
736 (define (/decode-expr-ifield-values ifld-name)
737 (let* ((ifld (current-ifld-lookup ifld-name))
738 (bits (ifld-length ifld)))
739 (if (mode-unsigned? (ifld-mode ifld))
740 (iota (logsll 1 bits))
741 (iota (logsll 1 bits) (- (logsll 1 (- bits 1))))))
744 ; Subroutine of /decode-expr-ifield-tracking,/decode-expr-ifield-mark-used.
745 ; Create the search key for tracking table lookup.
747 (define (/decode-expr-ifield-tracking-key insn ifld-name)
748 (symbol-append (obj:name (insn-ifmt insn)) '-x- ifld-name)
751 ; Subroutine of /gen-decode-expr-entry.
752 ; Return a table to track used ifield values.
753 ; The table is an associative list of (key . value-list).
754 ; KEY is "iformat-name-x-ifield-name".
755 ; VALUE-LIST is a list of the unused values.
757 (define (/decode-expr-ifield-tracking expr-list)
761 (map (lambda (ifld-name)
762 (cons (exprtable-entry-insn entry)
764 (/decode-expr-ifield-values ifld-name))))
765 (exprtable-entry-iflds entry)))
767 ; TABLE1 is a list of (insn ifld-name value1 value2 ...).
768 (nub (map (lambda (elm)
770 (/decode-expr-ifield-tracking-key (car elm) (cadr elm))
776 ; Subroutine of /decode-expr-ifield-mark-used!.
777 ; Return list of values completely used for ifield IFLD-NAME in EXPR.
778 ; "completely used" here means the value won't appear elsewhere.
779 ; e.g. in (andif (eq f-rd 15) (eq f-rx 14)) we don't know what happens
780 ; for the (ne f-rx 14) case.
782 (define (/decode-expr-ifield-values-used ifld-name expr)
783 (case (rtx-name expr)
785 (if (and (rtx-kind? 'ifield (rtx-cmp-op-arg expr 0))
786 (rtx-constant? (rtx-cmp-op-arg expr 1)))
787 (list (rtx-constant-value (rtx-cmp-op-arg expr 1)))
790 (if (rtx-kind? 'ifield (rtx-member-value expr))
791 (rtx-member-set expr)
797 ; Subroutine of /gen-decode-expr-entry.
798 ; Mark ifield values used by EXPR-ENTRY in TRACKING-TABLE.
800 (define (/decode-expr-ifield-mark-used! tracking-table expr-entry)
801 (let ((insn (exprtable-entry-insn expr-entry))
802 (expr (exprtable-entry-expr expr-entry))
803 (ifld-names (exprtable-entry-iflds expr-entry)))
804 (for-each (lambda (ifld-name)
806 (assq (/decode-expr-ifield-tracking-key insn ifld-name)
808 (used (/decode-expr-ifield-values-used ifld-name expr)))
809 (for-each (lambda (value)
810 (delq! value table-entry))
817 ; Generate code to decode the expression table in ENTRY.
818 ; INVALID-INSN is the <insn> object of the pseudo insn to handle invalid ones.
820 (define (/gen-decode-expr-entry entry indent invalid-insn fn?)
821 (assert (eq? 'expr (dtable-entry-type entry)))
822 (logit 3 "Generating decode expr entry for " (exprtable-name (dtable-entry-value entry)) " ...\n")
824 (let ((expr-list (exprtable-insns (dtable-entry-value entry))))
827 (number->string (dtable-entry-index entry))
830 (let ((iflds-tracking (/decode-expr-ifield-tracking expr-list))
831 (indent (string-append indent " ")))
833 (let loop ((expr-list expr-list) (code nil))
835 (if (null? expr-list)
837 ; All done. If we used up all field values we don't need to
838 ; "fall through" and select the invalid insn marker.
840 (if (all-true? (map null? (map cdr iflds-tracking)))
844 (/gen-bracketed-set-itype-and-extract
846 (gen-cpu-insn-enum (current-cpu) invalid-insn)
850 ; Not all done, process next expr.
852 (let ((insn (exprtable-entry-insn (car expr-list)))
853 (expr (exprtable-entry-expr (car expr-list)))
854 (ifld-names (exprtable-entry-iflds (car expr-list))))
856 ; Mark of those ifield values we use first.
857 ; If there are none left afterwards, we can unconditionally
859 (/decode-expr-ifield-mark-used! iflds-tracking (car expr-list))
862 ; If this is the last expression, and it uses up all
863 ; remaining ifield values, there's no need to perform any
865 (if (and (null? (cdr expr-list))
866 (all-true? (map null? (map cdr iflds-tracking))))
868 ; Need this in a list for a later append!.
870 (/gen-bracketed-set-itype-and-extract
872 (gen-cpu-insn-enum (current-cpu) insn)
873 (gen-sym (insn-sfmt insn))
876 ; We don't use up all ifield values, so emit a test.
877 (let ((iflds (map current-ifld-lookup ifld-names)))
880 (gen-define-ifields iflds
882 (string-append indent " ")
884 (gen-extract-ifields iflds
886 (string-append indent " ")
889 (rtl-c 'BI expr nil #:ifield-var? #t)
891 (/gen-bracketed-set-itype-and-extract
892 (string-append indent " ")
893 (gen-cpu-insn-enum (current-cpu) insn)
894 (gen-sym (insn-sfmt insn))
898 (loop (cdr expr-list)
899 (append! code next-code)))))))
903 ; Generate code to decode TABLE.
904 ; REST is the remaining entries.
905 ; SWITCH-NUM, STARTBIT, DECODE-BITSIZE, TABLE-GUTS-THUS-FAR,
906 ; INDENT, LSB0?, INVALID-INSN are the same as for /gen-decoder-switch.
908 (define (/gen-decode-table-entry table rest switch-num startbit decode-bitsize
910 indent lsb0? invalid-insn fn?)
911 (assert (eq? 'table (dtable-entry-type table)))
912 (logit 3 "Generating decode table entry for case " (dtable-entry-index table) " ...\n")
916 (number->string (dtable-entry-index table))
918 ; If table is same as next, just emit a "fall through" to cut down on
920 (if (and (not (null? rest))
921 ; Ensure both tables.
922 (eq? 'table (dtable-entry-type (car rest)))
924 (eqv? (subdtable-key (dtable-entry-value table))
925 (subdtable-key (dtable-entry-value (car rest)))))
926 " /* fall through */\n"
929 (/gen-decoder-switch switch-num
932 (subdtable-table (dtable-entry-value table))
934 (string-append indent " ")
940 ; Subroutine of /decode-sort-entries.
941 ; Return a boolean indicating if A,B are equivalent entries.
943 (define (/decode-equiv-entries? a b)
944 (let ((a-type (dtable-entry-type a))
945 (b-type (dtable-entry-type b)))
946 (if (eq? a-type b-type)
949 (let ((a-name (obj:name (dtable-entry-value a)))
950 (b-name (obj:name (dtable-entry-value b))))
951 (eq? a-name b-name)))
953 ; Ignore expr entries for now.
956 (let ((a-name (subdtable-key (dtable-entry-value a)))
957 (b-name (subdtable-key (dtable-entry-value b))))
958 (eq? a-name b-name))))
959 ; A and B are not the same type.
963 ; Subroutine of /gen-decoder-switch, sort ENTRIES according to desired
964 ; print order (maximizes amount of fall-throughs, but maintains numerical
965 ; order as much as possible).
966 ; ??? This is an O(n^2) algorithm. An O(n Log(n)) algorithm can be done
967 ; but it seemed more complicated than necessary for now.
969 (define (/decode-sort-entries entries)
971 ; Return list of entries in non-empty list L that have the same decode
972 ; entry as the first entry. Entries found are marked with #f so
973 ; they're not processed again.
975 ; Start off the result with the first entry, then see if the
976 ; remaining ones match it.
977 (let ((first (car l)))
978 (let loop ((l (cdr l)) (result (cons first nil)))
981 (if (and (car l) (/decode-equiv-entries? first (car l)))
982 (let ((lval (car l)))
984 (loop (cdr l) (cons lval result)))
985 (loop (cdr l) result)))))))
987 (let loop ((entries (list-copy entries)) (result nil))
989 (apply append (reverse! result))
992 (cons (find-equiv! entries)
994 (loop (cdr entries) result)))))
997 ; Generate switch statement to decode TABLE-GUTS.
998 ; SWITCH-NUM is for compatibility with the computed goto decoder and
1000 ; STARTBIT is the bit offset of the instruction value that C variable `insn'
1001 ; holds (note that this is independent of LSB0?).
1002 ; DECODE-BITSIZE is the number of bits of the insn that `insn' holds.
1003 ; TABLE-GUTS-THUS-FAR is a list of the table-guts that got us here,
1004 ; excluding TABLE-GUTS. It is used to decide whether insns have been
1005 ; fully decoded (i.e. all opcode bits have been examined).
1006 ; LSB0? is non-#f if bit number 0 is the least significant bit.
1007 ; INVALID-INSN is the <insn> object of the pseudo insn to handle invalid ones.
1009 ; FIXME: for the few-alternative case (say, 2), generating
1011 ; else if (val == 0) { ... }
1012 ; else if (val == 1) { ... }
1014 ; may well be less stressful on the compiler to optimize than small switch() stmts.
1016 (define (/gen-decoder-switch switch-num startbit decode-bitsize
1017 table-guts table-guts-thus-far
1018 indent lsb0? invalid-insn fn?)
1020 (let ((new-table-guts-thus-far (append table-guts-thus-far (list table-guts))))
1024 ;; Are we at the next word?
1025 (if (not (= startbit (dtable-guts-startbit table-guts)))
1027 (set! startbit (dtable-guts-startbit table-guts))
1028 (set! decode-bitsize (dtable-guts-bitsize table-guts))
1029 ;; FIXME: Bits may get fetched again during extraction.
1030 (string-append indent " unsigned int val;\n"
1031 indent " /* Must fetch more bits. */\n"
1033 (gen-ifetch "pc" startbit decode-bitsize)
1036 (string-append indent " unsigned int val = "))
1037 (/gen-decode-bits (dtable-guts-bitnums table-guts)
1038 (dtable-guts-startbit table-guts)
1039 (dtable-guts-bitsize table-guts)
1040 "insn" "entire_insn" lsb0?)
1042 indent " switch (val)\n"
1045 ;; The code is more readable, and icache use is improved, if we collapse
1046 ;; common code into one case and use "fall throughs" for all but the last
1047 ;; of a set of common cases.
1048 ;; FIXME: We currently rely on /gen-decode-foo-entry to recognize the fall
1049 ;; through. We should take care of it ourselves.
1051 (let loop ((entries (/decode-sort-entries (dtable-guts-entries table-guts)))
1060 ;; For entries that are a single insn, we're done, otherwise recurse.
1061 (cons (case (dtable-entry-type (car entries))
1063 (/gen-decode-insn-entry (car entries) (cdr entries)
1064 new-table-guts-thus-far
1065 indent lsb0? invalid-insn fn?))
1067 (/gen-decode-expr-entry (car entries) indent invalid-insn fn?))
1069 (/gen-decode-table-entry (car entries) (cdr entries)
1070 switch-num startbit decode-bitsize
1071 new-table-guts-thus-far
1072 indent lsb0? invalid-insn fn?))
1076 ;; ??? Can delete if all cases are present.
1077 indent " default : "
1078 (/gen-decode-default-entry invalid-insn fn?) "\n"
1084 ; Decoder generation entry point.
1085 ; Generate code to decode INSN-LIST.
1086 ; BITNUMS is the set of bits to initially key off of.
1087 ; DECODE-BITSIZE is the number of bits of the instruction that `insn' holds.
1088 ; LSB0? is non-#f if bit number 0 is the least significant bit.
1089 ; INVALID-INSN is the <insn> object of the pseudo insn to handle invalid ones.
1090 ; FN? is non-#f if the extractors are functions rather than inline code
1092 (define (gen-decoder insn-list bitnums decode-bitsize indent lsb0? invalid-insn fn?)
1093 (logit 3 "Building decode tree.\n"
1094 "bitnums = " (stringize bitnums " ") "\n"
1095 "decode-bitsize = " (number->string decode-bitsize) "\n"
1096 "lsb0? = " (if lsb0? "#t" "#f") "\n"
1097 "fn? = " (if fn? "#t" "#f") "\n"
1100 ; First build a table that decodes the instruction set.
1102 (let ((table-guts (decode-build-table insn-list bitnums
1103 decode-bitsize lsb0?
1108 (/gen-decoder-switch "0" 0 decode-bitsize
1110 indent lsb0? invalid-insn fn?))