From 3555a009f6d8734751bda1feadc8a09e7b0099b6 Mon Sep 17 00:00:00 2001 From: "Tarn W. Burton" Date: Thu, 17 Oct 2024 14:38:34 -0400 Subject: [PATCH] Remove static-vectors --- common-lisp-jupyter.asd | 4 +- src/heartbeat.lisp | 25 +++++----- src/kernel.lisp | 90 ------------------------------------ src/message.lisp | 8 ++-- src/utils.lisp | 90 ++++++++++++++++++++++++++++++++++++ src/widgets/trait-types.lisp | 4 +- 6 files changed, 111 insertions(+), 110 deletions(-) diff --git a/common-lisp-jupyter.asd b/common-lisp-jupyter.asd index 8186f18f..dbbc6114 100644 --- a/common-lisp-jupyter.asd +++ b/common-lisp-jupyter.asd @@ -21,9 +21,9 @@ "pzmq" "puri" "shasht" - (:feature (:or :abcl :allegro :ccl :clasp :cmu :ecl :lispworks :sbcl) "static-vectors") + #+(or)(:feature (:or :abcl :allegro :ccl :clasp :cmu :ecl :lispworks :sbcl) "static-vectors") "trivial-do" - "trivial-garbage" + #+(or)"trivial-garbage" "trivial-mimes" "trivial-features") :components diff --git a/src/heartbeat.lisp b/src/heartbeat.lisp index 2c2d2e51..e98c9cbf 100644 --- a/src/heartbeat.lisp +++ b/src/heartbeat.lisp @@ -15,15 +15,16 @@ (with-slots (socket thread) hb (setf thread (bordeaux-threads:make-thread - (lambda () - (inform :info hb "Starting thread") - #-cmucl (pzmq:proxy socket socket (cffi:null-pointer)) - #+cmucl - (pzmq:with-poll-items items ((socket :pollin)) - (prog () - poll - (unless (zerop (pzmq:poll items +zmq-poll-timeout+)) - (send-heartbeat hb (recv-heartbeat hb))) - (bordeaux-threads:thread-yield) - (go poll)))) - :name "Jupyter Heartbeat")))) + (lambda () + (with-debugger (:control t) + (inform :info hb "Starting thread") + #-cmucl (pzmq:proxy socket socket (cffi:null-pointer)) + #+cmucl + (pzmq:with-poll-items items ((socket :pollin)) + (prog () + poll + (unless (zerop (pzmq:poll items +zmq-poll-timeout+)) + (send-heartbeat hb (recv-heartbeat hb))) + (bordeaux-threads:thread-yield) + (go poll))))) + :name "Jupyter Heartbeat")))) diff --git a/src/kernel.lisp b/src/kernel.lisp index 4c1b78ef..775bf90b 100644 --- a/src/kernel.lisp +++ b/src/kernel.lisp @@ -672,96 +672,6 @@ (values)))) -(defun control-debugger-hook (condition me-or-my-encapsulation) - (declare (ignore me-or-my-encapsulation)) - (cond ((typep condition 'warning) - (inform :warning "[~S] ~A~%" (type-of condition) condition) - (muffle-warning)) - (t - (inform :error "[~S] ~A~%" (type-of condition) condition) - (abort)))) - -(defun shell-debugger-hook (condition me-or-my-encapsulation) - (declare (ignore me-or-my-encapsulation)) - (cond ((typep condition 'warning) - (format *standard-output* "[~S] ~A~%" (type-of condition) condition) - (finish-output *standard-output*) - (muffle-warning)) - (t - (let ((env (dissect:capture-environment condition))) - (format *error-output* "[~S] ~A~%" (type-of condition) condition) - (finish-output *error-output*) - (throw 'debug-error - (make-eval-error condition (format nil "~A" condition) - (mapcar (lambda (frame) - (dissect:present frame nil)) - (dissect:environment-stack env)))))))) - -(defun debugger-type () - (cond ((or (not *enable-debugger*) - #+clasp (core:debugger-disabled-p) - #+sbcl (eq sb-ext:*invoke-debugger-hook* 'sb-debug::debugger-disabled-hook)) - :none) - #+abcl - (sys::*invoke-debugger-hook* :external) - #+allegro - (excl::*break-hook* :external) - #+ccl - (ccl:*break-hook* :external) - #+clisp - (sys::*break-driver* :external) - #+clasp - (ext:*invoke-debugger-hook* :external) - #+ecl - (ext:*invoke-debugger-hook* :external) - #+lispworks - (dbg::*debugger-wrapper-list* :external) - #+mezzano - (mezzano.debug:*global-debugger* :external) - #+sbcl - (sb-ext:*invoke-debugger-hook* :external) - (*enable-internal-debugger* :internal) - (t :none))) - -(defmacro with-debugger ((&key control internal) &body body) - (let ((debugger-hook (if control - 'control-debugger-hook - 'shell-debugger-hook))) - `(flet ((body-func () - (catch 'debug-error - (with-simple-restart - (abort "Exit debugger, returning to top level.") - ,@body)))) - (case (debugger-type) - (:external - (body-func)) - ,@(when internal - #+clasp - `((:internal - (catch sys::*quit-tag* - (body-func)))) - #-clasp - `((:internal - (body-func)))) - (otherwise - (let ((*debugger-hook* ',debugger-hook) - #+sbcl (sb-ext:*invoke-debugger-hook* ',debugger-hook) - #+ccl (ccl:*break-hook* ',debugger-hook) - #+ecl (ext:*invoke-debugger-hook* ',debugger-hook) - #+clasp (ext:*invoke-debugger-hook* ',debugger-hook) - #+abcl (sys::*invoke-debugger-hook* ',debugger-hook) - #+clisp (sys::*break-driver* (lambda (continuable &optional condition print) - (declare (ignore continuable print)) - (,debugger-hook condition nil))) - #+allegro (excl::*break-hook* (lambda (&rest args) - (,debugger-hook (fifth args)))) - #+lispworks (dbg::*debugger-wrapper-list* (lambda (function condition) - (declare (ignore function)) - (,debugger-hook condition nil))) - #+mezzano (mezzano.debug:*global-debugger* (lambda (condition) - (,debugger-hook condition nil)))) - (body-func))))))) - (defun debug-enter-loop () "Re-enter the debug loop after a restart which implements a debugger command." (throw 'enter-loop t)) diff --git a/src/message.lisp b/src/message.lisp index d2b16494..5fd9d1a9 100644 --- a/src/message.lisp +++ b/src/message.lisp @@ -43,7 +43,7 @@ (:documentation "Representation of IPython messages")) -#+(or abcl allegro ccl clasp cmu ecl lispworks sbcl) +#+(or); abcl allegro ccl clasp cmu ecl lispworks sbcl) (defmethod initialize-instance :after ((instance message) &rest initargs &key &allow-other-keys) (declare (ignore initargs)) (let ((buffers (message-buffers instance))) @@ -149,7 +149,7 @@ ; explicitly defined element type is needed for CLISP :element-type '(unsigned-byte 8))) -#+(or abcl allegro ccl clasp cmu ecl lispworks sbcl) +#+(or); abcl allegro ccl clasp cmu ecl lispworks sbcl) (defun read-buffer-part (ch msg) (pzmq:msg-recv msg (channel-socket ch)) (let* ((size (pzmq:msg-size msg)) @@ -204,8 +204,8 @@ (unless (more-parts ch msg) (return (nreverse parts))) (push - #-(or abcl allegro ccl clasp cmu ecl lispworks sbcl) (read-binary-part ch msg) - #+(or abcl allegro ccl clasp cmu ecl lispworks sbcl) (read-buffer-part ch msg) + #-(or)#| abcl allegro ccl clasp cmu ecl lispworks sbcl)|# (read-binary-part ch msg) + #+(or)#| abcl allegro ccl clasp cmu ecl lispworks sbcl)|# (read-buffer-part ch msg) parts) (go next))))))) diff --git a/src/utils.lisp b/src/utils.lisp index 3bb969bb..ac5ec2e5 100644 --- a/src/utils.lisp +++ b/src/utils.lisp @@ -189,3 +189,93 @@ (defmethod close ((stream closed-input-stream) &key abort) (declare (ignore abort)) nil) + +(defun control-debugger-hook (condition me-or-my-encapsulation) + (declare (ignore me-or-my-encapsulation)) + (cond ((typep condition 'warning) + (inform :warning "[~S] ~A~%" (type-of condition) condition) + (muffle-warning)) + (t + (inform :error "[~S] ~A~%" (type-of condition) condition) + (abort)))) + +(defun shell-debugger-hook (condition me-or-my-encapsulation) + (declare (ignore me-or-my-encapsulation)) + (cond ((typep condition 'warning) + (format *standard-output* "[~S] ~A~%" (type-of condition) condition) + (finish-output *standard-output*) + (muffle-warning)) + (t + (let ((env (dissect:capture-environment condition))) + (format *error-output* "[~S] ~A~%" (type-of condition) condition) + (finish-output *error-output*) + (throw 'debug-error + (make-eval-error condition (format nil "~A" condition) + (mapcar (lambda (frame) + (dissect:present frame nil)) + (dissect:environment-stack env)))))))) + +(defun debugger-type () + (cond ((or (not *enable-debugger*) + #+clasp (core:debugger-disabled-p) + #+sbcl (eq sb-ext:*invoke-debugger-hook* 'sb-debug::debugger-disabled-hook)) + :none) + #+abcl + (sys::*invoke-debugger-hook* :external) + #+allegro + (excl::*break-hook* :external) + #+ccl + (ccl:*break-hook* :external) + #+clisp + (sys::*break-driver* :external) + #+clasp + (ext:*invoke-debugger-hook* :external) + #+ecl + (ext:*invoke-debugger-hook* :external) + #+lispworks + (dbg::*debugger-wrapper-list* :external) + #+mezzano + (mezzano.debug:*global-debugger* :external) + #+sbcl + (sb-ext:*invoke-debugger-hook* :external) + (*enable-internal-debugger* :internal) + (t :none))) + +(defmacro with-debugger ((&key control internal) &body body) + (let ((debugger-hook (if control + 'control-debugger-hook + 'shell-debugger-hook))) + `(flet ((body-func () + (catch 'debug-error + (with-simple-restart + (abort "Exit debugger, returning to top level.") + ,@body)))) + (case (debugger-type) + (:external + (body-func)) + ,@(when internal + #+clasp + `((:internal + (catch sys::*quit-tag* + (body-func)))) + #-clasp + `((:internal + (body-func)))) + (otherwise + (let ((*debugger-hook* ',debugger-hook) + #+sbcl (sb-ext:*invoke-debugger-hook* ',debugger-hook) + #+ccl (ccl:*break-hook* ',debugger-hook) + #+ecl (ext:*invoke-debugger-hook* ',debugger-hook) + #+clasp (ext:*invoke-debugger-hook* ',debugger-hook) + #+abcl (sys::*invoke-debugger-hook* ',debugger-hook) + #+clisp (sys::*break-driver* (lambda (continuable &optional condition print) + (declare (ignore continuable print)) + (,debugger-hook condition nil))) + #+allegro (excl::*break-hook* (lambda (&rest args) + (,debugger-hook (fifth args)))) + #+lispworks (dbg::*debugger-wrapper-list* (lambda (function condition) + (declare (ignore function)) + (,debugger-hook condition nil))) + #+mezzano (mezzano.debug:*global-debugger* (lambda (condition) + (,debugger-hook condition nil)))) + (body-func))))))) diff --git a/src/widgets/trait-types.lisp b/src/widgets/trait-types.lisp index 747b6dba..0c212f10 100644 --- a/src/widgets/trait-types.lisp +++ b/src/widgets/trait-types.lisp @@ -20,7 +20,7 @@ (declare (ignore object type name)) (values :null (list nil) (list value))) -#+(or abcl allegro ccl clasp cmu ecl lispworks sbcl) +#+(or); abcl allegro ccl clasp cmu ecl lispworks sbcl) (defmethod deserialize-trait (object (type (eql :buffer)) name (value vector)) (declare (ignore type name)) (if (binary-value-p value) @@ -217,7 +217,7 @@ (declare (ignore object type name)) (values :null (list nil) (list value))) -#+(or abcl allegro ccl clasp cmu ecl lispworks sbcl) +#+(or); abcl allegro ccl clasp cmu ecl lispworks sbcl) (defmethod deserialize-trait (object (type (eql :single-float-buffer)) name (value vector)) (declare (ignore type name)) (if (binary-value-p value)