hacking on 0.6.11.5 patches, continued..
..MAKE-HASH-TABLE :TEST #'EQUAL uses 'EQUAL instead.
..tested that PRINT-PRETTY-ON-STREAM? stuff doesn't get
confused on Gray streams
..added test case for new byte compiler bug
..removed extra DUP in patched GENERATE-BYTE-CODE-FOR-SET
new DEFCONSTANT cleanups, as per AL, sbcl-devel, 2001-02-27
Wrapping DEFCONSTANT +EMPTY-HT-SLOT+ in EVAL-WHEN seems to
cause problems, so instead I moved the +EMPTY-HT-SLOT+
definition 'way early in stems-and-flags.lisp-expr.
e.g. UNPROFILE will interact with TRACE and UNTRACE. (This shouldn't
matter, though, unless you are using profiling. If you never
profile anything, TRACE should continue to behave as before.)
+* The fasl file extension may change, perhaps to ".fasl".
\ No newline at end of file
"UNIX-ENVIRONMENT-CMUCL-FROM-SBCL"
"UNIX-ENVIRONMENT-SBCL-FROM-CMUCL"
+ ;; a sort of quasi unbound tag for use in hash tables
+ "+EMPTY-HT-SLOT+"
+
;; not used any more, I think -- WHN 19991206
#+nil
("SERVE-BUTTON-PRESS"
(cond ((and lisp-path-fp c-path-fp)
;; Both still seem valid - choose the lisp frame.
#+nil (when (zerop depth)
- (format t "debug: both still valid ~S ~S ~S ~S~%"
+ (format t
+ "debug: both still valid ~S ~S ~S ~S~%"
lisp-ocfp lisp-ra c-ocfp c-ra))
#+freebsd
(if (sap> lisp-ocfp c-ocfp)
(in-package "SB!IMPL")
-;;; an internal tag for marking empty slots
-;;;
-;;; CMU CL 18b used :EMPTY for this purpose, which was somewhat nasty
-;;; since it's easily accessible to the user, so that e.g.
-;;; (DEFVAR *HT* (MAKE-HASH-TABLE))
-;;; (SETF (GETHASH :EMPTY *HT*) :EMPTY)
-;;; (MAPHASH (LAMBDA (K V) (FORMAT T "~&~S ~S~%" K V)))
-;;; gives no output -- oops!
-;;;
-;;; Note that as of version 0.6.6 there's a dependence in the gencgc.c
-;;; code on this value being a symbol. (This is only one of many nasty
-;;; dependencies between that code and this, alas.)
-(defconstant +empty-ht-slot+ '%empty-ht-slot%)
-;;; KLUDGE: Using a private symbol still leaves us vulnerable to users
-;;; getting nonconforming behavior by messing around with
-;;; DO-ALL-SYMBOLS. That seems like a fairly obscure problem, so for
-;;; now we just don't worry about it. If for some reason it becomes
-;;; worrisome and the magic value needs replacement:
-;;; * The replacement value needs to be LOADable with EQL preserved,
-;;; so that macroexpansion for WITH-HASH-TABLE-ITERATOR will work
-;;; when compiled into a file and loaded back into SBCL.
-;;; (Thus, just uninterning %EMPTY-HT-SLOT% doesn't work.)
-;;; * The replacement value needs to be acceptable to the
-;;; low-level gencgc.lisp hash table scavenging code.
-;;; * The change will break binary compatibility, since comparisons
-;;; against the value used at the time of compilation are wired
-;;; into FASL files.
-;;; -- WHN 20000622
-
;;; HASH-TABLE is implemented as a STRUCTURE-OBJECT.
(sb!xc:defstruct (hash-table (:constructor %make-hash-table))
;; The type of hash table this is. Only used for printing and as
;; hash associated with the key, saving recalculation. Could be
;; useful for EQL, and EQUAL hash tables. This table is not needed
;; for EQ hash tables, and when present the value of #x8000000
- ;; represents EQ-based hashing on the respective Key.
+ ;; represents EQ-based hashing on the respective key.
(hash-vector nil :type (or null (simple-array (unsigned-byte 32) (*)))))
\f
(defmacro-mundanely with-hash-table-iterator ((function hash-table) &body body)
(let ((key (aref kv-vector (* 2 index)))
(value (aref kv-vector (1+ (* 2 index)))))
(incf index)
- (unless (and (eq key '#.+empty-ht-slot+)
- (eq value '#.+empty-ht-slot+))
+ (unless (and (eq key +empty-ht-slot+)
+ (eq value +empty-ht-slot+))
(return (values t key value))))))))
#',function))))
(macrolet ((,function () '(funcall ,n-function)))
(in-package "SB!INT")
\f
+;;;; target constants which need to appear as early as possible
+
+;;; an internal tag for marking empty slots, which needs to be defined
+;;; as early as possible because it appears in macroexpansions for
+;;; iteration over hash tables
+;;;
+;;; CMU CL 18b used :EMPTY for this purpose, which was somewhat nasty
+;;; since it's easily accessible to the user, so that e.g.
+;;; (DEFVAR *HT* (MAKE-HASH-TABLE))
+;;; (SETF (GETHASH :EMPTY *HT*) :EMPTY)
+;;; (MAPHASH (LAMBDA (K V) (FORMAT T "~&~S ~S~%" K V)))
+;;; gives no output -- oops!
+;;;
+;;; FIXME: It'd probably be good to use the unbound marker for this.
+;;; However, there might be some gotchas involving assumptions by
+;;; e.g. AREF that they're not going to return the unbound marker,
+;;; and there's also the noted-below problem that the C-level code
+;;; contains implicit assumptions about this marker.
+;;;
+;;; KLUDGE: Note that as of version 0.6.6 there's a dependence in the
+;;; gencgc.c code on this value being a symbol. (This is only one of
+;;; many nasty dependencies between that code and this, alas.)
+;;; -- WHN 2001-02-28
+(defconstant +empty-ht-slot+ '%empty-ht-slot%)
+;;; KLUDGE: Using a private symbol still leaves us vulnerable to users
+;;; getting nonconforming behavior by messing around with
+;;; DO-ALL-SYMBOLS. That seems like a fairly obscure problem, so for
+;;; now we just don't worry about it. If for some reason it becomes
+;;; worrisome and the magic value needs replacement:
+;;; * The replacement value needs to be LOADable with EQL preserved,
+;;; so that macroexpansion for WITH-HASH-TABLE-ITERATOR will work
+;;; when compiled into a file and loaded back into SBCL.
+;;; (Thus, just uninterning %EMPTY-HT-SLOT% doesn't work.)
+;;; * The replacement value needs to be acceptable to the
+;;; low-level gencgc.lisp hash table scavenging code.
+;;; * The change will break binary compatibility, since comparisons
+;;; against the value used at the time of compilation are wired
+;;; into FASL files.
+;;; -- WHN 20000622
+\f
;;;; DO-related stuff which needs to be visible on the cross-compilation host
(eval-when (:compile-toplevel :load-toplevel :execute)
(cond ((print-pretty-on-stream-p stream)
;; Since we're printing prettily on STREAM, format the
;; object within a logical block. PPRINT-LOGICAL-BLOCK does
- ;; not rebind the stream when it is already a pretty stream
+ ;; not rebind the stream when it is already a pretty stream,
;; so output from the body will go to the same stream.
(pprint-logical-block (stream nil :prefix "#<" :suffix ">")
(print-description)))
(defun output-vector (vector stream)
(declare (vector vector))
(cond ((stringp vector)
- (cond ((or *print-escape* *print-readably*)
- (write-char #\" stream)
- (quote-string vector stream)
- (write-char #\" stream))
- (t
- (write-string vector stream))))
+ (cond ((or *print-escape* *print-readably*)
+ (write-char #\" stream)
+ (quote-string vector stream)
+ (write-char #\" stream))
+ (t
+ (write-string vector stream))))
((not (or *print-array* *print-readably*))
- (output-terse-array vector stream))
+ (output-terse-array vector stream))
((bit-vector-p vector)
- (write-string "#*" stream)
- (dotimes (i (length vector))
- (output-object (aref vector i) stream)))
+ (write-string "#*" stream)
+ (dotimes (i (length vector))
+ (output-object (aref vector i) stream)))
(t
- (when (and *print-readably*
- (not (eq (array-element-type vector) 't)))
- (error 'print-not-readable :object vector))
- (descend-into (stream)
- (write-string "#(" stream)
- (dotimes (i (length vector))
- (unless (zerop i)
- (write-char #\space stream))
- (punt-print-if-too-long i stream)
- (output-object (aref vector i) stream))
- (write-string ")" stream)))))
-
-;;; This function outputs a string quoting characters sufficiently that so
-;;; someone can read it in again. Basically, put a slash in front of an
-;;; character satisfying NEEDS-SLASH-P
+ (when (and *print-readably*
+ (not (eq (array-element-type vector) 't)))
+ (error 'print-not-readable :object vector))
+ (descend-into (stream)
+ (write-string "#(" stream)
+ (dotimes (i (length vector))
+ (unless (zerop i)
+ (write-char #\space stream))
+ (punt-print-if-too-long i stream)
+ (output-object (aref vector i) stream))
+ (write-string ")" stream)))))
+
+;;; This function outputs a string quoting characters sufficiently
+;;; that so someone can read it in again. Basically, put a slash in
+;;; front of an character satisfying NEEDS-SLASH-P.
(defun quote-string (string stream)
(macrolet ((needs-slash-p (char)
;; KLUDGE: We probably should look at the readtable, but just do
,@body))))
;;; Check for stupid typos in FLAGS list keywords.
-(let ((stems (make-hash-table :test #'equal)))
+(let ((stems (make-hash-table :test 'equal)))
(for-stems-and-flags (stem flags)
(if (gethash stem stems)
(error "duplicate stem ~S in stems-and-flags data" stem)
(values (if info
(byte-continuation-info-results info)
0)))
- (unless (eql values 0)
- ;; Someone wants the value, so copy it.
- (output-do-xop segment 'dup))
(etypecase leaf
(global-var
(ecase (global-var-kind leaf)
;; references to the variable before we actually try to set it.
;; (Setting a lexical variable with no refs caused bugs ca. CMU
;; CL 18c, because the compiler deletes such variables.)
- (cond ((leaf-refs leaf)
- (unless (eql values 0)
- ;; Someone wants the value, so copy it.
- (output-do-xop segment 'dup))
- (output-set-lambda-var segment leaf (node-environment set)))
- ;; If no one wants the value, then pop it, else leave it
- ;; for them.
- ((eql values 0)
- (output-byte-with-operand segment byte-pop-n 1)))))
+ (cond ((leaf-refs leaf)
+ (unless (eql values 0)
+ ;; Someone wants the value, so copy it.
+ (output-do-xop segment 'dup))
+ (output-set-lambda-var segment leaf (node-environment set)))
+ ;; If no one wants the value, then pop it, else leave it
+ ;; for them.
+ ((eql values 0)
+ (output-byte-with-operand segment byte-pop-n 1)))))
(unless (eql values 0)
(checked-canonicalize-values segment cont 1)))
(values))
(defun reference-this-var-to-keep-it-alive (node)
node)
-;;; This sets a sb!c::cset node's var to value, returning value. When var is
-;;; local, we have to compare its home environment to the current one, node's
-;;; environment. If they're the same, we check to see whether the var is
-;;; indirect, and store the value on the stack or in the value cell as
-;;; appropriate. Otherwise, var is a closure variable, and since we're
-;;; setting it, we know its location contains an indirect value object.
+;;; This sets a SB!C::CSET node's var to value, returning value. When
+;;; var is local, we have to compare its home environment to the
+;;; current one, node's environment. If they're the same, we check to
+;;; see whether the var is indirect, and store the value on the stack
+;;; or in the value cell as appropriate. Otherwise, var is a closure
+;;; variable, and since we're setting it, we know its location
+;;; contains an indirect value object.
(defun set-leaf-value (node frame-ptr closure value)
(let ((var (sb!c::set-var node)))
(etypecase var
(setf (symbol-value (sb!c::global-var-name var)) value)))))
;;; This does SET-LEAF-VALUE for a LAMBDA-VAR leaf. The debugger tools'
-;;; internals uses this also to set interpreted local variables.
+;;; internals use this also to set interpreted local variables.
(defun set-leaf-value-lambda-var (node var frame-ptr closure value)
;; Note: We avoid trying to set a lexical variable with no refs
;; because the compiler deletes such variables.
(let ((env (sb!c::node-environment node)))
(cond ((not (eq (sb!c::lambda-environment (sb!c::lambda-var-home var))
env))
- (setf (indirect-value
- (svref closure
- (position var (sb!c::environment-closure env)
- :test #'eq)))
- value))
+ (setf (indirect-value
+ (svref closure
+ (position var (sb!c::environment-closure env)
+ :test #'eq)))
+ value))
((sb!c::lambda-var-indirect var)
- (setf (indirect-value
- (eval-stack-local frame-ptr (sb!c::lambda-var-info var)))
- value))
+ (setf (indirect-value
+ (eval-stack-local frame-ptr (sb!c::lambda-var-info var)))
+ value))
(t
- (setf (eval-stack-local frame-ptr (sb!c::lambda-var-info var))
- value))))))
+ (setf (eval-stack-local frame-ptr (sb!c::lambda-var-info var))
+ value))))))
-;;; This figures out how to return a value for a ref node. Leaf is the ref's
-;;; structure that tells us about the value, and it is one of the following
-;;; types:
+;;; This figures out how to return a value for a ref node. LEAF is the
+;;; ref's structure that tells us about the value, and it is one of
+;;; the following types:
;;; constant -- It knows its own value.
;;; global-var -- It's either a value or function reference. Get it right.
;;; local-var -- This may on the stack or in the current closure, the
(indirect-value temp)
temp)))
-;;; This computes a closure for a local call and for returned call'able closure
-;;; objects. Sometimes the closure is a simple-vector of no elements. Node
-;;; is either a reference node or a combination node. Leaf is either the leaf
-;;; of the reference node or the lambda to internally apply for the combination
-;;; node. Frame-ptr is the current frame pointer for fetching current values
-;;; to store in the closure. Closure is the current closure, the currently
-;;; interpreting lambda's closed over environment.
-;;;
-;;; A computed closure is a vector corresponding to the list of closure
-;;; variables described in an environment. The position of a lambda-var in
-;;; this closure list is the index into the closure vector of values.
+;;; Compute a closure for a local call and for returned call'able
+;;; closure objects. Sometimes the closure is a SIMPLE-VECTOR of no
+;;; elements. NODE is either a reference node or a combination node.
+;;; LEAF is either the leaf of the reference node or the lambda to
+;;; internally apply for the combination node. FRAME-PTR is the
+;;; current frame pointer for fetching current values to store in the
+;;; closure. CLOSURE is the current closure, the closed-over
+;;; environment of the currently interpreting LAMBDA.
;;;
-;;; Functional-env is the environment description for leaf, the lambda for
-;;; which we're computing a closure. This environment describes which of
-;;; lambda's vars we find in lambda's closure when it's running, versus finding
-;;; them on the stack. For each lambda-var in the functional environment's
-;;; closure list, if the lambda-var's home environment is the current
-;;; environment, then get a value off the stack and store it in the closure
-;;; we're computing. Otherwise that lambda-var's value comes from somewhere
-;;; else, but we have it in our current closure, the environment we're running
-;;; in as we compute this new closure. Find this value the same way we do in
-;;; LEAF-VALUE, by finding the lambda-var's position in the current
-;;; environment's description of the current closure.
+;;; A computed closure is a vector corresponding to the list of
+;;; closure variables described in an environment. The position of a
+;;; lambda-var in this closure list is the index into the closure
+;;; vector of values.
(defun compute-closure (node leaf frame-ptr closure)
(let* ((current-env (sb!c::node-environment node))
(current-closure-vars (sb!c::environment-closure current-env))
+ ;; FUNCTIONAL-ENV is the environment description for leaf,
+ ;; the lambda for which we're computing a closure. This
+ ;; environment describes which of lambda's vars we find in
+ ;; lambda's closure when it's running, versus finding them on
+ ;; the stack.
(functional-env (sb!c::lambda-environment leaf))
(functional-closure-vars (sb!c::environment-closure functional-env))
(functional-closure (make-array (length functional-closure-vars))))
+ ;; For each lambda-var VAR in the functional environment's closure
+ ;; list, if the VAR's home environment is the current environment,
+ ;; then get a value off the stack and store it in the closure
+ ;; we're computing. Otherwise VAR's value comes from somewhere
+ ;; else, but we have it in our current closure, the environment
+ ;; we're running in as we compute this new closure. Find this
+ ;; value the same way we do in LEAF-VALUE, by finding VAR's
+ ;; position in the current environment's description of the
+ ;; current closure.
(do ((vars functional-closure-vars (cdr vars))
(i 0 (1+ i)))
((null vars))
(sb!c::nlx-info-cleanup ele))
(sb!c::lambda-eval-info-entries
(sb!c::lambda-info
- ;; lambda INTERNAL-APPLY-LOOP tosses around.
+ ;; the lambda INTERNAL-APPLY-LOOP tosses around
(sb!c::environment-function
(sb!c::node-environment node))))))))
(svref closure
:test #'eq))))))))
functional-closure))
-;;; INTERNAL-APPLY uses this to invoke a function from the interpreter's stack
-;;; on some arguments also taken from the stack. When tail-p is non-nil,
-;;; control does not return to INTERNAL-APPLY to further interpret the current
-;;; IR1 lambda, so INTERNAL-INVOKE must clean up the current interpreter's
-;;; stack frame.
+;;; INTERNAL-APPLY uses this to invoke a function from the
+;;; interpreter's stack on some arguments also taken from the stack.
+;;; When tail-p is non-nil, control does not return to INTERNAL-APPLY
+;;; to further interpret the current IR1 lambda, so INTERNAL-INVOKE
+;;; must clean up the current interpreter's stack frame.
(defun internal-invoke (arg-count &optional tailp)
(let ((args (eval-stack-args arg-count)) ;LET says this init form runs first.
(fun (eval-stack-pop)))
(format t "(~S~{ ~S~})~%" fun args))
(apply fun args)))
-;;; Almost just like INTERNAL-INVOKE. We call MV-EVAL-STACK-ARGS, and our
-;;; function is in a list on the stack instead of simply on the stack.
+;;; This is almost just like INTERNAL-INVOKE. We call
+;;; MV-EVAL-STACK-ARGS, and our function is in a list on the stack
+;;; instead of simply on the stack.
(defun mv-internal-invoke (arg-count &optional tailp)
(let ((args (mv-eval-stack-args arg-count)) ;LET runs this init form first.
(fun (car (eval-stack-pop))))
(format t "(~S~{ ~S~})~%" fun args))
(apply fun args)))
-;;; This returns a list of the top arg-count elements on the interpreter's
+;;; Return a list of the top arg-count elements on the interpreter's
;;; stack. This removes them from the stack.
(defun eval-stack-args (arg-count)
(let ((args nil))
(dotimes (i arg-count args)
(push (eval-stack-pop) args))))
-;;; This assumes the top count elements on interpreter's stack are lists. This
-;;; returns a single list with all the elements from these lists.
+;;; This assumes the top count elements on interpreter's stack are
+;;; lists. This returns a single list with all the elements from these
+;;; lists.
(defun mv-eval-stack-args (count)
(if (= count 1)
(eval-stack-pop)
;;; the main types. These types are represented by the low three bits
;;; of the pointer or immediate object.
(eval-when (:compile-toplevel :load-toplevel :execute)
+ ;; The EVAL-WHEN is necessary (at least for Lispworks), because the
+ ;; second DEFENUM uses the value of OTHER-IMMEDIATE-0-TYPE, which is
+ ;; defined in the first DEFENUM. -- AL 20000216
(defenum (:suffix -type)
even-fixnum
function-pointer
;;; processed with MAKE-LOAD-FORM. We have to be careful, because
;;; CONSTANT might be circular. We also check that the constant (and
;;; any subparts) are dumpable at all.
-(defconstant list-to-hash-table-threshold 32)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ ;; The EVAL-WHEN is necessary for #.(1+ LIST-TO-HASH-TABLE-THRESHOLD)
+ ;; below. -- AL 20010227
+ (defconstant list-to-hash-table-threshold 32))
(defun maybe-emit-make-load-forms (constant)
(let ((things-processed nil)
(count 0))
;;;; generation of emit functions
(eval-when (:compile-toplevel :load-toplevel :execute)
+ ;; We need the EVAL-WHEN because %EMIT-GENERIC-VOP (below)
+ ;; uses #.MAX-VOP-TN-REFS, not just MAX-VOP-TN-REFS.
+ ;; -- AL 20010218
(defconstant max-vop-tn-refs 256))
(defvar *vop-tn-refs* (make-array max-vop-tn-refs :initial-element nil))
(let ((offset-sym (symbolicate name "-OFFSET"))
(names-vector (symbolicate "*" size "-REGISTER-NAMES*")))
`(progn
- (defconstant ,offset-sym ,offset)
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ ;; EVAL-WHEN is necessary because stuff like #.EAX-OFFSET
+ ;; (in the same file) depends on compile-time evaluation
+ ;; of the DEFCONSTANT. -- AL 20010224
+ (defconstant ,offset-sym ,offset))
(setf (svref ,names-vector ,offset-sym)
,(symbol-name name)))))
;; FIXME: It looks to me as though DEFREGSET should also
(defvar *note-iis-entry-p* nil)
(defvar *compiled-initialize-instance-simple-functions*
- (make-hash-table :test #'equal))
+ (make-hash-table :test 'equal))
(defun initialize-instance-simple-function (use info class form-list)
(let* ((pv-cell (get-pv-cell-for-class class))
* the hash table code reserves for marking empty slots. */
scavenge(where+3, 1);
if (!Pointerp(where[3])) {
- lose("not #:%EMPTY-HT-SLOT% symbol pointer: %x", where[3]);
+ lose("not empty-hash-table-slot symbol pointer: %x", where[3]);
}
empty_symbol = where[3];
/* fprintf(stderr,"* empty_symbol = %x\n", empty_symbol);*/
if (TypeOf(*(lispobj *)PTR(empty_symbol)) != type_SymbolHeader) {
- lose("not a symbol where #:%EMPTY-HT-SLOT% expected: %x",
+ lose("not a symbol where empty-hash-table-slot symbol expected: %x",
*(lispobj *)PTR(empty_symbol));
}
--- /dev/null
+;;;; miscellaneous tests of compiling toplevel forms
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
+(in-package :cl-user)
+
+;;; Exercise a compiler bug (by causing a call to ERROR).
+;;;
+;;; This bug was in sbcl-0.6.11.6.
+(let ((a 1) (b 1))
+ (declare (type (mod 1000) a b))
+ (let ((tmp (= 10 (+ (incf a) (incf a) (incf b) (incf b)))))
+ (or tmp (error "TMP not true"))))
(assert (null (fresh-line our-char-output)))
(write-char #\c our-char-output)))
(format nil "a ~%b~%c")))
+
+;;; Patches introduced in sbcl-0.6.11.5 made the pretty-print logic
+;;; test not only *PRINT-PRETTY* but also PRETTY-STREAM-P in some
+;;; cases. Try to verify that we don't end up doing tests like that on
+;;; bare Gray streams and thus bogusly omitting pretty-printing
+;;; operations.
+(flet ((frob ()
+ (with-output-to-string (string)
+ (let ((gray-output-stream (make-character-output-stream string)))
+ (format gray-output-stream
+ "~@<testing: ~@:_pretty Gray line breaks~:>~%")))))
+ (assert (= 1 (count #\newline (let ((*print-pretty* nil)) (frob)))))
+ (assert (= 2 (count #\newline (let ((*print-pretty* t)) (frob))))))
\f
;;;; example classes for binary output
# more information.
# how we invoke SBCL
-sbcl=${1:-../src/runtime/sbcl --core ../output/sbcl.core --noinform --noprint --noprogrammer}
+sbcl=${1:-../src/runtime/sbcl --core ../output/sbcl.core --noinform --sysinit /dev/null --userinit /dev/null --noprint --noprogrammer}
# "Ten four" is the closest numerical slang I can find to "OK", so
# it's the Unix status value that we expect from a successful test.
fi
done
+# *.pure-cload.lisp files want to be compiled, then loaded. They
+# can all be done in the same invocation of Lisp.
+echo //running '*.pure-cload.lisp' tests
+for f in *.pure-cload.lisp; do
+ if [ -f $f ]; then
+ echo //running $f test
+ $sbcl <<EOF ; tenfour
+ (compile-file "$f")
+ (progn (load *) (sb-ext:quit :unix-status 104))
+EOF
+ fi
+done
+
echo '//apparent success (reached end of run-tests.sh normally)'
;;; versions, and a string like "0.6.5.12" is used for versions which
;;; aren't released but correspond only to CVS tags or snapshots.
-"0.6.11.6"
+"0.6.11.7"