1 ; CPU architecture description.
2 ; Copyright (C) 2000, 2003, 2009 Red Hat, Inc.
3 ; This file is part of CGEN.
4 ; See file COPYING.CGEN for details.
6 ; Top level class that records everything about a cpu.
7 ; FIXME: Rename this to something else and rename <arch-data> to <arch>
8 ; for consistency with other classes (define-foo -> <foo> object).
14 ; An object of type <arch-data>.
17 ;; ??? All should really be assumed to be a black-box table.
18 (attr-list . (() . ()))
34 (insn-extract . #f) ; FIXME: wip (and move elsewhere)
35 (insn-execute . #f) ; FIXME: wip (and move elsewhere)
37 ; standard values derived from the input data
40 ; #t if multi-insns have been instantiated
41 (multi-insns-instantiated? . #f)
42 ; #t if instructions have been analyzed
43 (insns-analyzed? . #f)
44 ; #t if semantics were included in the analysis
45 (semantics-analyzed? . #f)
46 ; #t if alias insns were included in the analysis
47 (aliases-analyzed? . #f)
49 ; ordinal of next object that needs one
56 ; Each getter is arch-foo.
57 ; Each setter is arch-set-foo!.
59 (define-getters <arch> arch
61 attr-list enum-list kw-list
62 isa-list cpu-list mach-list model-list
63 ifld-table hw-list op-table ifmt-list sfmt-list
64 insn-table minsn-table subr-list
66 multi-insns-instantiated?
67 insns-analyzed? semantics-analyzed? aliases-analyzed?
72 (define-setters <arch> arch
74 attr-list enum-list kw-list
75 isa-list cpu-list mach-list model-list
76 ifld-table hw-list op-table ifmt-list sfmt-list
77 insn-table minsn-table subr-list
79 multi-insns-instantiated?
80 insns-analyzed? semantics-analyzed? aliases-analyzed?
85 ; For elements recorded as a table, return a sorted list.
86 ; ??? All elements should really be assumed to be a black-box table.
88 (define (arch-ifld-list arch)
89 (/ident-object-table->list (arch-ifld-table arch))
92 (define (arch-op-list arch)
93 (/ident-object-table->list (arch-op-table arch))
96 (define (arch-insn-list arch)
97 (/ident-object-table->list (arch-insn-table arch))
100 (define (arch-minsn-list arch)
101 (/ident-object-table->list (arch-minsn-table arch))
104 ;; Get the next ordinal and increment it for the next time.
106 (define (/get-next-ordinal! arch)
107 (let ((ordinal (arch-next-ordinal arch)))
108 (arch-set-next-ordinal! arch (+ ordinal 1))
112 ;; FIXME: temp hack for current-ifld-lookup, current-op-lookup.
113 ;; Return the element of list L with the lowest ordinal.
115 (define (/get-lowest-ordinal l)
116 (let ((lowest-obj #f)
117 (lowest-ord (/get-next-ordinal! CURRENT-ARCH)))
118 (for-each (lambda (elm)
119 (if (< (obj-ordinal elm) lowest-ord)
121 (set! lowest-obj elm)
122 (set! lowest-ord (obj-ordinal elm)))))
127 ;; Table of <source-ident> objects with two access styles:
128 ;; hash lookup, ordered list.
129 ;; The main table is the hash table, the list is lazily created and cached.
130 ;; The table is recorded as (hash-table . list).
131 ;; The list is #f if it needs to be computed.
132 ;; Each entry in the hash table is a list, multiple objects can have the same
133 ;; key (e.g. insns from different isas can have the same name).
135 ;; This relies on the ordinal element of <source-ident> objects to build the
138 (define (/make-ident-object-table hash-size)
139 (cons (make-hash-table hash-size) #f)
142 ;; Return ordered list.
144 ;; To allow splicing in new objects we recognize two kinds of ordinal numbers:
145 ;; integer and (integer . integer) where the latter is a pair of
146 ;; major-ordinal-number and minor-ordinal-number.
148 (define (/ident-object-table->list iot)
151 (let ((unsorted (hash-fold (lambda (key value prior)
152 ;; NOTE: {value} usually contains just
154 (append value prior))
158 (sort unsorted (lambda (a b)
159 ;; Ordinals are either an integer or
161 (let ((oa (obj-ordinal a))
162 (ob (obj-ordinal b)))
163 ;; Quick test for common case.
164 (if (and (number? oa) (number? ob))
166 (let ((maj-a (if (pair? oa) (car oa) oa))
167 (maj-b (if (pair? ob) (car ob) ob))
168 (min-a (if (pair? oa) (cdr oa) 0))
169 (min-b (if (pair? ob) (cdr ob) 0)))
170 (cond ((< maj-a maj-b) #t)
171 ((= maj-a maj-b) (< min-a min-b))
176 ;; Add an entry to an ident-object-table.
178 (define (/ident-object-table-add! arch iot key object)
179 ;; Give OBJECT an ordinal if it doesn't have one already.
180 (if (not (obj-ordinal object))
181 (obj-set-ordinal! object (/get-next-ordinal! arch)))
183 ;; Remember: Elements in the hash table are lists of objects, this is because
184 ;; multiple objects can have the same key if they come from different isas.
185 (let ((elm (hashq-ref (car iot) key)))
187 (hashq-set! (car iot) key (cons object elm))
188 (hashq-set! (car iot) key (cons object nil))))
190 ;; Need to recompute the sorted list.
196 ;; Look up KEY in an ident-object-table.
198 (define (/ident-object-table-lookup iot key)
202 ; Class for recording things specified in `define-arch'.
203 ; This simplifies define-arch as the global arch object CURRENT-ARCH
204 ; must exist before loading the .cpu file.
207 (class-make '<arch-data>
210 ; Default alignment of memory operations.
211 ; One of aligned, unaligned, forced.
214 ; Orientation of insn bit numbering (#f->msb=0, #t->lsb=0).
218 ; Each element is pair of (mach-name . sanitize-key)
219 ; where sanitize-key is #f if there is none.
220 ; blah blah blah ... ooohhh, evil sanitize key, blah blah blah
223 ; List of all isas (instruction set architecture).
224 ; Each element is a pair of (isa-name . sanitize-key)
225 ; where sanitize-key is #f if there is none.
226 ; There is usually just one. ARM has two (arm, thumb).
227 ; blah blah blah ... ooohhh, evil sanitize key, blah blah blah
230 ; ??? Defaults for other things should be here.
235 (define-getters <arch-data> adata
236 (default-alignment insn-lsb0? machs isas)
239 ; Add, list, lookup accessors for <arch>.
241 ; For the lookup routines, the result is the object or #f if not found.
242 ; For some, if X is already an object, return that.
244 (define (current-arch-name) (obj:name (arch-data CURRENT-ARCH)))
246 (define (current-arch-comment) (obj:comment (arch-data CURRENT-ARCH)))
248 (define (current-arch-atlist) (obj-atlist (arch-data CURRENT-ARCH)))
250 (define (current-arch-default-alignment)
251 (adata-default-alignment (arch-data CURRENT-ARCH)))
253 (define (current-arch-insn-lsb0?)
254 (adata-insn-lsb0? (arch-data CURRENT-ARCH)))
256 (define (current-arch-mach-name-list)
257 (map car (adata-machs (arch-data CURRENT-ARCH)))
260 (define (current-arch-isa-name-list)
261 (map car (adata-isas (arch-data CURRENT-ARCH)))
265 ; Recorded as a pair of lists.
266 ; The car is a list of <attribute> objects.
267 ; The cdr is an associative list of (name . <attribute>) elements, for lookup.
268 ; Could use a hash table except that there currently aren't that many.
270 (define (current-attr-list) (car (arch-attr-list CURRENT-ARCH)))
272 (define (current-attr-add! a)
273 ; NOTE: While putting this test in define-attr feels better, having it here
274 ; is more robust, internal calls get checked too. Thus it's here.
275 ; Ditto for all the other such tests in this file.
276 (if (current-attr-lookup (obj:name a))
277 (parse-error (make-current-context "define-attr")
278 "attribute already defined" (obj:name a)))
279 (let ((adata (arch-attr-list CURRENT-ARCH)))
280 ; Build list in normal order so we don't have to reverse it at the end
281 ; (since our format is non-trivial).
282 (if (null? (car adata))
283 (arch-set-attr-list! CURRENT-ARCH
285 (acons (obj:name a) a nil)))
287 (append! (car adata) (cons a nil))
288 (append! (cdr adata) (acons (obj:name a) a nil)))))
292 (define (current-attr-lookup attr-name)
293 (assq-ref (cdr (arch-attr-list CURRENT-ARCH)) attr-name)
298 (define (current-enum-list) (arch-enum-list CURRENT-ARCH))
300 (define (current-enum-add! e)
301 (if (current-enum-lookup (obj:name e))
302 (parse-error (make-current-context "define-enum")
303 "enum already defined" (obj:name e)))
304 (arch-set-enum-list! CURRENT-ARCH (cons e (arch-enum-list CURRENT-ARCH)))
308 (define (current-enum-lookup enum-name)
309 (object-assq enum-name (current-enum-list))
314 (define (current-kw-list) (arch-kw-list CURRENT-ARCH))
316 (define (current-kw-add! kw)
317 (if (current-kw-lookup (obj:name kw))
318 (parse-error (make-current-context "define-keyword")
319 "keyword already defined" (obj:name kw)))
320 (arch-set-kw-list! CURRENT-ARCH (cons kw (arch-kw-list CURRENT-ARCH)))
324 (define (current-kw-lookup kw-name)
325 (object-assq kw-name (current-kw-list))
330 (define (current-isa-list) (arch-isa-list CURRENT-ARCH))
332 (define (current-isa-add! i)
333 (if (current-isa-lookup (obj:name i))
334 (parse-error (make-current-context "define-isa")
335 "isa already defined" (obj:name i)))
336 (arch-set-isa-list! CURRENT-ARCH (cons i (arch-isa-list CURRENT-ARCH)))
340 (define (current-isa-lookup isa-name)
341 (object-assq isa-name (current-isa-list))
346 (define (current-cpu-list) (arch-cpu-list CURRENT-ARCH))
348 (define (current-cpu-add! c)
349 (if (current-cpu-lookup (obj:name c))
350 (parse-error (make-current-context "define-cpu")
351 "cpu already defined" (obj:name c)))
352 (arch-set-cpu-list! CURRENT-ARCH (cons c (arch-cpu-list CURRENT-ARCH)))
356 (define (current-cpu-lookup cpu-name)
357 (object-assq cpu-name (current-cpu-list))
362 (define (current-mach-list) (arch-mach-list CURRENT-ARCH))
364 (define (current-mach-add! m)
365 (if (current-mach-lookup (obj:name m))
366 (parse-error (make-current-context "define-mach")
367 "mach already defined" (obj:name m)))
368 (arch-set-mach-list! CURRENT-ARCH (cons m (arch-mach-list CURRENT-ARCH)))
372 (define (current-mach-lookup mach-name)
373 (object-assq mach-name (current-mach-list))
378 (define (current-model-list) (arch-model-list CURRENT-ARCH))
380 (define (current-model-add! m)
381 (if (current-model-lookup (obj:name m))
382 (parse-error (make-current-context "define-model")
383 "model already defined" (obj:name m)))
384 (arch-set-model-list! CURRENT-ARCH (cons m (arch-model-list CURRENT-ARCH)))
388 (define (current-model-lookup model-name)
389 (object-assq model-name (current-model-list))
394 (define (current-hw-list) (arch-hw-list CURRENT-ARCH))
396 (define (current-hw-add! hw)
397 (if (current-hw-lookup (obj:name hw))
398 (parse-error (make-current-context "define-hardware")
399 "hardware already defined" (obj:name hw)))
400 (arch-set-hw-list! CURRENT-ARCH (cons hw (arch-hw-list CURRENT-ARCH)))
404 (define (current-hw-lookup hw)
407 ; This doesn't use object-assq on purpose. Hardware objects handle
408 ; get-name specially.
409 (find-first (lambda (hw-obj) (eq? (send hw-obj 'get-name) hw))
413 ; Instruction fields.
415 (define (current-ifld-list)
416 (/ident-object-table->list (arch-ifld-table CURRENT-ARCH))
419 (define (current-ifld-add! f)
420 (if (/ifld-already-defined? f)
421 (parse-error (make-obj-context f "define-ifield")
422 "ifield already defined" (obj:name f)))
423 (/ident-object-table-add! CURRENT-ARCH (arch-ifld-table CURRENT-ARCH)
428 ;; Look up ifield X in the current architecture.
430 ;; If X is an <ifield> object, just return it.
431 ;; This is to handle ???
432 ;; Otherwise X is the name of the ifield to look up.
434 ;; ??? This doesn't work if there are multiple operands with the same name
435 ;; for different isas.
437 (define (current-ifld-lookup x)
440 (let ((f-list (/ident-object-table-lookup (car (arch-ifld-table CURRENT-ARCH))
443 (if (= (length f-list) 1)
445 ;; FIXME: For now just return the first one,
446 ;; same behaviour as before.
447 ;; Here "first one" means "first defined".
448 (/get-lowest-ordinal f-list))
452 ; Return a boolean indicating if <ifield> F is currently defined.
453 ; This is slightly complicated because multiple isas can have different
454 ; ifields with the same name.
456 (define (/ifld-already-defined? f)
457 (let ((iflds (/ident-object-table-lookup (car (arch-ifld-table CURRENT-ARCH))
459 ; We've got all the ifields with the same name,
460 ; now see if any have the same ISA as F.
463 (f-isas (obj-isa-list f)))
464 (for-each (lambda (ff)
465 (if (not (null? (intersection f-isas (obj-isa-list ff))))
474 (define (current-op-list)
475 (/ident-object-table->list (arch-op-table CURRENT-ARCH))
478 (define (current-op-add! op)
479 (if (/op-already-defined? op)
480 (parse-error (make-obj-context op "define-operand")
481 "operand already defined" (obj:name op)))
482 (/ident-object-table-add! CURRENT-ARCH (arch-op-table CURRENT-ARCH)
487 ; ??? This doesn't work if there are multiple operands with the same name
488 ; for different isas.
490 (define (current-op-lookup name)
491 (let ((op-list (/ident-object-table-lookup (car (arch-op-table CURRENT-ARCH))
494 (if (= (length op-list) 1)
496 ;; FIXME: For now just return the first one, same behaviour as before.
497 ;; Here "first one" means "first defined".
498 (/get-lowest-ordinal op-list))
502 ; Return a boolean indicating if <operand> OP is currently defined.
503 ; This is slightly complicated because multiple isas can have different
504 ; operands with the same name.
506 (define (/op-already-defined? op)
507 (let ((ops (/ident-object-table-lookup (car (arch-op-table CURRENT-ARCH))
509 ; We've got all the operands with the same name,
510 ; now see if any have the same ISA as OP.
513 (op-isas (obj-isa-list op)))
514 (for-each (lambda (o)
515 (if (not (null? (intersection op-isas (obj-isa-list o))))
522 ; Instruction field formats.
524 (define (current-ifmt-list) (arch-ifmt-list CURRENT-ARCH))
526 ; Semantic formats (akin to ifmt's, except includes semantics to distinguish
529 (define (current-sfmt-list) (arch-sfmt-list CURRENT-ARCH))
533 (define (current-insn-list)
534 (/ident-object-table->list (arch-insn-table CURRENT-ARCH))
537 (define (current-insn-add! i)
538 (if (/insn-already-defined? i)
539 (parse-error (make-obj-context i "define-insn")
540 "insn already defined" (obj:name i)))
541 (/ident-object-table-add! CURRENT-ARCH (arch-insn-table CURRENT-ARCH)
546 ; ??? This doesn't work if there are multiple insns with the same name
547 ; for different isas.
549 (define (current-insn-lookup name)
550 (let ((i (/ident-object-table-lookup (car (arch-insn-table CURRENT-ARCH))
556 ;; FIXME: For now just flag an error.
557 ;; Later add an isa-list arg to distinguish.
558 (error "multiple insns with name:" name)))
562 ; Return a boolean indicating if <insn> INSN is currently defined.
563 ; This is slightly complicated because multiple isas can have different
564 ; insns with the same name.
566 (define (/insn-already-defined? insn)
567 (let ((insns (/ident-object-table-lookup (car (arch-insn-table CURRENT-ARCH))
569 ; We've got all the insns with the same name,
570 ; now see if any have the same ISA as INSN.
573 (insn-isas (obj-isa-list insn)))
574 (for-each (lambda (i)
575 (if (not (null? (intersection insn-isas (obj-isa-list i))))
582 ; Macro instructions.
584 (define (current-minsn-list)
585 (/ident-object-table->list (arch-minsn-table CURRENT-ARCH))
588 (define (current-minsn-add! m)
589 (if (/minsn-already-defined? m)
590 (parse-error (make-obj-context m "define-minsn")
591 "macro-insn already defined" (obj:name m)))
592 (/ident-object-table-add! CURRENT-ARCH (arch-minsn-table CURRENT-ARCH)
597 ; ??? This doesn't work if there are multiple minsns with the same name
598 ; for different isas.
600 (define (current-minsn-lookup name)
601 (let ((m (/ident-object-table-lookup (car (arch-minsn-table CURRENT-ARCH))
607 ;; FIXME: For now just flag an error.
608 ;; Later add an isa-list arg to distinguish.
609 (error "multiple macro-insns with name:" name)))
613 ; Return a boolean indicating if <macro-insn> MINSN is currently defined.
614 ; This is slightly complicated because multiple isas can have different
615 ; macro-insns with the same name.
617 (define (/minsn-already-defined? m)
618 (let ((minsns (/ident-object-table-lookup (car (arch-minsn-table CURRENT-ARCH))
620 ; We've got all the macro-insns with the same name,
621 ; now see if any have the same ISA as M.
624 (m-isas (obj-isa-list m)))
625 (for-each (lambda (mm)
626 (if (not (null? (intersection m-isas (obj-isa-list mm))))
635 (define (current-subr-list) (map cdr (arch-subr-list CURRENT-ARCH)))
637 (define (current-subr-add! s)
638 (if (current-subr-lookup (obj:name s))
639 (parse-error (make-current-context "define-subr")
640 "subroutine already defined" (obj:name s)))
641 (arch-set-subr-list! CURRENT-ARCH
642 (acons (obj:name s) s (arch-subr-list CURRENT-ARCH)))
646 (define (current-subr-lookup name)
647 (assq-ref (arch-subr-list CURRENT-ARCH) name)
650 ; Arch parsing support.
652 ; Parse an alignment spec.
654 (define (/arch-parse-alignment context alignment)
655 (if (memq alignment '(aligned unaligned forced))
657 (parse-error context "invalid alignment" alignment))
660 ; Parse an arch mach spec.
661 ; The value is a list of mach names or (mach-name sanitize-key) elements.
662 ; The result is a list of (mach-name . sanitize-key) elements.
664 (define (/arch-parse-machs context machs)
665 (for-each (lambda (m)
667 (and (list? m) (= (length m) 2)
668 (symbol? (car m)) (symbol? (cadr m))))
670 (parse-error context "bad arch mach spec" m)))
675 (cons (car m) (cadr m))))
679 ; Parse an arch isa spec.
680 ; The value is a list of isa names or (isa-name sanitize-key) elements.
681 ; The result is a list of (isa-name . sanitize-key) elements.
683 (define (/arch-parse-isas context isas)
684 (for-each (lambda (m)
686 (and (list? m) (= (length m) 2)
687 (symbol? (car m)) (symbol? (cadr m))))
689 (parse-error context "bad arch isa spec" m)))
694 (cons (car m) (cadr m))))
698 ; Parse an architecture description
699 ; This is the main routine for building an arch object from a cpu
700 ; description in the .cpu file.
701 ; All arguments are in raw (non-evaluated) form.
703 (define (/arch-parse context name comment attrs
704 default-alignment insn-lsb0?
706 (logit 2 "Processing arch " name " ...\n")
708 (parse-name context name)
709 (parse-comment context comment)
710 (atlist-parse context attrs "arch")
711 (/arch-parse-alignment context default-alignment)
712 (parse-boolean context insn-lsb0?)
713 (/arch-parse-machs context machs)
714 (/arch-parse-isas context isas))
717 ; Read an architecture description.
718 ; This is the main routine for analyzing an arch description in the .cpu file.
719 ; ARG-LIST is an associative list of field name and field value.
720 ; parse-arch is invoked to create the `arch' object.
724 (let ((context "arch-read")
725 ; <arch-data> object members and default values
729 (default-alignment 'aligned)
734 ; Loop over each element in ARG-LIST, recording what's found.
735 (let loop ((arg-list arg-list))
738 (let ((arg (car arg-list))
739 (elm-name (caar arg-list)))
741 ((name) (set! name (cadr arg)))
742 ((comment) (set! comment (cadr arg)))
743 ((attrs) (set! attrs (cdr arg)))
744 ((default-alignment) (set! default-alignment (cadr arg)))
745 ((insn-lsb0?) (set! insn-lsb0? (cadr arg)))
746 ((machs) (set! machs (cdr arg)))
747 ((isas) (set! isas (cdr arg)))
748 (else (parse-error context "invalid arch arg" arg)))
749 (loop (cdr arg-list)))))
750 ; Ensure required fields are present.
752 (parse-error context "missing machs spec"))
754 (parse-error context "missing isas spec"))
755 ; Now that we've identified the elements, build the object.
756 (/arch-parse context name comment attrs default-alignment insn-lsb0?
762 ; Define an arch object, name/value pair list version.
766 (let ((a (apply /arch-read arg-list)))
767 (arch-set-data! CURRENT-ARCH a)
768 (def-mach-attr! (adata-machs a))
769 (keep-mach-validate!)
770 (def-isa-attr! (adata-isas a))
772 ; Install the builtin objects now that we have an arch, and now that
773 ; attributes MACH and ISA exist.
774 (reader-install-builtin!)
778 ; Mach/isa processing.
780 ; Create the MACH attribute.
781 ; MACHS is the canonicalized machs spec to define-arch: (name . sanitize-key).
783 (define (def-mach-attr! machs)
784 (let ((mach-enums (append
790 (list (cons 'sanitize (cdr mach)))
794 (define-attr '(type bitset) '(name MACH)
795 '(comment "machine type selection")
796 '(default base) (cons 'values mach-enums))
802 ; Return #t if MACH is supported by OBJ.
803 ; This is done by looking for the MACH attribute in OBJ.
804 ; By definition, objects that support the default (base) mach support
807 (define (mach-supports? mach obj)
808 (let ((machs (bitset-attr->list (obj-attr-value obj 'MACH)))
809 (name (obj:name mach)))
810 (or (memq name machs)
812 ;(let ((deflt (attr-lookup-default 'MACH obj)))
813 ; (any-true? (map (lambda (m) (memq m deflt)) machs)))))
816 ; Create the ISA attribute.
817 ; ISAS is the canonicalized isas spec to define-arch: (name . sanitize-key).
818 ; ISAS is a list of isa names.
820 (define (def-isa-attr! isas)
821 (let ((isa-enums (append
826 (list (cons 'sanitize (cdr isa)))
830 ; Using a bitset attribute here implies something could be used by two
831 ; separate isas. This seems highly unlikely but we don't [as yet]
832 ; preclude it. The other thing to consider is whether the cpu table
833 ; would ever want to be opened for multiple isas.
834 (define-attr '(type bitset) '(name ISA)
835 '(comment "instruction set selection")
836 ; If there's only one isa, don't (yet) pollute the tables with a value
838 (if (= (length isas) 1)
840 '(for ifield operand insn hardware))
841 (cons 'values isa-enums))
847 ; Return the bitset attr value for all isas.
849 (define (all-isas-attr-value)
850 (stringize (current-arch-isa-name-list) ",")
853 ; Return an ISA attribute of all isas.
854 ; This is useful for things like f-nil which exist across all isas.
856 (define (all-isas-attr)
857 (bitset-attr-make 'ISA (all-isas-attr-value))
860 ; Return list of ISA names specified by attribute object ATLIST.
862 (define (attr-isa-list atlist)
863 (bitset-attr->list (atlist-attr-value atlist 'ISA #f))
866 ; Return list of ISA names specified by OBJ.
868 (define (obj-isa-list obj)
869 (bitset-attr->list (obj-attr-value obj 'ISA))
872 ; Return #t if <isa> ISA is supported by OBJ.
873 ; This is done by looking for the ISA attribute in OBJ.
875 (define (isa-supports? isa obj)
876 (let ((isas (obj-isa-list obj))
877 (name (obj:name isa)))
878 (->bool (memq name isas)))
881 ; The fetch/decode/execute process.
882 ; "extract" is a fancy word for fetch/decode.
883 ; FIXME: wip, not currently used.
884 ; FIXME: move to inside define-isa, and maybe elsewhere.
887 ; define-extract (code)
888 ; ;(arch-set-insn-extract! CURRENT-ARCH code)
893 ; define-execute (code)
894 ; ;(arch-set-insn-execute! CURRENT-ARCH code)
899 ; Each architecture is generally one isa, but in the case of ARM (and a few
900 ; others) there is more than one.
902 ; ??? "ISA" has a very well defined meaning, and our usage of it one might
903 ; want to quibble over. A better name would be welcome.
905 ; Associated with an instruction set is its framing.
906 ; This refers to how instructions are laid out at the liw level (where several
907 ; insns are framed together and executed sequentially or in parallel).
908 ; ??? If one defines the term "format" as being how an individual instruction
909 ; is laid out then formatting can be thought of as being different from
910 ; framing. However, it's possible for a particular ISA to intertwine the two.
911 ; Thus this will need to evolve.
912 ; ??? Not used yet, wip.
914 (define <iframe> ; pronounced I-frame
915 (class-make '<iframe> '(<ident>)
917 ; list of <itype> objects that make up the frame
923 ; list of (length value) elements that make up the format
924 ; Length is in bits. Value is either a number or a $number
925 ; symbol refering to the insn specified in `insns'.
928 ; Initial bitnumbers to decode insns by.
929 ; ??? At present the rest of the decoding is determined
930 ; algorithmically. May wish to give the user more control
934 ; rtl that executes instructions in `value'
935 ; Fields specified in `value' can be used here.
943 (define-getters <iframe> iframe (insns syntax value decode-assist action))
945 ; Instruction types, recorded in <iframe>.
946 ; ??? Not used yet, wip.
949 (class-make '<itype> '(<ident>)
951 ; length in bits, or initial part if variable length (wip)
954 ; constraint specifying which insns are included
957 ; Initial bitnumbers to decode insns by.
958 ; ??? At present the rest of the decoding is determined
959 ; algorithmically. May wish to give the user more control
968 (define-getters <itype> itype (length constraint decode-assist))
970 ; Simulator instruction decode splitting.
971 ; FIXME: Should live in simulator specific code. Requires class handling
974 ; Instructions can be split by particular values for an ifield.
975 ; The ARM port uses this to split insns into those that set the pc and
978 (define <decode-split>
979 (class-make '<decode-split> '()
981 ; Name of ifield to split on.
984 ; Constraint. Only insns satifying this constraint are
985 ; split. #f if no constraint.
988 ; List of ifield splits.
989 ; Each element is one of (name value) or (name (values)).
998 (define-getters <decode-split> decode-split (name constraint values))
1000 ; Parse a decode-split spec.
1001 ; SPEC is (ifield-name constraint value-list).
1002 ; CONSTRAINT is an rtl expression. Only insns satifying the constraint
1004 ; Each element of VALUE-LIST is one of (name value) or (name (values)).
1005 ; FIXME: All possible values must be specified. Need an `else' clause.
1006 ; Ranges would also be useful.
1008 (define (/isa-parse-decode-split context spec)
1009 (if (!= (length spec) 3)
1010 (parse-error context "decode-split spec is (ifield-name constraint value-list)" spec))
1012 (let ((name (parse-name (car spec) context))
1013 (constraint (cadr spec))
1014 (value-list (caddr spec)))
1016 ; FIXME: more error checking.
1018 (make <decode-split>
1020 (if (null? constraint) #f constraint)
1024 ; Parse a list of decode-split specs.
1026 (define (/isa-parse-decode-splits context spec-list)
1028 (/isa-parse-decode-split context spec))
1032 ; Top level class to describe an isa.
1035 (class-make '<isa> '(<ident>)
1037 ; Default length to record in ifields.
1038 ; This is used in calculations involving bit numbers.
1039 default-insn-word-bitsize
1041 ; Length of an unknown instruction. Used by disassembly
1042 ; and by the simulator's invalid insn handler.
1043 default-insn-bitsize
1045 ; Number of bytes of insn that can be initially fetched.
1046 ; In non-LIW isas this would be the length of the smallest
1047 ; insn. For LIW isas it depends - only one LIW isa is
1048 ; currently supported (m32r).
1051 ; Initial bitnumbers to decode insns by.
1052 ; ??? At present the rest of the decoding is determined
1053 ; algorithmically. May wish to give the user more control
1057 ; Number of instructions that can be fetched at a time
1061 ; Maximum number of instructions the cpu can execute in
1063 ; FIXME: Rename to max-parallel-insns.
1066 ; List of <iframe> objects.
1069 ; Condition tested before execution of any instruction or
1070 ; #f if there is none. For architectures like ARM, ARC.
1071 ; If specified it is a pair of
1072 ; (condition-field-name . rtl-for-condition)
1075 ; Code to execute after CONDITION and prior to SEMANTICS.
1076 ; This is rtl in source form or #f if there is none.
1077 ; This is generally unused. It is used on the ARM to set
1078 ; R15 to the correct value.
1079 ; The reason it's not specified with SEMANTICS is that it is
1080 ; believed some applications won't need/want this.
1081 ; ??? It is a bit of a hack though, as it is used to aid
1082 ; implementation of apps (e.g. simulator). Arguably something
1083 ; that doesn't belong here. Maybe as more architectures are
1084 ; ported that have the PC as a general register, a better way
1085 ; to do this will arise.
1086 (setup-semantics . #f)
1088 ; list of simulator instruction splits
1089 ; FIXME: should live in simulator file (needs class cleanup).
1090 (decode-splits . ())
1092 ; ??? More may need to migrate here.
1099 (define-getters <isa> isa
1100 (base-insn-bitsize default-insn-bitsize default-insn-word-bitsize
1101 decode-assist liw-insns parallel-insns condition
1102 setup-semantics decode-splits)
1105 (define-setters <isa> isa
1109 (define (isa-enum isa) (string-append "ISA_" (string-upcase (gen-sym isa))))
1111 ; Return minimum/maximum size in bits of all insns in the isa.
1113 (define (isa-min-insn-bitsize isa)
1114 ; add `65535' in case list is nil (avoids crash)
1115 ; [a language with infinite precision can't have min-reduce-iota-0 :-)]
1116 (apply min (cons 65535
1117 (map insn-length (find (lambda (insn)
1118 (and (not (has-attr? insn 'ALIAS))
1119 (isa-supports? isa insn)))
1120 (non-multi-insns (current-insn-list))))))
1123 (define (isa-max-insn-bitsize isa)
1124 ; add `0' in case list is nil (avoids crash)
1125 ; [a language with infinite precision can't have max-reduce-iota-0 :-)]
1127 (map insn-length (find (lambda (insn)
1128 (and (not (has-attr? insn 'ALIAS))
1129 (isa-supports? isa insn)))
1130 (non-multi-insns (current-insn-list))))))
1133 ; Return a boolean indicating if instructions in ISA can be kept in a
1136 (define (isa-integral-insn? isa)
1137 (<= (isa-max-insn-bitsize isa) 32)
1140 ;; Parse an isa decode-assist spec.
1142 (define (/isa-parse-decode-assist context spec)
1143 (if (not (all-true? (map non-negative-integer? spec)))
1144 (parse-error context
1145 "spec must consist of non-negative-integers"
1147 (if (not (= (length spec) (length (nub spec identity))))
1148 (parse-error context
1149 "duplicate elements"
1154 ; Parse an isa condition spec.
1155 ; `condition' here refers to the condition performed by architectures like
1156 ; ARM and ARC before each insn.
1158 (define (/isa-parse-condition context spec)
1162 (if (or (!= (length spec) 2)
1163 (not (symbol? (car spec)))
1164 (not (form? (cadr spec))))
1165 (parse-error context
1166 "condition spec not `(ifield-name rtl-code)'" spec))
1170 ; Parse a setup-semantics spec.
1172 (define (/isa-parse-setup-semantics context spec)
1173 (if (not (null? spec))
1178 ; Parse an isa spec.
1179 ; The result is the <isa> object.
1180 ; All arguments are in raw (non-evaluated) form.
1182 (define (/isa-parse context name comment attrs
1183 base-insn-bitsize default-insn-bitsize default-insn-word-bitsize
1184 decode-assist liw-insns parallel-insns condition
1185 setup-semantics decode-splits)
1186 (logit 2 "Processing isa " name " ...\n")
1188 ;; Pick out name first to augment the error context.
1189 (let* ((name (parse-name context name))
1190 (context (context-append-name context name)))
1192 (if (not (memq name (current-arch-isa-name-list)))
1193 (parse-error context "isa name is not present in `define-arch'" name))
1195 ; Isa's are always kept - we need them to validate later uses, even if
1196 ; the then resulting object won't be kept. All isas are also needed to
1197 ; compute a proper value for the isas-cache member of <hardware-base>
1198 ; for builtin objects.
1201 (parse-comment context comment)
1202 (atlist-parse context attrs "isa")
1203 (parse-number (context-append context
1204 ": default-insn-word-bitsize")
1205 default-insn-word-bitsize '(8 . 128))
1206 (parse-number (context-append context
1207 ": default-insn-bitsize")
1208 default-insn-bitsize '(8 . 128))
1209 (parse-number (context-append context
1210 ": base-insn-bitsize")
1211 base-insn-bitsize '(8 . 128))
1212 (/isa-parse-decode-assist (context-append context
1217 (/isa-parse-condition context condition)
1218 (/isa-parse-setup-semantics context setup-semantics)
1219 (/isa-parse-decode-splits context decode-splits)
1223 ; Read an isa entry.
1224 ; ARG-LIST is an associative list of field name and field value.
1226 (define (/isa-read context . arg-list)
1231 (base-insn-bitsize #f)
1232 (default-insn-bitsize #f)
1233 (default-insn-word-bitsize #f)
1236 ;; FIXME: Hobbit computes the wrong symbol for `parallel-insns'
1237 ;; in the `case' expression below because there is a local var
1238 ;; of the same name ("__1" gets appended to the symbol name).
1241 (setup-semantics nil)
1245 (let loop ((arg-list arg-list))
1246 (if (null? arg-list)
1248 (let ((arg (car arg-list))
1249 (elm-name (caar arg-list)))
1251 ((name) (set! name (cadr arg)))
1252 ((comment) (set! comment (cadr arg)))
1253 ((attrs) (set! attrs (cdr arg)))
1254 ((default-insn-word-bitsize)
1255 (set! default-insn-word-bitsize (cadr arg)))
1256 ((default-insn-bitsize) (set! default-insn-bitsize (cadr arg)))
1257 ((base-insn-bitsize) (set! base-insn-bitsize (cadr arg)))
1258 ((decode-assist) (set! decode-assist (cadr arg)))
1259 ((liw-insns) (set! liw-insns (cadr arg)))
1260 ((parallel-insns) (set! parallel-insns- (cadr arg)))
1261 ((condition) (set! condition (cdr arg)))
1262 ((setup-semantics) (set! setup-semantics (cadr arg)))
1263 ((decode-splits) (set! decode-splits (cdr arg)))
1264 ((insn-types) #t) ; ignore for now
1265 ((frame) #t) ; ignore for now
1266 (else (parse-error context "invalid isa arg" arg)))
1267 (loop (cdr arg-list)))))
1269 ;; Now that we've identified the elements, build the object.
1270 (/isa-parse context name comment attrs
1272 (if default-insn-word-bitsize
1273 default-insn-word-bitsize
1275 (if default-insn-bitsize
1276 default-insn-bitsize
1278 decode-assist liw-insns parallel-insns- condition
1279 setup-semantics decode-splits))
1282 ; Define a <isa> object, name/value pair list version.
1286 (let ((i (apply /isa-read (cons (make-current-context "define-isa")
1289 (current-isa-add! i))
1293 ; Subroutine of modify-isa to process one add-decode-split spec.
1295 (define (/isa-add-decode-split! context isa spec)
1296 (let ((decode-split (/isa-parse-decode-split context spec)))
1297 (isa-set-decode-splits! (cons decode-split (isa-decode-splits isa)))
1301 ; Main routine for modifying existing isa definitions
1305 (let ((context (make-current-context "modify-isa"))
1306 (isa-spec (assq 'name arg-list)))
1308 (parse-error context "isa name not specified"))
1310 (let ((isa (current-isa-lookup (arg-list-symbol-arg context isa-spec))))
1312 (parse-error context "undefined isa" isa-spec))
1314 (let loop ((args arg-list))
1317 (let ((arg-spec (car args)))
1318 (case (car arg-spec)
1319 ((name) #f) ; ignore, already processed
1321 (/isa-add-decode-split! context isa (cdr arg-spec)))
1323 (parse-error context "invalid/unsupported option" (car arg-spec))))
1324 (loop (cdr args)))))))
1329 ; Return boolean indicating if ISA supports parallel execution.
1331 (define (isa-parallel-exec? isa) (> (isa-parallel-insns isa) 1))
1333 ; Return a boolean indicating if ISA supports conditional execution
1334 ; of all instructions.
1336 (define (isa-conditional-exec? isa) (->bool (isa-condition isa)))
1338 ; The `<cpu>' object collects together various details about a particular
1339 ; subset of the architecture (e.g. perhaps all 32 bit variants of the sparc
1341 ; This is called a "cpu-family".
1342 ; ??? May be renamed to <family> (both internally and in the .cpu file).
1343 ; ??? Another way to do this would be to discard the family notion and allow
1344 ; machs to inherit from other machs, as well as use isas to distinguish
1345 ; sufficiently dissimilar machs. This would remove a fuzzy illspecified
1346 ; notion with a concrete one.
1347 ; ??? Maybe a better way to organize sparc32 vs sparc64 is via an isa.
1353 ; one of big/little/either/#f.
1354 ; If #f, then {insn,data,float}-endian are used.
1355 ; Otherwise they're ignored.
1358 ; one of big/little/either.
1361 ; one of big/little/either/big-words/little-words.
1362 ; If big-words then each word is little-endian.
1363 ; If little-words then each word is big-endian.
1366 ; one of big/little/either/big-words/little-words.
1369 ; number of bits in a word.
1372 ; number of bits in a chunk of an instruction word, for
1373 ; endianness conversion purposes; 0 = no chunking
1376 ; Transformation to use in generated files should one be
1377 ; needed. At present the only supported value is a string
1378 ; which is the file suffix.
1379 ; ??? A dubious element of the description language, but given
1380 ; the quantity of generated files, some machine generated
1381 ; headers may need to #include other machine generated headers
1385 ; Allow a cpu family to override the isa parallel-insns spec.
1386 ; ??? Concession to the m32r port which can go away, in time.
1389 ; Computed: maximum number of insns which may pass before there
1390 ; an insn writes back its output operands.
1399 (define-getters <cpu> cpu (word-bitsize insn-chunk-bitsize file-transform parallel-insns max-delay))
1400 (define-setters <cpu> cpu (max-delay))
1402 ; Return endianness of instructions.
1404 (define (cpu-insn-endian cpu)
1405 (let ((endian (elm-xget cpu 'endian)))
1408 (elm-xget cpu 'insn-endian)))
1411 ; Return endianness of data.
1413 (define (cpu-data-endian cpu)
1414 (let ((endian (elm-xget cpu 'endian)))
1417 (elm-xget cpu 'data-endian)))
1420 ; Return endianness of floats.
1422 (define (cpu-float-endian cpu)
1423 (let ((endian (elm-xget cpu 'endian)))
1426 (elm-xget cpu 'float-endian)))
1429 ; Parse a cpu family description
1430 ; This is the main routine for building a <cpu> object from a cpu
1431 ; description in the .cpu file.
1432 ; All arguments are in raw (non-evaluated) form.
1434 (define (/cpu-parse context name comment attrs
1435 endian insn-endian data-endian float-endian
1436 word-bitsize insn-chunk-bitsize file-transform parallel-insns)
1437 (logit 2 "Processing cpu family " name " ...\n")
1439 ;; Pick out name first to augment the error context.
1440 (let* ((name (parse-name context name))
1441 (context (context-append-name context name)))
1443 (if (keep-cpu? name)
1446 (parse-comment context comment)
1447 (atlist-parse context attrs "cpu")
1448 endian insn-endian data-endian float-endian
1453 0 ; default max-delay. will compute correct value
1456 (logit 2 "Ignoring " name ".\n")
1457 #f))) ; cpu is not to be kept
1460 ; Read a cpu family description
1461 ; This is the main routine for analyzing a cpu description in the .cpu file.
1462 ; CONTEXT is a <context> object for error messages.
1463 ; ARG-LIST is an associative list of field name and field value.
1464 ; /cpu-parse is invoked to create the <cpu> object.
1466 (define (/cpu-read context . arg-list)
1476 (insn-chunk-bitsize 0)
1478 ;; FIXME: Hobbit computes the wrong symbol for `parallel-insns'
1479 ;; in the `case' expression below because there is a local var
1480 ;; of the same name ("__1" gets appended to the symbol name).
1481 (parallel-insns- #f)
1484 ;; Loop over each element in ARG-LIST, recording what's found.
1485 (let loop ((arg-list arg-list))
1486 (if (null? arg-list)
1488 (let ((arg (car arg-list))
1489 (elm-name (caar arg-list)))
1491 ((name) (set! name (cadr arg)))
1492 ((comment) (set! comment (cadr arg)))
1493 ((attrs) (set! attrs (cdr arg)))
1494 ((endian) (set! endian (cadr arg)))
1495 ((insn-endian) (set! insn-endian (cadr arg)))
1496 ((data-endian) (set! data-endian (cadr arg)))
1497 ((float-endian) (set! float-endian (cadr arg)))
1498 ((word-bitsize) (set! word-bitsize (cadr arg)))
1499 ((insn-chunk-bitsize) (set! insn-chunk-bitsize (cadr arg)))
1500 ((file-transform) (set! file-transform (cadr arg)))
1501 ((parallel-insns) (set! parallel-insns- (cadr arg)))
1502 (else (parse-error context "invalid cpu arg" arg)))
1503 (loop (cdr arg-list)))))
1505 ;; Now that we've identified the elements, build the object.
1506 (/cpu-parse context name comment attrs
1507 endian insn-endian data-endian float-endian
1508 word-bitsize insn-chunk-bitsize file-transform parallel-insns-))
1511 ; Define a cpu family object, name/value pair list version.
1515 (let ((c (apply /cpu-read (cons (make-current-context "define-cpu")
1519 (current-cpu-add! c)
1520 (mode-set-word-modes! (cpu-word-bitsize c))
1521 (hw-update-word-modes!)
1526 ; The `<mach>' object describes one member of a `cpu' family.
1529 (class-make '<mach> '(<ident>)
1531 ; cpu family this mach is a member of
1535 ; list of <isa> objects
1543 (define-getters <mach> mach (cpu bfd-name isas))
1545 (define (mach-enum obj)
1546 (string-append "MACH_" (string-upcase (gen-sym obj)))
1549 (define (mach-number obj) (mach-enum obj))
1551 (define (machs-for-cpu cpu)
1552 (let ((cpu-name (obj:name cpu)))
1553 (find (lambda (mach)
1554 (eq? (obj:name (mach-cpu mach)) cpu-name))
1555 (current-mach-list)))
1558 ; Parse a machine entry.
1559 ; The result is a <mach> object or #f if the mach isn't to be kept.
1560 ; All arguments are in raw (non-evaluated) form.
1562 (define (/mach-parse context name comment attrs cpu bfd-name isas)
1563 (logit 2 "Processing mach " name " ...\n")
1565 ;; Pick out name first to augment the error context.
1566 (let* ((name (parse-name context name))
1567 (context (context-append-name context name)))
1569 (if (not (list? isas))
1570 (parse-error context "isa spec not a list" isas))
1571 (let ((cpu-obj (current-cpu-lookup cpu))
1572 (isa-list (map current-isa-lookup isas)))
1573 (if (not (memq name (current-arch-mach-name-list)))
1574 (parse-error context "mach name is not present in `define-arch'" name))
1576 (parse-error context "missing cpu spec" cpu))
1578 (parse-error context "unknown cpu" cpu))
1580 (parse-error context "missing isas spec" isas))
1581 (if (not (all-true? isa-list))
1582 (parse-error context "unknown isa in" isas))
1583 (if (not (string? bfd-name))
1584 (parse-error context "bfd-name not a string" bfd-name))
1586 (if (keep-mach? (list name))
1590 (parse-comment context comment)
1591 (atlist-parse context attrs "mach")
1597 (logit 2 "Ignoring " name ".\n")
1598 #f)))) ; mach is not to be kept
1601 ; Read a mach entry.
1602 ; CONTEXT is a <context> object for error messages.
1603 ; ARG-LIST is an associative list of field name and field value.
1605 (define (/mach-read context . arg-list)
1615 (let loop ((arg-list arg-list))
1616 (if (null? arg-list)
1618 (let ((arg (car arg-list))
1619 (elm-name (caar arg-list)))
1621 ((name) (set! name (cadr arg)))
1622 ((comment) (set! comment (cadr arg)))
1623 ((attrs) (set! attrs (cdr arg)))
1624 ((cpu) (set! cpu (cadr arg)))
1625 ((bfd-name) (set! bfd-name (cadr arg)))
1626 ((isas) (set! isas (cdr arg)))
1627 (else (parse-error context "invalid mach arg" arg)))
1628 (loop (cdr arg-list)))))
1630 ;; Now that we've identified the elements, build the object.
1631 (/mach-parse context name comment attrs cpu
1632 ;; Default bfd-name is same as object's name.
1633 (if bfd-name bfd-name (symbol->string name))
1634 ;; Default isa is the first one.
1635 (if isas isas (list (obj:name (car (current-isa-list)))))))
1638 ; Define a <mach> object, name/value pair list version.
1642 (let ((m (apply /mach-read (cons (make-current-context "define-mach")
1645 (current-mach-add! m))
1649 ; Miscellaneous state derived from the input data.
1650 ; FIXME: being redone
1652 ; Size of a word in bits.
1653 ; All selected cpu families must have same value or error.
1654 ; Ergo, don't use this if multiple word-bitsize values are expected.
1655 ; E.g. opcodes support for architectures with both 32 and 64 variants.
1657 (define (state-word-bitsize)
1658 (let* ((wb-list (map cpu-word-bitsize (current-cpu-list)))
1659 (result (car wb-list)))
1660 (for-each (lambda (wb)
1662 (error "multiple word-bitsize values" wb-list)))
1667 ; Return maximum word bitsize.
1669 (define (state-max-word-bitsize)
1670 (apply max (map cpu-word-bitsize (current-cpu-list)))
1673 ; Size of normal instruction.
1674 ; All selected isas must have same value or error.
1676 (define (state-default-insn-bitsize)
1677 (let ((dib (map isa-default-insn-bitsize (current-isa-list))))
1678 ; FIXME: ensure all have same value.
1682 ; Number of bytes of insn we can initially fetch.
1683 ; All selected isas must have same value or error.
1685 (define (state-base-insn-bitsize)
1686 (let ((bib (map isa-base-insn-bitsize (current-isa-list))))
1687 ; FIXME: ensure all have same value.
1691 ; Return parallel-insns spec.
1693 (define (state-parallel-insns)
1694 ; Assert only one cpu family has been selected.
1697 (let ((par-insns (map isa-parallel-insns (current-isa-list)))
1698 (cpu-par-insns (cpu-parallel-insns (current-cpu))))
1699 ; ??? The m32r does have parallel execution, but to keep support for the
1700 ; base mach simpler, a cpu family is allowed to override the isa spec.
1702 ; FIXME: ensure all have same value.
1706 ; Return boolean indicating if parallel execution support is required.
1708 (define (state-parallel-exec?)
1709 (> (state-parallel-insns) 1)
1712 ; Return liw-insns spec.
1714 (define (state-liw-insns)
1715 (let ((liw-insns (map isa-liw-insns (current-isa-list))))
1716 ; FIXME: ensure all have same value.
1720 ; Return decode-assist spec.
1722 (define (state-decode-assist)
1723 (isa-decode-assist (current-isa))
1726 ; Return boolean indicating if current isa conditionally executes all insn.
1728 (define (state-conditional-exec?)
1729 (isa-conditional-exec? (current-isa))
1732 ; Architecture or cpu wide values derived from other data.
1734 (define <derived-arch-data>
1735 (class-make '<derived-arch-data>
1738 ; whether all insns can be recorded in a host int
1744 ; Called after the .cpu file has been read in to prime derived value
1746 ; Often this data isn't needed so we only computed it if we have to.
1748 (define (/adata-set-derived! arch)
1749 ; Don't compute this data unless we need to.
1752 (make <derived-arch-data>
1754 (delay (isa-integral-insn? (current-isa)))
1760 (define (adata-integral-insn? arch)
1761 (force (elm-xget (arch-derived arch) 'integral-insn?))
1764 ; Instruction analysis control.
1766 ;; The maximum number of virtual insns.
1767 ;; They can be recorded with negative ordinals, and multi-insns are currently
1768 ;; also recorded as negative numbers, so leave enough space.
1769 (define MAX-VIRTUAL-INSNS 100)
1771 ;; Subroutine of arch-analyze-insns! to simplify it.
1772 ;; Sanity check the instruction set.
1774 (define (/sanity-check-insns arch)
1775 (let ((insn-list (arch-insn-list arch)))
1777 ;; Ensure instruction base values agree with their masks.
1778 ;; Errors can come from bad .cpu files, bugs, or both.
1779 ;; It's better to catch such errors early.
1780 ;; If it is an error in the .cpu file, we don't want to crash
1781 ;; on a Guile error.
1787 (let ((base-len (insn-base-mask-length insn))
1788 (base-mask (insn-base-mask insn))
1789 (base-value (insn-base-value insn)))
1790 (if (not (= (cg-logand (cg-logxor base-mask (mask base-len))
1793 (context-owner-error
1795 "While performing sanity checks"
1796 (string-append "Instruction has opcode bits outside of its mask.\n"
1797 "This usually means some kind of error in the instruction's ifield list.\n"
1798 "base mask: 0x" (number->hex base-mask)
1799 ", base value: 0x" (number->hex base-value)
1801 (string-map (lambda (f)
1803 (ifld-pretty-print f)))
1807 ;; Insert more checks here.
1811 (non-multi-insns (non-alias-insns insn-list))))
1816 ;; Instantiate the multi-insns of ARCH (if there are any).
1818 (define (/instantiate-multi-insns! arch)
1819 ;; Skip if already done, we don't want to create duplicates.
1821 (if (not (arch-multi-insns-instantiated? arch))
1824 (if (any-true? (map multi-insn? (arch-insn-list arch)))
1827 ; Instantiate sub-insns of all multi-insns.
1828 (logit 1 "Instantiating multi-insns ...\n")
1830 ;; FIXME: Hack to remove differences in generated code when we
1831 ;; switched to recording insns in hash tables.
1832 ;; Multi-insn got instantiated after the list of insns had been
1833 ;; reversed and they got added to the front of the list, in
1834 ;; reverse order. Blech!
1835 ;; Eventually remove this, have a flag day, and check in the
1837 ;; NOTE: This causes major diffs to opcodes/m32c-*.[ch].
1838 (let ((orig-ord (arch-next-ordinal arch)))
1839 (arch-set-next-ordinal! arch (- MAX-VIRTUAL-INSNS))
1840 (for-each (lambda (insn)
1841 (multi-insn-instantiate! insn))
1842 (multi-insns (arch-insn-list arch)))
1843 (arch-set-next-ordinal! arch orig-ord))
1845 (logit 1 "Done instantiating multi-insns.\n")
1848 (arch-set-multi-insns-instantiated?! arch #t)
1852 ;; Subroutine of arch-analyze-insns! to simplify it.
1853 ;; Canonicalize INSNS of ARCH.
1855 (define (/canonicalize-insns! arch insn-list)
1856 (logit 1 "Canonicalizing instruction semantics ...\n")
1858 (for-each (lambda (insn)
1859 (cond ((insn-canonical-semantics insn)
1861 ((insn-semantics insn)
1862 (logit 2 "Canonicalizing semantics for " (obj:name insn) " ...\n")
1865 (make-obj-context insn
1866 (string-append "canonicalizing semantics of "
1867 (obj:str-name insn)))
1868 'VOID (insn-semantics insn) nil)))
1869 (insn-set-canonical-semantics! insn canon-sem)))
1871 (logit 2 "Skipping instruction " (obj:name insn) ", no semantics ...\n"))))
1874 (logit 1 "Done canonicalization.\n")
1877 ; Analyze the instruction set.
1878 ; The name is explicitly vague because it's intended that all insn analysis
1879 ; would be controlled here.
1880 ; If the instruction set has already been sufficiently analyzed, do nothing.
1881 ; INCLUDE-ALIASES? is #t if alias insns are to be included.
1882 ; ANALYZE-SEMANTICS? is #t if insn semantics are to be analyzed.
1884 ; This is a very expensive operation, so we only do it as necessary.
1885 ; There are (currently) two different kinds of users: assemblers and
1886 ; simulators. Assembler style apps don't always need to analyze the semantics.
1887 ; Simulator style apps don't want to include the alias insns.
1889 (define (arch-analyze-insns! arch include-aliases? analyze-semantics?)
1890 ; Catch apps that haven't set word sizes yet.
1891 (mode-ensure-word-sizes-defined)
1893 (if (or (not (arch-insns-analyzed? arch))
1894 (not (eq? analyze-semantics? (arch-semantics-analyzed? arch)))
1895 (not (eq? include-aliases? (arch-aliases-analyzed? arch))))
1899 (/instantiate-multi-insns! arch)
1901 (let ((insn-list (non-multi-insns
1902 (if include-aliases?
1903 (arch-insn-list arch)
1904 (non-alias-insns (arch-insn-list arch))))))
1906 ;; Compile each insns semantics, traversers/evaluators require it.
1907 (/canonicalize-insns! arch insn-list)
1909 ;; This is expensive so indicate start/finish.
1910 (logit 1 "Analyzing instruction set ...\n")
1913 (ifmt-compute! insn-list
1914 analyze-semantics?)))
1916 (arch-set-ifmt-list! arch (car fmt-lists))
1917 (arch-set-sfmt-list! arch (cadr fmt-lists))
1918 (arch-set-insns-analyzed?! arch #t)
1919 (arch-set-semantics-analyzed?! arch analyze-semantics?)
1920 (arch-set-aliases-analyzed?! arch include-aliases?)
1922 ;; Now that the instruction formats are computed,
1923 ;; do some sanity checks.
1924 (logit 1 "Performing sanity checks ...\n")
1925 (/sanity-check-insns arch)
1927 (logit 1 "Done analysis.\n")
1934 ; Called before a .cpu file is read in.
1936 (define (arch-init!)
1938 (reader-add-command! 'define-arch
1940 Define an architecture, name/value pair list version.
1942 nil 'arg-list define-arch)
1944 (reader-add-command! 'define-isa
1946 Define an instruction set architecture, name/value pair list version.
1948 nil 'arg-list define-isa)
1949 (reader-add-command! 'modify-isa
1951 Modify an isa, name/value pair list version.
1953 nil 'arg-list modify-isa)
1955 (reader-add-command! 'define-cpu
1957 Define a cpu family, name/value pair list version.
1959 nil 'arg-list define-cpu)
1964 ; Called before a .cpu file is read in.
1966 (define (mach-init!)
1967 (let ((arch CURRENT-ARCH))
1968 (arch-set-ifld-table! arch (/make-ident-object-table 127))
1969 (arch-set-op-table! arch (/make-ident-object-table 127))
1970 (arch-set-insn-table! arch (/make-ident-object-table 509))
1971 (arch-set-minsn-table! arch (/make-ident-object-table 127))
1974 (reader-add-command! 'define-mach
1976 Define a machine, name/value pair list version.
1978 nil 'arg-list define-mach)
1983 ; Called after .cpu file is read in.
1985 (define (arch-finish!)
1986 (let ((arch CURRENT-ARCH))
1988 ; Lists are constructed in the reverse order they appear in the file
1989 ; [for simplicity and efficiency]. Restore them to file order for the
1990 ; human reader/debugger.
1991 ; We don't need to do this for ifld, op, insn, minsn lists because
1992 ; they are handled differently.
1993 (arch-set-enum-list! arch (reverse (arch-enum-list arch)))
1994 (arch-set-kw-list! arch (reverse (arch-kw-list arch)))
1995 (arch-set-isa-list! arch (reverse (arch-isa-list arch)))
1996 (arch-set-cpu-list! arch (reverse (arch-cpu-list arch)))
1997 (arch-set-mach-list! arch (reverse (arch-mach-list arch)))
1998 (arch-set-model-list! arch (reverse (arch-model-list arch)))
1999 (arch-set-hw-list! arch (reverse (arch-hw-list arch)))
2000 (arch-set-subr-list! arch (reverse (arch-subr-list arch)))
2006 ; Called after .cpu file is read in.
2008 (define (mach-finish!)
2009 (/adata-set-derived! CURRENT-ARCH)