Trailing-Edge
-
PDP-10 Archives
-
clisp
-
clisp/upsala/char.lap
There are no other files named char.lap in the archive.
;;; CLC vP.U.V.1(2) compiling CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10
(IN-PACKAGE (QUOTE LISP))
(EXPORT (QUOTE (CHAR-CODE-LIMIT CHAR-FONT-LIMIT CHAR-BITS-LIMIT STANDARD-CHAR-P GRAPHIC-CHAR-P STRING-CHAR-P ALPHA-CHAR-P UPPER-CASE-P LOWER-CASE-P BOTH-CASE-P DIGIT-CHAR-P ALPHANUMERICP CHAR= CHAR/= CHAR< CHAR> CHAR<= CHAR>= CHAR-EQUAL CHAR-NOT-EQUAL CHAR-LESSP CHAR-GREATERP CHAR-NOT-GREATERP CHAR-NOT-LESSP CHARACTER CHAR-CODE CHAR-BITS CHAR-FONT CODE-CHAR MAKE-CHAR CHAR-UPCASE CHAR-DOWNCASE DIGIT-CHAR CHAR-INT INT-CHAR CHAR-NAME NAME-CHAR CHAR-CONTROL-BIT CHAR-META-BIT CHAR-HYPER-BIT CHAR-SUPER-BIT CHAR-BIT SET-CHAR-BIT)))
(DEFCONSTANT CHAR-CODE-LIMIT 128 "The upper exclusive bound on values produced by CHAR-CODE.")
(DEFCONSTANT CHAR-FONT-LIMIT 256 "The upper exclusive bound on values produced by CHAR-FONT.")
(DEFCONSTANT CHAR-BITS-LIMIT 256 "The upper exclusive bound on values produced by CHAR-BITS.")
(DEFCONSTANT CHAR-CONTROL-BIT 1 "This bit indicates a control character.")
(DEFCONSTANT CHAR-META-BIT 2 "This bit indicates a meta character.")
(DEFCONSTANT CHAR-SUPER-BIT 4 "This bit indicates a super character.")
(DEFCONSTANT CHAR-HYPER-BIT 8 "This bit indicates a hyper character.")
(%PUT (QUOTE STANDARD-CHAR-P) (QUOTE %FUN-DOCUMENTATION) (QUOTE "The argument must be a character object. Standard-char-p returns T if the
argument is a standard character -- one of the 95 ASCII printing characters
or <return>."))
#_(LAP #0_STANDARD-CHAR-P EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(8388607 31 127 13)
(CODE-START)
(LABEL 1) (ADDI Q 3)
(MOVEM O1 -2 Q)
(CALL LISP::GET-AND-CHECK-INT 1)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 0))
(CALL LOGAND 2)
(MOVEM O1 -1 Q)
(MOVE O3 (CONSTANT 2))
(MOVE O1 (CONSTANT 1))
(MOVE O2 -1 Q)
(CALL < 3)
(JUMPN O1 3)
(MOVE O2 (CONSTANT 3))
(MOVE O1 -1 Q)
(CALL = 2)
(LABEL 3) (SUBI Q 3)
(POPJ P)
)
(%PUT (QUOTE STANDARD-CHAR-P) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHAR)))
(%PUT (QUOTE STANDARD-CHAR-P) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE STANDARD-CHAR-P) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE GRAPHIC-CHAR-P) (QUOTE %FUN-DOCUMENTATION) (QUOTE "The argument must be a character object. Graphic-char-p returns T if the
argument is a printing character (space through ~ in ASCII), otherwise
returns ()."))
#_(LAP #0_GRAPHIC-CHAR-P EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(31 32767 127)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(CALL LISP::GET-AND-CHECK-INT 1)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 1))
(CALL LOGAND 2)
(MOVEM O1 0 Q)
(MOVE O3 (CONSTANT 2))
(MOVE O1 (CONSTANT 0))
(MOVE O2 0 Q)
(CALL < 3)
(SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE GRAPHIC-CHAR-P) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHAR)))
(%PUT (QUOTE GRAPHIC-CHAR-P) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE GRAPHIC-CHAR-P) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE STRING-CHAR-P) (QUOTE %FUN-DOCUMENTATION) (QUOTE "The argument must be a character object. String-char-p returns T if the
argument can be stored in a string."))
#_(LAP #0_STRING-CHAR-P EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(128)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(CALL CHAR-INT 1)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE STRING-CHAR-P) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHAR)))
(%PUT (QUOTE STRING-CHAR-P) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE STRING-CHAR-P) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE ALPHA-CHAR-P) (QUOTE %FUN-DOCUMENTATION) (QUOTE "The argument must be a character object. Alpha-char-p returns T if the
argument is an alphabetic character, A-Z or a-z; otherwise ()."))
#_(LAP #0_ALPHA-CHAR-P EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(32767 64 91 96 123)
(CODE-START)
(LABEL 1) (ADDI Q 3)
(MOVEM O1 -2 Q)
(CALL LISP::GET-AND-CHECK-INT 1)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 0))
(CALL LOGAND 2)
(MOVEM O1 -1 Q)
(MOVE O3 (CONSTANT 2))
(MOVE O1 (CONSTANT 1))
(MOVE O2 -1 Q)
(CALL < 3)
(JUMPN O1 3)
(MOVE O3 (CONSTANT 4))
(MOVE O1 (CONSTANT 3))
(MOVE O2 -1 Q)
(CALL < 3)
(LABEL 3) (SUBI Q 3)
(POPJ P)
)
(%PUT (QUOTE ALPHA-CHAR-P) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHAR)))
(%PUT (QUOTE ALPHA-CHAR-P) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE ALPHA-CHAR-P) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE UPPER-CASE-P) (QUOTE %FUN-DOCUMENTATION) (QUOTE "The argument must be a character object; upper-case-p returns T if the
argument is an upper-case character, () otherwise."))
#_(LAP #0_UPPER-CASE-P EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(64 32767 91)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(CALL LISP::GET-AND-CHECK-INT 1)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 1))
(CALL LOGAND 2)
(MOVEM O1 0 Q)
(MOVE O3 (CONSTANT 2))
(MOVE O1 (CONSTANT 0))
(MOVE O2 0 Q)
(CALL < 3)
(SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE UPPER-CASE-P) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHAR)))
(%PUT (QUOTE UPPER-CASE-P) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE UPPER-CASE-P) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LOWER-CASE-P) (QUOTE %FUN-DOCUMENTATION) (QUOTE "The argument must be a character object; lower-case-p returns T if the
argument is a lower-case character, () otherwise."))
#_(LAP #0_LOWER-CASE-P EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(96 32767 123)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(CALL LISP::GET-AND-CHECK-INT 1)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 1))
(CALL LOGAND 2)
(MOVEM O1 0 Q)
(MOVE O3 (CONSTANT 2))
(MOVE O1 (CONSTANT 0))
(MOVE O2 0 Q)
(CALL < 3)
(SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE LOWER-CASE-P) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHAR)))
(%PUT (QUOTE LOWER-CASE-P) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE LOWER-CASE-P) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE BOTH-CASE-P) (QUOTE %FUN-DOCUMENTATION) (QUOTE "The argument must be a character object. Both-case-p returns T if the
argument is an alphabetic character and if the character exists in
both upper and lower case. For ASCII, this is the same as Alpha-char-p."))
#_(LAP #0_BOTH-CASE-P EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(32767 64 91 96 123)
(CODE-START)
(LABEL 1) (ADDI Q 3)
(MOVEM O1 -2 Q)
(CALL LISP::GET-AND-CHECK-INT 1)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 0))
(CALL LOGAND 2)
(MOVEM O1 -1 Q)
(MOVE O3 (CONSTANT 2))
(MOVE O1 (CONSTANT 1))
(MOVE O2 -1 Q)
(CALL < 3)
(JUMPN O1 3)
(MOVE O3 (CONSTANT 4))
(MOVE O1 (CONSTANT 3))
(MOVE O2 -1 Q)
(CALL < 3)
(LABEL 3) (SUBI Q 3)
(POPJ P)
)
(%PUT (QUOTE BOTH-CASE-P) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHAR)))
(%PUT (QUOTE BOTH-CASE-P) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE BOTH-CASE-P) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE DIGIT-CHAR-P) (QUOTE %FUN-DOCUMENTATION) (QUOTE "If char is a digit in the specified radix, returns the fixnum for
which that digit stands, else returns NIL. Radix defaults to 10
(decimal)."))
#_(LAP #0_DIGIT-CHAR-P EXPR
(ENTRY-POINTS (2-FEW 1 2 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(10 32767 48 0 36 "~S too large to be an input radix." 7 32)
(CODE-START)
(LABEL 1) (MOVE O2 (CONSTANT 0))
(LABEL 2) (ADDI Q 4)
(MOVEM O1 -3 Q)
(MOVEM O2 -2 Q)
(CALL LISP::GET-AND-CHECK-INT 1)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 1))
(CALL LOGAND 2)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 2))
(CALL - 2)
(MOVEM O1 -1 Q)
(MOVE O2 (CONSTANT 0))
(MOVE O1 -2 Q)
(CALL > 2)
(JUMPN O1 5)
(MOVE O2 (CONSTANT 3))
(MOVE O1 -1 Q)
(CALL < 2)
(JUMPN O1 8)
(MOVE O2 -2 Q)
(MOVE O1 -1 Q)
(CALL < 2)
(SKIPN NIL O1)
(LABEL 8) (JRST 6)
(MOVE O1 -1 Q)
(MOVEI N 1)
(JRST 7)
(LABEL 6) (MOVE O1 NIL)
(MOVEI N 1)
(LABEL 7) (JRST 4)
(LABEL 5) (MOVE O2 (CONSTANT 4))
(MOVE O1 -2 Q)
(CALL > 2)
(JUMPE O1 10)
(MOVE O2 -2 Q)
(MOVE O1 (CONSTANT 5))
(CALL ERROR 2)
(JRST 4)
(LABEL 10) (MOVE O2 (CONSTANT 3))
(MOVE O1 -1 Q)
(CALL < 2)
(JUMPN O1 12)
(MOVE O2 (CONSTANT 0))
(MOVE O1 -1 Q)
(CALL < 2)
(SKIPN NIL O1)
(LABEL 12) (JRST 11)
(MOVE O1 -1 Q)
(MOVEI N 1)
(JRST 4)
(LABEL 11) (MOVE O2 (CONSTANT 6))
(MOVE O1 -1 Q)
(CALL - 2)
(MOVEM O1 -1 Q)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPN O1 15)
(MOVE O2 -2 Q)
(MOVE O1 -1 Q)
(CALL < 2)
(SKIPN NIL O1)
(LABEL 15) (JRST 14)
(MOVE O1 -1 Q)
(MOVEI N 1)
(JRST 4)
(LABEL 14) (MOVE O2 (CONSTANT 7))
(MOVE O1 -1 Q)
(CALL - 2)
(MOVEM O1 -1 Q)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPN O1 18)
(MOVE O2 -2 Q)
(MOVE O1 -1 Q)
(CALL < 2)
(SKIPN NIL O1)
(LABEL 18) (JRST 17)
(MOVE O1 -1 Q)
(MOVEI N 1)
(JRST 4)
(LABEL 17) (SKIPA)
(JRST 20)
(MOVE O1 NIL)
(MOVEI N 1)
(LABEL 20)
(LABEL 4) (SUBI Q 4)
(POPJ P)
)
(%PUT (QUOTE DIGIT-CHAR-P) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHAR &OPTIONAL (RADIX 10))))
(%PUT (QUOTE DIGIT-CHAR-P) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE DIGIT-CHAR-P) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE DIGIT-CHAR) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Converts a number into a character object, e.g. 1 into #1.
You can specify the radix (default decimal) and font bits (default
0) as options. Returns NIL if request is impossible."))
#_(LAP #0_DIGIT-CHAR EXPR
(ENTRY-POINTS (2-FEW 1 2 3 2-MANY 2-MANY 2-MANY))
#0_(10 0 36 48 55)
(CODE-START)
(LABEL 1) (MOVE O2 (CONSTANT 0))
(LABEL 2) (MOVE O3 (CONSTANT 1))
(LABEL 3) (ADDI Q 4)
(MOVEM O1 -3 Q)
(MOVEM O2 -2 Q)
(MOVEM O3 -1 Q)
(MOVE O2 (CONSTANT 1))
(CALL < 2)
(JUMPN1 O1 7)
(MOVE O2 -2 Q)
(MOVE O1 -3 Q)
(CALL < 2)
(JUMPE1 O1 7)
(MOVE O2 (CONSTANT 2))
(MOVE O1 -2 Q)
(CALL > 2)
(SKIPN NIL O1)
(LABEL 7) (JRST 6)
(MOVE O1 NIL)
(MOVEI N 1)
(JRST 5)
(LABEL 6) (MOVE O2 (CONSTANT 0))
(MOVE O1 -3 Q)
(CALL < 2)
(JUMPE O1 8)
(MOVE O2 (CONSTANT 3))
(MOVE O1 -3 Q)
(CALL + 2)
(MOVEM O1 0 Q)
(MOVE O3 -1 Q)
(MOVE O2 (CONSTANT 1))
(CALL CODE-CHAR 3)
(JRST 5)
(LABEL 8) (SKIPA)
(JRST 9)
(MOVE O2 (CONSTANT 4))
(MOVE O1 -3 Q)
(CALL + 2)
(MOVEM O1 0 Q)
(MOVE O3 -1 Q)
(MOVE O2 (CONSTANT 1))
(CALL CODE-CHAR 3)
(LABEL 9)
(LABEL 5) (SUBI Q 4)
(POPJ P)
)
(%PUT (QUOTE DIGIT-CHAR) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (WEIGHT &OPTIONAL (RADIX 10) (FONT 0))))
(%PUT (QUOTE DIGIT-CHAR) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE DIGIT-CHAR) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE ALPHANUMERICP) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Given a character-object argument, alphanumericp returns T if the
argument is either numeric or alphabetic."))
#_(LAP #0_ALPHANUMERICP EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(32767 47 58 64 91 96 123)
(CODE-START)
(LABEL 1) (ADDI Q 3)
(MOVEM O1 -2 Q)
(CALL LISP::GET-AND-CHECK-INT 1)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 0))
(CALL LOGAND 2)
(MOVEM O1 -1 Q)
(MOVE O3 (CONSTANT 2))
(MOVE O1 (CONSTANT 1))
(MOVE O2 -1 Q)
(CALL < 3)
(JUMPN O1 3)
(MOVE O3 (CONSTANT 4))
(MOVE O1 (CONSTANT 3))
(MOVE O2 -1 Q)
(CALL < 3)
(JUMPN O1 3)
(MOVE O3 (CONSTANT 6))
(MOVE O1 (CONSTANT 5))
(MOVE O2 -1 Q)
(CALL < 3)
(LABEL 3) (SUBI Q 3)
(POPJ P)
)
(%PUT (QUOTE ALPHANUMERICP) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHAR)))
(%PUT (QUOTE ALPHANUMERICP) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE ALPHANUMERICP) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR=) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns T if all of its arguments are the same character."))
#_(LAP #0_CHAR= EXPR
(ENTRY-POINTS (2-FEW 2 3 4 5 6 7) REST)
#0_(T)
(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 4)
(MOVEM O1 -3 Q)
(MOVEM O2 -2 Q)
(MOVE O5 O2)
(MOVEM O5 -1 Q)
(LABEL 13) (MOVE O1 -1 Q)
(CALL ATOM 1)
(JUMPE O1 14)
(MOVE O1 (CONSTANT 0))
(MOVEI N 1)
(JRST 9)
(LABEL 14) (MOVE O1 -1 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O2 -3 Q)
(CAMN O2 0 Q)
(JRST 17)
(MOVE O1 NIL)
(MOVEI N 1)
(JRST 9)
(LABEL 17) (MOVE O1 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -1 Q)
(JRST 13)
(LABEL 9) (SUBI Q 4)
(POPJ P)
)
(%PUT (QUOTE CHAR=) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHARACTER &REST MORE-CHARACTERS)))
(%PUT (QUOTE CHAR=) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR=) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR/=) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns T if no two of its arguments are the same character."))
#_(LAP #0_CHAR/= EXPR
(ENTRY-POINTS (2-FEW 2 3 4 5 6 7) REST)
#0_(T)
(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 O1)
(MOVEM O5 -2 Q)
(MOVE O5 O2)
(MOVEM O5 -1 Q)
(LABEL 13) (MOVE O1 -1 Q)
(CALL ATOM 1)
(JUMPE O1 14)
(MOVE O1 (CONSTANT 0))
(MOVEI N 1)
(JRST 9)
(LABEL 14) (MOVE O5 -1 Q)
(MOVEM O5 0 Q)
(LABEL 22) (MOVE O1 0 Q)
(CALL ATOM 1)
(JUMPE O1 23)
(JRST 18)
(JRST1 18)
(LABEL 23) (MOVE O1 0 Q)
(MOVE O2 0 O1)
(CAME O2 -2 Q)
(JRST 25)
(JRST1 18)
(LABEL 25) (MOVE O1 0 Q)
(MOVE O1 1 O1)
(MOVEM O1 0 Q)
(JRST 22)
(LABEL 18) (JRST 17)
(MOVE O1 NIL)
(MOVEI N 1)
(JRST 9)
(LABEL 17) (MOVE O1 -1 Q)
(MOVE O1 0 O1)
(MOVEM O1 -2 Q)
(MOVE O1 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -1 Q)
(JRST 13)
(LABEL 9) (SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE CHAR/=) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHARACTER &REST MORE-CHARACTERS)))
(%PUT (QUOTE CHAR/=) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR/=) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR<) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns T if its arguments are in strictly increasing alphabetic order."))
#_(LAP #0_CHAR< EXPR
(ENTRY-POINTS (2-FEW 2 3 4 5 6 7) REST)
#0_(T)
(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 O1)
(MOVEM O5 -2 Q)
(MOVE O5 O2)
(MOVEM O5 -1 Q)
(LABEL 13) (MOVE O1 -1 Q)
(CALL ATOM 1)
(JUMPE O1 14)
(MOVE O1 (CONSTANT 0))
(MOVEI N 1)
(JRST 9)
(LABEL 14) (MOVE O1 -2 Q)
(CALL CHAR-INT 1)
(MOVEM O1 0 Q)
(MOVE O1 -1 Q)
(MOVE O1 0 O1)
(CALL CHAR-INT 1)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL < 2)
(JUMPN O1 17)
(MOVE O1 NIL)
(MOVEI N 1)
(JRST 9)
(LABEL 17) (MOVE O1 -1 Q)
(MOVE O1 0 O1)
(MOVEM O1 -2 Q)
(MOVE O1 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -1 Q)
(JRST 13)
(LABEL 9) (SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE CHAR<) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHARACTER &REST MORE-CHARACTERS)))
(%PUT (QUOTE CHAR<) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR<) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR>) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns T if its arguments are in strictly decreasing alphabetic order."))
#_(LAP #0_CHAR> EXPR
(ENTRY-POINTS (2-FEW 2 3 4 5 6 7) REST)
#0_(T)
(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 O1)
(MOVEM O5 -2 Q)
(MOVE O5 O2)
(MOVEM O5 -1 Q)
(LABEL 13) (MOVE O1 -1 Q)
(CALL ATOM 1)
(JUMPE O1 14)
(MOVE O1 (CONSTANT 0))
(MOVEI N 1)
(JRST 9)
(LABEL 14) (MOVE O1 -2 Q)
(CALL CHAR-INT 1)
(MOVEM O1 0 Q)
(MOVE O1 -1 Q)
(MOVE O1 0 O1)
(CALL CHAR-INT 1)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL > 2)
(JUMPN O1 17)
(MOVE O1 NIL)
(MOVEI N 1)
(JRST 9)
(LABEL 17) (MOVE O1 -1 Q)
(MOVE O1 0 O1)
(MOVEM O1 -2 Q)
(MOVE O1 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -1 Q)
(JRST 13)
(LABEL 9) (SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE CHAR>) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHARACTER &REST MORE-CHARACTERS)))
(%PUT (QUOTE CHAR>) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR>) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR<=) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns T if its arguments are in strictly non-decreasing alphabetic order."))
#_(LAP #0_CHAR<= EXPR
(ENTRY-POINTS (2-FEW 2 3 4 5 6 7) REST)
#0_(T)
(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 O1)
(MOVEM O5 -2 Q)
(MOVE O5 O2)
(MOVEM O5 -1 Q)
(LABEL 13) (MOVE O1 -1 Q)
(CALL ATOM 1)
(JUMPE O1 14)
(MOVE O1 (CONSTANT 0))
(MOVEI N 1)
(JRST 9)
(LABEL 14) (MOVE O1 -2 Q)
(CALL CHAR-INT 1)
(MOVEM O1 0 Q)
(MOVE O1 -1 Q)
(MOVE O1 0 O1)
(CALL CHAR-INT 1)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL > 2)
(JUMPE O1 17)
(MOVE O1 NIL)
(MOVEI N 1)
(JRST 9)
(LABEL 17) (MOVE O1 -1 Q)
(MOVE O1 0 O1)
(MOVEM O1 -2 Q)
(MOVE O1 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -1 Q)
(JRST 13)
(LABEL 9) (SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE CHAR<=) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHARACTER &REST MORE-CHARACTERS)))
(%PUT (QUOTE CHAR<=) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR<=) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR>=) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns T if its arguments are in strictly non-increasing alphabetic order."))
#_(LAP #0_CHAR>= EXPR
(ENTRY-POINTS (2-FEW 2 3 4 5 6 7) REST)
#0_(T)
(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 O1)
(MOVEM O5 -2 Q)
(MOVE O5 O2)
(MOVEM O5 -1 Q)
(LABEL 13) (MOVE O1 -1 Q)
(CALL ATOM 1)
(JUMPE O1 14)
(MOVE O1 (CONSTANT 0))
(MOVEI N 1)
(JRST 9)
(LABEL 14) (MOVE O1 -2 Q)
(CALL CHAR-INT 1)
(MOVEM O1 0 Q)
(MOVE O1 -1 Q)
(MOVE O1 0 O1)
(CALL CHAR-INT 1)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL < 2)
(JUMPE O1 17)
(MOVE O1 NIL)
(MOVEI N 1)
(JRST 9)
(LABEL 17) (MOVE O1 -1 Q)
(MOVE O1 0 O1)
(MOVEM O1 -2 Q)
(MOVE O1 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -1 Q)
(JRST 13)
(LABEL 9) (SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE CHAR>=) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHARACTER &REST MORE-CHARACTERS)))
(%PUT (QUOTE CHAR>=) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR>=) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR-EQUAL) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns T if all of its arguments are the same character.
Font, bits, and case are ignored."))
#_(LAP #0_CHAR-EQUAL EXPR
(ENTRY-POINTS (2-FEW 2 3 4 5 6 7) REST)
#0_(T)
(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 4)
(MOVEM O1 -3 Q)
(MOVEM O2 -2 Q)
(MOVE O5 O2)
(MOVEM O5 -1 Q)
(LABEL 13) (MOVE O1 -1 Q)
(CALL ATOM 1)
(JUMPE O1 14)
(MOVE O1 (CONSTANT 0))
(MOVEI N 1)
(JRST 9)
(LABEL 14) (MOVE O1 -1 Q)
(MOVE O1 0 O1)
(CALL LISP::EQUAL-CHAR-INT 1)
(MOVEM O1 0 Q)
(MOVE O1 -3 Q)
(CALL LISP::EQUAL-CHAR-INT 1)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL = 2)
(JUMPN O1 17)
(MOVE O1 NIL)
(MOVEI N 1)
(JRST 9)
(LABEL 17) (MOVE O1 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -1 Q)
(JRST 13)
(LABEL 9) (SUBI Q 4)
(POPJ P)
)
(%PUT (QUOTE CHAR-EQUAL) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHARACTER &REST MORE-CHARACTERS)))
(%PUT (QUOTE CHAR-EQUAL) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR-EQUAL) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR-NOT-EQUAL) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns T if no two of its arguments are the same character.
Font, bits, and case are ignored."))
#_(LAP #0_CHAR-NOT-EQUAL EXPR
(ENTRY-POINTS (2-FEW 2 3 4 5 6 7) REST)
#0_(T)
(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 6)
(MOVEM O1 -5 Q)
(MOVEM O2 -4 Q)
(MOVE O5 O1)
(MOVEM O5 -3 Q)
(MOVE O5 O2)
(MOVEM O5 -2 Q)
(LABEL 13) (MOVE O1 -2 Q)
(CALL ATOM 1)
(JUMPE O1 14)
(MOVE O1 (CONSTANT 0))
(MOVEI N 1)
(JRST 9)
(LABEL 14) (MOVE O5 -2 Q)
(MOVEM O5 -1 Q)
(LABEL 22) (MOVE O1 -1 Q)
(CALL ATOM 1)
(JUMPE O1 23)
(JRST 18)
(JRST1 18)
(LABEL 23) (MOVE O1 -3 Q)
(CALL LISP::EQUAL-CHAR-INT 1)
(MOVEM O1 0 Q)
(MOVE O1 -1 Q)
(MOVE O1 0 O1)
(CALL LISP::EQUAL-CHAR-INT 1)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL = 2)
(JUMPE O1 25)
(JRST1 18)
(LABEL 25) (MOVE O1 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -1 Q)
(JRST 22)
(LABEL 18) (JRST 17)
(MOVE O1 NIL)
(MOVEI N 1)
(JRST 9)
(LABEL 17) (MOVE O1 -2 Q)
(MOVE O1 0 O1)
(MOVEM O1 -3 Q)
(MOVE O1 -2 Q)
(MOVE O1 1 O1)
(MOVEM O1 -2 Q)
(JRST 13)
(LABEL 9) (SUBI Q 6)
(POPJ P)
)
(%PUT (QUOTE CHAR-NOT-EQUAL) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHARACTER &REST MORE-CHARACTERS)))
(%PUT (QUOTE CHAR-NOT-EQUAL) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR-NOT-EQUAL) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR-LESSP) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns T if its arguments are in strictly increasing alphabetic order.
Font, bits, and case are ignored."))
#_(LAP #0_CHAR-LESSP EXPR
(ENTRY-POINTS (2-FEW 2 3 4 5 6 7) REST)
#0_(T)
(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 O1)
(MOVEM O5 -2 Q)
(MOVE O5 O2)
(MOVEM O5 -1 Q)
(LABEL 13) (MOVE O1 -1 Q)
(CALL ATOM 1)
(JUMPE O1 14)
(MOVE O1 (CONSTANT 0))
(MOVEI N 1)
(JRST 9)
(LABEL 14) (MOVE O1 -2 Q)
(CALL LISP::EQUAL-CHAR-INT 1)
(MOVEM O1 0 Q)
(MOVE O1 -1 Q)
(MOVE O1 0 O1)
(CALL LISP::EQUAL-CHAR-INT 1)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL < 2)
(JUMPN O1 17)
(MOVE O1 NIL)
(MOVEI N 1)
(JRST 9)
(LABEL 17) (MOVE O1 -1 Q)
(MOVE O1 0 O1)
(MOVEM O1 -2 Q)
(MOVE O1 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -1 Q)
(JRST 13)
(LABEL 9) (SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE CHAR-LESSP) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHARACTER &REST MORE-CHARACTERS)))
(%PUT (QUOTE CHAR-LESSP) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR-LESSP) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR-GREATERP) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns T if its arguments are in strictly decreasing alphabetic order.
Font, bits, and case are ignored."))
#_(LAP #0_CHAR-GREATERP EXPR
(ENTRY-POINTS (2-FEW 2 3 4 5 6 7) REST)
#0_(T)
(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 O1)
(MOVEM O5 -2 Q)
(MOVE O5 O2)
(MOVEM O5 -1 Q)
(LABEL 13) (MOVE O1 -1 Q)
(CALL ATOM 1)
(JUMPE O1 14)
(MOVE O1 (CONSTANT 0))
(MOVEI N 1)
(JRST 9)
(LABEL 14) (MOVE O1 -2 Q)
(CALL LISP::EQUAL-CHAR-INT 1)
(MOVEM O1 0 Q)
(MOVE O1 -1 Q)
(MOVE O1 0 O1)
(CALL LISP::EQUAL-CHAR-INT 1)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL > 2)
(JUMPN O1 17)
(MOVE O1 NIL)
(MOVEI N 1)
(JRST 9)
(LABEL 17) (MOVE O1 -1 Q)
(MOVE O1 0 O1)
(MOVEM O1 -2 Q)
(MOVE O1 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -1 Q)
(JRST 13)
(LABEL 9) (SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE CHAR-GREATERP) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHARACTER &REST MORE-CHARACTERS)))
(%PUT (QUOTE CHAR-GREATERP) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR-GREATERP) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR-NOT-GREATERP) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns T if its arguments are in strictly non-decreasing alphabetic order.
Font, bits, and case are ignored."))
#_(LAP #0_CHAR-NOT-GREATERP EXPR
(ENTRY-POINTS (2-FEW 2 3 4 5 6 7) REST)
#0_(T)
(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 O1)
(MOVEM O5 -2 Q)
(MOVE O5 O2)
(MOVEM O5 -1 Q)
(LABEL 13) (MOVE O1 -1 Q)
(CALL ATOM 1)
(JUMPE O1 14)
(MOVE O1 (CONSTANT 0))
(MOVEI N 1)
(JRST 9)
(LABEL 14) (MOVE O1 -2 Q)
(CALL LISP::EQUAL-CHAR-INT 1)
(MOVEM O1 0 Q)
(MOVE O1 -1 Q)
(MOVE O1 0 O1)
(CALL LISP::EQUAL-CHAR-INT 1)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL > 2)
(JUMPE O1 17)
(MOVE O1 NIL)
(MOVEI N 1)
(JRST 9)
(LABEL 17) (MOVE O1 -1 Q)
(MOVE O1 0 O1)
(MOVEM O1 -2 Q)
(MOVE O1 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -1 Q)
(JRST 13)
(LABEL 9) (SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE CHAR-NOT-GREATERP) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHARACTER &REST MORE-CHARACTERS)))
(%PUT (QUOTE CHAR-NOT-GREATERP) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR-NOT-GREATERP) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR-NOT-LESSP) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns T if its arguments are in strictly non-increasing alphabetic order.
Font, bits, and case are ignored."))
#_(LAP #0_CHAR-NOT-LESSP EXPR
(ENTRY-POINTS (2-FEW 2 3 4 5 6 7) REST)
#0_(T)
(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 O1)
(MOVEM O5 -2 Q)
(MOVE O5 O2)
(MOVEM O5 -1 Q)
(LABEL 13) (MOVE O1 -1 Q)
(CALL ATOM 1)
(JUMPE O1 14)
(MOVE O1 (CONSTANT 0))
(MOVEI N 1)
(JRST 9)
(LABEL 14) (MOVE O1 -2 Q)
(CALL LISP::EQUAL-CHAR-INT 1)
(MOVEM O1 0 Q)
(MOVE O1 -1 Q)
(MOVE O1 0 O1)
(CALL LISP::EQUAL-CHAR-INT 1)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL < 2)
(JUMPE O1 17)
(MOVE O1 NIL)
(MOVEI N 1)
(JRST 9)
(LABEL 17) (MOVE O1 -1 Q)
(MOVE O1 0 O1)
(MOVEM O1 -2 Q)
(MOVE O1 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -1 Q)
(JRST 13)
(LABEL 9) (SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE CHAR-NOT-LESSP) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHARACTER &REST MORE-CHARACTERS)))
(%PUT (QUOTE CHAR-NOT-LESSP) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR-NOT-LESSP) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHARACTER) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Coerces its argument into a character object if possible. Accepts
characters, strings and symbols of length 1, and integers."))
#_(LAP #0_CHARACTER EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(CHARACTER INTEGER STRING 1 0 "~S is of length >1, can't coerce into a character." SYMBOL "~S can't be coerced into a character.")
(CODE-START)
(LABEL 1) (ADDI Q 3)
(MOVEM O1 -2 Q)
(MOVE O5 O1)
(MOVEM O5 -1 Q)
(MOVE O2 (CONSTANT 0))
(CALL TYPEP 2)
(JUMPE O1 4)
(MOVE O1 -2 Q)
(MOVEI N 1)
(JRST 3)
(LABEL 4) (MOVE O2 (CONSTANT 1))
(MOVE O1 -1 Q)
(CALL TYPEP 2)
(JUMPE O1 5)
(MOVE O1 -2 Q)
(CALL INT-CHAR 1)
(JRST 3)
(LABEL 5) (MOVE O2 (CONSTANT 2))
(MOVE O1 -1 Q)
(CALL TYPEP 2)
(JUMPE O1 6)
(MOVE O1 -2 Q)
(CALL LENGTH 1)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 3))
(CALL = 2)
(JUMPE O1 7)
(MOVE O2 (CONSTANT 4))
(MOVE O1 -2 Q)
(CALL ELT 2)
(JRST 8)
(LABEL 7) (MOVE O2 -2 Q)
(MOVE O1 (CONSTANT 5))
(CALL ERROR 2)
(LABEL 8) (JRST 3)
(LABEL 6) (MOVE O2 (CONSTANT 6))
(MOVE O1 -1 Q)
(CALL TYPEP 2)
(JUMPE O1 9)
(MOVE O1 -2 Q)
(CALL SYMBOL-NAME 1)
(CALL LENGTH 1)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 3))
(CALL = 2)
(JUMPE O1 10)
(MOVE O1 -2 Q)
(CALL SYMBOL-NAME 1)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 4))
(CALL ELT 2)
(JRST 11)
(LABEL 10) (MOVE O2 -2 Q)
(MOVE O1 (CONSTANT 5))
(CALL ERROR 2)
(LABEL 11) (JRST 3)
(LABEL 9) (SKIPA)
(JRST 12)
(MOVE O2 -2 Q)
(MOVE O1 (CONSTANT 7))
(CALL ERROR 2)
(LABEL 12)
(LABEL 3) (SUBI Q 3)
(POPJ P)
)
(%PUT (QUOTE CHARACTER) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (OBJECT)))
(%PUT (QUOTE CHARACTER) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHARACTER) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR-CODE) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Given a character object argument, char-code returns the code attribute
of that object as a non-negative integer."))
#_(LAP #0_CHAR-CODE EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(127)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(CALL LISP::GET-AND-CHECK-INT 1)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 0))
(CALL LOGAND 2)
(SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE CHAR-CODE) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHAR)))
(%PUT (QUOTE CHAR-CODE) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR-CODE) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR-BITS) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Given a character object argument, char-code returns the bits attribute
of that object as a non-negative integer."))
#_(LAP #0_CHAR-BITS EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(29184)
(CODE-START)
(LABEL 1) (ADDI Q 1)
(MOVEM O1 0 Q)
(CALL LISP::GET-AND-CHECK-INT 1)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 0))
(CALL LDB 2)
(SUBI Q 1)
(POPJ P)
)
(%PUT (QUOTE CHAR-BITS) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHAR)))
(%PUT (QUOTE CHAR-BITS) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR-BITS) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR-FONT) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Given a character object argument, char-code returns the font attribute
of that object as a non-negative integer."))
#_(LAP #0_CHAR-FONT EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(61952)
(CODE-START)
(LABEL 1) (ADDI Q 1)
(MOVEM O1 0 Q)
(CALL LISP::GET-AND-CHECK-INT 1)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 0))
(CALL LDB 2)
(SUBI Q 1)
(POPJ P)
)
(%PUT (QUOTE CHAR-FONT) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHAR)))
(%PUT (QUOTE CHAR-FONT) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR-FONT) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CODE-CHAR) (QUOTE %FUN-DOCUMENTATION) (QUOTE "All three arguments, must be non-negative integers; the last two are
optional with default values of 0 (for the bits and font attributes).
Returns a character object with the specified code, bits, and font,
or returns NIL if this is not possible."))
#_(LAP #0_CODE-CHAR EXPR
(ENTRY-POINTS (2-FEW 1 2 3 2-MANY 2-MANY 2-MANY))
#0_(0 -1 128 256 61952 29184)
(CODE-START)
(LABEL 1) (MOVE O2 (CONSTANT 0))
(LABEL 2) (MOVE O3 (CONSTANT 0))
(LABEL 3) (ADDI Q 3)
(MOVEM O1 -2 Q)
(MOVEM O2 -1 Q)
(MOVEM O3 0 Q)
(MOVE O3 (CONSTANT 2))
(MOVE O1 (CONSTANT 1))
(MOVE O2 -2 Q)
(CALL < 3)
(JUMPN O1 6)
(MOVE O1 NIL)
(MOVEI N 1)
(JRST 5)
(LABEL 6) (MOVE O1 -1 Q)
(CALL ZEROP 1)
(JUMPE O1 8)
(MOVE O1 0 Q)
(CALL ZEROP 1)
(JUMPE O1 8)
(MOVE O1 -2 Q)
(CALL INT-CHAR 1)
(JRST 9)
(LABEL 8) (MOVE O1 NIL)
(MOVEI N 1)
(LABEL 9) (JUMPN O1 5)
(MOVE O3 (CONSTANT 3))
(MOVE O1 (CONSTANT 1))
(MOVE O2 -1 Q)
(CALL < 3)
(JUMPE O1 11)
(MOVE O3 (CONSTANT 3))
(MOVE O1 (CONSTANT 1))
(MOVE O2 0 Q)
(CALL < 3)
(JUMPE O1 11)
(MOVE O3 -2 Q)
(MOVE O1 -1 Q)
(MOVE O2 (CONSTANT 5))
(CALL DPB 3)
(MOVE O3 O1)
(MOVE O1 0 Q)
(MOVE O2 (CONSTANT 4))
(CALL DPB 3)
(CALL INT-CHAR 1)
(JRST 12)
(LABEL 11) (MOVE O1 NIL)
(MOVEI N 1)
(LABEL 12)
(LABEL 5) (SUBI Q 3)
(POPJ P)
)
(%PUT (QUOTE CODE-CHAR) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CODE &OPTIONAL (BITS 0) (FONT 0))))
(%PUT (QUOTE CODE-CHAR) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CODE-CHAR) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE MAKE-CHAR) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Replaces the bits and font attributes of the specified character with
those supplied by the user as fixnums. Bits and font both default to 0."))
#_(LAP #0_MAKE-CHAR EXPR
(ENTRY-POINTS (2-FEW 1 2 3 2-MANY 2-MANY 2-MANY))
#0_(0 -1 256 61952 29184 127)
(CODE-START)
(LABEL 1) (MOVE O2 (CONSTANT 0))
(LABEL 2) (MOVE O3 (CONSTANT 0))
(LABEL 3) (ADDI Q 4)
(MOVEM O1 -3 Q)
(MOVEM O2 -2 Q)
(MOVEM O3 -1 Q)
(MOVE O3 (CONSTANT 2))
(MOVE O1 (CONSTANT 1))
(CALL < 3)
(JUMPE O1 5)
(MOVE O3 (CONSTANT 2))
(MOVE O1 (CONSTANT 1))
(MOVE O2 -1 Q)
(CALL < 3)
(JUMPE O1 5)
(MOVE O1 -3 Q)
(CALL LISP::GET-AND-CHECK-INT 1)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 5))
(CALL LOGAND 2)
(MOVE O3 O1)
(MOVE O1 -2 Q)
(MOVE O2 (CONSTANT 4))
(CALL DPB 3)
(MOVE O3 O1)
(MOVE O1 -1 Q)
(MOVE O2 (CONSTANT 3))
(CALL DPB 3)
(CALL LISP::INT-TO-CHAR 1)
(JRST 6)
(LABEL 5) (MOVE O1 NIL)
(MOVEI N 1)
(LABEL 6) (SUBI Q 4)
(POPJ P)
)
(%PUT (QUOTE MAKE-CHAR) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHAR &OPTIONAL (BITS 0) (FONT 0))))
(%PUT (QUOTE MAKE-CHAR) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE MAKE-CHAR) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR-UPCASE) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns a character with the same bits and font as the input character,
converted to upper-case if that is possible."))
#_(LAP #0_CHAR-UPCASE EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(96 32767 123 32)
(CODE-START)
(LABEL 1) (ADDI Q 3)
(MOVEM O1 -2 Q)
(CALL LISP::GET-AND-CHECK-INT 1)
(MOVEM O1 -1 Q)
(MOVE O2 (CONSTANT 1))
(CALL LOGAND 2)
(MOVEM O1 0 Q)
(MOVE O3 (CONSTANT 2))
(MOVE O1 (CONSTANT 0))
(MOVE O2 0 Q)
(CALL < 3)
(JUMPE O1 4)
(MOVE O2 (CONSTANT 3))
(MOVE O1 -1 Q)
(CALL - 2)
(CALL LISP::INT-TO-CHAR 1)
(JRST 3)
(LABEL 4) (SKIPA)
(JRST 5)
(MOVE O1 -2 Q)
(MOVEI N 1)
(LABEL 5)
(LABEL 3) (SUBI Q 3)
(POPJ P)
)
(%PUT (QUOTE CHAR-UPCASE) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHAR)))
(%PUT (QUOTE CHAR-UPCASE) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR-UPCASE) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR-DOWNCASE) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns a character with the same bits and font as the input character,
converted to lower-case if that is possible."))
#_(LAP #0_CHAR-DOWNCASE EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(64 32767 91 32)
(CODE-START)
(LABEL 1) (ADDI Q 3)
(MOVEM O1 -2 Q)
(CALL LISP::GET-AND-CHECK-INT 1)
(MOVEM O1 -1 Q)
(MOVE O2 (CONSTANT 1))
(CALL LOGAND 2)
(MOVEM O1 0 Q)
(MOVE O3 (CONSTANT 2))
(MOVE O1 (CONSTANT 0))
(MOVE O2 0 Q)
(CALL < 3)
(JUMPE O1 4)
(MOVE O2 (CONSTANT 3))
(MOVE O1 -1 Q)
(CALL + 2)
(CALL LISP::INT-TO-CHAR 1)
(JRST 3)
(LABEL 4) (SKIPA)
(JRST 5)
(MOVE O1 -2 Q)
(MOVEI N 1)
(LABEL 5)
(LABEL 3) (SUBI Q 3)
(POPJ P)
)
(%PUT (QUOTE CHAR-DOWNCASE) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHAR)))
(%PUT (QUOTE CHAR-DOWNCASE) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR-DOWNCASE) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE DIGIT-WEIGHT) (QUOTE %FUN-DOCUMENTATION) (QUOTE "All arguments must be integers. Returns a character object that
represents a digit of the given weight in the specified radix. The
character will have the specified bits and font attributes."))
#_(LAP #0_DIGIT-WEIGHT EXPR
(ENTRY-POINTS (2-FEW 1 2 3 4 2-MANY 2-MANY))
#0_(10 0 36 48 55)
(CODE-START)
(LABEL 1) (MOVE O2 (CONSTANT 0))
(LABEL 2) (MOVE O3 (CONSTANT 1))
(LABEL 3) (MOVE O4 (CONSTANT 1))
(LABEL 4) (ADDI Q 5)
(MOVEM O1 -4 Q)
(MOVEM O2 -3 Q)
(MOVEM O3 -2 Q)
(MOVEM O4 -1 Q)
(CALL < 2)
(JUMPE O1 6)
(MOVE O2 (CONSTANT 2))
(MOVE O1 -4 Q)
(CALL < 2)
(JUMPE O1 6)
(MOVE O2 (CONSTANT 0))
(MOVE O1 -4 Q)
(CALL < 2)
(JUMPE O1 8)
(MOVE O2 -4 Q)
(MOVE O1 (CONSTANT 3))
(CALL + 2)
(MOVEM O1 0 Q)
(JRST 9)
(LABEL 8) (MOVE O2 -4 Q)
(MOVE O1 (CONSTANT 4))
(CALL + 2)
(MOVEM O1 0 Q)
(LABEL 9) (MOVE O3 -1 Q)
(MOVE O1 0 Q)
(MOVE O2 -2 Q)
(CALL CODE-CHAR 3)
(JRST 7)
(LABEL 6) (MOVE O1 NIL)
(MOVEI N 1)
(LABEL 7) (SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE DIGIT-WEIGHT) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (WEIGHT &OPTIONAL (RADIX 10) (BITS 0) (FONT 0))))
(%PUT (QUOTE DIGIT-WEIGHT) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE DIGIT-WEIGHT) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR-INT) (QUOTE %FUN-DOCUMENTATION) (QUOTE "The argument must be a character-object. Returns the font, bits, and
code fields as a single non-negative integer. Implementation dependent.
Used mostly for hashing."))
#_(LAP #0_CHAR-INT EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(8388607)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(CALL LISP::GET-AND-CHECK-INT 1)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 0))
(CALL LOGAND 2)
(SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE CHAR-INT) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CH)))
(%PUT (QUOTE CHAR-INT) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR-INT) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE INT-CHAR) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Performs the inverse of char-int. The argument must be a non-negative
integer of the appropriate size. It is turned into a character object."))
#_(LAP #0_INT-CHAR EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(0 8388607)
(CODE-START)
(LABEL 1) (ADDI Q 1)
(MOVEM O1 0 Q)
(CALL FIXNUMP 1)
(JUMPE O1 5)
(MOVE O3 (CONSTANT 1))
(MOVE O1 (CONSTANT 0))
(MOVE O2 0 Q)
(CALL <= 3)
(SKIPN NIL O1)
(LABEL 5) (JRST 4)
(MOVE O1 0 Q)
(CALL LISP::INT-TO-CHAR 1)
(JRST 3)
(LABEL 4) (SKIPA)
(JRST 7)
(MOVE O1 NIL)
(MOVEI N 1)
(LABEL 7)
(LABEL 3) (SUBI Q 1)
(POPJ P)
)
(%PUT (QUOTE INT-CHAR) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (N)))
(%PUT (QUOTE INT-CHAR) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE INT-CHAR) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR-NAME) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Given a character object, char-name returns the name for that
object (a symbol)."))
#_(LAP #0_CHAR-NAME EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(CHAR-NAME-ALIST :TEST CHAR=)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVE O5 (SPECIAL 0))
(MOVEM O5 0 Q)
(MOVE O4 (CONSTANT 2))
(MOVE O2 O5)
(MOVE O3 (CONSTANT 1))
(CALL RASSOC 4)
(MOVE O1 0 O1)
(MOVEI N 1)
(SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE CHAR-NAME) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHAR)))
(%PUT (QUOTE CHAR-NAME) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR-NAME) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE NAME-CHAR) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Given a symbol as argument, name-char returns a character object whose
name is that symbol, if one exists. Otherwise, () is returned."))
#_(LAP #0_NAME-CHAR EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(CHAR-NAME-ALIST :TEST STRING-EQUAL)
(CODE-START)
(LABEL 1) (ADDI Q 3)
(MOVEM O1 -2 Q)
(CALL STRING 1)
(MOVEM O1 -1 Q)
(MOVE O5 (SPECIAL 0))
(MOVEM O5 0 Q)
(MOVE O4 (CONSTANT 2))
(MOVE O2 O5)
(MOVE O3 (CONSTANT 1))
(CALL ASSOC 4)
(MOVE O1 1 O1)
(MOVEI N 1)
(SUBI Q 3)
(POPJ P)
)
(%PUT (QUOTE NAME-CHAR) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (SYM)))
(%PUT (QUOTE NAME-CHAR) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE NAME-CHAR) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHAR-BIT) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns T if the named bit is set in character object CHAR. Else,
returns NIL. Legal names are :CONTROL, :META, :HYPER, and :SUPER."))
#_(LAP #0_CHAR-BIT EXPR
(ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(1 :CONTROL :META 2 :HYPER 8 :SUPER 4 T)
(CODE-START)
(LABEL 1) (ADDI Q 4)
(MOVEM O1 -3 Q)
(MOVEM O2 -2 Q)
(MOVE O5 O2)
(MOVEM O5 0 Q)
(MOVE O2 (CONSTANT 1))
(CAME O2 0 Q)
(JRST 4)
(MOVE O5 (CONSTANT 0))
(MOVEM O5 -1 Q)
(JRST 3)
(LABEL 4) (MOVE O2 (CONSTANT 2))
(CAME O2 0 Q)
(JRST 5)
(MOVE O5 (CONSTANT 3))
(MOVEM O5 -1 Q)
(JRST 3)
(LABEL 5) (MOVE O2 (CONSTANT 4))
(CAME O2 0 Q)
(JRST 6)
(MOVE O5 (CONSTANT 5))
(MOVEM O5 -1 Q)
(JRST 3)
(LABEL 6) (MOVE O2 (CONSTANT 6))
(CAME O2 0 Q)
(JRST 7)
(MOVE O5 (CONSTANT 7))
(MOVEM O5 -1 Q)
(JRST 3)
(LABEL 7) (MOVEM NIL -1 Q)
(LABEL 3) (MOVE O1 -3 Q)
(CALL CHAR-BITS 1)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 0))
(MOVE O2 -1 Q)
(CALL BOOLE 3)
(CALL ZEROP 1)
(TDCN O1 O1)
(MOVE O1 (CONSTANT 8))
(MOVEI N 1)
(SUBI Q 4)
(POPJ P)
)
(%PUT (QUOTE CHAR-BIT) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHAR NAME)))
(%PUT (QUOTE CHAR-BIT) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE CHAR-BIT) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE SET-CHAR-BIT) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns a character just like CHAR except that the named bit is
set or cleared, according to whether NEWVALUE is non-null or NIL.
Legal bit names are :CONTROL, :META, :HYPER, and :SUPER."))
#_(LAP #0_SET-CHAR-BIT EXPR
(ENTRY-POINTS (2-FEW 2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY))
#0_(:CONTROL 1 :META 2 :HYPER 8 :SUPER 4 0)
(CODE-START)
(LABEL 1) (ADDI Q 6)
(MOVEM O1 -5 Q)
(MOVEM O2 -4 Q)
(MOVEM O3 -3 Q)
(MOVE O5 O2)
(MOVEM O5 0 Q)
(MOVE O2 (CONSTANT 0))
(CAME O2 0 Q)
(JRST 4)
(MOVE O5 (CONSTANT 1))
(MOVEM O5 -2 Q)
(JRST 3)
(LABEL 4) (MOVE O2 (CONSTANT 2))
(CAME O2 0 Q)
(JRST 5)
(MOVE O5 (CONSTANT 3))
(MOVEM O5 -2 Q)
(JRST 3)
(LABEL 5) (MOVE O2 (CONSTANT 4))
(CAME O2 0 Q)
(JRST 6)
(MOVE O5 (CONSTANT 5))
(MOVEM O5 -2 Q)
(JRST 3)
(LABEL 6) (MOVE O2 (CONSTANT 6))
(CAME O2 0 Q)
(JRST 7)
(MOVE O5 (CONSTANT 7))
(MOVEM O5 -2 Q)
(JRST 3)
(LABEL 7) (SKIPA)
(JRST 8)
(MOVE O5 (CONSTANT 8))
(MOVEM O5 -2 Q)
(LABEL 8)
(LABEL 3) (MOVE O1 -5 Q)
(CALL CHAR-CODE 1)
(MOVEM O1 -1 Q)
(SKIPN NIL -3 Q)
(JRST 10)
(MOVE O1 -5 Q)
(CALL CHAR-BITS 1)
(MOVE O2 O1)
(MOVE O1 -2 Q)
(CALL LOGIOR 2)
(MOVEM O1 0 Q)
(JRST 11)
(LABEL 10) (MOVE O1 -2 Q)
(CALL LOGNOT 1)
(MOVEM O1 0 Q)
(MOVE O1 -5 Q)
(CALL CHAR-BITS 1)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL LOGAND 2)
(MOVEM O1 0 Q)
(LABEL 11) (MOVE O1 -5 Q)
(CALL CHAR-FONT 1)
(MOVE O3 O1)
(MOVE O1 -1 Q)
(MOVE O2 0 Q)
(CALL CODE-CHAR 3)
(SUBI Q 6)
(POPJ P)
)
(%PUT (QUOTE SET-CHAR-BIT) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CHAR NAME NEWVALUE)))
(%PUT (QUOTE SET-CHAR-BIT) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>CHAR.CLISP.10") (GET (QUOTE SET-CHAR-BIT) (QUOTE %SOURCE-DOCUMENTATION))))
(DEFVAR CHAR-NAME-ALIST (LIST (CONS (QUOTE "NULL") (CODE-CHAR 0)) (CONS (QUOTE "^@") (CODE-CHAR 0)) (CONS (QUOTE "^A") (CODE-CHAR 1)) (CONS (QUOTE "^B") (CODE-CHAR 2)) (CONS (QUOTE "^C") (CODE-CHAR 3)) (CONS (QUOTE "^D") (CODE-CHAR 4)) (CONS (QUOTE "^E") (CODE-CHAR 5)) (CONS (QUOTE "^F") (CODE-CHAR 6)) (CONS (QUOTE "BELL") (CODE-CHAR 7)) (CONS (QUOTE "^G") (CODE-CHAR 7)) (CONS (QUOTE "BACKSPACE") (CODE-CHAR 8)) (CONS (QUOTE "BS") (CODE-CHAR 8)) (CONS (QUOTE "^H") (CODE-CHAR 8)) (CONS (QUOTE "TAB") (CODE-CHAR 9)) (CONS (QUOTE "^I") (CODE-CHAR 9)) (CONS (QUOTE "NEWLINE") (CODE-CHAR 10)) (CONS (QUOTE "NL") (CODE-CHAR 10)) (CONS (QUOTE "LINEFEED") (CODE-CHAR 10)) (CONS (QUOTE "^J") (CODE-CHAR 10)) (CONS (QUOTE "^K") (CODE-CHAR 11)) (CONS (QUOTE "PAGE") (CODE-CHAR 12)) (CONS (QUOTE "FF") (CODE-CHAR 12)) (CONS (QUOTE "FORMFEED") (CODE-CHAR 12)) (CONS (QUOTE "FORM") (CODE-CHAR 12)) (CONS (QUOTE "^L") (CODE-CHAR 12)) (CONS (QUOTE "RETURN") (CODE-CHAR 13)) (CONS (QUOTE "^M") (CODE-CHAR 13)) (CONS (QUOTE "CR") (CODE-CHAR 13)) (CONS (QUOTE "^N") (CODE-CHAR 14)) (CONS (QUOTE "^O") (CODE-CHAR 15)) (CONS (QUOTE "^P") (CODE-CHAR 16)) (CONS (QUOTE "^Q") (CODE-CHAR 17)) (CONS (QUOTE "^R") (CODE-CHAR 18)) (CONS (QUOTE "^S") (CODE-CHAR 19)) (CONS (QUOTE "^T") (CODE-CHAR 20)) (CONS (QUOTE "^U") (CODE-CHAR 21)) (CONS (QUOTE "^V") (CODE-CHAR 22)) (CONS (QUOTE "^W") (CODE-CHAR 23)) (CONS (QUOTE "^X") (CODE-CHAR 24)) (CONS (QUOTE "^Y") (CODE-CHAR 25)) (CONS (QUOTE "^Z") (CODE-CHAR 26)) (CONS (QUOTE "ESCAPE") (CODE-CHAR 27)) (CONS (QUOTE "ESC") (CODE-CHAR 27)) (CONS (QUOTE "ALTMODE") (CODE-CHAR 27)) (CONS (QUOTE "ALT") (CODE-CHAR 27)) (CONS (QUOTE "^[") (CODE-CHAR 27)) (CONS (QUOTE "^\\") (CODE-CHAR 28)) (CONS (QUOTE "^]") (CODE-CHAR 29)) (CONS (QUOTE "^^") (CODE-CHAR 30)) (CONS (QUOTE "^_") (CODE-CHAR 31)) (CONS (QUOTE "SPACE") (CODE-CHAR 32)) (CONS (QUOTE "SP") (CODE-CHAR 32)) (CONS (QUOTE "RUBOUT") (CODE-CHAR 127)) (CONS (QUOTE "DELETE") (CODE-CHAR 127)) (CONS (QUOTE "^?") (CODE-CHAR 127))) "This is the alist of (character-name . character) for characters
with long names. The first name in this list for a given character
is used on typeout and is the preferred form for input.")