(FILECREATED "25-Sep-86 13:07:05" ("compiled on " {ERIS}SOURCES>ADDARITH.;23) "24-Sep-86 19:51:31" in "Xerox Lisp 24-Sep-86 ..." dated "24-Sep-86 20:08:23") (FILECREATED "25-Sep-86 13:03:49" {ERIS}SOURCES>ADDARITH.;23 37899 changes to: (OPTIMIZERS LOADBYTE) (FUNCTIONS LOADBYTE DEPOSITBYTE IMODPLUS IMODDIFFERENCE \GETBASENIBBLE \PUTBASENIBBLE \GETBASEBIT \PUTBASEBIT) (VARS ADDARITHCOMS) previous date: "24-Sep-86 18:52:54" {ERIS}SOURCES>ADDARITH.;22) (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@ÙB BkØâýñ(6 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 ²ögHIkÙh(26Q POWEROFTWOP 12Q CONSTANTEXPRESSIONP) (33Q 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 @kBçkÙHçmÿæåhkBçkÙåHçä(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)) Y@1Hi Hi º¹J3 ²#I3 ²gIJh[dždiðª3µ gKhggggIggJh(21Q LISPFORM.SIMPLIFY 12Q LISPFORM.SIMPLIFY) (114Q _ 111Q BYTESPEC.POSITION 105Q _ 102Q BYTESPEC.SIZE 77Q BYTESPEC 74Q create 64Q 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@ @kHçkÙå(7 RSH) NIL () DPB D1 (L (2 INTEGER 1 BYTESPEC 0 NEWBYTE)) @kBçkÙAçmÿæåhkBçkÙåAçä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 ²[KM ²TLM ²MgIMLhgð²±gIJ^dždiðª3µ gNhJ_dŸdið«3µ gOhhgoogIohLMhlð²)K 3 ¦HK ²gIgHhgHhhgoogIohHh(321Q ARGS.COMMUTABLEP 310Q EVALUABLE.CONSTANTP 120Q ARGS.COMMUTABLEP 111Q ARGS.COMMUTABLEP 102Q ARGS.COMMUTABLEP 70Q EVALUABLE.CONSTANTP 32Q LISPFORM.SIMPLIFY 21Q EVALUABLE.CONSTANTP 10Q LISPFORM.SIMPLIFY) (371Q LOADBYTE 356Q LAMBDA 341Q BYTESIZE 332Q BYTEPOSITION 326Q LOADBYTE 253Q LOADBYTE 240Q LAMBDA 222Q QUOTE 174Q QUOTE 151Q LOADBYTE 143Q BYTESPEC 125Q LOADBYTE 47Q BYTE) ( 376Q ((BYTEPOSITION \PositionSize) (BYTESIZE \PositionSize)) 366Q (DECLARE (LOCALVARS \PositionSize)) 362Q (\PositionSize) 260Q (\Byteposition \Bytesize) 250Q (DECLARE (LOCALVARS \Bytesize \Byteposition)) 244Q (\Bytesize \Byteposition)) \DPBEXPANDER D1 (L (0 X)) ‰ @@i @i £ Id²dgð²doô˜_µ0I _µTHi ^dJ hðµOhð´ NI hð]d²vg°rgð²ÍO_O_¿»OO_¿¼K ´L _¿°°gð²¨O_dŸdið«3µ gOh»O_dŸdið«3µ gOh¼i_¿±ÿoH_K²ML²JO¬KL ²JI žgJLKOh°sgoogJggOhhKLh°JIlð²$JI ²gJgIhgIhOh°!i½googJohIh_M²gooOhHhO(453Q ARGS.COMMUTABLEP 346Q ARGS.COMMUTABLEP 337Q ARGS.COMMUTABLEP 207Q EVALUABLE.CONSTANTP 201Q EVALUABLE.CONSTANTP 124Q ARGS.COMMUTABLEP 105Q ARGS.COMMUTABLEP 77Q LISPFORM.SIMPLIFY 65Q EVALUABLE.CONSTANTP 20Q LISPFORM.SIMPLIFY 10Q LISPFORM.SIMPLIFY) (560Q LAMBDA 530Q DEPOSITBYTE 515Q LAMBDA 473Q BYTESIZE 464Q BYTEPOSITION 460Q DEPOSITBYTE 413Q \Bytesize 410Q \Byteposition 404Q DEPOSITBYTE 371Q LAMBDA 352Q DEPOSITBYTE 301Q QUOTE 247Q QUOTE 221Q BYTESPEC 143Q LIST 135Q \NewByte 35Q CONS) ( 570Q (DECLARE (LOCALVARS \NewByte)) 564Q (\NewByte) 535Q ((BYTEPOSITION \ByteSpec) (BYTESIZE \ByteSpec) \NewByte) 525Q (DECLARE (LOCALVARS \ByteSpec)) 521Q (\ByteSpec) 401Q (DECLARE (LOCALVARS \Bytesize \Byteposition)) 375Q (\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)) dAló²@AââââÐAlåb¿b¿°éBlAÕó²$@AlAÕCBlAÕÕb @kÐjb¿b¿¿°¿@dkBçkÙAçmÿæåCkBçkÙåAçäHIÍI(65Q \PUTBASEBITS 62Q RSH) NIL () \GETBASENIBBLE D1 (L (1 OFFST 0 BASE)) @AâÂAkåjð¤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ð¥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)) 2AâââlAlåÙkHç@HÂZIJåjð•Bjðhð‚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