[movitz-cvs] CVS update: movitz/losp/x86-pc/serial.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/x86-pc
In directory common-lisp.net:/tmp/cvs-serv7852

Modified Files:
	serial.lisp 
Log Message:
Some hacking for sending console output to serial port.

Date: Wed Mar  9 08:21:42 2005
Author: ffjeld

Index: movitz/losp/x86-pc/serial.lisp
diff -u movitz/losp/x86-pc/serial.lisp:1.2 movitz/losp/x86-pc/serial.lisp:1.3
--- movitz/losp/x86-pc/serial.lisp:1.2	Thu May 20 20:16:13 2004
+++ movitz/losp/x86-pc/serial.lisp	Wed Mar  9 08:21:42 2005
@@ -1,6 +1,6 @@
 ;;;;------------------------------------------------------------------
 ;;;; 
-;;;;    Copyright (C) 2001-2004, 
+;;;;    Copyright (C) 2001-2005, 
 ;;;;    Department of Computer Science, University of Tromso, Norway.
 ;;;; 
 ;;;;    For distribution policy, see the accompanying file COPYING.
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Fri Oct 11 14:42:12 2002
 ;;;;                
-;;;; $Id: serial.lisp,v 1.2 2004/05/20 18:16:13 ffjeld Exp $
+;;;; $Id: serial.lisp,v 1.3 2005/03/09 07:21:42 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -18,7 +18,7 @@
 (provide :x86-pc/serial)
 
 (defpackage muerte.x86-pc.serial
-  (:use muerte.cl muerte.lib muerte.x86-pc)
+  (:use muerte.cl muerte.lib muerte.x86-pc muerte)
   (:export uart-probe
 	   uart-divisor
 	   uart-baudrate
@@ -147,6 +147,28 @@
 ;;;(defun uart-read-char (io-base)
 ;;;  (loop until ))
 
+(defun uart-write-char (io-base char)
+  (loop until (logbitp 5 (io-register8 io-base +uart-read-lsr+)))
+  (setf (io-port (+ io-base +uart-write-transmitter-buffer+) :character)
+    char))
+
+(defun make-serial-write-char (&key (io-base (or (some #'uart-probe +uart-probe-addresses+)
+						 (error "No serial port found.")))
+				    (baudrate 9600)
+				    (word-length 8)
+				    (parity :none)
+				    (stop-bits 1))
+  (setf (uart-baudrate io-base) baudrate
+	(io-register8 io-base +uart-write-lcr+) (encode-uart-lcr word-length parity stop-bits))
+  (setf (io-register8 io-base +uart-write-fcr+) 0)
+  (lambda (char &optional stream)
+    (case char
+      (#\newline
+       (uart-write-char io-base #\return)))
+    (uart-write-char io-base char)
+    (muerte::%write-char char (muerte::output-stream-designator stream))))
+
+
 (defun com (string &key (io-base (or (some #'uart-probe +uart-probe-addresses+)
 				     (error "No serial port found.")))
 			(baudrate 9600)
@@ -157,7 +179,6 @@
 	(io-register8 io-base +uart-write-lcr+) (encode-uart-lcr word-length parity stop-bits))
   (setf (io-register8 io-base +uart-write-fcr+) 0)
   (loop for c across string
-      do (loop until (logbitp 5 (io-register8 io-base +uart-read-lsr+)))
-	 (setf (io-port (+ io-base +uart-write-transmitter-buffer+) :character) c))
+      do (uart-write-char io-base c))
   io-base)