diff --git a/quicklisp/bundle.lisp b/quicklisp/bundle.lisp index bff9086..282444d 100644 --- a/quicklisp/bundle.lisp +++ b/quicklisp/bundle.lisp @@ -202,8 +202,12 @@ (defmethod write-loader-script ((bundle bundle) stream) (let ((template-lines - (load-time-value - (with-open-file (stream #. (merge-pathnames "bundle-template" + (load-time-value + ;; On Genera, the semantics of Unix pathnames cause merging a filename with + ;; no type against defaults with a type to leave the type as :UNSPECIFIC. + ;; So, explicitly provide the type here to avoid that problem. (I'm not + ;; sure what would happen if I were to change that behavior. --Palter) + (with-open-file (stream #. (merge-pathnames "bundle-template.lisp" (or *compile-file-truename* *load-truename*))) (loop for line = (read-line stream nil) diff --git a/quicklisp/http.lisp b/quicklisp/http.lisp index d942fb8..074b946 100644 --- a/quicklisp/http.lisp +++ b/quicklisp/http.lisp @@ -24,6 +24,8 @@ 13) ((eql char :lf) 10) + ((eql char :tab) + 9) (t (let ((code (char-code char))) (if (<= 0 code 127) @@ -32,7 +34,7 @@ char)))))) (defvar *whitespace* - (list (acode #\Space) (acode #\Tab) (acode :cr) (acode :lf))) + (list (acode #\Space) (acode :tab) (acode :cr) (acode :lf))) (defun whitep (code) (member code *whitespace*)) @@ -74,6 +76,7 @@ (ecase key (:cr 13) (:lf 10) + (:tab 9) ((t) t))))) (if (consp keys) keys (list keys))))) `(case ,value @@ -550,7 +553,7 @@ the indexes in the header accordingly." (return-from process-header header)) (in-new-line (code) (acase code - ((#\Tab #\Space) (setf mark nil) #'in-value) + ((:tab #\Space) (setf mark nil) #'in-value) (t (when mark (save mark value-ends)) @@ -569,7 +572,7 @@ the indexes in the header accordingly." #'in-value) ((:cr :lf) (finish)) - ((#\Tab #\Space) + ((:tab #\Space) (error "Unexpected whitespace in header field name")) (t (unless (<= 0 code 127) diff --git a/quicklisp/impl-util.lisp b/quicklisp/impl-util.lisp index 9aab147..e8a58ed 100644 --- a/quicklisp/impl-util.lisp +++ b/quicklisp/impl-util.lisp @@ -80,6 +80,8 @@ ".cmucl-init.lisp") (:implementation scl ".scl-init.lisp") + (:implementation genera + "lispm-init.lisp") ) (defun init-file-name-for (&optional implementation-designator) @@ -174,7 +176,9 @@ quicklisp at CL startup." (:implementation t (file-write-date pathname)) (:implementation clisp - (nth-value 2 (ql-clisp:probe-pathname pathname)))) + (nth-value 2 (ql-clisp:probe-pathname pathname))) + (:implementation genera + (file-write-date (ql-genera:send pathname :directory-pathname-as-file)))) ;;; @@ -195,7 +199,12 @@ quicklisp at CL startup." (:implementation allegro (ql-allegro:file-directory-p entry :follow-symbolic-links nil)) (:implementation lispworks - (ql-lispworks:file-directory-p entry))) + (ql-lispworks:file-directory-p entry)) + (:implementation genera + (let ((path (if (call-next-method) + (scl:send entry :directory-pathname-as-file) + entry))) + (getf (cdr (ql-genera:file-properties path)) ':directory)))) (definterface directory-entries (directory) (:documentation "Return all directory entries of DIRECTORY as a @@ -247,6 +256,13 @@ quicklisp at CL startup." #+ecl :resolve-symlinks #+ecl nil) (directory (merge-pathnames *wild-relative* directory) #+ecl :resolve-symlinks #+ecl nil))) + (:implementation genera + (let ((entries (ql-genera:directory-list (merge-pathnames *wild-entry* directory)))) + (loop for (pathname . properties) in (cdr entries) + if (getf properties ':directory) + collect (scl:send pathname :pathname-as-directory) + else + collect pathname))) (:implementation mezzano (directory (merge-pathnames *wild-entry* directory))) (:implementation mkcl @@ -284,6 +300,8 @@ quicklisp at CL startup." (ql-scl:unix-rmdir (ql-scl:unix-namestring entry))) (:implementation ecl (ql-ecl:rmdir entry)) + (:implementation genera + (ql-genera:delete-directory entry :confirm nil)) (:implementation mkcl (ql-mkcl:rmdir entry)) (:implementation lispworks diff --git a/quicklisp/impl.lisp b/quicklisp/impl.lisp index a26f598..1d1a2ce 100644 --- a/quicklisp/impl.lisp +++ b/quicklisp/impl.lisp @@ -307,3 +307,17 @@ #:host-ent-address #:socket-connect #:socket-make-stream)) + +;;; Genera + +(define-implementation-package :genera #:ql-genera + (:documentation "Genera - https://github.com/SymbolicsGenera/IssuesAndWiki") + (:class genera) + (:reexport-from #:scl + #:send) + (:reexport-from #:fs + #:delete-directory + #:directory-list + #:file-properties) + (:reexport-from #:tcp + #:open-tcp-stream)) diff --git a/quicklisp/network.lisp b/quicklisp/network.lisp index a6d87df..d75231f 100644 --- a/quicklisp/network.lisp +++ b/quicklisp/network.lisp @@ -98,7 +98,9 @@ :element-type '(unsigned-byte 8) :input t :output t - :buffering :full)))) + :buffering :full))) + (:implementation genera + (ql-genera:open-tcp-stream host port nil :direction :io :characters nil))) (definterface read-octets (buffer connection) (:documentation "Read from CONNECTION into BUFFER. Returns the diff --git a/quicklisp/package.lisp b/quicklisp/package.lisp index f0346e6..5140597 100644 --- a/quicklisp/package.lisp +++ b/quicklisp/package.lisp @@ -52,6 +52,7 @@ #:cormanlisp #:ecl #:gcl + #:genera #:lispworks #:mezzano #:mkcl diff --git a/quicklisp/setup.lisp b/quicklisp/setup.lisp index edbd4c6..7a9223c 100644 --- a/quicklisp/setup.lisp +++ b/quicklisp/setup.lisp @@ -5,8 +5,10 @@ (*print-pretty* t) (*print-escape* nil) (prefix (make-string indent :initial-element #\Space))) - (pprint-logical-block (nil words :per-line-prefix prefix) - (pprint-fill *standard-output* (sort (copy-seq words) #'string<) nil)) + ;; Genera doesn't implement pprint-logical-block et al... + #-genera (pprint-logical-block (nil words :per-line-prefix prefix) + (pprint-fill *standard-output* (sort (copy-seq words) #'string<) nil)) + #+genera (format *standard-output* "~&~A~{~S ~}~%" prefix (sort (copy-seq words) #'string<)) (fresh-line) (finish-output))) @@ -87,7 +89,7 @@ :quicklisp-systems (remove-duplicates quicklisp-systems)))) (defun show-load-strategy (strategy) - (format t "To load ~S:~%" (name strategy)) + (format t "~&To load ~S:~%" (name strategy)) (let ((asdf-systems (asdf-systems strategy)) (releases (quicklisp-releases strategy))) (when asdf-systems