- (addr+ ptr
- (case mode
- ((immediate) 0)
- ((direct) num)
- ((indirect-A) (addr+ num (core (addr+ ptr num) 'A-num)))
- ((indirect-B) (addr+ num (core (addr+ ptr num) 'B-num)))
- ((pre-indirect-A)
- (let ((aux-ptr (addr+ ptr num)))
- (core aux-ptr 'set! 'A-num (addr+ -1 (core aux-ptr 'A-num)) name)
- (addr+ num (core aux-ptr 'A-num))))
- ((pre-indirect-B)
- (let ((aux-ptr (addr+ ptr num)))
- (core aux-ptr 'set! 'B-num (addr+ -1 (core aux-ptr 'B-num)) name)
- (addr+ num (core aux-ptr 'B-num))))
- ((post-indirect-A)
- (let* ((aux-ptr (addr+ ptr num))
- (old-A-num (core aux-ptr 'A-num)))
- (core aux-ptr 'set! 'A-num (addr+ 1 (core aux-ptr 'A-num)) name)
- (addr+ num old-A-num)))
- ((post-indirect-B)
- (let* ((aux-ptr (addr+ ptr num))
- (old-B-num (core aux-ptr 'B-num)))
- (core aux-ptr 'set! 'B-num (addr+ 1 (core aux-ptr 'B-num)) name)
- (addr+ num old-B-num)))
- (else
- (error "Unrecognized mode" mode)))))
+ (core '->addr (+ ptr
+ (case mode
+ ((immediate) 0)
+ ((direct) num)
+ ((indirect-A) (+ num (core (+ ptr num) 'A-num)))
+ ((indirect-B) (+ num (core (+ ptr num) 'B-num)))
+ ((pre-indirect-A)
+ (let ((aux-ptr (+ ptr num)))
+ (core aux-ptr 'set! 'A-num (- (core aux-ptr 'A-num) 1) name)
+ (+ num (core aux-ptr 'A-num))))
+ ((pre-indirect-B)
+ (let ((aux-ptr (+ ptr num)))
+ (core aux-ptr 'set! 'B-num (- (core aux-ptr 'B-num) 1) name)
+ (+ num (core aux-ptr 'B-num))))
+ ((post-indirect-A)
+ (let* ((aux-ptr (+ ptr num))
+ (old-A-num (core aux-ptr 'A-num)))
+ (core aux-ptr 'set! 'A-num (+ (core aux-ptr 'A-num) 1) name)
+ (+ num old-A-num)))
+ ((post-indirect-B)
+ (let* ((aux-ptr (+ ptr num))
+ (old-B-num (core aux-ptr 'B-num)))
+ (core aux-ptr 'set! 'B-num (+ (core aux-ptr 'B-num) 1) name)
+ (+ num old-B-num)))
+ (else
+ (error "Unrecognized mode" mode))))))