From 233cb8f81095185fad1481c9d1ebbcb6ce8f4eea Mon Sep 17 00:00:00 2001 From: Doug Evans Date: Sat, 12 Sep 2009 17:34:15 +0000 Subject: [PATCH] Clean up pass of mode handling. Make use of mode name vs object more consistent and clear. * hardware.scm (/keyword-read): Default mode to the mode name, not the object. (/hw-parse-indices): Parse mode name and pass mode object to constructor. (/hw-parse-values): Ditto. ( parse!): Pass mode name to /hw-parse-indices and /hw-parse-values. ( parse!): Ditto. ( parse!): Ditto. * mode.scm (/mode-table): New global, replaces mode-list. Modes stored in hashtable instead of list. (/mode-class-table): New global. (mode-list-non-alias-values): Update. (mode:eq?, mode-compatible?, mode:add!): Update. (mode:lookup): Restrict arg to the mode's name. All callers updated. (mode-maybe-lookup): New function. (mode-real-name): Restrict arg to a object. All callers updated. (mode-real-mode, mode-sem-mode, mode-bigger?): Ditto. (mode-find, mode-set-word-modes!): Update (mode-ensure-word-sizes-defined): Update. (/sort-mode-classes!): New function. (mode-builtin!): Update. Sort mode classes here. (mode-finish!): Sort mode classes here too. * rtl-c.scm (/rtl-c-get): Restrict mode arg to a object. All callers updated. (rtl-c-set-quiet): Allow mode to be name of object. (rtl-c-set-trace): Ditto. * rtl-traverse.scm (rtl-eval-with-estate): Restrict mode arg to object. All callers updated. * rtl.scm (rtx-sem-mode): Restrict arg to object. (rtx-lazy-sem-mode): Ditto. ( make!): Assert mode arg is a object. (rtx-env-make): Allow var-list modes to be name or object. * sem-frags.scm (/frag-expr-assq-locals): New function. (/frag-compute-locals!): Call it. (/sfrag-create-cse-mapping): Renamed from sfrag-create-cse-mapping. All callers updated. * semantics.scm (/build-mem-operand!): Handle mode aliases. --- ChangeLog | 41 +++++++++++ attr.scm | 2 +- hardware.scm | 35 +++++----- html.scm | 1 + ifield.scm | 1 + mode.scm | 172 ++++++++++++++++++++++++++++++----------------- operand.scm | 2 +- rtl-c.scm | 98 ++++++++++++++++++--------- rtl-traverse.scm | 5 +- rtl-xform.scm | 28 +++++--- rtl.scm | 28 +++++--- rtx-funcs.scm | 4 +- sem-frags.scm | 29 ++++++-- semantics.scm | 13 ++-- 14 files changed, 311 insertions(+), 148 deletions(-) diff --git a/ChangeLog b/ChangeLog index 72edd33..ea62567 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,46 @@ 2009-09-12 Doug Evans + Clean up pass of mode handling. + Make use of mode name vs object more consistent and clear. + * hardware.scm (/keyword-read): Default mode to the mode name, + not the object. + (/hw-parse-indices): Parse mode name and pass mode object to + constructor. + (/hw-parse-values): Ditto. + ( parse!): Pass mode name to /hw-parse-indices + and /hw-parse-values. + ( parse!): Ditto. + ( parse!): Ditto. + * mode.scm (/mode-table): New global, replaces mode-list. + Modes stored in hashtable instead of list. + (/mode-class-table): New global. + (mode-list-non-alias-values): Update. + (mode:eq?, mode-compatible?, mode:add!): Update. + (mode:lookup): Restrict arg to the mode's name. All callers updated. + (mode-maybe-lookup): New function. + (mode-real-name): Restrict arg to a object. All callers updated. + (mode-real-mode, mode-sem-mode, mode-bigger?): Ditto. + (mode-find, mode-set-word-modes!): Update + (mode-ensure-word-sizes-defined): Update. + (/sort-mode-classes!): New function. + (mode-builtin!): Update. Sort mode classes here. + (mode-finish!): Sort mode classes here too. + * rtl-c.scm (/rtl-c-get): Restrict mode arg to a object. + All callers updated. + (rtl-c-set-quiet): Allow mode to be name of object. + (rtl-c-set-trace): Ditto. + * rtl-traverse.scm (rtl-eval-with-estate): Restrict mode arg to + object. All callers updated. + * rtl.scm (rtx-sem-mode): Restrict arg to object. + (rtx-lazy-sem-mode): Ditto. + ( make!): Assert mode arg is a object. + (rtx-env-make): Allow var-list modes to be name or object. + * sem-frags.scm (/frag-expr-assq-locals): New function. + (/frag-compute-locals!): Call it. + (/sfrag-create-cse-mapping): Renamed from sfrag-create-cse-mapping. + All callers updated. + * semantics.scm (/build-mem-operand!): Handle mode aliases. + * sim-test.scm (*): Symbols no longer can be passed to string-append. 2009-09-10 Doug Evans diff --git a/attr.scm b/attr.scm index 6cc2fb5..43f6c10 100644 --- a/attr.scm +++ b/attr.scm @@ -496,7 +496,7 @@ (define (/attr-eval atval owner) (let* ((estate (estate-make-for-eval #f owner)) (expr (rtx-compile #f (rtx-simplify #f owner atval nil) nil)) - (value (rtx-eval-with-estate expr 'DFLT estate))) + (value (rtx-eval-with-estate expr DFLT estate))) (cond ((symbol? value) value) ((number? value) value) (error "/attr-eval: internal error, unsupported result:" value))) diff --git a/hardware.scm b/hardware.scm index 9621a9f..c060646 100644 --- a/hardware.scm +++ b/hardware.scm @@ -208,7 +208,7 @@ (define (class-make ' '() '( - ; The mode to use. + ; The object of the mode to use. ; A copy of the object's mode if we're in the "values" ; member. If we're in the "indices" member this is typically ; UINT. @@ -255,7 +255,7 @@ ; The syntax of VALUES is: (prefix ((name1 [value1 [(attr-list1)]]) ...)) ; NAME-PREFIX is a prefix added to each value's name in the generated ; lookup table. -; Each value is a number of mode MODE. +; Each value is a number of mode MODE, the name of the mode. ; ??? We have no problem handling any kind of number, we're Scheme. ; However, it's not clear yet how applications will want to handle it, but ; that is left to the application. Still, it might be preferable to impose @@ -300,7 +300,7 @@ (name #f) (comment "") (attrs nil) - (mode INT) + (mode 'INT) (enum-prefix #f) ;; #f indicates "not set" (name-prefix "") (values nil) @@ -390,6 +390,7 @@ ; Parse an inline keyword spec. ; These are keywords defined inside something else. ; CONTAINER is the object of the container. +; MODE is the name of the mode. (define (/hw-parse-keyword context args container mode) (if (!= (length args) 2) @@ -413,14 +414,14 @@ ; Parse an indices spec. ; CONTAINER is the object of the container. ; Currently there is only special support for keywords. -; Otherwise MODE is used. +; Otherwise MODE is used. MODE is the name, not a object. ; The syntax is: (keyword keyword-spec) - see for details. (define (/hw-parse-indices context indices container mode) (if (null? indices) (make (obj:name container) (obj:comment container) (obj-atlist container) - mode) + (parse-mode-name (context-append context ": mode") mode)) (begin (if (not (list? indices)) (parse-error context "invalid indices spec" indices)) @@ -441,14 +442,14 @@ ; Parse a values spec. ; CONTAINER is the object of the container. ; Currently there is only special support for keywords. -; Otherwise MODE is used. +; Otherwise MODE is used. MODE is the name, not a object. ; The syntax is: (keyword keyword-spec) - see for details. (define (/hw-parse-values context values container mode) (if (null? values) (make (obj:name container) (obj:comment container) (obj-atlist container) - mode) + (parse-mode-name (context-append context ": mode") mode)) (begin (if (not (list? values)) (parse-error context "invalid values spec" values)) @@ -887,10 +888,10 @@ (/hw-create-setter-from-layout context layout width))) )) - (elm-set! self 'indices (/hw-parse-indices context indices self UINT)) + (elm-set! self 'indices (/hw-parse-indices context indices self 'UINT)) (elm-set! self 'values (/hw-parse-values context values self - (send (elm-get self 'type) - 'get-mode))) + (obj:name (send (elm-get self 'type) + 'get-mode)))) (elm-set! self 'handlers (/hw-parse-handlers context handlers)) (elm-set! self 'get (/hw-parse-getter context getter (hw-scalar? self))) (elm-set! self 'set (/hw-parse-setter context setter (hw-scalar? self))) @@ -1003,10 +1004,10 @@ (parse-error context "layout specified for memory" values)) (elm-set! self 'type (parse-type context type)) ; Setting INDICES,VALUES here is mostly for experimentation at present. - (elm-set! self 'indices (/hw-parse-indices context indices self AI)) + (elm-set! self 'indices (/hw-parse-indices context indices self 'AI)) (elm-set! self 'values (/hw-parse-values context values self - (send (elm-get self 'type) - 'get-mode))) + (obj:name (send (elm-get self 'type) + 'get-mode)))) (elm-set! self 'handlers (/hw-parse-handlers context handlers)) (elm-set! self 'get (/hw-parse-getter context getter (hw-scalar? self))) (elm-set! self 'set (/hw-parse-setter context setter (hw-scalar? self))) @@ -1055,8 +1056,8 @@ (if (not (null? layout)) (parse-error context "layout specified for immediate" values)) (elm-set! self 'values (/hw-parse-values context values self - (send (elm-get self 'type) - 'get-mode))) + (obj:name (send (elm-get self 'type) + 'get-mode)))) (elm-set! self 'handlers (/hw-parse-handlers context handlers)) (if (not (null? getter)) (parse-error context "getter specified for immediate" getter)) @@ -1113,8 +1114,8 @@ (if (not (null? layout)) (parse-error context "layout specified for address" values)) (elm-set! self 'values (/hw-parse-values context values self - (send (elm-get self 'type) - 'get-mode))) + (obj:name (send (elm-get self 'type) + 'get-mode)))) (elm-set! self 'handlers (/hw-parse-handlers context handlers)) (if (not (null? getter)) (parse-error context "getter specified for address" getter)) diff --git a/html.scm b/html.scm index e2f7038..ba5e4d8 100644 --- a/html.scm +++ b/html.scm @@ -687,6 +687,7 @@ See the input .cpu file(s) for copyright information. (sem-attrs (list #f)) ; Called for expressions encountered in SEM-CODE-LIST. + ; MODE is the name of the mode. (process-expr! (lambda (rtx-obj expr mode parent-expr op-pos tstate appstuff) (case (car expr) diff --git a/ifield.scm b/ifield.scm index 6479e09..9c94b33 100644 --- a/ifield.scm +++ b/ifield.scm @@ -26,6 +26,7 @@ '() '( ; The mode the raw value is to be interpreted in. + ; This is a object. mode ; A object. diff --git a/mode.scm b/mode.scm index 9f11475..8772b10 100644 --- a/mode.scm +++ b/mode.scm @@ -104,21 +104,21 @@ (define cmode-elm-modes (elm-make-getter 'elm-modes)) -; List of all modes. +;; Table of all modes. +(define /mode-table nil) -(define mode-list nil) - -; Return list of mode objects. -; Hides the fact that its stored as an alist from caller. - -(define (mode-list-values) (map cdr mode-list)) +;; This exists to simplify mode-find. +(define /mode-class-table nil) ; Return list of real mode objects (no aliases). (define (mode-list-non-alias-values) - (map cdr - (find (lambda (m) (eq? (car m) (obj:name (cdr m)))) - mode-list)) + (hash-fold (lambda (key value prior) + (if (eq? key (obj:name value)) + (append value prior) + prior)) + '() + /mode-table) ) ; Return a boolean indicating if X is a object. @@ -134,10 +134,11 @@ ; Return a boolean indicating if MODE1 is equal to MODE2 ; Either may be the name of a mode or a object. ; Aliases are handled by refering to their real name. +; ??? Might be useful to restrict this to objects only. (define (mode:eq? mode1 mode2) - (let ((mode1-name (mode-real-name mode1)) - (mode2-name (mode-real-name mode2))) + (let ((mode1-name (mode-real-name (mode-maybe-lookup mode1))) + (mode2-name (mode-real-name (mode-maybe-lookup mode2)))) (eq? mode1-name mode2-name)) ) @@ -180,8 +181,8 @@ ; numeric: modes must be both numeric (define (mode-compatible? how mode1 mode2) - (let ((m1 (mode:lookup mode1)) - (m2 (mode:lookup mode2))) + (let ((m1 (mode-maybe-lookup mode1)) + (m2 (mode-maybe-lookup mode2))) (case how ((strict) (eq? (obj:name m1) (obj:name m2))) @@ -202,7 +203,7 @@ (else (error "bad `how' arg to mode-compatible?" how)))) ) -; Add MODE named NAME to the list of recognized modes. +; Add MODE named NAME to the table of recognized modes. ; If NAME is already present, replace it with MODE. ; MODE is a mode object. ; NAME exists to allow aliases of modes [e.g. WI, UWI, AI, IAI]. @@ -211,11 +212,18 @@ ; That is up to the caller. (define (mode:add! name mode) - (let ((entry (assq name mode-list))) - (if entry - (set-cdr! entry mode) - (set! mode-list (acons name mode mode-list))) - mode) + (hashq-set! /mode-table name mode) + + ;; Add the mode to its mode class. + ;; There's no point in building this list in any particular order, + ;; if the user adds some they could be of any size. + ;; So build the list the simple way (in reverse). + ;; The list is sorted in mode-finish!. + (let ((class (mode:class mode))) + (hashq-set! /mode-class-table class + (cons mode (hashq-ref /mode-class-table class)))) + + *UNSPECIFIED* ) ; Parse a mode. @@ -258,40 +266,52 @@ ; Return the found object or #f. ; If X is already a mode object, return that. -(define (mode:lookup x) - (if (mode? x) - x - (let ((result (assq x mode-list))) - (if result - (cdr result) - #f))) +(define (mode:lookup mode-name) +; (if (mode? x) +; x +; (let ((result (assq x mode-list))) +; (if result +; (cdr result) +; #f))) + (hashq-ref /mode-table mode-name) +) + +;; Same as mode:lookup except MODE is either the mode name or a object. + +(define (mode-maybe-lookup mode) + (if (symbol? mode) + (hashq-ref /mode-table mode) + mode) ) ; Return a boolean indicating if X is a valid mode name. (define (mode-name? x) (and (symbol? x) - ; FIXME: Time to make `mode-list' a hash table. - (->bool (assq x mode-list))) + (->bool (mode:lookup x))) ) -; Return the name of the real mode of M. +; Return the name of the real mode of MODE, a object. ; This is a no-op unless M is an alias in which case we return the ; real mode of the alias. -(define (mode-real-name m) - (obj:name (mode:lookup m)) +(define (mode-real-name mode) + (obj:name mode) ) -; Return the real mode of M. +; Return the real mode of MODE, a object. ; This is a no-op unless M is an alias in which case we return the ; real mode of the alias. -(define (mode-real-mode m) - (mode:lookup (mode-real-name m)) +(define (mode-real-mode mode) + ;; Lookups of aliases return its real mode, so this function is a no-op. + ;; But that's an implementation detail, so I'm not ready to delete this + ;; function. + mode ) ; Return the version of MODE to use in semantic expressions. +; MODE is a object. ; This (essentially) converts aliases to their real value and then uses ; mode:sem-mode. The implementation is the opposite but the effect is the ; same. @@ -299,34 +319,33 @@ ; disallow unsigned modes from being aliased and set sem-mode for aliased ; modes. -(define (mode-sem-mode m) - (let* ((m1 (mode:lookup m)) - (sm (mode:sem-mode m1))) +(define (mode-sem-mode mode) + (let ((sm (mode:sem-mode mode))) (if sm sm - (mode-real-mode m1))) + (mode-real-mode mode))) ) -; Return #t if mode M1-NAME is bigger than mode M2-NAME. +; Return #t if mode M1 is bigger than mode M2. +; Both are objects. -(define (mode-bigger? m1-name m2-name) - (> (mode:bits (mode:lookup m1-name)) - (mode:bits (mode:lookup m2-name))) +(define (mode-bigger? m1 m2) + (> (mode:bits m1) + (mode:bits m2)) ) ; Return a mode in mode class CLASS wide enough to hold BITS. ; This ignores "host" modes (e.g. INT,UINT). (define (mode-find bits class) - (let ((modes (find (lambda (mode) - (and (eq? (mode:class (cdr mode)) class) - (not (mode:host? (cdr mode))))) - mode-list))) + (let* ((class-modes (hashq-ref /mode-class-table class)) + (modes (find (lambda (mode) (not (mode:host? mode))) + (or class-modes nil)))) (if (null? modes) (error "invalid mode class" class)) (let loop ((modes modes)) (cond ((null? modes) (error "no modes for bits" bits)) - ((<= bits (mode:bits (cdar modes))) (cdar modes)) + ((<= bits (mode:bits (car modes))) (car modes)) (else (loop (cdr modes)))))) ) @@ -421,10 +440,10 @@ (set! UWI uword-mode) (set! AI uword-mode) (set! IAI uword-mode) - (assq-set! mode-list 'WI word-mode) - (assq-set! mode-list 'UWI uword-mode) - (assq-set! mode-list 'AI uword-mode) - (assq-set! mode-list 'IAI uword-mode) + (hashq-set! /mode-table 'WI word-mode) + (hashq-set! /mode-table 'UWI uword-mode) + (hashq-set! /mode-table 'AI uword-mode) + (hashq-set! /mode-table 'IAI uword-mode) )) ) ) @@ -451,7 +470,7 @@ ; and before any ifields, hardware, operand or insns have been read. (define (mode-ensure-word-sizes-defined) - (if (eq? (mode-real-name WI) 'VOID) + (if (eq? (obj:name WI) 'VOID) (error "word sizes must be defined")) ) @@ -469,6 +488,20 @@ (define INT #f) (define UINT #f) +;; Sort the modes for each class. + +(define (/sort-mode-classes!) + (for-each (lambda (class-name) + (hashq-set! /mode-class-table class-name + (sort (hashq-ref /mode-class-table class-name) + (lambda (a b) + (< (mode:bits a) + (mode:bits b)))))) + '(RANDOM INT UINT FLOAT)) + + *UNSPECIFIED* +) + (define (mode-init!) (set! /mode-word-sizes-kind 'IDENTICAL) @@ -490,7 +523,13 @@ Define a mode, all arguments specified. ; Elsewhere, functions are defined to perform the operation. (define-attr '(for mode) '(type boolean) '(name FN-SUPPORT)) - (set! mode-list nil) + (set! /mode-class-table (make-hash-table 7)) + (hashq-set! /mode-class-table 'RANDOM '()) + (hashq-set! /mode-class-table 'INT '()) + (hashq-set! /mode-class-table 'UINT '()) + (hashq-set! /mode-class-table 'FLOAT '()) + + (set! /mode-table (make-hash-table 41)) (let ((dfm define-full-mode)) ; This list must be defined in order of increasing size among each type. @@ -555,18 +594,27 @@ Define a mode, all arguments specified. (set! UINT (mode:lookup 'UINT)) ; While setting the real values of WI/UWI/AI/IAI is defered to - ; mode-set-word-modes!, create entries in the list. - (set! WI (mode:add! 'WI (mode:lookup 'VOID))) - (set! UWI (mode:add! 'UWI (mode:lookup 'VOID))) - (set! AI (mode:add! 'AI (mode:lookup 'VOID))) - (set! IAI (mode:add! 'IAI (mode:lookup 'VOID))) - - ; Keep the fields sorted for mode-find. - (set! mode-list (reverse mode-list)) + ; mode-set-word-modes!, create entries in the table. + (set! WI VOID) + (set! UWI VOID) + (set! AI VOID) + (set! IAI VOID) + (mode:add! 'WI VOID) + (mode:add! 'UWI VOID) + (mode:add! 'AI VOID) + (mode:add! 'IAI VOID) + + ;; Need to have usable mode classes at this point as define-cpu + ;; calls mode-set-word-modes!. + (/sort-mode-classes!) *UNSPECIFIED* ) (define (mode-finish!) + ;; FIXME: mode:add! should keep the class sorted. + ;; It's a cleaner way to handle modes from the .cpu file. + (/sort-mode-classes!) + *UNSPECIFIED* ) diff --git a/operand.scm b/operand.scm index eb0c62a..f9a84b0 100644 --- a/operand.scm +++ b/operand.scm @@ -373,7 +373,7 @@ (lambda (self name type mode value) (elm-set! self 'name name) (elm-set! self 'type type) - (elm-set! self 'mode (mode:lookup mode)) + (elm-set! self 'mode (mode-maybe-lookup mode)) (elm-set! self 'value value) self) ) diff --git a/rtl-c.scm b/rtl-c.scm index 1b8ba43..2308b73 100644 --- a/rtl-c.scm +++ b/rtl-c.scm @@ -128,7 +128,7 @@ ; CODE is a string of C code. (define (cx:make mode code) - (make (mode:lookup mode) code nil) + (make (mode-maybe-lookup mode) code nil) ) ; Make copy of CX in new mode MODE. @@ -141,7 +141,7 @@ ; Same as cx:make except with attributes. (define (cx:make-with-atlist mode code atlist) - (make (mode:lookup mode) code atlist) + (make (mode-maybe-lookup mode) code atlist) ) ; Return a boolean indicated if X is a object. @@ -270,8 +270,8 @@ ; Build an estate for use in generating C. ; CONTEXT is a object or #f if there is none. ; OWNER is the owner of the expression or #f if there is none. -; EXTRA-VARS-ALIST is an association list of (symbol value) -; elements to be used during value lookup. +; EXTRA-VARS-ALIST is an association list of +; (symbol -or-mode-name value) elements to be used during value lookup. ; OVERRIDES is a #:keyword/value list of parameters to apply last. (define (estate-make-for-rtl-c context owner extra-vars-alist @@ -302,6 +302,7 @@ ; Translate RTL expression EXPR to C. ; ESTATE is the current rtx evaluation state. +; MODE is a object. (define (rtl-c-with-estate estate mode expr) (cx:c (rtl-c-get estate mode (rtx-eval-with-estate expr mode estate))) @@ -310,8 +311,9 @@ ; Translate parsed RTL expression X to a string of C code. ; X must have already been fed through rtx-parse/rtx-compile. ; MODE is the desired mode of the value or DFLT for "natural mode". -; EXTRA-VARS-ALIST is an association list of extra (symbol value) -; elements to be used during value lookup. +; MODE is a object. +; EXTRA-VARS-ALIST is an association list of extra +; (symbol -or-mode-name value) elements to be used during value lookup. ; OVERRIDES is a #:keyword/value list of arguments to build the eval state ; with. ; ??? Maybe EXTRA-VARS-ALIST should be handled this way. @@ -322,6 +324,7 @@ ) ; Same as rtl-c-parsed but X is unparsed. +; MODE is a object. (define (rtl-c mode x extra-vars-alist . overrides) ; ??? rtx-compile could return a closure, then we wouldn't have to @@ -331,12 +334,14 @@ ) ; Same as rtl-c-with-estate except return a object. +; MODE is a object. (define (rtl-c-expr-with-estate estate mode expr) (rtl-c-get estate mode (rtx-eval-with-estate expr mode estate)) ) ; Same as rtl-c-parsed except return a object. +; MODE is a object. (define (rtl-c-expr-parsed mode x extra-vars-alist . overrides) (let ((estate (estate-make-for-normal-rtl-c extra-vars-alist overrides))) @@ -344,6 +349,7 @@ ) ; Same as rtl-c-expr-parsed but X is unparsed. +; MODE is a object. (define (rtl-c-expr mode x extra-vars-alist . overrides) ; ??? rtx-compile could return a closure, then we wouldn't have to @@ -372,6 +378,7 @@ ; Translate parsed RTL expression X to a string of C++ code. ; X must have already been fed through rtx-parse/rtx-compile. ; MODE is the desired mode of the value or DFLT for "natural mode". +; MODE is a object. ; EXTRA-VARS-ALIST is an association list of extra (symbol value) ; elements to be used during value lookup. ; OVERRIDES is a #:keyword/value list of arguments to build the eval state @@ -384,6 +391,7 @@ ) ; Same as rtl-c-parsed but X is unparsed. +; MODE is a object. (define (rtl-c++ mode x extra-vars-alist . overrides) ; ??? rtx-compile could return a closure, then we wouldn't have to @@ -396,6 +404,7 @@ ; Return a node to get the value of SRC in mode MODE. ; ESTATE is the current rtl evaluation state. +; MODE is a object. ; SRC is one of: ; - node ; - rtl expression (e.g. '(add WI dr sr)) @@ -412,7 +421,7 @@ ; ??? mode compatibility checks are wip (define (/rtl-c-get estate mode src) - (let ((mode (mode:lookup mode))) + (let ((mode mode)) ;;(mode:lookup mode))) (cond ((c-expr? src) (cond ((or (mode:eq? 'VOID mode) @@ -488,18 +497,22 @@ (else (estate-error estate "/rtl-c-get: invalid argument" src)))) ) +;; MODE is either a object or the mode name. + (define (rtl-c-get estate mode src) - (logit 4 (spaces (estate-depth estate)) - "(rtl-c-get " (mode-real-name mode) " " (rtx-strdump src) ")\n") - (let ((result (/rtl-c-get estate mode src))) + (let ((mode (mode-maybe-lookup mode))) (logit 4 (spaces (estate-depth estate)) - "(rtl-c-get " (mode-real-name mode) " " (rtx-strdump src) ") => " - (cx:c result) "\n") - result) + "(rtl-c-get " (mode-real-name mode) " " (rtx-strdump src) ")\n") + (let ((result (/rtl-c-get estate mode src))) + (logit 4 (spaces (estate-depth estate)) + "(rtl-c-get " (mode-real-name mode) " " (rtx-strdump src) ") => " + (cx:c result) "\n") + result)) ) ; Return a object to set the value of DEST to SRC. ; ESTATE is the current rtl evaluation state. +; MODE is either a object or the mode name. ; DEST is one of: ; - node ; - rtl expression (e.g. '(mem QI dr)) @@ -508,14 +521,15 @@ (define (rtl-c-set-quiet estate mode dest src) ;(display (list 'rtl-c-set-quiet mode dest src)) (newline) - (let ((xdest (cond ((c-expr? dest) - dest) - ((rtx? dest) - (rtx-eval-with-estate dest mode estate)) - (else - (estate-error estate - "rtl-c-set-quiet: invalid dest" - dest))))) + (let* ((mode (mode-maybe-lookup mode)) + (xdest (cond ((c-expr? dest) + dest) + ((rtx? dest) + (rtx-eval-with-estate dest mode estate)) + (else + (estate-error estate + "rtl-c-set-quiet: invalid dest" + dest))))) (if (not (object? xdest)) (estate-error estate "rtl-c-set-quiet: invalid dest" dest)) (let ((mode (if (mode:eq? 'DFLT mode) @@ -528,6 +542,7 @@ ) ; Same as rtl-c-set-quiet except also print TRACE_RESULT message. +; MODE is either a object or the mode name. ; ??? One possible change is to defer the (rtl-c-get src) call to dest's ; set handler. Such sources would be marked accordingly and rtl-c-get ; would recognize them. This would allow, for example, passing the address @@ -535,14 +550,15 @@ (define (rtl-c-set-trace estate mode dest src) ;(display (list 'rtl-c-set-trace mode dest src)) (newline) - (let ((xdest (cond ((c-expr? dest) - dest) - ((rtx? dest) - (rtx-eval-with-estate dest mode estate)) - (else - (estate-error estate - "rtl-c-set-trace: invalid dest" - dest))))) + (let* ((mode (mode-maybe-lookup mode)) + (xdest (cond ((c-expr? dest) + dest) + ((rtx? dest) + (rtx-eval-with-estate dest mode estate)) + (else + (estate-error estate + "rtl-c-set-trace: invalid dest" + dest))))) (if (not (object? xdest)) (estate-error estate "rtl-c-set-trace: invalid dest" dest)) (let ((mode (if (mode:eq? 'DFLT mode) @@ -567,6 +583,7 @@ ) ; Support for explicit C/C++ code. +; MODE is the mode name. ; ??? Actually, "support for explicit foreign language code". ; s-c-call needs a better name but "unspec" seems like obfuscation. ; ??? Need to distinguish owner of call (cpu, ???). @@ -603,6 +620,7 @@ ; Same as c-call except there is no particular owner of the call. ; In general this means making a call to a non-member function, ; whereas c-call makes calls to member functions (in C++ parlance). +; MODE is the mode name. (define (s-c-raw-call estate mode name . args) (cx:make mode @@ -648,6 +666,7 @@ ) ; One operand referenced, result is in same mode. +; MODE is the mode name. (define (s-unop estate name c-op mode src) (let* ((val (rtl-c-get estate mode src)) @@ -673,6 +692,7 @@ ) ; Two operands referenced in the same mode producing a result in the same mode. +; MODE is the mode name. ; If MODE is DFLT, use the mode of SRC1. ; ; ??? Will eventually want to handle floating point modes specially. Since @@ -713,6 +733,7 @@ ) ; Same as s-binop except there's a third argument which is always one bit. +; MODE is the mode name. (define (s-binop-with-bit estate name mode src1 src2 src3) (let* ((val1 (rtl-c-get estate mode src1)) @@ -732,6 +753,7 @@ ; Shift operations are slightly different than binary operations: ; the mode of src2 is any integral mode. +; MODE is the mode name. ; ??? Note that some cpus have a signed shift left that is semantically ; different from a logical one. May need to create `sla' some day. Later. @@ -771,6 +793,7 @@ ; Process andif, orif. ; SRC1 and SRC2 have any arithmetic mode. +; MODE is the mode name. ; The result has mode BI. ; ??? May want to use INT as BI may introduce some slowness ; in the generated code. @@ -795,6 +818,7 @@ ) ; Mode conversions. +; MODE is the mode name. (define (s-convop estate name mode s1) ; Get S1 in its normal mode, then convert. @@ -822,8 +846,10 @@ " (" (cx:c s) ")"))))) ) -; Compare SRC1 and SRC2 in mode MODE. The result has mode BI. +; Compare SRC1 and SRC2 in mode MODE. ; NAME is one of eq,ne,lt,le,gt,ge,ltu,leu,gtu,geu. +; MODE is the mode name. +; The result has mode BI. ; ??? May want a host int mode result as BI may introduce some slowness ; in the generated code. @@ -866,6 +892,7 @@ ; We support both: one with a result (non VOID mode), and one without (VOID mode). ; The non-VOID case must have an else part. ; MODE is the mode of the result, not the comparison. +; MODE is the mode name. ; The comparison is expected to return a zero/non-zero value. ; ??? Perhaps this should be a syntax-expr. Later. @@ -897,6 +924,7 @@ ) ; A multiway `if'. +; MODE is the mode name. ; If MODE is VOID emit a series of if/else's. ; If MODE is not VOID, emit a series of ?:'s. ; COND-CODE-LIST is a list of lists, each sublist is a list of two elements: @@ -994,6 +1022,7 @@ ) ; Utility of s-case-non-vm to generate code to perform the test. +; MODE is the mode name. (define (/gen-non-vm-case-test estate mode test cases) (assert (not (null? cases))) @@ -1023,6 +1052,7 @@ ; Utility of s-case to handle a non-void result. ; This is expanded as a series of ?:'s. +; MODE is the mode name. (define (s-case-non-vm estate mode test case-list) (let ((if-part "(") @@ -1067,6 +1097,7 @@ ; C switch statement ; To follow convention, MODE is the first arg. +; MODE is the mode name. ; FIXME: What to allow for case choices is wip. (define (s-case estate mode test . case-list) @@ -1199,6 +1230,7 @@ ) ; Return a node for a `sequence'. +; MODE is the mode name. (define (s-sequence estate mode env . exprs) (let* ((env (rtx-env-make-locals env)) ; compile env @@ -1288,6 +1320,7 @@ ) ; The rest of this file is one big function to return the rtl->c lookup table. +; For each of these functions, MODE is the name of the mode. (define (rtl-c-build-table) (let ((table (make-vector (rtx-max-num) #f))) @@ -1411,7 +1444,7 @@ ; ??? Maybe this should return an operand object. (define-fn index-of (estate options mode op) - (send (op:index (rtx-eval-with-estate op 'DFLT estate)) 'cxmake-get estate 'DFLT) + (send (op:index (rtx-eval-with-estate op DFLT estate)) 'cxmake-get estate 'DFLT) ) (define-fn clobber (estate options mode object) @@ -1444,7 +1477,8 @@ ;; update cpu-global pipeline bound (cpu-set-max-delay! (current-cpu) (max (cpu-max-delay (current-cpu)) new-delay)) ;; pass along new delay to embedded rtx - (rtx-eval-with-estate rtx mode (estate-with-modifiers estate `((#:delay ,new-delay))))))) + (rtx-eval-with-estate rtx (mode:lookup mode) + (estate-with-modifiers estate `((#:delay ,new-delay))))))) ;; not in sid-land (else (s-sequence (estate-with-modifiers estate '((#:delay))) VOID '() rtx))) diff --git a/rtl-traverse.scm b/rtl-traverse.scm index 5fe7fdf..8045d45 100644 --- a/rtl-traverse.scm +++ b/rtl-traverse.scm @@ -31,6 +31,7 @@ ; It is applied recursively to the expression and each sub-expression. ; It must be defined as ; (lambda (rtx-obj expr mode parent-expr op-pos tstate appstuff) ...). +; MODE is the name of the mode. ; If the result of EXPR-FN is a lambda, it is applied to ; (cons TSTATE (cdr EXPR)). TSTATE is prepended to the arguments. ; For syntax expressions if the result of EXPR-FN is #f, the operands are @@ -1023,7 +1024,7 @@ ; RTX expression evaluator. ; ; EXPR is the expression to be eval'd. It must be in compiled form. -; MODE is the mode of EXPR, a object or its name. +; MODE is the mode of EXPR, a object. ; ESTATE is the current evaluation state. (define (rtx-eval-with-estate expr mode estate) @@ -1066,5 +1067,5 @@ ; FIXME: context? (define (rtx-value expr owner) - (rtx-eval-with-estate expr 'DFLT (estate-make-for-eval #f owner)) + (rtx-eval-with-estate expr DFLT (estate-make-for-eval #f owner)) ) diff --git a/rtl-xform.scm b/rtl-xform.scm index 64522b0..d207a1d 100644 --- a/rtl-xform.scm +++ b/rtl-xform.scm @@ -116,6 +116,7 @@ ; Subroutine of rtx-simplify. ; This is the EXPR-FN argument to rtx-traverse. +; MODE is the name of the mode. (define (/rtx-simplify-expr-fn rtx-obj expr mode parent-expr op-pos tstate appstuff) @@ -324,6 +325,7 @@ ; Subroutine of rtx-solve. ; This is the EXPR-FN argument to rtx-traverse. +; MODE is the name of the mode. (define (/solve-expr-fn rtx-obj expr mode parent-expr op-pos tstate appstuff) #f ; wip @@ -417,6 +419,21 @@ ;; rtx-compile (and supporting cast) +;; Subroutine of rtx-compile. +;; This is the tstate-expr-fn. +;; MODE is the name of the mode. + +(define (/compile-expr-fn rtx-obj expr mode parent-expr op-pos tstate appstuff) +; (cond +; The intent of this is to handle sequences/closures, but is it needed? +; ((rtx-style-syntax? rtx-obj) +; ((rtx-evaluator rtx-obj) rtx-obj expr mode +; parent-expr op-pos tstate)) +; (else + (cons (car expr) ; rtx-obj + (/rtx-traverse-operands rtx-obj expr tstate appstuff)) +) + ; Convert rtl expression EXPR from source form to compiled form. ; The expression is validated and rtx macros are expanded as well. ; CONTEXT is a object or #f if there is none. @@ -430,17 +447,6 @@ ; ??? In the future the compiled form may be the same as the source form ; except that all elements would be converted to their respective objects. -(define (/compile-expr-fn rtx-obj expr mode parent-expr op-pos tstate appstuff) -; (cond -; The intent of this is to handle sequences/closures, but is it needed? -; ((rtx-style-syntax? rtx-obj) -; ((rtx-evaluator rtx-obj) rtx-obj expr mode -; parent-expr op-pos tstate)) -; (else - (cons (car expr) ; rtx-obj - (/rtx-traverse-operands rtx-obj expr tstate appstuff)) -) - (define (rtx-compile context expr extra-vars-alist) (/rtx-traverse expr #f 'DFLT #f 0 (tstate-make context #f diff --git a/rtl.scm b/rtl.scm index ff53f16..3af8cc2 100644 --- a/rtl.scm +++ b/rtl.scm @@ -411,22 +411,24 @@ ; Lookup the mode to use for semantic operations (unsigned modes aren't ; allowed since we don't have ANDUSI, etc.). +; MODE is a object. ; ??? I have actually implemented both ways (full use of unsigned modes ; and mostly hidden use of unsigned modes). Neither makes me real ; comfortable, though I liked bringing unsigned modes out into the open ; even if it doubled the number of semantic operations. -(define (rtx-sem-mode m) (or (mode:sem-mode m) m)) +(define (rtx-sem-mode mode) (or (mode:sem-mode mode) mode)) -; MODE is a mode name or object. +; MODE is a object. -(define (rtx-lazy-sem-mode mode) (rtx-sem-mode (mode:lookup mode))) +(define (rtx-lazy-sem-mode mode) (rtx-sem-mode mode)) ; Return the mode of object OBJ. (define (rtx-obj-mode obj) (send obj 'get-mode)) ; Return a boolean indicating of modes M1,M2 are compatible. +; M1,M2 are objects. (define (rtx-mode-compatible? m1 m2) (let ((mode1 (rtx-lazy-sem-mode m1)) @@ -439,6 +441,7 @@ ; Environments (sequences with local variables). ; Temporaries are created within a sequence. +; MODE is a object. ; e.g. (sequence ((WI tmp)) (set tmp reg0) ...) ; ??? Perhaps what we want here is `let' but for now I prefer `sequence'. ; This isn't exactly `let' either as no initial value is specified. @@ -455,6 +458,7 @@ (method-make! 'make! (lambda (self name mode value) + (assert (mode? mode)) (elm-set! self 'name name) (elm-set! self 'mode mode) (elm-set! self 'value (if value value (gen-temp name))) @@ -493,14 +497,16 @@ (define (rtx-env-empty? env) (null? env)) ; Create an initial environment. -; VAR-LIST is a list of (name value) elements. +; VAR-LIST is a list of (name -or-mode-name value) elements. (define (rtx-env-make var-list) ; Convert VAR-LIST to an associative list of objects. (map (lambda (var-spec) (cons (car var-spec) (make - (car var-spec) (cadr var-spec) (caddr var-spec)))) + (car var-spec) + (mode-maybe-lookup (cadr var-spec)) + (caddr var-spec)))) var-list) ) @@ -734,6 +740,8 @@ (define (rtx-sequence-exprs rtx) (cddddr rtx)) ; Same as rtx-sequence-locals except return in assq'able form. +; ??? Sometimes I should it should have been (sequence ((name MODE)) ...) +; instead of (sequence ((MODE name)) ...) from the beginning, sigh. (define (rtx-sequence-assq-locals rtx) (let ((locals (rtx-sequence-locals rtx))) @@ -1014,20 +1022,20 @@ ; ??? A register selector isn't supported yet. It's just an idea that's ; been put down on paper for future reference. -(define (reg estate mode hw-name . indx-sel) - (s-hw estate mode hw-name +(define (reg estate mode-name hw-name . indx-sel) + (s-hw estate mode-name hw-name (if (pair? indx-sel) (car indx-sel) 0) (if (and (pair? indx-sel) (pair? (cdr indx-sel))) (cadr indx-sel) hw-selector-default)) ) -; This is shorthand for (hw estate mode h-memory addr selector). +; This is shorthand for (hw estate mode-name h-memory addr selector). ; ADDR must be an unevaluated RTX expression. ; If present (car sel) must be a number or unevaluated RTX expression. -(define (mem estate mode addr . sel) - (s-hw estate mode 'h-memory addr +(define (mem estate mode-name addr . sel) + (s-hw estate mode-name 'h-memory addr (if (pair? sel) (car sel) hw-selector-default)) ) diff --git a/rtx-funcs.scm b/rtx-funcs.scm index 5f37a80..f353bd6 100644 --- a/rtx-funcs.scm +++ b/rtx-funcs.scm @@ -126,7 +126,7 @@ ;(dron (opspec: &options &mode op-name op-num hw-ref attrs) ; (OPTIONS ANYMODE SYMBOL NUMBER RTX ATTRS) (NA NA NA NA ANY NA) ; ARG -; (let ((opval (rtx-eval-with-estate hw-ref mode *estate*))) +; (let ((opval (rtx-eval-with-estate hw-ref (mode:lookup &mode) *estate*))) ; (assert (operand? opval)) ; ; Set the specified mode, ensuring it's ok. ; ; This also makes a copy as we don't want to modify predefined @@ -186,7 +186,7 @@ (dron (index-of &options &mode op-rtx) (OPTIONS DFLTMODE RTX) (NA NA ANY) ARG - (let* ((operand (rtx-eval-with-estate op-rtx 'DFLT *estate*)) + (let* ((operand (rtx-eval-with-estate op-rtx DFLT *estate*)) (f (hw-index:value (op:index operand))) (f-name (obj:name f))) (make (if (source-ident? f) (obj-location f) #f) diff --git a/sem-frags.scm b/sem-frags.scm index dc19dc4..f2d6001 100644 --- a/sem-frags.scm +++ b/sem-frags.scm @@ -90,6 +90,8 @@ expr ; Local variables of the sequence `expr' is in. + ; This is recorded in the same form as the sequence, + ; i.e. (MODE name). locals ; Ordinal of the statement. @@ -108,7 +110,7 @@ ; Users of this statement. ; Each element is (owner-number . owner-object), ; where owner-number is an index into the initial insn table - ; (e.g. insn-list arg of sfrag-create-cse-mapping), and + ; (e.g. insn-list arg of /sfrag-create-cse-mapping), and ; owner-object is the corresponding object. users ) @@ -170,6 +172,8 @@ (loop (cdr chars) (modulo (+ (* result 7) (car chars)) #xfffffff)))) ) +;; MODE is the name of the mode. + (define (/frag-hash-compute! rtx-obj expr mode parent-expr op-pos tstate appstuff) (let ((h 0)) (case (rtx-name expr) @@ -205,6 +209,8 @@ (define /frag-speed-cost-tmp 0) (define /frag-size-cost-tmp 0) +;; MODE is the name of the mode. + (define (/frag-cost-compute! rtx-obj expr mode parent-expr op-pos tstate appstuff) ; FIXME: wip (let ((speed 0) @@ -258,6 +264,17 @@ ; The result is in assq'able form. (define (/frag-expr-locals expr) + (if (rtx-kind? 'sequence expr) + (rtx-sequence-locals expr) + nil) +) + +; Return the locals in EXPR in assq-able form, i.e. (name MODE). +; If a sequence, return locals. +; Otherwise, return nil. +; The result is in assq'able form. + +(define (/frag-expr-assq-locals expr) (if (rtx-kind? 'sequence expr) (rtx-sequence-assq-locals expr) nil) @@ -895,7 +912,7 @@ (mode:eq? (cadr l1) (cadr l2))))) ) (for-each (lambda (expr) - (let ((locals (/frag-expr-locals expr))) + (let ((locals (/frag-expr-assq-locals expr))) (for-each (lambda (local) (let ((entry (lookup-local local result))) (if (and entry @@ -980,7 +997,7 @@ insn-list) ) -; Subroutine of sfrag-create-cse-mapping to compute INSN's fragment list. +; Subroutine of /sfrag-create-cse-mapping to compute INSN's fragment list. ; FRAG-USAGE is a vector of 3 elements: #(header middle trailer). ; Each element is a fragment number or #f if not present. ; Numbers in FRAG-USAGE are indices relative to their respective subtables @@ -1043,7 +1060,7 @@ (cdr result)) ) -; Subroutine of sfrag-create-cse-mapping to find the fragment number of the +; Subroutine of /sfrag-create-cse-mapping to find the fragment number of the ; x-header/x-trailer virtual frags. (define (/frag-lookup-virtual frag-list name) @@ -1061,7 +1078,7 @@ ; - table mapping used fragments for each insn (a list) ; - locals list -(define (sfrag-create-cse-mapping insn-list) +(define (/sfrag-create-cse-mapping insn-list) (logit 1 "Creating semantic fragments for pbb engine ...\n") (let ((cse-data (sem-find-common-frags insn-list))) @@ -1186,7 +1203,7 @@ (if (not /sim-sfrag-init?) (begin (set! /sim-sfrag-insn-list (non-multi-insns (non-alias-insns (current-insn-list)))) - (let ((frag-data (sfrag-create-cse-mapping /sim-sfrag-insn-list))) + (let ((frag-data (/sfrag-create-cse-mapping /sim-sfrag-insn-list))) (set! /sim-sfrag-frag-table (vector-ref frag-data 0)) (set! /sim-sfrag-usage-table (vector-ref frag-data 1)) (set! /sim-sfrag-locals-list (vector-ref frag-data 2))) diff --git a/semantics.scm b/semantics.scm index d020474..ed7abf4 100644 --- a/semantics.scm +++ b/semantics.scm @@ -11,6 +11,7 @@ ; Subroutine of -rtx-find-op to determine if two modes are equivalent. ; Two modes are equivalent if they're equal, or if their sem-mode fields ; are equal. +; M1 and M2 are mode names. (define (/rtx-mode-equiv? m1 m2) (or (eq? m1 m2) @@ -70,6 +71,7 @@ ; Subroutine of semantic-compile:process-expr!, to simplify it. ; Looks up the operand in the current set, returns it if found, ; otherwise adds it. +; MODE is the mode name. ; REF-TYPE is one of 'use, 'set, 'set-quiet. ; Adds COND-CTI/UNCOND-CTI to SEM-ATTRS if the operand is a set of the pc. @@ -77,7 +79,7 @@ ;(display (list op-name mode ref-type)) (newline) (force-output) (let* ((mode (mode-real-name (if (eq? mode 'DFLT) (op:mode op) - mode))) + (mode:lookup mode)))) ; The first #f is a placeholder for the object. (try (list '-op- #f mode op-name #f)) (existing-op (/rtx-find-op try op-list))) @@ -113,10 +115,11 @@ (hw (current-hw-sem-lookup-1 hw-name))) (if hw + ; If the mode is DFLT, use the object's natural mode. (let* ((mode (mode-real-name (if (eq? (rtx-mode expr) 'DFLT) - (obj:name (hw-mode hw)) - (rtx-mode expr)))) + (hw-mode hw) + (mode:lookup (rtx-mode expr))))) (indx-sel (rtx-reg-index-sel expr)) ; #f is a place-holder for the object (filled in later) (try (list 'reg #f mode hw-name indx-sel)) @@ -143,7 +146,7 @@ ; Subroutine of semantic-compile:process-expr!, to simplify it. (define (/build-mem-operand! expr tstate op-list) - (let ((mode (rtx-mode expr)) + (let ((mode (mode-real-name (mode:lookup (rtx-mode expr)))) (indx-sel (rtx-mem-index-sel expr))) (if (memq mode '(DFLT VOID)) @@ -334,6 +337,7 @@ (sem-attrs (list #f)) ; Called for expressions encountered in SEM-CODE. + ; MODE is the name of the mode. ; Don't waste cpu here, this is part of the slowest piece in CGEN. (process-expr! (lambda (rtx-obj expr mode parent-expr op-pos tstate appstuff) @@ -505,6 +509,7 @@ (sem-attrs (list #f)) ; Called for expressions encountered in SEM-CODE. + ; MODE is the name of the mode. (process-expr! (lambda (rtx-obj expr mode parent-expr op-pos tstate appstuff) (case (car expr) -- 2.43.5