cgen/hardware.scm

   1 ; Hardware descriptions.
   2 ; Copyright (C) 2000, 2009 Red Hat, Inc.
   3 ; This file is part of CGEN.
   4 ; See file COPYING.CGEN for details.
   5
   6 ; This is the base class for all hardware descriptions.
   7 ; The actual hardware objects inherit from this (e.g. register, immediate).
   8 ; This is used to describe registers, memory, and immediates.
   9 ; ??? Maybe other things as well, but this is all that's needed at present.
  10 ; ??? Eventually rename to <hardware> but not yet.
  11
  12 (define <hardware-base>
  13   (class-make '<hardware-base>
  14               '(<ident>)
  15               '(
  16                 ; Name used in semantics.
  17                 ; This is for cases where a particular hardware element is
  18                 ; sufficiently different on different mach's of an architecture
  19                 ; that it is defined separately for each case.  The semantics
  20                 ; refer to this name (which means that one must use a different
  21                 ; mechanism if one wants both machs in the same semantic code).
  22                 sem-name
  23
  24                 ; The type, an object of class <array>.
  25                 ; (mode + scalar or vector length)
  26                 type
  27
  28                 ; Indexing support.
  29                 ; An object of class <hw-asm>, or a subclass of it, or
  30                 ; #f if there is no special indexing support.
  31                 ; For register banks, a table of register names.
  32                 ; ??? Same class as VALUES.
  33                 ; ??? There are currently no descriptions that require both an
  34                 ; INDICES and a VALUES specification.  It might make sense to
  35                 ; combine them (which is how things used to be), but it is odd
  36                 ; to have them combined.
  37                 (indices . #f)
  38
  39                 ; Table of values.
  40                 ; An object of class <hw-asm>, or a subclass of it, or
  41                 ; #f if there is no special values support.
  42                 ; For immediates with special names, a table of names.
  43                 ; ??? Same class as INDICES.
  44                 (values . #f)
  45
  46                 ; Associative list of (symbol . "handler") entries.
  47                 ; Each entry maps an operation to its handler (which is up to
  48                 ; the application but is generally a function name).
  49                 (handlers . ())
  50
  51                 ; Get/set handlers or #f to use the default.
  52                 (get . #f)
  53                 (set . #f)
  54
  55                 ; Associative list of get/set handlers for each supported mode,
  56                 ; or #f to use the default.
  57                 ; ??? An interesting idea, but not sure it's the best way
  58                 ; to go.  Another way is to explicitly handle it in the insn
  59                 ; [complicates the RTL].  Another way is to handle this in
  60                 ; operand get/set handlers.  Another way is to have virtual
  61                 ; regs for each non-default mode.  Not sure which is better.
  62                 ;(getters . #f)
  63                 ;(setters . #f)
  64
  65                 ; List of <isa> objects that use this hardware element
  66                 ; or #f if not computed yet.
  67                 ; This is a derived from the ISA attribute and is for speed.
  68                 (isas-cache . #f)
  69
  70                 ; Flag indicates whether this hw has been used in a (delay ...)
  71                 ; rtl expression
  72                 (used-in-delay-rtl? . #f)
  73                 )
  74               nil)
  75 )
  76
  77 ; Accessors
  78
  79 (define-getters <hardware-base> hw
  80   (sem-name type indices values handlers
  81    ; ??? These might be more properly named hw-get/hw-set, but those names
  82    ; seem ambiguous.
  83    (get . getter) (set . setter)
  84    isas-cache used-in-delay-rtl?)
  85 )
  86
  87 ; Mode,rank,shape support.
  88
  89 (method-make-forward! <hardware-base> 'type '(get-mode get-rank get-shape get-num-elms))
  90 (define (hw-mode hw) (send hw 'get-mode))
  91 (define (hw-rank hw) (send hw 'get-rank))
  92 (define (hw-shape hw) (send hw 'get-shape))
  93 (define (hw-num-elms hw) (send hw 'get-num-elms))
  94
  95 ; Return default mode to reference HW in.
  96
  97 (define (hw-default-mode hw)
  98   (hw-mode hw)
  99 )
 100
 101 ; Return a boolean indicating if X is a hardware object.
 102 ; ??? <hardware-base> to be renamed <hardware> in time.
 103
 104 (define (hardware? x) (class-instance? <hardware-base> x))
 105
 106 ; Return #t if HW is a scalar.
 107
 108 (define (hw-scalar? hw) (= (hw-rank hw) 0))
 109
 110 ; Return number of bits in an element of HW.
 111
 112 (define (hw-bits hw)
 113   (type-bits (hw-type hw))
 114 )
 115
 116 ; Generate the name of the enum for hardware object HW.
 117 ; This uses the semantic name, not obj:name.
 118 ; If HW is a symbol, it is already the semantic name.
 119
 120 (define (hw-enum hw)
 121   (if (symbol? hw)
 122       (string-upcase (string-append "HW_" (gen-c-symbol hw)))
 123       (string-upcase (string-append "HW_" (gen-c-symbol (hw-sem-name hw)))))
 124 )
 125
 126 ; Return a boolean indicating if it's ok to reference SELF in mode
 127 ; NEW-MODE-NAME, index INDEX.
 128 ; Hardware types are required to override this method.
 129 ; VOID and DFLT are never valid for NEW-MODE-NAME.
 130
 131 (method-make!
 132  <hardware-base> 'mode-ok?
 133  (lambda (self new-mode-name index)
 134    (error "mode-ok? method not overridden:" (obj:name self)))
 135 )
 136
 137 (define (hw-mode-ok? hw new-mode-name index)
 138   (send hw 'mode-ok? new-mode-name index)
 139 )
 140
 141 ; Return mode to use for the index or #f if scalar.
 142
 143 (method-make!
 144  <hardware-base> 'get-index-mode
 145  (lambda (self)
 146    (error "get-index-mode method not overridden:" (obj:name self)))
 147 )
 148
 149 (define (hw-index-mode hw) (send hw 'get-index-mode))
 150
 151 ; Compute the isas used by HW and cache the results.
 152
 153 (method-make!
 154  <hardware-base> 'get-isas
 155  (lambda (self)
 156    (or (elm-get self 'isas-cache)
 157        (let* ((isas (obj-attr-value self 'ISA))
 158               (isa-objs (if (eq? isas 'all) (current-isa-list)
 159                             (map current-isa-lookup
 160                                  (bitset-attr->list isas)))))
 161          (elm-set! self 'isas-cache isa-objs)
 162          isa-objs)))
 163 )
 164
 165 (define (hw-isas hw) (send hw 'get-isas))
 166
 167 ; Was this hardware used in a (delay ...) rtl expression?
 168
 169 (method-make!
 170  <hardware-base> 'used-in-delay-rtl?
 171  (lambda (self) (elm-get self 'used-in-delay-rtl?))
 172 )
 173
 174 (define (hw-used-in-delay-rtl? hw) (send hw 'used-in-delay-rtl?))
 175
 176 ; FIXME: replace pc?,memory?,register?,iaddress? with just one method.
 177
 178 ; Return boolean indicating if hardware element is the PC.
 179
 180 (method-make! <hardware-base> 'pc? (lambda (self) #f))
 181
 182 ; Return boolean indicating if hardware element is some kind of memory.
 183 ; ??? Need to allow multiple kinds of memory and therefore need to allow
 184 ; .cpu files to specify this (i.e. an attribute).  We could use has-attr?
 185 ; here, or we could have the code that creates the object override this
 186 ; method if the MEMORY attribute is present.
 187 ; ??? Could also use a member instead of a method.
 188
 189 (method-make! <hardware-base> 'memory? (lambda (self) #f))
 190 (define (memory? hw) (send hw 'memory?))
 191
 192 ; Return boolean indicating if hardware element is some kind of register.
 193
 194 (method-make! <hardware-base> 'register? (lambda (self) #f))
 195 (define (register? hw) (send hw 'register?))
 196
 197 ; Return boolean indicating if hardware element is an address.
 198
 199 (method-make! <hardware-base> 'address? (lambda (self) #f))
 200 (method-make! <hardware-base> 'iaddress? (lambda (self) #f))
 201 (define (address? hw) (send hw 'address?))
 202 (define (iaddress? hw) (send hw 'iaddress?))
 203 \f
 204 ; Assembler support.
 205
 206 ; Baseclass.
 207
 208 (define <hw-asm>
 209   (class-make '<hw-asm> '(<ident>)
 210               '(
 211                 ; The mode to use.
 212                 ; A copy of the object's mode if we're in the "values"
 213                 ; member.  If we're in the "indices" member this is typically
 214                 ; UINT.
 215                 mode
 216                 )
 217               nil)
 218 )
 219
 220 ; Keywords.
 221 ; Keyword lists associate a name with a number and are used for things
 222 ; like register name tables (the `indices' field of a hw spec) and
 223 ; immediate value tables (the `values' field of a hw spec).
 224 ;
 225 ; TODO: For things like the sparc fp regs, have a quasi-keyword that is
 226 ; prefix plus number.  This will save having to create a table of each
 227 ; register name.
 228
 229 (define <keyword>
 230   (class-make '<keyword> '(<hw-asm>)
 231               '(
 232                 ; Name to use in generated code, as a string.
 233                 print-name
 234
 235                 ; Prefix of each name in VALUES, as a string.
 236                 prefix
 237
 238                 ; Associative list of values.
 239                 ; Each element is (name value [attrs]).
 240                 ; ??? May wish to allow calling a function to compute the
 241                 ; value at runtime.
 242                 values
 243                 )
 244               nil)
 245 )
 246
 247 ; Accessors
 248
 249 (define kw-mode (elm-make-getter <keyword> 'mode))
 250 (define kw-print-name (elm-make-getter <keyword> 'print-name))
 251 (define kw-prefix (elm-make-getter <keyword> 'prefix))
 252 (define kw-values (elm-make-getter <keyword> 'values))
 253
 254 ; Parse a keyword spec.
 255 ;
 256 ; The syntax of VALUES is: (prefix ((name1 [value1 [(attr-list1)]]) ...))
 257 ; PREFIX is a string prefix for each name.
 258 ; Each value is a number of mode MODE.
 259 ; ??? We have no problem handling any kind of number, we're Scheme.
 260 ; However, it's not clear yet how applications will want to handle it, but
 261 ; that is left to the application.  Still, it might be preferable to impose
 262 ; some restrictions which can later be relaxed as necessary.
 263
 264 (define (-keyword-parse context name comment attrs mode print-name prefix values)
 265   ; FIXME: parse values.
 266   (let ((result (make <keyword>
 267                   (parse-name context name)
 268                   (parse-comment context comment)
 269                   (atlist-parse context attrs "")
 270                   (parse-mode-name (context-append context ": mode") mode)
 271                   (parse-string (context-append context ": print-name")
 272                                 print-name)
 273                   (parse-string (context-append context ": prefix")
 274                                 prefix)
 275                   values)))
 276     result)
 277 )
 278
 279 ; Read a keyword description
 280 ; This is the main routine for analyzing a keyword description in the .cpu
 281 ; file.
 282 ; CONTEXT is a <context> object for error messages.
 283 ; ARG-LIST is an associative list of field name and field value.
 284 ; -keyword-parse is invoked to create the <keyword> object.
 285
 286 (define (-keyword-read context . arg-list)
 287   (let (
 288         (name #f)
 289         (comment "")
 290         (attrs nil)
 291         (mode INT)
 292         (print-name #f) ;; #f indicates "not set"
 293         (prefix "")
 294         (values nil)
 295         )
 296
 297     ; Loop over each element in ARG-LIST, recording what's found.
 298     (let loop ((arg-list arg-list))
 299       (if (null? arg-list)
 300           nil
 301           (let ((arg (car arg-list))
 302                 (elm-name (caar arg-list)))
 303             (case elm-name
 304               ((name) (set! name (cadr arg)))
 305               ((comment) (set! comment (cadr arg)))
 306               ((attrs) (set! attrs (cdr arg)))
 307               ((mode) (set! mode (cadr arg)))
 308               ((print-name) (set! print-name (cadr arg)))
 309               ((prefix) (set! prefix (cadr arg)))
 310               ((values) (set! values (cdr arg)))
 311               (else (parse-error context "invalid hardware arg" arg)))
 312             (loop (cdr arg-list)))))
 313
 314     ; Now that we've identified the elements, build the object.
 315     (-keyword-parse context name comment attrs mode
 316                     (or print-name name)
 317                     prefix values))
 318 )
 319
 320 ; Define a keyword object, name/value pair list version.
 321
 322 (define define-keyword
 323   (lambda arg-list
 324     (let ((kw (apply -keyword-read (cons (make-current-context "define-keyword")
 325                                          arg-list))))
 326       (if kw
 327           (begin
 328             (current-kw-add! kw)
 329             ; Define an enum so the values are usable everywhere.
 330             ; One use is giving names to register numbers and special constants
 331             ; to make periphery C/C++ code more legible.
 332             (define-full-enum (obj:name kw) (obj:comment kw)
 333               (atlist-source-form (obj-atlist kw))
 334               (string-upcase (string-append (kw-print-name kw) "-"))
 335               (kw-values kw))))
 336       kw))
 337 )
 338 \f
 339 ; Parsing support.
 340
 341 ; List of hardware types.
 342 ; This maps names in the `type' entry of define-hardware to the class name.
 343
 344 (define -hardware-types
 345   '((register . <hw-register>)
 346     (pc . <hw-pc>)
 347     (memory . <hw-memory>)
 348     (immediate . <hw-immediate>)
 349     (address . <hw-address>)
 350     (iaddress . <hw-iaddress>))
 351 )
 352
 353 ; Parse an inline keyword spec.
 354 ; These are keywords defined inside something else.
 355 ; CONTAINER is the <ident> object of the container.
 356
 357 (define (-hw-parse-keyword context args container mode)
 358   (if (!= (length args) 2)
 359       (parse-error context "invalid keyword spec" args))
 360
 361   ; These are copied from our container object.
 362   ; They're needed to output the table.
 363   ; ??? This isn't quite right as the container may contain multiple keyword
 364   ; instances.  To be fixed in time.
 365   (-keyword-parse context (obj:name container) (obj:comment container)
 366                   ;; PRIVATE: keyword table is implicitly defined and made
 367                   ;; "static" (in the C sense).
 368                   (cons 'PRIVATE (atlist-source-form (obj-atlist container)))
 369                   mode
 370                   (obj:name container) ; print-name
 371                   (car args) ; prefix
 372                   (cadr args)) ; value
 373 )
 374
 375 ; Parse an indices spec.
 376 ; CONTAINER is the <ident> object of the container.
 377 ; Currently there is only special support for keywords.
 378 ; Otherwise MODE is used.
 379 ; The syntax is: (keyword keyword-spec) - see <keyword> for details.
 380
 381 (define (-hw-parse-indices context indices container mode)
 382   (if (null? indices)
 383       (make <hw-asm>
 384         (obj:name container) (obj:comment container) (obj-atlist container)
 385         mode)
 386       (begin
 387         (if (not (list? indices))
 388             (parse-error context "invalid indices spec" indices))
 389         (case (car indices)
 390           ((keyword) (-hw-parse-keyword context (cdr indices) container mode))
 391           ((extern-keyword) (begin
 392                               (if (null? (cdr indices))
 393                                   (parse-error context "missing keyword name"
 394                                                indices))
 395                               (let ((kw (current-kw-lookup (cadr indices))))
 396                                 (if (not kw)
 397                                     (parse-error context "unknown keyword"
 398                                                  indices))
 399                                 kw)))
 400           (else (parse-error context "unknown indices type" (car indices))))))
 401 )
 402
 403 ; Parse a values spec.
 404 ; CONTAINER is the <ident> object of the container.
 405 ; Currently there is only special support for keywords.
 406 ; Otherwise MODE is used.
 407 ; The syntax is: (keyword keyword-spec) - see <keyword> for details.
 408
 409 (define (-hw-parse-values context values container mode)
 410   (if (null? values)
 411       (make <hw-asm>
 412         (obj:name container) (obj:comment container) (obj-atlist container)
 413         mode)
 414       (begin
 415         (if (not (list? values))
 416             (parse-error context "invalid values spec" values))
 417         (case (car values)
 418           ((keyword) (-hw-parse-keyword context (cdr values) container mode))
 419           ((extern-keyword) (begin
 420                               (if (null? (cdr values))
 421                                   (parse-error context "missing keyword name"
 422                                                values))
 423                               (let ((kw (current-kw-lookup (cadr values))))
 424                                 (if (not kw)
 425                                     (parse-error context "unknown keyword"
 426                                                  values))
 427                                 kw)))
 428           (else (parse-error context "unknown values type" (car values))))))
 429 )
 430
 431 ; Parse a handlers spec.
 432 ; Each element is (name "string").
 433
 434 (define (-hw-parse-handlers context handlers)
 435   (parse-handlers context '(parse print) handlers)
 436 )
 437
 438 ; Parse a getter spec.
 439 ; The syntax is (([index]) (expression)).
 440 ; Omit `index' for scalar objects.
 441 ; Externally they're specified as `get'.  Internally we use `getter'.
 442
 443 (define (-hw-parse-getter context getter scalar?)
 444   (if (null? getter)
 445       #f ; use default
 446       (let ((valid "((index) (expression))")
 447             (scalar-valid "(() (expression))"))
 448         (if (or (not (list? getter))
 449                 (!= (length getter) 2)
 450                 (not (and (list? (car getter))
 451                           (= (length (car getter)) (if scalar? 0 1)))))
 452             (parse-error context
 453                          (string-append "invalid getter, should be "
 454                                         (if scalar? scalar-valid valid))
 455                          getter))
 456         (if (not (rtx? (cadr getter)))
 457             (parse-error context "invalid rtx expression" getter))
 458         getter))
 459 )
 460
 461 ; Parse a setter spec.
 462 ; The syntax is (([index] newval) (expression)).
 463 ; Omit `index' for scalar objects.
 464 ; Externally they're specified as `set'.  Internally we use `setter'.
 465
 466 (define (-hw-parse-setter context setter scalar?)
 467   (if (null? setter)
 468       #f ; use default
 469       (let ((valid "((index newval) (expression))")
 470             (scalar-valid "((newval) (expression))"))
 471         (if (or (not (list? setter))
 472                 (!= (length setter) 2)
 473                 (not (and (list? (car setter))
 474                           (= (length (car setter)) (if scalar? 1 2)))))
 475             (parse-error context
 476                          (string-append "invalid setter, should be "
 477                                         (if scalar? scalar-valid valid))
 478                          setter))
 479         (if (not (rtx? (cadr setter)))
 480             (parse-error context "invalid rtx expression" setter))
 481         setter))
 482 )
 483
 484 ; Parse hardware description
 485 ; This is the main routine for building a hardware object from a hardware
 486 ; description in the .cpu file.
 487 ; All arguments are in raw (non-evaluated) form.
 488 ; The result is the parsed object or #f if object isn't for selected mach(s).
 489 ;
 490 ; ??? Might want to redo to handle hardware type specific specs more cleanly.
 491 ; E.g. <hw-immediate> shouldn't have to see get/set specs.
 492
 493 (define (-hw-parse context name comment attrs semantic-name type
 494                    indices values handlers get set layout)
 495   (logit 2 "Processing hardware element " name " ...\n")
 496
 497   (if (null? type)
 498       (parse-error context "missing hardware type" name))
 499
 500   ;; Pick out name first to augment the error context.
 501   (let* ((name (parse-name context name))
 502          (context (context-append-name context name))
 503          (class-name (assq-ref -hardware-types (car type)))
 504          (atlist-obj (atlist-parse context attrs "cgen_hw")))
 505
 506     (if (not class-name)
 507         (parse-error context "unknown hardware type" type))
 508
 509     (if (keep-atlist? atlist-obj #f)
 510
 511         (let ((result (new (class-lookup class-name))))
 512           (send result 'set-name! name)
 513           (send result 'set-comment! (parse-comment context comment))
 514           (send result 'set-atlist! atlist-obj)
 515           (elm-xset! result 'sem-name semantic-name)
 516           (send result 'parse! context
 517                 (cdr type) indices values handlers get set layout)
 518           ; If this is a virtual reg, get/set specs must be provided.
 519           (if (and (obj-has-attr? result 'VIRTUAL)
 520                    (not (and (hw-getter result) (hw-setter result))))
 521               (parse-error context "virtual reg requires get/set specs" name))
 522           ; If get or set specs are specified, can't have CACHE-ADDR.
 523           (if (and (obj-has-attr? result 'CACHE-ADDR)
 524                    (or (hw-getter result) (hw-setter result)))
 525               (parse-error context "can't have CACHE-ADDR with get/set specs"
 526                            name))
 527           result)
 528
 529         (begin
 530           (logit 2 "Ignoring " name ".\n")
 531           #f)))
 532 )
 533
 534 ; Read a hardware description
 535 ; This is the main routine for analyzing a hardware description in the .cpu
 536 ; file.
 537 ; CONTEXT is a <context> object for error messages.
 538 ; ARG-LIST is an associative list of field name and field value.
 539 ; -hw-parse is invoked to create the <hardware> object.
 540
 541 (define (-hw-read context . arg-list)
 542   (let (
 543         (name nil)
 544         (comment "")
 545         (attrs nil)
 546         (semantic-name nil) ; name used in semantics, default is `name'
 547         (type nil)          ; hardware type (register, immediate, etc.)
 548         (indices nil)
 549         (values nil)
 550         (handlers nil)
 551         (get nil)
 552         (set nil)
 553         (layout nil)
 554         )
 555
 556     ; Loop over each element in ARG-LIST, recording what's found.
 557     (let loop ((arg-list arg-list))
 558       (if (null? arg-list)
 559           nil
 560           (let ((arg (car arg-list))
 561                 (elm-name (caar arg-list)))
 562             (case elm-name
 563               ((name) (set! name (cadr arg)))
 564               ((comment) (set! comment (cadr arg)))
 565               ((attrs) (set! attrs (cdr arg)))
 566               ((semantic-name) (set! semantic-name (cadr arg)))
 567               ((type) (set! type (cdr arg)))
 568               ((indices) (set! indices (cdr arg)))
 569               ((values) (set! values (cdr arg)))
 570               ((handlers) (set! handlers (cdr arg)))
 571               ((get) (set! get (cdr arg)))
 572               ((set) (set! set (cdr arg)))
 573               ((layout) (set! layout (cdr arg)))
 574               (else (parse-error context "invalid hardware arg" arg)))
 575             (loop (cdr arg-list)))))
 576
 577     ; Now that we've identified the elements, build the object.
 578     (-hw-parse context name comment attrs
 579                (if (null? semantic-name) name semantic-name)
 580                type indices values handlers get set layout))
 581 )
 582
 583 ; Define a hardware object, name/value pair list version.
 584
 585 (define define-hardware
 586   (lambda arg-list
 587     (let ((hw (apply -hw-read (cons (make-current-context "define-hardware")
 588                                     arg-list))))
 589       (if hw
 590           (current-hw-add! hw))
 591       hw))
 592 )
 593
 594 ; Define a hardware object, all arguments specified.
 595
 596 (define (define-full-hardware name comment attrs semantic-name type
 597                               indices values handlers get set layout)
 598   (let ((hw (-hw-parse (make-current-context "define-full-hardware")
 599                        name comment attrs semantic-name type
 600                        indices values handlers get set layout)))
 601     (if hw
 602         (current-hw-add! hw))
 603     hw)
 604 )
 605
 606 ; Main routine for modifying existing definitions.
 607
 608 (define modify-hardware
 609   (lambda arg-list
 610     (let ((context (make-current-context "modify-hardware")))
 611
 612       ; FIXME: Experiment.  This implements the :name/value style by
 613       ; converting it to (name value).  In the end there shouldn't be two
 614       ; styles.  People might prefer :name/value, but it's not as amenable
 615       ; to macro processing (insert potshots regarding macro usage).
 616       (if (keyword-list? (car arg-list))
 617           (set! arg-list (keyword-list->arg-list arg-list)))
 618
 619       ; First find out which element.
 620       ; There's no requirement that the name be specified first.
 621       (let ((hw-spec (assq 'name arg-list)))
 622         (if (not hw-spec)
 623             (parse-error context "hardware name not specified" arg-list))
 624
 625         (let ((hw (current-hw-lookup (arg-list-symbol-arg context hw-spec))))
 626           (if (not hw)
 627               (parse-error context "undefined hardware element" hw-spec))
 628
 629           ; Process the rest of the args now that we have the affected object.
 630           (let loop ((args arg-list))
 631             (if (null? args)
 632                 #f ; done
 633                 (let ((arg-spec (car args)))
 634                   (case (car arg-spec)
 635                     ((name) #f) ; ignore, already processed
 636                     ((add-attrs)
 637                      (let ((atlist-obj (atlist-parse context (cdr arg-spec)
 638                                                      "cgen_hw")))
 639                        ; prepend attrs so new ones override existing ones
 640                        (obj-prepend-atlist! hw atlist-obj)))
 641                     (else
 642                      (parse-error context "invalid/unsupported option"
 643                                   (car arg-spec))))
 644                   (loop (cdr args))))))))
 645
 646     *UNSPECIFIED*)
 647 )
 648
 649 ; Lookup a hardware object using its semantic name.
 650 ; The result is a list of elements with SEM-NAME.
 651 ; Callers must deal with cases where there is more than one.
 652
 653 (define (current-hw-sem-lookup sem-name)
 654   (find (lambda (hw) (eq? (hw-sem-name hw) sem-name))
 655         (current-hw-list))
 656 )
 657
 658 ; Same as current-hw-sem-lookup, but result is 1 hw element or #f if not
 659 ; found.  An error is signalled if multiple hw elements are found.
 660
 661 (define (current-hw-sem-lookup-1 sem-name)
 662   (let ((hw-objs (current-hw-sem-lookup sem-name)))
 663     (case (length hw-objs)
 664       ((0) #f)
 665       ((1) (car hw-objs))
 666       (else (error "ambiguous hardware reference" sem-name))))
 667 )
 668 \f
 669 ; Basic hardware types.
 670 ; These inherit from `hardware-base'.
 671 ; ??? Might wish to allow each target to add more, but we provide enough
 672 ; examples to cover most cpus.
 673
 674 ; A register (or an array of them).
 675
 676 (define <hw-register> (class-make '<hw-register> '(<hardware-base>) nil nil))
 677
 678 ; Subroutine of -hw-create-[gs]etter-from-layout to validate a layout.
 679 ; Valid values:
 680 ; - 0 or 1
 681 ; - (value length)
 682 ; - hardware-name
 683
 684 (define (-hw-validate-layout context layout width)
 685   (if (not (list? layout))
 686       (parse-error context "layout is not a list" layout))
 687
 688   (let loop ((layout layout) (shift 0))
 689     (if (null? layout)
 690         (begin
 691           ; Done.  Now see if number of bits in layout matches total width.
 692           (if (not (= shift width))
 693               (parse-error context (string-append
 694                                     "insufficient number of bits (need "
 695                                     (number->string width)
 696                                     ")")
 697                            shift)))
 698         ; Validate next entry.
 699         (let ((val (car layout)))
 700           (cond ((number? val)
 701                  (if (not (memq val '(0 1)))
 702                      (parse-error context
 703                                   "non 0/1 layout entry requires length"
 704                                   val))
 705                  (loop (cdr layout) (1+ shift)))
 706                 ((pair? val)
 707                  (if (or (not (number? (car val)))
 708                          (not (pair? (cdr val)))
 709                          (not (number? (cadr val)))
 710                          (not (null? (cddr val))))
 711                      (parse-error context
 712                                   "syntax error in layout, expecting `(value length)'"
 713                                   val))
 714                  (loop (cdr layout) (+ shift (cadr val))))
 715                 ((symbol? val)
 716                  (let ((hw (current-hw-lookup val)))
 717                    (if (not hw)
 718                        (parse-error context "unknown hardware element" val))
 719                    (if (not (hw-scalar? hw))
 720                        (parse-error context "non-scalar hardware element" val))
 721                    (loop (cdr layout)
 722                          (+ shift (hw-bits hw)))))
 723                 (else
 724                  (parse-error context "bad layout element" val))))))
 725
 726   *UNSPECIFIED*
 727 )
 728
 729 ; Return the getter spec to use for LAYOUT.
 730 ; WIDTH is the width of the combined value in bits.
 731 ;
 732 ; Example:
 733 ; Assuming h-hw[123] are 1 bit registers, and width is 32
 734 ; given ((0 29) h-hw1 h-hw2 h-hw3), return
 735 ; (()
 736 ;  (or SI (sll SI (zext SI (reg h-hw1)) 2)
 737 ;      (or SI (sll SI (zext SI (reg h-hw2)) 1)
 738 ;          (zext SI (reg h-hw3)))))
 739
 740 (define (-hw-create-getter-from-layout context layout width)
 741   (let ((add-to-res (lambda (result mode-name val shift)
 742                       (if (null? result)
 743                           (rtx-make 'sll mode-name val shift)
 744                           (rtx-make 'or mode-name
 745                                     (rtx-make 'sll mode-name
 746                                               (rtx-make 'zext mode-name val)
 747                                               shift)
 748                                     result))))
 749         (mode-name (obj:name (mode-find width 'UINT))))
 750     (let loop ((result nil) (layout (reverse layout)) (shift 0))
 751       (if (null? layout)
 752           (list nil result) ; getter spec: (get () (expression))
 753           (let ((val (car layout)))
 754             (cond ((number? val)
 755                    ; ignore if zero
 756                    (if (= val 0)
 757                        (loop result (cdr layout) (1+ shift))
 758                        (loop (add-to-res result mode-name val shift)
 759                              (cdr layout)
 760                              (1+ shift))))
 761                   ((pair? val)
 762                    ; ignore if zero
 763                    (if (= (car val) 0)
 764                        (loop result (cdr layout) (+ shift (cadr val)))
 765                        (loop (add-to-res result mode-name (car val) shift)
 766                              (cdr layout)
 767                              (+ shift (cadr val)))))
 768                   ((symbol? val)
 769                    (let ((hw (current-hw-lookup val)))
 770                      (loop (add-to-res result mode-name
 771                                        (rtx-make 'reg val)
 772                                        shift)
 773                            (cdr layout)
 774                            (+ shift (hw-bits hw)))))
 775                   (else
 776                    (assert (begin "bad layout element" #f))))))))
 777 )
 778
 779 ; Return the setter spec to use for LAYOUT.
 780 ; WIDTH is the width of the combined value in bits.
 781 ;
 782 ; Example:
 783 ; Assuming h-hw[123] are 1 bit registers,
 784 ; given (h-hw1 h-hw2 h-hw3), return
 785 ; ((val)
 786 ;  (sequence ()
 787 ;            (set (reg h-hw1) (and (srl val 2) 1))
 788 ;            (set (reg h-hw2) (and (srl val 1) 1))
 789 ;            (set (reg h-hw3) (and (srl val 0) 1))
 790 ;            ))
 791
 792 (define (-hw-create-setter-from-layout context layout width)
 793   (let ((mode-name (obj:name (mode-find width 'UINT))))
 794     (let loop ((sets nil) (layout (reverse layout)) (shift 0))
 795       (if (null? layout)
 796           (list '(val) ; setter spec: (set (val) (expression))
 797                 (apply rtx-make (cons 'sequence (cons nil sets))))
 798           (let ((val (car layout)))
 799             (cond ((number? val)
 800                    (loop sets (cdr layout) (1+ shift)))
 801                   ((pair? val)
 802                    (loop sets (cdr layout) (+ shift (cadr val))))
 803                   ((symbol? val)
 804                    (let ((hw (current-hw-lookup val)))
 805                      (loop (cons (rtx-make 'set
 806                                            (rtx-make 'reg val)
 807                                            (rtx-make 'and
 808                                                      (rtx-make 'srl 'val shift)
 809                                                      (1- (logsll 1 (hw-bits hw)))))
 810                                  sets)
 811                            (cdr layout)
 812                            (+ shift (hw-bits hw)))))
 813                   (else
 814                    (assert (begin "bad layout element" #f))))))))
 815 )
 816
 817 ; Parse a register spec.
 818 ; .cpu syntax: (register mode [(dimension)])
 819 ;          or: (register (mode bits) [(dimension)])
 820
 821 (method-make!
 822  <hw-register> 'parse!
 823  (lambda (self context type indices values handlers getter setter layout)
 824    (if (or (null? type)
 825            (> (length type) 2))
 826        (parse-error context "invalid register spec" type))
 827    (if (and (= (length type) 2)
 828             (or (not (list? (cadr type)))
 829                 (> (length (cadr type)) 1)))
 830        (parse-error context "bad register dimension spec" type))
 831
 832    ; Must parse and set type before analyzing LAYOUT.
 833    (elm-set! self 'type (parse-type context type))
 834
 835    ; LAYOUT is a shorthand way of specifying getter/setter specs.
 836    ; For registers that are just a collection of other registers
 837    ; (e.g. the status register in mips), it's easier to specify the
 838    ; registers that make up the bigger register, rather than to specify
 839    ; get/set specs.
 840    ; We don't override any provided get/set specs though.
 841    (if (not (null? layout))
 842        (let ((width (hw-bits self)))
 843          (-hw-validate-layout context layout width)
 844          (if (null? getter)
 845              (set! getter
 846                    (-hw-create-getter-from-layout context layout width)))
 847          (if (null? setter)
 848              (set! setter
 849                    (-hw-create-setter-from-layout context layout width)))
 850          ))
 851
 852    (elm-set! self 'indices (-hw-parse-indices context indices self UINT))
 853    (elm-set! self 'values (-hw-parse-values context values self
 854                                             (send (elm-get self 'type)
 855                                                   'get-mode)))
 856    (elm-set! self 'handlers (-hw-parse-handlers context handlers))
 857    (elm-set! self 'get (-hw-parse-getter context getter (hw-scalar? self)))
 858    (elm-set! self 'set (-hw-parse-setter context setter (hw-scalar? self)))
 859    *UNSPECIFIED*)
 860 )
 861
 862 ; Return boolean indicating if hardware element is some kind of register.
 863
 864 (method-make! <hw-register> 'register? (lambda (self) #t))
 865
 866 ; Return a boolean indicating if it's ok to reference SELF in mode
 867 ; NEW-MODE-NAME, index INDEX.
 868 ;
 869 ; ??? INDEX isn't currently used.  The intent is to use it if it's a known
 870 ; value, and otherwise assume for our purposes it's valid and leave any
 871 ; further error checking to elsewhere.
 872 ;
 873 ; ??? This method makes more sense if we support multiple modes via
 874 ; getters/setters.  Maybe we will some day, so this is left as is for now.
 875
 876 (method-make!
 877  <hw-register> 'mode-ok?
 878  (lambda (self new-mode-name index)
 879    (let ((cur-mode (send self 'get-mode))
 880          (new-mode (mode:lookup new-mode-name)))
 881      (if (mode:eq? new-mode-name cur-mode)
 882          #t
 883          ; ??? Subject to revisiting.
 884          ; Only allow floats if same mode (which is handled above).
 885          ; Only allow non-widening if ints.
 886          ; On architectures where shortening/widening can refer to a
 887          ; quasi-different register, it is up to the target to handle this.
 888          ; See the comments for the getter/setter/getters/setters class
 889          ; members.
 890          (let ((cur-mode-class (mode:class cur-mode))
 891                (cur-bits (mode:bits cur-mode))
 892                (new-mode-class (mode:class new-mode))
 893                (new-bits (mode:bits new-mode)))
 894            ; Compensate for registers defined with an unsigned mode.
 895            (if (eq? cur-mode-class 'UINT)
 896                (set! cur-mode-class 'INT))
 897            (if (eq? new-mode-class 'UINT)
 898                (set! new-mode-class 'INT))
 899            (if (eq? cur-mode-class 'INT)
 900                (and (eq? new-mode-class cur-mode-class)
 901                     (<= new-bits cur-bits))
 902                #f)))))
 903 )
 904
 905 ; Return mode to use for the index or #f if scalar.
 906
 907 (method-make!
 908  <hw-register> 'get-index-mode
 909  (lambda (self)
 910    (if (scalar? (hw-type self))
 911        #f
 912        UINT))
 913 )
 914
 915 ; The program counter (PC) hardware register.
 916 ; This is a separate class as the simulator needs a place to put special
 917 ; get/set methods.
 918
 919 (define <hw-pc> (class-make '<hw-pc> '(<hw-register>) nil nil))
 920
 921 ; Parse a pc spec.
 922
 923 (method-make!
 924  <hw-pc> 'parse!
 925  (lambda (self context type indices values handlers getter setter layout)
 926    (if (not (null? type))
 927        (elm-set! self 'type (parse-type context type))
 928        (elm-set! self 'type (make <scalar> (mode:lookup 'IAI))))
 929    (if (not (null? indices))
 930        (parse-error context "indices specified for pc" indices))
 931    (if (not (null? values))
 932        (parse-error context "values specified for pc" values))
 933    (if (not (null? layout))
 934        (parse-error context "layout specified for pc" values))
 935    ; The initial value of INDICES, VALUES is #f which is what we want.
 936    (elm-set! self 'handlers (-hw-parse-handlers context handlers))
 937    (elm-set! self 'get (-hw-parse-getter context getter (hw-scalar? self)))
 938    (elm-set! self 'set (-hw-parse-setter context setter (hw-scalar? self)))
 939    *UNSPECIFIED*)
 940 )
 941
 942 ; Indicate we're the pc.
 943
 944 (method-make! <hw-pc> 'pc? (lambda (self) #t))
 945
 946 ; Memory.
 947
 948 (define <hw-memory> (class-make '<hw-memory> '(<hardware-base>) nil nil))
 949
 950 ; Parse a memory spec.
 951 ; .cpu syntax: (memory mode [(dimension)])
 952 ;          or: (memory (mode bits) [(dimension)])
 953
 954 (method-make!
 955  <hw-memory> 'parse!
 956  (lambda (self context type indices values handlers getter setter layout)
 957    (if (or (null? type)
 958            (> (length type) 2))
 959        (parse-error context "invalid memory spec" type))
 960    (if (and (= (length type) 2)
 961             (or (not (list? (cadr type)))
 962                 (> (length (cadr type)) 1)))
 963        (parse-error context "bad memory dimension spec" type))
 964    (if (not (null? layout))
 965        (parse-error context "layout specified for memory" values))
 966    (elm-set! self 'type (parse-type context type))
 967    ; Setting INDICES,VALUES here is mostly for experimentation at present.
 968    (elm-set! self 'indices (-hw-parse-indices context indices self AI))
 969    (elm-set! self 'values (-hw-parse-values context values self
 970                                             (send (elm-get self 'type)
 971                                                   'get-mode)))
 972    (elm-set! self 'handlers (-hw-parse-handlers context handlers))
 973    (elm-set! self 'get (-hw-parse-getter context getter (hw-scalar? self)))
 974    (elm-set! self 'set (-hw-parse-setter context setter (hw-scalar? self)))
 975    *UNSPECIFIED*)
 976 )
 977
 978 ; Return boolean indicating if hardware element is some kind of memory.
 979
 980 (method-make! <hw-memory> 'memory? (lambda (self) #t))
 981
 982 ; Return a boolean indicating if it's ok to reference SELF in mode
 983 ; NEW-MODE-NAME, index INDEX.
 984
 985 (method-make!
 986  <hw-memory> 'mode-ok?
 987  (lambda (self new-mode-name index)
 988    ; Allow any mode for now.
 989    #t)
 990 )
 991
 992 ; Return mode to use for the index or #f if scalar.
 993
 994 (method-make!
 995  <hw-memory> 'get-index-mode
 996  (lambda (self)
 997    AI)
 998 )
 999
1000 ; Immediate values (numbers recorded in the insn).
1001
1002 (define <hw-immediate> (class-make '<hw-immediate> '(<hardware-base>) nil nil))
1003
1004 ; Parse an immediate spec.
1005 ; .cpu syntax: (immediate mode)
1006 ;          or: (immediate (mode bits))
1007
1008 (method-make!
1009  <hw-immediate> 'parse!
1010  (lambda (self context type indices values handlers getter setter layout)
1011    (if (not (= (length type) 1))
1012        (parse-error context "invalid immediate spec" type))
1013    (elm-set! self 'type (parse-type context type))
1014    ; An array of immediates may be useful some day, but not yet.
1015    (if (not (null? indices))
1016        (parse-error context "indices specified for immediate" indices))
1017    (if (not (null? layout))
1018        (parse-error context "layout specified for immediate" values))
1019    (elm-set! self 'values (-hw-parse-values context values self
1020                                             (send (elm-get self 'type)
1021                                                   'get-mode)))
1022    (elm-set! self 'handlers (-hw-parse-handlers context handlers))
1023    (if (not (null? getter))
1024        (parse-error context "getter specified for immediate" getter))
1025    (if (not (null? setter))
1026        (parse-error context "setter specified for immediate" setter))
1027    *UNSPECIFIED*)
1028 )
1029
1030 ; Return a boolean indicating if it's ok to reference SELF in mode
1031 ; NEW-MODE-NAME, index INDEX.
1032
1033 (method-make!
1034  <hw-immediate> 'mode-ok?
1035  (lambda (self new-mode-name index)
1036    (let ((cur-mode (send self 'get-mode))
1037          (new-mode (mode:lookup new-mode-name)))
1038      (if (mode:eq? new-mode-name cur-mode)
1039          #t
1040          ; ??? Subject to revisiting.
1041          ; Only allow floats if same mode (which is handled above).
1042          ; For ints allow anything.
1043          (let ((cur-mode-class (mode:class cur-mode))
1044                (new-mode-class (mode:class new-mode)))
1045            (->bool (and (memq cur-mode-class '(INT UINT))
1046                         (memq new-mode-class '(INT UINT))))))))
1047 )
1048
1049 ; These are scalars.
1050
1051 (method-make!
1052  <hw-immediate> 'get-index-mode
1053  (lambda (self) #f)
1054 )
1055
1056 ; Addresses.
1057 ; These are usually symbols.
1058
1059 (define <hw-address> (class-make '<hw-address> '(<hardware-base>) nil nil))
1060
1061 (method-make! <hw-address> 'address? (lambda (self) #t))
1062
1063 ; Parse an address spec.
1064
1065 (method-make!
1066  <hw-address> 'parse!
1067  (lambda (self context type indices values handlers getter setter layout)
1068    (if (not (null? type))
1069        (parse-error context "invalid address spec" type))
1070    (elm-set! self 'type (make <scalar> AI))
1071    (if (not (null? indices))
1072        (parse-error context "indices specified for address" indices))
1073    (if (not (null? values))
1074        (parse-error context "values specified for address" values))
1075    (if (not (null? layout))
1076        (parse-error context "layout specified for address" values))
1077    (elm-set! self 'values (-hw-parse-values context values self
1078                                             (send (elm-get self 'type)
1079                                                   'get-mode)))
1080    (elm-set! self 'handlers (-hw-parse-handlers context handlers))
1081    (if (not (null? getter))
1082        (parse-error context "getter specified for address" getter))
1083    (if (not (null? setter))
1084        (parse-error context "setter specified for address" setter))
1085    *UNSPECIFIED*)
1086 )
1087
1088 ; Return a boolean indicating if it's ok to reference SELF in mode
1089 ; NEW-MODE-NAME, index INDEX.
1090
1091 (method-make!
1092  <hw-address> 'mode-ok?
1093  (lambda (self new-mode-name index)
1094    ; We currently don't allow referencing an address in any mode other than
1095    ; the original mode.
1096    (mode-compatible? 'samesize new-mode-name (send self 'get-mode)))
1097 )
1098
1099 ; Instruction addresses.
1100 ; These are treated separately from normal addresses as the simulator
1101 ; may wish to treat them specially.
1102 ; FIXME: Doesn't use mode IAI.
1103
1104 (define <hw-iaddress> (class-make '<hw-iaddress> '(<hw-address>) nil nil))
1105
1106 (method-make! <hw-iaddress> 'iaddress? (lambda (self) #t))
1107 \f
1108 ; Misc. random hardware support.
1109
1110 ; Map a mode to a hardware object that can contain immediate values of that
1111 ; mode.
1112
1113 (define (hardware-for-mode mode)
1114   (cond ((mode:eq? mode 'AI) h-addr)
1115         ((mode:eq? mode 'IAI) h-iaddr)
1116         ((mode-signed? mode) h-sint)
1117         ((mode-unsigned? mode) h-uint)
1118         (else (error "Don't know h-object for mode " mode)))
1119 )
1120
1121 ; Called when a cpu-family is read in to set the word sizes.
1122 ; Must be called after mode-set-word-modes! has been called.
1123
1124 (define (hw-update-word-modes!)
1125   (elm-xset! h-addr 'type (make <scalar> (mode:lookup 'AI)))
1126   (elm-xset! h-iaddr 'type (make <scalar> (mode:lookup 'IAI)))
1127 )
1128 \f
1129 ; Builtins, attributes, init/fini support.
1130
1131 (define h-memory #f)
1132 (define h-sint #f)
1133 (define h-uint #f)
1134 (define h-addr #f)
1135 (define h-iaddr #f)
1136
1137 ; Called before reading a .cpu file in.
1138
1139 (define (hardware-init!)
1140   (reader-add-command! 'define-keyword
1141                        "\
1142 Define a keyword, name/value pair list version.
1143 "
1144                        nil 'arg-list define-keyword)
1145   (reader-add-command! 'define-hardware
1146                        "\
1147 Define a hardware element, name/value pair list version.
1148 "
1149                        nil 'arg-list define-hardware)
1150   (reader-add-command! 'define-full-hardware
1151                        "\
1152 Define a hardware element, all arguments specified.
1153 "
1154                        nil '(name comment attrs semantic-name type
1155                                   indices values handlers get set layout)
1156                        define-full-hardware)
1157   (reader-add-command! 'modify-hardware
1158                        "\
1159 Modify a hardware element, name/value pair list version.
1160 "
1161                        nil 'arg-list modify-hardware)
1162
1163   *UNSPECIFIED*
1164 )
1165
1166 ; Install builtin hardware objects.
1167
1168 (define (hardware-builtin!)
1169   ; Standard h/w attributes.
1170   (define-attr '(for hardware) '(type boolean) '(name CACHE-ADDR)
1171     '(comment "cache register address during insn extraction"))
1172   ; FIXME: This should be deletable.
1173   (define-attr '(for hardware) '(type boolean) '(name PC)
1174     '(comment "the program counter"))
1175   (define-attr '(for hardware) '(type boolean) '(name PROFILE)
1176     '(comment "collect profiling data"))
1177
1178   (let ((all (all-isas-attr-value)))
1179     ; ??? The program counter, h-pc, used to be defined here.
1180     ; However, some targets need to modify it (e.g. provide special get/set
1181     ; specs).  There's still an outstanding issue of how to add things to
1182     ; objects after the fact (e.g. model parameters to instructions), but
1183     ; that's further down the road.
1184     (set! h-memory (define-full-hardware 'h-memory "memory"
1185                      `((ISA ,all))
1186                      ; Ensure memory not flagged as a scalar.
1187                      'h-memory '(memory UQI (1)) nil nil nil
1188                      nil nil nil))
1189     (set! h-sint (define-full-hardware 'h-sint "signed integer"
1190                    `((ISA ,all))
1191                    'h-sint '(immediate (INT 32)) nil nil nil
1192                    nil nil nil))
1193     (set! h-uint (define-full-hardware 'h-uint "unsigned integer"
1194                    `((ISA ,all))
1195                    'h-uint '(immediate (UINT 32)) nil nil nil
1196                    nil nil nil))
1197     (set! h-addr (define-full-hardware 'h-addr "address"
1198                    `((ISA ,all))
1199                    'h-addr '(address) nil nil '((print "print_address"))
1200                    nil nil nil))
1201     ; Instruction addresses.
1202     ; These are different because the simulator may want to do something
1203     ; special with them, and some architectures treat them differently.
1204     (set! h-iaddr (define-full-hardware 'h-iaddr "instruction address"
1205                     `((ISA ,all))
1206                     'h-iaddr '(iaddress) nil nil '((print "print_address"))
1207                     nil nil nil)))
1208
1209   *UNSPECIFIED*
1210 )
1211
1212 ; Called after a .cpu file has been read in.
1213
1214 (define (hardware-finish!)
1215   *UNSPECIFIED*
1216 )