These code examples shown here are for people interested in understanding how speech processing can be accomplished in DSP. These basic blocks work, but are shown as examples only and are not guaranteed to be error free or optimized. They must be initialized with the correct data structures in the dsPIC X and Y memory.
The pointers must be initialized to point to the respective data or program memory locations before each macro is used. Data must be in the dsPIC X memory region, and coefficients must be in the dsPIC Y memory region.
Data buffer ordering:
(located in X memory)
inP
iir16A
;Input previous HPF
inPP
iir16A
;Input previous previous HPF
outP
iir16A = inP iir16B ;Output previous HPF & Input
previous LPF
outPP
iir16A = inPP iir16B ;Output previous previous HPF & Input
previous previous LPF
outP
iir16B
;Output previous LPF
outPP
iir16B
;Output previous previous LPF
NEW Coefficient order is: B0,B1,B2,A1,A2, B0,B1,B2,A1,A2 (located in Y memory).
W8 is data pointer
(initialized before each macro to point to inP above).
W10 is coefficient
pointer (initialized before each macro to point to B0 above).
16 bit IIR filter
- This filter must be placed first, to perform data moves on the input
buffer.
.macro iir16A
clr
A,[W8],W7,[W10]+=2,W5
;clr A, read inP into W7, read B0 into W5 and advance
mov
W4,[W8++]
;write in into inP, (advance pointer to inPP)
mac
W4*W5,A,[W10]+=2,W5
;in x B0, read B1 coeff into W5 and advance
mac
W5*W7,A,[W8]+=2,W6,[W10]+=2,W5 ;inP x B1, read inPP into W6 and advance
to outP, read B2 coeff into W5 and advance
mov
W7,[W8-2]
;write inP into inPP (back 2)
mac
W5*W6,A,[W8]+=2,W7,[W10]+=2,W5 ;inPP x B2, read outP into W7 (advance
pointer to outPP), read A2 coeff into W5 and advance
mac
W5*W7,A,[W8]+=2,W6,[W10]+=2,W5 ;outP x A1, read outPP into W6 (advance
pointer for next filter), read A2 coeff into W5 and advance for next filter
mov
W7,[W8-2]
;write outP into outPP
mac
W5*W6,A
;outPP x A2
sac.r A,#-1,W4
;save result rounded
mov
W4,[W8-4]
;save output in outP
.endm
W4 = out = in
W6 = outPP =
inPP
W7 = outP =
inP
This means no
data moves or reads are necessary in the input of the following filter.
16 bit IIR filter
- This filter is placed second to save two data moves.
.macro iir16B
clr
A,[W10]+=2,W5
;clr A, read B0 into W5 and advance
mac
W4*W5,A,[W10]+=2,W5
;in x B0, read B1 coeff into W5 and advance
mac
W5*W7,A,[W10]+=2,W5
;inP x B1, read B2 coeff into W5 and advance
mac
W5*W6,A,[W8]+=2,W7,[W10]+=2,W5 ;inPP x B2, read outP into W7 (advance
pointer to outPP), read A1 coeff into W5 and advance
mac
W5*W7,A,[W8]+=2,W6,[W10]+=2,W5 ;outP x A1, read outPP into W6 (advance
pointer for next filter), read A2 coeff into W5 and advance for next filter
mov
W7,[W8-2]
;write outP into outPP
mac
W5*W6,A
;outPP x A2
sac.r A,#-1,W4
;save result rounded
mov
W4,[W8-4]
;save output in outP
.endm
Data buffer ordering:
(located in X memory)
inP
iir32A
;Input previous HPF
inPP
iir32A
;Input previous previous HPF
errorAiir32A
;Error feedback HPF
outP
iir32A
= inP iir32B
;Output previous HPF & Input previous LPF
outPP
iir32A
= inPP iir32B
;Output previous previous HPF & Input previous previous LPF
errorBiir32B
;Error feedback LPF
outP
iir32B
;Output previous LPF
outPP
iir32B
;Output previous previous LPF
Coefficient order is: B0,B1,B2,A2,A1, B0,B1,B2,A2,A1 (located in Y memory)
32 bit error
feedback IIR filter. This filter must be placed first, to perform data
moves on the input buffer
.macro iir32A
mov
[W8+4],W3
;load error feedback into W3
clr
A,[W8],W7,[W10]+=2,W5
;clr A, read inP into W7, read B0 into W5 and advance
mov
W3,ACCAL
;load error feedback into ACCAL
sftac A,#1
;scale error feedback
mov
W4,[W8++]
;write in into inP, (advance pointer to inPP)
mac
W4*W5,A,[W10]+=2,W5
;in x B0, read B1 coeff into W5 and advance
mac
W5*W7,A,[W8]+=4,W6,[W10]+=2,W5 ;inP x B1, read inPP into W6 and advance
to outP, read B2 coeff into W5 and advance
mov
W7,[W8-4]
;write inP into inPP (back 4)
mac
W5*W6,A,[W8]+=2,W7,[W10]+=2,W5 ;inPP x B2, read outP into W7 (advance
pointer to outPP), read A1 coeff into W5 and advance
mac
W5*W7,A,[W8]+=2,W6,[W10]+=2,W5 ;outP x A1, read outPP into W6 (advance
pointer for next filter), read A2 coeff into W5 and advance for next filter
mov
W7,[W8-2]
;write outP into outPP
mac
W5*W6,A
;outPP x A2
sac
A,#-1,W4
;save result without rounding
mov
W4,[W8-4]
;save output in outP
;sac.r A,#-1,W4
;save result rounded OPTIONAL
sftac A,#-1
;scale error feedback
mov
ACCAL,W3
;save error feedback in W3
mov
W3,[W8-6]
;save error feedback NEW
.endm
W4 = out = in
W6 = outPP =
inPP
W7 = outP =
inP
This means no
data moves or reads are necessary in the iir32B input, except for the error
feedback.
32 bit error
feedback IIR filter. This filter is placed second, to save two data moves.
.macro iir32B
mov
[W8++],W3
;load error feedback into W3 NEW
clr
A,[W10]+=2,W5
;clr A, read B0 into W5 and advance
mov
W3,ACCAL
;load error feedback into ACCAL
sftac A,#1
;scale error feedback
mac
W4*W5,A,[W10]+=2,W5
;in x B0, read B1 coeff into W5 and advance
mac
W5*W7,A,[W10]+=2,W5
;inP x B1, read B2 coeff into W5 and advance
mac
W5*W6,A,[W8]+=2,W7,[W10]+=2,W5 ;inPP x B2, read outP into W7 (advance
pointer to outPP), read A1 coeff into W5 and advance
mac
W5*W7,A,[W8]+=2,W6,[W10]+=2,W5 ;outP x A1, read outPP into W6 (advance
pointer for next filter), read A2 coeff into W5 and advance for next filter
mov
W7,[W8-2]
;write outP into outPP
mac
W5*W6,A
;outPP x A2
sac
A,#-1,W4
;save result without rounding
mov
W4,[W8-4]
;save output in outP
;sac.r A,#-1,W4
;save result rounded OPTIONAL
sftac A,#-1
;scale error feedback
mov
ACCAL,W3
;save error feedback
mov
W3,[W8-6]
;save error feedback NEW
.endm
These filters
can be cascaded this way:
mov
#IIRbufferB1,W8 ;get data start address (in X memory)
mov
#BPFcoeffsB1,W10 ;get coeffs start address (in Y memory)
mov
Input,W4 ;get input
iir32A
iir32B
iir32A
iir32B
;output is in W4
This cascade
causes the 32 bit error feedback to malfunction (cause unknown at this
time):
iir32A
iir32B
iir32B
iir32B
Example Coefficients:
These are repeated, to match the A/B/A/B hpf/lpf/hpf/lpf cascade above.
They must be copied from program memory into Y RAM before execution.
Coefficient
order is: B0,B1,B2,A2,A1, B0,B1,B2,A2,A1
B1coeffs:
.word 12288, -24576,
12288, 32393, -16016, 40, 80, 40, 31119, -14814
;40Hz HPF 125Hz LPF
.word 12288, -24576,
12288, 32393, -16016, 40, 80, 40, 31119, -14814
;40Hz HPF 125Hz LPF
B2coeffs:
.word 12000, -24000,
12000, 31119, -14814, 100, 200, 100, 29476, -13394
;125Hz HPF 250Hz LPF
.word 12000, -24000,
12000, 31119, -14814, 100, 200, 100, 29476, -13394
;125Hz HPF 250Hz LPF
B3coeffs:
.word 12000, -24000,
12000, 29476, -13394, 600, 1200, 600, 26232, -10951 ;250Hz
HPF 500Hz LPF
.word 12000, -24000,
12000, 29476, -13394, 600, 1200, 600, 26232, -10951 ;250Hz
HPF 500Hz LPF
B4coeffs:
.word 14000, -28000,
14000, 26232, -10951, 1500, 3000, 1500, 19970, -7335 ;500Hz
HPF 1k LPF
.word 14000, -28000,
14000, 26232, -10951, 1500, 3000, 1500, 19970, -7335 ;500Hz
HPF 1k LPF
B5coeffs:
.word 12000, -24000,
12000, 19970, -7335, 4000, 8000, 4000, 8335, -3567
;1K HPF 2k LPF
.word 12000, -24000,
12000, 19970, -7335, 4000, 8000, 4000, 8335, -3567
;1K HPF 2k LPF
B6coeffs:
.word 7000, -14000,
7000, 8335, -3567, 12000, 24000, 12000, -20000, -7000 ;2k HPF
4k4 LPF OK droops 1dB @4k
.word 7000, -14000,
7000, 8335, -3567, 12000, 24000, 12000, -20000, -7000 ;2k HPF
4k4 LPF OK droops 1dB @4k
B6bcoeffs:
.word 7000, -14000,
7000, 8335, -3567, 8000, 16000, 8000, -7084, -4817
;2k HPF 3k LPF Chebychev peaky 0.5dB
.word 7000, -14000,
7000, 8335, -3567, 8000, 16000, 8000, -7084, -4817
;2k HPF 3k LPF Chebychev peaky 0.5dB
Code for a simple compressor:
;---------------------------------------------------------------------------------------------------------------------------------------------------------
;Digital Audio
Compressor by Daz, April 2013 (old code - no sidechain, no delayed recovery,
not modular, not a macro, gain value smoothed before divider)
;Old code, non-optimized
- May contain errors!
;No initialization
or audio I/O shown, it is up to the programmer to provide this.
;Gain = (DivHI:DivLO)/(Smoothed
absolute input value)
;---------------------------------------------------------------------------------------------------------------------------------------------------------
;Assign RAM
locations for these:
.equ
Band0Peak
;Assign memory location (word) = Measured level of audio input
.equ
Band0audio
;Assign memory location (word) = Audio output of compressor
.equ
Band0Bufferpointer ;Assign memory location
(word) = Must be initialized to point to the start of the buffer below
.equ
Band0Buffer
;Assign memory buffer start = Data buffer for look-ahead.
Needs a memory space that matches the length of Band0Buffersize + 1. Must
end in 00.
.equ
Band0Buffersize 0x7F ;Look-ahead buffer size value for
a 0x80 length buffer (updated 29/02/2016) Needs
to be a continuous binary pattern to work!
(like 0x7F = 0111 1111)
.equ
Band0slewrate 100 ;slew rate value,
higher numbers = faster
.equ
divlowB0 0x0000 ;divide
low word value
.equ
divhighB0 0x0020 ;divide high
word value (this value is chosen to keep the compressor output below saturation
based on the amount of compshift used)
.equ
Band0gainlimit 8000 ;maximum gain value (this can
be higher for more compression gain - up to 32767)
.equ
Band0leak 10
;recovery value (this can be higher for a faster recovery but will increase
ripple distortion)
.equ
compshift, -4
;compressor gain 24dB (6dB per bit shifted)
;------------------------------------------------------------------------------
;Audio input
data is in W0
;------------------------------------------------------------------------------
mov W0,W6
;copy new data
;put into circular
buffer for look-ahead delay
mov Band0Bufferpointer,W2
;put I chan
in buffer and advance
mov [W2],W5
;read old data
mov W0,[W2++]
;save new data
and #Band0Buffersize,W2
;use modulo
mov #Band0Buffer,W1
;base address
add W2,W1,W2
;add base address
mov W2,Band0Bufferpointer
;save pointer
;SLEW LIMIT CODE
;check data
polarity
btsc
W6,#15
;check sign bit
neg W6,W6
;abs
btsc
W6,#15
;check sign bit to fix 0x8000 (this may not be necessary)
mov
0x7FFF,W6 ;fix 0x8000
mov Band0Peak,W8
cp W6,W8
;is current sample > saved peak?
bra leu,Band0nopeak1
;if not
;instead of updating
peak, slew towards it
mov #Band0slewrate,W7
;get #Band0slewrate
;W6 > W8
sub W6,W8,W6
;find error by subtracting W8 from W6
cp W6,W7
;check that error is less than slewlimit
bra leu,Band0Errorok
;if error < limit
mov W7,W6
;otherwise, make W6 = W7
Band0Errorok:
add W6,W8,W8
;add correction
mov W8,Band0Peak
;update saved peak
Band0nopeak1:
mov W8,W7
;copy data
;------------------------------------------------------------------------------
;compute a scaling
factor for it
cp0
W7
bra
nz,notzero
inc
W7,W7
;prevent divide-by-zero (updated 29/02/2016)
notzero:
btsc
W7,#15
;skip next if bit 15 is clear
mov
#0x7FFF,W7 ;set to max
mov #divlowB0,W8
mov #divhighB0,W9
;reference value for inverse function
repeat
#17
div.ud
W8,W7
;if overflow
is set, max out the result
bra nov,Band0noovf
mov #0x7FFF,W0
;max
Band0noovf:
;result is in
W0
Band0limiter:
mov #Band0gainlimit,W8
cp W0,W8
bra ltu,Band0nolimit
mov W8,W0
;replace with limit
Band0nolimit:
mov W0,W6
;scale the data
clr A
mpy W5*W6,A
;scale -> Accumulator
sac.r A,#compshift,W0
;store accu I
mov W0,Band0audio
;save compressed audio
;------------------------------------------------------------------------------
;Recovery time
constant
;subtract Band0leak
from Band0Peak, limit at zero
mov Band0Peak,W0
;get smoothed signal value
sub #Band0leak,W0
;decay value
;if it's now
negative, make it zero
bra nn,Band0noclear
clr W0
Band0noclear:
mov W0,Band0Peak
;save signal value
;------------------------------------------------------------------------------
;End of basic
compressor code