diff --git a/compiler/package.lisp b/compiler/package.lisp index 783de3f3..1b7f60e8 100644 --- a/compiler/package.lisp +++ b/compiler/package.lisp @@ -685,6 +685,9 @@ #:dma-buffer-n-sg-entries #:dma-buffer-sg-entry #:dma-buffer-sg-entry-list + + #:initialize-debug-serial + #:initialize-debug-serial-reads )) ;;; Runtime contains a bunch of low-level and common functions required to diff --git a/ipl.lisp b/ipl.lisp index 7b64f05d..1e71da38 100644 --- a/ipl.lisp +++ b/ipl.lisp @@ -282,6 +282,12 @@ Make sure there is a virtio-net NIC attached.~%") sys.int::*init-file-path* c))))) +(mezzano.supervisor:add-boot-hook + #'(lambda () + (unless (mezzano.supervisor:boot-option + mezzano.supervisor:+boot-option-video-console+) + ;; Start a REPL on the debug serial port. + (sys.int::debug-serial-repl-start)))) (mezzano.supervisor:add-boot-hook 'sys.int::load-init-file :late) (sys.int::load-init-file) diff --git a/supervisor/serial.lisp b/supervisor/serial.lisp index e02ef543..deaa05ab 100644 --- a/supervisor/serial.lisp +++ b/supervisor/serial.lisp @@ -108,7 +108,9 @@ (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*) +(sys.int::defglobal *debug-serial-irq*) +(sys.int::defglobal *debug-serial-irq-handler*) ;; Low-level byte functions. @@ -142,11 +144,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 +162,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,36 +181,37 @@ (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) (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)) (: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)) (setf *debug-serial-io-port* io-port *debug-serial-io-shift* io-shift *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))) (setf + *debug-serial-irq* irq + *debug-serial-irq-handler* nil ;; Turn interrupts off. (uart-16550-reg +serial-IER+) #x00 ;; DLAB on. @@ -231,3 +234,52 @@ ;; 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-blocking () + ;; 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+)) + +(defun initialize-debug-serial-reads () + ;; 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*))) + +(defun debug-serial-read-byte () + (mezzano.sync::wait-for-objects *debug-serial-irq-handler*) + (prog1 (debug-serial-read-byte-1-blocking) + (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))))) + (let ((result (code-char value))) + (debug-serial-write-char result) + result))) diff --git a/system/debug.lisp b/system/debug.lisp index 7f49fe61..9e732230 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))) @@ -909,3 +910,57 @@ 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-start (&rest args) + #+(not x86-64) + (error "debug-serial-repl is not yet implemented on this architecture. Please file a feature request.") + (debug-serial-repl-stop) + (let ((interrupt 4)) + ;; Remove existing interrupt handlers. + (setf (mezzano.supervisor::irq-attachments (mezzano.supervisor::platform-irq interrupt)) nil) + ;; Make sure debug pseudostream is set to debug-serial-stream. + (mezzano.supervisor:initialize-debug-serial + #x3F8 0 #'sys.int::io-port/8 #'(setf sys.int::io-port/8) interrupt 115200)) + (mezzano.supervisor:initialize-debug-serial-reads) + (mezzano.supervisor:make-thread + (lambda () (apply #'debug-serial-repl-main args)) + :name "Debug Serial Lisp Listener")) + +(defun debug-serial-repl-stop () + (dolist (thread (mezzano.supervisor:all-threads)) + (when (equal (mezzano.supervisor:thread-name thread) "Debug Serial Lisp Listener") + (mezzano.supervisor:terminate-thread thread)))) diff --git a/tools/cold-generator2/cold-generator.lisp b/tools/cold-generator2/cold-generator.lisp index eef87c21..d0e3422b 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"