PDP-10 Archive: decus/20-0004/arithmac.com from decuslib20-01

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0004/arithmac.com

There are no other files named arithmac.com in the archive.

(FILECREATED " 1-DEC-81 11:53:34" ("compiled on " <LISPUSERS>ARITHMAC.;2) (2 . 2) tcompl'd in LFG 
dated " 1-DEC-81 11:46:51")
(FILECREATED " 1-DEC-81 11:51:59" <LISPUSERS>ARITHMAC.;2 9848 previous date: "15-NOV-79 20:58:03" 
<LISPUSERS>ARITHMAC.;1)

FBIND BINARY
-.Z0B+ ,,~,< ,XBp,<Zw,<Z`,<Zp++

,<,<$/, ,\ D,\/,~X(VARIABLE-VALUE-CELL NARGS . 3)
FLOATP
VALUEERROR
(GUNBOX BHC FLOATT KNIL MKFN ASZ ENTERF)`
H0

FLOATSETQ BINARY
-.Z`Z7@7Z"+,<,<`$,<,<`""+
(VAL . 1)
"FLOATP variable not bound to floating box!"
HELP
EVAL
"Attempt to assign non-floating value to floating variable: "
(FUNBOX ALIST2 FLOATT KNOB ENTER2)P@

FLOATSETQMAC BINARY
-.,<[ZBD3B+,<Z,<,<&,~,<",<,<$Z,<,<$,<Z
,<,<&,~YM

`(VARIABLE-VALUE-CELL ARGS . 26)
FLOATP
DECLOF
COVERS
((VR VAL) . 0)
((ASSEMBLE NIL (CQ (VAG VAL)) (E (NUMTOAC 2 (QUOTE FLOATP))) (VAR (HRRZ 1 , VR)) (MOVEM 2 , 0 (1))) . 
0)
SUBPAIR
TERPRI
"Floating SETQ of unknown value:  "
PRIN1
PRINT
((VR VAL) . 0)
((ASSEMBLE NIL (CQ (VAG (the FLOATP VAL))) (E (NUMTOAC 2 (QUOTE FLOATP))) (VAR (HRRZ 1 , VR)) (MOVEM 2
 , 0 (1))) . 0)
(KT KNIL ENTERF)

