cgen/insn.scm

   1 ; Instruction definitions.
   2 ; Copyright (C) 2000 Red Hat, Inc.
   3 ; This file is part of CGEN.
   4 ; See file COPYING.CGEN for details.
   5
   6 ; Class to hold an insn.
   7
   8 (define <insn>
   9   (class-make '<insn>
  10               '(<ident>)
  11               '(
  12                 ; Used to explicitly specify mnemonic, now it's computed from
  13                 ; syntax string.  ??? Might be useful as an override someday.
  14                 ;mnemonic
  15
  16                 ; Instruction syntax string.
  17                 syntax
  18
  19                 ; The insn fields as specified in the .cpu file.
  20                 ; Also contains values for constant fields.
  21                 iflds
  22                 (iflds-values . #f) ; Lazily computed cache
  23
  24                 ; RTL source of assertions of ifield values or #f if none.
  25                 ; This is used, for example, by the decoder to help
  26                 ; distinguish what would otherwise be an ambiguity in the
  27                 ; specification.  It is also used by decode-split support.
  28                 ; ??? It could also be used the the assembler/disassembler
  29                 ; some day.
  30                 (ifield-assertion . #f)
  31
  32                 ; The <fmt-desc> of the insn.
  33                 ; This is used to help calculate the ifmt,sfmt members.
  34                 fmt-desc
  35
  36                 ; The <iformat> of the insn.
  37                 ifmt
  38
  39                 ; The <sformat> of the insn.
  40                 sfmt
  41
  42                 ; Temp slot for use by applications.
  43                 ; ??? Will go away in time.
  44                 tmp
  45
  46                 ; Instruction semantics.
  47                 ; This is the rtl in source form or #f if there is none.
  48                 ;
  49                 ; There are a few issues (ick, I hate that word) to consider
  50                 ; here:
  51                 ; - some apps don't need the trap checks (e.g. SIGSEGV)
  52                 ; - some apps treat the pieces in different ways
  53                 ; - the simulator tries to merge common fragments among insns
  54                 ;   to reduce code size in a pbb simulator
  55                 ;
  56                 ; Some insns don't have any semantics at all, they are defined
  57                 ; in another insn [akin to anonymous patterns in gcc].  wip.
  58                 ;
  59                 ; ??? GCC-like apps will need a new field to allow specifying
  60                 ; the semantics if a different value is needed.  wip.
  61                 ; ??? May wish to put this and the compiled forms in a
  62                 ; separate class.
  63                 ; ??? Contents of trap expressions is wip.  It will probably
  64                 ; be a sequence with an #:errchk modifier or some such.
  65                 (semantics . #f)
  66
  67                 ; The processed form of the above.
  68                 ; Each element of rtl is replaced with the associated object.
  69                 (compiled-semantics . #f)
  70
  71                 ; The mapping of the semantics onto the host.
  72                 ; FIXME: Not sure what its value will be.
  73                 ; Another thing that will be needed is [in some cases] a more
  74                 ; simplified version of the RTL for use by apps like compilers.
  75                 ; Perhaps that's what this will become.
  76                 host-semantics
  77
  78                 ; The function unit usage of the instruction.
  79                 timing
  80                 )
  81               nil)
  82 )
  83
  84 (method-make-make! <insn>
  85                    '(name comment attrs syntax iflds ifield-assertion
  86                           semantics timing)
  87 )
  88
  89 ; Accessor fns
  90
  91 (define-getters <insn> insn
  92   (syntax iflds ifield-assertion fmt-desc ifmt sfmt tmp
  93           semantics compiled-semantics host-semantics timing)
  94 )
  95
  96 (define-setters <insn> insn
  97   (fmt-desc ifmt sfmt ifield-assertion compiled-semantics)
  98 )
  99
 100 ; Return a boolean indicating if X is an <insn>.
 101
 102 (define (insn? x) (class-instance? <insn> x))
 103
 104 ; Return a list of the machs that support INSN.
 105
 106 (define (insn-machs insn)
 107   nil ; ??? wip
 108 )
 109
 110 ; Return the length of INSN in bits.
 111
 112 (define (insn-length insn)
 113   (ifmt-length (insn-ifmt insn))
 114 )
 115
 116 ; Return the length of INSN in bytes.
 117
 118 (define (insn-length-bytes insn)
 119   (bits->bytes (insn-length insn))
 120 )
 121
 122 ; Return instruction mnemonic.
 123 ; This is computed from the syntax string.
 124 ; The mnemonic, as we define it, is everything up to, but not including, the
 125 ; first space or '$'.
 126 ; FIXME: Rename to syntax-mnemonic, and take a syntax string argument.
 127
 128 (define (insn-mnemonic insn)
 129   (letrec ((mnem-len (lambda (str len)
 130                        (cond ((= (string-length str) 0) len)
 131                              ((char=? #\space (string-ref str 0)) len)
 132                              ((char=? #\$ (string-ref str 0)) len)
 133                              (else (mnem-len (string-drop1 str) (+ len 1)))))))
 134     (string-take (mnem-len (insn-syntax insn) 0) (insn-syntax insn)))
 135 )
 136
 137 ; Return enum cgen_insn_types value for INSN.
 138
 139 (define (insn-enum insn)
 140   (string-upcase (string-append "@ARCH@_INSN_" (gen-sym insn)))
 141 )
 142
 143 ; Return enum for insn named INSN-NAME.
 144 ; This is needed for the `invalid' insn, there is no object for it.
 145 ; [Though obviously having such an object seems like a good idea.]
 146
 147 (define (gen-insn-enum insn-name)
 148   (string-upcase (string-append "@ARCH@_INSN_" (gen-c-symbol insn-name)))
 149 )
 150 \f
 151 ; Insns with derived operands (see define-derived-operand).
 152 ; ??? These are [currently] recorded separately to minimize impact on existing
 153 ; code while the design is worked out.
 154 ;
 155 ; The class is called <multi-insn> because the insn has multiple variants,
 156 ; one for each combination of "anyof" alternatives.
 157 ; Internally we create one <insn> per alternative.  The theory is that this
 158 ; will remain an internal implementation issue.  When appropriate applications
 159 ; will collapse the number of insns in a way that is appropriate for them.
 160 ;
 161 ; ??? Another way to do this is with insn templates.  One problem the current
 162 ; way has is that it requires each operand's assembler syntax to be self
 163 ; contained (one way to fix this is to use "fake" operands like before).
 164 ; Insn templates needn't have this problem.  On the other hand insn templates
 165 ; [seem to] require more description file entries.
 166 ;
 167 ; ??? This doesn't use all of the members of <insn>.
 168 ; The <multi-insn> class is wip, but should eventually reorganize <insn>.
 169 ; This reorganization might also take into account real, virtual, etc. insns.
 170
 171 (define <multi-insn>
 172   (class-make '<multi-insn>
 173               '(<insn>)
 174               '(
 175                 ; An <insn> is created for each combination of "anyof"
 176                 ; alternatives.  They are recorded with other insns, but a
 177                 ; list of them is recorded here as well.
 178                 ; This is #f if the sub-insns haven't been instantiated yet.
 179                 (sub-insns . #f)
 180                 )
 181               nil)
 182 )
 183
 184 (method-make-make! <multi-insn>
 185                    '(name comment attrs syntax iflds ifield-assertion
 186                           semantics timing)
 187 )
 188
 189 (define-getters <multi-insn> multi-insn (sub-insns))
 190
 191 ; Return a boolean indicating if X is a <multi-insn>.
 192
 193 (define (multi-insn? x) (class-instance? <multi-insn> x))
 194
 195 ; Subroutine of -sub-insn-make! to create the ifield list.
 196 ; Return encoding of {insn} with each element of {anyof-operands} replaced
 197 ; with {new-values}.
 198 ; {value-names} is a list of names of {anyof-operands}.
 199
 200 (define (-sub-insn-ifields insn anyof-operands value-names new-values)
 201   ; (debug-repl-env insn anyof-operands value-names new-values)
 202
 203   ; Delete ifields of {anyof-operands} and add those for {new-values}.
 204   (let ((iflds
 205          (append!
 206           ; Delete ifields in {anyof-operands}.
 207           (find (lambda (f)
 208                   (not (and (ifld-anyof-operand? f)
 209                             (memq (obj:name (ifld-get-value f))
 210                                   value-names))))
 211                 (insn-iflds insn))
 212           ; Add ifields for {new-values}.
 213           (map derived-encoding new-values)))
 214
 215         ; Return the last ifield of OWNER in IFLD-LIST.
 216         ; OWNER is the object that owns the <ifield> we want.
 217         ; For ifields, the owner is the ifield itself.
 218         ; For operands, the owner is the operand.
 219         ; For derived operands, the owner is the "anyof" parent.
 220         ; IFLD-LIST is an unsorted list of <ifield> elements.
 221         (find-preceder
 222          (lambda (ifld-list owner)
 223            ;(debug-repl-env ifld-list owner)
 224            (cond ((ifield? owner)
 225                   owner)
 226                  ((anyof-operand? owner)
 227                   ; This is the interesting case.  The instantiated choice of
 228                   ; {owner} is in {ifld-list}.  We have to find it.
 229                   (let* ((name (obj:name owner))
 230                          (result
 231                           (find-first (lambda (f)
 232                                         (and (derived-ifield? f)
 233                                              (anyof-instance? (derived-ifield-owner f))
 234                                              (eq? name (obj:name (anyof-instance-parent (derived-ifield-owner f))))))
 235                                       ifld-list)))
 236                     ;(debug-repl-env ifld-list owner)
 237                     (assert result)
 238                     result))
 239                  ((operand? owner) ; derived operands are handled here too
 240                   (let ((result (op-ifield owner)))
 241                     (assert result)
 242                     result))
 243                  (else
 244                   (error "`owner' not <ifield>, <operand>, or <derived-operand>")))))
 245         )
 246
 247     ; Resolve any `follows' specs.
 248     ; Bad worst case performance but ifield lists aren't usually that long.
 249     ; FIXME: Doesn't handle A following B following C.
 250     (map (lambda (f)
 251            (let ((follows (ifld-follows f)))
 252              (if follows
 253                  (let ((preceder (find-preceder iflds follows)))
 254                    (ifld-new-word-offset f (ifld-next-word preceder)))
 255                  f)))
 256          iflds))
 257 )
 258
 259
 260 ; Subroutine of multi-insn-instantiate! to instantiate one insn.
 261 ; INSN is the parent insn.
 262 ; ANYOF-OPERANDS is a list of the <anyof-operand>'s of INSN.
 263 ; NEW-VALUES is a list of the value to use for each corresponding element in
 264 ; ANYOF-OPERANDS.  Each element is a <derived-operand>.
 265
 266 (define (-sub-insn-make! insn anyof-operands new-values)
 267   ;(debug-repl-env insn anyof-operands new-values)
 268   (assert (= (length anyof-operands) (length new-values)))
 269   (assert (all-true? (map anyof-operand? anyof-operands)))
 270   (assert (all-true? (map derived-operand? new-values)))
 271   (logit 3 "Instantiating "
 272          (obj:name insn)
 273          ":"
 274          (string-map (lambda (op newval)
 275                        (string-append " "
 276                                       (obj:name op)
 277                                       "="
 278                                       (obj:name newval)))
 279                      anyof-operands new-values)
 280          " ...\n")
 281
 282 ;  (if (eq? '@sib+disp8-QI-disp32-8
 283 ;          (obj:name (car new-values)))
 284 ;      (debug-repl-env insn anyof-operands new-values))
 285
 286   (let* ((value-names (map obj:name anyof-operands))
 287          (ifields (-sub-insn-ifields insn anyof-operands value-names new-values))
 288          (known-values (ifld-known-values ifields)))
 289
 290     ; Don't create insn if ifield assertions fail.
 291     (if (all-true? (map (lambda (op)
 292                           (anyof-satisfies-assertions? op known-values))
 293                         new-values))
 294
 295         (let ((sub-insn
 296                (make <insn>
 297                      (apply symbol-append
 298                             (cons (obj:name insn)
 299                                   (map (lambda (anyof)
 300                                          (symbol-append '- (obj:name anyof)))
 301                                        new-values)))
 302                      (obj:comment insn)
 303                      (obj-atlist insn)
 304                      (-anyof-merge-syntax (insn-syntax insn)
 305                                           value-names new-values)
 306                      ifields
 307                      (insn-ifield-assertion insn) ; FIXME
 308                      (anyof-merge-semantics (insn-semantics insn)
 309                                             value-names new-values)
 310                      (insn-timing insn)
 311                      )))
 312           (logit 3 "   instantiated.\n")
 313           (current-insn-add! sub-insn))
 314
 315         (begin
 316           logit 3 "    failed ifield assertions.\n")))
 317
 318   *UNSPECIFIED*
 319 )
 320
 321 ; Instantiate all sub-insns of MULTI-INSN.
 322 ; ??? Might be better to return the list of insns, rather than add them to
 323 ; the global list, and leave it to the caller to add them.
 324
 325 (define (multi-insn-instantiate! multi-insn)
 326   (logit 2 "Instantiating " (obj:name multi-insn) " ...\n")
 327
 328   ; We shouldn't get called more than once.
 329   ; ??? Though we could ignore second and subsequent calls.
 330   (assert (not (multi-insn-sub-insns multi-insn)))
 331
 332   (let ((iflds (insn-iflds multi-insn)))
 333
 334     ; What we want to create here is the set of all "anyof" alternatives.
 335     ; From that we create one <insn> per alternative.
 336
 337     (let ((anyof-iflds (find ifld-anyof-operand? iflds)))
 338
 339       (assert (all-true? (map anyof-operand? (map ifld-get-value anyof-iflds))))
 340       ;(display (obj:name multi-insn) (current-error-port))
 341       ;(display " anyof: " (current-error-port))
 342       ;(display (map obj:name (map ifld-get-value anyof-iflds)) (current-error-port))
 343       ;(newline (current-error-port))
 344
 345       ; Iterate over all combinations.
 346       ; TODO is a list with one element for each <anyof-operand>.
 347       ; Each element is in turn a list of all choices (<derived-operands>'s)
 348       ; for the <anyof-operand>.  Note that some of these values may be
 349       ; derived from nested <anyof-operand>'s.
 350       ; ??? anyof-all-choices should cache the results.
 351       ; ??? Need to cache results of assertion processing in addition or
 352       ; instead of anyof-all-choices.
 353
 354       (let* ((anyof-operands (map ifld-get-value anyof-iflds))
 355              (todo (map anyof-all-choices anyof-operands))
 356              (lengths (map length todo))
 357              (total (apply * lengths)))
 358         ; ??? One might prefer a `do' loop here, but every time I see one I
 359         ; have to spend too long remembering its syntax.
 360         (let loop ((i 0))
 361           (if (< i total)
 362               (let* ((indices (split-value lengths i))
 363                      (anyof-instances (map list-ref todo indices)))
 364                 ;(display "derived: " (current-error-port))
 365                 ;(display (map obj:name anyof-instances) (current-error-port))
 366                 ;(newline (current-error-port))
 367                 (-sub-insn-make! multi-insn anyof-operands anyof-instances)
 368                 (loop (+ i 1))))))))
 369
 370   *UNSPECIFIED*
 371 )
 372 \f
 373 ; Parse an instruction description.
 374 ; This is the main routine for building an insn object from a
 375 ; description in the .cpu file.
 376 ; All arguments are in raw (non-evaluated) form.
 377 ; The result is the parsed object or #f if insn isn't for selected mach(s).
 378
 379 (define (-insn-parse errtxt name comment attrs syntax fmt ifield-assertion
 380                      semantics timing)
 381   (logit 2 "Processing insn " name " ...\n")
 382
 383   (let ((name (parse-name name errtxt))
 384         (atlist-obj (atlist-parse attrs "cgen_insn" errtxt)))
 385
 386     (if (keep-atlist? atlist-obj #f)
 387
 388         (let ((ifield-assertion (if (not (null? ifield-assertion))
 389                                     ifield-assertion
 390                                     #f))
 391               (semantics (if (not (null? semantics))
 392                              semantics
 393                              #f))
 394               (format (-parse-insn-format (string-append errtxt " format")
 395                                           fmt))
 396               (comment (parse-comment comment errtxt))
 397               ; If there are no semantics, mark this as an alias.
 398               ; ??? Not sure this makes sense for multi-insns.
 399               (atlist-obj (if semantics
 400                               atlist-obj
 401                               (atlist-cons (bool-attr-make 'ALIAS #t)
 402                                            atlist-obj)))
 403               (syntax (parse-syntax syntax errtxt))
 404               (timing (parse-insn-timing errtxt timing))
 405               )
 406
 407           (if (anyof-operand-format? format)
 408
 409               (make <multi-insn>
 410                 name comment atlist-obj
 411                 syntax
 412                 format
 413                 ifield-assertion
 414                 semantics
 415                 timing)
 416
 417               (make <insn>
 418                 name comment atlist-obj
 419                 syntax
 420                 format
 421                 ifield-assertion
 422                 semantics
 423                 timing)))
 424
 425         (begin
 426           (logit 2 "Ignoring " name ".\n")
 427           #f)))
 428 )
 429
 430 ; Read an instruction description.
 431 ; This is the main routine for analyzing instructions in the .cpu file.
 432 ; ERRTXT is prepended to error messages to provide context.
 433 ; ARG-LIST is an associative list of field name and field value.
 434 ; -insn-parse is invoked to create the <insn> object.
 435
 436 (define (insn-read errtxt . arg-list)
 437   (let ((name nil)
 438         (comment "")
 439         (attrs nil)
 440         (syntax nil)
 441         (fmt nil)
 442         (ifield-assertion nil)
 443         (semantics nil)
 444         (timing nil)
 445         )
 446     ; Loop over each element in ARG-LIST, recording what's found.
 447     (let loop ((arg-list arg-list))
 448       (if (null? arg-list)
 449           nil
 450           (let ((arg (car arg-list))
 451                 (elm-name (caar arg-list)))
 452             (case elm-name
 453               ((name) (set! name (cadr arg)))
 454               ((comment) (set! comment (cadr arg)))
 455               ((attrs) (set! attrs (cdr arg)))
 456               ((syntax) (set! syntax (cadr arg)))
 457               ((format) (set! fmt (cadr arg)))
 458               ((ifield-assertion) (set! ifield-assertion (cadr arg)))
 459               ((semantics) (set! semantics (cadr arg)))
 460               ((timing) (set! timing (cdr arg)))
 461               (else (parse-error errtxt "invalid insn arg" arg)))
 462             (loop (cdr arg-list)))))
 463     ; Now that we've identified the elements, build the object.
 464     (-insn-parse errtxt name comment attrs syntax fmt ifield-assertion
 465                  semantics timing)
 466     )
 467 )
 468
 469 ; Define an instruction object, name/value pair list version.
 470
 471 (define define-insn
 472   (lambda arg-list
 473     (let ((i (apply insn-read (cons "define-insn" arg-list))))
 474       (if i
 475           (current-insn-add! i))
 476       i))
 477 )
 478
 479 ; Define an instruction object, all arguments specified.
 480
 481 (define (define-full-insn name comment attrs syntax fmt ifield-assertion
 482           semantics timing)
 483   (let ((i (-insn-parse "define-full-insn" name comment attrs
 484                         syntax fmt ifield-assertion
 485                         semantics timing)))
 486     (if i
 487         (current-insn-add! i))
 488     i)
 489 )
 490 \f
 491 ; Parsing support.
 492
 493 ; Parse an insn syntax field.
 494 ; SYNTAX is either a string or a list of strings, each element of which may
 495 ; in turn be a list of strings.
 496 ; ??? Not sure this extra flexibility is worth it yet.
 497
 498 (define (parse-syntax syntax errtxt)
 499   (cond ((list? syntax)
 500          (string-map (lambda (elm) (parse-syntax elm errtxt)) syntax))
 501         ((or (string? syntax) (symbol? syntax))
 502          syntax)
 503         (else (parse-error errtxt "improper syntax" syntax)))
 504 )
 505
 506 ; Subroutine of -parse-insn-format to parse a symbol ifield spec.
 507
 508 (define (-parse-insn-format-symbol errtxt sym)
 509   ;(debug-repl-env sym)
 510   (let ((op (current-op-lookup sym)))
 511     (if op
 512         (cond ((derived-operand? op)
 513                ; There is a one-to-one relationship b/w derived operands and
 514                ; the associated derived ifield.
 515                (let ((ifld (op-ifield op)))
 516                  (assert (derived-ifield? ifld))
 517                  ifld))
 518               ((anyof-operand? op)
 519                (ifld-new-value f-anyof op))
 520               (else
 521                (let ((ifld (op-ifield op)))
 522                  (ifld-new-value ifld op))))
 523         ; An insn-enum?
 524         (let ((e (ienum-lookup-val sym)))
 525           (if e
 526               (ifld-new-value (ienum:fld (cdr e)) (car e))
 527               (parse-error errtxt "bad format element, expecting symbol to be operand or insn enum" sym)))))
 528 )
 529
 530 ; Subroutine of -parse-insn-format to parse an (ifield-name value) ifield spec.
 531 ;
 532 ; The last element is the ifield's value.  It must be an integer.
 533 ; ??? Whether it can be negative is still unspecified.
 534 ; ??? While there might be a case where allowing floating point values is
 535 ; desirable, supporting them would require precise conversion routines.
 536 ; They should be rare enough that we instead punt.
 537 ;
 538 ; ??? May wish to support something like "(% startbit bitsize value)".
 539 ;
 540 ; ??? Error messages need improvement, but that's generally true of cgen.
 541
 542 (define (-parse-insn-format-ifield-spec errtxt ifld ifld-spec)
 543   (if (!= (length ifld-spec) 2)
 544       (parse-error errtxt "bad ifield format, should be (ifield-name value)" ifld-spec))
 545
 546   (let ((value (cadr ifld-spec)))
 547     ; ??? This use to allow (ifield-name operand-name).  That's how
 548     ; `operand-name' elements are handled, but there's no current need
 549     ; to handle (ifield-name operand-name).
 550     (if (not (integer? value))
 551         (parse-error errtxt "ifield value not an integer" ifld-spec))
 552     (ifld-new-value ifld value))
 553 )
 554
 555 ; Subroutine of -parse-insn-format to parse an
 556 ; (ifield-name value) ifield spec.
 557 ; ??? There is room for growth in the specification syntax here.
 558 ; Possibilities are (ifield-name|operand-name [options] [value]).
 559
 560 (define (-parse-insn-format-list errtxt spec)
 561   (let ((ifld (current-ifld-lookup (car spec))))
 562     (if ifld
 563         (-parse-insn-format-ifield-spec errtxt ifld spec)
 564         (parse-error errtxt "unknown ifield" spec)))
 565 )
 566
 567 ; Given an insn format field from a .cpu file, replace it with a list of
 568 ; ifield objects with the values assigned.
 569 ;
 570 ; An insn format field is a list of ifields that make up the instruction.
 571 ; All bits must be specified, including reserved bits
 572 ; [at present no checking is made of this, but the rule still holds].
 573 ;
 574 ; A normal entry begins with `+' and then consist of the following:
 575 ; - operand name
 576 ; - (ifield-name [options] value)
 577 ; - (operand-name [options] [value])
 578 ; - insn ifield enum
 579 ;
 580 ; Example: (+ OP1_ADD (f-res2 0) dr src1 (f-src2 1) (f-res1 #xea))
 581 ;
 582 ; where OP1_ADD is an enum, dr and src1 are operands, and f-src2 and f-res1
 583 ; are ifield's.  The `+' allows for future extension.
 584 ;
 585 ; The other form of entry begins with `=' and is followed by an instruction
 586 ; name that has the same format.  The specified instruction must already be
 587 ; defined.  Instructions with this form typically also include an
 588 ; `ifield-assertion' spec to keep them separate.
 589 ;
 590 ; An empty field list is ok.  This means it's unspecified.
 591 ; VIRTUAL insns have this.
 592 ;
 593 ; This is one of the more important routines to be efficient.
 594 ; It's called for each instruction, and is one of the more expensive routines
 595 ; in insn parsing.
 596
 597 (define (-parse-insn-format errtxt fld-list)
 598   (if (null? fld-list)
 599       nil ; field list unspecified
 600       (case (car fld-list)
 601         ((+) (map (lambda (fld)
 602                     (let ((f (if (string? fld)
 603                                  (string->symbol fld)
 604                                  fld)))
 605                       (cond ((symbol? f)
 606                              (-parse-insn-format-symbol errtxt f))
 607                             ((and (list? f)
 608                                   ; ??? This use to allow <ifield> objects
 609                                   ; in the `car' position.  Checked for below.
 610                                   (symbol? (car f)))
 611                              (-parse-insn-format-list errtxt f))
 612                             (else
 613                              (if (and (list? f)
 614                                       (ifield? (car f)))
 615                                  (parse-error errtxt "FIXME: <ifield> object in format spec"))
 616                              (parse-error errtxt "bad format element, neither symbol nor ifield spec" f)))))
 617                   (cdr fld-list)))
 618         ((=) (begin
 619                (if (or (!= (length fld-list) 2)
 620                        (not (symbol? (cadr fld-list))))
 621                    (parse-error errtxt
 622                                 "bad `=' format spec, should be `(= insn-name)'"
 623                                 fld-list))
 624                (let ((insn (current-insn-lookup (cadr fld-list))))
 625                  (if (not insn)
 626                      (parse-error errtxt "unknown insn" (cadr fld-list)))
 627                  (insn-iflds insn))))
 628         (else
 629          (parse-error errtxt "format must begin with `+' or `='" fld-list))
 630         ))
 631 )
 632
 633 ; Return a boolean indicating if IFLD-LIST contains anyof operands.
 634
 635 (define (anyof-operand-format? ifld-list)
 636   (any-true? (map (lambda (f)
 637                     (or (ifld-anyof? f)
 638                         (derived-ifield? f)))
 639                   ifld-list))
 640 )
 641 \f
 642 ; Insn utilities.
 643 ; ??? multi-insn support wip, may require changes here.
 644
 645 ; Return a boolean indicating if INSN is an alias insn.
 646
 647 (define (insn-alias? insn)
 648   (obj-has-attr? insn 'ALIAS)
 649 )
 650
 651 ; Return a list of instructions that are not aliases in INSN-LIST.
 652
 653 (define (non-alias-insns insn-list)
 654   (find (lambda (insn)
 655           (not (insn-alias? insn)))
 656         insn-list)
 657 )
 658
 659 ; Return a boolean indicating if INSN is a "real" INSN
 660 ; (not ALIAS and not VIRTUAL and not a <multi-insn>).
 661
 662 (define (insn-real? insn)
 663   (let ((atlist (obj-atlist insn)))
 664     (and (not (atlist-has-attr? atlist 'ALIAS))
 665          (not (atlist-has-attr? atlist 'VIRTUAL))
 666          (not (multi-insn? insn))))
 667 )
 668
 669 ; Return a list of real instructions in INSN-LIST.
 670
 671 (define (real-insns insn-list)
 672   (find insn-real? insn-list)
 673 )
 674
 675 ; Return a boolean indicating if INSN is a virtual insn.
 676
 677 (define (insn-virtual? insn)
 678   (obj-has-attr? insn 'VIRTUAL)
 679 )
 680
 681 ; Return a list of virtual instructions in INSN-LIST.
 682
 683 (define (virtual-insns insn-list)
 684   (find insn-virtual? insn-list)
 685 )
 686
 687 ; Return a list of non-alias/non-pbb insns in INSN-LIST.
 688
 689 (define (non-alias-pbb-insns insn-list)
 690   (find (lambda (insn)
 691           (let ((atlist (obj-atlist insn)))
 692             (and (not (atlist-has-attr? atlist 'ALIAS))
 693                  (not (atlist-has-attr? atlist 'PBB)))))
 694         insn-list)
 695 )
 696
 697 ; Return a list of multi-insns in INSN-LIST.
 698
 699 (define (multi-insns insn-list)
 700   (find multi-insn? insn-list)
 701 )
 702
 703 ; And the opposite:
 704
 705 (define (non-multi-insns insn-list)
 706   (find (lambda (insn) (not (multi-insn? insn))) insn-list)
 707 )
 708
 709
 710 ; Filter out instructions whose ifield patterns are strict supersets of
 711 ; another, keeping the less general cousin.  Used to resolve ambiguity
 712 ; when there are no more bits to consider.
 713
 714 (define (filter-non-specialized-ambiguous-insns insn-list)
 715   (logit 3 "Filtering " (length insn-list) " instructions for non specializations.\n")
 716   (find (lambda (insn)
 717           (let* ((i-mask (insn-base-mask insn))
 718                  (i-mask-len (insn-base-mask-length insn))
 719                  (i-value (insn-value insn))
 720                  (subset-insn (find-first
 721                                (lambda (insn2) ; insn2: possible submatch (more mask bits)
 722                                     (let ((i2-mask (insn-base-mask insn2))
 723                                           (i2-mask-len (insn-base-mask-length insn2))
 724                                           (i2-value (insn-value insn2)))
 725                                       (and (not (eq? insn insn2))
 726                                            (= i-mask-len i2-mask-len)
 727                                            (mask-superset? i-mask i-value i2-mask i2-value))))
 728                                   insn-list))
 729                  (keep? (not subset-insn)))
 730             (if (not keep?)
 731                 (logit 2
 732                        "Instruction " (obj:name insn) " specialization-filtered by "
 733                        (obj:name subset-insn) "\n"))
 734             keep?))
 735         insn-list)
 736 )
 737
 738 ; Filter out instructions whose ifield patterns are identical.
 739
 740 (define (filter-identical-ambiguous-insns insn-list)
 741   (logit 3 "Filtering " (length insn-list) " instructions for identical variants.\n")
 742   (let loop ((l insn-list) (result nil))
 743     (cond ((null? l) (reverse! result))
 744           ((find-identical-insn (car l) (cdr l)) (loop (cdr l) result))
 745           (else (loop (cdr l) (cons (car l) result)))
 746           )
 747     )
 748 )
 749
 750 (define (find-identical-insn insn insn-list)
 751   (let ((i-mask (insn-base-mask insn))
 752         (i-mask-len (insn-base-mask-length insn))
 753         (i-value (insn-value insn)))
 754     (find-first
 755      (lambda (insn2)
 756        (let ((i2-mask (insn-base-mask insn2))
 757              (i2-mask-len (insn-base-mask-length insn2))
 758              (i2-value (insn-value insn2)))
 759          (and (= i-mask-len i2-mask-len)
 760               (= i-mask i2-mask)
 761               (= i-value i2-value))))
 762        insn-list))
 763 )
 764
 765 ; Helper function for above: does (m1,v1) match a STRICT superset of (m2,v2) ?
 766 ;
 767 ; eg> mask-superset? #b1100 #b1000 #b1110 #b1010 -> #t
 768 ; eg> mask-superset? #b1100 #b1000 #b1010 #b1010 -> #f
 769 ; eg> mask-superset? #b1100 #b1000 #b1110 #b1100 -> #f
 770 ; eg> mask-superset? #b1100 #b1000 #b1100 #b1000 -> #f
 771 ;
 772 (define (mask-superset? m1 v1 m2 v2)
 773   (let ((result
 774          (and (= (cg-logand m1 m2) m1)
 775               (= (cg-logand m1 v1) (cg-logand m1 v2))
 776               (not (and (= m1 m2) (= v1 v2))))))
 777     (if result (logit 4
 778                       "(" (number->string m1 16) "," (number->string v1 16) ")"
 779                       " contains "
 780                       "(" (number->string m2 16) "," (number->string v2 16) ")"
 781                       "\n"))
 782     result)
 783 )
 784
 785
 786
 787
 788 ; Return a boolean indicating if INSN is a cti [control transfer insn].
 789 ; This includes SKIP-CTI insns even though they don't terminate a basic block.
 790 ; ??? SKIP-CTI insns are wip, waiting for more examples of how they're used.
 791
 792 (define (insn-cti? insn)
 793   (atlist-cti? (obj-atlist insn))
 794 )
 795
 796 ; Return a boolean indicating if INSN can be executed in parallel.
 797 ; Such insns are required to have enum attribute PARALLEL != NO.
 798 ; This is worded specifically to allow the PARALLEL attribute to have more
 799 ; than just NO/YES values (should a target want to do so).
 800 ; This specification may not be sufficient, but the intent is explicit.
 801
 802 (define (insn-parallel? insn)
 803   (let ((atval (obj-attr-value insn 'PARALLEL)))
 804     (and atval (not (eq? atval 'NO))))
 805 )
 806
 807 ; Return a list of the insns that support parallel execution in INSN-LIST.
 808
 809 (define (parallel-insns insn-list)
 810   (find insn-parallel? insn-list)
 811 )
 812 \f
 813 ; Instruction field utilities.
 814
 815 ; Return a boolean indicating if INSN has ifield named F-NAME.
 816
 817 (define (insn-has-ifield? insn f-name)
 818   (->bool (object-assq f-name (insn-iflds insn)))
 819 )
 820 \f
 821 ; Insn opcode value utilities.
 822
 823 ; Given INSN, return the length in bits of the base mask (insn-base-mask).
 824
 825 (define (insn-base-mask-length insn)
 826   (ifmt-mask-length (insn-ifmt insn))
 827 )
 828
 829 ; Given INSN, return the bitmask of constant values (the opcode field)
 830 ; in the base part.
 831
 832 (define (insn-base-mask insn)
 833   (ifmt-mask (insn-ifmt insn))
 834 )
 835
 836 ; Given INSN, return the sum of the constant values in the insn
 837 ; (i.e. the opcode field).
 838 ;
 839 ; See also (compute-insn-base-mask).
 840 ;
 841 (define (insn-value insn)
 842   (if (elm-get insn 'iflds-values)
 843       (elm-get insn 'iflds-values)
 844       (let* ((base-len (insn-base-mask-length insn))
 845              (value (apply +
 846                            (map (lambda (fld) (ifld-value fld base-len (ifld-get-value fld)))
 847                                 (find ifld-constant?
 848                                       (collect ifld-base-ifields (insn-iflds insn))))
 849                            )))
 850         (elm-set! insn 'iflds-values value)
 851         value)
 852       )
 853   )
 854 \f
 855 ; Insn operand utilities.
 856
 857 ; Lookup operand SEM-NAME in INSN.
 858
 859 (define (insn-lookup-op insn sem-name)
 860   (or (op:lookup-sem-name (sfmt-in-ops (insn-sfmt insn)) sem-name)
 861       (op:lookup-sem-name (sfmt-out-ops (insn-sfmt insn)) sem-name))
 862 )
 863 \f
 864 ; Insn syntax utilities.
 865
 866 ; Create a list of syntax strings broken up into a list of characters and
 867 ; operand objects.
 868
 869 (define (syntax-break-out syntax)
 870   (let ((result nil))
 871     ; ??? The style of the following could be more Scheme-like.  Later.
 872     (let loop ()
 873       (if (> (string-length syntax) 0)
 874           (begin
 875             (cond
 876              ; Handle escaped syntax metacharacters
 877              ((char=? #\\ (string-ref syntax 0))
 878               (begin
 879                 (if (= (string-length syntax) 1)
 880                     (parse-error context "syntax-break-out: missing char after '\\' in " syntax))
 881                 (set! result (cons (substring syntax 1 2) result))
 882                 (set! syntax (string-drop 2 syntax))))
 883                 ; Handle operand reference
 884              ((char=? #\$ (string-ref syntax 0))
 885               ; Extract the symbol from the string, get the operand.
 886               (if (char=? #\{ (string-ref syntax 1))
 887                   (let ((n (string-index syntax #\})))
 888                     (set! result (cons (current-op-lookup
 889                                         (string->symbol
 890                                          (substring syntax 2 n)))
 891                                        result))
 892                     (set! syntax (string-drop (+ 1 n) syntax)))
 893                   (let ((n (id-len (string-drop1 syntax))))
 894                     (set! result (cons (current-op-lookup
 895                                         (string->symbol
 896                                          (substring syntax 1 (+ 1 n))))
 897                                        result))
 898                     (set! syntax (string-drop (+ 1 n) syntax)))))
 899              ; Handle everything else
 900              (else (set! result (cons (substring syntax 0 1) result))
 901                    (set! syntax (string-drop1 syntax))))
 902             (loop))))
 903     (reverse result))
 904 )
 905
 906 ; Given a list of syntax elements (e.g. the result of syntax-break-out),
 907 ; create a syntax string.
 908
 909 (define (syntax-make elements)
 910   (apply string-append
 911          (map (lambda (e)
 912                 (cond ((char? e)
 913                        (string "\\" e))
 914                       ((string? e)
 915                        e)
 916                       (else
 917                        (assert (operand? e))
 918                        (string-append "${" (obj:name e) "}"))))
 919               elements))
 920 )
 921 \f
 922 ; Called before a .cpu file is read in.
 923
 924 (define (insn-init!)
 925   (reader-add-command! 'define-insn
 926                        "\
 927 Define an instruction, name/value pair list version.
 928 "
 929                        nil 'arg-list define-insn)
 930   (reader-add-command! 'define-full-insn
 931                        "\
 932 Define an instruction, all arguments specified.
 933 "
 934                        nil '(name comment attrs syntax fmt ifield-assertion semantics timing)
 935                        define-full-insn)
 936
 937   *UNSPECIFIED*
 938 )
 939
 940 ; Called before a . cpu file is read in to install any builtins.
 941
 942 (define (insn-builtin!)
 943   ; Standard insn attributes.
 944   ; ??? Some of these can be combined into one.
 945
 946   (define-attr '(for insn) '(type boolean) '(name UNCOND-CTI) '(comment "unconditional cti"))
 947
 948   (define-attr '(for insn) '(type boolean) '(name COND-CTI) '(comment "conditional cti"))
 949
 950   ; SKIP-CTI: one or more immediately following instructions are conditionally
 951   ; executed (or skipped)
 952   (define-attr '(for insn) '(type boolean) '(name SKIP-CTI) '(comment "skip cti"))
 953
 954   ; DELAY-SLOT: insn has one or more delay slots (wip)
 955   (define-attr '(for insn) '(type boolean) '(name DELAY-SLOT) '(comment "insn has a delay slot"))
 956
 957   ; RELAXABLE: Insn has one or more identical but larger variants.
 958   ; The assembler tries this one first and then the relaxation phase
 959   ; switches to the larger ones as necessary.
 960   ; All insns of identical behaviour have a RELAX_FOO attribute that groups
 961   ; them together.
 962   ; FIXME: This is a case where we need one attribute with several values.
 963   ; Presently each RELAX_FOO will use up a bit.
 964   (define-attr '(for insn) '(type boolean) '(name RELAXABLE) '(comment "insn is relaxable"))
 965
 966   ; RELAX: Large relaxable variant.  Avoided by assembler in first pass.
 967   ; FIXME: Rename this to RELAXED.
 968   (define-attr '(for insn) '(type boolean) '(name RELAX) '(comment "relaxed form of insn"))
 969
 970   ; NO-DIS: For macro insns, do not use during disassembly.
 971   (define-attr '(for insn) '(type boolean) '(name NO-DIS) '(comment "don't use for disassembly"))
 972
 973   ; PBB: Virtual insn used for PBB support.
 974   (define-attr '(for insn) '(type boolean) '(name PBB) '(comment "virtual insn used for PBB support"))
 975
 976   ; DECODE-SPLIT: insn resulted from decode-split processing
 977   (define-attr '(for insn) '(type boolean) '(name DECODE-SPLIT) '(comment "insn split from another insn for decoding purposes") '(attrs META))
 978
 979   ; Also (defined elsewhere):
 980   ; VIRTUAL: Helper insn used by the simulator.
 981
 982   *UNSPECIFIED*
 983 )
 984
 985 ; Called after the .cpu file has been read in.
 986
 987 (define (insn-finish!)
 988   *UNSPECIFIED*
 989 )