cgen/sim.scm

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