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 ; REF-TYPE is one of 'use, 'set, 'set-quiet.
 114 ; Adds COND-CTI/UNCOND-CTI to SEM-ATTRS if the operand is a set of the pc.
 115
 116 (define (/build-reg-operand! expr tstate ref-type op-list sem-attrs)
 117   (let* ((hw-name (rtx-reg-name expr))
 118          (hw (current-hw-sem-lookup-1 hw-name)))
 119
 120     (if hw
 121
 122         (let* ((mode (rtx-mode expr))
 123                (indx-sel (rtx-reg-index-sel expr))
 124                ; #f is a place-holder for the object (filled in later)
 125                (try (list 'reg #f mode hw-name indx-sel))
 126                (existing-op (/rtx-find-op try op-list)))
 127
 128           ;; FIXME: keep name h-pc hardwired?
 129           (if (and (eq? 'h-pc hw-name)
 130                    (memq ref-type '(set set-quiet)))
 131               (append! sem-attrs
 132                        (list (if (tstate-cond? tstate) 'COND-CTI 'UNCOND-CTI))))
 133
 134           ; If already present, return the object, otherwise add it.
 135           (if existing-op
 136
 137               (cadr existing-op)
 138
 139               (let ((xop (apply reg (cons (tstate->estate tstate)
 140                                           (cons mode
 141                                                 (cons hw-name indx-sel))))))
 142                 (op:set-cond?! xop (tstate-cond? tstate))
 143                 ; Set the object rtx in `try', now that we have it.
 144                 (set-car! (cdr try) (rtx-make-xop xop))
 145                 ; Add the operand to in/out-ops.
 146                 (append! op-list (list try))
 147                 (cadr try))))
 148
 149         (parse-error (tstate-context tstate) "unknown reg" expr)))
 150 )
 151
 152 ; Subroutine of semantic-compile:process-expr!, to simplify it.
 153
 154 (define (/build-mem-operand! expr tstate op-list)
 155   (let ((mode (rtx-mode expr))
 156         (indx-sel (rtx-mem-index-sel expr)))
 157
 158     (let* ((try (list 'mem #f mode 'h-memory indx-sel))
 159            (existing-op (/rtx-find-op try op-list)))
 160
 161       ; If already present, return the object, otherwise add it.
 162       (if existing-op
 163
 164           (cadr existing-op)
 165
 166           (let ((xop (apply mem (cons (tstate->estate tstate)
 167                                       (cons mode indx-sel)))))
 168             (op:set-cond?! xop (tstate-cond? tstate))
 169             ; Set the object in `try', now that we have it.
 170             (set-car! (cdr try) (rtx-make-xop xop))
 171             ; Add the operand to in/out-ops.
 172             (append! op-list (list try))
 173             (cadr try)))))
 174 )
 175
 176 ; Subroutine of semantic-compile:process-expr!, to simplify it.
 177
 178 (define (/build-ifield-operand! expr tstate op-list)
 179   (let* ((f-name (rtx-ifield-name expr))
 180          (f (current-ifld-lookup f-name)))
 181
 182     (if (not f)
 183         (parse-error (tstate-context tstate) "unknown ifield" f-name))
 184
 185     (let* ((mode (obj:name (ifld-mode f)))
 186            (try (list '-op- #f mode f-name #f))
 187            (existing-op (/rtx-find-op try op-list)))
 188
 189       ; If already present, return the object, otherwise add it.
 190       (if existing-op
 191
 192           (cadr existing-op)
 193
 194           (let ((xop (make <operand> (obj-location f)
 195                            f-name f-name
 196                            (atlist-cons (bool-attr-make 'SEM-ONLY #t)
 197                                         (obj-atlist f))
 198                            (obj:name (ifld-hw-type f))
 199                            mode
 200                            (make <hw-index> 'anonymous
 201                                  'ifield (ifld-mode f) f)
 202                            nil #f #f)))
 203             (set-car! (cdr try) (rtx-make-xop xop))
 204             (append! op-list (list try))
 205             (cadr try)))))
 206 )
 207
 208 ; Subroutine of semantic-compile:process-expr!, to simplify it.
 209 ;
 210 ; ??? There are various optimizations (both space usage in ARGBUF and time
 211 ; spent in semantic code) that can be done on code that uses index-of
 212 ; (see i960's movq insn).  Later.
 213
 214 (define (/build-index-of-operand! expr tstate op-list)
 215   (if (not (and (rtx? (rtx-index-of-value expr))
 216                 (rtx-kind? 'operand (rtx-index-of-value expr))))
 217       (parse-error (tstate-context tstate)
 218                    "only `(index-of operand)' is currently supported"
 219                    expr))
 220
 221   (let ((op (rtx-operand-obj (rtx-index-of-value expr)
 222                              (obj-isa-list (tstate-owner tstate)))))
 223     (let ((indx (op:index op)))
 224       (if (not (eq? (hw-index:type indx) 'ifield))
 225           (parse-error (tstate-context tstate)
 226                        "only ifield indices are currently supported"
 227                        expr))
 228       (let* ((f (hw-index:value indx))
 229              (f-name (obj:name f)))
 230         ; The rest of this is identical to /build-ifield-operand!.
 231         (let* ((mode (obj:name (ifld-mode f)))
 232                (try (list '-op- #f mode f-name #f))
 233                (existing-op (/rtx-find-op try op-list)))
 234
 235           ; If already present, return the object, otherwise add it.
 236           (if existing-op
 237
 238               (cadr existing-op)
 239
 240               (let ((xop (make <operand> (if (source-ident? f) (obj-location f) #f)
 241                                f-name f-name
 242                                (atlist-cons (bool-attr-make 'SEM-ONLY #t)
 243                                             (obj-atlist f))
 244                                (obj:name (ifld-hw-type f))
 245                                mode
 246                                (make <hw-index> 'anonymous
 247                                      'ifield
 248                                      (ifld-mode f)
 249                                      ; (send (op:type op) 'get-index-mode)
 250                                      f)
 251                                nil #f #f)))
 252                 (set-car! (cdr try) (rtx-make-xop xop))
 253                 (append! op-list (list try))
 254                 (cadr try)))))))
 255 )
 256
 257 ; Build the tstate known value list for INSN.
 258 ; This is built from the ifield-assertion list.
 259
 260 (define (insn-build-known-values insn)
 261   (let ((expr (insn-ifield-assertion insn)))
 262     (if expr
 263         (case (rtx-name expr)
 264           ((eq)
 265            (if (and (rtx-kind? 'ifield (rtx-cmp-op-arg expr 0))
 266                     (rtx-constant? (rtx-cmp-op-arg expr 1)))
 267                (list (cons (rtx-ifield-name (rtx-cmp-op-arg expr 0))
 268                            (rtx-cmp-op-arg expr 1)))
 269                nil))
 270           ((member)
 271            (if (rtx-kind? 'ifield (rtx-member-value expr))
 272                (list (cons (rtx-ifield-name (rtx-member-value expr))
 273                            (rtx-member-set expr)))
 274                nil))
 275           (else nil))
 276         nil))
 277 )
 278
 279 ; Structure to record the result of semantic-compile.
 280
 281 (define (csem-make compiled-code inputs outputs attributes)
 282   (vector compiled-code inputs outputs attributes)
 283 )
 284
 285 ; Accessors.
 286
 287 (define (csem-code csem) (vector-ref csem 0))
 288 (define (csem-inputs csem) (vector-ref csem 1))
 289 (define (csem-outputs csem) (vector-ref csem 2))
 290 (define (csem-attrs csem) (vector-ref csem 3))
 291 \f
 292 ; Traverse SEM-CODE, computing the input and output operands.
 293 ; The result is an object of four elements (built with csem-make).
 294 ; The first is a list of the canonical form of each element in SEM-CODE:
 295 ; operand and ifield elements specified without `operand' or `ifield' have it
 296 ; prepended, and operand numbers are computed for each operand.
 297 ; Operand numbers are needed when emitting "write" handlers for LIW cpus.
 298 ; Having the operand numbers available is also useful for efficient
 299 ; modeling: recording operand references can be done with a bitmask (one host
 300 ; insn), and the code to do the modeling can be kept out of the code that
 301 ; performs the insn.
 302 ; The second is the list of input <operand> objects.
 303 ; The third is the list of output <operand> objects.
 304 ; The fourth is an <attr-list> object of attributes that can be computed from
 305 ; the semantics.
 306 ; The possibilities are: UNCOND-CTI, COND-CTI, SKIP-CTI, DELAY-SLOT.
 307 ; ??? Combine *-CTI into an enum attribute.
 308 ;
 309 ; CONTEXT is a <context> object or #f if there is none.
 310 ; INSN is the <insn> object.
 311 ; SEM-CODE must be canonicalized rtl.
 312 ;
 313 ; ??? Specifying operand ordinals in the source would simplify this and speed
 314 ; it up.  On the other hand that makes the source form more complex.  Maybe the
 315 ; complexity will prove necessary, but following the goal of "incremental
 316 ; complication", we don't do this yet.
 317 ; Another way to simplify this and speed it up would be to add lists of
 318 ; input/output operands to the instruction description.
 319 ;
 320 ; ??? This calls rtx-simplify which calls rtx-traverse as it's simpler to
 321 ; simplify EXPR first, and then compile it.  On the other hand it's slower
 322 ; (two calls to rtx-traverse!).
 323
 324 (define (semantic-compile context insn sem-code)
 325   (assert (rtx? sem-code))
 326
 327   (let*
 328       (
 329        ; These record the result of traversing SEM-CODE.
 330        ; They're lists of (type object mode name [args ...]).
 331        ; TYPE is one of: -op- reg mem.
 332        ; `-op-' is just something unique and is only used internally.
 333        ; OBJECT is the constructed <operand> object.
 334        ; The first element is just a dummy so that append! always works.
 335        (in-ops (list (list #f)))
 336        (out-ops (list (list #f)))
 337
 338        ; List of attributes computed from SEM-CODE.
 339        ; The first element is just a dummy so that append! always works.
 340        (sem-attrs (list #f))
 341
 342        ; Called for expressions encountered in SEM-CODE.
 343        ; Don't waste cpu here, this is part of the slowest piece in CGEN.
 344        (process-expr!
 345         (lambda (rtx-obj expr parent-expr op-pos tstate appstuff)
 346           (case (car expr)
 347
 348             ;; NOTE: Despite the ! in, e.g., /build-reg-operand!,
 349             ;; it does return a result.
 350
 351             ; Registers.
 352             ((reg) (let ((ref-type (/rtx-ref-type parent-expr op-pos))
 353                          ; ??? could verify reg is a scalar
 354                          (regno (or (rtx-reg-number expr) 0)))
 355                      ; The register number is either a number or an
 356                      ; expression.
 357                      ; ??? This is a departure from GCC RTL that might have
 358                      ; significant ramifications.  On the other hand in cases
 359                      ; where it matters the expression could always be
 360                      ; required to reduce to a constant (or some such).
 361                      (cond ((number? regno) #t)
 362                            ((form? regno)
 363                             (rtx-traverse-operands rtx-obj expr tstate appstuff))
 364                            (else (parse-error (tstate-context tstate)
 365                                               "invalid register number"
 366                                               regno)))
 367                      (/build-reg-operand! expr tstate ref-type
 368                                           (if (eq? ref-type 'use)
 369                                               in-ops
 370                                               out-ops)
 371                                           sem-attrs)))
 372
 373             ; Memory.
 374             ((mem) (let ((ref-type (/rtx-ref-type parent-expr op-pos)))
 375                      (rtx-traverse-operands rtx-obj expr tstate appstuff)
 376                      (/build-mem-operand! expr tstate
 377                                           (if (eq? ref-type 'use)
 378                                               in-ops
 379                                               out-ops))))
 380
 381             ; Operands.
 382             ((operand) (let ((ref-type (/rtx-ref-type parent-expr op-pos)))
 383                          (/build-operand! expr tstate ref-type
 384                                           (if (eq? ref-type 'use)
 385                                               in-ops
 386                                               out-ops)
 387                                           sem-attrs)))
 388
 389             ; Give operand new name.
 390             ((name) (let ((result (/rtx-traverse (caddr expr) 'RTX
 391                                                  parent-expr op-pos tstate appstuff)))
 392                       (if (not (operand? result))
 393                           (error "name: invalid argument:" expr result))
 394                       (op:set-sem-name! result (cadr expr))
 395                       ; (op:set-num! result (caddr expr))
 396                       result))
 397
 398             ; Specify a reference to a local variable
 399             ((local) expr) ; nothing to do
 400
 401             ; Instruction fields.
 402             ((ifield) (let ((ref-type (/rtx-ref-type parent-expr op-pos)))
 403                         (if (not (eq? ref-type 'use))
 404                             (parse-error (tstate-context tstate)
 405                                          "can't set an `ifield'" expr))
 406                         (/build-ifield-operand! expr tstate in-ops)))
 407
 408             ; Hardware indices.
 409             ; For registers this is the register number.
 410             ; For memory this is the address.
 411             ; For constants, this is the constant.
 412             ((index-of) (let ((ref-type (/rtx-ref-type parent-expr op-pos)))
 413                           (if (not (eq? ref-type 'use))
 414                               (parse-error (tstate-context tstate)
 415                                            "can't set an `index-of'" expr))
 416                           (/build-index-of-operand! expr tstate in-ops)))
 417
 418             ; Machine generate the SKIP-CTI attribute.
 419             ((skip) (append! sem-attrs (list 'SKIP-CTI)) #f)
 420
 421             ; Machine generate the DELAY-SLOT attribute.
 422             ((delay) (append! sem-attrs (list 'DELAY-SLOT)) #f)
 423
 424             ; If this is a syntax expression, the operands won't have been
 425             ; processed, so tell our caller we want it to by returning #f.
 426             ; We do the same for non-syntax expressions to keep things
 427             ; simple.  This requires collaboration with the traversal
 428             ; handlers which are defined to do what we want if we return #f.
 429             (else #f))))
 430
 431        ; Whew.  We're now ready to traverse the expression.
 432        ; Traverse the expression recording the operands and building objects
 433        ; for most elements in the source representation.
 434        ; This also performs various simplifications.
 435        ; In particular machine dependent code for non-selected machines
 436        ; is discarded.
 437        (compiled-expr (rtx-traverse
 438                        context
 439                        insn
 440                        (rtx-simplify context insn sem-code
 441                                      (insn-build-known-values insn))
 442                        process-expr!
 443                        #f))
 444        )
 445
 446     ;(display "in:  ") (display in-ops) (newline)
 447     ;(display "out: ") (display out-ops) (newline)
 448     ;(force-output)
 449
 450     ; Now that we have the nub of all input and output operands,
 451     ; we can assign operand numbers.  Inputs and outputs are not defined
 452     ; separately, output operand numbers follow inputs.  This simplifies the
 453     ; code which keeps track of such things: it can use one variable.
 454     ; The assignment is defined to be arbitrary.  If there comes a day
 455     ; when we need to prespecify operand numbers, revisit.
 456     ; The operand lists are sorted to avoid spurious differences in generated
 457     ; code (for example unnecessary extra entries can be created in the
 458     ; ARGBUF struct).
 459
 460     ; Drop dummy first arg and sort operand lists.
 461     (let ((sorted-ins
 462            (alpha-sort-obj-list (map (lambda (op)
 463                                        (rtx-xop-obj (cadr op)))
 464                                      (cdr in-ops))))
 465           (sorted-outs
 466            (alpha-sort-obj-list (map (lambda (op)
 467                                        (rtx-xop-obj (cadr op)))
 468                                      (cdr out-ops))))
 469           (sem-attrs (cdr sem-attrs)))
 470
 471       (let ((in-op-nums (iota (length sorted-ins)))
 472             (out-op-nums (iota (length sorted-outs) (length sorted-ins))))
 473
 474         (for-each (lambda (op num) (op:set-num! op num))
 475                   sorted-ins in-op-nums)
 476         (for-each (lambda (op num) (op:set-num! op num))
 477                   sorted-outs out-op-nums)
 478
 479         (let ((dump (lambda (op)
 480                       (string/symbol-append "  "
 481                                             (obj:name op)
 482                                             " "
 483                                             (number->string (op:num op))
 484                                             "\n"))))
 485           (logit 4
 486                  "Input operands:\n"
 487                  (map dump sorted-ins)
 488                  "Output operands:\n"
 489                  (map dump sorted-outs)
 490                  "End of operands.\n"))
 491
 492         (csem-make compiled-expr sorted-ins sorted-outs
 493                    (atlist-parse context sem-attrs "")))))
 494 )
 495 \f
 496 ; Traverse SEM-CODE, computing attributes derivable from it.
 497 ; The result is an <attr-list> object of attributes that can be computed from
 498 ; the semantics.
 499 ; The possibilities are: UNCOND-CTI, COND-CTI, SKIP-CTI, DELAY-SLOT.
 500 ; This computes the same values as semantic-compile, but for speed is
 501 ; focused on attributes only.
 502 ; ??? Combine *-CTI into an enum attribute.
 503 ;
 504 ; CONTEXT is a <context> object or #f if there is none.
 505 ; INSN is the <insn> object.
 506 ; SEM-CODE must be canonicalized rtl.
 507
 508 (define (semantic-attrs context insn sem-code)
 509   (assert (rtx? sem-code))
 510
 511   (let*
 512       (
 513        ; List of attributes computed from SEM-CODE.
 514        ; The first element is just a dummy so that append! always works.
 515        (sem-attrs (list #f))
 516
 517        ; Called for expressions encountered in SEM-CODE.
 518        (process-expr!
 519         (lambda (rtx-obj expr parent-expr op-pos tstate appstuff)
 520           (case (car expr)
 521
 522             ;; FIXME: What's the result for the operand case?
 523             ((operand) (if (and (eq? 'pc (rtx-operand-name expr))
 524                                 (memq (/rtx-ref-type parent-expr op-pos)
 525                                       '(set set-quiet)))
 526                            (append! sem-attrs
 527                                     (if (tstate-cond? tstate)
 528                                         ;; Don't change these to '(FOO), since
 529                                         ;; we use append!.
 530                                         (list 'COND-CTI)
 531                                         (list 'UNCOND-CTI)))))
 532
 533             ;; FIXME: keep name h-pc hardwired?
 534             ((reg) (if (and (eq? 'h-pc (rtx-reg-name expr))
 535                             (memq (/rtx-ref-type parent-expr op-pos)
 536                                   '(set set-quiet)))
 537                        (append! sem-attrs
 538                                 (if (tstate-cond? tstate)
 539                                     ;; Don't change these to '(FOO), since
 540                                     ;; we use append!.
 541                                     (list 'COND-CTI)
 542                                     (list 'UNCOND-CTI)))))
 543
 544             ((skip) (append! sem-attrs (list 'SKIP-CTI)) #f)
 545
 546             ((delay) (append! sem-attrs (list 'DELAY-SLOT)) #f)
 547
 548             ; If this is a syntax expression, the operands won't have been
 549             ; processed, so tell our caller we want it to by returning #f.
 550             ; We do the same for non-syntax expressions to keep things
 551             ; simple.  This requires collaboration with the traversal
 552             ; handlers which are defined to do what we want if we return #f.
 553             (else #f))))
 554
 555        ; Traverse the expression recording the attributes.
 556        (traversed-expr (rtx-traverse
 557                         context
 558                         insn
 559                         (rtx-simplify context insn sem-code
 560                                       (insn-build-known-values insn))
 561                         process-expr!
 562                         #f))
 563        )
 564
 565     (let
 566         ; Drop dummy first arg.
 567         ((sem-attrs (cdr sem-attrs)))
 568       (atlist-parse context sem-attrs "")))
 569 )