qemu/roms/SLOF/board-js2x/slof/sio.fs

   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
   8 \ *
   9 \ * Contributors:
  10 \ *     IBM Corporation - initial implementation
  11 \ ****************************************************************************/
  12
  13
  14 \ National Semiconductor SIO.
  15 \ See http://www.national.com/pf/PC/PC87417.html for the datasheet.
  16
  17 \ We use both serial ports, and the RTC.
  18
  19 \ See 3.7.5.
  20 new-device   3f8 1 set-unit
  21
  22 s" serial" 2dup device-name device-type
  23
  24 \ Enable this UART.
  25 3 7 siocfg!  1 30 siocfg!
  26
  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
  31
  32 : open  true ;
  33 : close ;
  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 ;
  38
  39 finish-device
  40
  41
  42 new-device   2f8 1 set-unit
  43
  44 s" serial" 2dup device-name device-type
  45
  46 \ Enable this UART.
  47 2 7 siocfg!  1 30 siocfg!
  48
  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
  53
  54 : open  true ;
  55 : close ;
  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 ;
  60
  61 finish-device
  62
  63
  64
  65 \ See the "Device Support Extensions" OF Recommended Practice document.
  66 new-device   1070 1 set-unit
  67
  68 s" rtc" 2dup device-name device-type
  69 \ Following is for Linux, to recognize this RTC:
  70 s" pnpPNP,b00" compatible
  71
  72 : rtc!  my-space io-c!  my-space 1+ io-c! ;
  73 : rtc@  my-space io-c!  my-space 1+ io-c@ ;
  74
  75 \ 10 bytes of ISA I/O space, at 1070.
  76 my-unit encode-int rot encode-int+ 10 encode-int+ s" reg" property
  77
  78 : open   true ;
  79 : close ;
  80
  81 \ XXX: dummy methods.
  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 ;
  84
  85 finish-device