openfirmware

openfirmware@openfirmware.info

3007 discussions

r1273 - cpu/x86
by svn＠openfirmware.info 04 Aug '09

04 Aug '09

Author: wmb Date: 2009-08-04 03:42:24 +0200 (Tue, 04 Aug 2009) New Revision: 1273 Modified: cpu/x86/iirfilter.fth Log: Fixed typos in iirfilter.fth Modified: cpu/x86/iirfilter.fth =================================================================== --- cpu/x86/iirfilter.fth 2009-08-04 01:33:39 UTC (rev 1272) +++ cpu/x86/iirfilter.fth 2009-08-04 01:42:24 UTC (rev 1273) @@ -51,6 +51,7 @@ si pop \ Restore SI ax push \ Return value c; +[then] \ iir-cascade-z1 is the same basic structure as iir-cascade-z2, \ but the Z^-2 delays have been replaced by Z^-1. It is used @@ -210,7 +211,7 @@ buflen0 buffer: z0 \ First upsampler even path delay buffer buflen0 buffer: z1 \ First upsampler odd path delay buffer -1 1+ 2* /n* constant buflen0 \ 1 stage of Z^-2 plus final feedback +1 1+ 2* /n* constant buflen1 \ 1 stage of Z^-2 plus final feedback buflen1 buffer: z2 \ 3x upsampler even path G0 delay buffer buflen1 buffer: z3 \ 3x upsampler odd path G1 delay buffer @@ -264,16 +265,16 @@ interp3 >r 0 interp3 >r 0 interp3 r> r> ; -d# sample-stride +0 value sample-stride variable sample-outp : out, ( value -- ) - sample-outp @ w! sample-stride sample-out +! + sample-outp @ w! sample-stride sample-outp +! ; \ Stride is 2 for mono, 4 for stereo \ For stereo you must call it twice with an offset of 2 for \ inbuf and outbuf on the second call -: 8khz>48khz ( inbuf #samples stride outbuf -- ) +: 8khz>48khz ( inbuf #samples outbuf stride -- ) to sample-stride ( inbuf #samples outbuf ) sample-outp ! ( inbuf #samples ) init-upsample ( inbuf #samples ) @@ -287,7 +288,7 @@ drop ; -: 16khz>48khz ( inbuf #samples stride outbuf -- ) +: 16khz>48khz ( inbuf #samples outbuf stride -- ) to sample-stride ( inbuf #samples outbuf ) sample-outp ! ( inbuf #samples ) init-upsample ( inbuf #samples )

1 0

r1272 - cpu/x86
by svn＠openfirmware.info 04 Aug '09

04 Aug '09

Author: wmb Date: 2009-08-04 03:33:39 +0200 (Tue, 04 Aug 2009) New Revision: 1272 Modified: cpu/x86/assem.fth Log: Added SHRD and SHLD instructions to x86 assembler. Modified: cpu/x86/assem.fth =================================================================== --- cpu/x86/assem.fth 2009-08-04 01:32:33 UTC (rev 1271) +++ cpu/x86/assem.fth 2009-08-04 01:33:39 UTC (rev 1272) @@ -538,6 +538,14 @@ \ LSS, LFS, LGS : 16MI CREATE C, DOES> C@ prefix-0f ASM8, MEM, normal ; +\ SHLD, SHRD +: 17MI \ name ( [ cl | imm ] reg r/m -- ) + CREATE C, DOES> C@ prefix-0f here >r ASM8, ( [ cl | imm ] reg r/m r: opadr ) + dup reg? if swap else rot then ( [ cl | imm ] r/m reg r: opadr ) + r/m, ( [ cl | imm ] r: opadr ) + # = if ASM8, r> drop else r@ c@ 1+ r> c! then +; + \ TEST bits in dest : TEST (S source dest -- ) DUP REG? IF @@ -693,6 +701,8 @@ 9B 1MI WAIT ( XCHG ) D7 1MI XLAT 30 13MI XOR C2 14MI +RET +0AC 17MI SHRD 0A4 17MI SHLD + : invd ( -- ) prefix-0f h# 08 asm8, ; : wbinvd ( -- ) prefix-0f h# 09 asm8, ; : wrmsr ( -- ) prefix-0f h# 30 asm8, ;

1 0

r1271 - cpu/x86
by svn＠openfirmware.info 04 Aug '09

04 Aug '09

