diff --git a/sources/CMLARITH b/sources/CMLARITH index 9e0d3a7ae..419cabf9b 100644 --- a/sources/CMLARITH +++ b/sources/CMLARITH @@ -1,15 +1,15 @@ -(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "LISP") -(IL:FILECREATED " 4-Jan-93 17:38:48" IL:|{DSK}lde>lispcore>sources>CMLARITH.;2| 102283 +(DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10) - IL:|previous| IL:|date:| "16-May-90 12:46:36" IL:|{DSK}lde>lispcore>sources>CMLARITH.;1| -) +(IL:FILECREATED "24-Sep-2023 15:37:27" IL:|{WMEDLEY}CMLARITH.;3| 100379 + + :EDIT-BY IL:|rmk| + :PREVIOUS-DATE "23-Sep-2023 23:15:39" IL:|{WMEDLEY}CMLARITH.;2|) -; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990, 1993 by Venue & Xerox Corporation. All rights reserved. (IL:PRETTYCOMPRINT IL:CMLARITHCOMS) -(IL:RPAQQ IL:CMLARITHCOMS +(IL:RPAQQ IL:CMLARITHCOMS ( (IL:* IL:|;;;| "Common Lisp Arithmetic ") @@ -64,14 +64,14 @@ (IL:* IL:|;;| - "cl:floatp is defined in cmltypes (has an optimizer). il:floatp is defined on llbasic") + "cl:floatp is defined in cmltypes (has an optimizer). il:floatp is defined on llbasic") (IL:* IL:|;;| "cl:complexp is a defstruct predicate (compiles in line)") (IL:* IL:|;;| - "cl:numberp is defined in cmltypes (has an optimizer). il:numberp is defined on llbasic") + "cl:numberp is defined in cmltypes (has an optimizer). il:numberp is defined on llbasic") ) (IL:COMS @@ -79,7 +79,7 @@ (IL:* IL:|;;| - "cl:zerop is not shared with il:zerop, although they are equivalent. There is no il;plusp ") + "cl:zerop is not shared with il:zerop, although they are equivalent. There is no il;plusp ") (IL:COMS (IL:FUNCTIONS ZEROP PLUSP) (XCL:OPTIMIZERS ZEROP PLUSP)) @@ -102,24 +102,24 @@ (IL:* IL:\; "For the byte compiler") (IL:PROP IL:DMACRO %> %< %>= %<=) (IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOCOPY (IL:P - (IL:* IL:|;;| - "Backward compatibility") + (IL:* IL:|;;| + "Backward compatibility") (IL:* IL:\; - " il:%= is listed as the punt function for the = opcode") + " il:%= is listed as the punt function for the = opcode") (IL:MOVD '%= 'IL:%=) (IL:* IL:\; - "Greaterp is the UFN for the greaterp opcode. Effectively redefines the opcode") + "Greaterp is the UFN for the greaterp opcode. Effectively redefines the opcode") (IL:MOVD '%> 'IL:GREATERP) (IL:* IL:\; - "Interlisp Greaterp and Lessp are defined in llarith") + "Interlisp Greaterp and Lessp are defined in llarith") (IL:MOVD '%< 'IL:LESSP)))) (IL:* IL:|;;| - "=, <, >, <=, and >= are shared with il:, but cl:/= is NOT shared (?!)") + "=, <, >, <=, and >= are shared with il:, but cl:/= is NOT shared (?!)") (IL:COMS (IL:DECLARE\: IL:DONTCOPY IL:DOEVAL@COMPILE (IL:FUNCTIONS %COMPARISON-MACRO)) @@ -143,14 +143,14 @@ (IL:* IL:\; "For the byte compiler") (IL:PROP IL:DMACRO %+ %- %*) (IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOCOPY (IL:P - (IL:* IL:|;;| - "Backward compatibility") + (IL:* IL:|;;| + "Backward compatibility") (IL:MOVD '%/ 'IL:%/) (IL:* IL:|;;| - "Redefine UFNs for generic plus, difference, and times. Old UFN defined in llarith.") + "Redefine UFNs for generic plus, difference, and times. Old UFN defined in llarith.") (IL:MOVD '%+ 'IL:\\SLOWPLUS2) (IL:MOVD '%- @@ -174,7 +174,7 @@ (IL:* IL:|;;| - "So Interlisp quotient will do something reasonable with ratios") + "So Interlisp quotient will do something reasonable with ratios") (IL:* (IL:MOVD 'IL:NEW-QUOTIENT @@ -182,7 +182,7 @@ (IL:* IL:|;;| - "because QUOTIENT is already defined in LLARITH to do something useful with ratios. AR 8062.") + "because QUOTIENT is already defined in LLARITH to do something useful with ratios. AR 8062.") ))) (IL:* IL:|;;| "INCF and DECF implemented by CMLSETF.") @@ -192,7 +192,7 @@ (IL:COMS (IL:* IL:|;;| - "Optimizers for Interlisp functions, so that they compile open with the PavCompiler.") + "Optimizers for Interlisp functions, so that they compile open with the PavCompiler.") (IL:* IL:|;;| "optimizer of IL:minus") @@ -220,11 +220,11 @@ (IL:DECLARE\: IL:DONTCOPY IL:DOEVAL@COMPILE (IL:FILES IL:UNBOXEDOPS)) (IL:* IL:\; - "These should be exported from xcl") + "These should be exported from xcl") (IL:COMS (IL:FUNCTIONS XCL::STRUNCATE XCL::SFLOOR XCL::SCEILING XCL::SROUND) (XCL:OPTIMIZERS XCL::STRUNCATE XCL::SROUND)) (IL:* IL:\; - "Round is shared with il: (?!)") + "Round is shared with il: (?!)") (IL:COMS (IL:DECLARE\: IL:DONTCOPY IL:DOEVAL@COMPILE (IL:FUNCTIONS %INTEGER-COERCE-MACRO)) (IL:FUNCTIONS TRUNCATE FLOOR CEILING ROUND) @@ -340,9 +340,9 @@ (DEFSTRUCT (RATIO (:CONSTRUCTOR %MAKE-RATIO (NUMERATOR DENOMINATOR)) - (:PREDICATE %RATIO-P) - (:COPIER NIL) - (:PRINT-FUNCTION %RATIO-PRINT)) + (:PREDICATE %RATIO-P) + (:COPIER NIL) + (:PRINT-FUNCTION %RATIO-PRINT)) (NUMERATOR :READ-ONLY) (DENOMINATOR :READ-ONLY)) @@ -385,7 +385,7 @@ (COND ((NOT (IL:|fetch| (READTABLEP IL:COMMONNUMSYNTAX) IL:|of| *READTABLE*)) (IL:* IL:\; - "Can't print nice ratios to old read tables") + "Can't print nice ratios to old read tables") (IL:PRIN1 "|." STREAM) (IL:\\PRINDATUM (LIST '/ TOP BOTTOM) STREAM)) @@ -395,30 +395,31 @@ (IF *PRINT-RADIX* (SETQ PR (CONCATENATE 'STRING (STRING (CODE-CHAR (IL:|fetch| (READTABLEP IL:HASHMACROCHAR - ) - IL:|of| *READTABLE*))) + ) IL:|of| + *READTABLE*)) + ) (CASE *PRINT-BASE* (2 (IL:* IL:\; "Binary") "b") (8 "o") (16 "x") (T (IL:* IL:\; - "generalized radix prefix, even for decimal!") + "generalized radix prefix, even for decimal!") (CONCATENATE 'STRING (LET* ((X *PRINT-BASE*) (*PRINT-BASE* 10) (*PRINT-RADIX* NIL)) (PRINC-TO-STRING X)) "r")))))) (IL:.SPACECHECK. STREAM (+ 1 (IL:NCHARS TOP) - (IL:NCHARS BOTTOM) - (IF PR - (IL:NCHARS PR) - 0))) + (IL:NCHARS BOTTOM) + (IF PR + (IL:NCHARS PR) + 0))) (LET ((IL:\\THISFILELINELENGTH NIL) (*PRINT-RADIX* NIL)) (DECLARE (IL:SPECVARS IL:\\THISFILELINELENGTH)) (IL:* IL:\; - "Turn off linelength check just in case the NCHARS count is off because of radices") + "Turn off linelength check just in case the NCHARS count is off because of radices") (IF PR (IL:\\SOUT PR STREAM)) (IL:\\PRINDATUM TOP STREAM) (IL:\\SOUT "/" STREAM) @@ -427,7 +428,7 @@ (DEFUN %BUILD-RATIO (X Y) (IL:* IL:|;;| -"%BUILD-RATIO takes two integer arguments and builds the rational number which is their quotient. ") + "%BUILD-RATIO takes two integer arguments and builds the rational number which is their quotient. ") (LET ((REM (IL:IREMAINDER X Y))) (IF (EQ 0 REM) @@ -467,11 +468,11 @@ (LET ((GCD-D (%GCD DENOMINATOR-1 DENOMINATOR-2))) (IF (EQ GCD-D 1) (%MAKE-RATIO (+ (* NUMERATOR-1 DENOMINATOR-2) - (* NUMERATOR-2 DENOMINATOR-1)) + (* NUMERATOR-2 DENOMINATOR-1)) (* DENOMINATOR-1 DENOMINATOR-2)) (LET* ((D1/GCD-D (IL:IQUOTIENT DENOMINATOR-1 GCD-D)) (TOP (+ (* NUMERATOR-1 (IL:IQUOTIENT DENOMINATOR-2 GCD-D)) - (* NUMERATOR-2 D1/GCD-D))) + (* NUMERATOR-2 D1/GCD-D))) (GCD-TOP (%GCD TOP GCD-D)) (D2/GCD-TOP DENOMINATOR-2)) (UNLESS (EQ GCD-TOP 1) @@ -506,9 +507,9 @@ (DEFSTRUCT (COMPLEX (:CONSTRUCTOR %MAKE-COMPLEX (REALPART IMAGPART)) - (:PREDICATE COMPLEXP) - (:COPIER NIL) - (:PRINT-FUNCTION %COMPLEX-PRINT)) + (:PREDICATE COMPLEXP) + (:COPIER NIL) + (:PRINT-FUNCTION %COMPLEX-PRINT)) (REALPART :READ-ONLY) (IMAGPART :READ-ONLY)) @@ -592,7 +593,7 @@ (LET ((REALPART (COMPLEX-REALPART NUMBER)) (IMAGPART (COMPLEX-IMAGPART NUMBER))) (IL:.SPACECHECK. STREAM (+ 5 (IL:NCHARS REALPART) - (IL:NCHARS IMAGPART))) + (IL:NCHARS IMAGPART))) (IL:\\OUTCHAR STREAM (IL:FETCH (READTABLEP IL:HASHMACROCHAR) IL:OF *READTABLE*)) (IL:\\SOUT "C" STREAM) (IL:\\SOUT "(" STREAM) @@ -632,30 +633,30 @@ (COMPLEX (* REAL-1 REAL-2) (* IMAG-1 REAL-2))) (T (COMPLEX (- (* REAL-1 REAL-2) - (* IMAG-1 IMAG-2)) + (* IMAG-1 IMAG-2)) (+ (* IMAG-1 REAL-2) - (* REAL-1 IMAG-2)))))) + (* REAL-1 IMAG-2)))))) (DEFUN %COMPLEX-/ (REAL-1 IMAG-1 REAL-2 IMAG-2) (COND ((= 0 IMAG-1) (LET ((MODULUS (+ (* REAL-2 REAL-2) - (* IMAG-2 IMAG-2)))) + (* IMAG-2 IMAG-2)))) (COMPLEX (/ (* REAL-1 REAL-2) - MODULUS) + MODULUS) (/ (- (* REAL-1 IMAG-2)) - MODULUS)))) + MODULUS)))) ((= 0 IMAG-2) (COMPLEX (/ REAL-1 REAL-2) (/ IMAG-1 REAL-2))) (T (LET ((MODULUS (+ (* REAL-2 REAL-2) - (* IMAG-2 IMAG-2)))) + (* IMAG-2 IMAG-2)))) (COMPLEX (/ (+ (* REAL-1 REAL-2) - (* IMAG-1 IMAG-2)) - MODULUS) + (* IMAG-1 IMAG-2)) + MODULUS) (/ (- (* IMAG-1 REAL-2) - (* REAL-1 IMAG-2)) - MODULUS)))))) + (* REAL-1 IMAG-2)) + MODULUS)))))) (DEFUN %COMPLEX-ABS (Z) (LET ((X (FLOAT (COMPLEX-REALPART Z))) @@ -665,7 +666,7 @@ (IL:* IL:|;;| "Might want to use a BLUE algorithm here") (SQRT (SETQ X (+ (* X X) - (* Y Y)))))) + (* Y Y)))))) @@ -679,8 +680,7 @@ -(IL:* IL:|;;| "cl:floatp is defined in cmltypes (has an optimizer). il:floatp is defined on llbasic" -) +(IL:* IL:|;;| "cl:floatp is defined in cmltypes (has an optimizer). il:floatp is defined on llbasic") @@ -690,8 +690,8 @@ -(IL:* IL:|;;| -"cl:numberp is defined in cmltypes (has an optimizer). il:numberp is defined on llbasic") +(IL:* IL:|;;| "cl:numberp is defined in cmltypes (has an optimizer). il:numberp is defined on llbasic" +) @@ -712,10 +712,10 @@ (> NUMBER 0)) (XCL:DEFOPTIMIZER ZEROP (NUMBER) - `(= 0 ,NUMBER)) + `(= 0 ,NUMBER)) (XCL:DEFOPTIMIZER PLUSP (NUMBER) - `(> ,NUMBER 0)) + `(> ,NUMBER 0)) @@ -728,7 +728,7 @@ (< NUMBER 0)) (XCL:DEFOPTIMIZER MINUSP (NUMBER) - `(< ,NUMBER 0)) + `(< ,NUMBER 0)) @@ -750,16 +750,16 @@ (NOT (ZEROP (MOD INTEGER MODULUS))))) (XCL:DEFOPTIMIZER EVENP (INTEGER &OPTIONAL (MODULUS NIL MODULUS-P)) - (IF (NULL MODULUS-P) - `(EQ (LOGAND ,INTEGER 1) - 0) - 'COMPILER:PASS)) + (IF (NULL MODULUS-P) + `(EQ (LOGAND ,INTEGER 1) + 0) + 'COMPILER:PASS)) (XCL:DEFOPTIMIZER ODDP (INTEGER &OPTIONAL (MODULUS NIL MODULUS-P)) - (IF (NULL MODULUS-P) - `(EQ (LOGAND ,INTEGER 1) - 1) - 'COMPILER:PASS)) + (IF (NULL MODULUS-P) + `(EQ (LOGAND ,INTEGER 1) + 1) + 'COMPILER:PASS)) @@ -798,9 +798,9 @@ (OTHERWISE (%NOT-NUMBER-ERROR Y)))) (COMPLEX (TYPECASE Y (COMPLEX (AND (= (COMPLEX-REALPART X) - (COMPLEX-REALPART Y)) + (COMPLEX-REALPART Y)) (= (COMPLEX-IMAGPART X) - (COMPLEX-IMAGPART Y)))) + (COMPLEX-IMAGPART Y)))) (NUMBER (AND (= Y (COMPLEX-REALPART X)) (= 0 (COMPLEX-IMAGPART X)))) (OTHERWISE (%NOT-NUMBER-ERROR Y)))) @@ -815,33 +815,33 @@ (IL:* IL:|;;| "Compiles out to greaterp opcode") (IL:* IL:\; - "So we appear as > in a frame backtrace") + "So we appear as > in a frame backtrace") (IL:\\CALLME '>) (TYPECASE X (INTEGER (TYPECASE Y (INTEGER (IL:IGREATERP X Y)) (FLOAT (IL:FGREATERP X Y)) (RATIO (IL:IGREATERP (* (RATIO-DENOMINATOR Y) - X) + X) (RATIO-NUMERATOR Y))) (OTHERWISE (%NOT-NONCOMPLEX-NUMBER-ERROR Y)))) (FLOAT (TYPECASE Y ((OR INTEGER FLOAT) (IL:FGREATERP X Y)) (RATIO (IL:FGREATERP (* (RATIO-DENOMINATOR Y) - X) + X) (RATIO-NUMERATOR Y))) (OTHERWISE (%NOT-NONCOMPLEX-NUMBER-ERROR Y)))) (RATIO (TYPECASE Y (INTEGER (IL:IGREATERP (RATIO-NUMERATOR X) (* (RATIO-DENOMINATOR X) - Y))) + Y))) (FLOAT (IL:FGREATERP (RATIO-NUMERATOR X) (* (RATIO-DENOMINATOR X) - Y))) + Y))) (RATIO (IL:IGREATERP (* (RATIO-NUMERATOR X) - (RATIO-DENOMINATOR Y)) + (RATIO-DENOMINATOR Y)) (* (RATIO-NUMERATOR Y) - (RATIO-DENOMINATOR X)))) + (RATIO-DENOMINATOR X)))) (OTHERWISE (%NOT-NONCOMPLEX-NUMBER-ERROR Y)))) (OTHERWISE (%NOT-NONCOMPLEX-NUMBER-ERROR X)))) @@ -854,24 +854,24 @@ (DEFMACRO %<= (X Y) `(NOT (%> ,X ,Y))) -(IL:PUTPROPS %= IL:DOPVAL (2 =)) +(IL:PUTPROPS %= IL:DOPVAL (2 =)) -(IL:PUTPROPS %> IL:DOPVAL (2 IL:GREATERP)) +(IL:PUTPROPS %> IL:DOPVAL (2 IL:GREATERP)) -(IL:PUTPROPS %< IL:DOPVAL (2 IL:SWAP IL:GREATERP)) +(IL:PUTPROPS %< IL:DOPVAL (2 IL:SWAP IL:GREATERP)) (IL:* IL:\; "For the byte compiler") -(IL:PUTPROPS %> IL:DMACRO (= . IL:GREATERP)) +(IL:PUTPROPS %> IL:DMACRO (= . IL:GREATERP)) -(IL:PUTPROPS %< IL:DMACRO (= . IL:LESSP)) +(IL:PUTPROPS %< IL:DMACRO (= . IL:LESSP)) -(IL:PUTPROPS %>= IL:DMACRO (= . IL:GEQ)) +(IL:PUTPROPS %>= IL:DMACRO (= . IL:GEQ)) -(IL:PUTPROPS %<= IL:DMACRO (= . IL:LEQ)) +(IL:PUTPROPS %<= IL:DMACRO (= . IL:LEQ)) (IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOCOPY @@ -879,17 +879,17 @@ (IL:* IL:\; - " il:%= is listed as the punt function for the = opcode") + " il:%= is listed as the punt function for the = opcode") (IL:MOVD '%= 'IL:%=) (IL:* IL:\; - "Greaterp is the UFN for the greaterp opcode. Effectively redefines the opcode") + "Greaterp is the UFN for the greaterp opcode. Effectively redefines the opcode") (IL:MOVD '%> 'IL:GREATERP) (IL:* IL:\; - "Interlisp Greaterp and Lessp are defined in llarith") + "Interlisp Greaterp and Lessp are defined in llarith") (IL:MOVD '%< 'IL:LESSP) ) @@ -977,58 +977,56 @@ ((NULL THIRD-NUMBER) `(,PREDICATE ,FIRST-NUMBER ,SECOND-NUMBER)) (T `((IL:OPENLAMBDA (SI::%$$COMPARISON-FIRST-NUMBER SI::%$$COMPARISON-MIDDLE-NUMBER) - (AND (,PREDICATE SI::%$$COMPARISON-FIRST-NUMBER SI::%$$COMPARISON-MIDDLE-NUMBER) - (,PREDICATE SI::%$$COMPARISON-MIDDLE-NUMBER ,THIRD-NUMBER))) + (AND (,PREDICATE SI::%$$COMPARISON-FIRST-NUMBER SI::%$$COMPARISON-MIDDLE-NUMBER) + (,PREDICATE SI::%$$COMPARISON-MIDDLE-NUMBER ,THIRD-NUMBER))) ,FIRST-NUMBER ,SECOND-NUMBER)))) (XCL:DEFOPTIMIZER = (FIRST-NUMBER &OPTIONAL (SECOND-NUMBER NIL SECOND-NUMBER-P) - &REST MORE-NUMBERS) - (COND - ((NULL SECOND-NUMBER-P) - 'COMPILER:PASS) - ((NULL MORE-NUMBERS) - `(%= ,FIRST-NUMBER ,SECOND-NUMBER)) - (T - (SETQ MORE-NUMBERS (CONS SECOND-NUMBER MORE-NUMBERS)) - `((IL:OPENLAMBDA - (SI::%$$=FIRST-NUMBER) - (AND ,@(LET ((RESULT NIL) - (RESULT-TAIL NIL)) - (DOLIST (NUMBER MORE-NUMBERS RESULT) - (%LIST-COLLECT RESULT RESULT-TAIL - (LIST `(%= SI::%$$=FIRST-NUMBER - ,NUMBER))))))) - ,FIRST-NUMBER)))) + &REST MORE-NUMBERS) + (COND + ((NULL SECOND-NUMBER-P) + 'COMPILER:PASS) + ((NULL MORE-NUMBERS) + `(%= ,FIRST-NUMBER ,SECOND-NUMBER)) + (T + (SETQ MORE-NUMBERS (CONS SECOND-NUMBER MORE-NUMBERS)) + `((IL:OPENLAMBDA (SI::%$$=FIRST-NUMBER) + (AND ,@(LET ((RESULT NIL) + (RESULT-TAIL NIL)) + (DOLIST (NUMBER MORE-NUMBERS RESULT) + (%LIST-COLLECT RESULT RESULT-TAIL + (LIST `(%= SI::%$$=FIRST-NUMBER ,NUMBER))))))) + ,FIRST-NUMBER)))) (XCL:DEFOPTIMIZER /= (FIRST-NUMBER &OPTIONAL (SECOND-NUMBER NIL SECOND-NUMBER-P) - &REST MORE-NUMBERS) - (COND - ((NULL SECOND-NUMBER-P) - 'COMPILER:PASS) - ((NULL MORE-NUMBERS) - `(%/= ,FIRST-NUMBER ,SECOND-NUMBER)) - (T 'COMPILER:PASS))) + &REST MORE-NUMBERS) + (COND + ((NULL SECOND-NUMBER-P) + 'COMPILER:PASS) + ((NULL MORE-NUMBERS) + `(%/= ,FIRST-NUMBER ,SECOND-NUMBER)) + (T 'COMPILER:PASS))) (XCL:DEFOPTIMIZER < (FIRST-NUMBER &OPTIONAL SECOND-NUMBER THIRD-NUMBER &REST MORE-NUMBERS) - (IF (NULL MORE-NUMBERS) - (%COMPARISON-OPTIMIZER '%< FIRST-NUMBER SECOND-NUMBER THIRD-NUMBER) - 'COMPILER:PASS)) + (IF (NULL MORE-NUMBERS) + (%COMPARISON-OPTIMIZER '%< FIRST-NUMBER SECOND-NUMBER THIRD-NUMBER) + 'COMPILER:PASS)) (XCL:DEFOPTIMIZER > (FIRST-NUMBER &OPTIONAL SECOND-NUMBER THIRD-NUMBER &REST MORE-NUMBERS) - (IF (NULL MORE-NUMBERS) - (%COMPARISON-OPTIMIZER '%> FIRST-NUMBER SECOND-NUMBER THIRD-NUMBER) - 'COMPILER:PASS)) + (IF (NULL MORE-NUMBERS) + (%COMPARISON-OPTIMIZER '%> FIRST-NUMBER SECOND-NUMBER THIRD-NUMBER) + 'COMPILER:PASS)) (XCL:DEFOPTIMIZER <= (FIRST-NUMBER &OPTIONAL SECOND-NUMBER THIRD-NUMBER &REST MORE-NUMBERS) - (IF (NULL MORE-NUMBERS) - (%COMPARISON-OPTIMIZER '%<= FIRST-NUMBER SECOND-NUMBER THIRD-NUMBER) - 'COMPILER:PASS)) + (IF (NULL MORE-NUMBERS) + (%COMPARISON-OPTIMIZER '%<= FIRST-NUMBER SECOND-NUMBER THIRD-NUMBER) + 'COMPILER:PASS)) (XCL:DEFOPTIMIZER >= (FIRST-NUMBER &OPTIONAL SECOND-NUMBER THIRD-NUMBER &REST MORE-NUMBERS) - (IF (NULL MORE-NUMBERS) - (%COMPARISON-OPTIMIZER '%>= FIRST-NUMBER SECOND-NUMBER THIRD-NUMBER) - 'COMPILER:PASS)) + (IF (NULL MORE-NUMBERS) + (%COMPARISON-OPTIMIZER '%>= FIRST-NUMBER SECOND-NUMBER THIRD-NUMBER) + 'COMPILER:PASS)) @@ -1045,30 +1043,30 @@ (XCL:DEFOPTIMIZER MIN (&OPTIONAL (X NIL X-P) - (Y NIL Y-P) - &REST OTHER-NUMBERS) - (IF (AND (NULL OTHER-NUMBERS) - X-P Y-P) - `((IL:OPENLAMBDA (SI::%$$MIN-X SI::%$$MIN-Y) - (IF (< SI::%$$MIN-X SI::%$$MIN-Y) - SI::%$$MIN-X - SI::%$$MIN-Y)) - ,X - ,Y) - 'COMPILER:PASS)) + (Y NIL Y-P) + &REST OTHER-NUMBERS) + (IF (AND (NULL OTHER-NUMBERS) + X-P Y-P) + `((IL:OPENLAMBDA (SI::%$$MIN-X SI::%$$MIN-Y) + (IF (< SI::%$$MIN-X SI::%$$MIN-Y) + SI::%$$MIN-X + SI::%$$MIN-Y)) + ,X + ,Y) + 'COMPILER:PASS)) (XCL:DEFOPTIMIZER MAX (&OPTIONAL (X NIL X-P) - (Y NIL Y-P) - &REST OTHER-NUMBERS) - (IF (AND (NULL OTHER-NUMBERS) - X-P Y-P) - `((IL:OPENLAMBDA (SI::%$$MAX-X SI::%$$MAX-Y) - (IF (> SI::%$$MAX-X SI::%$$MAX-Y) - SI::%$$MAX-X - SI::%$$MAX-Y)) - ,X - ,Y) - 'COMPILER:PASS)) + (Y NIL Y-P) + &REST OTHER-NUMBERS) + (IF (AND (NULL OTHER-NUMBERS) + X-P Y-P) + `((IL:OPENLAMBDA (SI::%$$MAX-X SI::%$$MAX-Y) + (IF (> SI::%$$MAX-X SI::%$$MAX-Y) + SI::%$$MAX-X + SI::%$$MAX-Y)) + ,X + ,Y) + 'COMPILER:PASS)) @@ -1255,7 +1253,7 @@ (FLOAT (TYPECASE Y ((OR INTEGER FLOAT) (IL:FQUOTIENT X Y)) (RATIO (IL:FQUOTIENT (* (RATIO-DENOMINATOR Y) - X) + X) (RATIO-NUMERATOR Y))) (COMPLEX (%COMPLEX-/ X 0.0 (COMPLEX-REALPART Y) (COMPLEX-IMAGPART Y))) @@ -1266,7 +1264,7 @@ 1 Y)) (FLOAT (IL:FQUOTIENT (RATIO-NUMERATOR X) (* (RATIO-DENOMINATOR X) - Y))) + Y))) (RATIO (%RATIO-TIMES (RATIO-NUMERATOR X) (RATIO-DENOMINATOR X) (RATIO-DENOMINATOR Y) @@ -1295,22 +1293,22 @@ ) -(IL:PUTPROPS %+ IL:DOPVAL (2 IL:PLUS2)) +(IL:PUTPROPS %+ IL:DOPVAL (2 IL:PLUS2)) -(IL:PUTPROPS %- IL:DOPVAL (2 IL:DIFFERENCE)) +(IL:PUTPROPS %- IL:DOPVAL (2 IL:DIFFERENCE)) -(IL:PUTPROPS %* IL:DOPVAL (2 IL:TIMES2)) +(IL:PUTPROPS %* IL:DOPVAL (2 IL:TIMES2)) (IL:* IL:\; "For the byte compiler") -(IL:PUTPROPS %+ IL:DMACRO (= . IL:PLUS)) +(IL:PUTPROPS %+ IL:DMACRO (= . IL:PLUS)) -(IL:PUTPROPS %- IL:DMACRO (= . IL:DIFFERENCE)) +(IL:PUTPROPS %- IL:DMACRO (= . IL:DIFFERENCE)) -(IL:PUTPROPS %* IL:DMACRO (= . IL:TIMES)) +(IL:PUTPROPS %* IL:DMACRO (= . IL:TIMES)) (IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOCOPY @@ -1401,55 +1399,55 @@ (/ 1 NUMBER))) (XCL:DEFOPTIMIZER + (&REST NUMBERS) - (IF (NULL NUMBERS) - 0 - (LET ((FORM (CAR NUMBERS))) - (DOLIST (NUM (CDR NUMBERS) - FORM) - (SETQ FORM `(%+ ,FORM ,NUM)))))) + (IF (NULL NUMBERS) + 0 + (LET ((FORM (CAR NUMBERS))) + (DOLIST (NUM (CDR NUMBERS) + FORM) + (SETQ FORM `(%+ ,FORM ,NUM)))))) (XCL:DEFOPTIMIZER - (NUMBER &REST NUMBERS) - (IF (NULL NUMBERS) - `(%- 0 ,NUMBER) - (LET ((FORM NUMBER)) - (DOLIST (NUM NUMBERS FORM) - (SETQ FORM `(%- ,FORM ,NUM)))))) + (IF (NULL NUMBERS) + `(%- 0 ,NUMBER) + (LET ((FORM NUMBER)) + (DOLIST (NUM NUMBERS FORM) + (SETQ FORM `(%- ,FORM ,NUM)))))) (XCL:DEFOPTIMIZER * (&REST NUMBERS) - (IF (NULL NUMBERS) - 1 - (LET ((FORM (CAR NUMBERS))) - (DOLIST (NUM (CDR NUMBERS) - FORM) - (SETQ FORM `(%* ,FORM ,NUM)))))) + (IF (NULL NUMBERS) + 1 + (LET ((FORM (CAR NUMBERS))) + (DOLIST (NUM (CDR NUMBERS) + FORM) + (SETQ FORM `(%* ,FORM ,NUM)))))) (XCL:DEFOPTIMIZER / (NUMBER &REST NUMBERS) - (IF (NULL NUMBERS) - `(%RECIPROCOL ,NUMBER) - (LET ((FORM NUMBER)) - (DOLIST (NUM NUMBERS FORM) - (SETQ FORM `(%/ ,FORM ,NUM)))))) + (IF (NULL NUMBERS) + `(%RECIPROCOL ,NUMBER) + (LET ((FORM NUMBER)) + (DOLIST (NUM NUMBERS FORM) + (SETQ FORM `(%/ ,FORM ,NUM)))))) (XCL:DEFOPTIMIZER 1+ (NUMBER) - `(+ ,NUMBER 1)) + `(+ ,NUMBER 1)) (XCL:DEFOPTIMIZER 1- (NUMBER) - `(- ,NUMBER 1)) + `(- ,NUMBER 1)) (IL:* IL:\; "For the byte compiler") -(IL:PUTPROPS + IL:DMACRO (IL:ARGS (IL:|if| (IL:GREATERP (IL:LENGTH IL:ARGS) - 1) - IL:|then| `(IL:PLUS ,@IL:ARGS) - IL:|else| 'IL:IGNOREMACRO))) +(IL:PUTPROPS + IL:DMACRO (IL:ARGS (IL:|if| (IL:GREATERP (IL:LENGTH IL:ARGS) + 1) + IL:|then| `(IL:PLUS ,@IL:ARGS) + IL:|else| 'IL:IGNOREMACRO))) -(IL:PUTPROPS * IL:DMACRO (IL:ARGS (IL:|if| (IL:GREATERP (IL:LENGTH IL:ARGS) - 1) - IL:|then| `(IL:TIMES ,@IL:ARGS) - IL:|else| 'IL:IGNOREMACRO))) +(IL:PUTPROPS * IL:DMACRO (IL:ARGS (IL:|if| (IL:GREATERP (IL:LENGTH IL:ARGS) + 1) + IL:|then| `(IL:TIMES ,@IL:ARGS) + IL:|else| 'IL:IGNOREMACRO))) @@ -1469,8 +1467,8 @@ (IL:* IL:|;;| "So Interlisp quotient will do something reasonable with ratios") - (IL:* (IL:MOVD (QUOTE - IL:NEW-QUOTIENT) (QUOTE IL:QUOTIENT))) + (IL:* (IL:MOVD (QUOTE IL:NEW-QUOTIENT) + (QUOTE IL:QUOTIENT))) (IL:* IL:|;;| @@ -1532,7 +1530,7 @@ (IF (EQ GCD 1) (* X Y) (* (IL:IQUOTIENT X GCD) - Y)))))) + Y)))))) (IL:DEFINEQ (GCD @@ -1585,73 +1583,73 @@ (XCL:DEFOPTIMIZER IL:MINUS (IL:X) - `(- 0 ,IL:X)) + `(- 0 ,IL:X)) (XCL:DEFOPTIMIZER IL:PLUS (&REST NUMBERS) - (IF (NULL NUMBERS) - 0 - (LET ((FORM (CAR NUMBERS))) - (DOLIST (NUM (CDR NUMBERS) - FORM) - (SETQ FORM `(IL:PLUS2 ,FORM ,NUM)))))) + (IF (NULL NUMBERS) + 0 + (LET ((FORM (CAR NUMBERS))) + (DOLIST (NUM (CDR NUMBERS) + FORM) + (SETQ FORM `(IL:PLUS2 ,FORM ,NUM)))))) (XCL:DEFOPTIMIZER IL:IPLUS (&REST NUMBERS) - (IF (NULL NUMBERS) - 0 - (LET ((FORM (CAR NUMBERS))) - (COND - ((CDR NUMBERS) - (DOLIST (NUM (CDR NUMBERS) - FORM) - (SETQ FORM `(IL:IPLUS2 ,FORM ,NUM)))) - (T `(IL:IPLUS2 ,FORM 0)))))) - -(XCL:DEFOPTIMIZER IL:FPLUS (&REST NUMBERS) - (IF (NULL NUMBERS) - 0 - (LET ((FORM (CAR NUMBERS))) + (IF (NULL NUMBERS) + 0 + (LET ((FORM (CAR NUMBERS))) + (COND + ((CDR NUMBERS) (DOLIST (NUM (CDR NUMBERS) FORM) - (SETQ FORM `(IL:FPLUS2 ,FORM ,NUM)))))) + (SETQ FORM `(IL:IPLUS2 ,FORM ,NUM)))) + (T `(IL:IPLUS2 ,FORM 0)))))) + +(XCL:DEFOPTIMIZER IL:FPLUS (&REST NUMBERS) + (IF (NULL NUMBERS) + 0 + (LET ((FORM (CAR NUMBERS))) + (DOLIST (NUM (CDR NUMBERS) + FORM) + (SETQ FORM `(IL:FPLUS2 ,FORM ,NUM)))))) (XCL:DEFOPTIMIZER IL:TIMES (&REST NUMBERS) - (IF (NULL NUMBERS) - 0 - (LET ((FORM (CAR NUMBERS))) - (DOLIST (NUM (CDR NUMBERS) - FORM) - (SETQ FORM `(IL:TIMES2 ,FORM ,NUM)))))) + (IF (NULL NUMBERS) + 0 + (LET ((FORM (CAR NUMBERS))) + (DOLIST (NUM (CDR NUMBERS) + FORM) + (SETQ FORM `(IL:TIMES2 ,FORM ,NUM)))))) (XCL:DEFOPTIMIZER IL:ITIMES (&REST NUMBERS) - (IF (NULL NUMBERS) - 0 - (LET ((FORM (CAR NUMBERS))) - (DOLIST (NUM (CDR NUMBERS) - FORM) - (SETQ FORM `(IL:ITIMES2 ,FORM ,NUM)))))) + (IF (NULL NUMBERS) + 0 + (LET ((FORM (CAR NUMBERS))) + (DOLIST (NUM (CDR NUMBERS) + FORM) + (SETQ FORM `(IL:ITIMES2 ,FORM ,NUM)))))) (XCL:DEFOPTIMIZER IL:FTIMES (&REST NUMBERS) - (IF (NULL NUMBERS) - 1.0 - (LET ((FORM (CAR NUMBERS))) - (DOLIST (NUM (CDR NUMBERS) - FORM) - (SETQ FORM `(IL:FTIMES2 ,FORM ,NUM)))))) + (IF (NULL NUMBERS) + 1.0 + (LET ((FORM (CAR NUMBERS))) + (DOLIST (NUM (CDR NUMBERS) + FORM) + (SETQ FORM `(IL:FTIMES2 ,FORM ,NUM)))))) (XCL:DEFOPTIMIZER IL:RSH (IL:VALUE IL:SHIFT-AMOUNT) - `(IL:LSH ,IL:VALUE (IL:IMINUS ,IL:SHIFT-AMOUNT))) + `(IL:LSH ,IL:VALUE (IL:IMINUS ,IL:SHIFT-AMOUNT))) -(IL:PUTPROPS IL:PLUS2 IL:DOPVAL (2 IL:PLUS2)) +(IL:PUTPROPS IL:PLUS2 IL:DOPVAL (2 IL:PLUS2)) -(IL:PUTPROPS IL:IPLUS2 IL:DOPVAL (2 IL:IPLUS2)) +(IL:PUTPROPS IL:IPLUS2 IL:DOPVAL (2 IL:IPLUS2)) -(IL:PUTPROPS IL:FPLUS2 IL:DOPVAL (2 IL:FPLUS2)) +(IL:PUTPROPS IL:FPLUS2 IL:DOPVAL (2 IL:FPLUS2)) -(IL:PUTPROPS IL:TIMES2 IL:DOPVAL (2 IL:TIMES2)) +(IL:PUTPROPS IL:TIMES2 IL:DOPVAL (2 IL:TIMES2)) -(IL:PUTPROPS IL:ITIMES2 IL:DOPVAL (2 IL:ITIMES2)) +(IL:PUTPROPS IL:ITIMES2 IL:DOPVAL (2 IL:ITIMES2)) -(IL:PUTPROPS IL:FTIMES2 IL:DOPVAL (2 IL:FTIMES2)) +(IL:PUTPROPS IL:FTIMES2 IL:DOPVAL (2 IL:FTIMES2)) @@ -1669,19 +1667,19 @@ :NAME INTEGER :VALUE INTEGER :MESSAGE "a nonnegative integer")) (LET* ((ILENGTH (INTEGER-LENGTH INTEGER)) (LOW (ASH 1 (ASH (1- ILENGTH) - -1))) + -1))) (HIGH (+ LOW (ASH LOW (IF (ODDP ILENGTH) - -1 - 0))))) + -1 + 0))))) (DO ((MID (ASH (+ LOW HIGH) - -1) + -1) (ASH (+ LOW HIGH) - -1))) + -1))) ((<= (1- HIGH) - LOW) + LOW) LOW) (IF (<= (* MID MID) - INTEGER) + INTEGER) (SETQ LOW MID) (SETQ HIGH MID))))) @@ -1699,7 +1697,7 @@ (- 0.0 NUMBER) NUMBER)) (RATIO (IF (< (RATIO-NUMERATOR NUMBER) - 0) + 0) (%MAKE-RATIO (- 0 (RATIO-NUMERATOR NUMBER)) (RATIO-DENOMINATOR NUMBER)) NUMBER)) @@ -1711,9 +1709,9 @@ (IL:* IL:|;;| "Integer version of abs") `((IL:OPENLAMBDA (X) - (IF (< X 0) - (- 0 X) - X)) + (IF (< X 0) + (- 0 X) + X)) ,INTEGER)) (DEFUN SIGNUM (NUMBER) @@ -1737,12 +1735,12 @@ (IL:* IL:|;;| "Integer version of signum") `((IL:OPENLAMBDA (X) - (COND - ((EQ X 0) - 0) - ((PLUSP X) - 1) - (T -1))) + (COND + ((EQ X 0) + 0) + ((PLUSP X) + 1) + (T -1))) ,INTEGER)) @@ -1802,7 +1800,7 @@ (T RESULT))) (LET ((RESULT (XCL::STRUNCATE NUMBER DIVISOR))) (IF (= (REM NUMBER DIVISOR) - 0) + 0) RESULT (IF (< NUMBER 0) (IF (< DIVISOR 0) @@ -1826,7 +1824,7 @@ (T (1+ RESULT)))) (LET ((RESULT (XCL::STRUNCATE NUMBER DIVISOR))) (IF (= (REM NUMBER DIVISOR) - 0) + 0) RESULT (IF (< NUMBER 0) (IF (< DIVISOR 0) @@ -1848,14 +1846,14 @@ (IL:FIXR (/ NUMBER DIVISOR))))) (XCL:DEFOPTIMIZER XCL::STRUNCATE (NUMBER &OPTIONAL DIVISOR) - (IF (INTEGERP DIVISOR) - `(IL:IQUOTIENT ,NUMBER ,DIVISOR) - 'COMPILER:PASS)) + (IF (INTEGERP DIVISOR) + `(IL:IQUOTIENT ,NUMBER ,DIVISOR) + 'COMPILER:PASS)) (XCL:DEFOPTIMIZER XCL::SROUND (NUMBER &OPTIONAL (DIVISOR NIL DIVISOR-P)) - (IF (NULL DIVISOR-P) - `(IL:FIXR ,NUMBER) - 'COMPILER:PASS)) + (IF (NULL DIVISOR-P) + `(IL:FIXR ,NUMBER) + 'COMPILER:PASS)) @@ -1909,16 +1907,16 @@ 'COMPILER:PASS)) (XCL:DEFOPTIMIZER TRUNCATE (NUMBER &OPTIONAL DIVISOR XCL:&CONTEXT CONTEXT) - (%INTEGER-COERCE-OPTIMIZER 'XCL::STRUNCATE NUMBER DIVISOR CONTEXT)) + (%INTEGER-COERCE-OPTIMIZER 'XCL::STRUNCATE NUMBER DIVISOR CONTEXT)) (XCL:DEFOPTIMIZER FLOOR (NUMBER &OPTIONAL DIVISOR XCL:&CONTEXT CONTEXT) - (%INTEGER-COERCE-OPTIMIZER 'XCL::SFLOOR NUMBER DIVISOR CONTEXT)) + (%INTEGER-COERCE-OPTIMIZER 'XCL::SFLOOR NUMBER DIVISOR CONTEXT)) (XCL:DEFOPTIMIZER CEILING (NUMBER &OPTIONAL DIVISOR XCL:&CONTEXT CONTEXT) - (%INTEGER-COERCE-OPTIMIZER 'XCL::SCEILING NUMBER DIVISOR CONTEXT)) + (%INTEGER-COERCE-OPTIMIZER 'XCL::SCEILING NUMBER DIVISOR CONTEXT)) (XCL:DEFOPTIMIZER ROUND (NUMBER &OPTIONAL DIVISOR XCL:&CONTEXT CONTEXT) - (%INTEGER-COERCE-OPTIMIZER 'XCL::SROUND NUMBER DIVISOR CONTEXT)) + (%INTEGER-COERCE-OPTIMIZER 'XCL::SROUND NUMBER DIVISOR CONTEXT)) (DEFUN FTRUNCATE (NUMBER &OPTIONAL DIVISOR) @@ -1945,18 +1943,16 @@ (%INTEGER-COERCE-MACRO XCL::SROUND NUMBER DIVISOR T)) (XCL:DEFOPTIMIZER FTRUNCATE (NUMBER &OPTIONAL DIVISOR XCL:&CONTEXT CONTEXT) - (%INTEGER-COERCE-OPTIMIZER 'XCL::STRUNCATE NUMBER DIVISOR CONTEXT - T)) + (%INTEGER-COERCE-OPTIMIZER 'XCL::STRUNCATE NUMBER DIVISOR CONTEXT T)) (XCL:DEFOPTIMIZER FFLOOR (NUMBER &OPTIONAL DIVISOR XCL:&CONTEXT CONTEXT) - (%INTEGER-COERCE-OPTIMIZER 'XCL::SFLOOR NUMBER DIVISOR CONTEXT T)) + (%INTEGER-COERCE-OPTIMIZER 'XCL::SFLOOR NUMBER DIVISOR CONTEXT T)) (XCL:DEFOPTIMIZER FCEILING (NUMBER &OPTIONAL DIVISOR XCL:&CONTEXT CONTEXT) - (%INTEGER-COERCE-OPTIMIZER 'XCL::SCEILING NUMBER DIVISOR CONTEXT T - )) + (%INTEGER-COERCE-OPTIMIZER 'XCL::SCEILING NUMBER DIVISOR CONTEXT T)) (XCL:DEFOPTIMIZER FROUND (NUMBER &OPTIONAL DIVISOR XCL:&CONTEXT CONTEXT) - (%INTEGER-COERCE-OPTIMIZER 'XCL::SROUND NUMBER DIVISOR CONTEXT T)) + (%INTEGER-COERCE-OPTIMIZER 'XCL::SROUND NUMBER DIVISOR CONTEXT T)) (DEFUN MOD (NUMBER DIVISOR) @@ -1969,7 +1965,7 @@ REM) (DECLARE (TYPE FLOAT FX FY REM)) (SETQ REM (- FX (* (FLOAT (IL:UFIX (IL:FQUOTIENT FX FY))) - FY))) + FY))) (IF (IL:UFEQP REM 0.0) 0.0 (IF (IF (IL:UFGREATERP 0.0 FY) @@ -1999,7 +1995,7 @@ (FY (FLOAT DIVISOR))) (DECLARE (TYPE FLOAT FX FY)) (SETQ FX (- FX (* (FLOAT (IL:UFIX (IL:FQUOTIENT FX FY))) - FY))))) + FY))))) (T (- NUMBER (* DIVISOR (XCL::STRUNCATE NUMBER DIVISOR)))))) @@ -2037,16 +2033,16 @@ (SETQ FORM `(,BINARY-LOGICAL-FN ,FORM ,INTEGER))))))) (XCL:DEFOPTIMIZER LOGXOR (FIRST-INTEGER SECOND-INTEGER &REST MORE-INTEGERS) - (IF (AND COMPILER::*NEW-COMPILER-IS-EXPANDING* MORE-INTEGERS) - (%LOGICAL-OPTIMIZER 'LOGXOR 0 FIRST-INTEGER SECOND-INTEGER - MORE-INTEGERS) - 'COMPILER:PASS)) + (IF (AND COMPILER::*NEW-COMPILER-IS-EXPANDING* MORE-INTEGERS) + (%LOGICAL-OPTIMIZER 'LOGXOR 0 FIRST-INTEGER SECOND-INTEGER MORE-INTEGERS + ) + 'COMPILER:PASS)) (XCL:DEFOPTIMIZER LOGAND (FIRST-INTEGER SECOND-INTEGER &REST MORE-INTEGERS) - (IF (AND COMPILER::*NEW-COMPILER-IS-EXPANDING* MORE-INTEGERS) - (%LOGICAL-OPTIMIZER 'LOGAND -1 FIRST-INTEGER SECOND-INTEGER - MORE-INTEGERS) - 'COMPILER:PASS)) + (IF (AND COMPILER::*NEW-COMPILER-IS-EXPANDING* MORE-INTEGERS) + (%LOGICAL-OPTIMIZER 'LOGAND -1 FIRST-INTEGER SECOND-INTEGER + MORE-INTEGERS) + 'COMPILER:PASS)) (DEFUN %LOGIOR (X Y) (IL:LOGOR X Y)) @@ -2054,14 +2050,14 @@ (DEFMACRO %LOGEQV (X Y) `(LOGNOT (LOGXOR ,X ,Y))) -(IL:PUTPROPS %LOGIOR IL:DOPVAL (2 IL:LOGOR2)) +(IL:PUTPROPS %LOGIOR IL:DOPVAL (2 IL:LOGOR2)) (IL:* IL:\; "for the byte compiler") -(IL:PUTPROPS %LOGIOR IL:DMACRO (= . IL:LOGOR)) +(IL:PUTPROPS %LOGIOR IL:DMACRO (= . IL:LOGOR)) (IL:DEFINEQ (LOGIOR @@ -2108,12 +2104,10 @@ ) (XCL:DEFOPTIMIZER LOGIOR (FIRST-INTEGER SECOND-INTEGER &REST MORE-INTEGERS) - (%LOGICAL-OPTIMIZER '%LOGIOR 0 FIRST-INTEGER SECOND-INTEGER - MORE-INTEGERS)) + (%LOGICAL-OPTIMIZER '%LOGIOR 0 FIRST-INTEGER SECOND-INTEGER MORE-INTEGERS)) (XCL:DEFOPTIMIZER LOGEQV (FIRST-INTEGER SECOND-INTEGER &REST MORE-INTEGERS) - (%LOGICAL-OPTIMIZER '%LOGEQV -1 FIRST-INTEGER SECOND-INTEGER - MORE-INTEGERS)) + (%LOGICAL-OPTIMIZER '%LOGEQV -1 FIRST-INTEGER SECOND-INTEGER MORE-INTEGERS)) (DEFUN LOGNAND (INTEGER1 INTEGER2) (LOGNOT (LOGAND INTEGER1 INTEGER2))) @@ -2136,24 +2130,24 @@ (LOGIOR INTEGER1 (LOGNOT INTEGER2))) (XCL:DEFOPTIMIZER LOGNAND (INTEGER1 INTEGER2) - `(LOGNOT (LOGAND ,INTEGER1 ,INTEGER2))) + `(LOGNOT (LOGAND ,INTEGER1 ,INTEGER2))) (XCL:DEFOPTIMIZER LOGNOR (INTEGER1 INTEGER2) - `(LOGNOT (LOGIOR ,INTEGER1 ,INTEGER2))) + `(LOGNOT (LOGIOR ,INTEGER1 ,INTEGER2))) (XCL:DEFOPTIMIZER LOGANDC1 (INTEGER1 INTEGER2) - `(LOGAND (LOGNOT ,INTEGER1) - ,INTEGER2)) + `(LOGAND (LOGNOT ,INTEGER1) + ,INTEGER2)) (XCL:DEFOPTIMIZER LOGANDC2 (INTEGER1 INTEGER2) - `(LOGAND ,INTEGER1 (LOGNOT ,INTEGER2))) + `(LOGAND ,INTEGER1 (LOGNOT ,INTEGER2))) (XCL:DEFOPTIMIZER LOGORC1 (INTEGER1 INTEGER2) - `(LOGIOR (LOGNOT ,INTEGER1) - ,INTEGER2)) + `(LOGIOR (LOGNOT ,INTEGER1) + ,INTEGER2)) (XCL:DEFOPTIMIZER LOGORC2 (INTEGER1 INTEGER2) - `(LOGIOR ,INTEGER1 (LOGNOT ,INTEGER2))) + `(LOGIOR ,INTEGER1 (LOGNOT ,INTEGER2))) (DEFCONSTANT BOOLE-CLR 0) @@ -2235,19 +2229,19 @@ (EQ 1 (LOGAND 1 (ASH INTEGER (- INDEX))))) (XCL:DEFOPTIMIZER LOGTEST (INTEGER1 INTEGER2) - `(NOT (EQ 0 (LOGAND ,INTEGER1 ,INTEGER2)))) + `(NOT (EQ 0 (LOGAND ,INTEGER1 ,INTEGER2)))) (DEFUN ASH (INTEGER COUNT) (IL:LSH INTEGER COUNT)) -(IL:PUTPROPS ASH IL:DOPVAL (2 IL:LSH)) +(IL:PUTPROPS ASH IL:DOPVAL (2 IL:LSH)) (IL:* IL:\; "For the byte compiler") -(IL:PUTPROPS ASH IL:DMACRO (= . IL:LSH)) +(IL:PUTPROPS ASH IL:DMACRO (= . IL:LSH)) (DEFUN LOGCOUNT (INTEGER) @@ -2266,10 +2260,10 @@ (IL:* IL:|;;| "Returns number of 1 bits in nonnegative integer N. ") (LET ((CNT 0)) (IL:* IL:\; - "This loop uses a LOGAND trick to reduce the number of iterations. ") + "This loop uses a LOGAND trick to reduce the number of iterations. ") (LOOP (IF (EQ 0 POSITIVE-INTEGER) (RETURN CNT)) (IL:* IL:\; - "Change rightmost 1 bit of N to a 0 bit. ") + "Change rightmost 1 bit of N to a 0 bit. ") (SETQ CNT (1+ CNT)) (SETQ POSITIVE-INTEGER (LOGAND POSITIVE-INTEGER (1- POSITIVE-INTEGER)))))) (IL:DECLARE\: IL:DONTCOPY IL:DOEVAL@COMPILE @@ -2353,49 +2347,49 @@ (DEFUN %LRSH1 (X) (IL:LRSH X 1)) -(IL:PUTPROPS %LLSH8 IL:DOPVAL (1 IL:LLSH8)) +(IL:PUTPROPS %LLSH8 IL:DOPVAL (1 IL:LLSH8)) -(IL:PUTPROPS %LLSH1 IL:DOPVAL (1 IL:LLSH1)) +(IL:PUTPROPS %LLSH1 IL:DOPVAL (1 IL:LLSH1)) -(IL:PUTPROPS %LRSH8 IL:DOPVAL (1 IL:LRSH8)) +(IL:PUTPROPS %LRSH8 IL:DOPVAL (1 IL:LRSH8)) -(IL:PUTPROPS %LRSH1 IL:DOPVAL (1 IL:LRSH1)) +(IL:PUTPROPS %LRSH1 IL:DOPVAL (1 IL:LRSH1)) (XCL:DEFOPTIMIZER IL:LLSH (X N) - (IF COMPILER::*NEW-COMPILER-IS-EXPANDING* - (LET ((M (AND (CONSTANTP N) - (EVAL N)))) - (IF (TYPEP M '(INTEGER 0)) - (LET ((FORM X)) - (LOOP (IF (< M 8) - (RETURN NIL)) - (SETQ FORM `(%LLSH8 ,FORM)) - (DECF M 8)) - (LOOP (IF (<= M 0) - (RETURN NIL)) - (SETQ FORM `(%LLSH1 ,FORM)) - (DECF M 1)) - FORM) - 'COMPILER:PASS)) - 'COMPILER:PASS)) + (IF COMPILER::*NEW-COMPILER-IS-EXPANDING* + (LET ((M (AND (CONSTANTP N) + (EVAL N)))) + (IF (TYPEP M '(INTEGER 0)) + (LET ((FORM X)) + (LOOP (IF (< M 8) + (RETURN NIL)) + (SETQ FORM `(%LLSH8 ,FORM)) + (DECF M 8)) + (LOOP (IF (<= M 0) + (RETURN NIL)) + (SETQ FORM `(%LLSH1 ,FORM)) + (DECF M 1)) + FORM) + 'COMPILER:PASS)) + 'COMPILER:PASS)) (XCL:DEFOPTIMIZER IL:LRSH (X N) - (IF COMPILER::*NEW-COMPILER-IS-EXPANDING* - (LET ((M (AND (CONSTANTP N) - (EVAL N)))) - (IF (TYPEP M '(INTEGER 0)) - (LET ((FORM X)) - (LOOP (IF (< M 8) - (RETURN NIL)) - (SETQ FORM `(%LRSH8 ,FORM)) - (DECF M 8)) - (LOOP (IF (<= M 0) - (RETURN NIL)) - (SETQ FORM `(%LRSH1 ,FORM)) - (DECF M 1)) - FORM) - 'COMPILER:PASS)) - 'COMPILER:PASS)) + (IF COMPILER::*NEW-COMPILER-IS-EXPANDING* + (LET ((M (AND (CONSTANTP N) + (EVAL N)))) + (IF (TYPEP M '(INTEGER 0)) + (LET ((FORM X)) + (LOOP (IF (< M 8) + (RETURN NIL)) + (SETQ FORM `(%LRSH8 ,FORM)) + (DECF M 8)) + (LOOP (IF (<= M 0) + (RETURN NIL)) + (SETQ FORM `(%LRSH1 ,FORM)) + (DECF M 1)) + FORM) + 'COMPILER:PASS)) + 'COMPILER:PASS)) @@ -2409,7 +2403,7 @@ (IF (AND (< SIZE 256) (< POSITION 256)) (+ (ASH SIZE 8) - POSITION) + POSITION) (CONS SIZE POSITION)))) (XCL:DEFINLINE BYTE-SIZE (BYTESPEC) @@ -2433,18 +2427,18 @@ (IF (AND (TYPEP SIZE '(INTEGER 0 255)) (TYPEP POSITION '(INTEGER 0 255))) (+ (ASH SIZE 8) - POSITION) + POSITION) 'COMPILER:PASS)) -(IL:PUTPROPS BYTE IL:DMACRO (IL:ARGS (OPTIMIZE-BYTE (CAR IL:ARGS) - (CADR IL:ARGS)))) +(IL:PUTPROPS BYTE IL:DMACRO (IL:ARGS (OPTIMIZE-BYTE (CAR IL:ARGS) + (CADR IL:ARGS)))) (IL:DECLARE\: IL:DONTCOPY IL:DOEVAL@COMPILE (DEFMACRO %MAKE-BYTE-MASK-1 (SIZE POSITION) (IF (EQ POSITION 0) `(1- (ASH 1 ,SIZE)) `(ASH (1- (ASH 1 ,SIZE)) - ,POSITION))) + ,POSITION))) (DEFMACRO %MAKE-BYTE-MASK-0 (SIZE POSITION) `(LOGNOT (%MAKE-BYTE-MASK-1 ,SIZE ,POSITION))) @@ -2460,7 +2454,7 @@ (LET ((SIZE (BYTE-SIZE BYTESPEC)) (POSITION (BYTE-POSITION BYTESPEC))) (LOGIOR (ASH (LOGAND NEWBYTE (%MAKE-BYTE-MASK-1 SIZE 0)) - POSITION) + POSITION) (LOGAND INTEGER (%MAKE-BYTE-MASK-0 SIZE POSITION))))) (DEFUN MASK-FIELD (BYTESPEC INTEGER) @@ -2488,58 +2482,53 @@ (T NIL))) (XCL:DEFOPTIMIZER LDB (BYTESPEC INTEGER) - (LET ((CONSTANT-BYTE (%CONSTANT-BYTESPEC-P BYTESPEC))) - (IF CONSTANT-BYTE - (LET ((SIZE (BYTE-SIZE CONSTANT-BYTE)) - (POSITION (BYTE-POSITION CONSTANT-BYTE))) - (IF (ZEROP POSITION) - `(LOGAND ,INTEGER ,(%MAKE-BYTE-MASK-1 SIZE 0)) - `(LOGAND (ASH ,INTEGER ,(- POSITION)) - ,(%MAKE-BYTE-MASK-1 SIZE 0)))) - 'COMPILER:PASS))) + (LET ((CONSTANT-BYTE (%CONSTANT-BYTESPEC-P BYTESPEC))) + (IF CONSTANT-BYTE + (LET ((SIZE (BYTE-SIZE CONSTANT-BYTE)) + (POSITION (BYTE-POSITION CONSTANT-BYTE))) + (IF (ZEROP POSITION) + `(LOGAND ,INTEGER ,(%MAKE-BYTE-MASK-1 SIZE 0)) + `(LOGAND (ASH ,INTEGER ,(- POSITION)) + ,(%MAKE-BYTE-MASK-1 SIZE 0)))) + 'COMPILER:PASS))) (XCL:DEFOPTIMIZER DPB (NEWBYTE BYTESPEC INTEGER) - (LET ((CONSTANT-BYTE (%CONSTANT-BYTESPEC-P BYTESPEC))) - (IF CONSTANT-BYTE - (LET ((SIZE (BYTE-SIZE CONSTANT-BYTE)) - (POSITION (BYTE-POSITION CONSTANT-BYTE))) - (IF (ZEROP POSITION) - `(LOGIOR (LOGAND ,NEWBYTE ,(%MAKE-BYTE-MASK-1 - SIZE 0)) - (LOGAND ,INTEGER ,(%MAKE-BYTE-MASK-0 SIZE 0)) - ) - `(LOGIOR (ASH (LOGAND ,NEWBYTE - ,(%MAKE-BYTE-MASK-1 - SIZE 0)) - ,POSITION) - (LOGAND ,INTEGER ,(%MAKE-BYTE-MASK-0 SIZE - POSITION))))) - 'COMPILER:PASS))) + (LET ((CONSTANT-BYTE (%CONSTANT-BYTESPEC-P BYTESPEC))) + (IF CONSTANT-BYTE + (LET ((SIZE (BYTE-SIZE CONSTANT-BYTE)) + (POSITION (BYTE-POSITION CONSTANT-BYTE))) + (IF (ZEROP POSITION) + `(LOGIOR (LOGAND ,NEWBYTE ,(%MAKE-BYTE-MASK-1 SIZE 0)) + (LOGAND ,INTEGER ,(%MAKE-BYTE-MASK-0 SIZE 0))) + `(LOGIOR (ASH (LOGAND ,NEWBYTE ,(%MAKE-BYTE-MASK-1 SIZE 0)) + ,POSITION) + (LOGAND ,INTEGER ,(%MAKE-BYTE-MASK-0 SIZE POSITION)))) + ) + 'COMPILER:PASS))) (XCL:DEFOPTIMIZER MASK-FIELD (BYTESPEC INTEGER) - (LET ((CONSTANT-BYTE (%CONSTANT-BYTESPEC-P BYTESPEC))) - (IF CONSTANT-BYTE - (LET ((SIZE (BYTE-SIZE CONSTANT-BYTE)) - (POSITION (BYTE-POSITION CONSTANT-BYTE))) - `(LOGAND ,INTEGER ,(%MAKE-BYTE-MASK-1 SIZE - POSITION))) - 'COMPILER:PASS))) + (LET ((CONSTANT-BYTE (%CONSTANT-BYTESPEC-P BYTESPEC))) + (IF CONSTANT-BYTE + (LET ((SIZE (BYTE-SIZE CONSTANT-BYTE)) + (POSITION (BYTE-POSITION CONSTANT-BYTE))) + `(LOGAND ,INTEGER ,(%MAKE-BYTE-MASK-1 SIZE POSITION))) + 'COMPILER:PASS))) (XCL:DEFOPTIMIZER DEPOSIT-FIELD (NEWBYTE BYTESPEC INTEGER) - (LET ((CONSTANT-BYTE (%CONSTANT-BYTESPEC-P BYTESPEC))) - (IF CONSTANT-BYTE - (LET* ((SIZE (BYTE-SIZE CONSTANT-BYTE)) - (POSITION (BYTE-POSITION CONSTANT-BYTE)) - (MASK (%MAKE-BYTE-MASK-1 SIZE POSITION))) - `(LOGIOR (LOGAND ,NEWBYTE ,MASK) - (LOGAND ,INTEGER ,(LOGNOT MASK)))) - 'COMPILER:PASS))) + (LET ((CONSTANT-BYTE (%CONSTANT-BYTESPEC-P BYTESPEC))) + (IF CONSTANT-BYTE + (LET* ((SIZE (BYTE-SIZE CONSTANT-BYTE)) + (POSITION (BYTE-POSITION CONSTANT-BYTE)) + (MASK (%MAKE-BYTE-MASK-1 SIZE POSITION))) + `(LOGIOR (LOGAND ,NEWBYTE ,MASK) + (LOGAND ,INTEGER ,(LOGNOT MASK)))) + 'COMPILER:PASS))) (DEFUN LDB-TEST (BYTESPEC INTEGER) (NOT (EQ 0 (LDB BYTESPEC INTEGER)))) (XCL:DEFOPTIMIZER LDB-TEST (BYTESPEC INTEGER) - `(NOT (EQ 0 (LDB ,BYTESPEC ,INTEGER)))) + `(NOT (EQ 0 (LDB ,BYTESPEC ,INTEGER)))) (IL:DECLARE\: IL:DONTCOPY IL:DOEVAL@COMPILE (IL:DECLARE\: IL:DOEVAL@COMPILE IL:DONTCOPY @@ -2547,9 +2536,9 @@ ) ) -(IL:PUTPROPS IL:CMLARITH IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "LISP")) +(IL:PUTPROPS IL:CMLARITH IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "LISP")) -(IL:PUTPROPS IL:CMLARITH IL:FILETYPE COMPILE-FILE) +(IL:PUTPROPS IL:CMLARITH IL:FILETYPE COMPILE-FILE) (IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOEVAL@COMPILE IL:DONTCOPY IL:COMPILERVARS (IL:ADDTOVAR IL:NLAMA ) @@ -2558,11 +2547,48 @@ (IL:ADDTOVAR IL:LAMA LOGEQV LOGIOR LCM GCD / * - + >= <= > < /= =) ) -(IL:PUTPROPS IL:CMLARITH IL:COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1989 1990 1993) -) (IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (39320 41192 (= 39333 . 39855) (/= 39857 . 40582) (< 40584 . 40733) (> 40735 . 40884) - (<= 40886 . 41037) (>= 41039 . 41190)) (57727 59881 (+ 57740 . 58248) (- 58250 . 58830) (* 58832 . -59340) (/ 59342 . 59879)) (64441 65951 (GCD 64454 . 65229) (LCM 65231 . 65949)) (83940 85510 (LOGIOR -83953 . 84729) (LOGEQV 84731 . 85508))))) + (IL:FILEMAP (NIL (17050 17168 (%NOT-NUMBER-ERROR 17050 . 17168)) (17170 17383 ( +%NOT-NONCOMPLEX-NUMBER-ERROR 17170 . 17383)) (17385 17505 (%NOT-INTEGER-ERROR 17385 . 17505)) (17507 +17629 (%NOT-RATIONAL-ERROR 17507 . 17629)) (17631 17747 (%NOT-FLOAT-ERROR 17631 . 17747)) (18273 18510 + (DENOMINATOR 18273 . 18510)) (18512 18748 (NUMERATOR 18512 . 18748)) (18841 21757 (%RATIO-PRINT 18841 + . 21757)) (21759 22363 (%BUILD-RATIO 21759 . 22363)) (22365 22824 (RATIONAL 22365 . 22824)) (22826 +23307 (RATIONALIZE 22826 . 23307)) (23309 24325 (%RATIO-PLUS 23309 . 24325)) (24327 25126 ( +%RATIO-TIMES 24327 . 25126)) (26108 26969 (COMPLEX 26108 . 26969)) (26971 27137 (REALPART 26971 . +27137)) (27139 27319 (IMAGPART 27139 . 27319)) (27321 27561 (CONJUGATE 27321 . 27561)) (27563 28040 ( +PHASE 27563 . 28040)) (28042 28609 (%COMPLEX-PRINT 28042 . 28609)) (28611 28935 (%COMPLEX-+ 28611 . +28935)) (28937 29269 (%COMPLEX-- 28937 . 29269)) (29271 29725 (%COMPLEX-* 29271 . 29725)) (29727 30593 + (%COMPLEX-/ 29727 . 30593)) (30595 30900 (%COMPLEX-ABS 30595 . 30900)) (31519 31565 (ZEROP 31519 . +31565)) (31567 31613 (PLUSP 31567 . 31613)) (31916 31963 (MINUSP 31916 . 31963)) (32291 32448 (EVENP +32291 . 32448)) (32450 32612 (ODDP 32450 . 32612)) (33186 35069 (%= 33186 . 35069)) (35071 35120 (%/= +35071 . 35120)) (35122 36881 (%> 35122 . 36881)) (36883 36919 (%< 36883 . 36919)) (36921 36970 (%>= +36921 . 36970)) (36972 37021 (%<= 36972 . 37021)) (38291 39150 (%COMPARISON-MACRO 38291 . 39150)) ( +39153 41025 (= 39166 . 39688) (/= 39690 . 40415) (< 40417 . 40566) (> 40568 . 40717) (<= 40719 . 40870 +) (>= 40872 . 41023)) (41027 41568 (%COMPARISON-OPTIMIZER 41027 . 41568)) (45694 48178 (%+ 45694 . +48178)) (48180 50721 (%- 48180 . 50721)) (50723 53169 (%* 50723 . 53169)) (53171 56408 (%/ 53171 . +56408)) (57218 59372 (+ 57231 . 57739) (- 57741 . 58321) (* 58323 . 58831) (/ 58833 . 59370)) (59374 +59417 (1+ 59374 . 59417)) (59419 59462 (1- 59419 . 59462)) (59464 59577 (%RECIPROCOL 59464 . 59577)) ( +62387 63436 (%GCD 62387 . 63436)) (63438 63808 (%LCM 63438 . 63808)) (63809 65319 (GCD 63822 . 64597) +(LCM 64599 . 65317)) (68647 69886 (ISQRT 68647 . 69886)) (69968 70522 (ABS 69968 . 70522)) (70524 +70702 (%ABS 70524 . 70702)) (70704 71198 (SIGNUM 70704 . 71198)) (71200 71428 (%SIGNUM 71200 . 71428)) + (71715 72680 (XCL::STRUNCATE 71715 . 72680)) (72682 73500 (XCL::SFLOOR 72682 . 73500)) (73502 74316 ( +XCL::SCEILING 73502 . 74316)) (74318 74671 (XCL::SROUND 74318 . 74671)) (75249 75787 ( +%INTEGER-COERCE-MACRO 75249 . 75787)) (75791 76039 (TRUNCATE 75791 . 76039)) (76041 76291 (FLOOR 76041 + . 76291)) (76293 76547 (CEILING 76293 . 76547)) (76549 76804 (ROUND 76549 . 76804)) (76806 77145 ( +%INTEGER-COERCE-OPTIMIZER 76806 . 77145)) (77842 78093 (FTRUNCATE 77842 . 78093)) (78095 78279 (FFLOOR + 78095 . 78279)) (78281 78538 (FCEILING 78281 . 78538)) (78540 78798 (FROUND 78540 . 78798)) (79511 +80456 (MOD 79511 . 80456)) (80458 81025 (REM 80458 . 81025)) (81434 81928 (%LOGICAL-OPTIMIZER 81434 . +81928)) (82647 82690 (%LOGIOR 82647 . 82690)) (82692 82748 (%LOGEQV 82692 . 82748)) (82905 84475 ( +LOGIOR 82918 . 83694) (LOGEQV 83696 . 84473)) (84850 84928 (LOGNAND 84850 . 84928)) (84930 85011 ( +LOGNOR 84930 . 85011)) (85013 85102 (LOGANDC1 85013 . 85102)) (85104 85183 (LOGANDC2 85104 . 85183)) ( +85185 85277 (LOGORC1 85185 . 85277)) (85279 85361 (LOGORC2 85279 . 85361)) (86651 87640 (BOOLE 86651 + . 87640)) (87707 87789 (LOGTEST 87707 . 87789)) (88010 88067 (ASH 88010 . 88067)) (88212 88681 ( +LOGCOUNT 88212 . 88681)) (88683 89344 (%LOGCOUNT 88683 . 89344)) (89487 89719 (%BIGNUM-LOGCOUNT 89487 + . 89719)) (89721 91417 (INTEGER-LENGTH 89721 . 91417)) (91479 91518 (%LLSH8 91479 . 91518)) (91520 +91559 (%LLSH1 91520 . 91559)) (91561 91600 (%LRSH8 91561 . 91600)) (91602 91641 (%LRSH1 91602 . 91641) +) (94016 94328 (BYTE 94016 . 94328)) (94754 94958 (OPTIMIZE-BYTE 94754 . 94958)) (95142 95317 ( +%MAKE-BYTE-MASK-1 95142 . 95317)) (95319 95420 (%MAKE-BYTE-MASK-0 95319 . 95420)) (95424 95648 (LDB +95424 . 95648)) (95650 95963 (DPB 95650 . 95963)) (95965 96161 (MASK-FIELD 95965 . 96161)) (96163 +96455 (DEPOSIT-FIELD 96163 . 96455)) (96457 96760 (%CONSTANT-BYTESPEC-P 96457 . 96760)) (99669 99751 ( +LDB-TEST 99669 . 99751))))) IL:STOP diff --git a/sources/CMLARITH.LCOM b/sources/CMLARITH.LCOM index ec11e77bf..438354d5a 100644 --- a/sources/CMLARITH.LCOM +++ b/sources/CMLARITH.LCOM @@ -1,9 +1,10 @@ -(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "LISP") -(IL:FILECREATED "13-Jun-2021 21:16:13" ("compiled on " -IL:|{DSK}kaplan>Local>medley3.5>git-medley>sources>CMLARITH.;1|) "13-Jun-2021 14:44:27" -"COMPILE-FILEd" IL:|in| "FULL 13-Jun-2021 ..." IL:|dated| "13-Jun-2021 14:44:40") -(IL:FILECREATED " 4-Jan-93 17:38:48" IL:|{DSK}lde>lispcore>sources>CMLARITH.;2| 102283 -IL:|previous| IL:|date:| "16-May-90 12:46:36" IL:|{DSK}lde>lispcore>sources>CMLARITH.;1|) +(DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10) + +(IL:FILECREATED "24-Sep-2023 15:37:41" ("compiled on " IL:|{WMEDLEY}CMLARITH.;3|) +"24-Sep-2023 15:27:49" "COMPILE-FILEd" IL:|in| "FULL 24-Sep-2023 ..." IL:|dated| +"24-Sep-2023 15:27:56") +(IL:FILECREATED "24-Sep-2023 15:37:27" IL:|{WMEDLEY}CMLARITH.;3| 100379 :EDIT-BY IL:|rmk| +:PREVIOUS-DATE "23-Sep-2023 23:15:39" IL:|{WMEDLEY}CMLARITH.;2|) (IL:RPAQQ IL:CMLARITHCOMS ((IL:* IL:|;;;| "Common Lisp Arithmetic ") (IL:COMS (IL:* IL:|;;| "Error utilities") (IL:FUNCTIONS %NOT-NUMBER-ERROR %NOT-NONCOMPLEX-NUMBER-ERROR %NOT-INTEGER-ERROR %NOT-RATIONAL-ERROR %NOT-FLOAT-ERROR)) (IL:COMS (IL:* IL:|;;;| "Section 2.1.2 Ratios. ") (IL:COMS ( @@ -1145,6 +1146,4 @@ NIL (QUOTE LDB-TEST) (QUOTE COMPILER:OPTIMIZER-LIST)))) (IL:PUTPROPS IL:CMLARITH IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "LISP")) (IL:PUTPROPS IL:CMLARITH IL:FILETYPE COMPILE-FILE) -(IL:PUTPROPS IL:CMLARITH IL:COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1989 1990 1993) -) NIL diff --git a/sources/CMLCHARACTER b/sources/CMLCHARACTER index cec844f82..e609ee3fa 100644 --- a/sources/CMLCHARACTER +++ b/sources/CMLCHARACTER @@ -1,50 +1,53 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "28-Jun-99 21:54:32" {DSK}medley3.5>sources>CMLCHARACTER.;2 32559 - changes to%: (OPTIMIZERS CL:CODE-CHAR) - (FUNCTIONS CL:CODE-CHAR) +(FILECREATED "30-Oct-2023 18:04:29" {DSK}matt>Interlisp>medley>sources>CMLCHARACTER.;4 32004 - previous date%: "18-Aug-95 14:45:44" {DSK}medley3.5>sources>CMLCHARACTER.;1) + :EDIT-BY "mth" + + :CHANGES-TO (FNS CL:CHAR-NAME) + + :PREVIOUS-DATE "17-Oct-2023 13:16:14" {DSK}matt>Interlisp>medley>sources>CMLCHARACTER.;1 +) (* ; " -Copyright (c) 1985, 1986, 1987, 1990, 1995, 1999 by Venue & Xerox Corporation. All rights reserved. +Copyright (c) 1985-1987, 1990, 1995, 1999, 2023 by Venue & Xerox Corporation. ") (PRETTYCOMPRINT CMLCHARACTERCOMS) (RPAQQ CMLCHARACTERCOMS - [(COMS (* ; - "Interlisp CHARCODE; Some is here, the rest is in LLREAD.") + [(COMS (* ; + "Interlisp CHARCODE; Some is here, the rest is in LLREAD.") (FNS CHARCODE CHARCODE.UNDECODE) (PROP MACRO SELCHARQ ALPHACHARP DIGITCHARP UCASECODE) (OPTIMIZERS CHARCODE) (ALISTS (DWIMEQUIVLST SELCHARQ) (PRETTYEQUIVLST SELCHARQ))) - (COMS (* ; "Common Lisp CHARACTER type") + (COMS (* ; "Common Lisp CHARACTER type") (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS CHARACTER)) (VARIABLES \CHARHI) (VARIABLES CL:CHAR-BITS-LIMIT CL:CHAR-CODE-LIMIT CL:CHAR-CONTROL-BIT CL:CHAR-FONT-LIMIT CL:CHAR-HYPER-BIT CL:CHAR-META-BIT CL:CHAR-SUPER-BIT)) - (COMS (* ; "Basic character fns") + (COMS (* ; "Basic character fns") (FNS CL:CHAR-CODE CL:CHAR-INT CL:INT-CHAR) (FUNCTIONS CL:CODE-CHAR) (OPTIMIZERS CL:CHAR-CODE CL:CHAR-INT CL:CODE-CHAR CL:INT-CHAR)) - [COMS (* ; - "I/O; Some is here, the rest is in LLREAD.") + [COMS (* ; + "I/O; Some is here, the rest is in LLREAD.") (FNS CHARACTER.PRINT) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (SETTOPVAL (\TYPEGLOBALVARIABLE 'CHARACTER T) (NTYPX (CL:CODE-CHAR 0 0 0))) (DEFPRINT 'CHARACTER 'CHARACTER.PRINT] (COMS - (* ;; "Common lisp character functions") + (* ;; "Common lisp character functions") (FNS CL:CHAR-BIT CL:CHAR-BITS CL:CHAR-DOWNCASE CL:CHAR-FONT CL:CHAR-NAME CL:CHAR-UPCASE CL:CHARACTER CL:NAME-CHAR CL:SET-CHAR-BIT) (FUNCTIONS CL:DIGIT-CHAR CL:MAKE-CHAR) (OPTIMIZERS CL:CHAR-UPCASE CL:CHAR-DOWNCASE CL:MAKE-CHAR)) (COMS - (* ;; "Predicates") + (* ;; "Predicates") (FNS CL:ALPHA-CHAR-P CL:ALPHANUMERICP CL:BOTH-CASE-P CL:CHARACTERP CL:GRAPHIC-CHAR-P CL:LOWER-CASE-P CL:STANDARD-CHAR-P CL:STRING-CHAR-P CL:UPPER-CASE-P) @@ -57,11 +60,11 @@ Copyright (c) 1985, 1986, 1987, 1990, 1995, 1999 by Venue & Xerox Corporation. CL:CHAR> CL:CHAR>= CL:CHARACTERP CL:LOWER-CASE-P CL:STRING-CHAR-P CL:UPPER-CASE-P)) (COMS - (* ;; "Internals") + (* ;; "Internals") (FUNCTIONS %%CHAR-DOWNCASE-CODE %%CHAR-UPCASE-CODE %%CODE-CHAR)) (COMS - (* ;; "Compiler options") + (* ;; "Compiler options") (PROP FILETYPE CMLCHARACTER) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (LOCALVARS . T))) @@ -89,36 +92,35 @@ Copyright (c) 1985, 1986, 1987, 1990, 1995, 1999 by Venue & Xerox Corporation. ) (PUTPROPS SELCHARQ MACRO [F (CONS 'SELECTQ (CONS (CAR F) - (MAPLIST (CDR F) - (FUNCTION (LAMBDA (I) - (COND - ((CDR I) - (CONS - (CHARCODE.DECODE - (CAAR I)) - (CDAR I))) - (T (CAR I]) + (MAPLIST (CDR F) + (FUNCTION (LAMBDA (I) + (COND + ((CDR I) + (CONS (CHARCODE.DECODE + (CAAR I)) + (CDAR I))) + (T (CAR I]) (PUTPROPS ALPHACHARP MACRO ((CHAR) - ([LAMBDA (UCHAR) - (DECLARE (LOCALVARS UCHAR)) - (AND (IGEQ UCHAR (CHARCODE A)) - (ILEQ UCHAR (CHARCODE Z] - (LOGAND CHAR 95)))) + ([LAMBDA (UCHAR) + (DECLARE (LOCALVARS UCHAR)) + (AND (IGEQ UCHAR (CHARCODE A)) + (ILEQ UCHAR (CHARCODE Z] + (LOGAND CHAR 95)))) (PUTPROPS DIGITCHARP MACRO [LAMBDA (CHAR) - (AND (IGEQ CHAR (CHARCODE 0)) - (ILEQ CHAR (CHARCODE 9]) + (AND (IGEQ CHAR (CHARCODE 0)) + (ILEQ CHAR (CHARCODE 9]) (PUTPROPS UCASECODE MACRO (OPENLAMBDA (CHAR) - (COND - ((AND (IGEQ CHAR (CHARCODE a)) - (ILEQ CHAR (CHARCODE z))) - (LOGAND CHAR 95)) - (T CHAR)))) + (COND + ((AND (IGEQ CHAR (CHARCODE a)) + (ILEQ CHAR (CHARCODE z))) + (LOGAND CHAR 95)) + (T CHAR)))) (DEFOPTIMIZER CHARCODE (C) - (KWOTE (CHARCODE.DECODE C T))) + (KWOTE (CHARCODE.DECODE C T))) (ADDTOVAR DWIMEQUIVLST (SELCHARQ . SELECTQ)) @@ -132,7 +134,7 @@ Copyright (c) 1985, 1986, 1987, 1990, 1995, 1999 by Venue & Xerox Corporation. (DECLARE%: EVAL@COMPILE (ACCESSFNS CHARACTER [(CODE (\LOLOC (\DTEST DATUM 'CHARACTER] - (CREATE (\VAG2 \CHARHI CODE))) + (CREATE (\VAG2 \CHARHI CODE))) ) ) @@ -172,43 +174,43 @@ Copyright (c) 1985, 1986, 1987, 1990, 1995, 1999 by Venue & Xerox Corporation. ) (CL:DEFUN CL:CODE-CHAR (CODE &OPTIONAL (BITS 0) - (FONT 0)) + (FONT 0)) (CL:IF (AND (EQ BITS 0) (EQ FONT 0) - (* ;; "This checks for smallposp") + (* ;; "This checks for smallposp") (EQ (\HILOC CODE) \SmallPosHi)) (%%CODE-CHAR CODE))) (DEFOPTIMIZER CL:CHAR-CODE (CHAR) - [LET [(CONSTANT-CHAR (AND (CL:CONSTANTP CHAR) - (CL:EVAL CHAR] - (CL:IF (CL:CHARACTERP CONSTANT-CHAR) - (\LOLOC CONSTANT-CHAR) - `(\LOLOC (\DTEST ,CHAR 'CHARACTER)))]) + [LET [(CONSTANT-CHAR (AND (CL:CONSTANTP CHAR) + (CL:EVAL CHAR] + (CL:IF (CL:CHARACTERP CONSTANT-CHAR) + (\LOLOC CONSTANT-CHAR) + `(\LOLOC (\DTEST ,CHAR 'CHARACTER)))]) (DEFOPTIMIZER CL:CHAR-INT (CHAR) - `(CL:CHAR-CODE ,CHAR)) + `(CL:CHAR-CODE ,CHAR)) (DEFOPTIMIZER CL:CODE-CHAR (CODE &OPTIONAL (BITS 0) - (FONT 0)) - (CL:IF (AND (EQ BITS 0) - (EQ FONT 0)) - [LET [(CONSTANT-CODE (AND (CL:CONSTANTP CODE) - (CL:EVAL CODE] - (CL:IF (EQ (\HILOC CONSTANT-CODE) - \SmallPosHi) - (%%CODE-CHAR CONSTANT-CODE) - `(LET ((%%CODE ,CODE)) - (AND (EQ (\HILOC %%CODE) - ,\SmallPosHi) - (%%CODE-CHAR %%CODE))))] - 'COMPILER:PASS)) + (FONT 0)) + (CL:IF (AND (EQ BITS 0) + (EQ FONT 0)) + [LET [(CONSTANT-CODE (AND (CL:CONSTANTP CODE) + (CL:EVAL CODE] + (CL:IF (EQ (\HILOC CONSTANT-CODE) + \SmallPosHi) + (%%CODE-CHAR CONSTANT-CODE) + `(LET ((%%CODE ,CODE)) + (AND (EQ (\HILOC %%CODE) + ,\SmallPosHi) + (%%CODE-CHAR %%CODE))))] + 'COMPILER:PASS)) (DEFOPTIMIZER CL:INT-CHAR (INTEGER) - `(CL:CODE-CHAR ,INTEGER)) + `(CL:CODE-CHAR ,INTEGER)) @@ -267,33 +269,39 @@ Copyright (c) 1985, 1986, 1987, 1990, 1995, 1999 by Venue & Xerox Corporation. 0]) (CL:CHAR-NAME - [LAMBDA (CHAR) (* ; "Edited 19-Mar-87 15:49 by bvm:") + [LAMBDA (CHAR) (* ; "Edited 30-Oct-2023 17:57 by mth") + (* ; "Edited 19-Mar-87 15:49 by bvm:") (DECLARE (GLOBALVARS CHARACTERNAMES CHARACTERSETNAMES)) (COND ((EQ CHAR #\Space) (* ; - "Space is special because it is graphic but has a name") + "Space is special because it is graphic but has a name") "Space") - ((CL:GRAPHIC-CHAR-P CHAR) (* ; "graphics have no special names") + ((CL:GRAPHIC-CHAR-P CHAR) (* ; "graphics have no special names") NIL) (T (LET ((CODE (CL:CHAR-CODE CHAR)) CSET) (COND [(for X in CHARACTERNAMES when (EQ (CADR X) - CODE) - do (RETURN (CAR X] + CODE) do + (* ;; + "This assumes that (CAR X) is SYMBOL or STRING!!") + + (* ;; + "(Should this be enforced? I.e., error if not?)") + + (RETURN (STRING (CAR X] (T (SETQ CSET (LRSH CODE 8)) (SETQ CODE (LOGAND CODE 255)) (COND [(AND (EQ CSET 0) - (<= CODE (CHARCODE "^Z"))) (* ; - "represent ascii control chars nicely") + (<= CODE (CHARCODE "^Z"))) (* ; + "represent ascii control chars nicely") (CONCAT "^" (CL:CODE-CHAR (LOGOR CODE (- (CHARCODE "A") - (CHARCODE "^A"] + (CHARCODE "^A"] (T (* ; "Else charset-charcode") - (CONCAT (for X in CHARACTERSETNAMES - when (EQ (CADR X) - CSET) do (RETURN (CAR X)) - finally (RETURN (OCTALSTRING CSET))) + (CONCAT (for X in CHARACTERSETNAMES when (EQ (CADR X) + CSET) + do (RETURN (CAR X)) finally (RETURN (OCTALSTRING CSET))) "-" (OCTALSTRING CODE]) @@ -326,36 +334,34 @@ Copyright (c) 1985, 1986, 1987, 1990, 1995, 1999 by Venue & Xerox Corporation. ) (CL:DEFUN CL:DIGIT-CHAR (WEIGHT &OPTIONAL (RADIX 10) - (FONT 0)) + (FONT 0)) [AND (EQ FONT 0) (< -1 WEIGHT RADIX 37) (CL:IF (< WEIGHT 10) (%%CODE-CHAR (+ (CONSTANT (CL:CHAR-CODE #\0)) - WEIGHT)) + WEIGHT)) (%%CODE-CHAR (+ (CONSTANT (CL:CHAR-CODE #\A)) - (- WEIGHT 10))))]) + (- WEIGHT 10))))]) (CL:DEFUN CL:MAKE-CHAR (CHAR &OPTIONAL (BITS 0) - (FONT 0)) + (FONT 0)) (CL:IF (AND (EQL BITS 0) (EQL FONT 0)) CHAR)) (DEFOPTIMIZER CL:CHAR-UPCASE (CHAR) - `[%%CODE-CHAR (%%CHAR-UPCASE-CODE (CL:CHAR-CODE - ,CHAR]) + `[%%CODE-CHAR (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR]) (DEFOPTIMIZER CL:CHAR-DOWNCASE (CHAR) - `[%%CODE-CHAR (%%CHAR-DOWNCASE-CODE (CL:CHAR-CODE - ,CHAR]) + `[%%CODE-CHAR (%%CHAR-DOWNCASE-CODE (CL:CHAR-CODE ,CHAR]) (DEFOPTIMIZER CL:MAKE-CHAR (CHAR &OPTIONAL BITS FONT) - (CL:IF (AND (OR (NULL BITS) - (EQL BITS 0)) - (OR (NULL FONT) - (EQL FONT 0))) - CHAR - 'COMPILER:PASS)) + (CL:IF (AND (OR (NULL BITS) + (EQL BITS 0)) + (OR (NULL FONT) + (EQL FONT 0))) + CHAR + 'COMPILER:PASS)) @@ -627,105 +633,100 @@ Copyright (c) 1985, 1986, 1987, 1990, 1995, 1999 by Venue & Xerox Corporation. VAL))) (DEFOPTIMIZER CL:CHAR-EQUAL (CHAR &REST MORE-CHARS) - (CL:IF (EQL 1 (CL:LENGTH MORE-CHARS)) - `[EQ (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR)) - (%%CHAR-UPCASE-CODE (CL:CHAR-CODE - ,(CAR MORE-CHARS] - 'COMPILER:PASS)) + (CL:IF (EQL 1 (CL:LENGTH MORE-CHARS)) + `[EQ (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR)) + (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,(CAR MORE-CHARS] + 'COMPILER:PASS)) (DEFOPTIMIZER CL:CHAR-GREATERP (CHAR &REST MORE-CHARS) - `(> (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR)) - ,@(CL:MAPCAR [FUNCTION (CL:LAMBDA - (FORM) - `(%%CHAR-UPCASE-CODE - (CL:CHAR-CODE ,FORM] - MORE-CHARS))) + `(> (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR)) + ,@(CL:MAPCAR [FUNCTION (CL:LAMBDA + (FORM) + `(%%CHAR-UPCASE-CODE (CL:CHAR-CODE + ,FORM] + MORE-CHARS))) (DEFOPTIMIZER CL:CHAR-LESSP (CHAR &REST MORE-CHARS) - `(< (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR)) - ,@(CL:MAPCAR [FUNCTION (CL:LAMBDA - (FORM) - `(%%CHAR-UPCASE-CODE - (CL:CHAR-CODE ,FORM] - MORE-CHARS))) + `(< (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR)) + ,@(CL:MAPCAR [FUNCTION (CL:LAMBDA (FORM) + `(%%CHAR-UPCASE-CODE + (CL:CHAR-CODE ,FORM] + MORE-CHARS))) (DEFOPTIMIZER CL:CHAR-NOT-EQUAL (CHAR &REST MORE-CHARS) - (CL:IF (EQL 1 (CL:LENGTH MORE-CHARS)) - `[NOT (EQ (%%CHAR-UPCASE-CODE (CL:CHAR-CODE - ,CHAR)) - (%%CHAR-UPCASE-CODE (CL:CHAR-CODE - ,(CAR MORE-CHARS] - 'COMPILER:PASS)) + (CL:IF (EQL 1 (CL:LENGTH MORE-CHARS)) + `[NOT (EQ (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR)) + (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,(CAR MORE-CHARS] + 'COMPILER:PASS)) (DEFOPTIMIZER CL:CHAR-NOT-GREATERP (CHAR &REST MORE-CHARS) - `(<= (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR)) - ,@(CL:MAPCAR [FUNCTION (CL:LAMBDA - (FORM) - `(%%CHAR-UPCASE-CODE - (CL:CHAR-CODE ,FORM] - MORE-CHARS))) + `(<= (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR)) + ,@(CL:MAPCAR [FUNCTION (CL:LAMBDA + (FORM) + `(%%CHAR-UPCASE-CODE + (CL:CHAR-CODE ,FORM] + MORE-CHARS))) (DEFOPTIMIZER CL:CHAR-NOT-LESSP (CHAR &REST MORE-CHARS) - `(>= (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR)) - ,@(CL:MAPCAR [FUNCTION (CL:LAMBDA - (FORM) - `(%%CHAR-UPCASE-CODE - (CL:CHAR-CODE ,FORM] - MORE-CHARS))) + `(>= (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR)) + ,@(CL:MAPCAR [FUNCTION (CL:LAMBDA + (FORM) + `(%%CHAR-UPCASE-CODE (CL:CHAR-CODE + ,FORM] + MORE-CHARS))) (DEFOPTIMIZER CL:CHAR/= (CHAR &REST MORE-CHARS) - (CL:IF (CDR MORE-CHARS) - 'COMPILER:PASS - `(NEQ ,CHAR ,(CAR MORE-CHARS)))) + (CL:IF (CDR MORE-CHARS) + 'COMPILER:PASS + `(NEQ ,CHAR ,(CAR MORE-CHARS)))) (DEFOPTIMIZER CL:CHAR< (CHAR &REST MORE-CHARS) - `(< (CL:CHAR-CODE ,CHAR) - ,@(CL:MAPCAR [FUNCTION (CL:LAMBDA (FORM) - `(CL:CHAR-CODE ,FORM] - MORE-CHARS))) + `(< (CL:CHAR-CODE ,CHAR) + ,@(CL:MAPCAR [FUNCTION (CL:LAMBDA (FORM) + `(CL:CHAR-CODE ,FORM] + MORE-CHARS))) (DEFOPTIMIZER CL:CHAR<= (CHAR &REST MORE-CHARS) - `(<= (CL:CHAR-CODE ,CHAR) - ,@(CL:MAPCAR [FUNCTION (CL:LAMBDA (FORM) - `(CL:CHAR-CODE ,FORM] - MORE-CHARS))) + `(<= (CL:CHAR-CODE ,CHAR) + ,@(CL:MAPCAR [FUNCTION (CL:LAMBDA (FORM) + `(CL:CHAR-CODE ,FORM] + MORE-CHARS))) (DEFOPTIMIZER CL:CHAR= (CHAR &REST MORE-CHARS) - (CL:IF (CDR MORE-CHARS) - [LET - ((CH (GENSYM))) + (CL:IF (CDR MORE-CHARS) + [LET ((CH (GENSYM))) `(LET ((,CH ,CHAR)) (AND ,@(for X in MORE-CHARS collect `(EQ ,CH ,X] - `(EQ ,CHAR ,(CAR MORE-CHARS)))) + `(EQ ,CHAR ,(CAR MORE-CHARS)))) (DEFOPTIMIZER CL:CHAR> (CHAR &REST MORE-CHARS) - `(> (CL:CHAR-CODE ,CHAR) - ,@(CL:MAPCAR [FUNCTION (CL:LAMBDA (FORM) - `(CL:CHAR-CODE ,FORM] - MORE-CHARS))) + `(> (CL:CHAR-CODE ,CHAR) + ,@(CL:MAPCAR [FUNCTION (CL:LAMBDA (FORM) + `(CL:CHAR-CODE ,FORM] + MORE-CHARS))) (DEFOPTIMIZER CL:CHAR>= (CHAR &REST MORE-CHARS) - `(>= (CL:CHAR-CODE ,CHAR) - ,@(CL:MAPCAR [FUNCTION (CL:LAMBDA (FORM) - `(CL:CHAR-CODE ,FORM] - MORE-CHARS))) + `(>= (CL:CHAR-CODE ,CHAR) + ,@(CL:MAPCAR [FUNCTION (CL:LAMBDA (FORM) + `(CL:CHAR-CODE ,FORM] + MORE-CHARS))) (DEFOPTIMIZER CL:CHARACTERP (OBJECT) - `(TYPENAMEP ,OBJECT 'CHARACTER)) + `(TYPENAMEP ,OBJECT 'CHARACTER)) (DEFOPTIMIZER CL:LOWER-CASE-P (CHAR) - `(<= (CONSTANT (CL:CHAR-CODE #\a)) - (CL:CHAR-CODE ,CHAR) - (CONSTANT (CL:CHAR-CODE #\z)))) + `(<= (CONSTANT (CL:CHAR-CODE #\a)) + (CL:CHAR-CODE ,CHAR) + (CONSTANT (CL:CHAR-CODE #\z)))) (DEFOPTIMIZER CL:STRING-CHAR-P (CHAR) - `(\DTEST ,CHAR 'CHARACTER)) + `(\DTEST ,CHAR 'CHARACTER)) (DEFOPTIMIZER CL:UPPER-CASE-P (CHAR) - `(<= (CONSTANT (CL:CHAR-CODE #\A)) - (CL:CHAR-CODE ,CHAR) - (CONSTANT (CL:CHAR-CODE #\Z)))) + `(<= (CONSTANT (CL:CHAR-CODE #\A)) + (CL:CHAR-CODE ,CHAR) + (CONSTANT (CL:CHAR-CODE #\Z)))) @@ -772,21 +773,24 @@ Copyright (c) 1985, 1986, 1987, 1990, 1995, 1999 by Venue & Xerox Corporation. (ADDTOVAR NLAML CHARCODE) (ADDTOVAR LAMA CL:CHAR>= CL:CHAR> CL:CHAR= CL:CHAR<= CL:CHAR< CL:CHAR/= CL:CHAR-NOT-LESSP - CL:CHAR-NOT-GREATERP CL:CHAR-NOT-EQUAL CL:CHAR-LESSP CL:CHAR-GREATERP - CL:CHAR-EQUAL) + CL:CHAR-NOT-GREATERP CL:CHAR-NOT-EQUAL CL:CHAR-LESSP CL:CHAR-GREATERP + CL:CHAR-EQUAL) ) -(PUTPROPS CMLCHARACTER COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990 1995 1999)) +(PUTPROPS CMLCHARACTER COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990 1995 1999 2023)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4041 4323 (CHARCODE 4051 . 4110) (CHARCODE.UNDECODE 4112 . 4321)) (6868 7233 ( -CL:CHAR-CODE 6878 . 7026) (CL:CHAR-INT 7028 . 7090) (CL:INT-CHAR 7092 . 7231)) (9139 10193 ( -CHARACTER.PRINT 9149 . 10191)) (10406 13937 (CL:CHAR-BIT 10416 . 10569) (CL:CHAR-BITS 10571 . 10728) ( -CL:CHAR-DOWNCASE 10730 . 10916) (CL:CHAR-FONT 10918 . 11075) (CL:CHAR-NAME 11077 . 12860) ( -CL:CHAR-UPCASE 12862 . 13044) (CL:CHARACTER 13046 . 13534) (CL:NAME-CHAR 13536 . 13776) (CL:SET-CHAR-BIT - 13778 . 13935)) (15381 18563 (CL:ALPHA-CHAR-P 15391 . 15927) (CL:ALPHANUMERICP 15929 . 16123) ( -CL:BOTH-CASE-P 16125 . 16232) (CL:CHARACTERP 16234 . 16378) (CL:GRAPHIC-CHAR-P 16380 . 17513) ( -CL:LOWER-CASE-P 17515 . 17668) (CL:STANDARD-CHAR-P 17670 . 18336) (CL:STRING-CHAR-P 18338 . 18406) ( -CL:UPPER-CASE-P 18408 . 18561)) (18564 24388 (CL:CHAR-EQUAL 18574 . 18968) (CL:CHAR-GREATERP 18970 . -19477) (CL:CHAR-LESSP 19479 . 19983) (CL:CHAR-NOT-EQUAL 19985 . 20585) (CL:CHAR-NOT-GREATERP 20587 . -21099) (CL:CHAR-NOT-LESSP 21101 . 21610) (CL:CHAR/= 21612 . 22192) (CL:CHAR< 22194 . 22644) (CL:CHAR<= - 22646 . 23098) (CL:CHAR= 23100 . 23480) (CL:CHAR> 23482 . 23932) (CL:CHAR>= 23934 . 24386))))) + (FILEMAP (NIL (4013 4295 (CHARCODE 4023 . 4082) (CHARCODE.UNDECODE 4084 . 4293)) (6601 6966 ( +CL:CHAR-CODE 6611 . 6759) (CL:CHAR-INT 6761 . 6823) (CL:INT-CHAR 6825 . 6964)) (6968 7269 (CL:CODE-CHAR + 6968 . 7269)) (8788 9842 (CHARACTER.PRINT 8798 . 9840)) (10055 14089 (CL:CHAR-BIT 10065 . 10218) ( +CL:CHAR-BITS 10220 . 10377) (CL:CHAR-DOWNCASE 10379 . 10565) (CL:CHAR-FONT 10567 . 10724) (CL:CHAR-NAME + 10726 . 13012) (CL:CHAR-UPCASE 13014 . 13196) (CL:CHARACTER 13198 . 13686) (CL:NAME-CHAR 13688 . +13928) (CL:SET-CHAR-BIT 13930 . 14087)) (14091 14484 (CL:DIGIT-CHAR 14091 . 14484)) (14486 14650 ( +CL:MAKE-CHAR 14486 . 14650)) (15329 18511 (CL:ALPHA-CHAR-P 15339 . 15875) (CL:ALPHANUMERICP 15877 . +16071) (CL:BOTH-CASE-P 16073 . 16180) (CL:CHARACTERP 16182 . 16326) (CL:GRAPHIC-CHAR-P 16328 . 17461) +(CL:LOWER-CASE-P 17463 . 17616) (CL:STANDARD-CHAR-P 17618 . 18284) (CL:STRING-CHAR-P 18286 . 18354) ( +CL:UPPER-CASE-P 18356 . 18509)) (18512 24336 (CL:CHAR-EQUAL 18522 . 18916) (CL:CHAR-GREATERP 18918 . +19425) (CL:CHAR-LESSP 19427 . 19931) (CL:CHAR-NOT-EQUAL 19933 . 20533) (CL:CHAR-NOT-GREATERP 20535 . +21047) (CL:CHAR-NOT-LESSP 21049 . 21558) (CL:CHAR/= 21560 . 22140) (CL:CHAR< 22142 . 22592) (CL:CHAR<= + 22594 . 23046) (CL:CHAR= 23048 . 23428) (CL:CHAR> 23430 . 23880) (CL:CHAR>= 23882 . 24334)) (24338 +25228 (CL:DIGIT-CHAR-P 24338 . 25228)) (30590 30935 (%%CHAR-DOWNCASE-CODE 30590 . 30935)) (30937 31280 + (%%CHAR-UPCASE-CODE 30937 . 31280)) (31282 31341 (%%CODE-CHAR 31282 . 31341))))) STOP diff --git a/sources/CMLCHARACTER.LCOM b/sources/CMLCHARACTER.LCOM index ed86fbb82..619ea092d 100644 Binary files a/sources/CMLCHARACTER.LCOM and b/sources/CMLCHARACTER.LCOM differ