2 ; Copyright (C) 2000, 2009 Red Hat, Inc.
3 ; This file is part of CGEN.
4 ; See file COPYING.CGEN for details.
6 ; Enums having attribute PREFIX have their symbols prepended with
7 ; the enum class' name + "_" in generated code. FIXME: deprecated
9 ; Member PREFIX is prepended to the symbol names when the object is defined.
11 ; Enum values are looked up with `enum-lookup-val'. The value to search for
12 ; must already have PREFIX prepended.
14 ; Enums always have mode INT.
23 ; FIXME: this make! method is required by <insn-enum> for some reason.
27 (lambda (self name comment attrs prefix vals)
28 (elm-set! self 'name name)
29 (elm-set! self 'comment comment)
30 (elm-set! self 'attrs attrs)
31 (elm-set! self 'prefix prefix)
32 (elm-set! self 'vals vals)
36 (define enum-prefix (elm-make-getter <enum> 'prefix))
38 (method-make! <enum> 'enum-values (lambda (self) (elm-get self 'vals)))
40 ; Parse a list of enum name/value entries.
41 ; PREFIX is prepended to each name.
42 ; Elements are any of: symbol, (symbol), (symbol value)
43 ; (symbol - attrs), (symbol value attrs), (symbol - attrs comment),
44 ; (symbol value attrs comment).
45 ; The - or #f means "use the next value".
46 ; SYMBOL may be - which means "skip this value".
47 ; The result is the same list, except values are filled in where missing,
48 ; and each symbol is prepended with `prefix'.
50 (define (parse-enum-vals context prefix vals)
51 ; Scan the value list, building up RESULT as we go.
52 ; Each element's value is 1+ the previous, unless there's an explicit value.
53 (let loop ((result nil) (last -1) (remaining vals))
57 ; Compute the numeric value the next entry will have.
58 ((val (if (and (pair? (car remaining))
59 (not (null? (cdar remaining))))
60 (if (eq? '- (cadar remaining))
64 (if (eq? (car remaining) '-)
65 (loop result val (cdr remaining))
66 (let ((name (symbolstr-append prefix
67 (if (pair? (car remaining))
70 (attrs (if (and (pair? (car remaining))
71 (pair? (cdar remaining))
72 (pair? (cddar remaining)))
75 (comment (if (and (pair? (car remaining))
76 (pair? (cdar remaining))
77 (pair? (cddar remaining))
78 (pair? (cdddar remaining)))
79 (car (cdddar remaining))
81 (loop (cons (list name val attrs comment) result)
86 ; Accessors for the various elements of an enum val.
88 (define (enum-val-name ev) (list-ref ev 0))
89 (define (enum-val-value ev) (list-ref ev 1))
90 (define (enum-val-attrs ev) (list-ref ev 2))
91 (define (enum-val-comment ev) (list-ref ev 3))
93 ; Convert the names in the result of parse-enum-vals to uppercase.
95 (define (enum-vals-upcase vals)
97 (cons (symbol-upcase (car elm)) (cdr elm)))
101 ; Parse an enum definition.
103 ; Utility of /enum-parse to parse the prefix.
105 (define (/enum-parse-prefix context prefix)
107 (set! prefix (symbol->string prefix)))
109 (if (not (string? prefix))
110 (parse-error context "prefix is not a string" prefix))
112 ; Prefix must not contain lowercase chars (enforced style rule, sue me).
113 (if (any-true? (map char-lower-case? (string->list prefix)))
114 (parse-error context "prefix must be uppercase" prefix))
119 ; This is the main routine for building an enum object from a
120 ; description in the .cpu file.
121 ; All arguments are in raw (non-evaluated) form.
123 (define (/enum-parse context name comment attrs prefix vals)
124 (logit 2 "Processing enum " name " ...\n")
126 ;; Pick out name first to augment the error context.
127 (let* ((name (parse-name context name))
128 (context (context-append-name context name)))
132 (parse-comment context comment)
133 (atlist-parse context attrs "enum")
134 (/enum-parse-prefix context prefix)
135 (parse-enum-vals context prefix vals)))
138 ; Read an enum description
139 ; This is the main routine for analyzing enums in the .cpu file.
140 ; CONTEXT is a <context> object for error messages.
141 ; ARG-LIST is an associative list of field name and field value.
142 ; /enum-parse is invoked to create the `enum' object.
144 (define (/enum-read context . arg-list)
153 ; Loop over each element in ARG-LIST, recording what's found.
154 (let loop ((arg-list arg-list))
157 (let ((arg (car arg-list))
158 (elm-name (caar arg-list)))
160 ((name) (set! name (cadr arg)))
161 ((comment) (set! comment (cadr arg)))
162 ((attrs) (set! attrs (cdr arg)))
163 ((prefix) (set! prefix (cadr arg)))
164 ((values) (set! values (cadr arg)))
165 (else (parse-error context "invalid enum arg" arg)))
166 (loop (cdr arg-list)))))
168 ; Now that we've identified the elements, build the object.
169 (/enum-parse context name comment attrs prefix values))
172 ; Define an enum object, name/value pair list version.
176 (let ((e (apply /enum-read (cons (make-current-context "define-enum")
178 (current-enum-add! e)
182 ; Define an enum object, all arguments specified.
184 (define (define-full-enum name comment attrs prefix vals)
185 (let ((e (/enum-parse (make-current-context "define-full-enum")
186 name comment attrs prefix vals)))
187 (current-enum-add! e)
191 ; Lookup SYM in all recorded enums.
192 ; The result is (value . enum-obj) or #f if not found.
194 (define (enum-lookup-val name)
195 (let loop ((elist (current-enum-list)))
198 (let ((e (assq name (send (car elist) 'enum-values))))
199 ;(display e) (newline)
202 ; sanity check, ensure the enum has a value
203 (if (null? (cdr e)) (error "enum-lookup-val: enum missing value: " (car e)))
204 (cons (cadr e) (car elist)))
211 ; Enums support code.
213 ; Return #t if VALS is a sequential list of enum values.
214 ; VALS is a list of enums. e.g. ((sym1) (sym2 3) (sym3 - attr1 (attr2 4)))
215 ; FIXME: Doesn't handle gaps in specified values.
216 ; e.g. (sym1 val1) sym2 (sym3 val3)
218 (define (enum-sequential? vals)
219 (let loop ((last -1) (remaining vals))
220 (if (null? remaining)
222 (let ((val (if (and (pair? (car remaining))
223 (not (null? (cdar remaining))))
227 (loop (+ last 1) (cdr remaining))
228 (if (not (= val (+ last 1)))
230 (loop val (cdr remaining)))))))
233 ; Return C code to declare enum SYM with values VALS.
234 ; COMMENT is inserted in "/* Enum declaration for <...>. */".
235 ; PREFIX is added to each element of VALS (uppercased).
236 ; All enum symbols are uppercase.
237 ; If the list of vals is sequential beginning at 0, don't output them.
238 ; This simplifies the output and is necessary for sanitized values where
239 ; some values may be cut out.
240 ; VALS may have '- for the value, signifying use the next value as in C.
242 (define (gen-enum-decl name comment prefix vals)
243 (logit 2 "Generating enum decl for " name " ...\n")
244 ; Build result up as a list and then flatten it into a string.
245 ; We could just return a string-list but that seems like too much to ask
250 "/* Enum declaration for " comment ". */\n"
252 (string-downcase (gen-c-symbol name))
254 (let loop ((n 0) ; `n' is used to track the number of entries per line only
255 (sequential? (enum-sequential? vals))
260 (let* ((e (car vals))
261 (attrs (if (null? (cdr e)) nil (cddr e)))
262 (san-code (attr-value attrs 'sanitize #f))
263 (san? (and san-code (not (eq? san-code 'none)))))
266 4 ; reset to beginning of line (but != 0)
275 (if include-sanitize-marker?
276 ; split string to avoid removal
277 (string-append "/* start-"
285 (if (and (not san?) (=? (remainder n 4) 0))
291 (gen-c-symbol prefix)
292 (gen-c-symbol (car e))
298 (if (number? (cadr e))
299 (number->string (cadr e))
302 (if (and san? include-sanitize-marker?)
303 ; split string to avoid removal
304 (string-append "\n/* end-"
305 "sanitize-" san-code " */")
309 (string-upcase (gen-c-symbol name))
314 ; Return a list of enum value definitions for gen-enum-decl.
315 ; OBJ-LIST is a list of objects that support obj:name, obj-atlist.
317 (define (gen-obj-list-enums obj-list)
319 (cons (obj:name o) (cons '- (atlist-attrs (obj-atlist o)))))
323 ; Return C code that declares[/defines] an enum.
328 (gen-enum-decl (elm-get self 'name)
329 (elm-get self 'comment)
330 (if (has-attr? self 'PREFIX)
331 (string-append (elm-get self 'name) "_")
333 (elm-get self 'vals)))
336 ;; Return the C symbol of an enum value named VAL.
337 ;; ENUM-OBJ is the <enum> object containing VAL.
339 (define (gen-enum-sym enum-obj val)
341 (string-append (if (has-attr? enum-obj 'PREFIX)
342 (string-append (elm-xget enum-obj 'name) "_")
347 ; Instruction code enums.
348 ; These associate an enum with an instruction field so that the enum values
349 ; can be used in instruction field lists.
351 (define <insn-enum> (class-make '<insn-enum> '(<enum>) '(fld) nil))
355 (lambda (self name comment attrs prefix fld vals)
356 (send-next self '<insn-enum> 'make! name comment attrs prefix vals)
357 (elm-set! self 'fld fld)
362 (define ienum:fld (elm-make-getter <insn-enum> 'fld))
364 ; Same as enum-lookup-val except returned enum must be an insn-enum.
366 (define (ienum-lookup-val name)
367 (let ((result (enum-lookup-val name)))
368 (if (and result (eq? (object-class-name (cdr result)) '<insn-enum>))
373 ; Define an insn enum, all arguments specified.
375 (define (define-full-insn-enum name comment attrs prefix fld vals)
376 (let* ((context (make-current-context "define-full-insn-enum"))
377 (atlist-obj (atlist-parse context attrs "insn-enum"))
378 (isa-name-list (atlist-attr-value atlist-obj 'ISA #f))
379 (fld-obj (current-ifld-lookup fld isa-name-list)))
381 (if (keep-isa-atlist? atlist-obj #f)
384 (parse-error context "unknown insn field" fld))
385 ; Create enum object and add it to the list of enums.
386 (let ((e (make <insn-enum>
387 (parse-name context name)
388 (parse-comment context comment)
390 (/enum-parse-prefix context prefix)
392 (parse-enum-vals context prefix vals))))
393 (current-enum-add! e)
399 (reader-add-command! 'define-enum
401 Define an enum, name/value pair list version.
403 nil 'arg-list define-enum)
404 (reader-add-command! 'define-full-enum
406 Define an enum, all arguments specified.
408 nil '(name comment attrs prefix vals) define-full-enum)
409 (reader-add-command! 'define-full-insn-enum
411 Define an instruction opcode enum, all arguments specified.
413 nil '(name comment attrs prefix ifld vals)
414 define-full-insn-enum)
419 (define (enum-finish!)