[openfirmware] r1287 - cpu/x86/pc/olpc/via dev/olpc dev/olpc/viacamera

svn at openfirmware.info svn at openfirmware.info
Sun Aug 9 05:30:55 CEST 2009


Author: wmb
Date: 2009-08-09 05:30:55 +0200 (Sun, 09 Aug 2009)
New Revision: 1287

Added:
   dev/olpc/viacamera/
   dev/olpc/viacamera/camera.fth
   dev/olpc/viacamera/loadpkg.fth
   dev/olpc/viacamera/smbus.fth
Modified:
   cpu/x86/pc/olpc/via/devices.fth
Log:
Via - added camera selftest.















Modified: cpu/x86/pc/olpc/via/devices.fth
===================================================================
--- cpu/x86/pc/olpc/via/devices.fth	2009-08-06 03:48:08 UTC (rev 1286)
+++ cpu/x86/pc/olpc/via/devices.fth	2009-08-09 03:30:55 UTC (rev 1287)
@@ -306,8 +306,9 @@
 end-package
 devalias screen /display
 also hidden  d# 34 to display-height  previous  \ For editing
-[then]
 
+fload ${BP}/dev/olpc/viacamera/loadpkg.fth   \ Camera driver
+
 fload ${BP}/cpu/x86/adpcm.fth            \ ADPCM decoding
 
 warning @ warning off

