cgen/sid.scm

   1 ; Simulator generator support routines.
   2 ; Copyright (C) 2000-2005 Red Hat, Inc.
   3 ; This file is part of CGEN.
   4
   5 ; One goal of this file is to provide cover functions for all methods.
   6 ; i.e. this file fills in the missing pieces of the interface between
   7 ; the application independent part of CGEN (i.e. the code loaded by read.scm)
   8 ; and the application dependent part (i.e. sim-*.scm).
   9 ; `send' is not intended to appear in sim-*.scm.
  10 ; [It still does but that's to be fixed.]
  11
  12 ; Specify which application.
  13 (set! APPLICATION 'SID-SIMULATOR)
  14
  15 ; Misc. state info.
  16
  17 ; Currently supported options:
  18 ; with-scache
  19 ;       generate code to use the scache engine
  20 ; with-pbb
  21 ;       generate code to use the pbb engine
  22 ; with-sem-frags
  23 ;       generate semantic fragment engine (requires with-pbb)
  24 ; with-profile fn|sw
  25 ;       generate code to do profiling in the semantic function
  26 ;       code (fn) or in the semantic switch (sw)
  27 ; with-multiple-isa
  28 ;       enable multiple-isa support (e.g. arm+thumb)
  29 ;       ??? wip.
  30 ; copyright fsf|redhat
  31 ;       emit an FSF or Red Hat copyright (temporary, pending decision)
  32 ; package gnusim|cygsim
  33 ;       indicate the software package
  34
  35 ; #t if the scache is being used
  36 (define -with-scache? #f)
  37 (define (with-scache?) -with-scache?)
  38
  39 ; #t if we're generating profiling code
  40 ; Each of the function and switch semantic code can have profiling.
  41 ; The options as passed are stored in -with-profile-{fn,sw}?, and
  42 ; -with-profile? is set at code generation time.
  43 (define -with-profile-fn? #f)
  44 (define -with-profile-sw? #f)
  45 (define -with-profile? #f)
  46 (define (with-profile?) -with-profile?)
  47 (define (with-any-profile?) (or -with-profile-fn? -with-profile-sw?))
  48
  49 ; #t if multiple isa support is enabled
  50 (define -with-multiple-isa? #f)
  51 (define (with-multiple-isa?) -with-multiple-isa?)
  52
  53 ; #t if semantics are generated as pbb computed-goto engine
  54 (define -with-pbb? #f)
  55 (define (with-pbb?) -with-pbb?)
  56
  57 ; #t if the semantic fragment engine is to be used.
  58 ; This involves combining common fragments of each insn into one.
  59 (define -with-sem-frags? #f)
  60 (define (with-sem-frags?) -with-sem-frags?)
  61
  62 ; String containing copyright text.
  63 (define CURRENT-COPYRIGHT #f)
  64
  65 ; String containing text defining the package we're generating code for.
  66 (define CURRENT-PACKAGE #f)
  67
  68 ; Initialize the options.
  69
  70 (define (option-init!)
  71   (set! -with-scache? #f)
  72   (set! -with-pbb? #f)
  73   (set! -with-sem-frags? #f)
  74   (set! -with-profile-fn? #f)
  75   (set! -with-profile-sw? #f)
  76   (set! -with-multiple-isa? #f)
  77   (set! CURRENT-COPYRIGHT copyright-fsf)
  78   (set! CURRENT-PACKAGE package-gnu-simulators)
  79   *UNSPECIFIED*
  80 )
  81
  82 ; Handle an option passed in from the command line.
  83
  84 (define (option-set! name value)
  85   (case name
  86     ((with-scache) (set! -with-scache? #t))
  87     ((with-pbb) (set! -with-pbb? #t))
  88     ((with-sem-frags) (set! -with-sem-frags? #t))
  89     ((with-profile) (cond ((equal? value '("fn"))
  90                            (set! -with-profile-fn? #t))
  91                           ((equal? value '("sw"))
  92                            (set! -with-profile-sw? #t))
  93                           (else (error "invalid with-profile value" value))))
  94     ((with-multiple-isa) (set! -with-multiple-isa? #t))
  95     ((copyright) (cond ((equal?  value '("fsf"))
  96                         (set! CURRENT-COPYRIGHT copyright-fsf))
  97                        ((equal? value '("redhat"))
  98                         (set! CURRENT-COPYRIGHT copyright-red-hat))
  99                        (else (error "invalid copyright value" value))))
 100     ((package) (cond ((equal?  value '("gnusim"))
 101                       (set! CURRENT-PACKAGE package-gnu-simulators))
 102                      ((equal? value '("cygsim"))
 103                       (set! CURRENT-PACKAGE package-red-hat-simulators))
 104                      (else (error "invalid package value" value))))
 105     (else (error "unknown option" name))
 106     )
 107   *UNSPECIFIED*
 108 )
 109
 110 ; #t if we're currently generating a pbb engine.
 111 (define -current-pbb-engine? #f)
 112 (define (current-pbb-engine?) -current-pbb-engine?)
 113 (define (set-current-pbb-engine?! flag) (set! -current-pbb-engine? flag))
 114
 115 ; #t if the cpu can execute insns parallely.
 116 ; This one isn't passed on the command line, but we follow the convention
 117 ; of prefixing these things with `with-'.
 118 ; While processing operand reading (or writing), parallel execution support
 119 ; needs to be turned off, so it is up to the appropriate cgen-foo.c proc to
 120 ; set-with-parallel?! appropriately.
 121 (define -with-parallel? #f)
 122 (define (with-parallel?) -with-parallel?)
 123 (define (set-with-parallel?! flag) (set! -with-parallel? flag))
 124
 125 ; Kind of parallel support.
 126 ; If 'read, read pre-processing is done.
 127 ; If 'write, write post-processing is done.
 128 ; ??? At present we always use write post-processing, though the previous
 129 ; version used read pre-processing.  Not sure supporting both is useful
 130 ; in the long run.
 131 (define -with-parallel-kind 'write)
 132 ; #t if parallel support is provided by read pre-processing.
 133 (define (with-parallel-read?)
 134   (and -with-parallel? (eq? -with-parallel-kind 'read))
 135 )
 136 ; #t if parallel support is provided by write post-processing.
 137 (define (with-parallel-write?)
 138   (and -with-parallel? (eq? -with-parallel-kind 'write))
 139 )
 140 \f
 141 ; Cover functions for various methods.
 142
 143 ; Return the C type of something.  This isn't always a mode.
 144
 145 (define (gen-type self) (send self 'gen-type))
 146
 147 ; Return the C type of an index's value or #f if not needed (scalar).
 148
 149 (define (gen-index-type op sfmt)
 150   (let ((index-mode (send op 'get-index-mode)))
 151     (if index-mode
 152         (mode:c-type index-mode)
 153         #f))
 154 )
 155 \f
 156 ; Misc. utilities.
 157
 158 ; Return reference to hardware element SYM.
 159 ; ISAS is a list of <isa> objects.
 160 ; The idea is that in multiple isa architectures (e.g. arm) the elements
 161 ; common to all isas are kept in one class and the elements specific to each
 162 ; isa are kept in separate classes.
 163
 164 (define (gen-cpu-ref isas sym)
 165   (if (and (with-multiple-isa?)
 166            (= (length isas) 1))
 167       (string-append "current_cpu->@cpu@_hardware." sym)
 168       (string-append "current_cpu->hardware." sym))
 169 )
 170 \f
 171 ; Attribute support.
 172
 173 ; Return the C++ type to use to hold a value for attribute ATTR.
 174
 175 (define (gen-attr-type attr)
 176   (case (attr-kind attr)
 177     ((boolean) "int")
 178     ((bitset)  "unsigned int")
 179     ((integer) "int")
 180     ((enum)    (string-append "enum " (string-downcase (gen-sym attr)) "_attr"))
 181     )
 182 )
 183
 184 ; Return C code to fetch a value from instruction memory.
 185 ; PC-VAR is the C expression containing the address of the start of the
 186 ; instruction.
 187 ;
 188 ; We don't bother trying to handle bitsizes that don't have a
 189 ; corresponding GETIMEM method.  Doing so would require us to take
 190 ; endianness into account just to ensure that the requested bits end
 191 ; up at the proper place in the result.  It's easier just to make the
 192 ; caller ask us for something we can do directly.
 193 ;
 194 ; ??? Aligned/unaligned support?
 195
 196 (define (gen-ifetch pc-var bitoffset bitsize)
 197   (string-append "current_cpu->GETIMEM"
 198                  (case bitsize
 199                    ((8) "UQI")
 200                    ((16) "UHI")
 201                    ((32) "USI")
 202                    (else (error "bad bitsize argument to gen-ifetch" bitsize)))
 203                  " (pc, "
 204                  pc-var " + " (number->string (quotient bitoffset 8))
 205                  ")")
 206 )
 207
 208 ; Return definition of an object's attributes.
 209 ; This is like gen-obj-attr-defn, except split for sid.
 210 ; TYPE is one of 'ifld, 'hw, 'operand, 'insn.
 211 ; [Only 'insn is currently needed.]
 212 ; ALL-ATTRS is an ordered alist of all attributes.
 213 ; "ordered" means all the non-boolean attributes are at the front and
 214 ; duplicate entries have been removed.
 215
 216 (define (gen-obj-attr-sid-defn type obj all-attrs)
 217   (let* ((attrs (obj-atlist obj))
 218          (non-bools (attr-non-bool-attrs (atlist-attrs attrs)))
 219          (all-non-bools (list-take (attr-count-non-bools all-attrs) all-attrs))
 220          )
 221     (string-append
 222      "{ "
 223      (gen-bool-attrs attrs gen-attr-mask)
 224      ","
 225      (if (null? all-non-bools)
 226          " 0"
 227          (string-drop1 ; drop the leading ","
 228           (string-map (lambda (attr)
 229                         (let ((val (or (assq-ref non-bools (obj:name attr))
 230                                        (attr-default attr))))
 231                           ; FIXME: Are we missing attr-prefix here?
 232                           (string-append ", "
 233                                          (send attr 'gen-value-for-defn-raw val))))
 234                       all-non-bools)))
 235      " }"))
 236 )
 237 \f
 238 ; Instruction field support code.
 239
 240 ; Return a <c-expr> object of the value of an ifield.
 241
 242 (define (-cxmake-ifld-val mode f)
 243   (if (with-scache?)
 244       ; ??? Perhaps a better way would be to defer evaluating the src of a
 245       ; set until the method processing the dest.
 246       (cx:make-with-atlist mode (gen-ifld-argbuf-ref f)
 247                            (atlist-make "" (bool-attr-make 'CACHED #t)))
 248       (cx:make mode (gen-extracted-ifld-value f)))
 249 )
 250 \f
 251 ; Type system.
 252
 253 ; Methods:
 254 ; gen-type - return C code representing the type
 255 ; gen-sym-decl - generate decl using the provided symbol
 256 ; gen-sym-get-macro - generate GET macro for accessing CPU elements
 257 ; gen-sym-set-macro - generate SET macro for accessing CPU elements
 258
 259 ; Scalar type
 260
 261 (method-make!
 262  <scalar> 'gen-type
 263  (lambda (self) (mode:c-type (elm-get self 'mode)))
 264 )
 265
 266 (method-make!
 267  <scalar> 'gen-sym-decl
 268  (lambda (self sym comment)
 269    (string-append
 270     "  /* " comment " */\n"
 271     "  " (send self 'gen-type) " "
 272     (gen-c-symbol sym) ";\n"))
 273 )
 274
 275 (method-make! <scalar> 'gen-ref (lambda (self sym index estate) sym))
 276
 277 ; Array type
 278
 279 (method-make!
 280  <array> 'gen-type
 281  (lambda (self) (mode:c-type (elm-get self 'mode)))
 282 )
 283
 284 (method-make!
 285  <array> 'gen-sym-decl
 286  (lambda (self sym comment)
 287    (string-append
 288     "  /* " comment " */\n"
 289     "  " (send self 'gen-type) " "
 290     (gen-c-symbol sym)
 291     (gen-array-ref (elm-get self 'dimensions))
 292     ";\n")
 293    )
 294 )
 295
 296 ; Return a reference to the array.
 297 ; SYM is the name of the array.
 298 ; INDEX is either a single index object or a (possibly empty) list of objects,
 299 ; one object per dimension.
 300
 301 (method-make!
 302  <array> 'gen-ref
 303  (lambda (self sym index estate)
 304    (let ((gen-index1 (lambda (idx)
 305                        (string-append "["
 306                                       (-gen-hw-index idx estate)
 307                                       "]"))))
 308      (string-append sym
 309                     (cond ((list? index) (string-map gen-index1 index))
 310                           (else (gen-index1 index))))))
 311 )
 312
 313 ; Integers
 314 ;
 315 ;(method-make!
 316 ; <integer> 'gen-type
 317 ; (lambda (self)
 318 ;   (mode:c-type (mode-find (elm-get self 'bits)
 319 ;                          (if (has-attr? self 'UNSIGNED)
 320 ;                              'UINT 'INT)))
 321 ;   )
 322 ;)
 323 ;
 324 ;(method-make! <integer> 'gen-sym-decl (lambda (self sym comment) ""))
 325 ;(method-make! <integer> 'gen-sym-get-macro (lambda (self sym comment) ""))
 326 ;(method-make! <integer> 'gen-sym-set-macro (lambda (self sym comment) ""))
 327 \f
 328 ; Hardware descriptions support code.
 329 ;
 330 ; Various operations are required for each h/w object to support the various
 331 ; things the simulator will want to do with it.
 332 ;
 333 ; Methods:
 334 ; gen-decl
 335 ; gen-write     - Same as gen-read except done on output operands
 336 ; cxmake-get    - Return a <c-expr> object to fetch the value.
 337 ; gen-set-quiet - Set the value.
 338 ;                 ??? Could just call this gen-set as there is no gen-set-trace
 339 ;                 but for consistency with the messages passed to operands
 340 ;                 we use this same.
 341 ; gen-type      - C type to use to record value.
 342 ;                 ??? Delete and just use get-mode?
 343 ; save-index?   - return #t if an index needs to be saved for parallel
 344 ;                 execution post-write processing
 345 ; gen-profile-decl
 346 ; gen-record-profile
 347 ; get-mode
 348 ; gen-profile-locals
 349 ; gen-sym-decl  - Return a C declaration using the provided symbol.
 350 ; gen-sym-get-macro - Generate default GET access macro.
 351 ; gen-sym-set-macro - Generate default SET access macro.
 352 ; gen-ref       - Return a C reference to the object.
 353
 354 ; Generate CPU state struct entries.
 355
 356 (method-make!
 357  <hardware-base> 'gen-decl
 358  (lambda (self)
 359    (send self 'gen-sym-decl (obj:name self) (obj:comment self)))
 360 )
 361
 362 (method-make-virtual! <hardware-base> 'gen-sym-decl (lambda (self sym comment) ""))
 363
 364 ; Return a C reference to a hardware object.
 365
 366 (method-make! <hardware-base> 'gen-ref (lambda (self sym index estate) sym))
 367
 368 ; Each hardware type must provide its own gen-write method.
 369
 370 (method-make!
 371  <hardware-base> 'gen-write
 372  (lambda (self estate index mode sfmt op access-macro)
 373    (error "gen-write method not overridden:" self))
 374 )
 375
 376 ; gen-type handler, must be overridden
 377
 378 (method-make-virtual!
 379  <hardware-base> 'gen-type
 380  (lambda (self) (error "gen-type not overridden:" self))
 381 )
 382
 383 (method-make! <hardware-base> 'gen-profile-decl (lambda (self) ""))
 384
 385 ; Default gen-record-profile method.
 386
 387 (method-make!
 388  <hardware-base> 'gen-record-profile
 389  (lambda (self index sfmt estate)
 390    "") ; nothing to do
 391 )
 392
 393 ; Default cxmake-get method.
 394 ; Return a <c-expr> object of the value of SELF.
 395 ; ESTATE is the current rtl evaluator state.
 396 ; INDEX is a <hw-index> object.  It must be an ifield.
 397 ; SELECTOR is a hardware selector RTX.
 398
 399 (method-make!
 400  <hardware-base> 'cxmake-get
 401  (lambda (self estate mode index selector)
 402    ;(if (not (eq? 'ifield (hw-index:type index)))
 403    ;    (error "not an ifield hw-index" index))
 404    (-cxmake-ifld-val mode (hw-index:value index)))
 405 )
 406 \f
 407 ; PC support
 408
 409 ; 'gen-set-quiet helper for PC values.
 410 ; NEWVAL is a <c-expr> object of the value to be assigned.
 411 ; If OPTIONS contains #:direct, set the PC directly, bypassing semantic
 412 ; code considerations.
 413 ; ??? OPTIONS support wip.  Probably want a new form (or extend existing form)
 414 ; of rtx: that takes a variable number of named arguments.
 415 ; ??? Another way to get #:direct might be (raw-reg h-pc).
 416
 417 (define (-hw-gen-set-quiet-pc self estate mode index selector newval . options)
 418   (if (not (send self 'pc?)) (error "Not a PC:" self))
 419   (cond ((memq #:direct options)
 420          (-hw-gen-set-quiet self estate mode index selector newval))
 421         ((current-pbb-engine?)
 422          (string-append "npc = " (cx:c newval) ";"
 423                         (if (obj-has-attr? newval 'CACHED)
 424                             " br_status = BRANCH_CACHEABLE;"
 425                             " br_status = BRANCH_UNCACHEABLE;")
 426                         (if (assq #:delay (estate-modifiers estate))
 427                             (string-append " current_cpu->delay_slot_p = true;"
 428                                            " current_cpu->delayed_branch_address = npc;\n")
 429                             "\n")
 430                         ))
 431         ((assq #:delay (estate-modifiers estate))
 432          (string-append "current_cpu->delayed_branch (" (cx:c newval) ", npc, status);\n"))
 433         (else
 434          (string-append "current_cpu->branch (" (cx:c newval) ", npc, status);\n")))
 435 )
 436
 437 (method-make! <hw-pc> 'gen-set-quiet -hw-gen-set-quiet-pc)
 438
 439 ; Handle updates of the pc during parallel execution.
 440 ; This is done in a post-processing pass after semantic evaluation.
 441 ; SFMT is the <sformat>.
 442 ; OP is the operand.
 443 ; ACCESS-MACRO is the runtime C macro to use to fetch indices computed
 444 ; during semantic evaluation.
 445 ;
 446 ; ??? This wouldn't be necessary if gen-set-quiet were a virtual method.
 447 ; At this point I'm reluctant to willy nilly make methods virtual.
 448
 449 (method-make!
 450  <hw-pc> 'gen-write
 451  (lambda (self estate index mode sfmt op access-macro)
 452    (string-append "  "
 453                   (send self 'gen-set-quiet estate VOID index hw-selector-default
 454                         (cx:make VOID (string-append access-macro
 455                                                    " (" (gen-sym op) ")")))))
 456 )
 457
 458 (method-make!
 459  <hw-pc> 'cxmake-skip
 460  (lambda (self estate yes?)
 461    (cx:make VOID
 462             (string-append "if ("
 463                            yes?
 464                            ") {\n"
 465                            (if (current-pbb-engine?)
 466                                (string-append "  vpc = current_cpu->skip (vpc);\n")
 467                                (string-append "  npc = current_cpu->skip (pc);\n"))
 468                            "}\n")))
 469 )
 470 \f
 471 ; Registers.
 472
 473 ; Forward these methods onto TYPE.
 474 (method-make-virtual-forward! <hw-register> 'type '(gen-type gen-sym-decl))
 475 (method-make-forward! <hw-register> 'type '(gen-ref
 476                                             gen-sym-get-macro
 477                                             gen-sym-set-macro))
 478
 479 ; For parallel instructions supported by queueing outputs for later update,
 480 ; return a boolean indicating if an index needs to be recorded.
 481 ; An example of when the index isn't needed is if the index can be determined
 482 ; during extraction.
 483
 484 (method-make!
 485  <hw-register> 'save-index?
 486  (lambda (self op)
 487    ; For array registers, we need to store away the index.
 488    (if (hw-scalar? (op:type op))
 489        #f
 490        UINT))
 491 )
 492
 493 ; Handle updates of registers during parallel execution.
 494 ; This is done in a post-processing pass after semantic evaluation.
 495 ; SFMT is the <sformat>.
 496 ; OP is the <operand>.
 497 ; ACCESS-MACRO is the runtime C macro to use to fetch indices computed
 498 ; during semantic evaluation.
 499 ; FIXME: May need mode of OP.
 500
 501 (method-make!
 502  <hw-register> 'gen-write
 503  (lambda (self estate index mode sfmt op access-macro)
 504    ; First get a hw-index object to use during indexing.
 505    ; Some indices, e.g. memory addresses, are computed during semantic
 506    ; evaluation.  Others are computed during the extraction phase.
 507    (let ((index (send index 'get-write-index self sfmt op access-macro)))
 508      (string-append "  "
 509                     (send self 'gen-set-quiet estate mode index hw-selector-default
 510                           (cx:make VOID (string-append access-macro
 511                                                      " (" (gen-sym op) ")"))))))
 512 )
 513
 514 (method-make!
 515  <hw-register> 'gen-profile-decl
 516  (lambda (self)
 517    (string-append
 518     "  /* " (obj:comment self) " */\n"
 519     "  unsigned long " (gen-c-symbol (obj:name self)) ";\n"))
 520 )
 521
 522 (method-make!
 523  <hw-register> 'gen-record-profile
 524  (lambda (self index sfmt estate)
 525    ; FIXME: Need to handle scalars.
 526    (-gen-hw-index-raw index estate)
 527    ;(send index 'gen-extracted-field-value)
 528    )
 529 )
 530
 531 ; Utilities to generate register accesses via cover functions.
 532
 533 (define (-hw-gen-fun-get reg estate mode index)
 534   (let ((scalar? (hw-scalar? reg))
 535         (c-index (-gen-hw-index index estate)))
 536     (string-append "current_cpu->"
 537                    (gen-reg-get-fun-name reg)
 538                    " ("
 539                    (if scalar? "" (string-drop 2 (gen-c-args c-index)))
 540                    ")"))
 541 )
 542
 543 (define (-hw-gen-fun-set reg estate mode index newval)
 544   (let ((scalar? (hw-scalar? reg))
 545         (c-index (-gen-hw-index index estate)))
 546     (string-append "current_cpu->"
 547                    (gen-reg-set-fun-name reg)
 548                    " ("
 549                    (if scalar? "" (string-append (string-drop 2 (gen-c-args c-index)) ", "))
 550                    (cx:c newval)
 551                    ");\n"))
 552 )
 553
 554 ; Utility to build a <c-expr> object to fetch the value of a register.
 555
 556 (define (-hw-cxmake-get hw estate mode index selector)
 557   (let ((mode (if (mode:eq? 'DFLT mode)
 558                   (send hw 'get-mode)
 559                   mode)))
 560     ; If the register is accessed via a cover function/macro, do it.
 561     ; Otherwise fetch the value from the cached address or from the CPU struct.
 562     (cx:make mode
 563              (cond ((or (hw-getter hw)
 564                         (obj-has-attr? hw 'FUN-GET))
 565                     (-hw-gen-fun-get hw estate mode index))
 566                    ((and (hw-cache-addr? hw) ; FIXME: redo test
 567                          (eq? 'ifield (hw-index:type index)))
 568                     (string-append
 569                      "* "
 570                      (if (with-scache?)
 571                          (gen-hw-index-argbuf-ref index)
 572                          (gen-hw-index-argbuf-name index))))
 573                    (else (gen-cpu-ref (hw-isas hw)
 574                                       (send hw 'gen-ref
 575                                             (gen-sym hw) index estate))))))
 576 )
 577
 578 (method-make! <hw-register> 'cxmake-get -hw-cxmake-get)
 579
 580 ; raw-reg: support
 581 ; ??? raw-reg: support is wip
 582
 583 (method-make!
 584  <hw-register> 'cxmake-get-raw
 585  (lambda (self estate mode index selector)
 586   (let ((mode (if (mode:eq? 'DFLT mode)
 587                   (send self 'get-mode)
 588                   mode)))
 589     (cx:make mode (gen-cpu-ref (hw-isas self)
 590                                (send self 'gen-ref
 591                                      (gen-sym self) index estate)))))
 592 )
 593
 594 ; Utilities to generate C code to assign a variable to a register.
 595
 596 (define (-hw-gen-set-quiet hw estate mode index selector newval)
 597   (cond ((or (hw-setter hw)
 598              (obj-has-attr? hw 'FUN-SET))
 599          (-hw-gen-fun-set hw estate mode index newval))
 600         ((and (hw-cache-addr? hw) ; FIXME: redo test
 601               (eq? 'ifield (hw-index:type index)))
 602          (string-append "* "
 603                         (if (with-scache?)
 604                             (gen-hw-index-argbuf-ref index)
 605                             (gen-hw-index-argbuf-name index))
 606                         " = " (cx:c newval) ";\n"))
 607         (else (string-append (gen-cpu-ref (hw-isas hw)
 608                                           (send hw 'gen-ref
 609                                                 (gen-sym hw) index estate))
 610                              " = " (cx:c newval) ";\n")))
 611 )
 612
 613 (method-make! <hw-register> 'gen-set-quiet -hw-gen-set-quiet)
 614
 615 ; raw-reg: support
 616 ; ??? wip
 617
 618 (method-make!
 619  <hw-register> 'gen-set-quiet-raw
 620  (lambda (self estate mode index selector newval)
 621    (string-append (gen-cpu-ref (hw-isas self)
 622                                (send self 'gen-ref
 623                                      (gen-sym self) index estate))
 624                   " = " (cx:c newval) ";\n"))
 625 )
 626
 627 ; Return method name of access function.
 628 ; Common elements have no prefix.
 629 ; Elements specific to a particular isa are prefixed with @prefix@_.
 630
 631 (define (gen-reg-get-fun-name hw)
 632   (string-append (if (and (with-multiple-isa?)
 633                           (= (length (hw-isas hw)) 1))
 634                      (string-append (gen-sym (car (hw-isas hw))) "_")
 635                      "")
 636                  (gen-sym hw)
 637                  "_get")
 638 )
 639
 640 (define (gen-reg-set-fun-name hw)
 641   (string-append (if (and (with-multiple-isa?)
 642                           (= (length (hw-isas hw)) 1))
 643                      (string-append (gen-sym (car (hw-isas hw))) "_")
 644                      "")
 645                  (gen-sym hw)
 646                  "_set")
 647 )
 648 \f
 649 ; Memory support.
 650
 651 (method-make!
 652  <hw-memory> 'cxmake-get
 653  (lambda (self estate mode index selector)
 654    (let ((mode (if (mode:eq? 'DFLT mode)
 655                    (hw-mode self)
 656                    mode))
 657          (default-selector? (hw-selector-default? selector)))
 658      (cx:make mode
 659               (string-append "current_cpu->GETMEM" (obj:str-name mode)
 660                              (if default-selector? "" "ASI")
 661                              " ("
 662                              "pc, "
 663                              (-gen-hw-index index estate)
 664                              (if default-selector?
 665                                  ""
 666                                  (string-append ", "
 667                                                 (-gen-hw-selector selector)))
 668                              ")"))))
 669 )
 670
 671 (method-make!
 672  <hw-memory> 'gen-set-quiet
 673  (lambda (self estate mode index selector newval)
 674    (let ((mode (if (mode:eq? 'DFLT mode)
 675                    (hw-mode self)
 676                    mode))
 677          (default-selector? (hw-selector-default? selector)))
 678      (string-append "current_cpu->SETMEM" (obj:str-name mode)
 679                     (if default-selector? "" "ASI")
 680                     " ("
 681                     "pc, "
 682                     (-gen-hw-index index estate)
 683                     (if default-selector?
 684                         ""
 685                         (string-append ", "
 686                                        (-gen-hw-selector selector)))
 687                     ", " (cx:c newval) ");\n")))
 688 )
 689
 690 (method-make-virtual-forward! <hw-memory> 'type '(gen-type))
 691 (method-make-virtual! <hw-memory> 'gen-sym-decl (lambda (self sym comment) ""))
 692 (method-make! <hw-memory> 'gen-sym-get-macro (lambda (self sym comment) ""))
 693 (method-make! <hw-memory> 'gen-sym-set-macro (lambda (self sym comment) ""))
 694
 695 ; For parallel instructions supported by queueing outputs for later update,
 696 ; return the type of the index or #f if not needed.
 697
 698 (method-make!
 699  <hw-memory> 'save-index?
 700  (lambda (self op)
 701    ; In the case of the complete memory address being an immediate
 702    ; argument, we can return #f (later).
 703    AI)
 704 )
 705
 706 (method-make!
 707  <hw-memory> 'gen-write
 708  (lambda (self estate index mode sfmt op access-macro)
 709    (let ((index (send index 'get-write-index self sfmt op access-macro)))
 710      (string-append "  "
 711                     (send self 'gen-set-quiet estate mode index
 712                           hw-selector-default
 713                           (cx:make DFLT (string-append access-macro " ("
 714                                                      (gen-sym op)
 715                                                      ")"))))))
 716 )
 717 \f
 718 ; Immediates, addresses.
 719
 720 ; Forward these methods onto TYPE.
 721 (method-make-virtual-forward! <hw-immediate> 'type '(gen-type gen-sym-decl))
 722 (method-make-forward! <hw-immediate> 'type '(gen-sym-get-macro
 723                                              gen-sym-set-macro))
 724
 725 (method-make!
 726  <hw-immediate> 'gen-write
 727  (lambda (self estate index mode sfmt op access-macro)
 728    (error "gen-write of <hw-immediate> shouldn't happen"))
 729 )
 730
 731 ; FIXME.
 732 (method-make-virtual! <hw-address> 'gen-type (lambda (self) "ADDR"))
 733 (method-make-virtual! <hw-address> 'gen-sym-decl (lambda (self sym comment) ""))
 734 (method-make! <hw-address> 'gen-sym-get-macro (lambda (self sym comment) ""))
 735 (method-make! <hw-address> 'gen-sym-set-macro (lambda (self sym comment) ""))
 736
 737 ; Return a <c-expr> object of the value of SELF.
 738 ; ESTATE is the current rtl evaluator state.
 739 ; INDEX is a hw-index object.  It must be an ifield.
 740 ; Needed because we record our own copy of the ifield in ARGBUF.
 741 ; SELECTOR is a hardware selector RTX.
 742
 743 (method-make!
 744  <hw-address> 'cxmake-get
 745  (lambda (self estate mode index selector)
 746    (if (not (eq? 'ifield (hw-index:type index)))
 747        (error "not an ifield hw-index" index))
 748    (if (with-scache?)
 749        (cx:make mode (gen-hw-index-argbuf-ref index))
 750        (cx:make mode (gen-hw-index-argbuf-name index))))
 751 )
 752
 753 (method-make!
 754  <hw-address> 'gen-write
 755  (lambda (self estate index mode sfmt op access-macro)
 756    (error "gen-write of <hw-address> shouldn't happen"))
 757 )
 758
 759 ; FIXME: revisit.
 760 (method-make-virtual! <hw-iaddress> 'gen-type (lambda (self) "IADDR"))
 761
 762 ; Return a <c-expr> object of the value of SELF.
 763 ; ESTATE is the current rtl evaluator state.
 764 ; INDEX is a <hw-index> object.  It must be an ifield.
 765 ; Needed because we record our own copy of the ifield in ARGBUF,
 766 ; *and* because we want to record in the result the 'CACHED attribute
 767 ; since instruction addresses based on ifields are fixed [and thus cacheable].
 768 ; SELECTOR is a hardware selector RTX.
 769
 770 (method-make!
 771  <hw-iaddress> 'cxmake-get
 772  (lambda (self estate mode index selector)
 773    (if (not (eq? 'ifield (hw-index:type index)))
 774        (error "not an ifield hw-index" index))
 775    (if (with-scache?)
 776        ; ??? Perhaps a better way would be to defer evaluating the src of a
 777        ; set until the method processing the dest.
 778        (cx:make-with-atlist mode (gen-hw-index-argbuf-ref index)
 779                             (atlist-make "" (bool-attr-make 'CACHED #t)))
 780        (cx:make mode (gen-hw-index-argbuf-name index))))
 781 )
 782 \f
 783 ; Hardware index support code.
 784
 785 ; Return the index to use by the gen-write method.
 786 ; In the cases where this is needed (the index isn't known until insn
 787 ; execution time), the index is computed along with the value to be stored,
 788 ; so this is easy.
 789
 790 (method-make!
 791  <hw-index> 'get-write-index
 792  (lambda (self hw sfmt op access-macro)
 793    (if (memq (hw-index:type self) '(scalar constant str-expr ifield))
 794        self
 795        (let ((index-mode (send hw 'get-index-mode)))
 796          (if index-mode
 797              (make <hw-index> 'anonymous 'str-expr index-mode
 798                    (string-append access-macro " (" (-op-index-name op) ")"))
 799              (hw-index-scalar)))))
 800 )
 801
 802 ; Return the name of the PAREXEC structure member holding a hardware index
 803 ; for operand OP.
 804
 805 (define (-op-index-name op)
 806   (string-append (gen-sym op) "_idx")
 807 )
 808
 809 ; Cover fn to hardware indices to generate the actual C code.
 810 ; INDEX is the hw-index object (i.e. op:index).
 811 ; The result is a string of C code.
 812 ; FIXME:wip
 813
 814 (define (-gen-hw-index-raw index estate)
 815   (let ((type (hw-index:type index))
 816         (mode (hw-index:mode index))
 817         (value (hw-index:value index)))
 818     (case type
 819       ((scalar) "")
 820       ; special case UINT to cut down on unnecessary verbosity.
 821       ; ??? May wish to handle more similarily.
 822       ((constant) (if (mode:eq? 'UINT mode)
 823                       (number->string value)
 824                       (string-append "((" (mode:c-type mode) ") "
 825                                      (number->string value)
 826                                      ")")))
 827       ((str-expr) value)
 828       ((rtx) (rtl-c-with-estate estate mode value))
 829       ((ifield) (if (= (ifld-length value) 0)
 830                     ""
 831                     (gen-extracted-ifld-value value)))
 832       ((operand) (cx:c (send value 'cxmake-get estate mode (op:index value)
 833                              (op:selector value) #f)))
 834       (else (error "-gen-hw-index-raw: invalid index:" index))))
 835 )
 836
 837 ; Same as -gen-hw-index-raw except used where speedups are possible.
 838 ; e.g. doing array index calcs at extraction time.
 839
 840 (define (-gen-hw-index index estate)
 841   (let ((type (hw-index:type index))
 842         (mode (hw-index:mode index))
 843         (value (hw-index:value index)))
 844     (case type
 845       ((scalar) "")
 846       ((constant) (string-append "((" (mode:c-type mode) ") "
 847                                  (number->string value)
 848                                  ")"))
 849       ((str-expr) value)
 850       ((rtx) (rtl-c-with-estate estate mode value))
 851       ((ifield) (if (= (ifld-length value) 0)
 852                     ""
 853                     (cx:c (-cxmake-ifld-val mode value))))
 854       ((operand) (cx:c (send value 'cxmake-get estate mode (op:index value)
 855                              (op:selector value))))
 856       (else (error "-gen-hw-index: invalid index:" index))))
 857 )
 858
 859 ; Return a <c-expr> object of the value of a hardware index.
 860
 861 (method-make!
 862  <hw-index> 'cxmake-get
 863  (lambda (self estate mode)
 864    (let ((mode (if (mode:eq? 'DFLT mode) (elm-get self 'mode) mode)))
 865      ; If MODE is VOID, abort.
 866      (if (mode:eq? 'VOID mode)
 867          (error "hw-index:cxmake-get: result needs a mode" self))
 868      (cx:make (if (mode:host? mode)
 869                   ; FIXME: Temporary hack to generate same code as before.
 870                   (let ((xmode (object-copy-top mode)))
 871                     (obj-cons-attr! xmode (bool-attr-make 'FORCE-C #t))
 872                     xmode)
 873                   mode)
 874               (-gen-hw-index self estate))))
 875 )
 876 \f
 877 ; Hardware selector support code.
 878
 879 ; Generate C code for SEL.
 880
 881 (define (-gen-hw-selector sel)
 882   (rtl-c++ 'INT sel nil)
 883 )
 884 \f
 885 ; Instruction operand support code.
 886
 887 ; Methods:
 888 ; gen-type      - Return C type to use to hold operand's value.
 889 ; gen-read      - Record an operand's value prior to parallely executing
 890 ;                 several instructions.  Not used if gen-write used.
 891 ; gen-write     - Write back an operand's value after parallely executing
 892 ;                 several instructions.  Not used if gen-read used.
 893 ; cxmake-get    - Return C code to fetch the value of an operand.
 894 ; gen-set-quiet - Return C code to set the value of an operand.
 895 ; gen-set-trace - Return C code to set the value of an operand, and print
 896 ;                 a result trace message.  ??? Ideally this will go away when
 897 ;                 trace record support is complete.
 898
 899 ; Return the C type of an operand.
 900 ; Generally we forward things on to TYPE, but for the actual type we need to
 901 ; use the get-mode method.
 902
 903 ;(method-make-forward! <operand> 'type '(gen-type))
 904 (method-make!
 905  <operand> 'gen-type
 906  (lambda (self)
 907    ; First get the mode.
 908    (let ((mode (send self 'get-mode)))
 909      ; If default mode, use the type's type.
 910      (if (mode:eq? 'DFLT mode)
 911          (send (op:type self) 'gen-type)
 912          (mode:c-type mode))))
 913 )
 914
 915 ; Extra pc operand methods.
 916
 917 (method-make!
 918  <pc> 'cxmake-get
 919  (lambda (self estate mode index selector)
 920    (let ((mode (if (mode:eq? 'DFLT mode)
 921                    (send self 'get-mode)
 922                    mode)))
 923      ; The enclosing function must set `pc' to the correct value.
 924      (cx:make mode "pc")))
 925 )
 926
 927 (method-make!
 928  <pc> 'cxmake-skip
 929  (lambda (self estate yes?)
 930    (send (op:type self) 'cxmake-skip estate
 931          (rtl-c++ INT yes? nil #:rtl-cover-fns? #t)))
 932 )
 933
 934 ; Default gen-read method.
 935 ; This is used to help support targets with parallel insns.
 936 ; Either this or gen-write (but not both) is used.
 937
 938 (method-make!
 939  <operand> 'gen-read
 940  (lambda (self estate sfmt access-macro)
 941    (string-append "  "
 942                   access-macro " ("
 943                   (gen-sym self)
 944                   ") = "
 945                   ; Pass #f for the index -> use the operand's builtin index.
 946                   ; Ditto for the selector.
 947                   (cx:c (send self 'cxmake-get estate DFLT #f #f))
 948                   ";\n"))
 949 )
 950
 951 ; Forward gen-write onto the <hardware> object.
 952
 953 (method-make!
 954  <operand> 'gen-write
 955  (lambda (self estate sfmt access-macro)
 956    (let ((write-back-code (send (op:type self) 'gen-write estate
 957                                 (op:index self) (op:mode self)
 958                                 sfmt self access-macro)))
 959      ; If operand is conditionally written, we have to check that first.
 960      ; ??? If two (or more) operands are written based on the same condition,
 961      ; all the tests can be collapsed together.  Not sure that's a big
 962      ; enough win yet.
 963      (if (op:cond? self)
 964          (string-append "  if (written & (1ULL << "
 965                         (number->string (op:num self))
 966                         "))\n"
 967                         "    {\n"
 968                         "    " write-back-code
 969                         "    }\n")
 970          write-back-code)))
 971 )
 972
 973 ; Return <c-expr> object to get the value of an operand.
 974 ; ESTATE is the current rtl evaluator state.
 975 ; If INDEX is non-#f use it, otherwise use (op:index self).
 976 ; This special handling of #f for INDEX is *only* supported for operands
 977 ; in cxmake-get, gen-set-quiet, and gen-set-trace.
 978 ; Ditto for SELECTOR.
 979
 980 (method-make!
 981  <operand> 'cxmake-get
 982  (lambda (self estate mode index selector)
 983    (let* ((mode (if (mode:eq? 'DFLT mode)
 984                     (send self 'get-mode)
 985                     mode))
 986           (hw (op:type self))
 987           (index (if index index (op:index self)))
 988           (idx (if index (-gen-hw-index index estate) ""))
 989           (idx-args (if (equal? idx "") "" (string-append ", " idx)))
 990           (selector (if selector selector (op:selector self)))
 991           (delayval (op:delay self))
 992           (md (mode:c-type mode))
 993           (name (if
 994                  (eq? (obj:name hw) 'h-memory)
 995                  (string-append md "_memory")
 996                  (gen-c-symbol (obj:name hw))))
 997           (getter (op:getter self))
 998           (def-val (cond ((obj-has-attr? self 'RAW)
 999                           (send hw 'cxmake-get-raw estate mode index selector))
1000                          (getter
1001                           (let ((args (car getter))
1002                                 (expr (cadr getter)))
1003                             (rtl-c-expr mode expr
1004                                         (if (= (length args) 0) nil
1005                                             (list (list (car args) 'UINT index)))
1006                                         #:rtl-cover-fns? #t
1007                                         #:output-language (estate-output-language estate))))
1008                          (else
1009                           (send hw 'cxmake-get estate mode index selector)))))
1010
1011      (logit 4 "<operand> cxmake-get self=" (obj:name self) " mode=" (obj:name mode)
1012             " index=" (obj:name index) " selector=" selector "\n")
1013
1014      (if delayval
1015          (cx:make mode (string-append "lookahead ("
1016                                       (number->string delayval)
1017                                       ", tick, "
1018                                       "buf." name "_writes, "
1019                                       (cx:c def-val)
1020                                       idx-args ")"))
1021          def-val)))
1022 )
1023
1024
1025 ; Utilities to implement gen-set-quiet/gen-set-trace.
1026
1027 (define (-op-gen-set-quiet op estate mode index selector newval)
1028   (send (op:type op) 'gen-set-quiet estate mode index selector newval)
1029 )
1030
1031 (define (-op-gen-delayed-set-quiet op estate mode index selector newval)
1032   (-op-gen-delayed-set-maybe-trace op estate mode index selector newval #f))
1033
1034
1035 (define (-op-gen-set-trace op estate mode index selector newval)
1036   (string-append
1037    "  {\n"
1038    "    " (mode:c-type mode) " opval = " (cx:c newval) ";\n"
1039    (if (and (with-profile?)
1040             (op:cond? op))
1041        (string-append "    written |= (1ULL << "
1042                       (number->string (op:num op))
1043                       ");\n")
1044        "")
1045 ; TRACE_RESULT_<MODE> (cpu, abuf, hwnum, opnum, value);
1046 ; For each insn record array of operand numbers [or indices into
1047 ; operand instance table].
1048 ; Could just scan the operand table for the operand or hardware number,
1049 ; assuming the operand number is stored in `op'.
1050    (if (current-pbb-engine?)
1051        ""
1052        (string-append
1053         "    if (UNLIKELY(current_cpu->trace_result_p))\n"
1054         "      current_cpu->trace_stream << "
1055         (send op 'gen-pretty-name mode)
1056         (if (send op 'get-index-mode)
1057             (string-append
1058              " << '['"
1059              " << "
1060              ; print memory addresses in hex
1061              (if (string=? (send op 'gen-pretty-name mode) "\"memory\"")
1062                  " \"0x\" << hex << (UDI) "
1063                  "")
1064              (-gen-hw-index index estate)
1065              (if (string=? (send op 'gen-pretty-name mode) "\"memory\"")
1066                  " << dec"
1067                  "")
1068              " << ']'")
1069             "")
1070         " << \":=0x\" << hex << "
1071         ; Add (SI) or (USI) cast for byte-wide data, to prevent C++ iostreams
1072         ; from printing byte as plain raw char.
1073         (if (mode:eq? 'QI mode)
1074             "(SI) "
1075             (if (mode:eq? 'UQI mode)
1076                 "(USI) "
1077                 ""))
1078         "opval << dec << \"  \";\n"))
1079    ; Dispatch to setter code if appropriate
1080    "    "
1081    (if (op:setter op)
1082        (let ((args (car (op:setter op)))
1083              (expr (cadr (op:setter op))))
1084          (rtl-c 'VOID expr
1085                 (if (= (length args) 0)
1086                     (list (list 'newval mode "opval"))
1087                     (list (list (car args) 'UINT index)
1088                           (list 'newval mode "opval")))
1089                 #:rtl-cover-fns? #t
1090                 #:output-language (estate-output-language estate)))
1091        ;else
1092        (send (op:type op) 'gen-set-quiet estate mode index selector
1093                 (cx:make-with-atlist mode "opval" (cx:atlist newval))))
1094    "  }\n")
1095 )
1096
1097 (define (-op-gen-delayed-set-trace op estate mode index selector newval)
1098   (-op-gen-delayed-set-maybe-trace op estate mode index selector newval #t))
1099
1100 (define (-op-gen-delayed-set-maybe-trace op estate mode index selector newval do-trace?)
1101   (let* ((pad "    ")
1102          (hw (op:type op))
1103          (delayval (op:delay op))
1104          (md (mode:c-type mode))
1105          (name (if
1106                 (eq? (obj:name hw) 'h-memory)
1107                 (string-append md "_memory")
1108                 (gen-c-symbol (obj:name hw))))
1109          (val (cx:c newval))
1110          (idx (if index (-gen-hw-index index estate) ""))
1111          (idx-args (if (equal? idx "") "" (string-append ", " idx)))
1112          )
1113
1114     (string-append
1115      "  {\n"
1116
1117      (if delayval
1118
1119          ;; delayed write: push it to the appropriate buffer
1120          (string-append
1121           pad md " opval = " val ";\n"
1122           pad "buf." name "_writes [(tick + " (number->string delayval)
1123           ") % @prefix@::pipe_sz].push (@prefix@::write<" md ">(pc, opval" idx-args "));\n")
1124
1125          ;; else, uh, we should never have been called!
1126          (error "-op-gen-delayed-set-maybe-trace called on non-delayed operand"))
1127
1128
1129      (if do-trace?
1130
1131          (string-append
1132 ; TRACE_RESULT_<MODE> (cpu, abuf, hwnum, opnum, value);
1133 ; For each insn record array of operand numbers [or indices into
1134 ; operand instance table].
1135 ; Could just scan the operand table for the operand or hardware number,
1136 ; assuming the operand number is stored in `op'.
1137    "    if (UNLIKELY(current_cpu->trace_result_p))\n"
1138    "      current_cpu->trace_stream << "
1139    (send op 'gen-pretty-name mode)
1140    (if (send op 'get-index-mode)
1141        (string-append
1142         " << '['"
1143         " << "
1144                                         ; print memory addresses in hex
1145         (if (string=? (send op 'gen-pretty-name mode) "\"memory\"")
1146             " \"0x\" << hex << (UDI) "
1147             "")
1148         (-gen-hw-index index estate)
1149         (if (string=? (send op 'gen-pretty-name mode) "\"memory\"")
1150             " << dec"
1151             "")
1152         " << ']'")
1153        "")
1154    " << \":=0x\" << hex << "
1155    ;; Add (SI) or (USI) cast for byte-wide data, to prevent C++ iostreams
1156    ;; from printing byte as plain raw char.
1157    (if (mode:eq? 'QI mode)
1158        "(SI) "
1159        (if (mode:eq? 'UQI mode)
1160            "(USI) "
1161            ""))
1162    "opval << dec << \"  \";\n"
1163    "  }\n")
1164          ;; else no tracing is emitted
1165          ""))))
1166
1167 ; Return C code to set the value of an operand.
1168 ; NEWVAL is a <c-expr> object of the value to store.
1169 ; If INDEX is non-#f use it, otherwise use (op:index self).
1170 ; This special handling of #f for INDEX is *only* supported for operands
1171 ; in cxmake-get, gen-set-quiet, and gen-set-trace.
1172 ; Ditto for SELECTOR.
1173
1174 (method-make!
1175  <operand> 'gen-set-quiet
1176  (lambda (self estate mode index selector newval)
1177    (let ((mode (if (mode:eq? 'DFLT mode)
1178                    (send self 'get-mode)
1179                    mode))
1180          (index (if index index (op:index self)))
1181          (selector (if selector selector (op:selector self))))
1182      (cond ((obj-has-attr? self 'RAW)
1183             (send (op:type self) 'gen-set-quiet-raw estate mode index selector newval))
1184            ((op:delay self)
1185             (-op-gen-delayed-set-quiet self estate mode index selector newval))
1186            (else
1187             (-op-gen-set-quiet self estate mode index selector newval)))))
1188 )
1189
1190 ; Return C code to set the value of an operand and print TRACE_RESULT message.
1191 ; NEWVAL is a <c-expr> object of the value to store.
1192 ; If INDEX is non-#f use it, otherwise use (op:index self).
1193 ; This special handling of #f for INDEX is *only* supported for operands
1194 ; in cxmake-get, gen-set-quiet, and gen-set-trace.
1195 ; Ditto for SELECTOR.
1196
1197 (method-make!
1198  <operand> 'gen-set-trace
1199  (lambda (self estate mode index selector newval)
1200    (let ((mode (if (mode:eq? 'DFLT mode)
1201                    (send self 'get-mode)
1202                    mode))
1203          (index (if index index (op:index self)))
1204          (selector (if selector selector (op:selector self))))
1205      (cond ((obj-has-attr? self 'RAW)
1206             (send (op:type self) 'gen-set-quiet-raw estate mode index selector newval))
1207            ((op:delay self)
1208             (-op-gen-delayed-set-trace self estate mode index selector newval))
1209            (else
1210             (-op-gen-set-trace self estate mode index selector newval)))))
1211 )
1212
1213 \f
1214 ; Operand profiling and parallel execution support.
1215
1216 (method-make!
1217  <operand> 'save-index?
1218  (lambda (self) (send (op:type self) 'save-index? self))
1219 )
1220
1221 ; Return boolean indicating if operand OP needs its index saved
1222 ; (for parallel write post-processing support).
1223
1224 (define (op-save-index? op)
1225   (send op 'save-index?)
1226 )
1227
1228 ; Return C code to record profile data for modeling use.
1229 ; In the case of a register, this is usually the register's number.
1230 ; This shouldn't be called in the case of a scalar, the code should be
1231 ; smart enough to know there is no need.
1232
1233 (define (op:record-profile op sfmt out?)
1234   (let ((estate (vmake <rtl-c-eval-state>
1235                        #:rtl-cover-fns? #t
1236                        #:output-language "c++")))
1237     (send op 'gen-record-profile sfmt out? estate))
1238 )
1239
1240 ; Return C code to record the data needed for profiling operand SELF.
1241 ; This is done during extraction.
1242
1243 (method-make!
1244  <operand> 'gen-record-profile
1245  (lambda (self sfmt out? estate)
1246    (if (hw-scalar? (op:type self))
1247        ""
1248        (string-append "      "
1249                       (gen-argbuf-ref (string-append (if out? "out_" "in_")
1250                                                      (gen-sym self)))
1251                       " = "
1252                       (send (op:type self) 'gen-record-profile
1253                             (op:index self) sfmt estate)
1254                       ";\n")))
1255 )
1256
1257 ; Return C code to track profiling of operand SELF.
1258 ; This is usually called by the x-after handler.
1259
1260 (method-make!
1261  <operand> 'gen-profile-code
1262  (lambda (self insn when out?)
1263    (string-append "  "
1264                   "@prefix@_model_mark_"
1265                   (if out? "set_" "get_")
1266                   (gen-sym (op:type self))
1267                   "_" when
1268                   " (current_cpu"
1269                   (if (hw-scalar? (op:type self))
1270                       ""
1271                       (string-append ", "
1272                                      (gen-argbuf-ref
1273                                       (string-append (if out? "out_" "in_")
1274                                                      (gen-sym self)))))
1275                   ");\n"))
1276 )
1277 \f
1278 ; CPU, mach, model support.
1279
1280 ; Return the declaration of the cpu/insn enum.
1281
1282 (define (gen-cpu-insn-enum-decl cpu insn-list)
1283   (gen-enum-decl "@prefix@_insn_type"
1284                  "instructions in cpu family @prefix@"
1285                  "@PREFIX@_INSN_"
1286                  (append (map (lambda (i)
1287                                 (cons (obj:name i)
1288                                       (cons '-
1289                                             (atlist-attrs (obj-atlist i)))))
1290                               insn-list)
1291                          (if (with-parallel?)
1292                              (apply append
1293                                     (map (lambda (i)
1294                                            (list
1295                                             (cons (symbol-append 'par- (obj:name i))
1296                                                   (cons '-
1297                                                         (atlist-attrs (obj-atlist i))))
1298                                             (cons (symbol-append 'write- (obj:name i))
1299                                                   (cons '-
1300                                                         (atlist-attrs (obj-atlist i))))))
1301                                          (parallel-insns insn-list)))
1302                              nil)))
1303 )
1304
1305 ; Return the enum of INSN in cpu family CPU.
1306 ; In addition to CGEN_INSN_TYPE, an enum is created for each insn in each
1307 ; cpu family.  This collapses the insn enum space for each cpu to increase
1308 ; cache efficiently (since the IDESC table is similarily collapsed).
1309
1310 (define (gen-cpu-insn-enum cpu insn)
1311   (string-append "@PREFIX@_INSN_" (string-upcase (gen-sym insn)))
1312 )
1313
1314 ; Return C code to declare the machine data.
1315
1316 (define (-gen-mach-decls)
1317   (string-append
1318    (string-map (lambda (mach)
1319                  (gen-obj-sanitize mach
1320                                    (string-append "extern const MACH "
1321                                                   (gen-sym mach)
1322                                                   "_mach;\n")))
1323                (current-mach-list))
1324    "\n")
1325 )
1326
1327 ; Return C code to define the machine data.
1328
1329 (define (-gen-mach-data)
1330   (string-append
1331    "const MACH *sim_machs[] =\n{\n"
1332    (string-map (lambda (mach)
1333                  (gen-obj-sanitize
1334                   mach
1335                   (string-append "#ifdef " (gen-have-cpu (mach-cpu mach)) "\n"
1336                                  "  & " (gen-sym mach) "_mach,\n"
1337                                  "#endif\n")))
1338                (current-mach-list))
1339    "  0\n"
1340    "};\n\n"
1341    )
1342 )
1343
1344 ; Return C declarations of cpu model support stuff.
1345 ; ??? This goes in arch.h but a better place is each cpu.h.
1346
1347 (define (-gen-arch-model-decls)
1348   (string-append
1349    (gen-enum-decl 'model_type "model types"
1350                   "MODEL_"
1351                   (append (map (lambda (model)
1352                                  (cons (obj:name model)
1353                                        (cons '-
1354                                              (atlist-attrs (obj-atlist model)))))
1355                                (current-model-list))
1356                           '((max))))
1357    "#define MAX_MODELS ((int) MODEL_MAX)\n\n"
1358   )
1359 )
1360 \f
1361 ; Function units.
1362
1363 (method-make! <unit> 'gen-decl (lambda (self) ""))
1364
1365 ; Lookup operand named OP-NAME in INSN.
1366 ; Returns #f if OP-NAME is not an operand of INSN.
1367 ; IN-OUT is 'in to request an input operand, 'out to request an output operand,
1368 ; and 'in-out to request either (though if an operand is used for input and
1369 ; output then the input version is returned).
1370 ; FIXME: Move elsewhere.
1371
1372 (define (insn-op-lookup op-name insn in-out)
1373   (letrec ((lookup (lambda (op-list)
1374                      (cond ((null? op-list) #f)
1375                            ((eq? op-name (op:sem-name (car op-list))) (car op-list))
1376                            (else (lookup (cdr op-list)))))))
1377     (case in-out
1378       ((in) (lookup (sfmt-in-ops (insn-sfmt insn))))
1379       ((out) (lookup (sfmt-out-ops (insn-sfmt insn))))
1380       ((in-out) (or (lookup (sfmt-in-ops (insn-sfmt insn)))
1381                     (lookup (sfmt-out-ops (insn-sfmt insn)))))
1382       (else (error "insn-op-lookup: bad arg:" in-out))))
1383 )
1384
1385 ; Return C code to profile a unit's usage.
1386 ; UNIT-NUM is number of the unit in INSN.
1387 ; OVERRIDES is a list of (name value) pairs, where
1388 ; - NAME is a spec name, one of cycles, pred, in, out.
1389 ;   The only ones we're concerned with are in,out.  They map operand names
1390 ;   as they appear in the semantic code to operand names as they appear in
1391 ;   the function unit spec.
1392 ; - VALUE is the operand to NAME.  For in,out it is (NAME VALUE) where
1393 ;   - NAME is the name of an input/output arg of the unit.
1394 ;   - VALUE is the name of the operand as it appears in semantic code.
1395 ;
1396 ; ??? This is a big sucker, though half of it is just the definitions
1397 ; of utility fns.
1398
1399 (method-make!
1400  <unit> 'gen-profile-code
1401  (lambda (self unit-num insn when overrides cycles-var-name)
1402    (logit 3 "  'gen-profile-code\n")
1403    (let (
1404          (inputs (unit:inputs self))
1405          (outputs (unit:outputs self))
1406
1407           ; Return C code to initialize UNIT-REFERENCED-VAR to be a bit mask
1408           ; of operands of UNIT that were read/written by INSN.
1409           ; INSN-REFERENCED-VAR is a bitmask of operands read/written by INSN.
1410           ; All we have to do is map INSN-REFERENCED-VAR to
1411           ; UNIT-REFERENCED-VAR.
1412           ; ??? For now we assume all input operands are read.
1413           (gen-ref-arg (lambda (arg num in-out)
1414                          (logit 3 "    gen-ref-arg\n")
1415                          (let* ((op-name (assq-ref overrides (car arg)))
1416                                 (op (insn-op-lookup (if op-name
1417                                                         (car op-name)
1418                                                         (car arg))
1419                                                     insn in-out))
1420                                 (insn-referenced-var "insn_referenced")
1421                                 (unit-referenced-var "referenced"))
1422                            (if op
1423                                (if (op:cond? op)
1424                                    (string-append "    "
1425                                                   "if ("
1426                                                   insn-referenced-var
1427                                                   " & (1 << "
1428                                                   (number->string (op:num op))
1429                                                   ")) "
1430                                                   unit-referenced-var
1431                                                   " |= 1 << "
1432                                                   (number->string num)
1433                                                   ";\n")
1434                                    (string-append "    "
1435                                                   unit-referenced-var
1436                                                   " |= 1 << "
1437                                                   (number->string num)
1438                                                   ";\n"))
1439                                ""))))
1440
1441           ; Initialize unit argument ARG.
1442           ; OUT? is #f for input args, #t for output args.
1443           (gen-arg-init (lambda (arg out?)
1444                          (logit 3 "    gen-arg-unit\n")
1445                           (if (or
1446                                ; Ignore scalars.
1447                                (null? (cdr arg))
1448                                ; Ignore remapped arg, handled elsewhere.
1449                                (assq (car arg) overrides)
1450                                ; Ignore operands not in INSN.
1451                                (not (insn-op-lookup (car arg) insn
1452                                                     (if out? 'out 'in))))
1453                               ""
1454                               (string-append "    "
1455                                              (if out? "out_" "in_")
1456                                              (gen-c-symbol (car arg))
1457                                              " = "
1458                                              (gen-argbuf-ref
1459                                               (string-append (if out? "out_" "in_")
1460                                                              (gen-c-symbol (car arg))))
1461                                              ";\n"))))
1462
1463           ; Return C code to declare variable to hold unit argument ARG.
1464           ; OUT? is #f for input args, #t for output args.
1465           (gen-arg-decl (lambda (arg out?)
1466                          (logit 3 "    gen-arg-decl " arg out? "\n")
1467                           (if (null? (cdr arg)) ; ignore scalars
1468                               ""
1469                               (string-append "    "
1470                                              (mode:c-type (mode:lookup (cadr arg)))
1471                                              " "
1472                                              (if out? "out_" "in_")
1473                                              (gen-c-symbol (car arg))
1474                                              " = "
1475                                              (if (null? (cddr arg))
1476                                                  "0"
1477                                                  (number->string (caddr arg)))
1478                                              ";\n"))))
1479
1480           ; Return C code to pass unit argument ARG to the handler.
1481           ; OUT? is #f for input args, #t for output args.
1482           (gen-arg-arg (lambda (arg out?)
1483                          (logit 3 "    gen-arg-arg\n")
1484                          (if (null? (cdr arg)) ; ignore scalars
1485                              ""
1486                              (string-append ", "
1487                                             (if out? "out_" "in_")
1488                                             (gen-c-symbol (car arg))))))
1489           )
1490
1491      (string-append
1492       "  {\n"
1493       (if (equal? when 'after)
1494           (string-append
1495            "    int referenced = 0;\n"
1496            "    unsigned long long insn_referenced = abuf->written;\n")
1497           "")
1498       ; Declare variables to hold unit arguments.
1499       (string-map (lambda (arg) (gen-arg-decl arg #f))
1500                   inputs)
1501       (string-map (lambda (arg) (gen-arg-decl arg #t))
1502                   outputs)
1503       ; Initialize 'em, being careful not to initialize an operand that
1504       ; has an override.
1505       (let (; Make a list of names of in/out overrides.
1506             (in-overrides (find-apply cadr
1507                                       (lambda (elm) (eq? (car elm) 'in))
1508                                       overrides))
1509             (out-overrides (find-apply cadr
1510                                       (lambda (elm) (eq? (car elm) 'out))
1511                                       overrides)))
1512         (string-append
1513          (string-map (lambda (arg)
1514                        (if (memq (car arg) in-overrides)
1515                            ""
1516                            (gen-arg-init arg #f)))
1517                      inputs)
1518          (string-map (lambda (arg)
1519                        (if (memq (car arg) out-overrides)
1520                            ""
1521                            (gen-arg-init arg #t)))
1522                      outputs)))
1523       (string-map (lambda (arg)
1524                     (case (car arg)
1525                       ((pred) "")
1526                       ((cycles) "")
1527                       ((in)
1528                        (if (caddr arg)
1529                            (string-append "    in_"
1530                                           (gen-c-symbol (cadr arg))
1531                                           " = "
1532                                           (gen-argbuf-ref
1533                                            (string-append
1534                                             "in_"
1535                                             (gen-c-symbol (caddr arg))))
1536                                           ";\n")
1537                            ""))
1538                       ((out)
1539                        (if (caddr arg)
1540                            (string-append "    out_"
1541                                           (gen-c-symbol (cadr arg))
1542                                           " = "
1543                                           (gen-argbuf-ref
1544                                            (string-append
1545                                             "out_"
1546                                             (gen-c-symbol (caddr arg))))
1547                                           ";\n")
1548                            ""))
1549                       (else
1550                        (parse-error "insn function unit spec"
1551                                     "invalid spec" arg))))
1552                   overrides)
1553       ; Create bitmask indicating which args were referenced.
1554       (if (equal? when 'after)
1555           (string-append
1556            (string-map (lambda (arg num) (gen-ref-arg arg num 'in))
1557                        inputs
1558                        (iota (length inputs)))
1559            (string-map (lambda (arg num) (gen-ref-arg arg num 'out))
1560                        outputs
1561                        (iota (length outputs)
1562                              (length inputs))))
1563           "")
1564       ; Emit the call to the handler.
1565       "    " cycles-var-name " += "
1566       (gen-model-unit-fn-name (unit:model self) self when)
1567       " (current_cpu, idesc"
1568       ", " (number->string unit-num)
1569       (if (equal? when 'after) ", referenced" "")
1570       (string-map (lambda (arg) (gen-arg-arg arg #f))
1571                   inputs)
1572       (string-map (lambda (arg) (gen-arg-arg arg #t))
1573                   outputs)
1574       ");\n"
1575       "  }\n"
1576       )))
1577 )
1578
1579 ; Return C code to profile an insn-specific unit's usage.
1580 ; UNIT-NUM is number of the unit in INSN.
1581
1582 (method-make!
1583  <iunit> 'gen-profile-code
1584  (lambda (self unit-num insn when cycles-var-name)
1585    (let ((args (iunit:args self))
1586          (unit (iunit:unit self)))
1587      (send unit 'gen-profile-code unit-num insn when args cycles-var-name)))
1588 )
1589 \f
1590 ; Mode support.
1591
1592 ; Generate a table of mode data.
1593 ; For now all we need is the names.
1594
1595 (define (gen-mode-defs)
1596   (string-append
1597    "const char *mode_names[] = {\n"
1598    (string-map (lambda (m)
1599                  (string-append "  \"" (string-upcase (obj:str-name m)) "\",\n"))
1600                ; We don't treat aliases as being different from the real
1601                ; mode here, so ignore them.
1602                (mode-list-non-alias-values))
1603    "};\n\n"
1604    )
1605 )
1606 \f
1607 ; Insn profiling support.
1608
1609 ; Generate declarations for local variables needed for modelling code.
1610
1611 (method-make!
1612  <insn> 'gen-profile-locals
1613  (lambda (self model)
1614 ;   (let ((cti? (or (has-attr? self 'UNCOND-CTI)
1615 ;                  (has-attr? self 'COND-CTI))))
1616 ;     (string-append
1617 ;      (if cti? "  int UNUSED taken_p = 0;\n" "")
1618 ;      ))
1619    "")
1620 )
1621
1622 ; Generate C code to profile INSN.
1623
1624 (method-make!
1625  <insn> 'gen-profile-code
1626  (lambda (self model when cycles-var-name)
1627    (string-append
1628     (let ((timing (assq-ref (insn-timing self) (obj:name model))))
1629       (if timing
1630           (string-map (lambda (iunit unit-num)
1631                         (send iunit 'gen-profile-code unit-num self when cycles-var-name))
1632                       (timing:units timing)
1633                       (iota (length (timing:units timing))))
1634           (send (model-default-unit model) 'gen-profile-code 0 self when nil cycles-var-name)))
1635     ))
1636 )
1637 \f
1638 ; Instruction support.
1639
1640 ; Return list of all instructions to use for scache engine.
1641 ; This is all real insns plus the `invalid' and `cond' virtual insns.
1642 ; It does not include the pbb virtual insns.
1643
1644 (define (scache-engine-insns)
1645   (non-multi-insns (non-alias-pbb-insns (current-insn-list)))
1646 )
1647
1648 ; Return list of all instructions to use for pbb engine.
1649 ; This is all real insns plus the `invalid' and `cond' virtual insns.
1650
1651 (define (pbb-engine-insns)
1652   (non-multi-insns (real-insns (current-insn-list)))
1653 )
1654
1655 ; Create the virtual insns.
1656
1657 (define (-create-virtual-insns! isa)
1658   (let ((isa-name (obj:name isa))
1659         (context "virtual insns"))
1660
1661     (current-insn-add!
1662      (insn-read context
1663                 '(name x-invalid)
1664                 '(comment "invalid insn handler")
1665                 `(attrs VIRTUAL (ISA ,isa-name))
1666                 '(syntax "--invalid--")
1667                 '(semantics (c-code VOID "\
1668   {
1669     current_cpu->invalid_insn (pc);
1670     assert (0);
1671     /* NOTREACHED */
1672   }
1673 "))
1674                 ))
1675
1676     (if (with-pbb?)
1677         (begin
1678           (current-insn-add!
1679            (insn-read context
1680                       '(name x-begin)
1681                       '(comment "pbb begin handler")
1682                       `(attrs VIRTUAL PBB (ISA ,isa-name))
1683                       '(syntax "--begin--")
1684                       '(semantics (c-code VOID "\
1685   {
1686     vpc = current_cpu->@prefix@_pbb_begin (current_cpu->h_pc_get ());
1687   }
1688 "))
1689                       ))
1690
1691           (current-insn-add!
1692            (insn-read context
1693                       '(name x-chain)
1694                       '(comment "pbb chain handler")
1695                       `(attrs VIRTUAL PBB (ISA ,isa-name))
1696                       '(syntax "--chain--")
1697                       '(semantics (c-code VOID "\
1698   {
1699     vpc = current_cpu->@prefix@_engine.pbb_chain (current_cpu, abuf);
1700     // If we don't have to give up control, don't.
1701     // Note that we may overrun step_insn_count since we do the test at the
1702     // end of the block.  This is defined to be ok.
1703     if (UNLIKELY(current_cpu->stop_after_insns_p (abuf->fields.chain.insn_count)))
1704       BREAK (vpc);
1705   }
1706 "))
1707                       ))
1708
1709           (current-insn-add!
1710            (insn-read context
1711                       '(name x-cti-chain)
1712                       '(comment "pbb cti-chain handler")
1713                       `(attrs VIRTUAL PBB (ISA ,isa-name))
1714                       '(syntax "--cti-chain--")
1715                       '(semantics (c-code VOID "\
1716   {
1717     vpc = current_cpu->@prefix@_engine.pbb_cti_chain (current_cpu, abuf, pbb_br_status, pbb_br_npc);
1718     // If we don't have to give up control, don't.
1719     // Note that we may overrun step_insn_count since we do the test at the
1720     // end of the block.  This is defined to be ok.
1721     if (UNLIKELY(current_cpu->stop_after_insns_p (abuf->fields.chain.insn_count)))
1722       BREAK (vpc);
1723   }
1724 "))
1725                       ))
1726
1727           (current-insn-add!
1728            (insn-read context
1729                       '(name x-before)
1730                       '(comment "pbb before handler")
1731                       `(attrs VIRTUAL PBB (ISA ,isa-name))
1732                       '(syntax "--before--")
1733                       '(semantics (c-code VOID "\
1734   {
1735     current_cpu->@prefix@_engine.pbb_before (current_cpu, abuf);
1736   }
1737 "))
1738                       ))
1739
1740           (current-insn-add!
1741            (insn-read context
1742                       '(name x-after)
1743                       '(comment "pbb after handler")
1744                       `(attrs VIRTUAL PBB (ISA ,isa-name))
1745                       '(syntax "--after--")
1746                       '(semantics (c-code VOID "\
1747   {
1748     current_cpu->@prefix@_engine.pbb_after (current_cpu, abuf);
1749   }
1750 "))
1751                       ))
1752
1753           ))
1754
1755     ; If entire instruction set is conditionally executed, create a virtual
1756     ; insn to handle that.
1757     (if (and (with-pbb?)
1758              (isa-conditional-exec? isa))
1759         (current-insn-add!
1760          (insn-read context
1761                     '(name x-cond)
1762                     '(syntax "conditional exec test")
1763                     `(attrs VIRTUAL PBB (ISA ,isa-name))
1764                     '(syntax "--cond--")
1765                     (list 'semantics (list 'c-code 'VOID
1766                                            (string-append "\
1767   {
1768     // Assume branch not taken.
1769     pbb_br_status = BRANCH_UNTAKEN;
1770     UINT cond_code = abuf->cond;
1771     BI exec_p = "
1772     (rtl-c++ DFLT (cadr (isa-condition isa)) '((cond-code UINT "cond_code"))
1773              #:rtl-cover-fns? #t)
1774     ";
1775     if (! exec_p)
1776       ++vpc;
1777   }
1778 ")))
1779                     )))
1780     )
1781 )
1782
1783 ; Return a boolean indicating if INSN should be split.
1784
1785 (define (-decode-split-insn? insn isa)
1786   (let loop ((split-specs (isa-decode-splits isa)))
1787     (cond ((null? split-specs)
1788            #f)
1789           ((let ((f-name (decode-split-name (car split-specs))))
1790              (and (insn-has-ifield? insn f-name)
1791                   (let ((constraint
1792                          (decode-split-constraint (car split-specs))))
1793                     (or (not constraint)
1794                         (rtl-eval -FIXME-unfinished-)))))
1795            #t)
1796           (else (loop (cdr split-specs)))))
1797 )
1798
1799 ; Subroutine of -decode-split-insn-1.
1800 ; Build the ifield-assertion for ifield F-NAME.
1801 ; VALUE is either a number or a non-empty list of numbers.
1802
1803 (define (-decode-split-build-assertion f-name value)
1804   (if (number? value)
1805       (rtx-make 'eq 'INT (rtx-make 'ifield f-name) (rtx-make 'const 'INT value))
1806       (rtx-make 'member (rtx-make 'ifield f-name)
1807                 (apply rtx-make (cons 'number-list (cons 'INT value)))))
1808 )
1809
1810 ; Subroutine of -decode-split-insn.
1811 ; Specialize INSN according to <decode-split> dspec.
1812
1813 (define (-decode-split-insn-1 insn dspec)
1814   (let ((f-name (decode-split-name dspec))
1815         (values (decode-split-values dspec)))
1816     (let ((result (map object-copy-top (make-list (length values) insn))))
1817       (for-each (lambda (insn-copy value)
1818                   (obj-set-name! insn-copy
1819                                  (symbol-append (obj:name insn-copy)
1820                                                 '-
1821                                                 (car value)))
1822                   (obj-cons-attr! insn-copy (bool-attr-make 'DECODE-SPLIT #t))
1823                   (let ((existing-assertion (insn-ifield-assertion insn-copy))
1824                         (split-assertion
1825                          (-decode-split-build-assertion f-name (cadr value))))
1826                     (insn-set-ifield-assertion!
1827                      insn-copy
1828                      (if existing-assertion
1829                          (rtx-make 'andif split-assertion existing-assertion)
1830                          split-assertion)))
1831                   )
1832                 result values)
1833       result))
1834 )
1835
1836 ; Split INSN.
1837 ; The result is a list of the split copies of INSN.
1838
1839 (define (-decode-split-insn insn isa)
1840   (logit 3 "Splitting " (obj:name insn) " ...\n")
1841   (let loop ((splits (isa-decode-splits isa)) (result nil))
1842     (cond ((null? splits)
1843            result)
1844           ; FIXME: check constraint
1845           ((insn-has-ifield? insn (decode-split-name (car splits)))
1846            ; At each iteration, split the result of the previous.
1847            (loop (cdr splits)
1848                  (if (null? result)
1849                      (-decode-split-insn-1 insn (car splits))
1850                      (apply append
1851                             (map (lambda (insn)
1852                                    (-decode-split-insn-1 insn (car splits)))
1853                                  result)))))
1854           (else
1855            (loop (cdr splits) result))))
1856 )
1857
1858 ; Create copies of insns to be split.
1859 ; ??? better phrase needed?  Possible confusion with gcc's define-split.
1860 ; The original insns are then marked as aliases so the simulator ignores them.
1861
1862 (define (-fill-sim-insn-list!)
1863   (let ((isa (current-isa)))
1864
1865     (if (not (null? (isa-decode-splits isa)))
1866
1867         (begin
1868           (logit 1 "Splitting instructions ...\n")
1869           ; FIXME: We shouldn't need to know the innards of how insn lists
1870           ; are recorded.
1871           (let loop ((insns (current-raw-insn-list)))
1872             (if (null? insns)
1873                 #f ; done
1874                 (let ((insn (insn-list-car insns)))
1875                   (if (and (insn-real? insn)
1876                            (insn-semantics insn)
1877                            (-decode-split-insn? insn isa))
1878                       (begin
1879                         (for-each (lambda (new-insn)
1880                                     ; Splice new insns next to original.
1881                                     ; Keeps things tidy and generated code
1882                                     ; easier to read for human viewer.
1883                                     (let ((new-list (insn-list-splice! insns new-insn)))
1884                                       ; Assign insns separately.  Paranoia,
1885                                       ; insn-list-splice! modifies the list.
1886                                       (set! insns new-list))
1887                                     )
1888                                   (-decode-split-insn insn isa))
1889                         (obj-cons-attr! insn (bool-attr-make 'ALIAS #t))))
1890                   (loop (cdr insns)))))
1891           (logit 1 "Done splitting.\n"))
1892         ))
1893
1894   *UNSPECIFIED*
1895 )
1896 \f
1897 ; .cpu file loading support
1898
1899 ; Only run sim-analyze-insns! once.
1900 (define -sim-insns-analyzed? #f)
1901
1902 ; List of computed sformat argument buffers.
1903 (define -sim-sformat-argbuf-list #f)
1904 (define (current-sbuf-list) -sim-sformat-argbuf-list)
1905
1906 ; Called before the .cpu file has been read in.
1907
1908 (define (sim-init!)
1909   (set! -sim-insns-analyzed? #f)
1910   (set! -sim-sformat-argbuf-list #f)
1911   (if (with-sem-frags?)
1912       (sim-sfrag-init!))
1913   *UNSPECIFIED*
1914 )
1915
1916 ; Called after the .cpu file has been read in.
1917
1918 (define (sim-finish!)
1919   ; Specify FUN-GET/SET in the .sim file to cause all hardware references to
1920   ; go through methods, thus allowing the programmer to override them.
1921   (define-attr '(for hardware) '(type boolean) '(name FUN-GET)
1922     '(comment "read hardware elements via cover functions/methods"))
1923   (define-attr '(for hardware) '(type boolean) '(name FUN-SET)
1924     '(comment "write hardware elements via cover functions/methods"))
1925
1926   ; If there is a .sim file, load it.
1927   (let ((sim-file (string-append srcdir "/cpu/"
1928                                  (symbol->string (current-arch-name))
1929                                  ".sim")))
1930     (if (file-exists? sim-file)
1931         (begin
1932           (display (string-append "Loading sim file " sim-file " ...\n"))
1933           (reader-read-file! sim-file))))
1934
1935   ; If we're building files for an isa, create the virtual insns.
1936   (if (not (keep-isa-multiple?))
1937       (-create-virtual-insns! (current-isa)))
1938
1939   *UNSPECIFIED*
1940 )
1941
1942 ; Called after file is read in and global error checks are done
1943 ; to initialize tables.
1944
1945 (define (sim-analyze!)
1946   *UNSPECIFIED*
1947 )
1948
1949 ; Scan insns, copying them to the simulator insn list, splitting the
1950 ; requested insns, then analyze the semantics and compute instruction formats.
1951 ; 'twould be nice to do this in sim-analyze! but it doesn't know whether this
1952 ; needs to be done or not (which is determined by what files are being
1953 ; generated).  Since this is an expensive operation, we defer doing this
1954 ; to the files that need it.
1955
1956 (define (sim-analyze-insns!)
1957   ; This can only be done if one isa and one cpu family is being kept.
1958   (assert-keep-one)
1959
1960   (if (not -sim-insns-analyzed?)
1961
1962       (begin
1963         (-fill-sim-insn-list!)
1964
1965         (arch-analyze-insns! CURRENT-ARCH
1966                              #f ; don't include aliases
1967                              #t) ; do analyze the semantics
1968
1969         ; Compute the set of sformat argument buffers.
1970         (set! -sim-sformat-argbuf-list
1971               (compute-sformat-argbufs! (current-sfmt-list)))
1972
1973         (set! -sim-insns-analyzed? #t)
1974         ))
1975
1976   ; Do our own error checking.
1977   (assert (current-insn-lookup 'x-invalid))
1978
1979   *UNSPECIFIED*
1980 )