edge-table-storage.lisp

   1 ;;;;***************************************************************************
   2 ;;;;
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;;  Name:           edge-table-storage.lisp
   6 ;;;;  Purpose:        Store precompiled edge table for reversi
   7 ;;;;  Programer:      Kevin Rosenberg
   8 ;;;;  Date Started:   1 Nov 2001
   9 ;;;;
  10 ;;;; $Id: edge-table-storage.lisp,v 1.4 2003/06/12 12:42:13 kevin Exp $
  11 ;;;;
  12 ;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg
  13 ;;;;
  14 ;;;; Reversi users are granted the rights to distribute and use this software
  15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  17 ;;;;***************************************************************************
  18
  19 (in-package #:reversi)
  20
  21 (defparameter *et-path* nil)
  22
  23 (eval-when (:load-toplevel :execute)
  24   (let ((precompiled-path (make-pathname
  25                            :directory '(:absolute "usr" "share" "common-lisp"
  26                                                   "source" "reversi")
  27                            :name "edge-table"
  28                            :type "dat")))
  29     (if (probe-file precompiled-path)
  30         (setq *et-path* precompiled-path)
  31       (setq *et-path* (make-pathname
  32                        :directory (pathname-directory *load-truename*)
  33                        :host (pathname-host *load-truename*)
  34                        :device (pathname-device *load-truename*)
  35                        :name "edge-table"
  36                        :type "dat"))))
  37
  38   (defun store-edge-table (et &optional (path *et-path*))
  39     (with-open-file (stream path :direction :output
  40                             :if-exists :supersede)
  41       (print (length et) stream)
  42       (dotimes (i (length et))
  43         (declare (fixnum i))
  44         (print (aref et i) stream))))
  45
  46   (defun load-edge-table (&optional (path *et-path*))
  47     (when (probe-file path)
  48       (with-open-file (stream path :direction :input)
  49         (let* ((length (read stream))
  50                (et (make-array length :element-type 'fixnum)))
  51                       (dotimes (i length)
  52                         (declare (fixnum i))
  53                         (setf (aref et i) (read stream)))
  54                       et))))
  55
  56   (unless (probe-file *et-path*)
  57     (format *trace-output* ";; Recompiling edge-table, this make take several minutes")
  58     (store-edge-table (make-edge-table)))
  59
  60   (unless *edge-table*
  61     (setq *edge-table* (load-edge-table))))
  62
  63
  64
  65
  66