config.lsp.in 4.38 KB
Newer Older
1 2 3
;;;; -*- Mode: Lisp; Syntax: Common-Lisp; indent-tabs-mode: nil -*-
;;;; vim: set filetype=lisp tabstop=8 shiftwidth=2 expandtab:

4
;; @configure_input@
jjgarcia's avatar
jjgarcia committed
5
;;
6
;; Configuration file for ECL
jjgarcia's avatar
jjgarcia committed
7
;;
8
(in-package "COMMON-LISP")
9

10
#+(and (not ecl-min) (not nacl) (not windows) (not mingw32) uname)
11 12 13 14
(ffi:clines "
#include <sys/utsname.h>
")

15
#+(and (not ecl-min) (not nacl) (not windows) (not mingw32) uname)
16 17
(defun uname ()
 (ffi:c-inline () () :object "{
Daniel Kochmański's avatar
Daniel Kochmański committed
18 19 20 21 22
        cl_object output;
        struct utsname aux;
        if (uname(&aux) < 0)
                output = ECL_NIL;
        else
23 24 25 26 27
                output = cl_list(5, ecl_make_simple_base_string(aux.sysname,-1),
                            ecl_make_simple_base_string(aux.nodename,-1),
                            ecl_make_simple_base_string(aux.release,-1),
                            ecl_make_simple_base_string(aux.version,-1),
                            ecl_make_simple_base_string(aux.machine,-1));
Daniel Kochmański's avatar
Daniel Kochmański committed
28
        @(return) = output;
29 30
}" :one-liner nil))

31 32 33 34 35 36 37 38 39 40 41
#+(and ecl-min uname)
(defun uname ()
  "A poor man's uname"
  (list "@SOFTWARE_TYPE@"
        NIL #| hostname |#
        #.(let ((aux "@SOFTWARE_VERSION@"))
            (when (plusp (length aux))
              aux))
        NIL #| kernel version |#
        "@ARCHITECTURE@"))

jjgarcia's avatar
jjgarcia committed
42 43 44
;;
;; * Short and long site names
;;
45 46
;; Edit these with the name of your site:
;;
47 48 49
(defun short-site-name ()
  "Args: ()
Returns, as a string, the location of the machine on which ECL runs."
50
  nil)
51 52 53 54

(defun long-site-name () 
  "Args: ()
Returns, as a string, the location of the machine on which ECL runs."
55
  nil)
56

jjgarcia's avatar
jjgarcia committed
57
;;
58
;; * ECL version, architecture, etc
jjgarcia's avatar
jjgarcia committed
59
;;
60 61 62
(defun lisp-implementation-version ()
  "Args:()
Returns the version of your ECL as a string."
Juan Jose Garcia Ripoll's avatar
Juan Jose Garcia Ripoll committed
63
  "@PACKAGE_VERSION@")
64

65
(defun ext:lisp-implementation-vcs-id ()
66 67
  #.si::+commit-id+)

68 69 70
(defun machine-type ()
  "Args: ()
Returns, as a string, the type of the machine on which ECL runs."
71 72 73
  (or (ext:getenv "HOSTTYPE")
      #+(or :mingw32 :msvc :cygwin)
      (ext:getenv "PROCESSOR_ARCHITECTURE")
74 75
      #+uname
      (fifth (uname))
76
      "@ARCHITECTURE@"))
77 78 79

(defun machine-instance ()
  "Args: ()
80 81 82
Returns, as a string, the identifier of the machine on which ECL runs."
  (or (ext:getenv "HOSTNAME")
      #+(or :mingw32 :msvc :cygwin)
83 84 85 86
      (ext:getenv "COMPUTERNAME")
      #+uname
      (second (uname))
      ))
87 88 89 90 91

(defun machine-version ()
  "Args: ()
Returns, as a string, the version of the machine on which ECL runs. Obtained from
uname(2) where available."
92 93
  (or #+(or :mingw32 :msvc :cygwin)
      (ext:getenv "PROCESSOR_LEVEL")))
94

95
(pushnew :@thehost@ *features*)
jjgarcia's avatar
jjgarcia committed
96

97 98 99
(defun software-type ()
  "Args: ()
Returns, as a string, the type of the software under which ECL runs."
100 101
  (or #+uname (first (uname))
      "@SOFTWARE_TYPE@"))
102 103 104 105

(defun software-version ()
  "Args: ()
Returns, as a string, the version of the software under which ECL runs."
106 107
  (or #+uname (third (uname))
      #.(let ((aux "@SOFTWARE_VERSION@"))
Daniel Kochmański's avatar
Daniel Kochmański committed
108 109 110
          (if (plusp (length aux))
              aux
              nil))))
111

jjgarcia's avatar
jjgarcia committed
112 113 114
;;
;; * Set up some room
;;
115 116
#-boehm-gc
(progn
jjgarcia's avatar
jjgarcia committed
117
  (sys::allocate 'CONS 200)
jgarcia's avatar
jgarcia committed
118
  (sys::allocate 'BASE-STRING 40))
119

jjgarcia's avatar
jjgarcia committed
120 121 122 123
;;
;; * Set configuration pathnames. Notice the trailing slash!
;;   Otherwise it would not be a directory.
;;
124
#-msvc
125
(si::pathname-translations "HOME" '(("**;*.*" "~/**/*.*")))
126 127 128
#+msvc
(si::pathname-translations "HOME"
  `(("**;*.*" ,(merge-pathnames "**/*.*" (user-homedir-pathname)))))
129 130
(let (x)
  (cond ((and (setf x (ext:getenv "TMPDIR"))
Daniel Kochmański's avatar
Daniel Kochmański committed
131 132 133 134 135 136
              (probe-file x)))
        ((and (setf x (ext:getenv "TEMP"))
              (probe-file x)))
        ((and (setf x (ext:getenv "TMP"))
              (probe-file x)))
        (t (setf x #+unix "/tmp" #-unix "./")))
137 138
  (si::pathname-translations "TMP"
     `(("**;*.*" ,(format nil "~A/**/*.*" x)))))
139 140 141 142 143 144 145 146 147

#-ecl-min
(macrolet ((define-pathname-translations (name base-pathname)
             `(let ((path ,base-pathname))
               (when path
                 (si::pathname-translations
                  ,name `(("**;*.*" ,(merge-pathnames "**/*.*" path))))))))
  (define-pathname-translations "SYS" (si::get-library-pathname))
  (let ((x (ext:getenv "ECLSRCDIR")))
148 149
    ;; Notice we use true_srcdir, which in Windows resolves to a
    ;; Windows pathname, not a mingw/cygwin pathname
150
    (unless (and x (setq x (probe-file x)))
151
      (setf x #.(truename "@true_srcdir@/")))
152 153 154
    (define-pathname-translations "SRC" x)
    (define-pathname-translations "EXT" (merge-pathnames "../contrib/" x))
    ))