X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=edge-table-storage.lisp;h=d09f4166aeea8ee23859da69464b7b18693cb734;hb=5db70caccaeace444f36fae1cbe4ad4b6860df5c;hp=1d2d6e17f2ec1883c022a9e4026ca2dceb6fecf9;hpb=1758cfb593196dd65c70199aa1ebd90cbd6e7ee5;p=reversi.git diff --git a/edge-table-storage.lisp b/edge-table-storage.lisp index 1d2d6e1..d09f416 100644 --- a/edge-table-storage.lisp +++ b/edge-table-storage.lisp @@ -7,7 +7,7 @@ ;;;; Programer: Kevin Rosenberg ;;;; Date Started: 1 Nov 2001 ;;;; -;;;; $Id: edge-table-storage.lisp,v 1.2 2002/10/25 09:23:39 kevin Exp $ +;;;; $Id: edge-table-storage.lisp,v 1.3 2002/10/25 12:39:15 kevin Exp $ ;;;; ;;;; This file is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -18,28 +18,29 @@ (in-package :reversi) -(eval-when (:compile-toplevel :load-toplevel :execute) +(defparameter *et-path* nil) - (defparameter *et-path* nil) - - (if *load-truename* +(eval-when (:load-toplevel :execute) + (let ((precompiled-path (make-pathname + :directory '(:absolute "usr" "share" "common-lisp" + "source" "reversi") + :name "edge-table" + :type "dat"))) + (if (probe-file precompiled-path) + (setq *et-path* precompiled-path) (setq *et-path* (make-pathname :directory (pathname-directory *load-truename*) :host (pathname-host *load-truename*) :device (pathname-device *load-truename*) :name "edge-table" - :type "dat")) - (setq *et-path* (make-pathname - :directory '(:absolute "usr" "share" "common-lisp" - "source" "reversi" "data") - :name "edge-table" - :type "dat"))) + :type "dat")))) (defun store-edge-table (et &optional (path *et-path*)) (with-open-file (stream path :direction :output :if-exists :supersede) (print (length et) stream) (dotimes (i (length et)) + (declare (fixnum i)) (print (aref et i) stream)))) (defun load-edge-table (&optional (path *et-path*)) @@ -48,10 +49,12 @@ (let* ((length (read stream)) (et (make-array length :element-type 'fixnum))) (dotimes (i length) + (declare (fixnum i)) (setf (aref et i) (read stream))) et)))) (unless (probe-file *et-path*) + (format *trace-output* ";; Recompiling edge-table, this make take several minutes") (store-edge-table (make-edge-table))) (unless *edge-table*