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).
217 ;; List of all machs.
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))
344 ;; Given a list of objects OBJ-LIST, return those objects that are from the
345 ;; ISA(s) in ISA-NAME-LIST.
346 ;; ISA-NAME-LIST may be (all) or #f (which also means (all)).
348 (define (obj-filter-by-isa obj-list isa-name-list)
349 (if (or (eq? isa-name-list #f)
350 (memq 'all isa-name-list))
353 (let ((obj-isas (obj-attr-value obj 'ISA)))
354 (non-null-intersection? obj-isas isa-name-list)))
360 (define (current-cpu-list) (arch-cpu-list CURRENT-ARCH))
362 (define (current-cpu-add! c)
363 (if (current-cpu-lookup (obj:name c))
364 (parse-error (make-current-context "define-cpu")
365 "cpu already defined" (obj:name c)))
366 (arch-set-cpu-list! CURRENT-ARCH (cons c (arch-cpu-list CURRENT-ARCH)))
370 (define (current-cpu-lookup cpu-name)
371 (object-assq cpu-name (current-cpu-list))
376 (define (current-mach-list) (arch-mach-list CURRENT-ARCH))
378 (define (current-mach-add! m)
379 (if (current-mach-lookup (obj:name m))
380 (parse-error (make-current-context "define-mach")
381 "mach already defined" (obj:name m)))
382 (arch-set-mach-list! CURRENT-ARCH (cons m (arch-mach-list CURRENT-ARCH)))
386 (define (current-mach-lookup mach-name)
387 (object-assq mach-name (current-mach-list))
392 (define (current-model-list) (arch-model-list CURRENT-ARCH))
394 (define (current-model-add! m)
395 (if (current-model-lookup (obj:name m))
396 (parse-error (make-current-context "define-model")
397 "model already defined" (obj:name m)))
398 (arch-set-model-list! CURRENT-ARCH (cons m (arch-model-list CURRENT-ARCH)))
402 (define (current-model-lookup model-name)
403 (object-assq model-name (current-model-list))
406 ;; Hardware elements.
408 ;; NOTE: Hardware elements must be uniquely named across all machs and isas.
410 (define (current-hw-list) (arch-hw-list CURRENT-ARCH))
412 (define (current-hw-add! hw)
413 (if (current-hw-lookup (obj:name hw))
414 (parse-error (make-current-context "define-hardware")
415 "hardware already defined" (obj:name hw)))
416 (arch-set-hw-list! CURRENT-ARCH (cons hw (arch-hw-list CURRENT-ARCH)))
420 (define (current-hw-lookup hw)
423 ;; This doesn't use object-assq on purpose. Hardware objects handle
424 ;; get-name specially.
425 (find-first (lambda (hw-obj) (eq? (send hw-obj 'get-name) hw))
429 ;; Instruction fields.
431 ;; NOTE: Instruction fields must be uniquely named across all machs,
432 ;; but isas may share ifields with the same name.
434 (define (current-ifld-list)
435 (/ident-object-table->list (arch-ifld-table CURRENT-ARCH))
438 (define (current-ifld-add! f)
439 (if (/ifld-already-defined? f)
440 (parse-error (make-obj-context f "define-ifield")
441 "ifield already defined" (obj:name f)))
442 (/ident-object-table-add! CURRENT-ARCH (arch-ifld-table CURRENT-ARCH)
447 ;; Look up ifield X in the current architecture.
448 ;; Returns the <ifield> object or #f if not found.
449 ;; If there is an ambiguity (i.e. the ifield is in multiple ISAs and
450 ;; MAYBE-ISA-NAME-LIST doesn't disambiguate the choice) an error is signalled.
452 ;; If X is an <ifield> object, just return it.
453 ;; This is to handle ???
454 ;; Otherwise X is the name of the ifield to look up.
455 ;; If MAYBE-ISA-NAME-LIST is provided, the car is a list of ISAs to look in.
456 ;; If the specified isa list is #f, look in all ISAs.
458 (define (current-ifld-lookup x . maybe-isa-name-list)
461 (let ((f-list (/ident-object-table-lookup (car (arch-ifld-table CURRENT-ARCH))
464 (let* ((isas (if (not (null? maybe-isa-name-list)) (car maybe-isa-name-list) #f))
465 (filtered-f-list (obj-filter-by-isa f-list isas)))
466 (case (length filtered-f-list)
467 ((0) (error "Ifield not in specified ISA:" x))
468 ((1) (car filtered-f-list))
469 (else (error "Ambiguous ifield lookup:" x))))
473 ;; Return a boolean indicating if <ifield> F is currently defined.
474 ;; This is slightly complicated because multiple isas can have different
475 ;; ifields with the same name.
477 (define (/ifld-already-defined? f)
478 (let ((iflds (/ident-object-table-lookup (car (arch-ifld-table CURRENT-ARCH))
480 ;; We've got all the ifields with the same name,
481 ;; now see if any have the same ISA as F.
484 (f-isas (obj-isa-list f)))
485 (for-each (lambda (ff)
486 (if (non-null-intersection? f-isas (obj-isa-list ff))
495 ;; NOTE: Operands must be uniquely named across all machs,
496 ;; but isas may share operands with the same name.
498 (define (current-op-list)
499 (/ident-object-table->list (arch-op-table CURRENT-ARCH))
502 (define (current-op-add! op)
503 (if (/op-already-defined? op)
504 (parse-error (make-obj-context op "define-operand")
505 "operand already defined" (obj:name op)))
506 (/ident-object-table-add! CURRENT-ARCH (arch-op-table CURRENT-ARCH)
511 ;; Look up operand NAME in the current architecture.
512 ;; Returns the <operand> object or #f if not found.
513 ;; If there is an ambiguity (i.e. the operand is in multiple ISAs and
514 ;; MAYBE-ISA-NAME-LIST doesn't disambiguate the choice) an error is signalled.
516 ;; If MAYBE-ISA-NAME-LIST is provided, the car is a list of ISAs to look in.
517 ;; If the specified isa list is #f, look in all ISAs.
519 (define (current-op-lookup name . maybe-isa-name-list)
520 (let ((op-list (/ident-object-table-lookup (car (arch-op-table CURRENT-ARCH))
523 (let* ((isas (if (not (null? maybe-isa-name-list)) (car maybe-isa-name-list) #f))
524 (filtered-o-list (obj-filter-by-isa op-list isas)))
525 (case (length filtered-o-list)
526 ((0) (error "Operand not in specified ISA:" name))
527 ((1) (car filtered-o-list))
528 (else (error "Ambiguous operand lookup:" name))))
532 ;; Return a boolean indicating if <operand> OP is currently defined.
533 ;; This is slightly complicated because multiple isas can have different
534 ;; operands with the same name.
536 (define (/op-already-defined? op)
537 (let ((ops (/ident-object-table-lookup (car (arch-op-table CURRENT-ARCH))
539 ;; We've got all the operands with the same name,
540 ;; now see if any have the same ISA as OP.
543 (op-isas (obj-isa-list op)))
544 (for-each (lambda (o)
545 (if (non-null-intersection? op-isas (obj-isa-list o))
552 ;; Instruction field formats.
554 (define (current-ifmt-list) (arch-ifmt-list CURRENT-ARCH))
556 ;; Semantic formats (akin to ifmt's, except includes semantics to distinguish
559 (define (current-sfmt-list) (arch-sfmt-list CURRENT-ARCH))
563 ;; NOTE: Instructions must be uniquely named across all machs,
564 ;; but isas may share instructions with the same name.
566 (define (current-insn-list)
567 (/ident-object-table->list (arch-insn-table CURRENT-ARCH))
570 (define (current-insn-add! i)
571 (if (/insn-already-defined? i)
572 (parse-error (make-obj-context i "define-insn")
573 "insn already defined" (obj:name i)))
574 (/ident-object-table-add! CURRENT-ARCH (arch-insn-table CURRENT-ARCH)
579 ;; Look up insn NAME in the current architecture.
580 ;; Returns the <insn> object or #f if not found.
581 ;; If there is an ambiguity (i.e. the insn is in multiple ISAs and
582 ;; ISA-NAME-LIST doesn't disambiguate the choice) an error is signalled.
583 ;; If the specified isa list is #f, look in all ISAs.
585 (define (current-insn-lookup name isa-name-list)
586 (let ((i-list (/ident-object-table-lookup (car (arch-insn-table CURRENT-ARCH))
589 (let ((filtered-i-list (obj-filter-by-isa i-list isa-name-list)))
590 (case (length filtered-i-list)
591 ((0) (error "Insn not in specified ISA:" name))
592 ((1) (car filtered-i-list))
593 (else (error "Ambiguous insn lookup:" name))))
597 ;; Return a boolean indicating if <insn> INSN is currently defined.
598 ;; This is slightly complicated because multiple isas can have different
599 ;; insns with the same name.
601 (define (/insn-already-defined? insn)
602 (let ((insns (/ident-object-table-lookup (car (arch-insn-table CURRENT-ARCH))
604 ;; We've got all the insns with the same name,
605 ;; now see if any have the same ISA as INSN.
608 (insn-isas (obj-isa-list insn)))
609 (for-each (lambda (i)
610 (if (non-null-intersection? insn-isas (obj-isa-list i))
617 ;; Macro instructions.
619 ;; NOTE: Instructions must be uniquely named across all machs,
620 ;; but isas may share instructions with the same name.
622 (define (current-minsn-list)
623 (/ident-object-table->list (arch-minsn-table CURRENT-ARCH))
626 (define (current-minsn-add! m)
627 (if (/minsn-already-defined? m)
628 (parse-error (make-obj-context m "define-minsn")
629 "macro-insn already defined" (obj:name m)))
630 (/ident-object-table-add! CURRENT-ARCH (arch-minsn-table CURRENT-ARCH)
635 ;; Look up minsn NAME in the current architecture.
636 ;; Returns the <macro-insn> object or #f if not found.
637 ;; If there is an ambiguity (i.e. the minsn is in multiple ISAs and
638 ;; ISA-NAME-LIST doesn't disambiguate the choice) an error is signalled.
639 ;; If the specified isa list is #f, look in all ISAs.
641 (define (current-minsn-lookup name isa-name-list)
642 (let ((m-list (/ident-object-table-lookup (car (arch-minsn-table CURRENT-ARCH))
645 (let ((filtered-m-list (obj-filter-by-isa m-list isa-name-list)))
646 (case (length filtered-m-list)
647 ((0) (error "Macro-insn not in specified ISA:" name))
648 ((1) (car filtered-m-list))
649 (else (error "Ambiguous macro-insn lookup:" name))))
653 ;; Return a boolean indicating if <macro-insn> MINSN is currently defined.
654 ;; This is slightly complicated because multiple isas can have different
655 ;; macro-insns with the same name.
657 (define (/minsn-already-defined? m)
658 (let ((minsns (/ident-object-table-lookup (car (arch-minsn-table CURRENT-ARCH))
660 ;; We've got all the macro-insns with the same name,
661 ;; now see if any have the same ISA as M.
664 (m-isas (obj-isa-list m)))
665 (for-each (lambda (mm)
666 (if (non-null-intersection? m-isas (obj-isa-list mm))
675 (define (current-subr-list) (map cdr (arch-subr-list CURRENT-ARCH)))
677 (define (current-subr-add! s)
678 (if (current-subr-lookup (obj:name s))
679 (parse-error (make-current-context "define-subr")
680 "subroutine already defined" (obj:name s)))
681 (arch-set-subr-list! CURRENT-ARCH
682 (acons (obj:name s) s (arch-subr-list CURRENT-ARCH)))
686 (define (current-subr-lookup name)
687 (assq-ref (arch-subr-list CURRENT-ARCH) name)
690 ;; Arch parsing support.
692 ;; Parse an alignment spec.
694 (define (/arch-parse-alignment context alignment)
695 (if (memq alignment '(aligned unaligned forced))
697 (parse-error context "invalid alignment" alignment))
700 ;; Parse an arch mach spec.
701 ;; The value is a list of mach names or (mach-name sanitize-key) elements.
702 ;; The result is a list of (mach-name . sanitize-key) elements.
704 (define (/arch-parse-machs context machs)
705 (for-each (lambda (m)
707 (and (list? m) (= (length m) 2)
708 (symbol? (car m)) (symbol? (cadr m))))
710 (parse-error context "bad arch mach spec" m)))
715 (cons (car m) (cadr m))))
719 ;; Parse an arch isa spec.
720 ;; The value is a list of isa names or (isa-name sanitize-key) elements.
721 ;; The result is a list of (isa-name . sanitize-key) elements.
723 (define (/arch-parse-isas context isas)
724 (for-each (lambda (m)
726 (and (list? m) (= (length m) 2)
727 (symbol? (car m)) (symbol? (cadr m))))
729 (parse-error context "bad arch isa spec" m)))
734 (cons (car m) (cadr m))))
738 ;; Parse an architecture description
739 ;; This is the main routine for building an arch object from a cpu
740 ;; description in the .cpu file.
741 ;; All arguments are in raw (non-evaluated) form.
743 (define (/arch-parse context name comment attrs
744 default-alignment insn-lsb0?
746 (logit 2 "Processing arch " name " ...\n")
748 (parse-name context name)
749 (parse-comment context comment)
750 (atlist-parse context attrs "arch")
751 (/arch-parse-alignment context default-alignment)
752 (parse-boolean context insn-lsb0?)
753 (/arch-parse-machs context machs)
754 (/arch-parse-isas context isas))
757 ;; Read an architecture description.
758 ;; This is the main routine for analyzing an arch description in the .cpu file.
759 ;; ARG-LIST is an associative list of field name and field value.
760 ;; parse-arch is invoked to create the `arch' object.
764 (let ((context "arch-read")
765 ;; <arch-data> object members and default values
769 (default-alignment 'aligned)
774 ;; Loop over each element in ARG-LIST, recording what's found.
775 (let loop ((arg-list arg-list))
778 (let ((arg (car arg-list))
779 (elm-name (caar arg-list)))
781 ((name) (set! name (cadr arg)))
782 ((comment) (set! comment (cadr arg)))
783 ((attrs) (set! attrs (cdr arg)))
784 ((default-alignment) (set! default-alignment (cadr arg)))
785 ((insn-lsb0?) (set! insn-lsb0? (cadr arg)))
786 ((machs) (set! machs (cdr arg)))
787 ((isas) (set! isas (cdr arg)))
788 (else (parse-error context "invalid arch arg" arg)))
789 (loop (cdr arg-list)))))
790 ;; Ensure required fields are present.
792 (parse-error context "missing machs spec"))
794 (parse-error context "missing isas spec"))
795 ;; Now that we've identified the elements, build the object.
796 (/arch-parse context name comment attrs default-alignment insn-lsb0?
802 ;; Define an arch object, name/value pair list version.
806 (let ((a (apply /arch-read arg-list)))
807 (arch-set-data! CURRENT-ARCH a)
808 (def-mach-attr! (adata-machs a))
809 (keep-mach-validate!)
810 (def-isa-attr! (adata-isas a))
812 ;; Install the builtin objects now that we have an arch, and now that
813 ;; attributes MACH and ISA exist.
814 (reader-install-builtin!)
818 ;; Mach/isa processing.
820 ;; Create the MACH attribute.
821 ;; MACHS is the canonicalized machs spec to define-arch: (name . sanitize-key).
823 (define (def-mach-attr! machs)
824 (let ((mach-enums (append
830 (list (cons 'sanitize (cdr mach)))
834 (define-attr '(type bitset) '(name MACH)
835 '(comment "machine type selection")
836 '(default base) (cons 'values mach-enums))
842 ;; Return #t if MACH is supported by OBJ.
843 ;; This is done by looking for the MACH attribute in OBJ.
844 ;; By definition, objects that support the default (base) mach support
847 (define (mach-supports? mach obj)
848 (let ((machs (obj-attr-value obj 'MACH))
849 (name (obj:name mach)))
850 (or (memq name machs)
852 ;;(let ((deflt (attr-lookup-default 'MACH obj)))
853 ;; (any-true? (map (lambda (m) (memq m deflt)) machs)))))
856 ;; Create the ISA attribute.
857 ;; ISAS is the canonicalized isas spec to define-arch: (name . sanitize-key).
858 ;; ISAS is a list of isa names.
860 (define (def-isa-attr! isas)
861 (let ((isa-enums (append
866 (list (cons 'sanitize (cdr isa)))
870 (define-attr '(type bitset) '(name ISA)
871 '(comment "instruction set selection")
872 ;; If there's only one isa, don't (yet) pollute the tables with a value
874 (if (= (length isas) 1)
876 '(for ifield operand insn hardware))
877 (cons 'default (list (caar isa-enums)))
878 (cons 'values isa-enums))
884 ;; Return the bitset attr value for all isas.
886 (define (all-isas-attr-value)
887 (current-arch-isa-name-list)
890 ;; Return an ISA attribute of all isas.
891 ;; This is useful for things like f-nil which exist across all isas.
893 (define (all-isas-attr)
894 (bitset-attr-make 'ISA (all-isas-attr-value))
897 ;; Return list of ISA names specified by attribute object ATLIST.
899 (define (attr-isa-list atlist)
900 (atlist-attr-value atlist 'ISA #f)
903 ;; Return list of ISA names specified by OBJ.
905 (define (obj-isa-list obj)
906 (obj-attr-value obj 'ISA)
909 ;; Return #t if <isa> ISA is supported by OBJ.
910 ;; This is done by looking for the ISA attribute in OBJ.
912 (define (isa-supports? isa obj)
913 (let ((isas (obj-isa-list obj))
914 (name (obj:name isa)))
915 (->bool (memq name isas)))
918 ;; The fetch/decode/execute process.
919 ;; "extract" is a fancy word for fetch/decode.
920 ;; FIXME: wip, not currently used.
921 ;; FIXME: move to inside define-isa, and maybe elsewhere.
924 ;; define-extract (code)
925 ;; ;;(arch-set-insn-extract! CURRENT-ARCH code)
930 ;; define-execute (code)
931 ;; ;;(arch-set-insn-execute! CURRENT-ARCH code)
935 ;; ISA specification.
936 ;; Each architecture is generally one isa, but in the case of ARM (and a few
937 ;; others) there is more than one.
939 ;; ??? "ISA" has a very well defined meaning, and our usage of it one might
940 ;; want to quibble over. A better name would be welcome.
942 ;; Associated with an instruction set is its framing.
943 ;; This refers to how instructions are laid out at the liw level (where several
944 ;; insns are framed together and executed sequentially or in parallel).
945 ;; ??? If one defines the term "format" as being how an individual instruction
946 ;; is laid out then formatting can be thought of as being different from
947 ;; framing. However, it's possible for a particular ISA to intertwine the two.
948 ;; Thus this will need to evolve.
949 ;; ??? Not used yet, wip.
951 (define <iframe> ;; pronounced I-frame
952 (class-make '<iframe> '(<ident>)
954 ;; list of <itype> objects that make up the frame
960 ;; list of (length value) elements that make up the format
961 ;; Length is in bits. Value is either a number or a $number
962 ;; symbol refering to the insn specified in `insns'.
965 ;; Initial bitnumbers to decode insns by.
966 ;; ??? At present the rest of the decoding is determined
967 ;; algorithmically. May wish to give the user more control
971 ;; rtl that executes instructions in `value'
972 ;; Fields specified in `value' can be used here.
980 (define-getters <iframe> iframe (insns syntax value decode-assist action))
982 ;; Instruction types, recorded in <iframe>.
983 ;; ??? Not used yet, wip.
986 (class-make '<itype> '(<ident>)
988 ;; length in bits, or initial part if variable length (wip)
991 ;; constraint specifying which insns are included
994 ;; Initial bitnumbers to decode insns by.
995 ;; ??? At present the rest of the decoding is determined
996 ;; algorithmically. May wish to give the user more control
1005 (define-getters <itype> itype (length constraint decode-assist))
1007 ;; Simulator instruction decode splitting.
1008 ;; FIXME: Should live in simulator specific code. Requires class handling
1011 ;; Instructions can be split by particular values for an ifield.
1012 ;; The ARM port uses this to split insns into those that set the pc and
1013 ;; those that don't.
1015 (define <decode-split>
1016 (class-make '<decode-split> '()
1018 ;; Name of ifield to split on.
1021 ;; Constraint. Only insns satifying this constraint are
1022 ;; split. #f if no constraint.
1025 ;; List of ifield splits.
1026 ;; Each element is one of (name value) or (name (values)).
1035 (define-getters <decode-split> decode-split (name constraint values))
1037 ;; Parse a decode-split spec.
1038 ;; SPEC is (ifield-name constraint value-list).
1039 ;; CONSTRAINT is an rtl expression. Only insns satifying the constraint
1041 ;; Each element of VALUE-LIST is one of (name value) or (name (values)).
1042 ;; FIXME: All possible values must be specified. Need an `else' clause.
1043 ;; Ranges would also be useful.
1045 (define (/isa-parse-decode-split context spec)
1046 (if (!= (length spec) 3)
1047 (parse-error context "decode-split spec is (ifield-name constraint value-list)" spec))
1049 (let ((name (parse-name (car spec) context))
1050 (constraint (cadr spec))
1051 (value-list (caddr spec)))
1053 ;; FIXME: more error checking.
1055 (make <decode-split>
1057 (if (null? constraint) #f constraint)
1061 ;; Parse a list of decode-split specs.
1063 (define (/isa-parse-decode-splits context spec-list)
1065 (/isa-parse-decode-split context spec))
1069 ;; Top level class to describe an isa.
1072 (class-make '<isa> '(<ident>)
1074 ;; Default length to record in ifields.
1075 ;; This is used in calculations involving bit numbers.
1076 default-insn-word-bitsize
1078 ;; Length of an unknown instruction. Used by disassembly
1079 ;; and by the simulator's invalid insn handler.
1080 default-insn-bitsize
1082 ;; Number of bytes of insn that can be initially fetched.
1083 ;; In non-LIW isas this would be the length of the smallest
1084 ;; insn. For LIW isas it depends - only one LIW isa is
1085 ;; currently supported (m32r).
1088 ;; Initial bitnumbers to decode insns by.
1089 ;; ??? At present the rest of the decoding is determined
1090 ;; algorithmically. May wish to give the user more control
1094 ;; Number of instructions that can be fetched at a time
1095 ;; [e.g. 2 on m32r].
1098 ;; Maximum number of instructions the cpu can execute in
1100 ;; FIXME: Rename to max-parallel-insns.
1103 ;; List of <iframe> objects.
1106 ;; Condition tested before execution of any instruction or
1107 ;; #f if there is none. For architectures like ARM, ARC.
1108 ;; If specified it is a pair of
1109 ;; (condition-field-name . rtl-for-condition)
1112 ;; Code to execute after CONDITION and prior to SEMANTICS.
1113 ;; This is rtl in source form or #f if there is none.
1114 ;; This is generally unused. It is used on the ARM to set
1115 ;; R15 to the correct value.
1116 ;; The reason it's not specified with SEMANTICS is that it is
1117 ;; believed some applications won't need/want this.
1118 ;; ??? It is a bit of a hack though, as it is used to aid
1119 ;; implementation of apps (e.g. simulator). Arguably something
1120 ;; that doesn't belong here. Maybe as more architectures are
1121 ;; ported that have the PC as a general register, a better way
1122 ;; to do this will arise.
1123 (setup-semantics . #f)
1125 ;; list of simulator instruction splits
1126 ;; FIXME: should live in simulator file (needs class cleanup).
1127 (decode-splits . ())
1129 ;; ??? More may need to migrate here.
1136 (define-getters <isa> isa
1137 (base-insn-bitsize default-insn-bitsize default-insn-word-bitsize
1138 decode-assist liw-insns parallel-insns condition
1139 setup-semantics decode-splits)
1142 (define-setters <isa> isa
1146 (define (isa-enum isa) (string-append "ISA_" (string-upcase (gen-sym isa))))
1148 ;; Return minimum/maximum size in bits of all insns in the isa.
1150 (define (isa-min-insn-bitsize isa)
1151 ;; add `65535' in case list is nil (avoids crash)
1152 ;; [a language with infinite precision can't have min-reduce-iota-0 :-)]
1153 (apply min (cons 65535
1154 (map insn-length (find (lambda (insn)
1155 (and (not (has-attr? insn 'ALIAS))
1156 (isa-supports? isa insn)))
1157 (non-multi-insns (current-insn-list))))))
1160 (define (isa-max-insn-bitsize isa)
1161 ;; add `0' in case list is nil (avoids crash)
1162 ;; [a language with infinite precision can't have max-reduce-iota-0 :-)]
1164 (map insn-length (find (lambda (insn)
1165 (and (not (has-attr? insn 'ALIAS))
1166 (isa-supports? isa insn)))
1167 (non-multi-insns (current-insn-list))))))
1170 ;; Return a boolean indicating if instructions in ISA can be kept in a
1173 (define (isa-integral-insn? isa)
1174 (<= (isa-max-insn-bitsize isa) 32)
1177 ;; Parse an isa decode-assist spec.
1179 (define (/isa-parse-decode-assist context spec)
1180 (if (not (all-true? (map non-negative-integer? spec)))
1181 (parse-error context
1182 "spec must consist of non-negative-integers"
1184 (if (not (= (length spec) (length (nub spec identity))))
1185 (parse-error context
1186 "duplicate elements"
1191 ;; Parse an isa condition spec.
1192 ;; `condition' here refers to the condition performed by architectures like
1193 ;; ARM and ARC before each insn.
1195 (define (/isa-parse-condition context spec)
1199 (if (or (!= (length spec) 2)
1200 (not (symbol? (car spec)))
1201 (not (form? (cadr spec))))
1202 (parse-error context
1203 "condition spec not `(ifield-name rtl-code)'" spec))
1207 ;; Parse a setup-semantics spec.
1209 (define (/isa-parse-setup-semantics context spec)
1210 (if (not (null? spec))
1215 ;; Parse an isa spec.
1216 ;; The result is the <isa> object.
1217 ;; All arguments are in raw (non-evaluated) form.
1219 (define (/isa-parse context name comment attrs
1220 base-insn-bitsize default-insn-bitsize default-insn-word-bitsize
1221 decode-assist liw-insns parallel-insns condition
1222 setup-semantics decode-splits)
1223 (logit 2 "Processing isa " name " ...\n")
1225 ;; Pick out name first to augment the error context.
1226 (let* ((name (parse-name context name))
1227 (context (context-append-name context name)))
1229 (if (not (memq name (current-arch-isa-name-list)))
1230 (parse-error context "isa name is not present in `define-arch'" name))
1232 ;; Isa's are always kept - we need them to validate later uses, even if
1233 ;; the then resulting object won't be kept. All isas are also needed to
1234 ;; compute a proper value for the isas-cache member of <hardware-base>
1235 ;; for builtin objects.
1238 (parse-comment context comment)
1239 (atlist-parse context attrs "isa")
1240 (parse-number (context-append context
1241 ": default-insn-word-bitsize")
1242 default-insn-word-bitsize '(8 . 128))
1243 (parse-number (context-append context
1244 ": default-insn-bitsize")
1245 default-insn-bitsize '(8 . 128))
1246 (parse-number (context-append context
1247 ": base-insn-bitsize")
1248 base-insn-bitsize '(8 . 128))
1249 (/isa-parse-decode-assist (context-append context
1254 (/isa-parse-condition context condition)
1255 (/isa-parse-setup-semantics context setup-semantics)
1256 (/isa-parse-decode-splits context decode-splits)
1260 ;; Read an isa entry.
1261 ;; ARG-LIST is an associative list of field name and field value.
1263 (define (/isa-read context . arg-list)
1268 (base-insn-bitsize #f)
1269 (default-insn-bitsize #f)
1270 (default-insn-word-bitsize #f)
1273 ;; FIXME: Hobbit computes the wrong symbol for `parallel-insns'
1274 ;; in the `case' expression below because there is a local var
1275 ;; of the same name ("__1" gets appended to the symbol name).
1278 (setup-semantics nil)
1282 (let loop ((arg-list arg-list))
1283 (if (null? arg-list)
1285 (let ((arg (car arg-list))
1286 (elm-name (caar arg-list)))
1288 ((name) (set! name (cadr arg)))
1289 ((comment) (set! comment (cadr arg)))
1290 ((attrs) (set! attrs (cdr arg)))
1291 ((default-insn-word-bitsize)
1292 (set! default-insn-word-bitsize (cadr arg)))
1293 ((default-insn-bitsize) (set! default-insn-bitsize (cadr arg)))
1294 ((base-insn-bitsize) (set! base-insn-bitsize (cadr arg)))
1295 ((decode-assist) (set! decode-assist (cadr arg)))
1296 ((liw-insns) (set! liw-insns (cadr arg)))
1297 ((parallel-insns) (set! parallel-insns- (cadr arg)))
1298 ((condition) (set! condition (cdr arg)))
1299 ((setup-semantics) (set! setup-semantics (cadr arg)))
1300 ((decode-splits) (set! decode-splits (cdr arg)))
1301 ((insn-types) #t) ;; ignore for now
1302 ((frame) #t) ;; ignore for now
1303 (else (parse-error context "invalid isa arg" arg)))
1304 (loop (cdr arg-list)))))
1306 ;; Now that we've identified the elements, build the object.
1307 (/isa-parse context name comment attrs
1309 (if default-insn-word-bitsize
1310 default-insn-word-bitsize
1312 (if default-insn-bitsize
1313 default-insn-bitsize
1315 decode-assist liw-insns parallel-insns- condition
1316 setup-semantics decode-splits))
1319 ;; Define a <isa> object, name/value pair list version.
1323 (let ((i (apply /isa-read (cons (make-current-context "define-isa")
1326 (current-isa-add! i))
1330 ;; Subroutine of modify-isa to process one add-decode-split spec.
1332 (define (/isa-add-decode-split! context isa spec)
1333 (let ((decode-split (/isa-parse-decode-split context spec)))
1334 (isa-set-decode-splits! (cons decode-split (isa-decode-splits isa)))
1338 ;; Main routine for modifying existing isa definitions
1342 (let ((context (make-current-context "modify-isa"))
1343 (isa-spec (assq 'name arg-list)))
1345 (parse-error context "isa name not specified"))
1347 (let ((isa (current-isa-lookup (arg-list-symbol-arg context isa-spec))))
1349 (parse-error context "undefined isa" isa-spec))
1351 (let loop ((args arg-list))
1354 (let ((arg-spec (car args)))
1355 (case (car arg-spec)
1356 ((name) #f) ;; ignore, already processed
1358 (/isa-add-decode-split! context isa (cdr arg-spec)))
1360 (parse-error context "invalid/unsupported option" (car arg-spec))))
1361 (loop (cdr args)))))))
1366 ;; Return boolean indicating if ISA supports parallel execution.
1368 (define (isa-parallel-exec? isa) (> (isa-parallel-insns isa) 1))
1370 ;; Return a boolean indicating if ISA supports conditional execution
1371 ;; of all instructions.
1373 (define (isa-conditional-exec? isa) (->bool (isa-condition isa)))
1375 ;; The `<cpu>' object collects together various details about a particular
1376 ;; subset of the architecture (e.g. perhaps all 32 bit variants of the sparc
1378 ;; This is called a "cpu-family".
1379 ;; ??? May be renamed to <family> (both internally and in the .cpu file).
1380 ;; ??? Another way to do this would be to discard the family notion and allow
1381 ;; machs to inherit from other machs, as well as use isas to distinguish
1382 ;; sufficiently dissimilar machs. This would remove a fuzzy illspecified
1383 ;; notion with a concrete one.
1384 ;; ??? Maybe a better way to organize sparc32 vs sparc64 is via an isa.
1390 ;; one of big/little/either/#f.
1391 ;; If #f, then {insn,data,float}-endian are used.
1392 ;; Otherwise they're ignored.
1395 ;; one of big/little/either.
1398 ;; one of big/little/either/big-words/little-words.
1399 ;; If big-words then each word is little-endian.
1400 ;; If little-words then each word is big-endian.
1403 ;; one of big/little/either/big-words/little-words.
1406 ;; number of bits in a word.
1409 ;; number of bits in a chunk of an instruction word, for
1410 ;; endianness conversion purposes; 0 = no chunking
1413 ;; Transformation to use in generated files should one be
1414 ;; needed. At present the only supported value is a string
1415 ;; which is the file suffix.
1416 ;; ??? A dubious element of the description language, but given
1417 ;; the quantity of generated files, some machine generated
1418 ;; headers may need to #include other machine generated headers
1422 ;; Allow a cpu family to override the isa parallel-insns spec.
1423 ;; ??? Concession to the m32r port which can go away, in time.
1426 ;; Computed: maximum number of insns which may pass before there
1427 ;; an insn writes back its output operands.
1436 (define-getters <cpu> cpu (word-bitsize insn-chunk-bitsize file-transform parallel-insns max-delay))
1437 (define-setters <cpu> cpu (max-delay))
1439 ;; Return endianness of instructions.
1441 (define (cpu-insn-endian cpu)
1442 (let ((endian (elm-xget cpu 'endian)))
1445 (elm-xget cpu 'insn-endian)))
1448 ;; Return endianness of data.
1450 (define (cpu-data-endian cpu)
1451 (let ((endian (elm-xget cpu 'endian)))
1454 (elm-xget cpu 'data-endian)))
1457 ;; Return endianness of floats.
1459 (define (cpu-float-endian cpu)
1460 (let ((endian (elm-xget cpu 'endian)))
1463 (elm-xget cpu 'float-endian)))
1466 ;; Parse a cpu family description
1467 ;; This is the main routine for building a <cpu> object from a cpu
1468 ;; description in the .cpu file.
1469 ;; All arguments are in raw (non-evaluated) form.
1471 (define (/cpu-parse context name comment attrs
1472 endian insn-endian data-endian float-endian
1473 word-bitsize insn-chunk-bitsize file-transform parallel-insns)
1474 (logit 2 "Processing cpu family " name " ...\n")
1476 ;; Pick out name first to augment the error context.
1477 (let* ((name (parse-name context name))
1478 (context (context-append-name context name)))
1480 (if (keep-cpu? name)
1483 (parse-comment context comment)
1484 (atlist-parse context attrs "cpu")
1485 endian insn-endian data-endian float-endian
1490 0 ;; default max-delay. will compute correct value
1493 (logit 2 "Ignoring " name ".\n")
1494 #f))) ;; cpu is not to be kept
1497 ;; Read a cpu family description
1498 ;; This is the main routine for analyzing a cpu description in the .cpu file.
1499 ;; CONTEXT is a <context> object for error messages.
1500 ;; ARG-LIST is an associative list of field name and field value.
1501 ;; /cpu-parse is invoked to create the <cpu> object.
1503 (define (/cpu-read context . arg-list)
1513 (insn-chunk-bitsize 0)
1515 ;; FIXME: Hobbit computes the wrong symbol for `parallel-insns'
1516 ;; in the `case' expression below because there is a local var
1517 ;; of the same name ("__1" gets appended to the symbol name).
1518 (parallel-insns- #f)
1521 ;; Loop over each element in ARG-LIST, recording what's found.
1522 (let loop ((arg-list arg-list))
1523 (if (null? arg-list)
1525 (let ((arg (car arg-list))
1526 (elm-name (caar arg-list)))
1528 ((name) (set! name (cadr arg)))
1529 ((comment) (set! comment (cadr arg)))
1530 ((attrs) (set! attrs (cdr arg)))
1531 ((endian) (set! endian (cadr arg)))
1532 ((insn-endian) (set! insn-endian (cadr arg)))
1533 ((data-endian) (set! data-endian (cadr arg)))
1534 ((float-endian) (set! float-endian (cadr arg)))
1535 ((word-bitsize) (set! word-bitsize (cadr arg)))
1536 ((insn-chunk-bitsize) (set! insn-chunk-bitsize (cadr arg)))
1537 ((file-transform) (set! file-transform (cadr arg)))
1538 ((parallel-insns) (set! parallel-insns- (cadr arg)))
1539 (else (parse-error context "invalid cpu arg" arg)))
1540 (loop (cdr arg-list)))))
1542 ;; Now that we've identified the elements, build the object.
1543 (/cpu-parse context name comment attrs
1544 endian insn-endian data-endian float-endian
1545 word-bitsize insn-chunk-bitsize file-transform parallel-insns-))
1548 ;; Define a cpu family object, name/value pair list version.
1552 (let ((c (apply /cpu-read (cons (make-current-context "define-cpu")
1556 (current-cpu-add! c)
1557 (mode-set-word-modes! (cpu-word-bitsize c))
1558 (hw-update-word-modes!)
1563 ;; The `<mach>' object describes one member of a `cpu' family.
1566 (class-make '<mach> '(<ident>)
1568 ;; cpu family this mach is a member of
1572 ;; list of <isa> objects
1580 (define-getters <mach> mach (cpu bfd-name isas))
1582 (define (mach-enum obj)
1583 (string-append "MACH_" (string-upcase (gen-sym obj)))
1586 (define (mach-number obj) (mach-enum obj))
1588 (define (machs-for-cpu cpu)
1589 (let ((cpu-name (obj:name cpu)))
1590 (find (lambda (mach)
1591 (eq? (obj:name (mach-cpu mach)) cpu-name))
1592 (current-mach-list)))
1595 ;; Parse a machine entry.
1596 ;; The result is a <mach> object or #f if the mach isn't to be kept.
1597 ;; All arguments are in raw (non-evaluated) form.
1599 (define (/mach-parse context name comment attrs cpu bfd-name isas)
1600 (logit 2 "Processing mach " name " ...\n")
1602 ;; Pick out name first to augment the error context.
1603 (let* ((name (parse-name context name))
1604 (context (context-append-name context name)))
1606 (if (not (list? isas))
1607 (parse-error context "isa spec not a list" isas))
1608 (let ((cpu-obj (current-cpu-lookup cpu))
1609 (isa-list (map current-isa-lookup isas)))
1610 (if (not (memq name (current-arch-mach-name-list)))
1611 (parse-error context "mach name is not present in `define-arch'" name))
1613 (parse-error context "missing cpu spec" cpu))
1615 (parse-error context "unknown cpu" cpu))
1617 (parse-error context "missing isas spec" isas))
1618 (if (not (all-true? isa-list))
1619 (parse-error context "unknown isa in" isas))
1620 (if (not (string? bfd-name))
1621 (parse-error context "bfd-name not a string" bfd-name))
1623 (if (keep-mach? (list name))
1627 (parse-comment context comment)
1628 (atlist-parse context attrs "mach")
1634 (logit 2 "Ignoring " name ".\n")
1635 #f)))) ;; mach is not to be kept
1638 ;; Read a mach entry.
1639 ;; CONTEXT is a <context> object for error messages.
1640 ;; ARG-LIST is an associative list of field name and field value.
1642 (define (/mach-read context . arg-list)
1652 (let loop ((arg-list arg-list))
1653 (if (null? arg-list)
1655 (let ((arg (car arg-list))
1656 (elm-name (caar arg-list)))
1658 ((name) (set! name (cadr arg)))
1659 ((comment) (set! comment (cadr arg)))
1660 ((attrs) (set! attrs (cdr arg)))
1661 ((cpu) (set! cpu (cadr arg)))
1662 ((bfd-name) (set! bfd-name (cadr arg)))
1663 ((isas) (set! isas (cdr arg)))
1664 (else (parse-error context "invalid mach arg" arg)))
1665 (loop (cdr arg-list)))))
1667 ;; Now that we've identified the elements, build the object.
1668 (/mach-parse context name comment attrs cpu
1669 ;; Default bfd-name is same as object's name.
1670 (if bfd-name bfd-name (symbol->string name))
1671 ;; Default isa is the first one.
1672 (if isas isas (list (obj:name (car (current-isa-list)))))))
1675 ;; Define a <mach> object, name/value pair list version.
1679 (let ((m (apply /mach-read (cons (make-current-context "define-mach")
1682 (current-mach-add! m))
1686 ;; Miscellaneous state derived from the input data.
1687 ;; FIXME: being redone
1689 ;; Size of a word in bits.
1690 ;; All selected cpu families must have same value or error.
1691 ;; Ergo, don't use this if multiple word-bitsize values are expected.
1692 ;; E.g. opcodes support for architectures with both 32 and 64 variants.
1694 (define (state-word-bitsize)
1695 (let* ((wb-list (map cpu-word-bitsize (current-cpu-list)))
1696 (result (car wb-list)))
1697 (for-each (lambda (wb)
1699 (error "multiple word-bitsize values" wb-list)))
1704 ;; Return maximum word bitsize.
1706 (define (state-max-word-bitsize)
1707 (apply max (map cpu-word-bitsize (current-cpu-list)))
1710 ;; Size of normal instruction.
1711 ;; All selected isas must have same value or error.
1713 (define (state-default-insn-bitsize)
1714 (let ((dib (map isa-default-insn-bitsize (current-isa-list))))
1715 ;; FIXME: ensure all have same value.
1719 ;; Number of bytes of insn we can initially fetch.
1720 ;; All selected isas must have same value or error.
1722 (define (state-base-insn-bitsize)
1723 (let ((bib (map isa-base-insn-bitsize (current-isa-list))))
1724 ;; FIXME: ensure all have same value.
1728 ;; Return parallel-insns spec.
1730 (define (state-parallel-insns)
1731 ;; Assert only one cpu family has been selected.
1734 (let ((par-insns (map isa-parallel-insns (current-isa-list)))
1735 (cpu-par-insns (cpu-parallel-insns (current-cpu))))
1736 ;; ??? The m32r does have parallel execution, but to keep support for the
1737 ;; base mach simpler, a cpu family is allowed to override the isa spec.
1739 ;; FIXME: ensure all have same value.
1743 ;; Return boolean indicating if parallel execution support is required.
1745 (define (state-parallel-exec?)
1746 (> (state-parallel-insns) 1)
1749 ;; Return liw-insns spec.
1751 (define (state-liw-insns)
1752 (let ((liw-insns (map isa-liw-insns (current-isa-list))))
1753 ;; FIXME: ensure all have same value.
1757 ;; Return decode-assist spec.
1759 (define (state-decode-assist)
1760 (isa-decode-assist (current-isa))
1763 ;; Return boolean indicating if current isa conditionally executes all insn.
1765 (define (state-conditional-exec?)
1766 (isa-conditional-exec? (current-isa))
1769 ;; Architecture or cpu wide values derived from other data.
1771 (define <derived-arch-data>
1772 (class-make '<derived-arch-data>
1775 ;; whether all insns can be recorded in a host int
1778 ;; whether a large int is needed for insns
1784 ;; Called after the .cpu file has been read in to prime derived value
1786 ;; Often this data isn't needed so we only computed it if we have to.
1787 ;; The computation can require a single selected ISA; if we don't require
1788 ;; the data don't unnecessarily flag an error.
1790 (define (/adata-set-derived! arch)
1791 ;; Don't compute this data unless we need to.
1794 (make <derived-arch-data>
1796 (delay (isa-integral-insn? (current-isa)))
1797 ;; insn-word-bitsize
1798 (> (apply max (map isa-base-insn-bitsize (current-isa-list))) 32)
1804 (define (adata-integral-insn? arch)
1805 (force (elm-xget (arch-derived arch) 'integral-insn?))
1808 (define (adata-large-insn-word? arch)
1809 (elm-xget (arch-derived arch) 'large-insn-word?)
1812 ;; Instruction analysis control.
1814 ;; The maximum number of virtual insns.
1815 ;; They can be recorded with negative ordinals, and multi-insns are currently
1816 ;; also recorded as negative numbers, so leave enough space.
1817 (define MAX-VIRTUAL-INSNS 100)
1819 ;; Subroutine of arch-analyze-insns! to simplify it.
1820 ;; Sanity check the instruction set.
1822 (define (/sanity-check-insns arch)
1823 (let ((insn-list (arch-insn-list arch)))
1825 ;; Ensure instruction base values agree with their masks.
1826 ;; Errors can come from bad .cpu files, bugs, or both.
1827 ;; It's better to catch such errors early.
1828 ;; If it is an error in the .cpu file, we don't want to crash
1829 ;; on a Guile error.
1835 (let ((base-len (insn-base-mask-length insn))
1836 (base-mask (insn-base-mask insn))
1837 (base-value (insn-base-value insn)))
1838 (if (not (= (cg-logand (cg-logxor base-mask (mask base-len))
1841 (context-owner-error
1843 "While performing sanity checks"
1844 (string-append "Instruction has opcode bits outside of its mask.\n"
1845 "This usually means some kind of error in the instruction's ifield list.\n"
1846 "base mask: 0x" (number->hex base-mask)
1847 ", base value: 0x" (number->hex base-value)
1849 (string-map (lambda (f)
1851 (ifld-pretty-print f)))
1855 ;; Insert more checks here.
1859 (non-multi-insns (non-alias-insns insn-list))))
1864 ;; Instantiate the multi-insns of ARCH (if there are any).
1866 (define (/instantiate-multi-insns! arch)
1867 ;; Skip if already done, we don't want to create duplicates.
1869 (if (not (arch-multi-insns-instantiated? arch))
1872 (if (any-true? (map multi-insn? (arch-insn-list arch)))
1875 ;; Instantiate sub-insns of all multi-insns.
1876 (logit 1 "Instantiating multi-insns ...\n")
1878 ;; FIXME: Hack to remove differences in generated code when we
1879 ;; switched to recording insns in hash tables.
1880 ;; Multi-insn got instantiated after the list of insns had been
1881 ;; reversed and they got added to the front of the list, in
1882 ;; reverse order. Blech!
1883 ;; Eventually remove this, have a flag day, and check in the
1885 ;; NOTE: This causes major diffs to opcodes/m32c-*.[ch].
1886 (let ((orig-ord (arch-next-ordinal arch)))
1887 (arch-set-next-ordinal! arch (- MAX-VIRTUAL-INSNS))
1888 (for-each (lambda (insn)
1889 (multi-insn-instantiate! insn))
1890 (multi-insns (arch-insn-list arch)))
1891 (arch-set-next-ordinal! arch orig-ord))
1893 (logit 1 "Done instantiating multi-insns.\n")
1896 (arch-set-multi-insns-instantiated?! arch #t)
1900 ;; Subroutine of arch-analyze-insns! to simplify it.
1901 ;; Canonicalize INSNS of ARCH.
1903 (define (/canonicalize-insns! arch insn-list)
1904 (logit 1 "Canonicalizing instruction semantics ...\n")
1906 (for-each (lambda (insn)
1907 (cond ((insn-canonical-semantics insn)
1909 ((insn-semantics insn)
1910 (logit 2 "Canonicalizing semantics for " (obj:name insn) " ...\n")
1913 (make-obj-context insn
1914 (string-append "canonicalizing semantics of "
1915 (obj:str-name insn)))
1916 'VOID (obj-isa-list insn) nil
1917 (insn-semantics insn))))
1918 (insn-set-canonical-semantics! insn canon-sem)))
1920 (logit 2 "Skipping instruction " (obj:name insn) ", no semantics ...\n"))))
1923 (logit 1 "Done canonicalization.\n")
1926 ;; Analyze the instruction set.
1927 ;; The name is explicitly vague because it's intended that all insn analysis
1928 ;; would be controlled here.
1929 ;; If the instruction set has already been sufficiently analyzed, do nothing.
1930 ;; INCLUDE-ALIASES? is #t if alias insns are to be included.
1931 ;; ANALYZE-SEMANTICS? is #t if insn semantics are to be analyzed.
1933 ;; This is a very expensive operation, so we only do it as necessary.
1934 ;; There are (currently) two different kinds of users: assemblers and
1935 ;; simulators. Assembler style apps don't always need to analyze the semantics.
1936 ;; Simulator style apps don't want to include the alias insns.
1938 (define (arch-analyze-insns! arch include-aliases? analyze-semantics?)
1939 ;; Catch apps that haven't set word sizes yet.
1940 (mode-ensure-word-sizes-defined)
1942 (if (or (not (arch-insns-analyzed? arch))
1943 (not (eq? analyze-semantics? (arch-semantics-analyzed? arch)))
1944 (not (eq? include-aliases? (arch-aliases-analyzed? arch))))
1948 (/instantiate-multi-insns! arch)
1950 (let ((insn-list (non-multi-insns
1951 (if include-aliases?
1952 (arch-insn-list arch)
1953 (non-alias-insns (arch-insn-list arch))))))
1955 ;; Compile each insns semantics, traversers/evaluators require it.
1956 (/canonicalize-insns! arch insn-list)
1958 ;; This is expensive so indicate start/finish.
1959 (logit 1 "Analyzing instruction set ...\n")
1962 (ifmt-compute! insn-list
1963 analyze-semantics?)))
1965 (arch-set-ifmt-list! arch (car fmt-lists))
1966 (arch-set-sfmt-list! arch (cadr fmt-lists))
1967 (arch-set-insns-analyzed?! arch #t)
1968 (arch-set-semantics-analyzed?! arch analyze-semantics?)
1969 (arch-set-aliases-analyzed?! arch include-aliases?)
1971 ;; Now that the instruction formats are computed,
1972 ;; do some sanity checks.
1973 (logit 1 "Performing sanity checks ...\n")
1974 (/sanity-check-insns arch)
1976 (logit 1 "Done analysis.\n")
1983 ;; Called before a .cpu file is read in.
1985 (define (arch-init!)
1987 (reader-add-command! 'define-arch
1989 Define an architecture, name/value pair list version.
1991 nil 'arg-list define-arch)
1993 (reader-add-command! 'define-isa
1995 Define an instruction set architecture, name/value pair list version.
1997 nil 'arg-list define-isa)
1998 (reader-add-command! 'modify-isa
2000 Modify an isa, name/value pair list version.
2002 nil 'arg-list modify-isa)
2004 (reader-add-command! 'define-cpu
2006 Define a cpu family, name/value pair list version.
2008 nil 'arg-list define-cpu)
2013 ;; Called before a .cpu file is read in.
2015 (define (mach-init!)
2016 (let ((arch CURRENT-ARCH))
2017 (arch-set-ifld-table! arch (/make-ident-object-table 127))
2018 (arch-set-op-table! arch (/make-ident-object-table 127))
2019 (arch-set-insn-table! arch (/make-ident-object-table 509))
2020 (arch-set-minsn-table! arch (/make-ident-object-table 127))
2023 (reader-add-command! 'define-mach
2025 Define a machine, name/value pair list version.
2027 nil 'arg-list define-mach)
2032 ;; Called after .cpu file is read in.
2034 (define (arch-finish!)
2035 (let ((arch CURRENT-ARCH))
2037 ;; Lists are constructed in the reverse order they appear in the file
2038 ;; [for simplicity and efficiency]. Restore them to file order for the
2039 ;; human reader/debugger.
2040 ;; We don't need to do this for ifld, op, insn, minsn lists because
2041 ;; they are handled differently.
2042 (arch-set-enum-list! arch (reverse (arch-enum-list arch)))
2043 (arch-set-kw-list! arch (reverse (arch-kw-list arch)))
2044 (arch-set-isa-list! arch (reverse (arch-isa-list arch)))
2045 (arch-set-cpu-list! arch (reverse (arch-cpu-list arch)))
2046 (arch-set-mach-list! arch (reverse (arch-mach-list arch)))
2047 (arch-set-model-list! arch (reverse (arch-model-list arch)))
2048 (arch-set-hw-list! arch (reverse (arch-hw-list arch)))
2049 (arch-set-subr-list! arch (reverse (arch-subr-list arch)))
2055 ;; Called after .cpu file is read in.
2057 (define (mach-finish!)
2058 (/adata-set-derived! CURRENT-ARCH)