cgen/insn.scm

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