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