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.
   8 ; Member PREFIX is always prepended to the symbol names.
   9 ;
  10 ; Enum values are looked up with `enum-lookup-val'.  The value to search for
  11 ; has PREFIX prepended.
  12 ;
  13 ; Enums always have mode INT.
  14
  15 (define <enum>
  16   (class-make '<enum>
  17               '(<ident>)
  18               '(prefix vals)
  19               nil)
  20 )
  21
  22 ; FIXME: this make! method is required by <insn-enum> for some reason.
  23
  24 (method-make!
  25  <enum> 'make!
  26  (lambda (self name comment attrs prefix vals)
  27    (elm-set! self 'name name)
  28    (elm-set! self 'comment comment)
  29    (elm-set! self 'attrs attrs)
  30    (elm-set! self 'prefix prefix)
  31    (elm-set! self 'vals vals)
  32    self)
  33 )
  34
  35 (define enum-prefix (elm-make-getter <enum> 'prefix))
  36
  37 (method-make! <enum> 'enum-values (lambda (self) (elm-get self 'vals)))
  38
  39 ; Parse a list of enum name/value entries.
  40 ; PREFIX is prepended to each name.
  41 ; Elements are any of: symbol, (symbol), (symbol value)
  42 ; (symbol - attrs), (symbol value attrs), (symbol - attrs comment),
  43 ; (symbol value attrs comment).
  44 ; The - or #f means "use the next value".
  45 ; SYMBOL may be - which means "skip this value".
  46 ; The result is the same list, except values are filled in where missing,
  47 ; and each symbol is prepended with `prefix'.
  48
  49 (define (parse-enum-vals context prefix vals)
  50   ; Scan the value list, building up RESULT as we go.
  51   ; Each element's value is 1+ the previous, unless there's an explicit value.
  52   (let loop ((result nil) (last -1) (remaining vals))
  53     (if (null? remaining)
  54         (reverse! result)
  55         (let
  56             ; Compute the numeric value the next entry will have.
  57             ((val (if (and (pair? (car remaining))
  58                            (not (null? (cdar remaining))))
  59                       (if (eq? '- (cadar remaining))
  60                           (+ last 1)
  61                           (cadar remaining))
  62                       (+ last 1))))
  63           (if (eq? (car remaining) '-)
  64               (loop result val (cdr remaining))
  65               (let ((name (symbolstr-append prefix
  66                                             (if (pair? (car remaining))
  67                                                 (caar remaining)
  68                                                 (car remaining))))
  69                     (attrs (if (and (pair? (car remaining))
  70                                     (pair? (cdar remaining))
  71                                     (pair? (cddar remaining)))
  72                                (caddar remaining)
  73                                nil))
  74                     (comment (if (and (pair? (car remaining))
  75                                       (pair? (cdar remaining))
  76                                       (pair? (cddar remaining))
  77                                       (pair? (cdddar remaining)))
  78                                  (car (cdddar remaining))
  79                                  "")))
  80                 (loop (cons (list name val attrs comment) result)
  81                       val
  82                       (cdr remaining)))))))
  83 )
  84
  85 ; Accessors for the various elements of an enum val.
  86
  87 (define (enum-val-name ev) (list-ref ev 0))
  88 (define (enum-val-value ev) (list-ref ev 1))
  89 (define (enum-val-attrs ev) (list-ref ev 2))
  90 (define (enum-val-comment ev) (list-ref ev 3))
  91
  92 ; Convert the names in the result of parse-enum-vals to uppercase.
  93
  94 (define (enum-vals-upcase vals)
  95   (map (lambda (elm)
  96          (cons (symbol-upcase (car elm)) (cdr elm)))
  97        vals)
  98 )
  99 \f
 100 ; Parse an enum definition.
 101
 102 ; Utility of /enum-parse to parse the prefix.
 103
 104 (define (/enum-parse-prefix context prefix)
 105   (if (symbol? prefix)
 106       (set! prefix (symbol->string prefix)))
 107
 108   (if (not (string? prefix))
 109       (parse-error context "prefix is not a string" prefix))
 110
 111   ; Prefix must not contain lowercase chars (enforced style rule, sue me).
 112   (if (any-true? (map char-lower-case? (string->list prefix)))
 113       (parse-error context "prefix must be uppercase" prefix))
 114
 115   prefix
 116 )
 117
 118 ; This is the main routine for building an enum object from a
 119 ; description in the .cpu file.
 120 ; All arguments are in raw (non-evaluated) form.
 121
 122 (define (/enum-parse context name comment attrs prefix vals)
 123   (logit 2 "Processing enum " name " ...\n")
 124
 125   ;; Pick out name first to augment the error context.
 126   (let* ((name (parse-name context name))
 127          (context (context-append-name context name)))
 128
 129     (make <enum>
 130           name
 131           (parse-comment context comment)
 132           (atlist-parse context attrs "enum")
 133           (/enum-parse-prefix context prefix)
 134           (parse-enum-vals context prefix vals)))
 135 )
 136
 137 ; Read an enum description
 138 ; This is the main routine for analyzing enums in the .cpu file.
 139 ; CONTEXT is a <context> object for error messages.
 140 ; ARG-LIST is an associative list of field name and field value.
 141 ; /enum-parse is invoked to create the `enum' object.
 142
 143 (define (/enum-read context . arg-list)
 144   (let (
 145         (name #f)
 146         (comment "")
 147         (attrs nil)
 148         (prefix "")
 149         (values nil)
 150         )
 151
 152     ; Loop over each element in ARG-LIST, recording what's found.
 153     (let loop ((arg-list arg-list))
 154       (if (null? arg-list)
 155           nil
 156           (let ((arg (car arg-list))
 157                 (elm-name (caar arg-list)))
 158             (case elm-name
 159               ((name) (set! name (cadr arg)))
 160               ((comment) (set! comment (cadr arg)))
 161               ((attrs) (set! attrs (cdr arg)))
 162               ((prefix) (set! prefix (cadr arg)))
 163               ((values) (set! values (cadr arg)))
 164               (else (parse-error context "invalid enum arg" arg)))
 165             (loop (cdr arg-list)))))
 166
 167     ; Now that we've identified the elements, build the object.
 168     (/enum-parse context name comment attrs prefix values))
 169 )
 170
 171 ; Define an enum object, name/value pair list version.
 172
 173 (define define-enum
 174   (lambda arg-list
 175     (let ((e (apply /enum-read (cons (make-current-context "define-enum")
 176                                      arg-list))))
 177       (current-enum-add! e)
 178       e))
 179 )
 180
 181 ; Define an enum object, all arguments specified.
 182
 183 (define (define-full-enum name comment attrs prefix vals)
 184   (let ((e (/enum-parse (make-current-context "define-full-enum")
 185                         name comment attrs prefix vals)))
 186     (current-enum-add! e)
 187     e)
 188 )
 189 \f
 190 ; Lookup SYM in all recorded enums.
 191 ; The result is (value . enum-obj) or #f if not found.
 192
 193 (define (enum-lookup-val name)
 194   (let loop ((elist (current-enum-list)))
 195     (if (null? elist)
 196         #f
 197         (let ((e (assq name (send (car elist) 'enum-values))))
 198           ;(display e) (newline)
 199           (if e
 200               (begin
 201                 ; sanity check, ensure the enum has a value
 202                 (if (null? (cdr e)) (error "enum-lookup-val: enum missing value: " (car e)))
 203                 (cons (cadr e) (car elist)))
 204               (loop (cdr elist)))
 205           )
 206         )
 207     )
 208 )
 209 \f
 210 ; Enums support code.
 211
 212 ; Return #t if VALS is a sequential list of enum values.
 213 ; VALS is a list of enums.  e.g. ((sym1) (sym2 3) (sym3 - attr1 (attr2 4)))
 214 ; FIXME: Doesn't handle gaps in specified values.
 215 ; e.g. (sym1 val1) sym2 (sym3 val3)
 216
 217 (define (enum-sequential? vals)
 218   (let loop ((last -1) (remaining vals))
 219     (if (null? remaining)
 220         #t
 221         (let ((val (if (and (pair? (car remaining))
 222                             (not (null? (cdar remaining))))
 223                        (cadar remaining)
 224                        (+ last 1))))
 225           (if (eq? val '-)
 226               (loop (+ last 1) (cdr remaining))
 227               (if (not (= val (+ last 1)))
 228                   #f
 229                   (loop val (cdr remaining)))))))
 230 )
 231
 232 ; Return C code to declare enum SYM with values VALS.
 233 ; COMMENT is inserted in "/* Enum declaration for <...>.  */".
 234 ; PREFIX is added to each element of VALS.
 235 ; All enum symbols are uppercase.
 236 ; If the list of vals is sequential beginning at 0, don't output them.
 237 ; This simplifies the output and is necessary for sanitized values where
 238 ; some values may be cut out.
 239 ; VALS may have '- for the value, signifying use the next value as in C.
 240
 241 (define (gen-enum-decl name comment prefix vals)
 242   (logit 2 "Generating enum decl for " name " ...\n")
 243   ; Build result up as a list and then flatten it into a string.
 244   ; We could just return a string-list but that seems like too much to ask
 245   ; of callers.
 246   (string-list->string
 247    (append!
 248     (string-list
 249      "/* Enum declaration for " comment ".  */\n"
 250      "typedef enum "
 251      (string-downcase (gen-c-symbol name))
 252      " {")
 253     (let loop ((n 0) ; `n' is used to track the number of entries per line only
 254                (sequential? (enum-sequential? vals))
 255                (vals vals)
 256                (result (list "")))
 257       (if (null? vals)
 258           result
 259           (let* ((e (car vals))
 260                  (attrs (if (null? (cdr e)) nil (cddr e)))
 261                  (san-code (attr-value attrs 'sanitize #f))
 262                  (san? (and san-code (not (eq? san-code 'none)))))
 263             (loop
 264              (if san?
 265                  4 ; reset to beginning of line (but != 0)
 266                  (+ n 1))
 267              sequential?
 268              (cdr vals)
 269              (append!
 270               result
 271               (string-list
 272                (if san?
 273                    (string-append "\n"
 274                                   (if include-sanitize-marker?
 275                                       ; split string to avoid removal
 276                                       (string-append "/* start-"
 277                                                      "sanitize-"
 278                                                      san-code " */\n")
 279                                       "")
 280                                   " ")
 281                    "")
 282                (string-upcase
 283                 (string-append
 284                  (if (and (not san?) (=? (remainder n 4) 0))
 285                      "\n "
 286                      "")
 287                  (if (= n 0)
 288                      " "
 289                      ", ")
 290                  (gen-c-symbol prefix)
 291                  (gen-c-symbol (car e))
 292                  (if (or sequential?
 293                          (null? (cdr e))
 294                          (eq? '- (cadr e)))
 295                      ""
 296                      (string-append " = "
 297                                     (if (number? (cadr e))
 298                                         (number->string (cadr e))
 299                                         (cadr e))))
 300                  ))
 301                (if (and san? include-sanitize-marker?)
 302                    ; split string to avoid removal
 303                    (string-append "\n/* end-"
 304                                   "sanitize-" san-code " */")
 305                    "")))))))
 306     (string-list
 307      "\n} "
 308      (string-upcase (gen-c-symbol name))
 309      ";\n\n")
 310     ))
 311 )
 312
 313 ; Return a list of enum value definitions for gen-enum-decl.
 314 ; OBJ-LIST is a list of objects that support obj:name, obj-atlist.
 315
 316 (define (gen-obj-list-enums obj-list)
 317   (map (lambda (o)
 318          (cons (obj:name o) (cons '- (atlist-attrs (obj-atlist o)))))
 319        obj-list)
 320 )
 321
 322 ; Return C code that declares[/defines] an enum.
 323
 324 (method-make!
 325  <enum> 'gen-decl
 326  (lambda (self)
 327    (gen-enum-decl (elm-get self 'name)
 328                   (elm-get self 'comment)
 329                   (if (has-attr? self 'PREFIX)
 330                       (string-append (elm-get self 'name) "_")
 331                       "")
 332                   (elm-get self 'vals)))
 333 )
 334
 335 ; Return the C symbol of an enum value named VAL.
 336
 337 (define (gen-enum-sym enum-obj val)
 338   (string-upcase (gen-c-symbol (string-append (enum-prefix enum-obj) val)))
 339 )
 340 \f
 341 ; Instruction code enums.
 342 ; These associate an enum with an instruction field so that the enum values
 343 ; can be used in instruction field lists.
 344
 345 (define <insn-enum> (class-make '<insn-enum> '(<enum>) '(fld) nil))
 346
 347 (method-make!
 348  <insn-enum> 'make!
 349  (lambda (self name comment attrs prefix fld vals)
 350    (send (object-parent self <enum>) 'make! name comment attrs prefix vals)
 351    (elm-set! self 'fld fld)
 352    self
 353    )
 354 )
 355
 356 (define ienum:fld (elm-make-getter <insn-enum> 'fld))
 357
 358 ; Same as enum-lookup-val except returned enum must be an insn-enum.
 359
 360 (define (ienum-lookup-val name)
 361   (let ((result (enum-lookup-val name)))
 362     (if (and result (eq? (object-class-name (cdr result)) '<insn-enum>))
 363         result
 364         #f))
 365 )
 366
 367 ; Define an insn enum, all arguments specified.
 368
 369 (define (define-full-insn-enum name comment attrs prefix fld vals)
 370   (let* ((context (make-current-context "define-full-insn-enum"))
 371          (atlist (atlist-parse context attrs "insn-enum"))
 372          (fld-obj (current-ifld-lookup fld)))
 373
 374     (if (keep-isa-atlist? atlist #f)
 375         (begin
 376           (if (not fld-obj)
 377               (parse-error context "unknown insn field" fld))
 378           ; Create enum object and add it to the list of enums.
 379           (let ((e (make <insn-enum>
 380                      (parse-name context name)
 381                      (parse-comment context comment)
 382                      atlist
 383                      (/enum-parse-prefix context prefix)
 384                      fld-obj
 385                      (parse-enum-vals context prefix vals))))
 386             (current-enum-add! e)
 387             e))))
 388 )
 389 \f
 390 (define (enum-init!)
 391
 392   (reader-add-command! 'define-enum
 393                        "\
 394 Define an enum, name/value pair list version.
 395 "
 396                        nil 'arg-list define-enum)
 397   (reader-add-command! 'define-full-enum
 398                        "\
 399 Define an enum, all arguments specified.
 400 "
 401                        nil '(name comment attrs prefix vals) define-full-enum)
 402   (reader-add-command! 'define-full-insn-enum
 403                        "\
 404 Define an instruction opcode enum, all arguments specified.
 405 "
 406                        nil '(name comment attrs prefix ifld vals)
 407                        define-full-insn-enum)
 408
 409   *UNSPECIFIED*
 410 )
 411
 412 (define (enum-finish!)
 413   *UNSPECIFIED*
 414 )