(FILECREATED " 7-Oct-86 15:49:32" ("compiled on " {ERIS}SOURCES>ADDARITH.;24) " 1-Oct-86 20:23:15" "COMPILE-FILEd" in "Xerox Lisp 1-Oct-86 ..." dated " 1-Oct-86 21:24:44") (FILECREATED " 7-Oct-86 15:48:41" {ERIS}SOURCES>ADDARITH.;24 37851 changes to: (VARS ADDARITHCOMS) (FNS ROT) previous date: "25-Sep-86 13:03:49" {ERIS}SOURCES>ADDARITH.;23) (RPAQQ ADDARITHCOMS ((LOCALVARS . T) (COMS (* ; "Rational operations and useful constants") (FNS \RTIMES2 \RATIONALIZE \RPLUS2 \RMINUS CREATERATIONAL RATIONALTOINTEGER) (RECORDS RATIONAL)) (* ; "OK") (MACROS MASK.1'S MASK.0'S BITTEST BITSET BITCLEAR) (OPTIMIZERS LOGNOT) (FNS LOGNOT) (* ; "BYTE hacking functions") (RECORDS BYTESPEC) (FUNCTIONS LOADBYTE DEPOSITBYTE) (FNS IMODLESSP) ( FUNCTIONS IMODPLUS IMODDIFFERENCE) (OPTIMIZERS IMOD) (FNS ROT) (MACROS .ROT.) (* ; "NOT OK YET") ( OPTIMIZERS BYTE DPB LDB) (MACROS BYTESIZE BYTEPOSITION) (FNS LDB DPB BYTE) (FNS \LDBEXPANDER \DPBEXPANDER) (COMS (* ;; "Primitive Functions for extracting fields as integers") (MACROS \XLOADBYTEWORD) (FNS \PUTBASEBITS) (* ;; "Primitive functions, especially needed for CommonLisp array package.") (DECLARE: DONTCOPY (MACROS .HIHALFWORDLO. .HIHALFWORDHI. .LOHALFWORDLO. .LOHALFWORDHI.)) (FUNCTIONS \GETBASENIBBLE \PUTBASENIBBLE \GETBASEBIT \PUTBASEBIT)) (COMS (* ;; "Beginning of rewrite of some LLARITH things, modularly using the macros of this file") (DECLARE: DONTCOPY (EXPORT (CONSTANTS MASK0WORD1'S MASK1WORD0'S MASKWORD1'S MASKHALFWORD1'S BITSPERHALFWORD) ( MACROS EQZEROP) (MACROS \MOVETOBOX .XUNBOX. .XLLSH. .XLLSH1. .XLRSH. .ADD.2WORD.INTEGERS. .SUB.2WORD.INTEGERS. .32BITMUL.) (MACROS .SUMSMALLMOD. .DIFFERENCESMALLMOD.)) (MACROS .ADD.2WORD.INTEGERS. .SUB.2WORD.INTEGERS. .32BITMUL.))) (PROP FILETYPE ADDARITH DF CREATERATIONAL))) \RTIMES2 D1 (L (1 R2 0 R1)) @µAµ@3 ².A3 ²@AÚ b¿°ì b¿°ß@dAô“¿AAÚA A3 µ@dAô²¿A@ d@ô“¿@@Ö@ Aô—@A @AÚ@AÚ (174Q \RATIONALIZE 156Q \RATIONALIZE 141Q \RATIONALIZE 117Q \RATIONALIZE 71Q \RATIONALIZE 42Q MAKERATIONAL 32Q MAKERATIONAL) NIL () \RATIONALIZE D1 (L (1 DEN 0 NUM)) @A AHô“@HÛ@HÛAHÛ (30Q CREATERATIONAL 4 GCD) NIL () \RPLUS2 D1 (L (1 R2 0 R1)) l@µAµ@3 ²)Ad3 ²¿@AØ b¿°ê b¿°Ý@AÚØA A3 œ@A@ÚØ@ @dAô™AØA AÚ@AÚØ@AÚ (151Q \RATIONALIZE 126Q \RATIONALIZE 105Q \RATIONALIZE 64Q \RATIONALIZE 44Q MAKERATIONAL 34Q MAKERATIONAL) NIL () \RMINUS D1 (L (0 X)) @d²d3 žd3 ™ @ (33Q MINUS 27Q CREATERATIONAL 22Q MINUS) NIL () CREATERATIONAL D1 (L (1 DENOMINATOR 0 NUMERATOR)) 8@A"jdHñ›HÙ¸jIñ›jIÙ¹ˆIñ•jIÙ¹i»HI ZHJÛXIJÛYK“jHÙ€HI(43Q GCD) NIL () RATIONALTOINTEGER D1 (L (0 RAT)) @@ë (7 FIXR) NIL () (RECORD RATIONAL (NUMERATOR . DENOMINATOR) (TYPE? (AND (LISTP DATUM) (FIXP (CAR DATUM)) (FIXP (CDR DATUM)))) (CREATE (CREATERATIONAL NUMERATOR DENOMINATOR))) (PUTPROPS MASK.1'S MACRO (OPENLAMBDA (POSITION SIZE) (LSH (SUB1 (LSH 1 SIZE)) POSITION))) (PUTPROPS MASK.0'S MACRO (OPENLAMBDA (POSITION SIZE) (LOGNOT (MASK.1'S POSITION SIZE)))) (PUTPROPS BITTEST MACRO ((N MASK) (NEQ 0 (LOGAND N MASK)))) (PUTPROPS BITSET MACRO (= . LOGOR)) (PUTPROPS BITCLEAR MACRO ((X MASK) (LOGAND X (LOGNOT MASK)))) optimize-LOGNOT D1 (L (2 $$CTX 1 $$ENV 0 $$WHOLE)) @gmÿHhNIL (10Q LOGXOR) () (PUTPROP (QUOTE LOGNOT) (QUOTE COMPILER:OPTIMIZER-LIST) (UNION (GETPROP (QUOTE LOGNOT) (QUOTE COMPILER:OPTIMIZER-LIST)) (LIST (QUOTE optimize-LOGNOT)))) LOGNOT D1 (L (0 INTEGER)) @mÿæNIL NIL () (TYPERECORD BYTESPEC (BYTESPEC.SIZE BYTESPEC.POSITION)) LOADBYTE D1 (L (2 SIZE 1 POS 0 N)) @A kBçkÙå(4 RSH) NIL () defsubst-LOADBYTE D1 (L (2 $$CTX 1 $$ENV 0 $$WHOLE)) @oHNIL NIL ( 10Q (CL:LAMBDA (N POS SIZE) (CL:BLOCK LOADBYTE (LOGAND (RSH N POS) (MASK.1'S 0 SIZE))))) (PUTPROP (QUOTE LOADBYTE) (QUOTE COMPILER:OPTIMIZER-LIST) (UNION (GETPROP (QUOTE LOADBYTE) (QUOTE COMPILER:OPTIMIZER-LIST)) (LIST (QUOTE defsubst-LOADBYTE)))) DEPOSITBYTE D1 (L (3 VAL 2 SIZE 1 POS 0 N)) @kBçkÙAçmÿæåCkBçkÙåAçäNIL NIL () defsubst-DEPOSITBYTE D1 (L (2 $$CTX 1 $$ENV 0 $$WHOLE)) @oHNIL NIL ( 10Q (CL:LAMBDA (N POS SIZE VAL) (CL:BLOCK DEPOSITBYTE (LOGOR (BITCLEAR N (MASK.1'S POS SIZE)) (LSH (LOGAND VAL (MASK.1'S 0 SIZE)) POS))))) (PUTPROP (QUOTE DEPOSITBYTE) (QUOTE COMPILER:OPTIMIZER-LIST) (UNION (GETPROP (QUOTE DEPOSITBYTE) ( QUOTE COMPILER:OPTIMIZER-LIST)) (LIST (QUOTE defsubst-DEPOSITBYTE)))) IMODLESSP D1 (L (2 MODULUS 1 Y 0 X)) A@BHIÙJ BkØâýñ(14Q IMOD) NIL () IMODPLUS D1 (L (2 MODULUS 1 Y 0 X)) @AØB (6 IMOD) NIL () defsubst-IMODPLUS D1 (L (2 $$CTX 1 $$ENV 0 $$WHOLE)) @oHNIL NIL ( 10Q (CL:LAMBDA (X Y MODULUS) (CL:BLOCK IMODPLUS (IMOD (IPLUS X Y) MODULUS)))) (PUTPROP (QUOTE IMODPLUS) (QUOTE COMPILER:OPTIMIZER-LIST) (UNION (GETPROP (QUOTE IMODPLUS) (QUOTE COMPILER:OPTIMIZER-LIST)) (LIST (QUOTE defsubst-IMODPLUS)))) IMODDIFFERENCE D1 (L (2 MODULUS 1 Y 0 X)) @AÙB (6 IMOD) NIL () defsubst-IMODDIFFERENCE D1 (L (2 $$CTX 1 $$ENV 0 $$WHOLE)) @oHNIL NIL ( 10Q (CL:LAMBDA (X Y MODULUS) (CL:BLOCK IMODDIFFERENCE (IMOD (IDIFFERENCE X Y) MODULUS)))) (PUTPROP (QUOTE IMODDIFFERENCE) (QUOTE COMPILER:OPTIMIZER-LIST) (UNION (GETPROP (QUOTE IMODDIFFERENCE) (QUOTE COMPILER:OPTIMIZER-LIST)) (LIST (QUOTE defsubst-IMODDIFFERENCE)))) optimize-IMOD D1 (L (2 $$CTX 1 $$ENV 0 $$WHOLE)) +@H µgYd ‘h€i³ògHIkÙh(26Q POWEROFTWOP 12Q CONSTANTEXPRESSIONP) (37Q LOGAND 17Q IGNOREMACRO) () (PUTPROP (QUOTE IMOD) (QUOTE COMPILER:OPTIMIZER-LIST) (UNION (GETPROP (QUOTE IMOD) (QUOTE COMPILER:OPTIMIZER-LIST)) (LIST (QUOTE optimize-IMOD)))) ROT D1 (L (2 FIELDSIZE 1 N 0 X)) <AB BHÙ¹@IHJK kLçkÙåHI@JkLçkÙKçmÿæåMkLçkÙåKçä(26Q RSH 4 IMOD) NIL () (PUTPROPS .ROT. MACRO ((XFORM N FIELDSIZE) ((OPENLAMBDA (X) (DEPOSITBYTE (LOADBYTE X (IDIFFERENCE FIELDSIZE N) N) N (IDIFFERENCE FIELDSIZE N) X)) XFORM))) optimize-BYTE D1 (L (2 $$CTX 1 $$ENV 0 $$WHOLE)) _@1Hi Hi º¹J3 ²)I3 ²$gIJh[d²dið¯3‘h€i—gKhKggggIggJh(21Q LISPFORM.SIMPLIFY 12Q LISPFORM.SIMPLIFY) (122Q _ 117Q BYTESPEC.POSITION 113Q _ 110Q BYTESPEC.SIZE 105Q BYTESPEC 102Q create 70Q QUOTE 40Q BYTESPEC) () (PUTPROP (QUOTE BYTE) (QUOTE COMPILER:OPTIMIZER-LIST) (UNION (GETPROP (QUOTE BYTE) (QUOTE COMPILER:OPTIMIZER-LIST)) (LIST (QUOTE optimize-BYTE)))) optimize-DPB D1 (L (2 $$CTX 1 $$ENV 0 $$WHOLE)) @ (4 \DPBEXPANDER) NIL () (PUTPROP (QUOTE DPB) (QUOTE COMPILER:OPTIMIZER-LIST) (UNION (GETPROP (QUOTE DPB) (QUOTE COMPILER:OPTIMIZER-LIST)) (LIST (QUOTE optimize-DPB)))) optimize-LDB D1 (L (2 $$CTX 1 $$ENV 0 $$WHOLE)) @ (4 \LDBEXPANDER) NIL () (PUTPROP (QUOTE LDB) (QUOTE COMPILER:OPTIMIZER-LIST) (UNION (GETPROP (QUOTE LDB) (QUOTE COMPILER:OPTIMIZER-LIST)) (LIST (QUOTE optimize-LDB)))) (PUTPROPS BYTESIZE MACRO ((BYTESPEC) (fetch BYTESPEC.SIZE of BYTESPEC))) (PUTPROPS BYTEPOSITION MACRO ((BYTESPEC) (fetch BYTESPEC.POSITION of BYTESPEC))) LDB D1 (L (1 INTEGER 0 BYTESPEC)) A@@HI kJçkÙå(17Q RSH) NIL () DPB D1 (L (2 INTEGER 1 BYTESPEC 0 NEWBYTE)) $BAA@HkJçkÙIçmÿæåKkJçkÙåIçäNIL NIL () BYTE D1 (L (1 POSITION 0 SIZE)) g@AhNIL (2 BYTESPEC) () \LDBEXPANDER D1 (L (0 X)) €@i X@YH ZµKIi [Hd¢±dgð¢±£\H]K 3 ³KL ²iKM ²bLM ²[gIMLhgð²±gIJ^d²dið¯3‘h€i—gNh€NJ_d²dið³3‘h€i˜gOhOhgoogIohLMhlð²)K 3 ¦HK ²gIgHhgHhhgoogIohHh(337Q ARGS.COMMUTABLEP 326Q EVALUABLE.CONSTANTP 120Q ARGS.COMMUTABLEP 111Q ARGS.COMMUTABLEP 102Q ARGS.COMMUTABLEP 70Q EVALUABLE.CONSTANTP 32Q LISPFORM.SIMPLIFY 21Q EVALUABLE.CONSTANTP 10Q LISPFORM.SIMPLIFY) (407Q LOADBYTE 374Q LAMBDA 357Q BYTESIZE 350Q BYTEPOSITION 344Q LOADBYTE 271Q LOADBYTE 256Q LAMBDA 235Q QUOTE 200Q QUOTE 151Q LOADBYTE 143Q BYTESPEC 125Q LOADBYTE 47Q BYTE) ( 414Q ((BYTEPOSITION \PositionSize) (BYTESIZE \PositionSize)) 404Q (DECLARE (LOCALVARS \PositionSize)) 400Q (\PositionSize) 276Q (\Byteposition \Bytesize) 266Q (DECLARE (LOCALVARS \Bytesize \Byteposition)) 262Q (\Bytesize \Byteposition)) \DPBEXPANDER D1 (L (0 X)) ¢ @@i @i £Id²dgð²doô˜_µI _µBHi ^dJ ¢±†h±ƒgð²ßO_O_¿»OO_¿¼K ´L _¿°Âgð²ºO_d²dið³3‘h€i˜gOhO»O_d²dið³3‘h€i˜gOhO¼i_¿±ÿqiµO‘h€i´NI ‘h€i]d“g€H_K²ML²JO¬KL ²JI žgJLKOh°sgoogJggOhhKLh°JIlð²$JI ²gJgIhgIhOh°!i½googJohIh_M²gooOhHhO(504Q ARGS.COMMUTABLEP 377Q ARGS.COMMUTABLEP 370Q ARGS.COMMUTABLEP 334Q ARGS.COMMUTABLEP 165Q EVALUABLE.CONSTANTP 157Q EVALUABLE.CONSTANTP 105Q ARGS.COMMUTABLEP 77Q LISPFORM.SIMPLIFY 65Q EVALUABLE.CONSTANTP 20Q LISPFORM.SIMPLIFY 10Q LISPFORM.SIMPLIFY) (611Q LAMBDA 561Q DEPOSITBYTE 546Q LAMBDA 524Q BYTESIZE 515Q BYTEPOSITION 511Q DEPOSITBYTE 444Q \Bytesize 441Q \Byteposition 435Q DEPOSITBYTE 422Q LAMBDA 403Q DEPOSITBYTE 346Q \NewByte 274Q QUOTE 232Q QUOTE 177Q BYTESPEC 121Q LIST 35Q CONS) ( 621Q (DECLARE (LOCALVARS \NewByte)) 615Q (\NewByte) 566Q ((BYTEPOSITION \ByteSpec) (BYTESIZE \ByteSpec) \NewByte) 556Q (DECLARE (LOCALVARS \ByteSpec)) 552Q (\ByteSpec) 432Q (DECLARE (LOCALVARS \Bytesize \Byteposition)) 426Q (\Bytesize \Byteposition) 47Q (QUOTE BYTESPEC)) (PUTPROPS \XLOADBYTEWORD DMACRO ((N POS SIZE) (* N is constrained to be a SMALLP) (LOGAND (\XLRSHWORD N POS) (MASK.1'S 0 (IMIN BITSPERWORD SIZE))))) \PUTBASEBITS D1 (L (3 VAL 2 SIZE 1 POSITION 0 ADDR)) qAló²@AââââÐAlåb¿b¿°éBlAÕó²$@AlAÕCBlAÕÕb @kÐjb¿b¿¿°¿@dÈlAÕBCHkJçkÙIçmÿæåKkJçkÙåIçäHIÍI(65Q \PUTBASEBITS 62Q RSH) NIL () \GETBASENIBBLE D1 (L (1 OFFST 0 BASE)) @AâÂAkåjð‘h€i”HlåHââââNIL NIL () defsubst-\GETBASENIBBLE D1 (L (2 $$CTX 1 $$ENV 0 $$WHOLE)) @oHNIL NIL ( 10Q (CL:LAMBDA (BASE OFFST) (CL:BLOCK \GETBASENIBBLE ((LAMBDA (\Byte) (DECLARE (LOCALVARS \Byte)) (if (ODDP OFFST) then (LOGAND \Byte (CONSTANT (MASK.1'S 0 BITSPERNIBBLE))) else (LRSH \Byte BITSPERNIBBLE))) (\GETBASEBYTE BASE (FOLDLO OFFST NIBBLESPERBYTE)))))) (PUTPROP (QUOTE \GETBASENIBBLE) (QUOTE COMPILER:OPTIMIZER-LIST) (UNION (GETPROP (QUOTE \GETBASENIBBLE) (QUOTE COMPILER:OPTIMIZER-LIST)) (LIST (QUOTE defsubst-\GETBASENIBBLE)))) \PUTBASENIBBLE D1 (L (2 VAL 1 OFFST 0 BASE)) (Aâ@HÂ¹@HAkåjð‘h€i•IlðåBˆIlåBààààäÇNIL NIL () defsubst-\PUTBASENIBBLE D1 (L (2 $$CTX 1 $$ENV 0 $$WHOLE)) @oHNIL NIL ( 10Q (CL:LAMBDA (BASE OFFST VAL) (CL:BLOCK \PUTBASENIBBLE ((LAMBDA (\ByteNo) (DECLARE (LOCALVARS \ByteNo)) ((LAMBDA (\Byte) (DECLARE (LOCALVARS \Byte)) (\PUTBASEBYTE BASE \ByteNo (if (ODDP OFFST) then (LOGOR (LOGAND \Byte (CONSTANT (MASK.1'S BITSPERNIBBLE BITSPERNIBBLE))) VAL) else (LOGOR (LOGAND \Byte (CONSTANT (MASK.1'S 0 BITSPERNIBBLE))) (LLSH VAL BITSPERNIBBLE))))) (\GETBASEBYTE BASE \ByteNo))) (FOLDLO OFFST NIBBLESPERBYTE))))) (PUTPROP (QUOTE \PUTBASENIBBLE) (QUOTE COMPILER:OPTIMIZER-LIST) (UNION (GETPROP (QUOTE \PUTBASENIBBLE) (QUOTE COMPILER:OPTIMIZER-LIST)) (LIST (QUOTE defsubst-\PUTBASENIBBLE)))) \GETBASEBIT D1 (L (1 OFFST 0 BASE)) "AâââlAlåÙkHçI@HÂåjð‘jkNIL NIL () defsubst-\GETBASEBIT D1 (L (2 $$CTX 1 $$ENV 0 $$WHOLE)) @oHNIL NIL ( 10Q (CL:LAMBDA (BASE OFFST) (CL:BLOCK \GETBASEBIT ((LAMBDA (\ByteNo \BitMask) (DECLARE (LOCALVARS \ByteNo \BitMask)) (if (EQ 0 (LOGAND \BitMask (\GETBASEBYTE BASE \ByteNo))) then 0 else 1)) (FOLDLO OFFST BITSPERBYTE) (MASK.1'S (IDIFFERENCE (CONSTANT (SUB1 BITSPERBYTE)) (IMOD OFFST BITSPERBYTE)) 1))))) (PUTPROP (QUOTE \GETBASEBIT) (QUOTE COMPILER:OPTIMIZER-LIST) (UNION (GETPROP (QUOTE \GETBASEBIT) ( QUOTE COMPILER:OPTIMIZER-LIST)) (LIST (QUOTE defsubst-\GETBASEBIT)))) \PUTBASEBIT D1 (L (2 VAL 1 OFFST 0 BASE)) 4AâââlAlåÙkHç@HÂZIJåjð—Bjð‘h„i‚Bjð•@HIJæÇBNIL NIL () defsubst-\PUTBASEBIT D1 (L (2 $$CTX 1 $$ENV 0 $$WHOLE)) @oHNIL NIL ( 10Q (CL:LAMBDA (BASE OFFST VAL) (CL:BLOCK \PUTBASEBIT ((LAMBDA (\ByteNo \BitMask \Byte) (DECLARE (LOCALVARS \ByteNo \BitMask \Byte)) (SETQ \Byte (\GETBASEBYTE BASE \ByteNo)) (if (if (EQ 0 (LOGAND \BitMask \Byte)) then (NOT (EQ 0 VAL)) else (EQ 0 VAL)) then (\PUTBASEBYTE BASE \ByteNo (LOGXOR \BitMask \Byte))) VAL) (FOLDLO OFFST BITSPERBYTE) (MASK.1'S (IDIFFERENCE (CONSTANT (SUB1 BITSPERBYTE)) (IMOD OFFST BITSPERBYTE)) 1))))) (PUTPROP (QUOTE \PUTBASEBIT) (QUOTE COMPILER:OPTIMIZER-LIST) (UNION (GETPROP (QUOTE \PUTBASEBIT) ( QUOTE COMPILER:OPTIMIZER-LIST)) (LIST (QUOTE defsubst-\PUTBASEBIT)))) (PUTPROPS ADDARITH FILETYPE COMPILE-FILE) (PUTPROPS ADDARITH COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985 1986)) NIL