1 ;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: set-logical.cl
6 ;;;; Purpose: Sets a logical host for src/binaries based on a pathname.
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Feb 2002
10 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
12 ;;;; UFFI users are granted the rights to distribute and use this software
13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
15 ;;;; *************************************************************************
18 ;;; Setup logical pathname translaton with separate binary directories
19 ;;; for each implementation
21 ;; push allegro case sensitivity on *features*
23 (eval-when (:compile-toplevel :load-toplevel :execute)
24 (if (or (eq excl:*current-case-mode* :case-sensitive-lower)
25 (eq excl:*current-case-mode* :case-sensitive-upper))
26 (pushnew :case-sensitive cl:*features*)
27 (pushnew :case-insensitive cl:*features*)))
29 (defconstant +set-logical-compiler-name+
30 #+(and allegro ics case-sensitive) "acl-modern"
31 #+(and allegro (not ics) case-sensitive) "acl-modern8"
32 #+(and allegro ics (not case-sensitive)) "acl-ansi"
33 #+(and allegro (not ics) (not case-sensitive)) "acl-ansi8"
34 #+lispworks "lispworks"
41 #-(or allegro lispworks clisp cmu sbcl corman mcl openmcl) "unknown")
43 (defun set-logical-host-for-pathname (host base-pathname)
44 (setf (logical-pathname-translations host)
45 `(("ROOT;" ,(make-pathname
46 :host (pathname-host base-pathname)
47 :device (pathname-device base-pathname)
48 :directory (pathname-directory base-pathname)))
49 ("**;bin;*.*.*" ,(merge-pathnames
54 (append '(:relative :wild-inferiors
55 ".bin" #.+set-logical-compiler-name+)))
57 ("**;*.*.*" ,(merge-pathnames
61 :directory '(:relative :wild-inferiors))
65 (export 'set-logical-host-for-pathname)