2 ;; Copyright (C) 2000, 2002, 2003, 2009, 2010 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)
29 ;; Source locations are recorded as a stack, with (ideally) one extra level
30 ;; for each macro invocation.
32 (define-class <location> location- ()
34 ;; A list of "single-location" objects,
35 ;; sorted by most recent location first.
40 ;; A single source location.
41 ;; This is recorded as a vector for simplicity.
42 ;; END? is true if the location marks the end of the expression.
43 ;; NOTE: LINE and COLUMN are origin-0 (the first line is line 0).
45 (define (make-single-location file line column end?)
46 (vector file line column end?)
49 (define (single-location-file sloc) (vector-ref sloc 0))
50 (define (single-location-line sloc) (vector-ref sloc 1))
51 (define (single-location-column sloc) (vector-ref sloc 2))
52 (define (single-location-end? sloc) (vector-ref sloc 3))
54 ;; Return a single-location in a readable form.
56 (define (single-location->string sloc)
57 ;; +1: numbers are recorded origin-0
58 (string-append (single-location-file sloc)
60 (number->string (+ (single-location-line sloc) 1))
62 (number->string (+ (single-location-column sloc) 1))
63 (if (single-location-end? sloc) "(end)" ""))
66 ;; Same as single-location->string, except omit any directory info in
69 (define (single-location->simple-string sloc)
70 ;; +1: numbers are recorded origin-0
71 (string-append (basename (single-location-file sloc))
73 (number->string (+ (single-location-line sloc) 1))
75 (number->string (+ (single-location-column sloc) 1))
76 (if (single-location-end? sloc) "(end)" ""))
79 ;; Return a location in a readable form.
81 (define (location->string loc)
82 (let ((ref-from " referenced from:"))
84 (- 0 (string-length ref-from) 1)
89 (single-location->string sloc)
92 (location-list loc))))))
95 ;; Return the location information in Guile's source-properties
96 ;; in a readable form.
98 (define (source-properties-location->string src-props)
99 (let ((file (assq-ref src-props 'filename))
100 (line (assq-ref src-props 'line))
101 (column (assq-ref src-props 'column)))
104 (number->string (+ line 1))
106 (number->string (+ column 1))))
109 ;; Return the top location on LOC's stack.
111 (define (location-top loc)
112 (car (location-list loc))
115 ;; Return a new <location> with FILE, LINE pushed onto the stack.
117 (define (location-push-single loc file line column end?)
118 (make <location> (cons (make-single-location file line column end?)
119 (location-list loc)))
122 ;; Return a new <location> with NEW-LOC preappended to LOC.
124 (define (location-push loc new-loc)
125 (make <location> (append (location-list new-loc)
126 (location-list loc)))
129 ;; Return an unspecified <location>.
130 ;; This is mainly for use in debugging utilities.
131 ;; Ideally for .cpu-file related stuff we always have a location,
132 ;; but that's not always true.
134 (define (unspecified-location)
135 (make <location> (list (make-single-location "unspecified" 0 0 #f)))
138 ;; Return a location denoting a builtin object.
140 (define (builtin-location)
141 (make <location> (list (make-single-location "builtin" 0 0 #f)))
144 ;; Return a <location> object for the current input port.
145 ;; END? is true if the location marks the end of the expression.
147 (define (current-input-location end?)
148 (let ((cip (current-input-port)))
149 (make <location> (list (make-single-location (port-filename cip)
155 ;; An object property for tracking source locations during macro expansion.
157 (define location-property (make-object-property))
159 ;; Set FORM's location to LOC.
161 (define (location-property-set! form loc)
162 (set! (location-property form) loc)
166 ;; Each named entry in the description file typically has these three members:
167 ;; name, comment attrs.
169 (define-class <ident> ident- () (!name !comment !attrs))
171 ;; All objects defined in the .cpu file have name, comment, attrs elements.
172 ;; Where in the class hierarchy they're recorded depends on the object.
173 ;; Each object is required to provide these interfaces.
175 (define-interface obj-name get-name)
176 (define-interface obj-comment get-comment)
177 ;; FIXME: See definition of obj-atlist.
178 (define-interface obj-atlist1 get-atlist)
180 (define-interface obj-set-name! set-name! newval)
181 (define-interface obj-set-comment! set-comment! newval)
182 (define-interface obj-set-atlist! set-atlist! newval)
184 ;; Get/set attributes of OBJ.
185 ;; OBJ is any object which supports the get-atlist interface.
187 (define (obj-atlist obj)
188 (let ((result (obj-atlist1 obj)))
189 ;; As a speed up, we allow objects to specify an empty attribute list
190 ;; with #f or (), rather than creating an attr-list object.
191 ;; ??? There is atlist-empty now which should be used directly, after
192 ;; which we can delete use and rename obj-atlist1 -> obj-atlist.
193 (if (or (null? result) (not result))
198 (define-method <ident> get-name (self)
200 (define-method <ident> get-comment (self)
201 (ident-comment self))
202 (define-method <ident> get-atlist (self)
205 (define-method <ident> set-name! (self newval)
206 (ident-set-name! self newval))
207 (define-method <ident> set-comment! (self newval)
208 (ident-set-comment! self newval))
209 (define-method <ident> set-atlist! (self newval)
210 (ident-set-attrs! self newval))
212 ;; FIXME: Delete and replace with the above interfaces.
213 (define (obj:name obj) (obj-name obj))
214 (define (obj:comment obj) (obj-comment obj))
216 ;; Utility to return the name as a string.
218 (define (obj:str-name obj) (symbol->string (obj:name obj)))
220 ;; Given a list of named objects, return a string of comma-separated names.
222 (define (obj-csv-names obj-list)
224 (string-map (lambda (o)
230 ;; Subclass of <ident> for use by description file objects.
232 ;; Records the source location of the object.
234 ;; We also record an internally generated entry, ordinal, to record the
235 ;; relative position within the description file. It's generally more efficient
236 ;; to record some kinds of objects (e.g. insns) in a hash table. But we also
237 ;; want to emit these objects in file order. Recording the object's relative
238 ;; position lets us generate an ordered list when we need to.
239 ;; We can't just use the line number because we want an ordering over multiple
242 (define-class <source-ident> source-ident- (<ident>)
244 ;; A <location> object.
246 ;; #f for ordinal means "unassigned"
251 (define-interface obj-location get-location)
252 (define-interface obj-set-location! set-location! newval)
254 (define-method <source-ident> get-location (self)
255 (/source-ident-location self))
256 (define-method <source-ident> set-location! (self newval)
257 (/source-ident-set-location! self newval))
259 (define-interface obj-ordinal get-ordinal)
260 (define-interface obj-set-ordinal! set-ordinal! newval)
262 (define-method <source-ident> get-ordinal (self)
263 (/source-ident-ordinal self))
264 (define-method <source-ident> set-ordinal! (self newval)
265 (/source-ident-set-ordinal! self newval))
269 ;; A parsing/processing context, used to give better error messages.
270 ;; LOCATION must be an object created with make-location.
272 (define-class <context> context- ()
274 ;; Location of the object being processed,
275 ;; or #f if unknown (or there is none).
277 ;; Error message prefix or #f if there is none.
282 ;; Create a <context> object that is just a prefix.
284 (define (make-prefix-context prefix)
285 (make <context> #f prefix)
288 ;; Create a <context> object that (current-reader-location) with PREFIX.
290 (define (make-current-context prefix)
291 (make <context> (current-reader-location) prefix)
294 ;; Create a <context> object from <source-ident> object OBJ.
296 (define (make-obj-context obj prefix)
297 (make <context> (obj-location obj) prefix)
300 ;; Create a new context from CONTEXT with TEXT appended to the prefix.
302 (define (context-append context text)
303 (make <context> (context-location context)
304 (string-append (context-prefix context) text))
307 ;; Create a new context from CONTEXT with NAME appended to the prefix.
309 (define (context-append-name context name)
310 (context-append context (stringsym-append ":" name))
313 ;; Call this to issue an error message when all you have is a context.
314 ;; CONTEXT is a <context> object or #f if there is none.
315 ;; INTRO is a general introduction to what cgen was doing.
316 ;; ERRMSG is, yes, you guessed it, the error message.
317 ;; EXPR is the value that had the error if there is one.
319 (define (context-error context intro errmsg . expr)
320 (apply context-owner-error
324 (cons errmsg expr)))))
327 ;; Call this to issue an error message when you have a context and an
328 ;; <ident> or <source-ident> object (we call the "owner").
329 ;; CONTEXT is a <context> object or #f if there is none.
330 ;; OWNER is an <ident> or <source-ident> object or #f if there is none.
331 ;; INTRO is a general introduction to what cgen was doing.
332 ;; If OWNER is non-#f, the text " of <object-name>" is appended.
333 ;; ERRMSG is, yes, you guessed it, the error message.
334 ;; EXPR is the value that had the error if there is one.
336 (define (context-owner-error context owner intro errmsg . expr)
337 ;; If we don't have a context, look at the owner to try to find one.
338 ;; We want to include the source location in the error if we can.
339 (if (and (not context)
341 (source-ident? owner))
342 (set! context (make-obj-context owner #f)))
344 (set! context (make-prefix-context #f)))
346 (let* ((loc (context-location context))
347 (top-sloc (and loc (location-top loc)))
348 (intro (string-append intro
350 (string-append " of "
351 (obj:str-name owner))
353 (prefix (or (context-prefix context) "Error"))
354 (text (string-append prefix ": " errmsg)))
362 "\n~A:\n@ ~A:\n\n~A: ~A:"
364 (location->string loc)
365 (single-location->simple-string top-sloc)
379 ;; Parse an object name.
380 ;; NAME is either a symbol or a list of symbols which are concatenated
381 ;; together. Each element can in turn be a list of symbols, and so on.
382 ;; This supports symbol concatenation in the description file without having
383 ;; to using string-append or some such.
385 (define (parse-name context name)
387 (let parse ((name name))
389 ((symbol? name) (symbol->string name))
390 ((string? name) name)
391 ((number? name) (number->string name))
392 ((list? name) (string-map parse name))
393 (else (parse-error context "improper name" name)))))
396 ;; Parse an object comment.
397 ;; COMMENT is either a string or a list of strings, each element of which may
398 ;; in turn be a list of strings.
400 (define (parse-comment context comment)
401 (cond ((string? comment) comment)
402 ((symbol? comment) (symbol->string comment))
403 ((number? comment) (number->string comment))
405 (string-map (lambda (elm) (parse-comment context elm)) comment))
406 (else (parse-error context "improper comment" comment)))
411 (define (parse-symbol context value)
412 (if (and (not (symbol? value)) (not (string? value)))
413 (parse-error context "not a symbol or string" value))
419 (define (parse-string context value)
420 (if (and (not (symbol? value)) (not (string? value)))
421 (parse-error context "not a string or symbol" value))
426 ;; VALID-VALUES is a list of numbers and (min . max) pairs.
428 (define (parse-number context value . valid-values)
429 (if (not (number? value))
430 (parse-error context "not a number" value))
431 (if (any-true? (map (lambda (test)
433 (and (>= value (car test))
434 (<= value (cdr test)))
438 (parse-error context "invalid number" value valid-values))
441 ;; Parse a boolean value
443 (define (parse-boolean context value)
446 (parse-error context "not a boolean (#f/#t)" value))
449 ;; Parse a list of handlers.
450 ;; Each entry is (symbol "string").
451 ;; These map function to a handler for it.
452 ;; The meaning is up to the application but generally the handler is a
453 ;; C/C++ function name.
454 ;; ALLOWED is a list valid values for the symbol or #f if anything is allowed.
455 ;; The result is handlers unchanged.
457 (define (parse-handlers context allowed handlers)
458 (if (not (list? handlers))
459 (parse-error context "bad handler spec" handlers))
460 (for-each (lambda (arg)
461 (if (not (list-elements-ok? arg (list symbol? string?)))
462 (parse-error context "bad handler spec" arg))
463 (if (and allowed (not (memq (car arg) allowed)))
464 (parse-error context "unknown handler type" (car arg))))
469 ;; Return a boolean indicating if X is a keyword.
470 ;; This also handles symbols named :foo because Guile doesn't stablely support
471 ;; :keywords (how does one enable :keywords? read-options doesn't appear to
474 (define (keyword-list? x)
477 (or (keyword? (car x))
478 (and (symbol? (car x))
479 (char=? (string-ref (symbol->string (car x)) 0) #\:))))
482 ;; Convert a list like (#:key1 val1 #:key2 val2 ...) to
483 ;; ((#:key1 val1) (#:key2 val2) ...).
484 ;; Missing values are specified with an empty list.
485 ;; This also supports (:sym1 val1 ...) because Guile doesn't stablely support
486 ;; :keywords (#:keywords work, but #:foo shouldn't appear in the description
489 (define (keyword-list->arg-list kl)
490 ;; Scan KL backwards, building up each element as we go.
491 (let loop ((result nil) (current nil) (rkl (reverse kl)))
494 ((keyword? (car rkl))
495 (loop (acons (keyword->symbol (car rkl)) current result)
498 ((and (symbol? (car rkl))
499 (char=? (string-ref (symbol->string (car rkl)) 0) #\:))
500 (loop (acons (string->symbol
501 (substring (car rkl) 1 (string-length (car rkl))))
507 (cons (car rkl) current)
511 ;; Signal an error if the argument name is not a symbol.
512 ;; This is done by each of the argument validation routines so the caller
513 ;; doesn't need to make two calls.
515 (define (arg-list-validate-name context arg-spec)
517 (parse-error context "empty argument spec" arg-spec))
518 (if (not (symbol? (car arg-spec)))
519 (parse-error context "argument name not a symbol" arg-spec))
523 ;; Signal a parse error if an argument was specified with a value.
524 ;; ARG-SPEC is (name value).
526 (define (arg-list-check-no-args context arg-spec)
527 (arg-list-validate-name context arg-spec)
528 (if (not (null? (cdr arg-spec)))
529 (parse-error context (string-append (car arg-spec)
530 " takes zero arguments")))
534 ;; Validate and return a symbol argument.
535 ;; ARG-SPEC is (name value).
537 (define (arg-list-symbol-arg context arg-spec)
538 (arg-list-validate-name context arg-spec)
539 (if (or (!= (length (cdr arg-spec)) 1)
540 (not (symbol? (cadr arg-spec))))
541 (parse-error context (string-append (car arg-spec)
542 ": argument not a symbol")))
548 ;; Sanitization is handled via attributes. Anything that must be sanitized
549 ;; has a `sanitize' attribute with the value being the keyword to sanitize on.
550 ;; Ideally most, if not all, of the guts of the generated sanitization is here.
552 ;; Utility to simplify expression in .cpu file.
553 ;; Usage: (sanitize isa-name-list keyword entry-type entry-name1 [entry-name2 ...])
554 ;; Enum attribute `(sanitize keyword)' is added to the entry.
556 (define (sanitize isa-name-list keyword entry-type . entry-names)
557 (for-each (lambda (entry-name)
560 ((attr) (set! entry (current-attr-lookup entry-name)))
561 ((enum) (set! entry (current-enum-lookup entry-name)))
562 ((isa) (set! entry (current-isa-lookup entry-name)))
563 ((cpu) (set! entry (current-cpu-lookup entry-name)))
564 ((mach) (set! entry (current-mach-lookup entry-name)))
565 ((model) (set! entry (current-model-lookup entry-name)))
566 ((ifield) (set! entry (current-ifld-lookup entry-name isa-name-list)))
567 ((hardware) (set! entry (current-hw-lookup entry-name)))
568 ((operand) (set! entry (current-op-lookup entry-name isa-name-list)))
569 ((insn) (set! entry (current-insn-lookup entry-name isa-name-list)))
570 ((macro-insn) (set! entry (current-minsn-lookup entry-name isa-name-list)))
571 (else (parse-error (make-prefix-context "sanitize")
572 "unknown entry type" entry-type)))
574 ;; ENTRY is #f in the case where the element was discarded
575 ;; because its mach wasn't selected. But in the case where
576 ;; we're keeping everything, ensure ENTRY is not #f to
577 ;; catch spelling errors.
582 (obj-cons-attr! entry (enum-attr-make 'sanitize keyword))
583 ;; Propagate the sanitize attribute to class members
587 (if (hw-indices entry)
588 (obj-cons-attr! (hw-indices entry)
589 (enum-attr-make 'sanitize
591 (if (hw-values entry)
592 (obj-cons-attr! (hw-values entry)
593 (enum-attr-make 'sanitize
597 (if (and (eq? APPLICATION 'OPCODES) (keep-all?))
598 (parse-error (make-prefix-context "sanitize")
599 (string-append "unknown " entry-type)
603 #f ;; caller eval's our result, so return a no-op
606 ;; Return TEXT sanitized with KEYWORD.
607 ;; TEXT must exist on a line (or lines) by itself.
608 ;; i.e. it is assumed that it begins at column 1 and ends with a newline.
609 ;; If KEYWORD is #f, no sanitization is generated.
611 (define (gen-sanitize keyword text)
612 (cond ((null? text) "")
613 ((pair? text) ;; pair? -> cheap list?
614 (if (and keyword include-sanitize-marker?)
616 ;; split string to avoid removal
618 "sanitize-" keyword " */\n"
621 "sanitize-" keyword " */\n")
624 (if (= (string-length text) 0)
626 (if (and keyword include-sanitize-marker?)
628 ;; split string to avoid removal
630 "sanitize-" keyword " */\n"
633 "sanitize-" keyword " */\n")
637 ;; Return TEXT sanitized with OBJ's sanitization, if it has any.
640 (define (gen-obj-sanitize obj text)
642 (let ((san (obj-attr-value obj 'sanitize)))
643 (gen-sanitize (if (or (not san) (eq? san 'none)) #f san)
645 (gen-sanitize #f text))
648 ;; Cover procs to handle generation of object declarations and definitions.
649 ;; All object output should be routed through gen-decl and gen-defn.
651 ;; Send the gen-decl message to OBJ, and sanitize the output if necessary.
653 (define (gen-decl obj)
654 (logit 3 "Generating decl for "
655 (cond ((method-present? obj 'get-name) (send obj 'get-name))
656 ((elm-present? obj 'name) (elm-get obj 'name))
659 (cond ((and (method-present? obj 'gen-decl) (not (has-attr? obj 'META)))
660 (gen-obj-sanitize obj (send obj 'gen-decl)))
664 ;; Send the gen-defn message to OBJ, and sanitize the output if necessary.
666 (define (gen-defn obj)
667 (logit 3 "Generating defn for "
668 (cond ((method-present? obj 'get-name) (send obj 'get-name))
669 ((elm-present? obj 'name) (elm-xget obj 'name))
672 (cond ((and (method-present? obj 'gen-defn) (not (has-attr? obj 'META)))
673 (gen-obj-sanitize obj (send obj 'gen-defn)))
679 ;; Return the C/C++ type to use to hold a value for attribute ATTR.
681 (define (gen-attr-type attr)
682 (if (string=? (string-downcase (gen-sym attr)) "isa")
684 (case (attr-kind attr)
686 ((bitset) "unsigned int")
688 ((enum) (string-append "enum " (string-downcase (gen-sym attr)) "_attr"))
692 ;; Return C macros for accessing an object's attributes ATTRS.
693 ;; PREFIX is one of "cgen_ifld", "cgen_hw", "cgen_operand", "cgen_insn".
694 ;; ATTRS is an alist of attribute values. The value is unimportant except that
695 ;; it is used to determine bool/non-bool.
696 ;; Non-bools need to be separated from bools as they're each recorded
697 ;; differently. Non-bools are recorded in an int for each. All bools are
698 ;; combined into one int to save space.
699 ;; ??? We assume there is at least one bool.
701 (define (gen-attr-accessors prefix attrs)
703 "/* " prefix " attribute accessor macros. */\n"
704 (string-map (lambda (attr)
707 (string-upcase prefix)
709 (string-upcase (gen-sym attr))
711 (if (bool-attr? attr)
713 "(((attrs)->bool_ & (1 << "
714 (string-upcase prefix)
716 (string-upcase (gen-sym attr))
720 (string-upcase prefix)
722 (string-upcase (gen-sym attr))
724 (string-upcase prefix)
726 (case (attr-kind attr)
728 (if (string=? (string-downcase (gen-sym attr)) "isa")
738 ;; Return C code to declare an enum of attributes ATTRS.
739 ;; PREFIX is one of "cgen_ifld", "cgen_hw", "cgen_operand", "cgen_insn".
740 ;; ATTRS is an alist of attribute values. The value is unimportant except that
741 ;; it is used to determine bool/non-bool.
742 ;; Non-bools need to be separated from bools as they're each recorded
743 ;; differently. Non-bools are recorded in an int for each. All bools are
744 ;; combined into one int to save space.
745 ;; ??? We assume there is at least one bool.
747 (define (gen-attr-enum-decl prefix attrs)
749 (gen-enum-decl (string-append prefix "_attr")
750 (string-append prefix " attrs")
751 (string-append prefix "_")
752 (attr-list-enum-list attrs))
753 "/* Number of non-boolean elements in " prefix "_attr. */\n"
754 "#define " (string-upcase prefix) "_NBOOL_ATTRS "
755 "(" (string-upcase prefix) "_END_NBOOLS - "
756 (string-upcase prefix) "_START_NBOOLS - 1)\n"
760 ;; Return name of symbol ATTR-NAME.
761 ;; PREFIX is the prefix arg to gen-attr-enum-decl.
763 (define (gen-attr-name prefix attr-name)
764 (string-upcase (gen-c-symbol (string-append prefix "_"
765 (symbol->string attr-name))))
768 ;; Normal gen-mask argument to gen-bool-attrs.
769 ;; Returns "(1<< PREFIX_NAME)" where PREFIX is from atlist-prefix and
770 ;; NAME is the name of the attribute.
771 ;; ??? This used to return PREFIX_NAME-CGEN_ATTR_BOOL_OFFSET.
772 ;; The tradeoff is simplicity vs perceived maximum number of boolean attributes
773 ;; needed. In the end the maximum number needn't be fixed, and the simplicity
774 ;; of the current way is good.
776 (define (gen-attr-mask prefix name)
777 (string-append "(1<<" (gen-attr-name prefix name) ")")
780 ;; Return C expression of bitmasks of boolean attributes in ATTRS.
781 ;; ATTRS is an <attr-list> object, it need not be pre-sorted.
782 ;; GEN-MASK is a procedure that returns the C code of the mask.
784 (define (gen-bool-attrs attrs gen-mask)
785 (let loop ((result "0")
786 (alist (attr-remove-meta-attrs-alist
787 (attr-nub (atlist-attrs attrs)))))
788 (cond ((null? alist) result)
789 ((and (boolean? (cdar alist)) (cdar alist))
790 (loop (string-append result
791 ;; `|' is used here instead of `+' so we don't
792 ;; have to care about duplicates.
793 "|" (gen-mask (atlist-prefix attrs)
796 (else (loop result (cdr alist)))))
799 ;; Return the C definition of OBJ's attributes.
800 ;; TYPE is one of 'ifld, 'hw, 'operand, 'insn.
801 ;; [Other objects have attributes but these are the only ones we currently
802 ;; emit definitions for.]
803 ;; OBJ is any object that supports the 'get-atlist message.
804 ;; ALL-ATTRS is an ordered alist of all attributes.
805 ;; "ordered" means all the non-boolean attributes are at the front and
806 ;; duplicate entries have been removed.
807 ;; GEN-MASK is the gen-mask arg to gen-bool-attrs.
809 (define (gen-obj-attr-defn type obj all-attrs num-non-bools gen-mask)
810 (let* ((attrs (obj-atlist obj))
811 (non-bools (attr-non-bool-attrs (atlist-attrs attrs)))
812 (all-non-bools (list-take num-non-bools all-attrs)))
815 (gen-bool-attrs attrs gen-mask)
817 ;; For the boolean case, we can (currently) get away with only specifying
818 ;; the attributes that are used since they all fit in one int and the
819 ;; default is currently always #f (and won't be changed without good
820 ;; reason). In the non-boolean case order is important since each value
821 ;; has a specific spot in an array, all of them must be specified.
822 (if (null? all-non-bools)
824 (string-drop1 ;; drop the leading ","
825 (string-map (lambda (attr)
826 (let ((val (or (assq-ref non-bools (obj:name attr))
827 (attr-default attr))))
828 ;; FIXME: Are we missing attr-prefix here?
830 (send attr 'gen-value-for-defn val))))
836 ;; Return the C definition of the terminating entry of an object's attributes.
837 ;; ALL-ATTRS is an ordered alist of all attributes.
838 ;; "ordered" means all the non-boolean attributes are at the front and
839 ;; duplicate entries have been removed.
841 (define (gen-obj-attr-end-defn all-attrs num-non-bools)
842 (let ((all-non-bools (list-take num-non-bools all-attrs)))
845 (if (null? all-non-bools)
847 (string-drop1 ;; drop the leading ","
848 (string-map (lambda (attr)
849 (let ((val (attr-default attr)))
850 ;; FIXME: Are we missing attr-prefix here?
852 (send attr 'gen-value-for-defn val))))
858 ;; Return a boolean indicating if ATLIST indicates a CTI insn.
860 (define (atlist-cti? atlist)
861 (or (atlist-has-attr? atlist 'UNCOND-CTI)
862 (atlist-has-attr? atlist 'COND-CTI))
867 ;; Return name of obj as a C symbol.
869 (define (gen-sym obj) (gen-c-symbol (obj:name obj)))
871 ;; Return the name of the selected cpu family.
872 ;; An error is signalled if more than one has been selected.
874 (define (gen-cpu-name)
875 ;; FIXME: error checking
876 (gen-sym (current-cpu))
879 ;; Return HAVE_CPU_<CPU>.
881 (define (gen-have-cpu cpu)
882 (string-append "HAVE_CPU_"
883 (string-upcase (gen-sym cpu)))
886 ;; Return the bfd mach name for MACH.
888 (define (gen-mach-bfd-name mach)
889 (string-append "bfd_mach_" (gen-c-symbol (mach-bfd-name mach)))
892 ;; Return definition of C macro to get the value of SYM.
893 ;; INDEX-ARGS, EXPR must not have any newlines.
895 (define (gen-get-macro sym index-args expr)
897 "#define GET_" (string-upcase sym) "(" index-args ") " expr "\n")
900 ;; Return definition of C macro to get the value of SYM, version 2.
901 ;; EXPR is a C expression *without* proper \newline handling,
902 ;; we prepend \ to each line.
903 ;; INDEX-ARGS, EXPR must not have any newlines.
905 (define (gen-get-macro2 sym index-args expr)
907 "#define GET_" (string-upcase sym) "(" index-args ") "
908 (backslash "\n" expr)
912 ;; Return definition of C macro to set the value of SYM.
913 ;; INDEX-ARGS, EXPR, LVALUE must not have any newlines.
915 (define (gen-set-macro sym index-args lvalue)
917 "#define SET_" (string-upcase sym)
919 (if (equal? index-args "") "" ", ")
920 "x) (" lvalue " = (x))\n")
923 ;; Return definition of C macro to set the value of SYM, version 2.
924 ;; EXPR is one or more C statements *without* proper \newline handling,
925 ;; we prepend \ to each line.
926 ;; INDEX-ARGS, NEWVAL-ARG must not have any newlines.
928 (define (gen-set-macro2 sym index-args newval-arg expr)
930 "#define SET_" (string-upcase sym)
932 (if (equal? index-args "") "" ", ")
935 (backslash "\n" expr)
939 ;; Misc. object utilities.
941 ;; Return the nub of a list of objects.
943 (define (obj-list-nub obj-list)
944 (nub obj-list obj:name)
947 ;; Sort a list of objects with get-name methods alphabetically.
949 (define (alpha-sort-obj-list l)
952 (symbol<? (obj:name o1) (obj:name o2))))
955 ;; Called before loading the .cpu file to initialize.
957 (define (utils-init!)
958 (reader-add-command! 'sanitize
960 Mark an entry as being sanitized.
962 nil '(keyword entry-type . entry-names) sanitize)
967 ;; Return the definition of a C macro that concatenates its argument symbols.
969 (define (gen-define-with-symcat head . args)
973 (string-map (lambda (elm) (string-append "##" elm)) args)