From f1a8fd095e82249ec17894444283c81a9bd0d90d Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Tue, 20 Feb 2024 18:14:17 -0500 Subject: [PATCH 1/6] serial: Rename *debug-serial-at-line-start* --- supervisor/serial.lisp | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/supervisor/serial.lisp b/supervisor/serial.lisp index e02ef543f..4a2223415 100644 --- a/supervisor/serial.lisp +++ b/supervisor/serial.lisp @@ -108,7 +108,7 @@ (sys.int::defglobal *debug-serial-read-fn*) (sys.int::defglobal *debug-serial-write-fn*) (sys.int::defglobal *debug-serial-lock*) -(sys.int::defglobal *serial-at-line-start*) +(sys.int::defglobal *debug-serial-at-line-start*) ;; Low-level byte functions. @@ -142,11 +142,11 @@ ;; end of the port uses UTF-8 with CRLF newlines. (defun debug-serial-write-char (char) - (setf *serial-at-line-start* nil) + (setf *debug-serial-at-line-start* nil) ;; FIXME: Should write all the bytes to the buffer in one go. ;; Other processes may interfere. (cond ((eql char #\Newline) - (setf *serial-at-line-start* t) + (setf *debug-serial-at-line-start* t) ;; Turn #\Newline into CRLF (debug-serial-write-byte #x0D) (debug-serial-write-byte #x0A)) @@ -160,12 +160,12 @@ (dotimes (i (string-length string)) (let ((char (char string i))) (cond ((eql char #\Newline) - (setf *serial-at-line-start* t) + (setf *debug-serial-at-line-start* t) ;; Turn #\Newline into CRLF (debug-serial-write-byte-1 #x0D) (debug-serial-write-byte-1 #x0A)) (t - (setf *serial-at-line-start* nil) + (setf *debug-serial-at-line-start* nil) (with-utf-8-bytes (char byte) (debug-serial-write-byte-1 byte))))))))) @@ -179,12 +179,12 @@ (dotimes (i (cdr buf)) (let ((byte (aref buf-data (the fixnum i)))) (cond ((eql byte #.(char-code #\Newline)) - (setf *serial-at-line-start* t) + (setf *debug-serial-at-line-start* t) ;; Turn #\Newline into CRLF (debug-serial-write-byte-1 #x0D) (debug-serial-write-byte-1 #x0A)) (t - (setf *serial-at-line-start* nil) + (setf *debug-serial-at-line-start* nil) (debug-serial-write-byte-1 byte))))))))) (defun debug-serial-stream (op &optional arg) @@ -195,7 +195,7 @@ (:write-string (debug-serial-write-string arg)) (:flush-buffer (debug-serial-flush-buffer arg)) (:force-output) - (:start-line-p *serial-at-line-start*))) + (:start-line-p *debug-serial-at-line-start*))) (defun initialize-debug-serial (io-port io-shift io-read-fn io-write-fn irq baud &optional (reinit t)) (declare (ignore irq)) @@ -204,7 +204,7 @@ *debug-serial-read-fn* io-read-fn *debug-serial-write-fn* io-write-fn *debug-serial-lock* :unlocked - *serial-at-line-start* t) + *debug-serial-at-line-start* t) ;; Initialize port. (when reinit (let ((divisor (truncate 115200 baud))) From 0c10d228ca60ec4ccc41abee52761a6b6d734392 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Mon, 19 Feb 2024 12:40:21 -0500 Subject: [PATCH 2/6] serial: Implement debug-serial-read-byte-1 --- supervisor/serial.lisp | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/supervisor/serial.lisp b/supervisor/serial.lisp index 4a2223415..2794b79a6 100644 --- a/supervisor/serial.lisp +++ b/supervisor/serial.lisp @@ -231,3 +231,11 @@ ;; Enable RX interrupts. (uart-16550-reg +serial-IER+) +serial-ier-received-data-available+))) (debug-set-output-pseudostream 'debug-serial-stream)) + +(defun debug-serial-read-byte-1 () + ;; Wait for the RX FIFO to have data available. + (loop + until (logbitp +serial-lsr-data-available+ + (uart-16550-reg +serial-LSR+))) + ;; Read byte. + (uart-16550-reg +serial-THR+)) From 510c3894cd174cb4c0c18d8d866694aade4e35c3 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Tue, 20 Feb 2024 18:15:01 -0500 Subject: [PATCH 3/6] serial: Implement debug-serial-read-byte --- supervisor/serial.lisp | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/supervisor/serial.lisp b/supervisor/serial.lisp index 2794b79a6..5e750a346 100644 --- a/supervisor/serial.lisp +++ b/supervisor/serial.lisp @@ -109,6 +109,8 @@ (sys.int::defglobal *debug-serial-write-fn*) (sys.int::defglobal *debug-serial-lock*) (sys.int::defglobal *debug-serial-at-line-start*) +(sys.int::defglobal *debug-serial-irq*) +(sys.int::defglobal *debug-serial-irq-handler*) ;; Low-level byte functions. @@ -198,7 +200,6 @@ (:start-line-p *debug-serial-at-line-start*))) (defun initialize-debug-serial (io-port io-shift io-read-fn io-write-fn irq baud &optional (reinit t)) - (declare (ignore irq)) (setf *debug-serial-io-port* io-port *debug-serial-io-shift* io-shift *debug-serial-read-fn* io-read-fn @@ -209,6 +210,8 @@ (when reinit (let ((divisor (truncate 115200 baud))) (setf + *debug-serial-irq* irq + *debug-serial-irq-handler* nil ;; Turn interrupts off. (uart-16550-reg +serial-IER+) #x00 ;; DLAB on. @@ -239,3 +242,17 @@ (uart-16550-reg +serial-LSR+))) ;; Read byte. (uart-16550-reg +serial-THR+)) + +(defun debug-serial-read-byte () + ;; IRQ initialization cannot be done in initialize-debug-serial + ;; because it is called very early during boot, before interrupt + ;; objects exist. Calling make-simple-irq there causes the boot to + ;; hang just before "Hello, Debug World!" is printed. Initialize + ;; IRQ during the first debug-serial-read-byte call instead. + (unless *debug-serial-irq-handler* + (setf *debug-serial-irq-handler* (make-simple-irq *debug-serial-irq*)) + (simple-irq-attach *debug-serial-irq-handler*) + (simple-irq-unmask *debug-serial-irq-handler*)) + (mezzano.sync::wait-for-objects *debug-serial-irq-handler*) + (prog1 (debug-serial-read-byte-1) + (mezzano.supervisor:simple-irq-unmask *debug-serial-irq-handler*))) From ca9ff0807926c6eda6fe30fbe452b41e786fb964 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Mon, 19 Feb 2024 22:17:12 -0500 Subject: [PATCH 4/6] serial: Implement debug-serial-read-char --- supervisor/serial.lisp | 25 ++++++++++++++++++++++++- 1 file changed, 24 insertions(+), 1 deletion(-) diff --git a/supervisor/serial.lisp b/supervisor/serial.lisp index 5e750a346..293feea81 100644 --- a/supervisor/serial.lisp +++ b/supervisor/serial.lisp @@ -191,7 +191,7 @@ (defun debug-serial-stream (op &optional arg) (ecase op - (:read-char (panic "Serial read char not implemented.")) + (:read-char (debug-serial-read-char)) (:clear-input) (:write-char (debug-serial-write-char arg)) (:write-string (debug-serial-write-string arg)) @@ -256,3 +256,26 @@ (mezzano.sync::wait-for-objects *debug-serial-irq-handler*) (prog1 (debug-serial-read-byte-1) (mezzano.supervisor:simple-irq-unmask *debug-serial-irq-handler*))) + +(defun utf8-sequence-length (byte) + (cond + ((eql (logand byte #x80) #x00) + (values 1 byte)) + ((eql (logand byte #xE0) #xC0) + (values 2 (logand byte #x1F))) + ((eql (logand byte #xF0) #xE0) + (values 3 (logand byte #x0F))) + ((eql (logand byte #xF8) #xF0) + (values 4 (logand byte #x07))) + (t (error "Invalid UTF-8 lead byte ~S." byte)))) + +(defun debug-serial-read-char () + (multiple-value-bind (length value) + (utf8-sequence-length (debug-serial-read-byte)) + ;; Read remaining bytes. They must all be continuation bytes. + (dotimes (i (1- length)) + (let ((byte (debug-serial-read-byte))) + (unless (eql (logand byte #xC0) #x80) + (error "Invalid UTF-8 continuation byte ~S." byte)) + (setf value (logior (ash value 6) (logand byte #x3F))))) + (code-char value))) From 4c953e630188a2683ddb5d88f3faed78bc573348 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Tue, 20 Feb 2024 18:15:25 -0500 Subject: [PATCH 5/6] system/debug: Fix a compiler warning --- system/debug.lisp | 1 + 1 file changed, 1 insertion(+) diff --git a/system/debug.lisp b/system/debug.lisp index 7f49fe615..79421ed26 100644 --- a/system/debug.lisp +++ b/system/debug.lisp @@ -596,6 +596,7 @@ executed, and the offset into it." (defgeneric function-source-location (function &key)) (defmethod function-source-location ((function compiled-function) &key (offset 0)) + (declare (ignore offset)) (let* ((info (function-debug-info function)) (pathname (mezzano.internals::debug-info-source-pathname info)) (tlf (mezzano.internals::debug-info-source-top-level-form-number info))) From dc70cf0b85c1db98b4a9a0c3c4533a6f8f90abcf Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Tue, 20 Feb 2024 18:15:44 -0500 Subject: [PATCH 6/6] system/debug: Implement debug-serial REPL --- system/debug.lisp | 41 +++++++++++++++++++++++ tools/cold-generator2/cold-generator.lisp | 2 +- 2 files changed, 42 insertions(+), 1 deletion(-) diff --git a/system/debug.lisp b/system/debug.lisp index 79421ed26..2f4e9f7c5 100644 --- a/system/debug.lisp +++ b/system/debug.lisp @@ -910,3 +910,44 @@ executed, and the offset into it." (defmethod function-lambda-list ((function mezzano.clos:generic-function)) (mezzano.clos:generic-function-lambda-list function)) + +;;; A REPL for the debug serial port. + +(defclass debug-serial-repl (mezzano.gray:unread-char-mixin + mezzano.gray:fundamental-character-input-stream + mezzano.gray:fundamental-character-output-stream) + ((%thread :initarg :thread :reader thread))) + +(defmethod mezzano.gray:stream-read-char ((stream debug-serial-repl)) + (mezzano.supervisor::debug-serial-read-char)) + +(defmethod mezzano.gray:stream-terpri ((stream debug-serial-repl)) + (mezzano.supervisor::debug-serial-write-char #\Newline)) + +(defmethod mezzano.gray:stream-write-char ((stream debug-serial-repl) character) + (mezzano.supervisor::debug-serial-write-char character)) + +(defmethod mezzano.gray:stream-start-line-p ((stream debug-serial-repl)) + mezzano.supervisor::*debug-serial-at-line-start*) + +(defmethod mezzano.gray:stream-line-column ((stream debug-serial-repl)) + nil) + +(defun debug-serial-repl-main () + (let* ((terminal (make-instance 'debug-serial-repl + :thread (mezzano.supervisor:current-thread))) + (*terminal-io* terminal) + (*standard-input* (make-synonym-stream '*terminal-io*)) + (*standard-output* *standard-input*) + (*error-output* *standard-input*) + (*query-io* *standard-input*) + (*trace-output* *standard-input*) + (*debug-io* *standard-input*)) + (mezzano.internals::repl))) + +(defun debug-serial-repl-spawn (&rest args) + (mezzano.supervisor:make-thread + (lambda () (apply #'debug-serial-repl-main args)) + :name "Debug Serial Lisp Listener")) + +(mezzano.supervisor:add-boot-hook 'debug-serial-repl-spawn :late) diff --git a/tools/cold-generator2/cold-generator.lisp b/tools/cold-generator2/cold-generator.lisp index eef87c214..d0e3422bf 100644 --- a/tools/cold-generator2/cold-generator.lisp +++ b/tools/cold-generator2/cold-generator.lisp @@ -148,12 +148,12 @@ "system/condition.lisp" "system/error.lisp" "system/coerce.lisp" + "system/gray-streams.lisp" ; before system/debug for debug-serial-repl "system/debug.lisp" "system/dispatch.lisp" "system/full-eval.lisp" "system/fast-eval.lisp" "system/eval.lisp" - "system/gray-streams.lisp" "system/external-format.lisp" "system/standard-streams.lisp" "system/stream.lisp"