+2009-11-23 Doug Evans <dje@sebabeach.org>
+
+ * hardware.scm (hw-pc?): New function.
+ * ifield.scm (ifld-signed?): New function.
+ * iformat.scm (ifmt-analyze): Call insn-cti-attr? instead of insn-cti?.
+ * insn.scm (insn-cti-attr?): Renamed from insn-ctl?.
+ (insn-cti?): New function.
+ * rtl.scm (/hw): Create <pc> object for pcs.
+ * semantics.scm (/build-reg-operand!): New args ref-type, sem-attrs.
+ All callers updated. Watch for sets to the pc.
+ (semantic-attrs): Watch for sets to the pc.
+ * sid.scm (<pc> cxmake-get): Handle raw-reg.
+ * sim.scm (<pc> cxmake-get): Handle raw-reg.
+ (<operand> cxmake-get): Add debugging printf.
+ * utils-gen.scm (/gen-ifld-extract-base): Emit calls to
+ EXTRACT_[LM]SB0_LG[SU]INT for values > 32 bits.
+ (/gen-extract-word): Ditto.
+
+ * utils.scm (gen-c-hex-constant): New function.
+ * utils-sim.scm (/gen-decode-insn-entry): Call it.
+
2009-11-22 Doug Evans <dje@sebabeach.org>
* insn.scm (/parse-insn-format): Watch for duplicate ifields.
(method-make! <hw-pc> 'pc? (lambda (self) #t))
+(define (hw-pc? hw) (send hw 'pc?))
+
; Memory.
(define <hw-memory> (class-make '<hw-memory> '(<hardware-base>) nil nil))
; (not (has-attr? f 'RESERVED))))
)
+; Return a boolean indicating if ifield F is signed.
+
+(define (ifld-signed? f)
+ (eq? (mode:class (ifld-mode f)) 'INT)
+)
+
; Return a boolean indicating if ifield F is an operand.
; FIXME: Should check for operand? or some such.
(out-ops (csem-outputs sem-ops))
(attrs (csem-attrs sem-ops))
(cti? (or (atlist-cti? (csem-attrs sem-ops))
- (insn-cti? insn))))
+ (insn-cti-attr? insn))))
(list (make <fmt-desc>
cti? sorted-ifields in-ops out-ops
result)
)
-; Return a boolean indicating if INSN is a cti [control transfer insn].
-; This includes SKIP-CTI insns even though they don't terminate a basic block.
-; ??? SKIP-CTI insns are wip, waiting for more examples of how they're used.
+;; Return a boolean indicating if INSN is a cti [control transfer insn]
+;; according the its attributes.
+;;
+;; N.B. This only looks at the insn's atlist, which only contains what was
+;; specified in the .cpu file. .cpu files are not required to manually mark
+;; CTI insns. Basically this exists as an escape hatch in case semantic-attrs
+;; gets it wrong.
+
+(define (insn-cti-attr? insn)
+ (atlist-cti? (obj-atlist insn))
+)
+
+;; Return a boolean indicating if INSN is a cti [control transfer insn].
+;; This includes SKIP-CTI insns even though they don't terminate a basic block.
+;; ??? SKIP-CTI insns are wip, waiting for more examples of how they're used.
+;;
+;; N.B. This requires the <sformat> of INSN.
(define (insn-cti? insn)
- (atlist-cti? (obj-atlist insn))
+ (or (insn-cti-attr? insn)
+ (sfmt-cti? (insn-sfmt insn)))
)
; Return a boolean indicating if INSN can be executed in parallel.
(let* ((mode (if (eq? mode-name 'DFLT) (hw-mode hw) (mode:lookup mode-name)))
(hw-name-with-mode (symbol-append hw-name '- (obj:name mode)))
(index-mode (if (eq? hw-name 'h-memory) 'AI 'INT))
- (result (new <operand>))) ; ??? lookup-for-new?
+ (result (if (hw-pc? hw)
+ (new <pc>)
+ (new <operand>)))) ; ??? lookup-for-new?
(if (not mode)
(parse-error (estate-context estate) "invalid mode" mode-name))
; The name of the operand must include the index so that multiple copies
; of a hardware object (e.g. h-gr[0], h-gr[14]) can be distinguished.
- (let ((name (/rtx-hw-name hw hw-name-with-mode index-arg)))
+ (let ((name (if (hw-pc? hw)
+ 'pc
+ (/rtx-hw-name hw hw-name-with-mode index-arg))))
(send result 'set-name! name)
(op:set-sem-name! result name))
)
; Subroutine of semantic-compile:process-expr!, to simplify it.
+; 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.
-(define (/build-reg-operand! expr tstate op-list)
+(define (/build-reg-operand! expr tstate ref-type op-list sem-attrs)
(let* ((hw-name (rtx-reg-name expr))
(hw (current-hw-sem-lookup-1 hw-name)))
(try (list 'reg #f mode hw-name indx-sel))
(existing-op (/rtx-find-op try op-list)))
+ ;; FIXME: keep name h-pc hardwired?
+ (if (and (eq? 'h-pc hw-name)
+ (memq ref-type '(set set-quiet)))
+ (append! sem-attrs
+ (list (if (tstate-cond? tstate) 'COND-CTI 'UNCOND-CTI))))
+
; If already present, return the object, otherwise add it.
(if existing-op
(else (parse-error (tstate-context tstate)
"invalid register number"
regno)))
- (/build-reg-operand! expr tstate
+ (/build-reg-operand! expr tstate ref-type
(if (eq? ref-type 'use)
in-ops
- out-ops))))
+ out-ops)
+ sem-attrs)))
; Memory.
((mem) (let ((ref-type (/rtx-ref-type parent-expr op-pos)))
;
; CONTEXT is a <context> object or #f if there is none.
; INSN is the <insn> object.
+; SEM-CODE must be canonicalized rtl.
(define (semantic-attrs context insn sem-code)
(assert (rtx? sem-code))
'(set set-quiet)))
(append! sem-attrs
(if (tstate-cond? tstate)
- ; Don't change these to '(FOO), since
- ; we use append!.
+ ;; Don't change these to '(FOO), since
+ ;; we use append!.
(list 'COND-CTI)
(list 'UNCOND-CTI)))))
+
+ ;; FIXME: keep name h-pc hardwired?
+ ((reg) (if (and (eq? 'h-pc (rtx-reg-name expr))
+ (memq (/rtx-ref-type parent-expr op-pos)
+ '(set set-quiet)))
+ (append! sem-attrs
+ (if (tstate-cond? tstate)
+ ;; Don't change these to '(FOO), since
+ ;; we use append!.
+ (list 'COND-CTI)
+ (list 'UNCOND-CTI)))))
+
((skip) (append! sem-attrs (list 'SKIP-CTI)) #f)
+
((delay) (append! sem-attrs (list 'DELAY-SLOT)) #f)
; If this is a syntax expression, the operands won't have been
(let ((mode (if (mode:eq? 'DFLT mode)
(send self 'get-mode)
mode)))
- ; The enclosing function must set `pc' to the correct value.
- (cx:make mode "pc")))
+
+ (logit 4 "<pc> cxmake-get self=" (obj:name self) " mode=" (obj:name mode) "\n")
+
+ (if (obj-has-attr? self 'RAW)
+ (let ((hw (op:type self))
+ ;; For consistency with <operand> process index,selector similarly.
+ (index (if index index (op:index self)))
+ (selector (if selector selector (op:selector self))))
+ (send hw 'cxmake-get-raw estate mode index selector))
+ ;; The enclosing function must set `pc' to the correct value.
+ (cx:make mode "pc"))))
)
(method-make!
#:output-language (estate-output-language estate))))
(else
(send hw 'cxmake-get estate mode index selector)))))
-
+
(logit 4 "<operand> cxmake-get self=" (obj:name self) " mode=" (obj:name mode)
" index=" (obj:name index) " selector=" selector "\n")
-
+
(if delayval
(cx:make mode (string-append "lookahead ("
(number->string delayval)
(let ((mode (if (mode:eq? 'DFLT mode)
(send self 'get-mode)
mode)))
- ; The enclosing function must set `pc' to the correct value.
- (cx:make mode "pc")))
+
+ (logit 4 "<pc> cxmake-get self=" (obj:name self) " mode=" (obj:name mode) "\n")
+
+ (if (obj-has-attr? self 'RAW)
+ (let ((hw (op:type self))
+ ;; For consistency with <operand> process index,selector similarly.
+ (index (if index index (op:index self)))
+ (selector (if selector selector (op:selector self))))
+ (send hw 'cxmake-get-raw estate mode index selector))
+ ;; The enclosing function must set `pc' to the correct value.
+ (cx:make mode "pc"))))
)
(method-make!
mode))
(index (if index index (op:index self)))
(selector (if selector selector (op:selector self))))
- ; If the instruction could be parallely executed with others and we're
- ; doing read pre-processing, the operand has already been fetched, we
- ; just have to grab the cached value.
- ; ??? reg-raw: support wip
- (cond ((obj-has-attr? self 'RAW)
- (send (op:type self) 'cxmake-get-raw estate mode index selector))
- ((with-parallel-read?)
- (cx:make-with-atlist mode
- (string-append /par-operand-macro
- " (" (gen-sym self) ")")
- nil)) ; FIXME: want CACHED attr if present
- ((op:getter self)
- (let ((args (car (op:getter self)))
- (expr (cadr (op:getter self))))
- (rtl-c-expr mode
- (obj-isa-list self)
- (if (= (length args) 0)
- nil
- (list (list (car args) 'UINT index)))
- expr
- #:rtl-cover-fns? #t)))
- (else
- (send (op:type self) 'cxmake-get estate mode index selector)))))
+ ;; If the instruction could be parallely executed with others and we're
+ ;; doing read pre-processing, the operand has already been fetched, we
+ ;; just have to grab the cached value.
+ (let ((result
+ (cond ((obj-has-attr? self 'RAW)
+ (send (op:type self) 'cxmake-get-raw estate mode index selector))
+ ((with-parallel-read?)
+ (cx:make-with-atlist mode
+ (string-append /par-operand-macro
+ " (" (gen-sym self) ")")
+ nil)) ;; FIXME: want CACHED attr if present
+ ((op:getter self)
+ (let ((args (car (op:getter self)))
+ (expr (cadr (op:getter self))))
+ (rtl-c-expr mode
+ (obj-isa-list self)
+ (if (= (length args) 0)
+ nil
+ (list (list (car args) 'UINT index)))
+ expr
+ #:rtl-cover-fns? #t)))
+ (else
+ (send (op:type self) 'cxmake-get estate mode index selector)))))
+
+ (logit 4 "<operand> cxmake-get self=" (obj:name self) " mode=" (obj:name mode)
+ " index=" (obj:name index) " selector=" selector "\n")
+
+ result)))
)
; Utilities to implement gen-set-quiet/gen-set-trace.
(let ((extraction
(string-append "EXTRACT_"
(if (current-arch-insn-lsb0?) "LSB0_" "MSB0_")
+ (if (> total-length 32) "LG" "")
(case (mode:class (ifld-mode f))
- ((INT) "INT")
+ ((INT) "SINT")
((UINT) "UINT")
(else (error "unsupported mode class"
(mode:class (ifld-mode f)))))
(base (if (< start word-start) word-start start)))
(string-append "("
"EXTRACT_"
- (if lsb0? "LSB0" "MSB0")
+ (if lsb0? "LSB0_" "MSB0_")
+ (if (> word-length 32) "LG" "")
(if (and (not unsigned?)
; Only want sign extension for word with sign bit.
(bitrange-overlap? field-start 1
word-start word-length
lsb0?))
- "_INT ("
- "_UINT (")
+ "SINT"
+ "UINT")
+ " ("
; What to extract from.
word-name
", "
"\n")
indent " if (("
(if (adata-integral-insn? CURRENT-ARCH) "entire_insn" "base_insn")
- " & 0x" (number->hex (insn-base-mask insn))
- ") == 0x" (number->hex (insn-value insn)) ")\n"
+ " & " (gen-c-hex-constant (insn-base-mask insn) "CGEN_INSN_LGUINT")
+ ") == " (gen-c-hex-constant (insn-value insn) "CGEN_INSN_LGUINT") ")\n"
(/gen-bracketed-set-itype-and-extract (string-append indent " ")
(gen-cpu-insn-enum (current-cpu) insn)
fmt-name fn?)
(number->string num 16)
)
+; Convert a number to a hex C constant,
+; taking care to handle large numbers.
+; If NUM won't fit in a portable int (32-bits), cast it to BIG-NUM-TYPE.
+
+(define (gen-c-hex-constant num big-num-type)
+ (cond ((< num (- (ash 1 31)))
+ ;; Skip outputting -ve numbers in hex for now.
+ (string-append "((" big-num-type ") " (number->string num) "LL)"))
+ ((> num (- (ash 1 32) 1))
+ (string-append "((" big-num-type ") 0x" (number->string num 16) "LL)"))
+ (else
+ (string-append "0x" (number->string num 16))))
+)
+
; Given a list of numbers NUMS, generate text to pass them as arguments to a
; C function. We assume they're not the first argument and thus have a
; leading comma.
OSDN Git Service
