Trailing-Edge
-
PDP-10 Archives
-
clisp
-
clisp/flavors/upsala/kkernel.lap
There are no other files named kkernel.lap in the archive.
;;; CLC v1.5 compiling SS:<VICTOR.FLAVORS>KKERNEL.CLISP.1
(in-package "SYSTEM")
(export (quote (send alloc-instance get-self %instance-ref instance-ref slot-unbound-p instance-descriptor instancep pointer-to-fixnum)))
#_(lap #0_pointer-to-fixnum macro
(entry-points (2-few 1 2-many 2-many 2-many 2-many 2-many))
#0_(2 "Macro ~S cannot be called with ~S args." pointer-to-fixnum %cl-pointer-to-fixnum)
(code-start)
(label 1) (adjsp q 5)
(movem o1 -4 q)
(move o1 -4 q)
(call length 1)
(movem o1 -3 q)
(move o2 (constant 0))
(move o1 -3 q)
(call = 2)
(jumpn o1 4)
(move o1 -4 q)
(call length 1)
(call 1- 1)
(move o3 o1)
(move o1 (constant 1))
(move o2 (constant 2))
(call error 3)
(jrst 3)
(label 4) (move o1 -4 q)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -3 q)
(move o2 -3 q)
(move o1 (constant 3))
(call list 2)
(label 3) (adjsp q -5)
(popj p)
)
(%put (quote pointer-to-fixnum) (quote lisp::%args-documentation) (quote (lisp::**macroarg**)))
(%put (quote pointer-to-fixnum) (quote lisp::%source-documentation) (quote "SS:<VICTOR.FLAVORS>KKERNEL.CLISP.1"))
(remprop (quote %instance-ref) (quote lisp::setf-inverse))
(%put (quote %instance-ref) (quote lisp::setf-method-expander) (function (lambda (lisp::access-form) (do* ((lisp::args (cdr lisp::access-form) (cdr lisp::args)) (lisp::dummies nil (cons (gensym) lisp::dummies)) (lisp::newval-var (gensym)) (lisp::new-access-form nil)) ((atom lisp::args) (setq lisp::new-access-form (cons (car lisp::access-form) lisp::dummies)) (values lisp::dummies (cdr lisp::access-form) (list lisp::newval-var) (funcall (function (lambda (lisp::%access-arglist new) (let* ((instance (car (cdr lisp::%access-arglist))) (slot (car (cdr (cdr lisp::%access-arglist))))) (list (quote setf) (list (quote aref) (list (quote %instance-vector) (list (quote get-self) instance)) slot) new)))) lisp::new-access-form lisp::newval-var) lisp::new-access-form))))))
(remprop (quote %instance-ref) (quote lisp::%setf-documentation))
(quote %instance-ref)
(remprop (quote instance-ref) (quote lisp::setf-inverse))
(%put (quote instance-ref) (quote lisp::setf-method-expander) (function (lambda (lisp::access-form) (do* ((lisp::args (cdr lisp::access-form) (cdr lisp::args)) (lisp::dummies nil (cons (gensym) lisp::dummies)) (lisp::newval-var (gensym)) (lisp::new-access-form nil)) ((atom lisp::args) (setq lisp::new-access-form (cons (car lisp::access-form) lisp::dummies)) (values lisp::dummies (cdr lisp::access-form) (list lisp::newval-var) (funcall (function (lambda (lisp::%access-arglist new) (let* ((instance (car (cdr lisp::%access-arglist))) (slot (car (cdr (cdr lisp::%access-arglist))))) (list (quote setf) (list (quote aref) (list (quote %instance-vector) (list (quote get-self) instance)) (list (quote 1+) slot)) new)))) lisp::new-access-form lisp::newval-var) lisp::new-access-form))))))
(remprop (quote instance-ref) (quote lisp::%setf-documentation))
(quote instance-ref)
#_(lap #0_internal-make-instance expr
(entry-points (2-few 1 2-many 2-many 2-many 2-many 2-many))
#0_(2 -2 1 0 %instance)
(code-start)
(label 1) (adjsp q 7)
(movem o1 -6 q)
(move o1 (constant 0))
(call make-array 1)
(movem o1 -4 q)
(move o3 (constant 2))
(move o1 -4 q)
(move o2 (constant 1))
(call lisp::%sp-svset 3)
(move o3 (constant 4))
(move o1 -4 q)
(move o2 (constant 3))
(call lisp::%sp-svset 3)
(move o6 -4 q)
(movem o6 -5 q)
(move o3 -6 q)
(move o1 -5 q)
(move o2 (constant 2))
(call lisp::%sp-svset 3)
(move o1 -5 q)
(movei n 1)
(adjsp q -7)
(popj p)
)
(%put (quote internal-make-instance) (quote lisp::%args-documentation) (quote (vector)))
(%put (quote internal-make-instance) (quote lisp::%source-documentation) (quote "SS:<VICTOR.FLAVORS>KKERNEL.CLISP.1"))
#_(lap #0_%instance-vector expr
(entry-points (2-few 1 2-many 2-many 2-many 2-many 2-many))
#0_(1)
(code-start)
(label 1) (adjsp q 4)
(movem o1 -3 q)
(move o2 (constant 0))
(move o1 -3 q)
(call lisp::%sp-svref 2)
(adjsp q -4)
(popj p)
)
(%put (quote %instance-vector) (quote lisp::%args-documentation) (quote (lisp::object)))
(%put (quote %instance-vector) (quote lisp::%source-documentation) (quote "SS:<VICTOR.FLAVORS>KKERNEL.CLISP.1"))
(setf (symbol-function (quote copy-%instance)) (function lisp::built-in-copier))
#_(lap #0_instancep expr
(entry-points (2-few 1 2-many 2-many 2-many 2-many 2-many))
#0_(-2 1 0 %instance lisp::included-structure)
(code-start)
(label 1) (adjsp q 5)
(movem o1 -4 q)
(move o1 -4 q)
(call simple-vector-p 1)
(jumpe o1 3)
(move o1 -4 q)
(call stringp 1)
(jumpn o1 3)
(move o2 (constant 0))
(move o1 -4 q)
(call lisp::%sp-svref 2)
(movem o1 -3 q)
(move o2 (constant 1))
(move o1 -3 q)
(call = 2)
(jumpe o1 3)
(move o2 (constant 2))
(move o1 -4 q)
(call lisp::%sp-svref 2)
(movem o1 -3 q)
(move o2 (constant 3))
(move o1 -3 q)
(call eq 2)
(jumpn o1 5)
(move o2 (constant 4))
(move o1 -3 q)
(call get 2)
(movem o1 -2 q)
(move o2 (constant 3))
(move o1 -2 q)
(call eq 2)
(label 5) (jrst 4)
(label 3) (move o1 nil)
(movei n 1)
(label 4) (adjsp q -5)
(popj p)
)
(%put (quote instancep) (quote lisp::%args-documentation) (quote (lisp::thing)))
(%put (quote instancep) (quote lisp::%source-documentation) (quote "SS:<VICTOR.FLAVORS>KKERNEL.CLISP.1"))
(remprop (quote %instance-vector) (quote lisp::setf-inverse))
(%put (quote %instance-vector) (quote lisp::setf-method-expander) (function (lambda (lisp::access-form) (do* ((lisp::args (cdr lisp::access-form) (cdr lisp::args)) (lisp::dummies nil (cons (gensym) lisp::dummies)) (lisp::newval-var (gensym)) (lisp::new-access-form nil)) ((atom lisp::args) (setq lisp::new-access-form (cons (car lisp::access-form) lisp::dummies)) (values lisp::dummies (cdr lisp::access-form) (list lisp::newval-var) (funcall (function (lambda (lisp::%access-arglist lisp::new-value) (let* ((structure (car (cdr lisp::%access-arglist)))) (lisp::setelt-form structure 1 lisp::new-value (quote vector))))) lisp::new-access-form lisp::newval-var) lisp::new-access-form))))))
(remprop (quote %instance-vector) (quote lisp::%setf-documentation))
(quote %instance-vector)
(%put (quote %instance) (quote lisp::structure-print) (quote internal-print-instance))
(%put (quote %instance) (quote lisp::defstruct-description) (quote (%instance vector ((:print-function internal-print-instance) (:constructor internal-make-instance (vector)) (:predicate instancep)) 2 %instance- (internal-make-instance (vector)) (%instance-vector) (vector) (nil) (nil) ((%instance-vector . 1)) nil ((:vector . 1)))))
(quote %instance)
#_(lap #0_internal-print-instance expr
(entry-points (2-few 2-few 2-few 1 2-many 2-many 2-many))
#0_(print)
(code-start)
(label 1) (adjsp q 8)
(movem o1 -7 q)
(movem o2 -6 q)
(movem o3 -5 q)
(move o4 -5 q)
(move o1 -7 q)
(move o2 (constant 0))
(move o3 -6 q)
(call system:send 4)
(adjsp q -8)
(popj p)
)
(%put (quote internal-print-instance) (quote lisp::%args-documentation) (quote (instance stream depth)))
(%put (quote internal-print-instance) (quote lisp::%source-documentation) (quote "SS:<VICTOR.FLAVORS>KKERNEL.CLISP.1"))
(%put (quote alloc-instance) (quote lisp::%fun-documentation) (quote "Allocates a new instance."))
#_(lap #0_alloc-instance macro
(entry-points (2-few 1 2-many 2-many 2-many 2-many 2-many))
#0_(4 3 "Macro ~S cannot be called with ~S args." alloc-instance (quote unbound) let array make-array 1+ :initial-element setf (aref array 0) ((internal-make-instance array)))
(code-start)
(label 1) (adjsp q 11)
(movem o1 -10 q)
(move o1 -10 q)
(call length 1)
(movem o1 -9 q)
(move o2 (constant 0))
(move o1 -9 q)
(call > 2)
(jumpn1 o1 5)
(move o1 -10 q)
(call length 1)
(movem o1 -9 q)
(move o2 (constant 1))
(move o1 -9 q)
(call < 2)
(skipn nil o1)
(label 5) (jrst 4)
(move o1 -10 q)
(call length 1)
(call 1- 1)
(move o3 o1)
(move o1 (constant 2))
(move o2 (constant 3))
(call error 3)
(jrst 3)
(label 4) (move o1 -10 q)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -9 q)
(move o1 -10 q)
(move o1 1 o1)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -8 q)
(move o1 -10 q)
(move o1 1 o1)
(move o1 1 o1)
(move o1 1 o1)
(jumpe o1 8)
(move o1 -10 q)
(move o1 1 o1)
(move o1 1 o1)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -7 q)
(jrst 7)
(label 8) (move o6 (constant 4))
(movem o6 -7 q)
(label 7) (move o2 -9 q)
(move o1 (constant 8))
(call list 2)
(movem o1 -3 q)
(move o4 -7 q)
(move o1 (constant 7))
(move o2 -3 q)
(move o3 (constant 9))
(call list 4)
(move o2 o1)
(move o1 (constant 6))
(call list 2)
(call list 1)
(movem o1 -5 q)
(move o3 -8 q)
(move o1 (constant 10))
(move o2 (constant 11))
(call list 3)
(movem o1 -4 q)
(move o4 (constant 12))
(move o1 (constant 5))
(move o2 -5 q)
(move o3 -4 q)
(call list* 4)
(label 3) (adjsp q -11)
(popj p)
)
(%put (quote alloc-instance) (quote lisp::%args-documentation) (quote (lisp::**macroarg**)))
(%put (quote alloc-instance) (quote lisp::%source-documentation) (quote "SS:<VICTOR.FLAVORS>KKERNEL.CLISP.1"))
(%put (quote %instance-ref) (quote lisp::%fun-documentation) (quote "Doesn't follow 'forwarding pointers'."))
#_(lap #0_%instance-ref macro
(entry-points (2-few 1 2-many 2-many 2-many 2-many 2-many))
#0_(3 "Macro ~S cannot be called with ~S args." %instance-ref aref %instance-vector)
(code-start)
(label 1) (adjsp q 7)
(movem o1 -6 q)
(move o1 -6 q)
(call length 1)
(movem o1 -5 q)
(move o2 (constant 0))
(move o1 -5 q)
(call = 2)
(jumpn o1 4)
(move o1 -6 q)
(call length 1)
(call 1- 1)
(move o3 o1)
(move o1 (constant 1))
(move o2 (constant 2))
(call error 3)
(jrst 3)
(label 4) (move o1 -6 q)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -5 q)
(move o1 -6 q)
(move o1 1 o1)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -4 q)
(move o2 -5 q)
(move o1 (constant 4))
(call list 2)
(movem o1 -2 q)
(move o3 -4 q)
(move o1 (constant 3))
(move o2 -2 q)
(call list 3)
(label 3) (adjsp q -7)
(popj p)
)
(%put (quote %instance-ref) (quote lisp::%args-documentation) (quote (lisp::**macroarg**)))
(%put (quote %instance-ref) (quote lisp::%source-documentation) (quote "SS:<VICTOR.FLAVORS>KKERNEL.CLISP.1"))
(%put (quote instance-ref) (quote lisp::%fun-documentation) (quote "Follows 'forwarding pointers'."))
#_(lap #0_instance-ref macro
(entry-points (2-few 1 2-many 2-many 2-many 2-many 2-many))
#0_(3 "Macro ~S cannot be called with ~S args." instance-ref aref %instance-vector get-self 1+)
(code-start)
(label 1) (adjsp q 8)
(movem o1 -7 q)
(move o1 -7 q)
(call length 1)
(movem o1 -6 q)
(move o2 (constant 0))
(move o1 -6 q)
(call = 2)
(jumpn o1 4)
(move o1 -7 q)
(call length 1)
(call 1- 1)
(move o3 o1)
(move o1 (constant 1))
(move o2 (constant 2))
(call error 3)
(jrst 3)
(label 4) (move o1 -7 q)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -6 q)
(move o1 -7 q)
(move o1 1 o1)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -5 q)
(move o2 -6 q)
(move o1 (constant 5))
(call list 2)
(move o2 o1)
(move o1 (constant 4))
(call list 2)
(movem o1 -3 q)
(move o2 -5 q)
(move o1 (constant 6))
(call list 2)
(move o3 o1)
(move o1 (constant 3))
(move o2 -3 q)
(call list 3)
(label 3) (adjsp q -8)
(popj p)
)
(%put (quote instance-ref) (quote lisp::%args-documentation) (quote (lisp::**macroarg**)))
(%put (quote instance-ref) (quote lisp::%source-documentation) (quote "SS:<VICTOR.FLAVORS>KKERNEL.CLISP.1"))
(%put (quote get-self) (quote lisp::%fun-documentation) (quote "Follows 'forwarding pointers' to get the REAL instance."))
#_(lap #0_get-self macro
(entry-points (2-few 1 2-many 2-many 2-many 2-many 2-many))
#0_(2 "Macro ~S cannot be called with ~S args." get-self let* self ((loop (let ((new (%instance-ref self 0))) (if (instancep new) (setq self new) (return self))))))
(code-start)
(label 1) (adjsp q 6)
(movem o1 -5 q)
(move o1 -5 q)
(call length 1)
(movem o1 -4 q)
(move o2 (constant 0))
(move o1 -4 q)
(call = 2)
(jumpn o1 4)
(move o1 -5 q)
(call length 1)
(call 1- 1)
(move o3 o1)
(move o1 (constant 1))
(move o2 (constant 2))
(call error 3)
(jrst 3)
(label 4) (move o1 -5 q)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -4 q)
(move o2 -4 q)
(move o1 (constant 4))
(call list 2)
(call list 1)
(movem o1 -2 q)
(move o3 (constant 5))
(move o1 (constant 3))
(move o2 -2 q)
(call list* 3)
(label 3) (adjsp q -6)
(popj p)
)
(%put (quote get-self) (quote lisp::%args-documentation) (quote (lisp::**macroarg**)))
(%put (quote get-self) (quote lisp::%source-documentation) (quote "SS:<VICTOR.FLAVORS>KKERNEL.CLISP.1"))
(%put (quote instance-descriptor) (quote lisp::%fun-documentation) (quote "Follows 'forwarding pointers'."))
#_(lap #0_instance-descriptor macro
(entry-points (2-few 1 2-many 2-many 2-many 2-many 2-many))
#0_(2 "Macro ~S cannot be called with ~S args." instance-descriptor %instance-ref get-self (0))
(code-start)
(label 1) (adjsp q 6)
(movem o1 -5 q)
(move o1 -5 q)
(call length 1)
(movem o1 -4 q)
(move o2 (constant 0))
(move o1 -4 q)
(call = 2)
(jumpn o1 4)
(move o1 -5 q)
(call length 1)
(call 1- 1)
(move o3 o1)
(move o1 (constant 1))
(move o2 (constant 2))
(call error 3)
(jrst 3)
(label 4) (move o1 -5 q)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -4 q)
(move o2 -4 q)
(move o1 (constant 4))
(call list 2)
(movem o1 -2 q)
(move o3 (constant 5))
(move o1 (constant 3))
(move o2 -2 q)
(call list* 3)
(label 3) (adjsp q -6)
(popj p)
)
(%put (quote instance-descriptor) (quote lisp::%args-documentation) (quote (lisp::**macroarg**)))
(%put (quote instance-descriptor) (quote lisp::%source-documentation) (quote "SS:<VICTOR.FLAVORS>KKERNEL.CLISP.1"))
(%put (quote slot-unbound-p) (quote lisp::%fun-documentation) (quote "Follows 'forwarding pointers'."))
#_(lap #0_slot-unbound-p macro
(entry-points (2-few 1 2-many 2-many 2-many 2-many 2-many))
#0_(3 "Macro ~S cannot be called with ~S args." slot-unbound-p let thing instance-ref ((eq (quote unbound) thing)))
(code-start)
(label 1) (adjsp q 9)
(movem o1 -8 q)
(move o1 -8 q)
(call length 1)
(movem o1 -7 q)
(move o2 (constant 0))
(move o1 -7 q)
(call = 2)
(jumpn o1 4)
(move o1 -8 q)
(call length 1)
(call 1- 1)
(move o3 o1)
(move o1 (constant 1))
(move o2 (constant 2))
(call error 3)
(jrst 3)
(label 4) (move o1 -8 q)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -7 q)
(move o1 -8 q)
(move o1 1 o1)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -6 q)
(move o3 -6 q)
(move o1 (constant 5))
(move o2 -7 q)
(call list 3)
(move o2 o1)
(move o1 (constant 4))
(call list 2)
(call list 1)
(movem o1 -4 q)
(move o3 (constant 6))
(move o1 (constant 3))
(move o2 -4 q)
(call list* 3)
(label 3) (adjsp q -9)
(popj p)
)
(%put (quote slot-unbound-p) (quote lisp::%args-documentation) (quote (lisp::**macroarg**)))
(%put (quote slot-unbound-p) (quote lisp::%source-documentation) (quote "SS:<VICTOR.FLAVORS>KKERNEL.CLISP.1"))
#_(lap #0_send expr
(entry-points (2-few 2-few 2 3 4 5 6) rest)
#0_(0)
(code-start)
(label 2) (move o3 nil)
(jrst 1)
(label 3) (movei w2 1)
(icall rest3)
(jrst 1)
(label 4) (movei w2 2)
(icall rest4)
(jrst 1)
(label 5) (movei w2 3)
(icall rest5)
(jrst 1)
(label 6) (movei w2 2)
(icall restx)
(label 1) (adjsp q 11)
(movem o1 -10 q)
(movem o2 -9 q)
(movem o3 -8 q)
(move o6 -10 q)
(movem o6 -6 q)
(label 12) (move o1 -6 q)
(call system::%instance-vector 1)
(movem o1 -4 q)
(move o2 (constant 0))
(move o1 -4 q)
(call aref 2)
(movem o1 -5 q)
(move o1 -5 q)
(call system:instancep 1)
(jumpe o1 13)
(move o6 -5 q)
(movem o6 -6 q)
(jrst 14)
(label 13) (move o6 -6 q)
(movem o6 -7 q)
(jrst 8)
(label 14) (jrst 12)
(label 8) (move o1 -7 q)
(call system::%instance-vector 1)
(movem o1 -5 q)
(move o2 (constant 0))
(move o1 -5 q)
(call aref 2)
(movem o1 -6 q)
(move o2 (constant 0))
(move o1 -6 q)
(call aref 2)
(movem o1 -5 q)
(move o4 -8 q)
(move o1 -5 q)
(move o2 -10 q)
(move o3 -9 q)
(call apply 4)
(adjsp q -11)
(popj p)
)
(%put (quote send) (quote lisp::%args-documentation) (quote (instance message &rest args)))
(%put (quote send) (quote lisp::%source-documentation) (quote "SS:<VICTOR.FLAVORS>KKERNEL.CLISP.1"))