(FILECREATED " 8-APR-74 04:08:56" DICT

     changes to:  DICTVARS

     previous date: " 7-APR-74 08:06:37")


  (LISPXPRINT (QUOTE DICTVARS)
              T)
  [RPAQQ DICTVARS ((FNS ENTER LOOKUP MAKTAB WRITESOME PUSHCAR WRITEALL 
                        WRITEDICT WRITESOME1)
          (VARS (DICTIONARYLST)
                (CHANGEDICTLST))
          (ADDVARS (PRETTYTYPELST (CHANGEDICTLST NIL "dictionaries")))
          (P (ADVISE (QUOTE CLEANUP)
                     (QUOTE BEFORE)
                     (QUOTE (WRITEDICT)))
             (SETQ ADVISEDFNS (/DREMOVE (QUOTE CLEANUP)
                                        ADVISEDFNS]
(DEFINEQ

(ENTER
  [LAMBDA (PTR DICT VAL)

          (* ENTER value into dictionary -
          VAL is the value, PTR is the return from LOOKUP 
          (which should be (LIST ARGS)) and DICT is the dictionary in 
          which PTR is contained (needed to get the file name, and the 
          number in core verses the max in core allowed))


    (OR (LISTP DICT)
        (ERROR "BAD DICTIONARY" "GIVEN TO ENTER"))
    (FRPLACA (CDR DICT)
             (ADD1 (CADR DICT)))                (* Bump the incore counter)
    (FRPLACD PTR (CONS NIL VAL))
    (FRPLACA (QUOTE CHANGEDICTLST)
             DICTIONARYLST)
    (WRITESOME DICT)
    VAL])

(LOOKUP
  [LAMBDA (INDEX DICT NOENTER)

          (* Lookup INDEX on the dictionary DICT -
          Unless NOENTER is on, insert empty marker and return it if 
          INDEX isn't found)


    (OR (LISTP DICT)
        (ERROR "LOOKUP GIVEN" "EMPTY DICTIONARY"))
    (PROG ((FND (SASSOC INDEX (CDDDR DICT)))
           FIL)                                 (* Use SACCOC to find entry, if 
                                                any)
          (COND
            ((NOT FND)
              (AND NOENTER (RETURN))            (* If no entry, just insert 
                                                empty entry in the dictionary 
                                                and return)
              (SETQ FND (LIST INDEX))
              (FRPLACD (CDDR DICT)
                       (CONS FND (CDDDR DICT)))
              (RETURN FND)))
          [PUSHCAR (CDDR DICT)
                   (NLEFT (CDDR DICT)
                          1
                          (FMEMB FND (CDDDR DICT]
                                                (* Move the found entry to the 
                                                front of the dictionary)
          (COND
            ((NULL (CDR FND))

          (* If no file pointer, then this was an empty entry 
          (only possible for an aborted computation))


              (RETURN FND))
            ((NULL (CDDR FND))
              (COND
                ((NULL (CADR FND))

          (* No value, no ptr, but a ptr place -- this is a funny 
          situation again, but might happen if abort occurs)


                  (FRPLACD FND NIL)
                  (RETURN 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 DICT))
                                   (IOFILE (CAR DICT]
                     (CADR FND))
              (FRPLACD (CDR FND)
                       (DICTREADFN FIL))
              (FRPLACA (CDR DICT)
                       (ADD1 (CADR DICT)))
              (WRITESOME DICT)                  (* Check if need to bump some 
                                                out)
              (RETURN FND))
            (T                                  (* It's already in core)
               (RETURN FND])

(MAKTAB
  [LAMBDA (FN MAXCORE FILE INDEX)

          (* Fix up FN so that it uses a dictionary called FILE 
          (which is also the file name that it uses) -
          If FILE is NIL, use the FN name -
          MAXCORE is the maximum number of dictionary entries that can 
          reside in core -
          If FN is NIL, just create the dictionary, but don't ADVISE 
          any function)


    (PROG (VARS TEM)
          (OR FN FILE (ERROR "NO NAME FOR THIS" "DICTIONARY"))
          (SETQ TEM (NAMEFIELD (OR FN FILE)))
          [OR FILE (SETQ FILE (PACK (LIST TEM (QUOTE ".DICT"]
          (COND
            ((MEMB FILE DICTIONARYLST)
              (ERROR FILE "ALREADY IS A DICTIONARY")))
          (COND
            (FN [COND
                  ((CDR (SETQ VARS (ARGLIST FN)))
                    (SETQ VARS (CONS (QUOTE LIST)
                                     VARS)))
                  (T (SETQ VARS (CAR VARS]

          (* VARS will be the expression that is to be looked up -
          Usually (LIST <ARGLIST FN>) but if there is only one ARG to 
          FN, will use it alone)


                (VIRGINFN FN T)

          (* The function will look like -
          (tem← (LOOKUP <ARGS> <DICT>)) (if 
          (CDR TEM) then (RETURN (CDDR TEM)) else <compute function> 
          (ENTER TEM FN !VALUE)))


                [ADVISE FN (QUOTE BIND)
                        (LIST (LIST (QUOTE TEM)
                                    (LIST (QUOTE LOOKUP)
                                          VARS FILE]
                [ADVISE FN (QUOTE BEFORE)
                        (QUOTE (COND
                                 ((CDR TEM)
                                   (RETURN (CDDR TEM]
                [ADVISE FN (QUOTE AFTER)
                        (LIST (QUOTE COND)
                              (LIST (QUOTE (NULL (CDR TEM)))
                                    (LIST (QUOTE ENTER)
                                          (QUOTE TEM)
                                          FILE
                                          (QUOTE !VALUE]
                (/PUT FN (QUOTE DICTIONARY)
                      FILE)))                   (* Open FILE, and set up incore 
                                                dictionary)
          [/SET
            FILE
            (COND
              [INDEX
                (READFILE
                  (OR
                    (INFILEP INDEX)
                    (INFILEP
                      (HELP
                        "INDEX file for dictionary not found" 
                      "%"RETURN (QUOTE newfile)%" to use 'newfile' instead"))
                    (ERROR "YOU BLEW IT"]
              ([INFILEP (SETQ TEM (OR INDEX (PACK (LIST TEM ".INDEX"]
                (READFILE TEM))
              (T (LIST (IOFILE (OR (INFILEP FILE)
                                   (OUTFILEP FILE)))
                       0
                       (OR MAXCORE 10]
          (/PUT FILE (QUOTE INDEX)
                TEM)
          (/RPLACA (QUOTE DICTIONARYLST)
                   (CONS FILE DICTIONARYLST])

(WRITESOME
  [LAMBDA (DICT CNT)

          (* If the number of incore entries exceeds the max incore 
          entries, look for the first incore entry that is followed by 
          one not in core -
          Delete the incore value (writing it out if it's not already 
          on file), and decrement the incore counter)


    (AND [NOT (ILESSP (CADR DICT)
                      (OR CNT (CADDR DICT]
         (WRITESOME1 (CDDDR DICT))
         (FRPLACA (CDR DICT)
                  (SUB1 (CADR DICT])

(PUSHCAR
  [LAMBDA (L1 L2)

          (* PUSH (CADR L2) after (CAR L1) -
          L2 is a tail of L1 -
          Sort of complicated)


    (OR (EQ L1 L2)
        (PROG (TEM)
              (SETQ TEM (CDR L1))
              (FRPLACD L1 (CDR L2))
              (FRPLACD L2 (CDDR L2))
              (FRPLACD (CDR L1)
                       TEM])

(WRITEALL
  [LAMBDA (DICT)
    (WHILE (WRITESOME DICT 0) DO NIL])

(WRITEDICT
  [LAMBDA (FILE)
    (COND
      [(NULL FILE)
        (COND
          ((AND CHANGEDICTLST DICTIONARYLST)
            (LISPXPRIN1 "writing dictionaries:
" T)
            [MAPC DICTIONARYLST (FUNCTION (LAMBDA (FILE)
                      (LISPXPRINT (WRITEDICT FILE)
                                  T]
            (SETQ CHANGEDICTLST]
      ((MEMB FILE DICTIONARYLST)
        (WRITEALL (CAR FILE))
        [WRITEFILE (CAR FILE)
                   (OR (GETP FILE (QUOTE INDEX))
                       (PACK (LIST (NAMEFIELD FILE)
                                   (QUOTE .INDEX]
        FILE)
      [(PROG [(TEM (GETP FILE (QUOTE DICTIONARY]
             (COND
               (TEM (WRITEDICT TEM]
      (T (ERROR FILE "is not a dictionary"])

(WRITESOME1
  [LAMBDA (DICTL)

          (* Tries to write out the last possible DICT element -
          Should be the one referenced least recently)


    (COND
      ((NULL DICTL)                             (* End of list, back up)
        NIL)
      ((WRITESOME1 (CDR DICTL))                 (* First try on CDR, if 
                                                sucessful, return)
        T)
      ((CDDR (CAR DICTL))                       (* This is the last entry that 
                                                has a value in it)
        [COND
          ((NULL (CADAR DICTL))

          (* If it hasn't been written out on a file, the ptr field 
          will be NIL)


            (PROG (POS (FIL (CAR DICT)))        (* Get the file name from DICT)
                  (SFPTR (SETQ FIL (OR (OPENP FIL (QUOTE OUTPUT))
                                       (IOFILE FIL)))
                         -1)                    (* Set file pointer to end of 
                                                file)
                  (SETQ POS (SFPTR FIL))

          (* And save the pointer so that it can be entered into the 
          DICT)


                  (DICTPRINTFN (CDDR (CAR DICTL))
                               FIL)             (* Write out value on the file)
                  (FRPLACA (CDAR DICTL)
                           POS)                 (* Insert file pointer in 
                                                dictionary)
              ]
        (FRPLACD (CDR (CAR DICTL))
                 NIL])
)
  (RPAQ DICTIONARYLST)
  (RPAQ CHANGEDICTLST)
  (ADDTOVAR PRETTYTYPELST (CHANGEDICTLST NIL "dictionaries"))
  (ADVISE (QUOTE CLEANUP)
          (QUOTE BEFORE)
          (QUOTE (WRITEDICT)))
  (SETQ ADVISEDFNS (/DREMOVE (QUOTE CLEANUP)
                             ADVISEDFNS))
STOP