cgen/sid.scm

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