!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  Utility/test macro for ICE-PIC DSP card
!
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
startmacro/setup/nover/quiet/ps=128k/nmq=1k &
 u:function u:p1 u:p2 u:p3 u:p4 u:p5 u:p6

local ii,nn,errors,total_errors,name,bname,scale,msgtxt,filename
local p1a p1b p2a p2b ramqual sr cfreq form spb chan card 
local sample osamples tmode timeleft time1 time2 timecode answer
local time1x time2x timecodex timedif info item value amp savehome

trap error quit

if ramaux rexists then
  res ramqual "(CTG=1)(AUX=RAMAUX)(DET=1)"
else
  res ramqual " "
endif

if function eqs "AUX" then
  if ramaux nrexists res/attr=p ramaux 1
  if p1 eqs "PIC"  ask l:p1 "Ram Aux [^ramaux]: "
  if ^p1 neq ramaux res/force/attr=p l:ramaux ^p1
  if env(ostype) eqs "UNIX"
    fname filename drv/lnx "chkramaux" "" ice
    env get "HOSTNAME" name
    fname bname cfg "diskunx_^name" "cfg" sys
    if bname nfexists then fname bname cfg "diskunx" "cfg" sys
    $ ^filename ^bname
  endif

elseif function eqs "DIR" then
  files ,,, ramaux

elseif function eqs "CLEAN" then
  files ,,, ramaux
  if /batch le 0
   ask answer "**** Erase all RAMDISK files [Y]/N :"
   if answer neqss "Y" return
  endif
  files/f ,,, ramaux
  forall files erase #

elseif function eqs "COPY" then
  noop ^p1 ^{p2}^ramqual

elseif function eqs "STATUS" then
  picd dmac ^p1
  picd get ^p1 "TYPE" ctype
  if ctype ge 5 and ctype le 9 then
    picd/dmac=0/hex GET ^p1 "ROUTE"
    picd GET ^p1 "STATUS"
  endif
  loop 2 nn
    picd/dmac=-nn get ^p1 "PMTYPE" pmtype
    if pmtype eq 0 continue
    picd/dmac=(10+nn)/hex GET ^p1 "ROUTE"
  endloop

elseif function eqs "SNAP" then
  snapper ^p1,^p2

elseif function eqs "CREATE" then
  if p1 eqs "PIC" ask u:p1 "Filename [RAMFILE]: "
  if p2 eqs " "   ask u:p2 "Format [SB]: "
  if p3 eqs " "   ask u:p3 "Samples [1M]: "
  if p4 eqs " "   ask u:p4 "SampleRate [1e6]: "
  if p5 eqs "TEST"   ask u:p5 "Options (RAMP|TRAMP|WHITE|BITS|SINE|ZERO) [NONE]: "
  callp create ^p1 ^p2 ^p3 ^p4 ^p5 ^p6

elseif function eqs "COPY" then
  noop ^p1 ^{p2}^{ramqual}

elseif function eqss "EXP" then
  explain pic

elseif function eqs "HELP" then
  if p1 eqs "PIC" res p1 "MAINHELP"
  help ^p1,^p2,ice

