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)))))
130 (list (list value (obj:name (ifld-decode-mode self)) "value")
139 (ifld-insert-fn-name self)
145 ; We explicitly pass the attributes here rather than look them up
146 ; to give the code more optimization opportunities.
147 ; ??? Maybe when fields are recorded in opc.c, stop doing this, and
148 ; pass a pointer to the recorded attributes instead.
149 (gen-bool-attrs (if (eq? (mode:class (ifld-mode self)) 'INT)
150 (atlist-cons (bool-attr-make 'SIGNED #t)
154 ", " (number->string (ifld-word-offset self))
155 ", " (number->string (ifld-start self))
156 ", " (number->string (ifld-length self))
157 ", " (number->string (ifld-word-length self))
167 ; Default routine to emit C code to extract a field from an insn.
170 <ifield> 'gen-extract
171 (lambda (self operand)
172 (let* ((decode (elm-get self 'decode))
173 (need-extra? decode) ; use to also handle operand's `extract' field
174 (varname (gen-operand-result-var self)))
177 (string-append " {\n "
178 (gen-ifield-default-type)
182 (ifld-extract-fn-name self)
183 " (cd, ex_info, insn_value, "
184 ; We explicitly pass the attributes here rather than look them up
185 ; to give the code more optimization opportunities.
186 ; ??? Maybe when fields are recorded in opc.c, stop doing this, and
187 ; pass a pointer to the recorded attributes instead.
188 (gen-bool-attrs (if (eq? (mode:class (ifld-mode self)) 'INT)
189 (atlist-cons (bool-attr-make 'SIGNED #t)
193 ", " (number->string (ifld-word-offset self))
194 ", " (number->string (ifld-start self))
195 ", " (number->string (ifld-length self))
196 ", " (number->string (ifld-word-length self))
205 (string-append " value = "
206 ;; NOTE: DECODE is either, e.g.,
207 ;; ((value pc) (sll DI value 1))
209 ;; (((<mode> value) (<mode> pc)) (sll DI value 1))
210 (let ((expr (cadr decode))
211 (value (if (symbol? (caar decode)) (caar decode) (cadr (caar decode))))
212 (pc (if (symbol? (cadar decode)) (cadar decode) (cadr (cadar decode)))))
215 (list (list value (obj:name (ifld-decode-mode self)) "value")
221 (string-append " " varname " = value;\n"
227 ; gen-insert of multi-ifields
230 <multi-ifield> 'gen-insert
231 (lambda (self operand)
232 (let* ((varname (gen-operand-result-var self))
233 (encode (elm-get self 'encode))
234 (need-extra? encode))
238 (string-append " " varname " = "
239 (let ((expr (cadr encode))
240 (value (caar encode))
244 (list (list value (obj:name (ifld-decode-mode self)) varname)
249 (let ((expr (elm-get self 'insert)))
250 (rtl-c VOID (obj-isa-list self) nil expr))
251 (string-list-map (lambda (subfld)
254 (send subfld 'gen-insert operand)
257 (elm-get self 'subfields))
262 ; gen-insert of derived-operands
265 <derived-operand> 'gen-insert
266 (lambda (self operand)
270 ; gen-extract of multi-ifields
273 <multi-ifield> 'gen-extract
274 (lambda (self operand)
275 (let* ((varname (gen-operand-result-var self))
276 (decode (elm-get self 'decode))
277 (need-extra? decode))
280 (string-list-map (lambda (subfld)
283 (send subfld 'gen-extract operand)
284 " if (length <= 0) break;\n"
286 (elm-get self 'subfields))
287 (let ((expr (elm-get self 'extract)))
288 (rtl-c VOID (obj-isa-list self) nil expr))
290 (string-append " " varname " = "
291 (let ((expr (cadr decode))
292 (value (caar decode))
296 (list (list value (obj:name (ifld-decode-mode self)) varname)
307 <derived-operand> 'gen-extract
308 (lambda (self operand)
313 ; <derived-operand> 'gen-extract
314 ; (lambda (self operand)
317 ; (string-list-map (lambda (subop)
319 ; " " (send subop 'gen-extract operand)
320 ; " if (length <= 0)\n"
322 ; (elm-get self 'args))
328 ; Hardware index support code.
331 <hw-index> 'gen-insert
332 (lambda (self operand)
333 (case (hw-index:type self)
335 (send (hw-index:value self) 'gen-insert operand))
341 <hw-index> 'gen-extract
342 (lambda (self operand)
343 (case (hw-index:type self)
345 (send (hw-index:value self) 'gen-extract operand))
349 ; HW-ASM is the base class for supporting hardware elements in the opcode table
350 ; (aka assembler/disassembler).
352 ; Utility to return C code to parse a number of <mode> MODE for an operand.
353 ; RESULT-VAR-NAME is a string containing the variable to store the
355 ; PARSE-FN is the name of the function to call or #f to use the default.
356 ; OP-ENUM is the enum of the operand.
358 (define (/gen-parse-number mode parse-fn op-enum result-var-name)
361 ; Use operand's special parse function if there is one, otherwise compute
362 ; the function's name from the mode.
364 (case (obj:name mode)
365 ((QI HI SI INT) "cgen_parse_signed_integer")
366 ((BI UQI UHI USI UINT) "cgen_parse_unsigned_integer")
367 (else (error "unsupported (as yet) mode for parsing"
372 ; This is to pacify gcc 4.x which will complain about
373 ; incorrect signed-ness of pointers passed to functions.
374 (case (obj:name mode)
375 ((QI HI SI INT) "(long *)")
376 ((BI UQI UHI USI UINT) "(unsigned long *)")
378 " (& " result-var-name
383 ; Utility to return C code to parse an address.
384 ; RESULT-VAR-NAME is a string containing the variable to store the
386 ; PARSE-FN is the name of the function to call or #f to use the default.
387 ; OP-ENUM is the enum of the operand.
389 (define (/gen-parse-address parse-fn op-enum result-var-name)
392 " bfd_vma value = 0;\n"
394 ; Use operand's special parse function if there is one.
396 "cgen_parse_address")
400 "NULL, " ; result_type arg (FIXME)
402 " " result-var-name " = value;\n"
407 ; Return C code to parse an expression.
411 (lambda (self operand)
412 (let ((mode (elm-get self 'mode))
414 (case (hw-index:type (op:index operand))
415 ((ifield) (gen-operand-result-var (op-ifield operand)))
417 (if (address? (op:type operand))
418 (/gen-parse-address (send operand 'gen-function-name 'parse)
421 (/gen-parse-number mode (send operand 'gen-function-name 'parse)
426 ; Default method to emit C code to print a hardware element.
430 (lambda (self operand)
432 (case (hw-index:type (op:index operand))
433 ((ifield) (gen-operand-result-var (op-ifield operand)))
437 (or (send operand 'gen-function-name 'print)
438 (and (address? (op:type operand))
441 ; (or (send operand 'gen-function-name 'print)
442 ; (case (obj:name (elm-get self 'mode))
443 ; ((QI HI SI INT) "print_signed")
444 ; ((BI UQI UHI USI UINT) "print_unsigned")
445 ; (else (error "unsupported (as yet) mode for printing"
446 ; (obj:name (elm-get self 'mode))))))
450 ; We explicitly pass the attributes here rather than look them up
451 ; to give the code more optimization opportunities.
452 (gen-bool-attrs (if (eq? (mode:class (elm-get self 'mode)) 'INT)
453 (atlist-cons (bool-attr-make 'SIGNED #t)
454 (obj-atlist operand))
455 (obj-atlist operand))
457 ;(gen-bool-attrs (obj-atlist operand) gen-attr-mask)
465 ; Return C code to parse a keyword.
469 (lambda (self operand)
471 (case (hw-index:type (op:index operand))
472 ((ifield) (gen-operand-result-var (op-ifield operand)))
476 (or (send operand 'gen-function-name 'parse)
477 "cgen_parse_keyword")
479 (send self 'gen-ref) ", "
480 ;(op-enum operand) ", "
486 ; Return C code to print a keyword.
490 (lambda (self operand)
492 (case (hw-index:type (op:index operand))
493 ((ifield) (gen-operand-result-var (op-ifield operand)))
497 (or (send operand 'gen-function-name 'print)
500 "info" ; The disassemble_info argument to print_insn.
505 ; We explicitly pass the attributes here rather than look them up
506 ; to give the code more optimization opportunities.
507 (gen-bool-attrs (obj-atlist operand) gen-attr-mask)
514 ; For registers, use the indices field. Ignore values.
515 ; ??? Not that that will always be the case.
517 (method-make-forward! <hw-register> 'indices '(gen-parse gen-print))
519 ; No such support for memory yet.
522 <hw-memory> 'gen-parse
523 (lambda (self operand)
524 (error "gen-parse of memory not supported yet"))
528 <hw-memory> 'gen-print
529 (lambda (self operand)
530 (error "gen-print of memory not supported yet"))
533 ; For immediates, use the values field. Ignore indices.
534 ; ??? Not that that will always be the case.
536 (method-make-forward! <hw-immediate> 'values '(gen-parse gen-print))
538 ; For addresses, use the values field. Ignore indices.
540 (method-make-forward! <hw-address> 'values '(gen-parse gen-print))
542 ; Generate the C code for dealing with operands.
543 ; This code is inserted into cgen-{ibld,asm,dis}.in above the insn routines
544 ; so that it can be inlined if desired. ??? Actually this isn't always the
545 ; case but this is minutiae to be dealt with much later.
547 ; Generate the guts of a C switch to handle an operation for all operands.
548 ; WHAT is one of fget/fset/parse/insert/extract/print.
550 ; The "f" prefix (e.g. set -> fset) is for "field" to distinguish the
551 ; operations from similar ones in other contexts. ??? I'd prefer to come
552 ; up with better names for fget/fset but I haven't come up with anything
555 (define (gen-switch what)
558 ; OPS is a list of operands with the same name that for whatever reason
559 ; were defined separately.
560 (logit 3 (string/symbol-append
561 "Processing " (obj:str-name (car ops)) " " what " ...\n"))
562 (if (= (length ops) 1)
566 " case @ARCH@_OPERAND_"
567 (string-upcase (gen-sym (car ops)))
569 (send (car ops) (symbol-append 'gen- what) (car ops))
572 ; FIXME: operand name doesn't get sanitized.
573 " case @ARCH@_OPERAND_"
574 (string-upcase (gen-sym (car ops)))
576 ; There's more than one operand defined with this name, so we
577 ; have to distinguish them.
579 (string-list-map (lambda (op)
583 (send op (symbol-append 'gen- what) op)
588 (op-sort (find (lambda (op) (and (not (has-attr? op 'SEM-ONLY))
589 (not (anyof-operand? op))
590 (not (derived-operand? op))))
596 ; Return the function name to use for WHAT or #f if there isn't a special one.
597 ; WHAT is one of fget/fset/parse/insert/extract/print.
600 <operand> 'gen-function-name
602 (let ((handlers (elm-get self 'handlers)))
603 (let ((fn (assq-ref handlers what)))
604 (and fn (string-append (symbol->string what) "_" (car fn))))))
608 ; The default is to forward the request onto TYPE.
609 ; OP is a copy of SELF so the method we forward to sees it.
610 ; There is one case in the fget/fset/parse/insert/extract/print
611 ; switches for each operand.
612 ; These are invoked via gen-switch.
614 ; Emit C code to get an operand value from the fields struct.
615 ; Operand values are stored in a struct "indexed" by field name.
617 ; The "f" prefix (e.g. set -> fset) is for "field" to distinguish the
618 ; operations from similar ones in other contexts. ??? I'd prefer to come
619 ; up with better names for fget/fset but I haven't come up with anything
624 (lambda (self operand)
625 (case (hw-index:type (op:index self))
627 (string-append " value = "
628 (gen-operand-result-var (op-ifield self))
635 <derived-operand> 'gen-fget
636 (lambda (self operand)
637 " abort();\n") ; should never be called
640 ; Emit C code to save an operand value in the fields struct.
644 (lambda (self operand)
645 (case (hw-index:type (op:index self))
648 (gen-operand-result-var (op-ifield self))
655 <derived-operand> 'gen-fset
656 (lambda (self operand)
657 " abort();\n") ; should never be called
660 ; Need to call op:type to resolve the hardware reference.
661 ;(method-make-forward! <operand> 'type '(gen-parse gen-print))
665 (lambda (self operand)
666 (send (op:type self) 'gen-parse operand))
670 <derived-operand> 'gen-parse
671 (lambda (self operand)
672 " abort();\n") ; should never be called
677 (lambda (self operand)
678 (send (op:type self) 'gen-print operand))
682 <derived-operand> 'gen-print
683 (lambda (self operand)
684 " abort();\n") ; should never be called
687 (method-make-forward! <operand> 'index '(gen-insert gen-extract))
688 ; But: <derived-operand> has its own gen-insert / gen-extract.
690 ; Return the value of PC.
691 ; Used by insert/extract fields.
695 (lambda (self estate mode index selector)
699 ; Opcodes init,finish,analyzer support.
701 ; Initialize any opcodes specific things before loading the .cpu file.
703 (define (opcodes-init!)
705 (mode-set-biggest-word-bitsizes!)
709 ; Finish any opcodes specific things after loading the .cpu file.
710 ; This is separate from analyze-data! as cpu-load performs some
711 ; consistency checks in between.
713 (define (opcodes-finish!)
718 ; Compute various needed globals and assign any computed fields of
719 ; the various objects. This is the standard routine that is called after
720 ; a .cpu file is loaded.
722 (define (opcodes-analyze!)
725 ; Initialize the rtl->c translator.
728 ; Only include semantic operands when computing the format tables if we're
729 ; generating operand instance tables.
730 ; ??? Actually, may always be able to exclude the semantic operands.
731 ; Still need to traverse the semantics to derive machine computed attributes.
732 (arch-analyze-insns! CURRENT-ARCH
734 /opcodes-build-operand-instance-table?)
739 ; Extra target specific code generation.
741 ; Pick out a section from the .opc file.
742 ; The section is delimited with:
747 ; FIXME: This is a pretty involved bit of code. 'twould be nice to split
748 ; it up into manageable chunks.
750 (define (read-cpu.opc opc-file delim)
751 (let ((file opc-file)
752 (start-delim (string-append "/* -- " delim))
753 (end-delim "/* -- "))
754 (if (file-exists? file)
755 (let ((port (open-file file "r"))
756 ; Extra amount is added to SIZE so substring's to fetch possible
757 ; delim won't fail, even at end of file
758 (size (+ (file-size file) (string-length start-delim))))
760 (let ((result (make-string size #\space)))
761 (let loop ((start -1) (line 0) (index 0))
762 (let ((char (read-char port)))
763 (if (not (eof-object? char))
764 (string-set! result index char))
765 (cond ((eof-object? char)
768 ; End of file, did we find the text?
771 (substring result start index))))
772 ((char=? char #\newline)
773 ; Check for start delim or end delim?
775 (if (string=? (substring result line
776 (+ (string-length start-delim)
779 (loop line (+ index 1) (+ index 1))
780 (loop -1 (+ index 1) (+ index 1)))
781 (if (string=? (substring result line
782 (+ (string-length end-delim)
787 (substring result start (+ index 1)))
788 (loop start (+ index 1) (+ index 1)))))
790 (loop start line (+ index 1)))))))
791 (error "Unable to open:" file)))
792 "" ; file doesn't exist
796 (define (gen-extra-cpu.h opc-file arch)
797 (logit 2 "Generating extra cpu.h stuff from " arch ".opc ...\n")
798 (read-cpu.opc opc-file "cpu.h")
800 (define (gen-extra-cpu.c opc-file arch)
801 (logit 2 "Generating extra cpu.c stuff from " arch ".opc ...\n")
802 (read-cpu.opc opc-file "cpu.c")
804 (define (gen-extra-opc.h opc-file arch)
805 (logit 2 "Generating extra opc.h stuff from " arch ".opc ...\n")
806 (read-cpu.opc opc-file "opc.h")
808 (define (gen-extra-opc.c opc-file arch)
809 (logit 2 "Generating extra opc.c stuff from " arch ".opc ...\n")
810 (read-cpu.opc opc-file "opc.c")
812 (define (gen-extra-asm.c opc-file arch)
813 (logit 2 "Generating extra asm.c stuff from " arch ".opc ...\n")
814 (read-cpu.opc opc-file "asm.c")
816 (define (gen-extra-dis.c opc-file arch)
817 (logit 2 "Generating extra dis.c stuff from " arch ".opc ...\n")
818 (read-cpu.opc opc-file "dis.c")
820 (define (gen-extra-ibld.h opc-file arch)
821 (logit 2 "Generating extra ibld.h stuff from " arch ".opc ...\n")
822 (read-cpu.opc opc-file "ibld.h")
824 (define (gen-extra-ibld.c opc-file arch)
825 (logit 2 "Generating extra ibld.c stuff from " arch ".opc ...\n")
826 (read-cpu.opc opc-file "ibld.c")