- (ref-name set-name sc type size &optional signed)
- (let ((ref-name-c (symbolicate ref-name "-C"))
- (set-name-c (symbolicate set-name "-C")))
- `(progn
- (define-vop (,ref-name)
- (:translate ,ref-name)
- (:policy :fast-safe)
- (:args (sap :scs (sap-reg))
- (offset :scs (signed-reg)))
- (:arg-types system-area-pointer signed-num)
- (:results (result :scs (,sc)))
- (:result-types ,type)
- (:generator 5
- (inst ,(ecase size
- (:byte 'lbzx)
- (:short (if signed 'lhax 'lhzx))
- (:long 'lwzx)
- (:single 'lfsx)
- (:double 'lfdx))
- result sap offset)
- ,@(when (and (eq size :byte) signed)
- '((inst extsb result result)))))
- (define-vop (,ref-name-c)
- (:translate ,ref-name)
- (:policy :fast-safe)
- (:args (sap :scs (sap-reg)))
- (:arg-types system-area-pointer (:constant (signed-byte 16)))
- (:info offset)
- (:results (result :scs (,sc)))
- (:result-types ,type)
- (:generator 4
- (inst ,(ecase size
- (:byte 'lbz)
- (:short (if signed 'lha 'lhz))
- (:long 'lwz)
- (:single 'lfs)
- (:double 'lfd))
- result sap offset)
- ,@(when (and (eq size :byte) signed)
- '((inst extsb result result)))))
- (define-vop (,set-name)
- (:translate ,set-name)
- (:policy :fast-safe)
- (:args (sap :scs (sap-reg))
- (offset :scs (signed-reg))
- (value :scs (,sc) :target result))
- (:arg-types system-area-pointer signed-num ,type)
- (:results (result :scs (,sc)))
- (:result-types ,type)
- (:generator 5
- (inst ,(ecase size
- (:byte 'stbx)
- (:short 'sthx)
- (:long 'stwx)
- (:single 'stfsx)
- (:double 'stfdx))
- value sap offset)
- (unless (location= result value)
- ,@(case size
- (:single
- '((inst frsp result value)))
- (:double
- '((inst fmr result value)))
- (t
- '((inst mr result value)))))))
- (define-vop (,set-name-c)
- (:translate ,set-name)
- (:policy :fast-safe)
- (:args (sap :scs (sap-reg))
- (value :scs (,sc) :target result))
- (:arg-types system-area-pointer (:constant (signed-byte 16)) ,type)
- (:info offset)
- (:results (result :scs (,sc)))
- (:result-types ,type)
- (:generator 4
- (inst ,(ecase size
- (:byte 'stb)
- (:short 'sth)
- (:long 'stw)
- (:single 'stfs)
- (:double 'stfd))
- value sap offset)
- (unless (location= result value)
- ,@(case size
- (:single
- '((inst frsp result value)))
- (:double
- '((inst fmr result value)))
- (t
- '((inst mr result value)))))))))))
+ (ref-name set-name sc type size &optional signed)
+ (let ((ref-name-c (symbolicate ref-name "-C"))
+ (set-name-c (symbolicate set-name "-C")))
+ `(progn
+ (define-vop (,ref-name)
+ (:translate ,ref-name)
+ (:policy :fast-safe)
+ (:args (sap :scs (sap-reg))
+ (offset :scs (signed-reg)))
+ (:arg-types system-area-pointer signed-num)
+ (:results (result :scs (,sc)))
+ (:result-types ,type)
+ (:generator 5
+ (inst ,(ecase size
+ (:byte 'lbzx)
+ (:short (if signed 'lhax 'lhzx))
+ (:long 'lwzx)
+ (:single 'lfsx)
+ (:double 'lfdx))
+ result sap offset)
+ ,@(when (and (eq size :byte) signed)
+ '((inst extsb result result)))))
+ (define-vop (,ref-name-c)
+ (:translate ,ref-name)
+ (:policy :fast-safe)
+ (:args (sap :scs (sap-reg)))
+ (:arg-types system-area-pointer (:constant (signed-byte 16)))
+ (:info offset)
+ (:results (result :scs (,sc)))
+ (:result-types ,type)
+ (:generator 4
+ (inst ,(ecase size
+ (:byte 'lbz)
+ (:short (if signed 'lha 'lhz))
+ (:long 'lwz)
+ (:single 'lfs)
+ (:double 'lfd))
+ result sap offset)
+ ,@(when (and (eq size :byte) signed)
+ '((inst extsb result result)))))
+ (define-vop (,set-name)
+ (:translate ,set-name)
+ (:policy :fast-safe)
+ (:args (sap :scs (sap-reg))
+ (offset :scs (signed-reg))
+ (value :scs (,sc) :target result))
+ (:arg-types system-area-pointer signed-num ,type)
+ (:results (result :scs (,sc)))
+ (:result-types ,type)
+ (:generator 5
+ (inst ,(ecase size
+ (:byte 'stbx)
+ (:short 'sthx)
+ (:long 'stwx)
+ (:single 'stfsx)
+ (:double 'stfdx))
+ value sap offset)
+ (unless (location= result value)
+ ,@(case size
+ (:single
+ '((inst frsp result value)))
+ (:double
+ '((inst fmr result value)))
+ (t
+ '((inst mr result value)))))))
+ (define-vop (,set-name-c)
+ (:translate ,set-name)
+ (:policy :fast-safe)
+ (:args (sap :scs (sap-reg))
+ (value :scs (,sc) :target result))
+ (:arg-types system-area-pointer (:constant (signed-byte 16)) ,type)
+ (:info offset)
+ (:results (result :scs (,sc)))
+ (:result-types ,type)
+ (:generator 4
+ (inst ,(ecase size
+ (:byte 'stb)
+ (:short 'sth)
+ (:long 'stw)
+ (:single 'stfs)
+ (:double 'stfd))
+ value sap offset)
+ (unless (location= result value)
+ ,@(case size
+ (:single
+ '((inst frsp result value)))
+ (:double
+ '((inst fmr result value)))
+ (t
+ '((inst mr result value)))))))))))