- #'(lambda (segment posn delta-if-after)
- (let ((delta (funcall calc label posn delta-if-after)))
- (when (<= (- (ash 1 15)) delta (1- (ash 1 15)))
- (emit-back-patch segment 4
- #'(lambda (segment posn)
- (assemble (segment vop)
- (inst lda dst
- (funcall calc label posn 0)
- src))))
- t)))
- #'(lambda (segment posn)
- (assemble (segment vop)
- (flet ((se (x n)
- (let ((x (logand x (lognot (ash -1 n)))))
- (if (logbitp (1- n) x)
- (logior (ash -1 (1- n)) x)
- x))))
- (let* ((value (se (funcall calc label posn 0) 32))
- (low (ldb (byte 16 0) value))
- (tmp1 (- value (se low 16)))
- (high (ldb (byte 16 16) tmp1))
- (tmp2 (- tmp1 (se (ash high 16) 32)))
- (extra 0))
- (unless (= tmp2 0)
- (setf extra #x4000)
- (setf tmp1 (- tmp1 #x40000000))
- (setf high (ldb (byte 16 16) tmp1)))
- (inst lda dst low src)
- (inst ldah dst extra dst)
- (inst ldah dst high dst)))))))
+ (lambda (segment posn delta-if-after)
+ (let ((delta (funcall calc label posn delta-if-after)))
+ (when (<= (- (ash 1 15)) delta (1- (ash 1 15)))
+ (emit-back-patch segment 4
+ (lambda (segment posn)
+ (assemble (segment vop)
+ (inst lda dst
+ (funcall calc label posn 0)
+ src))))
+ t)))
+ (lambda (segment posn)
+ (assemble (segment vop)
+ (flet ((se (x n)
+ (let ((x (logand x (lognot (ash -1 n)))))
+ (if (logbitp (1- n) x)
+ (logior (ash -1 (1- n)) x)
+ x))))
+ (let* ((value (se (funcall calc label posn 0) 32))
+ (low (ldb (byte 16 0) value))
+ (tmp1 (- value (se low 16)))
+ (high (ldb (byte 16 16) tmp1))
+ (tmp2 (- tmp1 (se (ash high 16) 32)))
+ (extra 0))
+ (unless (= tmp2 0)
+ (setf extra #x4000)
+ (setf tmp1 (- tmp1 #x40000000))
+ (setf high (ldb (byte 16 16) tmp1)))
+ (inst lda dst low src)
+ (inst ldah dst extra dst)
+ (inst ldah dst high dst)))))))