cgen/enum.scm

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