elseif function eqs "TEST/RT" then

  if p2 eqs " " then	! file name
    ask a:p2 "Filename [RAMFILE]: "
  endif
  if p3 eqs " " then	! fft size
    res p3 2k
    ask l:p3 "FFT size [2K]: "
  endif
  if p4 eqs " " then	! decimation
    calc p4 1/p2(hcb.xd) ^p3 / 10 / round 64 max
  endif
  sedit p2 p2a trim ,, "|"
  if "B" subs p2a(hcb.f) then	! scale factor
    res scale 128
  elseif "P" subs p2a(hcb.f) then
    res scale 1
  else
    res scale 32k
  endif
  if p5 eqs " " then	! frequency
    res p5 -1
  endif

  xpipe/controls on

  if p6 neqs " " then
    ^p6
  endif

  if "|" subs p1					! dual channel
    sedit p1 p1a trim ,, "|"
    sedit p1 p1b trim "|"
    sedit p2 p2a trim ,, "|"
    sedit p2 p2b trim "|"
    sourcepic/id=11/tl=1/wb=1/master=2002 p2a(fs=^p3) _cba(ps=128k) , ^p1a, ^p4, ^p5
    sourcepic/id=12/tl=1/wb=2/slave       p2b(fs=^p3) _cbb(ps=128k) , ^p1b, ^p4, ^p5
    if /nospectra le 0
      ubiq _cba(fs=0) _cbaf ^p3 HANN 0 ,,, _cbb(fs=0) _cbbf _cbf
      fanin _cbxf _cbaf _cbbf
      xrtraster/xs=2/dbrange=100 _cbf ,,,ph,, 32
      xrtplot/xs=3/dbrange=100/lps=2 _cbxf ,,,d1
    endif
    fanin _cbx _cba _cbb
    xrtplot/xs=4/lps=2 _cbx -scale scale re
  else							! single channel
    sourcepic/id=11/tl=1/wb=1 p2(fs=^p3) _cb(ps=1m) , p1, ^p4, ^p5
    if /nospectra gt 0
      xrtraster/xs=2 _cb -scale scale im ,, 32
      xrtplot/xs=3 _cb -scale scale imag
    else
      ubiq _cb(fs=0) _cbf ^p3 HANN 0 
      xrtraster/xs=2/dbrange=100 _cbf ,,,d1,, 32
      xrtplot/xs=3/dbrange=100 _cbf ,,,d1
    endif
    xrtplot/xs=4 _cb -scale scale im
  endif
  xpipe off

elseif function eqs "TEST/MOD/RT" then

  if p2 eqs " " res p2 "1"
  res p2a ^p2
  res p2b 3-^p2
  if p3 eqs " " res p3 "1K"	! FFT size
  if p4 eqs " " res p4 "1K"	! decimation
  if p5 eqs " " res p5 "TRAMP"	! waveform
  res sr 10e6
  if /HS gt 0 res sr 20e6

  picd reset ^p1 t^p2a
  if /ext gt 0 picd reset ^p1 iot
  if /int gt 0 picd reset ^p1 iir

  if /b gt 0
    res form "SB"
    res scale 128
  else
    res form "SI"
    res scale 32k
  endif

  if p6 neqs " "
    res sr 1/p6(hcb.xd)
  else
    res p6 "testin"
    callp create testin ^form 1m sr ^p5
  endif
  callp create testout ^form 4m sr

  switch aflags u:value get

  xpipe on 
  sourcepic/id=11/tl=1/wb=1/port=module^p2a/flags=muxclk=i|^value &
			testout(fs=^p3) _cb , ^p1, ^p4 
  if /int gt 0 
    ! data generated internally
  elseif /test gt 0
    picd/replay=5/pause=0.25/port=module^p2b/flags=bigend play ^p1 ^p6 
  elseif /hs gt 0
    picd/replay=5/pause=0.25/port=module^p2b play ^p1 ^p6 
  else
    picd/replay=2/pause=0.25/port=module^p2b play ^p1 ^p6 
  endif
  ubiq _cb(fs=0) _cbf ^p3 HANN 0 
  xrtraster/xs=2/dbrange=100 _cbf ,,,d1,, 32
  xrtplot/xs=3/dbrange=100 _cbf ,,,d1
  xrtplot/xs=4 _cb -scale scale re
  xpipe off
  picd reset ^p1 

elseif function eqs "TEST/TUN/RT" then

  res sr 8e6
  if p2 eqs " " res p2 "1"
  calc a:p2a ^p2-1 2 mod 1 +
  calc a:p2b ^p2 2 mod 1 +
  if p3 eqs " " res p3 "1K"	! FFT size
  if p4 eqs " " res p4 "256"	! decimation
  picd reset ^p1 t^p2a
  switch aflags u:value get
  if /ovsr gt 0
    picd OVSR ^p1 ,, /ovsr