Added: dev/olpc/viacamera/camera.fth
===================================================================
--- dev/olpc/viacamera/camera.fth	                        (rev 0)
+++ dev/olpc/viacamera/camera.fth	2009-08-09 03:30:55 UTC (rev 1287)
@@ -0,0 +1,564 @@
+\ See license at end of file
+purpose: Driver for OLPC camera connected to Via VX855 Video Capture Port
+
+headers
+hex
+
+" OV7670" " sensor" string-property
+
+: cl!  ( l adr -- )  " mmio-base" $call-parent + rl!  ;
+: cl@  ( adr -- l )  " mmio-base" $call-parent + rl@  ;
+
+\ ======================= OV7670 SMBUS operations ==========================
+
+h# 42 constant ov-sid
+h# 31 constant sccb-port
+
+: sccb-setup  ( -- )  sccb-port to smb-port  ov-sid to smb-slave  ;
+: ov@  ( reg -- data )  sccb-setup  smb-byte@  ;
+: ov!  ( data reg -- )  sccb-setup  smb-byte!  ;
+
+: ovc  ( val adr -- )
+   2dup ov@      ( val reg# val actual )
+   tuck <>  if   ( val reg# actual )
+      ." Bad camera I2C value at " swap 2 u.r  ( val actual )
+      ."  expected " swap 2 u.r  ."  got " 2 u.r  cr    ( )
+   else          ( val reg# actual )
+      3drop      ( )
+   then          ( )
+;
+
+\ ============================= camera operations =============================
+
+false value ov7670-detected?
+
+: ((camera-init)  ( -- )
+   80 12 ov!  2 ms		\ reset (reads back different)
+   01 11 ov!			\ 30 fps
+   04 3a ov!			\ UYVY or VYUY
+   00 12 ov!			\ VGA
+
+   \ Hardware window
+   13 17 ov!			\ Horiz start high bits
+   01 18 ov!			\ Horiz stop high bits
+   b6 32 ov!			\ HREF pieces
+   0a 19 ov!			\ Vert start high bits
+   7a 1a ov!			\ Vert stop high bits
+   0a 03 ov!			\ GAIN, VSTART, VSTOP pieces
+
+   \ Mystery scaling numbers
+   00 0c ov!			\ Control 3
+   00 3e ov!			\ Control 14
+   3a 70 ov!  35 71 ov!  11 72 ov!  f0 73 ov!
+   02 a2 ov!
+   00 15 ov!			\ Control 10
+
+   \ Gamma curve values
+   20 7a ov!  10 7b ov!  1e 7c ov!  35 7d ov!
+   5a 7e ov!  69 7f ov!  76 80 ov!  80 81 ov!
+   88 82 ov!  8f 83 ov!  96 84 ov!  a3 85 ov!
+   af 86 ov!  c4 87 ov!  d7 88 ov!  e8 89 ov!
+
+   \ AGC and AEC parameters
+   e0 13 ov!			\ Control 8
+   00 00 ov!			\ Gain lower 8 bits
+   40 0d ov!			\ Control 4 magic reserved bit
+   18 14 ov!			\ Control 9: 4x gain + magic reserved bit
+   05 a5 ov!			\ 50hz banding step limit
+   07 ab ov!			\ 60hz banding step limit
+   95 24 ov!			\ AGC upper limit
+   33 25 ov!			\ AGC lower limit
+   e3 24 ov!			\ AGC/AEC fast mode op region
+   78 9f ov!			\ Hist AEC/AGC control 1
+   68 a0 ov!			\ Hist AEC/AGC control 2
+   03 a1 ov!			\ Magic
+   d8 a6 ov!			\ Hist AEC/AGC control 3
+   d8 a7 ov!			\ Hist AEC/AGC control 4
+   f0 a8 ov!			\ Hist AEC/AGC control 5
+   90 a9 ov!			\ Hist AEC/AGC control 6
+   94 aa ov!			\ Hist AEC/AGC control 7
+   e5 13 ov!			\ Control 8
+
+   \ Mostly magic
+   61 0e ov!  4b 0f ov!  02 16 ov!  07 1e ov!
+   02 21 ov!  91 22 ov!  07 29 ov!  0b 33 ov!
+   0b 35 ov!  1d 37 ov!  71 38 ov!  2a 39 ov!
+   78 3c ov!  40 4d ov!  20 4e ov!  00 69 ov! 
+   4a 6b ov!  10 74 ov!  4f 8d ov!  00 8e ov!
+   00 8f ov!  00 90 ov!  00 91 ov!  00 96 ov!
+   00 9a ov!  84 b0 ov!  0c b1 ov!  0e b2 ov!
+   82 b3 ov!  0a b8 ov!
+
+   \ More magic, some of which tweaks white balance
+   0a 43 ov!  f0 44 ov!  34 45 ov!  58 46 ov!
+   28 47 ov!  3a 48 ov!  88 59 ov!  88 5a ov!
+   44 5b ov!  67 5c ov!  49 5d ov!  0e 5e ov!
+   0a 6c ov!  55 6d ov!  11 6e ov!
+   9f 6f ov!			\ 9e for advance AWB
+   40 6a ov!
+   40 01 ov!			\ Blue gain
+   60 02 ov!			\ Red gain
+   e7 13 ov!			\ Control 8
+
+   \ Matrix coefficients
+   80 4f ov!  80 50 ov!  00 51 ov!  22 52 ov!
+   5e 53 ov!  80 54 ov!  9e 58 ov!
+
+   08 41 ov!			\ AWB gain enable
+   00 3f ov!			\ Edge enhancement factor
+   05 75 ov!  e1 76 ov!  00 4c ov!  01 77 ov!
+   c3 3d ov!			\ Control 13
+   09 4b ov!  60 c9 ov!         \ Reads back differently
+   38 41 ov!			\ Control 16
+   40 56 ov!
+
+   11 34 ov!
+   12 3b ov!			\ Control 11
+   88 a4 ov!  00 96 ov!  30 97 ov!  20 98 ov!
+   30 99 ov!  84 9a ov!  29 9b ov!  03 9c ov!
+   5c 9d ov!  3f 9e ov!  04 78 ov!
+
+   \ Extra-weird stuff.  Some sort of multiplexor register
+   01 79 ov!  f0 c8 ov!
+   0f 79 ov!  00 c8 ov!
+   10 79 ov!  7e c8 ov!
+   0a 79 ov!  80 c8 ov!
+   0b 79 ov!  01 c8 ov!
+   0c 79 ov!  0f c8 ov!
+   0d 79 ov!  20 c8 ov!
+   09 79 ov!  80 c8 ov!
+   02 79 ov!  c0 c8 ov!
+   03 79 ov!  40 c8 ov!
+   05 79 ov!  30 c8 ov!
+   26 79 ov!
+
+   \ OVT says that rewrite this works around a bug in 565 mode.
+   \ The symptom of the bug is red and green speckles in the image.
+   01 11 ov!			\ 30 fps def 80
+;
+
+: config-check  ( -- )
+   01 11 ovc			\ 30 fps
+   04 3a ovc			\ UYVY or VYUY
+   ( 00 12 ovc )		\ VGA
+
+   \ Hardware window
+   13 17 ovc			\ Horiz start high bits
+   01 18 ovc			\ Horiz stop high bits
+   b6 32 ovc			\ HREF pieces
+   ( 0a 19 ovc )		\ Vert start high bits
+   7a 1a ovc			\ Vert stop high bits
+   0a 03 ovc			\ GAIN, VSTART, VSTOP pieces
+
+   \ Mystery scaling numbers
+   00 0c ovc			\ Control 3
+   00 3e ovc			\ Control 14
+   3a 70 ovc  35 71 ovc  11 72 ovc  f0 73 ovc
+   02 a2 ovc
+   00 15 ovc			\ Control 10
+
+   \ Gamma curve values
+   20 7a ovc  10 7b ovc  1e 7c ovc  35 7d ovc
+   5a 7e ovc  69 7f ovc  76 80 ovc  80 81 ovc
+   88 82 ovc  8f 83 ovc  96 84 ovc  a3 85 ovc
+   af 86 ovc  c4 87 ovc  d7 88 ovc  e8 89 ovc
+
+   \ AGC and AEC parameters
+   ( e0 13 ovc )		\ Control 8
+   ( 00 00 ovc )		\ Gain lower 8 bits
+   40 0d ovc			\ Control 4 magic reserved bit
+   ( 18 14 ovc )		\ Control 9: 4x gain + magic reserved bit
+   05 a5 ovc			\ 50hz banding step limit
+   07 ab ovc			\ 60hz banding step limit
+   ( 95 24 ovc )		\ AGC upper limit
+   33 25 ovc			\ AGC lower limit
+   e3 24 ovc			\ AGC/AEC fast mode op region
+   78 9f ovc			\ Hist AEC/AGC control 1
+   68 a0 ovc			\ Hist AEC/AGC control 2
+   03 a1 ovc			\ Magic
+   d8 a6 ovc			\ Hist AEC/AGC control 3
+   d8 a7 ovc			\ Hist AEC/AGC control 4
+   f0 a8 ovc			\ Hist AEC/AGC control 5
+   90 a9 ovc			\ Hist AEC/AGC control 6
+   94 aa ovc			\ Hist AEC/AGC control 7
+   ( e5 13 ovc	)		\ Control 8
+
+   \ Mostly magic
+   61 0e ovc  4b 0f ovc  02 16 ovc  07 1e ovc
+   02 21 ovc  91 22 ovc  07 29 ovc  0b 33 ovc
+   0b 35 ovc  1d 37 ovc  71 38 ovc  2a 39 ovc
+   78 3c ovc  40 4d ovc  20 4e ovc  00 69 ovc 
+   4a 6b ovc  10 74 ovc  4f 8d ovc  00 8e ovc
+   00 8f ovc  00 90 ovc  00 91 ovc  00 96 ovc
+   ( 00 9a ovc )  84 b0 ovc  0c b1 ovc  0e b2 ovc
+   82 b3 ovc  0a b8 ovc
+
+   \ More magic, some of which tweaks white balance
+   0a 43 ovc  f0 44 ovc  34 45 ovc  58 46 ovc
+   28 47 ovc  3a 48 ovc  88 59 ovc  88 5a ovc
+   44 5b ovc  67 5c ovc  49 5d ovc  0e 5e ovc
+   0a 6c ovc  55 6d ovc  11 6e ovc
+   9f 6f ovc			\ 9e for advance AWB
+   ( 40 6a ovc )
+   ( 40 01 ovc )		\ Blue gain
+   ( 60 02 ovc )		\ Red gain
+   e7 13 ovc			\ Control 8
+
+   \ Matrix coefficients
+   b3 4f ovc  b3 50 ovc  00 51 ovc  3d 52 ovc
+   a7 53 ovc  e4 54 ovc  9e 58 ovc
+
+   \ 08 41 ovc			\ AWB gain enable
+   ( 00 3f ovc )		\ Edge enhancement factor
+   05 75 ovc  e1 76 ovc  ( 00 4c ovc )  01 77 ovc
+   c0 3d ovc			\ Control 13
+   09 4b ovc  ( 60 c9 ovc )
+   38 41 ovc			\ Control 16
+   40 56 ovc
+
+   11 34 ovc
+   12 3b ovc			\ Control 11
+   88 a4 ovc  00 96 ovc  30 97 ovc  20 98 ovc
+   30 99 ovc  84 9a ovc  29 9b ovc  03 9c ovc
+   5c 9d ovc  3f 9e ovc  04 78 ovc
+
+;
+
+: camera-init  ( -- )
+   false to ov7670-detected?
+   ((camera-init)
+   1d ov@ 1c ov@  bwjoin 7fa2 <>  if  exit  then	\ Manufacturing ID
+    b ov@  a ov@  bwjoin 7673 <>  if  exit  then	\ Product ID
+   true to ov7670-detected?
+;
+
+\ VGA RGB565
+: init-rgb565  ( -- )
+   04 12 ov!				\ VGA, RGB565
+   00 8c ov!				\ No RGB444
+   40 04 ov!				\ Control 1: CCIR656 (CaFe value is 00)
+   10 40 ov!				\ RGB565 output
+   38 14 ov!				\ 16x gain ceiling
+   b3 4f ov!				\ v-red
+   b3 50 ov!				\ v-green
+   00 51 ov!				\ v-blue
+   3d 52 ov!				\ u-red
+   a7 53 ov!				\ u-green
+   e4 54 ov!				\ u-blue
+   c0 3d ov!				\ Gamma enable, UV saturation auto adjust
+;
+
+: read-agc  ( -- n )
+   3 ov@  h# c0 and  2 lshift  0 ov@ or
+;
+
+: read-aec  ( -- n )
+   7 ov@  h# 3f and  d# 10 lshift
+   h# 10 ov@  2 lshift  or
+   4 ov@  3 and  or
+;
+
+: set-hw  ( vstop vstart hstop hstart -- )
+   dup  3 >> 17 ov!			\ Horiz start high bits
+   over 3 >> 18 ov!			\ Horiz stop high bits
+   32 ov@ swap 7 and or swap 7 and 3 << or 10 ms 32 ov!	\ Horiz bottom bits
+
+   dup  2 >> 19 ov!			\ Vert start high bits
+   over 2 >> 1a ov!			\ Vert start high bits
+   03 ov@ swap 3 and or swap 3 and 2 << or 10 ms 03 ov!	\ Vert bottom bits
+;
+
+: camera-config  ( -- )
+   ((camera-init)
+   init-rgb565
+   d# 490 d# 10 d# 14 d# 158 set-hw	\ VGA window info
+;
+
+\ ==========================  video capture operations ==========================
+
+d# 640 constant VGA_WIDTH
+d# 480 constant VGA_HEIGHT
+
+VGA_WIDTH VGA_HEIGHT * 2* constant /dma-buf
+3 constant #dma-bufs
+0 value dma-bufs
+0 value dma-bufs-phys
+0 value next-buf
+
+: dma-sync     ( virt phys size -- )         " dma-sync"    $call-parent  ;
+: dma-alloc    ( len -- adr )                " dma-alloc"   $call-parent  ;
+: dma-free     ( adr len -- )                " dma-free"    $call-parent  ;
+: dma-map-in   ( virt size cache? -- phys )  " dma-map-in"  $call-parent  ;
+: dma-map-out  ( virt phys size -- )         " dma-map-out" $call-parent  ;
+
+: 'dma-buf       ( i -- virt )  /dma-buf * dma-bufs      +  ;
+: 'dma-buf-phys  ( i -- phys )  /dma-buf * dma-bufs-phys +  ;
+
+0 [if]
+: alloc-dma-bufs  ( -- )
+   dma-bufs 0=  if
+      /dma-buf #dma-bufs * dup dma-alloc dup to dma-bufs
+      swap false dma-map-in to dma-bufs-phys
+   then
+;
+: free-dma-bufs  ( -- )
+   dma-bufs ?dup  if
+      /dma-buf #dma-bufs 1+ * 2dup dma-bufs-phys swap dma-map-out
+      dma-free
+      0 to dma-bufs  0 to dma-bufs-phys
+   then
+;
+
+: setup-dma  ( -- )
+   #dma-bufs 0  do
+      i 'dma-buf-phys  2 or  i 4 *  340 + cl!	\ Capture frame buffers
+   loop
+;
+[else]
+
+[ifdef] notdef
+\ XXX Capture video to video memory only.  I don't know why I can't capture to
+\ XXX system memory.  I'm using an arbitrary offset into the video memory.
+
+h# 200.0000 constant capture-base
+
+: alloc-dma-bufs  ( -- )
+   dma-bufs 0=  if
+      capture-base dup frame-buffer-adr + to dma-bufs
+      to dma-bufs-phys
+   then
+;
+: free-dma-bufs  ( -- )  0 to dma-bufs 0 to dma-bufs-phys  ;
+[else]
+: alloc-dma-bufs  ( -- )
+   dma-bufs 0=  if
+      /dma-buf #dma-bufs *  " alloc-capture-buffer" $call-parent  to dma-bufs-phys  to dma-bufs
+   then
+;
+: free-dma-bufs  ( -- )
+   dma-bufs  dma-bufs-phys  /dma-buf #dma-bufs *  " free-capture-buffer" $call-parent
+   0 to dma-bufs 0 to dma-bufs-phys
+;
+[then]
+: setup-dma  ( -- )
+   #dma-bufs 0  do
+      i 'dma-buf-phys  340 i 4 * + cl!	\ Capture frame buffers
+   loop
+;
+
+[then]
+
+
+\ VGA RGB565
+: setup-image  ( -- )
+   0         31c cl!			\ Active video scaling control
+   01e2.00f0 334 cl!			\ Maximum data count of active video
+;
+
+: ctlr-config  ( -- )
+   setup-dma
+   setup-image
+;
+
+: ctlr-start  ( -- )  310 dup cl@ 1 or swap cl!  ;		\ Start the whole thing
+: ctlr-stop   ( -- )  310 dup cl@ 1 invert and swap cl!  ;	\ Stop the whole thing
+
+: read-setup  ( -- )
+   camera-config
+   ctlr-config
+   83 300 cl!				\ Clear pending interrupts
+   1000.0000 200 cl!			\ Allow CAP0 end interrupt
+   ctlr-start
+   0 to next-buf
+;
+
+: soft-reset  ( -- )  ;
+
+: (init)  ( -- )
+   0         300 cl!		\ Mask all interrupts
+   8850.2114 310 cl!		\ Enable CLK, FIFO threshold, UYVY, 8-bit CCIR656,
+				\ Capture odd/even in interlace, triple buffers
+   500       350 cl!		\ Disable coring and 640*2 stride
+;
+
+: power-up  ( -- )
+   \ Disable UART
+   8846 dup config-b@  40 invert and swap config-b!	\ Disable UART
+   78 dup seq@ 80 invert and swap seq!		\ Enable VCP/DVP1 interface
+
+   \ Setup VGPIO[2..3]
+   2c dup seq@ 02 or swap seq!			\ Enable VGPIO2..3 ports
+   2c dup seq@ d0 or swap seq!			\ cam_PWREN, cam_Reset
+   1 ms
+   2c dup seq@ f0 or swap seq!			\ Release reset
+   1 ms
+
+   \ Power on video capture port
+   1e dup seq@ c0 or swap seq!			\ Pad on/off according to PMS
+   1 ms
+;
+
+: power-off  ( -- )
+   2c dup seq@ 20 invert and swap seq!		\ Assert cam_Reset
+   1 ms
+   2c dup seq@ 10 invert and swap seq!		\ Power off
+;
+
+: init  ( -- )
+   (init)
+   power-up
+   sccb-setup  smb-on
+   camera-init
+;
+
+
+\ =============================  read operation ==============================
+
+0 value buf-act
+: /string  ( adr len n -- adr' len' )  tuck - -rot + swap  ;
+: buf-done?  ( -- done? )
+   200 cl@ 1000 and dup  if
+      300 cl@ 3 >> 3 and to next-buf
+   then
+;
+
+: (read)  ( adr len -- actual )
+   next-buf 'dma-buf -rot /dma-buf min dup >r move r>	( actual )
+   300 cl@ 83 or 300 cl!		\ Clear interrupts
+;
+
+external
+
+: camera-read   ( adr len -- actual )
+   buf-done?  if  (read)  else  2drop 0  then
+;
+
+: camera-open  ( -- flag )
+   init
+   ov7670-detected? 0=  if  false exit  then
+   alloc-dma-bufs
+   read-setup
+   true
+;
+
+: camera-close  ( -- )
+   ctlr-stop
+   power-off
+   free-dma-bufs
+;
+
+
+\ ============================= selftest operation ===========================
+
+d# 10,000 constant movie-time
+0 constant test-x
+0 constant test-y
+
+\ Thanks to Cortland Setlow (AKA Blaketh) for the autobrightness code
+\ and the full-screen + mirrored display.
+
+: autobright  ( -- )
+   read-agc 3 + 3 rshift  h# f min  " bright!" $call-parent
+;
+: full-brightness  ( -- )  h# f " bright!" $call-parent  ;
+
+: display-frame  ( adr -- )
+\   test-x test-y VGA_WIDTH VGA_HEIGHT draw-rectangle
+   " expand-to-screen" $call-parent
+   autobright
+;
+
+: timeout-read  ( adr len timeout -- actual )
+   >r 0 -rot r>  0  ?do			( actual adr len )
+      2dup camera-read ?dup  if  3 roll drop -rot leave  then
+      1 ms
+
+   loop  2drop
+;
+
+: shoot-movie  ( -- error? )
+   /dma-buf #dma-bufs * dup dma-alloc swap	( adr len )
+   get-msecs movie-time + -rot			( timeout adr len )
+   begin
+      2dup camera-read ?dup 0>  if		( timeout adr len actual )
+         VGA_WIDTH VGA_HEIGHT * 2* / 0  ?do  over display-frame  loop
+      else
+         1 ms
+      then					( timeout adr len )
+      get-msecs 3 pick u>
+   until					( timeout adr len )
+   dma-free drop false				( error? )
+;
+
+: shoot-still  ( -- error? )
+   /dma-buf dup dma-alloc tuck			( adr len adr )
+   /dma-buf d# 1,000 timeout-read 0>  if	( adr len )
+      over display-frame
+      false
+   else
+      true
+   then						( adr len error? )
+   -rot dma-free				( error? )
+;
+
+: mirrored  ( -- )  h# 1e ov@  h# 20 or  h# 1e ov!  ;
+: unmirrored  ( -- )  h# 1e ov@  h# 20 invert and  h# 1e ov!  ;
+
+: selftest  ( -- error? )
+   camera-open 0=  if  true exit  then
+   d# 300 ms
+   unmirrored  shoot-still  ?dup  if  camera-close exit  then	( error? )
+   d# 1,000 ms
+   mirrored   shoot-movie  full-brightness		( error? )
+   camera-close						( error? )
+;
+
+: dump-regs  ( run# -- )
+   0 d# 16 " at-xy" eval
+   ." Pass " .d
+   key upc  h# 47 =  if ." Good" else  ." Bad" then cr  \ 47 is G
+
+   ."        0  1  2  3  4  5  6  7  8  9  a  b  c  d  e  f" cr
+   ."       -----------------------------------------------" cr
+   h# ca 0  do
+      i 2 u.r ." :  "
+      i h# 10 bounds  do
+         i h# ca <  if  i ov@ 3 u.r   then
+      loop
+      cr
+   h# 10 +loop
+;
+
+: xselftest  ( -- error? )
+   camera-open 0=  if  true exit  then
+   h# 10 0 do
+      shoot-still  drop  d# 500 ms  camera-config  config-check
+      i dump-regs
+   loop
+   0 camera-close					( error? )
+;
+
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2009 FirmWorks
+\ 
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\ 
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\ 
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END


Property changes on: dev/olpc/viacamera/camera.fth
___________________________________________________________________
Added: svn:executable
   + *

Added: dev/olpc/viacamera/loadpkg.fth
===================================================================
--- dev/olpc/viacamera/loadpkg.fth	                        (rev 0)
+++ dev/olpc/viacamera/loadpkg.fth	2009-08-09 03:30:55 UTC (rev 1287)
@@ -0,0 +1,27 @@
+dev screen
+\ XXX Capture video to video memory only.  I don't know why I can't capture to
+\ XXX system memory.  I'm using an arbitrary offset into the video memory.
+
+h# 200.0000 constant capture-base
+
+: alloc-capture-buffer  ( len -- vadr padr )
+   >r                                          ( r: len )
+   capture-base 0  h# 0200.0010 my-space or    ( pci-phys.. r: len )
+   r> " map-in" $call-parent                   ( vadr )
+
+   dup >physical                               ( vadr padr )
+;
+
+: free-capture-buffer  ( vadr padr len -- )  nip unmap  ;
+
+: dma-alloc  ( len -- adr )  " dma-alloc" $call-parent  ;
+: dma-free  ( adr len -- )  " dma-free" $call-parent  ;
+
+new-device
+   " camera" device-name
+   fload ${BP}/dev/olpc/viacamera/smbus.fth
+   fload ${BP}/dev/olpc/viacamera/camera.fth
+finish-device
+
+device-end
+

Added: dev/olpc/viacamera/smbus.fth
===================================================================
--- dev/olpc/viacamera/smbus.fth	                        (rev 0)
+++ dev/olpc/viacamera/smbus.fth	2009-08-09 03:30:55 UTC (rev 1287)
@@ -0,0 +1,132 @@
+[ifndef] seq!
+: seq!  3c4 pc! 3c5 pc!  ;
+[then]
+
+[ifndef] seq@
+: seq@  3c4 pc! 3c5 pc@  ;
+[then]
+
+0 value smb-port
+
+: smb-dly  4 us  ;
+: crtsp-set  ( mask -- )  smb-port seq@  or  smb-port seq!  smb-dly  ;
+: crtsp-clr  ( mask -- )  invert  smb-port seq@  and  smb-port seq!  smb-dly  ;
+: crtsp@  ( mask -- flag )  smb-port seq@ and  0<>  ;
+
+: smb-data-hi  ( -- )  h# 10 crtsp-set  ;
+: smb-data-lo  ( -- )  h# 10 crtsp-clr  ;
+: smb-clk-hi  ( -- )  h# 20 crtsp-set  ;
+: smb-clk-lo  ( -- )  h# 20 crtsp-clr  ;
+: smb-data@  ( -- flag )  4 crtsp@  ;
+: smb-clk@  ( -- )  8 crtsp@  ;
+\ : smb-on  ( -- )  1 crtsp-set  h# 30 crtsp-set  d# 10 ms  ;
+: smb-off  ( -- )  1 crtsp-clr  ;
+: smb-on  ( -- )  h# 31 crtsp-set  ;
+: smb-bit@  ( -- )  smb-clk-hi  smb-port seq@ 4 and 0<>  smb-clk-lo  ;
+
+h# 3500 constant smb-clk-timeout-us
+\ Slave can flow control by holding CLK low temporarily
+: smb-wait-clk-hi  ( -- )
+   smb-clk-timeout-us 0  do
+      smb-clk@  if  smb-dly  unloop exit  then  1 us
+   loop
+   true abort" I2C clock stuck low"
+;
+: smb-data-hi-w  ( -- )  smb-data-hi  smb-wait-clk-hi  ;
+
+h# 3500 constant smb-data-timeout-us
+: smb-wait-data-hi  ( -- )
+   smb-data-timeout-us 0  do
+      smb-data@  if  unloop exit  then  1 us
+   loop
+   true abort" I2C data stuck low"
+;
+
+: smb-restart  ( -- )
+   smb-clk-hi  smb-data-lo  smb-clk-lo
+;
+
+: smb-start ( -- )  smb-clk-hi  smb-data-hi  smb-data-lo smb-clk-lo  ;
+: smb-stop  ( -- )  smb-clk-lo  smb-data-lo  smb-clk-hi  smb-data-hi  ;
+
+: smb-get-ack  ( -- )
+   smb-data-hi
+   smb-clk-hi smb-wait-clk-hi  
+   smb-data@  \ drop		\ SCCB generates an don't care bit
+   if  smb-stop  true abort" I2c NAK" then
+   smb-clk-lo
+\   smb-wait-data-hi
+;
+: smb-bit  ( flag -- )
+   if  smb-data-hi  else  smb-data-lo  then
+   smb-clk-hi smb-wait-clk-hi  smb-clk-lo
+;
+
+: smb-byte  ( b -- )
+   8 0  do                     ( b )
+      dup h# 80 and  smb-bit   ( b )
+      2*                       ( b' )
+   loop                        ( b )
+   drop                        ( )
+   smb-get-ack
+;
+: smb-byte-in  ( ack=0/nak=1 -- b )
+   0
+   8 0  do             ( n )
+      smb-clk-hi       ( n )
+      2*  smb-data@  if  1 or  then  ( n' )
+      smb-clk-lo
+   loop
+   swap smb-bit  smb-data-hi  \ Send ACK or NAK
+;
+
+0 value smb-slave
+: smb-addr  ( lowbit -- )  smb-slave or  smb-byte  ;
+
+: smb-byte!  ( byte reg# -- )
+   smb-start
+   0 smb-addr          ( byte reg# )
+   smb-byte            ( byte )
+   smb-byte            ( )
+   smb-stop
+;
+
+: smb-byte@  ( reg# -- byte )
+   smb-start
+   0 smb-addr          ( reg# )
+   smb-byte            ( )
+   smb-stop smb-start	\ SCCB bus needs a stop and a start for the second phase
+   1 smb-addr
+   1 smb-byte-in       ( byte )
+   smb-stop
+;
+
+: smb-word!  ( word reg# -- )
+   smb-start
+   0 smb-addr          ( word reg# )
+   smb-byte            ( word )
+   wbsplit swap smb-byte smb-byte  ( )
+   smb-stop
+;
+
+: smb-word@  ( reg# -- word )
+   smb-start
+   0 smb-addr          ( reg# )
+   smb-byte            ( )
+   smb-restart
+   1 smb-addr          ( )
+   0 smb-byte-in   1 smb-byte-in  bwjoin  ( word )
+   smb-stop
+;
+
+\ This can useful for clearing out DCON SMB internal state
+: smb-pulses  ( -- )
+   d# 32 0  do  smb-clk-lo smb-clk-hi  loop
+;
+
+h# 26 constant dcon-port
+: dcon-setup  ( -- )  dcon-port to smb-port  h# 1a to smb-slave  ;
+: smb-init    ( -- )  dcon-setup  smb-on  smb-pulses  ;
+
+: dcon@  ( reg# -- word )  dcon-setup  smb-word@  ;
+: dcon!  ( word reg# -- )  dcon-setup  smb-word!  ;


Property changes on: dev/olpc/viacamera/smbus.fth
___________________________________________________________________
Added: svn:executable
   + *




More information about the openfirmware mailing list