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 little 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
 723             ;; FIXME: We don't use parse-error here because some existing ports
 724             ;; have problems, and I don't have time to fix them right now.
 725             (cond ((< base-iflds-length base-len)
 726                    (parse-warning context
 727                                   (string-append
 728                                    "insufficient number of bits specified in base insn\n"
 729                                    "ifields:"
 730                                    (pretty-print-iflds parsed-ifld-list)
 731                                    "\nprovided spec")
 732                                   ifld-list))
 733                   ((> base-iflds-length base-len)
 734                    (parse-warning context
 735                                   (string-append
 736                                    "too many or duplicated bits specified in base insn\n"
 737                                    "ifields:"
 738                                    (pretty-print-iflds parsed-ifld-list)
 739                                    "\nprovided spec")
 740                                   ifld-list)))
 741
 742             ;; Detect duplicate ifields.
 743             (if (!= (length base-iflds)
 744                     (length (obj-list-nub base-iflds)))
 745                 (parse-error-continuable context
 746                                          "duplicate ifields present"
 747                                          ifld-list))
 748             )
 749           ))
 750
 751     parsed-ifld-list)
 752 )
 753
 754 ; Return a boolean indicating if IFLD-LIST contains anyof operands.
 755
 756 (define (anyof-operand-format? ifld-list)
 757   (any-true? (map (lambda (f)
 758                     (or (ifld-anyof? f)
 759                         (derived-ifield? f)))
 760                   ifld-list))
 761 )
 762 \f
 763 ; Insn utilities.
 764 ; ??? multi-insn support wip, may require changes here.
 765
 766 ; Return a boolean indicating if INSN is an alias insn.
 767
 768 (define (insn-alias? insn)
 769   (obj-has-attr? insn 'ALIAS)
 770 )
 771
 772 ; Return a list of instructions that are not aliases in INSN-LIST.
 773
 774 (define (non-alias-insns insn-list)
 775   (find (lambda (insn)
 776           (not (insn-alias? insn)))
 777         insn-list)
 778 )
 779
 780 ; Return a boolean indicating if INSN is a "real" INSN
 781 ; (not ALIAS and not VIRTUAL and not a <multi-insn>).
 782
 783 (define (insn-real? insn)
 784   (let ((atlist (obj-atlist insn)))
 785     (and (not (atlist-has-attr? atlist 'ALIAS))
 786          (not (atlist-has-attr? atlist 'VIRTUAL))
 787          (not (multi-insn? insn))))
 788 )
 789
 790 ; Return a list of real instructions in INSN-LIST.
 791
 792 (define (real-insns insn-list)
 793   (find insn-real? insn-list)
 794 )
 795
 796 ; Return a boolean indicating if INSN is a virtual insn.
 797
 798 (define (insn-virtual? insn)
 799   (obj-has-attr? insn 'VIRTUAL)
 800 )
 801
 802 ; Return a list of virtual instructions in INSN-LIST.
 803
 804 (define (virtual-insns insn-list)
 805   (find insn-virtual? insn-list)
 806 )
 807
 808 ; Return a list of non-alias/non-pbb insns in INSN-LIST.
 809
 810 (define (non-alias-pbb-insns insn-list)
 811   (find (lambda (insn)
 812           (let ((atlist (obj-atlist insn)))
 813             (and (not (atlist-has-attr? atlist 'ALIAS))
 814                  (not (atlist-has-attr? atlist 'PBB)))))
 815         insn-list)
 816 )
 817
 818 ; Return a list of multi-insns in INSN-LIST.
 819
 820 (define (multi-insns insn-list)
 821   (find multi-insn? insn-list)
 822 )
 823
 824 ; And the opposite:
 825
 826 (define (non-multi-insns insn-list)
 827   (find (lambda (insn) (not (multi-insn? insn))) insn-list)
 828 )
 829
 830 ; Filter out instructions whose ifield patterns are strict supersets of
 831 ; another, keeping the less general cousin.  Used to resolve ambiguity
 832 ; when there are no more bits to consider.
 833
 834 (define (filter-non-specialized-ambiguous-insns insn-list)
 835   (logit 3 "Filtering " (length insn-list) " instructions for non specializations.\n")
 836   (find (lambda (insn)
 837           (let* ((i-mask (insn-base-mask insn))
 838                  (i-mask-len (insn-base-mask-length insn))
 839                  (i-value (insn-value insn))
 840                  (subset-insn (find-first
 841                                (lambda (insn2) ; insn2: possible submatch (more mask bits)
 842                                     (let ((i2-mask (insn-base-mask insn2))
 843                                           (i2-mask-len (insn-base-mask-length insn2))
 844                                           (i2-value (insn-value insn2)))
 845                                       (and (not (eq? insn insn2))
 846                                            (= i-mask-len i2-mask-len)
 847                                            (mask-superset? i-mask i-value i2-mask i2-value))))
 848                                   insn-list))
 849                  (keep? (not subset-insn)))
 850             (if (not keep?)
 851                 (logit 2
 852                        "Instruction " (obj:name insn) " specialization-filtered by "
 853                        (obj:name subset-insn) "\n"))
 854             keep?))
 855         insn-list)
 856 )
 857
 858 ; Filter out instructions whose ifield patterns are identical.
 859
 860 (define (filter-identical-ambiguous-insns insn-list)
 861   (logit 3 "Filtering " (length insn-list) " instructions for identical variants.\n")
 862   (let loop ((l insn-list) (result nil))
 863     (cond ((null? l) (reverse! result))
 864           ((find-identical-insn (car l) (cdr l)) (loop (cdr l) result))
 865           (else (loop (cdr l) (cons (car l) result)))
 866           )
 867     )
 868 )
 869
 870 (define (find-identical-insn insn insn-list)
 871   (let ((i-mask (insn-base-mask insn))
 872         (i-mask-len (insn-base-mask-length insn))
 873         (i-value (insn-value insn)))
 874     (find-first
 875      (lambda (insn2)
 876        (let ((i2-mask (insn-base-mask insn2))
 877              (i2-mask-len (insn-base-mask-length insn2))
 878              (i2-value (insn-value insn2)))
 879          (and (= i-mask-len i2-mask-len)
 880               (= i-mask i2-mask)
 881               (= i-value i2-value))))
 882        insn-list))
 883 )
 884
 885 ; Helper function for above: does (m1,v1) match a STRICT superset of (m2,v2) ?
 886 ;
 887 ; eg> mask-superset? #b1100 #b1000 #b1110 #b1010 -> #t
 888 ; eg> mask-superset? #b1100 #b1000 #b1010 #b1010 -> #f
 889 ; eg> mask-superset? #b1100 #b1000 #b1110 #b1100 -> #f
 890 ; eg> mask-superset? #b1100 #b1000 #b1100 #b1000 -> #f
 891
 892 (define (mask-superset? m1 v1 m2 v2)
 893   (let ((result
 894          (and (= (cg-logand m1 m2) m1)
 895               (= (cg-logand m1 v1) (cg-logand m1 v2))
 896               (not (and (= m1 m2) (= v1 v2))))))
 897     (if result (logit 4
 898                       "(" (number->string m1 16) "," (number->string v1 16) ")"
 899                       " contains "
 900                       "(" (number->string m2 16) "," (number->string v2 16) ")"
 901                       "\n"))
 902     result)
 903 )
 904
 905 ;; Return a boolean indicating if INSN is a cti [control transfer insn]
 906 ;; according the its attributes.
 907 ;;
 908 ;; N.B. This only looks at the insn's atlist, which only contains what was
 909 ;; specified in the .cpu file.  .cpu files are not required to manually mark
 910 ;; CTI insns.  Basically this exists as an escape hatch in case semantic-attrs
 911 ;; gets it wrong.
 912
 913 (define (insn-cti-attr? insn)
 914   (atlist-cti? (obj-atlist insn))
 915 )
 916
 917 ;; Return a boolean indicating if INSN is a cti [control transfer insn].
 918 ;; This includes SKIP-CTI insns even though they don't terminate a basic block.
 919 ;; ??? SKIP-CTI insns are wip, waiting for more examples of how they're used.
 920 ;;
 921 ;; N.B. This requires the <sformat> of INSN.
 922
 923 (define (insn-cti? insn)
 924   (or (insn-cti-attr? insn)
 925       (sfmt-cti? (insn-sfmt insn)))
 926 )
 927
 928 ; Return a boolean indicating if INSN can be executed in parallel.
 929 ; Such insns are required to have enum attribute PARALLEL != NO.
 930 ; This is worded specifically to allow the PARALLEL attribute to have more
 931 ; than just NO/YES values (should a target want to do so).
 932 ; This specification may not be sufficient, but the intent is explicit.
 933
 934 (define (insn-parallel? insn)
 935   (let ((atval (obj-attr-value insn 'PARALLEL)))
 936     (and atval (not (eq? atval 'NO))))
 937 )
 938
 939 ; Return a list of the insns that support parallel execution in INSN-LIST.
 940
 941 (define (parallel-insns insn-list)
 942   (find insn-parallel? insn-list)
 943 )
 944 \f
 945 ; Instruction field utilities.
 946
 947 ; Return a boolean indicating if INSN has ifield named F-NAME.
 948
 949 (define (insn-has-ifield? insn f-name)
 950   (->bool (object-assq f-name (insn-iflds insn)))
 951 )
 952 \f
 953 ; Insn opcode value utilities.
 954
 955 ; Given INSN, return the length in bits of the base mask (insn-base-mask).
 956
 957 (define (insn-base-mask-length insn)
 958   (ifmt-mask-length (insn-ifmt insn))
 959 )
 960
 961 ; Given INSN, return the bitmask of constant values (the opcode field)
 962 ; in the base part.
 963
 964 (define (insn-base-mask insn)
 965   (ifmt-mask (insn-ifmt insn))
 966 )
 967
 968 ; Given INSN, return the sum of the constant values in the insn
 969 ; (i.e. the opcode field).
 970 ;
 971 ; See also (compute-insn-base-mask).
 972 ;
 973 ; FIXME: For non-fixed-length ISAs, using this doesn't feel right.
 974
 975 (define (insn-value insn)
 976   (if (elm-get insn '/insn-value)
 977       (elm-get insn '/insn-value)
 978       (let* ((base-len (insn-base-mask-length insn))
 979              (value (apply +
 980                            (map (lambda (fld) (ifld-value fld base-len (ifld-get-value fld)))
 981                                 (find ifld-constant?
 982                                       (ifields-base-ifields (insn-iflds insn))))
 983                            )))
 984         (elm-set! insn '/insn-value value)
 985         value))
 986 )
 987
 988 ;; Return the base value of INSN.
 989
 990 (define (insn-base-value insn)
 991   (if (elm-get insn '/insn-base-value)
 992       (elm-get insn '/insn-base-value)
 993       (let* ((base-len (insn-base-mask-length insn))
 994              (constant-base-iflds
 995               (find (lambda (f)
 996                       (and (ifld-constant? f)
 997                            (not (ifld-beyond-base? f))))
 998                     (ifields-base-ifields (insn-iflds insn))))
 999              (base-value (apply +
1000                                 (map (lambda (f)
1001                                        (ifld-value f base-len (ifld-get-value f)))
1002                                      constant-base-iflds))))
1003         (elm-set! insn '/insn-base-value base-value)
1004         base-value))
1005 )
1006 \f
1007 ; Insn operand utilities.
1008
1009 ; Lookup operand SEM-NAME in INSN.
1010
1011 (define (insn-lookup-op insn sem-name)
1012   (or (op:lookup-sem-name (sfmt-in-ops (insn-sfmt insn)) sem-name)
1013       (op:lookup-sem-name (sfmt-out-ops (insn-sfmt insn)) sem-name))
1014 )
1015 \f
1016 ; Insn syntax utilities.
1017
1018 ; Create a list of syntax strings broken up into a list of characters and
1019 ; operand objects.
1020
1021 (define (syntax-break-out syntax isa-name-list)
1022   (let ((result nil))
1023     ; ??? The style of the following could be more Scheme-like.  Later.
1024     (let loop ()
1025       (if (> (string-length syntax) 0)
1026           (begin
1027             (cond
1028              ; Handle escaped syntax metacharacters.
1029              ((char=? #\\ (string-ref syntax 0))
1030               (begin
1031                 (if (= (string-length syntax) 1)
1032                     (parse-error context "syntax-break-out: missing char after '\\' in " syntax))
1033                 (set! result (cons (substring syntax 1 2) result))
1034                 (set! syntax (string-drop 2 syntax))))
1035                 ; Handle operand reference.
1036              ((char=? #\$ (string-ref syntax 0))
1037               ; Extract the symbol from the string, get the operand.
1038               ; FIXME: Will crash if $ is last char in string.
1039               (if (char=? #\{ (string-ref syntax 1))
1040                   (let ((n (string-index syntax #\})))
1041                     (set! result (cons (current-op-lookup
1042                                         (string->symbol
1043                                          (substring syntax 2 n))
1044                                         isa-name-list)
1045                                        result))
1046                     (set! syntax (string-drop (+ 1 n) syntax)))
1047                   (let ((n (id-len (string-drop1 syntax))))
1048                     (set! result (cons (current-op-lookup
1049                                         (string->symbol
1050                                          (substring syntax 1 (+ 1 n)))
1051                                         isa-name-list)
1052                                        result))
1053                     (set! syntax (string-drop (+ 1 n) syntax)))))
1054              ; Handle everything else.
1055              (else (set! result (cons (substring syntax 0 1) result))
1056                    (set! syntax (string-drop1 syntax))))
1057             (loop))))
1058     (reverse result))
1059 )
1060
1061 ; Given a list of syntax elements (e.g. the result of syntax-break-out),
1062 ; create a syntax string.
1063
1064 (define (syntax-make elements)
1065   (apply string-append
1066          (map (lambda (e)
1067                 (cond ((char? e)
1068                        (string "\\" e))
1069                       ((string? e)
1070                        e)
1071                       (else
1072                        (assert (operand? e))
1073                        (string-append "${" (obj:str-name e) "}"))))
1074               elements))
1075 )
1076 \f
1077 ; Called before a .cpu file is read in.
1078
1079 (define (insn-init!)
1080   (reader-add-command! 'define-insn
1081                        "\
1082 Define an instruction, name/value pair list version.
1083 "
1084                        nil 'arg-list define-insn)
1085   (reader-add-command! 'define-full-insn
1086                        "\
1087 Define an instruction, all arguments specified.
1088 "
1089                        nil '(name comment attrs syntax fmt ifield-assertion semantics timing)
1090                        define-full-insn)
1091
1092   *UNSPECIFIED*
1093 )
1094
1095 ; Called before a .cpu file is read in to install any builtins.
1096
1097 (define (insn-builtin!)
1098   ; Standard insn attributes.
1099   ; ??? Some of these can be combined into one.
1100
1101   (define-attr '(for insn) '(type boolean) '(name UNCOND-CTI) '(comment "unconditional cti"))
1102
1103   (define-attr '(for insn) '(type boolean) '(name COND-CTI) '(comment "conditional cti"))
1104
1105   ; SKIP-CTI: one or more immediately following instructions are conditionally
1106   ; executed (or skipped)
1107   (define-attr '(for insn) '(type boolean) '(name SKIP-CTI) '(comment "skip cti"))
1108
1109   ; DELAY-SLOT: insn has one or more delay slots (wip)
1110   (define-attr '(for insn) '(type boolean) '(name DELAY-SLOT) '(comment "insn has a delay slot"))
1111
1112   ; RELAXABLE: Insn has one or more identical but larger variants.
1113   ; The assembler tries this one first and then the relaxation phase
1114   ; switches to the larger ones as necessary.
1115   ; All insns of identical behaviour have a RELAX_FOO attribute that groups
1116   ; them together.
1117   ; FIXME: This is a case where we need one attribute with several values.
1118   ; Presently each RELAX_FOO will use up a bit.
1119   (define-attr '(for insn) '(type boolean) '(name RELAXABLE)
1120     '(comment "insn is relaxable"))
1121
1122   ; RELAXED: Large relaxable variant.  Avoided by assembler in first pass.
1123   (define-attr '(for insn) '(type boolean) '(name RELAXED)
1124     '(comment "relaxed form of insn"))
1125
1126   ; NO-DIS: For macro insns, do not use during disassembly.
1127   (define-attr '(for insn) '(type boolean) '(name NO-DIS) '(comment "don't use for disassembly"))
1128
1129   ; PBB: Virtual insn used for PBB support.
1130   (define-attr '(for insn) '(type boolean) '(name PBB) '(comment "virtual insn used for PBB support"))
1131
1132   ; DECODE-SPLIT: insn resulted from decode-split processing
1133   (define-attr '(for insn) '(type boolean) '(name DECODE-SPLIT) '(comment "insn split from another insn for decoding purposes") '(attrs META))
1134
1135   ; Also (defined elsewhere):
1136   ; VIRTUAL: Helper insn used by the simulator.
1137
1138   *UNSPECIFIED*
1139 )
1140
1141 ; Called after the .cpu file has been read in.
1142
1143 (define (insn-finish!)
1144   *UNSPECIFIED*
1145 )