From: Jim A. <ja...@us...> - 2006-07-10 00:45:42
|
Update of /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv12367 Modified Files: boot.lisp special.lisp system.lisp tli-util.lisp Log Message: CLISP loop no longer allows both a never and a thereis clause within a single loop, so I worked around that. Cleaned up the finalize-pathname stuff, which appeared to be no longer needed. Cleaned up a couple of spots where the port to SBCL had broken the CLISP port due to SBCL-specific package names. Index: boot.lisp =================================================================== RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/boot.lisp,v retrieving revision 1.28 retrieving revision 1.29 diff -C2 -r1.28 -r1.29 *** boot.lisp 23 Aug 2005 00:21:01 -0000 1.28 --- boot.lisp 10 Jul 2006 00:45:40 -0000 1.29 *************** *** 242,250 **** (defun finalize-pathname (pathname) - ; #+allegro - ; (merge-pathnames pathname) - ; #-allegro - ; (format t "~&finalize: p: ~S d: ~S m: ~S" pathname *default-pathname-defaults* (merge-pathnames pathname)) - #+sbcl (merge-pathnames pathname)) --- 242,245 ---- Index: special.lisp =================================================================== RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/special.lisp,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -r1.11 -r1.12 *** special.lisp 2 Jul 2001 02:04:13 -0000 1.11 --- special.lisp 10 Jul 2006 00:45:40 -0000 1.12 *************** *** 1035,1043 **** ;;; The walker for `tl:progn' is a simple as they get (though I got it wrong the ! ;;; first time by expanding into a let, not a tl:let -jra 11/9/95). (def-special-form-walker tl:progn (form env walker required-type) `(tl:progn ,@(walk-progn-body (cons-cdr form) env walker required-type))) --- 1035,1051 ---- ;;; The walker for `tl:progn' is a simple as they get (though I got it wrong the ! ;;; first time by expanding into a let, not a tl:let -jra 11/9/95). Also add a ! ;;; walker for the Lisp symbol progn, since it occasionally slips into ! ;;; translated forms. (def-special-form-walker tl:progn (form env walker required-type) `(tl:progn ,@(walk-progn-body (cons-cdr form) env walker required-type))) + (tl:declaim (special-form progn)) + + (def-special-form-walker progn (form env walker required-type) + `(tl:progn ,@(walk-progn-body (cons-cdr form) env walker required-type))) + + *************** *** 1182,1187 **** (return (loop for subform = (car subform-cons) while subform-cons ! never (atom subform) ! thereis (equal subform '(tl:go tl::next-loop)) do (setf subform-cons (cons-cdr subform-cons)))))) --- 1190,1195 ---- (return (loop for subform = (car subform-cons) while subform-cons ! thereis (and (consp subform) ! (equal subform '(tl:go tl::next-loop))) do (setf subform-cons (cons-cdr subform-cons)))))) *************** *** 1777,1781 **** ! ;;; The numeric operations `+' and `*' have to be done as speical forms in TL in ;;; order to allow the use of lisp:+ and lisp:* within the read-eval-print loop ;;; of the Lisp development environment. The implementations of the walkers for --- 1785,1789 ---- ! ;;; The numeric operations `+' and `*' have to be done as special forms in TL in ;;; order to allow the use of lisp:+ and lisp:* within the read-eval-print loop ;;; of the Lisp development environment. The implementations of the walkers for *************** *** 1801,1804 **** --- 1809,1815 ---- + + + ;;;; C Comments Index: system.lisp =================================================================== RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/system.lisp,v retrieving revision 1.20 retrieving revision 1.21 diff -C2 -r1.20 -r1.21 *** system.lisp 23 Aug 2005 00:21:01 -0000 1.20 --- system.lisp 10 Jul 2006 00:45:40 -0000 1.21 *************** *** 263,309 **** ',name))) ! (defun make-new-system ! (name nicknames library main-function used-systems lisp-dir c-dir ! extra-c-files extra-h-files modules alias properties) ! (flet ((finalize-pathname (pathname) ! ; #+allegro ! ; (merge-pathnames pathname) ! ; #-allegro ! ; (format t "~&finalize: p: ~S d: ~S m: ~S" pathname *default-pathname-defaults* (merge-pathnames pathname)) ! #+sbcl ! (merge-pathnames pathname))) ! (make-system ! :name name ! :nicknames nicknames ! :is-library-p library ! :main-function main-function ! :used-systems used-systems ! :lisp-dir (finalize-pathname ! (if lisp-dir ! (pathname lisp-dir) ! (make-pathname ! :directory ! (list :relative ! (string-downcase (symbol-name name)) ! "lisp")))) ! :c-dir (finalize-pathname ! (if c-dir ! (pathname c-dir) ! (make-pathname ! :directory ! (list :relative ! (string-downcase (symbol-name name)) ! "c")))) ! :extra-c-files extra-c-files ! :extra-h-files extra-h-files ! :modules (loop for mod in modules ! collect (if (consp mod) ! (cons-car mod) ! mod)) ! :module-properties-alist (loop for mod in modules ! when (consp mod) ! collect mod) ! :alias alias ! :properties properties))) --- 263,301 ---- ',name))) ! (defun make-new-system (name nicknames library main-function used-systems ! lisp-dir c-dir extra-c-files extra-h-files ! modules alias properties) ! (make-system ! :name name ! :nicknames nicknames ! :is-library-p library ! :main-function main-function ! :used-systems used-systems ! :lisp-dir (merge-pathnames ! (if lisp-dir ! (pathname lisp-dir) ! (make-pathname :directory ! (list :relative ! (string-downcase (symbol-name name)) ! "lisp")))) ! :c-dir (merge-pathnames ! (if c-dir ! (pathname c-dir) ! (make-pathname ! :directory ! (list :relative ! (string-downcase (symbol-name name)) ! "c")))) ! :extra-c-files extra-c-files ! :extra-h-files extra-h-files ! :modules (loop for mod in modules ! collect (if (consp mod) ! (cons-car mod) ! mod)) ! :module-properties-alist (loop for mod in modules ! when (consp mod) ! collect mod) ! :alias alias ! :properties properties)) Index: tli-util.lisp =================================================================== RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/tli-util.lisp,v retrieving revision 1.19 retrieving revision 1.20 diff -C2 -r1.19 -r1.20 *** tli-util.lisp 23 Aug 2005 00:21:01 -0000 1.19 --- tli-util.lisp 10 Jul 2006 00:45:40 -0000 1.20 *************** *** 922,929 **** #+sbcl(eval-when (:compile-toplevel) (warn "In port to SBCL with-common-lisp-unlocked is not well thought thru.")) ! (defmacro with-common-lisp-unlocked (() &body body) ! `(#+sbcl sb-ext:with-unlocked-packages #+sbcl ("COMMON-LISP") ! #-sbcl progn ! ,@body)) ;;; The Lucid we are currently using does not support declaim, so we have a --- 922,929 ---- #+sbcl(eval-when (:compile-toplevel) (warn "In port to SBCL with-common-lisp-unlocked is not well thought thru.")) ! (defmacro with-common-lisp-unlocked (ignored &body body) ! (declare (ignore ignored)) ! #+sbcl `(sb-ext:with-unlocked-packages ("COMMON-LISP") ,@body) ! #-sbcl `(progn ,@body)) ;;; The Lucid we are currently using does not support declaim, so we have a *************** *** 984,989 **** ;;; The function `gc-a-little' will invoke the ephemeral garbage collector on ;;; the most transient levels of garbage. This should be called at top levels ! ;;; of large processes when it is expected that most of the recent created data ! ;;; will be garbage, for example inbetween module translations. (defun gc-a-little () --- 984,989 ---- ;;; The function `gc-a-little' will invoke the ephemeral garbage collector on ;;; the most transient levels of garbage. This should be called at top levels ! ;;; of large processes when it is expected that most of the recently created ! ;;; data will be garbage, for example in between module translations. (defun gc-a-little () |