Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0004/nobox.dcom
There are no other files named nobox.dcom in the archive.
(FILECREATEDc"18-MAY-82t21:34:08"B("compileddon1"-<LISPUSERS>NOBOX.;3)-"16-MAY-82(21:33:20"EFLOAT 
d@�o
�(17Q4PutUnboxed4MAKENUMBER)
d@�o
�(31Q1PutFloat16Q)MAKEFLOATNUMBER)
d@
�kj
d@
�(44Q1PutUnboxedX37QSMAKENUMBER 30Q PutFloat 23Q MAKEFLOATNUMBER)
(RPAQQ NOBOXCOMS ((* use of this package is not recommended for interlisp-d. it is supplied for 
compatibility with old code) (FNS IBOX FBOX NBOX) (P (MOVD? (QUOTE LIST) (QUOTE LBOX)) (MOVD? (QUOTE 
CONS) (QUOTE CBOX))) (DECLARE: EVAL@COMPILE (RECORDS FBOX IBOX) (MACROS NOBOX.MAKEFLOAT 
NOBOX.MAKELARGE) (MACROS IBOX FBOX NBOX) (MACROS CBOX LBOX) (I.S.OPRS scratchcollect) (ADDVARS (
SYSLOCALVARS $$SCCONS $$SCPTR) (INVISIBLEVARS $$SCCONS $$SCPTR)))))
(MOVD? (QUOTE LIST) (QUOTE LBOX))
(MOVD? (QUOTE CONS) (QUOTE CBOX))
(DECLARE: EVAL@COMPILE (BLOCKRECORD FBOX ((F FLOATING)) (CREATE (NOBOX.MAKEFLOAT))) (BLOCKRECORD IBOX 
((I INTEGER)) (CREATE (NOBOX.MAKELARGE))))
(DECLARE: EVAL@COMPILE (PUTPROPS NOBOX.MAKEFLOAT 10MACRO (NIL (FPLUS 0.0))) (PUTPROPS NOBOX.MAKEFLOAT 
DMACRO (NIL (CREATECELL \FLOATP))) (PUTPROPS NOBOX.MAKELARGE 10MACRO (NIL (IPLUS 1000000))) (PUTPROPS 
NOBOX.MAKELARGE DMACRO (NIL (CREATECELL \FIXP))))
(DECLARE: EVAL@COMPILE (PUTPROPS IBOX 10MACRO (ARGS (COND ((CAR ARGS) (LIST (QUOTE ASSEMBLE) NIL (LIST
 (QUOTE CQ) (LIST (QUOTE VAG) (LIST (QUOTE FIX) (CAR ARGS)))) (QUOTE (MOVE 2 , 1)) (LIST (QUOTE CQ) (
create IBOX)) (QUOTE (MOVEM 2 , 0 (1))))) (T (create IBOX))))) (PUTPROPS IBOX DMACRO (ARGS (COND ((CAR
 ARGS) (SUBST (CAR ARGS) (QUOTE NUM) (QUOTE (create IBOX smashing (CONSTANT (create IBOX)) I _ NUM))))
 (T (create IBOX))))) (PUTPROPS FBOX 10MACRO (ARGS (COND ((CAR ARGS) (LIST (QUOTE ASSEMBLE) NIL (LIST 
(QUOTE CQ) (LIST (QUOTE VAG) (LIST (QUOTE FLOAT) (CAR ARGS)))) (QUOTE (MOVE 2 , 1)) (LIST (QUOTE CQ) (
create FBOX)) (QUOTE (MOVEM 2 , 0 (1))))) (T (create FBOX))))) (PUTPROPS FBOX DMACRO (ARGS (COND ((CAR
 ARGS) (SUBST (CAR ARGS) (QUOTE NUM) (QUOTE (create FBOX smashing (CONSTANT (create FBOX)) F _ NUM))))
 (T (create FBOX))))) (PUTPROPS NBOX 10MACRO (ARGS (SUBPAIR (QUOTE (NVAL FBOX)) (LIST (CAR ARGS) (
create FBOX)) (QUOTE (ASSEMBLE NIL (CQ NVAL) (CQ (COND ((FLOATP (AC)) (ASSEMBLE NIL (MOVE 2 , 0 (1)) (
CQ FBOX) (MOVEM 2 , 0 (1)))) (T (IBOX (AC)))))))))) (PUTPROPS NBOX DMACRO (OPENLAMBDA (NVAL) (COND ((
FLOATP NVAL) (FBOX NVAL)) (T (IBOX NVAL))))))
(DECLARE: EVAL@COMPILE (PUTPROPS CBOX MACRO ((X Y) (FRPLNODE (CONSTANT (CONS)) X Y))) (PUTPROPS CBOX 
DMACRO (= . CONS)) (PUTPROPS LBOX MACRO (ARGLIST (PROG (NILIST (FORM (QUOTE $X$))) (MAP ARGLIST (
FUNCTION (LAMBDA (ARG) (SETQ NILIST (CONS NIL NILIST)) (SETQ FORM (LIST (QUOTE FRPLACA) FORM (CAR ARG)
)) (AND (CDR ARG) (SETQ FORM (LIST (QUOTE CDR) FORM)))))) (RETURN (LIST (LIST (QUOTE LAMBDA) (QUOTE (
$X$)) (QUOTE (DECLARE (LOCALVARS $X$))) FORM (QUOTE $X$)) (KWOTE NILIST)))))) (PUTPROPS LBOX DMACRO (=
 . LIST)))
(DECLARE: EVAL@COMPILE (I.S.OPR (QUOTE scratchcollect) (QUOTE (SETQ $$SCPTR (FRPLACA (OR (CDR $$SCPTR)
 (CDR (FRPLACD $$SCPTR (CAR (FRPLACA $$SCCONS (CONS)))))) BODY))) (QUOTE (BIND $$SCPTR $$SCCONS _ (
CONSTANT (CONS)) FIRST (SETQ $$SCPTR $$SCCONS) FINALLY (SETQ $$VAL (AND (NEQ $$SCPTR $$SCCONS) (PROG1 
(CDR $$SCCONS) (COND ((CDR $$SCPTR) (FRPLACD $$SCCONS (PROG1 (CDR $$SCPTR) (FRPLACD $$SCPTR NIL) (
FRPLACD (PROG1 (CAR $$SCCONS) (FRPLACA $$SCCONS $$SCPTR)) (CDR $$SCCONS)))))))))))))
(ADDTOVAR SYSLOCALVARS $$SCCONS $$SCPTR)
(ADDTOVAR INVISIBLEVARS $$SCCONS $$SCPTR)
NIL