cgen/semantics.scm

   1 ; Routines for instruction semantic analysis.
   2 ; Copyright (C) 2000, 2009 Red Hat, Inc.
   3 ; This file is part of CGEN.
   4 ; See file COPYING.CGEN for details.
   5 ;
   6 ; Semantic expression compilation.
   7 ; This is more involved than normal rtx compilation as we need to keep
   8 ; track of the inputs and outputs.  Various attributes that can be derived
   9 ; from the code are also computed.
  10
  11 ; Subroutine of -rtx-find-op to determine if two modes are equivalent.
  12 ; Two modes are equivalent if they're equal, or if their sem-mode fields
  13 ; are equal.
  14 ; M1 and M2 are mode names.
  15
  16 (define (/rtx-mode-equiv? m1 m2)
  17   (or (eq? m1 m2)
  18       (let ((mode1 (mode:lookup m1))
  19             (mode2 (mode:lookup m2)))
  20         (let ((s1 (mode:sem-mode mode1))
  21               (s2 (mode:sem-mode mode2)))
  22           (eq? (if s1 (obj:name s1) m1) (if s2 (obj:name s2) m2)))))
  23 )
  24
  25 ; Subroutine of semantic-compile to find OP in OP-LIST.
  26 ; OP-LIST is a list of operand expressions: (type expr mode name indx-sel).
  27 ; The result is the list element or #f if not found.
  28 ; TYPE is one of -op- reg mem.
  29 ; EXPR is the constructed `xop' rtx expression for the operand,
  30 ;   ignored in the search.
  31 ; MODE must match, as defined by /rtx-mode-equiv?.
  32 ; NAME is the hardware element name, ifield name, or '-op-'.
  33 ; INDX-SEL must match if present in either.
  34 ;
  35 ; ??? Does this need to take "conditionally-referenced" into account?
  36
  37 (define (/rtx-find-op op op-list)
  38   (let ((type (car op))
  39         (mode (caddr op))
  40         (name (cadddr op))
  41         (indx-sel (car (cddddr op))))
  42     ; The first cdr is to drop the dummy first arg.
  43     (let loop ((op-list (cdr op-list)))
  44       (cond ((null? op-list) #f)
  45             ((eq? type (caar op-list))
  46              (let ((try (car op-list)))
  47                (if (and (eq? name (cadddr try))
  48                         (/rtx-mode-equiv? mode (caddr try))
  49                         (equal? indx-sel (car (cddddr try))))
  50                    try
  51                    (loop (cdr op-list)))))
  52             (else (loop (cdr op-list))))))
  53 )
  54
  55 ; Subroutine of semantic-compile to determine how the operand in
  56 ; position OP-POS of EXPR is used.
  57 ; The result is one of 'use, 'set, 'set-quiet.
  58 ; "use" means "input operand".
  59
  60 (define (/rtx-ref-type expr op-pos)
  61   ; operand 0 is the option list, operand 1 is the mode
  62   ; (if you want to complain, fine, it's not like it would be unexpected)
  63   (if (= op-pos 2)
  64       (case (car expr)
  65         ((set) 'set)
  66         ((set-quiet clobber) 'set-quiet)
  67         (else 'use))
  68       'use)
  69 )
  70
  71 ; Subroutine of semantic-compile:process-expr!, to simplify it.
  72 ; Looks up the operand in the current set, returns it if found,
  73 ; otherwise adds it.
  74 ; REF-TYPE is one of 'use, 'set, 'set-quiet.
  75 ; Adds COND-CTI/UNCOND-CTI to SEM-ATTRS if the operand is a set of the pc.
  76
  77 (define (/build-operand! op-expr tstate ref-type op-list sem-attrs)
  78   (let* ((orig-op (rtx-operand-obj op-expr (obj-isa-list (tstate-owner tstate))))
  79          (mode (rtx-mode op-expr))
  80          ;; We need a copy as we'll be modifying it.
  81          (op (op:new-mode orig-op mode))
  82          ;; The first #f is a placeholder for the object.
  83          (try (list '-op- #f mode (rtx-arg1 op-expr) #f))
  84          (existing-op (/rtx-find-op try op-list)))
  85
  86     (assert (not (eq? (op:mode-name op) 'DFLT)))
  87
  88     (if (and (pc? op)
  89              (memq ref-type '(set set-quiet)))
  90         (append! sem-attrs
  91                  (list (if (tstate-cond? tstate) 'COND-CTI 'UNCOND-CTI))))
  92
  93     ; If already present, return the object, otherwise add it.
  94     (if existing-op
  95
  96         (cadr existing-op)
  97
  98         ; We can't set the operand number yet 'cus we don't know it.
  99         ; However, when it's computed we'll need to set all associated
 100         ; operands.  This is done by creating shared rtx (a la gcc) - the
 101         ; operand number then need only be updated in one place.
 102
 103         (begin
 104           (op:set-cond?! op (tstate-cond? tstate))
 105           ; Set the object rtx in `try', now that we have it.
 106           (set-car! (cdr try) (rtx-make-xop op))
 107           ; Add the operand to in/out-ops.
 108           (append! op-list (list try))
 109           (cadr try))))
 110 )
 111
 112 ; Subroutine of semantic-compile:process-expr!, to simplify it.
 113
 114 (define (/build-reg-operand! expr tstate op-list)
 115   (let* ((hw-name (rtx-reg-name expr))
 116          (hw (current-hw-sem-lookup-1 hw-name)))
 117
 118     (if hw
 119
 120         (let* ((mode (rtx-mode expr))
 121                (indx-sel (rtx-reg-index-sel expr))
 122                ; #f is a place-holder for the object (filled in later)
 123                (try (list 'reg #f mode hw-name indx-sel))
 124                (existing-op (/rtx-find-op try op-list)))
 125
 126           ; If already present, return the object, otherwise add it.
 127           (if existing-op
 128
 129               (cadr existing-op)
 130
 131               (let ((xop (apply reg (cons (tstate->estate tstate)
 132                                           (cons mode
 133                                                 (cons hw-name indx-sel))))))
 134                 (op:set-cond?! xop (tstate-cond? tstate))
 135                 ; Set the object rtx in `try', now that we have it.
 136                 (set-car! (cdr try) (rtx-make-xop xop))
 137                 ; Add the operand to in/out-ops.
 138                 (append! op-list (list try))
 139                 (cadr try))))
 140
 141         (parse-error (tstate-context tstate) "unknown reg" expr)))
 142 )
 143
 144 ; Subroutine of semantic-compile:process-expr!, to simplify it.
 145
 146 (define (/build-mem-operand! expr tstate op-list)
 147   (let ((mode (rtx-mode expr))
 148         (indx-sel (rtx-mem-index-sel expr)))
 149
 150     (let* ((try (list 'mem #f mode 'h-memory indx-sel))
 151            (existing-op (/rtx-find-op try op-list)))
 152
 153       ; If already present, return the object, otherwise add it.
 154       (if existing-op
 155
 156           (cadr existing-op)
 157
 158           (let ((xop (apply mem (cons (tstate->estate tstate)
 159                                       (cons mode indx-sel)))))
 160             (op:set-cond?! xop (tstate-cond? tstate))
 161             ; Set the object in `try', now that we have it.
 162             (set-car! (cdr try) (rtx-make-xop xop))
 163             ; Add the operand to in/out-ops.
 164             (append! op-list (list try))
 165             (cadr try)))))
 166 )
 167
 168 ; Subroutine of semantic-compile:process-expr!, to simplify it.
 169
 170 (define (/build-ifield-operand! expr tstate op-list)
 171   (let* ((f-name (rtx-ifield-name expr))
 172          (f (current-ifld-lookup f-name)))
 173
 174     (if (not f)
 175         (parse-error (tstate-context tstate) "unknown ifield" f-name))
 176
 177     (let* ((mode (obj:name (ifld-mode f)))
 178            (try (list '-op- #f mode f-name #f))
 179            (existing-op (/rtx-find-op try op-list)))
 180
 181       ; If already present, return the object, otherwise add it.
 182       (if existing-op
 183
 184           (cadr existing-op)
 185
 186           (let ((xop (make <operand> (obj-location f)
 187                            f-name f-name
 188                            (atlist-cons (bool-attr-make 'SEM-ONLY #t)
 189                                         (obj-atlist f))
 190                            (obj:name (ifld-hw-type f))
 191                            mode
 192                            (make <hw-index> 'anonymous
 193                                  'ifield (ifld-mode f) f)
 194                            nil #f #f)))
 195             (set-car! (cdr try) (rtx-make-xop xop))
 196             (append! op-list (list try))
 197             (cadr try)))))
 198 )
 199
 200 ; Subroutine of semantic-compile:process-expr!, to simplify it.
 201 ;
 202 ; ??? There are various optimizations (both space usage in ARGBUF and time
 203 ; spent in semantic code) that can be done on code that uses index-of
 204 ; (see i960's movq insn).  Later.
 205
 206 (define (/build-index-of-operand! expr tstate op-list)
 207   (if (not (and (rtx? (rtx-index-of-value expr))
 208                 (rtx-kind? 'operand (rtx-index-of-value expr))))
 209       (parse-error (tstate-context tstate)
 210                    "only `(index-of operand)' is currently supported"
 211                    expr))
 212
 213   (let ((op (rtx-operand-obj (rtx-index-of-value expr)
 214                              (obj-isa-list (tstate-owner tstate)))))
 215     (let ((indx (op:index op)))
 216       (if (not (eq? (hw-index:type indx) 'ifield))
 217           (parse-error (tstate-context tstate)
 218                        "only ifield indices are currently supported"
 219                        expr))
 220       (let* ((f (hw-index:value indx))
 221              (f-name (obj:name f)))
 222         ; The rest of this is identical to /build-ifield-operand!.
 223         (let* ((mode (obj:name (ifld-mode f)))
 224                (try (list '-op- #f mode f-name #f))
 225                (existing-op (/rtx-find-op try op-list)))
 226
 227           ; If already present, return the object, otherwise add it.
 228           (if existing-op
 229
 230               (cadr existing-op)
 231
 232               (let ((xop (make <operand> (if (source-ident? f) (obj-location f) #f)
 233                                f-name f-name
 234                                (atlist-cons (bool-attr-make 'SEM-ONLY #t)
 235                                             (obj-atlist f))
 236                                (obj:name (ifld-hw-type f))
 237                                mode
 238                                (make <hw-index> 'anonymous
 239                                      'ifield
 240                                      (ifld-mode f)
 241                                      ; (send (op:type op) 'get-index-mode)
 242                                      f)
 243                                nil #f #f)))
 244                 (set-car! (cdr try) (rtx-make-xop xop))
 245                 (append! op-list (list try))
 246                 (cadr try)))))))
 247 )
 248
 249 ; Build the tstate known value list for INSN.
 250 ; This is built from the ifield-assertion list.
 251
 252 (define (insn-build-known-values insn)
 253   (let ((expr (insn-ifield-assertion insn)))
 254     (if expr
 255         (case (rtx-name expr)
 256           ((eq)
 257            (if (and (rtx-kind? 'ifield (rtx-cmp-op-arg expr 0))
 258                     (rtx-constant? (rtx-cmp-op-arg expr 1)))
 259                (list (cons (rtx-ifield-name (rtx-cmp-op-arg expr 0))
 260                            (rtx-cmp-op-arg expr 1)))
 261                nil))
 262           ((member)
 263            (if (rtx-kind? 'ifield (rtx-member-value expr))
 264                (list (cons (rtx-ifield-name (rtx-member-value expr))
 265                            (rtx-member-set expr)))
 266                nil))
 267           (else nil))
 268         nil))
 269 )
 270
 271 ; Structure to record the result of semantic-compile.
 272
 273 (define (csem-make compiled-code inputs outputs attributes)
 274   (vector compiled-code inputs outputs attributes)
 275 )
 276
 277 ; Accessors.
 278
 279 (define (csem-code csem) (vector-ref csem 0))
 280 (define (csem-inputs csem) (vector-ref csem 1))
 281 (define (csem-outputs csem) (vector-ref csem 2))
 282 (define (csem-attrs csem) (vector-ref csem 3))
 283 \f
 284 ; Traverse SEM-CODE, computing the input and output operands.
 285 ; The result is an object of four elements (built with csem-make).
 286 ; The first is a list of the canonical form of each element in SEM-CODE:
 287 ; operand and ifield elements specified without `operand' or `ifield' have it
 288 ; prepended, and operand numbers are computed for each operand.
 289 ; Operand numbers are needed when emitting "write" handlers for LIW cpus.
 290 ; Having the operand numbers available is also useful for efficient
 291 ; modeling: recording operand references can be done with a bitmask (one host
 292 ; insn), and the code to do the modeling can be kept out of the code that
 293 ; performs the insn.
 294 ; The second is the list of input <operand> objects.
 295 ; The third is the list of output <operand> objects.
 296 ; The fourth is an <attr-list> object of attributes that can be computed from
 297 ; the semantics.
 298 ; The possibilities are: UNCOND-CTI, COND-CTI, SKIP-CTI, DELAY-SLOT.
 299 ; ??? Combine *-CTI into an enum attribute.
 300 ;
 301 ; CONTEXT is a <context> object or #f if there is none.
 302 ; INSN is the <insn> object.
 303 ; SEM-CODE must be canonicalized rtl.
 304 ;
 305 ; ??? Specifying operand ordinals in the source would simplify this and speed
 306 ; it up.  On the other hand that makes the source form more complex.  Maybe the
 307 ; complexity will prove necessary, but following the goal of "incremental
 308 ; complication", we don't do this yet.
 309 ; Another way to simplify this and speed it up would be to add lists of
 310 ; input/output operands to the instruction description.
 311 ;
 312 ; ??? This calls rtx-simplify which calls rtx-traverse as it's simpler to
 313 ; simplify EXPR first, and then compile it.  On the other hand it's slower
 314 ; (two calls to rtx-traverse!).
 315
 316 (define (semantic-compile context insn sem-code)
 317   (assert (rtx? sem-code))
 318
 319   (let*
 320       (
 321        ; These record the result of traversing SEM-CODE.
 322        ; They're lists of (type object mode name [args ...]).
 323        ; TYPE is one of: -op- reg mem.
 324        ; `-op-' is just something unique and is only used internally.
 325        ; OBJECT is the constructed <operand> object.
 326        ; The first element is just a dummy so that append! always works.
 327        (in-ops (list (list #f)))
 328        (out-ops (list (list #f)))
 329
 330        ; List of attributes computed from SEM-CODE.
 331        ; The first element is just a dummy so that append! always works.
 332        (sem-attrs (list #f))
 333
 334        ; Called for expressions encountered in SEM-CODE.
 335        ; Don't waste cpu here, this is part of the slowest piece in CGEN.
 336        (process-expr!
 337         (lambda (rtx-obj expr parent-expr op-pos tstate appstuff)
 338           (case (car expr)
 339
 340             ;; NOTE: Despite the ! in, e.g., /build-reg-operand!,
 341             ;; it does return a result.
 342
 343             ; Registers.
 344             ((reg) (let ((ref-type (/rtx-ref-type parent-expr op-pos))
 345                          ; ??? could verify reg is a scalar
 346                          (regno (or (rtx-reg-number expr) 0)))
 347                      ; The register number is either a number or an
 348                      ; expression.
 349                      ; ??? This is a departure from GCC RTL that might have
 350                      ; significant ramifications.  On the other hand in cases
 351                      ; where it matters the expression could always be
 352                      ; required to reduce to a constant (or some such).
 353                      (cond ((number? regno) #t)
 354                            ((form? regno)
 355                             (rtx-traverse-operands rtx-obj expr tstate appstuff))
 356                            (else (parse-error (tstate-context tstate)
 357                                               "invalid register number"
 358                                               regno)))
 359                      (/build-reg-operand! expr tstate
 360                                           (if (eq? ref-type 'use)
 361                                               in-ops
 362                                               out-ops))))
 363
 364             ; Memory.
 365             ((mem) (let ((ref-type (/rtx-ref-type parent-expr op-pos)))
 366                      (rtx-traverse-operands rtx-obj expr tstate appstuff)
 367                      (/build-mem-operand! expr tstate
 368                                           (if (eq? ref-type 'use)
 369                                               in-ops
 370                                               out-ops))))
 371
 372             ; Operands.
 373             ((operand) (let ((ref-type (/rtx-ref-type parent-expr op-pos)))
 374                          (/build-operand! expr tstate ref-type
 375                                           (if (eq? ref-type 'use)
 376                                               in-ops
 377                                               out-ops)
 378                                           sem-attrs)))
 379
 380             ; Give operand new name.
 381             ((name) (let ((result (/rtx-traverse (caddr expr) 'RTX
 382                                                  parent-expr op-pos tstate appstuff)))
 383                       (if (not (operand? result))
 384                           (error "name: invalid argument:" expr result))
 385                       (op:set-sem-name! result (cadr expr))
 386                       ; (op:set-num! result (caddr expr))
 387                       result))
 388
 389             ; Specify a reference to a local variable
 390             ((local) expr) ; nothing to do
 391
 392             ; Instruction fields.
 393             ((ifield) (let ((ref-type (/rtx-ref-type parent-expr op-pos)))
 394                         (if (not (eq? ref-type 'use))
 395                             (parse-error (tstate-context tstate)
 396                                          "can't set an `ifield'" expr))
 397                         (/build-ifield-operand! expr tstate in-ops)))
 398
 399             ; Hardware indices.
 400             ; For registers this is the register number.
 401             ; For memory this is the address.
 402             ; For constants, this is the constant.
 403             ((index-of) (let ((ref-type (/rtx-ref-type parent-expr op-pos)))
 404                           (if (not (eq? ref-type 'use))
 405                               (parse-error (tstate-context tstate)
 406                                            "can't set an `index-of'" expr))
 407                           (/build-index-of-operand! expr tstate in-ops)))
 408
 409             ; Machine generate the SKIP-CTI attribute.
 410             ((skip) (append! sem-attrs (list 'SKIP-CTI)) #f)
 411
 412             ; Machine generate the DELAY-SLOT attribute.
 413             ((delay) (append! sem-attrs (list 'DELAY-SLOT)) #f)
 414
 415             ; If this is a syntax expression, the operands won't have been
 416             ; processed, so tell our caller we want it to by returning #f.
 417             ; We do the same for non-syntax expressions to keep things
 418             ; simple.  This requires collaboration with the traversal
 419             ; handlers which are defined to do what we want if we return #f.
 420             (else #f))))
 421
 422        ; Whew.  We're now ready to traverse the expression.
 423        ; Traverse the expression recording the operands and building objects
 424        ; for most elements in the source representation.
 425        ; This also performs various simplifications.
 426        ; In particular machine dependent code for non-selected machines
 427        ; is discarded.
 428        (compiled-expr (rtx-traverse
 429                        context
 430                        insn
 431                        (rtx-simplify context insn sem-code
 432                                      (insn-build-known-values insn))
 433                        process-expr!
 434                        #f))
 435        )
 436
 437     ;(display "in:  ") (display in-ops) (newline)
 438     ;(display "out: ") (display out-ops) (newline)
 439     ;(force-output)
 440
 441     ; Now that we have the nub of all input and output operands,
 442     ; we can assign operand numbers.  Inputs and outputs are not defined
 443     ; separately, output operand numbers follow inputs.  This simplifies the
 444     ; code which keeps track of such things: it can use one variable.
 445     ; The assignment is defined to be arbitrary.  If there comes a day
 446     ; when we need to prespecify operand numbers, revisit.
 447     ; The operand lists are sorted to avoid spurious differences in generated
 448     ; code (for example unnecessary extra entries can be created in the
 449     ; ARGBUF struct).
 450
 451     ; Drop dummy first arg and sort operand lists.
 452     (let ((sorted-ins
 453            (alpha-sort-obj-list (map (lambda (op)
 454                                        (rtx-xop-obj (cadr op)))
 455                                      (cdr in-ops))))
 456           (sorted-outs
 457            (alpha-sort-obj-list (map (lambda (op)
 458                                        (rtx-xop-obj (cadr op)))
 459                                      (cdr out-ops))))
 460           (sem-attrs (cdr sem-attrs)))
 461
 462       (let ((in-op-nums (iota (length sorted-ins)))
 463             (out-op-nums (iota (length sorted-outs) (length sorted-ins))))
 464
 465         (for-each (lambda (op num) (op:set-num! op num))
 466                   sorted-ins in-op-nums)
 467         (for-each (lambda (op num) (op:set-num! op num))
 468                   sorted-outs out-op-nums)
 469
 470         (let ((dump (lambda (op)
 471                       (string/symbol-append "  "
 472                                             (obj:name op)
 473                                             " "
 474                                             (number->string (op:num op))
 475                                             "\n"))))
 476           (logit 4
 477                  "Input operands:\n"
 478                  (map dump sorted-ins)
 479                  "Output operands:\n"
 480                  (map dump sorted-outs)
 481                  "End of operands.\n"))
 482
 483         (csem-make compiled-expr sorted-ins sorted-outs
 484                    (atlist-parse context sem-attrs "")))))
 485 )
 486 \f
 487 ; Traverse SEM-CODE, computing attributes derivable from it.
 488 ; The result is an <attr-list> object of attributes that can be computed from
 489 ; the semantics.
 490 ; The possibilities are: UNCOND-CTI, COND-CTI, SKIP-CTI, DELAY-SLOT.
 491 ; This computes the same values as semantic-compile, but for speed is
 492 ; focused on attributes only.
 493 ; ??? Combine *-CTI into an enum attribute.
 494 ;
 495 ; CONTEXT is a <context> object or #f if there is none.
 496 ; INSN is the <insn> object.
 497
 498 (define (semantic-attrs context insn sem-code)
 499   (assert (rtx? sem-code))
 500
 501   (let*
 502       (
 503        ; List of attributes computed from SEM-CODE.
 504        ; The first element is just a dummy so that append! always works.
 505        (sem-attrs (list #f))
 506
 507        ; Called for expressions encountered in SEM-CODE.
 508        (process-expr!
 509         (lambda (rtx-obj expr parent-expr op-pos tstate appstuff)
 510           (case (car expr)
 511
 512             ;; FIXME: What's the result for the operand case?
 513             ((operand) (if (and (eq? 'pc (rtx-operand-name expr))
 514                                 (memq (/rtx-ref-type parent-expr op-pos)
 515                                       '(set set-quiet)))
 516                            (append! sem-attrs
 517                                     (if (tstate-cond? tstate)
 518                                         ; Don't change these to '(FOO), since
 519                                         ; we use append!.
 520                                         (list 'COND-CTI)
 521                                         (list 'UNCOND-CTI)))))
 522             ((skip) (append! sem-attrs (list 'SKIP-CTI)) #f)
 523             ((delay) (append! sem-attrs (list 'DELAY-SLOT)) #f)
 524
 525             ; If this is a syntax expression, the operands won't have been
 526             ; processed, so tell our caller we want it to by returning #f.
 527             ; We do the same for non-syntax expressions to keep things
 528             ; simple.  This requires collaboration with the traversal
 529             ; handlers which are defined to do what we want if we return #f.
 530             (else #f))))
 531
 532        ; Traverse the expression recording the attributes.
 533        (traversed-expr (rtx-traverse
 534                         context
 535                         insn
 536                         (rtx-simplify context insn sem-code
 537                                       (insn-build-known-values insn))
 538                         process-expr!
 539                         #f))
 540        )
 541
 542     (let
 543         ; Drop dummy first arg.
 544         ((sem-attrs (cdr sem-attrs)))
 545       (atlist-parse context sem-attrs "")))
 546 )