[openfirmware] [commit] r2019 - cpu/arm/mmp2 cpu/arm/olpc/1.75 dev/geode/ac97 dev/hdaudio dev/olpc/dcon dev/olpc/kb3700 dev/olpc/mmp2camera forth/lib

repository service svn at openfirmware.info
Thu Nov 11 20:13:40 CET 2010


Author: wmb
Date: Thu Nov 11 20:13:40 2010
New Revision: 2019
URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2019

Log:
OLPC XO-1.75 - Rudimentary sound, rtc, accelerometer, compass drivers.  More compact sdhci driver.  EC reflash support.

Added:
   cpu/arm/olpc/1.75/accelerometer.fth
   cpu/arm/olpc/1.75/audiosmb.fth
   cpu/arm/olpc/1.75/compass.fth
   cpu/arm/olpc/1.75/ecflash.fth
   cpu/arm/olpc/1.75/rtc.fth
   cpu/arm/olpc/1.75/smbus.fth
   cpu/arm/olpc/1.75/sound.fth
   forth/lib/tones.fth
Modified:
   cpu/arm/mmp2/mmuon.fth
   cpu/arm/olpc/1.75/devices.fth
   cpu/arm/olpc/1.75/fw-version.fth
   cpu/arm/olpc/1.75/sdhci.fth
   dev/geode/ac97/ac97.bth
   dev/geode/ac97/selftest.fth
   dev/hdaudio/hdaudio.bth
   dev/olpc/dcon/mmp2dcon.fth
   dev/olpc/kb3700/spicmd.fth
   dev/olpc/mmp2camera/loadpkg.fth
   dev/olpc/mmp2camera/platform.fth
   forth/lib/isin.fth

Modified: cpu/arm/mmp2/mmuon.fth
==============================================================================
--- cpu/arm/mmp2/mmuon.fth	Thu Nov 11 19:40:11 2010	(r2018)
+++ cpu/arm/mmp2/mmuon.fth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -26,8 +26,10 @@
    h# 0000.0000  h# c0e  over  fb-pa        map-sections  \ Cache and write bufferable
 \  fw-pa         h# c0e  over  /fw-ram      map-sections  \ Cache and write bufferable
    fb-pa         h# c06  over  fb-size      map-sections  \ Write bufferable
-   h# d100.0000  h# c0e  over  fb-pa        map-sections  \ Cache and write bufferable (SRAM)
+\   h# d100.0000  h# c0e  over  h# 0030.0000 map-sections  \ Cache and write bufferable (SRAM)
+   h# d100.0000  h# c02  over  h# 0030.0000 map-sections  \ I/O - no caching or buffering (SRAM)
    h# d400.0000  h# c02  over  h# 0040.0000 map-sections  \ I/O - no caching or buffering
+   h# e000.0000  h# c02  over  /section     map-sections  \ I/O - no caching or buffering
 ;
 
 : setup-sections

