Trailing-Edge
-
PDP-10 Archives
-
clisp
-
clisp/upsala/arith.lap
There are no other files named arith.lap in the archive.
;;; CLC vP.U.V.1(2) compiling CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11
(IN-PACKAGE (QUOTE LISP))
(EXPORT (QUOTE (MAX MIN CONJUGATE PHASE SIGNUM NUMERATOR DENOMINATOR FLOOR CEILING ROUND MOD REM FFLOOR FCEILING FTRUNCATE FROUND COMPLEX REALPART IMAGPART CIS LOGIOR LOGXOR LOGAND LOGEQV LOGNAND LOGNOR LOGANDC1 LOGANDC2 LOGORC1 LOGORC2 LOGNOT BOOLE-CLR BOOLE-SET BOOLE-1 BOOLE-2 BOOLE-C1 BOOLE-C2 BOOLE-AND BOOLE-IOR BOOLE-XOR BOOLE-EQV BOOLE-NAND BOOLE-NOR BOOLE-ANDC1 BOOLE-ANDC2 BOOLE-ORC1 BOOLE-ORC2 LOGTEST LOGBITP LOGCOUNT LDB-TEST DEPOSIT-FIELD LCM FLOAT-DIGITS FLOAT-PRECISION RATIONALIZE)))
(%PUT (QUOTE MAX) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the greatest of its arguments."))
#_(LAP #0_MAX EXPR
(ENTRY-POINTS (2-FEW 2 3 4 5 6 7) REST)
#0_NIL
(CODE-START)
(LABEL 2) (MOVE O2 NIL)
(JRST 1)
(LABEL 3) (MOVEI W2 1)
(ICALL REST2)
(JRST 1)
(LABEL 4) (MOVEI W2 2)
(ICALL REST3)
(JRST 1)
(LABEL 5) (MOVEI W2 3)
(ICALL REST4)
(JRST 1)
(LABEL 6) (MOVEI W2 4)
(ICALL REST5)
(JRST 1)
(LABEL 7) (MOVEI W2 1)
(ICALL RESTX)
(LABEL 1) (ADDI Q 5)
(MOVEM O1 -4 Q)
(MOVEM O2 -3 Q)
(MOVE O5 O2)
(MOVEM O5 -2 Q)
(MOVE O5 O1)
(MOVEM O5 -1 Q)
(LABEL 13) (SKIPE NIL -2 Q)
(JRST 14)
(MOVE O1 -1 Q)
(MOVEI N 1)
(JRST 9)
(LABEL 14) (MOVE O1 -2 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O2 -1 Q)
(MOVE O1 O5)
(CALL > 2)
(JUMPE O1 16)
(MOVE O1 -2 Q)
(MOVE O1 0 O1)
(MOVEM O1 -1 Q)
(LABEL 16) (MOVE O1 -2 Q)
(MOVE O1 1 O1)
(MOVEM O1 -2 Q)
(JRST 13)
(LABEL 9) (SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE MAX) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NUMBER &REST MORE-NUMBERS)))
(%PUT (QUOTE MAX) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE MAX) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE MIN) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the least of its arguments."))
#_(LAP #0_MIN EXPR
(ENTRY-POINTS (2-FEW 2 3 4 5 6 7) REST)
#0_NIL
(CODE-START)
(LABEL 2) (MOVE O2 NIL)
(JRST 1)
(LABEL 3) (MOVEI W2 1)
(ICALL REST2)
(JRST 1)
(LABEL 4) (MOVEI W2 2)
(ICALL REST3)
(JRST 1)
(LABEL 5) (MOVEI W2 3)
(ICALL REST4)
(JRST 1)
(LABEL 6) (MOVEI W2 4)
(ICALL REST5)
(JRST 1)
(LABEL 7) (MOVEI W2 1)
(ICALL RESTX)
(LABEL 1) (ADDI Q 5)
(MOVEM O1 -4 Q)
(MOVEM O2 -3 Q)
(MOVE O5 O2)
(MOVEM O5 -2 Q)
(MOVE O5 O1)
(MOVEM O5 -1 Q)
(LABEL 13) (SKIPE NIL -2 Q)
(JRST 14)
(MOVE O1 -1 Q)
(MOVEI N 1)
(JRST 9)
(LABEL 14) (MOVE O1 -2 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O2 -1 Q)
(MOVE O1 O5)
(CALL < 2)
(JUMPE O1 16)
(MOVE O1 -2 Q)
(MOVE O1 0 O1)
(MOVEM O1 -1 Q)
(LABEL 16) (MOVE O1 -2 Q)
(MOVE O1 1 O1)
(MOVEM O1 -2 Q)
(JRST 13)
(LABEL 9) (SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE MIN) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NUMBER &REST MORE-NUMBERS)))
(%PUT (QUOTE MIN) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE MIN) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CONJUGATE) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the complex conjugate of NUMBER. For non-complex numbers, this is
an identity."))
#_(LAP #0_CONJUGATE EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(COMPLEX)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVE O2 (CONSTANT 0))
(CALL TYPEP 2)
(JUMPE O1 3)
(MOVE O1 -1 Q)
(CALL REALPART 1)
(MOVEM O1 0 Q)
(MOVE O1 -1 Q)
(CALL IMAGPART 1)
(CALL - 1)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL COMPLEX 2)
(JRST 4)
(LABEL 3) (MOVE O1 -1 Q)
(MOVEI N 1)
(LABEL 4) (SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE CONJUGATE) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NUMBER)))
(%PUT (QUOTE CONJUGATE) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE CONJUGATE) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE PHASE) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the angle part of the polar representation of a complex number.
For non-complex numbers, this is 0."))
#_(LAP #0_PHASE EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(0)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(CALL COMPLEXP 1)
(JUMPE O1 3)
(MOVE O1 -1 Q)
(CALL REALPART 1)
(MOVEM O1 0 Q)
(MOVE O1 -1 Q)
(CALL IMAGPART 1)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL ATAN 2)
(JRST 4)
(LABEL 3) (MOVE O1 (CONSTANT 0))
(MOVEI N 1)
(LABEL 4) (SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE PHASE) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NUMBER)))
(%PUT (QUOTE PHASE) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE PHASE) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CIS) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns cos(Theta) + i sin(Theta)."))
#_(LAP #0_CIS EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_("Complex numbers are not implemented yet.")
(CODE-START)
(LABEL 1) (ADDI Q 1)
(MOVEM O1 0 Q)
(MOVE O1 (CONSTANT 0))
(CALL ERROR 1)
(SUBI Q 1)
(POPJ P)
)
(%PUT (QUOTE CIS) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (THETA)))
(%PUT (QUOTE CIS) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE CIS) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE SIGNUM) (QUOTE %FUN-DOCUMENTATION) (QUOTE "If NUMBER is zero, return NUMBER, else return (/ NUMBER (ABS NUMBER)).
Currently not implemented for complex numbers."))
#_(LAP #0_SIGNUM EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(0 1 -1)
(CODE-START)
(LABEL 1) (ADDI Q 1)
(MOVEM O1 0 Q)
(CALL ZEROP 1)
(JUMPE O1 3)
(MOVE O1 0 Q)
(MOVEI N 1)
(JRST 4)
(LABEL 3) (MOVE O1 0 Q)
(CALL RATIONALP 1)
(JUMPE O1 5)
(MOVE O2 (CONSTANT 0))
(MOVE O1 0 Q)
(CALL > 2)
(JUMPE O1 7)
(MOVE O1 (CONSTANT 1))
(MOVEI N 1)
(JRST 8)
(LABEL 7) (MOVE O1 (CONSTANT 2))
(MOVEI N 1)
(LABEL 8) (JRST 6)
(LABEL 5) (MOVE O1 0 Q)
(CALL ABS 1)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL / 2)
(LABEL 6)
(LABEL 4) (SUBI Q 1)
(POPJ P)
)
(%PUT (QUOTE SIGNUM) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NUMBER)))
(%PUT (QUOTE SIGNUM) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE SIGNUM) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE RATIONALIZE) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Converts any non-complex number to be a rational number. Assumes
that a floating-point number is accurate only to the precision of the
floating-point representation, and may return any rational number for
which the floating-point number is the best available approximation of
its format; in doing this it attempts to keep both numerator and
denominator small."))
#_(LAP #0_RATIONALIZE EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(RATIONAL SHORT-FLOAT 2.38418579F-7 LONG-FLOAT 2.16840434497100886801D-19 "Argument not a non complex number, ~A.")
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVE O5 O1)
(MOVEM O5 0 Q)
(MOVE O2 (CONSTANT 0))
(CALL TYPEP 2)
(JUMPE O1 4)
(MOVE O1 -1 Q)
(MOVEI N 1)
(JRST 3)
(LABEL 4) (MOVE O2 (CONSTANT 1))
(MOVE O1 0 Q)
(CALL TYPEP 2)
(JUMPE O1 5)
(MOVE O2 (CONSTANT 2))
(MOVE O1 -1 Q)
(CALL LISP::RATIONALIZE-FLOAT 2)
(JRST 3)
(LABEL 5) (MOVE O2 (CONSTANT 3))
(MOVE O1 0 Q)
(CALL TYPEP 2)
(JUMPE O1 6)
(MOVE O2 (CONSTANT 4))
(MOVE O1 -1 Q)
(CALL LISP::RATIONALIZE-FLOAT 2)
(JRST 3)
(LABEL 6) (SKIPA)
(JRST 7)
(MOVE O2 -1 Q)
(MOVE O1 (CONSTANT 5))
(CALL ERROR 2)
(LABEL 7)
(LABEL 3) (SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE RATIONALIZE) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (X)))
(%PUT (QUOTE RATIONALIZE) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE RATIONALIZE) (QUOTE %SOURCE-DOCUMENTATION))))
#_(LAP #0_RATIONALIZE-FLOAT EXPR
(ENTRY-POINTS (2-FEW 1 2 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(2.16840434497100886801D-19 0 1 1.0)
(CODE-START)
(LABEL 1) (MOVE O2 (CONSTANT 0))
(LABEL 2) (ADDI Q 14)
(MOVEM O1 -13 Q)
(MOVEM O2 -12 Q)
(MOVE O2 (CONSTANT 1))
(CALL < 2)
(JUMPE O1 5)
(MOVE O1 -13 Q)
(CALL - 1)
(CALL RATIONALIZE 1)
(CALL - 1)
(JRST 4)
(LABEL 5) (MOVE O1 -13 Q)
(CALL ZEROP 1)
(JUMPE O1 6)
(MOVE O1 (CONSTANT 1))
(MOVEI N 1)
(JRST 4)
(LABEL 6) (SKIPA)
(JRST 7)
(MOVEM NIL -11 Q)
(MOVEM NIL -10 Q)
(MOVE O5 -13 Q)
(MOVEM O5 -9 Q)
(MOVE O2 (CONSTANT 2))
(MOVE O1 O5)
(CALL TRUNCATE 2)
(MOVEM O1 -10 Q)
(MOVEM O1 -8 Q)
(MOVE O5 (CONSTANT 2))
(MOVEM O5 -7 Q)
(MOVE O5 (CONSTANT 2))
(MOVEM O5 -6 Q)
(MOVE O5 (CONSTANT 1))
(MOVEM O5 -5 Q)
(LABEL 12) (MOVE O1 -7 Q)
(CALL ZEROP 1)
(JUMPN O1 15)
(MOVE O2 -13 Q)
(MOVE O1 -8 Q)
(CALL FLOAT 2)
(MOVEM O1 -3 Q)
(MOVE O2 -13 Q)
(MOVE O1 -7 Q)
(CALL FLOAT 2)
(MOVE O2 O1)
(MOVE O1 -3 Q)
(CALL / 2)
(MOVE O2 O1)
(MOVE O1 -13 Q)
(CALL - 2)
(MOVEM O1 -4 Q)
(MOVE O2 -13 Q)
(CALL / 2)
(CALL ABS 1)
(MOVEM O1 -4 Q)
(MOVE O2 -12 Q)
(CALL > 2)
(SKIPE NIL O1)
(LABEL 15) (JRST 13)
(MOVE O2 -7 Q)
(MOVE O1 -8 Q)
(CALL / 2)
(JRST 8)
(LABEL 13) (MOVE O2 -13 Q)
(MOVE O1 -10 Q)
(CALL FLOAT 2)
(MOVE O2 O1)
(MOVE O1 -9 Q)
(CALL - 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 3))
(CALL / 2)
(MOVEM O1 -11 Q)
(MOVEM O1 -4 Q)
(MOVE O2 (CONSTANT 2))
(CALL TRUNCATE 2)
(MOVEM O1 -10 Q)
(MOVEM O1 -3 Q)
(MOVE O2 -8 Q)
(CALL * 2)
(MOVEM O1 -3 Q)
(MOVE O2 -6 Q)
(CALL + 2)
(MOVEM O1 -3 Q)
(MOVE O2 -7 Q)
(MOVE O1 -10 Q)
(CALL * 2)
(MOVEM O1 -2 Q)
(MOVE O2 -5 Q)
(CALL + 2)
(MOVEM O1 -2 Q)
(MOVE O5 -8 Q)
(MOVEM O5 -1 Q)
(MOVE O5 -7 Q)
(MOVEM O5 0 Q)
(MOVE O1 -4 Q)
(MOVEM O1 -9 Q)
(MOVE O1 -3 Q)
(MOVEM O1 -8 Q)
(MOVE O1 -2 Q)
(MOVEM O1 -7 Q)
(MOVE O1 -1 Q)
(MOVEM O1 -6 Q)
(MOVE O1 O5)
(MOVEM O1 -5 Q)
(JRST 12)
(LABEL 8)
(LABEL 7)
(LABEL 4) (SUBI Q 14)
(POPJ P)
)
(%PUT (QUOTE RATIONALIZE-FLOAT) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (X &OPTIONAL (EPS LONG-FLOAT-EPSILON))))
(%PUT (QUOTE RATIONALIZE-FLOAT) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE RATIONALIZE-FLOAT) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE NUMERATOR) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Extracts the numerator of an integer or a ratio."))
#_(LAP #0_NUMERATOR EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(INTEGER RATIO 0 "~S is not a rational number.")
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVE O5 O1)
(MOVEM O5 0 Q)
(MOVE O2 (CONSTANT 0))
(CALL TYPEP 2)
(JUMPE O1 4)
(MOVE O1 -1 Q)
(MOVEI N 1)
(JRST 3)
(LABEL 4) (MOVE O2 (CONSTANT 1))
(MOVE O1 0 Q)
(CALL TYPEP 2)
(JUMPE O1 5)
(MOVE O2 (CONSTANT 2))
(MOVE O1 -1 Q)
(ADDI O1 0 O2)
(MOVE O1 0 O1)
(MOVEI N 1)
(JRST 3)
(LABEL 5) (SKIPA)
(JRST 6)
(MOVE O2 -1 Q)
(MOVE O1 (CONSTANT 3))
(CALL ERROR 2)
(LABEL 6)
(LABEL 3) (SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE NUMERATOR) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (RATIONAL)))
(%PUT (QUOTE NUMERATOR) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE NUMERATOR) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE DENOMINATOR) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Extracts the denominator of an integer or a ratio."))
#_(LAP #0_DENOMINATOR EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(INTEGER 1 RATIO "~S is not a rational number.")
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVE O5 O1)
(MOVEM O5 0 Q)
(MOVE O2 (CONSTANT 0))
(CALL TYPEP 2)
(JUMPE O1 4)
(MOVE O1 (CONSTANT 1))
(MOVEI N 1)
(JRST 3)
(LABEL 4) (MOVE O2 (CONSTANT 2))
(MOVE O1 0 Q)
(CALL TYPEP 2)
(JUMPE O1 5)
(MOVE O2 (CONSTANT 1))
(MOVE O1 -1 Q)
(ADDI O1 0 O2)
(MOVE O1 0 O1)
(MOVEI N 1)
(JRST 3)
(LABEL 5) (SKIPA)
(JRST 6)
(MOVE O2 -1 Q)
(MOVE O1 (CONSTANT 3))
(CALL ERROR 2)
(LABEL 6)
(LABEL 3) (SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE DENOMINATOR) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (RATIONAL)))
(%PUT (QUOTE DENOMINATOR) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE DENOMINATOR) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE FLOOR) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the greatest integer not greater than number, or number/divisor.
The second returned value is (mod number divisor)."))
#_(LAP #0_FLOOR EXPR
(ENTRY-POINTS (2-FEW 1 2 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(1 0)
(CODE-START)
(LABEL 1) (MOVE O2 (CONSTANT 0))
(LABEL 2) (ADDI Q 5)
(MOVEM O1 -4 Q)
(MOVEM O2 -3 Q)
(CALL TRUNCATE 2)
(ADJUST-VALUES 2)
(MOVEM O1 -2 Q)
(MOVEM O2 -1 Q)
(MOVE O1 O2)
(CALL ZEROP 1)
(JUMPN O1 6)
(MOVE O2 (CONSTANT 1))
(MOVE O1 -3 Q)
(CALL < 2)
(JUMPE O1 8)
(MOVE O2 (CONSTANT 1))
(MOVE O1 -4 Q)
(CALL > 2)
(JUMPE O1 9)
(JRST1 9)
(LABEL 8) (MOVE O2 (CONSTANT 1))
(MOVE O1 -4 Q)
(CALL < 2)
(SKIPN NIL O1)
(LABEL 9)
(LABEL 6) (JRST 4)
(MOVE O1 -2 Q)
(CALL 1- 1)
(MOVEM O1 0 Q)
(MOVE O2 -3 Q)
(MOVE O1 -1 Q)
(CALL + 2)
(MOVE O2 O1)
(MOVE O1 0 Q)
(MOVEI N 2)
(JRST 5)
(LABEL 4) (MOVE O2 -1 Q)
(MOVE O1 -2 Q)
(MOVEI N 2)
(LABEL 5) (SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE FLOOR) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NUMBER &OPTIONAL (DIVISOR 1))))
(%PUT (QUOTE FLOOR) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE FLOOR) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CEILING) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the smallest integer not less than number, or number/divisor.
The second returned value is the remainder."))
#_(LAP #0_CEILING EXPR
(ENTRY-POINTS (2-FEW 1 2 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(1 0)
(CODE-START)
(LABEL 1) (MOVE O2 (CONSTANT 0))
(LABEL 2) (ADDI Q 5)
(MOVEM O1 -4 Q)
(MOVEM O2 -3 Q)
(CALL TRUNCATE 2)
(ADJUST-VALUES 2)
(MOVEM O1 -2 Q)
(MOVEM O2 -1 Q)
(MOVE O1 O2)
(CALL ZEROP 1)
(JUMPN O1 6)
(MOVE O2 (CONSTANT 1))
(MOVE O1 -3 Q)
(CALL < 2)
(JUMPE O1 8)
(MOVE O2 (CONSTANT 1))
(MOVE O1 -4 Q)
(CALL < 2)
(JUMPE O1 9)
(JRST1 9)
(LABEL 8) (MOVE O2 (CONSTANT 1))
(MOVE O1 -4 Q)
(CALL > 2)
(SKIPN NIL O1)
(LABEL 9)
(LABEL 6) (JRST 4)
(MOVE O1 -2 Q)
(CALL 1+ 1)
(MOVEM O1 0 Q)
(MOVE O2 -3 Q)
(MOVE O1 -1 Q)
(CALL - 2)
(MOVE O2 O1)
(MOVE O1 0 Q)
(MOVEI N 2)
(JRST 5)
(LABEL 4) (MOVE O2 -1 Q)
(MOVE O1 -2 Q)
(MOVEI N 2)
(LABEL 5) (SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE CEILING) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NUMBER &OPTIONAL (DIVISOR 1))))
(%PUT (QUOTE CEILING) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE CEILING) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE ROUND) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Rounds number (or number/divisor) to nearest integer.
The second returned value is the remainder."))
#_(LAP #0_ROUND EXPR
(ENTRY-POINTS (2-FEW 1 3 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(1 T 2 0)
(CODE-START)
(LABEL 1) (ADDI Q 7)
(MOVEM O1 -4 Q)
(MOVE O2 (CONSTANT 0))
(MOVEM O2 -3 Q)
(MOVEM NIL -5 Q)
(JRST 2)
(LABEL 3) (ADDI Q 7)
(MOVEM O1 -4 Q)
(MOVEM O2 -3 Q)
(MOVE O6 (CONSTANT 1))
(MOVEM O6 -5 Q)
(LABEL 2) (MOVEM NIL -6 Q)
(MOVE O2 -3 Q)
(MOVE O1 -4 Q)
(CALL TRUNCATE 2)
(ADJUST-VALUES 2)
(MOVEM O1 -2 Q)
(MOVEM O2 -1 Q)
(MOVE O1 -3 Q)
(CALL ABS 1)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 2))
(CALL / 2)
(MOVEM O1 -6 Q)
(MOVE O2 O1)
(MOVE O1 -1 Q)
(CALL > 2)
(JUMPN1 O1 7)
(MOVE O2 -6 Q)
(MOVE O1 -1 Q)
(CALL = 2)
(JUMPE O1 8)
(MOVE O3 (CONSTANT 0))
(MOVE O1 (CONSTANT 0))
(MOVE O2 -2 Q)
(CALL BOOLE 3)
(CALL ZEROP 1)
(SKIPE NIL O1)
(LABEL 8)
(LABEL 7) (JRST 6)
(MOVE O2 (CONSTANT 3))
(MOVE O1 -3 Q)
(CALL < 2)
(JUMPE O1 10)
(MOVE O1 -2 Q)
(CALL 1- 1)
(MOVEM O1 0 Q)
(MOVE O2 -3 Q)
(MOVE O1 -1 Q)
(CALL + 2)
(MOVE O2 O1)
(MOVE O1 0 Q)
(MOVEI N 2)
(JRST 11)
(LABEL 10) (MOVE O1 -2 Q)
(CALL 1+ 1)
(MOVEM O1 0 Q)
(MOVE O2 -3 Q)
(MOVE O1 -1 Q)
(CALL - 2)
(MOVE O2 O1)
(MOVE O1 0 Q)
(MOVEI N 2)
(LABEL 11) (JRST 5)
(LABEL 6) (MOVE O1 -6 Q)
(CALL - 1)
(MOVE O2 O1)
(MOVE O1 -1 Q)
(CALL < 2)
(JUMPN1 O1 13)
(MOVE O1 -6 Q)
(CALL - 1)
(MOVE O2 O1)
(MOVE O1 -1 Q)
(CALL = 2)
(JUMPE O1 14)
(MOVE O3 (CONSTANT 0))
(MOVE O1 (CONSTANT 0))
(MOVE O2 -2 Q)
(CALL BOOLE 3)
(CALL ZEROP 1)
(SKIPE NIL O1)
(LABEL 14)
(LABEL 13) (JRST 12)
(MOVE O2 (CONSTANT 3))
(MOVE O1 -3 Q)
(CALL < 2)
(JUMPE O1 16)
(MOVE O1 -2 Q)
(CALL 1+ 1)
(MOVEM O1 0 Q)
(MOVE O2 -3 Q)
(MOVE O1 -1 Q)
(CALL - 2)
(MOVE O2 O1)
(MOVE O1 0 Q)
(MOVEI N 2)
(JRST 17)
(LABEL 16) (MOVE O1 -2 Q)
(CALL 1- 1)
(MOVEM O1 0 Q)
(MOVE O2 -3 Q)
(MOVE O1 -1 Q)
(CALL + 2)
(MOVE O2 O1)
(MOVE O1 0 Q)
(MOVEI N 2)
(LABEL 17) (JRST 5)
(LABEL 12) (SKIPA)
(JRST 18)
(MOVE O2 -1 Q)
(MOVE O1 -2 Q)
(MOVEI N 2)
(LABEL 18)
(LABEL 5) (SUBI Q 7)
(POPJ P)
)
(%PUT (QUOTE ROUND) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NUMBER &OPTIONAL (DIVISOR 1 DIVP) &AUX THRESH)))
(%PUT (QUOTE ROUND) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE ROUND) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE MOD) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns second result of FLOOR."))
#_(LAP #0_MOD EXPR
(ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(0)
(CODE-START)
(LABEL 1) (ADDI Q 3)
(MOVEM O1 -2 Q)
(MOVEM O2 -1 Q)
(CALL REM 2)
(MOVEM O1 0 Q)
(CALL ZEROP 1)
(JUMPN O1 5)
(MOVE O2 (CONSTANT 0))
(MOVE O1 -1 Q)
(CALL < 2)
(JUMPE O1 7)
(MOVE O2 (CONSTANT 0))
(MOVE O1 -2 Q)
(CALL > 2)
(JUMPE O1 8)
(JRST1 8)
(LABEL 7) (MOVE O2 (CONSTANT 0))
(MOVE O1 -2 Q)
(CALL < 2)
(SKIPN NIL O1)
(LABEL 8)
(LABEL 5) (JRST 3)
(MOVE O2 -1 Q)
(MOVE O1 0 Q)
(CALL + 2)
(JRST 4)
(LABEL 3) (MOVE O1 0 Q)
(MOVEI N 1)
(LABEL 4) (SUBI Q 3)
(POPJ P)
)
(%PUT (QUOTE MOD) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NUMBER DIVISOR)))
(%PUT (QUOTE MOD) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE MOD) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE REM) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns second result of TRUNCATE."))
#_(LAP #0_REM EXPR
(ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
#0_NIL
(CODE-START)
(LABEL 1) (ADDI Q 4)
(MOVEM O1 -3 Q)
(MOVEM O2 -2 Q)
(CALL TRUNCATE 2)
(ADJUST-VALUES 2)
(MOVEM O1 -1 Q)
(MOVEM O2 0 Q)
(MOVE O1 O2)
(MOVEI N 1)
(SUBI Q 4)
(POPJ P)
)
(%PUT (QUOTE REM) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NUMBER DIVISOR)))
(%PUT (QUOTE REM) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE REM) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE FFLOOR) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Same as FLOOR, but returns first value as a float."))
#_(LAP #0_FFLOOR EXPR
(ENTRY-POINTS (2-FEW 1 2 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(1)
(CODE-START)
(LABEL 1) (MOVE O2 (CONSTANT 0))
(LABEL 2) (ADDI Q 5)
(MOVEM O1 -4 Q)
(MOVEM O2 -3 Q)
(CALL FLOOR 2)
(ADJUST-VALUES 2)
(MOVEM O1 -2 Q)
(MOVEM O2 -1 Q)
(CALL FLOAT 1)
(MOVEM O1 0 Q)
(MOVE O2 -1 Q)
(MOVEI N 2)
(SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE FFLOOR) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NUMBER &OPTIONAL (DIVISOR 1))))
(%PUT (QUOTE FFLOOR) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE FFLOOR) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE FCEILING) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Same as CEILING, but returns first value as a float."))
#_(LAP #0_FCEILING EXPR
(ENTRY-POINTS (2-FEW 1 2 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(1)
(CODE-START)
(LABEL 1) (MOVE O2 (CONSTANT 0))
(LABEL 2) (ADDI Q 5)
(MOVEM O1 -4 Q)
(MOVEM O2 -3 Q)
(CALL CEILING 2)
(ADJUST-VALUES 2)
(MOVEM O1 -2 Q)
(MOVEM O2 -1 Q)
(CALL FLOAT 1)
(MOVEM O1 0 Q)
(MOVE O2 -1 Q)
(MOVEI N 2)
(SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE FCEILING) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NUMBER &OPTIONAL (DIVISOR 1))))
(%PUT (QUOTE FCEILING) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE FCEILING) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE FTRUNCATE) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Same as TRUNCATE, but returns first value as a float."))
#_(LAP #0_FTRUNCATE EXPR
(ENTRY-POINTS (2-FEW 1 2 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(1)
(CODE-START)
(LABEL 1) (MOVE O2 (CONSTANT 0))
(LABEL 2) (ADDI Q 5)
(MOVEM O1 -4 Q)
(MOVEM O2 -3 Q)
(CALL TRUNCATE 2)
(ADJUST-VALUES 2)
(MOVEM O1 -2 Q)
(MOVEM O2 -1 Q)
(CALL FLOAT 1)
(MOVEM O1 0 Q)
(MOVE O2 -1 Q)
(MOVEI N 2)
(SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE FTRUNCATE) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NUMBER &OPTIONAL (DIVISOR 1))))
(%PUT (QUOTE FTRUNCATE) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE FTRUNCATE) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE FROUND) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Same as ROUND, but returns first value as a float."))
#_(LAP #0_FROUND EXPR
(ENTRY-POINTS (2-FEW 1 2 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(1)
(CODE-START)
(LABEL 1) (MOVE O2 (CONSTANT 0))
(LABEL 2) (ADDI Q 5)
(MOVEM O1 -4 Q)
(MOVEM O2 -3 Q)
(CALL ROUND 2)
(ADJUST-VALUES 2)
(MOVEM O1 -2 Q)
(MOVEM O2 -1 Q)
(CALL FLOAT 1)
(MOVEM O1 0 Q)
(MOVE O2 -1 Q)
(MOVEI N 2)
(SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE FROUND) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NUMBER &OPTIONAL (DIVISOR 1))))
(%PUT (QUOTE FROUND) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE FROUND) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE COMPLEX) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Builds a complex number. Currently, complex numbers are not supported."))
#_(LAP #0_COMPLEX EXPR
(ENTRY-POINTS (2-FEW 1 2 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(0 "Complex numbers are not yet implemented." "~S is a complex number." %COMPLEX-REAL-PART-SLOT %COMPLEX-IMAGINARY-PART-SLOT)
(CODE-START)
(LABEL 1) (MOVE O2 (CONSTANT 0))
(LABEL 2) (ADDI Q 4)
(MOVEM O1 -3 Q)
(MOVEM O2 -2 Q)
(MOVE O1 (CONSTANT 1))
(CALL ERROR 1)
(MOVE O1 -3 Q)
(CALL COMPLEXP 1)
(JUMPE O1 4)
(MOVE O2 -3 Q)
(MOVE O1 (CONSTANT 2))
(CALL ERROR 2)
(LABEL 4) (MOVE O1 -2 Q)
(CALL COMPLEXP 1)
(JUMPE O1 6)
(MOVE O2 -2 Q)
(MOVE O1 (CONSTANT 2))
(CALL ERROR 2)
(LABEL 6) (CALL LISP::%SP-ALLOC-COMPLEX 0)
(MOVEM O1 -1 Q)
(MOVE O5 (SPECIAL 3))
(MOVEM O5 0 Q)
(MOVE O3 -3 Q)
(MOVE O2 O5)
(ADDI O1 0 O2)
(MOVEM O3 0 O1)
(MOVE O5 (SPECIAL 4))
(MOVEM O5 0 Q)
(MOVE O3 -2 Q)
(MOVE O1 -1 Q)
(MOVE O2 O5)
(ADDI O1 0 O2)
(MOVEM O3 0 O1)
(MOVE O1 -1 Q)
(MOVEI N 1)
(SUBI Q 4)
(POPJ P)
)
(%PUT (QUOTE COMPLEX) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (REALPART &OPTIONAL (IMAGPART 0))))
(%PUT (QUOTE COMPLEX) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE COMPLEX) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE REALPART) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Extracts the real part of a number."))
#_(LAP #0_REALPART EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(%COMPLEX-REAL-PART-SLOT)
(CODE-START)
(LABEL 1) (ADDI Q 1)
(MOVEM O1 0 Q)
(CALL COMPLEXP 1)
(JUMPE O1 3)
(MOVE O2 (SPECIAL 0))
(MOVE O1 0 Q)
(ADDI O1 0 O2)
(MOVE O1 0 O1)
(MOVEI N 1)
(JRST 4)
(LABEL 3) (MOVE O1 0 Q)
(MOVEI N 1)
(LABEL 4) (SUBI Q 1)
(POPJ P)
)
(%PUT (QUOTE REALPART) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NUMBER)))
(%PUT (QUOTE REALPART) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE REALPART) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE IMAGPART) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Extracts the imaginary part of a number."))
#_(LAP #0_IMAGPART EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(COMPLEX %COMPLEX-IMAGINARY-PART-SLOT NUMBER 0 "~S not a number.")
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVE O5 O1)
(MOVEM O5 0 Q)
(MOVE O2 (CONSTANT 0))
(CALL TYPEP 2)
(JUMPE O1 4)
(MOVE O2 (SPECIAL 1))
(MOVE O1 -1 Q)
(ADDI O1 0 O2)
(MOVE O1 0 O1)
(MOVEI N 1)
(JRST 3)
(LABEL 4) (MOVE O2 (CONSTANT 2))
(MOVE O1 0 Q)
(CALL TYPEP 2)
(JUMPE O1 5)
(MOVE O1 -1 Q)
(CALL TYPE-OF 1)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 3))
(CALL COERCE 2)
(JRST 3)
(LABEL 5) (SKIPA)
(JRST 6)
(MOVE O2 -1 Q)
(MOVE O1 (CONSTANT 4))
(CALL ERROR 2)
(LABEL 6)
(LABEL 3) (SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE IMAGPART) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NUMBER)))
(%PUT (QUOTE IMAGPART) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE IMAGPART) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LOGIOR) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the bit-wise or of its arguments. Args must be integers."))
#_(LAP #0_LOGIOR EXPR
(ENTRY-POINTS (2 3 4 5 6 7 8) REST)
#0_(7 0)
(CODE-START)
(LABEL 2) (MOVE O1 NIL)
(JRST 1)
(LABEL 3) (MOVEI W2 1)
(ICALL REST1)
(JRST 1)
(LABEL 4) (MOVEI W2 2)
(ICALL REST2)
(JRST 1)
(LABEL 5) (MOVEI W2 3)
(ICALL REST3)
(JRST 1)
(LABEL 6) (MOVEI W2 4)
(ICALL REST4)
(JRST 1)
(LABEL 7) (MOVEI W2 5)
(ICALL REST5)
(JRST 1)
(LABEL 8) (MOVEI W2 0)
(ICALL RESTX)
(LABEL 1) (ADDI Q 4)
(MOVEM O1 -3 Q)
(SKIPN NIL -3 Q)
(JRST 10)
(MOVE O1 -3 Q)
(MOVE O5 0 O1)
(MOVEM O5 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -3 Q)
(MOVEM O5 -2 Q)
(LABEL 16) (SKIPE NIL -3 Q)
(JRST 17)
(MOVE O1 -2 Q)
(MOVEI N 1)
(JRST 12)
(LABEL 17) (MOVE O1 -3 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O1 1 O1)
(MOVEM O1 -3 Q)
(MOVE O3 O5)
(MOVE O1 (CONSTANT 0))
(MOVE O2 -2 Q)
(CALL BOOLE 3)
(MOVEM O1 -2 Q)
(JRST 16)
(LABEL 12) (JRST 11)
(LABEL 10) (MOVE O1 (CONSTANT 1))
(MOVEI N 1)
(LABEL 11) (SUBI Q 4)
(POPJ P)
)
(%PUT (QUOTE LOGIOR) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (&REST INTEGERS)))
(%PUT (QUOTE LOGIOR) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE LOGIOR) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LOGXOR) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the bit-wise exclusive or of its arguments. Args must be integers."))
#_(LAP #0_LOGXOR EXPR
(ENTRY-POINTS (2 3 4 5 6 7 8) REST)
#0_(6 0)
(CODE-START)
(LABEL 2) (MOVE O1 NIL)
(JRST 1)
(LABEL 3) (MOVEI W2 1)
(ICALL REST1)
(JRST 1)
(LABEL 4) (MOVEI W2 2)
(ICALL REST2)
(JRST 1)
(LABEL 5) (MOVEI W2 3)
(ICALL REST3)
(JRST 1)
(LABEL 6) (MOVEI W2 4)
(ICALL REST4)
(JRST 1)
(LABEL 7) (MOVEI W2 5)
(ICALL REST5)
(JRST 1)
(LABEL 8) (MOVEI W2 0)
(ICALL RESTX)
(LABEL 1) (ADDI Q 4)
(MOVEM O1 -3 Q)
(SKIPN NIL -3 Q)
(JRST 10)
(MOVE O1 -3 Q)
(MOVE O5 0 O1)
(MOVEM O5 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -3 Q)
(MOVEM O5 -2 Q)
(LABEL 16) (SKIPE NIL -3 Q)
(JRST 17)
(MOVE O1 -2 Q)
(MOVEI N 1)
(JRST 12)
(LABEL 17) (MOVE O1 -3 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O1 1 O1)
(MOVEM O1 -3 Q)
(MOVE O3 O5)
(MOVE O1 (CONSTANT 0))
(MOVE O2 -2 Q)
(CALL BOOLE 3)
(MOVEM O1 -2 Q)
(JRST 16)
(LABEL 12) (JRST 11)
(LABEL 10) (MOVE O1 (CONSTANT 1))
(MOVEI N 1)
(LABEL 11) (SUBI Q 4)
(POPJ P)
)
(%PUT (QUOTE LOGXOR) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (&REST INTEGERS)))
(%PUT (QUOTE LOGXOR) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE LOGXOR) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LOGAND) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the bit-wise and of its arguments. Args must be integers."))
#_(LAP #0_LOGAND EXPR
(ENTRY-POINTS (2 3 4 5 6 7 8) REST)
#0_(1 -1)
(CODE-START)
(LABEL 2) (MOVE O1 NIL)
(JRST 1)
(LABEL 3) (MOVEI W2 1)
(ICALL REST1)
(JRST 1)
(LABEL 4) (MOVEI W2 2)
(ICALL REST2)
(JRST 1)
(LABEL 5) (MOVEI W2 3)
(ICALL REST3)
(JRST 1)
(LABEL 6) (MOVEI W2 4)
(ICALL REST4)
(JRST 1)
(LABEL 7) (MOVEI W2 5)
(ICALL REST5)
(JRST 1)
(LABEL 8) (MOVEI W2 0)
(ICALL RESTX)
(LABEL 1) (ADDI Q 4)
(MOVEM O1 -3 Q)
(SKIPN NIL -3 Q)
(JRST 10)
(MOVE O1 -3 Q)
(MOVE O5 0 O1)
(MOVEM O5 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -3 Q)
(MOVEM O5 -2 Q)
(LABEL 16) (SKIPE NIL -3 Q)
(JRST 17)
(MOVE O1 -2 Q)
(MOVEI N 1)
(JRST 12)
(LABEL 17) (MOVE O1 -3 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O1 1 O1)
(MOVEM O1 -3 Q)
(MOVE O3 O5)
(MOVE O1 (CONSTANT 0))
(MOVE O2 -2 Q)
(CALL BOOLE 3)
(MOVEM O1 -2 Q)
(JRST 16)
(LABEL 12) (JRST 11)
(LABEL 10) (MOVE O1 (CONSTANT 1))
(MOVEI N 1)
(LABEL 11) (SUBI Q 4)
(POPJ P)
)
(%PUT (QUOTE LOGAND) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (&REST INTEGERS)))
(%PUT (QUOTE LOGAND) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE LOGAND) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LOGEQV) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the bit-wise equivalence of its arguments. Args must be integers."))
#_(LAP #0_LOGEQV EXPR
(ENTRY-POINTS (2 3 4 5 6 7 8) REST)
#0_(9 -1)
(CODE-START)
(LABEL 2) (MOVE O1 NIL)
(JRST 1)
(LABEL 3) (MOVEI W2 1)
(ICALL REST1)
(JRST 1)
(LABEL 4) (MOVEI W2 2)
(ICALL REST2)
(JRST 1)
(LABEL 5) (MOVEI W2 3)
(ICALL REST3)
(JRST 1)
(LABEL 6) (MOVEI W2 4)
(ICALL REST4)
(JRST 1)
(LABEL 7) (MOVEI W2 5)
(ICALL REST5)
(JRST 1)
(LABEL 8) (MOVEI W2 0)
(ICALL RESTX)
(LABEL 1) (ADDI Q 4)
(MOVEM O1 -3 Q)
(SKIPN NIL -3 Q)
(JRST 10)
(MOVE O1 -3 Q)
(MOVE O5 0 O1)
(MOVEM O5 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -3 Q)
(MOVEM O5 -2 Q)
(LABEL 16) (SKIPE NIL -3 Q)
(JRST 17)
(MOVE O1 -2 Q)
(MOVEI N 1)
(JRST 12)
(LABEL 17) (MOVE O1 -3 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O1 1 O1)
(MOVEM O1 -3 Q)
(MOVE O3 O5)
(MOVE O1 (CONSTANT 0))
(MOVE O2 -2 Q)
(CALL BOOLE 3)
(MOVEM O1 -2 Q)
(JRST 16)
(LABEL 12) (JRST 11)
(LABEL 10) (MOVE O1 (CONSTANT 1))
(MOVEI N 1)
(LABEL 11) (SUBI Q 4)
(POPJ P)
)
(%PUT (QUOTE LOGEQV) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (&REST INTEGERS)))
(%PUT (QUOTE LOGEQV) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE LOGEQV) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LOGNAND) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the complement of the logical AND of integer1 and integer2."))
#_(LAP #0_LOGNAND EXPR
(ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(14)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVEM O2 0 Q)
(MOVE O3 O2)
(MOVE O1 (CONSTANT 0))
(MOVE O2 -1 Q)
(CALL BOOLE 3)
(SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE LOGNAND) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (INTEGER1 INTEGER2)))
(%PUT (QUOTE LOGNAND) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE LOGNAND) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LOGNOR) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the complement of the logical OR of integer1 and integer2."))
#_(LAP #0_LOGNOR EXPR
(ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(8)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVEM O2 0 Q)
(MOVE O3 O2)
(MOVE O1 (CONSTANT 0))
(MOVE O2 -1 Q)
(CALL BOOLE 3)
(SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE LOGNOR) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (INTEGER1 INTEGER2)))
(%PUT (QUOTE LOGNOR) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE LOGNOR) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LOGANDC1) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the logical AND of (LOGNOT integer1) and integer2."))
#_(LAP #0_LOGANDC1 EXPR
(ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(2)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVEM O2 0 Q)
(MOVE O3 O2)
(MOVE O1 (CONSTANT 0))
(MOVE O2 -1 Q)
(CALL BOOLE 3)
(SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE LOGANDC1) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (INTEGER1 INTEGER2)))
(%PUT (QUOTE LOGANDC1) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE LOGANDC1) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LOGANDC2) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the logical AND of integer1 and (LOGNOT integer2)."))
#_(LAP #0_LOGANDC2 EXPR
(ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(4)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVEM O2 0 Q)
(MOVE O3 O2)
(MOVE O1 (CONSTANT 0))
(MOVE O2 -1 Q)
(CALL BOOLE 3)
(SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE LOGANDC2) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (INTEGER1 INTEGER2)))
(%PUT (QUOTE LOGANDC2) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE LOGANDC2) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LOGORC1) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the logical OR of (LOGNOT integer1) and integer2."))
#_(LAP #0_LOGORC1 EXPR
(ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(11)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVEM O2 0 Q)
(MOVE O3 O2)
(MOVE O1 (CONSTANT 0))
(MOVE O2 -1 Q)
(CALL BOOLE 3)
(SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE LOGORC1) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (INTEGER1 INTEGER2)))
(%PUT (QUOTE LOGORC1) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE LOGORC1) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LOGORC2) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the logical OR of integer1 and (LOGNOT integer2)."))
#_(LAP #0_LOGORC2 EXPR
(ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(13)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVEM O2 0 Q)
(MOVE O3 O2)
(MOVE O1 (CONSTANT 0))
(MOVE O2 -1 Q)
(CALL BOOLE 3)
(SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE LOGORC2) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (INTEGER1 INTEGER2)))
(%PUT (QUOTE LOGORC2) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE LOGORC2) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LOGNOT) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the bit-wise logical not of integer."))
#_(LAP #0_LOGNOT EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(10 0)
(CODE-START)
(LABEL 1) (ADDI Q 1)
(MOVEM O1 0 Q)
(MOVE O3 (CONSTANT 1))
(MOVE O1 (CONSTANT 0))
(MOVE O2 0 Q)
(CALL BOOLE 3)
(SUBI Q 1)
(POPJ P)
)
(%PUT (QUOTE LOGNOT) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NUMBER)))
(%PUT (QUOTE LOGNOT) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE LOGNOT) (QUOTE %SOURCE-DOCUMENTATION))))
(DEFCONSTANT BOOLE-CLR 0 "Boole function op, makes BOOLE return 0.")
(DEFCONSTANT BOOLE-SET 15 "Boole function op, makes BOOLE return -1.")
(DEFCONSTANT BOOLE-1 5 "Boole function op, makes BOOLE return integer1.")
(DEFCONSTANT BOOLE-2 3 "Boole function op, makes BOOLE return integer2.")
(DEFCONSTANT BOOLE-C1 10 "Boole function op, makes BOOLE return complement of integer1.")
(DEFCONSTANT BOOLE-C2 12 "Boole function op, makes BOOLE return complement of integer2.")
(DEFCONSTANT BOOLE-AND 1 "Boole function op, makes BOOLE return logand of integer1 and integer2.")
(DEFCONSTANT BOOLE-IOR 7 "Boole function op, makes BOOLE return logior of integer1 and integer2.")
(DEFCONSTANT BOOLE-XOR 6 "Boole function op, makes BOOLE return logxor of integer1 and integer2.")
(DEFCONSTANT BOOLE-EQV 9 "Boole function op, makes BOOLE return logeqv of integer1 and integer2.")
(DEFCONSTANT BOOLE-NAND 14 "Boole function op, makes BOOLE return log nand of integer1 and integer2.")
(DEFCONSTANT BOOLE-NOR 8 "Boole function op, makes BOOLE return lognor of integer1 and integer2.")
(DEFCONSTANT BOOLE-ANDC1 2 "Boole function op, makes BOOLE return logandc1 of integer1 and integer2.")
(DEFCONSTANT BOOLE-ANDC2 4 "Boole function op, makes BOOLE return logandc2 of integer1 and integer2.")
(DEFCONSTANT BOOLE-ORC1 11 "Boole function op, makes BOOLE return logorc1 of integer1 and integer2.")
(DEFCONSTANT BOOLE-ORC2 13 "Boole function op, makes BOOLE return logorc2 of integer1 and integer2.")
(%PUT (QUOTE LOGTEST) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Predicate which returns T if logand of integer1 and integer2 is not zero."))
#_(LAP #0_LOGTEST EXPR
(ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(1 T)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVEM O2 0 Q)
(MOVE O3 O2)
(MOVE O1 (CONSTANT 0))
(MOVE O2 -1 Q)
(CALL BOOLE 3)
(CALL ZEROP 1)
(TDCN O1 O1)
(MOVE O1 (CONSTANT 1))
(MOVEI N 1)
(SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE LOGTEST) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (INTEGER1 INTEGER2)))
(%PUT (QUOTE LOGTEST) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE LOGTEST) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LOGBITP) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Predicate returns T if bit index of integer is a 1."))
#_(LAP #0_LOGBITP EXPR
(ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(1 T)
(CODE-START)
(LABEL 1) (ADDI Q 3)
(MOVEM O1 -2 Q)
(MOVEM O2 -1 Q)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 0))
(CALL CONS 2)
(MOVEM O1 0 Q)
(MOVE O2 -1 Q)
(CALL LDB 2)
(CALL ZEROP 1)
(TDCN O1 O1)
(MOVE O1 (CONSTANT 1))
(MOVEI N 1)
(SUBI Q 3)
(POPJ P)
)
(%PUT (QUOTE LOGBITP) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (INDEX INTEGER)))
(%PUT (QUOTE LOGBITP) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE LOGBITP) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LOGCOUNT) (QUOTE %FUN-DOCUMENTATION) (QUOTE "If INTEGER is negative, then # of 0 bits is returned,
else # of 1 bits is returned."))
#_(LAP #0_LOGCOUNT EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(0 1)
(CODE-START)
(LABEL 1) (ADDI Q 6)
(MOVEM O1 -5 Q)
(MOVE O5 (CONSTANT 0))
(MOVEM O5 -4 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE O1 3)
(MOVE O5 (CONSTANT 0))
(MOVEM O5 -3 Q)
(MOVE O1 -5 Q)
(CALL INTEGER-LENGTH 1)
(MOVEM O1 -2 Q)
(LABEL 9) (MOVE O2 -2 Q)
(MOVE O1 -3 Q)
(CALL < 2)
(JUMPN O1 10)
(JRST 5)
(LABEL 10) (MOVE O2 -3 Q)
(MOVE O1 (CONSTANT 1))
(CALL CONS 2)
(MOVEM O1 -1 Q)
(MOVE O2 -5 Q)
(CALL LDB 2)
(CALL ZEROP 1)
(JUMPE O1 12)
(MOVE O1 -4 Q)
(CALL 1+ 1)
(MOVEM O1 0 Q)
(MOVEM O1 -4 Q)
(LABEL 12) (MOVE O1 -3 Q)
(CALL 1+ 1)
(MOVEM O1 -3 Q)
(JRST 9)
(LABEL 5) (JRST 4)
(LABEL 3) (MOVE O5 (CONSTANT 0))
(MOVEM O5 -3 Q)
(MOVE O1 -5 Q)
(CALL INTEGER-LENGTH 1)
(MOVEM O1 -2 Q)
(LABEL 18) (MOVE O2 -2 Q)
(MOVE O1 -3 Q)
(CALL < 2)
(JUMPN O1 19)
(JRST 14)
(LABEL 19) (MOVE O2 -3 Q)
(MOVE O1 (CONSTANT 1))
(CALL CONS 2)
(MOVEM O1 -1 Q)
(MOVE O2 -5 Q)
(CALL LDB 2)
(CALL ZEROP 1)
(JUMPN O1 21)
(MOVE O1 -4 Q)
(CALL 1+ 1)
(MOVEM O1 0 Q)
(MOVEM O1 -4 Q)
(LABEL 21) (MOVE O1 -3 Q)
(CALL 1+ 1)
(MOVEM O1 -3 Q)
(JRST 18)
(LABEL 14)
(LABEL 4) (MOVE O1 -4 Q)
(MOVEI N 1)
(SUBI Q 6)
(POPJ P)
)
(%PUT (QUOTE LOGCOUNT) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (INTEGER)))
(%PUT (QUOTE LOGCOUNT) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE LOGCOUNT) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LDB-TEST) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns T if any of the specified bits in integer are 1's."))
#_(LAP #0_LDB-TEST EXPR
(ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(T)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVEM O2 0 Q)
(CALL LDB 2)
(CALL ZEROP 1)
(TDCN O1 O1)
(MOVE O1 (CONSTANT 0))
(MOVEI N 1)
(SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE LDB-TEST) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (BYTESPEC INTEGER)))
(%PUT (QUOTE LDB-TEST) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE LDB-TEST) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE DEPOSIT-FIELD) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns new integer with newbyte in specified position, newbyte is not
right justified."))
#_(LAP #0_DEPOSIT-FIELD EXPR
(ENTRY-POINTS (2-FEW 2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY))
#0_NIL
(CODE-START)
(LABEL 1) (ADDI Q 4)
(MOVEM O1 -3 Q)
(MOVEM O2 -2 Q)
(MOVEM O3 -1 Q)
(MOVE O2 O1)
(MOVE O1 -2 Q)
(CALL LDB 2)
(MOVEM O1 0 Q)
(MOVE O3 -1 Q)
(MOVE O2 -2 Q)
(CALL DPB 3)
(SUBI Q 4)
(POPJ P)
)
(%PUT (QUOTE DEPOSIT-FIELD) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NEWBYTE BYTESPEC INTEGER)))
(%PUT (QUOTE DEPOSIT-FIELD) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE DEPOSIT-FIELD) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LCM2) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Least common multiple of two nonzero integers. No type checking."))
#_(LAP #0_LCM2 EXPR
(ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
#0_NIL
(CODE-START)
(LABEL 1) (ADDI Q 3)
(MOVEM O1 -2 Q)
(MOVEM O2 -1 Q)
(CALL > 2)
(JUMPE O1 3)
(MOVE O5 -2 Q)
(MOVEM O5 0 Q)
(JRST 4)
(LABEL 3) (MOVE O5 -1 Q)
(MOVEM O5 0 Q)
(LABEL 4) (MOVE O2 -1 Q)
(MOVE O1 -2 Q)
(CALL GCD 2)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL / 2)
(MOVEM O1 0 Q)
(MOVE O2 -1 Q)
(MOVE O1 -2 Q)
(CALL < 2)
(JUMPE O1 5)
(MOVE O2 -2 Q)
(JRST 6)
(LABEL 5) (MOVE O2 -1 Q)
(LABEL 6) (MOVE O1 0 Q)
(CALL * 2)
(SUBI Q 3)
(POPJ P)
)
(%PUT (QUOTE LCM2) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (N M)))
(%PUT (QUOTE LCM2) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE LCM2) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LCM) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns the least common multiple of one or more integers."))
#_(LAP #0_LCM EXPR
(ENTRY-POINTS (2 3 4 5 6 7 8) REST)
#0_(1 "Lcm: argument not an integer, ~A" 0)
(CODE-START)
(LABEL 2) (MOVE O1 NIL)
(JRST 1)
(LABEL 3) (MOVEI W2 1)
(ICALL REST1)
(JRST 1)
(LABEL 4) (MOVEI W2 2)
(ICALL REST2)
(JRST 1)
(LABEL 5) (MOVEI W2 3)
(ICALL REST3)
(JRST 1)
(LABEL 6) (MOVEI W2 4)
(ICALL REST4)
(JRST 1)
(LABEL 7) (MOVEI W2 5)
(ICALL REST5)
(JRST 1)
(LABEL 8) (MOVEI W2 0)
(ICALL RESTX)
(LABEL 1) (ADDI Q 6)
(MOVEM O1 -5 Q)
(MOVE O5 O1)
(MOVEM O5 -4 Q)
(MOVE O5 (CONSTANT 0))
(MOVEM O5 -3 Q)
(LABEL 14) (SKIPE NIL -4 Q)
(JRST 15)
(MOVE O1 -3 Q)
(MOVEI N 1)
(JRST 10)
(LABEL 15) (MOVE O1 -4 Q)
(MOVE O1 0 O1)
(CALL INTEGERP 1)
(JUMPN O1 18)
(MOVE O1 -4 Q)
(MOVE O2 0 O1)
(MOVE O1 (CONSTANT 1))
(CALL ERROR 2)
(JRST 17)
(LABEL 18) (MOVE O1 -4 Q)
(MOVE O1 0 O1)
(CALL ZEROP 1)
(JUMPE O1 19)
(MOVE O1 -4 Q)
(MOVE O5 1 O1)
(MOVEM O5 -1 Q)
(MOVE O1 O5)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(LABEL 24) (MOVE O1 -1 Q)
(CALL ATOM 1)
(JUMPE O1 25)
(JRST 20)
(LABEL 25) (MOVE O1 0 Q)
(CALL INTEGERP 1)
(JUMPN O1 27)
(MOVE O2 0 Q)
(MOVE O1 (CONSTANT 1))
(CALL ERROR 2)
(LABEL 27) (MOVE O1 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -1 Q)
(MOVE O1 0 O1)
(MOVEM O1 0 Q)
(JRST 24)
(LABEL 20) (MOVE O1 (CONSTANT 2))
(MOVEI N 1)
(JRST 10)
(LABEL 19)
(LABEL 17) (MOVE O1 -4 Q)
(MOVE O5 1 O1)
(MOVEM O5 -2 Q)
(MOVE O2 0 O1)
(MOVE O1 -3 Q)
(CALL LISP::LCM2 2)
(MOVEM O1 -1 Q)
(MOVE O1 -2 Q)
(MOVEM O1 -4 Q)
(MOVE O1 -1 Q)
(MOVEM O1 -3 Q)
(JRST 14)
(LABEL 10) (SUBI Q 6)
(POPJ P)
)
(%PUT (QUOTE LCM) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (&REST ARGS)))
(%PUT (QUOTE LCM) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE LCM) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE FLOAT-DIGITS) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns, as a non-negative integer, the number of radix-b digits used in
the representation of its argument."))
#_(LAP #0_FLOAT-DIGITS EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(SHORT-FLOAT 23 LONG-FLOAT 62 "Float-digits: ~A not a float")
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVE O5 O1)
(MOVEM O5 0 Q)
(MOVE O2 (CONSTANT 0))
(CALL TYPEP 2)
(JUMPE O1 4)
(MOVE O1 (CONSTANT 1))
(MOVEI N 1)
(JRST 3)
(LABEL 4) (MOVE O2 (CONSTANT 2))
(MOVE O1 0 Q)
(CALL TYPEP 2)
(JUMPE O1 5)
(MOVE O1 (CONSTANT 3))
(MOVEI N 1)
(JRST 3)
(LABEL 5) (SKIPA)
(JRST 6)
(MOVE O2 -1 Q)
(MOVE O1 (CONSTANT 4))
(CALL ERROR 2)
(LABEL 6)
(LABEL 3) (SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE FLOAT-DIGITS) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (F)))
(%PUT (QUOTE FLOAT-DIGITS) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE FLOAT-DIGITS) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE FLOAT-PRECISION) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns, as a non-negative integer, the number of significant radix-b
digits present in the argument: if the argument is (a floating-point) zero,
then the result is (an integer) zero."))
#_(LAP #0_FLOAT-PRECISION EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(0)
(CODE-START)
(LABEL 1) (ADDI Q 1)
(MOVEM O1 0 Q)
(CALL ZEROP 1)
(JUMPE O1 3)
(MOVE O1 (CONSTANT 0))
(MOVEI N 1)
(JRST 4)
(LABEL 3) (MOVE O1 0 Q)
(CALL FLOAT-DIGITS 1)
(LABEL 4) (SUBI Q 1)
(POPJ P)
)
(%PUT (QUOTE FLOAT-PRECISION) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (F)))
(%PUT (QUOTE FLOAT-PRECISION) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ARITH.CLISP.11") (GET (QUOTE FLOAT-PRECISION) (QUOTE %SOURCE-DOCUMENTATION))))