2 ; Copyright (C) 2000, 2001, 2009, 2010 Red Hat, Inc.
3 ; This file is part of CGEN.
4 ; See file COPYING.CGEN for details.
6 ; The name for the description language has been changed a couple of times.
7 ; RTL isn't my favorite because of perceived confusion with GCC
8 ; (and perceived misinterpretation of intentions!).
9 ; On the other hand my other choices were taken (and believed to be
12 ; RTL functions are described by class <rtx-func>.
13 ; The complete list of rtl functions is defined in doc/rtl.texi.
15 ; Conventions used in this file:
16 ; - procs that perform the basic rtl or semantic expression manipulation that
17 ; is for public use shall be prefixed with "s-" or "rtl-" or "rtx-"
18 ; - no other procs shall be so prefixed
19 ; - rtl globals and other rtx-func object support shall be prefixed with
21 ; - no other procs shall be so prefixed
23 ; Class for defining rtx nodes.
25 ; FIXME: Add new members that are lambda's to perform the argument checking
26 ; specified by `arg-types' and `arg-modes'. This will save a lookup during
27 ; traversing. It will also allow custom versions for oddballs (e.g. for
28 ; `member' we want to verify the 2nd arg is a `number-list' rtx).
32 (class-make '<rtx-func> nil
34 ; name as it appears in RTL
35 ; must be accessed via obj:name
39 ; ??? Not used I think, but keep.
42 ; result mode, or #f if from arg 2
43 ; (or the containing expression when canonicalizing)
46 ; types of each argument, as symbols
47 ; This is #f for macros.
49 ; OPTIONS - optional list of keyword-prefixed options
50 ; ANYINTMODE - any integer mode
51 ; ANYFLOATMODE - any floating point mode
52 ; ANYNUMMODE - any numeric mode
53 ; ANYEXPRMODE - VOID, PTR, SYM, or any numeric mode
54 ; ANYCEXPRMODE - VOID, PTR, or any numeric mode
55 ; EXPLNUMMODE - explicit numeric mode, can't be DFLT or VOID
56 ; VOIDORNUMMODE - VOID or any numeric mode
57 ; VOIDMODE - must be `VOID'
58 ; BIMODE - BI (boolean or bit int)
59 ; INTMODE - must be `INT'
60 ; SYMMODE - must be SYM
61 ; INSNMODE - must be INSN
62 ; MACHMODE - must be MACH
64 ; SETRTX - any rtx allowed to be `set'
65 ; TESTRTX - the test of an `if'
66 ; CONDRTX - a cond expression ((test) rtx ... rtx)
67 ; CASERTX - a case expression ((symbol .. symbol) rtx ... rtx)
68 ; LOCALS - the locals list of a sequence
69 ; ITERATION - the iteration
70 ; SYMBOLLIST - used for ISA name lists
71 ; ENVSTACK - environment stack
72 ; ATTRS - attribute list
73 ; SYMBOL - arg must be a symbol
74 ; STRING - arg must be a string
75 ; NUMBER - arg must be a number
76 ; SYMORNUM - arg must be a symbol or number
77 ; OBJECT - arg is an object (FIXME: restrict to <operand>?)
80 ; required mode of each argument
81 ; This is #f for macros.
82 ; Possible values include any mode name and:
84 ; ANYINT - any integer mode
86 ; MATCHEXPR - mode has to match the mode specified in the
87 ; containing expression
88 ; NOTE: This isn't necessarily the mode of the
89 ; result of the expression. E.g. in `set', the
90 ; result always has mode VOID, but the mode
91 ; specified in the expression is the mode of the
93 ; MATCHSEQ - for sequences
94 ; last expression has to match mode of sequence,
95 ; preceding expressions must be VOID
96 ; MATCH2 - must match mode of arg 2
97 ; MATCH3 - must match mode of arg 3
98 ; <MODE-NAME> - must match specified mode
101 ; arg number of the MATCHEXPR arg,
102 ; or #f if there is none
106 ; This is #f for macros.
107 ; ARG - operand, local, const
108 ; SET - set, set-quiet
109 ; UNARY - not, inv, etc.
110 ; BINARY - add, sub, etc.
111 ; TRINARY - addc, subc, etc.
112 ; COMPARE - eq, ne, etc.
115 ; SEQUENCE - sequence, parallel
117 ; MISC - everything else
120 ; A symbol indicating the flavour of rtx node this is.
121 ; FUNCTION - normal function
122 ; SYNTAX - don't pre-eval arguments
123 ; OPERAND - result is an operand
124 ; MACRO - converts one rtx expression to another
125 ; The word "style" was chosen to be sufficiently different
126 ; from "type", "kind", and "class".
129 ; A function to perform the rtx.
132 ; Ordinal number of rtx. Used to index into tables.
140 (define (rtx-func? x) (class-instance? <rtx-func> x))
144 (define-getters <rtx-func> rtx
145 (result-mode arg-types arg-modes matchexpr-index class style evaluator num)
148 (define (rtx-style-syntax? rtx) (eq? (rtx-style rtx) 'syntax))
150 ; Add standard `get-name' method since this isn't a subclass of <ident>.
152 (method-make! <rtx-func> 'get-name (lambda (self) (elm-get self 'name)))
154 ; List of mode types for arg-types.
156 (define /rtx-valid-mode-types
158 ANYINTMODE ANYFLOATMODE ANYNUMMODE ANYEXPRMODE ANYCEXPRMODE EXPLNUMMODE
159 VOIDORNUMMODE VOIDMODE BIMODE INTMODE SYMMODE INSNMODE MACHMODE
163 ; List of valid values for arg-types, not including mode names.
165 (define /rtx-valid-types
168 /rtx-valid-mode-types
169 '(RTX SETRTX TESTRTX CONDRTX CASERTX)
170 '(LOCALS ITERATION SYMBOLLIST ENVSTACK ATTRS)
171 '(SYMBOL STRING NUMBER SYMORNUM OBJECT)
175 ; List of valid mode matchers, excluding mode names.
177 (define /rtx-valid-matches
178 '(ANY ANYINT NA MATCHEXPR MATCHSEQ MATCH2 MATCH3)
181 ;; Return arg number of MATCHEXPR in ARG-MODES or #f if not present.
183 (define (/rtx-find-matchexpr-index arg-modes)
184 ;; We can't use find-first-index here because arg-modes can be an
185 ;; improper list (a b c . d).
186 ;;(find-first-index 0 (lambda (t) (eq? t 'MATCHEXPR)) arg-modes)
187 (define (improper-find-first-index i pred l)
190 (cond ((pred (car l)) i)
191 (else (improper-find-first-index (+ 1 i) pred (cdr l)))))
194 (improper-find-first-index 0 (lambda (t) (eq? t 'MATCHEXPR)) arg-modes)
197 ; List of all defined rtx names. This can be map'd over without having
198 ; to know the innards of /rtx-func-table (which is a hash table).
200 (define /rtx-name-list nil)
201 (define (rtx-name-list) /rtx-name-list)
203 ; Table of rtx function objects.
204 ; This is set in rtl-init!.
206 (define /rtx-func-table nil)
208 ; Look up the <rtx-func> object for RTX-KIND.
209 ; Returns the object or #f if not found.
210 ; RTX-KIND is the name of the rtx function.
212 (define (rtx-lookup rtx-kind)
213 (assert (symbol? rtx-kind))
214 (hashq-ref /rtx-func-table rtx-kind)
217 ; Table of rtx macro objects.
218 ; This is set in rtl-init!.
220 (define /rtx-macro-table nil)
222 ; Table of operands, modes, and other non-functional aspects of RTL.
223 ; This is defined in rtl-finish!, after all operands have been read in.
225 (define /rtx-operand-table nil)
227 ; Number of next rtx to be defined.
229 (define /rtx-num-next #f)
231 ; Return the number of rtx's.
233 (define (rtx-max-num)
239 ; Add an entry to the rtx function table.
240 ; NAME-ARGS is a list of the operation name and arguments.
241 ; The mode of the result must be the first element in `args' (if there are
243 ; ARG-TYPES is a list of argument types (/rtx-valid-types).
244 ; ARG-MODES is a list of mode matchers (/rtx-valid-matches).
245 ; CLASS is the class of the rtx to be created.
246 ; ACTION is a list of Scheme expressions to perform the operation.
248 ; ??? Note that we can support variables. Not sure it should be done.
250 (define (def-rtx-node name-args result-mode arg-types arg-modes class action)
251 (let* ((name (car name-args))
252 (args (cdr name-args))
253 (context (make-prefix-context (string-append "defining rtx "
254 (symbol->string name))))
255 (matchexpr-index (/rtx-find-matchexpr-index arg-modes)))
257 ; (map1-improper (lambda (arg-type)
258 ; (if (not (memq arg-type /rtx-valid-types))
259 ; (context-error context "While defining rtx functions"
260 ; "invalid arg type" arg-type)))
262 ; (map1-improper (lambda (arg-mode)
263 ; (if (and (not (memq arg-mode /rtx-valid-matches))
264 ; (not (symbol? arg-mode))) ;; FIXME: mode-name?
265 ; (context-error context "While defining rtx functions"
266 ; "invalid arg mode match" arg-mode)))
269 (let ((rtx (make <rtx-func> name args
270 result-mode arg-types arg-modes matchexpr-index
275 (cons '*estate* args)
279 ; Add it to the table of rtx handlers.
280 (hashq-set! /rtx-func-table name rtx)
281 (set! /rtx-num-next (+ /rtx-num-next 1))
282 (set! /rtx-name-list (cons name /rtx-name-list))
286 (define define-rtx-node
287 ; Written this way so Hobbit can handle it.
288 (defmacro:syntax-transformer (lambda arg-list
289 (apply def-rtx-node arg-list)
293 ; Same as define-rtx-node but don't pre-evaluate the arguments.
294 ; Remember that `mode' must be the first argument.
296 (define (def-rtx-syntax-node name-args result-mode arg-types arg-modes class action)
297 (let ((name (car name-args))
298 (args (cdr name-args))
299 (matchexpr-index (/rtx-find-matchexpr-index arg-modes)))
300 (let ((rtx (make <rtx-func> name args
301 result-mode arg-types arg-modes matchexpr-index
306 (cons '*estate* args)
310 ; Add it to the table of rtx handlers.
311 (hashq-set! /rtx-func-table name rtx)
312 (set! /rtx-num-next (+ /rtx-num-next 1))
313 (set! /rtx-name-list (cons name /rtx-name-list))
317 (define define-rtx-syntax-node
318 ; Written this way so Hobbit can handle it.
319 (defmacro:syntax-transformer (lambda arg-list
320 (apply def-rtx-syntax-node arg-list)
324 ; Same as define-rtx-node but return an operand (usually an <operand> object).
325 ; ??? `mode' must be the first argument?
327 (define (def-rtx-operand-node name-args result-mode arg-types arg-modes class action)
328 ; Operand nodes must specify an action.
330 (let ((name (car name-args))
331 (args (cdr name-args))
332 (matchexpr-index (/rtx-find-matchexpr-index arg-modes)))
333 (let ((rtx (make <rtx-func> name args
334 result-mode arg-types arg-modes matchexpr-index
338 (cons '*estate* args)
341 ; Add it to the table of rtx handlers.
342 (hashq-set! /rtx-func-table name rtx)
343 (set! /rtx-num-next (+ /rtx-num-next 1))
344 (set! /rtx-name-list (cons name /rtx-name-list))
348 (define define-rtx-operand-node
349 ; Written this way so Hobbit can handle it.
350 (defmacro:syntax-transformer (lambda arg-list
351 (apply def-rtx-operand-node arg-list)
355 ; Convert one rtx expression into another.
356 ; NAME-ARGS is a list of the operation name and arguments.
357 ; ACTION is a list of Scheme expressions to perform the operation.
358 ; The result of ACTION must be another rtx expression (a list).
360 (define (def-rtx-macro-node name-args action)
361 ; macro nodes must specify an action
363 (let ((name (car name-args))
364 (args (cdr name-args)))
365 (let ((rtx (make <rtx-func> name args #f #f #f #f
368 (eval1 (list 'lambda args action))
370 ; Add it to the table of rtx macros.
371 (hashq-set! /rtx-macro-table name rtx)
372 (set! /rtx-num-next (+ /rtx-num-next 1))
373 (set! /rtx-name-list (cons name /rtx-name-list))
377 (define define-rtx-macro-node
378 ; Written this way so Hobbit can handle it.
379 (defmacro:syntax-transformer (lambda arg-list
380 (apply def-rtx-macro-node arg-list)
384 ; RTL macro expansion.
385 ; RTL macros are different than pmacros. The difference is that the expansion
386 ; happens internally, RTL macros are part of the language.
388 ; Lookup MACRO-NAME and return its <rtx-func> object or #f if not found.
390 (define (/rtx-macro-lookup macro-name)
391 (hashq-ref /rtx-macro-table macro-name)
394 ; Lookup (car exp) and return the macro's lambda if it is one or #f.
396 (define (/rtx-macro-check exp fn-getter)
397 (let ((macro (hashq-ref /rtx-macro-table (car exp))))
405 (define (/rtx-macro-expand-list exp fn-getter)
406 (let ((macro (/rtx-macro-check exp fn-getter)))
408 (apply macro (map (lambda (x) (/rtx-macro-expand x fn-getter))
410 (map (lambda (x) (/rtx-macro-expand x fn-getter))
414 ; Main entry point to expand a macro invocation.
416 (define (/rtx-macro-expand exp fn-getter)
417 (if (pair? exp) ; pair? -> cheap (and (not (null? exp)) (list? exp))
418 (let ((result (/rtx-macro-expand-list exp fn-getter)))
419 ; If the result is a new macro invocation, recurse.
421 (let ((macro (/rtx-macro-check result fn-getter)))
423 (/rtx-macro-expand (apply macro (cdr result)) fn-getter)
429 ; Publically accessible version.
431 (define rtx-macro-expand /rtx-macro-expand)
435 ; Get implied mode of X, either an operand expression, sequence temp, or
436 ; a hardware reference expression.
437 ; The result is the name of the mode.
439 (define (rtx-lvalue-mode-name estate x)
442 ; ((operand) (obj:name (op:mode (current-op-lookup (cadr x) (obj-isa-list (estate-owner estate))))))
443 ((xop) (obj:name (send (rtx-xop-obj x) 'get-mode)))
445 ; (if (eq? (rtx-opspec-mode x) 'VOID)
446 ; (rtx-lvalue-mode-name estate (rtx-opspec-hw-ref x))
447 ; (rtx-opspec-mode x)))
448 ; ((reg mem) (cadr x))
449 ((local) ;; (local options mode name)
450 (let* ((name (cadddr x))
451 (temp (rtx-temp-lookup (estate-env-stack estate) name)))
453 (estate-error estate "unknown local" name))
454 (obj:name (rtx-temp-mode temp))))
457 "rtx-lvalue-mode-name: not an operand or hardware reference:"
461 ; Lookup the mode to use for semantic operations (unsigned modes aren't
462 ; allowed since we don't have ANDUSI, etc.).
463 ; MODE is a <mode> object.
464 ; ??? I have actually implemented both ways (full use of unsigned modes
465 ; and mostly hidden use of unsigned modes). Neither makes me real
466 ; comfortable, though I liked bringing unsigned modes out into the open
467 ; even if it doubled the number of semantic operations.
469 (define (rtx-sem-mode mode) (or (mode:sem-mode mode) mode))
471 ; Return the mode of object OBJ.
473 (define (rtx-obj-mode obj) (send obj 'get-mode))
475 ; Return a boolean indicating of modes M1,M2 are compatible.
476 ; M1,M2 are <mode> objects.
478 (define (rtx-mode-compatible? m1 m2)
479 ;; ??? This is more permissive than is perhaps proper.
480 (let ((mode1 (rtx-sem-mode m1))
481 (mode2 (rtx-sem-mode m2)))
482 ;;(eq? (obj:name mode1) (obj:name mode2)))
483 (mode-compatible? 'sameclass mode1 mode2))
486 ; Environments (sequences with local variables).
488 ; Temporaries are created within a sequence.
489 ; MODE is a <mode> object.
490 ; VALUE is #f if not set yet.
491 ; e.g. (sequence ((WI tmp)) (set tmp reg0) ...)
492 ; ??? Perhaps what we want here is `let' but for now I prefer `sequence'.
493 ; This isn't exactly `let' either as no initial value is specified.
494 ; Environments are also used to specify incoming values from the top level.
496 (define <rtx-temp> (class-make '<rtx-temp> nil '(name mode value) nil))
498 ;(define cx-temp:name (elm-make-getter <c-expr-temp> 'name))
499 ;(define cx-temp:mode (elm-make-getter <c-expr-temp> 'mode))
500 ;(define cx-temp:value (elm-make-getter <c-expr-temp> 'value))
502 (define-getters <rtx-temp> rtx-temp (name mode value))
506 (lambda (self name mode value)
507 (assert (mode? mode))
508 (elm-set! self 'name name)
509 (elm-set! self 'mode mode)
510 (elm-set! self 'value (if value value (gen-temp name)))
514 (define (gen-temp name)
515 ; ??? calls to gen-c-symbol don't belong here
516 (string-append "tmp_" (gen-c-symbol name))
519 ; Return a boolean indicating if X is an <rtx-temp>.
521 (define (rtx-temp? x) (class-instance? <rtx-temp> x))
523 ; Respond to 'get-mode messages.
525 (method-make! <rtx-temp> 'get-mode (lambda (self) (elm-get self 'mode)))
527 ; Respond to 'get-name messages.
529 (method-make! <rtx-temp> 'get-name (lambda (self) (elm-get self 'name)))
531 ; An environment is a list of <rtx-temp> objects.
532 ; An environment stack is a list of environments.
534 (define (rtx-env-stack-empty? env-stack) (null? env-stack))
535 (define (rtx-env-stack-head env-stack) (car env-stack))
536 (define (rtx-env-empty-stack) nil)
537 (define (rtx-env-init-stack1 vars-alist)
538 (if (null? vars-alist)
540 (cons (rtx-env-make vars-alist) nil))
542 (define (rtx-env-empty? env) (null? env))
544 ;; Create an environment from VAR-ALIST,
545 ;; an alist of (name <mode>-or-mode-name value) elements,
546 ;; or, in the case of /rtx-closure-make, a list of (name . <rtx-temp>).
548 (define (rtx-env-make var-alist)
549 ;; Check for an already-compiled environment, for /rtx-closure-make's sake.
550 (if (and (pair? var-alist)
551 (rtx-temp? (cdar var-alist)))
553 ;; Convert VAR-ALIST to an associative list of <rtx-temp> objects.
554 (map (lambda (var-spec)
558 (mode-maybe-lookup (cadr var-spec))
563 ; Create an initial environment with local variables.
564 ; VAR-LIST is a list of (mode-name name) elements, i.e. the locals argument to
565 ; `sequence' or equivalent thereof.
567 (define (rtx-env-make-locals var-list)
568 ; Convert VAR-LIST to an associative list of <rtx-temp> objects.
569 (map (lambda (var-spec)
570 (cons (cadr var-spec)
572 (cadr var-spec) (mode:lookup (car var-spec)) #f)))
576 ; Return the symbol name of the limit variable of `do-count'
577 ; given iteration-variable ITER-VAR.
578 ; ??? We don't publish that this variable is available to use, but we could.
580 (define (rtx-make-iteration-limit-var iter-var)
581 (symbol-append iter-var '-limit)
584 ; Create an environment with the iteration local variables of `do-count'.
586 (define (rtx-env-make-iteration-locals iter-var)
587 (rtx-env-make-locals (list (list 'INT iter-var)
588 (list 'INT (rtx-make-iteration-limit-var iter-var))))
591 ;; Convert an alist of (name <mode>-object-or-name value) to
594 (define (rtx-var-alist-to-env var-alist) var-alist)
596 ;; Convert an alist of (name <mode>-object-or-name value) to
597 ;; an environment stack.
599 (define (rtx-var-alist-to-closure-env-stack var-alist)
600 ;; Preserve emptiness so (null? env-stack) works.
601 (if (null? var-alist)
606 ;; Convert the source form of an env-stack, e.g. as used in a closure,
607 ;; to the internal form, which is (name <rtx-temp>-object).
609 (define (rtx-make-env-stack closure-env-stack)
610 (map rtx-env-make closure-env-stack)
613 ; Push environment ENV onto the front of environment stack ENV-STACK,
614 ; returning a new object. ENV-STACK is not modified.
616 (define (rtx-env-push env-stack env)
620 ; Lookup variable NAME in environment stack ENV-STACK.
621 ; The result is the <rtx-temp> object.
623 (define (rtx-temp-lookup env-stack name)
624 (let loop ((stack env-stack))
627 (let ((temp (assq-ref (car stack) name)))
630 (loop (cdr stack))))))
633 ; Create a "closure" of EXPR using the current ISA list and temp stack.
634 ; MODE is the mode name.
636 (define (/rtx-closure-make estate mode expr)
637 ;; NOTE: This records the "compiled" environment stack in the closure.
638 (rtx-make 'closure mode (estate-isas estate) (estate-env-stack estate)
642 (define (rtx-env-stack-dump env-stack)
643 (let ((stack env-stack))
644 (if (rtx-env-stack-empty? stack)
645 (display "rtx-env stack (empty):\n")
646 (let loop ((stack stack) (level 0))
650 (display "rtx-env stack, level ")
653 (for-each (lambda (var)
655 ;(display (obj:name (rtx-temp-mode (cdr var))))
657 (display (rtx-temp-name (cdr var)))
660 (loop (cdr stack) (+ level 1)))))))
663 ; Build, test, and analyze various kinds of rtx's.
664 ; ??? A lot of this could be machine generated except that I don't yet need
667 (define (rtx-make kind . args)
668 (cons kind (rtx-munge-mode&options (rtx-lookup kind) 'DFLT kind args))
671 (define rtx-name car)
672 (define (rtx-kind? kind rtx) (eq? kind (rtx-name rtx)))
674 (define (rtx-make-const mode value) (rtx-make 'const mode value))
675 (define (rtx-make-enum mode value) (rtx-make 'enum mode value))
677 (define (rtx-constant? rtx) (memq (rtx-name rtx) '(const enum)))
679 ; Return value of constant RTX (either const or enum).
680 (define (rtx-constant-value rtx)
682 ((const) (rtx-const-value rtx))
683 ((enum) (car (enum-lookup-val (rtx-enum-value rtx))))
684 (else (error "rtx-constant-value: not const or enum" rtx)))
687 (define rtx-options cadr)
688 (define rtx-mode caddr)
689 (define rtx-args cdddr)
690 (define rtx-arg1 cadddr)
691 (define (rtx-arg2 rtx) (car (cddddr rtx)))
693 (define rtx-const-value rtx-arg1)
694 (define rtx-enum-value rtx-arg1)
696 (define rtx-reg-name rtx-arg1)
698 ; Return register number or #f if absent.
699 ; (reg options mode hw-name [regno [selector]])
700 (define (rtx-reg-number rtx) (list-maybe-ref rtx 4))
702 ; Return register selector or #f if absent.
703 (define (rtx-reg-selector rtx) (list-maybe-ref rtx 5))
705 ; Return both register number and selector.
706 (define rtx-reg-index-sel cddddr)
708 ; Return memory address.
709 (define rtx-mem-addr rtx-arg1)
711 ; Return memory selector or #f if absent.
712 (define (rtx-mem-sel mem) (list-maybe-ref mem 4))
714 ; Return both memory address and selector.
715 (define rtx-mem-index-sel cdddr)
717 ; Return MEM with new address NEW-ADDR.
718 ; ??? Complicate as necessary.
719 (define (rtx-change-address mem new-addr)
727 ; Return argument to `symbol' rtx.
728 (define rtx-symbol-name rtx-arg1)
730 (define (rtx-make-ifield mode-name ifield-name)
731 (rtx-make 'ifield mode-name ifield-name)
733 (define (rtx-ifield? rtx) (eq? 'ifield (rtx-name rtx)))
734 (define (rtx-ifield-name rtx)
735 (let ((ifield (rtx-arg1 rtx)))
740 (define (rtx-ifield-obj rtx)
741 (let ((ifield (rtx-arg1 rtx)))
743 (current-ifld-lookup ifield)
747 (define (rtx-make-operand mode-name op-name)
748 (rtx-make 'operand mode-name op-name)
750 (define (rtx-operand? rtx) (eq? 'operand (rtx-name rtx)))
751 ;; FIXME: This should just fetch rtx-arg1,
752 ;; operand rtxes shouldn't have objects, that's what xop is for.
753 (define (rtx-operand-name rtx)
754 (let ((operand (rtx-arg1 rtx)))
755 (if (symbol? operand)
760 ;; Given an operand rtx, return the <operand> object.
761 ;; RTX must be canonical rtl.
762 ;; ISA-NAME-LIST is the list of ISAs to look the operand up in.
764 ;; NOTE: op:mode-name can be DFLT, which means use the mode of the type.
765 ;; It is up to the caller to deal with it.
767 (define (rtx-operand-obj rtx isa-name-list)
768 (let ((op (current-op-lookup (rtx-arg1 rtx) isa-name-list))
769 (mode-name (rtx-mode rtx)))
771 (assert (not (eq? mode-name 'DFLT)))
772 ;; Ensure requested mode is supported by the hardware.
773 ;; rtx-canonicalize should have verified this already (I think).
774 (assert (hw-mode-ok? (op:type op) mode-name (op:index op)))
778 (define (rtx-make-local mode-name local-name)
779 (rtx-make 'local mode-name local-name)
781 (define (rtx-local? rtx) (eq? 'local (rtx-name rtx)))
782 (define (rtx-local-name rtx)
783 (let ((local (rtx-arg1 rtx)))
788 (define (rtx-local-obj rtx)
789 (let ((local (rtx-arg1 rtx)))
791 (error "can't use rtx-local-obj on local name")
795 (define (rtx-make-xop op)
796 (rtx-make 'xop (op:mode-name op) op)
798 (define rtx-xop-obj rtx-arg1)
800 ;(define (rtx-opspec? rtx) (eq? 'opspec (rtx-name rtx)))
801 ;(define (rtx-opspec-mode rtx) (rtx-mode rtx))
802 ;(define (rtx-opspec-hw-ref rtx) (list-ref rtx 5))
803 ;(define (rtx-opspec-set-op-num! rtx num) (set-car! (cddddr rtx) num))
805 (define rtx-index-of-value rtx-arg1)
807 (define (rtx-make-set dest src) (rtx-make 'set dest src))
808 (define rtx-set-dest rtx-arg1)
809 (define rtx-set-src rtx-arg2)
810 (define (rtx-single-set? rtx) (memq (car rtx) '(set set-quiet)))
812 (define rtx-alu-op-mode rtx-mode)
813 (define (rtx-alu-op-arg rtx n) (list-ref rtx (+ n 3)))
815 (define (rtx-boolif-op-arg rtx n) (list-ref rtx (+ n 3)))
817 (define rtx-cmp-op-mode rtx-mode)
818 (define (rtx-cmp-op-arg rtx n) (list-ref rtx (+ n 3)))
820 (define rtx-number-list-values cdddr)
822 (define rtx-member-value rtx-arg1)
823 (define (rtx-member-set rtx) (list-ref rtx 4))
825 (define rtx-if-mode rtx-mode)
826 (define (rtx-if-test rtx) (rtx-arg1 rtx))
827 (define (rtx-if-then rtx) (list-ref rtx 4))
828 ; If `else' clause is missing the result is #f.
829 (define (rtx-if-else rtx) (list-maybe-ref rtx 5))
831 (define (rtx-eq-attr-owner rtx) (list-ref rtx 3))
832 (define (rtx-eq-attr-attr rtx) (list-ref rtx 4))
833 (define (rtx-eq-attr-value rtx) (list-ref rtx 5))
835 (define (rtx-sequence-locals rtx) (cadddr rtx))
836 (define (rtx-sequence-exprs rtx) (cddddr rtx))
838 ; Same as rtx-sequence-locals except return in assq'able form.
839 ; ??? Sometimes I think it should have been (sequence ((name MODE)) ...)
840 ; instead of (sequence ((MODE name)) ...) from the beginning, sigh.
842 (define (rtx-sequence-assq-locals rtx)
843 (let ((locals (rtx-sequence-locals rtx)))
845 (list (cadr local) (car local)))
849 (define (rtx-closure-isas rtx) (list-ref rtx 3))
850 (define (rtx-closure-env-stack rtx) (list-ref rtx 4))
851 (define (rtx-closure-expr rtx) (list-ref rtx 5))
853 ; Return a semi-pretty string describing RTX.
854 ; This is used by hw to include the index in the element's name.
856 (define (rtx-pretty-name rtx)
859 ((const) (number->string (rtx-const-value rtx)))
860 ((operand) (symbol->string (rtx-operand-name rtx)))
861 ((local) (symbol->string (rtx-local-name rtx)))
862 ((xop) (symbol->string (obj:name (rtx-xop-obj rtx))))
864 (if (null? (cdr rtx))
865 (rtx-pretty-name (car rtx))
866 (apply stringsym-append
867 (cons (rtx-pretty-name (car rtx))
869 (string-append "-" (rtx-pretty-name elm)))
874 ; Various rtx utilities.
876 ; Dump an rtx expression.
878 (define (rtx-dump rtx)
879 (cond ((list? rtx) (map rtx-dump rtx))
880 ((object? rtx) (string/symbol-append "#<object "
881 (object-class-name rtx)
888 ; Dump an expression to a string.
890 (define (rtx-strdump rtx)
891 (with-output-to-string
893 ;; Use write instead of display, we want strings displayed with quotes.
894 (write (rtx-dump rtx))))
897 ;; Return the pretty-printed from of RTX.
899 (define (rtx-pretty-strdump rtx)
900 (with-output-to-string
902 (pretty-print (rtx-dump rtx))))
905 ; Return a boolean indicating if EXPR is known to be a compile-time constant.
907 (define (rtx-compile-time-constant? expr)
912 ((memq expr '(FALSE TRUE)) #t)
916 ; Return boolean indicating if EXPR has side-effects.
917 ; FIXME: for now punt.
919 (define (rtx-side-effects? expr)
923 ; Return a boolean indicating if EXPR is a "true" boolean value.
925 ; ??? In RTL, #t is a synonym for (const 1). This is confusing for Schemers,
926 ; so maybe RTL's #t should be renamed to TRUE.
928 (define (rtx-true? expr)
931 ((const enum) (!= (rtx-constant-value expr) 0))
933 ((eq? expr 'TRUE) #t)
937 ; Return a boolean indicating if EXPR is a "false" boolean value.
939 ; ??? In RTL, #f is a synonym for (const 0). This is confusing for Schemers,
940 ; so maybe RTL's #f should be renamed to FALSE.
942 (define (rtx-false? expr)
945 ((const enum) (= (rtx-constant-value expr) 0))
947 ((eq? expr 'FALSE) #t)
951 ; Return canonical boolean values.
953 (define (rtx-false) (rtx-make-const 'BI 0))
954 (define (rtx-true) (rtx-make-const 'BI 1))
956 ; Convert EXPR to a canonical boolean if possible.
958 (define (rtx-canonical-bool expr)
959 (cond ((rtx-side-effects? expr) expr)
960 ((rtx-false? expr) (rtx-false))
961 ((rtx-true? expr) (rtx-true))
965 ; Return rtx values for #f/#t.
967 (define (rtx-make-bool value)
973 ; Return #t if X is an rtl expression.
974 ; e.g. '(add WI dr simm8);
978 (and (pair? x) ; pair? -> cheap non-null-list?
979 (or (hashq-ref /rtx-func-table (car x))
980 (hashq-ref /rtx-macro-table (car x)))))
983 ; Instruction field support.
985 ; Return list of ifield names refered to in EXPR.
986 ; Assumes EXPR is more than just (ifield x).
988 (define (rtl-find-ifields expr)
990 (letrec ((scan! (lambda (arg-list)
991 (for-each (lambda (arg)
993 (if (eq? (car arg) 'ifield)
995 (cons (rtx-ifield-name arg)
1000 (nub ifields identity)))
1003 ; Hardware rtx handlers.
1005 ; Subroutine of hw to compute the object's name.
1006 ; The name of the operand must include the index so that multiple copies
1007 ; of a hardware object (e.g. h-gr[0], h-gr[14]) can be distinguished.
1008 ; We make some attempt to make the name pretty as it appears in generated
1011 (define (/rtx-hw-name hw hw-name index-arg)
1012 (cond ((hw-scalar? hw)
1015 (symbolstr-append hw-name '- (rtx-pretty-name index-arg)))
1017 (symbolstr-append hw-name ; (obj:name (op:type self))
1019 ; (obj:name (op:index self)))))
1020 (stringize index-arg "-"))))
1023 ; Return the <operand> object described by
1024 ; HW-NAME/MODE-NAME/SELECTOR/INDEX-ARG.
1026 ; HW-NAME is the name of the hardware element.
1027 ; MODE-NAME is the name of the mode.
1028 ; INDEX-ARG is an rtx or number of the index.
1029 ; In the case of scalar hardware elements, pass 0 for INDEX-ARG.
1030 ; In the case of a vector of registers, INDEX-ARG is the vector index.
1031 ; SELECTOR is an rtx or number and is passed to HW-NAME to allow selection of a
1032 ; particular variant of the hardware. It's kind of like an INDEX, but along
1033 ; an atypical axis. An example is memory ASI's on Sparc. Pass
1034 ; hw-selector-default if there is no selector.
1035 ; ESTATE is the current rtx evaluation state.
1037 ; *** The index is passed unevaluated because for parallel execution support
1038 ; *** a variable is created with a name based on the hardware element and
1039 ; *** index, and we want a reasonably simple and stable name. We get this by
1040 ; *** stringize-ing it.
1041 ; *** ??? Though this needs to be redone anyway.
1043 ; ??? The specified hardware element must be either a scalar or a vector.
1044 ; Maybe in the future allow arrays although there's significant utility in
1045 ; allowing only at most a scalar index.
1047 (define (/hw estate mode-name hw-name index-arg selector)
1048 ; Enforce some rules to keep things in line with the current design.
1049 (if (not (symbol? mode-name))
1050 (parse-error (estate-context estate) "invalid mode name" mode-name))
1051 (if (not (symbol? hw-name))
1052 (parse-error (estate-context estate) "invalid hw name" hw-name))
1053 (if (not (or (number? index-arg)
1055 (parse-error (estate-context estate) "invalid index" index-arg))
1056 (if (not (or (number? selector)
1058 (parse-error (estate-context estate) "invalid selector" selector))
1060 (let ((hw (current-hw-sem-lookup-1 hw-name)))
1062 (parse-error (estate-context estate) "invalid hardware element" hw-name))
1064 (let* ((mode (if (eq? mode-name 'DFLT) (hw-mode hw) (mode:lookup mode-name)))
1065 (hw-name-with-mode (symbol-append hw-name '- (obj:name mode)))
1066 (index-mode (if (eq? hw-name 'h-memory) 'AI 'INT))
1067 (result (if (hw-pc? hw)
1069 (new <operand>)))) ; ??? lookup-for-new?
1072 (parse-error (estate-context estate) "invalid mode" mode-name))
1074 ; Record the selector.
1075 (elm-xset! result 'selector selector)
1077 ; Create the index object.
1078 (elm-xset! result 'index
1079 (cond ((number? index-arg)
1080 (make <hw-index> 'anonymous 'constant UINT index-arg))
1082 ; Make sure constant indices are recorded as such.
1083 (case (rtx-name index-arg)
1085 (make <hw-index> 'anonymous 'constant UINT
1086 (rtx-constant-value index-arg)))
1088 (make-enum-hw-index 'anonymous (rtx-enum-value index-arg)))
1090 (make <hw-index> 'anonymous 'rtx (mode:lookup index-mode)
1091 (/rtx-closure-make estate index-mode index-arg)))))
1092 (else (parse-error (estate-context estate)
1093 "invalid index" index-arg))))
1095 (if (not (hw-mode-ok? hw (obj:name mode) (elm-xget result 'index)))
1096 (parse-error (estate-context estate)
1097 "invalid mode for hardware" mode-name))
1099 (elm-xset! result 'hw-name hw-name)
1100 (elm-xset! result 'type hw)
1101 (elm-xset! result 'mode-name mode-name)
1102 (elm-xset! result 'mode mode)
1104 (op:set-pretty-sem-name! result hw-name)
1106 ; The name of the operand must include the index so that multiple copies
1107 ; of a hardware object (e.g. h-gr[0], h-gr[14]) can be distinguished.
1108 (let ((name (if (hw-pc? hw)
1110 (/rtx-hw-name hw hw-name-with-mode index-arg))))
1111 (send result 'set-name! name)
1112 (op:set-sem-name! result name))
1114 ; Empty comment and attribute.
1115 ; ??? Stick the arguments in the comment for debugging purposes?
1116 (send result 'set-comment! "")
1117 (send result 'set-atlist! atlist-empty)
1122 ; This is shorthand for (hw estate mode hw-name regno selector).
1123 ; ESTATE is the current rtx evaluation state.
1124 ; INDX-SEL is an optional register number and possible selector.
1125 ; The register number, if present, is (car indx-sel) and must be a number or
1126 ; unevaluated canonical RTX expression.
1127 ; The selector, if present, is (cadr indx-sel) and must be a number or
1128 ; unevaluated canonical RTX expression.
1129 ; ??? A register selector isn't supported yet. It's just an idea that's
1130 ; been put down on paper for future reference.
1132 (define (reg estate mode-name hw-name . indx-sel)
1133 (s-hw estate mode-name hw-name
1134 (if (pair? indx-sel) (car indx-sel) 0)
1135 (if (and (pair? indx-sel) (pair? (cdr indx-sel)))
1137 hw-selector-default))
1140 ; This is shorthand for (hw estate mode-name h-memory addr selector).
1141 ; ADDR must be an unevaluated canonical RTX expression.
1142 ; If present (car sel) must be a number or unevaluated canonical
1145 (define (mem estate mode-name addr . sel)
1146 (s-hw estate mode-name 'h-memory addr
1147 (if (pair? sel) (car sel) hw-selector-default))
1150 ; For the rtx nodes to use.
1154 ; The program counter.
1155 ; When this code is loaded, global `pc' is nil, it hasn't been set to the
1156 ; pc operand yet (see operand-init!). We can't use `pc' inside the drn as the
1157 ; value is itself. So we use s-pc. rtl-finish! must be called after
1162 ; Conditional execution.
1164 ; `if' in RTL has a result, like ?: in C.
1165 ; We support both: one with a result (non VOID mode), and one without (VOID mode).
1166 ; The non-VOID case must have an else part.
1167 ; MODE is the mode of the result, not the comparison.
1168 ; The comparison is expected to return a zero/non-zero value.
1169 ; ??? Perhaps this should be a syntax-expr. Later.
1171 (define (e-if estate mode cond then . else)
1172 (if (> (length else) 1)
1173 (estate-error estate "if: too many elements in `else' part" else))
1176 (if cond then (car else)))
1180 ; ??? Not sure this should live here.
1182 (define (/subr-read context . arg-list)
1188 (let ((s (apply /subr-read (cons "define-subr" arg-list))))
1190 (current-subr-add! s))
1196 ; The argument to drn,drmn,drsn must be Scheme code (or a fixed subset
1197 ; thereof). .str/.sym are used in pmacros so it makes sense to include them
1200 (define .str string-append)
1201 (define .sym symbol-append)
1203 ; Given (expr1 expr2 expr3 expr4), for example,
1204 ; return (fn (fn (fn expr1 expr2) expr3) expr4).
1206 (define (rtx-combine fn exprs)
1207 (assert (not (null? exprs)))
1208 (letrec ((-rtx-combine (lambda (fn exprs result)
1216 (-rtx-combine fn (cdr exprs) (car exprs)))
1219 ; Called before a .cpu file is read in.
1222 (set! /rtx-func-table (make-hash-table 127))
1223 (set! /rtx-macro-table (make-hash-table 127))
1224 (set! /rtx-num-next 0)
1228 ; All rtx take options for the first arg and a mode for the second.
1229 (for-each (lambda (rtx-name)
1230 (let ((rtx (rtx-lookup rtx-name)))
1233 (if (null? (rtx-arg-types rtx))
1234 #f ; pc is the one exception, blech
1236 (assert (eq? (car (rtx-arg-types rtx)) 'OPTIONS))
1237 (assert (memq (cadr (rtx-arg-types rtx)) /rtx-valid-mode-types)))))
1242 (reader-add-command! 'define-subr
1244 Define an rtx subroutine, name/value pair list version.
1246 nil 'arg-list define-subr)
1253 (define (rtl-builtin!)
1254 (rtx-init-traversal-tables!)
1259 ; Called after cpu files are loaded to add misc. remaining entries to the
1260 ; rtx handler table for use during evaluation.
1261 ; rtl-finish! must be done before ifmt-compute!, the latter will
1262 ; construct hardware objects which is done by rtx evaluation.
1264 (define (rtl-finish!)
1265 (logit 2 "Building rtx operand table ...\n")
1267 ; Update s-pc, must be called after operand-init!.
1270 ; Initialize the operand hash table.
1271 (set! /rtx-operand-table (make-hash-table 127))
1273 ; Add the operands to the eval symbol table.
1274 (for-each (lambda (op)
1275 (hashq-set! /rtx-operand-table (obj:name op) op))
1278 ; Add ifields to the eval symbol table.
1279 (for-each (lambda (f)
1280 (hashq-set! /rtx-operand-table (obj:name f) f))
1281 (non-derived-ifields (current-ifld-list)))