1 ; General cpu info generator support.
2 ; Copyright (C) 2000, 2002, 2005, 2009 Red Hat, Inc.
3 ; This file is part of CGEN.
5 ; Global state variables.
7 ; Specify which application.
8 (set! APPLICATION 'OPCODES)
10 ; Records the -OPC arg which specifies the path to the .opc file.
11 (define /opc-file-path #f)
12 (define (opc-file-path)
15 (error ".opc file unspecified, missing -OPC argument"))
17 (define (set-opc-file-path! path)
18 (set! /opc-file-path path)
21 ; Return #t if the -OPC parameter was specified.
23 (define (opc-file-provided?)
24 (and /opc-file-path #t)
27 ; Boolean indicating if we're to build the operand instance table.
28 ; The default is no, since only the m32r uses it at present.
29 ; ??? Simulator tracing support could use it.
30 ; ??? Might be lazily built at runtime by parsing the semantic code
31 ; (which would be recorded in the insn table).
32 ; FIXME: Referenced outside this file in opc-opinst.scm.
33 (define /opcodes-build-operand-instance-table? #f)
35 ; String containing copyright text.
36 (define CURRENT-COPYRIGHT #f)
38 ; String containing text defining the package we're generating code for.
39 (define CURRENT-PACKAGE #f)
41 ; Initialize the options.
43 (define (option-init!)
44 (set! /opcodes-build-operand-instance-table? #f)
45 (set! CURRENT-COPYRIGHT copyright-fsf)
46 (set! CURRENT-PACKAGE package-gnu-binutils-gdb)
50 ; Handle an option passed in from the command line.
52 (define (option-set! name value)
54 ((opinst) (set! /opcodes-build-operand-instance-table? #t))
55 ((copyright) (cond ((equal? value '("fsf"))
56 (set! CURRENT-COPYRIGHT copyright-fsf))
57 ((equal? value '("redhat"))
58 (set! CURRENT-COPYRIGHT copyright-red-hat))
59 (else (error "invalid copyright value" value))))
60 ((package) (cond ((equal? value '("binutils"))
61 (set! CURRENT-PACKAGE package-gnu-binutils-gdb))
62 ((equal? value '("gnusim"))
63 (set! CURRENT-PACKAGE package-gnu-simulators))
64 ((equal? value '("cygsim"))
65 (set! CURRENT-PACKAGE package-red-hat-simulators))
66 (else (error "invalid package value" value))))
67 (else (error "unknown option" name))
72 ; Instruction fields support code.
74 ; Default type of variable to use to hold ifield value.
76 (define (gen-ifield-default-type)
77 ; FIXME: Use long for now.
81 ; Given field F, return a C definition of a variable big enough to hold
84 (define (gen-ifield-value-decl f)
85 (gen-obj-sanitize f (string-append " "
86 (gen-ifield-default-type)
87 " " (gen-sym f) ";\n"))
90 ; Return name of function to call to insert the value of <ifield> F
93 (define (ifld-insert-fn-name f)
97 ; Return name of function to call to extract the value of <ifield> F
100 (define (ifld-extract-fn-name f)
104 ; Default routine to emit C code to insert a field in an insn.
108 (lambda (self operand)
109 (let* ((encode (elm-get self 'encode))
110 (need-extra? encode) ; use to also handle operand's `insert' field
111 (varname (gen-operand-result-var self)))
114 (string-append " {\n"
116 (gen-ifield-default-type)
117 " value = " varname ";\n")
120 (string-append " value = "
121 ;; NOTE: ENCODE is either, e.g.,
122 ;; ((value pc) (sra DI value 1))
124 ;; (((<mode> value) (<mode> pc)) (sra DI value 1))
125 (let ((expr (cadr encode))
126 (value (if (symbol? (caar encode)) (caar encode) (cadr (caar encode))))
127 (pc (if (symbol? (cadar encode)) (cadar encode) (cadr (cadar encode)))))
129 (list (list value (obj:name (ifld-encode-mode self)) "value")
130 (list pc 'IAI "pc"))))
137 (ifld-insert-fn-name self)
143 ; We explicitly pass the attributes here rather than look them up
144 ; to give the code more optimization opportunities.
145 ; ??? Maybe when fields are recorded in opc.c, stop doing this, and
146 ; pass a pointer to the recorded attributes instead.
147 (gen-bool-attrs (if (eq? (mode:class (ifld-mode self)) 'INT)
148 (atlist-cons (bool-attr-make 'SIGNED #t)
152 ", " (number->string (ifld-word-offset self))
153 ", " (number->string (ifld-start self))
154 ", " (number->string (ifld-length self))
155 ", " (number->string (ifld-word-length self))
165 ; Default routine to emit C code to extract a field from an insn.
168 <ifield> 'gen-extract
169 (lambda (self operand)
170 (let* ((decode (elm-get self 'decode))
171 (need-extra? decode) ; use to also handle operand's `extract' field
172 (varname (gen-operand-result-var self)))
175 (string-append " {\n "
176 (gen-ifield-default-type)
180 (ifld-extract-fn-name self)
181 " (cd, ex_info, insn_value, "
182 ; We explicitly pass the attributes here rather than look them up
183 ; to give the code more optimization opportunities.
184 ; ??? Maybe when fields are recorded in opc.c, stop doing this, and
185 ; pass a pointer to the recorded attributes instead.
186 (gen-bool-attrs (if (eq? (mode:class (ifld-mode self)) 'INT)
187 (atlist-cons (bool-attr-make 'SIGNED #t)
191 ", " (number->string (ifld-word-offset self))
192 ", " (number->string (ifld-start self))
193 ", " (number->string (ifld-length self))
194 ", " (number->string (ifld-word-length self))
203 (string-append " value = "
204 ;; NOTE: DECODE is either, e.g.,
205 ;; ((value pc) (sll DI value 1))
207 ;; (((<mode> value) (<mode> pc)) (sll DI value 1))
208 (let ((expr (cadr decode))
209 (value (if (symbol? (caar decode)) (caar decode) (cadr (caar decode))))
210 (pc (if (symbol? (cadar decode)) (cadar decode) (cadr (cadar decode)))))
212 (list (list value (obj:name (ifld-decode-mode self)) "value")
213 (list pc 'IAI "pc"))))
217 (string-append " " varname " = value;\n"
223 ; gen-insert of multi-ifields
226 <multi-ifield> 'gen-insert
227 (lambda (self operand)
228 (let* ((varname (gen-operand-result-var self))
229 (encode (elm-get self 'encode))
230 (need-extra? encode))
234 (string-append " " varname " = "
235 (let ((expr (cadr encode))
236 (value (caar encode))
239 (list (list value (obj:name (ifld-encode-mode self)) varname)
240 (list pc 'IAI "pc"))))
243 (let ((expr (elm-get self 'insert)))
244 (rtl-c VOID expr nil))
245 (string-list-map (lambda (subfld)
248 (send subfld 'gen-insert operand)
251 (elm-get self 'subfields))
256 ; gen-insert of derived-operands
259 <derived-operand> 'gen-insert
260 (lambda (self operand)
264 ; gen-extract of multi-ifields
267 <multi-ifield> 'gen-extract
268 (lambda (self operand)
269 (let* ((varname (gen-operand-result-var self))
270 (decode (elm-get self 'decode))
271 (need-extra? decode))
274 (string-list-map (lambda (subfld)
277 (send subfld 'gen-extract operand)
278 " if (length <= 0) break;\n"
280 (elm-get self 'subfields))
281 (let ((expr (elm-get self 'extract)))
282 (rtl-c VOID expr nil))
284 (string-append " " varname " = "
285 (let ((expr (cadr decode))
286 (value (caar decode))
289 (list (list value (obj:name (ifld-decode-mode self)) varname)
290 (list pc 'IAI "pc"))))
299 <derived-operand> 'gen-extract
300 (lambda (self operand)
305 ; <derived-operand> 'gen-extract
306 ; (lambda (self operand)
309 ; (string-list-map (lambda (subop)
311 ; " " (send subop 'gen-extract operand)
312 ; " if (length <= 0)\n"
314 ; (elm-get self 'args))
320 ; Hardware index support code.
323 <hw-index> 'gen-insert
324 (lambda (self operand)
325 (case (hw-index:type self)
327 (send (hw-index:value self) 'gen-insert operand))
333 <hw-index> 'gen-extract
334 (lambda (self operand)
335 (case (hw-index:type self)
337 (send (hw-index:value self) 'gen-extract operand))
341 ; HW-ASM is the base class for supporting hardware elements in the opcode table
342 ; (aka assembler/disassembler).
344 ; Utility to return C code to parse a number of <mode> MODE for an operand.
345 ; RESULT-VAR-NAME is a string containing the variable to store the
347 ; PARSE-FN is the name of the function to call or #f to use the default.
348 ; OP-ENUM is the enum of the operand.
350 (define (/gen-parse-number mode parse-fn op-enum result-var-name)
353 ; Use operand's special parse function if there is one, otherwise compute
354 ; the function's name from the mode.
356 (case (obj:name mode)
357 ((QI HI SI INT) "cgen_parse_signed_integer")
358 ((BI UQI UHI USI UINT) "cgen_parse_unsigned_integer")
359 (else (error "unsupported (as yet) mode for parsing"
364 ; This is to pacify gcc 4.x which will complain about
365 ; incorrect signed-ness of pointers passed to functions.
366 (case (obj:name mode)
367 ((QI HI SI INT) "(long *)")
368 ((BI UQI UHI USI UINT) "(unsigned long *)")
370 " (& " result-var-name
375 ; Utility to return C code to parse an address.
376 ; RESULT-VAR-NAME is a string containing the variable to store the
378 ; PARSE-FN is the name of the function to call or #f to use the default.
379 ; OP-ENUM is the enum of the operand.
381 (define (/gen-parse-address parse-fn op-enum result-var-name)
384 " bfd_vma value = 0;\n"
386 ; Use operand's special parse function if there is one.
388 "cgen_parse_address")
392 "NULL, " ; result_type arg (FIXME)
394 " " result-var-name " = value;\n"
399 ; Return C code to parse an expression.
403 (lambda (self operand)
404 (let ((mode (elm-get self 'mode))
406 (case (hw-index:type (op:index operand))
407 ((ifield) (gen-operand-result-var (op-ifield operand)))
409 (if (address? (op:type operand))
410 (/gen-parse-address (send operand 'gen-function-name 'parse)
413 (/gen-parse-number mode (send operand 'gen-function-name 'parse)
418 ; Default method to emit C code to print a hardware element.
422 (lambda (self operand)
424 (case (hw-index:type (op:index operand))
425 ((ifield) (gen-operand-result-var (op-ifield operand)))
429 (or (send operand 'gen-function-name 'print)
430 (and (address? (op:type operand))
433 ; (or (send operand 'gen-function-name 'print)
434 ; (case (obj:name (elm-get self 'mode))
435 ; ((QI HI SI INT) "print_signed")
436 ; ((BI UQI UHI USI UINT) "print_unsigned")
437 ; (else (error "unsupported (as yet) mode for printing"
438 ; (obj:name (elm-get self 'mode))))))
442 ; We explicitly pass the attributes here rather than look them up
443 ; to give the code more optimization opportunities.
444 (gen-bool-attrs (if (eq? (mode:class (elm-get self 'mode)) 'INT)
445 (atlist-cons (bool-attr-make 'SIGNED #t)
446 (obj-atlist operand))
447 (obj-atlist operand))
449 ;(gen-bool-attrs (obj-atlist operand) gen-attr-mask)
457 ; Return C code to parse a keyword.
461 (lambda (self operand)
463 (case (hw-index:type (op:index operand))
464 ((ifield) (gen-operand-result-var (op-ifield operand)))
468 (or (send operand 'gen-function-name 'parse)
469 "cgen_parse_keyword")
471 (send self 'gen-ref) ", "
472 ;(op-enum operand) ", "
478 ; Return C code to print a keyword.
482 (lambda (self operand)
484 (case (hw-index:type (op:index operand))
485 ((ifield) (gen-operand-result-var (op-ifield operand)))
489 (or (send operand 'gen-function-name 'print)
492 "info" ; The disassemble_info argument to print_insn.
497 ; We explicitly pass the attributes here rather than look them up
498 ; to give the code more optimization opportunities.
499 (gen-bool-attrs (obj-atlist operand) gen-attr-mask)
506 ; For registers, use the indices field. Ignore values.
507 ; ??? Not that that will always be the case.
509 (method-make-forward! <hw-register> 'indices '(gen-parse gen-print))
511 ; No such support for memory yet.
514 <hw-memory> 'gen-parse
515 (lambda (self operand)
516 (error "gen-parse of memory not supported yet"))
520 <hw-memory> 'gen-print
521 (lambda (self operand)
522 (error "gen-print of memory not supported yet"))
525 ; For immediates, use the values field. Ignore indices.
526 ; ??? Not that that will always be the case.
528 (method-make-forward! <hw-immediate> 'values '(gen-parse gen-print))
530 ; For addresses, use the values field. Ignore indices.
532 (method-make-forward! <hw-address> 'values '(gen-parse gen-print))
534 ; Generate the C code for dealing with operands.
535 ; This code is inserted into cgen-{ibld,asm,dis}.in above the insn routines
536 ; so that it can be inlined if desired. ??? Actually this isn't always the
537 ; case but this is minutiae to be dealt with much later.
539 ; Generate the guts of a C switch to handle an operation for all operands.
540 ; WHAT is one of fget/fset/parse/insert/extract/print.
542 ; The "f" prefix (e.g. set -> fset) is for "field" to distinguish the
543 ; operations from similar ones in other contexts. ??? I'd prefer to come
544 ; up with better names for fget/fset but I haven't come up with anything
547 (define (gen-switch what)
550 ; OPS is a list of operands with the same name that for whatever reason
551 ; were defined separately.
552 (logit 3 (string/symbol-append
553 "Processing " (obj:str-name (car ops)) " " what " ...\n"))
554 (if (= (length ops) 1)
558 " case @ARCH@_OPERAND_"
559 (string-upcase (gen-sym (car ops)))
561 (send (car ops) (symbol-append 'gen- what) (car ops))
564 ; FIXME: operand name doesn't get sanitized.
565 " case @ARCH@_OPERAND_"
566 (string-upcase (gen-sym (car ops)))
568 ; There's more than one operand defined with this name, so we
569 ; have to distinguish them.
571 (string-list-map (lambda (op)
575 (send op (symbol-append 'gen- what) op)
580 (op-sort (find (lambda (op) (and (not (has-attr? op 'SEM-ONLY))
581 (not (anyof-operand? op))
582 (not (derived-operand? op))))
588 ; Return the function name to use for WHAT or #f if there isn't a special one.
589 ; WHAT is one of fget/fset/parse/insert/extract/print.
592 <operand> 'gen-function-name
594 (let ((handlers (elm-get self 'handlers)))
595 (let ((fn (assq-ref handlers what)))
596 (and fn (string-append (symbol->string what) "_" (car fn))))))
600 ; The default is to forward the request onto TYPE.
601 ; OP is a copy of SELF so the method we forward to sees it.
602 ; There is one case in the fget/fset/parse/insert/extract/print
603 ; switches for each operand.
604 ; These are invoked via gen-switch.
606 ; Emit C code to get an operand value from the fields struct.
607 ; Operand values are stored in a struct "indexed" by field name.
609 ; The "f" prefix (e.g. set -> fset) is for "field" to distinguish the
610 ; operations from similar ones in other contexts. ??? I'd prefer to come
611 ; up with better names for fget/fset but I haven't come up with anything
616 (lambda (self operand)
617 (case (hw-index:type (op:index self))
619 (string-append " value = "
620 (gen-operand-result-var (op-ifield self))
627 <derived-operand> 'gen-fget
628 (lambda (self operand)
629 " abort();\n") ; should never be called
632 ; Emit C code to save an operand value in the fields struct.
636 (lambda (self operand)
637 (case (hw-index:type (op:index self))
640 (gen-operand-result-var (op-ifield self))
647 <derived-operand> 'gen-fset
648 (lambda (self operand)
649 " abort();\n") ; should never be called
652 ; Need to call op:type to resolve the hardware reference.
653 ;(method-make-forward! <operand> 'type '(gen-parse gen-print))
657 (lambda (self operand)
658 (send (op:type self) 'gen-parse operand))
662 <derived-operand> 'gen-parse
663 (lambda (self operand)
664 " abort();\n") ; should never be called
669 (lambda (self operand)
670 (send (op:type self) 'gen-print operand))
674 <derived-operand> 'gen-print
675 (lambda (self operand)
676 " abort();\n") ; should never be called
679 (method-make-forward! <operand> 'index '(gen-insert gen-extract))
680 ; But: <derived-operand> has its own gen-insert / gen-extract.
682 ; Return the value of PC.
683 ; Used by insert/extract fields.
687 (lambda (self estate mode index selector)
691 ; Opcodes init,finish,analyzer support.
693 ; Initialize any opcodes specific things before loading the .cpu file.
695 (define (opcodes-init!)
697 (mode-set-biggest-word-bitsizes!)
701 ; Finish any opcodes specific things after loading the .cpu file.
702 ; This is separate from analyze-data! as cpu-load performs some
703 ; consistency checks in between.
705 (define (opcodes-finish!)
710 ; Compute various needed globals and assign any computed fields of
711 ; the various objects. This is the standard routine that is called after
712 ; a .cpu file is loaded.
714 (define (opcodes-analyze!)
717 ; Initialize the rtl->c translator.
720 ; Only include semantic operands when computing the format tables if we're
721 ; generating operand instance tables.
722 ; ??? Actually, may always be able to exclude the semantic operands.
723 ; Still need to traverse the semantics to derive machine computed attributes.
724 (arch-analyze-insns! CURRENT-ARCH
726 /opcodes-build-operand-instance-table?)
731 ; Extra target specific code generation.
733 ; Pick out a section from the .opc file.
734 ; The section is delimited with:
739 ; FIXME: This is a pretty involved bit of code. 'twould be nice to split
740 ; it up into manageable chunks.
742 (define (read-cpu.opc opc-file delim)
743 (let ((file opc-file)
744 (start-delim (string-append "/* -- " delim))
745 (end-delim "/* -- "))
746 (if (file-exists? file)
747 (let ((port (open-file file "r"))
748 ; Extra amount is added to SIZE so substring's to fetch possible
749 ; delim won't fail, even at end of file
750 (size (+ (file-size file) (string-length start-delim))))
752 (let ((result (make-string size #\space)))
753 (let loop ((start -1) (line 0) (index 0))
754 (let ((char (read-char port)))
755 (if (not (eof-object? char))
756 (string-set! result index char))
757 (cond ((eof-object? char)
760 ; End of file, did we find the text?
763 (substring result start index))))
764 ((char=? char #\newline)
765 ; Check for start delim or end delim?
767 (if (string=? (substring result line
768 (+ (string-length start-delim)
771 (loop line (+ index 1) (+ index 1))
772 (loop -1 (+ index 1) (+ index 1)))
773 (if (string=? (substring result line
774 (+ (string-length end-delim)
779 (substring result start (+ index 1)))
780 (loop start (+ index 1) (+ index 1)))))
782 (loop start line (+ index 1)))))))
783 (error "Unable to open:" file)))
784 "" ; file doesn't exist
788 (define (gen-extra-cpu.h opc-file arch)
789 (logit 2 "Generating extra cpu.h stuff from " arch ".opc ...\n")
790 (read-cpu.opc opc-file "cpu.h")
792 (define (gen-extra-cpu.c opc-file arch)
793 (logit 2 "Generating extra cpu.c stuff from " arch ".opc ...\n")
794 (read-cpu.opc opc-file "cpu.c")
796 (define (gen-extra-opc.h opc-file arch)
797 (logit 2 "Generating extra opc.h stuff from " arch ".opc ...\n")
798 (read-cpu.opc opc-file "opc.h")
800 (define (gen-extra-opc.c opc-file arch)
801 (logit 2 "Generating extra opc.c stuff from " arch ".opc ...\n")
802 (read-cpu.opc opc-file "opc.c")
804 (define (gen-extra-asm.c opc-file arch)
805 (logit 2 "Generating extra asm.c stuff from " arch ".opc ...\n")
806 (read-cpu.opc opc-file "asm.c")
808 (define (gen-extra-dis.c opc-file arch)
809 (logit 2 "Generating extra dis.c stuff from " arch ".opc ...\n")
810 (read-cpu.opc opc-file "dis.c")
812 (define (gen-extra-ibld.h opc-file arch)
813 (logit 2 "Generating extra ibld.h stuff from " arch ".opc ...\n")
814 (read-cpu.opc opc-file "ibld.h")
816 (define (gen-extra-ibld.c opc-file arch)
817 (logit 2 "Generating extra ibld.c stuff from " arch ".opc ...\n")
818 (read-cpu.opc opc-file "ibld.c")