-
Notifications
You must be signed in to change notification settings - Fork 0
/
serial.lsp
84 lines (75 loc) · 2.29 KB
/
serial.lsp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
'(%Z%%M% %R%.%L%.%B%.%S% %E% %Y%)
'(MIKKO-3 (25 / 11 - 2003) (0 : 41 : 51 49))
(defq *package* SERIAL)
(defun terminal ()
(initialize-serial-port 'COM1 2400 8 'none 1)
(repeat
(setq one-char (byte-received?))
(if one-char (printc one-char))
(if (any-key) (send-byte (setq one-char (readcc))) (setq one-char nil))
(and one-char
(zerop one-char)
(if
(= 45 (setq one-char (readcc)))
t
(progn (printc 0) (printc one-char) nil)))))
(defun hui ()
(repeat-times 1000
(setq ch (byte-received?))
(if ch (printc (logand ch 127)))
(sp)))
(defun taajuus ()
(initialize-serial-port 'COM1 2400 8 'none 1)
(repeat-times 100
(while (zerop (logand 1 (input-byte line-status-reg))) nil)
(sp)
(setq iik (input-byte base-address))
(setq aak 1)
(repeat-times 8
(print
(if (zerop (logand aak iik)) '_ '=))
(setq aak (* 2 aak)))))
(defun standard-init () (initialize-serial-port 'COM1 4800 8 'none 1))
(defun send-byte
(x)
(if
(zerop (logand 32 (input-byte line-status-reg)))
nil
(progn (output-byte base-address x) x)))
(defun byte-received? ()
(if (zerop (logand 1 (input-byte line-status-reg))) nil (input-byte base-address)))
(defun initialize-serial-port
(port baud-rate word-length parity stop-bits)
(setq base-address
(peekw 64
(case port
(COM1 0)
(COM2 2)
(t
(error-reset (list 'NO 'SUCH 'PORT port))))))
(setq line-control-reg (+ base-address 3))
(setq line-status-reg (+ base-address 5))
(setq interrupt-enable-register (- line-control-reg 2))
(output-byte line-control-reg 128)
(setq baud-rate-divisor
(/ 1152 (compress (nreverse (cddr (nreverse (explode baud-rate)))))))
(output-byte (- line-control-reg 2) (high-byte baud-rate-divisor))
(output-byte (- line-control-reg 3) (low-byte baud-rate-divisor))
(output-byte line-control-reg
(+
(case word-length
(5 0)
(6 1)
(7 2)
(8 3)
(t (error-reset (list 'word-length word-length '?))))
(case stop-bits
(1 0)
(2 4)
(t (error-reset (list 'stop-bits stop-bits '?))))
(case parity
(none 0)
(odd 8)
(even 24)
(t (error-reset (list 'parity parity '?)))))))
(defq SERIAL (terminal hui taajuus standard-init send-byte byte-received? initialize-serial-port SERIAL))