[OpenBIOS] r373 - dev/geode/ac97
svn at openbios.org
svn at openbios.org
Sat May 12 03:17:47 CEST 2007
Author: wmb
Date: 2007-05-12 03:17:47 +0200 (Sat, 12 May 2007)
New Revision: 373
Modified:
dev/geode/ac97/selftest.fth
Log:
OPLC Audio selftest - lowered distortion by adjusting gains, made the
tone frequency programmable, use sweep in selftest.
Modified: dev/geode/ac97/selftest.fth
===================================================================
--- dev/geode/ac97/selftest.fth 2007-05-12 01:15:35 UTC (rev 372)
+++ dev/geode/ac97/selftest.fth 2007-05-12 01:17:47 UTC (rev 373)
@@ -40,6 +40,7 @@
record-base record-len audio-out drop write-done
;
+[ifdef] notdef
create sin-half
d# 0 w,
d# 3212 w,
@@ -92,19 +93,88 @@
;
: make-wave ( -- )
+ \ Start with everything quiet
+ record-base record-len erase
+
+ \ Add a sine wave to the left channel for the first half of the time
record-base record-len 2/ bounds ( endadr startadr )
begin 2dup u> while cycle repeat ( endadr startadr )
2drop
+ \ Add a sine wave to the right channel for the last half of the time
record-base record-len bounds ( endadr startadr )
record-len 2/ + wa1+
begin 2dup u> while cycle repeat ( endadr startadr )
2drop
;
+[then]
-0 value raw-buf
-0 value /raw-buf
+fload ${BP}/forth/lib/isin.fth
+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 +
+;
+
+: make-tone-wave ( -- )
+ \ Start with everything quiet
+ record-base record-len erase
+
+ sample-rate to fs
+ tone-freq set-freq
+
+ 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
+;
+
+: copy-cycle ( adr #copies -- adr' )
+ 1 ?do ( adr )
+ dup /cycle - over ( adr adr- adr )
+ /cycle move ( adr )
+ /cycle + ( adr+ )
+ loop ( adr' )
+;
+
+: make-wave ( -- )
+ \ Start with everything quiet
+ record-base record-len erase
+
+ sample-rate to fs
+
+ record-base
+ 1 d# 30 do ( adr )
+ i set-period ( adr )
+ make-cycle ( adr )
+\ d# 42 copy-cycle ( adr' )
+ d# 35 copy-cycle ( adr' )
+ -1 +loop
+ drop
+
+ \ Copy the left channel into the right channel
+ record-base record-base record-len 2/ + wa1+ record-len 2/ /w - move
+;
+
+
: selftest-args ( -- arg$ ) my-args ascii : left-parse-string 2drop ;
: ?play-wav-file ( -- )
@@ -112,20 +182,40 @@
" $play-wav-loop" $find 0= if 2drop else catch drop then
;
-: selftest ( -- error? )
- open 0= if ." Failed to open /audio" cr true exit then
- 0 set-plevel 0 set-glevel
+d# -8 value wav-plevel
+d# -12 value wav-glevel
+: wav-test ( -- )
+ wav-plevel set-plevel wav-glevel set-glevel
?play-wav-file
- record-len alloc-mem to record-base
- ." Play tone" cr
- 0 set-plevel d# -12 set-glevel
+;
+
+d# -8 value tone-plevel
+d# -12 value tone-glevel
+
+: tone-test ( -- )
+ ." Playing tone" cr
+ \ Onset of clipping in the P domain is -7
+ tone-plevel set-plevel tone-glevel set-glevel
make-wave play
+;
+
+d# -8 value rec-plevel
+d# -3 value rec-glevel
+: mic-test ( -- )
." Recording ..." cr
- 0 set-plevel 0 set-glevel
+ rec-plevel set-plevel rec-glevel set-glevel
record
." Playing ..." cr
play
- record-base record-len free-mem
+;
+
+: selftest ( -- error? )
+ open 0= if ." Failed to open /audio" cr true exit then
+ wav-test
+ record-len la1+ alloc-mem to record-base
+ tone-test
+ mic-test
+ record-base record-len la1+ free-mem
close false
;
More information about the OpenBIOS
mailing list