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
� (17Q4PutUnboxed 4 MAKENUMBER)
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