(	

LARGESETQ BINARY
-.Z`Z7@7Z,<Zp(B{ZA"."0B	+	Zp+	Z/2B+

,<,<`$,<,<`"-,+,<,<`,<`",D,+, ,\ D,~(i2 (VAR . 1)
(VAL . 1)
"LARGEP variable not bound to large box!"
HELP
EVAL
"Attempt to assign non-integer value to largep variable: "
(IUNBOX ALIST2 SKNI BHC KNIL ASZ TYPTAB KNOB ENTER2)@
 

LARGESETQMAC BINARY
! -.,<Z,<[ZB,<@ +,<ZD3B+
Z,~,<ZD3B+
D3B+Z,~,<",<,<$Z,<,<$Z,~F,~+--,QP(VARIABLE-VALUE-CELL ARGS . 39)
((VR VAL) . 0)
DECLOF
(VARIABLE-VALUE-CELL $$TMP . 28)
LARGEP
COVERS
((ASSEMBLE NIL (CQ (VAG VAL)) (E (NUMTOAC 2 (QUOTE LARGEP))) (VAR (HRRZ 1 , VR)) (MOVEM 2 , 0 (1))) . 
0)
SMALLP
((ASSEMBLE NIL (CQ (VAG VAL)) (E (NUMTOAC 2 (QUOTE SMALLP))) (VAR (HRRZ 1 , VR)) (MOVEM 2 , 0 (1))) . 
0)
FIXP
((ASSEMBLE NIL (CQ (VAG VAL)) (E (NUMTOAC 2 (QUOTE FIXP))) (VAR (HRRZ 1 , VR)) (MOVEM 2 , 0 (1))) . 0)
TERPRI
"Large SETQ of unknown value:  "
PRIN1
PRINT
((ASSEMBLE NIL (CQ (VAG (the FIXP VAL))) (E (NUMTOAC 2 (QUOTE FIXP))) (VAR (HRRZ 1 , VR)) (MOVEM 2 , 0
 (1))) . 0)
SUBPAIR
(KT KNIL ENTERF)X



LBIND BINARY
-.Z0B+ ,,~,< ,XBp,<Zw,<Z`,<Zp-,++

,<,<$/, ,\ D,\/,~B X(VARIABLE-VALUE-CELL NARGS . 3)
FIXP
VALUEERROR
(GUNBOX BHC SKI KNIL MKN ASZ ENTERF)X(Xh

NUMTOAC BINARY
wbt-.bZ2B+Z"XB@d,~Z-,ZXBZ2Bd+;[Z2Be+^[XBZ3Be+2Bf+,Z-,ZXB	Z2Bf+![[[ZZ2Bg+[XBZ,<Zg[[[,Zh,,Zh,Bi+:ZZi,Zh,Bi+:2Bj+)[XB",<hZ,<,<h,<gZg[,^,,Bi+:Z#Zj,Zh,Bi+:2Bk+1Z)Zk,Zl,Bi+:2Bl+9,<m"iZ-Zm,Zn,BiZ3Zn,Zl,Bi+:,<oDoZ,~2Bp+CZ6[&Z3B+:["XB?,<pZ<,<,Bi+:2Bp+KZ@1B+:[?XBE,<q[=Z,<ZD,<,Bi+:2Bh+SZH[GZ3B+:[FXBNZL[L[,Zh,Bi+:2Bq+^[PBr,<@c +\ZO,<Z

DrZOBsZq,,~[Y,XB\+:ZW1B+:Zs,Zh,Bi+: GAjy85=/j+f	BzQ`M0(VARIABLE-VALUE-CELL AC . 188)
(VARIABLE-VALUE-CELL KNOWNTYPE . 177)
(VARIABLE-VALUE-CELL CODE . 186)
(NIL VARIABLE-VALUE-CELL INST . 169)
FASTCALL
GUNBOX
FLOATP
LARGEP
HRRZ
VREF
@
,
MOVE
STORIN
((, 0 (1)) . 0)
LDV
((, 0 (1)) . 0)
SMALLP
((, -2048 (1)) . 0)
HRREI
FIXP
((STE SMALLT) . 0)
((, 0 (1)) . 0)
SKIPA
((, -2048 (1)) . 0)
"UNRECOGNIZED KNOWNTYPE - NUMTOAC"
HELP
LPOPN
LDN
LDN2
ASSEM
REVERSE
NUMTOAC
DREVERSE
((, 1) . 0)
(LIST3 LIST2 ALIST CONSS1 CONS21 CONS SKLST ASZ KNIL ENTERF)	((@

 \
09`0@ PaXR5x+x(_X;0
(PRETTYCOMPRINT ARITHMACCOMS)
(RPAQQ ARITHMACCOMS ((FNS FBIND FLOATSETQ FLOATSETQMAC LARGESETQ LARGESETQMAC LBIND NUMTOAC) (FILES (
SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) NOBOX DECL) (DECLTYPES (FLOATP BINDFN) (FLOATP SETFN) (
LARGEP BINDFN) (LARGEP SETFN)) (MACROS FBIND FBOX FLOATSETQ IBOX LARGESETQ LBIND) (PROP (MACRO 
BYTEMACRO) FIX FLOAT) (PROP AMAC VAGFIX) (PROP DECLOF FBOX IBOX FLOATSETQ LARGESETQ) (IGNOREDECL) (
DECLARE: EVAL@COMPILE DONTCOPY (MACROS LARGEVAL) COMPILERVARS (ADDVARS (NLAMA) (NLAML LARGESETQ 
FLOATSETQ) (LAMA LBIND FBIND)))))
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) NOBOX DECL)
(DECLTYPES (FLOATP FLOATP BINDFN FBIND) (FLOATP FLOATP SETFN FLOATSETQ) (LARGEP LARGEP BINDFN LBIND) (
LARGEP LARGEP SETFN LARGESETQ))
(PUTPROPS FBIND MACRO (ARGS (COND (ARGS (LIST (QUOTE FBOX) (LIST (QUOTE the) (QUOTE FLOATP) (CAR ARGS)
))) (T (QUOTE (FBOX))))))
(PUTPROPS FBOX MACRO (ARGS (COND ((CAR ARGS) (LIST (QUOTE ASSEMBLE) NIL (LIST (QUOTE CQ) (LIST (QUOTE 
VAG) (LIST (QUOTE FLOAT) (CAR ARGS)))) (QUOTE (E (NUMTOAC 2 (QUOTE FLOATP)))) (LIST (QUOTE CQ) (KWOTE 
(FPLUS 0.0))) (QUOTE (MOVEM 2 , 0 (1))))) (T (KWOTE (FPLUS 0.0))))))
(PUTPROPS FBOX ALTOMACRO (ARGS (COND ((CAR ARGS) (SUBST (CAR ARGS) (QUOTE NUM) (QUOTE (create FBOX 
smashing (CONSTANT (create FBOX)) F _ NUM)))) (T (create FBOX)))))
(PUTPROPS FBOX BYTEMACRO PUNT)
(PUTPROPS FLOATSETQ MACRO (ARGS (FLOATSETQMAC ARGS)))
(PUTPROPS IBOX MACRO (ARGS (COND ((CAR ARGS) (LIST (QUOTE ASSEMBLE) NIL (LIST (QUOTE VAGFIX) (CAR ARGS
) 2) (LIST (QUOTE CQ) (KWOTE (IPLUS 100000))) (QUOTE (MOVEM 2 , 0 (1))))) (T (KWOTE (IPLUS 10000000)))
)))
(PUTPROPS IBOX ALTOMACRO (ARGS (COND ((CAR ARGS) (SUBST (CAR ARGS) (QUOTE NUM) (QUOTE (create IBOX 
smashing (CONSTANT (create IBOX)) I _ NUM)))) (T (create IBOX)))))
(PUTPROPS IBOX BYTEMACRO PUNT)
(PUTPROPS LARGESETQ MACRO (ARGS (LARGESETQMAC ARGS)))
(PUTPROPS LBIND MACRO (ARGS (COND (ARGS (LIST (QUOTE IBOX) (LIST (QUOTE the) (QUOTE FIXP) (CAR ARGS)))
) (T (QUOTE (IBOX))))))
(PUTPROPS FIX MACRO (ARGS (COND ((COVERS (QUOTE FIXP) (DECLOF (CAR ARGS))) (CAR ARGS)) (T (QUOTE 
IGNOREMACRO)))))
(PUTPROPS FLOAT MACRO (ARGS (COND ((COVERS (QUOTE FLOATP) (DECLOF (CAR ARGS))) (CAR ARGS)) (T (QUOTE 
IGNOREMACRO)))))
(PUTPROPS FIX BYTEMACRO (ARGS (COND ((COVERS (QUOTE FIXP) (DECLOF (CAR ARGS))) (CAR ARGS)) (T (LIST (
QUOTE IPLUS) (CAR ARGS) 0)))))
(PUTPROPS VAGFIX AMAC ((EX R) (* Compiles EX and diddles code to put it right into R) (CQ (VAG (FIX EX
))) (E (NUMTOAC R (QUOTE FIXP)))))
(PUTPROPS FBOX DECLOF FLOATP)
(PUTPROPS IBOX DECLOF LARGEP)
(PUTPROPS FLOATSETQ DECLOF FLOATP)
(PUTPROPS LARGESETQ DECLOF LARGEP)
NIL