!    calc sr sr /ovsr /
  endif
  if p5 eqs " " res p5 sr/128.1	! frequency
  switch "UFILT" u:ufilt get
  if ufilt neqs " "
    picd loadfc ^p1 ufilt ,, ^p2
    concat value "|UFILT" value
  endif
  if p6 neqs " "
    calc sr 1 p6(hcb.xd) / 
    callp create testin ^p6(hcb.f) 4m sr
  else
    res p6 testin
    waveform testin^ramqual si 64k saw 20000 sr/128 ,,, 1/sr
  endif
  if /C gt 0
    callp create testout1 ci 256k sr/2/^p4
  else
    callp create testout1 si 256k sr/^p4
  endif
  callp create testout2 si 4m sr
  if /sfres gt 0
    res p3r ^p3*^p4
  else
    res p3r p3
  endif
  if /tout gt 0
    res p2 p2b
  endif

  xpipe on 
  res cfreq ^p5
  if /sink gt 0
    sinkpic/replay=2/port=module^p2b/pause=.25/wrap ^p6 testin ^p1
  else
    picd/replay=2/port=module^p2b/pause=.25 play ^p1 ^p6
  endif
  sourcepic/id=11/tl=1/wb=1/port=tuner^p2/flags=^value &
		testout1(fs=^p3) _cb1 , ^p1, ^p4, ^p5, 0
  sourcepic/id=12/tl=1/wb=2/port=module^p2a/host=n &
		testout2(fs=^p3r) _cb2 , ^p1, 16
  ubiq _cb1(fs=0) _cbf1 ^p3 HANN 0 ,, 5
  ubiq _cb2(fs=0) _cbf2 ^p3r HANN 0 ,, 5
  xrtplot/xs=2/dbrange=120/mtag=x:w_1005/xcnt=2 _cbf2 ,,, d1 
  xrtplot/xs=3/dbrange=120 _cbf1 ,,60, d1
  xrtplot/xs=4 _cb1(cl=5*^p3) -32k 32k re
  xpipe off
  picd reset ^p1 

elseif function eqs "TEST/SINK" then

  if p2 eqs " " res p2 "1"
  res p2a ^p2
  res p2b 3-^p2
  if p3 eqs " " res p3 "1K"	! FFT size
  if p4 eqs " " res p4 "128"	! decimation
  res sr 1e6

  picd reset ^p1 t^p2a
  callp create testout si 1m sr
  callp create testin si 1m sr
  if p6 eqs " "
    res p6 "testfile"
    ramp ^p6 si 1m 1 259 0 1/sr
  else
    header testout xd=^p6(hcb.xd)
  endif

  xpipe on 
  sourcepic/id=11/tl=1/wb=1/port=module^p2a/flags=iom=test &
			testout(fs=^p3) _cb , ^p1, ^p4 
  sinkpic/id=12/wb=2/port=module^p2b/flags=iom=test/replay=0 &
			^p6 testin ^p1
  ubiq _cb(fs=0) _cbf ^p3 HANN 0 
  xrtraster/xs=2/dbrange=100 _cbf ,,,d1,, 32
  xrtplot/xs=3/dbrange=100 _cbf ,,,d1
  xrtplot/xs=4 _cb -32k 32k re
  xpipe off
  picd reset ^p1 

elseif function eqs "TEST/TCGEN" then

  if p2 eqs " " res p2 "50"
  picd reset ^p1 oow
  picd test ^p1 1000+^p2

elseif function eqs "TEST/LOOP" then

  calc total_errors 0
  picdriver reset ^p1 
  loop 10000 ii
    picdriver test ^p1,^p2,errors
    calc total_errors total_errors errors +
    say " **********************   Loop=^ii, Errors=^errors Total=^total_errors"
  endloop

elseif function eqs "TEST/SPEC" then

  picd getkey ^p1 PCIBW scale
  xpipe on
  picd specs ^p1 _specs
  xrtplot/xs=2/grid _specs 0 scale
  xpipe off

elseif function eqs "FLASH" or function eqs "LOADFLASH" then
  $$ $ICEROOT/jre/ice flash ^p1 ^p2

elseif function eqs "MAKE"
  callp make

elseif function eqs "HOME" then
  fname name fat ,,, ice
  homepath name

