(FILECREATED "29-Jan-85 17:32:18" {ERIS}<LISPUSERS>NOBOX.;5
 5893   

      changes to:  (RECORDS IBOX FBOX)
		   (MACROS IBOX FBOX)
		   (FNS IBOX)

      previous date: "29-Jan-85 15:54:35" {ERIS}<LISPUSERS>NOBOX.;4)


(* Copyright (c) 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT NOBOXCOMS)

(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 IBOX FBOX NBOX)
			    (MACROS CBOX LBOX)
			    (I.S.OPRS scratchcollect)
			    (ADDVARS (SYSLOCALVARS $$SCCONS $$SCPTR)
				     (INVISIBLEVARS $$SCCONS $$SCPTR])



(* use of this package is not recommended for interlisp-d. it is supplied for compatibility 
with old code)


(DEFINEQ

(IBOX

  [LAMBDA (IVAL)                                             (* edited: "29-Jan-85 17:28")

                                                             (* If needed, give field the initial value defined in 

							     the record)

    (create
 IBOX
	    I ←(
OR
 IVAL 0])

(FBOX

  [LAMBDA (FVAL)                                       (* rmk: "23-SEP-77 09:39")

    (create
 FBOX
	    F ←(OR FVAL 0.0])

(NBOX

  [LAMBDA (NVAL)                                       (* rmk: "10-OCT-77 10:17")


          (* A boxing function for numbers of unknown type. Since most functions that produce unknown-typed numbers compile closed and box 

	  internally, this is really useful only to copy boxes produced by those functions into new boxes at setq's. E.g. 

	  (SETQ X (NBOX Y)), where previously there was (SETQ Y (DIFFERENCE A B)))



    (if
 (FLOATP NVAL)
	then
 (create
 FBOX
		     F ← NVAL)
      else
 (create
 IBOX
		   I ← NVAL])
)
(MOVD? (QUOTE LIST)
       (QUOTE LBOX))
(MOVD? (QUOTE CONS)
       (QUOTE CBOX))
(DECLARE: EVAL@COMPILE 
[DECLARE: EVAL@COMPILE 

(BLOCKRECORD FBOX
 ((F FLOATING))
		  [CREATE
 (
SELECTQ
 (
SYSTEMTYPE
)
				   ((
TENEX
 TOPS-20)
				     (
FPLUS
 0.0))
				   (D (
\CREATECELL
 (
CONSTANT
 \FLOATP)))
				   (
HELP
 "FBOX CREATE NOT DEFINED FOR SYSTEMTYPE " (
SYSTEMTYPE
])

(BLOCKRECORD IBOX
 ((I INTEGER))
		  [CREATE
 (
SELECTQ
 (
SYSTEMTYPE
)
				   ((
TENEX
 TOPS-20)
				     (
IPLUS
 100000))
				   (D (
\CREATECELL
 (
CONSTANT
 \FIXP)))
				   (
HELP
 "IBOX CREATE NOT DEFINED FOR SYSTEMTYPE " (
SYSTEMTYPE
])
]

(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 (QUOTE (create IBOX])

(PUTPROPS IBOX DMACRO
 [ARGS (COND (ARGS (APPEND (QUOTE (create IBOX smashing
							       (LOADTIMECONSTANT (\CREATECELL
										   (CONSTANT \FIXP)))
							       I ←))
						ARGS))
				  (T (QUOTE (LOADTIMECONSTANT (\CREATECELL (CONSTANT \FIXP])

(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 (QUOTE (create FBOX])

(PUTPROPS FBOX DMACRO
 [ARGS (COND (ARGS (APPEND (QUOTE (create FBOX smashing
							       (LOADTIMECONSTANT (\CREATECELL
										   (CONSTANT \FLOATP))
										 )
							       F ←))
						ARGS))
				  (T (QUOTE (LOADTIMECONSTANT (\CREATECELL (CONSTANT \FLOATP])

(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)
)
(PUTPROPS NOBOX COPYRIGHT ("Xerox Corporation" 1983 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (936 1945 (IBOX 946 . 1244) (FBOX 1246 . 1383) (NBOX 1385 . 1943)))))
STOP