OSDN Git Service

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