elseif function eqs "FAT" then
  env get home savehome
  pic home
  if p1 eqss "E2D" or p1 eqss "T2D" then
    ask answer "**** Execute short pass [Y]/N :"
    if answer eqss "Y" %testmod/fab io ^p1 3 
    ask answer "**** Execute long pass [Y]/N :"
    if answer eqss "Y" %testmod/fab io ^p1 50 
  elseif p1 eqss "D2E" or p1 eqss "D2T" then
    ask answer "**** Execute short pass [Y]/N :"
    if answer eqss "Y" %testmod/fab oi ^p1 3 
    ask answer "**** Execute long pass [Y]/N :"
    if answer eqss "Y" %testmod/fab oi ^p1 50 
  elseif p1 eqss "PIC4X" 
    ask answer "**** Execute short pass [Y]/N :"
    if answer eqss "Y" %testcard/fab/noxlink/ntun=2 ^p1 3
    ask answer "**** Execute long pass [Y]/N :"
    if answer eqss "Y" %testcard/fab/noxlink/ntun=2 ^p1 50
  elseif p1 eqss "DTDM" 
    ask answer "**** Execute short pass [Y]/N :"
    if answer eqss "Y" %testcard/fab/noxlink/noext/noint ^p1 3
    ask answer "**** Execute long pass [Y]/N :"
    if answer eqss "Y" %testcard/fab/noxlink/noext/noint ^p1 50
  elseif p1 eqss "PIC" or p1 eqss "MBT" then
    ask answer "**** Execute short pass [Y]/N :"
    if answer eqss "Y" %testcard/fab/noxlink ^p1 3
    ask answer "**** Execute long pass [Y]/N :"
    if answer eqss "Y" %testcard/fab/noxlink ^p1 50
  else
    say "Invalid card type = ^p1"
  endif
  env set home savehome

elseif function eqs "PFAT" then
  env get home savehome
  pic home
  if p2 eqs " " res p2 5
  if p1 eqss "E2D" or p1 eqs "D2E" or p1 eqs "A2D" then
    %testmod/noext ix ^p1 ^p2 pico
  elseif /batch gt 0
    %testcard/noext ^p1 ^p2
  else
    %testcard/noext ^p1 ^p2
    if /nox le 0 %testtuners/hs/c ^p1
  endif
  env set home savehome

elseif function eqs "TACH" then
  picd/flags=test test ^p1 91

elseif function eqs "ATT" then
  picd/flags=test test ^p1 91
  picd/verbose reset ^p1

elseif function eqs "CHECKFLASH" then
  picd/hex checkflash ^p1 
  picd/node=0 get ^p1 type ctype
  picd/node=0/ascii get ^p1 fpgasig sig
  fname fname dat icepic^{ctype}_^sig prm ice
  keyword fname get "CRC" a:crc
  say "File ^fname ChkSum = ^crc"

else

  picdriver/nopipe/quiet=0 , ^function , ^p1 , ^p2 , ^p3 , ^p4

endif
label quit
endmacro

startcontrols

label initialentry
res tmode -1
xcontrol/lab=m1 menu item ,, "TEST;Once,Cont,Stop,ReStart,Timecode,NewPort,Archive,Exit"
xcontrol/lab=f1/name="Freq: " dval freq ,^p5, 1 -1 1
xcontrol/lab=t1/disp/countdown/name="Time: " tmon timeleft tmode
return

label m1
if item ge 1 and item le 3 then
  res w_1001 item
elseif item eq 4 then
  res w_1001 7
elseif item eq 5
  xcall menu tmode tmode+2 "TIMECODE;Off,Now,1 sec,2 sec,3 sec,4 sec,5 sec,Zero"
  res tmode tmode-2
  if tmode eq 0 goto t1
  if tmode gt 0 xcall setc timeleft tmode
  if tmode gt 5 xcall setc timeleft 0.1
elseif item eq 6
  message send "MGO" 11 0 
  message getwn "=MGO"
  xcall prompt p1 ^p1 "Device Name:" 20
  sedit p1 p1 upcase
  message send "DEVICE" 11 0 1 s[40] p1
elseif item eq 7 and function eqs "TEST/TUN/RT/LIVE"
  timex NOW time1
  message send "ARCHIVE" 11 0 3 s[80]dd ARCHIVE_NB time1+1 1
  message send "ARCHIVE" 12 0 3 s[80]dd ARCHIVE_WB time1+1 1
  message getwn "=ARCHIVE" ,, info
  say "ARCHIVE status = ^info"
  message getwn "=ARCHIVE" ,, info
  say "ARCHIVE status = ^info"
  if info le 0 return
  message getwn "ARCHDONE" ,, info
  say "ARCHIVE archive_nb done "
  message getwn "ARCHDONE" ,, info
  say "ARCHIVE archive_wb done "
