( cast.4th - 20 MAY 2007 version runs from RAM cold exram hex 1010 dp ! ( start varns at $1010 in exram : is constant ; : fis fconstant ; : ccreate create ; decimal 800 is cver variable bufcasts ( holds # of casts moved to buffer variable bufptr ( points at locn of next cast data in buffer variable s1 ( starting sample # for std-tgt cals variable s2 ( ending sample # variable scntr ( used by bstr variable mem-full ( flag to signal memory is full ( if set, go to sleep variable delay-between ( holds delay time between pings variable castcntr ( primary cast counter, copy to castnum variable psamps ( place to hold # samples in sounder mode variable poffset ( holds depth sensor zero value variable pulse ( holds timer value for pulse length variable instflag ( = t if any instruments enabled variable tapsmode ( = t if power on, pinging 2variable temp-len ( used in hex dump routines variable temp1 ( temp value storage variable #dp ( used in fp conversion routines 2variable integers 2variable decimals variable killme ( flag to exit flash variable source ( used in write-program code 2variable sum ( 4-byte intensity accumulator, cast mode sum is high-byte ( entry to upper word sum 2 + is low-byte ( entry to lower word 2variable tsum ( sum of n temperature readings 2variable dsum ( sum of n pressure readings variable nstart ( starting sample for ei variable cntr variable high variable low fvariable sf1 ( holds nsamps * npings variable num1 ( use for number conversion variable num2 variable num3 variable errorcount ( holds # of errors in compare 2variable fadr ( holds current sector address in cf-ram 2variable temp-fadr ( holds fadr during data dumps variable 110data ( 16 bit result from read-110 fvariable lnr ( log of sensor resistance, tsttmp variable sgn ( place to save sign, temp fvariable fp-temp ( place to save fp temperature 2variable cur-depth ( place to save current depth in cm ( +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ( ram assignments ( ( this section of varns is copied from eeprom on startup; 124 bytes ( from $e00 to $e7b. ( this section is also copied into cfram to start every cast. ( also holds current working variables. ccreate header 124 allot ( space for variables header is mode ( 0 = cast mode ( 1 = remote sounder, no storage ( 2 = internal sounder, starts at set times ( 3 = instrument mode ( 4 = raw data cast mode mode 2+ is serno serno 2+ is verno verno 2+ is castnum ( place for cast # castnum 2+ is numfreq ( fixed at 6 freqs numfreq 2+ is datalen datalen 2+ is nbins ( 3 range bins in sounder mode nbins 2+ is vbat ( gets over-written by ops prog vbat 2+ is npings ( # of pings per average npings 2+ is nsamps ( # of samples per ping nsamps is nprofiles ( sounder defn: # profiles before quit nsamps 2+ is gatelen ( fixed gatelength = 3*112 usec gatelen 2+ is range ( mean sample range in cm range is timeint ( minutes between sounder profiles range 2+ is dsf ( fp depth scale factor dsf 4 + is tofs ( fp temperature offset value tofs 4 + is d-sensor ( psia rating of depth sensor d-sensor 2+ is delta-dep ( 10 * mm/bit delta-dep 2+ is baud baud 2+ is freq1 freq1 2+ is freq2 ( define elements in this array freq2 2+ is freq3 freq3 2+ is freq4 freq4 2+ is freq5 freq5 2+ is freq6 freq6 2+ is fcal1 fcal1 4 + is fcal2 fcal2 4 + is fcal3 fcal3 4 + is fcal4 fcal4 4 + is fcal5 fcal5 4 + is fcal6 fcal6 4 + is inst1 inst1 2+ is inst2 inst2 2+ is eorflag eorflag 2+ is d-on d-on 4 + is d-off d-off 4 + is d-max d-max 4 + is vbatsf vbatsf 4 + is junk ccreate pheader 124 allot ( space for variables pheader is pmode ( 0 = cast mode ( 1 = remote sounder, no storage ( 2 = internal sounder, starts at set times ( 3 = instrument mode ( 4 = raw data cast mode pmode 2+ is pserno pserno 2+ is pverno pverno 2+ is pcastnum ( place for cast # pcastnum 2+ is pnumfreq ( fixed at 6 freqs pnumfreq 2+ is pdatalen pdatalen 2+ is pnbins ( 3 range bins in sounder mode pnbins 2+ is pvbat ( gets over-written by ops prog pvbat 2+ is pnpings ( # of pings per average pnpings 2+ is pnsamps ( # of samples per ping pnsamps is pnprofiles ( sounder defn: # profiles before quit pnsamps 2+ is pgatelen ( fixed gatelength = 3*112 usec pgatelen 2+ is prange ( mean sample range in cm prange is ptimeint ( minutes between sounder profiles prange 2+ is pdsf ( fp depth scale factor pdsf 4 + is ptofs ( fp temperature offset value ptofs 4 + is pd-sensor ( psia rating of depth sensor pd-sensor 2+ is pdelta-dep ( 10 * mm/bit pdelta-dep 2+ is pbaud pbaud 2+ is pfreq1 pfreq1 2+ is pfreq2 ( define elements in this array pfreq2 2+ is pfreq3 pfreq3 2+ is pfreq4 pfreq4 2+ is pfreq5 pfreq5 2+ is pfreq6 pfreq6 2+ is pfcal1 pfcal1 4 + is pfcal2 pfcal2 4 + is pfcal3 pfcal3 4 + is pfcal4 pfcal4 4 + is pfcal5 pfcal5 4 + is pfcal6 pfcal6 4 + is pinst1 pinst1 2+ is pinst2 pinst2 2+ is peorflag peorflag 2+ is pd-on pd-on 4 + is pd-off pd-off 4 + is pd-max pd-max 4 + is pvbatsf pvbatsf 4 + is pjunk ( ---------------- cast-mode data goes ( here ------------------------| ( 44 bytes w/eor flag ccreate dheader 50 allot dheader 2+ is daytime daytime is year year 1+ is month month 1+ is day day 1+ is hour hour 1+ is minute minute 1+ is second second 1+ is wdepth ( double-word depth accumulator wdepth 4 + is wtemp ( double-word temp accumulator wtemp 4 + is ifreq1 ifreq1 2+ is ifreq2 ifreq2 2+ is cacc1 cacc1 4 + is cacc2 cacc2 4 + is cacc3 cacc3 4 + is cacc4 cacc4 4 + is cacc5 cacc5 4 + is cacc6 cacc6 4 + is ceorflag ( ----------------- other ram variables ------------------------- ccreate buff ( 32 byte input text buffer 32 allot ccreate buffer 512 allot ( compact flash sector buffer ccreate data 40 allot ( room for 20 data samples ( end of ram assignments ( +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ( ---------------------- constants ----------------------------------- hex ( commands: 4b is kill ( ascii 'k' to kill program 10 is p ( ctrl-p to program new parms 14 is reset-clock ( ctrl-t to set clock 1a is cals ( ctrl-z to change cal constants 43 is temperature ( ascii 'c' for temperature display 44 is d ( ascii 'd' for dump data 45 is e ( ascii 'e' for erase data 49 is instruments ( ascii "i" for instrument display 53 is s ( ascii 's' for status display 54 is clock ( ascii 't' for tod display 56 is volts ( ascii 'v' for battery voltage display ( registers: 0056 is portp ( port p data register 0057 is ddrp ( port p data direction register 006f is portad ( on-board adc data register 00ae is portt ( port t data register 00af is ddrt ( port t data direction register 00fe is pdlc ( port dlc data register 00ff is ddrdlc ( port dlc data direction register 00c0 is baud-reg ( serial baud rate reg - 16 bits 00d0 is spocr1 ( spi 1 control register 00d1 is spocr2 ( spi 2 control register 00d2 is spobr ( spi baud rate register 00d3 is sposr ( spi status register 00d5 is spodr ( spi data register 00d6 is ports ( port s data register 00d7 is ddrs ( port s data direction register 0080 is tios ( timer i/o select register 0084 is tcntr ( timer counter register 0086 is tscr ( timer system control register 008b is tctl4 ( timer control register 4 008d is tmsk2 ( timer interrupt mask register 2 008e is tflg1 ( timer interrupt flag register 1 008f is tflg2 ( timer interrupt flag register 2 0090 is tc0 ( timer input compare register 1 0091 is tc1 ( timer input compare register 2 0e00 is mycals ( eeprom region for ops parms 1000 is prgm-adrs ( place for program address 1004 is first-flag ( TRUE on first program load aaaa is marker ( start of frame marker dddd is dmarker ( start of data marker eded is eod ( eod marker 7e00 is cfbase ( memory-mapped window to cf ram ( addresses decoded to r/w to cf: $7ea0 - 7eaf 7ea0 is cfdata ( byte-port to flash 7ea1 is cferror ( read-only 7ea1 is features ( write only 7ea2 is sctrcnt ( sector count register 7ea3 is lba0 ( lba0:7 = sector number 7ea4 is lba1 ( lba8:15 = cylinder low 7ea5 is lba2 ( lba16:23 = cylinder high 7ea6 is head ( byte value for head count head is lba3 ( alternate name 7ea7 is status ( read only 7ea7 is command ( write only 7eae is dev-ctrl ( write only 7e90 is config ( r/w config register 7e96 is socket ( r/w socket & copy register ( real-time clock 7fff is year-reg ( clock registers 7ffe is month-reg 7ffd is day-reg 7ffc is dow-reg 7ffb is hour-reg 7ffa is min-reg 7ff9 is sec-reg 7ff8 is ctrl-reg ff is year-mask 1f is month-mask 3f is day-mask 07 is dow-mask 3f is hour-mask 7f is min-mask 7f is sec-mask 80 is write 40 is read 0 is false -1 is true ( ---------------------------- tvg table ----------------------------------- ( linear tvg for 16 samps from 0.38 to 2.34 m @ 0.13 m intervals + 23dB gain hex create tvg 0a2d , 0b3d , 0c0d , 0cb6 , 0d43 , 0dbd , 0e29 , 0e88 , 0edf , 0f2e , 0f76 , 0fb9 , 0ff0 , 0ff0 , 0ff0 , 0ff0 , ( ------------------ prefix table for dds codes --------------------- hex create prefix 3322 , 3120 , 3726 , 3524 , 0000 , ( ---------------------- frequency tables --------------------------- ( 5/09/05 ( layout is ttdd ffff ffff llll llll, w( here ( tt is the mux/gain code ( dd is a dummy byte [0] ( ffff ffff is the code for 2*xmit freq ( llll llll is the code for the lo freq hex create freqs 8000 , 02b6 , ae7d , 0189 , 374c , ( 265 khz freqs + 0 8400 , 044d , 013b , 0254 , 60aa , ( 420 khz freqs + 10 4800 , 072b , 020c , 03c3 , 6113 , ( 700 khz freqs + 20 6c00 , 0b43 , 9581 , 05cf , aace , ( 1100 khz freqs + 30 7000 , 12f1 , a9fc , 09a6 , b50b , ( 1850 khz freqs + 40 9400 , 1f21 , 2d77 , 0fbe , 76c9 , ( 3040 khz freqs + 50 ( companion table of xmit freqs in khz decimal create khz 265 , 420 , 700 , 1100 , 1850 , 3040 , hex decimal ( ------------------------------------------------------------------- 130 is crange ( nominal sample range 200 is delay2 ( time between pings 15000 is delay-on ( time to wait after transceiver power turned on ( fp constants 1.47e1 fis atm 1.0e5 fis ten5 1.6383e4 fis maxn ( max adc value 4.294967e9 fis f2pos ( correct accumulator overflow 1e6 fis fclock ( clock rate of internal timer 6.5536e4 fis fullscale ( for max110 adc 9.354e-4 fis a ( select for r-25 2.211e-4 fis b ( select for r-25 1.275e-7 fis c ( select for r-25 30.0e3 fis r-25 ( select for thermistor 5.0e-1 fis one-half 273.115e0 fis k2c 1.0e-15 fis eps ( a small value 0.0e0 fis zero 1.0e0 fis one 1.0e1 fis ten 2.0e1 fis v20 ( turn-on threshold voltage 990317 1.0e2 fis hundred -1.0e2 fis minus100 6.25e-8 fis sf2 ( convert acc to v^2 2.03451e0 fis sffreq ( convert count to hz 4.9e-1 fis fpd-on ( 50 cm min d-on 7.4e-1 fis fpd-off ( 75 cm min d-off 1.01e3 fis fpd-max ( 1000 m max d-max ( ======================= spi init subroutine ========================= hex code-sub spi-init ( code to setup spi i/o 4cd6 , 80 c, ( bset ports,#$80 ; set ss line high 180b , e0 c, ddrs , ( movb #$e0,ddrs ; configure port s ddr 180b , 02 c, spobr , ( movb #$02,spobr ; set sclk rate = 1 mhz 180b , 12 c, spocr1 , ( movb #$12,spocr1 ; mstr=1, cpol=cpha=0 180b , 08 c, spocr2 , ( movb #$08,spocr2 ; spi 2 outputs, active 96d3 , ( ldaa sposr ; 1st step to clear spif flag 96d5 , ( ldaa spodr ; 2nd step to clear spif flag 4cd0 , 40 c, ( bset spocr1,#$40 ; enable spi 3d c, ( rts end-code code-sub spi-on 4cd0 , 40 c, ( bset spocr1,#$40 ; enable spi 3d c, ( rts end-code code-sub spi-off 4dd0 , 40 c, ( bclr spocr1,#$40 ; disable spi 3d c, end-code ( ;==================================================================== ( ; program tapstr.asm ( ; 25 march 2005 ( ; 68hc12 subroutine to generate pings and sample echoes ( ; for the bubblescan and taps newgen ( ; ( ; assumes the dds, mux, and gains have been set ( ; always takes 16 samples at t/2 intervals ( ; ( ; uses the free-running timer to set pulse lengths and ( ; sample intervals ( ; ( ; y register used to point to freqs table ( ; x register used to point to prefix table ( ; ( ;------------------- code starts ( here -------------------- code-sub tapstr ( main: 3b c, ( pshd ; save d accumulator 34 c, ( pshx ; save x register 35 c, ( pshy ; save y register 4cd0 , 40 c, ( bset spocr1,#$40 ; enable spi ce c, data , ( ldx #data ; point x at top of data array cc c, 0010 , ( ldd #16 ; load fixed # of samples 7c c, scntr , ( std scntr ; into sample counter 4d56 , 20 c, ( bclr portp,#$20 ; ensure dds set to xmit freq ( ; -------------- set tvg amp to first gain value ------------ cd c, tvg , ( ldy #tvg ; point y at start of tvg table ec40 , ( ldd 0,y ; read it 4d56 , 10 c, ( bclr portp,#$10 ; assert \dac, pp4 5ad5 , ( staa spodr ; send to dac 4fd3 , 80fc , ( brclr sposr,#$80,* 96d5 , ( ldaa spodr ; clear data register 5bd5 , ( stab spodr 4fd3 , 80fc , ( brclr sposr,#$80,* 96d5 , ( ldaa spodr ; clear data register 4c56 , 10 c, ( bset portp,#$10 ; de-assert \dac, pp4 02 c, ( iny 02 c, ( iny ; update tvg pointer ( ; generate the transmit pulse 4d8e , fe c, ( bclr tflg1,#~$01 ; clear timer flag bit 1 4d86 , 80 c, ( bclr tscr,#ten ; stop timer fc c, pulse , ( ldd pulse ; timer tics for xmit pulse d384 , ( addd tcnt ; add to value of timer counter 5c90 , ( std tco ; init the oc register with delay 4c86 , 80 c, ( bset tscr,#ten ; restart the counter 4d56 , 80 c, ( bclr portp,#$80 ; start xmit gate 4f8e , 01fc , ( brclr tflg1,#$01,* ; wait until timer matches new count 4d8e , fe c, ( bclr tflg1,#~$01 ; clear timer flag bit 1 4c56 , 80 c, ( bset portp,#$80 ; end of xmit pulse 4c56 , 20 c, ( bset portp,#$20 ; select lo freq ( ; generate a fixed-length delay 4d86 , 80 c, ( bclr tscr,#ten ; stop timer fc c, pulse , ( ldd pulse 49 c, ( lsrd ; t/2 delay d384 , ( addd tcnt ; add to value of timer counter 5c90 , ( std tco ; init the oc register with delay 4c86 , 80 c, ( bset tscr,#ten ; restart the counter 4f8e , 01fc , ( brclr tflg1,#$01,* ; wait until timer matches new count 4d8e , fe c, ( bclr tflg1,#~$01 ; clear timer flag bit 1 ( ; take nsamps echo samples ( start with t/2 delay ( sample: 4d86 , 80 c, ( bclr tscr,#ten ; stop timer fc c, pulse , ( ldd pulse 49 c, ( lsrd ; t/2 delay d384 , ( addd tcnt ; add to value of timer counter 5c90 , ( std tco ; init the oc register with delay value 4c86 , 80 c, ( bset tscr,#ten ; restart the counter 4d56 , 08 c, ( bclr portp,#$08 ; assert \adc1, pp3; start adc sample 180b , 0000 , d5 c, ( movb #$00,spodr ; send command byte to adc 4fd3 , 80fc , ( brclr sposr,#$80,* ; wait for data gone 96d5 , ( ldaa spodr ; read dummy value 180b , 0000 , d5 c, ( movb #$00,spodr ; send a dummy byte 4fd3 , 80fc , ( brclr sposr,#$80,* ; wait for data gone 96d5 , ( ldaa spodr ; read high byte of result 180b , 0000 , d5 c, ( movb #$00,spodr ; send a dummy byte 4fd3 , 80fc , ( brclr sposr,#$80,* ; wait for data gone d6d5 , ( ldab spodr ; read low byte of result 4c56 , 08 c, ( bset portp,#$08, ; de-assert \adc 49 c, ( lsrd 49 c, ( lsrd ; shift d right twice to normalize 843f , ( anda #$3f ; mask d to $3fff max 6c31 , ( std 2,x+ ; save word, inc x by 2 ( ; -------------- set tvg amp to next gain value ------------ ec40 , ( ldd 0,y ; read it 4d56 , 10 c, ( bclr portp,#$10 ; assert \dac, pp4 5ad5 , ( staa spodr ; send to dac2 4fd3 , 80fc , ( brclr sposr,#$80,* 96d5 , ( ldaa spodr ; clear data register 5bd5 , ( stab spodr 4fd3 , 80fc , ( brclr sposr,#$80,* 96d5 , ( ldaa spodr ; clear data register 4c56 , 10 c, ( bset portp,#$10 ; de-assert \dac, pp4 02 c, ( iny 02 c, ( iny ; update tvg pointer 4f8e , 01fc , ( brclr tflg1,#$01,* ; wait until timer matches new count 4d8e , fe c, ( bclr tflg1,#-01 ; clear timer flag bit 1 ( ; ---------------- check if done sampling ------------------- fc c, scntr , ( ldd scntr ; fetch sample counter 83 c, 0001 , ( subd #01 ; subtract one 7c c, scntr , ( std scntr ; save updated counter 2699 , ( bne sample ; take another sample? 31 c, ( puly ; restore stack 30 c, ( pulx 3a c, ( puld 3d c, ( rts ; and return end-code ( ======================== cast mac =================================== ( cast-mode mac code - stack points at beginning sample # in data ( squares and sums 5 samples, returns with double-value on stack ( 68hc12 version 060621 code-sub cmac ec40 , ( ldd 0,y ; read starting sample # 02 c, ( iny ; fix stack pointer 02 c, ( iny 35 c, ( pshy ; save y register on stack 34 c, ( pshx ; save x register on stack 53 c, ( decb ; sub 1 from sample # 59 c, ( asld ; multiply sample # by 2 c3 c, data , ( addd #data ; add to address of data b7c5 , ( xgdx ; put data address in x register ( mac 5 samples starting at selected sample c605 , ( ldab #05 7b c, cntr , ( stab cntr cc c, 0000 , ( ldd #00 7c c, high-byte , ( std high 7c c, low-byte , ( std low ( square & sum data ( sloop: 10fe , ( clc e600 , ( ldab 0,x 180f , ( tba 12 c, ( mul f3 c, high-byte , ( addd high 7c c, high-byte , ( std high e600 , ( ldab 0,x 08 c, ( inx a600 , ( ldaa 0,x 12 c, ( mul 59 c, ( asld 7c c, temp1 , ( std temp1 180f , ( tba c7 c, ( clrb f3 c, low-byte , ( addd low 7c c, low-byte , ( std low 2409 , ( bcc nocar1 cc c, 0001 , ( ldd #01 f3 c, high-byte , ( addd high 7c c, high-byte , ( std high ( nocar1: fc c, temp1 , ( ldd temp1 180e , ( tab 87 c, ( clra f3 c, high-byte , ( addd high 7c c, high-byte , ( std high a600 , ( ldaa 0,x 180e , ( tab 12 c, ( mul f3 c, low-byte , ( addd low 7c c, low-byte , ( std low 2409 , ( bcc nocar2 cc c, 0001 , ( ldd #01 f3 c, high-byte , ( addd high 7c c, high-byte , ( std high ( nocar2: 08 c, ( inx 73 c, cntr , ( dec cntr 26ad , ( bne sloop - end of square & sum loop ( ; and exit with mean-squared value on stack 30 c, ( pulx 31 c, ( puly - restore y register 03 c, ( dey 03 c, ( dey fc c, low-byte , ( ldd low 6c40 , ( std 0,y 03 c, ( dey 03 c, ( dey fc c, high-byte , ( ldd high 6c40 , ( std 0,y 3d c, ( rts - exit with on stack end-code ( ===================================================================== ( 10 march 2005 ( 68hc12 subroutine: ( sends two frequencies to dds from freqs table ( ( uses prefix table to send address codes ( and freqs table to send mux/gain/freq codes ( ( prefix table ends with $00, used to end loop ( freqs table is very long, start point sent to ( subroutine via stack by calling word ( layout is ttdd ffff ffff llll llll ( w( here tt is the chan/mux code for port-t ( dd is the gain code for port-dlc ( ffff ffff is the code for 2*xmit freq ( llll llll is the code for the lo freq ( ( y register used to point to freqs table ( x register used to point to prefix table ( ( --------------------------------------------------------- code-sub send-freqs 3b c, ( pshd ; save d accumulator 34 c, ( pshx ; save x register ec40 , ( ldd 0,y ; read freq table pointer from stack 02 c, ( iny 02 c, ( iny ; adjust stack pointer 35 c, ( pshy ; save y register b746 , ( tfr d,y ; put freq table pointer in y ce c, prefix , ( ldx #prefix ; point x at top of prefix table ( setup the channel/mux/receiver gain a670 , ( ldaa 1,y+ ; get the chan/mux code from the table 5aae , ( staa portt ; set port-t 02 c, ( iny ( setup the dds cc c, d800 , ( ldd #$d800 ; dds preamble 071b , ( bsr sendit cc c, a000 , ( ldd #$a000 0716 , ( bsr sendit ( loop: a630 , ( ldaa 1,x+ ; get byte from prefix table, inc x 2706 , ( beq done ; if = 0, end of table e670 , ( ldab 1,y+ ; get byte from freqs table, inc y 070e , ( bsr sendit 20f6 , ( bra loop ; do another ( done: cc c, c000 , ( ldd #$c000 ; cmd to load these values 0707 , ( bsr sendit 4d56 , 20 c, ( bclr portp,#$20 ; select f0 31 c, ( puly ; restore stack 30 c, ( pulx 3a c, ( puld 3d c, ( rts ; and return ( -------------- sendit subroutine ------------------------ ( sendit: 4d56 , 40 c, ( bclr portp,#$40 ; assert /frame sync 5ad5 , ( staa spodr ; send high byte 4fd3 , 80fc , ( brclr sposr,#$80,* ; wait for xmission complete 5bd5 , ( stab spodr ; send low byte 4fd3 , 80fc , ( brclr sposr,#$80,* 4c56 , 40 c, ( bset portp,#$40 ; reset /frame sync 3d c, ( rts end-code code-sub set-xmit-freq 4d56 , 20 c, ( bclr portp,#$20 ; select F0 = XMIT frequency 3d c, ( rts end-code code-sub set-lo-freq 4c56 , 20 c, ( bset portp,#$20 ; select F1 = local oscillator freq 3d c, ( rts end-code ( =================== measure sensor frequencies ====================== ( uses internal timer to measure period of input cycle in microseconds code-sub getfreq1 ( -- period ) 3b c, ( pshd ; save d register cc c, 0004 , ( ldd #$04 7c c, tcntr , ( std tcntr ; initialize timer o'flow counter 8680 , ( ldaa #$80 5a8f , ( staa tflg2 ; clear overflow flag 8601 , ( ldaa #$01 5a8b , ( staa tctl4 ; rising edge captures on pt0 5a8e , ( staa tflg1 ; clear timer flag ( main loop - check for edge detected or timer overflow ( f1: 968e , ( ldaa tflg1 ; get timer1 flags 8401 , ( anda #$01 ; bit 1 set = edge detected? 2612 , ( bne f2 ; yes, save & measure again 968f , ( ldaa tflg2 ; no, get timer2 flags 8480 , ( anda #$80 ; bit 7 set = timer overflow? 27f4 , ( beq f1 ; no, try again 73 c, tcntr , ( dec tcntr ; yes, tcnt = tcnt - 1 26ef , ( bne f1 ; tcnt >0? yes, try again cc c, ffff , ( ldd #$ffff ; no freq input so 6c6e , ( std 2,-y ; save zeros on stack 3a c, ( puld ; restore d register 3d c, ( rts ; and exit ( f2: dc90 , ( ldd tc0 ; read timer count 6c6e , ( std 2,-y ; save on data stack 8601 , ( ldaa #$01 5a8e , ( staa tflg1 ; clear timer flag ( end of main loop ( f3: 968e , ( ldaa tflg1 ; get timer1 flags 8401 , ( anda #$01 ; bit 1 set = edge detected? 27fa , ( beq f3 dc90 , ( ldd tc0 ; read timer count a340 , ( subd 0,y ; d = d - @y 6c40 , ( std 0,y ; replace with t2 - t1 8601 , ( ldaa #$01 5a8e , ( staa tflg1 ; clear timer flag 3a c, ( puld ; restore d register 3d c, ( rts end-code ( --------------------------------------------------------------------- hex code-sub getfreq2 ( -- period ) ( measure channel 1 3b c, ( pshd ; save d register cc c, 0004 , ( ldd #$04 7c c, tcntr , ( std tcntr ; initialize timer o'flow cntr 8680 , ( ldaa #$80 5a8f , ( staa tflg2 ; clear overflow flag 8604 , ( ldaa #$04 5a8b , ( staa tctl4 ; rising edge captures on pt1 8602 , ( ldaa #$02 5a8e , ( staa tflg1 ; clear timer flag ( main loop - check for edge detected or timer overflow ( f1: 968e , ( ldaa tflg1 ; get timer1 flags 8402 , ( anda #$02 ; bit 1 set = edge detected? 2612 , ( bne f2 ; yes, save value and measure 968f , ( ldaa tflg2 ; no, get timer2 flags 8480 , ( anda #$80 ; bit 7 set = timer overflow? 27f4 , ( beq f1 ; no, try again 73 c, tcntr , ( dec tcntr ; yes, tcnt = tcnt - 1 26ef , ( bne f1 ; tcnt >0? yes, try again: cc c, ffff , ( ldd #$ffff ; no freq input so 6c6e , ( std 2,-y ; save zeros on stack 3a c, ( puld ; restore d register 3d c, ( rts ; and exit ( f2: dc92 , ( ldd tc1 ; read timer count 6c6e , ( std 2,-y ; save on data stack 8602 , ( ldaa #$02 5a8e , ( staa tflg1 ; clear timer flag ( end of main loop ( f3: 968e , ( ldaa tflg1 ; get timer1 flags 8402 , ( anda #$02 ; bit 1 set = edge detected? 27fa , ( beq f3 dc92 , ( ldd tc1 ; read timer count a340 , ( subd 0,y ; d = d - @y 6c40 , ( std 0,y ; replace with t2 - t1 8602 , ( ldaa #$02 5a8e , ( staa tflg1 ; clear timer flag 3a c, ( puld ; restore d register 3d c, ( rts end-code ( ====================== taspadc routine ======================== ( read from MAX1167 ADC. ( tapsadc : read 16 samples from chan-x and stores in data array ( stack: ( chancode - ) code-sub tapsadc 3b c, ( pshd ; save d accumulator 34 c, ( pshx ; save x register ec40 , ( ldd 0,y ; read channel code 7c c, scntr , ( std scntr ; save channel code 02 c, ( iny 02 c, ( iny ; fix stack 35 c, ( pshy ; save y register ce c, data , ( ldx #data ; point x at start of data cd c, 0010 , ( ldy #16 ; setup sample counter 4cd0 , 40 c, ( bset spocr1,#$40 ; enable spi ( take 16 adc samples ( begin with short delay ( sample: 4d c, 8680 , ( bclr tscr,#ten ; stop timer cc c, 0500 , ( ldd #$500 ; arbitrary delay d384 , ( addd tcnt ; add to value of timer counter 5c90 , ( std tco ; init the oc register with delay 4c c, 8680 , ( bset tscr,#ten ; restart the counter 4f8e , 01fc , ( brclr tflg1,#$01,* ; wait until timer matches new count 4d c, 8eff , ( bclr tflg1,#-01 ; clear timer flag bit 1 4d c, 5608 , ( bclr portp,#$08 ; assert \adc1, pp3; start adc b6 c, scntr , ( ldaa scntr ; get channel code 102a , 5ad5 , ( staa spodr ; send command byte to adc 4fd3 , 80fc , ( brclr sposr,#$80,* ; wait for data gone 96d5 , ( ldaa spodr ; read dummy data 180b , 0000 , d5 c, ( movb #$00,spodr ; send a dummy byte to adc 4fd3 , 80fc , ( brclr sposr,#$80,* ; wait for data gone 96d5 , ( ldaa spodr ; read high byte of result 180b , 0000 , d5 c, ( movb #$00,spodr ; send another dummy byte 4fd3 , 80fc , ( brclr sposr,#$80,* ; wait for data gone d6d5 , ( ldab spodr ; read low byte of result 4c c, 5608 , ( bset portp,#$08, ; de-assert \adc 49 c, ( lsrd 49 c, ( lsrd ; shift d right twice to normalize 843f , ( anda #$3f ; mask d to $3fff max 6c31 , ( std 2,x+ ; save word, inc x ( ; ---------------- check if done sampling ------------------- 03 c, ( dey ; decrement counter 26ba , ( bne sample ; if >0, take another sample 31 c, ( puly ; restore stack 30 c, ( pulx 3a c, ( puld 3d c, ( rts ; and return end-code ( ==================== power control ============================ code-sub trans-on 4cfe , 20 c, ( bset pdlc,#$20 ; enable trans power 3d c, ( rts end-code code-sub trans-off 4dfe , 20 c, ( bclr pdlc,#$20 ; disable trans power 3d c, ( rts end-code code-sub inst-on 4cfe , 40 c, ( bset pdlc,#$40 ; enable insts power 3d c, ( rts end-code code-sub inst-off 4dfe , 40 c, ( bclr pdlc,#$40 ; disable insts power 3d c, ( rts end-code code-sub iob-on 180b , fd c, portp , ( movb #$fd,portp ; power on 3d c, ( rts end-code code-sub iob-off 180b , 0a c, portp , ( movb #$0a,portp ; power off 3d c, ( rts end-code code-sub adc2-on 4d56 , 04 c, ( bclr portp,#$04 ; enable ADC2 3d c, ( rts end-code code-sub adc2-off 4c56 , 04 c, ( bset portp,#$04 ; disable ADC2 3d c, ( rts end-code : power-off trans-off inst-off ; ( ====================== 2+! routine ============================= : 2+! ( dbl adr - ) rot rot sum 2! ( save dble value to temp dup 2@ ( fetch dble from address sum 2@ d+ ( add stored value rot 2! ( save to address ; ( ============================ m/ code ================================ ( divides unsigned double by unsigned single ( outputs double unsigned quotient and single remainder ( ( stack: ( ud un -- urem uquotient ) code-sub m/ 3b c, ( pshd ; save d on stack 34 c, ( pshx ; save x on stack 35 c, ( pshy ; save y on stack b765 , ( tfr y,x ; x is now the data stack pointer ec00 , ( ldd 0,x 6c2e , ( std 2,-x ; dup un 34 c, ( pshx ec04 , ( ldd 4,x ; d = udh cd c, 0000 , ( ldy #0 ; 0:udh / un ee00 , ( ldx 0,x 11 c, ( ediv ; y = quoth, d = remh 2412 , ( bcc mu1 ; if div by 0 30 c, ( pulx 1a02 , ( leax 2,x cc c, ffff , ( ldd #$ffff ; rem, quot = $ffff 6c00 , ( std 0,x 6c02 , ( std 2,x 6c04 , ( std 4,x b756 , ( tfr x,y ; make y the data stack pointer again 31 c, ( puly ; recover y 30 c, ( pulx ; recover x 3a c, ( puld ; recover d 3d c, ( rts ( mu1 30 c, ( pulx 6d02 , ( sty 2,x ; quoth 6c04 , ( std 4,x ; remh ed04 , ( ldy 4,x ; y = remh ec06 , ( ldd 6,x ; d = udl 34 c, ( pshx ee00 , ( ldx 0,x ; x = un 11 c, ( ediv ; y = quotl, d = reml 30 c, ( pulx 6c06 , ( std 6,x ; reml 6d04 , ( sty 4,x ; quotl 1a02 , ( leax 2,x b756 , ( tfr x,y ; make y the data stack pointer again 31 c, ( puly ; recover y 30 c, ( pulx ; recover x 3a c, ( puld ; recover d 3d c, ( rts end-code ( ===================== compact flash ram routines ==================== ( ( This code copies the RAM code image to CF; call with the ( starting address of the SOURCE data on the stack code-sub write-program-sector ( main: 3b c, ( pshd ; save D accumulator 34 c, ( pshx ; save X register ec40 , ( ldd 0,y ; read source address 7c c, source , ( std source 02 c, ( iny 02 c, ( iny ; adjust stack pointer 35 c, ( pshy ( ; Setup Sector Address values 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high 8601 , ( ldaa #01 7a c, sctrcnt , ( staa sctrcnt cd c, FADR , ( ldy #FADR ; point Y at FLASH address 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high a643 , ( ldaa 3,y ; LB of address 7a c, lba0 , ( staa lba0 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high a642 , ( ldaa 2,y ; ML byte of address 7a c, lba1 , ( staa lba1 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high a641 , ( ldaa 1,y ; set Low byte of ADR 7a c, lba2 , ( staa lba2 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high a640 , ( ldaa 0,y ; set High byte of ADR 840f , ( anda #$0f ; only use low 4 bits 8ae0 , ( ora #$e0 ; set CF1, LBA enabled 7a c, lba3 , ( staa lba3 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high 8630 , ( ldaa #write 7a c, command , ( staa command ; set mode to WRITE ( ; Write a block of 512 bytes, checking RDY=1 before each write fe c, source , ( ldx source ; X points at BUFFER cd c, cfdata , ( ldy #cfdata ; Y points at DATA port to FLASH c600 , ( ldb #256 ; B counts words ( wordmove: 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high 180a , 3070 , ( movb 1,x+,1,y+ ; move a byte, post-increment 03 c, ( dey ; adjust Y back to DATA 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high 180a , 3070 , ( movb 1,x+,1,y+ ; move a byte, post-increment 03 c, ( dey 04 c, 31eb , ( dbne b,wordmove ; continue till all are moved 31 c, ( puly 30 c, ( pulx ; recover registers 3a c, ( puld ; and accumulator 3d c, ( rts end-code ( This code writes the BUFFER to CF code-sub write-cf 3b c, ( pshd ; save D accumulator 34 c, ( pshx ; save X register 35 c, ( pshy ( ; Setup Sector Address values 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high 8601 , ( ldaa #01 7a c, sctrcnt , ( staa sctrcnt cd c, FADR , ( ldy #FADR ; point Y at FLASH address 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high a643 , ( ldaa 3,y ; LB of address 7a c, lba0 , ( staa lba0 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high a642 , ( ldaa 2,y ; ML byte of address 7a c, lba1 , ( staa lba1 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high a641 , ( ldaa 1,y ; set Low byte of ADR 7a c, lba2 , ( staa lba2 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high a640 , ( ldaa 0,y ; set High byte of ADR 840f , ( anda #$0f ; only use low 4 bits 8ae0 , ( ora #$e0 ; set CF1, LBA enabled 7a c, lba3 , ( staa lba3 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high 8630 , ( ldaa #write 7a c, command , ( staa command ; set mode to WRITE ( Write a block of 512 bytes into FLASH, checking RDY=1 before each write ce c, buffer , ( ldx #buffer ; X points at BUFFER cd c, cfdata , ( ldy #cfdata ; Y points at DATA port to FLASH c600 , ( ldb #256 ; B counts words ( wordmove: 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high 180a , 3070 , ( movb 1,x+,1,y+ ; move a byte, post-increment 03 c, ( dey ; adjust Y back to DATA 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high 180a , 3070 , ( movb 1,x+,1,y+ ; move a byte, post-increment 03 c, ( dey 04 c, 31eb , ( dbne b,wordmove ; continue till all are moved 31 c, ( puly 30 c, ( pulx ; recover registers 3a c, ( puld ; and accumulator 3d c, ( rts end-code code-sub read-cf 3b c, ( pshd ; save D accumulator 34 c, ( pshx ; save X register 35 c, ( pshy ( ; Setup Sector Address values 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high 8601 , ( ldaa #01 7a c, sctrcnt , ( staa sctrcnt cd c, FADR , ( ldy #FADR ; point Y at FLASH address 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high a643 , ( ldaa 3,y ; LB of address 7a c, lba0 , ( staa lba0 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high a642 , ( ldaa 2,y ; ML byte of address 7a c, lba1 , ( staa lba1 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high a641 , ( ldaa 1,y ; set Low byte of ADR 7a c, lba2 , ( staa lba2 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high a640 , ( ldaa 0,y ; set High byte of ADR 840f , ( anda #$0f ; only use low 4 bits 8ae0 , ( ora #$e0 ; set CF1, LBA enabled 7a c, lba3 , ( staa lba3 ; set high byte of ADR 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high 8620 , ( ldaa #read 7a c, command , ( staa command ; set mode to READ ( Read a block of 512 bytes into RAM, checking RDY=1 before each write cd c, buffer , ( ldy #buffer ; X points at BUFFER c600 , ( ldb #256 ; B counts words ( wordmove: 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high b6 c, cfdata , ( ldaa cfdata ; read a byte 6a40 , ( staa 0,y ; save to BUFFER 4f6f , 01fc , ( brclr portad,#$01,* ; ensure RDY is high b6 c, cfdata , ( ldaa cfdata 6a41 , ( staa 1,y 0202 , ( iny 2X 04 c, 31e9 , ( dbne b,wordmove ; continue till all are moved 31 c, ( puly 30 c, ( pulx ; recover registers 3a c, ( puld ; and accumulator 3d c, ( rts end-code ( ======================= forth code ================================= decimal : s>d ( convert single integer to dbl integer ( put 0 on top of stack if positive #. else put -1 dup 0< ( neg number? if -1 else 0 then ; : bs 16 0 do 8 emit loop ; ( ---------------- read battery voltage ----------------------- decimal : dv 16384 tapsadc ( dummy read on ch2 16384 tapsadc ( read 16 samples from ch2 0. 16 0 do i 2* data + @ ( get a value 0 d+ ( make double & add to sum loop 64 m/ ( normalize, scale to mV drop dup vbat ! ( convert to single and save s>d d>f ( float value vbatsf f@ f* ( convert to battery voltage 2 places f. drop ( print, drop remainder off stack ; ( ------- wait before pinging ------------- : wait-on ( - ) delay-on 0 do ( loop fixed length of time 10 0 do i drop loop loop ; : wait-test 4000 0 do i drop loop ; ( -------------------- clock routines ----------------------- ( routines to control dallas semi ds1644 clock/ram. decimal : ten/mod 10 /mod ; : bcd2int ( bcd - integer ) 16 /mod 10 * + ; : int2bcd ( n - n ) ( turn number into 2-digit bcd equivalent ten/mod ( bcd - units tens 16 * + ; hex : 2.r ten/mod 30 or emit 30 or emit ; decimal : get-time read ctrl-reg c! ( halt updates to clock registers year-reg c@ year-mask and bcd2int year c! month-reg c@ month-mask and bcd2int month c! day-reg c@ day-mask and bcd2int day c! hour-reg c@ hour-mask and bcd2int hour c! min-reg c@ min-mask and bcd2int minute c! sec-reg c@ sec-mask and bcd2int second c! 0 ctrl-reg c! ; : display-time year c@ 2.r month c@ 2.r day c@ 2.r ( yymmdd space hour c@ 2.r minute c@ 2.r second c@ 2.r ( hhmmss space ; : pretty-time hour c@ 2.r ." :" minute c@ 2.r ." :" second c@ 2.r 2 spaces month c@ 2.r ." /" day c@ 2.r ." /" year c@ 2.r ; : write-time ( loads clock with data in year/month/day/etc write ctrl-reg c! ( halt clock hour c@ int2bcd hour-reg c! minute c@ int2bcd min-reg c! second c@ int2bcd sec-reg c! 0 ctrl-reg c! ; : write-date write ctrl-reg c! year c@ int2bcd year-reg c! month c@ int2bcd month-reg c! day c@ int2bcd day-reg c! 0 ctrl-reg c! ; : buff-init buff 16 blank ; : get-string buff-init buff 16 expect ; : good-digit? ( n - flg ) dup 47 > ( ascii value > 47? swap 58 < ( ascii value < 58? and ( t if passes both tests ; : get3num ( convert string into up to 3 numbers 0 0 0 num1 ! num2 ! num3 ! ( clear result registers buff-init get-string ( read the input string buff c@ good-digit? ( is first character a digit? if 0 0 buff 1- convert ( convert until non-number found rot rot drop num1 ! ( save the first number 1+ dup c@ good-digit? ( valid digit? if 0. rot 1- convert ( convert until non-number found rot rot drop num2 ! ( save the first number 1+ dup c@ good-digit? ( valid digit? if 0. rot 1- convert ( convert until non-number found rot rot drop num3 ! ( save the first number then then then drop ( clean buff address off stack ; : set-time ." enter time as hh mm ss: " get3num ( read and turn into 3 numbers num1 @ hour c! num2 @ minute c! num3 @ second c! cr ." press a key to start" key drop write-time cr ; : set-date ." enter date as yy mm dd: " get3num ( read and turn into 3 numbers num1 @ year c! num2 @ month c! num3 @ day c! write-date cr ; : set-clock set-date set-time ; ( -------------- temperature adc routines --------------------------- decimal : clr sposr c@ drop spodr c@ drop ; : wait-110 2000 0 do i drop loop ( allows max110 more time to convert ; : checkbusy ( - flag ) false 500 0 do portad c@ 2 and ( portad bit 1 set? if drop true ( yes, set flag true leave then loop ; hex : init-110 ( - flag ) ( 3-step calibration sequence checkbusy ( ensure busy is high before starting if adc2-on ( enable max110, begins transfer/access wait-110 87 spodr c! ( conversion speed and offset correction clr 0c spodr c! clr adc2-off checkbusy drop adc2-on 87 spodr c! ( step 2 calibration clr 08 spodr c! clr adc2-off checkbusy drop adc2-on 87 spodr c! ( performs an offset-null conversion clr 04 spodr c! clr adc2-off ( disable max110 true ( got through ok else false ( could not init max110 then ; : read-110 ( - ) checkbusy if ( only convert if flag is true adc2-on ( enable max110 wait-110 87 spodr c! ( dummy conversion clr 00 spodr c! clr adc2-off ( disable max110, start conversion begin portad c@ 2 and ( wait for conversion complete until adc2-on ( enable max110 wait-110 87 spodr c! ( send hi byte to adc, serial data transfer begin sposr c@ 80 = until spodr c@ ( read hi byte 110data c! ( store hi byte 00 spodr c! begin sposr c@ 80 = until spodr c@ ( read lo byte 110data 1+ c! ( store lo byte adc2-off ( disable max110 then ; decimal : r>t ( fp: r - t ) ( steinhart & hart eqn: ( 1/t = a + b*lnr + c*lnr^3 ( enter with r on fp stack, ( exit with t in k on fp stack fln lnr f! a b lnr f@ f* f+ ( a+b*lnr c lnr f@ f* lnr f@ f* lnr f@ f* ( c*lnr^3 f+ ( 1/t = a + b*lnr + c*lnr^3 1. d>f fswap f/ ( t ; : d>r ( d - ) ( convert mean adc count to resistance ( z = count/8192 ( x = [.5+z]/[.5-z] ( r = r25 * x ( enter with d on integer stack ( exit with r on fp stack d>f fullscale f/ fdup one-half f+ fswap one-half fswap f- f/ r-25 f* ; : d>t ( d - ) ( - t ) ( convert adc count to fp temp. ( enter with double integer on stack. ( converts to t on fp stack d>r ( convert n to resistance r>t k2c f- ( convert resistance to deg k, k to c tofs f@ f+ ( add offset ; : add-temp ( read temp adc, add to sum read-110 110data @ s>d ( read 110, convert to dbl wtemp 2+! ( save value ; ( ---------------- pressure/depth sensor routines ----------------- decimal : dout2digit <# # # 46 hold #s #> type ; : out2digit 0 <# # # 46 hold #s #> type ; : out3digit 0 <# # # # 46 hold #s #> type ; : get-press ( - ) 8192 tapsadc ( dummy read on ch1 8192 tapsadc ( read 16 samples from ch2 0. 16 0 do i 2* data + @ ( get a value 0 d+ ( make double & add to sum loop 16 m/ ( normalize drop swap drop ( output value ; ( Convert ADC value to depth: double word in cm : p2d ( n - d ) delta-dep @ um* ( output depth in cm 100 m/ rot drop ; : get-depth ( - ) get-press ( read pressure sensor poffset @ - 0 max ( ensure >= 0 p2d ( convert to depth cur-depth 2! ( save depth in cm ; : add-press get-press ( read depth sensor poffset @ - 0 max s>d ( subtract offset, convert to dble wdepth 2+! ( add to running sum of ADC values ; : init-depth get-press ( read surface depth poffset ! ( store surface offset value ; : disp-dep ( display depth get-depth ( read sensor & convert cur-depth 2@ ( fetch reading dout2digit ( print it as XXX.XX ; : depth? ( - flg ) ( check for depth in proper range for power on ( t = power is or should be on ( f = power is or should be off tapsmode @ if ( do this test if power currently on ( exit w/f if dd-max d-off 2@ cur-depth 2@ d< ( d-off < depth? cur-depth 2@ d-max 2@ d< ( depth < d-max? and ( combime flags else ( do this if power currently off ( exit w/t if d>d-on and d d-on? and ( combine flags cur-depth 2@ d-max 2@ d< ( d-max > depth? and ( =t if d-on < depth < d-max then ; : check-depths ( - flg) fpd-on hundred f* one f- d-on 2@ d>f f< ( d-on > min? d-off 2@ d-on 2@ d< and ( d-off < d-on? d-max 2@ d>f fpd-max hundred f* one f+ f< and ( d-max < max? ; ( ------------------- compact flash ram routines ----------------------- ( ( Save cast data to buffer. when 10 casts saved, move buffer to cf-ram ( and start over. Always save in multiples of 10 casts. hex : busy? ( - ) 100 0 do status c@ ( read status register 80 and ( mask bit 7 0= ( is it clear? if leave then ( if so, quit loop loop ; decimal : get-regs ( read cf registers & setup sector address busy? lba0 c@ fadr c! lba1 c@ fadr 1 + c! lba2 c@ fadr 2 + c! head c@ fadr 3 + c! ; hex : setup-cf busy? 01 features c! ( enable 8-bit data transfer busy? fadr c@ lba3 c! busy? fadr 1+ c@ lba2 c! busy? fadr 2 + c@ lba1 c! busy? fadr 3 + c@ f0 and e0 or lba0 c! busy? ef command c! ( execute commands just loaded busy? ; hex : reset-cf 1000. fadr 2! ( start at beginning of cfram ; decimal : inc-sector ( - ) ( increment sector address by one fadr 2@ 1. d+ fadr 2! ; : dec-sector ( - ) ( decrement sector address by one fadr 2@ 1. d- fadr 2! ; : save-cast 48 0 do ( header + data dheader i + c@ ( read a byte bufptr @ i + c! ( save a byte to buffer loop 46 emit ( print a period 48 bufptr +! ( increment buffer pointer bufcasts @ 1- dup ( decrement cast counter 0= if ( if counter = 0 drop ( tidy stack write-cf ( write this buffer to cfram inc-sector ( add 1 to sector address 10 bufcasts ! ( start counter at 10 buffer bufptr ! ( point bufptr at start of buffer else bufcasts ! ( save decremented counter then ; ( move header data to buffer, thence to cf-ram : save-header ( - ) 1 castcntr +! ( increment cast counter castcntr @ castnum ! ( save cast # in header 258 0 do header i + c@ ( read a byte buffer i + c! ( move to buffer loop write-cf ( write the buffer to cfram inc-sector ( add 1 to sector address ." header" cr ; ( read header from cfram into buffer ( assumes pointers are already set : read-header ( - ) read-cf ( read sector into buffer inc-sector ( bump the sector address 61 0 do buffer i 2* + @ pheader i 2* + ! loop pnpings @ ( recall npings used this data set 5 * 0 d>f sf1 f! ( scale factor for this data set ; : yes? ( char - flag ) dup 89 = swap 121 = or ; ( erase - writes zero at start of first frame hex : erase-ram ." erase DATA (y/n)? " key dup emit yes? if reset-cf ( reset sector address counter 0 castcntr ! ( clear cast counter setup-cf ( save CF registers then cr ; decimal : mem-full? ( - f ) ( t if pointers at end of ram false ; : cast-map castcntr @ dup castnum ! ." cfram contains" . ." casts" cr ; : ram-map mode @ 0 = if cast-map then ; ( ------------------ initialization routines ------------------------ decimal : read-eeprom ( 021115: from freq1 through poffset 61 0 do mycals i 2* + @ header i 2* + ! loop ; : write-eeprom ( move data to eeprom starting at header 61 0 do header i 2* + @ ( read a word from ram mycals i 2* + ee! ( write the word to eeprom loop ; : check-varns ( - flg ) true 122 0 do mycals i + c@ ( read from eeprom header i + c@ ( read from ram = or ( compare, or with previous test loop ; : init-header ( put operating values into header begin read-eeprom ( get cal constants, etc. check-varns ( compare varns to eeprom, return flag until ( read until ram == eeprom marker header ! ( make sure $aaaa at top of header field dmarker dheader ! ( make sure $dddd at top of data field cver verno ! ( s/w version # to nvram castcntr @ castnum ! ( update cast # in header field 6 numfreq ! 48 datalen ! ( only update in cast mode 5 nsamps ! ( fixed # of cast-mode samples 336 dup gatelen ! ( pulse length in usec 8 * pulse ! ( timer value for TAPSTR crange range ! ( nominal mean range inst1 @ 0> inst2 @ 0> or instflag ! ( update flag 6 0 do khz i 2* + @ freq1 i 2* + ! loop ; ( --------------- read instrument frequencies ----------------------- hex : tic-init fc tios c! ( timer bits 0-1 as input capture 33 tmsk2 c! ( set timer to 1 us ticks 80 tscr c! ( enable timer ; decimal ( read external sensor data: ( INST #1 can be voltage or frequency output ( INST #2 is frequency output only : get-insts ( - ) inst1 @ dup 1 = if getfreq1 ifreq1 ! ( get period in microseconds then 2 = if 24576 tapsadc 24576 tapsadc 0. 16 0 do i 2* data + @ ( get a value 0 d+ ( make double & add to sum loop 64 m/ ( convert to mVolts drop swap drop ( output single word ifreq1 ! then inst2 @ 1 = if getfreq2 ifreq2 ! ( get period in microseconds then ; : print-insts inst1 @ 0 = if 0 . then inst1 @ 1 = if 1 places fclock ( 1 mhz ifreq1 @ s>d d>f ( fetch & float # cycles f/ ( 1e6/# cycles = frequency fdup f0< if ( is # negative? fdrop 0 . ( yes, output zero else f. then then inst1 @ 2 = if ifreq1 ? ( fetch & print sensor voltage then inst2 @ 1 = if fclock ( 1 mhz ifreq2 @ s>d d>f ( fetch & float # cycles f/ ( 1e6/# cycles = frequency fdup f0< if ( is # negative? fdrop 0 . ( yes, output zero else f. then else 0 . then ; : tc ( measure/display instrument freqs get-insts print-insts ; ( ------------------- data collection drivers ------------------- ( 68hc12 version hex code-sub clear-all 34 c, ( pshx ce c, daytime , ( ldx #daytime ec40 , ( ldd 0,y ; read mode off stack 02 c, ( iny 02 c, ( iny ; pop stack pointer 35 c, ( pshy cd c, 002c , ( ldy #44 ; # samples to clear, cast mode 8600 , ( ldaa #00 ( loop 6a00 , ( staa 0,x 08 c, ( inx 03 c, ( dey 26fa , ( bne loop 31 c, ( puly 30 c, ( pulx 3d c, ( rts end-code decimal ( caccum sums the cast-mode samples into the proper accumulators : caccum ( ch dsum - ) rot ( dsum ch 1- 2* 2* cacc1 + ( point to proper accumulator 2+! ( add dsum to accumx ; : set-ch ( ch# - ) 1- ( transform to 0-5 range 10 * freqs + ( point at freqs data row send-freqs ( setup mux, gains, & dds set-xmit-freq ( set to XMIT freq ; : cping ( ch - ) ( generic cast-mode ping cycle dup set-ch ( select channel tapstr ( xmit & digitize samples 6 cmac ( mac 5 samps, start at samp 6, = 1.4m caccum ( add to running sum 3500 0 do i drop ( pace pinging to 24/sec loop ; ( generic routine to get all data in cast mode ( IOB & SPI on before called : get-data ( - ) 0 clear-all ( zero the data accumulators get-time ( store time data frame begins instflag @ if get-insts ( for now, one reading per data set then npings @ 0 do ( loop over pings spi-on 7 1 do ( ping once on channels 1-6 i cping ( get a cast-mode ping on channel i loop ( end loop over channels add-press ( read depth sensor, add to sum add-temp ( read temp, add to sum loop ( end loop over pings ; : hout ( - ) <# # # # # # # # # #> type ; : disp-freqs ." frequencies: " 6 0 do freq1 i 2* + @ . 2 spaces loop ." khz" cr ; : disp-cals 1 places ." cals = " fcal1 f@ f. 3 spaces fcal2 f@ f. 3 spaces fcal3 f@ f. 3 spaces fcal4 f@ f. 3 spaces fcal5 f@ f. 3 spaces fcal6 f@ f. 1 spaces 100 emit ." b" cr ; : print-types ( inst - ) dup 0 = if ." - " then dup 1 = if ." frequency output sensor " then 2 = if ." voltage output sensor " then cr ; : disp-insts inst1 @ ." sensor #1: " print-types inst2 @ ." sensor #2: " print-types ; : print-header ( prints formatted version of header cr ." taps-6: s/n 16 / s/w v 8.0" cr ." cast # " pcastnum @ . cr ." pulselen = " pgatelen @ . ." , npings = " pnpings @ . ." , nsamps = " pnsamps @ . ." = " range ? ." cm" cr ." battery = " 2 places vbat @ s>d d>f vbatsf f@ f* f. ." , depth sf = " pdsf f@ 3 places f. ." , temp offset = " ptofs f@ 2 places f. cr disp-freqs disp-cals disp-insts cr ; : n2db ( d - ) ( - fp ) d>f fdup f0< if ( float, check if negative f2pos f+ ( if so, fix overflow problem then sf1 f@ f/ ( scale by npings * nsamps sf2 f* ( convert to v^2 eps fmax flog ten f* ( 10 log v^2 ; : dep-temp ( output depth and temperature wdepth 2@ ( read sum of samples pnpings @ ( divide by npings m/ ( divide WDEPTH / NPINGS rot drop drop ( drop remainder p2d ( convert to cm ( rot drop dout2digit space ( print wtemp 2@ 2dup 0. d< ( is wtemp < 0? if dnegate ( change sign, store for m/ 001214 pnpings @ m/ ( divide and get result 001214 rot drop dnegate else pnpings @ m/ ( divide and get result 001214 rot drop then d>t 2 places f. ; : print-cast display-time ( print date/time dep-temp ( print depth & temperature print-insts cacc1 2@ n2db fcal1 f@ f+ f. cacc2 2@ n2db fcal2 f@ f+ f. cacc3 2@ n2db fcal3 f@ f+ f. cacc4 2@ n2db fcal4 f@ f+ f. cacc5 2@ n2db fcal5 f@ f+ f. cacc6 2@ n2db fcal6 f@ f+ f. cr ; : print-casts 10 0 do ( loop over 10 casts 48 0 do j 48 * i + ( calculate offset into buffer buffer + c@ ( fetch a byte dheader i + c! ( move it to data header loop print-cast loop ; ( dump data from cfram. uses cast counter to count casts. : dump-casts ( - ) fadr 2@ temp-fadr 2! ( save current cf sector address reset-cf ( start cf sectors at 1000 castcntr @ 0 do ( loop over # casts read-header print-header ( print the header info begin read-cf ( read a sector of data buffer @ ( read 1st word of sector eod = not ( not End Of Data? while print-casts ( print 10 casts, exit w/flag inc-sector repeat inc-sector loop temp-fadr 2@ fadr 2! ( restore fadr ; : dump-data castcntr @ 0= if cr ." no data " cr else cr ." setup data capture and press " key emit dump-casts then ; decimal ( ------------------- display status/version -------------------- : ud. ( d - ) ( print unsigned double <# #s #> type ; : disp-status ( - ) cr ." taps-6 acoustic profiling system" cr ." s/n " serno @ u. cr ." s/w version " verno @ s>d d>f hundred f/ 2 places f. cr cr ." cast mode: internal recording" cr ." number of casts stored = " castcntr @ . cr ." cf sector # = " fadr 2@ hex d. cr decimal ." turn-on depth = " d-on 2@ d>f hundred f/ f. ." m" cr ." turn-off depth = " d-off 2@ d>f hundred f/ f. ." m" cr ." maximum operating depth = " d-max 2@ d>f hundred f/ f. ." m" cr ." mean sample range = " range @ u. ." cm" cr ." number of pings/data set = " npings @ . cr ." current time & date = " get-time pretty-time cr ( this code reads from both ADC's spi-on iob-on wait-110 ." current battery voltage = " dv ." vdc" cr ." current depth = " disp-dep ." m" cr ." current temperature = " init-110 drop wait-110 read-110 110data @ s>d d>t 2 places f. ." c" cr spi-off iob-off space disp-freqs space disp-cals disp-insts ; ( -------------------- reprogram parms -------------------------- decimal : buff-fix buff c@ dup 45 = if drop else 48 max 57 min buff c! then 16 1 do i buff + c@ dup 32 = if drop else 48 max 57 min i buff + c! then loop ; : get-dat ( 3/20/2000 added cr ( here 2 spaces get-string buff-fix ( be sure input is number buff 1- number cr ; hex : getline buff 20 20 fill ( clear the buffer, fill with spaces buff 20 expect ( get a line of text ; : isanum? ( n - flg ) dup 3a < ( t if char < $3a swap 2f > ( t if char > $2f and ( combine flags ; ( scan a fp numeric string to find the length of the d-part portion : decpl 0 #dp ! cr buff 1- 10 0 do 1 + dup c@ ( get the i'th character 2e = if ( is it a period? leave ( if so, leave this loop then loop 10 0 do 1 + dup c@ dup 20 = if ( is it a space? drop leave ( if so, leave loop with #dp count then isanum? if 1 #dp +! ( if valid #, add to count else leave ( else quit then loop drop ; : get-num 0. integers 2! 0. decimals 2! buff dup c@ dup 2d = ( starts with -? if -1 sgn ! ( yes, set sign = -1 drop ( leave buff pointer alone else 1 sgn ! ( assume positive 2b = not if ( if not a + sign, dec cntr 1- then then 0 swap 0 swap convert rot rot sgn @ 0< if dnegate then integers 2! 0 swap 0 swap convert drop decimals 2! ; decimal ( assemble the sign, integer, and decimal parts into a fp number : make-fp ( - fp# ) decimals 2@ d>f ( float decimal portion #dp @ 0 d>f falog ( fp = 10 ** #dp f/ ( scale dec's integers 2@ d>f ( get integers sgn @ 0< if ( sign negative? fswap f- ( subtract decimal part else f+ then ; : get-fp-num ( - flg ) ( - fp# [if flg==t] ) getline span @ 0> dup ( set flag = t if span >0 if get-num ( convert the string into integers decpl ( find # digits after decimal point make-fp ( convert the integers into fp then ; : new-cals ." enter cal constants as fp numbers (ex: -45.3)" cr ." enter c1: " get-fp-num if fcal1 f! else cr then ." enter c2: " get-fp-num if fcal2 f! else cr then ." enter c3: " get-fp-num if fcal3 f! else cr then ." enter c4: " get-fp-num if fcal4 f! else cr then ." enter c5: " get-fp-num if fcal5 f! else cr then ." enter c6: " get-fp-num if fcal6 f! else cr then ; : versions ." depth sensor rating in psia = " d-sensor ? ( print depth sensor rating get-dat drop span @ 0> if dup d-sensor ! ( save psia rating s>d d>f ten5 f* maxn f/ atm f/ one-half f+ ( round number f>d drop ( convert to single delta-dep ! ( save as mm/10 per bit else cr ( drop then ." depth scale factor = " dsf f@ 3 places f. get-fp-num if 7.0e-1 fmax dsf f! else cr then ." temp offset = " tofs f@ 3 places f. get-fp-num if tofs f! else cr then ; : set-factory ." serial number = " serno @ . get-dat drop span @ 0> if serno ! else cr ( drop then ." battery scale factor = " vbatsf f@ 6 places f. get-fp-num if 1.0e-5 fmax ( floor at 0.00001 vbatsf f! else cr then ; : change-cals cr ." change cals (y/n)? " key dup emit cr yes? if cr ." enter to keep existing values" cr new-cals versions set-factory write-eeprom then ; : saveparm ( flg adr - ) swap if ( is there an fp # on fp stack? hundred f* ( convert to cm f>d ( adr high low ) rot 2! ( save to ADR as double-word else drop cr then ; : shwprm d>f hundred f/ 2 places f. ; : savenum ( dbl adr - ) swap drop ( num adr ) span @ 0> if ! else 2drop then ; : cast-parms ." # pings/average = " npings @ . get-dat npings savenum ." turn-on depth = " d-on 2@ shwprm get-fp-num d-on saveparm ." turn-off depth = " d-off 2@ shwprm get-fp-num d-off saveparm 16384 p2d 1000. d- cr ." max safe depth = " dout2digit ." m " cr ." max operating depth = " d-max 2@ shwprm get-fp-num d-max saveparm check-depths not if ." depth settings inconsistent, please re-enter " cr then 68 datalen ! ( set length in cast mode ; : inst-header cr ." select external sensor type: " cr ." 0 = no sensor installed " cr ." 1 = frequency output sensor " cr ." 2 = voltage output sensor " cr cr ; : inst-setup inst-header ." external sensor # 1 type = " inst1 @ . get-dat inst1 savenum ." external sensor # 2 type = " inst2 @ . get-dat inst2 savenum inst1 @ 0> inst2 @ 0> or instflag ! ( update flag ; : ?reprog cr ." reprogram operating parameters:" cr ." enter new data or to accept current value" cr cr cast-parms ( update cast-mode parms inst-setup ( setup external sensors cr ." make these changes permanent (y/n)? " key dup emit cr yes? if write-eeprom ( move to eeprom space disp-status ( show new setup then ; hex : dokill ." exit TAPS (y/n)? " key yes? if true killme ! ( set flag true to force exit cr then ; decimal : dokey ( ascii - ) dup s = if ( status command? disp-status then dup p = if ( program command? ?reprog then dup d = if ( dump command? dump-data then dup e = if ( erase command? erase-ram then dup instruments = if spi-on inst-on wait-on tc inst-off spi-off cr then dup temperature = if spi-on iob-on wait-test init-110 drop read-110 2 places 110data @ s>d d>t f. cr spi-off iob-off then dup volts = if ( battery voltage command? spi-on iob-on wait-test dv iob-off spi-off cr then dup clock = if ( time command? get-time pretty-time cr then dup reset-clock = if ( set-clock command? set-date set-time then dup cals = if ( enter new cals, depth sensor change-cals then kill = if dokill then ; decimal : key-fix ( ascii - ascii' ) dup 123 > if drop 0 then dup 96 > ( lc letter? if 97 - 65 + then ( shift to uc ; : input? ?terminal if key key-fix ( read key, allow only certain ones dokey ( execute command then ; : do-cast spi-on iob-on ( turn on IOB power trans-on ( turn on boards instflag @ if inst-on ( turn on instruments if needed then true tapsmode ! ( signal taps running ." power on @ d = " cur-depth 2@ dout2digit cr init-110 ( initialize MAX110 ADC if ." ADC2 initialized " else ." Error initializing ADC2" then cr save-header ( inc cast cntr & save a header to cfram 10 bufcasts ! ( initialize cast counter buffer bufptr ! ( initialize buffer pointer wait-on ( let power stabilize ." cast # " castcntr @ . cr begin get-data ( init SPI bus and get a data set save-cast ( save it to ram, send to cfram if necessary get-depth ( read depth sensor depth? ( = T if still ok to run not dup if ( if not, check to see if 10 casts saved drop bufcasts @ 10 = ( done a sector's worth of casts? then ( exit with t or f until power-off spi-off iob-off buffer 256 eod fill ( write EOD into buffer write-cf ( save it to CF-RAM inc-sector ( update the sector address counter setup-cf ( update the CF registers cr ." power off @ d = " cur-depth 2@ dout2digit cr ; ( Main loop: waits for depth within limits to take data. ( Execute commands while waiting. : dep-loop begin depth? ( exit if depth range ok killme @ or not ( or if killme set while input? ( if cmd sent, deal with it wait-test spi-on iob-on wait-110 get-depth spi-off iob-off repeat ( stay ( here until condition met ; : cast begin ( outer endless loop false tapsmode ! ( not running yet wait-on 0. cur-depth 2! ( start with depth = 0 dep-loop ( wait until depth > D-ON killme @ not if ( KILLME = F => take data do-cast ( take data false ( don't exit begin-until else true ( do exit begin-until then until ( loop while KILLME is not true ; ( --------------------------------------------------------------------- hex : init exram ( hopefully redundant 02 portp c! ( set cpu peripheral power off 00 pdlc c! ( set external power off 00 portt c! ( set mux to ch 0, gain to 0 ff ddrp c! ( set port p ddr 7e ddrdlc c! ( set port dlc ddr fc ddrt c! ( set port t ddr; bits 0-1 are inputs fc tios c! ( set port t tios same 86 c@ 80 and 86 c! ( set ten bit of tscr, start timer 01 tios c! ( set output compare timer 1 cr ." initializing TAPS ... " power-off iob-off ( disable external board power wait-test spi-init ( setup the SPI bus 0c dev-ctrl c! ( soft reset of cf 08 dev-ctrl c! setup-cf ( setup the compact-flash card fadr 2@ 1000. d< ( is Sector Adr < $1000? if ( if so, clear data memory pointers reset-cf ( reset sector address counter 0 castcntr ! ( clear cast counter setup-cf ( save CF registers then 2 places init-header spi-on iob-on wait-test 20 0 do ( make sure depth offset is valid init-depth ( update poffset poffset @ 800 < ( < 1024? if leave then wait-test ( short delay loop spi-off iob-off ( disable SPI & board power false killme ! ( assume want to run false tapsmode ! decimal ." done" cr first-flag @ if false first-flag ! ?reprog then ; decimal : main ( - ) init disp-status cast power-off spi-off iob-off ." Exiting TAPS " cr cr ; ( cast.4th - 20 May 2007: load from CF, run in RAM ' main cfa prgm-adrs ! ( put execution adr at $1000 true first-flag ! ( set flag for first load of program