Merge branch 'main' of github.com:clasp-developers/clasp

src/core/bytecode.cc

@@ -781,7 +781,10 @@ bytecode_vm(VirtualMachine& vm, T_O** literals, T_O** closed, Closure_O* closure
         return result;
       });
       if (thrown) pc = target;
-      else pc = vm._pc;
+      else {
+        pc = vm._pc;
+        sp = vm._stackPointer;
+      }
       break;
     }
     case vm_catch_16: {
@@ -798,7 +801,10 @@ bytecode_vm(VirtualMachine& vm, T_O** literals, T_O** closed, Closure_O* closure
         return result;
       });
       if (thrown) pc = target;
-      else pc = vm._pc;
+      else {
+        pc = vm._pc;
+        sp = vm._stackPointer;
+      }
       break;
     }
     case vm_throw: {

src/core/numbers.cc

@@ -2556,13 +2556,13 @@ Number_sp clasp_atan1(Number_sp y) {
   }
 }
 
-CL_LAMBDA(x &optional y);
+CL_LAMBDA(x &optional (y nil yp));
 CL_DECLARE();
 CL_UNWIND_COOP(true);
 CL_DOCSTRING(R"dx(atan)dx");
 DOCGROUP(clasp);
-CL_DEFUN Number_sp cl__atan(Number_sp x, T_sp y) {
-  if (y.nilp())
+CL_DEFUN Number_sp cl__atan(Number_sp x, T_sp y, bool yp) {
+  if (!yp)
     return clasp_atan1(x);
 
   if (gctools::IsA<Number_sp>(y))

src/lisp/kernel/cleavir/packages.lisp

@@ -81,7 +81,7 @@
 
 (defpackage #:clasp-cleavir-bmir
   (:nicknames #:cc-bmir)
-  (:shadow #:characterp #:consp #:load #:variable)
+  (:shadow #:characterp #:consp #:load #:variable #:load-time-value)
   (:local-nicknames (#:bir #:cleavir-bir))
   (:export #:fixnump #:characterp #:consp #:single-float-p #:generalp
            #:headerq #:info)

src/lisp/kernel/clos/conditions.lisp

@@ -1281,9 +1281,9 @@ The conflict resolver must be one of ~s" chosen-symbol candidates))
 			   for value in values
 			   collect (assert-prompt place-name value)))))))
 
-(define-condition step () ())
+(define-condition step-condition () ())
 
-(define-condition clasp-debug:step-form (step)
+(define-condition clasp-debug:step-form (step-condition)
   ((%source :initarg :source :reader source))
   (:report (lambda (condition stream)
              (format stream "Evaluating form: ~s" (source condition)))))

src/lisp/kernel/cmp/opt/opt-sequence.lisp

@@ -167,13 +167,22 @@
                      ;; types we kind of just give up.
                      ;; MAKE-SEQUENCE handles any length check.
                      ;; TODO: Call SEQUENCE:MAP for user sequence types, maybe.
-                     (let ((ssyms (gensym-list sequences "SEQUENCE")))
+                     (let* ((ssyms (gensym-list sequences "SEQUENCE"))
+                            (result (gensym "RESULT"))
+                            (result-form `(core::map-into-sequence
+                                           (make-sequence ',type
+                                                          (min ,@(loop for ssym in ssyms
+                                                                       collect `(length ,ssym))))
+                                           ,function ,@ssyms)))
                        `(let (,@(mapcar #'list ssyms sequences))
-                          (core::map-into-sequence
-                           (make-sequence ',type
-                                          (min ,@(loop for ssym in ssyms
-                                                       collect `(length ,ssym))))
-                           ,function ,@ssyms))))))))
+                          ,(if (consp type)
+                               `(let ((,result ,result-form))
+                                  (if (typep ,result ',type)
+                                      ,result
+                                      (error 'type-error
+                                             :datum ,result
+                                             :expected-type ',type)))
+                               result-form))))))))
       form))
 
 ;;;

src/lisp/kernel/lsp/seq.lisp

@@ -435,12 +435,19 @@ SEQUENCEs, where K is the minimum length of the given SEQUENCEs."
                       (error-sequence-length result result-type l))))
                 result)
               ;; ditto note in CONCATENATE above
-              (let ((length
-                      (reduce #'min more-sequences
-                              :initial-value (length sequence)
-                              :key #'length)))
-                (apply #'map-into (make-sequence result-type length)
-                       function sequence more-sequences))))
+              (let ((result
+                      (apply #'map-into
+                             (make-sequence result-type
+                                            (reduce #'min more-sequences
+                                                    :initial-value (length sequence)
+                                                    :key #'length))
+                             function sequence more-sequences)))
+                (if (or (not (consp result-type))
+                        (typep result result-type))
+                    result
+                    (error 'type-error
+                           :datum result
+                           :expected-type result-type)))))
         (apply #'map-for-effect function sequence more-sequences))))
 
 (defun map-to-list (function &rest sequences)

src/lisp/regression-tests/misc.lisp

@@ -316,3 +316,8 @@
           (declare (ignorable #'macro-function-shadowing.f))
           (e (macro-function-shadowing.f))))
       ((macro-function-shadowing.f)))
+
+;;; This returned junk due to my VM mistake and caused me no end of grief.
+(test single-value-catch
+      (let ((c (catch 'foo 4))) c)
+      (4))

tools-for-build/ansi-test-expected-failures.sexp

@@ -43,8 +43,6 @@ CALL-NEXT-METHOD.ERROR.2
 DEFMETHOD.ERROR.14
 DEFMETHOD.ERROR.15
 UPGRADED-ARRAY-ELEMENT-TYPE.8
-ATAN.ERROR.5
-MAP.ERROR.11
 TYPE-OF.1
 TYPE-OF.4
 COMPILE-FILE.2
@@ -66,7 +64,6 @@ DEFCLASS.FORWARD-REF.3
 #-bytecode BUTLAST.FOLD.3
 DEFSTRUCT.ERROR.3
 DEFSTRUCT.ERROR.4
-ALL-EXPORTED-CL-CLASS-NAMES-ARE-VALID
 FORMAT.E.26
 
 DEFINE-METHOD-COMBINATION-LONG.05.2