(FILECREATED "16-Oct-85 01:13:48" {ERIS}<LISPCORE>SOURCES>ABASIC.;6 20605  

      changes to:  (VARS ABASICCOMS)
		   (FNS EQUAL)

      previous date: "19-Sep-85 15:18:51" {ERIS}<LISPCORE>SOURCES>ABASIC.;5)


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

(PRETTYCOMPRINT ABASICCOMS)

(RPAQQ ABASICCOMS [(FNS EVALQT \SystemERROR)
	(FNS NILL EVQ TRUE ZERO DUMMYDEF NOTIMP)
	(P (DUMMYDEF (WINDOWWORLDP NILL)))
	(FNS EQUAL)
	(FNS TYPENAMEP)
	(FNS NEQ NULL NOT)
	(COMS (* "Belong on ACODE except they would clobber 10-versions in ABC")
	      (FNS LAPRD DEFC CGETD))
	(FNS NCONC \NCONC2 PRINTARRAY SORT MERGE SORT1 PRETTYCOMPRINT FASSOC FLAST FLENGTH FMEMB FNTH 
	     LIST LIST* COUNT)
	(FNS CHANGENAME1 CHANGENAME1A)
	(FNS CDDR CDAR CADR CAAR CDDDR CDDAR CDADR CDAAR CADDR CADAR CAADR CAAAR CDDDDR CAAAAR CDDDAR 
	     CDDADR CDDAAR CDAAAR CADADR CDADDR CDADAR CAADDR CDAADR CAADAR CADDDR CADAAR CADDAR 
	     CAAADR)
	(FNS SYSTEMTYPE)
	(COMS (* Because can't have bignums in code at makeinit time)
	      (VARS (\IMAX.FLOAT (FIX MAX.FLOAT))
		    (\IMIN.FLOAT (FIX MIN.FLOAT)))
	      (GLOBALVARS \IMAX.FLOAT \IMIN.FLOAT))
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
		  (ADDVARS (NLAMA DUMMYDEF)
			   (NLAML PRETTYCOMPRINT)
			   (LAMA LIST* LIST NCONC NOTIMP ZERO TRUE NILL])
(DEFINEQ

(EVALQT
  [LAMBDA NIL                      (* lmm "11-MAR-80 15:57")
    (PROG (EVALQTXX)
      EVALQTLP
          (PRIN1 (QUOTE ←)
		 T)
          (PRINT [COND
		   ((NULL (SETQ EVALQTXX (READ T)))
		     (GO EVALQTLP))
		   ((OR (LISTP EVALQTXX)
			(NULL (READP T)))
		     (EVAL EVALQTXX))
		   (T (APPLY EVALQTXX (READ T]
		 T)
          (GO EVALQTLP])

(\SystemERROR
  [LAMBDA NIL                      (* lmm " 6-MAY-80 20:41")
    (SELECTQ (GETTOPVAL (QUOTE \SystemErrorVAL))
	     (0 (RAID))
	     (1 (LISPERROR "FILE SYSTEM RESOURCES EXCEEDED"))
	     (RAID])
)
(DEFINEQ

(NILL
  [LAMBDA NOBIND                                             (* lmm " 4-OCT-83 03:05")
    NIL])

(EVQ
  [LAMBDA (X)                      (* lmm: 26 JUN 75 726)
    X])

(TRUE
  [LAMBDA NOBIND                                             (* lmm " 4-OCT-83 03:05")
    T])

(ZERO
  [LAMBDA NOBIND                                             (* lmm " 4-OCT-83 03:05")
    0])

(DUMMYDEF
  [NLAMBDA LST                                               (* lmm " 4-OCT-83 03:08")
    (for X in LST when (NOT (GETD (CAR X))) do (PUTD (CAR X)
						     (GETD (CADR X))
						     T])

(NOTIMP
  [LAMBDA N                        (* lmm " 5-MAR-80 20:17")
    (HELP "UNIMPLEMENTED FUNCTION"])
)
(DUMMYDEF (WINDOWWORLDP NILL))
(DEFINEQ

(EQUAL
  [LAMBDA (X Y)                                              (* bvm: "16-Oct-85 01:12")
                                                             (* tortured logic to optimize performance)
    (OR (EQ X Y)
	  (COND
	    [(LISTP X)
	      (AND (LISTP Y)
		     (PROG NIL
			 RETRYLISTP
			     (RETURN (AND (EQUAL (CAR X)
						       (CAR Y))
					      (COND
						[(LISTP (SETQ X (CDR X)))
						  (RETURN (AND (LISTP (SETQ Y (CDR Y)))
								   (OR (EQ X Y)
									 (GO RETRYLISTP]
						(T (EQUAL X (CDR Y]
	    ((OR (LITATOM X)
		   (LITATOM Y))                            (* can't be EQUAL and not EQ)
	      NIL)
	    [(NUMBERP X)
	      (AND (NUMBERP Y)
		     (SELECTC (NTYPX X)
				[\FLOATP (SELECTC (NTYPX Y)
						    (\FLOATP (FEQP X Y))
						    (\SMALLP (FEQP X Y))
						    (\FIXP (FEQP X Y))
						    (PROGN 
                                                             (* If comparing against bignum, avoid floating 
							     overflow when coercing a too-large bignum to floatp)
							     (AND (NOT (GREATERP Y \IMAX.FLOAT))
								    (NOT (LESSP Y \IMIN.FLOAT))
								    (FEQP X Y]
				(\SMALLP (SELECTC (NTYPX Y)
						    (\FLOATP (FEQP X Y))
						    (\SMALLP 
                                                             (* both small, not EQ)
							     NIL)
						    [\FIXP 
                                                             (* should allow small in fixp boxes?)
							   (AND (EQ (ffetch (FIXP LONUM)
									   of Y)
									(\LOLOC X))
								  (EQ (ffetch (FIXP HINUM)
									   of Y)
									(COND
									  ((ILESSP X 0)
									    MAX.SMALLP)
									  (T 0]
						    NIL))
				(\FIXP (SELECTC (NTYPX Y)
						  (\FLOATP (FEQP X Y))
						  [\SMALLP 
                                                             (* should allow small in fixp boxes?)
							   (AND (EQ (ffetch (FIXP LONUM)
									   of X)
									(\LOLOC Y))
								  (EQ (ffetch (FIXP HINUM)
									   of X)
									(COND
									  ((ILESSP Y 0)
									    MAX.SMALLP)
									  (T 0]
						  [\FIXP (AND (EQ (ffetch (FIXP HINUM)
									 of X)
								      (ffetch (FIXP HINUM)
									 of Y))
								(EQ (ffetch (FIXP LONUM)
									 of X)
								      (ffetch (FIXP LONUM)
									 of Y]
						  (PROGN 
                                                             (* fixp bignum)
							   NIL)))
				(SELECTC (NTYPX Y)
					   (\FLOATP          (* BIGNUM \FLOATP)
						    (AND (NOT (GREATERP X \IMAX.FLOAT))
							   (NOT (LESSP X \IMIN.FLOAT))
							   (FEQP X Y)))
					   (\SMALLP          (* BIGNUM \SMALLP)
						    NIL)
					   (\FIXP            (* BIGNUM \FIXP)
						  NIL)
					   (PROGN          (* BIGNUM BIGNUM)
						    (EQ (\BIGNUM.COMPARE X Y)
							  0]
	    ((NUMBERP Y)
	      NIL)
	    ((STRINGP X)
	      (STREQUAL X Y))
	    ((EQ (NTYPX X)
		   (NTYPX Y))
	      (SELECTC (NTYPX X)
			 (\STACKP (EQ (fetch (STACKP EDFXP) of X)
					(fetch (STACKP EDFXP) of Y)))
			 (\ARRAYP (AND (EQ (fetch (ARRAYP TYP) of X)
					       \ST.CODE)
					 (EQDEFP X Y)))
			 NIL])
)
(DEFINEQ

(TYPENAMEP
  [LAMBDA (DATUM TYPE)
    (EQ (TYPENAME DATUM)
	TYPE])
)
(DEFINEQ

(NEQ
  [LAMBDA (X Y)
    (NOT (EQ X Y])

(NULL
  [LAMBDA (X)
    (EQ X NIL])

(NOT
  [LAMBDA (X)
    (EQ X NIL])
)



(* "Belong on ACODE except they would clobber 10-versions in ABC")

(DEFINEQ

(LAPRD
  [LAMBDA (FN)                     (* wsh: "20-JUL-79 12:27")
    (PROG (X Y)
          (RETURN (COND
		    ([OR (NEQ (PEEKC)
			      (QUOTE % ))
			 [NOT (LITATOM (SETQ X (SETQ Y (READ]
			 (NOT (LISTP (SETQ X (GETP X (QUOTE CODEREADER]
		      (ERROR (QUOTE "Bad compiled function")
			     FN))
		    (T (APPLY* (CAR X)
			       FN])

(DEFC
  [LAMBDA (NM DF)                                            (* lmm "11-FEB-82 14:44")
    (PROG ((PROP (QUOTE CODE)))
          (COND
	    ((OR (NULL DFNFLG)
		 (EQ DFNFLG T))
	      [COND
		((GETD NM)
		  (VIRGINFN NM T)
		  (COND
		    ((NULL DFNFLG)
		      (PRINT (CONS NM (QUOTE (redefined)))
			     T T)                            (* NOTE: this call to PRINT is changed to LISPXPRINT 
							     later in the loadup.)
		      (SAVEDEF NM]
	      (PUTD NM DF T)                                 (* NOTE: this call to \PUTD is changed to /PUTD later in
							     the loadup.)
	      )
	    (T (PUTPROP NM PROP DF)                          (* NOTE: this call to PUTPROP is changed to /PUTPROP 
							     later in the loadup.)
	       ))
          (RETURN DF])

(CGETD
  [LAMBDA (X)
    (COND
      ((LITATOM X)
	(GETD X))
      (T X])
)
(DEFINEQ

(NCONC
  [LAMBDA N
    (AND (NEQ N 0)
	 (PROG ((L (ARG N N))
		(J N)
		X)
	   LP  (COND
		 ((EQ (SETQ J (SUB1 J))
		      0)
		   (RETURN L))
		 ((LISTP (SETQ X (ARG N J)))
		   (FRPLACD (LAST X)
			    L)
		   (SETQ L X)))
	       (GO LP])

(\NCONC2
  [LAMBDA (X Y)                    (* lmm "15-APR-82 22:10")
    (COND
      ((LISTP X)
	(RPLACD (LAST X)
		Y)
	X)
      (T Y])

(PRINTARRAY
  [LAMBDA (V)                                                (* rrb "20-JUL-83 11:49")
                                                             (* Used by prettydef. Included in ABASIC because it uses
							     LOC and VAG on the 10)
    (PROG (A N M TYPE FLG DOUBLEFLG ORIG)
          [COND
	    ([AND (LITATOM V)
		  (ARRAYP (SETQ A (EVALV V (QUOTE PRINTARRAY]
	      (printout NIL "(SETQ " .P2 V ,)
	      (printout NIL "(READARRAY " (SETQ N (ARRAYSIZE A))
			, "(QUOTE " (SETQ TYPE (ARRAYTYP A))
			") "
			(SETQ ORIG (ARRAYORIG A))
			")")
	      (printout NIL ")" T)                           (* Close the SETQ)
	      )
	    ((ARRAYP V)                                      (* Just dumps the element expression--assumes that 
							     READARRAY has already been written)
	      (SETQ A V)
	      (SETQ N (ARRAYSIZE A))
	      (SETQ TYPE (ARRAYTYP A))
	      (SETQ ORIG (ARRAYORIG A)))
	    (T (RETURN (HELP (CONS V (QUOTE (not array]
          (PRIN1 (QUOTE %())
          (SETQ DOUBLEFLG (OR (EQ TYPE (QUOTE DOUBLEPOINTER))
			      (NUMBERP TYPE)))               (* note if this array has different ELTD.)
          (SETQ M 1)
      LP  (COND
	    ((NOT (IGREATERP M N))
	      (COND
		[(OR (EQ TYPE (QUOTE POINTER))
		     DOUBLEFLG)
		  (PRINT (ELT A (SUB1 (IPLUS M ORIG]
		(T                                           (* changed from PRINT to PRIN2 so would look better in 
							     file.)
		   [PRIN2 (ELT A (SUB1 (IPLUS M ORIG]
		   (SPACES 1)))

          (* check for any non-NIL entries in the ELTD part of the double arrays. If there are none, format for print out 
	  avoids lots of NILs.)


	      (AND DOUBLEFLG (COND
		     ((NUMBERP TYPE)                         (* check for M being in the double pointer part of the 
							     array)
		       (IGREATERP M TYPE))
		     (T T))
		   (ELTD A (SUB1 (IPLUS M ORIG)))
		   (SETQ FLG T))
	      (SETQ M (ADD1 M))
	      (GO LP))
	    ((NULL (PRINT FLG))                              (* if FLG is NULL, there are non-NIL double word 
							     entries.)
	      (GO OUT)))
          [SETQ M (COND
	      ((EQ TYPE (QUOTE DOUBLEPOINTER))               (* all entries are double)
		1)
	      ((NUMBERP TYPE)                                (* first TYPE elements in the array are numbers)
		(ADD1 TYPE]
      LP1 (COND
	    ((NOT (IGREATERP M N))
	      [PRINT (ELTD A (SUB1 (IPLUS M ORIG]
	      (SETQ M (ADD1 M))
	      (GO LP1)))
      OUT (PRIN1 (QUOTE %)))
          (RETURN A])

(SORT
  [LAMBDA (DATA COMPAREFN)
    (DECLARE (LOCALVARS . T))      (* lmm: "11-NOV-76 23:48:23")
    (COND
      [(NLISTP DATA)
	(COND
	  (DATA (ERROR (QUOTE "DATA NOT LIST:")
		       DATA]
      (T (OR COMPAREFN (SETQ COMPAREFN (FUNCTION ALPHORDER)))
	 (FRPLACD (LAST DATA)
		  NIL)
	 (SORT1 DATA NIL COMPAREFN])

(MERGE
  [LAMBDA (A B COMPAREFN)          (* lmm " 6-MAY-80 21:36")
    (PROG (ATAIL BTAIL)
          [COND
	    ((NULL B)              (* MERGE will work if either arg is NIL.)
	      (RETURN A))
	    ((NULL A)
	      (RETURN B))
	    ((NLISTP B)            (* No possible meaning here; user must be in error.)
	      (ERRORX (LIST 4 B)))
	    ((NLISTP A)
	      (ERRORX (LIST 4 A)))
	    ([NOT (SELECTQ COMPAREFN
			   (T (ALPHORDER (CAAR A)
					 (CAAR B)))
			   (NIL (ALPHORDER (CAR A)
					   (CAR B)))
			   (APPLY* COMPAREFN (CAR A)
				   (CAR B]

          (* (CAR A) must be before (CAR B) at LOOP (see comment below). If not, swap A and B. -
	  The SELECTQ compares the next things on A and B.)


	      (SETQ A (PROG1 B (SETQ B A]
          (SETQ ATAIL A)

          (* It is desireable to make the value of the merged list available to the user not only as the return from MERGE, 
	  but also on both the CONSES given as arguments. To this end, the MERGE is actually performed on the lists A and 
	  (CONS (CAR B) (CDR B)), so that when we return, the original B may be smashed with (CAR A) and 
	  (CDR A).)


          (SETQ BTAIL (CONS (CAR B)
			    (CDR B)))

          (* Whenever we pass LOOP, we know that ATAIL is LISTP, BTAIL is LISTP, and (CAR ATAIL) belongs before 
	  (CAR BTAIL). We therefore look to see if there is anything more on ATAIL; if not, tie on BTAIL and return.
	  Otherwise, compare (CADR ATAIL) to (CAR BTAIL). If ATAIL wins, just take one CDR and go around.
	  But if BTAIL wins, then we swap variable/structures: ATAIL is rplacd'd to the structure that was on BTAIL, and BTAIL
	  is bound to the old CDR of ATAIL. We then take the CDR and go around. Observe that this swapping preserves the 
	  assumptions made at LOOP.)


      LOOP[COND
	    [(NLISTP (CDR ATAIL))
	      (FRPLACD ATAIL BTAIL)
	      (RETURN (FRPLACA (FRPLACD B (CDR A))
			       (CAR A]
	    [(SELECTQ COMPAREFN
		      (NIL (ALPHORDER (CADR ATAIL)
				      (CAR BTAIL)))
		      (T (ALPHORDER (CAADR ATAIL)
				    (CAAR BTAIL)))
		      (APPLY* COMPAREFN (CADR ATAIL)
			      (CAR BTAIL]
	    (T (FRPLACD ATAIL (PROG1 BTAIL (SETQ BTAIL (CDR ATAIL]
          (SETQ ATAIL (CDR ATAIL))
          (GO LOOP])

(SORT1
  [LAMBDA (DATA END COMPAREFN)
    (DECLARE (LOCALVARS . T))      (* lmm: "11-NOV-76 23:49:27")
    (COND
      ((OR (EQ DATA END)
	   (EQ (CDR DATA)
	       END))
	DATA)
      (T (PROG ((L DATA)
		(A DATA)
		TM)                (* Split DATA by setting A to one cell before its midpoint.
				   DATA remains EQ to the original list.)
	   LP  (COND
		 ((AND (NEQ (SETQ L (CDR L))
			    END)
		       (NEQ (SETQ L (CDR L))
			    END))
		   (SETQ A (CDR A))
		   (GO LP)))
	       (SETQ TM (SORT1 DATA (CDR A)
			       COMPAREFN))
	       (SORT1 (SETQ L (CDR A))
		      END COMPAREFN)

          (* Merge DATA thru A with L (= (CDR A)) up to END. This is a little tricky because DATA must remain EQ to its 
	  original value.)


	   ALP (COND
		 ((EQ TM L)        (* Exhausted first list.)
		   (RETURN DATA)))
	   BLP (COND
		 ((SELECTQ COMPAREFN
			   [T (ALPHORDER (COND
					   ((LISTP (CAR TM))
					     (CAAR TM))
					   (T (CAR TM)))
					 (COND
					   ((LISTP (CAR L))
					     (CAAR L))
					   (T (CAR L]
			   (APPLY* COMPAREFN (CAR TM)
				   (CAR L)))
		   (SETQ TM (CDR TM))
		   (GO ALP)))

          (* Move first element of second list (L = (CDR A)) to before first element of first list (TM). This must be done by 
	  exchanging the CARs and then patching up the CDRs, to retain the EQ property. This is a (QUOTE critical) section' in
	  that data will be lost if a hard interrupt occurs, but it cannot be interrupted by ↑H because it does no function 
	  calls.)


	       [COND
		 [(EQ TM A)        (* Special case.)
		   [FRPLACA TM (PROG1 (CAR L)
				      (FRPLACA L (CAR TM]
		   (SETQ L (CDR (SETQ TM (SETQ A L]
		 (T [FRPLACD A (PROG1 (CDR L)
				      (FRPLACA TM (PROG1 (CAR L)
							 (FRPLNODE2 L TM)
							 (FRPLACD TM L]
		    (SETQ TM L)
		    (SETQ L (CDR A]
	       (COND
		 ((NEQ L END)
		   (GO BLP)))      (* Exhausted second list.)
	       (RETURN DATA])

(PRETTYCOMPRINT
  [NLAMBDA (X)
    (PRINT X T T])

(FASSOC
  [LAMBDA (KEY ALST)               (* lmm " 5-MAR-80 20:55")
    (COND
      ((NULL ALST)
	NIL)
      ((EQ KEY (CAAR ALST))
	(CAR ALST))
      (T (FASSOC KEY (CDR ALST])

(FLAST
  [LAMBDA (X)                      (* lmm " 5-MAR-80 20:57")
    (PROG ((Y X))
          (GO LP0)
      LP  (SETQ X Y)
          (SETQ Y (CDR X))
      LP0 (COND
	    (Y (GO LP)))
          (RETURN X])

(FLENGTH
  [LAMBDA (X)                      (* lmm: "11-NOV-76 23:53:54")
    (PROG ((N 0)
	   Y)
          (SETQ Y X)
          (GO LP0)
      LP  (SETQ X Y)
          (SETQ N (ADD1 N))
          (SETQ Y (CDR X))
      LP0 (COND
	    (Y (GO LP)))
          (RETURN N])

(FMEMB
  [LAMBDA (X Y)                    (* lmm "27-MAR-80 12:53")
    (PROG NIL
      LP  (RETURN (COND
		    ((NULL Y)
		      NIL)
		    ((EQ (CAR Y)
			 X)
		      Y)
		    (T (SETQ Y (CDR Y))
		       (GO LP])

(FNTH
  [LAMBDA (X N)                    (* lmm " 6-MAY-80 22:29")
    (COND
      ((IGREATERP 1 N)
	(CONS NIL X))
      (T (PROG ((X0 X))
	       (DECLARE (LOCALVARS X0))
	   LP  (COND
		 ((NULL X)
		   (RETURN NIL))
		 ((NOT (IGREATERP N 1))
		   (RETURN X)))
	       (SETQ N (SUB1 N))
	       (SETQ X (CDR X))
	       (GO LP])

(LIST
  (LAMBDA N                                                  (* JonL "24-Apr-84 14:49")
    (PROG ((J N)
	   L)
      LP  (COND
	    ((EQ 0 J)
	      (RETURN L)))
          (SETQ L (CONS (ARG N J)
			L))
          (SETQ J (SUB1 J))
          (GO LP))))

(LIST*
  (LAMBDA NARGS                                              (* JonL "27-Sep-84 21:19")
    (if (EQ 0 NARGS)
	then NIL
      elseif (EQ 1 NARGS)
	then (ARG NARGS 1)
      else (bind (VAL ←(ARG NARGS NARGS)) for I from (SUB1 NARGS) by -1 until (ILEQ I 0)
	      do (push VAL (ARG NARGS I)) finally (RETURN VAL)))))

(COUNT
  [LAMBDA (X)                      (* lmm: 24 JUN 75 32)
    (PROG ((N 0))
      LP  (COND
	    ((NLISTP X)
	      (RETURN N))
	    (T (SETQ N (IPLUS (COUNT (CAR X))
			      1 N))
	       (SETQ X (CDR X))
	       (GO LP])
)
(DEFINEQ

(CHANGENAME1
  [LAMBDA (DEF X Y)                (* rmk: "15-APR-80 17:29")
                                   (* This isn't on ACODE because it would smash the 10 version in ABC)
    (COND
      ((EXPRP DEF)
	(NLSETQ (ESUBST Y X DEF)))
      ((CCODEP DEF)
	[COND
	  ((LITATOM DEF)
	    (SETQ DEF (GETD DEF]
	(CHANGENAME1A DEF X Y (CHANGECCODE X X DEF])

(CHANGENAME1A
  [LAMBDA (DEF OLD NEW MAP)        (* lmm "20-MAY-80 09:43")
    (COND
      ((AND MAP (find X in (CDR MAP) suchthat (find Y in (CDR X) suchthat Y)))
	(CHANGECCODE NEW MAP DEF)
	(UNDOSAVE (LIST (QUOTE CHANGENAME1A)
			DEF NEW OLD MAP))
	T])
)
(DEFINEQ

(CDDR
  [LAMBDA (X)
    (CDR (CDR X])

(CDAR
  [LAMBDA (X)
    (CDR (CAR X])

(CADR
  [LAMBDA (X)
    (CAR (CDR X])

(CAAR
  [LAMBDA (X)
    (CAR (CAR X])

(CDDDR
  [LAMBDA (X)
    (CDR (CDDR X])

(CDDAR
  [LAMBDA (X)
    (CDR (CDAR X])

(CDADR
  [LAMBDA (X)
    (CDR (CADR X])

(CDAAR
  [LAMBDA (X)
    (CDR (CAAR X])

(CADDR
  [LAMBDA (X)
    (CAR (CDDR X])

(CADAR
  [LAMBDA (X)
    (CAR (CDAR X])

(CAADR
  [LAMBDA (X)
    (CAR (CADR X])

(CAAAR
  [LAMBDA (X)
    (CAR (CAAR X])

(CDDDDR
  [LAMBDA (X)
    (CDDR (CDDR X])

(CAAAAR
  [LAMBDA (X)
    (CAAR (CAAR X])

(CDDDAR
  [LAMBDA (X)
    (CDDR (CDAR X])

(CDDADR
  [LAMBDA (X)
    (CDDR (CADR X])

(CDDAAR
  [LAMBDA (X)
    (CDDR (CAAR X])

(CDAAAR
  [LAMBDA (X)
    (CDAR (CAAR X])

(CADADR
  [LAMBDA (X)
    (CADR (CADR X])

(CDADDR
  [LAMBDA (X)
    (CDAR (CDDR X])

(CDADAR
  [LAMBDA (X)
    (CDAR (CDAR X])

(CAADDR
  [LAMBDA (X)
    (CAAR (CDDR X])

(CDAADR
  [LAMBDA (X)
    (CDAR (CADR X])

(CAADAR
  [LAMBDA (X)
    (CAAR (CDAR X])

(CADDDR
  [LAMBDA (X)
    (CADR (CDDR X])

(CADAAR
  [LAMBDA (X)
    (CADR (CAAR X])

(CADDAR
  [LAMBDA (X)
    (CADR (CDAR X])

(CAAADR
  [LAMBDA (X)
    (CAAR (CADR X])
)
(DEFINEQ

(SYSTEMTYPE
  [LAMBDA NIL                      (* lmm "17-AUG-81 15:50")
                                   (* let the macro decide)
    (SYSTEMTYPE])
)



(* Because can't have bignums in code at makeinit time)


(RPAQ \IMAX.FLOAT (FIX MAX.FLOAT))

(RPAQ \IMIN.FLOAT (FIX MIN.FLOAT))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \IMAX.FLOAT \IMIN.FLOAT)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA DUMMYDEF)

(ADDTOVAR NLAML PRETTYCOMPRINT)

(ADDTOVAR LAMA LIST* LIST NCONC NOTIMP ZERO TRUE NILL)
)
(PUTPROPS ABASIC COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1346 1949 (EVALQT 1356 . 1730) (\SystemERROR 1732 . 1947)) (1950 2716 (NILL 1960 . 2070
) (EVQ 2072 . 2148) (TRUE 2150 . 2258) (ZERO 2260 . 2368) (DUMMYDEF 2370 . 2601) (NOTIMP 2603 . 2714))
 (2748 6377 (EQUAL 2758 . 6375)) (6378 6458 (TYPENAMEP 6388 . 6456)) (6459 6593 (NEQ 6469 . 6514) (
NULL 6516 . 6553) (NOT 6555 . 6591)) (6669 7949 (LAPRD 6679 . 7050) (DEFC 7052 . 7866) (CGETD 7868 . 
7947)) (7950 17852 (NCONC 7960 . 8210) (\NCONC2 8212 . 8356) (PRINTARRAY 8358 . 10929) (SORT 10931 . 
11264) (MERGE 11266 . 13606) (SORT1 13608 . 15604) (PRETTYCOMPRINT 15606 . 15657) (FASSOC 15659 . 
15854) (FLAST 15856 . 16070) (FLENGTH 16072 . 16347) (FMEMB 16349 . 16574) (FNTH 16576 . 16923) (LIST 
16925 . 17191) (LIST* 17193 . 17605) (COUNT 17607 . 17850)) (17853 18525 (CHANGENAME1 17863 . 18233) (
CHANGENAME1A 18235 . 18523)) (18526 19924 (CDDR 18536 . 18575) (CDAR 18577 . 18616) (CADR 18618 . 
18657) (CAAR 18659 . 18698) (CDDDR 18700 . 18745) (CDDAR 18747 . 18792) (CDADR 18794 . 18839) (CDAAR 
18841 . 18886) (CADDR 18888 . 18933) (CADAR 18935 . 18980) (CAADR 18982 . 19027) (CAAAR 19029 . 19074)
 (CDDDDR 19076 . 19127) (CAAAAR 19129 . 19180) (CDDDAR 19182 . 19233) (CDDADR 19235 . 19286) (CDDAAR 
19288 . 19339) (CDAAAR 19341 . 19392) (CADADR 19394 . 19445) (CDADDR 19447 . 19498) (CDADAR 19500 . 
19551) (CAADDR 19553 . 19604) (CDAADR 19606 . 19657) (CAADAR 19659 . 19710) (CADDDR 19712 . 19763) (
CADAAR 19765 . 19816) (CADDAR 19818 . 19869) (CAAADR 19871 . 19922)) (19925 20103 (SYSTEMTYPE 19935 . 
20101)))))
STOP