cgen/enum.scm

   1 ; Enums.
   2 ; Copyright (C) 2000, 2009 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 (define (/enum-read context . arg-list)
 145   (let (
 146         (name #f)
 147         (comment "")
 148         (attrs nil)
 149         (prefix "")
 150         (values nil)
 151         )
 152
 153     ; Loop over each element in ARG-LIST, recording what's found.
 154     (let loop ((arg-list arg-list))
 155       (if (null? arg-list)
 156           nil
 157           (let ((arg (car arg-list))
 158                 (elm-name (caar arg-list)))
 159             (case elm-name
 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)))))
 167
 168     ; Now that we've identified the elements, build the object.
 169     (/enum-parse context name comment attrs prefix values))
 170 )
 171
 172 ; Define an enum object, name/value pair list version.
 173
 174 (define define-enum
 175   (lambda arg-list
 176     (let ((e (apply /enum-read (cons (make-current-context "define-enum")
 177                                      arg-list))))
 178       (current-enum-add! e)
 179       e))
 180 )
 181
 182 ; Define an enum object, all arguments specified.
 183
 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)
 188     e)
 189 )
 190 \f
 191 ; Lookup SYM in all recorded enums.
 192 ; The result is (value . enum-obj) or #f if not found.
 193
 194 (define (enum-lookup-val name)
 195   (let loop ((elist (current-enum-list)))
 196     (if (null? elist)
 197         #f
 198         (let ((e (assq name (send (car elist) 'enum-values))))
 199           ;(display e) (newline)
 200           (if e
 201               (begin
 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)))
 205               (loop (cdr elist)))
 206           )
 207         )
 208     )
 209 )
 210 \f
 211 ; Enums support code.
 212
 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)
 217
 218 (define (enum-sequential? vals)
 219   (let loop ((last -1) (remaining vals))
 220     (if (null? remaining)
 221         #t
 222         (let ((val (if (and (pair? (car remaining))
 223                             (not (null? (cdar remaining))))
 224                        (cadar remaining)
 225                        (+ last 1))))
 226           (if (eq? val '-)
 227               (loop (+ last 1) (cdr remaining))
 228               (if (not (= val (+ last 1)))
 229                   #f
 230                   (loop val (cdr remaining)))))))
 231 )
 232
 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.
 241
 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
 246   ; of callers.
 247   (string-list->string
 248    (append!
 249     (string-list
 250      "/* Enum declaration for " comment ".  */\n"
 251      "typedef enum "
 252      (string-downcase (gen-c-symbol name))
 253      " {")
 254     (let loop ((n 0) ; `n' is used to track the number of entries per line only
 255                (sequential? (enum-sequential? vals))
 256                (vals vals)
 257                (result (list "")))
 258       (if (null? vals)
 259           result
 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)))))
 264             (loop
 265              (if san?
 266                  4 ; reset to beginning of line (but != 0)
 267                  (+ n 1))
 268              sequential?
 269              (cdr vals)
 270              (append!
 271               result
 272               (string-list
 273                (if san?
 274                    (string-append "\n"
 275                                   (if include-sanitize-marker?
 276                                       ; split string to avoid removal
 277                                       (string-append "/* start-"
 278                                                      "sanitize-"
 279                                                      san-code " */\n")
 280                                       "")
 281                                   " ")
 282                    "")
 283                (string-upcase
 284                 (string-append
 285                  (if (and (not san?) (=? (remainder n 4) 0))
 286                      "\n "
 287                      "")
 288                  (if (= n 0)
 289                      " "
 290                      ", ")
 291                  (gen-c-symbol prefix)
 292                  (gen-c-symbol (car e))
 293                  (if (or sequential?
 294                          (null? (cdr e))
 295                          (eq? '- (cadr e)))
 296                      ""
 297                      (string-append " = "
 298                                     (if (number? (cadr e))
 299                                         (number->string (cadr e))
 300                                         (cadr e))))
 301                  ))
 302                (if (and san? include-sanitize-marker?)
 303                    ; split string to avoid removal
 304                    (string-append "\n/* end-"
 305                                   "sanitize-" san-code " */")
 306                    "")))))))
 307     (string-list
 308      "\n} "
 309      (string-upcase (gen-c-symbol name))
 310      ";\n\n")
 311     ))
 312 )
 313
 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.
 316
 317 (define (gen-obj-list-enums obj-list)
 318   (map (lambda (o)
 319          (cons (obj:name o) (cons '- (atlist-attrs (obj-atlist o)))))
 320        obj-list)
 321 )
 322
 323 ; Return C code that declares[/defines] an enum.
 324
 325 (method-make!
 326  <enum> 'gen-decl
 327  (lambda (self)
 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) "_")
 332                       "")
 333                   (elm-get self 'vals)))
 334 )
 335
 336 ;; Return the C symbol of an enum value named VAL.
 337 ;; ENUM-OBJ is the <enum> object containing VAL.
 338
 339 (define (gen-enum-sym enum-obj val)
 340   (string-upcase
 341    (string-append (if (has-attr? enum-obj 'PREFIX)
 342                       (string-append (elm-xget enum-obj 'name) "_")
 343                       "")
 344                   (gen-c-symbol val)))
 345 )
 346 \f
 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.
 350
 351 (define <insn-enum> (class-make '<insn-enum> '(<enum>) '(fld) nil))
 352
 353 (method-make!
 354  <insn-enum> 'make!
 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)
 358    self
 359    )
 360 )
 361
 362 (define ienum:fld (elm-make-getter <insn-enum> 'fld))
 363
 364 ; Same as enum-lookup-val except returned enum must be an insn-enum.
 365
 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>))
 369         result
 370         #f))
 371 )
 372
 373 ; Define an insn enum, all arguments specified.
 374
 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)))
 380
 381     (if (keep-isa-atlist? atlist-obj #f)
 382         (begin
 383           (if (not fld-obj)
 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)
 389                      atlist-obj
 390                      (/enum-parse-prefix context prefix)
 391                      fld-obj
 392                      (parse-enum-vals context prefix vals))))
 393             (current-enum-add! e)
 394             e))))
 395 )
 396 \f
 397 (define (enum-init!)
 398
 399   (reader-add-command! 'define-enum
 400                        "\
 401 Define an enum, name/value pair list version.
 402 "
 403                        nil 'arg-list define-enum)
 404   (reader-add-command! 'define-full-enum
 405                        "\
 406 Define an enum, all arguments specified.
 407 "
 408                        nil '(name comment attrs prefix vals) define-full-enum)
 409   (reader-add-command! 'define-full-insn-enum
 410                        "\
 411 Define an instruction opcode enum, all arguments specified.
 412 "
 413                        nil '(name comment attrs prefix ifld vals)
 414                        define-full-insn-enum)
 415
 416   *UNSPECIFIED*
 417 )
 418
 419 (define (enum-finish!)
 420   *UNSPECIFIED*
 421 )