Annotation of qemu/roms/SLOF/board-js2x/slof/i2c.fs, revision 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.