Commit 24dd8bb9 authored by Robert Goldman's avatar Robert Goldman

Merge branch 'master' into 'master'

Minimal set of changes to allow ASDF to function on Genera.

See merge request !102
parents 4125c273 0046d995
......@@ -45,3 +45,14 @@
;;; The problem with writing a defsystem replacement is bootstrapping:
;;; we can't use defsystem to compile it. Hence, all in one file.
(eval-when (:compile-toplevel :load-toplevel :execute)
(multiple-value-bind (system-major system-minor)
(multiple-value-bind (is-major is-minor)
(sct:get-system-version "Intel-Support")
(unless (or (> system-major 452)
(and is-major
(or (> is-major 3)
(and (= is-major 3) (> is-minor 86)))))
(error "ASDF requires either System 453 or later or Intel Support 3.87 or later")))))
......@@ -71,7 +71,13 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
(or (ignore-errors (truename p))
;; this is here because trying to find the truename of a directory pathname WITHOUT supplying
;; a trailing directory separator, causes an error on some lisps.
#+(or clisp gcl) (if-let (d (ensure-directory-pathname p nil)) (ignore-errors (truename d)))))))
#+(or clisp gcl) (if-let (d (ensure-directory-pathname p nil)) (ignore-errors (truename d)))
;; On Genera, truename of a directory pathname will probably fail as Genera
;; will merge in a filename/type/version from *default-pathname-defaults* and
;; will try to get the truename of a file that probably doesn't exist.
#+genera (when (directory-pathname-p p)
(let ((d (scl:send p :directory-pathname-as-file)))
(ensure-directory-pathname (ignore-errors (truename d)) nil)))))))
(defun safe-file-write-date (pathname)
"Safe variant of FILE-WRITE-DATE that may return NIL rather than raise an error."
......@@ -714,9 +714,10 @@ it will filter them appropriately."
(with-saved-deferred-warnings (warnings-file :source-namestring (namestring input-file))
(with-muffled-compiler-conditions ()
(or #-(or clasp ecl mkcl)
(let (#+genera (si:*common-lisp-syntax-is-ansi-common-lisp* t))
(apply 'compile-file input-file :output-file tmp-file
#+sbcl (if emit-cfasl (list* :emit-cfasl tmp-cfasl keywords) keywords)
#-sbcl keywords)
#-sbcl keywords))
#+ecl (apply 'compile-file input-file :output-file
(if object-file
(list* object-file :system-p t keywords)
......@@ -768,6 +769,7 @@ it will filter them appropriately."
(defun load* (x &rest keys &key &allow-other-keys)
"Portable wrapper around LOAD that properly handles loading from a stream."
(with-muffled-loader-conditions ()
(let (#+genera (si:*common-lisp-syntax-is-ansi-common-lisp* t))
(etypecase x
((or pathname string #-(or allegro clozure genera) stream #+clozure file-stream)
(apply 'load x keys))
......@@ -780,7 +782,7 @@ it will filter them appropriately."
(*readtable* *readtable*)
(*load-pathname* nil)
(*load-truename* nil))
(eval-input x))))))
(eval-input x)))))))
(defun load-from-string (string)
"Portably read and evaluate forms from a STRING."
......@@ -91,8 +91,8 @@ by the underlying implementation's MAKE-PATHNAME and other primitives"
;; See CLHS make-pathname and
;; This will be :unspecific if supported, or NIL if not.
(defparameter *unspecific-pathname-type*
#+(or abcl allegro clozure cmucl genera lispworks sbcl scl) :unspecific
#+(or clasp clisp ecl mkcl gcl xcl #|These haven't been tested:|# cormanlisp mcl mezzano) nil
#+(or abcl allegro clozure cmucl lispworks sbcl scl) :unspecific
#+(or genera clasp clisp ecl mkcl gcl xcl #|These haven't been tested:|# cormanlisp mcl mezzano) nil
"Unspecific type component to use with the underlying implementation's MAKE-PATHNAME")
(defun make-pathname* (&rest keys &key directory host device name type version defaults
......@@ -330,7 +330,14 @@ actually-existing directory."
(make-pathname :directory (append (or (normalize-pathname-directory-component
(pathname-directory pathspec))
(list :relative))
(list (file-namestring pathspec)))
(list #-genera (file-namestring pathspec)
;; On Genera's native filesystem (LMFS),
;; directories have a type and version
;; which must be ignored when converting
;; to a directory pathname
#+genera (if (typep pathspec 'fs:lmfs-pathname)
(pathname-name pathspec)
(file-namestring pathspec))))
:name nil :type nil :version nil :defaults pathspec)
(error (c) (call-function on-error (compatfmt "~@<error while trying to create a directory pathname for ~S: ~A~@:>") pathspec c)))))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment