OSDN Git Service

whitespace fixes in previous patch
[pf3gnuchains/pf3gnuchains4x.git] / cgen / decode.scm
1 ; Application independent decoder support.
2 ; Copyright (C) 2000, 2004, 2009 Red Hat, Inc.
3 ; This file is part of CGEN.
4 ;
5 ; This file provides utilities for building instruction set decoders.
6 ; At present its rather limited, and is geared towards the simulator
7 ; where the goal is hyper-efficiency [not that there isn't room for much
8 ; improvement, but rather that that's what the current focus is].
9 ;
10 ; The CPU description file provides the first pass's bit mask with the
11 ; `decode-assist' spec.  This gives the decoder a head start on how to
12 ; efficiently decode the instruction set.  The rest of the decoder is
13 ; determined algorithmically.
14 ; ??? Need to say more here.
15 ;
16 ; The main entry point is decode-build-table.
17 ;
18 ; Main procedure call tree:
19 ; decode-build-table
20 ;     /build-slots
21 ;     /build-decode-table-guts
22 ;         /build-decode-table-entry
23 ;             /build-slots
24 ;             /build-decode-table-guts
25 ;
26 ; /build-slots//build-decode-table-guts are recursively called to construct a
27 ; tree of "table-guts" elements, and then the application recurses on the
28 ; result.  For example see sim-decode.scm.
29 ;
30 ; The decoder exits when insns are unambiguously determined, even if there are
31 ; more opcode bits to examine, leaving it to the caller to validate any
32 ; remaining bits.
33 ;
34 ; FIXME: Don't create more than 3 shifts (i.e. no more than 3 groups).
35 \f
36 ; Decoder data structures and accessors.
37 ; The set of instruction is internally recorded as a tree of two data
38 ; structures: "table-guts" and "table-entry".
39 ; [The choice of "table-guts" is historical, a better name will come to mind
40 ; eventually.]
41
42 ; Decoded tables data structure, termed "dtable-guts".
43 ; A simple data structure of 4 elements:
44 ; bitnums:  list of bits that have been used thus far to decode the insn
45 ; startbit: bit offset in instruction of value in C local variable `insn'
46 ;           (note that this is independent of LSB0?)
47 ; bitsize:  size of value in C local variable `insn'
48 ; entries:  list of insns that match the decoding thus far,
49 ;           each entry in the list is a `dtable-entry' record
50
51 (define (dtable-guts-make bitnums startbit bitsize entries)
52   (vector bitnums startbit bitsize entries)
53 )
54
55 ; Accessors.
56 (define (dtable-guts-bitnums tg) (vector-ref tg 0))
57 (define (dtable-guts-startbit tg) (vector-ref tg 1))
58 (define (dtable-guts-bitsize tg) (vector-ref tg 2))
59 (define (dtable-guts-entries tg) (vector-ref tg 3))
60
61 ; A decoded subtable.
62 ; A simple data structure of 3 elements:
63 ; key: name to distinguish this subtable from others, used for lookup
64 ; table: a table-guts element
65 ; name: name of C variable containing the table
66 ;
67 ; The implementation uses a list so the lookup can use assv.
68
69 (define (subdtable-make key table name)
70   (list key table name)
71 )
72
73 ; Accessors.
74 (define (subdtable-key st) (car st))
75 (define (subdtable-table st) (cadr st))
76 (define (subdtable-name st) (caddr st))
77
78 ; List of decode subtables.
79 (define /decode-subtables nil)
80
81 (define (subdtable-lookup key) (assv key /decode-subtables))
82
83 ; Add SUBTABLE-GUTS to the subtables list if not already present.
84 ; Result is the subtable entry already present, or new entry.
85 ; The key is computed so as to make comparisons possible with assv.
86
87 (define (subdtable-add subtable-guts name)
88   (let* ((key (string->symbol
89                (string-append
90                 (numbers->string (dtable-guts-bitnums subtable-guts) " ")
91                 " " (number->string (dtable-guts-bitsize subtable-guts))
92                 (string-map
93                  (lambda (elm)
94                    (case (dtable-entry-type elm)
95                      ((insn)
96                       (stringsym-append " " (obj:name (dtable-entry-value elm))))
97                      ((table)
98                       (stringsym-append " " (subdtable-name (dtable-entry-value elm))))
99                      ((expr)
100                       (stringsym-append " " (exprtable-name (dtable-entry-value elm))))
101                      (else (error "bad dtable entry type:"
102                                   (dtable-entry-type elm)))))
103                  (dtable-guts-entries subtable-guts)))))
104          (entry (subdtable-lookup key)))
105     (if (not entry)
106         (begin
107           (set! /decode-subtables (cons (subdtable-make key subtable-guts name)
108                                         /decode-subtables))
109           (car /decode-subtables))
110         entry))
111 )
112
113 ; An instruction and predicate for final matching.
114
115 (define (exprtable-entry-make insn expr)
116   (vector insn expr (rtl-find-ifields expr))
117 )
118
119 ; Accessors.
120
121 (define (exprtable-entry-insn entry) (vector-ref entry 0))
122 (define (exprtable-entry-expr entry) (vector-ref entry 1))
123 (define (exprtable-entry-iflds entry) (vector-ref entry 2))
124
125 ; Return a pseudo-cost of processing exprentry X.
126
127 (define (exprentry-cost x)
128   (let ((expr (exprtable-entry-expr x)))
129     (case (rtx-name expr)
130       ((member) (length (rtx-member-set expr)))
131       (else 4)))
132 )
133
134 ; Sort an exprtable, optimum choices first.
135 ; Basically an optimum choice is a cheaper choice.
136
137 (define (exprtable-sort expr-list)
138   (sort expr-list
139         (lambda (a b)
140           (let ((costa (exprentry-cost a))
141                 (costb (exprentry-cost b)))
142             (< costa costb))))
143 )
144
145 ; Return the name of the expr table for INSN-EXPRS,
146 ; which is a list of exprtable-entry elements.
147
148 (define (/gen-exprtable-name insn-exprs)
149   (string-map (lambda (x)
150                 (string-append (obj:str-name (exprtable-entry-insn x))
151                                "-"
152                                (rtx-strdump (exprtable-entry-expr x))))
153               insn-exprs)
154 )
155
156 ; A set of instructions that need expressions to distinguish.
157 ; Typically the expressions are ifield-assertion specs.
158 ; INSN-EXPRS is a sorted list of exprtable-entry elements.
159 ; The list is considered sorted in the sense that the first insn to satisfy
160 ; its predicate is chosen.
161
162 (define (exprtable-make name insn-exprs)
163   (vector name insn-exprs)
164 )
165
166 ; Accessors.
167
168 (define (exprtable-name etable) (vector-ref etable 0))
169 (define (exprtable-insns etable) (vector-ref etable 1))
170
171 ; Decoded table entry data structure.
172 ; A simple data structure of 3 elements:
173 ; index: index in the parent table
174 ; entry type indicator: 'insn or 'table or 'expr
175 ; value: the insn or subtable or exprtable
176
177 (define (dtable-entry-make index type value)
178   (assert value)
179   (vector index type value)
180 )
181
182 ; Accessors.
183 (define (dtable-entry-index te) (vector-ref te 0))
184 (define (dtable-entry-type te) (vector-ref te 1))
185 (define (dtable-entry-value te) (vector-ref te 2))
186 \f
187 ; Return #t if BITNUM is a good bit to use for decoding.
188 ; MASKS is a list of opcode masks.
189 ; MASK-LENS is a list of lengths of each value in MASKS.
190 ; BITNUM is the number of the bit to test.  It's value depends on LSB0?.
191 ; It can be no larger than the smallest element in MASKS.
192 ; E.g. If MASK-LENS consists of 16 and 32 and LSB0? is #f, BITNUM must
193 ; be from 0 to 15.
194 ; FIXME: This isn't quite right.  What if LSB0? = #t?  Need decode-bitsize.
195 ; LSB0? is non-#f if bit number 0 is the least significant bit.
196 ;
197 ; FIXME: This is just a first cut, but the governing intent is to not require
198 ; targets to specify decode tables, hints, or algorithms.
199 ; Certainly as it becomes useful they can supply such information.
200 ; The point is to avoid having to as much as possible.
201 ;
202 ; FIXME: Bit numbers shouldn't be considered in isolation.
203 ; It would be better to compute use counts of all of them and then see
204 ; if there's a cluster of high use counts.
205
206 (define (/usable-decode-bit? masks mask-lens bitnum lsb0?)
207   (let* ((has-bit (map (lambda (msk len)
208                          (bit-set? msk (if lsb0? bitnum (- len bitnum 1))))
209                        masks mask-lens)))
210     (or (all-true? has-bit)
211         ; If half or more insns use the bit, it's a good one.
212         ; FIXME: An empirical guess at best.
213         (>= (count-true has-bit) (quotient (length has-bit) 2))
214         ))
215 )
216
217 ; Compute population counts for each bit.  Return it as a vector indexed by bit
218 ; number.  Rather than computing raw popularity, attempt to compute
219 ; "disinguishing value" or inverse-entropy for each bit.  The idea is that the
220 ; larger the number for any particular bit slot, the more instructions it can
221 ; be used to distinguish.  Raw mask popularity is not enough -- popular masks
222 ; may include useless "reserved" fields whose values don't change, and thus are
223 ; useless in distinguishing.
224 ;
225 ; NOTE: mask-lens are not necessarily all the same value.
226 ; E.g. for the m32r it can consist of both 16 and 32.
227 ; But all masks must exist in the window specified by STARTBIT,DECODE-BITSIZE,
228 ; and all bits in the result must live in that window.
229 ; If no distinguishing bit fits in the window, return an empty vector.
230
231 (define (/distinguishing-bit-population masks mask-lens values lsb0?)
232   (let* ((max-length (apply max mask-lens))
233          (0-population (make-vector max-length 0))
234          (1-population (make-vector max-length 0))
235          (num-insns (length masks)))
236     ; Compute the 1- and 0-population vectors
237     (for-each (lambda (mask len value)
238                 (logit 5 " population count mask=" (number->hex mask) " len=" len "\n")
239                 (for-each (lambda (bitno)
240                             (let ((lsb-bitno (if lsb0? bitno (- len bitno 1))))
241                               ; ignore this bit if it's not set in the mask
242                               (if (bit-set? mask lsb-bitno)
243                                 (let ((chosen-pop-vector (if (bit-set? value lsb-bitno)
244                                                              1-population 0-population)))
245                                   (vector-set! chosen-pop-vector bitno
246                                                (+ 1 (vector-ref chosen-pop-vector bitno)))))))
247                           (/range len)))
248               masks mask-lens values)
249     ; Compute an aggregate "distinguishing value" for each bit.
250     (list->vector
251      (map (lambda (p0 p1)
252             (logit 4 p0 "/" p1 " ")
253             ; The most useful bits for decoding are those with counts in both
254             ; p0 and p1. These are the bits which distinguish one insn from
255             ; another. Assign these bits a high value (greater than num-insns).
256             ;
257             ; The next most useful bits are those with counts in either p0
258             ; or p1.  These bits represent specializations of other insns.
259             ; Assign these bits a value between 0 and (num-insns - 1). Note that
260             ; p0 + p1 is guaranteed to be <= num-insns. The value 0 is assigned
261             ; to bits for which p0 or p1 is equal to num_insns. These are bits
262             ; which are always 1 or always 0 in the ISA and are useless for
263             ; decoding purposes.
264             ;
265             ; Bits with no count in either p0 or p1 are useless for decoding
266             ; and should never be considered. Assigning these bits a value of
267             ; 0 ensures this.
268             (cond
269              ((= (+ p0 p1) 0) 0)
270              ((= (* p0 p1) 0) (- num-insns (+ p0 p1)))
271              (else (+ num-insns (sqrt (* p0 p1))))))
272           (vector->list 0-population) (vector->list 1-population))))
273 )
274
275 ; Return a list (0 ... LIMIT-1).
276
277 (define (/range limit)
278   (let loop ((i 0)
279              (indices (list)))
280     (if (= i limit)
281         (reverse! indices)
282         (loop (+ i 1) (cons i indices))))
283 )
284
285 ; Return a list (BASE ... BASE+SIZE-1).
286
287 (define (/range2 base size)
288   (let loop ((i base)
289              (indices (list)))
290     (if (= i (+ base size))
291         (reverse! indices)
292         (loop (+ i 1) (cons i indices))))
293 )
294
295 ; Return a copy of VECTOR, with all entries with given INDICES set
296 ; to VALUE.
297
298 (define (/vector-copy-set-all vector indices value)
299   (let ((new-vector (make-vector (vector-length vector))))
300     (for-each (lambda (index)
301                 (vector-set! new-vector index (if (memq index indices)
302                                                   value
303                                                   (vector-ref vector index))))
304               (/range (vector-length vector)))
305     new-vector)
306 )
307
308 ; Return a list of indices whose counts in the given vector exceed the given
309 ; threshold.
310 ; Sort them in decreasing order of popularity.
311
312 (define (/population-above-threshold population threshold)
313   (let* ((unsorted
314           (find (lambda (index) (if (vector-ref population index)
315                                     (>= (vector-ref population index) threshold)
316                                     #f))
317                 (/range (vector-length population))))
318          (sorted
319           (sort unsorted (lambda (i1 i2) (> (vector-ref population i1)
320                                             (vector-ref population i2))))))
321     sorted)
322 )
323
324 ; Return the top few most popular indices in the population vector,
325 ; ignoring any that are already used (marked by #f).  Don't exceed
326 ; `size' unless the clustering is just too good to pass up.
327
328 (define (/population-top-few population size)
329   (let loop ((old-picks (list))
330              (remaining-population population)
331              (count-threshold (apply max (map (lambda (value) (or value 0))
332                                               (vector->list population)))))
333       (let* ((new-picks (/population-above-threshold remaining-population count-threshold)))
334         (logit 4 "/population-top-few"
335                " desired=" size
336                " picks=(" old-picks ") pop=(" remaining-population ")"
337                " threshold=" count-threshold " new-picks=(" new-picks ")\n")
338         (cond
339          ; No point picking bits with population count of zero.  This leads to
340          ; the generation of layers of subtables which resolve nothing.  Generating
341          ; these tables can slow the build by several orders of magnitude.
342          ((= 0 count-threshold)
343           (logit 2 "/population-top-few: count-threshold is zero!\n")
344           old-picks)
345          ; No new matches?
346          ((null? new-picks)
347           (if (null? old-picks)
348               (logit 2 "/population-top-few: No bits left to pick from!\n"))
349           old-picks)
350          ; Way too many matches?
351          ((> (+ (length new-picks) (length old-picks)) (+ size 3))
352           (list-take (+ 3 size) (append old-picks new-picks))) ; prefer old-picks
353          ; About right number of matches?
354          ((> (+ (length new-picks) (length old-picks)) (- size 1))
355           (append old-picks new-picks))
356          ; Not enough?  Lower the threshold a bit and try to add some more.
357          (else
358           (loop (append old-picks new-picks)
359                 (/vector-copy-set-all remaining-population new-picks #f)
360                 ; Notice magic clustering decay parameter
361                 ;  vvvv
362                 (* 0.75 count-threshold))))))
363 )
364
365 ; Given list of insns, return list of bit numbers of constant bits in opcode
366 ; that they all share (or mostly share), up to MAX elements.
367 ; ALREADY-USED is a list of bitnums we can't use.
368 ; STARTBIT is the bit offset of the instruction value that C variable `insn'
369 ; holds (note that this is independent of LSB0?).
370 ; DECODE-BITSIZE is the number of bits of the insn that `insn' holds.
371 ; LSB0? is non-#f if bit number 0 is the least significant bit.
372 ;
373 ; Nil is returned if there are none, meaning that there is an ambiguity in
374 ; the specification up to the current word as defined by startbit,
375 ; decode-bitsize, and more bytes need to be fetched.
376 ;
377 ; We assume INSN-LIST matches all opcode bits before STARTBIT (if any).
378 ; FIXME: Revisit, as a more optimal decoder is sometimes achieved by doing
379 ; a cluster of opcode bits that appear later in the insn, and then coming
380 ; back to earlier ones.
381 ;
382 ; All insns are assumed to start at the same address so we handle insns of
383 ; varying lengths - we only analyze the common bits in all of them.
384 ;
385 ; Note that if we get called again to compute further opcode bits, we
386 ; start looking at STARTBIT again (rather than keeping track of how far in
387 ; the insn word we've progressed).  We could do this as an optimization, but
388 ; we also have to handle the case where the initial set of decode bits misses
389 ; some and thus we have to go back and look at them.  It may also turn out
390 ; that an opcode bit is skipped over because it doesn't contribute much
391 ; information to the decoding process (see /usable-decode-bit?).  As the
392 ; possible insn list gets wittled down, the bit will become significant.  Thus
393 ; the optimization is left for later.
394 ; Also, see preceding FIXME: We can't proceed past startbit + decode-bitsize
395 ; until we've processed all bits up to startbit + decode-bitsize.
396
397 (define (decode-get-best-bits insn-list already-used startbit max decode-bitsize lsb0?)
398   (let* ((raw-population (/distinguishing-bit-population (map insn-base-mask insn-list)
399                                                          (map insn-base-mask-length insn-list)
400                                                          (map insn-value insn-list)
401                                                          lsb0?))
402          ;; (undecoded (if lsb0?
403          ;;             (/range2 startbit (+ startbit decode-bitsize))
404          ;;             (/range2 (- startbit decode-bitsize) startbit)))
405          (used+undecoded already-used) ; (append already-used undecoded))
406          (filtered-population (/vector-copy-set-all raw-population used+undecoded #f))
407          (favorite-indices (/population-top-few filtered-population max))
408          (sorted-indices (sort favorite-indices (lambda (a b) 
409                                                   (if lsb0? (> a b) (< a b))))))
410     (logit 3
411            "Best decode bits (prev=" already-used " start=" startbit " decode=" decode-bitsize ")"
412            "=>"
413            "(" sorted-indices ")\n")
414     sorted-indices)
415 )
416
417 (define (OLDdecode-get-best-bits insn-list already-used startbit max decode-bitsize lsb0?)
418   (let ((masks (map insn-base-mask insn-list))
419         ; ??? We assume mask lengths are repeatedly used for insns longer
420         ; than the base insn size.
421         (mask-lens (map insn-base-mask-length insn-list))
422         (endbit (if lsb0?
423                     -1 ; FIXME: for now (gets sparc port going)
424                     (+ startbit decode-bitsize)))
425         (incr (if lsb0? -1 1)))
426     (let loop ((result nil)
427                (bitnum (if lsb0?
428                            (+ startbit (- decode-bitsize 1))
429                            startbit)))
430       (if (or (= (length result) max) (= bitnum endbit))
431           (reverse! result)
432           (if (and (not (memq bitnum already-used))
433                    (/usable-decode-bit? masks mask-lens bitnum lsb0?))
434               (loop (cons bitnum result) (+ bitnum incr))
435               (loop result (+ bitnum incr))))
436       ))
437 )
438
439 ;; Subroutine of /opcode-slots to simplify it.
440 ;; Compute either the opcode value or mask for the bits in BITNUMS.
441 ;; DEFAULT is 0 when computing the opcode value, 1 for the mask value.
442 ;; DECODE-LEN is (length BITNUMS).
443
444 (define (/get-subopcode-value value insn-len decode-len bitnums default lsb0?)
445   ;;(display (list val insn-len decode-len bl)) (newline)
446   ;; Oh My God.  This isn't tail recursive.
447   (letrec ((compute
448             ;; BNS is the remaining elements of BITNUMS to examine.
449             ;; THIS-BN ranges from (length bitnums), ..., 3, 2, 1.
450             (lambda (bns this-bn)
451               (if (null? bns)
452                   0
453                   (let ((bn (car bns)))
454                     (+ (if (or (and (>= bn insn-len) (= default 1))
455                                (and (< bn insn-len)
456                                     (bit-set? value
457                                               (if lsb0?
458                                                   bn
459                                                   (- insn-len bn 1)))))
460                            (integer-expt 2 (- this-bn 1))
461                            0)
462                        (compute (cdr bns) (- this-bn 1))))))))
463     (compute bitnums decode-len))
464 )
465
466 ; Return list of decode table entry numbers for INSN's opcode bits BITNUMS.
467 ; This is the indices into the decode table that match the instruction.
468 ; LSB0? is non-#f if bit number 0 is the least significant bit.
469 ;
470 ; Example: If BITNUMS is (0 1 2 3 4 5), and the constant (i.e. opcode) part of
471 ; the those bits of INSN is #b1100xx (where 'x' indicates a non-constant
472 ; part), then the result is (#b110000 #b110001 #b110010 #b110011).
473
474 (define (/opcode-slots insn bitnums lsb0?)
475   (let ((opcode (insn-value insn)) ;; FIXME: unused, overridden below
476         (insn-len (insn-base-mask-length insn))
477         (decode-len (length bitnums)))
478     (let* ((opcode (/get-subopcode-value (insn-value insn) insn-len decode-len bitnums 0 lsb0?))
479            (opcode-mask (/get-subopcode-value (insn-base-mask insn) insn-len decode-len bitnums 1 lsb0?))
480            (indices (missing-bit-indices opcode-mask (- (integer-expt 2 decode-len) 1))))
481       (logit 3 "insn =" (obj:name insn)
482              " insn-value=" (number->hex (insn-value insn))
483              " insn-base-mask=" (number->hex (insn-base-mask insn))
484              " insn-len=" insn-len
485              " decode-len=" decode-len
486              " opcode=" (number->hex opcode)
487              " opcode-mask=" (number->hex opcode-mask)
488              " indices=" indices "\n")
489       (map (lambda (index) (+ opcode index)) indices)))
490 )
491
492 ; Subroutine of /build-slots.
493 ; Fill slot in INSN-VEC that INSN goes into.
494 ; BITNUMS is the list of opcode bits.
495 ; LSB0? is non-#f if bit number 0 is the least significant bit.
496 ;
497 ; Example: If BITNUMS is (0 1 2 3 4 5) and the constant (i.e. opcode) part of
498 ; the first six bits of INSN is #b1100xx (where 'x' indicates a non-constant
499 ; part), then elements 48 49 50 51 of INSN-VEC are cons'd with INSN.
500 ; Each "slot" is a list of matching instructions.
501
502 (define (/fill-slot! insn-vec insn bitnums lsb0?)
503   (logit 3 "Filling slots for " (obj:str-name insn)
504          ", bitnums " bitnums "\n")
505   (let ((slot-nums (/opcode-slots insn bitnums lsb0?)))
506     ;(display (list "Filling slot(s)" slot-nums "...")) (newline)
507     (for-each (lambda (slot-num)
508                 (vector-set! insn-vec slot-num
509                              (cons insn (vector-ref insn-vec slot-num))))
510               slot-nums)
511     *UNSPECIFIED*
512     )
513 )
514
515 ; Given a list of constant bitnums (ones that are predominantly, though perhaps
516 ; not always, in the opcode), record each insn in INSN-LIST in the proper slot.
517 ; LSB0? is non-#f if bit number 0 is the least significant bit.
518 ; The result is a vector of insn lists.  Each slot is a list of insns
519 ; that go in that slot.
520
521 (define (/build-slots insn-list bitnums lsb0?)
522   (let ((result (make-vector (integer-expt 2 (length bitnums)) nil)))
523     ; Loop over each element, filling RESULT.
524     (for-each (lambda (insn)
525                 (/fill-slot! result insn bitnums lsb0?))
526               insn-list)
527     result)
528 )
529 \f
530 ; Compute the name of a decode table, prefixed with PREFIX.
531 ; INDEX-LIST is a list of pairs: list of bitnums, table entry number,
532 ; in reverse order of traversal (since they're built with cons).
533 ; INDEX-LIST may be empty.
534
535 (define (/gen-decode-table-name prefix index-list)
536   (set! index-list (reverse index-list))
537   (string-append
538    prefix
539    "table"
540    (string-map (lambda (elm) (string-append "_" (number->string elm)))
541                 ; CDR of each element is the table index.
542                (map cdr index-list)))
543 )
544
545 ; Generate one decode table entry for INSN-VEC at INDEX.
546 ; INSN-VEC is a vector of slots where each slot is a list of instructions that
547 ; map to that slot (opcode value).  If a slot is nil, no insn has that opcode
548 ; value so the decoder marks it as being invalid.
549 ; STARTBIT is the bit offset of the instruction value that C variable `insn'
550 ; holds (note that this is independent of LSB0?).
551 ; DECODE-BITSIZE is the number of bits of the insn that `insn' holds.
552 ; INDEX-LIST is a list of pairs: list of bitnums, table entry number.
553 ; LSB0? is non-#f if bit number 0 is the least significant bit.
554 ; INVALID-INSN is an <insn> object to use for invalid insns.
555 ; The result is a dtable-entry element (or "slot").
556
557 ; ??? For debugging.
558 (define /build-decode-table-entry-args #f)
559
560 (define (/build-decode-table-entry insn-vec startbit decode-bitsize index index-list lsb0? invalid-insn)
561   (let ((slot (vector-ref insn-vec index)))
562     (logit 2 "Processing decode entry "
563            (number->string index)
564            " in "
565            (/gen-decode-table-name "decode_" index-list)
566            ", "
567            (cond ((null? slot) "invalid")
568                  ((= 1 (length slot)) (insn-syntax (car slot)))
569                  (else "subtable"))
570            " ...\n")
571
572     (cond
573      ; If no insns map to this value, mark it as invalid.
574      ((null? slot) (dtable-entry-make index 'insn invalid-insn))
575
576      ; If only one insn maps to this value, that's it for this insn.
577      ((= 1 (length slot))
578       ; FIXME: Incomplete: need to check further opcode bits.
579       (dtable-entry-make index 'insn (car slot)))
580
581      ; Otherwise more than one insn maps to this value and we need to look at
582      ; further opcode bits.
583      (else
584       (logit 3 "Building subtable at index " (number->string index)
585              ", decode-bitsize = " (number->string decode-bitsize)
586              ", indices used thus far:"
587              (string-map (lambda (i) (string-append " " (number->string i)))
588                          (apply append (map car index-list)))
589              "\n")
590
591       (let ((bitnums (decode-get-best-bits slot
592                                            (apply append (map car index-list))
593                                            startbit 4
594                                            decode-bitsize lsb0?)))
595
596         ; If bitnums is nil, either there is an ambiguity or we need to read
597         ; more of the instruction in order to distinguish insns in SLOT.
598         (if (and (null? bitnums)
599                  (< startbit (apply min (map insn-length slot))))
600             (begin
601               ; We might be able to resolve the ambiguity by reading more bits.
602               ; We know from the < test that there are, indeed, more bits to
603               ; be read.
604               ; FIXME: It's technically possible that the next
605               ; startbit+decode-bitsize chunk has no usable bits and we have to
606               ; iterate, but rather unlikely.
607               ; The calculation of the new startbit, decode-bitsize will
608               ; undoubtedly need refinement.
609               (set! startbit (+ startbit decode-bitsize))
610               (set! decode-bitsize
611                     (min decode-bitsize
612                          (- (apply min (map insn-length slot))
613                             startbit)))
614               (set! bitnums (decode-get-best-bits slot
615                                                   ;nil ; FIXME: what to put here?
616                                                   (apply append (map car index-list))
617                                                   startbit 4
618                                                   decode-bitsize lsb0?))))
619
620         ; If bitnums is still nil there is an ambiguity.
621         (if (null? bitnums)
622             (begin
623               ; Try filtering out insns which are more general cases of
624               ; other insns in the slot.  The filtered insns will appear
625               ; in other slots as appropriate.
626               (set! slot (filter-non-specialized-ambiguous-insns slot))
627
628               (if (= 1 (length slot))
629                   ; Only 1 insn left in the slot, so take it.
630                   (dtable-entry-make index 'insn (car slot))
631                   ; There is still more than one insn in 'slot',
632                   ; so there is still an ambiguity.
633                   (begin
634                     ; If all insns are marked as DECODE-SPLIT, don't warn.
635                     (if (not (all-true? (map (lambda (insn)
636                                                (obj-has-attr? insn 'DECODE-SPLIT))
637                                              slot)))
638                         (message "WARNING: Decoder ambiguity detected: "
639                                  (string-drop1 ; drop leading comma
640                                   (string-map (lambda (insn)
641                                                 (string-append ", " (obj:str-name insn)))
642                                               slot))
643                                  "\n"))
644                         ; Things aren't entirely hopeless.  We've warned about
645                         ; the ambiguity.  Now, if there are any identical insns,
646                         ; filter them out.  If only one remains, then use it.
647                     (set! slot (filter-identical-ambiguous-insns slot))
648                     (if (= 1 (length slot))
649                         ; Only 1 insn left in the slot, so take it.
650                         (dtable-entry-make index 'insn (car slot))
651                         ; Otherwise, see if any ifield-assertion
652                         ; specs are present.
653                         ; FIXME: For now we assume that if they all have an
654                         ; ifield-assertion spec, then there is no ambiguity (it's left
655                         ; to the programmer to get it right).  This can be made more
656                         ; clever later.
657                         ; FIXME: May need to back up startbit if we've tried to read
658                         ; more of the instruction.  We currently require that
659                         ; all bits get used before advancing startbit, so this
660                         ; shouldn't be necessary.  Verify.
661                         (let ((assertions (map insn-ifield-assertion slot)))
662                           (if (not (all-true? assertions))
663                               (begin
664                                 ; Save arguments for debugging purposes.
665                                 (set! /build-decode-table-entry-args
666                                       (list insn-vec startbit decode-bitsize index index-list lsb0? invalid-insn))
667                                 (error "Unable to resolve ambiguity (maybe need some ifield-assertion specs?)")))
668                                 ; FIXME: Punt on even simple cleverness for now.
669                           (let ((exprtable-entries
670                                  (exprtable-sort (map exprtable-entry-make
671                                                       slot
672                                                       assertions))))
673                             (dtable-entry-make index 'expr
674                                                (exprtable-make
675                                                 (/gen-exprtable-name exprtable-entries)
676                                                 exprtable-entries))))))))
677
678             ; There is no ambiguity so generate the subtable.
679             ; Need to build `subtable' separately because we
680             ; may be appending to /decode-subtables recursively.
681             (let* ((insn-vec (/build-slots slot bitnums lsb0?))
682                    (subtable
683                     (/build-decode-table-guts insn-vec bitnums startbit
684                                               decode-bitsize index-list lsb0?
685                                               invalid-insn)))
686               (dtable-entry-make index 'table
687                                  (subdtable-add subtable
688                                                 (/gen-decode-table-name "" index-list)))))))
689      )
690     )
691 )
692
693 ; Given a vector of insn slots INSN-VEC, generate the guts of the decode table,
694 ; recorded as a "dtable-guts" data structure.
695 ;
696 ; BITNUMS is the list of bit numbers used to build the slot table.
697 ; I.e., (= (vector-length insn-vec) (ash 1 (length bitnums))).
698 ; STARTBIT is the bit offset of the instruction value that C variable `insn'
699 ; holds (note that this is independent of LSB0?).
700 ; For example, it is initially zero.  If DECODE-BITSIZE is 16 and after
701 ; scanning the first fetched piece of the instruction, more decoding is
702 ; needed, another piece will be fetched and STARTBIT will then be 16.
703 ; DECODE-BITSIZE is the number of bits of the insn that `insn' holds.
704 ; INDEX-LIST is a list of pairs: list of bitnums, table entry number.
705 ; Decode tables consist of entries of two types: actual insns and
706 ; pointers to other tables.
707 ; LSB0? is non-#f if bit number 0 is the least significant bit.
708 ; INVALID-INSN is an <insn> object representing invalid insns.
709 ;
710 ; BITNUMS is recorded with the guts so that tables whose contents are
711 ; identical but are accessed by different bitnums are treated as separate in
712 ; /decode-subtables.  Not sure this will ever happen, but play it safe.
713
714 (define (/build-decode-table-guts insn-vec bitnums startbit decode-bitsize index-list lsb0? invalid-insn)
715   (logit 2 "Processing decoder for bits"
716          (numbers->string bitnums " ")
717          ", startbit " startbit
718          ", decode-bitsize " decode-bitsize
719          ", index-list " index-list
720          " ...\n")
721   (assert (= (vector-length insn-vec) (ash 1 (length bitnums))))
722
723   (dtable-guts-make
724    bitnums startbit decode-bitsize
725    (map (lambda (index)
726           (/build-decode-table-entry insn-vec startbit decode-bitsize index
727                                      (cons (cons bitnums index)
728                                            index-list)
729                                      lsb0? invalid-insn))
730         (iota (vector-length insn-vec))))
731 )
732
733 ; Entry point.
734 ; Return a table that efficiently decodes INSN-LIST.
735 ; The table is a "dtable-guts" data structure, see dtable-guts-make.
736 ;
737 ; BITNUMS is the set of bits to initially key off of.
738 ; DECODE-BITSIZE is the number of bits of the instruction that `insn' holds.
739 ; LSB0? is non-#f if bit number 0 is the least significant bit.
740 ; INVALID-INSN is an <insn> object representing the `invalid' insn (for
741 ; instructions values that don't decode to any entry in INSN-LIST).
742
743 (define (decode-build-table insn-list bitnums decode-bitsize lsb0? invalid-insn)
744   ; Initialize the list of subtables computed.
745   (set! /decode-subtables nil)
746
747   ; ??? Another way to handle simple forms of ifield-assertions (like those
748   ; created by insn specialization) is to record a copy of the insn for each
749   ; possible value of the ifield and modify its ifield list with the ifield's
750   ; value.  This would then let the decoder table builder handle it normally.
751   ; I wouldn't create N insns, but would rather create an intermediary record
752   ; that recorded the necessary bits (insn, ifield-list, remaining
753   ; ifield-assertions).
754
755   (let ((insn-vec (/build-slots insn-list bitnums lsb0?)))
756     (let ((table-guts (/build-decode-table-guts insn-vec bitnums
757                                                 0 decode-bitsize
758                                                 nil lsb0?
759                                                 invalid-insn)))
760       table-guts))
761 )