2 ; Copyright (C) 2000, 2002, 2003, 2009 Red Hat, Inc.
3 ; This file is part of CGEN.
4 ; See file COPYING.CGEN for details.
6 ; This file contains utilities specific to cgen.
7 ; Generic utilities should go in utils.scm.
9 ; True if text of sanitize markers are to be emitted.
10 ; This is a debugging tool only, though it could have use in sanitized trees.
11 (define include-sanitize-marker? #t)
13 ; Utility to display command line invocation for debugging purposes.
15 (define (display-argv argv)
16 (let ((cep (current-error-port)))
17 (display "cgen -s " cep)
18 (for-each (lambda (arg)
19 ; Output double-quotes if string has a space for better
20 ; correspondence to how to specify string to shell.
21 (if (string-index arg #\space)
30 ; Perhaps these should be provided with cos (cgen-object-system), but for
33 ; Define the getter for a list of elements of a class.
35 (defmacro define-getters (class class-prefix elm-names)
37 (map (lambda (elm-name)
39 `(define ,(symbol-append class-prefix '- (cdr elm-name))
40 (elm-make-getter ,class (quote ,(car elm-name))))
41 `(define ,(symbol-append class-prefix '- elm-name)
42 (elm-make-getter ,class (quote ,elm-name)))))
46 ; Define the setter for a list of elements of a class.
48 (defmacro define-setters (class class-prefix elm-names)
50 (map (lambda (elm-name)
52 `(define ,(symbol-append class-prefix '-set- (cdr elm-name) '!)
53 (elm-make-setter ,class (quote ,(car elm-name))))
54 `(define ,(symbol-append class-prefix '-set- elm-name '!)
55 (elm-make-setter ,class (quote ,elm-name)))))
59 ; Make an object, specifying values for particular elements.
60 ; ??? Eventually move to cos.scm/cos.c.
62 (define (vmake class . args)
63 (let ((obj (new class)))
64 (let ((unrecognized (send obj 'vmake! args)))
65 (if (null? unrecognized)
67 (error "vmake: unknown options:" unrecognized))))
70 ;;; Source locations are recorded as a stack, with (ideally) one extra level
71 ;;; for each macro invocation.
73 (define <location> (class-make '<location>
76 ;; A list of "single-location" objects,
77 ;; sorted by most recent location first.
82 (define-getters <location> location (list))
83 (define-setters <location> location (list))
85 ;;; A single source location.
86 ;;; This is recorded as a vector for simplicity.
87 ;;; END? is true if the location marks the end of the expression.
88 ;;; NOTE: LINE and COLUMN are origin-0 (the first line is line 0).
90 (define (make-single-location file line column end?)
91 (vector file line column end?)
94 (define (single-location-file sloc) (vector-ref sloc 0))
95 (define (single-location-line sloc) (vector-ref sloc 1))
96 (define (single-location-column sloc) (vector-ref sloc 2))
97 (define (single-location-end? sloc) (vector-ref sloc 3))
99 ;;; Return a single-location in a readable form.
101 (define (single-location->string sloc)
102 ;; +1: numbers are recorded origin-0
103 (string-append (single-location-file sloc)
105 (number->string (+ (single-location-line sloc) 1))
107 (number->string (+ (single-location-column sloc) 1))
108 (if (single-location-end? sloc) "(end)" ""))
111 ;;; Same as single-location->string, except omit any directory info in
114 (define (single-location->simple-string sloc)
115 ;; +1: numbers are recorded origin-0
116 (string-append (basename (single-location-file sloc))
118 (number->string (+ (single-location-line sloc) 1))
120 (number->string (+ (single-location-column sloc) 1))
121 (if (single-location-end? sloc) "(end)" ""))
124 ;;; Return a location in a readable form.
126 (define (location->string loc)
127 (let ((ref-from " referenced from:"))
129 (- 0 (string-length ref-from) 1)
134 (single-location->string sloc)
137 (location-list loc))))))
140 ;;; Return the location information in Guile's source-properties
141 ;;; in a readable form.
143 (define (source-properties-location->string src-props)
144 (let ((file (assq-ref src-props 'filename))
145 (line (assq-ref src-props 'line))
146 (column (assq-ref src-props 'column)))
149 (number->string (+ line 1))
151 (number->string (+ column 1))))
154 ;;; Return the top location on LOC's stack.
156 (define (location-top loc)
157 (car (location-list loc))
160 ;;; Return a new <location> with FILE, LINE pushed onto the stack.
162 (define (location-push-single loc file line column end?)
163 (make <location> (cons (make-single-location file line column end?)
164 (location-list loc)))
167 ;;; Return a new <location> with NEW-LOC preappended to LOC.
169 (define (location-push loc new-loc)
170 (make <location> (append (location-list new-loc)
171 (location-list loc)))
174 ;;; Return an unspecified <location>.
175 ;;; This is mainly for use in debugging utilities.
176 ;;; Ideally for .cpu-file related stuff we always have a location,
177 ;;; but that's not always true.
179 (define (unspecified-location)
180 (make <location> (list (make-single-location "unspecified" 0 0 #f)))
183 ;;; Return a location denoting a builtin object.
185 (define (builtin-location)
186 (make <location> (list (make-single-location "builtin" 0 0 #f)))
189 ;;; Return a <location> object for the current input port.
190 ;;; END? is true if the location marks the end of the expression.
192 (define (current-input-location end?)
193 (let ((cip (current-input-port)))
194 (make <location> (list (make-single-location (port-filename cip)
200 ;;; An object property for tracking source locations during macro expansion.
202 (define location-property (make-object-property))
204 ;;; Set FORM's location to LOC.
206 (define (location-property-set! form loc)
207 (set! (location-property form) loc)
211 ; Each named entry in the description file typically has these three members:
212 ; name, comment attrs.
214 (define <ident> (class-make '<ident> '() '(name comment attrs) '()))
216 (method-make! <ident> 'get-name (lambda (self) (elm-get self 'name)))
217 (method-make! <ident> 'get-comment (lambda (self) (elm-get self 'comment)))
218 (method-make! <ident> 'get-atlist (lambda (self) (elm-get self 'attrs)))
220 (method-make! <ident> 'set-name!
221 (lambda (self newval) (elm-set! self 'name newval)))
222 (method-make! <ident> 'set-comment!
223 (lambda (self newval) (elm-set! self 'comment newval)))
224 (method-make! <ident> 'set-atlist!
225 (lambda (self newval) (elm-set! self 'attrs newval)))
227 ; All objects defined in the .cpu file have these elements.
228 ; Where in the class hierarchy they're recorded depends on the object.
229 ; Additionally most objects have `name', `comment' and `attrs' elements.
231 (define (obj:name obj) (send obj 'get-name))
232 (define (obj-set-name! obj name) (send obj 'set-name! name))
233 (define (obj:comment obj) (send obj 'get-comment))
235 ; Utility to return the name as a string.
237 (define (obj:str-name obj) (symbol->string (obj:name obj)))
239 ;; Given a list of named objects, return a string of comma-separated names.
241 (define (obj-csv-names obj-list)
243 (string-map (lambda (o)
249 ; Subclass of <ident> for use by description file objects.
251 ; Records the source location of the object.
253 ; We also record an internally generated entry, ordinal, to record the
254 ; relative position within the description file. It's generally more efficient
255 ; to record some kinds of objects (e.g. insns) in a hash table. But we also
256 ; want to emit these objects in file order. Recording the object's relative
257 ; position lets us generate an ordered list when we need to.
258 ; We can't just use the line number because we want an ordering over multiple
261 (define <source-ident>
262 (class-make '<source-ident> '(<ident>)
264 ;; A <location> object.
266 ;; #f for ordinal means "unassigned"
271 (method-make! <source-ident> 'get-location
272 (lambda (self) (elm-get self 'location)))
273 (method-make! <source-ident> 'set-location!
274 (lambda (self newval) (elm-set! self 'location newval)))
275 (define (obj-location obj) (send obj 'get-location))
276 (define (obj-set-location! obj location) (send obj 'set-location! location))
278 (method-make! <source-ident> 'get-ordinal
279 (lambda (self) (elm-get self 'ordinal)))
280 (method-make! <source-ident> 'set-ordinal!
281 (lambda (self newval) (elm-set! self 'ordinal newval)))
282 (define (obj-ordinal obj) (send obj 'get-ordinal))
283 (define (obj-set-ordinal! obj ordinal) (send obj 'set-ordinal! ordinal))
285 ; Return a boolean indicating if X is a <source-ident>.
287 (define (source-ident? x) (class-instance? <source-ident> x))
291 ;;; A parsing/processing context, used to give better error messages.
292 ;;; LOCATION must be an object created with make-location.
295 (class-make '<context> nil
297 ;; Location of the object being processed,
298 ;; or #f if unknown (or there is none).
300 ;; Error message prefix or #f if there is none.
308 (define-getters <context> context (location prefix))
310 ; Create a <context> object that is just a prefix.
312 (define (make-prefix-context prefix)
313 (make <context> #f prefix)
316 ; Create a <context> object that (current-reader-location) with PREFIX.
318 (define (make-current-context prefix)
319 (make <context> (current-reader-location) prefix)
322 ; Create a <context> object from <source-ident> object OBJ.
324 (define (make-obj-context obj prefix)
325 (make <context> (obj-location obj) prefix)
328 ; Create a new context from CONTEXT with TEXT appended to the prefix.
330 (define (context-append context text)
331 (make <context> (context-location context)
332 (string-append (context-prefix context) text))
335 ; Create a new context from CONTEXT with NAME appended to the prefix.
337 (define (context-append-name context name)
338 (context-append context (stringsym-append ":" name))
341 ; Call this to issue an error message when all you have is a context.
342 ; CONTEXT is a <context> object or #f if there is none.
343 ; INTRO is a general introduction to what cgen was doing.
344 ; ERRMSG is, yes, you guessed it, the error message.
345 ; EXPR is the value that had the error if there is one.
347 (define (context-error context intro errmsg . expr)
348 (apply context-owner-error
352 (cons errmsg expr)))))
355 ; Call this to issue an error message when you have a context and an
356 ; <ident> or <source-ident> object (we call the "owner").
357 ; CONTEXT is a <context> object or #f if there is none.
358 ; OWNER is an <ident> or <source-ident> object or #f if there is none.
359 ; INTRO is a general introduction to what cgen was doing.
360 ; If OWNER is non-#f, the text " of <object-name>" is appended.
361 ; ERRMSG is, yes, you guessed it, the error message.
362 ; EXPR is the value that had the error if there is one.
364 (define (context-owner-error context owner intro errmsg . expr)
365 ;; If we don't have a context, look at the owner to try to find one.
366 ;; We want to include the source location in the error if we can.
367 (if (and (not context)
369 (source-ident? owner))
370 (set! context (make-obj-context owner #f)))
372 (set! context (make-prefix-context #f)))
374 (let* ((loc (context-location context))
375 (top-sloc (and loc (location-top loc)))
376 (intro (string-append intro
378 (string-append " of "
379 (obj:str-name owner))
381 (prefix (or (context-prefix context) "Error"))
382 (text (string-append prefix ": " errmsg)))
390 "\n~A:\n@ ~A:\n\n~A: ~A:"
392 (location->string loc)
393 (single-location->simple-string top-sloc)
407 ; Parse an object name.
408 ; NAME is either a symbol or a list of symbols which are concatenated
409 ; together. Each element can in turn be a list of symbols, and so on.
410 ; This supports symbol concatenation in the description file without having
411 ; to using string-append or some such.
413 (define (parse-name context name)
415 (let parse ((name name))
417 ((symbol? name) (symbol->string name))
418 ((string? name) name)
419 ((number? name) (number->string name))
420 ((list? name) (string-map parse name))
421 (else (parse-error context "improper name" name)))))
424 ; Parse an object comment.
425 ; COMMENT is either a string or a list of strings, each element of which may
426 ; in turn be a list of strings.
428 (define (parse-comment context comment)
429 (cond ((string? comment) comment)
430 ((symbol? comment) (symbol->string comment))
431 ((number? comment) (number->string comment))
433 (string-map (lambda (elm) (parse-comment context elm)) comment))
434 (else (parse-error context "improper comment" comment)))
439 (define (parse-symbol context value)
440 (if (and (not (symbol? value)) (not (string? value)))
441 (parse-error context "not a symbol or string" value))
447 (define (parse-string context value)
448 (if (and (not (symbol? value)) (not (string? value)))
449 (parse-error context "not a string or symbol" value))
454 ; VALID-VALUES is a list of numbers and (min . max) pairs.
456 (define (parse-number context value . valid-values)
457 (if (not (number? value))
458 (parse-error context "not a number" value))
459 (if (any-true? (map (lambda (test)
461 (and (>= value (car test))
462 (<= value (cdr test)))
466 (parse-error context "invalid number" value valid-values))
469 ; Parse a boolean value
471 (define (parse-boolean context value)
474 (parse-error context "not a boolean (#f/#t)" value))
477 ; Parse a list of handlers.
478 ; Each entry is (symbol "string").
479 ; These map function to a handler for it.
480 ; The meaning is up to the application but generally the handler is a
481 ; C/C++ function name.
482 ; ALLOWED is a list valid values for the symbol or #f if anything is allowed.
483 ; The result is handlers unchanged.
485 (define (parse-handlers context allowed handlers)
486 (if (not (list? handlers))
487 (parse-error context "bad handler spec" handlers))
488 (for-each (lambda (arg)
489 (if (not (list-elements-ok? arg (list symbol? string?)))
490 (parse-error context "bad handler spec" arg))
491 (if (and allowed (not (memq (car arg) allowed)))
492 (parse-error context "unknown handler type" (car arg))))
497 ; Return a boolean indicating if X is a keyword.
498 ; This also handles symbols named :foo because Guile doesn't stablely support
499 ; :keywords (how does one enable :keywords? read-options doesn't appear to
502 (define (keyword-list? x)
505 (or (keyword? (car x))
506 (and (symbol? (car x))
507 (char=? (string-ref (symbol->string (car x)) 0) #\:))))
510 ; Convert a list like (#:key1 val1 #:key2 val2 ...) to
511 ; ((#:key1 val1) (#:key2 val2) ...).
512 ; Missing values are specified with an empty list.
513 ; This also supports (:sym1 val1 ...) because Guile doesn't stablely support
514 ; :keywords (#:keywords work, but #:foo shouldn't appear in the description
517 (define (keyword-list->arg-list kl)
518 ; Scan KL backwards, building up each element as we go.
519 (let loop ((result nil) (current nil) (rkl (reverse kl)))
522 ((keyword? (car rkl))
523 (loop (acons (keyword->symbol (car rkl)) current result)
526 ((and (symbol? (car rkl))
527 (char=? (string-ref (symbol->string (car rkl)) 0) #\:))
528 (loop (acons (string->symbol
529 (substring (car rkl) 1 (string-length (car rkl))))
535 (cons (car rkl) current)
539 ; Signal an error if the argument name is not a symbol.
540 ; This is done by each of the argument validation routines so the caller
541 ; doesn't need to make two calls.
543 (define (arg-list-validate-name context arg-spec)
545 (parse-error context "empty argument spec" arg-spec))
546 (if (not (symbol? (car arg-spec)))
547 (parse-error context "argument name not a symbol" arg-spec))
551 ; Signal a parse error if an argument was specified with a value.
552 ; ARG-SPEC is (name value).
554 (define (arg-list-check-no-args context arg-spec)
555 (arg-list-validate-name context arg-spec)
556 (if (not (null? (cdr arg-spec)))
557 (parse-error context (string-append (car arg-spec)
558 " takes zero arguments")))
562 ; Validate and return a symbol argument.
563 ; ARG-SPEC is (name value).
565 (define (arg-list-symbol-arg context arg-spec)
566 (arg-list-validate-name context arg-spec)
567 (if (or (!= (length (cdr arg-spec)) 1)
568 (not (symbol? (cadr arg-spec))))
569 (parse-error context (string-append (car arg-spec)
570 ": argument not a symbol")))
576 ; Sanitization is handled via attributes. Anything that must be sanitized
577 ; has a `sanitize' attribute with the value being the keyword to sanitize on.
578 ; Ideally most, if not all, of the guts of the generated sanitization is here.
580 ; Utility to simplify expression in .cpu file.
581 ; Usage: (sanitize isa-name-list keyword entry-type entry-name1 [entry-name2 ...])
582 ; Enum attribute `(sanitize keyword)' is added to the entry.
584 (define (sanitize isa-name-list keyword entry-type . entry-names)
585 (for-each (lambda (entry-name)
588 ((attr) (set! entry (current-attr-lookup entry-name)))
589 ((enum) (set! entry (current-enum-lookup entry-name)))
590 ((isa) (set! entry (current-isa-lookup entry-name)))
591 ((cpu) (set! entry (current-cpu-lookup entry-name)))
592 ((mach) (set! entry (current-mach-lookup entry-name)))
593 ((model) (set! entry (current-model-lookup entry-name)))
594 ((ifield) (set! entry (current-ifld-lookup entry-name isa-name-list)))
595 ((hardware) (set! entry (current-hw-lookup entry-name)))
596 ((operand) (set! entry (current-op-lookup entry-name isa-name-list)))
597 ((insn) (set! entry (current-insn-lookup entry-name isa-name-list)))
598 ((macro-insn) (set! entry (current-minsn-lookup entry-name isa-name-list)))
599 (else (parse-error (make-prefix-context "sanitize")
600 "unknown entry type" entry-type)))
602 ; ENTRY is #f in the case where the element was discarded
603 ; because its mach wasn't selected. But in the case where
604 ; we're keeping everything, ensure ENTRY is not #f to
605 ; catch spelling errors.
610 (obj-cons-attr! entry (enum-attr-make 'sanitize keyword))
611 ; Propagate the sanitize attribute to class members
615 (if (hw-indices entry)
616 (obj-cons-attr! (hw-indices entry)
617 (enum-attr-make 'sanitize
619 (if (hw-values entry)
620 (obj-cons-attr! (hw-values entry)
621 (enum-attr-make 'sanitize
625 (if (and (eq? APPLICATION 'OPCODES) (keep-all?))
626 (parse-error (make-prefix-context "sanitize")
627 (string-append "unknown " entry-type)
631 #f ; caller eval's our result, so return a no-op
634 ; Return TEXT sanitized with KEYWORD.
635 ; TEXT must exist on a line (or lines) by itself.
636 ; i.e. it is assumed that it begins at column 1 and ends with a newline.
637 ; If KEYWORD is #f, no sanitization is generated.
639 (define (gen-sanitize keyword text)
640 (cond ((null? text) "")
641 ((pair? text) ; pair? -> cheap list?
642 (if (and keyword include-sanitize-marker?)
644 ; split string to avoid removal
646 "sanitize-" keyword " */\n"
649 "sanitize-" keyword " */\n")
652 (if (= (string-length text) 0)
654 (if (and keyword include-sanitize-marker?)
656 ; split string to avoid removal
658 "sanitize-" keyword " */\n"
661 "sanitize-" keyword " */\n")
665 ; Return TEXT sanitized with OBJ's sanitization, if it has any.
668 (define (gen-obj-sanitize obj text)
670 (let ((san (obj-attr-value obj 'sanitize)))
671 (gen-sanitize (if (or (not san) (eq? san 'none)) #f san)
673 (gen-sanitize #f text))
676 ; Cover procs to handle generation of object declarations and definitions.
677 ; All object output should be routed through gen-decl and gen-defn.
679 ; Send the gen-decl message to OBJ, and sanitize the output if necessary.
681 (define (gen-decl obj)
682 (logit 3 "Generating decl for "
683 (cond ((method-present? obj 'get-name) (send obj 'get-name))
684 ((elm-present? obj 'name) (elm-get obj 'name))
687 (cond ((and (method-present? obj 'gen-decl) (not (has-attr? obj 'META)))
688 (gen-obj-sanitize obj (send obj 'gen-decl)))
692 ; Send the gen-defn message to OBJ, and sanitize the output if necessary.
694 (define (gen-defn obj)
695 (logit 3 "Generating defn for "
696 (cond ((method-present? obj 'get-name) (send obj 'get-name))
697 ((elm-present? obj 'name) (elm-xget obj 'name))
700 (cond ((and (method-present? obj 'gen-defn) (not (has-attr? obj 'META)))
701 (gen-obj-sanitize obj (send obj 'gen-defn)))
707 ; Return the C/C++ type to use to hold a value for attribute ATTR.
709 (define (gen-attr-type attr)
710 (if (string=? (string-downcase (gen-sym attr)) "isa")
712 (case (attr-kind attr)
714 ((bitset) "unsigned int")
716 ((enum) (string-append "enum " (string-downcase (gen-sym attr)) "_attr"))
720 ; Return C macros for accessing an object's attributes ATTRS.
721 ; PREFIX is one of "cgen_ifld", "cgen_hw", "cgen_operand", "cgen_insn".
722 ; ATTRS is an alist of attribute values. The value is unimportant except that
723 ; it is used to determine bool/non-bool.
724 ; Non-bools need to be separated from bools as they're each recorded
725 ; differently. Non-bools are recorded in an int for each. All bools are
726 ; combined into one int to save space.
727 ; ??? We assume there is at least one bool.
729 (define (gen-attr-accessors prefix attrs)
731 "/* " prefix " attribute accessor macros. */\n"
732 (string-map (lambda (attr)
735 (string-upcase prefix)
737 (string-upcase (gen-sym attr))
739 (if (bool-attr? attr)
741 "(((attrs)->bool & (1 << "
742 (string-upcase prefix)
744 (string-upcase (gen-sym attr))
748 (string-upcase prefix)
750 (string-upcase (gen-sym attr))
752 (string-upcase prefix)
754 (case (attr-kind attr)
756 (if (string=? (string-downcase (gen-sym attr)) "isa")
765 ; Return C code to declare an enum of attributes ATTRS.
766 ; PREFIX is one of "cgen_ifld", "cgen_hw", "cgen_operand", "cgen_insn".
767 ; ATTRS is an alist of attribute values. The value is unimportant except that
768 ; it is used to determine bool/non-bool.
769 ; Non-bools need to be separated from bools as they're each recorded
770 ; differently. Non-bools are recorded in an int for each. All bools are
771 ; combined into one int to save space.
772 ; ??? We assume there is at least one bool.
774 (define (gen-attr-enum-decl prefix attrs)
776 (gen-enum-decl (string-append prefix "_attr")
777 (string-append prefix " attrs")
778 (string-append prefix "_")
779 (attr-list-enum-list attrs))
780 "/* Number of non-boolean elements in " prefix "_attr. */\n"
781 "#define " (string-upcase prefix) "_NBOOL_ATTRS "
782 "(" (string-upcase prefix) "_END_NBOOLS - "
783 (string-upcase prefix) "_START_NBOOLS - 1)\n"
787 ; Return name of symbol ATTR-NAME.
788 ; PREFIX is the prefix arg to gen-attr-enum-decl.
790 (define (gen-attr-name prefix attr-name)
791 (string-upcase (gen-c-symbol (string-append prefix "_"
792 (symbol->string attr-name))))
795 ; Normal gen-mask argument to gen-bool-attrs.
796 ; Returns "(1<< PREFIX_NAME)" where PREFIX is from atlist-prefix and
797 ; NAME is the name of the attribute.
798 ; ??? This used to return PREFIX_NAME-CGEN_ATTR_BOOL_OFFSET.
799 ; The tradeoff is simplicity vs perceived maximum number of boolean attributes
800 ; needed. In the end the maximum number needn't be fixed, and the simplicity
801 ; of the current way is good.
803 (define (gen-attr-mask prefix name)
804 (string-append "(1<<" (gen-attr-name prefix name) ")")
807 ; Return C expression of bitmasks of boolean attributes in ATTRS.
808 ; ATTRS is an <attr-list> object, it need not be pre-sorted.
809 ; GEN-MASK is a procedure that returns the C code of the mask.
811 (define (gen-bool-attrs attrs gen-mask)
812 (let loop ((result "0")
813 (alist (attr-remove-meta-attrs-alist
814 (attr-nub (atlist-attrs attrs)))))
815 (cond ((null? alist) result)
816 ((and (boolean? (cdar alist)) (cdar alist))
817 (loop (string-append result
818 ; `|' is used here instead of `+' so we don't
819 ; have to care about duplicates.
820 "|" (gen-mask (atlist-prefix attrs)
823 (else (loop result (cdr alist)))))
826 ; Return the C definition of OBJ's attributes.
827 ; TYPE is one of 'ifld, 'hw, 'operand, 'insn.
828 ; [Other objects have attributes but these are the only ones we currently
829 ; emit definitions for.]
830 ; OBJ is any object that supports the 'get-atlist message.
831 ; ALL-ATTRS is an ordered alist of all attributes.
832 ; "ordered" means all the non-boolean attributes are at the front and
833 ; duplicate entries have been removed.
834 ; GEN-MASK is the gen-mask arg to gen-bool-attrs.
836 (define (gen-obj-attr-defn type obj all-attrs num-non-bools gen-mask)
837 (let* ((attrs (obj-atlist obj))
838 (non-bools (attr-non-bool-attrs (atlist-attrs attrs)))
839 (all-non-bools (list-take num-non-bools all-attrs)))
842 (gen-bool-attrs attrs gen-mask)
844 ; For the boolean case, we can (currently) get away with only specifying
845 ; the attributes that are used since they all fit in one int and the
846 ; default is currently always #f (and won't be changed without good
847 ; reason). In the non-boolean case order is important since each value
848 ; has a specific spot in an array, all of them must be specified.
849 (if (null? all-non-bools)
851 (string-drop1 ; drop the leading ","
852 (string-map (lambda (attr)
853 (let ((val (or (assq-ref non-bools (obj:name attr))
854 (attr-default attr))))
855 ; FIXME: Are we missing attr-prefix here?
857 (send attr 'gen-value-for-defn val))))
863 ; Return the C definition of the terminating entry of an object's attributes.
864 ; ALL-ATTRS is an ordered alist of all attributes.
865 ; "ordered" means all the non-boolean attributes are at the front and
866 ; duplicate entries have been removed.
868 (define (gen-obj-attr-end-defn all-attrs num-non-bools)
869 (let ((all-non-bools (list-take num-non-bools all-attrs)))
872 (if (null? all-non-bools)
874 (string-drop1 ; drop the leading ","
875 (string-map (lambda (attr)
876 (let ((val (attr-default attr)))
877 ; FIXME: Are we missing attr-prefix here?
879 (send attr 'gen-value-for-defn val))))
885 ; Return a boolean indicating if ATLIST indicates a CTI insn.
887 (define (atlist-cti? atlist)
888 (or (atlist-has-attr? atlist 'UNCOND-CTI)
889 (atlist-has-attr? atlist 'COND-CTI))
894 ; Return name of obj as a C symbol.
896 (define (gen-sym obj) (gen-c-symbol (obj:name obj)))
898 ; Return the name of the selected cpu family.
899 ; An error is signalled if more than one has been selected.
901 (define (gen-cpu-name)
902 ; FIXME: error checking
903 (gen-sym (current-cpu))
906 ; Return HAVE_CPU_<CPU>.
908 (define (gen-have-cpu cpu)
909 (string-append "HAVE_CPU_"
910 (string-upcase (gen-sym cpu)))
913 ; Return the bfd mach name for MACH.
915 (define (gen-mach-bfd-name mach)
916 (string-append "bfd_mach_" (gen-c-symbol (mach-bfd-name mach)))
919 ;; Return definition of C macro to get the value of SYM.
920 ;; INDEX-ARGS, EXPR must not have any newlines.
922 (define (gen-get-macro sym index-args expr)
924 "#define GET_" (string-upcase sym) "(" index-args ") " expr "\n")
927 ;; Return definition of C macro to get the value of SYM, version 2.
928 ;; EXPR is a C expression *without* proper \newline handling,
929 ;; we prepend \ to each line.
930 ;; INDEX-ARGS, EXPR must not have any newlines.
932 (define (gen-get-macro2 sym index-args expr)
934 "#define GET_" (string-upcase sym) "(" index-args ") "
935 (backslash "\n" expr)
939 ;; Return definition of C macro to set the value of SYM.
940 ;; INDEX-ARGS, EXPR, LVALUE must not have any newlines.
942 (define (gen-set-macro sym index-args lvalue)
944 "#define SET_" (string-upcase sym)
946 (if (equal? index-args "") "" ", ")
947 "x) (" lvalue " = (x))\n")
950 ;; Return definition of C macro to set the value of SYM, version 2.
951 ;; EXPR is one or more C statements *without* proper \newline handling,
952 ;; we prepend \ to each line.
953 ;; INDEX-ARGS, NEWVAL-ARG must not have any newlines.
955 (define (gen-set-macro2 sym index-args newval-arg expr)
957 "#define SET_" (string-upcase sym)
959 (if (equal? index-args "") "" ", ")
962 (backslash "\n" expr)
966 ;; Misc. object utilities.
968 ;; Return the nub of a list of objects.
970 (define (obj-list-nub obj-list)
971 (nub obj-list obj:name)
974 ;; Sort a list of objects with get-name methods alphabetically.
976 (define (alpha-sort-obj-list l)
979 (symbol<? (obj:name o1) (obj:name o2))))
982 ; Called before loading the .cpu file to initialize.
984 (define (utils-init!)
985 (reader-add-command! 'sanitize
987 Mark an entry as being sanitized.
989 nil '(keyword entry-type . entry-names) sanitize)
994 ; Return a pair of definitions for a C macro that concatenates its
995 ; argument symbols. The definitions are conditional on ANSI C
996 ; semantics: one contains ANSI concat operators (##), and the other
997 ; uses the empty-comment trick (/**/). We must do this, rather than
998 ; use CONCATn(...) as defined in include/symcat.h, in order to avoid
999 ; spuriously expanding our macro's args.
1001 (define (gen-define-with-symcat head . args)
1004 #if defined (__STDC__) || defined (ALMOST_STDC) || defined (HAVE_STRINGIZE)
1006 head (string-map (lambda (elm) (string-append "##" elm)) args)
1010 head (string-map (lambda (elm) (string-append "/**/" elm)) args)