(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "CASH-FILE" ( USE "LISP" "XCL")))
(il:filecreated " 9-Oct-87 11:22:19" il:|{POGO:AISNORTH:XEROX}<CUTTING>LISP>CASH-FILE.;3| 4728
il:|previous| il:|date:| " 8-Oct-87 16:29:03" il:|{POGO:AISNORTH:XEROX}<CUTTING>LISP>CASH-FILE.;2|
)
; Copyright (c) 1987 by Xerox Corporation. All rights reserved.
(il:prettycomprint il:cash-filecoms)
(il:rpaqq il:cash-filecoms ((il:p (provide "CASH-FILE") (export (quote (make-cash-file open-cash-file get-cash-file rem-cash-file cash-file cash-file-p cash-file-hash-file)) "CASH-FILE") (require "HASH-FILE" "HASH-FILE.DFASL") (use-package "HASH-FILE" "CASH-FILE")) (il:structures cash-file) (il:functions %print-cash-file) (il:variables not-in-hash-file) (il:functions make-cash-file open-cash-file get-cash-file put-cash-file rem-cash-file) (il:setfs get-cash-file) (il:functions move-to-head-of-queue add-to-cache del-from-cache) (il:prop (il:makefile-environment il:filetype) il:cash-file))
)
(provide "CASH-FILE")
(export (quote (make-cash-file open-cash-file get-cash-file rem-cash-file cash-file cash-file-p cash-file-hash-file)) "CASH-FILE")
(require "HASH-FILE" "HASH-FILE.DFASL")
(use-package "HASH-FILE" "CASH-FILE")
(defstruct (cash-file (:constructor make-cash-file-internal) (:print-function %print-cash-file)) (cache nil :type hash-table :read-only t) (cache-size nil :type integer :read-only t) (queue nil :type list) (hash-file nil :type hash-file :read-only t))
(defun %print-cash-file (cash-file stream depth) (format stream "#<Cash-File on ~A>" (let* ((stream (hash-file::hash-file-stream (cash-file-hash-file cash-file))) (namestring (namestring (pathname stream)))) (if namestring namestring stream))))
(defconstant not-in-hash-file (quote (not-in-hash-file)))
(defun make-cash-file (file-name size cache-size) (make-cash-file-internal :hash-file (make-hash-file file-name size) :cache (make-hash-table :size cache-size :test (quote equal)) :cache-size cache-size))
(defun open-cash-file (file-name cache-size &key (direction :input)) (make-cash-file-internal :hash-file (open-hash-file file-name :direction direction) :cache (make-hash-table :size cache-size :test (quote equal)) :cache-size cache-size))
(defun get-cash-file (key cash-file &optional default) (multiple-value-bind (value found?) (gethash key (cash-file-cache cash-file)) (cond (found? (il:* il:|;;| "cache hit ") (move-to-head-of-queue key cash-file) (if (eq value not-in-hash-file) (il:* il:|;;| "it was a cached miss") (values default nil) (il:* il:|;;| "it was a cached hit") (values (il:* il:|;;| "return a copy to be compatable with GET-HASH-FILE which always hands you new structure") (copy-tree value) t))) (t (il:* il:|;;| "try the HASH-FILE") (multiple-value-setq (value found?) (get-hash-file key (cash-file-hash-file cash-file))) (il:* il:|;;| "cache what we found") (add-to-cache key (if found? (il:* il:|;;| "cache the VALUE") value (il:* il:|;;| "cache the miss") not-in-hash-file) cash-file) (il:* il:|;;| "return VALUE or DEFAULT") (if found? (values value t) (values default nil))))))
(defun put-cash-file (key cash-file value) (il:* il:|;;| "add it to the hash file") (setf (get-hash-file key (cash-file-hash-file cash-file)) value) (il:* il:|;;| "add it to the cache") (add-to-cache key value cash-file) value)
(defun rem-cash-file (key cash-file) (let ((found? (rem-hash-file key (cash-file-hash-file cash-file)))) (when found? (del-from-cache key cash-file)) found?))
(defsetf get-cash-file put-cash-file)
(defun move-to-head-of-queue (key cash-file) (setf (cash-file-queue cash-file) (delete key (cash-file-queue cash-file) :test (quote equal) :count 1)) (push key (cash-file-queue cash-file)))
(defun add-to-cache (key value cash-file) (let ((cache (cash-file-cache cash-file))) (if (>= (hash-table-count cache) (cash-file-cache-size cash-file)) (il:* il:|;;| "cache is full -- throw out last entry") (del-from-cache (car (last (cash-file-queue cash-file))) cash-file)) (il:* il:|;;| "store VALUE in the cache") (setf (gethash key cache) value) (il:* il:|;;| "put the KEY at the head of the QUEUE") (push key (cash-file-queue cash-file)) value))
(defun del-from-cache (key cash-file) (il:* il:|;;| "delete it from the queue") (setf (cash-file-queue cash-file) (delete key (cash-file-queue cash-file) :test (quote equal) :count 1)) (il:* il:|;;| "delete it from the cache") (remhash key (cash-file-cache cash-file)))
(il:putprops il:cash-file il:makefile-environment (:readtable "XCL" :package (defpackage "CASH-FILE" (:use "LISP" "XCL")))
)
(il:putprops il:cash-file il:filetype :xcl-compile-file)
(il:putprops il:cash-file il:copyright ("Xerox Corporation" 1987))
(il:declare\: il:dontcopy
(il:filemap (nil)))
il:stop