elseif item eq 7 and function eqs "TEST/RT" then
  message send "ARCHIVE" 11 0 3 s[80]dd ARCHIVE 0 -1
  message getwn "=ARCHIVE" ,, info
  say "ARCHIVE status = ^info"
elseif item eq 7 
  timex NOW time1
  message send "ARCHIVE" 11 0 3 s[80]dd ARCHIVE time1+0.1 0.1
  message getwn "=ARCHIVE" ,, info
  say "ARCHIVE status = ^info"
  if info le 0 return
  message getwn "ARCHDONE" ,, info
  say "ARCHIVE done "
  xplot archive
elseif item eq 8
  stop
endif
return

label f1
res w_1005 freq
return

label t1
if tmode eq -1 return
if tmode gt 5
message send "TC" 11 ,, 1 "D" 0
else
message send "TC" 11 ,, 1 "D" -1
endif
message getwn "=TC" ,,info,,, sample time1 time2
timex time1|time2 tx:timecode
if "|" subs p1					! dual channel
  message send "TC" 12 ,, 1 "D" sample
  message getwn "=TC" ,,,,, sample time1x time2x
  calc timedif time1x-time1 time2x-time2 + 1e9 * round
  res msgtxt "TC = ^timecode  Diff=^timedif nSec at Sample ^sample"
else
  res msgtxt "TC = ^timecode at Sample ^sample Stat ^info"
endif
if tmode eq 0 then
  xcall message msgtxt
elseif tmode gt 0
  say msgtxt
  if info ne 1 
    xcall message "TC stat != 1 Problem - Reset to continue"
  elseif tmode gt 5 
    xcall setc timeleft 0.1
  else
    xcall setc timeleft tmode
    pause 0.1
  endif
endif
return


endcontrols

procedure create a:filename a:format n:samples n:samplerate a:shape n:gain
local bpe bytes
if "I" subs format
  res bpe 2
elseif "B" subs format
  res bpe 1
elseif "L" subs format
  res bpe 4
elseif "P" subs format
  res bpe .125
endif
if "C" subs format
  res bpe bpe*2
endif
if /ROUND gt 0
 calc spb /round bpe /
else
 calc spb 64k bpe /
endif
calc osamples samples
calc samples samples spb / round 1 max spb *
if /POWER2 gt 0 calc samples samples power2
if /EXACT gt 0 res samples osamples
if shape neqs " " and shape neqs "NONE" and osamples lt spb res samples osamples
if samples ne osamples
!  warn "Rounding PIC create samples from ^osamples to ^samples
endif
if /multi gt 0 then
  calc samples samples /multi *
endif
if "B" subs format
  res amp 120
else
  res amp 32000
endif
if gain neq 0 calc amp amp 2 (gain/6) ** *
if shape eqs "RAMP" 
  ramp/nopipe ^{filename}^ramqual ^format ^samples 0 1 0 1/^samplerate
elseif shape eqs "TRAMP" 
  ramp/nopipe ^{filename}^ramqual ^format ^samples 1 256+3 0 1/^samplerate
elseif shape eqs "ZERO" 
  constant/nopipe ^{filename}^ramqual ^format ^samples 0 0 0 1/^samplerate 1
elseif shape eqs "WHITE"
  if "B" subs format
  white/nopipe ^{filename}^ramqual ^format ^samples 0 512  0 1/^samplerate
  else
  white/nopipe ^{filename}^ramqual ^format ^samples 0 5e7  0 1/^samplerate
  endif
elseif shape eqs "BITS"
  ramp/nopipe testbits si ^samples/16 1 259 0 1/^samplerate
  header testbits f=sp
  reformat/nopipe testbits ^{filename}^ramqual si
elseif shape eqs "SINE"
  waveform/nopipe ^{filename}^ramqual ^format ^samples "SINE" amp ^samplerate/50 0 0 1/^samplerate
