Trailing-Edge
-
PDP-10 Archives
-
clisp
-
clisp/flavors/upsala/symmac.lap
There are no other files named symmac.lap in the archive.
;;; CLC v1.5 compiling SS:<VICTOR.FLAVORS>SYMMAC.CLISP.1
(in-package (quote user::lisp))
(export (quote (symbol-macro-let)))
(%put (quote *symbol-macro-environment*) (quote globally-special) t)
(or (boundp (quote *symbol-macro-environment*)) (setq *symbol-macro-environment* nil))
(%put (quote *symbol-macro-environment*) (quote %var-documentation) (quote "Used to pass the expansion environment to the transforms."))
(quote *symbol-macro-environment*)
(%put (quote *symbol-macro-replacements*) (quote globally-special) t)
(or (boundp (quote *symbol-macro-replacements*)) (setq *symbol-macro-replacements* nil))
(%put (quote *symbol-macro-replacements*) (quote %var-documentation) (quote "Holds symbol-macro-let replacements during macroexpansion."))
(quote *symbol-macro-replacements*)
#_(lap #0_symbol-replaced-p expr
(entry-points (2-few 1 2-many 2-many 2-many 2-many 2-many))
#0_(*symbol-macro-replacements*)
(code-start)
(label 1) (adjsp q 4)
(movem o1 -3 q)
(move o2 (special 0))
(move o1 -3 q)
(call assoc 2)
(adjsp q -4)
(popj p)
)
(%put (quote symbol-replaced-p) (quote %args-documentation) (quote (symbol)))
(%put (quote symbol-replaced-p) (quote %source-documentation) (quote "SS:<VICTOR.FLAVORS>SYMMAC.CLISP.1"))
#_(lap #0_symbol-replacement expr
(entry-points (2-few 1 2-many 2-many 2-many 2-many 2-many))
#0_NIL
(code-start)
(label 1) (adjsp q 2)
(movem o1 -1 q)
(move o1 -1 q)
(move o1 1 o1)
(movei n 1)
(adjsp q -2)
(popj p)
)
(%put (quote symbol-replacement) (quote %args-documentation) (quote (replaced-p)))
(%put (quote symbol-replacement) (quote %source-documentation) (quote "SS:<VICTOR.FLAVORS>SYMMAC.CLISP.1"))
#_(lap #0_bind-symbol-macro expr
(entry-points (2-few 2-few 1 2-many 2-many 2-many 2-many))
#0_(*symbol-macro-replacements*)
(code-start)
(label 1) (adjsp q 5)
(movem o1 -4 q)
(movem o2 -3 q)
(move o2 -3 q)
(move o1 -4 q)
(call cons 2)
(movem o1 -2 q)
(move o2 (special 0))
(move o1 -2 q)
(call cons 2)
(movem o1 (special 0))
(move o1 (special 0))
(movei n 1)
(adjsp q -5)
(popj p)
)
(%put (quote bind-symbol-macro) (quote %args-documentation) (quote (symbol expansion)))
(%put (quote bind-symbol-macro) (quote %source-documentation) (quote "SS:<VICTOR.FLAVORS>SYMMAC.CLISP.1"))
#_(lap #0_bind-non-macros 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." bind-non-macros let *symbol-macro-replacements* remove-if function lambda (x) member x (*symbol-macro-replacements* :key (function car)))
(code-start)
(label 1) (adjsp q 13)
(movem o1 -12 q)
(move o1 -12 q)
(call length 1)
(movem o1 -11 q)
(move o2 (constant 0))
(move o1 -11 q)
(call < 2)
(jumpe o1 4)
(move o1 -12 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 -12 q)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -11 q)
(move o1 -12 q)
(move o1 1 o1)
(move o1 1 o1)
(movem o1 -10 q)
(move o3 -11 q)
(move o1 (constant 9))
(move o2 (constant 10))
(call list 3)
(move o3 o1)
(move o1 (constant 7))
(move o2 (constant 8))
(call list 3)
(move o2 o1)
(move o1 (constant 6))
(call list 2)
(movem o1 -6 q)
(move o3 (constant 11))
(move o1 (constant 5))
(move o2 -6 q)
(call list* 3)
(move o2 o1)
(move o1 (constant 4))
(call list 2)
(call list 1)
(movem o1 -8 q)
(move o3 -10 q)
(move o1 (constant 3))
(move o2 -8 q)
(call list* 3)
(label 3) (adjsp q -13)
(popj p)
)
(%put (quote bind-non-macros) (quote %args-documentation) (quote (**macroarg**)))
(%put (quote bind-non-macros) (quote %source-documentation) (quote "SS:<VICTOR.FLAVORS>SYMMAC.CLISP.1"))
#_(lap #0_bind-non-macro 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." bind-non-macro let *symbol-macro-replacements* remove (*symbol-macro-replacements* :key (function car)))
(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)
(jumpe 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)
(movem o1 -6 q)
(move o3 (constant 6))
(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 -6 q)
(move o1 (constant 3))
(move o2 -4 q)
(call list* 3)
(label 3) (adjsp q -9)
(popj p)
)
(%put (quote bind-non-macro) (quote %args-documentation) (quote (**macroarg**)))
(%put (quote bind-non-macro) (quote %source-documentation) (quote "SS:<VICTOR.FLAVORS>SYMMAC.CLISP.1"))
#_(lap #0_symbol-macro-let 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." symbol-macro-let *symbol-macro-replacements* progn)
(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)
(jumpe o1 4)
(move o1 -10 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 -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)
(movem o1 -8 q)
(move o6 (special 3))
(movem o6 -7 q)
(move o1 -7 q)
(spec-bind (special 3))
(movem o1 (special 3))
(move o6 -9 q)
(movem o6 -6 q)
(move o1 -6 q)
(move o1 0 o1)
(movem o1 -5 q)
(label 10) (move o1 -6 q)
(call atom 1)
(jumpe o1 11)
(jrst 6)
(label 11) (move o1 -5 q)
(move o1 0 o1)
(movem o1 -4 q)
(move o1 -5 q)
(move o1 1 o1)
(move o1 0 o1)
(move o2 o1)
(move o1 -4 q)
(call lisp::bind-symbol-macro 2)
(move o1 -6 q)
(move o1 1 o1)
(movem o1 -6 q)
(move o1 -6 q)
(move o1 0 o1)
(movem o1 -5 q)
(jrst 10)
(label 6) (move o1 nil)
(call list 1)
(movem o1 -5 q)
(move o6 -5 q)
(movem o6 -4 q)
(move o6 -8 q)
(movem o6 -3 q)
(label 17) (skipe nil -3 q)
(jrst 18)
(move o1 -5 q)
(move o1 1 o1)
(move o2 o1)
(jrst 13)
(label 18) (move o6 -4 q)
(movem o6 -2 q)
(move o1 -3 q)
(move o1 0 o1)
(call lisp::symmac-replace 1)
(call list 1)
(movem o1 -4 q)
(move o2 -4 q)
(move o1 -2 q)
(call rplacd 2)
(move o1 -3 q)
(move o1 1 o1)
(movem o1 -3 q)
(jrst 17)
(label 13) (move o1 (constant 4))
(call cons 2)
(unbind 1)
(label 3) (adjsp q -11)
(popj p)
)
(%put (quote symbol-macro-let) (quote %args-documentation) (quote (**macroarg**)))
(%put (quote symbol-macro-let) (quote %source-documentation) (quote "SS:<VICTOR.FLAVORS>SYMMAC.CLISP.1"))
#_(lap #0_symmac-replace expr
(entry-points (2-few 1 2-many 2-many 2-many 2-many 2-many))
#0_(lambda "Illegal function object: ~A" sym-mac-transform *symbol-macro-environment* "Symbol-macro-let internal error: untransformed special~
form ~A.")
(code-start)
(label 1) (adjsp q 11)
(movem o1 -10 q)
(movem nil -9 q)
(label 7) (move o1 -10 q)
(call symbolp 1)
(jumpe o1 10)
(move o1 -10 q)
(call lisp::symbol-replaced-p 1)
(movem o1 -9 q)
(skipn nil -9 q)
(label 10) (jrst 9)
(move o1 -9 q)
(call lisp::symbol-replacement 1)
(movem o1 -10 q)
(jrst 7)
(label 9) (move o1 -10 q)
(call atom 1)
(jumpe o1 12)
(move o1 -10 q)
(movei n 1)
(jrst 3)
(label 12) (move o1 -10 q)
(move o1 0 o1)
(call symbolp 1)
(jumpn o1 13)
(move o1 -10 q)
(move o1 0 o1)
(movem o1 -8 q)
(move o1 -10 q)
(move o1 1 o1)
(movem o1 -7 q)
(move o1 -8 q)
(call listp 1)
(jumpe1 o1 15)
(move o1 -8 q)
(move o1 0 o1)
(movem o1 -6 q)
(move o2 (constant 0))
(move o1 -6 q)
(call eq 2)
(skipe nil o1)
(label 15) (jrst 14)
(move o2 -8 q)
(move o1 (constant 1))
(call error 2)
(label 14) (move o1 -8 q)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -5 q)
(move o1 -8 q)
(move o1 1 o1)
(move o1 1 o1)
(move o2 o1)
(move o1 -5 q)
(call lisp::replace-lambda 2)
(move o2 o1)
(move o1 (constant 0))
(call cons 2)
(movem o1 -6 q)
(move o1 nil)
(call list 1)
(movem o1 -5 q)
(move o6 -5 q)
(movem o6 -4 q)
(move o6 -7 q)
(movem o6 -3 q)
(label 21) (skipe nil -3 q)
(jrst 22)
(move o1 -5 q)
(move o1 1 o1)
(move o2 o1)
(jrst 17)
(label 22) (move o6 -4 q)
(movem o6 -2 q)
(move o1 -3 q)
(move o1 0 o1)
(call lisp::symmac-replace 1)
(call list 1)
(movem o1 -4 q)
(move o2 -4 q)
(move o1 -2 q)
(call rplacd 2)
(move o1 -3 q)
(move o1 1 o1)
(movem o1 -3 q)
(jrst 21)
(label 17) (move o1 -6 q)
(call cons 2)
(jrst 3)
(label 13) (move o1 -10 q)
(move o1 0 o1)
(movem o1 -8 q)
(move o2 (constant 2))
(move o1 -8 q)
(call get 2)
(movem o1 -9 q)
(skipn nil -9 q)
(jrst 26)
(move o2 -10 q)
(move o1 -9 q)
(call funcall 2)
(jrst 3)
(label 26) (move o2 (special 3))
(move o1 -10 q)
(call macroexpand 2)
(adjust-values 2)
(movem o1 -10 q)
(movem o2 -9 q)
(skipn nil -9 q)
(jrst 27)
(jrst 7)
(label 27) (move o1 -10 q)
(move o1 0 o1)
(call special-form-p 1)
(jumpe o1 28)
(move o1 -10 q)
(move o1 0 o1)
(move o2 o1)
(move o1 (constant 4))
(call error 2)
(jrst 8)
(label 28) (move o1 -10 q)
(move o1 0 o1)
(movem o1 -8 q)
(move o1 nil)
(call list 1)
(movem o1 -7 q)
(move o6 -7 q)
(movem o6 -6 q)
(move o1 -10 q)
(move o1 1 o1)
(movem o1 -5 q)
(label 34) (skipe nil -5 q)
(jrst 35)
(move o1 -7 q)
(move o1 1 o1)
(move o2 o1)
(jrst 30)
(label 35) (move o6 -6 q)
(movem o6 -4 q)
(move o1 -5 q)
(move o1 0 o1)
(movem o1 -3 q)
(move o1 -3 q)
(call lisp::symmac-replace 1)
(call list 1)
(movem o1 -6 q)
(move o2 -6 q)
(move o1 -4 q)
(call rplacd 2)
(move o1 -5 q)
(move o1 1 o1)
(movem o1 -5 q)
(jrst 34)
(label 30) (move o1 -8 q)
(call cons 2)
(jrst 3)
(label 8) (move o1 nil)
(movei n 1)
(label 3) (adjsp q -11)
(popj p)
)
(%put (quote symmac-replace) (quote %args-documentation) (quote (form)))
(%put (quote symmac-replace) (quote %source-documentation) (quote "SS:<VICTOR.FLAVORS>SYMMAC.CLISP.1"))
#_(lap #0_replace-lambda expr
(entry-points (2-few 2-few 1 2-many 2-many 2-many 2-many))
#0_(*symbol-macro-replacements* (&optional &rest &key &allow-other-keys &aux) &optional :key car &rest &key &allow-other-keys &aux "~A in lambda-list after &allow-other-keys.")
(code-start)
(label 1) (adjsp q 13)
(movem o1 -12 q)
(movem o2 -11 q)
(move o1 (special 0))
(call copy-list 1)
(spec-bind (special 0))
(movem o1 (special 0))
(move o6 -12 q)
(movem o6 -10 q)
(move o6 (constant 1))
(movem o6 -9 q)
(movem nil -8 q)
(movem nil -7 q)
(label 7) (move o1 -10 q)
(call endp 1)
(jumpe o1 8)
(move o1 -7 q)
(call nreverse 1)
(movem o1 -6 q)
(move o1 nil)
(call list 1)
(movem o1 -5 q)
(move o6 -5 q)
(movem o6 -4 q)
(move o6 -11 q)
(movem o6 -3 q)
(label 14) (skipe nil -3 q)
(jrst 15)
(move o1 -5 q)
(move o1 1 o1)
(move o2 o1)
(jrst 10)
(label 15) (move o6 -4 q)
(movem o6 -2 q)
(move o1 -3 q)
(move o1 0 o1)
(call lisp::symmac-replace 1)
(call list 1)
(movem o1 -4 q)
(move o2 -4 q)
(move o1 -2 q)
(call rplacd 2)
(move o1 -3 q)
(move o1 1 o1)
(movem o1 -3 q)
(jrst 14)
(label 10) (move o1 -6 q)
(call cons 2)
(unbind 1)
(jrst 3)
(label 8) (move o1 -10 q)
(move o1 0 o1)
(movem o1 -6 q)
(move o2 -9 q)
(move o1 -6 q)
(call member 2)
(movem o1 -8 q)
(skipn nil -8 q)
(jrst 20)
(move o1 -8 q)
(move o1 1 o1)
(movem o1 -9 q)
(move o2 -7 q)
(move o1 -6 q)
(call cons 2)
(movem o1 -7 q)
(jrst 19)
(label 20) (move o1 -9 q)
(move o1 0 o1)
(movem o1 -5 q)
(move o2 (constant 2))
(move o1 -5 q)
(call eq 2)
(jumpe o1 23)
(move o6 (special 0))
(movem o6 -3 q)
(move o4 (constant 4))
(move o1 -6 q)
(move o2 -3 q)
(move o3 (constant 3))
(call delete 4)
(movem o1 (special 0))
(move o2 -7 q)
(move o1 -6 q)
(call cons 2)
(movem o1 -7 q)
(jrst 22)
(label 23) (move o2 (constant 5))
(move o1 -5 q)
(call eq 2)
(jumpe o1 24)
(move o1 -6 q)
(call symbolp 1)
(jumpe o1 26)
(move o6 (special 0))
(movem o6 -3 q)
(move o4 (constant 4))
(move o1 -6 q)
(move o2 -3 q)
(move o3 (constant 3))
(call delete 4)
(movem o1 (special 0))
(move o2 -7 q)
(move o1 -6 q)
(call cons 2)
(movem o1 -7 q)
(jrst 25)
(label 26) (move o1 -6 q)
(move o1 1 o1)
(jumpn o1 29)
(move o2 -7 q)
(move o1 -6 q)
(call cons 2)
(movem o1 -7 q)
(jrst 28)
(label 29) (move o1 -6 q)
(move o1 0 o1)
(movem o1 -4 q)
(move o1 -6 q)
(move o1 1 o1)
(move o1 0 o1)
(call lisp::symmac-replace 1)
(movem o1 -3 q)
(move o1 -6 q)
(move o1 1 o1)
(move o1 1 o1)
(move o3 o1)
(move o1 -4 q)
(move o2 -3 q)
(call list* 3)
(movem o1 -4 q)
(move o2 -7 q)
(move o1 -4 q)
(call cons 2)
(movem o1 -7 q)
(move o1 -6 q)
(move o1 1 o1)
(move o1 1 o1)
(jumpe o1 31)
(move o1 -6 q)
(move o1 1 o1)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -4 q)
(move o6 (special 0))
(movem o6 -3 q)
(move o4 (constant 4))
(move o1 -4 q)
(move o2 -3 q)
(move o3 (constant 3))
(call delete 4)
(movem o1 (special 0))
(label 31)
(label 28) (move o1 -6 q)
(move o1 0 o1)
(movem o1 -4 q)
(move o6 (special 0))
(movem o6 -3 q)
(move o4 (constant 4))
(move o1 -4 q)
(move o2 -3 q)
(move o3 (constant 3))
(call delete 4)
(movem o1 (special 0))
(label 25) (jrst 22)
(label 24) (move o2 (constant 6))
(move o1 -5 q)
(call eq 2)
(jumpe o1 35)
(move o6 (special 0))
(movem o6 -3 q)
(move o4 (constant 4))
(move o1 -6 q)
(move o2 -3 q)
(move o3 (constant 3))
(call delete 4)
(movem o1 (special 0))
(move o2 -7 q)
(move o1 -6 q)
(call cons 2)
(movem o1 -7 q)
(jrst 22)
(label 35) (move o2 (constant 7))
(move o1 -5 q)
(call eq 2)
(jumpe o1 36)
(move o1 -6 q)
(call symbolp 1)
(jumpe o1 38)
(move o6 (special 0))
(movem o6 -3 q)
(move o4 (constant 4))
(move o1 -6 q)
(move o2 -3 q)
(move o3 (constant 3))
(call delete 4)
(movem o1 (special 0))
(move o2 -7 q)
(move o1 -6 q)
(call cons 2)
(movem o1 -7 q)
(jrst 37)
(label 38) (move o1 -6 q)
(move o1 1 o1)
(move o1 0 o1)
(jumpe o1 40)
(move o1 -6 q)
(move o1 0 o1)
(movem o1 -4 q)
(move o1 -6 q)
(move o1 1 o1)
(move o1 0 o1)
(call lisp::symmac-replace 1)
(movem o1 -3 q)
(move o1 -6 q)
(move o1 1 o1)
(move o1 1 o1)
(move o1 0 o1)
(move o3 o1)
(move o1 -4 q)
(move o2 -3 q)
(call list 3)
(movem o1 -4 q)
(move o2 -7 q)
(move o1 -4 q)
(call cons 2)
(movem o1 -7 q)
(jrst 41)
(label 40) (move o2 -7 q)
(move o1 -6 q)
(call cons 2)
(movem o1 -7 q)
(label 41) (move o1 -6 q)
(move o1 1 o1)
(move o1 1 o1)
(move o1 0 o1)
(jumpe o1 42)
(move o1 -6 q)
(move o1 1 o1)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -4 q)
(move o6 (special 0))
(movem o6 -3 q)
(move o4 (constant 4))
(move o1 -4 q)
(move o2 -3 q)
(move o3 (constant 3))
(call delete 4)
(movem o1 (special 0))
(label 42) (move o1 -6 q)
(move o1 0 o1)
(call listp 1)
(jumpe o1 44)
(move o1 -6 q)
(move o1 0 o1)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -4 q)
(move o6 (special 0))
(movem o6 -3 q)
(move o4 (constant 4))
(move o1 -4 q)
(move o2 -3 q)
(move o3 (constant 3))
(call delete 4)
(movem o1 (special 0))
(label 44)
(label 37) (jrst 22)
(label 36) (move o2 (constant 8))
(move o1 -5 q)
(call eq 2)
(jumpe o1 47)
(move o2 -6 q)
(move o1 (constant 9))
(call error 2)
(jrst 22)
(label 47) (jrst 48)
(move o1 -6 q)
(call symbolp 1)
(jumpe o1 50)
(move o6 (special 0))
(movem o6 -3 q)
(move o4 (constant 4))
(move o1 -6 q)
(move o2 -3 q)
(move o3 (constant 3))
(call delete 4)
(movem o1 (special 0))
(move o2 -7 q)
(move o1 -6 q)
(call cons 2)
(movem o1 -7 q)
(jrst 49)
(label 50) (move o1 -6 q)
(move o1 0 o1)
(movem o1 -4 q)
(move o1 -6 q)
(move o1 1 o1)
(move o1 0 o1)
(call lisp::symmac-replace 1)
(move o2 o1)
(move o1 -4 q)
(call list 2)
(movem o1 -4 q)
(move o2 -7 q)
(move o1 -4 q)
(call cons 2)
(movem o1 -7 q)
(move o1 -6 q)
(move o1 0 o1)
(movem o1 -4 q)
(move o6 (special 0))
(movem o6 -3 q)
(move o4 (constant 4))
(move o1 -4 q)
(move o2 -3 q)
(move o3 (constant 3))
(call delete 4)
(movem o1 (special 0))
(label 49)
(label 48)
(label 22)
(label 19) (move o1 -10 q)
(move o1 1 o1)
(movem o1 -10 q)
(jrst 7)
(label 3) (adjsp q -13)
(popj p)
)
(%put (quote replace-lambda) (quote %args-documentation) (quote (lambda-list forms)))
(%put (quote replace-lambda) (quote %source-documentation) (quote "SS:<VICTOR.FLAVORS>SYMMAC.CLISP.1"))
#_(lap #0_defsymtrans 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." defsymtrans setf get quote ((quote sym-mac-transform)) function lambda let ((*symbol-macro-replacements* *symbol-macro-replacements*)))
(code-start)
(label 1) (adjsp q 13)
(movem o1 -12 q)
(move o1 -12 q)
(call length 1)
(movem o1 -11 q)
(move o2 (constant 0))
(move o1 -11 q)
(call < 2)
(jumpe o1 4)
(move o1 -12 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 -12 q)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -11 q)
(move o1 -12 q)
(move o1 1 o1)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -10 q)
(move o1 -12 q)
(move o1 1 o1)
(move o1 1 o1)
(move o1 1 o1)
(movem o1 -9 q)
(move o2 -11 q)
(move o1 (constant 5))
(call list 2)
(movem o1 -6 q)
(move o3 (constant 6))
(move o1 (constant 4))
(move o2 -6 q)
(call list* 3)
(movem o1 -7 q)
(skipn nil -9 q)
(jrst 6)
(move o3 -9 q)
(move o1 (constant 9))
(move o2 (constant 10))
(call list* 3)
(move o3 o1)
(move o1 (constant 8))
(move o2 -10 q)
(call list 3)
(move o2 o1)
(move o1 (constant 7))
(call list 2)
(move o3 o1)
(jrst 7)
(label 6) (move o3 -10 q)
(label 7) (move o1 (constant 3))
(move o2 -7 q)
(call list 3)
(label 3) (adjsp q -13)
(popj p)
)
(%put (quote defsymtrans) (quote %args-documentation) (quote (**macroarg**)))
(%put (quote defsymtrans) (quote %source-documentation) (quote "SS:<VICTOR.FLAVORS>SYMMAC.CLISP.1"))
#_(lap #0_symmac-leave-first-arg expr
(entry-points (2-few 1 2-many 2-many 2-many 2-many 2-many))
#0_NIL
(code-start)
(label 1) (adjsp q 9)
(movem o1 -8 q)
(move o1 -8 q)
(move o1 0 o1)
(movem o1 -7 q)
(move o1 -8 q)
(move o1 1 o1)
(move o1 0 o1)
(movem o1 -6 q)
(move o1 nil)
(call list 1)
(movem o1 -5 q)
(move o6 -5 q)
(movem o6 -4 q)
(move o1 -8 q)
(move o1 1 o1)
(move o1 1 o1)
(movem o1 -3 q)
(label 7) (skipe nil -3 q)
(jrst 8)
(move o1 -5 q)
(move o1 1 o1)
(move o3 o1)
(jrst 3)
(label 8) (move o6 -4 q)
(movem o6 -2 q)
(move o1 -3 q)
(move o1 0 o1)
(call lisp::symmac-replace 1)
(call list 1)
(movem o1 -4 q)
(move o2 -4 q)
(move o1 -2 q)
(call rplacd 2)
(move o1 -3 q)
(move o1 1 o1)
(movem o1 -3 q)
(jrst 7)
(label 3) (move o1 -7 q)
(move o2 -6 q)
(call list* 3)
(adjsp q -9)
(popj p)
)
(%put (quote symmac-leave-first-arg) (quote %args-documentation) (quote (form)))
(%put (quote symmac-leave-first-arg) (quote %source-documentation) (quote "SS:<VICTOR.FLAVORS>SYMMAC.CLISP.1"))
#_(lap #0_symmac-progn-like expr
(entry-points (2-few 1 2-many 2-many 2-many 2-many 2-many))
#0_NIL
(code-start)
(label 1) (adjsp q 8)
(movem o1 -7 q)
(move o1 -7 q)
(move o1 0 o1)
(movem o1 -6 q)
(move o1 nil)
(call list 1)
(movem o1 -5 q)
(move o6 -5 q)
(movem o6 -4 q)
(move o1 -7 q)
(move o1 1 o1)
(movem o1 -3 q)
(label 7) (skipe nil -3 q)
(jrst 8)
(move o1 -5 q)
(move o1 1 o1)
(move o2 o1)
(jrst 3)
(label 8) (move o6 -4 q)
(movem o6 -2 q)
(move o1 -3 q)
(move o1 0 o1)
(call lisp::symmac-replace 1)
(call list 1)
(movem o1 -4 q)
(move o2 -4 q)
(move o1 -2 q)
(call rplacd 2)
(move o1 -3 q)
(move o1 1 o1)
(movem o1 -3 q)
(jrst 7)
(label 3) (move o1 -6 q)
(call cons 2)
(adjsp q -8)
(popj p)
)
(%put (quote symmac-progn-like) (quote %args-documentation) (quote (form)))
(%put (quote symmac-progn-like) (quote %source-documentation) (quote "SS:<VICTOR.FLAVORS>SYMMAC.CLISP.1"))
(defsymtrans quote (function identity))
(defsymtrans go (function identity))
(defsymtrans declare (function identity))
(defsymtrans eval-when (function symmac-leave-first-arg))
(defsymtrans block (function symmac-leave-first-arg))
(defsymtrans return-from (function symmac-leave-first-arg))
(defsymtrans the (function symmac-leave-first-arg))
(defsymtrans %primitive (function symmac-leave-first-arg))
(defsymtrans return (function symmac-progn-like))
(defsymtrans and (function symmac-progn-like))
(defsymtrans or (function symmac-progn-like))
(defsymtrans multiple-value-call (function symmac-progn-like))
(defsymtrans multiple-value-prog1 (function symmac-progn-like))
(defsymtrans unwind-protect (function symmac-progn-like))
(defsymtrans progn (function symmac-progn-like))
(defsymtrans prog1 (function symmac-progn-like))
(defsymtrans prog2 (function symmac-progn-like))
(defsymtrans if (function symmac-progn-like))
(defsymtrans progv (function symmac-progn-like))
(defsymtrans catch (function symmac-progn-like))
(defsymtrans throw (function symmac-progn-like))
(defsymtrans function (form) (let ((lambdap (cadr form))) (cond ((symbolp lambdap) form) ((atom lambdap) (error "Illegal arg to FUNCTION - ~A." lambdap)) ((eq (quote lambda) (car lambdap)) (list (quote function) (cons (quote lambda) (replace-lambda (cadr lambdap) (cddr lambdap))))) (t (error "Symmac - strange thing in FUNCTION.")))))
(defsymtrans tagbody (form) (do ((forms (cdr form) (cdr forms)) (newforms nil)) ((null forms) (cons (quote tagbody) (nreverse newforms))) (if (symbolp (car forms)) (push (car forms) newforms) (push (symmac-replace (car forms)) newforms))))
(defsymtrans setq (form) (cons (quote setf) (mapcar (function symmac-replace) (cdr form))))
(defsymtrans let (form) (let ((bound nil)) (list* (quote let) (mapcar (function (lambda (binding) (cond ((atom binding) (push binding bound) binding) (t (push (car binding) bound) (list (car binding) (symmac-replace (cadr binding))))))) (cadr form)) (bind-non-macros bound (mapcar (function symmac-replace) (cddr form))))))
(defsymtrans prog (form) (list (quote let) (cadr form) (list* (quote prog) nil (mapcar (function (lambda (f) (if (symbolp f) f (symmac-replace f)))) (cddr form)))))
(defsymtrans prog* (form) (list (quote let*) (cadr form) (list* (quote prog*) nil (mapcar (function (lambda (f) (if (symbolp f) f (symmac-replace f)))) (cddr form)))))
(defsymtrans let* (form) (list* (quote let*) (mapcar (function (lambda (binding) (cond ((atom binding) (setq *symbol-macro-replacements* (delete binding *symbol-macro-replacements* :key (function car))) binding) (t (prog1 (list (car binding) (symmac-replace (cadr binding))) (setq *symbol-macro-replacements* (delete (car binding) *symbol-macro-replacements* :key (function car)))))))) (cadr form)) (mapcar (function symmac-replace) (cddr form))))
(defsymtrans cond (form) (cons (quote cond) (mapcar (function (lambda (clause) (mapcar (function symmac-replace) clause))) (cdr form))))
(defsymtrans defun (form) (let ((name (cadr form)) (args (caddr form)) (body (cdddr form))) (list* (quote defun) name (replace-lambda args body))))
(defsymtrans multiple-value-bind (form) (let ((bindings (cadr form)) (values (caddr form)) (forms (cdddr form))) (list* (quote multiple-value-bind) bindings (symmac-replace values) (bind-non-macros bindings (mapcar (function symmac-replace) forms)))))
(defsymtrans multiple-value-setq (form) (pop form) (let* ((vars (pop form)) (values (pop form)) (pairs nil) (gens (mapcar (function (lambda (var) (let ((gen (gensym))) (push gen pairs) (push var pairs) gen))) vars))) (list (quote multiple-value-bind) gens (symmac-replace values) (symmac-replace (cons (quote setf) pairs)))))
(defsymtrans compiler-let (form) (list (quote compiler-let) (cadr form) (list* (quote symmac-internal) *symbol-macro-replacements* (cddr form))))
(defsymtrans flet (form) (list (quote flet) (cadr form) (list* (quote symmac-internal) *symbol-macro-replacements* (cddr form))))
(defsymtrans macrolet (form) (list (quote macrolet) (cadr form) (list* (quote symmac-internal) *symbol-macro-replacements* (cddr form))))
(defsymtrans labels (form) (list (quote labels) (cadr form) (list (quote symmac-internal) *symbol-macro-replacements* (cons (quote symmac-labels) (cdr form)))))
(defsymtrans symmac-labels (form) (list* (quote labels) (mapcar (function (lambda (binding) (cons (car binding) (replace-lambda (cadr binding) (cddr binding))))) (cadr form)) (mapcar (function symmac-replace) (cddr form))))