1 \ *****************************************************************************
2 \ * Copyright (c) 2004, 2008 IBM Corporation
3 \ * All rights reserved.
4 \ * This program and the accompanying materials
5 \ * are made available under the terms of the BSD License
6 \ * which accompanies this distribution, and is available at
7 \ * http://www.opensource.org/licenses/bsd-license.php
10 \ * IBM Corporation - initial implementation
11 \ ****************************************************************************/
14 \ National Semiconductor SIO.
15 \ See http://www.national.com/pf/PC/PC87417.html for the datasheet.
17 \ We use both serial ports, and the RTC.
20 new-device 3f8 1 set-unit
22 s" serial" 2dup device-name device-type
25 3 7 siocfg! 1 30 siocfg!
27 \ 8 bytes of ISA I/O space
28 my-unit encode-int rot encode-int+ 8 encode-int+ s" reg" property
29 d# 19200 encode-int s" current-speed" property
30 44 encode-int 0 encode-int+ s" interrupts" property
34 : write ( adr len -- actual ) tuck type ;
35 : read ( adr len -- actual ) 0= IF drop 0 EXIT THEN
36 serial-key? 0= IF 0 swap c! -2 EXIT THEN
37 serial-key swap c! 1 ;
42 new-device 2f8 1 set-unit
44 s" serial" 2dup device-name device-type
47 2 7 siocfg! 1 30 siocfg!
49 \ 8 bytes of ISA I/O space
50 my-unit encode-int rot encode-int+ 8 encode-int+ s" reg" property
51 d# 19200 encode-int s" current-speed" property
52 43 encode-int 0 encode-int+ s" interrupts" property
56 : write ( adr len -- actual ) tuck type ;
57 : read ( adr len -- actual ) 0= IF drop 0 EXIT THEN
58 serial-key? 0= IF 0 swap c! -2 EXIT THEN
59 serial-key swap c! 1 ;
65 \ See the "Device Support Extensions" OF Recommended Practice document.
66 new-device 1070 1 set-unit
68 s" rtc" 2dup device-name device-type
69 \ Following is for Linux, to recognize this RTC:
70 s" pnpPNP,b00" compatible
72 : rtc! my-space io-c! my-space 1+ io-c! ;
73 : rtc@ my-space io-c! my-space 1+ io-c@ ;
75 \ 10 bytes of ISA I/O space, at 1070.
76 my-unit encode-int rot encode-int+ 10 encode-int+ s" reg" property
82 : get-time ( -- sec min hr day mth yr ) 38 22 c 1 1 d# 1973 ;
83 : set-time ( sec min hr day mth yr -- ) 3drop 3drop ;