elseif shape eqs "TONES"
  firwind tmpfir bandpass hann 256 ^samplerate/5 ^samplerate/4 ^samplerate/2
  pipe on
  waveform _t1 sf ^samples "SINE" amp/4 ^samplerate/4 0 0 1/^samplerate
  waveform _t2 sf ^samples "SINE" amp/4 ^samplerate/11 0 0 1/^samplerate
  waveform _t3 sf ^samples "SINE" amp/4 ^samplerate/12 0 0 1/^samplerate
  waveform _t4 sf ^samples "SINE" amp/4 ^samplerate/30 0 0 1/^samplerate
  whitenoise _t5p sf ^samples+16k 0 (amp/8)**2
  fastfilter _t5p tmpfir _t5
  fcalc _tt _t1 _t2 + _t3 + _t4 + _t5 +
  reformat _tt ^{filename}^ramqual format
  pipe off
elseif env(ostype) eqs "OSF"
  fcreate/nopipe/nowarn filename^ramqual format samples 0 1/samplerate 1
else
  fcreate/nopipe filename^ramqual format samples 0 1/samplerate 1
endif
return

procedure make
if p1 eqss "LIB"
  buildopt;ice/makelib

elseif p1 eqss "SHARC"
  fname name sharc xcode ,, ice
  fname bname dat ^p2 prm ice
  callp copy ^name.ldr ^name.txt
  convert name t2b i6
  headermod name f=6b xs=1 xd=1 xu=0
  comment name "SHARC Boot Loader Code Segments"
  callp copy ^name.tmp bname
  status/key bname
  fname name sharc handlers.doj ,, ice
  fname bname sharc handlers_^p2.doj ,, ice
  callp copy ^name ^bname

elseif p1 eqss "IOC" then
  fname bname dat ^p2 prm ice
  find ycode.ttf name
  picd "TTF2M" ,, name bname
  status/key bname

elseif p1 eqss "ABITS" then
  fname bname dat ^p2 prm ice
  find ycode.bit name
  picd "TTF2M" ,, name bname
  status/key bname

elseif p1 eqss "ALLIOC" then
  if p2 eqs " " res p2 "PIC3"
  ask a:card "Card name [ICE^p2]: "
  res bname "T1,T2,II,IIX,IIR,IOX,IO,OI,OO,GSM,8E1,E321,BP"
  loop 13 ii
    sedit bname name parse ii
    res name ^{card}_^{name}
    say "List = ^bname"
    ask answer "Process file ^name (Y/N) [Y]:"
    if answer eqss "Y" pic make ioc ^name
  endloop

elseif p1 eqss "FCSYM"
  res name p2
  status name sz=nn
  calc sample nn*2-1
  loop sample-nn ii
    res name(nn+ii) name(nn-ii)
  endloop
  status name

elseif p1 eqss "ADFILT"
  find ^p2.imp p4
  fcreate fc_tmp
  find fc_tmp bname
  sedit bname bname subs ".tmp" ".txt"
  callp copy p4 bname
  convert fc_tmp t2b "L10" 6
  status fc_tmp sz=ntap
  block fc_tmp fc_tmpb ntap
  maxmin fc_tmp tmax 
  calc/quiet=0 scale 65536 fc_tmpb(1) ntap * /
  calc/quiet=0 scale 32767 tmax / scale min
  marray fc_tmp fc_tmp(ft=i) scale
  xplot fc_tmp
  if p3 neqs " " then
    fname bname dat ^p3 prm ice
    noop fc_tmp bname
  endif

elseif p1 eqs "GAP"
  picd gerber

elseif p1 eqss "GTUN"
  %testcard/nosig/noint/nolink/noxlink/noext/gtun ^p2 1
  fname bname dat ^p1 prm ice
  noop testout bname
  res nn 2
  if p1 eqs "GTUN2" res nn 0
  if p1 eqs "GTUN3" res nn 256
  key/scope=main bname repl a:skip ^nn
  if p1 eqs "GTUN10" key/scope=main bname repl a:mask 0x000F000F

else
  warn "Unknown make option: ^p1"
endif
return

procedure copy a:from a:to
if env(ostype) eqs "VMS"
  $copy ^from ^to
else
  sedit from from locase
  sedit to to locase
  $cp ^from ^to
endif
return

