cgen/enum.scm

   1 ; Enums.
   2 ; Copyright (C) 2000, 2009, 2010 Red Hat, Inc.
   3 ; This file is part of CGEN.
   4 ; See file COPYING.CGEN for details.
   5
   6 ; Enums having attribute PREFIX have their symbols prepended with
   7 ; the enum class' name + "_" in generated code.  FIXME: deprecated
   8 ;
   9 ; Member PREFIX is prepended to the symbol names when the object is defined.
  10 ;
  11 ; Enum values are looked up with `enum-lookup-val'.  The value to search for
  12 ; must already have PREFIX prepended.
  13 ;
  14 ; Enums always have mode INT.
  15
  16 (define <enum>
  17   (class-make '<enum>
  18               '(<ident>)
  19               '(prefix vals)
  20               nil)
  21 )
  22
  23 ; FIXME: this make! method is required by <insn-enum> for some reason.
  24
  25 (method-make!
  26  <enum> 'make!
  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)
  33    self)
  34 )
  35
  36 (define enum-prefix (elm-make-getter <enum> 'prefix))
  37
  38 (method-make! <enum> 'enum-values (lambda (self) (elm-get self 'vals)))
  39
  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'.
  49
  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))
  54     (if (null? remaining)
  55         (reverse! result)
  56         (let
  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))
  61                           (+ last 1)
  62                           (cadar remaining))
  63                       (+ last 1))))
  64           (if (eq? (car remaining) '-)
  65               (loop result val (cdr remaining))
  66               (let ((name (symbolstr-append prefix
  67                                             (if (pair? (car remaining))
  68                                                 (caar remaining)
  69                                                 (car remaining))))
  70                     (attrs (if (and (pair? (car remaining))
  71                                     (pair? (cdar remaining))
  72                                     (pair? (cddar remaining)))
  73                                (caddar remaining)
  74                                nil))
  75                     (comment (if (and (pair? (car remaining))
  76                                       (pair? (cdar remaining))
  77                                       (pair? (cddar remaining))
  78                                       (pair? (cdddar remaining)))
  79                                  (car (cdddar remaining))
  80                                  "")))
  81                 (loop (cons (list name val attrs comment) result)
  82                       val
  83                       (cdr remaining)))))))
  84 )
  85
  86 ; Accessors for the various elements of an enum val.
  87
  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))
  92
  93 ; Convert the names in the result of parse-enum-vals to uppercase.
  94
  95 (define (enum-vals-upcase vals)
  96   (map (lambda (elm)
  97          (cons (symbol-upcase (car elm)) (cdr elm)))
  98        vals)
  99 )
 100 \f
 101 ; Parse an enum definition.
 102
 103 ; Utility of /enum-parse to parse the prefix.
 104
 105 (define (/enum-parse-prefix context prefix)
 106   (if (symbol? prefix)
 107       (set! prefix (symbol->string prefix)))
 108
 109   (if (not (string? prefix))
 110       (parse-error context "prefix is not a string" prefix))
 111
 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))
 115
 116   prefix
 117 )
 118
 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.
 122
 123 (define (/enum-parse context name comment attrs prefix vals)
 124   (logit 2 "Processing enum " name " ...\n")
 125
 126   ;; Pick out name first to augment the error context.
 127   (let* ((name (parse-name context name))
 128          (context (context-append-name context name)))
 129
 130     (make <enum>
 131           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)))
 136 )
 137
 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.
 143 ;;
 144 ;; FIXME: Change (values ((foo 42) (bar 43))) to (values (foo 42) (bar 43)).
 145
 146 (define (/enum-read context . arg-list)
 147   (let (
 148         (name #f)
 149         (comment "")
 150         (attrs nil)
 151         (prefix "")
 152         (values nil)
 153         )
 154
 155     ; Loop over each element in ARG-LIST, recording what's found.
 156     (let loop ((arg-list arg-list))
 157       (if (null? arg-list)
 158           nil
 159           (let ((arg (car arg-list))
 160                 (elm-name (caar arg-list)))
 161             (case elm-name
 162               ((name) (set! name (cadr arg)))
 163               ((comment) (set! comment (cadr arg)))
 164               ((attrs) (set! attrs (cdr arg)))
 165               ((prefix) (set! prefix (cadr arg)))
 166               ((values) (set! values (cadr arg)))
 167               (else (parse-error context "invalid enum arg" arg)))
 168             (loop (cdr arg-list)))))
 169
 170     ; Now that we've identified the elements, build the object.
 171     (/enum-parse context name comment attrs prefix values))
 172 )
 173
 174 ; Define an enum object, name/value pair list version.
 175
 176 (define define-enum
 177   (lambda arg-list
 178     (let ((e (apply /enum-read (cons (make-current-context "define-enum")
 179                                      arg-list))))
 180       (current-enum-add! e)
 181       e))
 182 )
 183
 184 ; Define an enum object, all arguments specified.
 185
 186 (define (define-full-enum name comment attrs prefix vals)
 187   (let ((e (/enum-parse (make-current-context "define-full-enum")
 188                         name comment attrs prefix vals)))
 189     (current-enum-add! e)
 190     e)
 191 )
 192 \f
 193 ; Lookup SYM in all recorded enums.
 194 ; The result is (value . enum-obj) or #f if not found.
 195
 196 (define (enum-lookup-val name)
 197   (let loop ((elist (current-enum-list)))
 198     (if (null? elist)
 199         #f
 200         (let ((e (assq name (send (car elist) 'enum-values))))
 201           ;(display e) (newline)
 202           (if e
 203               (begin
 204                 ; sanity check, ensure the enum has a value
 205                 (if (null? (cdr e)) (error "enum-lookup-val: enum missing value: " (car e)))
 206                 (cons (cadr e) (car elist)))
 207               (loop (cdr elist)))
 208           )
 209         )
 210     )
 211 )
 212 \f
 213 ; Enums support code.
 214
 215 ; Return #t if VALS is a sequential list of enum values.
 216 ; VALS is a list of enums.  e.g. ((sym1) (sym2 3) (sym3 - attr1 (attr2 4)))
 217 ; FIXME: Doesn't handle gaps in specified values.
 218 ; e.g. (sym1 val1) sym2 (sym3 val3)
 219
 220 (define (enum-sequential? vals)
 221   (let loop ((last -1) (remaining vals))
 222     (if (null? remaining)
 223         #t
 224         (let ((val (if (and (pair? (car remaining))
 225                             (not (null? (cdar remaining))))
 226                        (cadar remaining)
 227                        (+ last 1))))
 228           (if (eq? val '-)
 229               (loop (+ last 1) (cdr remaining))
 230               (if (not (= val (+ last 1)))
 231                   #f
 232                   (loop val (cdr remaining)))))))
 233 )
 234
 235 ; Return C code to declare enum SYM with values VALS.
 236 ; COMMENT is inserted in "/* Enum declaration for <...>.  */".
 237 ; PREFIX is added to each element of VALS (uppercased).
 238 ; All enum symbols are uppercase.
 239 ; If the list of vals is sequential beginning at 0, don't output them.
 240 ; This simplifies the output and is necessary for sanitized values where
 241 ; some values may be cut out.
 242 ; VALS may have '- for the value, signifying use the next value as in C.
 243
 244 (define (gen-enum-decl name comment prefix vals)
 245   (logit 2 "Generating enum decl for " name " ...\n")
 246   ; Build result up as a list and then flatten it into a string.
 247   ; We could just return a string-list but that seems like too much to ask
 248   ; of callers.
 249   (string-list->string
 250    (append!
 251     (string-list
 252      "/* Enum declaration for " comment ".  */\n"
 253      "typedef enum "
 254      (string-downcase (gen-c-symbol name))
 255      " {")
 256     (let loop ((n 0) ; `n' is used to track the number of entries per line only
 257                (sequential? (enum-sequential? vals))
 258                (vals vals)
 259                (result (list "")))
 260       (if (null? vals)
 261           result
 262           (let* ((e (car vals))
 263                  (attrs (if (null? (cdr e)) nil (cddr e)))
 264                  (san-code (attr-value attrs 'sanitize #f))
 265                  (san? (and san-code (not (eq? san-code 'none)))))
 266             (loop
 267              (if san?
 268                  4 ; reset to beginning of line (but != 0)
 269                  (+ n 1))
 270              sequential?
 271              (cdr vals)
 272              (append!
 273               result
 274               (string-list
 275                (if san?
 276                    (string-append "\n"
 277                                   (if include-sanitize-marker?
 278                                       ; split string to avoid removal
 279                                       (string-append "/* start-"
 280                                                      "sanitize-"
 281                                                      san-code " */\n")
 282                                       "")
 283                                   " ")
 284                    "")
 285                (string-upcase
 286                 (string-append
 287                  (if (and (not san?) (=? (remainder n 4) 0))
 288                      "\n "
 289                      "")
 290                  (if (= n 0)
 291                      " "
 292                      ", ")
 293                  (gen-c-symbol prefix)
 294                  (gen-c-symbol (car e))
 295                  (if (or sequential?
 296                          (null? (cdr e))
 297                          (eq? '- (cadr e)))
 298                      ""
 299                      (string-append " = "
 300                                     (if (number? (cadr e))
 301                                         (number->string (cadr e))
 302                                         (cadr e))))
 303                  ))
 304                (if (and san? include-sanitize-marker?)
 305                    ; split string to avoid removal
 306                    (string-append "\n/* end-"
 307                                   "sanitize-" san-code " */")
 308                    "")))))))
 309     (string-list
 310      "\n} "
 311      (string-upcase (gen-c-symbol name))
 312      ";\n\n")
 313     ))
 314 )
 315
 316 ; Return a list of enum value definitions for gen-enum-decl.
 317 ; OBJ-LIST is a list of objects that support obj:name, obj-atlist.
 318
 319 (define (gen-obj-list-enums obj-list)
 320   (map (lambda (o)
 321          (cons (obj:name o) (cons '- (atlist-attrs (obj-atlist o)))))
 322        obj-list)
 323 )
 324
 325 ; Return C code that declares[/defines] an enum.
 326
 327 (method-make!
 328  <enum> 'gen-decl
 329  (lambda (self)
 330    (gen-enum-decl (elm-get self 'name)
 331                   (elm-get self 'comment)
 332                   (if (has-attr? self 'PREFIX)
 333                       (string-append (elm-get self 'name) "_")
 334                       "")
 335                   (elm-get self 'vals)))
 336 )
 337
 338 ;; Return the C symbol of an enum value named VAL.
 339 ;; ENUM-OBJ is the <enum> object containing VAL.
 340
 341 (define (gen-enum-sym enum-obj val)
 342   (string-upcase
 343    (string-append (if (has-attr? enum-obj 'PREFIX)
 344                       (string-append (elm-xget enum-obj 'name) "_")
 345                       "")
 346                   (gen-c-symbol val)))
 347 )
 348 \f
 349 ; Instruction code enums.
 350 ; These associate an enum with an instruction field so that the enum values
 351 ; can be used in instruction field lists.
 352
 353 (define <insn-enum> (class-make '<insn-enum> '(<enum>) '(fld) nil))
 354
 355 (method-make!
 356  <insn-enum> 'make!
 357  (lambda (self name comment attrs prefix fld vals)
 358    (send-next self '<insn-enum> 'make! name comment attrs prefix vals)
 359    (elm-set! self 'fld fld)
 360    self
 361    )
 362 )
 363
 364 (define ienum:fld (elm-make-getter <insn-enum> 'fld))
 365
 366 ; Same as enum-lookup-val except returned enum must be an insn-enum.
 367
 368 (define (ienum-lookup-val name)
 369   (let ((result (enum-lookup-val name)))
 370     (if (and result (eq? (object-class-name (cdr result)) '<insn-enum>))
 371         result
 372         #f))
 373 )
 374
 375 ; Define an insn enum, all arguments specified.
 376
 377 (define (define-full-insn-enum name comment attrs prefix fld vals)
 378   (let* ((context (make-current-context "define-full-insn-enum"))
 379          (atlist-obj (atlist-parse context attrs "insn-enum"))
 380          (isa-name-list (atlist-attr-value atlist-obj 'ISA #f))
 381          (fld-obj (current-ifld-lookup fld isa-name-list)))
 382
 383     (if (keep-isa-atlist? atlist-obj #f)
 384         (begin
 385           (if (not fld-obj)
 386               (parse-error context "unknown insn field" fld))
 387           ; Create enum object and add it to the list of enums.
 388           (let ((e (make <insn-enum>
 389                      (parse-name context name)
 390                      (parse-comment context comment)
 391                      atlist-obj
 392                      (/enum-parse-prefix context prefix)
 393                      fld-obj
 394                      (parse-enum-vals context prefix vals))))
 395             (current-enum-add! e)
 396             e))))
 397 )
 398 \f
 399 (define (enum-init!)
 400
 401   (reader-add-command! 'define-enum
 402                        "\
 403 Define an enum, name/value pair list version.
 404 "
 405                        nil 'arg-list define-enum)
 406   (reader-add-command! 'define-full-enum
 407                        "\
 408 Define an enum, all arguments specified.
 409 "
 410                        nil '(name comment attrs prefix vals) define-full-enum)
 411   (reader-add-command! 'define-full-insn-enum
 412                        "\
 413 Define an instruction opcode enum, all arguments specified.
 414 "
 415                        nil '(name comment attrs prefix ifld vals)
 416                        define-full-insn-enum)
 417
 418   *UNSPECIFIED*
 419 )
 420
 421 (define (enum-builtin!)
 422   ;; Provide FPCONV-DEFAULT == 0 as an enum constant to use as the `how'
 423   ;; parameter to the floating point conversion functions.
 424   ;; ??? Add standard IEEE rounding modes?
 425   (define-enum '(name fpconv-kind)
 426     '(comment "builtin floating point conversion kinds")
 427     '(attrs VIRTUAL) ;; let app provide def'n instead of each cpu's desc.h
 428     '(prefix FPCONV-)
 429     '(values ((DEFAULT 0)
 430               (TIES-TO-EVEN 1)
 431               (TIES-TO-AWAY 2)
 432               (TOWARD-ZERO 3)
 433               (TOWARD-POSITIVE 4)
 434               (TOWARD-NEGATIVE 5))))
 435
 436   *UNSPECIFIED*
 437 )
 438
 439 (define (enum-finish!)
 440   *UNSPECIFIED*
 441 )