Skip to content
Snippets Groups Projects
Commit b9070f45 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Reinstate some GCL support.

parent 614279d4
No related branches found
No related tags found
No related merge requests found
......@@ -35,7 +35,7 @@ Some constraints:
(declaim (optimize (speed 2) (safety #-gcl 3 #+gcl 0) #-(or allegro gcl genera) (debug 3)
#+(or cmu scl) (c::brevity 2)))
(proclaim '(optimize (speed 2) (safety #-gcl 3 #+gcl 0) #-(or allegro gcl genera) (debug 3)
(proclaim '(optimize (speed #-gcl 2 #+gcl 0) (safety #-gcl 3 #+gcl 0) #-(or allegro gcl genera) (debug 3)
#+(or cmu scl) (c::brevity 2)))
(defvar *trace-symbols*
......
......@@ -65,7 +65,8 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
(defun truename* (p)
"Nicer variant of TRUENAME that plays well with NIL and avoids logical pathname contexts"
;; avoids both logical-pathname merging and physical resolution issues
(and p (handler-case (with-pathname-defaults () (truename p)) (file-error () nil))))
(and p (handler-case (with-pathname-defaults () (truename p))
(#-gcl file-error #+gcl error () nil))))
(defun safe-file-write-date (pathname)
"Safe variant of FILE-WRITE-DATE that may return NIL rather than raise an error."
......@@ -107,7 +108,7 @@ or the original (parsed) pathname if it is false (the default)."
#+sbcl (sb-unix:unix-stat (sb-ext:native-namestring pp))
#-(or cmu (and lispworks unix) sbcl scl) (file-write-date pp)
p))))
#+clisp
#+(or clisp gcl)
#.(flet ((probe (probe)
`(let ((foundtrue ,probe))
(cond
......@@ -124,8 +125,11 @@ or the original (parsed) pathname if it is false (the default)."
`(if truename
,resolve
(and (ignore-errors (,fs p)) p))
(probe resolve)))))
(file-error () nil)))))))
(probe resolve)))
#+gcl
(probe '(or (probe-file p)
(truename* (ensure-directory-pathname p))))))
(#-gcl file-error #+gcl error () nil)))))))
(defun directory-exists-p (x)
"Is X the name of a directory that exists on the filesystem?"
......@@ -523,7 +527,7 @@ in an atomic way if the implementation allows."
(defun delete-file-if-exists (x)
"Delete a file X if it already exists"
(when x (handler-case (delete-file x) (file-error () nil))))
(when x (handler-case (delete-file x) (#-gcl file-error #+gcl error () nil))))
(defun delete-empty-directory (directory-pathname)
"Delete an empty directory"
......
......@@ -591,7 +591,7 @@ possibly in a different process. Otherwise just call THUNK."
(defun compile-file-pathname* (input-file &rest keys &key output-file &allow-other-keys)
"Variant of COMPILE-FILE-PATHNAME that works well with COMPILE-FILE*"
(let* ((keys
(remove-plist-keys `(#+(and allegro (not (version>= 8 2))) :external-format
(remove-plist-keys `(#+(or (and allegro (not (version>= 8 2))) gcl) :external-format
,@(unless output-file '(:output-file))) keys)))
(if (absolute-pathname-p output-file)
;; what cfp should be doing, w/ mp* instead of mp
......@@ -629,7 +629,7 @@ it will filter them appropriately."
'compile-file* output-file object-file)
(rotatef output-file object-file))
(let* ((keywords (remove-plist-keys
`(:output-file :compile-check :warnings-file
`(:output-file :compile-check :warnings-file #+gcl :external-format
#+clisp :lib-file #+(or ecl mkcl) :object-file) keys))
(output-file
(or output-file
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment