Author: wmb Date: Sat Jun 11 01:51:31 2011 New Revision: 2260 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2260
Log: OLPC XO-1.75 trac #10886 - autocorrelation-based audio selftest for XO-1.75
Modified: cpu/arm/olpc/1.75/alc5631.fth cpu/arm/olpc/1.75/sound.fth dev/hdaudio/noiseburst.fth dev/hdaudio/test.fth forth/kernel/double.fth forth/lib/isin.fth forth/lib/tones.fth
Modified: cpu/arm/olpc/1.75/alc5631.fth ============================================================================== --- cpu/arm/olpc/1.75/alc5631.fth Fri Jun 10 23:41:31 2011 (r2259) +++ cpu/arm/olpc/1.75/alc5631.fth Sat Jun 11 01:51:31 2011 (r2260) @@ -14,7 +14,7 @@ b# 1110.0000.0001.1101 h# 3c codec! \ Fast VREF control d# 100 ms
- h# 8021 h# 34 codec! \ Slave mode, 16 bits, left justified, left channel on LRCLK high + h# 8001 h# 34 codec! \ Slave mode, 16 bits, left justified
h# 1010 h# 38 codec! \ Divisors; the values in this register don't seem to make much \ difference unless you set the divisors to very high values. @@ -95,10 +95,10 @@
false value force-speakers? : set-volume ( n -- ) - headphones-inserted? force-speakers? 0= and if - set-headphone-volume + headphones-inserted? ( force-speakers? 0= and ) if + set-headphone-volume mute-speakers else - set-speaker-volume + set-speaker-volume mute-headphones then ; d# 0 constant default-adc-gain \ 0 dB - range is -96.625 to +28.5 @@ -179,7 +179,7 @@ : mic+20db ( -- ) d# 20 set-mic-gain ; : set-default-gains ( -- ) output-config - headphones-inserted? force-speakers? 0= and if + headphones-inserted? ( force-speakers? 0= and ) if headphones-on speakers-off else
Modified: cpu/arm/olpc/1.75/sound.fth ============================================================================== --- cpu/arm/olpc/1.75/sound.fth Fri Jun 10 23:41:31 2011 (r2259) +++ cpu/arm/olpc/1.75/sound.fth Sat Jun 11 01:51:31 2011 (r2260) @@ -48,6 +48,12 @@
: reset-rx ( -- ) h# 8000.0002 h# 0c sspa! ;
+: active-low-rx-fs ( -- ) + h# 0c sspa@ h# 8001.0000 or h# 0c sspa! +; +: active-high-rx-fs ( -- ) + h# 0c sspa@ h# 10000 invert and h# 8000.0000 or h# 0c sspa! +; : setup-sspa-rx ( -- ) reset-rx
@@ -64,10 +70,10 @@
h# 8000.0000 \ Enable writes d# 15 d# 20 lshift or \ Frame sync width -\ We choose the master/slave configuration later, in enable-sspa-tx +\ We choose the master/slave configuration later, in enable-sspa-rx 0 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 + 1 d# 16 lshift or \ Active low frame sync (I2S standard) d# 31 d# 4 lshift or \ Frame sync period 1 d# 2 lshift or \ Flush the FIFO h# 0c sspa! @@ -80,6 +86,12 @@
: reset-tx ( -- ) h# 8000.0002 h# 8c sspa! ;
+: active-low-tx-fs ( -- ) + h# 8c sspa@ h# 8001.0000 or h# 8c sspa! +; +: active-high-tx-fs ( -- ) + h# 8c sspa@ h# 10000 and h# 8000.0000 or h# 8c sspa! +; : setup-sspa-tx ( -- ) reset-tx
@@ -100,7 +112,10 @@ \ We choose the master/slave configuration later, in master-tx 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 + +\ Empirically, this needs to be backwards from what we think it should be + 0 d# 16 lshift or \ Active high frame sync (should be active low, but that gives backwards results) + d# 31 d# 4 lshift or \ Frame sync period 1 d# 2 lshift or \ Flush the FIFO h# 8c sspa! @@ -247,7 +262,7 @@
: open-in ( -- ) ; : close-in ( -- ) ; -: open-out ( -- ) setup-sspa-tx ; +: open-out ( -- ) ; : close-out ( -- ) ;
: wait-out ( -- ) @@ -274,6 +289,7 @@
: stop-out ( -- ) disable-sspa-tx + reset-tx stop-out-ring uninstall-playback-alarm false to playing? @@ -313,6 +329,7 @@ : start-audio-out ( adr len -- ) to out-len ( adr ) to out-adr ( ) + setup-sspa-tx ( ) make-out-ring copy-out out-len if copy-out then \ Prefill the second buffer @@ -369,15 +386,30 @@ copy-in ( actual ) repeat ( actual ) disable-sspa-rx ( actual ) + reset-rx ( actual ) ; : read ( adr len -- actual ) open-in audio-in ;
+0 value mono? +0 value in-adr0 +0 value in-len0 +: collapse-in ( -- ) + in-len0 0 ?do + in-adr0 i la+ w@ in-adr0 i wa+ w! + loop +; : out-in ( out-adr out-len in-adr in-len -- ) - to in-len to in-adr ( out-adr out-len ) + to in-len0 to in-adr0 ( out-adr out-len ) to out-len to out-adr ( )
+ in-adr0 to in-adr ( ) + in-len0 mono? if 2* then to in-len + + audio-clock-on ( ) \ This will mess up any frequency settings + setup-sspa-tx ( ) setup-sspa-rx ( ) + active-high-rx-fs ( )
make-in-ring ( ) make-out-ring ( ) @@ -402,7 +434,12 @@ disable-sspa-rx ( ) disable-sspa-tx ( )
+ reset-rx + reset-tx + dac-off adc-off ( ) + + mono? if collapse-in then ( ) ;
0 [if] \ Interactive test words for out-in @@ -452,8 +489,8 @@ set-adc-gain ;
-: stereo ; -: mono ; +: stereo false to mono? ; +: mono true to mono? ;
: init-codec ( -- ) codec-on @@ -486,6 +523,12 @@ false value force-internal-mic? \ Can't be implemented on XO-1.75 2 value #channels fload ${BP}/dev/hdaudio/test.fth +: input-settings ( -- ) + audio-clock-on ( ) \ If you don't do this, the L/R phase is often wrong +; +: output-settings ( -- ) ; +' input-settings to input-common-settings +' output-settings to output-common-settings
end-package
Modified: dev/hdaudio/noiseburst.fth ============================================================================== --- dev/hdaudio/noiseburst.fth Fri Jun 10 23:41:31 2011 (r2259) +++ dev/hdaudio/noiseburst.fth Sat Jun 11 01:51:31 2011 (r2260) @@ -302,9 +302,11 @@ drop ( ) ; : -stereo-wmean ( adr len -- ) - 2dup stereo-wmean ( adr len mean ) - -rot bounds ?do ( mean ) - i <w@ over - h# 7fff min h# -7fff max i w! + 2dup stereo-wmean >r ( adr len r: lmean ) + over wa1+ over stereo-wmean r> swap ( adr len lmean rmean ) + 2swap bounds ?do ( lmean rmean ) + i <w@ 2 pick - h# 7fff min h# -7fff max i w! + i wa1+ <w@ over - h# 7fff min h# -7fff max i wa1+ w! /l +loop ( mean ) drop ( ) ; @@ -340,34 +342,44 @@ 3drop ( ) ;
+\ sample-delay accounts for the different timing between adc-on and dac-on +\ for different combinations of codec and controller. + +d# 0 value sample-delay +: +sample-delay ( start #samples -- end' start' ) + swap sample-delay + swap bounds +; 0. 2value total-covar -: sm-covar-sum ( adr1 adr2 len end start -- d.covar ) +: sm-covar-sum ( adr1 adr2 len start #samples -- d.covar ) + +sample-delay ( adr1 adr2 len end' start' ) 0. to total-covar do 3dup swap i wa+ swap stereo-mono-covar ( adr1 adr2 len d.covar ) total-covar d+ to total-covar ( adr1 adr2 len ) loop ( adr1 adr2 len ) 3drop ( ) - total-covar + total-covar d2* d2* ; -: sm-covar-abs-sum ( adr1 adr2 len end start -- d.covar ) +: sm-covar-abs-sum ( adr1 adr2 len start #samples -- d.covar ) + +sample-delay ( adr1 adr2 len end' start' ) 0. to total-covar do 3dup swap i wa+ swap stereo-mono-covar ( adr1 adr2 len d.covar ) dabs total-covar d+ to total-covar ( adr1 adr2 len ) loop ( adr1 adr2 len ) 3drop ( ) - total-covar + total-covar d2* d2* ;
-: ss-covar-abs-sum ( adr1 adr2 len end start -- d.covar ) +: ss-covar-abs-sum ( adr1 adr2 len start #samples -- d.covar ) + +sample-delay ( adr1 adr2 len end' start' ) 0. to total-covar do 3dup swap i la+ swap stereo-covar ( adr1 adr2 len d.covar ) dabs total-covar d+ to total-covar ( adr1 adr2 len ) loop ( adr1 adr2 len ) 3drop ( ) - total-covar + total-covar d2* d2* ;
@@ -457,47 +469,70 @@ debug? if dup .d cr then ;
+d# 100 value #fixture +d# 25 value fixture-threshold : fixture-ratio-left ( -- error? ) - left-range d# 160 d# 60 sm-covar-abs-sum nip ( sum1 ) - left-range d# 400 d# 300 sm-covar-abs-sum nip ( sum1 sum2 ) + left-range d# 60 #fixture sm-covar-abs-sum nip ( sum1 ) + left-range d# 300 #fixture sm-covar-abs-sum nip ( sum1 sum2 ) >ratio - d# 25 < + fixture-threshold < ; : fixture-ratio-right ( -- error? ) - right-range d# 160 d# 60 sm-covar-abs-sum nip ( sum1 ) - right-range d# 400 d# 300 sm-covar-abs-sum nip ( sum1 sum2 ) + right-range d# 60 #fixture sm-covar-abs-sum nip ( sum1 ) + right-range d# 300 #fixture sm-covar-abs-sum nip ( sum1 sum2 ) >ratio - d# 25 < + fixture-threshold < ;
+d# 60 value case-start-left +d# 60 value case-start-right +d# 400 value case-start-quiet +d# 60 value #case-left +d# 190 value #case-right +d# 25 value case-threshold-left +d# 14 value case-threshold-right + \ This compares the total energy within the impulse response band to the \ total energy in a similar-length band : case-ratio-left ( -- error? ) - left-range d# 120 d# 60 sm-covar-abs-sum nip ( sum1.high ) - left-range d# 460 d# 400 sm-covar-abs-sum nip ( sum1.high sum2.high ) + left-range case-start-left #case-left sm-covar-abs-sum nip ( sum1.high ) + left-range case-start-quiet #case-left sm-covar-abs-sum nip ( sum1.high sum2.high ) >ratio - d# 25 < + case-threshold-left < ; : case-ratio-right ( -- error? ) - right-range d# 250 d# 60 sm-covar-abs-sum nip ( sum1.high ) - right-range d# 590 d# 400 sm-covar-abs-sum nip ( sum1.high sum2.high ) + right-range case-start-right #case-right sm-covar-abs-sum nip ( sum1.high ) + right-range case-start-quiet #case-right sm-covar-abs-sum nip ( sum1.high sum2.high ) >ratio - d# 14 < + case-threshold-right < ;
+d# 20 value #loopback +d# 70 value loopback-threshold \ This compares the total energy within the impulse response band to the \ total energy in a similar-length band : loopback-ratio-left ( -- error? ) - left-stereo-range d# 68 d# 48 ss-covar-abs-sum nip ( sum1.high ) - left-stereo-range d# 220 d# 200 ss-covar-abs-sum nip ( sum1.high sum2.high ) + left-stereo-range d# 48 #loopback ss-covar-abs-sum nip ( sum1.high ) + left-stereo-range d# 200 #loopback ss-covar-abs-sum nip ( sum1.high sum2.high ) >ratio - d# 70 < + loopback-threshold < ; : loopback-ratio-right ( -- error? ) - right-stereo-range d# 68 d# 48 ss-covar-abs-sum nip ( sum1.high ) - right-stereo-range d# 220 d# 200 ss-covar-abs-sum nip ( sum1.high sum2.high ) + right-stereo-range d# 48 #loopback ss-covar-abs-sum nip ( sum1.high ) + right-stereo-range d# 200 #loopback ss-covar-abs-sum nip ( sum1.high sum2.high ) >ratio - d# 70 < + loopback-threshold < +; + +\ Ideally we would not put platform-specific information in this module. +\ If we add many more platforms, this should be redesigned. +: configure-xo1.75 ( -- ) + d# -23 to sample-delay + d# 50 to fixture-threshold + d# 40 to #fixture + d# 83 to case-start-right + d# 30 to #case-right + d# 25 to case-threshold-right ;
d# 1200 constant #impulse-response @@ -507,7 +542,7 @@ pb + rb #samples ( adr1 adr2 #samples ) #impulse-response 0 do 3dup swap i wa+ swap stereo-mono-covar ( adr1 adr2 #samples d.covar ) - d# 50000000 m/mod nip ( adr1 adr2 #samples n.covar ) + d# 500,000,000 m/mod nip ( adr1 adr2 #samples n.covar ) impulse-response i wa+ w! ( adr1 adr2 #samples ) loop ( adr1 adr2 len ) 3drop ( ) @@ -516,8 +551,8 @@ : calc-stereo-impulse ( offset -- adr ) \ offset is 0 for left or 2 for right dup pb + swap rb + #samples ( adr1 adr2 #samples ) #impulse-response 0 do - 3dup swap i wa+ swap stereo-covar ( adr1 adr2 #samples d.covar ) - d# 50000000 m/mod nip ( adr1 adr2 #samples n.covar ) + 3dup swap i la+ swap stereo-covar ( adr1 adr2 #samples d.covar ) + d# 50,000,000 m/mod nip ( adr1 adr2 #samples n.covar ) impulse-response i wa+ w! ( adr1 adr2 #samples ) loop ( adr1 adr2 len ) 3drop ( ) @@ -561,8 +596,6 @@ : setup-fixture ( -- ) h# 20000 to /pb \ Medium burst /pb 2/ h# 1000 + to /rb \ Mono reception (internal mic) -\ ['] fixture-analyze-left to analyze-left -\ ['] fixture-analyze-right to analyze-right ['] fixture-ratio-left to analyze-left ['] fixture-ratio-right to analyze-right ['] -mono-wmean to fix-dc
Modified: dev/hdaudio/test.fth ============================================================================== --- dev/hdaudio/test.fth Fri Jun 10 23:41:31 2011 (r2259) +++ dev/hdaudio/test.fth Sat Jun 11 01:51:31 2011 (r2260) @@ -108,7 +108,7 @@ defer input-common-settings defer output-common-settings [ifdef] with-adc -\ XXX this is hd-audio specific. Factore it out +\ XXX this is hd-audio specific. Factor it out : (input-common-settings) ( -- ) open-in 48kHz 16bit with-adc d# 73 input-gain ; @@ -120,11 +120,12 @@ [then]
: test-with-case ( -- ) - " setup-case" $call-analyzer +\ " setup-case" $call-analyzer \ xxx - this needs to use the internal speakers and mic even though the loopback cable is attached true to force-speakers? true to force-internal-mic? + mic-bias-on input-common-settings mono - output-common-settings d# -9 set-volume + output-common-settings d# -1 set-volume ." Testing internal speakers and microphone" cr " setup-case" test-common false to force-speakers? false to force-internal-mic? @@ -135,8 +136,9 @@ ; : test-with-fixture ( -- error? ) true to force-speakers? true to force-internal-mic? + mic-bias-on input-common-settings mono - output-common-settings d# -23 set-volume \ -23 prevents obvious visible clipping + output-common-settings d# -13 set-volume \ -23 prevents obvious visible clipping ." Testing internal speakers and microphone with fixture" cr " setup-fixture" test-common false to force-speakers? false to force-internal-mic? @@ -146,8 +148,9 @@ then ; : test-with-loopback ( -- error? ) - input-common-settings stereo - output-common-settings d# -33 set-volume \ -23 prevents obvious visible clipping + mic-bias-off + input-common-settings stereo + output-common-settings d# -22 set-volume ." Testing headphone and microphone jacks with loopback cable" cr " setup-loopback" test-common plot? if @@ -193,8 +196,13 @@ instructions-done then ; +: configure-platform ( -- ) + board-revision h# 1a28 >= if " configure-xo1.75" $call-analyzer exit then +; \ Returns failure by throwing : automatic-test ( -- ) + configure-platform + disconnect-loopback \ Not for 1.5; it can test internal while loopback is connected " smt-test?" evaluate if test-with-fixture throw else
Modified: forth/kernel/double.fth ============================================================================== --- forth/kernel/double.fth Fri Jun 10 23:41:31 2011 (r2259) +++ forth/kernel/double.fth Sat Jun 11 01:51:31 2011 (r2260) @@ -43,6 +43,25 @@ : drot ( d1 d2 d3 -- d2 d3 d1 ) 2>r 2swap 2r> 2swap ; : -drot ( d1 d2 d3 -- d3 d1 d2 ) drot drot ; : dinvert ( d1 -- d2 ) swap invert swap invert ; + +: dlshift ( d1 n -- d2 ) + tuck lshift >r ( low n r: high2 ) + 2dup bits/cell swap - rshift r> or >r ( low n r: high2' ) + lshift r> ( d2 ) +; +: drshift ( d1 n -- d2 ) + 2dup rshift >r ( low high n r: high2 ) + tuck bits/cell swap - lshift ( low n low2 r: high2 ) + -rot rshift or ( low2 r: high2 ) + r> ( d2 ) +; +: d>>a ( d1 n -- d2 ) + 2dup rshift >r ( low high n r: high2 ) + tuck bits/cell swap - lshift ( low n low2 r: high2 ) + -rot >>a or ( low2 r: high2 ) + r> ( d2 ) +; + \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \
Modified: forth/lib/isin.fth ============================================================================== --- forth/lib/isin.fth Fri Jun 10 23:41:31 2011 (r2259) +++ forth/lib/isin.fth Sat Jun 11 01:51:31 2011 (r2260) @@ -16,23 +16,23 @@ 0 value freq 0 value fstep 0 value #cycle -0 value #half-cycle -0 value #quarter-cycle +0 value #cycle/2 +0 value #cycle/4
: 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 - 2/ to #quarter-cycle + 2/ dup to #cycle/2 + 2/ to #cycle/4 ; -: set-period ( quarter-cycle -- ) - dup to #quarter-cycle ( quarter-cycle ) - 2* dup to #half-cycle ( half-cycle ) +: set-period ( cycle/4 -- ) + dup to #cycle/4 ( cycle/4 ) + 2* dup to #cycle/2 ( cycle/2 ) 2* dup to #cycle ( cycle ) fs over / to freq ( period ) - pi swap / fs * to fstep ( ) + pi fs rot */ to fstep ( ) ;
\ Multiply two fractional numbers where the scale factor is 2^15 @@ -42,27 +42,84 @@ \ Computes (1 - (theta^2 / divisor) * last) : sin-step ( last divisor -- next ) thetasq swap / times one min one swap - ;
+0 [if] +\ Cos +\ 1 - t^2/(2) + t^4/(2..4) - t^6/2..6) + t^8/(2..8) +\ 1 - (t^2/(1*2)) * (1 - (t^2/(3*4)) * (1 - (t^2/(5*6)) * (1 - (t^2/(7*8)))) + +: icos ( index -- frac ) + fstep fs 2/ */ to theta + theta dup times to thetasq + one d# 90 cos-step d# 56 cos-step d# 30 cos-step d# 12 cos-step 2 cos-step one min +; +[then] + \ Taylor series expansion of sin, calculated as +\ t - t^3/(2*3) + t^5/(2*3*4*5) - t^7/(2..7) + t^9/(2...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 theta +: calc-sin ( index -- frac ) + 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 -- ) - #quarter-cycle 1+ 0 do ( adr ) - i isin + #cycle/4 1+ 0 do ( adr ) + i calc-sin 2dup swap i wa+ w! ( adr isin ) - 2dup swap #half-cycle i - wa+ w! ( adr isin ) + 2dup swap #cycle/2 i - wa+ w! ( adr isin ) negate ( adr -isin ) - 2dup swap #half-cycle i + wa+ w! ( adr -isin ) + 2dup swap #cycle/2 i + wa+ w! ( adr -isin ) over #cycle i - wa+ w! ( adr ) loop ( adr ) drop ;
+ +0 [if] +: reduce-to-quarter-cycle ( -- ) + \ Move a cycle/4 to the left until negative, then fix + #cycle/4 - dup 0<= if #cycle/4 + (sin) exit then ( theta' ) \ Quadrant 1 + #cycle/4 - dup 0<= if negate (sin) exit then ( theta' ) \ Quadrant 2 + #cycle/4 - dup 0<= if #cycle/4 + (sin) negate exit then ( theta' ) \ Quadrant 3 + #cycle/4 - negate (sin) negate \ Quadrant 4 +; +[then] + +\ For isin and icos we use a cosine table instead of a sine table. +\ Argument reduction is a bit easier for cos because it is an even function. +: one-cycle-cos ( adr -- ) + #cycle/4 1+ 0 do ( adr ) + i calc-sin ( adr isin ) + 2dup swap #cycle/4 i - wa+ w! ( adr isin ) \ Quadrant 1 + 2dup swap #cycle/4 3 * i + wa+ w! ( adr isin ) \ Quadrant 4 + negate ( adr -isin ) + 2dup swap #cycle/4 i + wa+ w! ( adr -isin ) \ Quadrant 2 + over #cycle/4 3 * i - wa+ w! ( adr ) \ Quadrant 3 + loop ( adr ) + drop +; + +\ The scale factor for theta is such that h# 10000 is pi radians. +\ Binary 1 is therefore pi/2^16 +0 value cos-table +: init-sincos ( -- ) + cos-table if exit then + h# 20000 /w* alloc-mem to cos-table + 1 h# 20000 set-freq + cos-table one-cycle-cos +; +: release-cos-table ( -- ) cos-table h# 20000 /w* free-mem 0 to cos-table ; + +: icos ( theta -- cos ) + abs ( theta' ) + dup #cycle >= if #cycle mod then ( theta' ) + cos-table swap wa+ <w@ ( cos ) +; +: isin ( theta -- sin ) #cycle/4 - icos ; + + \ d# 16000 to fs \ d# 150 set-freq \ here one-cycle
Modified: forth/lib/tones.fth ============================================================================== --- forth/lib/tones.fth Fri Jun 10 23:41:31 2011 (r2259) +++ forth/lib/tones.fth Sat Jun 11 01:51:31 2011 (r2260) @@ -3,14 +3,14 @@ : /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/4 1+ 0 do ( adr ) + i calc-sin ( adr isin ) + 2dup swap i la+ w! ( adr isin ) + 2dup swap #cycle/2 i - la+ w! ( adr isin ) + negate ( adr -isin ) + 2dup swap #cycle/2 i + la+ w! ( adr -isin ) + over #cycle i - la+ w! ( adr ) + loop ( adr ) /cycle + ;