+(defun emit-compute-inst (segment vop src label temp dst calc)
+ (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 )
+ (lambda (segment posn delta-if-after)
+ (let ((delta (funcall calc label posn delta-if-after)))
+ ;; 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 )
+ (lambda (segment posn)
+ (let ((delta (funcall calc label posn 0)))
+ ;; 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
+ (inst ldil delta temp)
+ (inst ldo (ldb (byte 11 0) delta) temp temp :unsigned t)
+ (inst add src temp dst))))))
+
+(macrolet ((compute ((name) &body body)
+ `(define-instruction ,name (segment src label temp dst)
+ (:declare (type tn src dst temp) (type label label))
+ (:attributes variable-length)
+ (:dependencies (reads src) (writes dst) (writes temp))
+ (:delay 0)
+ (:vop-var vop)
+ (:emitter
+ (emit-compute-inst segment vop src label temp dst
+ ,@body)))))
+ (compute (compute-code-from-lip)
+ (lambda (label posn delta-if-after)
+ (- other-pointer-lowtag
+ (label-position label posn delta-if-after)
+ (component-header-length))))
+ (compute (compute-code-from-lra)
+ (lambda (label posn delta-if-after)
+ (- (+ (label-position label posn delta-if-after)
+ (component-header-length)))))
+ (compute (compute-lra-from-code)
+ (lambda (label posn delta-if-after)
+ (+ (label-position label posn delta-if-after)
+ (component-header-length)))))
+\f
+;;;; Data instructions.