Commit 0046d995 authored by Gary Palter 's avatar Gary Palter

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

These changes require a large set of patches to Genera which are, presently, only
available in the world used by the Intel and ARM versions of Open Genera called
Portable Genera.  (If there's ever a new release of Genera, ...)
parent 4125c273
......@@ -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