(fp-single-zero (values 0 nil))
(single-reg (values (tn-offset tn) nil))
(fp-double-zero (values 0 t))
- (double-reg (values (tn-offset tn) t))))
+ (double-reg (values (tn-offset tn) t))
+ (complex-single-reg (values (tn-offset tn) nil))
+ (complex-double-reg (values (tn-offset tn) t))))
(defconstant-eqx compare-conditions
'(:never := :< :<= :<< :<<= :sv :od :tr :<> :>= :> :>>= :>> :nsv :ev)
\f
;;;; Initial disassembler setup.
-;FIX-lav: is this still used, if so , why use package prefix
-;(setf sb!disassem:*disassem-inst-alignment-bytes* 4)
+
+;;; FIXME-lav: is this still used, if so , why use package prefix
+;;; (setf sb!disassem:*disassem-inst-alignment-bytes* 4)
(defvar *disassem-use-lisp-reg-names* t)
; immediate or anything else.
; this routine will return an location-number
; this number must be less than *assem-max-locations*
-(!def-vm-support-routine location-number (loc)
+(defun location-number (loc)
(etypecase loc
(null)
(number)
(emit-back-patch segment 4
(lambda (segment posn)
(let ((disp (label-relative-displacement target posn)))
- (aver (<= (- (ash 1 16)) disp (1- (ash 1 16))))
+ (aver (typep disp '(signed-byte 17)))
(multiple-value-bind
(w1 w2 w)
(decompose-branch-disp segment disp)
(emit-back-patch segment 4
(lambda (segment posn)
(let ((disp (label-relative-displacement target posn)))
- (when (not (<= (- (ash 1 11)) disp (1- (ash 1 11))))
- (format t "AVER fail: disp = ~s~%" disp)
- (format t "target = ~s~%" target)
- (format t "posn = ~s~%" posn)
- )
- (aver (<= (- (ash 1 11)) disp (1- (ash 1 11))))
+ ; emit-conditional-branch is used by instruction emitters: MOVB, COMB, ADDB and BB
+ ; which assembles an immediate of total 12 bits (including sign bit).
+ (aver (typep disp '(signed-byte 12)))
(let ((w1 (logior (ash (ldb (byte 10 0) disp) 1)
(ldb (byte 1 10) disp)))
- (w (ldb (byte 1 11) disp)))
+ (w (ldb (byte 1 11) disp))) ; take out the sign bit
(emit-branch segment opcode r2 r1 cond w1 (if nullify 1 0) w))))))
(defun im5-encoding (value)
(:printer r3-inst ((op ,opcode) (c nil :type ',(symbolicate
cond-kind
"-CONDITION"))))
- ;FIX-lav, change opcode test to name test
- ,@(when (= opcode #x12)
+ ,@(when (eq name 'or)
`((:printer r3-inst ((op ,opcode) (r2 0)
(c nil :type ',(symbolicate cond-kind
"-CONDITION")))
(lambda (segment posn)
(let ((disp (label-relative-displacement target posn)))
(assemble (segment vop)
- (cond ((<= (- (ash 1 11)) disp (1- (ash 1 11)))
+ (cond ((typep disp '(signed-byte 12))
(inst comb (maybe-negate-cond cond not-p) r1 r2 target)
- (inst nop)) ;FIX-lav, cant nullify when backward branch
+ (inst nop)) ; FIXME-lav, cant nullify when backward branch
(t
(inst comclr r1 r2 zero-tn
(maybe-negate-cond cond (not not-p)))
(lambda (segment posn delta-if-after)
(let ((disp (label-relative-displacement target posn delta-if-after)))
(when (and (<= 0 disp (1- (ash 1 11)))
- (<= (- (ash 1 4)) imm (1- (ash 1 4))))
+ (typep imm '(signed-byte 5)))
(assemble (segment vop)
(inst comib (maybe-negate-cond cond not-p) imm reg target
:nullify t))
(lambda (segment posn)
(let ((disp (label-relative-displacement target posn)))
(assemble (segment vop)
- (cond ((and (<= (- (ash 1 11)) disp (1- (ash 1 11)))
- (<= (- (ash 1 4)) imm (1- (ash 1 4))))
+ (cond ((and (typep disp '(signed-byte 12))
+ (typep imm '(signed-byte 5)))
(inst comib (maybe-negate-cond cond not-p) imm reg target)
(inst nop))
(t
(emit-chooser
;; We emit either 12 or 4 bytes, so we maintain 3 byte alignments.
segment 12 3
- ; This is the best-case that emits one instruction ( 4 bytes )
+ ;; This is the best-case that emits one instruction ( 4 bytes )
(lambda (segment posn delta-if-after)
(let ((delta (funcall calc label posn delta-if-after)))
- ; WHEN, Why not AVER ?
- (when (<= (- (ash 1 10)) delta (1- (ash 1 10)))
+ ;; WHEN, Why not AVER ?
+ (when (typep delta '(signed-byte 11))
(emit-back-patch segment 4
(lambda (segment posn)
(assemble (segment vop)
(inst addi (funcall calc label posn 0) src
dst))))
t)))
- ; This is the worst-case that emits three instruction ( 12 bytes )
+ ;; This is the worst-case that emits three instruction ( 12 bytes )
(lambda (segment posn)
(let ((delta (funcall calc label posn 0)))
- ; FIX-lav: why do we hit below check ?
- ;(when (<= (- (ash 1 10)) delta (1- (ash 1 10)))
- ; (error "emit-compute-inst selected worst-case, but is shrinkable, delta is ~s" delta))
+ ;; FIXME-lav: why do we hit below check ?
+ ;; (when (<= (- (ash 1 10)) delta (1- (ash 1 10)))
+ ;; (error "emit-compute-inst selected worst-case, but is shrinkable, delta is ~s" delta))
;; Note: if we used addil/ldo to do this in 2 instructions then the
;; intermediate value would be tagged but pointing into space.
;; Does above note mean that the intermediate value would be
;; a bogus pointer that would be GCed wrongly ?
;; Also what I can see addil would also overwrite NFP (r1) ???
(assemble (segment vop)
- ; Three instructions (4 * 3) this is the reason for 12 bytes
+ ;; Three instructions (4 * 3) this is the reason for 12 bytes
(inst ldil delta temp)
(inst ldo (ldb (byte 11 0) delta) temp temp :unsigned t)
(inst add src temp dst))))))
projects / sbcl.git / blobdiff