(loader '((title |setf.lo|)))
(defvar #:sys-package:colon 'setf)
(add-feature 'setf)
(loader'((fentry system-put dmsubr)
(entry system-put dmsubr)
(mov (cdr a1) a4)
(mov (car a1) a1)
(push a1)
(mov (cdr a4) a3)
(mov (car a4) a4)
(mov (car a3) a3)
(push (@ 101))
(push 'progn)
(push (@ 102))
(push 'putprop)
(push a1)
(push a3)
(push a4)
(mov '4 a4)
(jmp list)
102
(eval ())
(push a1)
(push (& 3))
(mov '3 a4)
(jmp list)
101
(eval ())
(adjstk '1)
(return)
))
(loader'((fentry push-setf-method dmsubr)
(entry push-setf-method dmsubr)
(mov (cdr a1) a4)
(mov (car a1) a1)
(mov (car a4) a4)
(push (@ 101))
(push 'system-put)
(push a1)
(push ''setf-method)
(push a4)
(mov '4 a4)
(jmp list)
101
(eval ())
(return)
))
(loader'((fentry push-setf-inverse dmsubr)
(entry push-setf-inverse dmsubr)
(mov (cdr a1) a4)
(mov (car a1) a1)
(mov (car a4) a4)
(push (@ 101))
(push 'system-put)
(push a1)
(push ''setf-inverse)
(push a4)
(mov '4 a4)
(jmp list)
101
(eval ())
(return)
))
(loader'((fentry push-setf-expander dmsubr)
(entry push-setf-expander dmsubr)
(mov (cdr a1) a4)
(mov (car a1) a1)
(mov (car a4) a4)
(push (@ 101))
(push 'system-put)
(push a1)
(push ''setf-expander)
(push a4)
(mov '4 a4)
(jmp list)
101
(eval ())
(return)
))
(loader'((fentry define-setf-method dmsubr)
(entry define-setf-method dmsubr)
(mov (cdr a1) a4)
(mov (car a1) a1)
(push a1)
(mov (cdr a4) a3)
(mov (car a4) a4)
(push a4)
(push a3)
(push (@ 101))
(push 'progn)
(push (@ 102))
(push 'push-setf-method)
(push (@ 103))
(push 'quote)
(push a1)
(mov '2 a4)
(jmp list)
103
(eval ())
(push a1)
(push (@ 104))
(push 'function)
(push (@ 105))
(push 'lambda)
(push (& 10))
(push (& 10))
(mov '3 a4)
(jmp mcons)
105
(eval ())
(push a1)
(mov '2 a4)
(jmp list)
104
(eval ())
(push a1)
(mov '3 a4)
(jmp list)
102
(eval ())
(push a1)
(push (@ 106))
(push 'quote)
(push (& 7))
(mov '2 a4)
(jmp list)
106
(eval ())
(push a1)
(mov '3 a4)
(jmp list)
101
(eval ())
(adjstk '3)
(return)
))
(loader'((fentry get-setf-method subr1)
(entry get-setf-method subr1)
(push a1)
(bfsymb a1 101)
(jcall gensym)
(push a1)
(push (@ 103))
(push nil)
(push nil)
(push (@ 104))
(push a1)
(mov '1 a4)
(jmp list)
104
(eval ())
(push a1)
(push (@ 105))
(push 'setq)
(push (& 7))
(push (& 7))
(mov '3 a4)
(jmp list)
105
(eval ())
(push a1)
(push (& 6))
(mov '5 a4)
(jmp list)
103
(eval ())
(adjstk '2)
(return)
101
(jcall listp)
(btnil a1 106)
(mov (& 0) a4)
(bfsymb (car a4) 106)
(push nil)
(mov (& 1) a1)
(mov (car a1) a1)
(call macro-function)
(btnil a1 108)
(mov (& 1) a1)
(jcall macroexpand)
(adjstk '2)
(jmp get-setf-method)
108
(mov (& 1) a1)
(mov 'setf-method a2)
(mov (car a1) a1)
(jcall getprop)
(mov a1 (& 0))
(btnil a1 110)
(push (@ 112))
(push a1)
(mov (& 3) a4)
(push (cdr a4))
(mov '2 a4)
(jmp apply)
112
(eval ())
(adjstk '2)
(return)
110
(mov (& 1) a1)
(mov 'setf-inverse a2)
(mov (car a1) a1)
(jcall getprop)
(mov a1 (& 0))
(btnil a1 113)
(jcall gensym)
(push a1)
(mov (& 2) a4)
(push (cdr a4))
(push nil)
115
(bfcons (& 1) 116)
(mov (& 1) a4)
(mov (cdr a4) (& 1))
(push (car a4))
(mov '1 a4)
(jcall #:llcp:nlist)
(jcall gensym)
(mov (& 0) a2)
(jcall cons)
(mov a1 (& 0))
(bra 115)
116
(mov (& 0) a1)
(jcall nreverse)
(adjstk '2)
(push a1)
(push (@ 117))
(push a1)
(mov (& 5) a4)
(push (cdr a4))
(push (@ 118))
(push (& 5))
(mov '1 a4)
(jmp list)
118
(eval ())
(push a1)
(push (@ 119))
(push (& 5))
(push (@ 120))
(push (& 8))
(mov '1 a4)
(jmp list)
120
(eval ())
(push a1)
(mov '2 a4)
(jmp append)
119
(eval ())
(mov a1 a2)
(mov (& 6) a1)
(jcall cons)
(push a1)
(mov (& 8) a1)
(mov (& 5) a2)
(mov (car a1) a1)
(jcall cons)
(push a1)
(mov '5 a4)
(jmp list)
117
(eval ())
(adjstk '4)
(return)
113
(mov (& 1) a1)
(mov 'setf-expander a2)
(mov (car a1) a1)
(jcall getprop)
(mov a1 (& 0))
(btnil a1 121)
(mov (& 1) a4)
(push (cdr a4))
(push (& 0))
(push nil)
123
(bfcons (& 1) 124)
(mov (& 1) a4)
(mov (cdr a4) (& 1))
(push (car a4))
(mov '1 a4)
(jcall #:llcp:nlist)
(jcall gensym)
(mov (& 0) a2)
(jcall cons)
(mov a1 (& 0))
(bra 123)
124
(mov (& 0) a1)
(jcall nreverse)
(adjstk '2)
(push a1)
(jcall gensym)
(push a1)
(push (@ 125))
(push (& 2))
(push (& 4))
(push (@ 126))
(push a1)
(mov '1 a4)
(jmp list)
126
(eval ())
(push a1)
(push (@ 127))
(push (& 8))
(mov (& 7) a2)
(mov (& 6) a1)
(jcall cons)
(push a1)
(mov '2 a4)
(jmp apply)
127
(eval ())
(push a1)
(mov (& 9) a1)
(mov (& 6) a2)
(mov (car a1) a1)
(jcall cons)
(push a1)
(mov '5 a4)
(jmp list)
125
(eval ())
(adjstk '5)
(return)
121
(mov (& 1) a3)
(mov 'errgen a2)
(mov 'get-setf-method a1)
(adjstk '2)
(jmp error)
106
(mov (& 0) a3)
(mov 'errbpa a2)
(mov 'get-setf-method a1)
(adjstk '1)
(jmp error)
))
(loader'((fentry setf dmsubr)
(entry setf dmsubr)
(push a1)
(mov (cdr a1) a4)
(btnil (cdr a4) 101)
(push a1)
(push (@ 103))
(push 'progn)
(mov '1 a4)
(jmp list)
103
(eval ())
(push a1)
104
(btnil (& 1) 105)
(mov (& 1) a4)
(mov (cdr a4) a4)
(push (cdr a4))
(mov (& 2) a3)
(btnil (cdr a3) 106)
(push (@ 108))
(push (& 2))
(push (@ 109))
(push (@ 110))
(push 'setf)
(push (car a3))
(mov (cdr a3) a2)
(push (car a2))
(mov '3 a4)
(jmp list)
110
(eval ())
(push a1)
(mov '1 a4)
(jmp list)
109
(eval ())
(push a1)
(mov '2 a4)
(jmp nconc)
108
(eval ())
(mov a1 a3)
(bra 107)
106
(mov (& 3) a3)
(mov 'errwna a2)
(mov 'setf a1)
(jcall error)
(mov a1 a3)
107
(mov a3 (& 1))
(pop a4)
(mov a4 (& 1))
(bra 104)
105
(mov (& 0) a1)
(adjstk '3)
(return)
101
(btnil (cdr a1) 111)
(mov (cdr a1) a3)
(push (car a1))
(push (car a3))
(bfsymb (& 1) 113)
(push (@ 115))
(push 'setq)
(push (& 3))
(push (& 3))
(mov '3 a4)
(jmp list)
115
(eval ())
(adjstk '3)
(return)
113
(mov (& 1) a1)
(jcall listp)
(btnil a1 116)
(mov (& 1) a4)
(bfsymb (car a4) 116)
(push nil)
(mov (& 2) a1)
(mov 'setf-inverse a2)
(mov (car a1) a1)
(jcall getprop)
(mov a1 (& 0))
(btnil a1 118)
(push a1)
(push (@ 120))
(mov (& 4) a4)
(push (cdr a4))
(push (@ 121))
(push (& 5))
(mov '1 a4)
(jmp list)
121
(eval ())
(push a1)
(mov '2 a4)
(jmp append)
120
(eval ())
(mov a1 a2)
(pop a1)
(adjstk '4)
(jmp cons)
118
(mov (& 2) a1)
(jcall get-setf-method)
(mov (cdr a1) a4)
(mov (car a1) a1)
(mov (cdr a4) a3)
(mov (car a4) a4)
(push a4)
(mov (cdr a3) a2)
(mov (car a3) a3)
(push a3)
(push (cdr a2))
(mov (car a2) a2)
(push a2)
(mov (& 1) a4)
(mov (car a4) (& 1))
(btnil a1 122)
(push (@ 124))
(push 'let*)
(push (& 5))
(push a1)
(push nil)
125
(bfcons (& 1) 126)
(bfcons (& 2) 126)
(push (@ 127))
(mov (& 2) a4)
(mov (cdr a4) (& 2))
(push (car a4))
(mov (& 4) a4)
(mov (cdr a4) (& 4))
(push (car a4))
(mov '2 a4)
(jmp list)
127
(eval ())
(mov (& 0) a2)
(jcall cons)
(mov a1 (& 0))
(bra 125)
126
(mov (& 0) a1)
(jcall nreverse)
(adjstk '3)
(push a1)
(push (@ 128))
(push 'let)
(push (@ 129))
(push (@ 130))
(push (& 9))
(push (@ 131))
(push (& 14))
(mov '1 a4)
(jmp list)
131
(eval ())
(push a1)
(mov '2 a4)
(jmp append)
130
(eval ())
(push a1)
(mov '1 a4)
(jmp list)
129
(eval ())
(push a1)
(push (& 6))
(mov '3 a4)
(jmp list)
128
(eval ())
(push a1)
(mov '3 a4)
(jmp list)
124
(eval ())
(adjstk '8)
(return)
122
(btnil a3 132)
(push (@ 134))
(push 'let)
(push (@ 135))
(push (@ 136))
(push a3)
(push (@ 137))
(push (& 11))
(mov '1 a4)
(jmp list)
137
(eval ())
(push a1)
(mov '2 a4)
(jmp append)
136
(eval ())
(push a1)
(mov '1 a4)
(jmp list)
135
(eval ())
(push a1)
(push (& 3))
(mov '3 a4)
(jmp list)
134
(eval ())
(adjstk '8)
(return)
132
(mov a2 a1)
(adjstk '8)
(return)
116
(mov (& 1) a3)
(mov 'errbpa a2)
(mov 'setf a1)
(adjstk '3)
(jmp error)
111
(mov a1 a3)
(mov 'errwna a2)
(mov 'setf a1)
(adjstk '1)
(jmp error)
))
(loader'((fentry defsetf dmsubr)
(entry defsetf dmsubr)
(mov (cdr a1) a4)
(mov (car a1) a1)
(push a1)
(push a4)
(btsymb a1 101)
(mov a1 a3)
(mov 'errnaa a2)
(mov 'defsetf a1)
(adjstk '2)
(jmp error)
101
(mov (car a4) a1)
(jcall listp)
(btnil a1 103)
(mov (& 0) a1)
(mov (cdr a1) a1)
(mov (car a1) a1)
(jcall listp)
(bfnil a1 106)
(mov (& 0) a3)
(mov (cdr a3) a3)
(mov (car a3) a3)
(mov 'errbpa a2)
(mov 'defsetf a1)
(jcall error)
106
(push (@ 107))
(push 'push-setf-expander)
(push (@ 108))
(push 'quote)
(push (& 5))
(mov '2 a4)
(jmp list)
108
(eval ())
(push a1)
(push (@ 109))
(push 'lambda)
(push (@ 110))
(mov (& 6) a4)
(mov (cdr a4) a4)
(push (car a4))
(mov (& 7) a4)
(push (car a4))
(mov '2 a4)
(jmp append)
110
(eval ())
(push a1)
(mov (& 6) a4)
(mov (cdr a4) a4)
(push (cdr a4))
(mov '3 a4)
(jmp mcons)
109
(eval ())
(push a1)
(mov '3 a4)
(jmp list)
107
(eval ())
(adjstk '2)
(return)
103
(mov (& 0) a4)
(bfsymb (car a4) 111)
(push (@ 113))
(push 'push-setf-inverse)
(push (@ 114))
(push 'quote)
(push (& 5))
(mov '2 a4)
(jmp list)
114
(eval ())
(push a1)
(push (@ 115))
(push 'quote)
(mov (& 5) a4)
(push (car a4))
(mov '2 a4)
(jmp list)
115
(eval ())
(push a1)
(mov '3 a4)
(jmp list)
113
(eval ())
(adjstk '2)
(return)
111
(mov (car a4) a3)
(mov 'errbal a2)
(mov 'defsetf a1)
(adjstk '2)
(jmp error)
))
(loader'((fentry define-modify-macro dmsubr)
(entry define-modify-macro dmsubr)
(mov (cdr a1) a4)
(mov (car a1) a1)
(mov (cdr a4) a3)
(mov (car a4) a4)
(push a4)
(mov (car a3) a3)
(push a3)
(push (@ 101))
(push 'defmacro)
(push a1)
(mov a4 a2)
(mov 'ref a1)
(jcall cons)
(push a1)
(push (@ 102))
(push 'cond)
(push (@ 103))
(push '(symbolp ref))
(push (@ 104))
(push 'list)
(push ''setq)
(push 'ref)
(push (@ 105))
(push '#:setf:make-call)
(push (@ 106))
(push 'quote)
(push (& 16))
(mov '2 a4)
(jmp list)
106
(eval ())
(push a1)
(push 'ref)
(push (& 17))
(mov '4 a4)
(jmp mcons)
105
(eval ())
(push a1)
(mov '4 a4)
(jmp list)
104
(eval ())
(push a1)
(mov '2 a4)
(jmp list)
103
(eval ())
(push a1)
(push (@ 107))
(push '(consp ref))
(push (@ 108))
(jcall gensym)
(push a1)
(jcall gensym)
(push a1)
(jcall gensym)
(push a1)
(jcall gensym)
(push a1)
(jcall gensym)
(push a1)
(mov '5 a4)
(jmp list)
108
(eval ())
(push a1)
(push (@ 109))
(push 'let)
(push (@ 110))
(mov '((get-setf-method ref)) a2)
(jcall cons)
(push a1)
(mov '1 a4)
(jmp list)
110
(eval ())
(push a1)
(push (@ 111))
(push 'list)
(push ''let*)
(push (@ 112))
(push 'mapcar)
(push '(function (lambda (x y) (list x y))))
(mov (& 9) a4)
(push (car a4))
(mov (cdr a4) a4)
(push (car a4))
(mov '4 a4)
(jmp list)
112
(eval ())
(push a1)
(push (@ 113))
(push 'list)
(push ''let)
(push (@ 114))
(push 'list)
(push (@ 115))
(push 'list)
(push (@ 116))
(push 'car)
(mov (& 16) a4)
(mov (cdr a4) a4)
(mov (cdr a4) a4)
(push (car a4))
(mov '2 a4)
(jmp list)
116
(eval ())
(push a1)
(push (@ 117))
(push '#:setf:make-call)
(push (@ 118))
(push 'quote)
(push (& 29))
(mov '2 a4)
(jmp list)
118
(eval ())
(push a1)
(mov (& 18) a2)
(mov '4 a1)
(jcall nth)
(push a1)
(push (& 30))
(mov '4 a4)
(jmp mcons)
117
(eval ())
(push a1)
(mov '3 a4)
(jmp list)
115
(eval ())
(push a1)
(mov '2 a4)
(jmp list)
114
(eval ())
(push a1)
(mov (& 11) a2)
(mov '3 a1)
(jcall nth)
(push a1)
(mov '4 a4)
(jmp list)
113
(eval ())
(push a1)
(mov '4 a4)
(jmp list)
111
(eval ())
(push a1)
(mov '3 a4)
(jmp list)
109
(eval ())
(adjstk '1)
(push a1)
(mov '2 a4)
(jmp list)
107
(eval ())
(push a1)
(push '((t (error 'define-modify-macro 'errbpa ref))))
(mov '4 a4)
(jmp mcons)
102
(eval ())
(push a1)
(mov '4 a4)
(jmp list)
101
(eval ())
(adjstk '2)
(return)
))
(loader'((fentry #:setf:make-call nsubr)
(entry #:setf:make-call nsubr)
(cnbge a4 '2 0)
(mov '#:setf:make-call a1)
(mov '2 a2)
(jmp #:llcp:errwna)
0
(diff '2 a4)
(jcall #:llcp:nlist)
(push (@ 101))
(push (& 2))
(push (& 2))
(push a1)
(mov '3 a4)
(jmp mcons)
101
(eval ())
(adjstk '2)
(return)
))
(putprop 'car (function (lambda (list) (let ((plist (gensym)) (new-val (gensym))) (list (list plist) (list list) (list new-val) (list 'progn (list 'rplaca plist new-val) new-val) (list 'car plist))))) 'setf-method)
'car
'car
(putprop 'cdr (lambda (new-val list) (list 'progn (list 'rplacd list new-val) new-val)) 'setf-expander)
'cdr
(putprop 'caar (lambda (new-val list) (list 'progn (list 'rplaca (list 'car list) new-val) new-val)) 'setf-expander)
'caar
(putprop 'cadr (lambda (new-val list) (list 'progn (list 'rplaca (list 'cdr list) new-val) new-val)) 'setf-expander)
'cadr
(putprop 'cdar (lambda (new-val list) (list 'progn (list 'rplacd (list 'car list) new-val) new-val)) 'setf-expander)
'cdar
(putprop 'cddr (lambda (new-val list) (list 'progn (list 'rplacd (list 'cdr list) new-val) new-val)) 'setf-expander)
'cddr
(putprop 'get (lambda (new-val symbol indicator) (list 'putprop symbol new-val indicator)) 'setf-expander)
'get
(putprop 'getprop (lambda (new-val symbol indicator) (list 'putprop symbol new-val indicator)) 'setf-expander)
'getprop
(putprop 'vref 'vset 'setf-inverse)
'vref
(putprop 'nth (function (lambda (index list) (let ((pindex (gensym)) (plist (gensym)) (new-val (gensym))) (list (list pindex plist) (list index list) (list new-val) (list 'progn (list 'rplaca (list 'nthcdr pindex plist) new-val) new-val) (list 'nth pindex plist))))) 'setf-method)
'nth
'nth
(putprop 'dynamic 'setq 'setf-inverse)
'dynamic
(loader'((entry macro-function subr1)
(push a1)
(jcall symbolp)
(btnil a1 101)
(mov (& 0) a1)
(jcall typefn)
(mov '(dmacro dmsubr macro msubr) a2)
(jcall memq)
(btnil a1 101)
(mov (& 0) a1)
(jcall valfn)
(mov a1 a2)
(mov 'lambda a1)
(adjstk '1)
(jmp cons)
101
(adjstk '1)
(return)
))
(putprop 'valfn (lambda (new-val symb) (list 'progn (list 'setfn symb ''expr new-val) new-val)) 'setf-expander)
'valfn
(putprop 'plist (lambda (new-val symb) (list 'progn (list 'plist symb new-val) new-val)) 'setf-expander)
'plist
(loader '((end)))