|
|
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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.