Annotation of qemu/roms/SLOF/board-js2x/slof/i2c.fs, revision 1.1.1.1

1.1       root        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: new-device
                     15: 
                     16: s" i2c" 2dup device-name device-type
                     17: s" u4-i2c" compatible
                     18: 
                     19: 0 encode-int  f8001000 encode-int+
                     20: 0 encode-int+     1000 encode-int+ s" reg" property
                     21: 
                     22: : >i2c  f8001000 + ;
                     23: : i2c@  >i2c rl@ ;
                     24: : i2c!  >i2c rl! ;
                     25: 
                     26: : .i2c  80 0 DO i i2c@ . 10 +LOOP ;
                     27: 
                     28: \ 0 mode  1 ctrl  2 stat  3 isr  4 ier  5 addr  6 suba  7 data
                     29: \ 8 rev  9 risetime  a bittime
                     30: 
                     31: \ 0 mode: 08
                     32: \ 1 ctrl: 8 = start  4 = stop  2 = xaddr  1 = aak
                     33: \ 2 stat: 2 = lastaak  1 = busy
                     34: \ 3 isr: 8 = istart  4 = istop  2 = iaddr  1 = idata
                     35: \ 4 ier: --
                     36: \ 5 addr: a1..a7
                     37: \ 6 suba: offset
                     38: \ 7 data: data
                     39: 
                     40: : i2c-addr ( addr -- )  50 i2c!  2 10 i2c!  BEGIN 30 i2c@ 2 and UNTIL ;
                     41: : i2c-subaddr ( suba -- )  60 i2c! ;
                     42: : i2c-stop ( -- )  BEGIN 30 i2c@ dup 30 i2c! 4 and UNTIL ;
                     43: : i2c-nak? ( -- failed? )  20 i2c@ 2 and 0= dup IF i2c-stop THEN ;
                     44: : i2c-short? ( -- failed? )  30 i2c@ 4 and 0<> dup IF 0 10 i2c! i2c-stop THEN ;
                     45: : i2c-aak-if-more ( n -- )  1 <> 1 and 10 i2c! ;
                     46: 
                     47: : (read) ( buf len addr -- error? )
                     48:   1 or i2c-addr  i2c-nak? IF 2drop true EXIT THEN
                     49:   dup i2c-aak-if-more  2 30 i2c!
                     50:   BEGIN
                     51:   30 i2c@ 1 and IF
                     52:     1- >r 70 i2c@ over c! char+ r>
                     53:     dup 0= IF i2c-stop 2drop false EXIT THEN
                     54:     dup i2c-aak-if-more 1 30 i2c! THEN
                     55:   i2c-short? IF 2drop true EXIT THEN
                     56:   AGAIN ;
                     57: 
                     58: : i2c-read ( buf len addr -- error? )
                     59:   4 0 i2c!  (read) ;
                     60: : i2c-sub-read ( buf len addr suba -- error? )
                     61:   c 0 i2c!  i2c-subaddr  (read) ;
                     62: 
                     63: : i2c-write ( buf len addr -- error? )
                     64:   4 0 i2c!  i2c-addr  i2c-nak? IF 2drop true EXIT THEN
                     65:   over c@ 70 i2c!  2 30 i2c!
                     66:   BEGIN
                     67:   30 i2c@ 1 and IF
                     68:     1- >r char+ r> i2c-nak? IF 2drop true EXIT THEN
                     69:     dup 0= IF 4 10 i2c! i2c-stop nip EXIT THEN
                     70:     over c@ 70 i2c!  1 30 i2c! THEN
                     71:   i2c-short? IF 2drop true EXIT THEN
                     72:   AGAIN ;
                     73: 
                     74: : open  true ;
                     75: : close ;
                     76: 
                     77: finish-device

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.