/usr/share/common-lisp/source/common-lisp-controller/common-lisp-controller.lisp is in common-lisp-controller 7.10.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 | ;;; -*- Mode: Lisp; Package: COMMON-LISP-CONTROLLER -*-
;;;
;;; Copyright (C) 2000,2010 Peter Van Eynde and Kevin M. Rosenberg
;;; Licensed under the LLGPL, see debian/copyright file
(in-package #:cl-user)
#+ecl ;; Hush ECL
(setf *load-verbose* nil
*load-print* nil)
(defpackage #:common-lisp-controller
(:use #:common-lisp)
(:export #:init-common-lisp-controller
#:init-common-lisp-controller-v4
#:compile-common-lisp-controller-v5
#:init-common-lisp-controller-v5
#:clc-require
#:*clc-quiet*)
(:nicknames #:clc))
(in-package #:common-lisp-controller)
(defvar *clc-quiet* nil
"If true then clc prints no messages")
;; Some general utilities to make the
;; descriptions shorter
(defvar *fasl-root* nil "Root of implementation's directories of binary files")
(defvar *source-root* #p"/usr/share/common-lisp/source/"
"Root of source directories")
(defvar *systems-root* #p"/usr/share/common-lisp/systems/"
"Root of systems directory")
(defvar *image-preferences* #p"/etc/common-lisp/images/"
"Directory where user can choose what systems shall be added to
Images per default")
(defvar *implementation-name* nil "The name of the implementation,
used to name the directory in /var/cache/common-lisp-controller")
(define-modify-macro appendf (&rest lists) append)
(defun init-common-lisp-controller-v5 (implementation-name)
;; register the systems root:
(setf *implementation-name* implementation-name)
(pushnew :common-lisp-controller *features*)
(pushnew :clc-os-debian *features*))
(defun compile-common-lisp-controller-v5 (implementation-name)
"Compiles the clc files. Returns a list of fasls
that should be loaded in the list to enable clc"
(setf *implementation-name* implementation-name)
(pushnew :common-lisp-controller *features*)
(pushnew :clc-os-debian *features*)
(let* ((fasl-root (merge-pathnames
(make-pathname
:directory
`(:relative "0" ,*implementation-name*))
#p"/var/cache/common-lisp-controller/")))
(labels ((source-filename (package-name filename)
(let ((file (parse-namestring filename)))
(merge-pathnames
(make-pathname
:name (pathname-name file)
:type (pathname-type file)
:directory (list :relative package-name))
*source-root*)))
#+ecl
(system-fasl-filename (package-name filename)
;; this is complex because ecl
;; should produce system fasls,
;; and they have .o extension
(merge-pathnames
(make-pathname :type "o")
(fasl-filename package-name filename)))
(fasl-filename (package-name filename)
;; this is complex because ecl
;; should produce system fasls,
;; and they have .o extension
(let* ((file (parse-namestring filename))
(output-path
(merge-pathnames
(make-pathname :name (pathname-name file)
:type (pathname-type file)
:directory (list :relative package-name))
fasl-root))
(compiled-file-pathname
(compile-file-pathname
output-path)))
compiled-file-pathname))
(compile-and-load (package-name filename)
(let* ((file-path (source-filename package-name filename))
(compiled-file-pathname
(progn
;; first make the target directory:
(ensure-directories-exist
(fasl-filename package-name filename))
;; now compile it:
(compile-file file-path
:output-file (fasl-filename package-name filename)
:print nil
:verbose nil))))
;; then load it:
(load compiled-file-pathname)
;; return fasl filename
compiled-file-pathname
;; now for ecl: make the system file
#+ecl
(compile-file file-path
:output-file
(system-fasl-filename package-name filename)
:print nil
:verbose nil
;; make 'linkable object files'
:system-p t))))
;; then asdf:
;; For SBCL, take advantage of it's REQUIRE/contrib directories integration
#+sbcl
(when (boundp 'sb-ext::*module-provider-functions*)
(pushnew :sbcl-hooks-require cl:*features*))
;; return a list
(prog1
(nconc
(list
;; first ourselves:
(compile-and-load "common-lisp-controller"
"common-lisp-controller.lisp")
;; asdf
(compile-and-load "cl-asdf" "asdf.lisp")
(compile-and-load "cl-asdf" "wild-modules.lisp")
;; now patch it::
(compile-and-load "common-lisp-controller"
"post-sysdef-install.lisp"))
;; so that it will neither recalculate it nor save it in our image
(let ((*fasl-root* fasl-root))
;; "load-user-image-components" is in the above-loaded files.
(funcall (symbol-function
(find-symbol
(symbol-name :load-user-image-components)
:common-lisp-controller)))))
#+sbcl
(setq cl:*features* (delete :sbcl-hooks-require cl:*features*))))))
(defun init-common-lisp-controller-v4 (implementation-name)
"configures common-lisp-controller. IMPLEMENTATION-NAME
is the name of this implementation. Fasl's will be created in
/var/cache/common-lisp-controller/<userid>/<implementation>"
(compile-common-lisp-controller-v5 implementation-name)
;; no need to load them as they are already loaded
(init-common-lisp-controller-v5 implementation-name))
(defun init-common-lisp-controller (fasl-root
&key
(source-root "/usr/share/common-lisp/")
(version 2))
(declare (ignore source-root version))
;; vodoo: extract the name of the implementation
;; from the old fasl directory...
(init-common-lisp-controller-v4
(first
(last
(pathname-directory
(parse-namestring
fasl-root))))))
|