Trailing-Edge
-
PDP-10 Archives
-
clisp
-
clisp/upsala/spirrat.lap
There are no other files named spirrat.lap in the archive.
;;; CLC vP.U.V.1(2) compiling CARMEN::SS:<CLISP.UPSALA>SPIRRAT.CLISP.12
(IN-PACKAGE (QUOTE LISP))
(EXPORT (QUOTE (EXPT ISQRT ASINH ACOSH ATANH PI)))
(%PUT (QUOTE ISQRT) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the integer square root; ie. (<= (expt result 2) input)."))
#_(LAP #0_ISQRT EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(0 1 -1 T "Isqrt: ~S argument must be a nonnegative integer")
(CODE-START)
(LABEL 1) (ADDI Q 6)
(MOVEM O1 -5 Q)
(CALL INTEGERP 1)
(JUMPE O1 5)
(MOVE O2 (CONSTANT 0))
(MOVE O1 -5 Q)
(CALL < 2)
(SKIPE NIL O1)
(LABEL 5) (JRST 3)
(MOVE O1 -5 Q)
(CALL ZEROP 1)
(JUMPE O1 7)
(MOVE O1 (CONSTANT 0))
(MOVEI N 1)
(JRST 8)
(LABEL 7) (MOVEM NIL -4 Q)
(MOVE O5 (CONSTANT 1))
(MOVEM O5 -3 Q)
(MOVE O5 -5 Q)
(MOVEM O5 -2 Q)
(MOVE O2 (CONSTANT 2))
(MOVE O1 O5)
(CALL ASH 2)
(MOVEM O1 -1 Q)
(LABEL 13) (MOVE O1 -3 Q)
(CALL 1+ 1)
(MOVE O2 O1)
(MOVE O1 -2 Q)
(CALL > 2)
(JUMPN O1 14)
(MOVE O1 -3 Q)
(MOVEI N 1)
(JRST 9)
(LABEL 14) (MOVE O2 -1 Q)
(MOVE O1 O2)
(CALL * 2)
(MOVEM O1 0 Q)
(MOVE O2 -5 Q)
(CALL > 2)
(TDCN O1 O1)
(MOVE O1 (CONSTANT 3))
(MOVEM O1 -4 Q)
(SKIPN NIL -4 Q)
(JRST 16)
(MOVE O1 -1 Q)
(JRST 17)
(LABEL 16) (MOVE O1 -3 Q)
(LABEL 17) (MOVEM O1 -3 Q)
(SKIPN NIL -4 Q)
(JRST 18)
(MOVE O1 -2 Q)
(JRST 19)
(LABEL 18) (MOVE O1 -1 Q)
(LABEL 19) (MOVEM O1 -2 Q)
(MOVE O2 O1)
(MOVE O1 -3 Q)
(CALL + 2)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 2))
(CALL ASH 2)
(MOVEM O1 -1 Q)
(JRST 13)
(LABEL 9)
(LABEL 8) (JRST 4)
(LABEL 3) (MOVE O2 -5 Q)
(MOVE O1 (CONSTANT 4))
(CALL ERROR 2)
(LABEL 4) (SUBI Q 6)
(POPJ P)
)
(%PUT (QUOTE ISQRT) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (X)))
(%PUT (QUOTE ISQRT) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>SPIRRAT.CLISP.12") (GET (QUOTE ISQRT) (QUOTE %SOURCE-DOCUMENTATION))))
#_(LAP #0_INTEXP EXPR
(ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(0 1 2 -1)
(CODE-START)
(LABEL 1) (ADDI Q 7)
(MOVEM O1 -6 Q)
(MOVEM O2 -5 Q)
(MOVE O2 (CONSTANT 0))
(MOVE O1 -5 Q)
(CALL < 2)
(JUMPE O1 4)
(MOVE O1 -5 Q)
(CALL - 1)
(MOVE O2 O1)
(MOVE O1 -6 Q)
(CALL LISP::INTEXP 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 1))
(CALL / 2)
(JRST 3)
(LABEL 4) (MOVE O1 -6 Q)
(CALL RATIONALP 1)
(JUMPE O1 6)
(MOVE O1 -6 Q)
(CALL INTEGERP 1)
(SKIPE NIL O1)
(LABEL 6) (JRST 5)
(MOVE O1 -6 Q)
(CALL NUMERATOR 1)
(MOVEM O1 -4 Q)
(MOVE O2 -5 Q)
(CALL LISP::INTEXP 2)
(MOVEM O1 -4 Q)
(MOVE O1 -6 Q)
(CALL DENOMINATOR 1)
(MOVEM O1 -3 Q)
(MOVE O2 -5 Q)
(CALL LISP::INTEXP 2)
(MOVE O2 O1)
(MOVE O1 -4 Q)
(CALL / 2)
(JRST 3)
(LABEL 5) (MOVE O1 -6 Q)
(CALL INTEGERP 1)
(JUMPE O1 9)
(MOVE O2 (CONSTANT 2))
(MOVE O1 -6 Q)
(CALL = 2)
(SKIPN NIL O1)
(LABEL 9) (JRST 8)
(MOVE O2 -5 Q)
(MOVE O1 (CONSTANT 1))
(CALL ASH 2)
(JRST 3)
(LABEL 8) (SKIPA)
(JRST 11)
(MOVE O2 (CONSTANT 3))
(MOVE O1 -5 Q)
(CALL ASH 2)
(MOVEM O1 -3 Q)
(MOVE O3 (CONSTANT 1))
(MOVE O1 (CONSTANT 1))
(MOVE O2 -5 Q)
(CALL BOOLE 3)
(CALL ZEROP 1)
(JUMPN O1 13)
(MOVE O5 -6 Q)
(MOVEM O5 -2 Q)
(JRST 14)
(LABEL 13) (MOVE O5 (CONSTANT 1))
(MOVEM O5 -2 Q)
(LABEL 14)
(LABEL 18) (MOVE O1 -3 Q)
(CALL ZEROP 1)
(JUMPE O1 19)
(MOVE O1 -2 Q)
(MOVEI N 1)
(JRST 12)
(LABEL 19) (MOVE O2 -6 Q)
(MOVE O1 O2)
(CALL * 2)
(MOVEM O1 -6 Q)
(MOVE O1 -3 Q)
(MOVEM O1 -5 Q)
(MOVE O2 (CONSTANT 3))
(CALL ASH 2)
(MOVEM O1 -1 Q)
(MOVE O3 (CONSTANT 1))
(MOVE O1 (CONSTANT 1))
(MOVE O2 -5 Q)
(CALL BOOLE 3)
(CALL ZEROP 1)
(JUMPN O1 21)
(MOVE O2 -2 Q)
(MOVE O1 -6 Q)
(CALL * 2)
(MOVEM O1 0 Q)
(JRST 22)
(LABEL 21) (MOVE O5 -2 Q)
(MOVEM O5 0 Q)
(LABEL 22) (MOVE O1 -1 Q)
(MOVEM O1 -3 Q)
(MOVE O1 0 Q)
(MOVEM O1 -2 Q)
(JRST 18)
(LABEL 12)
(LABEL 11)
(LABEL 3) (SUBI Q 7)
(POPJ P)
)
(%PUT (QUOTE INTEXP) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (BASE POWER)))
(%PUT (QUOTE INTEXP) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>SPIRRAT.CLISP.12") (GET (QUOTE INTEXP) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE EXPT) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns X raised to the Nth power."))
#_(LAP #0_EXPT EXPR
(ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(0 "~A to a non-positive power ~A." "Negative number ~A to non-integral power ~A.")
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVEM O2 0 Q)
(CALL RATIONALP 1)
(JUMPE O1 5)
(MOVE O1 0 Q)
(CALL INTEGERP 1)
(SKIPN NIL O1)
(LABEL 5) (JRST 4)
(MOVE O2 0 Q)
(MOVE O1 -1 Q)
(CALL LISP::INTEXP 2)
(JRST 3)
(LABEL 4) (MOVE O1 -1 Q)
(CALL ZEROP 1)
(JUMPE O1 7)
(MOVE O2 (CONSTANT 0))
(MOVE O1 0 Q)
(CALL > 2)
(JUMPE O1 8)
(MOVE O1 -1 Q)
(MOVEI N 1)
(JRST 9)
(LABEL 8) (MOVE O3 0 Q)
(MOVE O1 (CONSTANT 1))
(MOVE O2 -1 Q)
(CALL ERROR 3)
(LABEL 9) (JRST 3)
(LABEL 7) (MOVE O1 0 Q)
(CALL INTEGERP 1)
(JUMPN O1 11)
(MOVE O2 (CONSTANT 0))
(MOVE O1 -1 Q)
(CALL < 2)
(SKIPN NIL O1)
(LABEL 11) (JRST 10)
(MOVE O3 0 Q)
(MOVE O1 (CONSTANT 2))
(MOVE O2 -1 Q)
(CALL ERROR 3)
(JRST 3)
(LABEL 10) (SKIPA)
(JRST 13)
(MOVE O2 0 Q)
(MOVE O1 -1 Q)
(CALL LISP::%SP-EXPT 2)
(LABEL 13)
(LABEL 3) (SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE EXPT) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (X N)))
(%PUT (QUOTE EXPT) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>SPIRRAT.CLISP.12") (GET (QUOTE EXPT) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE ASINH) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the hyperbolic arc sine of the argument."))
#_(LAP #0_ASINH EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_NIL
(CODE-START)
(LABEL 1) (ADDI Q 1)
(MOVEM O1 0 Q)
(MOVE O2 O1)
(CALL * 2)
(CALL 1+ 1)
(CALL SQRT 1)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL + 2)
(CALL LOG 1)
(SUBI Q 1)
(POPJ P)
)
(%PUT (QUOTE ASINH) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (X)))
(%PUT (QUOTE ASINH) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>SPIRRAT.CLISP.12") (GET (QUOTE ASINH) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE ACOSH) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the hyperbolic arc cosine of the argument."))
#_(LAP #0_ACOSH EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(0 "~S argument out of range.")
(CODE-START)
(LABEL 1) (ADDI Q 1)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 0))
(CALL > 2)
(JUMPE O1 3)
(MOVE O2 0 Q)
(MOVE O1 O2)
(CALL * 2)
(CALL 1- 1)
(CALL SQRT 1)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL + 2)
(CALL LOG 1)
(JRST 4)
(LABEL 3) (MOVE O2 0 Q)
(MOVE O1 (CONSTANT 1))
(CALL ERROR 2)
(LABEL 4) (SUBI Q 1)
(POPJ P)
)
(%PUT (QUOTE ACOSH) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (X)))
(%PUT (QUOTE ACOSH) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>SPIRRAT.CLISP.12") (GET (QUOTE ACOSH) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE ATANH) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the hyperbolic arc tangent of the argument."))
#_(LAP #0_ATANH EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(-1 1 0.5 "~S argument out of range.")
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVE O3 (CONSTANT 1))
(MOVE O1 (CONSTANT 0))
(MOVE O2 -1 Q)
(CALL < 3)
(JUMPE O1 3)
(MOVE O1 -1 Q)
(CALL 1+ 1)
(MOVEM O1 0 Q)
(MOVE O2 -1 Q)
(MOVE O1 (CONSTANT 1))
(CALL - 2)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL / 2)
(CALL LOG 1)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 2))
(CALL * 2)
(JRST 4)
(LABEL 3) (MOVE O2 -1 Q)
(MOVE O1 (CONSTANT 3))
(CALL ERROR 2)
(LABEL 4) (SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE ATANH) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (X)))
(%PUT (QUOTE ATANH) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>SPIRRAT.CLISP.12") (GET (QUOTE ATANH) (QUOTE %SOURCE-DOCUMENTATION))))
(MAKUNBOUND (QUOTE PI))
(DEFCONSTANT PI 3.14159265358979323829D0 "pi, as a long real.")