From: Wheeler Ruml

Subject: code to modify ACL fasl extension

Date: 1997-10-16 10:37

I recently wrote a simple function for my ~/.clinit.cl to change the
"fasl" extension in ACL for Unix to reflect the current machine
architecture - this way, I don't have to have separate directories for
various architectures or worry about loading errors.  I couldn't find
such a function in the distribution, so I append it here in case
anyone else finds it useful.

Wheeler
-- 
Wheeler Ruml, Eng Sci Lab Rm 420, <eecs.harvard.edu, at ruml> (617) 495-2081 (voice)
http://www.eecs.harvard.edu/~ruml/                       (617) 496-1066 (fax)
=======================================
;;;;;;;; fasl extensions by architecture
;;
;; Wheeler Ruml <eecs.harvard.edu) at (ruml>

(defun get-proper-fasl-type (&optional (hosttype (sys:getenv "HOSTTYPE"))
				       (default "fasl"))
  (let ((table '(("hp9000s700" "hp-fasl")
		 ("alpha" "alpha-fasl"))))
    (or (second (find hosttype table :test #'string-equal :key #'first))
	(progn
	  (format *terminal-io* "; DEFAULTING TO ~A for object files.~%"
		  default)
	  default))))

(defun subst-search-list (search-list new-fasl old-fasl)
  (mapcar #'(lambda (entry)
	      (typecase entry
		(cons (subst-search-list entry new-fasl old-fasl))
		(pathname (if (equal (pathname-type entry)
				     old-fasl)
			      (make-pathname
			       :host (pathname-host entry)
			       :device (pathname-device entry)
			       :directory (pathname-directory entry)
			       :name (pathname-name entry)
			       :type new-fasl
			       :version (pathname-version entry))
			    entry))
		(t entry)))
	  search-list))

(defun set-fasl-type (&optional (to (get-proper-fasl-type))
				(from excl:*fasl-default-type*))
  (setf excl:*fasl-default-type* to)
  (setf sys:*load-search-list* (subst-search-list sys:*load-search-list*
						  to from))
  (setf sys:*require-search-list* (subst-search-list sys:*require-search-list*
						     to from))
  to)

(set-fasl-type)
  
;; EOF