Author: wmb Date: 2009-08-04 03:32:33 +0200 (Tue, 04 Aug 2009) New Revision: 1271 Modified: cpu/x86/iirfilter.fth Log: Commented IIR upsampling filter code. Modified: cpu/x86/iirfilter.fth =================================================================== --- cpu/x86/iirfilter.fth 2009-08-04 00:46:03 UTC (rev 1270) +++ cpu/x86/iirfilter.fth 2009-08-04 01:32:33 UTC (rev 1271) @@ -1,12 +1,22 @@ -purpose: IIR digital filter support +purpose: IIR digital upsampling filter -\ iir-cascade implements the "Folded Cascade First Order Filters" -\ structure as shown on page 274 of _Multirate Signal Processing -\ for Communications Systems_ by fredric j harris, Prentice Hall 2004 -\ ISBN 0-13-146511-2 +\ This file implements x2 and x3 upsampling filters using techniques +\ described in chapter 10 of _Multirate Signal Processing for Communications +\ Systems_ by fredric j harris, Prentice Hall 2004, ISBN 0-13-146511-2 +\ The filters may be cascaded for x6 upsampling (e.g. for 8kHz -> 48kHz) -d# 14 constant mulscale +d# 15 constant mulscale \ Bits for fractional multipliers +0 [if] + +\ iir-cascade-z2 implements a folded cascade of multiple sections +\ of a second-order IIR filter block in a polynomial in Z^2. +\ This is the basic building block for half-band all-pass +\ recursive filters, as described in section 10.2 of the book +\ cited above. +\ This code is commented out because we don't use it directly, +\ instead using the -z1 variant below in a polyphase structure. + code iir-cascade-z2 ( sample weights z #sections -- out ) cx pop \ CX: Number of sections @@ -28,20 +38,29 @@ 0 [bp] dx mov dx 4 [bp] mov - bx 0 [bp] mov \ Update M[i] + bx 0 [bp] mov \ Update Z[i] - 8 [bp] bp lea \ Point to next M[i] + 8 [bp] bp lea \ Point to next Z[i] loopa 0 [bp] dx mov dx 4 [bp] mov - ax 0 [bp] mov \ Update M[i] + ax 0 [bp] mov \ Update Z[i] bp pop \ Restore BP si pop \ Restore SI ax push \ Return value c; +\ iir-cascade-z1 is the same basic structure as iir-cascade-z2, +\ but the Z^-2 delays have been replaced by Z^-1. It is used +\ in the polyphase upsampler "up2". When the rate is doubled, +\ a zero sample is inserted between each pair of input samples, +\ causing every other computation of the Z^-2 polynomial to be +\ unnecessary. The basic block can thus be restructured to have +\ a single delay element, and the block only has to run at half +\ the rate. See section 10.6 (figure 10.48) of the book. + code iir-cascade-z1 ( sample weights z #sections -- out ) cx pop \ CX: Number of sections @@ -54,25 +73,32 @@ bx push \ Saved BP on stack begin ax bx mov \ Save last value - d# 4 [bp] ax sub \ last - M[i+1] + d# 4 [bp] ax sub \ last - Z[i+1] - 0 [si] imul \ alpha[i] * (last - M[i+1]) (kills DX) + 0 [si] imul \ alpha[i] * (last - Z[i+1]) (kills DX) 4 [si] si lea \ Increment alpha pointer mulscale # dx ax shrd \ Scale down by multiplier scale factor - d# 0 [bp] ax add \ M[i] + alpha[i] * (last - M[i+1]) + d# 0 [bp] ax add \ Z[i] + alpha[i] * (last - Z[i+1]) - bx 0 [bp] mov \ Update M[i] + bx 0 [bp] mov \ Update Z[i] - 4 [bp] bp lea \ Point to next M[i] + 4 [bp] bp lea \ Point to next Z[i] loopa - ax 0 [bp] mov \ Update M[i] + ax 0 [bp] mov \ Update Z[i] bp pop \ Restore BP si pop \ Restore SI ax push \ Return value c; +\ iir-cascade-z2g implements the generalized second-order +\ low pass filter cascade as shown in section 10.5.1 (figure 10.35) +\ of the book. The generalized form allows arbitrary bandwidths +\ as opposed to the half-band restriction of the simplifed form. +\ We use this form for 3x upsampling so we can set the lowpass +\ frequency to Fnyquist/3. + code iir-cascade-z2g ( sample weights z #sections -- out ) cx pop \ CX: Number of sections @@ -121,12 +147,14 @@ c; +\ Convert a decimal fraction to a scaled integer multiplier : mul: ( "coef" -- ) safe-parse-word push-decimal $number drop pop-base ( n ) 1 mulscale lshift d# 1,000,000,000 */ ( n' ) , ; +\ Clip too-large sample values to +- 15 bits code saturate ( s -- s' ) ax pop d# 32767 # ax cmp > if @@ -146,44 +174,56 @@ ; [then] -\ upsample by 4 - 2 constant #coefs \ This is for a 9-pole, 9-zero 2-path all-pass halfband IIR filter +\ From page 278 of the book create weights0 mul: .101467517 mul: .612422841 \ Even path create weights1 mul: .342095596 mul: .867647439 \ Odd path 0 [if] \ This is for a 5-pole, 5-zero 2-path all-pass halfband IIR filter +\ From page 276 of the book create weights2 mul: .141348600 \ Even path create weights3 mul: .589994800 \ Odd path [then] \ This is for a 5-pole, 5-zero 2-path all-pass third-band IIR filter \ G0 and G1 use iir-cascade-z2g, H1 uses iir-cascade-z1 +\ This is derived from the 5-pole halfband coefficients according +\ to the formulas on page 291, with fb/fs = 1/6 (fb/fnyquist = 1/3). +\ The book has a missing sign somewhere, because without the minus +\ signs on c1 and b, you end up with the corner frequency at 2/6 +\ instead of 1/6. I had to figure that out the hard way, by trial +\ and error (looking at spectra of impulse responses). If you +\ replace b with -b in equation 10.25, the c1's work out automatically. + +\ c1 c2 create coefg0 mul: -.605502011 mul: .211004022 \ Even path G0 create coefg1 mul: -.817448745 mul: .634897489 \ Odd path G1 +\ b create coefh1 mul: -.267949192 -#coefs 1+ 2* /n* constant buflen -buflen buffer: z0 \ First upsampler even path delay buffer -buflen buffer: z1 \ First upsampler odd path delay buffer -buflen buffer: z2 \ 3x upsampler even path G0 delay buffer -buflen buffer: z3 \ 3x upsampler odd path G1 delay buffer -buflen buffer: z4 \ 3x upsampler odd path H1 delay buffer +2 1+ /n* constant buflen0 \ 2 stages of Z^-1 plus final feedback -: init-upsample - z0 buflen erase - z1 buflen erase - z2 buflen erase - z3 buflen erase - z4 buflen erase +buflen0 buffer: z0 \ First upsampler even path delay buffer +buflen0 buffer: z1 \ First upsampler odd path delay buffer + +1 1+ 2* /n* constant buflen0 \ 1 stage of Z^-2 plus final feedback + +buflen1 buffer: z2 \ 3x upsampler even path G0 delay buffer +buflen1 buffer: z3 \ 3x upsampler odd path G1 delay buffer +buflen1 buffer: z4 \ 3x upsampler odd path H1 delay buffer + +: init-upsample ( -- ) + z0 buflen0 erase + z1 buflen0 erase + z2 buflen1 erase + z3 buflen1 erase + z4 buflen1 erase ; -0 value lastsample - \ This is a polyphase decomposition of upsampling by 2 \ The filter prototype for each path is a polynomial in Z^2, \ but when you apply the polyphase transform with Nobel's identity, @@ -194,6 +234,8 @@ ; 0 [if] +0 value lastsample + \ This is the base rate (non-polyphase) version of up2 \ Both paths run for each sample, with Z^-1 between the \ paths, summing the paths to get a lowpass output. @@ -234,6 +276,7 @@ : 8khz>48khz ( inbuf #samples stride outbuf -- ) to sample-stride ( inbuf #samples outbuf ) sample-outp ! ( inbuf #samples ) + init-upsample ( inbuf #samples ) 0 ?do ( inbuf ) dup sample-stride + ( inbuf inbuf' ) swap <w@ ( inbuf' sample ) @@ -247,6 +290,7 @@ : 16khz>48khz ( inbuf #samples stride outbuf -- ) to sample-stride ( inbuf #samples outbuf ) sample-outp ! ( inbuf #samples ) + init-upsample ( inbuf #samples ) 0 ?do ( inbuf ) dup sample-stride + ( inbuf inbuf' ) swap <w@ ( inbuf' sample ) @@ -254,3 +298,28 @@ loop ( inbuf ) drop ; + +0 [if] +\ Here is some Matlab/Octave code to do the "coefg.." coefficient +\ transformations +function retval = c1(a, b) + retval = 2 * b * (1 + a) / (1 + a * b * b); +end +function retval = c2(a, b) + retval = ((b * b) + a) / (1 + a * b * b); +end +function retval = cvtb(frac) + retval = (1 - tan(pi * frac)) / (1 + tan(pi * frac)); +end +function cvtfilt (bw) % bw is fb/fs + a0 = .141348600 + a1 = .589994800 + + b = cvtb(bw) + c10 = c1(a0, b) + c20 = c2(a0, b) + c11 = c1(a1, b) + c21 = c2(a1, b) +end +cvtfilt(1/6); +[then]

1 0

r1270 - cpu/x86
by svn＠openfirmware.info 04 Aug '09

04 Aug '09

