Changeset 3644

Show
Ignore:
Timestamp:
07/25/08 18:46:19 (4 months ago)
Author:
hans
Message:

Revive cmucl support for BOS.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/bknr/datastore/src/utils/acl-mp-compat.lisp

    r3483 r3644  
    5656 
    5757(defun make-process (function &key name) 
    58   #+sbcl(sb-thread:make-thread function :name name) 
    59   #+openmcl(ccl:process-run-function name function) 
    60   #+cmu(mp:make-process function :name name)) 
     58  #+sbcl (sb-thread:make-thread function :name name) 
     59  #+openmcl (ccl:process-run-function name function) 
     60  #+cmu (mp:make-process function :name name)) 
    6161 
    6262(defun destroy-process (process) 
    63   #+sbcl(sb-thread:destroy-thread process) 
    64   #+openmcl(ccl:process-kill process) 
    65   #+cmu(mp:destroy-process process)) 
     63  #+sbcl (sb-thread:destroy-thread process) 
     64  #+openmcl (ccl:process-kill process) 
     65  #+cmu (mp:destroy-process process)) 
    6666 
    6767(defun process-active-p (process) 
    68   #+sbcl(sb-thread:thread-alive-p process) 
    69   #+openmcl(ccl::process-active-p process) 
    70   #+cmu(mp:process-active-p process)) 
     68  #+sbcl (sb-thread:thread-alive-p process) 
     69  #+openmcl (ccl::process-active-p process) 
     70  #+cmu (mp:process-active-p process)) 
    7171 

  • trunk/bknr/datastore/src/utils/package.lisp

    r2970 r3644  
    77        :md5 
    88        #+sbcl :sb-ext 
    9         #+cmu :mp 
    109        #+openmcl :ccl) 
    1110  #+openmcl 

  • trunk/clean.lisp

    r2720 r3644  
    44 
    55(format t "; cleaning fasls in ~A~%" (probe-file *default-pathname-defaults*)) 
    6 (mapc #'delete-file (directory (compile-file-pathname #P"**/*.lisp"))) 
     6(mapc #'delete-file 
     7      (directory 
     8       (merge-pathnames (make-pathname :name :wild 
     9                                             :directory '(:relative :wild-inferiors) 
     10                                             :type (pathname-type (compile-file-pathname ""))) 
     11                        (probe-file *default-pathname-defaults*)))) 
    712 
    813 

  • trunk/projects/bos/build.lisp

    r3619 r3644  
    22(in-package :cl-user) 
    33 
    4 #+cmu(load (compile-file "../../bknr/patches/patch-around-mop-cmucl19a.lisp")) 
     4#+sbcl (require 'asdf) 
     5#+sbcl (require 'sb-posix) 
    56 
    6 #+sbcl(require 'asdf) 
    7 #+sbcl(require 'sb-posix) 
    8  
    9 #+sbcl(assert (eql sb-impl::*default-external-format* :utf-8)) 
     7#+sbcl (assert (eql sb-impl::*default-external-format* :utf-8)) 
     8#+cmu 
     9(setf stream:*default-external-format* :utf-8 
     10      ext:*gc-verbose* nil 
     11      *compile-print* nil 
     12      ext:*bytes-consed-between-gcs* (* 64 1024 1024) 
     13      *default-pathname-defaults* (pathname (format nil "~A/" (nth-value 1 (unix:unix-current-directory))))) 
    1014 
    1115(load (compile-file "../../thirdparty/asdf/asdf.lisp")) 
    1216 
    1317;; cl-gd glue 
    14 #+darwin(assert (zerop (asdf:run-shell-command "cd ../../thirdparty/cl-gd-0.5.6; make cl-gd-glue.dylib"))) 
    15 #-darwin(assert (zerop (asdf:run-shell-command "cd ../../thirdparty/cl-gd-0.5.6; make"))) 
     18#+darwin (assert (zerop (asdf:run-shell-command "cd ../../thirdparty/cl-gd-0.5.6; make cl-gd-glue.dylib"))) 
     19#-darwin (assert (zerop (asdf:run-shell-command "cd ../../thirdparty/cl-gd-0.5.6; make"))) 
    1620 
    1721;;; some helpers 
    …… 
    2327                     asdf:*central-registry* 
    2428                     :test #'equal)) 
    25         (directory #p"../../**/*.asd"))) 
     29        (directory (merge-pathnames #p"**/*.asd" (truename "../../"))))) 
    2630 
    2731(defun read-configuration (pathname) 
    …… 
    3842(asdf:oos 'asdf:load-op :bos.web) 
    3943 
     44#+sbcl 
    4045(defvar *sbcl-home* (sb-int:sbcl-homedir-pathname)) 
    4146 
     47#+sbcl 
    4248(defun ensure-sbcl-home () 
    4349  (sb-posix:putenv (format nil "SBCL_HOME=~a" *sbcl-home*))) 
    4450 
    4551(defun env-ascii-check () 
    46   #+sbcl(assert (block top 
    47                   (dolist (string (posix-environ) t) 
    48                     (loop for ch across string 
    49                        unless (< 0 (char-code ch) 128) 
    50                        do (return-from top nil)))) 
    51                 nil 
    52                 "We will have a problem if your environment contains anything else than ASCII characters.~ 
     52  #+sbcl 
     53  (assert (block top 
     54            (dolist (string (posix-environ) t) 
     55              (loop for ch across string 
     56                 unless (< 0 (char-code ch) 128) 
     57                 do (return-from top nil)))) 
     58          nil 
     59          "We will have a problem if your environment contains anything else than ASCII characters.~ 
    5360             ~%So I'd like to enforce this here.")) 
    5461 
    5562(defun start (&key (swank-port 4005)) 
    56   (ensure-sbcl-home) 
     63  #+sbcl (ensure-sbcl-home) 
    5764  (env-ascii-check) 
    5865  ;; check for changes that are not yet in the core 
    …… 
    7380  (bos.web::start-contract-tree-image-update-daemon) 
    7481  (bos.m2::start-postmaster) 
    75   (bknr.cron::start-cron)) 
     82  (bknr.cron::start-cron) 
     83  #+(and cmu mp) 
     84  (mp::startup-idle-and-top-level-loops)) 
    7685 
    7786(defun start-cert-daemon () 

  • trunk/projects/bos/m2/m2-pdf.lisp

    r3478 r3644  
    6666      ;; usable manner.  In order to avoid having to deal with 
    6767      ;; embedding fonts and encoding, just work around the issue: 
    68       (princ (remove #\Latin_Capital_Letter_A_With_Circumflex 
     68      (princ (remove (code-char 194) 
    6969                     (with-output-to-string (s) 
    7070                       (let ((pdf:*compress-streams* nil)) 

  • trunk/projects/bos/m2/packages.lisp

    r3619 r3644  
    273273(defpackage :bos.m2.cert-generator 
    274274  (:use :cl 
    275         #+cmu :extensions 
    276         #+sbcl :sb-ext 
    277275        :bos.m2.config 
    278276        :bknr.utils 

  • trunk/projects/bos/web/bos.web.asd

    r3493 r3644  
    3838               (:file "sat-tree" :depends-on ("quad-tree" "contract-tree")) 
    3939               (:file "countries" :depends-on ("packages")) 
     40               (:file "website-language" :depends-on ("packages")) 
    4041               (:file "kml-handlers" :depends-on ("packages" 
     42                                                  "website-language" 
    4143                                                  "web-macros" 
    4244                                                  "countries" 
    …… 
    5355               (:file "webserver" :depends-on ("news-tags" 
    5456                                               "tags" 
     57                                               "website-language" 
    5558                                               "map-handlers" 
    5659                                               "map-browser-handler" 

  • trunk/projects/bos/web/packages.lisp

    r3353 r3644  
    55  (:use :cl 
    66        :date-calc 
    7         #+cmu :extensions 
    8         #+sbcl :sb-ext 
    97        :cl-user 
    108        :cl-interpol 
    …… 
    1311        :cxml 
    1412        :puri 
    15         #+(or) :mime 
    1613        :bknr.web 
    1714        :bknr.web.frontend 

  • trunk/projects/bos/web/webserver.lisp

    r3621 r3644  
    5757                (cons :language (request-language))) 
    5858          (call-next-method))) 
    59  
    60 (define-persistent-class website-language () 
    61   ((code :read :index-type string-unique-index :index-reader language-with-code) 
    62    (name :read :index-type string-unique-index))) 
    63  
    64 (defun website-languages () 
    65   (mapcar #'(lambda (language) (list (website-language-code language) 
    66                                      (website-language-name language))) 
    67           (class-instances 'website-language))) 
    68  
    69 (defun website-supports-language (language) 
    70   (find language (website-languages) :test #'string-equal :key #'car)) 
    71  
    72 (defun language-from-url (path) 
    73   (register-groups-bind (language) (#?r"^/(..)/" path) 
    74                         (when (website-supports-language language) 
    75                           language))) 
    76  
    77 (defun find-browser-prefered-language () 
    78   "Determine the language prefered by the user, as determined by the Accept-Language header 
    79 present in the HTTP request.  Header decoding is done according to RFC2616, considering individual 
    80 language preference weights." 
    81   (let ((accept-language (hunchentoot:header-in* :accept-language))) 
    82     (dolist (language (mapcar #'car 
    83                               (sort (mapcar #'(lambda (language-spec-string) 
    84                                                 (if (find #\; language-spec-string) 
    85                                                     (destructuring-bind (language preference-string) 
    86                                                         (split #?r" *; *q=" language-spec-string) 
    87                                                       (cons language (read-from-string preference-string))) 
    88                                                     (cons language-spec-string 1))) 
    89                                             (split #?r" *, *" accept-language)) 
    90                                     #'> :key #'cdr))) 
    91       (when (website-supports-language language) 
    92         (return-from find-browser-prefered-language language)) 
    93       (register-groups-bind (language variant) (#?r"^(.*)-(.*)$" language) 
    94                             (declare (ignore variant)) 
    95                             (when (website-supports-language language) 
    96                               (return-from find-browser-prefered-language language))))) 
    97   nil) 
    9859 
    9960(defclass index-handler (page-handler) 

  • trunk/thirdparty/bordeaux-threads_0.4.0/src/cmu.lisp

    r2983 r3644  
    99;;; Thread Creation 
    1010 
    11 (defun make-thread (function &key name) 
     11(defun make-thread (function &key (name "Anonymous")) 
    1212  (mp:make-process function :name name)) 
    1313