(FILECREATED "26-Sep-86 14:56:32" {ERIS}<LISPCORE>SOURCES>ABASIC.;8 26813  

      changes to:  (FNS PRETTYCOMPRINT)
                   (VARS ABASICCOMS)

      previous date: "16-Jul-86 23:24:05" {ERIS}<LISPCORE>SOURCES>ABASIC.;7)


(* "
Copyright (c) 1982, 1983, 1984, 1985, 1986 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 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 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)
                      (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: " 7-Jul-86 22:41")
                                                             (* 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))
           (T (\EXTENDED.EQP X Y])

(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])

(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")
    (COND
       ((EQ 0 NARGS)
        NIL)
       ((EQ 1 NARGS)
        (ARG NARGS 1))
       (T (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 )

(ADDTOVAR LAMA LIST* LIST NCONC NOTIMP ZERO TRUE NILL)
)
(PUTPROPS ABASIC COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1503 2295 (EVALQT 1513 . 2038) (\SystemERROR 2040 . 2293)) (2296 3222 (NILL 2306 . 2420
) (EVQ 2422 . 2526) (TRUE 2528 . 2640) (ZERO 2642 . 2754) (DUMMYDEF 2756 . 3075) (NOTIMP 3077 . 3220))
 (3254 8144 (EQUAL 3264 . 8012) (NEQ 8014 . 8061) (NULL 8063 . 8102) (NOT 8104 . 8142)) (8220 10067 (
LAPRD 8230 . 8777) (DEFC 8779 . 9977) (CGETD 9979 . 10065)) (10068 23724 (NCONC 10078 . 10481) (
\NCONC2 10483 . 10686) (PRINTARRAY 10688 . 14274) (SORT 14276 . 14698) (MERGE 14700 . 17797) (SORT1 
17799 . 21012) (FASSOC 21014 . 21258) (FLAST 21260 . 21514) (FLENGTH 21516 . 21838) (FMEMB 21840 . 
22207) (FNTH 22209 . 22699) (LIST 22701 . 23012) (LIST* 23014 . 23392) (COUNT 23394 . 23722)) (23725 
24630 (CHANGENAME1 23735 . 24263) (CHANGENAME1A 24265 . 24628)) (24631 26085 (CDDR 24641 . 24682) (
CDAR 24684 . 24725) (CADR 24727 . 24768) (CAAR 24770 . 24811) (CDDDR 24813 . 24860) (CDDAR 24862 . 
24909) (CDADR 24911 . 24958) (CDAAR 24960 . 25007) (CADDR 25009 . 25056) (CADAR 25058 . 25105) (CAADR 
25107 . 25154) (CAAAR 25156 . 25203) (CDDDDR 25205 . 25258) (CAAAAR 25260 . 25313) (CDDDAR 25315 . 
25368) (CDDADR 25370 . 25423) (CDDAAR 25425 . 25478) (CDAAAR 25480 . 25533) (CADADR 25535 . 25588) (
CDADDR 25590 . 25643) (CDADAR 25645 . 25698) (CAADDR 25700 . 25753) (CDAADR 25755 . 25808) (CAADAR 
25810 . 25863) (CADDDR 25865 . 25918) (CADAAR 25920 . 25973) (CADDAR 25975 . 26028) (CAAADR 26030 . 
26083)) (26086 26320 (SYSTEMTYPE 26096 . 26318)))))
STOP