Author: wmb Date: 2009-08-04 02:46:03 +0200 (Tue, 04 Aug 2009) New Revision: 1270 Modified: cpu/x86/iirfilter.fth Log: IIR upsampling filter works. Modified: cpu/x86/iirfilter.fth =================================================================== --- cpu/x86/iirfilter.fth 2009-08-01 20:30:45 UTC (rev 1269) +++ cpu/x86/iirfilter.fth 2009-08-04 00:46:03 UTC (rev 1270) @@ -5,9 +5,11 @@ \ for Communications Systems_ by fredric j harris, Prentice Hall 2004 \ ISBN 0-13-146511-2 -code iir-cascade ( sample weights z #coefs -- out ) - cx pop \ CX: Number of coefficients +d# 14 constant mulscale +code iir-cascade-z2 ( sample weights z #sections -- out ) + cx pop \ CX: Number of sections + bp bx mov \ Save bp pop \ BP: Z list si dx mov \ Save SI @@ -16,82 +18,239 @@ dx push \ Saved SI on stack bx push \ Saved BP on stack begin - ax bx mov \ Save last value - 4 [bp] ax sub \ last - M[i+1] - 0 [si] imul \ alpha[i] * (last - M[i+1]) (kills DX) - 4 [si] si lea \ Increment alpha pointer - d# 16 # ax sar \ Scale down by multiplier scale factor - 0 [bp] ax add \ M[i] + alpha[i] * (last - M[i+1]) - bx 0 [bp] mov \ Update M[i] - 4 [bp] bp lea \ Point to next M[i] + ax bx mov \ Save last value + d# 12 [bp] ax sub \ last - Z[i+1] + 0 [si] imul \ alpha[i] * (last - Z[i+1]) (kills DX) + 4 [si] si lea \ Increment alpha pointer + mulscale # dx ax shrd \ Scale down by multiplier scale factor + + d# 4 [bp] ax add \ Z[i] + alpha[i] * (last - Z[i+1]) + + 0 [bp] dx mov + dx 4 [bp] mov + bx 0 [bp] mov \ Update M[i] + + 8 [bp] bp lea \ Point to next M[i] loopa + + 0 [bp] dx mov + dx 4 [bp] mov + ax 0 [bp] mov \ Update M[i] + bp pop \ Restore BP si pop \ Restore SI ax push \ Return value c; -: mul16: ( "coef" -- ) +code iir-cascade-z1 ( sample weights z #sections -- out ) + cx pop \ CX: Number of sections + + bp bx mov \ Save + bp pop \ BP: Z list + si dx mov \ Save SI + si pop \ SI: Filter weights + ax pop \ AX: current value + dx push \ Saved SI on stack + bx push \ Saved BP on stack + begin + ax bx mov \ Save last value + d# 4 [bp] ax sub \ last - M[i+1] + + 0 [si] imul \ alpha[i] * (last - M[i+1]) (kills DX) + 4 [si] si lea \ Increment alpha pointer + mulscale # dx ax shrd \ Scale down by multiplier scale factor + + d# 0 [bp] ax add \ M[i] + alpha[i] * (last - M[i+1]) + + bx 0 [bp] mov \ Update M[i] + + 4 [bp] bp lea \ Point to next M[i] + loopa + ax 0 [bp] mov \ Update M[i] + + bp pop \ Restore BP + si pop \ Restore SI + ax push \ Return value +c; + +code iir-cascade-z2g ( sample weights z #sections -- out ) + cx pop \ CX: Number of sections + + bp bx mov \ Save + bp pop \ BP: Z list + si dx mov \ Save SI + si pop \ SI: Filter weights + ax pop \ AX: current value + dx push \ Saved SI on stack + bx push \ Saved BP on stack + di push \ Saved DI on stack + begin + ax bx mov \ Save last value + d# 12 [bp] ax sub \ last - Z[3] + + 4 [si] imul \ c2 * (last - Z[3]) (kills DX) + mulscale # dx ax shrd \ Scale down by multiplier scale factor + + d# 4 [bp] ax add \ next += Z[1] + + ax di mov \ Save next in di to free up ax + + d# 0 [bp] ax mov \ AX: Z[0] + ax d# 4 [bp] mov \ Z[1] = Z[0] + bx d# 0 [bp] mov \ Z[0] = sample + + d# 8 [bp] ax sub \ Z[0] - Z[2] + + 0 [si] imul \ c1 * (Z[0] - Z[2]) + mulscale # dx ax shrd \ Scale down by multiplier scale factor + + di ax add \ AX: next + + 8 [si] si lea \ Increment coefficient pointer + 8 [bp] bp lea \ Increment Z pointer + loopa + + 0 [bp] dx mov + dx 4 [bp] mov \ Z[1] = Z[0] + ax 0 [bp] mov \ Z[0] = next + + di pop \ Restore DI + bp pop \ Restore BP + si pop \ Restore SI + ax push \ Return value +c; + + +: mul: ( "coef" -- ) safe-parse-word push-decimal $number drop pop-base ( n ) - d# 65536 d# 1,000,000,000 */ ( n' ) + 1 mulscale lshift d# 1,000,000,000 */ ( n' ) , ; +code saturate ( s -- s' ) + ax pop + d# 32767 # ax cmp > if + d# 32767 # ax mov + else + d# -32767 # ax cmp < if + d# -32767 # ax mov + then + then + ax push +c; + +0 [if] +: saturate ( n -- ) + dup d# 32767 > if drop d# 32767 then + dup d# -32767 < if drop d# -32767 then +; +[then] + \ upsample by 4 2 constant #coefs -create weights0 mul16: .101467517 mul16: .612422841 -create weights1 mul16: .342095596 mul16: .867647439 +\ This is for a 9-pole, 9-zero 2-path all-pass halfband IIR filter +create weights0 mul: .101467517 mul: .612422841 \ Even path +create weights1 mul: .342095596 mul: .867647439 \ Odd path -#coefs 1+ /n* constant buflen -buflen buffer: z0 -buflen buffer: z1 -buflen buffer: z2 -buflen buffer: z3 +0 [if] +\ This is for a 5-pole, 5-zero 2-path all-pass halfband IIR filter +create weights2 mul: .141348600 \ Even path +create weights3 mul: .589994800 \ Odd path +[then] +\ This is for a 5-pole, 5-zero 2-path all-pass third-band IIR filter +\ G0 and G1 use iir-cascade-z2g, H1 uses iir-cascade-z1 +create coefg0 mul: -.605502011 mul: .211004022 \ Even path G0 +create coefg1 mul: -.817448745 mul: .634897489 \ Odd path G1 +create coefh1 mul: -.267949192 + + +#coefs 1+ 2* /n* constant buflen +buflen buffer: z0 \ First upsampler even path delay buffer +buflen buffer: z1 \ First upsampler odd path delay buffer +buflen buffer: z2 \ 3x upsampler even path G0 delay buffer +buflen buffer: z3 \ 3x upsampler odd path G1 delay buffer +buflen buffer: z4 \ 3x upsampler odd path H1 delay buffer + : init-upsample z0 buflen erase z1 buflen erase z2 buflen erase z3 buflen erase + z4 buflen erase ; +0 value lastsample + +\ This is a polyphase decomposition of upsampling by 2 +\ The filter prototype for each path is a polynomial in Z^2, +\ but when you apply the polyphase transform with Nobel's identity, +\ the paths split and the output summation becomes a commutation. +: up2 ( sample -- out1 out0 ) + dup weights0 z0 2 iir-cascade-z1 saturate >r + weights1 z1 2 iir-cascade-z1 saturate r> +; + 0 [if] -for each input sample -sample weights0 z0 #coefs iir-cascade - dup weights0 z2 #coefs iir-cascade ,next-output - weights1 z3 #coefs iir-cascade ,next-output - -sample weights1 z1 #coefs iir-cascade - dup weights0 z2 #coefs iir-cascade ,next-output - weights1 z3 #coefs iir-cascade ,next-output +\ This is the base rate (non-polyphase) version of up2 +\ Both paths run for each sample, with Z^-1 between the +\ paths, summing the paths to get a lowpass output. +: filter2 ( sample -- out ) + lastsample weights1 z3 2 iir-cascade-z2 >r ( sample r: out1 ) + to lastsample + lastsample weights0 z2 2 iir-cascade-z2 r> ( out0 out1 ) + + saturate ( out ) +; [then] -0 [if] -for each input sample -sample weights0 z0 #coefs iir-cascade dup to int0 ( out0 ) int1 + - dup weights0 z2 #coefs iir-cascade dup to out0 out1 + ,next-output - weights1 z3 #coefs iir-cascade dup to out1 out0 + ,next-output -sample weights1 z1 #coefs iir-cascade dup to int1 ( out1 ) int0 + - dup weights0 z2 #coefs iir-cascade dup to out0 out1 + ,next-output - weights1 z3 #coefs iir-cascade dup to out1 out0 + ,next-output -[then] -init-upsample -: up2 ( sample -- out1 out0 ) - dup weights0 z0 #coefs iir-cascade >r - weights1 z1 #coefs iir-cascade r> +\ Third-band interpolation filter. You have to run this once +\ for each output sample, with 0-stuffing between input samples. +\ It would be nice to polyphase this, but doing so requires a +\ complex design methodology for the IIR filter sections that +\ I haven't mastered. +: interp3 ( sample -- out ) + dup coefg0 z2 1 iir-cascade-z2g ( sample out0 ) + swap coefh1 z4 1 iir-cascade-z1 ( out0 outh ) + coefg1 z3 1 iir-cascade-z2g ( out0 out1 ) + + saturate ( ) ; -: up4 ( in -- out3 out2 out1 out0 ) - dup weights0 z0 #coefs iir-cascade ( in intermed0 ) - dup weights0 z2 #coefs iir-cascade >r ( in intermed0 r: out0 ) - weights1 z3 #coefs iir-cascade >r ( in r: out0 out1 ) +\ Upsample by a factor of 3 +: up3 ( sample -- out2 out1 out0 ) + interp3 >r 0 interp3 >r 0 interp3 r> r> +; - weights1 z1 #coefs iir-cascade ( intermed1 r: out0 out1 ) +d# sample-stride +variable sample-outp +: out, ( value -- ) + sample-outp @ w! sample-stride sample-out +! +; - dup weights0 z2 #coefs iir-cascade >r ( intermed1 r: out0 out1 out2 ) - weights1 z3 #coefs iir-cascade ( out3 r: out0 out1 out2 ) +\ Stride is 2 for mono, 4 for stereo +\ For stereo you must call it twice with an offset of 2 for +\ inbuf and outbuf on the second call +: 8khz>48khz ( inbuf #samples stride outbuf -- ) + to sample-stride ( inbuf #samples outbuf ) + sample-outp ! ( inbuf #samples ) + 0 ?do ( inbuf ) + dup sample-stride + ( inbuf inbuf' ) + swap <w@ ( inbuf' sample ) + up2 ( inbuf s1 s0 ) + up3 out, out, out, ( inbuf s1 ) + up3 out, out, out, ( inbuf ) + loop ( inbuf ) + drop +; - r> r> r> +: 16khz>48khz ( inbuf #samples stride outbuf -- ) + to sample-stride ( inbuf #samples outbuf ) + sample-outp ! ( inbuf #samples ) + 0 ?do ( inbuf ) + dup sample-stride + ( inbuf inbuf' ) + swap <w@ ( inbuf' sample ) + up3 out, out, out, ( inbuf s1 ) + loop ( inbuf ) + drop ; -

1 0

r1269 - cpu/x86
by svn＠openfirmware.info 01 Aug '09

01 Aug '09

Author: wmb Date: 2009-08-01 22:30:45 +0200 (Sat, 01 Aug 2009) New Revision: 1269 Modified: cpu/x86/iirfilter.fth Log: iirfilter.fth - this version seems to work. Modified: cpu/x86/iirfilter.fth =================================================================== --- cpu/x86/iirfilter.fth 2009-08-01 18:16:45 UTC (rev 1268) +++ cpu/x86/iirfilter.fth 2009-08-01 20:30:45 UTC (rev 1269) @@ -18,25 +18,30 @@ begin ax bx mov \ Save last value 4 [bp] ax sub \ last - M[i+1] - 0 [si] ax imul \ alpha[i] * (last - M[i+1]) (kills DX) + 0 [si] imul \ alpha[i] * (last - M[i+1]) (kills DX) 4 [si] si lea \ Increment alpha pointer - d# 14 # ax shr \ Scale down by multiplier scale factor + d# 16 # ax sar \ Scale down by multiplier scale factor 0 [bp] ax add \ M[i] + alpha[i] * (last - M[i+1]) bx 0 [bp] mov \ Update M[i] 4 [bp] bp lea \ Point to next M[i] loopa - bp pop \ Restore BP si pop \ Restore SI ax push \ Return value c; +: mul16: ( "coef" -- ) + safe-parse-word push-decimal $number drop pop-base ( n ) + d# 65536 d# 1,000,000,000 */ ( n' ) + , +; + \ upsample by 4 2 constant #coefs -create weights0 mul14: .101467517 mul14: .612422841 -create weights1 mul14: .342095596 mul14: .867647439 +create weights0 mul16: .101467517 mul16: .612422841 +create weights1 mul16: .342095596 mul16: .867647439 #coefs 1+ /n* constant buflen buflen buffer: z0 @@ -53,11 +58,40 @@ 0 [if] for each input sample - sample weights0 z0 #coefs iir-cascade dup to int0 ( out0 ) int1 + +sample weights0 z0 #coefs iir-cascade + dup weights0 z2 #coefs iir-cascade ,next-output + weights1 z3 #coefs iir-cascade ,next-output + +sample weights1 z1 #coefs iir-cascade + dup weights0 z2 #coefs iir-cascade ,next-output + weights1 z3 #coefs iir-cascade ,next-output +[then] +0 [if] +for each input sample +sample weights0 z0 #coefs iir-cascade dup to int0 ( out0 ) int1 + dup weights0 z2 #coefs iir-cascade dup to out0 out1 + ,next-output weights1 z3 #coefs iir-cascade dup to out1 out0 + ,next-output - sample weights0 z1 #coefs iir-cascade dup to int1 ( out1 ) int0 + +sample weights1 z1 #coefs iir-cascade dup to int1 ( out1 ) int0 + dup weights0 z2 #coefs iir-cascade dup to out0 out1 + ,next-output weights1 z3 #coefs iir-cascade dup to out1 out0 + ,next-output [then] +init-upsample +: up2 ( sample -- out1 out0 ) + dup weights0 z0 #coefs iir-cascade >r + weights1 z1 #coefs iir-cascade r> +; +: up4 ( in -- out3 out2 out1 out0 ) + dup weights0 z0 #coefs iir-cascade ( in intermed0 ) + + dup weights0 z2 #coefs iir-cascade >r ( in intermed0 r: out0 ) + weights1 z3 #coefs iir-cascade >r ( in r: out0 out1 ) + + weights1 z1 #coefs iir-cascade ( intermed1 r: out0 out1 ) + + dup weights0 z2 #coefs iir-cascade >r ( intermed1 r: out0 out1 out2 ) + weights1 z3 #coefs iir-cascade ( out3 r: out0 out1 out2 ) + + r> r> r> +; +

1 0

r1268 - cpu/x86
by svn＠openfirmware.info 01 Aug '09

01 Aug '09

Author: wmb Date: 2009-08-01 20:16:45 +0200 (Sat, 01 Aug 2009) New Revision: 1268 Added: cpu/x86/iirfilter.fth Log: First cut at IIR upsampling filter. Added: cpu/x86/iirfilter.fth =================================================================== --- cpu/x86/iirfilter.fth (rev 0) +++ cpu/x86/iirfilter.fth 2009-08-01 18:16:45 UTC (rev 1268) @@ -0,0 +1,63 @@ +purpose: IIR digital filter support + +\ iir-cascade implements the "Folded Cascade First Order Filters" +\ structure as shown on page 274 of _Multirate Signal Processing +\ for Communications Systems_ by fredric j harris, Prentice Hall 2004 +\ ISBN 0-13-146511-2 + +code iir-cascade ( sample weights z #coefs -- out ) + cx pop \ CX: Number of coefficients + + bp bx mov \ Save + bp pop \ BP: Z list + si dx mov \ Save SI + si pop \ SI: Filter weights + ax pop \ AX: current value + dx push \ Saved SI on stack + bx push \ Saved BP on stack + begin + ax bx mov \ Save last value + 4 [bp] ax sub \ last - M[i+1] + 0 [si] ax imul \ alpha[i] * (last - M[i+1]) (kills DX) + 4 [si] si lea \ Increment alpha pointer + d# 14 # ax shr \ Scale down by multiplier scale factor + 0 [bp] ax add \ M[i] + alpha[i] * (last - M[i+1]) + bx 0 [bp] mov \ Update M[i] + 4 [bp] bp lea \ Point to next M[i] + loopa + + bp pop \ Restore BP + si pop \ Restore SI + ax push \ Return value +c; + +\ upsample by 4 + +2 constant #coefs + +create weights0 mul14: .101467517 mul14: .612422841 +create weights1 mul14: .342095596 mul14: .867647439 + +#coefs 1+ /n* constant buflen +buflen buffer: z0 +buflen buffer: z1 +buflen buffer: z2 +buflen buffer: z3 + +: init-upsample + z0 buflen erase + z1 buflen erase + z2 buflen erase + z3 buflen erase +; + +0 [if] +for each input sample + sample weights0 z0 #coefs iir-cascade dup to int0 ( out0 ) int1 + + dup weights0 z2 #coefs iir-cascade dup to out0 out1 + ,next-output + weights1 z3 #coefs iir-cascade dup to out1 out0 + ,next-output + + sample weights0 z1 #coefs iir-cascade dup to int1 ( out1 ) int0 + + dup weights0 z2 #coefs iir-cascade dup to out0 out1 + ,next-output + weights1 z3 #coefs iir-cascade dup to out1 out0 + ,next-output +[then]

1 0

r1267 - dev/hdaudio
by svn＠openfirmware.info 31 Jul '09

31 Jul '09

Author: wmb Date: 2009-08-01 01:16:23 +0200 (Sat, 01 Aug 2009) New Revision: 1267 Modified: dev/hdaudio/core.fth Log: OLPC trac 9431 - fixed volume-setting for HDAudio driver, thanks to Luke. Modified: dev/hdaudio/core.fth =================================================================== --- dev/hdaudio/core.fth 2009-07-31 22:52:11 UTC (rev 1266) +++ dev/hdaudio/core.fth 2009-07-31 23:16:23 UTC (rev 1267) @@ -419,7 +419,7 @@ : steps/dB ( -- #steps ) step-size 4 * ; : dB>steps ( dB -- #steps ) -4 * step-size / ; -: dB>step# ( dB -- step ) dB>steps 0dB-step + ; +: dB>step# ( dB -- step ) dB>steps 0dB-step swap - ; \ \\ Playback

1 0

r1266 - dev/ide
by svn＠openfirmware.info 31 Jul '09

31 Jul '09

Author: wmb Date: 2009-08-01 00:52:11 +0200 (Sat, 01 Aug 2009) New Revision: 1266 Modified: dev/ide/dmaide.fth dev/ide/generic.fth Log: IDE driver - added DMA write support. Modified: dev/ide/dmaide.fth =================================================================== --- dev/ide/dmaide.fth 2009-07-31 20:05:33 UTC (rev 1265) +++ dev/ide/dmaide.fth 2009-07-31 22:52:11 UTC (rev 1266) @@ -38,7 +38,7 @@ ; : dma-wait ( -- ) - begin dma-stat@ dup 1 and 0= swap 2 and or until + begin 1 ms dma-stat@ dup 1 and 0= swap 2 and or until ; \ Sense and clear errors. The bit masked by 04 is read-clear and means @@ -49,30 +49,36 @@ : dma-interrupt? ( -- flag ) dma-stat@ 4 and ; -: dma-rblock ( dma-adr #blks -- error? ) - /block@ * - set-dma ( ) - dma-cmd@ 1 or dma-cmd! dma-wait dma-cmd@ 1 invert and dma-cmd! - dma-interrupt? if +: dma-begin ( dma-adr #blks direction -- dma-adr phys #blks ) + dma-cmd! ( dma-adr #blks ) + 2dup /block@ * true " dma-map-in" $call-parent swap ( adr phys #blks ) + 2dup /block@ * set-dma ( adr phys #blks ) + dma-cmd@ 1 or dma-cmd! ( adr phys #blks ) +; +: dma-end ( adr phys #blks -- actual# ) + dma-wait 0 dma-cmd! ( adr phys #blks ) + dma-interrupt? if ( adr phys #blks ) r-csr@ drop \ Clear interrupt in drive - dma-stat@ h# f0 and 4 or dma-stat! - then - dma-error? -; + dma-stat@ h# f0 and 4 or dma-stat! ( adr phys #blks ) + then ( adr phys #blks ) -: (drblocks) ( adr #blks -- actual# ) - tuck dma-rblock if drop 0 then + dma-error? if 0 else dup then >r ( adr phys #blks r: actual ) + + /block@ * " dma-map-out" $call-parent ( r: actual ) + + r> ( actual# ) ; : dma-rblocks ( adr #blks -- actual#blks ) - 2dup /block@ * true " dma-map-in" $call-parent swap ( adr phys #blks ) + 8 dma-begin ( adr phys #blks ) + dma-read-cmd r-csr! ( adr phys #blks ) + dma-end ( actual#blks ) +; - dma-read-cmd r-csr! - 8 dma-cmd! \ DMA direction for disk read (0 is write) - ['] rblock behavior >r ['] dma-rblock to rblock - 2dup (drblocks) ( adr phys #blks actual#blks ) - r> to rblock - >r /block@ * " dma-map-out" $call-parent r> ( actual#blks ) +: dma-wblocks ( adr #blks -- actual#blks ) + 0 dma-begin ( adr phys #blks ) + dma-write-cmd r-csr! ( adr phys #blks ) + dma-end ( actual#blks ) ; : vendor-id ( -- w ) my-space " config-w@" $call-parent ; @@ -172,11 +178,13 @@ 4 my-w@ 4 or 4 my-w! ['] dma-rblocks to rblocks + ['] dma-wblocks to wblocks ; ' (open-dma) to open-dma : (close-dma) ( -- ) ['] pio-rblocks to rblocks + ['] pio-wblocks to wblocks \ Disable bus mastering 4 my-w@ 4 invert and 4 my-w! Modified: dev/ide/generic.fth =================================================================== --- dev/ide/generic.fth 2009-07-31 20:05:33 UTC (rev 1265) +++ dev/ide/generic.fth 2009-07-31 22:52:11 UTC (rev 1266) @@ -177,7 +177,8 @@ chip-base io-blk-w! false pio-end-hack ; -: wblocks ( addr #blks -- actual# | error ) + +: pio-wblocks ( addr #blks -- actual# | error ) over >r ( addr #blks ) ( R: addr ) h# 30 r-csr! @@ -194,6 +195,8 @@ until r> - /block@ / ; +defer wblocks +' pio-wblocks to wblocks \ Read or write "#blks" blocks starting at "block#" into memory at "addr" \ Input? is true for reading or false for writing.

1 0

r1265 - cpu/x86/pc/olpc/via
by svn＠openfirmware.info 31 Jul '09

31 Jul '09

Author: wmb Date: 2009-07-31 22:05:33 +0200 (Fri, 31 Jul 2009) New Revision: 1265 Added: cpu/x86/pc/olpc/via/fsupdate.fth Log: Via - added "fs-update" command for OS installation. Added: cpu/x86/pc/olpc/via/fsupdate.fth =================================================================== --- cpu/x86/pc/olpc/via/fsupdate.fth (rev 0) +++ cpu/x86/pc/olpc/via/fsupdate.fth 2009-07-31 20:05:33 UTC (rev 1265) @@ -0,0 +1,290 @@ +purpose: Secure NAND updater +\ See license at end of file + +\ Depends on words from security.fth and copynand.fth + +: get-hex# ( -- n ) + safe-parse-word + push-hex $number pop-base " Bad number" ?nand-abort +; + +0 [if] +0 value partition-map-offset +0 value next-partition-start + +0 value partition# +d# 256 constant /partition-entry +: partition-adr ( -- adr ) partition# /partition-entry * load-base + ; +: max-nand-offset ( -- n ) " usable-page-limit" $call-nand /nand-page * ; + +: add-partition ( name$ #eblocks -- ) + partition# " max#partitions" $call-nand >= abort" Partition map overflow" + + -rot ( #eblocks name$ ) + partition-adr /partition-entry erase ( #eblocks name$ ) + d# 15 min partition-adr swap move ( #eblocks ) + next-partition-start partition-adr d# 16 + l! ( #eblocks ) + + dup -1 = if ( #eblocks ) + drop max-nand-offset ( last-offset ) + next-partition-start - ( #bytes ) + else + /nand-block * ( #bytes ) + then ( #bytes ) + + dup partition-adr d# 24 + l! \ size ( #bytes ) + + next-partition-start + to next-partition-start ( ) + next-partition-start max-nand-offset > abort" NAND size overflow" + + partition# 1+ to partition# +; +: start-partition-map ( -- ) + load-base /nand-block h# ff fill + 0 to partition# +\ 0 to next-partition-start + " partition-map-page#" $call-nand /nand-page * to partition-map-offset + + partition-map-offset to next-partition-start + " FIS directory" 1 add-partition +; +: write-partition-map ( -- ) + partition-map-offset /nand-page / dup " erase-block" $call-nand + load-base swap nand-pages/block " write-pages" $call-nand + nand-pages/block <> abort" Can't write partition map" + " read-partmap" $call-nand +; + +0 value partition-page-offset +: map-eblock# ( block# -- block#' ) partition-page-offset + ; + +\ XXX need to check for overwriting existing partition map +[then] + +0 value last-eblock# +: erase-eblock ( eblock# -- ) + drop \ XXX +; + +0 value secure-fsupdate? +d# 128 constant /spec-maxline + +: erase-gap ( end-block -- ) + dup last-eblock# > if + last-eblock# 1+ ?do i erase-eblock loop + else + drop + then +; + +vocabulary nand-commands +also nand-commands definitions + +0 [if] +: set-partition: ( "partitionid" -- ) \ partitionid is number or name + safe-parse-word " $set-partition" $call-nand abort" Nonexistent partition#" +; + +: partitions: ( "name" "#eblocks" ... -- ) + start-partition-map + begin parse-word dup while ( name$ ) + get-hex# add-partition ( ) + repeat ( null$ ) + 2drop + write-partition-map +; +[then] + +: zblocks: ( "eblock-size" "#eblocks" ... -- ) + get-hex# to /nand-block + get-hex# to #image-eblocks + open-nand + #image-eblocks show-init + get-inflater +; + +: zblocks-end: ( -- ) #image-eblocks erase-gap ; + +: data: ( "filename" -- ) + safe-parse-word fn-buf place + " ${DN}${PN}\${CN}${FN}" expand$ image-name-buf place + open-img + true to secure-fsupdate? +; + +: erase-all ( -- ) + #image-eblocks 0 ?do i erase-eblock loop + #image-eblocks show-writing +; + +: get-zdata ( comprlen -- ) + secure-fsupdate? if + load-base /spec-maxline fileih read-line ( len end? error? ) + " Spec line read error" ?nand-abort ( len end? ) + 0= " Spec line too long" ?nand-abort ( len ) + load-base swap ( adr len ) + source $= 0= " Spec line mismatch" ?nand-abort ( ) + + fileih ( ih ) + else ( ) + source-id ( ih ) + then ( ih ) + + >r load-base /nand-block + over r@ fgets ( comprlen #read r: ih ) + <> " Short read of zdata file" ?nand-abort ( r: ih ) + + r> fgetc newline <> ( error? ) + " Missing newline after zdata" ?nand-abort ( ) + + \ The "2+" skips the Zlib header + load-base /nand-block + 2+ load-base true (inflate) ( len ) + /nand-block <> " Wrong expanded data length" ?nand-abort ( ) +; + +: zblock: ( "eblock#" "comprlen" "hashname" "hash-of-128KiB" -- ) + get-hex# ( eblock# ) + get-hex# >r ( eblock# r: comprlen ) + safe-parse-word ( eblock# hashname$ r: comprlen ) + safe-parse-word hex-decode ( eblock# hashname$ [ hash$ ] err? r: comprlen ) + " Malformed hash string" ?nand-abort ( eblock# hashname$ hash$ r: comprlen ) + + r> get-zdata ( eblock# hashname$ hash$ ) + + 2>r ( eblock# hashname$ r: hash$ ) + load-base /nand-block 2swap ( eblock# data$ hashname$ r: hash$ ) + hash ( eblock# calc-hash$ r: hash$ ) + + 2r> $= 0= if ( eblock# ) + ." Bad hash for eblock# " .x cr cr + ." Your USB key may be bad. Please try a different one." cr + ." See http://wiki.laptop.org/go/Bad_hash" cr cr + abort + then ( eblock# ) + + dup erase-gap ( eblock# ) + + dup /nand-block um* " seek" $call-nand ( eblock# error ) + " Bad seek" ?nand-abort ( eblock# ) + + load-base /nand-block " write" $call-nand ( eblock# #written ) + /nand-block <> ( eblock# error? ) + " Error writing to NAND FLASH" ?nand-abort ( eblock# ) + + dup to last-eblock# ( eblock# ) + show-written ( ) +; + +previous definitions + +: fs-update ( "devspec" -- ) + load-crypto abort" Can't load hash routines" + + false to secure-fsupdate? + safe-parse-word r/o open-file ( fd ) + abort" Can't open file" ( fd ) + + file @ ( fd fd' ) + over file ! linefeed line-delimiter c! ( fd fd' ) + file ! ( fd ) + + + also nand-commands + ['] include-file catch dup if + nip .error + then + previous + show-done + close-nand-ihs +; + +: do-fs-update ( img$ -- ) + tuck load-base h# c00000 + swap move ( len ) + load-base h# c00000 + swap ( adr len ) + + ['] noop to show-progress + +\ clear-context nand-commands + also nand-commands + + true to secure-fsupdate? + ['] include-buffer catch ?dup if nip nip .error security-failure then + + previous +\ only forth also definitions + + show-done + close-nand-ihs +; + +: fs-update-from-list ( devlist$ -- ) + load-crypto if visible ." Crytpo load failed" cr show-sad security-failure then + + visible ( devlist$ ) + begin dup while ( rem$ ) + bl left-parse-string ( rem$ dev$ ) + dn-buf place ( rem$ ) + + null$ pn-buf place ( rem$ ) + null$ cn-buf place ( rem$ ) + " fs" bundle-present? if ( rem$ ) + " Filesystem image found - " ?lease-debug + fskey$ to pubkey$ ( rem$ ) + img$ sig$ sha-valid? if ( rem$ ) + 2drop ( ) + show-unlock ( ) + img$ do-fs-update ( ) + ." Rebooting in 10 seconds ..." cr + d# 10,000 ms bye + exit + then ( rem$ ) + show-lock ( rem$ ) + then ( rem$ ) + repeat ( rem$ ) + 2drop +; +: update-devices " disk: sd: http:\\172.18.0.1" ; +: try-fs-update ( -- ) + ." Searching for a NAND file system update image." cr + " disk: sd:" fs-update-from-list +[ifdef] Later + ." Trying NANDblaster" cr + ['] nandblaster catch 0= if exit then + " http:\\172.18.0.1" fs-update-from-list +[then] +; + +: $update-nand ( devspec$ -- ) + load-crypto abort" Can't load the crypto functions" + null$ cn-buf place ( devspec$ ) + 2dup ( devspec$ devspec$ ) + [char] : right-split-string dn-buf place ( devspec$ path+file$ ) + [char] \ right-split-string ( devspec$ file$ path$ ) + dup if 1- then pn-buf place ( devspec$ file$ ) + 2drop ( devspec$ ) + boot-read loaded do-fs-update ( ) +; +: update-nand ( "devspec" -- ) safe-parse-word $update-nand ; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 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

1 0

r1264 - cpu/x86/pc/olpc/via
by svn＠openfirmware.info 31 Jul '09

31 Jul '09

Author: wmb Date: 2009-07-31 20:46:49 +0200 (Fri, 31 Jul 2009) New Revision: 1264 Added: cpu/x86/pc/olpc/via/copynand.fth Modified: cpu/x86/pc/olpc/via/devices.fth cpu/x86/pc/olpc/via/fw.bth cpu/x86/pc/olpc/via/olpc.bth Log: Via - added "fs-update" command for OS installation. Added: cpu/x86/pc/olpc/via/copynand.fth =================================================================== --- cpu/x86/pc/olpc/via/copynand.fth (rev 0) +++ cpu/x86/pc/olpc/via/copynand.fth 2009-07-31 18:46:49 UTC (rev 1264) @@ -0,0 +1,567 @@ +\ See license at end of file +purpose: Copy a file onto the NAND FLASH + +0 value fileih +0 value nandih + +h# 20000 value /nand-block +h# 200 value /nand-page +/nand-block /nand-page / value nand-pages/block +0 value #nand-pages + +0 value #image-eblocks + +: $call-nand ( ?? method$ -- ?? ) nandih $call-method ; + +: close-image-file ( -- ) + fileih ?dup if 0 to fileih close-dev then +; +: close-nand ( -- ) + nandih ?dup if 0 to nandih close-dev then +; +: close-nand-ihs ( -- ) + close-image-file + close-nand +; + +: ?nand-abort ( flag msg$ -- ) + rot if + close-nand-ihs $abort + else + 2drop + then +; + +: ?key-stop ( -- ) + key? dup if key drop then ( stop? ) + " Stopped by keystroke" ?nand-abort +; + +: set-nand-vars ( -- ) + " size" $call-nand /nand-page um/mod nip to #nand-pages +; +: open-nand ( -- ) + " fsdisk" open-dev to nandih + nandih 0= " Can't open disk device" ?nand-abort + set-nand-vars +; + +h# 100 buffer: image-name-buf +: image-name$ ( -- adr len ) image-name-buf count ; + +: get-img-filename ( -- ) safe-parse-word image-name-buf place ; + +: open-img ( "devspec" -- ) + image-name$ open-dev to fileih + fileih 0= " Can't open NAND image file" ?nand-abort + " size" fileih $call-method ( d.size ) + + 2dup h# 20000 um/mod swap if 1+ then ( d.size #eblocks ) + nip nip ( #eblocks ) + + to #image-eblocks + + #image-eblocks 0= " Image file is empty" ?nand-abort +; + +: read-image-block ( -- ) + load-base /nand-block " read" fileih $call-method ( len ) + dup /nand-block <> if ( len ) + load-base over + /nand-page rot - h# ff fill + else + drop + then +; + +: check-mem-hash ( record# -- ) + drop \ XXX +; + + +defer show-init ( #eblocks -- ) +' drop to show-init + +defer show-erasing ( #blocks -- ) +: (show-erasing) ( #blocks -- ) ." Erasing " . ." blocks" cr ; +' (show-erasing) to show-erasing + +defer show-erased ( block# -- ) +: (show-erased) ( block# -- ) (cr . ; +' (show-erased) to show-erased + +defer show-bad ( block# -- ) +' drop to show-bad + +defer show-bbt-block ( block# -- ) +' drop to show-bbt-block + +defer show-clean ( block# -- ) +' drop to show-clean + +defer show-cleaning ( -- ) +: (show-cleaning) ( -- ) cr ." Cleanmarkers" ; +' (show-cleaning) to show-cleaning + +defer show-writing ( #blocks -- ) +: (show-writing) ." Writing " . ." blocks" cr ; +' (show-writing) to show-writing + +defer show-pending ( block# -- ) +' drop to show-pending + +defer show-written +: (show-written) ( block# -- ) (cr . ; +' (show-written) to show-written + +defer show-strange +' drop to show-strange + +defer show-done +' cr to show-done + +: written? ( adr len -- flag ) h# ffffffff lskip 0<> ; + +h# 80 h# 80 h# 80 rgb>565 constant bbt-color \ gray + 0 0 0 rgb>565 constant erased-color \ black +h# ff 0 0 rgb>565 constant bad-color \ red + 0 0 h# ff rgb>565 constant clean-color \ blue +h# ff 0 h# ff rgb>565 constant partial-color \ magenta +h# ff h# ff 0 rgb>565 constant pending-color \ yellow + 0 h# ff 0 rgb>565 constant written-color \ green + 0 h# ff h# ff rgb>565 constant strange-color \ cyan +h# ff h# ff h# ff rgb>565 constant starting-color \ white + +d# 22 constant status-line + +: gshow-init ( #eblocks -- ) + cursor-off " erase-screen" $call-screen + + starting-color ( #eblocks color ) + swap 0 ?do i over show-state loop + drop + 0 status-line at-xy +; + +: gshow-erasing ( #eblocks -- ) drop ." Erasing " ; + +: gshow-erased ( eblock# -- ) erased-color show-state ; +: gshow-bad ( eblock# -- ) bad-color show-state ; +: gshow-bbt-block ( eblock# -- ) bbt-color show-state ; +: gshow-clean ( eblock# -- ) clean-color show-state ; +: gshow-strange ( eblock# -- ) strange-color show-state ; + +: gshow-cleaning ( -- ) d# 26 status-line at-xy ." Cleanmarkers" cr ; +: gshow-done ( -- ) cursor-on ; + +: gshow-pending ( eblock# -- ) pending-color show-state ; + +: gshow-writing ( #eblocks -- ) + ." Writing " + 0 swap 0 ?do ( eblock# ) + dup show-pending ( eblock# ) + 1 ( eblock# increment ) + swap 1+ swap ( eblock#' increment ) + +loop ( eblock#' ) + drop +; + +: show-eblock# ( eblock# -- ) d# 20 status-line at-xy .x ; +: gshow-written ( eblock# -- ) + dup written-color show-state + show-eblock# +; + +: gshow + ['] gshow-init to show-init + ['] gshow-erasing to show-erasing + ['] gshow-erased to show-erased + ['] gshow-bad to show-bad + ['] gshow-bbt-block to show-bbt-block + ['] gshow-clean to show-clean + ['] gshow-cleaning to show-cleaning + ['] gshow-pending to show-pending + ['] gshow-writing to show-writing + ['] gshow-written to show-written + ['] gshow-strange to show-strange + ['] gshow-done to show-done +; + +gshow + +\ 0 - marked bad block : show-bad +\ 1 - unreadable block : show-bad +\ 2 - jffs2 w/ summary: show-written +\ 3 - jffs2 w/o summary: show-pending +\ 4 - clean : show-clean +\ 5 - non-jffs2 data : show-strange +\ 6 - erased : show-erased +\ 7 - primary bad-block-table : show-bbt-block +\ 8 - secondary bad-block-table : show-bbt-block +: show-status ( status eblock# -- ) + swap case + 0 of show-bad endof + 1 of show-bad endof + 2 of show-written endof + 3 of show-pending endof + 4 of show-clean endof + 5 of show-strange endof + 6 of show-erased endof + 7 of show-bbt-block endof + 8 of show-bbt-block endof + endcase +; + +0 value nand-map +0 value working-page +: classify-block ( page# -- status ) + to working-page + + working-page /nand-page um* " seek" $call-nand drop + + \ Try to read the first few bytes + load-base /l " read" $call-nand + + \ Check for non-erased, non-JFFS2 data + load-base l@ h# ffff.ffff <> if 5 exit then + + \ See if the whole thing is really completely erased + load-base /l + /nand-block /l - " read" $call-nand /nand-block /l - <> if 1 exit then + + \ Not completely erased + load-base /nand-block written? if 5 exit then + + \ Erased + 6 +; + +0 value current-block +0 value examine-done? + +string-array status-descriptions + ," Marked bad in Bad Block Table" \ 0 + ," Read error" \ 1 + ," JFFS2 data with summary" \ 2 + ," JFFS2 data, no summary" \ 3 + ," Clean (erased with JFFS2 cleanmarker)" \ 4 + ," Dirty, with non-JFFS2 data" \ 5 + ," Erased, no cleanmarker" \ 6 + ," Primary Bad Block Table" \ 7 + ," Secondary Bad Block Table" \ 8 +end-string-array + +: show-block-status ( block# -- ) + dup show-eblock# + nand-map + c@ status-descriptions count type kill-line +; + +: cell-border ( block# color -- ) + swap >loc ( color x y ) + -1 -1 xy+ + 3dup grid-w 1 do-fill ( color x y ) + 3dup grid-w 0 xy+ 1 grid-h do-fill ( color x y ) + 3dup 0 1 xy+ 1 grid-h do-fill ( color x y ) + 1 grid-h xy+ grid-w 1 do-fill +; +: lowlight ( block# -- ) background-rgb rgb>565 cell-border ; +: highlight ( block# -- ) 0 cell-border ; +: point-block ( block# -- ) + current-block lowlight + to current-block + current-block highlight +; + +0 value nand-block-limit +: +block ( offset -- ) + current-block + nand-block-limit mod ( new-block ) + point-block + current-block show-block-status +; + +: process-key ( char -- ) + case + h# 9b of endof + [char] A of #cols negate +block endof \ up + [char] B of #cols +block endof \ down + [char] C of 1 +block endof \ right + [char] D of -1 +block endof \ left + [char] ? of #cols 8 * negate +block endof \ page up + [char] / of #cols 8 * +block endof \ page down + [char] K of 8 +block endof \ page right + [char] H of -8 +block endof \ page left + h# 1b of d# 20 ms key? 0= if true to examine-done? then endof + endcase +; + +: examine-nand ( -- ) + 0 status-line 1- at-xy red-letters ." Arrows, fn Arrows to move, Esc to exit" black-letters cr + #nand-pages nand-pages/block / to nand-block-limit + 0 to current-block + current-block highlight + false to examine-done? + begin key process-key examine-done? until + current-block lowlight +; + +: (scan-nand) ( -- ) + nand-map 0= if + #nand-pages nand-pages/block / alloc-mem to nand-map + then + + " usable-page-limit" $call-nand + dup nand-pages/block / show-init ( page-limit ) + + 0 ?do + i classify-block ( status ) + i nand-pages/block / ( status eblock# ) + 2dup nand-map + c! ( status eblock# ) + show-status + nand-pages/block +loop ( ) + + show-done +; + +: scan-nand ( -- ) + open-nand (scan-nand) close-nand-ihs + examine-nand +; + + +: >eblock# ( page# -- eblock# ) nand-pages/block / ; + +: copy-nand ( "devspec" -- ) + open-nand + get-img-filename + open-img + + ['] noop to show-progress + + #nand-pages >eblock# dup show-init ( #eblocks ) + + show-erasing ( ) + + #image-eblocks show-writing + + #image-eblocks 0 ?do + read-image-block + i check-mem-hash + load-base " copy-block" $call-nand ( page# error? ) + " Error writing to NAND FLASH" ?nand-abort ( page# ) + >eblock# show-written ( ) + loop + + show-done + + close-nand-ihs +; + +: verify-nand ( "devspec" -- ) + open-nand + get-img-filename + open-img + ['] noop to show-progress + + ." Verifing " #image-eblocks . ." blocks" cr + + #image-eblocks 0 ?do + (cr i . + read-image-block + + i /nand-block um* " seek" $call-nand drop + load-base /nand-block " read" $call-nand ( len ) + /nand-block <> " Disk read error" ?nand-abort ( ) + + load-base load-base /nand-block + /nand-block comp if ( ) + cr ." Miscompare in block starting at page# " ( ) + ?key-stop + then ( ) + loop ( ) + close-nand-ihs +; + +: verify-img ( "img-devspec" -- ) + hex + open-nand close-nand-ihs \ To set sizes + get-img-filename + open-img + + ['] noop to show-progress + + ." Verifying " #image-eblocks . ." blocks" cr + + #image-eblocks 0 ?do + (cr i . + read-image-block + i check-mem-hash + loop + close-nand-ihs +; + +: check-hash ( adr len -- ) + 2drop \ XXX +; + +: verify-nand ( "crc-devspec" -- ) + hex + open-nand + safe-parse-word open-img + ['] noop to show-progress + + ." Verifying " #image-eblocks . ." blocks" cr + + #image-eblocks 0 ?do + (cr i . + + i /nand-block um* " seek" $call-nand drop + load-base /nand-block " read" $call-nand ( len ) + /nand-block <> " Disk read failure" ?nand-abort ( ) + + load-base /nand-block check-hash if ( ) + cr ." Hash mismatch at eblock " i . cr ( ) + ?key-stop + else ( actual-crc expected-crc ) + 2drop ( ) + then ( ) + loop ( ) + close-nand-ihs +; + +: make-new-file ( devspec$ -- fileih ) + 2dup ['] $delete catch if 2drop then ( name$ ) + 2dup ['] $create-file catch if ( name$ x x ) + 2drop ( name$ ) + " Can't open a file. Try using the raw disk?" confirm if ( name$ ) + open-dev ( ih ) + else ( name$ ) + 2drop 0 ( ih=0 ) + then ( ih ) + else ( name$ ih ) + nip nip ( ih ) + then ( ih ) +; + +: open-dump-file ( devspec$ -- ) + cr ." Dumping to " 2dup type cr + + make-new-file to fileih + + fileih 0= " Can't open output" ?nand-abort +; + +: dump-eblock? ( block# -- flag ) + \ Dump JFFS2 w/summary (2), JFFS2 w/o summary (3), non JFFS2 data (5) + nand-map + c@ dup 2 = over 3 = or swap 5 = or +; + +0 [if] +: eblock>file ( -- ) + load-base /nand-block " write" fileih $call-method + /nand-block <> " Write to dump file failed" ?nand-abort + load-base /nand-block $crc #image-eblocks >crc l! + #image-eblocks 1+ to #image-eblocks +; + +: fastdump-nand ( -- ) + \ The stack is empty at the end of each line unless otherwise noted + (scan-nand) + + cursor-off + d# 20 status-line at-xy ." " + + " usable-page-limit" $call-nand >eblock# 0 do + i dump-eblock? if + i point-block + i show-eblock# + load-base i nand-pages/block * nand-pages/block " read-pages" $call-nand ( #read ) + nand-pages/block <> " Read failed" ?nand-abort + eblock>file + then + loop + show-done +; + +: slowdump-nand ( -- ) + \ The stack is empty at the end of each line unless otherwise noted + #nand-pages 0 ?do + (cr i >eblock# . + load-base i nand-pages/block " read-pages" $call-nand ( #read ) + nand-pages/block = if + load-base /nand-block written? if + ." w" + eblock>file + i nand-pages/block bounds ?do + i pad ! pad 4 " write" fileih $call-method + 4 <> " Write of eblock number failed" ?nand-abort + loop + else + ." s" + then + then + nand-pages/block +loop +; + +: (dump-nand) ( "devspec" -- ) + open-nand + get-img-filename + + alloc-crc-buf + image-name$ open-dump-file + + 0 to #image-eblocks + + fastdump-nand + cr ." Done" cr + + close-image-file + + close-nand-ihs +; +: save-nand ( "devspec" -- ) (dump-nand) ; + +: fastcopy-nand ( "devspec" -- ) + open-nand + + safe-parse-word open-dev to fileih + fileih 0= " Can't open NAND fastboot image file" ?nand-abort + + " size" fileih $call-method drop ( len ) + " start-fastcopy" $call-nand ( error? ) + " Not enough spare NAND space for fast copy" ?nand-abort + + begin ( ) + load-base /nand-block " read" fileih $call-method ( len ) + dup 0> while ( len ) + \ If the read didn't fill a complete block, zero the rest + load-base /nand-block rot /string erase + + load-base " next-fastcopy" $call-nand ( ) + repeat ( len ) + drop ( ) + " end-fastcopy" $call-nand ( ) + + close-nand-ihs +; +[then] + +\ LICENSE_BEGIN +\ Copyright (c) 2006 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/x86/pc/olpc/via/devices.fth =================================================================== --- cpu/x86/pc/olpc/via/devices.fth 2009-07-31 18:45:34 UTC (rev 1263) +++ cpu/x86/pc/olpc/via/devices.fth 2009-07-31 18:46:49 UTC (rev 1264) @@ -164,9 +164,6 @@ .( XXX Not clearing CMOS) cr patch noop init-bios-cmos stand-init -devalias nand /nandflash -devalias mtd /nandflash - [ifdef] use-null-nvram \ For not storing configuration variable changes across reboots ... \ This is useful for "turnkey" systems where configurability would Modified: cpu/x86/pc/olpc/via/fw.bth =================================================================== --- cpu/x86/pc/olpc/via/fw.bth 2009-07-31 18:45:34 UTC (rev 1263) +++ cpu/x86/pc/olpc/via/fw.bth 2009-07-31 18:46:49 UTC (rev 1264) @@ -319,9 +319,8 @@ fload ${BP}/dev/olpc/keyboard/selftest.fth \ Keyboard diagnostic fload ${BP}/dev/olpc/touchpad/touchpad.fth \ Touchpad diagnostic fload ${BP}/cpu/x86/pc/olpc/gridmap.fth \ Gridded display tools -[ifdef] Later -fload ${BP}/cpu/x86/pc/olpc/copynand.fth -[then] +fload ${BP}/cpu/x86/pc/olpc/via/copynand.fth + \ fload ${BP}/cpu/x86/pc/olpc/carousel.fth \ Carouseled NAND writing fload ${BP}/cpu/x86/pc/olpc/crypto.fth \ Cryptographic image validation fload ${BP}/cpu/x86/pc/olpc/lzip.fth \ Access zip images from memory @@ -480,8 +479,9 @@ [ifdef] Later fload ${BP}/cpu/x86/pc/olpc/nandcastui.fth fload ${BP}/cpu/x86/pc/olpc/wifichannel.fth -fload ${BP}/cpu/x86/pc/olpc/fsupdate.fth [then] +fload ${BP}/cpu/x86/pc/olpc/via/fsupdate.fth +devalias fsdisk /ide@0/disk:0 fload ${BP}/ofw/inet/sntp.fth : olpc-ntp-servers ( -- ) Modified: cpu/x86/pc/olpc/via/olpc.bth =================================================================== --- cpu/x86/pc/olpc/via/olpc.bth 2009-07-31 18:45:34 UTC (rev 1263) +++ cpu/x86/pc/olpc/via/olpc.bth 2009-07-31 18:46:49 UTC (rev 1264) @@ -145,8 +145,8 @@ " memtest" " memtest" $add-deflated-dropin + " verify.img" " verify" $add-deflated-dropin [ifdef] Later - " verify.img" " verify" $add-deflated-dropin " os.public" " ospubkey" $add-dropin \ Incompressible " fw.public" " fwpubkey" $add-dropin \ Incompressible " fs.public" " fspubkey" $add-dropin \ Incompressible

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

openfirmware