perm filename CATALO[PAT,LMM] blob sn#097632 filedate 1974-04-15 generic text, type T, neo UTF8
(FILECREATED " 8-APR-74 02:49:40" CATALOG)


  (LISPXPRINT (QUOTE CATALOGVARS)
              T)
  [RPAQQ CATALOGVARS ((FNS CATALOG PUTCATALOG)
          (VARS (CATALOGTYPE)
                (CATALOGTYPES (QUOTE (POLYGONAL GAUCHE NONPOLY]
(DEFINEQ

(CATALOG
  [LAMBDA (TVL)
    (SETQ TVL (TRIMZEROS TVL))

          (* The CATALOG is contained in the CATALOG.DICTIONARY;
          just does a LOOKUP on it)


    (PROG (TEM)
          (COND
            [(SETQ TEM
                (for X in (OR CATALOGTYPE CATALOGTYPES)
                   join
                    (APPEND
                      (CDDR
                        (PROG (FND FIL)
                          TRY1(SETQ FND (SASSOC (CONS X TVL)
                                                (CDDDR CATDICT)))
                                                (* Use SACCOC to find entry, if 
                                                any)
                              (OR (CDR FND)
                                  (GO TRY2))
                              [PUSHCAR (CDDR CATDICT)
                                       (NLEFT (CDDR CATDICT)
                                              1
                                              (FMEMB FND (CDDDR CATDICT]
                                                (* Move the found entry to the 
                                                front of the dictionary)
                              (COND
                                ((NULL (CDDR FND))

          (* Read in from file, bump incore counter, and check if too 
          many incore, writing outsome; then return the value)


                                  (SFPTR [SETQ FIL
                                           (OR (OPENP (CAR CATDICT))
                                               (INPUT (INFILE (CAR CATDICT]
                                         (CADR FND))
                                  (FRPLACD (CDR FND)
                                           (READ FIL))
                                  (FRPLACA (CDR CATDICT)
                                           (ADD1 (CADR CATDICT)))
                                  (WRITESOME CATDICT)
                                                (* Check if need to bump some 
                                                out)
                                  (RETURN FND))
                                (T              (* It's already in core)
                                   (RETURN FND)))
                          TRY2(SETQ FND (SASSOC (CONS X TVL)
                                                (CDDDR CATALOG.DICTIONARY)))
                                                (* Use SACCOC to find entry, if 
                                                any)
                              (OR FND (RETURN))
                              [PUSHCAR (CDDR CATALOG.DICTIONARY)
                                       (NLEFT (CDDR CATALOG.DICTIONARY)
                                              1
                                              (FMEMB FND (CDDDR 
                                                         CATALOG.DICTIONARY]
                                                (* Move the found entry to the 
                                                front of the dictionary)
                              (AND (CDDR FND)
                                   (GO GOTONE))

          (* Read in from file, bump incore counter, and check if too 
          many incore, writing outsome; then return the value)


                              (SFPTR [SETQ FIL
                                       (OR (OPENP (CAR CATALOG.DICTIONARY))
                                           (INPUT (INFILE (CAR 
                                                         CATALOG.DICTIONARY]
                                     (CADR FND))
                              (FRPLACD (CDR FND)
                                       (READ FIL))
                          GOTONE
                              (PUTCATALOG (CDAR FND)
                                          (CAAR FND)
                                          (MAPCAR (CDDR FND)
                                                  (QUOTE CONVERT)))
                              (FRPLACA (CDR CATALOG.DICTIONARY)
                                       (ADD1 (CADR CATALOG.DICTIONARY)))
                              (WRITESOME CATALOG.DICTIONARY)
                                                (* Check if need to bump some 
                                                out)
                              (SETQ FND)
                              (GO TRY1]
            (T (LIST (create STRUCFORM (SETQ FORM (LIST (QUOTE CATALOG)
                                                        TVL])

(PUTCATALOG
  [LAMBDA (TVL TYPE LISTOFSTRUCTURES)
    (for X in LISTOFSTRUCTURES do (OR (type? STRUCTURE X)
                                      (HELP))
                                  (FIXUPGROUP X))
    (ENTER (LOOKUP (CONS TYPE TVL)
                   CATDICT)
           CATDICT LISTOFSTRUCTURES])
)
  (RPAQ CATALOGTYPE)
  (RPAQQ CATALOGTYPES (POLYGONAL GAUCHE NONPOLY))
STOP