cgen/sim.scm

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