Added: cpu/arm/olpc/1.75/accelerometer.fth
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ cpu/arm/olpc/1.75/accelerometer.fth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -0,0 +1,30 @@
+0 0  " "  " /" begin-package
+" accelerometer" name
+
+\ This is for the stand-alone accelerometer chip LIS33DETR
+
+\ We could call this just once in open if we had a TWSI parent node
+: set-address  ( -- )  h# 3a 6 set-twsi-target  ;
+: accelerometer-on  ( -- )
+   set-address
+   h# 47 h# 20 twsi-b!     \ Power up, X,Y,Z
+;
+: accelerometer-off  ( -- )
+   set-address
+   h# 07 h# 20 twsi-b!     \ Power up, X,Y,Z
+;
+
+: bext  ( b -- n )  dup h# 80 and  if  h# ffffff00 or  then  ;
+: acceleration@  ( -- x y z )
+   set-address
+   h# 29 twsi-b@ bext
+   h# 2b twsi-b@ bext
+   h# 2d twsi-b@ bext
+;
+: open  ( -- flag )
+   ['] accelerometer-on catch 0=   
+;
+: close  ( -- )
+   accelerometer-off
+;
+end-package

Added: cpu/arm/olpc/1.75/audiosmb.fth
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ cpu/arm/olpc/1.75/audiosmb.fth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -0,0 +1,122 @@
+: smb-dly  4 us  ;
+
+: smb-data-hi  ( -- )  d# 163 gpio-set  smb-dly  ;
+: smb-data-lo  ( -- )  d# 163 gpio-clr  smb-dly  ;
+: smb-clk-hi  ( -- )  d# 162 gpio-set  smb-dly  ;
+: smb-clk-lo  ( -- )  d# 162 gpio-clr  smb-dly  ;
+: smb-data@  ( -- flag )  d# 163 gpio-pin@  ;
+: smb-clk@  ( -- flag )  d# 162 gpio-pin@  ;
+: smb-off  ( -- )  d# 163 gpio-dir-in  ;
+: smb-on  ( -- )  d# 163 gpio-dir-out  ;
+: smb-data-dir-out  ( -- )  d# 163 gpio-dir-out  ;
+: smb-data-dir-in  ( -- )  d# 163 gpio-dir-in  ;
+
+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-dir-in
+   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-data-dir-out
+;
+: 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 )
+   smb-data-dir-in
+   0
+   8 0  do             ( n )
+      smb-clk-hi       ( n )
+      2*  smb-data@  if  1 or  then  ( n' )
+      smb-clk-lo
+   loop
+   smb-data-dir-out
+   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
+;
+
+: set-dcon-slave  ( -- )  h# 1a to smb-slave  ;
+: smb-init    ( -- )  set-dcon-slave  smb-on  smb-pulses  ;
+
+: dcon@  ( reg# -- word )  set-dcon-slave  smb-word@  ;
+: dcon!  ( word reg# -- )  set-dcon-slave  smb-word!  ;

Added: cpu/arm/olpc/1.75/compass.fth
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ cpu/arm/olpc/1.75/compass.fth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -0,0 +1,47 @@
+0 0  " "  " /" begin-package
+" compass" name
+
+: set-compass-slave  ( -- )
+   4 to smb-clock-gpio#
+   5 to smb-data-gpio#
+   h# 3c to smb-slave
+;
+: smb-init    ( -- )  set-compass-slave  smb-on  smb-pulses  ;
+
+: compass@  ( reg# -- byte )  set-compass-slave  smb-byte@  ;
+: compass!  ( byte reg# -- )  set-compass-slave  smb-byte!  ;
+: open  ( -- okay? )
+   0 0 ['] compass! catch  if  false exit  then
+   h# a  compass@  [char] H  <>
+;
+: close  ( -- )
+;
+\ XXX need some words to take compass readings
+
+end-package
+
+0 0  " "  " /" begin-package
+" combo-accelerometer" name
+
+: set-sensor-slave  ( -- )  h# 30 6 set-twsi-target  ;
+: sensor@  ( reg# -- byte )  set-sensor-slave  twsi-b@  ;
+: sensor!  ( byte reg# -- )  set-sensor-slave  twsi-b@  ;
+
+: accelerometer-on   ( -- )   h# 27 h# 20 sensor!  ;
+: accelerometer-off  ( -- )   h# 07 h# 20 sensor!  ;
+: wext  ( w -- l )  dup h# 8000 and  if  h# ffff0000 or  then  ;
+: acceleration@  ( -- x y z )
+   set-sensor-slave
+   h# 28 1 6 twsi-get  ( xl xh yl yh zl zh )
+   2>r 2>r             ( xl xh )
+   bwjoin wext         ( x r: zl,zh yl,yh )
+   2r> bwjoin wext     ( x y r: zl,zh )
+   2r> bwjoin wext     ( x y z )
+;   
+
+: open  ( -- okay? )
+   ['] accelerometer-on catch  0=
+;   
+: close  ( -- )  ;
+
+end-package

Modified: cpu/arm/olpc/1.75/devices.fth
==============================================================================
--- cpu/arm/olpc/1.75/devices.fth	Thu Nov 11 19:40:11 2010	(r2018)
+++ cpu/arm/olpc/1.75/devices.fth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -91,7 +91,9 @@
 
 \needs md5init  fload ${BP}/ofw/ppp/md5.fth                \ MD5 hash
 
-fload ${BP}/dev/olpc/spiflash/flashif.fth   \ Generic FLASH interface
+fload ${BP}/cpu/arm/olpc/1.75/smbus.fth    \ Bit-banged SMBUS (I2C) using GPIOs
+
+fload ${BP}/dev/olpc/spiflash/flashif.fth  \ Generic FLASH interface
 
 fload ${BP}/dev/olpc/spiflash/spiif.fth    \ Generic low-level SPI bus access
 
@@ -144,7 +146,6 @@
    fload ${BP}/cpu/arm/olpc/1.75/lcdcfg.fth
 
    fload ${BP}/cpu/arm/olpc/1.75/lcd.fth
-   fload ${BP}/cpu/arm/olpc/1.75/dconsmb.fth     \ SMB access to DCON chip - bitbanged
    fload ${BP}/dev/olpc/dcon/mmp2dcon.fth        \ DCON control
    defer pixel*
    defer pixel+
@@ -219,6 +220,8 @@
 
 devalias keyboard /ec-spi/keyboard
 
+fload ${BP}/cpu/arm/olpc/1.75/ecflash.fth
+
 0 0  " d4208000"  " /" begin-package  \ USB Host Controller
    h# 200 constant /regs
    my-address my-space /regs reg
@@ -254,6 +257,11 @@
 
 fload ${BP}/dev/olpc/mmp2camera/loadpkg.fth
 
+fload ${BP}/cpu/arm/olpc/1.75/sound.fth
+fload ${BP}/cpu/arm/olpc/1.75/rtc.fth
+fload ${BP}/cpu/arm/olpc/1.75/accelerometer.fth
+fload ${BP}/cpu/arm/olpc/1.75/compass.fth
+
 warning @ warning off
 : stand-init
    stand-init

Added: cpu/arm/olpc/1.75/ecflash.fth
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ cpu/arm/olpc/1.75/ecflash.fth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -0,0 +1,96 @@
+\ See license at end of file
+purpose: Reflash the EC code
+
+0 value ec-ih
+: open-ec  ( -- )
+   ec-ih 0=  if
+      " /eccmd" open-dev to ec-ih
+   then
+   ec-ih 0= abort" Can't open eccmd node"
+;
+: close-ec  ( -- )
+   ec-ih  if
+      ec-ih close-dev
+      0 to ec-ih
+   then
+;
+
+h# 10000 value /ec-flash
+
+char 3 value expected-ec-version
+
+: check-signature  ( adr -- )
+   h# ff00 +                   ( adr' )
+   dup  " XO-EC" comp abort" Bad signature in EC image"  ( adr )
+   dup ." EC firmware verison: " cscount type cr         ( adr )
+   dup 6 + c@ expected-ec-version <>  abort" Wrong EC version"  ( adr )
+   drop
+;
+: ?ec-image-valid  ( adr len -- )
+   dup /ec-flash <>  abort" Image file is the wrong size"   ( adr len )
+   over c@ h# 02 <>  abort" Invalid EC image - must start with 02"
+   2dup 0 -rot  bounds ?do  i l@ +  /l +loop    ( adr len checksum )
+   abort" Incorrect EC image checksum"          ( adr len )
+   over check-signature                         ( adr len )
+   2drop
+;
+
+0 value ec-file-loaded?
+: get-ec-file  ( "name" -- )
+   safe-parse-word  ." Reading " 2dup type cr
+   $read-open
+   load-base /ec-flash  ifd @ fgets  ( len )
+   ifd @ fclose                      ( len )
+   load-base swap ?ec-image-valid
+;
+: flash-ec  ( "filename" -- )
+   get-ec-file
+   open-ec
+   " enter-updater" ec-ih $call-method
+   ." Erasing ..." " erase-flash" ec-ih $call-method cr
+   ." Writing ..." load-base /ec-flash 0 " write-flash" ec-ih $call-method  cr
+   ." Verifying ..."
+   load-base /ec-flash + /ec-flash 0 " read-flash" ec-ih $call-method
+   load-base  load-base /ec-flash +  /ec-flash  comp
+   abort" Miscompare!"
+   cr
+   " reboot-ec" ec-ih $call-method
+   close-ec
+;
+: read-ec-flash  ( -- )
+   open-ec
+   " enter-updater" ec-ih $call-method
+   flash-buf /ec-flash 0 " read-flash" ec-ih $call-method
+\  " reboot-ec" ec-ih $call-method
+   close-ec
+;
+: save-ec-flash  ( "name" -- )
+   safe-parse-word $new-file
+   read-ec-flash
+   load-base /ec-flash ofd @ fputs
+   ofd @ fclose
+;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2010 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

Modified: cpu/arm/olpc/1.75/fw-version.fth
==============================================================================
--- cpu/arm/olpc/1.75/fw-version.fth	Thu Nov 11 19:40:11 2010	(r2018)
+++ cpu/arm/olpc/1.75/fw-version.fth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -1,3 +1,3 @@
 \ The overall firmware revision
 macro: FW_MAJOR A
-macro: FW_MINOR 04
+macro: FW_MINOR 04c

Added: cpu/arm/olpc/1.75/rtc.fth
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ cpu/arm/olpc/1.75/rtc.fth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -0,0 +1,9 @@
+0 0  " "  " /" begin-package
+" rtc" name
+
+: set-address  ( -- )  h# d0 2 set-twsi-target  ;
+: rtc@  ( reg# -- byte )  set-address  twsi-b@  ;
+: rtc!  ( byte reg# -- )  set-address  twsi-b!  ;
+: open  ( -- okay )  true  ;
+: close  ( -- )  ;
+end-package

Modified: cpu/arm/olpc/1.75/sdhci.fth
==============================================================================
--- cpu/arm/olpc/1.75/sdhci.fth	Thu Nov 11 19:40:11 2010	(r2018)
+++ cpu/arm/olpc/1.75/sdhci.fth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -15,13 +15,16 @@
    patch 203  003 card-clock-50    \ n is 2, divisor is 4, clk is 50 MHz
    patch 043 8003 card-clock-slow  \ n is h# 100 (high 2 bits in [7:6], for divisor of 512 from 200 MHz clock
 
-   : gpio-card-inserted?  ( -- flag )  d# 31 gpio-pin@ 0=  ;
-   ' gpio-card-inserted? to card-inserted?
+   : olpc-card-inserted?  ( -- flag )
+      slot 1 =  if  d# 31 gpio-pin@ 0=  else  true  then
+   ;
+   ' olpc-card-inserted? to card-inserted?
 
-   : gpio-power-on  ( -- )  sdhci-card-power-on  d# 35 gpio-set  ;
+   \ Slot:power_GPIO - 1:35, 2:34, 3:33
+   : gpio-power-on  ( -- )  sdhci-card-power-on  d# 36 slot - gpio-set  ;
    ' gpio-power-on to card-power-on
 
-   : gpio-power-off  ( -- )  d# 35 gpio-clr  sdhci-card-power-off  ;
+   : gpio-power-off  ( -- )  d# 36 slot - gpio-clr  sdhci-card-power-off  ;
    ' gpio-power-off to card-power-off
 
    new-device
@@ -31,64 +34,13 @@
       " external" " slot-name" string-property
    finish-device
 
-end-package
-
-0 0  " d4280800"  " /"  begin-package
-
-   fload ${BP}/cpu/arm/olpc/1.75/sdregs.fth
-   fload ${BP}/dev/mmc/sdhci/sdhci.fth
-
-   true to avoid-high-speed?
-
-   hex
-   \ The new clock divisor layout is low 8 bits in [15:8] and high 2 bits in [7:6]
-   \ The resulting 10-bit value is multiplied by 2 to form the divisor for the
-   \ 200 MHz base clock.
-   patch 403  103 card-clock-25    \ n is 4, divisor is 8, clk is 25 MHz
-   patch 203  003 card-clock-50    \ n is 2, divisor is 4, clk is 50 MHz
-   patch 043 8003 card-clock-slow  \ n is h# 100 (high 2 bits in [7:6], for divisor of 512 from 200 MHz clock
-
-   ' true to card-inserted?
-
-   : gpio-power-on  ( -- )  sdhci-card-power-on  d# 34 gpio-set  ;
-   ' gpio-power-on to card-power-on
-
-   : gpio-power-off  ( -- )  d# 34 gpio-clr  sdhci-card-power-off  ;
-   ' gpio-power-off to card-power-off
-
    new-device
-      1 encode-int " reg" property
+      2 encode-int " reg" property
       fload ${BP}/dev/mmc/sdhci/mv8686/loadpkg.fth
    finish-device
 
-end-package
-
-0 0  " d4281000"  " /"  begin-package
-
-   fload ${BP}/cpu/arm/olpc/1.75/sdregs.fth
-   fload ${BP}/dev/mmc/sdhci/sdhci.fth
-
-   true to avoid-high-speed?
-
-   hex
-   \ The new clock divisor layout is low 8 bits in [15:8] and high 2 bits in [7:6]
-   \ The resulting 10-bit value is multiplied by 2 to form the divisor for the
-   \ 200 MHz base clock.
-   patch 403  103 card-clock-25    \ n is 4, divisor is 8, clk is 25 MHz
-   patch 203  003 card-clock-50    \ n is 2, divisor is 4, clk is 50 MHz
-   patch 043 8003 card-clock-slow  \ n is h# 100 (high 2 bits in [7:6], for divisor of 512 from 200 MHz clock
-
-   ' true to card-inserted?
-
-   : gpio-power-on  ( -- )  sdhci-card-power-on d# 33 gpio-set  ;
-   ' gpio-power-on to card-power-on
-
-   : gpio-power-off  ( -- )  d# 33 gpio-clr  sdhci-card-power-off  ;
-   ' gpio-power-off to card-power-off
-
-
    new-device
-      1 encode-int " reg" property
+      3 encode-int " reg" property
       fload ${BP}/dev/mmc/sdhci/sdmmc.fth
       \ fload ${BP}/dev/mmc/sdhci/selftest.fth
       " internal" " slot-name" string-property

Added: cpu/arm/olpc/1.75/smbus.fth
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ cpu/arm/olpc/1.75/smbus.fth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -0,0 +1,141 @@
+1 value smb-dly-us
+
+4 value smb-clock-gpio#
+5 value smb-data-gpio#
+
+: smb-dly  smb-dly-us us  ;
+: smb-data-hi  ( -- )  smb-data-gpio# gpio-set  smb-dly  ;
+: smb-data-lo  ( -- )  smb-data-gpio# gpio-clr  smb-dly  ;
+: smb-clk-hi  ( -- )  smb-clock-gpio# gpio-set  smb-dly  ;
+: smb-clk-lo  ( -- )  smb-clock-gpio# gpio-clr  smb-dly  ;
+: smb-data@  ( -- flag )  smb-data-gpio# gpio-pin@  ;
+: smb-clk@  ( -- flag )  smb-clock-gpio# gpio-pin@  ;
+: smb-off  ( -- )  smb-data-gpio# gpio-dir-in  ;
+: smb-on  ( -- )  smb-data-gpio# gpio-dir-out  ;
+: smb-data-dir-out  ( -- )  smb-data-gpio# gpio-dir-out  ;
+: smb-data-dir-in  ( -- )  smb-data-gpio# gpio-dir-in  ;
+
+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-dir-in
+   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-data-dir-out
+;
+: 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 )
+   smb-data-dir-in
+   0
+   8 0  do             ( n )
+      smb-clk-hi       ( n )
+      2*  smb-data@  if  1 or  then  ( n' )
+      smb-clk-lo
+   loop
+   smb-data-dir-out
+   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-read-n  ( n reg# -- byte0 .. byten-1 )
+   smb-start           ( n reg# )
+   0 smb-addr          ( n reg# )
+   smb-byte            ( n )
+   smb-stop smb-start	\ SCCB bus needs a stop and a start for the second phase
+   1 smb-addr          ( n )
+   ?dup  if            ( n )
+      1- 0  ?do  0 smb-byte-in  loop  ( byte0 .. byten-2 )
+      1 smb-byte-in    ( byte0 .. byten-2 )
+   then                ( byte0 .. byten-2 )
+   smb-stop            ( byte0 .. byten-2 )
+;   
+
+: smb-write-n  ( byten-1 .. byte0 n reg# -- )
+   smb-start               ( byten-1 .. byte0 n reg# )
+   0 smb-addr              ( byten-1 .. byte0 n reg# )
+   smb-byte                ( byten-1 .. byte0 n )
+   0  ?do  smb-byte  loop  ( )
+   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
+;

Added: cpu/arm/olpc/1.75/sound.fth
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ cpu/arm/olpc/1.75/sound.fth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -0,0 +1,362 @@
+0 0  " d42a0c00"  " /" begin-package
+" audio" name
+my-space h# 40 reg
+
+: sspa!  ( n offset -- )  h# d42a.0c00 + l!  ;  \ Write a register in SSPA1
+: sspa@  ( offset -- n )  h# d42a.0c00 + l@  ;  \ Read a register in SSPA1
+: adma!  ( n offset -- )  h# d42a.0800 + l!  ;
+: adma@  ( offset -- n )  h# d42a.0800 + l@  ;
+
+: audio-clock-on  ( -- )
+   h# 600 h# d428.290c l!  d# 10 us  \ Enable
+   h# 610 h# d428.290c l!  d# 10 us  \ Release reset
+   h# 710 h# d428.290c l!  d# 10 us  \ Enable
+   h# 712 h# d428.290c l!  d# 10 us  \ Release reset
+
+
+   \  * 10 / 27 gives about 147.456
+   \ The M/N divisor gets 199.33 MHz (Figure 283 - clock tree - in Datasheet)
+   \ But the M/N divisors always have an implicit /2 (section 7.3.7 in datasheet),
+   \ so the input frequency is 99.67 with respect to NOM (sic) and DENOM.
+   \ we want 24.576 MHz SYSCLK.  99.67 * 18 / 73 = 24.575 - 50 ppm error.
+   d# 18 d# 15 lshift d# 73 or h# d000.0000 or  h# d4050040 l!
+
+   h# d405.0024 l@  h# 20 or  h# d405.0024 l!  \ Enable 12S clock out to SSPA1
+
+   h# 10800 38 sspa!
+   \ Bits 14:9 set the divisor from SYSCLK to BITCLK.  The setting below
+   \ is d# 16, which gives BITCLK = 3.072 MHz.  That's 32x 48000, just enough
+   \ for two (stereo) 16-bit samples.
+\   h#  2183 34 sspa!
+  
+   h#  2183 34 sspa!  \ Divisor 16 - BITCLK = 3.072 Mhz
+;
+
+: setup-sspa-rx  ( -- )
+   h# 8000.0000  \ Dual phase (stereo)
+   0 d# 24 lshift or  \ 1 word in phase 2
+   2 d# 21 lshift or  \ 16 bit word in phase 2
+   0 d# 19 lshift or  \ 0 bit delay
+   2 d# 16 lshift or  \ 16-bit audio sample in phase 2
+   0 d#  8 lshift or  \ 1 word in phase 1
+   2 d#  5 lshift or  \ 16 bit word in phase 1
+   0 d#  3 lshift or  \ Left justified data
+   2 d#  0 lshift or  \ 16-bit audio sample in phase 1
+   h# 08 sspa!   \ Receive control register
+
+   h# 8000.0000          \ Enable writes
+   d# 15 d# 20 lshift or \ Frame sync width
+   1     d# 18 lshift or \ Internal clock - master configuration
+   0     d# 17 lshift or \ Sample on rising edge of clock
+   0     d# 16 lshift or \ Active high frame sync
+   d# 31 d#  4 lshift or \ Frame sync period
+   1     d#  2 lshift or \ Flush the FIFO
+   h# 0c sspa!
+;
+: enable-sspa-rx  ( -- )  h# 0c sspa@  h# 8004.0001 or  h# 0c sspa!  ;
+: disable-sspa-rx  ( -- )  h# 0c sspa@  h# 8000.0040 or  h# 4.0001 invert and    h# 0c sspa!  ;
+
+
+: setup-sspa-tx  ( -- )
+   h# 8000.0000  \ Dual phase (stereo)
+   0 d# 24 lshift or  \ 1 word in phase 2
+   2 d# 21 lshift or  \ 16 bit word in phase 2
+   0 d# 19 lshift or  \ 0 bit delay
+   2 d# 16 lshift or  \ 16-bit audio sample in phase 2
+   1 d# 15 lshift or  \ Transmit last sample when FIFO empty
+   0 d#  8 lshift or  \ 1 word in phase 1
+   2 d#  5 lshift or  \ 16 bit word in phase 1
+   0 d#  3 lshift or  \ Left justified data
+   2 d#  0 lshift or  \ 16-bit audio sample in phase 1
+   h# 88 sspa!   \ Receive control register
+
+   h# 8000.0000          \ Enable writes
+   d# 15 d# 20 lshift or \ Frame sync width
+   1     d# 18 lshift or \ Internal clock - master configuration
+\  0     d# 18 lshift or \ External clock - slave configuration (Rx is master)
+   0     d# 17 lshift or \ Sample on rising edge of clock
+   0     d# 16 lshift or \ Active high frame sync
+   d# 31 d#  4 lshift or \ Frame sync period
+   1     d#  2 lshift or \ Flush the FIFO
+   h# 8c sspa!
+;
+: enable-sspa-tx  ( -- )  h# 8c sspa@  h# 8004.0001 or  h# 8c sspa!  ;
+: disable-sspa-tx  ( -- )  h# 8c sspa@  h# 8000.0040 or  h# 4.0001 invert and  h# 8c sspa!  ;
+: set-tx-fifo-limit  ( n -- )  h# 90 sspa!  ;
+: set-rx-fifo-limit  ( n -- )  h# 10 sspa!  ;
+
+: putsample  ( w -- )
+   d# 16 lshift    \ Justify               ( l )
+   h# a0 sspa@                             ( l fifo-size )
+   begin  dup h# 9c sspa@ <>  until  drop  ( w )
+   h# 80 sspa!
+;
+: getsample  ( -- w )
+   begin  h# 1c sspa@  until
+   0 sspa@ d# 16 rshift
+;
+: audio-in  ( adr len -- actual )
+   tuck bounds  ?do
+      getsample  i w!
+   /w +loop
+;
+: audio-out  ( adr len -- actual )
+   tuck bounds  ?do
+      i w@  putsample
+   /w +loop
+;
+0 value descriptors
+0 value /descriptors
+: make-out-dma-descriptor-chain  ( adr len -- )
+   dup h# 8000 round-up h# 8000 / to /descriptors
+   /descriptors alloc-mem  to descriptors    ( adr len )
+   descriptors /descriptors  bounds  ?do     ( adr len )
+      dup h# 8000 max     i l!               ( adr len )
+      over          i 1 la+ l!               ( adr len )
+      h# d42a.0c80  i 2 la+ l!               ( adr len )
+      i h# 10 +     i 3 la+ l!               ( adr len )
+      h# 8000 /string                        ( adr' len' )
+   h# 10 +loop                               ( adr len )
+   2drop
+   0 descriptors /descriptors + -1 la+ l!
+;
+: make-in-dma-descriptor-chain  ( adr len -- )
+   dup h# 8000 round-up h# 8000 / to /descriptors
+   /descriptors alloc-mem  to descriptors    ( adr len )
+   descriptors /descriptors  bounds  ?do     ( adr len )
+      dup h# 8000 max     i l!               ( adr len )
+      h# d42a.0c00  i 1 la+ l!               ( adr len )
+      over          i 2 la+ l!               ( adr len )
+      i h# 10 +     i 3 la+ l!               ( adr len )
+      h# 8000 /string                        ( adr' len' )
+   h# 10 +loop                               ( adr len )
+   2drop
+   0 descriptors /descriptors + -1 la+ l!
+;
+: dma-audio-in  ( adr len -- )
+   make-in-dma-descriptor-chain
+   \ Channel 1
+   tuck  4 adma!  h# 14 adma! \ Address and length
+   h# d42a.0c00 h# 24 adma!   \ RX Data register
+   0 h# 34 adma!              \ Next descriptor
+   h# 0081.1208   h# 44 adma! \ 16 bits, pack, enable, non-chain, inc dest, hold src
+;
+: dma-audio-out  ( adr len -- )
+   \ Channel 0
+   tuck  0 adma!  h# 10 adma! \ Address and length
+   h# d42a.0c80 h# 20 adma!   \ Tx data register
+   0 h# 30 adma!              \ Next descriptor
+   h# 0081.1220   h# 40 adma! \ 16 bits, pack, enable, non-chain, hold dest, inc src
+;
+: write-done  ;
+
+: open-in   ( -- )  h# 10 set-tx-fifo-limit enable-sspa-rx  ;
+: close-in  ( -- )  disable-sspa-rx  ;
+: open-out  ( -- )  h# 10 set-tx-fifo-limit enable-sspa-tx  ;
+: close-out ( -- )  disable-sspa-tx  ;
+
+\ Reset is unconnected on current boards
+\ : audio-reset  ( -- )  8 gpio-clr  ;
+\ : audio-unreset  ( -- )  8 gpio-set  ;
+: codec@  ( reg# -- w )  1 2 twsi-get  swap bwjoin  ;
+: codec!  ( w reg# -- )  >r wbsplit r> 3 twsi-write  ;
+: codec-i@  ( index# -- w )  h# 6a codec!  h# 6c codec@  ;
+: codec-i!  ( w index# -- )  h# 6a codec!  h# 6c codec!  ;
+
+: codec-set  ( bitmask reg# -- )  tuck codec@  or  swap codec!  ;
+: codec-clr  ( bitmask reg# -- )  tuck codec@  swap invert and  swap codec!  ;
+: codec-field  ( value-mask field-mask reg# -- )
+   >r r@ codec@      ( value-mask field-mask value r: reg# )
+   swap invert and   ( value-mask masked-value r: reg# )
+   or                ( final-value  r: reg# )
+   r> codec!         ( )
+;
+
+: codec-bias-off  ( -- )
+   h# 8080 h# 02 codec-set
+   h# 8080 h# 04 codec-set
+   h# 0000 h# 3a codec!
+   h# 0000 h# 3c codec!
+   h# 0000 h# 3e codec!
+;
+: linux-codec-on
+   h# 0000 h# 26 codec!  \ Don't power down any groups
+   h# 8000 h# 53 codec!  \ Disable fast vref
+   h# 0c00 h# 3e codec!  \ enable HP out volume power
+   h# 0002 h# 3a codec!  \ enable Main bias
+   h# 2000 h# 3c codec!  \ enable Vref
+   h# 6808 h# 0c codec!  \ Stereo DAC Volume
+   h# 3f3f h# 14 codec!  \ ADC Record Mixer Control
+   h# 4b40 h# 1c codec!  \ Output Mixer Control
+   h# 0500 h# 22 codec!  \ Microphone Control
+   h# 04e8 h# 40 codec!  \ General Purpose Control
+;
+: codec-on  ( -- )
+   h# 30 1 set-twsi-target
+   h# 0000 h# 26 codec!  \ Don't power down any groups
+   h# 8002 h# 34 codec!  \ Slave mode, 16 bits, left justified
+   b# 1000.1000.0011.1111 h# 3a codec!  \ All on except MONO depop, 0-cross
+   b# 1010.0011.1111.0011 h# 3c codec!  \ All on except ClassAB, PLL, speaker mixer, MONO mixer
+   b# 0011.1111.1100.1111 h# 3e codec!  \ All on except MONO_OUT and PHONE in
+   h# 0140 h# 40 codec!  \ MCLK is SYSCLK, HPamp Vmid 1.25, ClassDamp Vmid 1.5
+;
+: codec-off  ( -- )
+   h# ef00 h# 26 codec!  \ Power down everything
+;
+
+\ Mic bias 2 is for external mic
+\ I think we don't need to use the audio PLL, because we are using the PMUM M/N divider
+\ DIV_MCL 0  DIV_FBCLK 01 FRACT 00da1
+\ POSTDIV 1  DIV_OCLK_MODULO 000 (NA)  DIV_OCLK_PATTERN 00 (NA)  
+\ : setup-audio-pll  ( -- )
+\    h# 000d.a189 h# 38 sspa!
+\    h# 0000.0000 h# 3c sspa!
+\ ;
+
+: init-audio  ( -- )
+   audio-clock-on
+   codec-on
+   setup-sspa-rx
+   setup-sspa-tx
+;
+: test-setup  ( -- )
+   h# 2000 0 do
+      i     h# e000.0000 i wa+  w!
+   loop
+;
+: dma  h# e000.0000 h# 4000 dma-audio-out  ;
+: run  open-out  d# 200 ms  close-out  ;
+
+0 [if]
+\ Notes:
+\ Page 1504 - what does "RTC (and WTC) for sync fifo" mean?
+\ Page 1508 - SSPA_AUD_PLL_CTRL1 bit 17 refers to "zsp_clk_gen" <- undefined term appears nowhere else in either document
+\ Page 1501 - do the Frame-Sync Width and Frame-Sync Active fields matter in slave mode, or are they only relevant in master mode???  If they matter in slave mode, what do they control, considering that the external code is driving FSYNC and thus controls its width.
+\ Page 1506 - For I2S_RXDATA, the connection from the pin driver to RX_DATA_IN(18) is shown going to the (disabled) output driver.  I think it should come from the input (left-pointing triangle) instead.
+\ Page 1506 - The "18" and "19" notation is unexplained and unclear.  I sort of think that 18 means the Rx direction and 19 the Tx direction.  If so, and the diagram is correct, then you cannot drive FSYNC from the Tx direction.  If that is the case, it ought to be explained elsewhere too.  In particular, if you can't drive FSYNC from Tx, what are the FWID and FPER fields in SSPA_TX_SP_CTRL for?
+\ Page 1506 - The diagram shows the ENB for the I2S_BITCLK driver coming from M/S_19 in SSPA.  But the Master/Slave bits in both SSPA_TX_SP_CTRL and SSPA_RX_SP_CTRL have no effect on whether BITCLK is driven.  It seems to be controlled by bit 8 in SSPA_AUD_CTRL0 (which is misnamed as enabling the SYSCLK Divider, not the BITCLK output.  Which makes me wonder what enables the I2S_FSYNC signal, which is shown as being enabled along with I2S_BITCLK.  But I can't seem to get FSYNC to come out.
+\ What is the relationship between Rx master mode and Tx master mode with regards to whether FSYNC is driven?  Empirically, if I turn on and enable the Rx portion, FSYNC comes on, but if I then turn on the Tx portion, FSYNC turns off until I enable the Tx portion.  After that, Tx seems to control FSYNC and nothing I do seems to let Rx control it.
+\ Page 1502 - S_RST is listed as W, but empirically it is readable.  When you write 1 to it, the 1 sticks and you have to write 0 again.  It's unclear which of the registers it really resets.  It doesn't reset the register it is in.
+\ Page 1498 - The data transmit register is listed as RO.  How can a transmit register be RO????
+[then]
+
+: mic-gain  ( bits11:8 -- )  h# f00 h# 22 codec-field  ;
+: mic+0db   ( -- )  0 mic-gain  ;  \ Needed
+: mic+20db  ( -- )  h# 500 mic-gain  ;  \ Needed
+: mic+30db   ( -- )  h# a00 mic-gain  ;
+: mic+40db   ( -- )  h# f00 mic-gain  ;
+
+
+: mic-bias-off  ( -- )  h# 000c h# 3a codec-clr  ;
+: mic-bias-on   ( -- )  h# 000c h# 3a codec-set  ;
+
+: mic1-high-bias  ( -- )  h# 20 h# 22 codec-clr  mic-bias-on  ;  \ 0.90*AVDD, e.g. 3V with AVDD=3.3V
+: mic1-low-bias   ( -- )  h# 20 h# 22 codec-set  mic-bias-on  ;  \ 0.75*AVDD, e.g. 2.5V with AVDD=3.3V
+: mic2-high-bias  ( -- )  h# 10 h# 22 codec-clr  mic-bias-on  ;  \ 0.90*AVDD, e.g. 3V with AVDD=3.3V
+: mic2-low-bias   ( -- )  h# 21 h# 22 codec-set  mic-bias-on  ;  \ 0.75*AVDD, e.g. 2.5V with AVDD=3.3V
+
+\ The mic bias short circuit detection threshold can be set with reg 0x22 bits 1:0 -
+\ 00:600uA  01:1200uA  1x:1800uA
+\ 600uA is probably good for OLPC, since the 5.6K bias resistor limits the SC current to less than that.
+
+\ Sets both speakers simultaneously
+: speakers-source  ( value -- )  h# d800 h# 1c codec-field  ;
+
+: speakers-off  ( -- )  0  speakers-source  ;
+: hp-mixer>speakers  ( -- )  h# 4800  speakers-source  ;
+: speaker-mixer>speakers  ( -- )  h# 9000  speakers-source  ;
+: mono>speakers  ( -- )  h# d800  speakers-source  ;
+
+: class-ab-speakers  ( -- )  h# 2000 h# 1c codec-clr  ;
+: class-d-speakers  ( -- )  h# 2000 h# 1c codec-set  ;
+
+: headphones-off  ( -- )  h# 300 h# 1c codec-clr  ;
+: headphones-on   ( -- )  h# 300 h# 1c codec-set  ;
+
+0 [if]  \ OLPC does not connect the MONO output
+: mono-source  ( value -- )  h# c0 h# 1c codec-field  ;
+: mono-off  ( -- )  0 mono-source  ;
+: hp-mixer>mono  ( -- )  h# 40 mono-source  ;
+: speaker-mixer>mono  ( -- )  h# 80 mono-source  ;
+: mono-mixer>mono  ( -- )  h# c0 mono-source  ;
+[then]
+
+: headphones-inserted?  ( -- flag )  h# 54 codec@ 2 and 0<>  ;
+
+\ 0 is off, 1 is softest non-off, etc
+: set-record-gain  ( n -- )
+   0 max  h# 1f max  dup 7 lshift   h# 0f9f h# 12 codec-field
+;
+: attenuation>lr  ( n -- true | regval false )
+   0 max        ( n' )
+   ?dup  if     ( n )
+      h# 1f min
+      h# 20 swap -
+      dup 8 lshift or  ( regval )
+      false
+   else         ( )
+      true
+   then
+;   
+: >output-volume  ( n -- regval mask )
+   attenuation>lr  if  h# 8080  then   h# 9f9f       
+;
+: set-speaker-volume    ( n -- )  >output-volume  2 codec-field  ;
+: set-headphone-volume  ( n -- )  >output-volume  4 codec-field  ;
+\ : set-mono-volume       ( n -- )  >output-volume  6 codec-field  ;
+: set-volume  ( n -- )
+   dup set-speaker-volume  set-headphone-volume
+;
+d# 8 constant default-dac-gain
+
+d# 20 constant default-volume
+
+: select-headphones  ( -- )  h# 300 h# 1c codec!  ;
+: select-speakers-ab  ( -- )  h# 4800 h# 1c codec!  ;  \ ClassAB, headphone mixer
+: select-speakers  ( -- )  h# 6800 h# 1c codec!  ;  \ ClassD, headphone mixer
+
+: set-line-in-gain  ( n -- )
+   attenuation>lr  if  h# e000  then  h# ff1f  h# a  codec-field
+;
+: set-dac-gain  ( n -- )
+   attenuation>lr  if  h# e000  then  h# ff1f  h# c  codec-field
+;
+false value external-mic?
+: mic-routing  ( -- n )
+   \ Mute selected MIC inputs to the ADC as follows:
+   \ For external, we send MIC1 to left and MIC2 to right
+   \ For internal, we send MIC1 to both left and right
+   external-mic?  if   h# 2040  else  h# 2020  then
+;
+: set-mic-gain  ( n -- )
+   attenuation>lr  if  ( )  \ Mute
+      \ Turn everything off
+      0  h# 6060  h# e0e0     ( gain adc-mute mic-output-mute )
+   else                       ( gain )
+      \ Mic routing to ADC depends on internal or external mic
+      \ We route the mic only to the headphone output
+      mic-routing  h# 6060    ( gain adc-mute mic-output-mute )
+   then                       ( gain adc-mute mic-output-mute )
+   h# e0e0 h# 10 codec-field  ( gain adc-mute )
+   h# 6060 h# 14 codec-field  ( gain )
+   h# 1f1f h# 0c codec-field
+;
+
+: stereo  ;
+: mono  ;
+
+d# 48000 value sample-rate
+: open  ( -- flag )
+   init-audio
+   headphones-inserted?  if  select-headphones  else  select-speakers  then
+   default-volume set-volume
+   default-dac-gain set-dac-gain
+   true
+;
+: close  ( -- )  ;
+.s cr
+
+fload ${BP}/forth/lib/isin.fth
+fload ${BP}/forth/lib/tones.fth
+
+end-package

Modified: dev/geode/ac97/ac97.bth
==============================================================================
--- dev/geode/ac97/ac97.bth	Thu Nov 11 19:40:11 2010	(r2018)
+++ dev/geode/ac97/ac97.bth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -10,6 +10,7 @@
 FCode-version2
 fload ${BP}/dev/geode/ac97/ac97.fth
 fload ${BP}/forth/lib/isin.fth
+fload ${BP}/forth/lib/tones.fth
 fload ${BP}/dev/geode/ac97/selftest.fth
 end0
 

Modified: dev/geode/ac97/selftest.fth
==============================================================================
--- dev/geode/ac97/selftest.fth	Thu Nov 11 19:40:11 2010	(r2018)
+++ dev/geode/ac97/selftest.fth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -34,61 +34,9 @@
    record-base  record-len  audio-out drop  write-done
 ;
 
-d# 500 value tone-freq
-
-: /cycle  ( -- #bytes )  #cycle /l*  ;
-
-: make-cycle  ( adr -- adr' )
-   #quarter-cycle 1+  0  do               ( adr )
-      i isin                              ( adr isin )
-      2dup  swap  i la+ w!                ( adr isin )
-      2dup  swap  #half-cycle i - la+ w!  ( adr isin )
-      negate                              ( adr -isin )
-      2dup  swap  #half-cycle i + la+ w!  ( adr -isin )
-      over  #cycle i - la+ w!             ( adr )
-   loop                                   ( adr )
-   /cycle +
-;
-
-\ This version puts the tone first into the left channel for
-\ half the time, then into the right channel for the remainder
-: make-tone  ( freq -- )
-   sample-rate to fs  ( freq )  set-freq
-
-   \ Start with everything quiet
-   record-base record-len erase
-
-   record-base  make-cycle  drop
-
-   \ Copy the wave template into the left channel
-   record-base /cycle +   record-len 2/  /cycle -  bounds  ?do
-      record-base  i  /cycle  move
-   /cycle +loop
-
-   \ Copy the wave template into the right channel
-   record-base record-len 2/ + wa1+  record-len 2/ /cycle -   bounds  ?do
-      record-base  i  /cycle  move
-   /cycle +loop
-;
-
-\ This version puts the tone into both channels simultaneously
-: make-tone2  ( freq -- )
-   sample-rate to fs  ( freq )  set-freq
-
-   record-base  make-cycle  drop
-
-   \ Duplicate left into right in the template
-   record-base  #cycle /l*  bounds  ?do  i w@  i wa1+ w!  /l +loop
-
-   \ Replicate the template
-   record-base /cycle +   record-len /cycle -  bounds  ?do
-      record-base  i  /cycle  move
-   /cycle +loop
-;
-
 : tone  ( freq -- )
-   record-len la1+  " dma-alloc" $call-parent  to record-base
-   make-tone
+   record-len la1+  " dma-alloc" $call-parent  to record-base  ( freq )
+   record-base record-len  rot sample-rate make-tone           ( )
    d# -9 set-volume  play
    record-base record-len la1+  " dma-free" $call-parent
 ;

Modified: dev/hdaudio/hdaudio.bth
==============================================================================
--- dev/hdaudio/hdaudio.bth	Thu Nov 11 19:40:11 2010	(r2018)
+++ dev/hdaudio/hdaudio.bth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -13,6 +13,7 @@
 fload ${BP}/dev/hdaudio/audio.fth
 fload ${BP}/dev/hdaudio/extra.fth
 fload ${BP}/forth/lib/isin.fth
+fload ${BP}/forth/lib/tones.fth
 fload ${BP}/dev/geode/ac97/selftest.fth
 fload ${BP}/dev/hdaudio/test.fth
 end0

Modified: dev/olpc/dcon/mmp2dcon.fth
==============================================================================
--- dev/olpc/dcon/mmp2dcon.fth	Thu Nov 11 19:40:11 2010	(r2018)
+++ dev/olpc/dcon/mmp2dcon.fth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -28,6 +28,17 @@
 \ h# 4000 constant DM_DEBUG
 \ h# 8000 constant DM_SELFTEST
 
+: set-dcon-slave  ( -- )
+   d# 162 to smb-clock-gpio#
+   d# 163 to smb-data-gpio#
+   h# 1a to smb-slave
+;
+
+: smb-init    ( -- )  set-dcon-slave  smb-on  smb-pulses  ;
+
+: dcon@  ( reg# -- word )  set-dcon-slave  smb-word@  ;
+: dcon!  ( word reg# -- )  set-dcon-slave  smb-word!  ;
+
 : dcon-load  ( -- )  d# 151 gpio-set  ;
 : dcon-unload  ( -- )  d# 151 gpio-clr  ;
 \ : dcon-blnk?  ( -- flag )  ;  \ Not hooked up
@@ -160,14 +171,10 @@
 
 : video-save
    0 set-source  \ Freeze image
-\  olpc-lcd-off
 ;
 
 : video-restore
    smb-init
-\  olpc-lcd-mode
-
-\   gp-setup
    1 set-source  \ Unfreeze image
 ;
 
@@ -178,15 +185,11 @@
 : init-xo-display  ( -- )
    smb-init
 
-\   olpc-lcd-mode
-
    dcon-load
    dcon-enable  ( maybe-set-cmos )
    \ dcon-enable leaves mode set to 69 - 40:antialias, 20:swizzle, 8:backlight on, 1:passthru off
 ;
 
-\ ' init-xo-display to init-display
-
 \ LICENSE_BEGIN
 \ Copyright (c) 2010 FirmWorks
 \ 

Modified: dev/olpc/kb3700/spicmd.fth
==============================================================================
--- dev/olpc/kb3700/spicmd.fth	Thu Nov 11 19:40:11 2010	(r2018)
+++ dev/olpc/kb3700/spicmd.fth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -378,6 +378,8 @@
    ec-respbuf 1 true  ec-cmdbuf 8 true " data-command" $call-parent
 ;
 
+: reboot-ec  ( -- )  0 0 h# 28 ec-command drop  ;
+
 create pgm-cmd     h# 51 c, h# 84 c, d# 16 c, h# 02 c, h# 00 c, 0 c, 0 c, 0 c,
 create read-cmd    h# 51 c, h# 04 c, d# 16 c, h# 03 c, h# 00 c, 0 c, 0 c, 0 c,
 create rdstat-cmd  h# 51 c, h# 01 c, d# 01 c, h# 05 c, h# 80 c, 0 c, 0 c, 0 c,
@@ -443,23 +445,6 @@
    h# 10 +loop             ( adr )
    drop                    ( )
 ;
-h# 6000 value flash-size
-: get-flash  ( -- )
-   load-base flash-size  0 read-flash
-;
-: put-flash  ( -- )
-   ." Erasing" cr
-   erase-flash
-   ." Writing" cr
-   load-base flash-size  0 write-flash
-;
-: help  ( -- )
-   ." enter-updater" cr
-   ." h# 8000 to flash-size   ( default is 6000)" cr
-   ." get-flash"  cr
-   ." load-base 100 ldump" cr
-   ." put-flash"  cr
-;
 
 finish-device
 

Modified: dev/olpc/mmp2camera/loadpkg.fth
==============================================================================
--- dev/olpc/mmp2camera/loadpkg.fth	Thu Nov 11 19:40:11 2010	(r2018)
+++ dev/olpc/mmp2camera/loadpkg.fth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -22,7 +22,7 @@
    ;
 [then]
 
-   fload ${BP}/dev/olpc/mmp2camera/smbus.fth
+   fload ${BP}/cpu/arm/olpc/1.75/smbus.fth
    fload ${BP}/dev/olpc/mmp2camera/platform.fth
    fload ${BP}/dev/olpc/mmp2camera/ov.fth
    fload ${BP}/dev/olpc/mmp2camera/ccic.fth

Modified: dev/olpc/mmp2camera/platform.fth
==============================================================================
--- dev/olpc/mmp2camera/platform.fth	Thu Nov 11 19:40:11 2010	(r2018)
+++ dev/olpc/mmp2camera/platform.fth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -8,7 +8,8 @@
 
 : ov-smb-setup  ( -- )
    1 to smb-dly-us
-   d# 108 to smb-clk-gpio# d# 109 to smb-data-gpio#
+   d# 108 to smb-clock-gpio#
+   d# 109 to smb-data-gpio#
    h# 42 to smb-slave
 ;
 

Modified: forth/lib/isin.fth
==============================================================================
--- forth/lib/isin.fth	Thu Nov 11 19:40:11 2010	(r2018)
+++ forth/lib/isin.fth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -7,8 +7,8 @@
 \ sample index from 0 to fs/freq/4 .
 
 d# 16000 value fs
-0 value x
-0 value xsq
+0 value theta
+0 value thetasq
 
 d#  32767 constant one
 d# 102943 constant pi
@@ -19,8 +19,9 @@
 0 value #half-cycle
 0 value #quarter-cycle
 
-: set-freq  ( freq -- )
-   dup to freq
+: set-freq  ( freq sample-rate -- )
+   to fs             ( freq )
+   dup to freq       ( freq )
    pi * to fstep
    fs freq /  dup  to #cycle
    2/         dup  to #half-cycle
@@ -38,16 +39,16 @@
 \ : times  ( n1 n2 -- n3 )  d# 32767 */  ;   \ Insignificantly more accurate, but slower
 : times  ( n1 n2 -- n3 )  *  d# 15 rshift   ;
 
-\ Computes  (1 - (x^2 / divisor) * last)
-: sin-step  ( last divisor -- next )  xsq  swap /  times  one min  one swap -  ;
+\ Computes  (1 - (theta^2 / divisor) * last)
+: sin-step  ( last divisor -- next )  thetasq  swap /  times  one min  one swap -  ;
 
 \ Taylor series expansion of sin, calculated as
-\ x * (1 - (x^2/(2*3)) * (1 - (x^2/(4*5)) * (1 - (x^2/(6*7)) * (1 - (x^2/(8*9))))))
+\ theta * (1 - (theta^2/(2*3)) * (1 - (theta^2/(4*5)) * (1 - (theta^2/(6*7)) * (1 - (theta^2/(8*9))))))
 \ This is good for the first quadrant only, i.e. 0 <= index <= fs / freq / 4
 : isin  ( index -- frac )
-   fstep *  fs 2/  /  to x
-   x dup times to xsq
-   one  d# 72 sin-step d# 42 sin-step  d# 20 sin-step  6 sin-step  x times  one min
+   fstep *  fs 2/  /  to theta
+   theta dup times to thetasq
+   one  d# 72 sin-step d# 42 sin-step  d# 20 sin-step  6 sin-step  theta times  one min
 ;
 
 : one-cycle  ( adr -- )

Added: forth/lib/tones.fth
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ forth/lib/tones.fth	Thu Nov 11 20:13:40 2010	(r2019)
@@ -0,0 +1,55 @@
+d# 500 value tone-freq
+
+: /cycle  ( -- #bytes )  #cycle /l*  ;
+
+: make-cycle  ( adr -- adr' )
+   #quarter-cycle 1+  0  do               ( adr )
+      i isin                              ( adr isin )
+      2dup  swap  i la+ w!                ( adr isin )
+      2dup  swap  #half-cycle i - la+ w!  ( adr isin )
+      negate                              ( adr -isin )
+      2dup  swap  #half-cycle i + la+ w!  ( adr -isin )
+      over  #cycle i - la+ w!             ( adr )
+   loop                                   ( adr )
+   /cycle +
+;
+
+\ This version puts the tone first into the left channel for
+\ half the time, then into the right channel for the remainder
+: make-tone  ( adr len freq sample-rate -- )
+   set-freq        ( adr len )
+
+   \ Start with everything quiet
+   2dup erase                         ( adr len )
+
+   over  make-cycle  drop             ( adr len )
+
+   \ Copy the wave template into the left channel
+   over /cycle +   over 2/  /cycle -  bounds  ?do  ( adr len )
+      over  i  /cycle  move                        ( adr len )
+   /cycle +loop                                    ( adr len )
+
+   \ Copy the wave template into the right channel
+   2dup 2/ + wa1+  over 2/ /cycle -   bounds  ?do  ( adr len )
+      over  i  /cycle  move                        ( adr len )
+   /cycle +loop                                    ( adr len )
+   2drop                                           ( )
+;
+
+\ This version puts the tone into both channels simultaneously
+: make-tone2  ( adr len freq sample-rate -- )
+   set-freq           ( adr len )
+
+   over  make-cycle  drop      ( adr len )
+
+   \ Duplicate left into right in the template
+   over  #cycle /l*  bounds  ?do   ( adr len )
+      i w@  i wa1+ w!              ( adr len )
+   /l +loop                        ( adr len )
+
+   \ Replicate the template
+   over /cycle +   over /cycle -  bounds  ?do  ( adr len )
+      over  i  /cycle  move                    ( adr len )
+   /cycle +loop                                ( adr len )
+   2drop                                       ( )
+;



More information about the openfirmware mailing list