(FILECREATED "10-Feb-86 13:15:25" {DSK}<LISPFILES2>ARITH.;1 15128 changes to: (VARS ARITHCOMS) previous date: " 7-Feb-86 15:42:30" {DSK}<LISPFILES2>ARITH.;1) (PRETTYCOMPRINT ARITHCOMS) (RPAQQ ARITHCOMS ((FNS R.add R.add.neg.word R.add.pos.word R.boolean.and R.boolean.not R.boolean.or R.boolean.xor R.divide R.equal.to R.equal.to.else R.fix R.float R.greater.than R.greater.than.else R.integer.divide R.left.shift R.less.than R.less.than.else R.load.constant R.load.neg.word R.load.pos.word R.load.value.Xn R.load.value.XnM R.load.value.Yn R.minus R.modulus R.multiply R.not.equal.to R.not.equal.to.else R.not.greater.than R.not.greater.than.else R.not.less.than R.not.less.than.else R.raw.float R.right.shift R.store.float R.store.integer R.store.value.Xn R.store.value.XnM R.store.value.Yn R.store.variable.Xn R.store.variable.XnM R.store.variable.Yn R.subtract W.add W.add.neg.word W.add.pos.word W.boolean.and W.boolean.not W.boolean.or W.boolean.xor W.divide W.equal.to W.equal.to.else W.fix W.float W.greater.than W.greater.than.else W.integer.divide W.left.shift W.less.than W.less.than.else W.load.constant W.load.neg.word W.load.pos.word W.load.value.Xn W.load.value.XnM W.load.value.Yn W.minus W.modulus W.multiply W.not.equal.to W.not.equal.to.else W.not.greater.than W.not.greater.than.else W.not.less.than W.not.less.than.else W.raw.float W.right.shift W.store.float W.store.integer W.store.value.Xn W.store.value.XnM W.store.value.Yn W.store.variable.Xn W.store.variable.XnM W.store.variable.Yn W.subtract load.value.error) (MACROS def.binop def.relop load.value store.value store.variable))) (DEFINEQ (R.add [LAMBDA NIL (put.nb T0 (PLUS (get.nb T1) (get.nb T0))) (continue 0]) (R.add.neg.word [LAMBDA NIL [put.nb T0 (PLUS (get.nb T0) (\VAG2 (CONSTANT (\HILOC -1)) (get.code P 0] (continue 1]) (R.add.pos.word [LAMBDA NIL (put.nb T0 (PLUS (get.nb T0) (get.code P 0))) (continue 1]) (R.boolean.and [LAMBDA NIL (put.nb T0 (LOGAND (get.nb T1) (get.nb T0))) (continue 0]) (R.boolean.not [LAMBDA NIL (put.nb T0 (LOGNOT (get.nb T0))) (continue 0]) (R.boolean.or [LAMBDA NIL (put.nb T0 (LOGOR (get.nb T1) (get.nb T0))) (continue 0]) (R.boolean.xor [LAMBDA NIL (put.nb T0 (LOGXOR (get.nb T1) (get.nb T0))) (continue 0]) (R.divide [LAMBDA NIL (put.nb T0 (FQUOTIENT (get.nb T1) (get.nb T0))) (continue 0]) (R.equal.to [LAMBDA NIL (if (EQP (get.nb T1) (get.nb T0)) then (continue 0) else (fast.fail]) (R.equal.to.else [LAMBDA NIL (if (EQP (get.nb T1) (get.nb T0)) then (continue 1) else (continue.at (address.operand]) (R.fix [LAMBDA NIL [if (FLOATP (get.nb T0)) then (put.nb T0 (FIX (get.nb T0] (continue 0]) (R.float [LAMBDA NIL [if (NOT (FLOATP (get.nb T0))) then (put.nb T0 (FLOAT (get.nb T0] (continue 0]) (R.greater.than [LAMBDA NIL (if (GREATERP (get.nb T1) (get.nb T0)) then (continue 0) else (fast.fail]) (R.greater.than.else [LAMBDA NIL (if (GREATERP (get.nb T1) (get.nb T0)) then (continue 1) else (continue.at (address.operand]) (R.integer.divide [LAMBDA NIL (put.nb T0 (IQUOTIENT (get.nb T1) (get.nb T0))) (continue 0]) (R.left.shift [LAMBDA NIL (put.nb T0 (LSH (get.nb T1) (get.nb T0))) (continue 0]) (R.less.than [LAMBDA NIL (if (LESSP (get.nb T1) (get.nb T0)) then (continue 0) else (fast.fail]) (R.less.than.else [LAMBDA NIL (if (LESSP (get.nb T1) (get.nb T0)) then (continue 1) else (continue.at (address.operand]) (R.load.constant [LAMBDA NIL (put.32 T1 (get.32 T0)) (put.32 T0 (cell.operand)) (continue 2]) (R.load.neg.word [LAMBDA NIL (put.32 T1 (get.32 T0)) (put.nb T0 (\VAG2 (CONSTANT (\HILOC -1)) (get.code P 0))) (continue 1]) (R.load.pos.word [LAMBDA NIL (put.32 T1 (get.32 T0)) (put.nb T0 (get.code P 0)) (continue 1]) (R.load.value.Xn [LAMBDA NIL (put.32 T1 (get.32 T0)) (put.32 T0 (get.Aval N)) (load.value]) (R.load.value.XnM [LAMBDA NIL (put.32 T1 (get.32 T0)) (put.32 T0 (get.Amem N)) (load.value]) (R.load.value.Yn [LAMBDA NIL (put.32 T1 (get.32 T0)) (put.32 T0 (get.Yval N)) (load.value]) (R.minus [LAMBDA NIL (put.nb T0 (MINUS (get.nb T0))) (continue 0]) (R.modulus [LAMBDA NIL (put.nb T0 (REMAINDER (get.nb T1) (get.nb T0))) (continue 0]) (R.multiply [LAMBDA NIL (put.nb T0 (TIMES (get.nb T1) (get.nb T0))) (continue 0]) (R.not.equal.to [LAMBDA NIL (if ([LAMBDA (X Y) (NOT (EQP X Y] (get.nb T1) (get.nb T0)) then (continue 0) else (fast.fail]) (R.not.equal.to.else [LAMBDA NIL (if ([LAMBDA (X Y) (NOT (EQP X Y] (get.nb T1) (get.nb T0)) then (continue 1) else (continue.at (address.operand]) (R.not.greater.than [LAMBDA NIL (if (LEQ (get.nb T1) (get.nb T0)) then (continue 0) else (fast.fail]) (R.not.greater.than.else [LAMBDA NIL (if (LEQ (get.nb T1) (get.nb T0)) then (continue 1) else (continue.at (address.operand]) (R.not.less.than [LAMBDA NIL (if (GEQ (get.nb T1) (get.nb T0)) then (continue 0) else (fast.fail]) (R.not.less.than.else [LAMBDA NIL (if (GEQ (get.nb T1) (get.nb T0)) then (continue 1) else (continue.at (address.operand]) (R.raw.float [LAMBDA NIL [LET [(Ptr (FLOAT (get.nb T0] (put.nb T0 (\MAKENUMBER (\GETBASE Ptr 0) (\GETBASE Ptr 1] (continue 0]) (R.right.shift [LAMBDA NIL (put.nb T0 (RSH (get.nb T1) (get.nb T0))) (continue 0]) (R.store.float [LAMBDA NIL (put.32 T1 (cell.operand)) (if (AND (FLOATP (get.nb T0)) (EQP (get.nb T0) (get.nb T1))) then (continue 2) else (fast.fail]) (R.store.integer [LAMBDA NIL (put.32 T1 (cell.operand)) (if (AND (FIXP (get.nb T0)) (EQP (get.nb T0) (get.nb T1))) then (continue 2) else (fast.fail]) (R.store.value.Xn [LAMBDA NIL (put.32 T1 (get.Aval N)) (store.value]) (R.store.value.XnM [LAMBDA NIL (put.32 T1 (get.Amem N)) (store.value]) (R.store.value.Yn [LAMBDA NIL (put.32 T1 (get.Yval N)) (store.value]) (R.store.variable.Xn [LAMBDA NIL (store.variable put.Aval) (continue 0]) (R.store.variable.XnM [LAMBDA NIL (store.variable put.Amem) (continue 0]) (R.store.variable.Yn [LAMBDA NIL (store.variable put.Yval) (continue 0]) (R.subtract [LAMBDA NIL (put.nb T0 (DIFFERENCE (get.nb T1) (get.nb T0))) (continue 0]) (W.add [LAMBDA NIL (put.nb T0 (PLUS (get.nb T1) (get.nb T0))) (continue 0]) (W.add.neg.word [LAMBDA NIL [put.nb T0 (PLUS (get.nb T0) (\VAG2 (CONSTANT (\HILOC -1)) (get.code P 0] (continue 1]) (W.add.pos.word [LAMBDA NIL (put.nb T0 (PLUS (get.nb T0) (get.code P 0))) (continue 1]) (W.boolean.and [LAMBDA NIL (put.nb T0 (LOGAND (get.nb T1) (get.nb T0))) (continue 0]) (W.boolean.not [LAMBDA NIL (put.nb T0 (LOGNOT (get.nb T0))) (continue 0]) (W.boolean.or [LAMBDA NIL (put.nb T0 (LOGOR (get.nb T1) (get.nb T0))) (continue 0]) (W.boolean.xor [LAMBDA NIL (put.nb T0 (LOGXOR (get.nb T1) (get.nb T0))) (continue 0]) (W.divide [LAMBDA NIL (put.nb T0 (FQUOTIENT (get.nb T1) (get.nb T0))) (continue 0]) (W.equal.to [LAMBDA NIL (if (EQP (get.nb T1) (get.nb T0)) then (continue 0) else (fast.fail]) (W.equal.to.else [LAMBDA NIL (if (EQP (get.nb T1) (get.nb T0)) then (continue 1) else (continue.at (address.operand]) (W.fix [LAMBDA NIL [if (FLOATP (get.nb T0)) then (put.nb T0 (FIX (get.nb T0] (continue 0]) (W.float [LAMBDA NIL [if (NOT (FLOATP (get.nb T0))) then (put.nb T0 (FLOAT (get.nb T0] (continue 0]) (W.greater.than [LAMBDA NIL (if (GREATERP (get.nb T1) (get.nb T0)) then (continue 0) else (fast.fail]) (W.greater.than.else [LAMBDA NIL (if (GREATERP (get.nb T1) (get.nb T0)) then (continue 1) else (continue.at (address.operand]) (W.integer.divide [LAMBDA NIL (put.nb T0 (IQUOTIENT (get.nb T1) (get.nb T0))) (continue 0]) (W.left.shift [LAMBDA NIL (put.nb T0 (LSH (get.nb T1) (get.nb T0))) (continue 0]) (W.less.than [LAMBDA NIL (if (LESSP (get.nb T1) (get.nb T0)) then (continue 0) else (fast.fail]) (W.less.than.else [LAMBDA NIL (if (LESSP (get.nb T1) (get.nb T0)) then (continue 1) else (continue.at (address.operand]) (W.load.constant [LAMBDA NIL (put.32 T1 (get.32 T0)) (put.32 T0 (cell.operand)) (continue 2]) (W.load.neg.word [LAMBDA NIL (put.32 T1 (get.32 T0)) (put.nb T0 (\VAG2 (CONSTANT (\HILOC -1)) (get.code P 0))) (continue 1]) (W.load.pos.word [LAMBDA NIL (put.32 T1 (get.32 T0)) (put.nb T0 (get.code P 0)) (continue 1]) (W.load.value.Xn [LAMBDA NIL (put.32 T1 (get.32 T0)) (put.32 T0 (get.Aval N)) (load.value]) (W.load.value.XnM [LAMBDA NIL (put.32 T1 (get.32 T0)) (put.32 T0 (get.Amem N)) (load.value]) (W.load.value.Yn [LAMBDA NIL (put.32 T1 (get.32 T0)) (put.32 T0 (get.Yval N)) (load.value]) (W.minus [LAMBDA NIL (put.nb T0 (MINUS (get.nb T0))) (continue 0]) (W.modulus [LAMBDA NIL (put.nb T0 (REMAINDER (get.nb T1) (get.nb T0))) (continue 0]) (W.multiply [LAMBDA NIL (put.nb T0 (TIMES (get.nb T1) (get.nb T0))) (continue 0]) (W.not.equal.to [LAMBDA NIL (if ([LAMBDA (X Y) (NOT (EQP X Y] (get.nb T1) (get.nb T0)) then (continue 0) else (fast.fail]) (W.not.equal.to.else [LAMBDA NIL (if ([LAMBDA (X Y) (NOT (EQP X Y] (get.nb T1) (get.nb T0)) then (continue 1) else (continue.at (address.operand]) (W.not.greater.than [LAMBDA NIL (if (LEQ (get.nb T1) (get.nb T0)) then (continue 0) else (fast.fail]) (W.not.greater.than.else [LAMBDA NIL (if (LEQ (get.nb T1) (get.nb T0)) then (continue 1) else (continue.at (address.operand]) (W.not.less.than [LAMBDA NIL (if (GEQ (get.nb T1) (get.nb T0)) then (continue 0) else (fast.fail]) (W.not.less.than.else [LAMBDA NIL (if (GEQ (get.nb T1) (get.nb T0)) then (continue 1) else (continue.at (address.operand]) (W.raw.float [LAMBDA NIL [LET [(Ptr (FLOAT (get.nb T0] (put.nb T0 (\MAKENUMBER (\GETBASE Ptr 0) (\GETBASE Ptr 1] (continue 0]) (W.right.shift [LAMBDA NIL (put.nb T0 (RSH (get.nb T1) (get.nb T0))) (continue 0]) (W.store.float [LAMBDA NIL (put.32 T1 (cell.operand)) (if (AND (FLOATP (get.nb T0)) (EQP (get.nb T0) (get.nb T1))) then (continue 2) else (fast.fail]) (W.store.integer [LAMBDA NIL (put.32 T1 (cell.operand)) (if (AND (FIXP (get.nb T0)) (EQP (get.nb T0) (get.nb T1))) then (continue 2) else (fast.fail]) (W.store.value.Xn [LAMBDA NIL (put.32 T1 (get.Aval N)) (store.value]) (W.store.value.XnM [LAMBDA NIL (put.32 T1 (get.Amem N)) (store.value]) (W.store.value.Yn [LAMBDA NIL (put.32 T1 (get.Yval N)) (store.value]) (W.store.variable.Xn [LAMBDA NIL (store.variable put.Aval) (continue 0]) (W.store.variable.XnM [LAMBDA NIL (store.variable put.Amem) (continue 0]) (W.store.variable.Yn [LAMBDA NIL (store.variable put.Yval) (continue 0]) (W.subtract [LAMBDA NIL (put.nb T0 (DIFFERENCE (get.nb T1) (get.nb T0))) (continue 0]) (load.value.error [LAMBDA NIL (QP.PUT.TOKEN.SIMPLE QP.CURRENT.OUTPUT " % [Warning: Arithmetic predicate has failed - tried to evaluate a non number] % [ Use the interpreter and debugger to locate this error] % ") (fast.fail]) ) (DECLARE: EVAL@COMPILE (PUTPROPS def.binop MACRO (X (APPLY [FUNCTION (LAMBDA (Op Fn) (BQUOTE (def.both.mode (\, Op) (extend) (put.nb T0 ((\, Fn) (get.nb T1) (get.nb T0))) (continue 0] X))) (PUTPROPS def.relop MACRO (X (APPLY [FUNCTION (LAMBDA (Fn Op1 Op2) (BQUOTE (PROGN (def.both.mode (\, Op1) (extend) (if ((\, Fn) (get.nb T1) (get.nb T0)) then (continue 0) else (fast.fail))) (def.both.mode (\, Op2) (address) (if ((\, Fn) (get.nb T1) (get.nb T0)) then (continue 1) else (continue.at ( address.operand] X))) [PUTPROPS load.value MACRO (OPENLAMBDA NIL (LET (Tag R) (while [AND (EQ (SETQ Tag (tag.of T0)) ref.tag.8) (NEQ (SETQ R (untag.ref T0)) (PROGN (put.32 T0 (get-cell-for-apply R 0)) (untag.ref T0] do NIL) (if (ILESSP Tag immed.tag.8) then (load.value.error) else (continue 0] (PUTPROPS store.value MACRO (OPENLAMBDA NIL (LET ((Ptr (get.nb T0))) (if (AND (EQ (tag.of T1) ref.tag.8) (NOT (SMALLP Ptr)) (NUMBERP Ptr)) then (QP.ADD.REF Ptr)) (put.32 T0 (tag.other Ptr))) (unify.and.continue 0))) (PUTPROPS store.variable MACRO (X (APPLY [FUNCTION (LAMBDA (store) (BQUOTE (LET ((Ptr (get.nb T0))) (if (AND (NOT (SMALLP Ptr)) (NUMBERP Ptr)) then (QP.ADD.REF Ptr)) ((\, store) N (tag.other Ptr] X))) ) (DECLARE: DONTCOPY (FILEMAP (NIL (1733 13215 (R.add 1743 . 1845) (R.add.neg.word 1847 . 2005) (R.add.pos.word 2007 . 2121 ) (R.boolean.and 2123 . 2230) (R.boolean.not 2232 . 2319) (R.boolean.or 2321 . 2425) (R.boolean.xor 2427 . 2534) (R.divide 2536 . 2644) (R.equal.to 2646 . 2775) (R.equal.to.else 2777 . 2930) (R.fix 2932 . 3053) (R.float 3055 . 3190) (R.greater.than 3192 . 3335) (R.greater.than.else 3337 . 3504) ( R.integer.divide 3506 . 3622) (R.left.shift 3624 . 3731) (R.less.than 3733 . 3867) (R.less.than.else 3869 . 4027) (R.load.constant 4029 . 4140) (R.load.neg.word 4142 . 4299) (R.load.pos.word 4301 . 4412) (R.load.value.Xn 4414 . 4523) (R.load.value.XnM 4525 . 4635) (R.load.value.Yn 4637 . 4746) (R.minus 4748 . 4832) (R.modulus 4834 . 4943) (R.multiply 4945 . 5047) (R.not.equal.to 5049 . 5225) ( R.not.equal.to.else 5227 . 5427) (R.not.greater.than 5429 . 5566) (R.not.greater.than.else 5568 . 5729 ) (R.not.less.than 5731 . 5865) (R.not.less.than.else 5867 . 6025) (R.raw.float 6027 . 6199) ( R.right.shift 6201 . 6309) (R.store.float 6311 . 6512) (R.store.integer 6514 . 6715) (R.store.value.Xn 6717 . 6800) (R.store.value.XnM 6802 . 6886) (R.store.value.Yn 6888 . 6971) (R.store.variable.Xn 6973 . 7059) (R.store.variable.XnM 7061 . 7148) (R.store.variable.Yn 7150 . 7236) (R.subtract 7238 . 7350) (W.add 7352 . 7454) (W.add.neg.word 7456 . 7614) (W.add.pos.word 7616 . 7730) (W.boolean.and 7732 . 7839) (W.boolean.not 7841 . 7928) (W.boolean.or 7930 . 8034) (W.boolean.xor 8036 . 8143) (W.divide 8145 . 8253) (W.equal.to 8255 . 8384) (W.equal.to.else 8386 . 8539) (W.fix 8541 . 8662) (W.float 8664 . 8799) (W.greater.than 8801 . 8944) (W.greater.than.else 8946 . 9113) (W.integer.divide 9115 . 9231) (W.left.shift 9233 . 9340) (W.less.than 9342 . 9476) (W.less.than.else 9478 . 9636) (W.load.constant 9638 . 9749) (W.load.neg.word 9751 . 9908) (W.load.pos.word 9910 . 10021) (W.load.value.Xn 10023 . 10132) (W.load.value.XnM 10134 . 10244) (W.load.value.Yn 10246 . 10355) (W.minus 10357 . 10441) ( W.modulus 10443 . 10552) (W.multiply 10554 . 10656) (W.not.equal.to 10658 . 10834) ( W.not.equal.to.else 10836 . 11036) (W.not.greater.than 11038 . 11175) (W.not.greater.than.else 11177 . 11338) (W.not.less.than 11340 . 11474) (W.not.less.than.else 11476 . 11634) (W.raw.float 11636 . 11808) (W.right.shift 11810 . 11918) (W.store.float 11920 . 12121) (W.store.integer 12123 . 12324) ( W.store.value.Xn 12326 . 12409) (W.store.value.XnM 12411 . 12495) (W.store.value.Yn 12497 . 12580) ( W.store.variable.Xn 12582 . 12668) (W.store.variable.XnM 12670 . 12757) (W.store.variable.Yn 12759 . 12845) (W.subtract 12847 . 12959) (load.value.error 12961 . 13213))))) STOP