\ CRC: $2A1045F9 #romversion &270 checkrom #version &184 checkversion forget-application Vocabulary HF100 &03072002 Constant #date NV Variable _boot_delay : link_watchdog $62000000 or priority ! ; : feed_watchdog ticks @ + ticks 3 + ! ; : send_morse ticks 4 + off ticks 5 + ! ; : err_boot _boot_delay @ 2* 1 max _boot_delay ! #100ms sleep boot ; : power_down flush-erom #100ms sleep setsleep ; : print-errors flush-erom errors ; LABEL my_(watchdog 0 # RPTS, $2000 # ST ANDN, ticks AR0#LDI, R0 WDFLAG1 #) STI, R0 WDFLAG2 #) STI, $2000 # ST OR, AR0 *) R0 LDI, AR0 3 # +*) R0 SUBI, RETSEQ, R0 ROLC, RETSC, BEGIN, AGAIN, END-CODE LABEL my_tickerint ST PUSH, $2000 # ST OR, AR1 PUSH, AR0 PUSH, TICKS AR1#LDI, AR1 0 # +*) AR0 LDI, 1 # AR0 ADDI, AR0 AR1 0 # +*) STI, AR1 1 # +*) AR0 LDI, 0 # AR0 CMPI, NZ IF, 1 # AR0 SUBI, AR0 AR1 1 # +*) STI, 0 # AR0 CMPI, Z IF, AR1 2 # +*) AR0 LDI, AR0 AR1 1 # +*) STI, AR1 5 # +*) AR0 LDI, 0 # AR0 CMPI, Z IF, T0CTRL AR0#LDI, AR0 *) AR1 LDI, 4 # AR1 XOR, ELSE, AR1 4 # +*) AR0 LDI, 0 # AR0 CMPI, Z IF, AR1 5 # +*) AR0 LDI, AR0 AR1 4 # +*) STI, THEN, 1 # AR0 TSTB, Z IFD, -1 # AR0 LSH, NOP, AR0 AR1 4 # +*) STI, T0CTRL AR0#LDI, AR0 *) AR1 LDI, 4 # AR1 OR, ELSE, T0CTRL AR0#LDI, AR0 *) AR1 LDI, 4 # AR1 ANDN, THEN, THEN, AR1 AR0 *) STI, THEN, THEN, AR0 POP, AR1 POP, ST POP, RETIU, END-CODE 0 $30 $30 Task adc_task 0 $30 $30 Task disk_task 0 $30 $30 Task sequ_task 0 $20 $20 Task wdog_task $01 CONSTANT #IOMAPPED $40 CONSTANT #LEVELINT $00 CONSTANT #DRV0 #IOMAPPED #LEVELINT OR CONSTANT #COR_INIT $00 CONSTANT #DCR_INIT $80 CONSTANT #BUSY $8000 CONSTANT #CARDRESET $1E7900 constant #morse_w $004900 constant #morse_s $13C900 constant #morse_f $F3CF00 constant #morse_o 3 constant #ctrl-C 3 constant #typ_access &40 sec constant #max_boot &10 sec constant #max_access &200 sec constant #max_command 4 constant #dead_blocks &86400 constant #once_a_day #max_sec #blk_size / Constant #max_blk $7FFFFFFF Constant #max_int $FFFFFFFF Constant #max_uns 6 Constant #blk_shift Variable led_display Variable led_hidden Variable led_message Variable escape_all Variable may_sleep Variable last_pointer Variable curr_drive Variable disk_entry Variable burst_value Variable get_disk_dir Variable halted Variable last_reboot Variable last_command : user_y/n ." (y/n)? " dup IF ." y" ELSE ." n" THEN backspace BEGIN key dup #CR = IF drop exit THEN dup [char] y = over [char] n = or 0= WHILE drop REPEAT nip [char] n = IF ." n" FALSE ELSE ." y" TRUE THEN ; : boot_y/n #max_int last_reboot ! user_y/n ticks @ 1 max last_reboot ! ; : uncount swap 1- dup -rot ! ; NV definitions Method : >move bounds ?DO count I NV ! pause LOOP drop ; Method : move> >r dup r@ BL fill swap NV addr count >r swap 2r> min cmove pause ; Method : place swap 2dup NV ! 1+ swap bounds ?DO dup @ I NV ! 1+ pause LOOP drop ; Method : .string NV addr count type ; Method : passcalstring 2>r count r> umin r> swap NV place ; Forth definitions NV Variable _channels NV Variable _sample_period NV Variable _bits NV Variable _sec/mark NV Variable _for NV Variable _every NV Variable _start NV Variable _stop NV Variable _release NV Variable _trigger NV Variable _program NV Variable _InitTime NV Variable _SkewTime NV Variable _disk_full NV Variable _circular NV Variable _main_size NV Variable _disk_entry NV Variable _start_disk NV Variable _rec_enable NV Variable _rec_resume NV Variable _use_remapping _use_remapping off NV Create _last_block $400 NV allot : _last_block_off $3FF ?FOR #max_int _last_block [] r@ + 1+ ! NEXT last_pointer off _last_block off ; : _last_block_! last_pointer @ swap over 1+ $3ff and dup >r _last_block [] + ! #max_int swap _last_block [] + ! r> last_pointer ! ; : std_fall_asleep disk_sleeps @ ?EXIT standby_immediate set_sleep_mode disk_sleeps on ; : std_wake_up disk_sleeps @ 0=EXIT Pcmcia lock #100ms sleep Pcmcia unlock global_reset_pcm disk_sleeps off ; ' std_fall_asleep IS fall_asleep ' std_wake_up IS wake_up reset_adapter : dos_block? #mode_mask and #dos_view = ; : directory_now offset @ curr_adapter @ >drive ; : directory_next offset @ curr_adapter @ 1+ >drive ; : write_log dup dos_block? IF offset push dos_blocks directory_now 2dup u> IF _rec_resume on THEN over = get_disk_dir @ and directory_next swap IF _last_block_! disk_entry @ _disk_entry ! flush-erom drop exit THEN 1- over u> IF dup _last_block_! THEN THEN drop ; : pcmcia_r/w retries @ ?FOR 3DUP >R PHYSICAL set_adapter R> IF ticks @ last_access ! readmultiple last_access off 0= IF 2DROP DROP RDROP FALSE EXIT THEN message" (74) repairing bad sector" reset_adapter 3DUP >R PHYSICAL set_adapter rdrop ticks @ last_access ! writemultiple last_access off drop ELSE ticks @ last_access ! writemultiple last_access off 0= IF over write_log 2DROP DROP RDROP FALSE EXIT THEN THEN reset_adapter NEXT 2DROP DROP TRUE ; : pcmcia_diskerror reset_adapter fall_asleep #100MS SLEEP ?dup 0 = IF message" (70) disk write error" EXIT THEN dup 1 = IF message" (71) disk read error, rebooting" THEN dup 2 = IF message" (81) drive out of range, rebooting" THEN dup 3 = IF message" (82) no more buffers, rebooting" THEN dup 4 = IF message" (72) can't access drive, rebooting" THEN dup 5 = IF message" (83) illegal geometry, rebooting" THEN dup 6 = IF message" (73) directory corrupted, rebooting" THEN 7 u> ?EXIT err_boot ; NV Create "exp_number &2 1+ NV allot NV Create "exp_name &24 1+ NV allot NV Create "exp_comment &40 1+ NV allot NV Create "stat_number &4 1+ NV allot NV Create "stat_name &24 1+ NV allot NV Create "stat_comment &40 1+ NV allot NV Create "chan_name_1 &10 1+ NV allot NV Create "chan_name_2 &10 1+ NV allot NV Create "chan_name_3 &10 1+ NV allot NV Create "chan_name_4 &10 1+ NV allot NV Create "chan_sensor_1 &12 1+ NV allot NV Create "chan_sensor_2 &12 1+ NV allot NV Create "chan_sensor_3 &12 1+ NV allot NV Create "chan_sensor_4 &12 1+ NV allot NV Create "chan_sensor_nr_1 &12 1+ NV allot NV Create "chan_sensor_nr_2 &12 1+ NV allot NV Create "chan_sensor_nr_3 &12 1+ NV allot NV Create "chan_sensor_nr_4 &12 1+ NV allot NV Create "chan_comment_1 &40 1+ NV allot NV Create "chan_comment_2 &40 1+ NV allot NV Create "chan_comment_3 &40 1+ NV allot NV Create "chan_comment_4 &40 1+ NV allot NV Create "message &160 1+ NV allot : word" [char] " word ; word" 00" count "exp_number swap place word" experiment_name" count "exp_name swap place word" experiment_comment" count "exp_comment swap place word" 0000" count "stat_number swap place word" station_name" count "stat_name swap place word" station_comment" count "stat_comment swap place word" chan1_name" count "chan_name_1 swap place word" chan2_name" count "chan_name_2 swap place word" chan3_name" count "chan_name_3 swap place word" chan4_name" count "chan_name_4 swap place word" sensor1_name" count "chan_sensor_1 swap place word" sensor2_name" count "chan_sensor_2 swap place word" sensor3_name" count "chan_sensor_3 swap place word" sensor4_name" count "chan_sensor_4 swap place word" sensor1_num" count "chan_sensor_nr_1 swap place word" sensor2_num" count "chan_sensor_nr_2 swap place word" sensor3_num" count "chan_sensor_nr_3 swap place word" sensor4_num" count "chan_sensor_nr_4 swap place word" chan1_comment" count "chan_comment_1 swap place word" chan2_comment" count "chan_comment_2 swap place word" chan3_comment" count "chan_comment_3 swap place word" chan4_comment" count "chan_comment_4 swap place word" sample_queue overflow" count "message swap place Forth &21 constant #message_len Semaphor kick_server : alloc_block pause buffer lock-buffer ; : write_block pause buffer drop unlock-buffer update-buffer kick_server signal pause ; : read_block pause block lock-buffer ; : free_block pause buffer drop unlock-buffer ; : _last_block_@ #max_int $400 dup last_pointer ! ?FOR _last_block [] r@ + @ dup #max_int <> IF min last_pointer @ $400 < IF dup last_pointer @ _last_block [] + ! #max_int _last_block [] r@ + ! ELSE r@ last_pointer ! THEN ELSE drop THEN NEXT ; variable sys_byte variable main_sec : bios_mapping _use_remapping @ 0=EXIT #romversion &270 = 0=EXIT cyl @ $400 > 0=EXIT cyl @ heads @ * sector @ * $3F sector ! $10 heads ! BEGIN cyl @ $400 > WHILE heads @ 2* $FF min heads ! dup sector @ / heads @ / cyl ! heads @ $FF < WHILE REPEAT drop cyl @ $400 min cyl ! $883824 EXECUTE ; : main_start #fat_start #SYS_sec_max clu_sec @ / + ; : main_sec_max fat_len main_start - clu_sec @ * #FREE_sec - $FFFFFFC0 and ; : main_end main_start main_sec @ #BLK_SIZE * main_sec_max min clu_sec @ / + ; : sys_end #fat_start SYS_BYTE @ 1- -9 ASHIFT 1+ #SYS_sec_max min 1- clu_sec @ / 1+ + ; : scan_drives flush 0 *file [] >shift ! #blk_shift *file [] >sys_shift ! #blk_shift *file [] >dos_shift ! 0 *file [] >FileID ! #sys_view *file [] >sys_FileID ! #dos_view *file [] >dos_FileID ! 3 FOR 3 r@ - dup >r identify_drive dup 1 = IF message" (46) harddisk has not been licensed" THEN 0= IF bios_mapping 0 *file [] >off r@ + ! fat_off dup *file [] >sys_off r@ + ! #sys_sec_max + *file [] >dos_off r@ + ! total @ *file [] >cnt r@ + ! 1 *file [] >sys_cnt r@ + ! main_end main_start - clu_sec @ * #blk_size / *file [] >dos_cnt r@ + ! ELSE 0 dup *file [] >off r@ + ! dup *file [] >sys_off r@ + ! dup *file [] >dos_off r@ + ! dup *file [] >cnt r@ + ! dup *file [] >sys_cnt r@ + ! *file [] >dos_cnt r@ + ! THEN rdrop NEXT 0 dup *file [] >off 4 + ! dup *file [] >sys_off 4 + ! *file [] >dos_off 4 + ! #max_int dup *file [] >cnt 4 + ! #blk_size / dup *file [] >sys_cnt 4 + ! *file [] >dos_cnt 4 + ! flush-erom ; : drv_count 0 BEGIN *file [] >dos_cnt over + @ WHILE 1+ dup 4 = ?EXIT REPEAT ; 2 Constant #new_data 3 Constant #old_data $0008 Constant #dir_skip $2000 Constant #dir_size #dir_skip 2* field [dir_skip] 0 field [disk_number] 1 field [sequ_number] 2 field [block_count] 4 field [status_bits] 5 field [skew_offset] 8 field [InitTime] $a field [SkewTime] $c field [SyncTime] $e field [SerialNr] Create tmp_buffer $200 allot Variable last_index Variable data_index Variable dir_offset Variable entry_nr Variable last_entry Variable Dir_ptr Create Samples 0 , 0 , 0 , 0 , here 0 , here 0 , here 0 , here 0 , here 0 , Constant Buf_cnt Constant Buf_adc Constant Buf_end Constant Buf_ptr Constant Buf_state $80000000 Constant #invalid $E0000000 Constant #str_sec_short $F0000020 Constant #std_type_cmd $F0000000 Constant #std_mesg_cmd $F00001AE Constant #passcal_sc_cmd $F0000000 Constant #passcal_ds_cmd $F0000000 Constant #passcal_fd_cmd $00000001 Constant #std_type_tag $00000002 Constant #std_mesg_tag $00000003 Constant #passcal_sc_tag $00000004 Constant #passcal_ds_tag $00000005 Constant #passcal_fd_tag $F8000001 Constant #str_event_short $F8000002 Constant #str_end_short $F8000003 Constant #str_reset_short $F880C004 Constant #str_sync_short : >dat_buffer dup Buf_ptr ! #buffer_size + Buf_end ! ; Variable 'disk_full ' abort 'disk_full ! Variable 'settings ' abort 'settings ! Variable block_alert Variable block_range : lock_device dup drive pause dup drv_count 1- = swap *file [] >dos_cnt + @ block_range ! IF block_range @ 1- block_alert ! ELSE #max_int block_alert ! THEN pause 1 _main_size ! ; : samples/sec &100000 _sample_period @ / ; : access_buffer samples/sec _channels @ 1+ * #typ_access * 3 * #buffer_size 2 * / 1+ ; : put_next_disk entry_nr @ 1+ disk_entry ! curr_drive ++@ lock_device 1 data_index ! #dir_skip dir_offset ! ; : get_next_disk entry_nr @ dup disk_entry ! _disk_entry ! curr_drive ++@ lock_device #dir_skip 1- dir_offset ! ; : get_reset_disk curr_adapter @ 1+ IF fall_asleep curr_adapter on THEN 1 last_entry ! _disk_entry @ dup disk_entry ! entry_nr ! curr_drive @ lock_device #dir_skip 1- dir_offset ! ; -1 Constant #next_disk : get_dir_entry dir_offset @ 1+ #dir_size = ABORT" (80) directory overflow" dup dir_offset ++@ 2* + pause dword@ dup 0= last_entry @ #next_disk = and IF 0 free_block pause get_next_disk nip 0 read_block swap THEN dup last_entry ! #blk_shift negate ashift ; : put_dir_entry dir_offset @ 1+ #dir_size = ABORT" (80) directory overflow" BEGIN pause dir_ptr @ ?dup UNTIL swap dup #next_disk <> IF #blk_size * THEN pause over dir_offset @++ 2* + dword! 0 over dir_offset @++ 2* + dword! _disk_entry @ over [sequ_number] ! #new_data swap [status_bits] ! 0 write_block dir_ptr off ; : put_data_block *buf_cnt @ #dead_blocks - access_buffer - 0 max burst_value ! data_index dup @ dup 1+ rot ! curr_drive @ drive write_block data_index @ dup block_alert @ = _circular @ IF IF drop 2 dup data_index ! THEN ELSE IF 'disk_full @ execute THEN THEN pause block_range @ = _disk_full @ 0= and IF curr_drive @ 1+ get_disk_dir ! burst_value off #next_disk put_dir_entry pause put_next_disk THEN data_index @ alloc_block >dat_buffer ; Code buf8! Samples AR1#LDI, AR1 Buf_state Samples - # +*) R0 LDI, NN IFD, 0 # R2 LDI, $8000 # R1 LDI, $10 # R1 LSH, R1 AR2 OR, NEXTD, AR2 AR1 Buf_state Samples - # +*) STI, AR3 AR2 LDI, AR3 POP, THEN, R2 AR1 Buf_state Samples - # +*) STI, 8 # AR2 LSH, R0 AR2 OR, AR1 Buf_ptr Samples - # +*) AR0 LDI, AR2 AR0 *++) STI, AR1 Buf_end Samples - # +*) AR0 CMPI, Z IFD, AR0 AR1 Buf_ptr Samples - # +*) STI, AR3 AR2 LDI, AR3 POP, FORTH: put_data_block ;ASM THEN, NEXT, end-code Code buf! AR2 AR0 LDI, -8 # AR2 LSH, $FF # AR2 AND, 8 # AR0 LSH, AR0 AR2 OR, Samples AR1#LDI, AR1 Buf_ptr Samples - # +*) AR0 LDI, AR2 AR0 *++) STI, AR1 Buf_end Samples - # +*) AR0 CMPI, Z IFD, AR0 AR1 Buf_ptr Samples - # +*) STI, AR3 AR2 LDI, AR3 POP, FORTH: put_data_block ;ASM THEN, NEXT, end-code Code put_bytes AR2 R0 LDI, Z IF, ' buf8! # BRD, AR3 AR2 LDI, AR3 POP, $FF # AR2 AND, THEN, 1 # R0 SUBI, Z IFD, AR3 AR2 LDI, $FF # AR3 AND, -8 # AR2 LSH, FORTH: buf8! buf8! ;ASM THEN, 1 # R0 SUBI, Z IFD, AR3 PUSH, AR2 AR3 LDI, $FF # AR3 AND, -8 # AR2 LSH, FORTH: buf8! buf8! buf8! ;ASM THEN, -8 # AR2 LSH, AR3 PUSH, AR2 AR3 LDI, $FF # AR3 AND, -8 # AR2 LSH, FORTH: buf8! buf8! buf8! buf8! ;ASM end-code : put_meta_info dup 3 put_bytes dup $F8000000 and $F0000000 = IF swap 1 put_bytes $07FFFFFF and dup tmp_buffer + 1- swap ?FOR dup r@ - @ buf8! NEXT THEN drop pause ; : fill_data_block 0 buf8! Buf_end @ #buffer_size - Buf_ptr @ - IF put_data_block THEN Samples 4 #invalid fill Buf_state off data_index @ free_block ; : server dos_blocks updated_bufs off BEGIN kick_server wait updated_bufs ++@ burst_value @ > IF save-buffers kick_server cell+ off _boot_delay off get_disk_dir @ ?dup IF get_disk_dir off drive 0 read_block dir_ptr ! THEN burst_value @ IF fall_asleep THEN THEN REPEAT ; &4000 &12 * Constant Adcq_depth heap Constant Adcq_end sys Adcq_depth 5 + hallot heap Constant AdcQ Create adc_base here 0 , here 0 , here 0 , 0 , 0 , 0 , here 0 , here 0 , AdcQ , DMA0_GCR , FPGADAT , here 0 , 0 , 0 , 0 , 0 , Constant Spill Constant Active_Channels Constant data_processed Constant sub_sequ# Constant pause_cnt Constant adc_sec : init_seconds BEGIN gettime _synctime @ - seconds ! 2 sleep gettime now = UNTIL BEGIN seconds @ adc_sec ! 2 sleep seconds @ adc_sec @ over = and UNTIL ; $7D43 Constant #@DMA0 sys $40 Constant #getadc sys Semaphor kick_dac LABEL NOP_INT ST PUSH, AR1 PUSH, R2 PUSH, adc_base AR1#LDI, SECFLAG #) R2 LDI, #SECFLAG # R2 TSTB, NZ IF, AR1 0 # +*) R2 LDI, NZ IF, 1 # R2 ADDI, R2 AR1 0 # +*) STI, THEN, THEN, R2 POP, AR1 POP, ST POP, RETIU, END-CODE NOP_INT INT_ADC ! LABEL ADC_INT ST PUSH, AR0 PUSH, R0 PUSH, AR1 PUSH, AR2 PUSH, R1 PUSH, R2 PUSH, adc_base AR1#LDI, AR1 7 # +*) R0 LDI, 1 # R0 ADDI, R0 R1 LDI, AR1 8 # +*) AR2 LDI, 5 # AR2 ADDI, AR2 PUSH, AR2 3 # -*) R0 ADDI, AR2 1 # -*) R0 CMPI, Z IF, AR2 R0 LDI, THEN, AR2 2 # -*) R0 CMPI, NZ IFD, SECFLAG #) R2 LDI, #SECFLAG # R2 TSTB, NOP, NZ IFD, $FFFF # R2 LDI, $10 # R2 LSH, AR2 4 # -*) AR0 LDI, AR0 *) AR0 LDI, $FFFF # AR0 AND, AR1 0 # +*) R2 LDI, NZ IF, 1 # R2 ADDI, R2 AR1 0 # +*) STI, THEN, $11 # R2 LSH, -1 # R2 LSH, AR0 R2 OR, AR2 4 # -*) AR0 LDI, ELSE, AR0 *) R2 OR, THEN, R2 AR0 *) STI, AR2 3 # -*) AR0 LDI, AR0 AR2 4 # -*) STI, R0 AR2 3 # -*) STI, AR0 AR2 LDI, ELSE, AR1 &11 # +*) AR0 LDI, 1 # AR0 ADDI, AR0 AR1 &11 # +*) STI, AR1 AR2 LDI, &12 # AR2 ADDI, THEN, AR1 9 # +*) AR0 LDI, R1 AR0 DMA0_CTR DMA0_GCR - # +*) STI, AR2 AR0 DMA0_DST DMA0_GCR - # +*) STI, AR1 &10 # +*) R1 LDI, R1 AR0 DMA0_SRC DMA0_GCR - # +*) STI, #@DMA0 # R1 LDI, R1 AR0 *) STI, BEGIN, FPGAINT #) R1 LDI, #FPGABUSY # R1 AND, Z UNTIL, #getadc # R1 LDI, R1 FPGACTRL #) STI, Buf_cnt AR2#LDI, AR2 *) R1 LDI, 1 # R1 ADDI, R1 AR2 *) STI, AR2 POP, AR2 5 # -*) R1 LDI, NZ IF, AR2 2 # -*) R0 SUBI, N IF, AR2 1 # -*) R0 ADDI, AR2 R0 SUBI, THEN, $80 # R0 SUBI, NN IFD, CALL-WAKE split # AR0 LDI, $10 # AR0 LSH, # AR0 OR, 0 # R0 LDI, R0 AR2 5 # -*) STI, R1 AR2 LDI, AR0 AR2 *) STI, THEN, THEN, R2 POP, R1 POP, AR2 POP, AR1 POP, R0 POP, AR0 POP, ST POP, RETIU, END-CODE : adcq_empty Adcq_end [ AdcQ 5 + ] Literal dup Active_Channels @ 1+ + dup 0 AdcQ 1 !+ 1 !+ 1 !+ 1 !+ ! ; CODE getsamples Active_channels AR0#LDI, AR0 1 # +*) AR5 LDI, 5 # AR5 ADDI, AR5 2 # -*) AR1 LDI, AR0 *) AR1 ADDI, 1 # AR1 ADDI, AR5 1 # -*) AR1 CMPI, Z IFD, AR5 4 # -*) AR1 CMPI, AR3 PUSH, AR2 PUSH, AR5 AR1 LDI, AR5 4 # -*) AR1 CMPI, THEN, Z IF, -1 # R0 LDI, R0 AR0 1 # -*) STI, PRIORITY 1+ # BRD, AR6 AR5 5 # -*) STI, 2 # SP SUBI, 1 # AR4 SUBI, THEN, AR1 AR5 2 # -*) STI, AR0 *) AR2 LDI, AR1 AR3 LDI, AR0 active_channels pause_cnt - # -*) R0 LDI, 1 # R0 ADDI, $1F # R0 TSTB, Z IFD, NOP, NOP, R0 AR0 active_channels pause_cnt - # -*) STI, ' pause @ # BR, THEN, NEXT, END-CODE : flush-adc pause adcq @ wake data_processed off BEGIN pause data_processed @ INT_ADC @ NOP_INT = and UNTIL Buf_adc off ; Forth definitions $001 CONSTANT #on $001 CONSTANT #syn $01E CONSTANT #gain $040 CONSTANT #cal NV Create _ADC_controls 4 NV allot : chan_gain _ADC_controls addr + @ #gain and 2/ ; : setchannel dup 3 u> ABORT" (30) range 1 to 4" dup >r _ADC_controls addr + 1 r> 1+ fpgatransfer ; : AD_CTRL: Create , ms , Does> count _ADC_controls addr dup >r @ tuck or r@ ! 0 setchannel r> ! @ sleep ; sys &100 #cal AD_CTRL: calibrate_adc &50 #syn AD_CTRL: synchronize_adc : gain 1- dup 3 u> ABORT" (30) GAIN range 1 to 4" dup >r _ADC_controls [] + >r [ #gain 2/ ] Literal and 2* r@ @ [ #gain NOT ] Literal and or r> NV ! r> setchannel ; : switch_channel _ADC_controls [] + dup @ rot IF 1 or ELSE [ 1 not ] Literal and THEN swap NV ! ; : consume 2drop rdrop ; sys &10 Constant #filters sys : decimate consume consume consume consume consume consume consume consume consume consume ; : sampling dos_blocks BEGIN getsamples decimate REPEAT ; : channels Adc_task deactivate dup NOP_INT INT_ADC ! 0 setchannel 4 1 DO dup I switch_channel 1- 0 max I setchannel LOOP drop dup _channels ! Active_channels ! calibrate_adc synchronize_adc adcq_empty Adc_task activate sampling ; NV Create _filters #filters 1+ NV allot Variable FP FP off sys : Dataplexer Create , Does> FP @ #filters 2- > ABORT" (84) Filter bank full" [ ' decimate >body ] Literal FP @ + ! 1 FP +! ; : empty-filters FP off [ ' decimate >body ] Literal #filters ['] consume fill ; : filters [ ' decimate >body ] Literal BEGIN count dup ['] consume - WHILE 1- .name ?cr REPEAT 2drop ; : bits &30 - _bits ! ; : bits/sample &30 _bits @ + ; &1600 Constant #pixels_max variable pixels variable buf_show variable buf_in variable buf_out variable buf_len Create buf_base #pixels_max 1+ allot Label (clip AR2 AR0 LDI, AR3 AR1 LDI, _bits addr Assembler AR5#LDI, AR5 *) R3 LDI, buf_base AR5#LDI, AR5 buf_base buf_show - # -*) R2 LDI, DO, AR1 *) R0 LDI, R0 R0 NOT, 1 # R0 ADDI, R0 R1 LDI, 2 # R1 ASH, V IFD, NOP, NOP, R0 R0 LDI, N IFD, $1FFFFFFF R0#LDI, R0 R0 NOT, THEN, THEN, R2 AR0 CMPI, EQ IFD, R3 R0 ASH, R0 AR1 *++) STI, NOP, AR5 buf_base buf_in - # -*) IR0 LDI, R0 AR5 IR0 +*) STI, 1 # IR0 ADDI, AR5 buf_base buf_len - # -*) IR0 CMPI, EQ IF, 0 # IR0 LDI, THEN, AR5 buf_base buf_out - # -*) IR0 CMPI, NE IF, IR0 AR5 buf_base buf_in - # -*) STI, THEN, THEN, AR0 LOOP, next, end-code sys (clip Dataplexer clip Label (mark-time AR3 *) R0 LDI, N IFD, AR5 *) R1 LDI, 1 # R1 SUBI, NOP, NEXT, THEN, NZ IFD, R1 AR5 *++) STI, AR5 *) R1 LDI, NOP, NEXT, THEN, R1 AR5 1 # -*) STI, AR3 PUSH, AR2 PUSH, Samples AR1#LDI, #invalid R1#LDI, R1 AR1 *) STI, R1 AR1 1 # +*) STI, R1 AR1 2 # +*) STI, R1 AR1 3 # +*) STI, adc_sec AR0#LDI, -$10 # R0 LSH, AR0 *) R2 LDI, R0 R2 SUBI, -$0f # R2 LSH, $0f # R2 LSH, R0 R2 ADDI, AR1 Buf_adc Samples - # +*) R0 LDI, Z IFD, NOP, NOP, AR1 Buf_state Samples - # +*) R0 LDI, NEXTD, AR2 POP, AR3 POP, NOP, THEN, N IF, R2 AR2 LDI, $FF # AR2 AND, AR2 PUSH, -8 # R2 LSH, R2 PUSH, -$10 # R2 LSH, #str_sec_short -$18 shift #str_sync_short 8 shift or # R2 OR, R2 PUSH, #str_sync_short -8 shift # AR3 LDI, #str_sync_short -$18 shift # AR2 LDI, FORTH: buf8! buf! buf! buf! buf8! ;ASM THEN, R2 PUSH, -$10 # R2 LSH, #str_sec_short -$10 shift # R2 OR, R2 PUSH, #str_sync_short # AR3 LDI, #str_sync_short -$10 shift # AR2 LDI, FORTH: buf! buf! buf! buf! ;ASM end-code sys (mark-time Dataplexer mark-time here 1 , here 1 , Constant sec/mark_val Constant sec/mark_cnt Label (scale AR2 AR0 LDI, AR3 AR1 LDI, _bits addr Assembler AR5#LDI, AR5 *) R3 LDI, 2 # R3 SUBI, buf_base AR5#LDI, AR5 buf_base buf_show - # -*) R2 LDI, DO, AR1 *) R0 LDI, $10 # R0 LSH, R0 R0 NOT, 1 # R0 ADDI, R2 AR0 CMPI, EQ IFD, R3 R0 ASH, R0 AR1 *++) STI, NOP, AR5 buf_base buf_in - # -*) IR0 LDI, R0 AR5 IR0 +*) STI, 1 # IR0 ADDI, AR5 buf_base buf_len - # -*) IR0 CMPI, EQ IF, 0 # IR0 LDI, THEN, AR5 buf_base buf_out - # -*) IR0 CMPI, NE IF, IR0 AR5 buf_base buf_in - # -*) STI, THEN, THEN, AR0 LOOP, next, end-code sys (scale Dataplexer scale Label (encode Samples AR1#LDI, AR2 IR0 LDI, AR3 *++) R0 LDI, R0 R1 LDI, IR0 R2 LDI, NZ IFD, AR1 IR0 +*) R1 SUBI, R0 AR1 IR0 +*) STI, 1 # IR0 SUBI, 1 # AR4 SUBI, AR3 PUSH, IR0 PUSH, ELSE, AR7 *--) AR4 LDI, THEN, R1 R2 LDI, N IFD, $FFFFFFC0 AR0#LDI, R1 R2 NOT, THEN, AR1 Buf_adc Samples - # +*) R3 LDI, Z IFD, AR1 Buf_end Samples - # +*) R3 LDI, 4 # R3 SUBI, AR1 Buf_ptr Samples - # +*) R3 CMPI, NEXTD, AR2 POP, AR3 POP, NOP, THEN, HI IFD, R2 R3 LDI, AR0 R3 AND, NOP, Z IFD, $FFFFF000 AR0#LDI, AR1 Buf_state Samples - # +*) R3 LDI, N IFD, $7F # R1 AND, 0 # AR2 LDI, NOP, AR2 AR1 Buf_state Samples - # +*) STI, 8 # R1 LSH, R3 R1 OR, AR1 Buf_ptr Samples - # +*) AR2 LDI, R1 AR2 *++) STI, AR2 AR1 Buf_ptr Samples - # +*) STI, nextd, AR2 POP, AR3 POP, NOP, THEN, R1 ROL, 1 # R1 OR, R1 ROR, R1 AR1 Buf_state Samples - # +*) STI, nextd, AR2 POP, AR3 POP, NOP, THEN, R2 R3 LDI, AR0 R3 AND, Z IFD, $003FFFFF AR0#LDI, AR1 Buf_state Samples - # +*) R3 LDI, N IFD, $1FFF # R1 AND, $C000 # R1 OR, R1 R0 LDI, $00FF # R1 AND, R1 ROL, 1 # R1 OR, R1 ROR, R1 AR1 Buf_state Samples - # +*) STI, $00FF # R3 AND, $FF00 # R0 AND, R3 R0 OR, AR1 Buf_ptr Samples - # +*) AR2 LDI, R0 AR2 *++) STI, AR2 AR1 Buf_ptr Samples - # +*) STI, nextd, AR2 POP, AR3 POP, NOP, THEN, -8 # R0 LSH, $FF # R0 AND, 8 # R1 LSH, R0 R1 OR, AR1 Buf_ptr Samples - # +*) AR2 LDI, R1 AR2 *++) STI, AR2 AR1 Buf_ptr Samples - # +*) STI, nextd, AR2 POP, AR3 POP, NOP, THEN, $800000 AR2#LDI, AR1 Buf_state Samples - # +*) R3 LDI, N IFD, AR0 R0 AND, AR2 R0 OR, R0 R1 LDI, 0 # AR2 LDI, AR2 AR1 Buf_state Samples - # +*) STI, -8 # R0 LSH, $FF00 # R0 AND, R3 R0 OR, AR1 Buf_ptr Samples - # +*) AR2 LDI, R0 AR2 *++) STI, R1 AR3 LDI, -8 # AR3 LSH, $FF # AR3 AND, 8 # R1 LSH, AR3 R1 OR, R1 AR2 *++) STI, AR2 AR1 Buf_ptr Samples - # +*) STI, nextd, AR2 POP, AR3 POP, NOP, THEN, $00FF # R0 AND, R0 ROL, 1 # R0 OR, R0 ROR, R0 AR1 Buf_state Samples - # +*) STI, R1 AR3 LDI, -$10 # AR3 LSH, $FF # AR3 AND, $ff00 # R1 AND, AR3 R1 OR, AR1 Buf_ptr Samples - # +*) AR2 LDI, R1 AR2 *++) STI, AR2 AR1 Buf_ptr Samples - # +*) STI, nextd, AR2 POP, AR3 POP, NOP, ELSE, Z IFD, $FFFFF000 AR0#LDI, ' buf8! @ # BRD, $7F # R1 AND, R1 AR2 LDI, AR3 POP, THEN, R2 R3 LDI, AR0 R3 AND, Z IFD, $003FFFFF AR0#LDI, AR1 Buf_state Samples - # +*) R0 LDI, N IFD, $1FFF # R1 AND, $C000 # R1 OR, NOP, R1 AR3 LDI, $FF # AR3 AND, R1 AR2 LDI, -8 # AR2 LSH, FORTH: buf8! buf8! ;ASM THEN, ' buf! @ # BRD, R1 AR2 LDI, AR3 POP, NOP, THEN, AR0 R0 AND, AR1 Buf_state Samples - # +*) R1 LDI, N IFD, $800000 AR0#LDI, AR0 R0 OR, R0 AR3 LDI, R0 AR2 LDI, -$10 # AR2 LSH, FORTH: buf8! buf! ;ASM THEN, AR0 R0 OR, R0 AR3 LDI, $FF # AR3 AND, R0 AR2 LDI, -8 # AR2 LSH, FORTH: buf! buf8! ;ASM THEN, end-code (encode Dataplexer encode : Coefficients Create , here 0 , 0 Does> count swap count rot ; : end-coefficients 0 ?pairs here over - 1- swap ! ; 2variable Scalor sys : ref Scalor 2! ; sys : norm Scalor 2@ */ ; sys : power2 dup >r 1 swap BEGIN ?dup WHILE 2/ swap 2* swap REPEAT dup 2/ r> = 0=EXIT 2/ ; : z-buffer over power2 tuck * hallot 1- heap and hallot heap ; : Filter Dataplexer 2 pick , swap , swap power2 , dup , , + 1- , ; Label single-decimation AR3 R7 LDI, AR2 R6 LDI, AR5 *++) BK LDI, AR5 *) AR0 LDI, AR0 AR1 LDI, AR0 1 # *--)% AR0 TSTB, AR0 AR5 *++) STI, AR5 *++) IR1 LDI, DO, AR3 *++) R0 LDI, $10 # R0 LSH, -$10 # R0 ASH, R0 AR1 IR1 *++) STI, AR2 LOOP, AR5 *++) R0 LDI, 1 # R0 SUBI, NZ IFD, R7 AR3 LDI, R6 AR2 LDI, R0 AR5 1 # -*) STI, AR7 *--) AR4 LDI, NEXTD, AR2 POP, AR3 POP, NOP, THEN, AR5 *++) R0 LDI, R0 AR5 2 # -*) STI, AR5 *) AR5 LDI, AR0 AR1 LDI, DO, BK IR0 LDI, 0 # R3 LDI, BEGIN, 1 # IR0 SUBI, IR0 R0 LDI, NN WHILED, AR0 IR0 *--)% R0 LDI, -1 # IR0 LSH, AR5 IR0 -*) R1 LDI, 1 # IR0 LSH, AR0 IR0 *++)% R0 ADDI, -1 # R1 ASH, R0 R1 R2 XOR3, N IFD, R1 R1 ABSI, R1 R2 LDI, -$10 # R1 LSH, $FFFF # R2 AND, R0 R0 ABSI, R0 R1 MPYI, R1 R3 SUBI, R0 R2 MPYI, -$10 # R2 LSH, R2 R3 SUBI, ELSE, $FFFF # R2 AND, R0 R0 ABSI, R0 R1 MPYI, R1 R3 ADDI, R0 R2 MPYI, -$10 # R2 LSH, R2 R3 ADDI, THEN, REPEAT, R3 AR3 *++) STI, IR1 AR1 ADDI, AR1 AR0 LDI, AR2 LOOP, NEXTD, R7 AR3 LDI, R6 AR2 LDI, NOP, end-code &24 Coefficients FIR_5000/750 $1FFFFFFF $1FACFE2C ref $00112347 norm , $002A55C4 norm , $FFD5540C norm , $FEF1E41F norm , $FF2055BD norm , $01D2B0CC norm , $038AE252 norm , $FE7C35B7 norm , $F6DB7588 norm , $FCDD794D norm , $17570FF8 norm , $324D2DCB norm , end-coefficients FIR_5000/750 4 z-buffer 2 single-decimation Filter single/2 Label double-decimation AR3 R7 LDI, AR2 R6 LDI, AR5 *++) BK LDI, AR5 *) AR0 LDI, AR0 AR1 LDI, AR0 1 # *--)% AR0 TSTB, AR0 AR5 *++) STI, AR5 *++) IR1 LDI, DO, AR3 *++) R0 LDI, R0 AR1 IR1 *++) STI, AR2 LOOP, AR5 *++) R0 LDI, 1 # R0 SUBI, NZ IFD, R7 AR3 LDI, R6 AR2 LDI, R0 AR5 1 # -*) STI, AR7 *--) AR4 LDI, NEXTD, AR2 POP, AR3 POP, NOP, THEN, AR5 *++) R0 LDI, R0 AR5 2 # -*) STI, AR5 *) AR5 LDI, AR0 AR1 LDI, DO, BK IR0 LDI, 0 # R3 LDI, BEGIN, 1 # IR0 SUBI, IR0 R0 LDI, NN WHILED, AR0 IR0 *--)% R0 LDI, -1 # IR0 LSH, AR5 IR0 -*) R1 LDI, 1 # IR0 LSH, AR0 IR0 *++)% R0 ADDI, R0 R1 R2 XOR3, N IFD, R1 R1 ABSI, R1 R2 LDI, -$10 # R1 LSH, $FFFF # R2 AND, R0 R0 ABSI, R0 R4 LDI, -$10 # R0 LSH, $FFFF # R4 AND, R1 R4 MPYI, R0 R2 MPYI, R4 R2 ADDI, -$10 # R2 LSH, R2 R3 SUBI, R0 R1 MPYI, R1 R3 SUBI, ELSE, $FFFF # R2 AND, R0 R0 ABSI, R0 R4 LDI, -$10 # R0 LSH, $FFFF # R4 AND, R1 R4 MPYI, R0 R2 MPYI, R4 R2 ADDI, -$10 # R2 LSH, R2 R3 ADDI, R0 R1 MPYI, R1 R3 ADDI, THEN, REPEAT, R3 AR3 *++) STI, IR1 AR1 ADDI, AR1 AR0 LDI, AR2 LOOP, NEXTD, R7 AR3 LDI, R6 AR2 LDI, NOP, end-code &44 Coefficients Sharp_140dB $1FFFC000 $1EFCABC4 ref $FFFF4ABA norm 2* , $FFF9F520 norm 2* , $FFE690DF norm 2* , $FFBBDD14 norm 2* , $FF841F41 norm 2* , $FF6ED057 norm 2* , $FFBACF03 norm 2* , $00697C80 norm 2* , $00FBD609 norm 2* , $00B0C53E norm 2* , $FF5C01FE norm 2* , $FE10DBC4 norm 2* , $FE84E316 norm 2* , $01278CE6 norm 2* , $03C4A278 norm 2* , $02E1D6FB norm 2* , $FD91CD60 norm 2* , $F8263701 norm 2* , $F9FAD11B norm 2* , $06F33D66 norm 2* , $1A5BAF45 norm 2* , $28D8C5F9 norm 2* , end-coefficients Sharp_140dB 4 z-buffer 2 double-decimation Filter sharp/2 Create C_hb136 $40000000 $4000000D ref $FFFEDD00 norm abs 2/ split , , $000A672F norm abs 2/ split , , $FFCCD022 norm abs 2/ split , , $00B28D82 norm abs 2/ split , , $FE0E8D25 norm abs 2/ split , , $04B60256 norm abs 2/ split , , $F4D22814 norm abs 2/ split , , $27E0A601 norm abs 2/ split , , $40000000 norm abs 2/ split , , Label single-halfband AR3 R7 LDI, AR2 R6 LDI, AR5 *++) BK LDI, AR5 *) AR0 LDI, AR0 AR1 LDI, AR0 1 # *--)% AR0 TSTB, AR0 AR5 2 # *++) STI, DO, AR3 *++) R0 LDI, $10 # R0 LSH, -$10 # R0 ASH, R0 AR1 $40 # *++) STI, AR2 LOOP, AR5 *++) R0 LDI, NZ IFD, R0 R0 NOT, R0 AR5 1 # -*) STI, R7 AR3 LDI, AR7 *--) AR4 LDI, NEXTD, AR2 POP, AR3 POP, NOP, THEN, R6 AR2 LDI, AR5 1 # +*) AR5 LDI, AR0 1 # *--)% AR0 TSTB, AR0 AR1 LDI, DO, 0 # R3 LDI, AR0 &30 # *--)% R0 LDI, AR0 &28 # *++)% R0 ADDI, NN IFD, R0 R0 ABSI, R0 R1 LDI, AR5 &00 # +*) R0 MPYI, R0 R3 SUBI, AR5 &01 # +*) R1 MPYI, -$10 # R1 LSH, R1 R3 SUBI, ELSE, R0 R3 ADDI, AR5 &01 # +*) R1 MPYI, -$10 # R1 LSH, R1 R3 ADDI, THEN, AR0 &26 # *--)% R0 LDI, AR0 &24 # *++)% R0 ADDI, N IFD, R0 R0 ABSI, R0 R1 LDI, AR5 &02 # +*) R0 MPYI, R0 R3 SUBI, AR5 &03 # +*) R1 MPYI, -$10 # R1 LSH, R1 R3 SUBI, ELSE, R0 R3 ADDI, AR5 &03 # +*) R1 MPYI, -$10 # R1 LSH, R1 R3 ADDI, THEN, AR0 &22 # *--)% R0 LDI, AR0 &20 # *++)% R0 ADDI, NN IFD, R0 R0 ABSI, R0 R1 LDI, AR5 &04 # +*) R0 MPYI, R0 R3 SUBI, AR5 &05 # +*) R1 MPYI, -$10 # R1 LSH, R1 R3 SUBI, ELSE, R0 R3 ADDI, AR5 &05 # +*) R1 MPYI, -$10 # R1 LSH, R1 R3 ADDI, THEN, AR0 &18 # *--)% R0 LDI, AR0 &16 # *++)% R0 ADDI, N IFD, R0 R0 ABSI, R0 R1 LDI, AR5 &06 # +*) R0 MPYI, R0 R3 SUBI, AR5 &07 # +*) R1 MPYI, -$10 # R1 LSH, R1 R3 SUBI, ELSE, R0 R3 ADDI, AR5 &07 # +*) R1 MPYI, -$10 # R1 LSH, R1 R3 ADDI, THEN, AR0 &14 # *--)% R0 LDI, AR0 &12 # *++)% R0 ADDI, NN IFD, R0 R0 ABSI, R0 R1 LDI, AR5 &08 # +*) R0 MPYI, R0 R3 SUBI, AR5 &09 # +*) R1 MPYI, -$10 # R1 LSH, R1 R3 SUBI, ELSE, R0 R3 ADDI, AR5 &09 # +*) R1 MPYI, -$10 # R1 LSH, R1 R3 ADDI, THEN, AR0 &10 # *--)% R0 LDI, AR0 &08 # *++)% R0 ADDI, N IFD, R0 R0 ABSI, R0 R1 LDI, AR5 &10 # +*) R0 MPYI, R0 R3 SUBI, AR5 &11 # +*) R1 MPYI, -$10 # R1 LSH, R1 R3 SUBI, ELSE, R0 R3 ADDI, AR5 &11 # +*) R1 MPYI, -$10 # R1 LSH, R1 R3 ADDI, THEN, AR0 &06 # *--)% R0 LDI, AR0 &04 # *++)% R0 ADDI, NN IFD, R0 R0 ABSI, R0 R1 LDI, AR5 &12 # +*) R0 MPYI, R0 R3 SUBI, AR5 &13 # +*) R1 MPYI, -$10 # R1 LSH, R1 R3 SUBI, ELSE, R0 R3 ADDI, AR5 &13 # +*) R1 MPYI, -$10 # R1 LSH, R1 R3 ADDI, THEN, AR0 &02 # *--)% R0 LDI, AR0 &01 # *++)% R0 ADDI, N IFD, R0 R0 ABSI, R0 R1 LDI, AR5 &14 # +*) R0 MPYI, R0 R3 SUBI, AR5 &15 # +*) R1 MPYI, -$10 # R1 LSH, R1 R3 SUBI, ELSE, R0 R3 ADDI, AR5 &15 # +*) R1 MPYI, -$10 # R1 LSH, R1 R3 ADDI, THEN, AR0 *) R0 LDI, &13 # R0 ASH, R0 R3 ADDI, R3 AR3 *++) STI, $40 # AR1 ADDI, AR1 AR0 LDI, AR2 LOOP, NEXTD, R7 AR3 LDI, R6 AR2 LDI, NOP, end-code C_hb136 1 &33 4 z-buffer 0 single-halfband Filter HB136 Create C_hb144 $40000000 $40000000 ref $00005D57 norm abs 2* split , , $FFFC4E0D norm abs 2* split , , $0013EB0A norm abs 2* split , , $FFB4A329 norm abs 2* split , , $00E0765C norm abs 2* split , , $FDCB2A88 norm abs 2* split , , $050209D8 norm abs 2* split , , $F494C9B0 norm abs 2* split , , $27F85200 norm abs 2* split , , $3FFFFFFF norm abs 2* split , , Label double-halfband AR3 R7 LDI, AR2 R6 LDI, AR5 *++) BK LDI, AR5 *) AR0 LDI, AR0 AR1 LDI, AR0 1 # *--)% AR0 TSTB, AR0 AR5 2 # *++) STI, DO, AR3 *++) R0 LDI, R0 AR1 $40 # *++) STI, AR2 LOOP, AR5 *++) R0 LDI, NZ IFD, R0 R0 NOT, R0 AR5 1 # -*) STI, R7 AR3 LDI, AR7 *--) AR4 LDI, NEXTD, AR2 POP, AR3 POP, NOP, THEN, R6 AR2 LDI, AR5 1 # +*) AR5 LDI, AR0 1 # *--)% AR0 TSTB, AR0 AR1 LDI, DO, 0 # R3 LDI, AR0 &34 # *--)% R0 LDI, AR0 &32 # *++)% R0 ADDI, N IFD, R0 R0 ABSI, -$10 # R0 LSH, AR5 1 # +*) R0 MPYI, -$10 # R0 LSH, R0 R3 SUBI, ELSE, -$10 # R0 LSH, R0 R3 ADDI, THEN, AR0 &30 # *--)% R0 LDI, AR0 &28 # *++)% R0 ADDI, NN IFD, R0 R0 ABSI, R0 R1 LDI, -$10 # R0 LSH, $FFFF # R1 AND, AR5 2 # +*) R1 MPYI, AR5 3 # +*) R2 LDI, R0 R2 MPYI, R1 R2 ADDI, -$10 # R2 LSH, R2 R3 SUBI, AR5 2 # +*) R0 MPYI, R0 R3 SUBI, ELSE, $FFFF # R1 AND, AR5 2 # +*) R1 MPYI, AR5 3 # +*) R2 LDI, R0 R2 MPYI, R1 R2 ADDI, -$10 # R2 LSH, R2 R3 ADDI, AR5 2 # +*) R0 MPYI, R0 R3 ADDI, THEN, AR0 &26 # *--)% R0 LDI, AR0 &24 # *++)% R0 ADDI, N IFD, R0 R0 ABSI, R0 R1 LDI, -$10 # R0 LSH, $FFFF # R1 AND, AR5 4 # +*) R1 MPYI, AR5 5 # +*) R2 LDI, R0 R2 MPYI, R1 R2 ADDI, -$10 # R2 LSH, R2 R3 SUBI, AR5 4 # +*) R0 MPYI, R0 R3 SUBI, ELSE, $FFFF # R1 AND, AR5 4 # +*) R1 MPYI, AR5 5 # +*) R2 LDI, R0 R2 MPYI, R1 R2 ADDI, -$10 # R2 LSH, R2 R3 ADDI, AR5 4 # +*) R0 MPYI, R0 R3 ADDI, THEN, AR0 &22 # *--)% R0 LDI, AR0 &20 # *++)% R0 ADDI, NN IFD, R0 R0 ABSI, R0 R1 LDI, -$10 # R0 LSH, $FFFF # R1 AND, AR5 6 # +*) R1 MPYI, AR5 7 # +*) R2 LDI, R0 R2 MPYI, R1 R2 ADDI, -$10 # R2 LSH, R2 R3 SUBI, AR5 6 # +*) R0 MPYI, R0 R3 SUBI, ELSE, $FFFF # R1 AND, AR5 6 # +*) R1 MPYI, AR5 7 # +*) R2 LDI, R0 R2 MPYI, R1 R2 ADDI, -$10 # R2 LSH, R2 R3 ADDI, AR5 6 # +*) R0 MPYI, R0 R3 ADDI, THEN, AR0 &18 # *--)% R0 LDI, AR0 &16 # *++)% R0 ADDI, N IFD, R0 R0 ABSI, R0 R1 LDI, -$10 # R0 LSH, $FFFF # R1 AND, AR5 8 # +*) R1 MPYI, AR5 9 # +*) R2 LDI, R0 R2 MPYI, R1 R2 ADDI, -$10 # R2 LSH, R2 R3 SUBI, AR5 8 # +*) R0 MPYI, R0 R3 SUBI, ELSE, $FFFF # R1 AND, AR5 8 # +*) R1 MPYI, AR5 9 # +*) R2 LDI, R0 R2 MPYI, R1 R2 ADDI, -$10 # R2 LSH, R2 R3 ADDI, AR5 8 # +*) R0 MPYI, R0 R3 ADDI, THEN, AR0 &14 # *--)% R0 LDI, AR0 &12 # *++)% R0 ADDI, NN IFD, R0 R0 ABSI, R0 R1 LDI, -$10 # R0 LSH, $FFFF # R1 AND, AR5 &10 # +*) R1 MPYI, AR5 &11 # +*) R2 LDI, R0 R2 MPYI, R1 R2 ADDI, -$10 # R2 LSH, R2 R3 SUBI, AR5 &10 # +*) R0 MPYI, R0 R3 SUBI, ELSE, $FFFF # R1 AND, AR5 &10 # +*) R1 MPYI, AR5 &11 # +*) R2 LDI, R0 R2 MPYI, R1 R2 ADDI, -$10 # R2 LSH, R2 R3 ADDI, AR5 &10 # +*) R0 MPYI, R0 R3 ADDI, THEN, AR0 &10 # *--)% R0 LDI, AR0 &08 # *++)% R0 ADDI, N IFD, R0 R0 ABSI, R0 R1 LDI, -$10 # R0 LSH, $FFFF # R1 AND, AR5 &12 # +*) R1 MPYI, AR5 &13 # +*) R2 LDI, R0 R2 MPYI, R1 R2 ADDI, -$10 # R2 LSH, R2 R3 SUBI, AR5 &12 # +*) R0 MPYI, R0 R3 SUBI, ELSE, $FFFF # R1 AND, AR5 &12 # +*) R1 MPYI, AR5 &13 # +*) R2 LDI, R0 R2 MPYI, R1 R2 ADDI, -$10 # R2 LSH, R2 R3 ADDI, AR5 &12 # +*) R0 MPYI, R0 R3 ADDI, THEN, AR0 &06 # *--)% R0 LDI, AR0 &04 # *++)% R0 ADDI, NN IFD, R0 R0 ABSI, R0 R1 LDI, -$10 # R0 LSH, $FFFF # R1 AND, AR5 &14 # +*) R1 MPYI, AR5 &15 # +*) R2 LDI, R0 R2 MPYI, R1 R2 ADDI, -$10 # R2 LSH, R2 R3 SUBI, AR5 &14 # +*) R0 MPYI, R0 R3 SUBI, ELSE, $FFFF # R1 AND, AR5 &14 # +*) R1 MPYI, AR5 &15 # +*) R2 LDI, R0 R2 MPYI, R1 R2 ADDI, -$10 # R2 LSH, R2 R3 ADDI, AR5 &14 # +*) R0 MPYI, R0 R3 ADDI, THEN, AR0 &02 # *--)% R0 LDI, AR0 &01 # *++)% R0 ADDI, N IFD, R0 R0 ABSI, R0 R1 LDI, -$10 # R0 LSH, $FFFF # R1 AND, AR5 &16 # +*) R1 MPYI, AR5 &17 # +*) R2 LDI, R0 R2 MPYI, R1 R2 ADDI, -$10 # R2 LSH, R2 R3 SUBI, AR5 &16 # +*) R0 MPYI, R0 R3 SUBI, ELSE, $FFFF # R1 AND, AR5 &16 # +*) R1 MPYI, AR5 &17 # +*) R2 LDI, R0 R2 MPYI, R1 R2 ADDI, -$10 # R2 LSH, R2 R3 ADDI, AR5 &16 # +*) R0 MPYI, R0 R3 ADDI, THEN, AR0 *) R0 LDI, -1 # R0 ASH, R0 R3 ADDI, R3 AR3 *++) STI, $40 # AR1 ADDI, AR1 AR0 LDI, AR2 LOOP, NEXTD, R7 AR3 LDI, R6 AR2 LDI, NOP, end-code C_hb144 1 &37 4 z-buffer 0 double-halfband Filter HB1 C_hb144 1 &37 4 z-buffer 0 double-halfband Filter HB2 C_hb144 1 &37 4 z-buffer 0 double-halfband Filter HB3 C_hb144 1 &37 4 z-buffer 0 double-halfband Filter HB4 VARIABLE SYS_POS SYS_POS OFF VARIABLE SYS_BUF SYS_BUF OFF : SYS_EMIT 1 OUT +! >BYTE SYS_BUF @ PAUSE SYS_POS @ $7FFF MIN DUP 1+ SYS_POS ! BYTE>WORD! ; : SYS_CR OUT OFF #CR SYS_EMIT #LF SYS_EMIT ; : SYS_BACKSPACE -1 OUT +! SYS_POS DECREMENT ; CREATE SYS_IO ] SYS_EMIT SYS_CR SYS_BACKSPACE [ CODE RAM_ASC_LEN 1 # AR2 CMPI, 1 # AR2 SUBI, HS IF, DO, AR3 AR0 LDI, AR2 AR0 ADDI, 1 # AR0 TSTB, NZ IFD, -1 # AR0 LSH, AR0 *) AR0 LDI, NOP, -8 # AR0 LSH, THEN, $FF # AR0 AND, $20 # AR0 CMPI, HI IF, 1 # AR2 ADDI, NEXT, THEN, AR2 LOOP, THEN, 0 # AR2 LDI, NEXT, END-CODE : SYSIO RS232_SEMA LOCK SYS_BLOCKS 0 BLOCK LOCK-BUFFER DUP 2* #BUFFER_SIZE 2* RAM_ASC_LEN NIP SYS_POS ! SYS_BUF ! SYS_IO IO ! ; : STDIO STD_IO IO ! SYS_BLOCKS 0 BLOCK DROP UPDATE-BUFFER UNLOCK-BUFFER RS232_SEMA UNLOCK ; &365 4 * 1+ &86400 * constant #sec_of_4_years : day_of_year dup #sec_of_4_years + swap sec>date 4 + >r 2drop 1 1 r> date>sec - &86400 / 1+ ; : bcd_read -4 * shift dup $0F and swap $F0 and -4 shift &10 * + ; : int>char &36 mod $30 + dup $3A u< ?exit 7 + ; : int>packed >r 0 r@ ?FOR -8 shift over &10 mod $30 + &24 shift or swap &10 / swap NEXT nip 4 r> - -8 * shift ; : build_file_name >r $31 + 8 shift ser# @ dup 0 bcd_read dup &90 < IF &10 + ELSE &90 - THEN int>char &24 shift over 2 bcd_read int>char &16 shift or swap 4 bcd_read 2 int>packed or r> swap >r dup >r sec>date drop drop drop nip nip 2 int>packed &16 shift or r> day_of_year 3 int>packed &8 shift $5F or >r split r> split r> split ; : dir_file_name tmp_buffer >r &11 r@ ! wsplit r@ 1 + ! r@ 2 + ! wsplit r@ 3 + ! r@ 4 + ! wsplit r@ 5 + ! r@ 6 + ! wsplit r@ 7 + ! r@ 8 + ! wsplit r@ 9 + ! r@ &10 + ! wsplit r> &11 + ! drop ; : log_file_name tmp_buffer >r wsplit r@ ! r@ 1 + ! wsplit r@ 2 + ! r@ 3 + ! wsplit r@ 4 + ! r@ 5 + ! wsplit r@ 6 + ! r@ 7 + ! [char] . r@ 8 + ! wsplit r@ 9 + ! r@ &10 + ! wsplit r> &11 + ! drop ; : >tmp_buffer tmp_buffer + ; : meta@ >tmp_buffer dup @ swap 1+ @ wjoin ; : meta! >tmp_buffer >r wsplit r@ 1+ ! r> ! ; variable coeff_ptr variable coeff_rev variable total_delay : coeff_halfband swap dup 7 + @ 2 2 meta! over 2 + @ 2- dup 0 meta! 4 coeff_ptr ! dup 4 * 2+ coeff_rev ! 2+ 4 / dup >r 2* + r> ?FOR dup r@ 1+ 2* - 2@ join 3 pick ashift r@ 2 mod IF negate THEN dup split swap coeff_ptr @2++ meta! coeff_ptr @2++ meta! 0 split swap coeff_ptr @2++ meta! coeff_ptr @2++ meta! split coeff_rev @2-- meta! coeff_rev @2-- meta! 0 split coeff_rev @2-- meta! coeff_rev @2-- meta! NEXT 2@ join -4 coeff_ptr +! rot shift split swap coeff_ptr @2++ meta! coeff_ptr @2++ meta! ; : coeff_decimation swap dup 7 + @ over 6 + @ 2 meta! over 2 + @ dup 0 meta! 4 coeff_ptr ! dup 4 * 2+ coeff_rev ! 2/ ?FOR dup r@ - @ 3 pick ashift dup split swap coeff_ptr @2++ meta! coeff_ptr @2++ meta! split coeff_rev @2-- meta! coeff_rev @2-- meta! NEXT drop nip ; : mk_spec over 0 meta@ 1- &500 * * total_delay +! 2 meta@ rot * swap ; : .coeff swap dup $80000000 = IF 1+ THEN dup dup abs = IF ." 0." ELSE negate ." -0." THEN 0 rot BEGIN swap 1+ swap base @ / ?dup 0= UNTIL ?FOR base @ um* int>char emit NEXT drop space ; : .filter dup cr cr ." [" >name count type ." ]" 2 meta@ cr . ." decimation" 0 meta@ dup cr . ." coefficients" 4 * dup 4 / ?FOR dup r@ 4 * - cr ." #" dup 4 / . dup meta@ swap 2+ meta@ join ." : " $1FFFFFFF .coeff pause NEXT drop ; : sys_filter total_delay off 1 [ ' decimate >body ] Literal BEGIN count dup ['] consume xor WHILE 1- rot swap dup ['] HB136 = IF 2 coeff_halfband mk_spec .filter THEN dup ['] HB1 = IF 0 coeff_halfband mk_spec .filter THEN dup ['] HB2 = IF 0 coeff_halfband mk_spec .filter THEN dup ['] HB3 = IF 0 coeff_halfband mk_spec .filter THEN dup ['] HB4 = IF 0 coeff_halfband mk_spec .filter THEN dup ['] SINGLE/2 = IF 1 coeff_decimation mk_spec .filter THEN dup ['] SHARP/2 = IF 0 coeff_decimation mk_spec .filter THEN drop swap REPEAT 2drop cr cr ." [delay]" total_delay @ swap / &1000 * samples/sec / [ &2155 &19530 * ] Literal samples/sec dup &2000 < IF drop &2000 THEN dup &5000 < IF 2* THEN / + dup cr . ." us, " samples/sec * &500000 + &1000000 / . ." samples" ; : header_sys_file sysio 1+ _SyncTime @ cr cr ." \\\" cr cr ." [sync_time]" cr .time&date backspace cr cr ." [this_disk]" cr ." disk #" . backspace cr cr ." [file_name]" 3 FOR 3 r@ - *file [] >dos_cnt + @ IF 3 r@ - cr ." disk #" dup 1+ . backspace ." : " _SyncTime @ build_file_name log_file_name tmp_buffer &12 type THEN NEXT stdio ; $8000 Constant #no_skew : trailer_sys_file sysio _SkewTime @ cr cr cr ." [skew_time]" cr .time&date backspace cr cr ." [deviation]" dup #no_skew = IF drop ." not available" ELSE cr . ." ms" THEN cr cr ." [messages]" cr print-errors cr cr ." [settings]" 'settings @ execute cr cr ." [filters]" cr filters sys_filter sys_pos @ sys_byte ! stdio ; create log_name ," MBS.....SYS" create vol_name ," MBS140_1 " create init_name ," INIT" 1 constant #start_head 1 constant #start_sec 0 constant #start_cyl 0 constant #mbr_sector $00FF constant #cyl_low_mask $0300 constant #cyl_high_mask $AA55 constant #valid_tag $28 constant #volume_tag $20 constant #file_tag $00 constant first_entry $20 constant second_entry $40 constant third_entry Variable 12_bit_state Variable fat_blk_size Variable clear_rest : pos>cyl #cyl_low_mask and ; : pos>pck #cyl_high_mask and -2 shift or ; : media_0 partition_type @ IF $FFF8 ELSE $0FF8 THEN ; : media_1 partition_type @ IF $FFFF ELSE $0FFF THEN ; : time>word 6 shift + 5 shift swap 2/ + ; : date>word &1980 - 4 shift + 5 shift + ; : erase_sector_buffer dup $100 0 fill ; : write_mbr flush 1 raw_blk_size ! #mbr_sector read_block dup $E7 + $18 0 fill partition_type @ 1+ $1C2 byte>sec! #valid_tag $1FE word>sec! #start_head $1BF byte>sec! #start_sec #start_cyl pos>pck $1C0 byte>sec! #start_cyl pos>cyl $1C1 byte>sec! heads @ 1- $1C3 byte>sec! sector @ cyl @ 1- #unused_cyl - pos>pck $1C4 byte>sec! cyl @ 1- #unused_cyl - pos>cyl $1C5 byte>sec! sector @ $1C6 long>sec! par_sec $1CA long>sec! drop #mbr_sector write_block ; 2 constant #fats_cnt $200 constant #sec_bytes $FFF8 constant #media_des : write_bootsector flush 1 raw_blk_size ! sector @ read_block #boot_len $00E word>sec! #fats_cnt $010 byte>sec! #root_entr $011 word>sec! fat_sec $016 word>sec! #media_des $015 byte>sec! clu_sec @ $00D byte>sec! #valid_tag $1FE word>sec! #sec_bytes $00B word>sec! sector @ $018 word>sec! heads @ $01A byte>sec! sector @ $01C long>sec! partition_type @ 5 = IF par_sec $020 long>sec! 0 $013 word>sec! ELSE 0 $020 long>sec! par_sec $013 word>sec! THEN now $027 long>sec! drop sector @ write_block ; CODE 2dup_+_fat_count_++@ AR3 PUSH, AR2 PUSH, AR2 AR3 ADDI, fat_count AR1#LDI, NEXTD, AR1 *) AR2 LDI, 1 # AR2 ADDI, AR2 AR1 *) STI, END-CODE CODE swap_!_1+ partition_type AR0#LDI, AR0 *) R0 LDI, NZ IFD, 12_bit_state AR0#LDI, AR2 AR3 *) STI, NEXTD, AR2 POP, AR3 POP, 1 # AR2 ADDI, THEN, AR0 *) R0 LDI, AR0 *) R1 LDI, Z IFD, 1 # R1 ADDI, 3 # R1 AND, R1 AR0 *) STI, NEXTD, AR2 AR3 *) STI, AR2 POP, AR3 POP, THEN, 1 # R0 CMPI, EQ IF, &12 # AR2 LSH, AR3 *) R1 LDI, R1 AR2 OR, AR2 AR3 *++) STI, -&16 # AR2 LSH, AR2 AR3 *) STI, NEXTD, AR2 POP, AR3 POP, 1 # AR2 ADDI, THEN, 2 # R0 CMPI, EQ IF, 8 # AR2 LSH, AR3 *) R1 LDI, R1 AR2 OR, AR2 AR3 *++) STI, -&16 # AR2 LSH, AR2 AR3 *) STI, NEXTD, AR2 POP, AR3 POP, 1 # AR2 ADDI, THEN, 3 # R0 CMPI, EQ IF, 4 # AR2 LSH, AR3 *) R1 LDI, R1 AR2 OR, AR2 AR3 *) STI, NEXTD, AR2 POP, AR3 POP, 1 # AR2 ADDI, THEN, END-CODE W/BUF 1- constant W/BUF-1 : clear_eob BEGIN fat_count @ W/BUF-1 and $FF + W/BUF < IF $FF FOR 2dup + 0 swap_!_1+ NEXT fat_count @ $100 + fat_count ! ELSE 2dup + 0 swap_!_1+ fat_count increment THEN pause fat_count @ W/BUF-1 and 0= UNTIL 2drop ; : head_fat_block clear_rest off 2dup + media_0 swap_!_1+ 2dup + media_1 swap_!_1+ sys_end 3 - ?FOR 2dup_+_fat_count_++@ swap_!_1+ NEXT 2dup_+_fat_count_++@ drop fat_eof swap_!_1+ main_start sys_end - ?FOR 2dup_+_fat_count_++@ drop 0 swap_!_1+ NEXT ; : fill_fat_block clear_rest @ IF clear_eob EXIT THEN W/BUF fat_count @ + main_end 2- > IF fat_count @ main_end 1- < IF BEGIN fat_count @ $FF + main_end 2- u> 0= IF $FF FOR 2dup_+_fat_count_++@ swap_!_1+ NEXT ELSE 2dup_+_fat_count_++@ swap_!_1+ THEN fat_count @ main_end 2- u> pause UNTIL THEN fat_count @ main_end 1- = IF 2dup_+_fat_count_++@ drop fat_eof swap_!_1+ THEN clear_eob clear_rest on exit THEN BEGIN fat_count @ W/BUF-1 and $FF + W/BUF < IF $FF FOR 2dup_+_fat_count_++@ swap_!_1+ NEXT ELSE 2dup_+_fat_count_++@ swap_!_1+ THEN fat_count @ W/BUF-1 and 0= pause UNTIL 2drop ; : build_fat_block flush over alloc_block 0 fat_count @ 2 = IF head_fat_block THEN fill_fat_block ; : write_fats #blk_size partition_type @ 0= IF 3 * 4 / THEN fat_blk_size ! #fats_cnt ." ." ?FOR 12_bit_state off 2 fat_count ! fat_sectors #fats_cnt 1- r@ - fat_sec * + fat_sec build_fat_block BEGIN dup fat_blk_size @ u> IF fat_blk_size @ ELSE dup THEN >r r@ raw_blk_size ! over write_block swap r@ + swap r> - dup WHILE build_fat_block REPEAT 2drop ." ." NEXT ; : write_root_dir swap 2dup >r >r >r >r flush #root_sec raw_blk_size ! root_sectors alloc_block r> r> build_file_name dir_file_name dup #buffer_size 0 fill dup first_entry 2/ + vol_name dir_copy dup second_entry 2/ + log_name dir_copy dup third_entry 2/ + tmp_buffer dir_copy dup $03 + dup @ r> 8 shift + swap ! r> sec>date date>word dup dup >r >r >r time>word dup dup >r >r >r r> first_entry [time] word>sec! r> second_entry [time] word>sec! r> third_entry [time] word>sec! r> first_entry [date] word>sec! r> second_entry [date] word>sec! r> third_entry [date] word>sec! main_end main_start - clu_sec @ * 9 shift third_entry [size] long>sec! sys_byte @ #sys_size min second_entry [size] long>sec! main_start dup main_end = IF drop 0 THEN third_entry [clu0] word>sec! #fat_start dup sys_end = IF drop 0 THEN second_entry [clu0] word>sec! #file_tag third_entry [type] byte>sec! #file_tag second_entry [type] byte>sec! #volume_tag first_entry [type] byte>sec! drop root_sectors write_block ; : pos_list> flush fat_blk raw_blk_size ! 0 >r BEGIN dup 1- swap WHILE over fat_eof <> WHILE over >r swap fat>next fat_check swap REPEAT 2drop 0 BEGIN r> dup 0= UNTIL drop ; : copy_cluster BEGIN over ?dup pause WHILE fat>lba read_block over clu_sec @ 8 shift dup >r cmove r> + swap fat>lba free_block REPEAT 2drop ; LABEL ram_prefix AR2 *) AR1 CMPI, LO IF, 0 # AR1 LDI, RETSU, THEN, AR2 AR1 LDI, AR1 *++) AR5 LDI, 1 # AR5 SUBI, 0 # R0 LDI, DO, AR3 AR0 LDI, R0 AR0 ADDI, 1 # R0 ADDI, 1 # AR0 TSTB, NZ IFD, -1 # AR0 LSH, AR0 *) AR0 LDI, NOP, -8 # AR0 LSH, THEN, $00FF # AR0 AND, AR1 *++) R1 LDI, $20 # R1 CMPI, Z IF, $20 # AR0 CMPI, HI IF, 0 # AR1 LDI, RETSU, THEN, ELSE, $3F # R1 CMPI, NZ IF, AR0 R1 XOR, NZ IF, 0 # AR1 LDI, RETSU, THEN, THEN, THEN, AR5 LOOP, -1 # AR1 LDI, RETSU, END-CODE CODE ram_prefix? AR1 POP, AR3 PUSH, AR1 AR3 LDI, AR1 POP, ram_prefix # CALL, NEXTD, AR1 AR2 LDI, AR3 POP, NOP, END-CODE : ram_strpos? -rot dup ?FOR 3dup rot ram_prefix? IF rot drop rdrop exit THEN 1- swap 1+ swap pause NEXT rot drop ; here ," \\\ " constant drop_prefix here ," \\\ " constant drop_token : ram_no_comment 2dup drop_prefix ram_prefix? IF drop 0 exit THEN 2dup drop_token ram_strpos? 0= IF drop exit THEN nip over - ; : temp>destin rot >r dup #buffer_size $2020 fill r@ 1 AND IF over r@ 2/ + dup @ $FF and $2000 or swap ! THEN r> 1+ 2/ cmove ; : trunc_mbs_sys -rot 2/ >r IF IF ." & erasing mbs.sys" ELSE ." & creating mbs.sys" THEN r@ W/BUF $2020 fill ELSE dup W/BUF 2/ > IF ." & truncating mbs.sys" drop W/BUF 2/ ELSE dup IF ." & saving mbs.sys" ELSE ." & creating mbs.sys" THEN THEN dup 1 and IF dup $20 r@ rot byte>word! 1+ THEN 2/ dup r@ + swap W/BUF swap - $2020 fill THEN rdrop ; : move_sys_file #string log_name dir_copy pos_find #sys_sec_max clu_sec @ / pos_list> flush clu_sec @ raw_blk_size ! #max_sec buffer lock-buffer dup >r copy_cluster r> #blk_size raw_blk_size ! #fat_start fat>lba alloc_block dup >r temp>destin r> 2* #buffer_size 2* ram_asc_len ram_no_comment ram_asc_len trunc_mbs_sys #fat_start fat>lba write_block #max_sec block drop empty-buffer ; : format_drive flush over drive over identify_drive IF 4 diskerror THEN bios_mapping dup IF _SyncTime @ ELSE dos_blocks 0 read_block [SyncTime] dword@ 0 free_block THEN -rot raw_blocks IF dup move_sys_file write_mbr write_bootsector THEN write_fats write_root_dir ; variable last_mb : .last_mb dup $800 / dup last_mb @ <> IF dup last_mb ! out @ over space u. ." MB" out @ swap - backspaces THEN drop ; : repair_drive flush dup drive identify_drive IF 4 diskerror THEN bios_mapping raw_blocks last_mb on cr ." system area:" FAT_OFF 1- DUP 1+ ?FOR 1 raw_blk_size ! dup r@ - .last_mb block drop key? IF key #ctrl-C = IF cr rdrop drop EXIT THEN THEN NEXT DROP ." done. " last_mb on cr ." data area:" FAT_LEN 3 - DUP 1+ ?FOR clu_sec @ raw_blk_size ! dup r@ - 2+ FAT>LBA .last_mb block drop key? IF key #ctrl-C = IF cr rdrop drop EXIT THEN THEN NEXT DROP ." done. " last_mb on cr ." unused area:" TOTAL @ 1- DUP 1+ FAT_LEN FAT>LBA - ?FOR 1 raw_blk_size ! dup r@ - .last_mb block drop key? IF key #ctrl-C = IF cr rdrop drop EXIT THEN THEN NEXT DROP ." done. " cr ; Forth definitions empty-filters mark-time scale encode ' decimate >body _filters #filters >move : seek_back curr_drive off last_index off data_index off _disk_entry off _start_disk off _rec_resume off _last_block_off 0 drive 1 _main_size ! #DOS_VIEW _last_block_! ; : init_header _SkewTime @ 0= IF _SyncTime @ over [SyncTime] dword! _InitTime @ over [InitTime] dword! ser# @ over [SerialNr] dword! #old_data over [status_bits] ! ELSE #new_data over [status_bits] ! THEN _SkewTime @ over [SkewTime] dword! swap over [skew_offset] ! 2dup [disk_number] ! swap *file [] >dos_cnt + @ main_sec @ min #blk_size * swap [block_count] dword! ; : disk_present? *file [] >dos_cnt + @ 1 u> ; : log_skew reset_adapter scan_drives dup #no_skew = cr IF ." deviation not available" ELSE ." deviation " dup . ." ms" THEN _rec_resume @ IF message" (25) abnormal termination, filelength not adjusted" #max_blk main_sec ! drv_count ?FOR drv_count 1- r@ - >r r@ disk_present? IF r@ drive r@ cr ." unknown card " 1+ u. r@ over dos_blocks 0 read_block init_header 0 write_block dup trailer_sys_file ." maximizing file length" r@ false format_drive THEN rdrop NEXT drop ELSE curr_drive @ drv_count ?FOR drv_count 1- r@ - >r r@ disk_present? IF r@ dup drive cr 2dup < IF ." empty " 1 main_sec ! THEN 2dup = IF ." last " _main_size @ main_sec ! THEN 2dup > IF ." full " #max_blk main_sec ! THEN r@ ." card " 1+ u. drop over r@ swap dos_blocks 0 read_block init_header 0 write_block over trailer_sys_file ." adjusting file length" r@ false format_drive THEN rdrop NEXT 2drop #max_blk main_sec ! THEN #max_int sys_byte ! flush fall_asleep ; : decision_process flush raw_blocks #root_sec raw_blk_size ! root_sectors read_block dup third_entry 2/ + @ $FF and dup 0= swap $7F > OR swap third_entry [CLU0] 2/ + @ main_start <> OR #root_sec free_block ?dup ?EXIT flush dos_blocks 0 read_block [status_bits] @ #new_data = IF cr ." !!! previous recording hasn't been saved yet !!!" cr ." abort formatting " dtr? dup IF user_y/n 0= dup IF cr ." DESTROY OLD DATA " FALSE user_y/n nip THEN ELSE #morse_f led_message ! THEN ELSE TRUE THEN 0 free_block ; : lock_drives reset_adapter scan_drives #max_blk main_sec ! 3 FOR 3 r@ - disk_present? IF 3 r@ - dup cr ." card " 1+ u. dup *file [] >dos_cnt + @ #blk_size * ." capacity " 2/ u. ." KB" drive decision_process ELSE rdrop false flush fall_asleep EXIT THEN IF ." , formatting drive" 3 r@ - dup true format_drive dup #no_skew dos_blocks 0 alloc_block dup #buffer_size 0 fill #blk_size over [dir_skip] dword! init_header 0 write_block header_sys_file flush ELSE rdrop true flush fall_asleep EXIT THEN pause NEXT false flush fall_asleep ; : std_type_info _SyncTime @ split $02 meta! $00 meta! 0 $04 meta! _channels @ $06 meta! _bits @ &30 + $08 meta! 1 $0A meta! _sample_period @ $0C meta! 0 chan_gain $0E meta! 1 chan_gain $10 meta! 2 chan_gain $12 meta! 3 chan_gain $14 meta! entry_nr @ $16 meta! ser# @ split $1A meta! $18 meta! 0 split $1E meta! $1C meta! #std_type_tag #std_type_cmd put_meta_info ; : std_mesg_info now split $02 meta! $00 meta! 0 $04 meta! "message [] $06 >tmp_buffer #message_len $06 + move> #std_mesg_tag #std_mesg_cmd #message_len $06 + or put_meta_info ; : str_event_info #str_event_short put_meta_info ; : str_end_info #str_end_short put_meta_info ; : str_reset_info #str_reset_short put_meta_info ; : str_sync_info #str_sync_short put_meta_info ; : str_sec_info #str_sec_short or put_meta_info ; : passcal_coeff 0 meta@ 1+ 4 * #passcal_fd_tag #passcal_fd_cmd rot or put_meta_info ; : passcal_fd [ ' decimate >body ] Literal BEGIN count dup ['] consume xor WHILE 1- dup ['] HB136 = IF 2 coeff_halfband passcal_coeff THEN dup ['] HB1 = IF 0 coeff_halfband passcal_coeff THEN dup ['] HB2 = IF 0 coeff_halfband passcal_coeff THEN dup ['] HB3 = IF 0 coeff_halfband passcal_coeff THEN dup ['] HB4 = IF 0 coeff_halfband passcal_coeff THEN dup ['] SINGLE/2 = IF 1 coeff_decimation passcal_coeff THEN dup ['] SHARP/2 = IF 0 coeff_decimation passcal_coeff THEN drop REPEAT 2drop ; &16 Constant #name_len : tmp_copy 2dup + >r >r >tmp_buffer dup r@ BL fill swap count >r swap 2r> min cmove r> pause ; : passcal_ds total_delay off 1 [ ' decimate >body ] Literal BEGIN count dup ['] consume xor WHILE 1- rot swap dup ['] HB136 = IF 2 coeff_halfband mk_spec THEN dup ['] HB1 = IF 0 coeff_halfband mk_spec THEN dup ['] HB2 = IF 0 coeff_halfband mk_spec THEN dup ['] HB3 = IF 0 coeff_halfband mk_spec THEN dup ['] HB4 = IF 0 coeff_halfband mk_spec THEN dup ['] SINGLE/2 = IF 1 coeff_decimation mk_spec THEN dup ['] SHARP/2 = IF 0 coeff_decimation mk_spec THEN drop swap REPEAT 2drop total_delay @ swap / &1000 * samples/sec / [ &2155 &19530 * ] Literal samples/sec dup &2000 < IF drop &2000 THEN dup &5000 < IF 2* THEN / + tmp_buffer $200 bl fill 6 >r [ ' decimate >body ] Literal BEGIN count dup ['] consume xor WHILE 1- dup ['] HB136 = IF dup >name r> #name_len tmp_copy >r THEN dup ['] HB1 = IF dup >name r> #name_len tmp_copy >r THEN dup ['] HB2 = IF dup >name r> #name_len tmp_copy >r THEN dup ['] HB3 = IF dup >name r> #name_len tmp_copy >r THEN dup ['] HB4 = IF dup >name r> #name_len tmp_copy >r THEN dup ['] SINGLE/2 = IF dup >name r> #name_len tmp_copy >r THEN dup ['] SHARP/2 = IF dup >name r> #name_len tmp_copy >r THEN drop REPEAT 2drop split $04 meta! $02 meta! r@ #name_len / $00 meta! #passcal_ds_tag #passcal_ds_cmd r> or put_meta_info ; : passcal_sc "exp_number [] $000 >tmp_buffer &2 move> "exp_name [] $002 >tmp_buffer &24 move> "exp_comment [] $01A >tmp_buffer &40 move> "stat_number [] $042 >tmp_buffer &4 move> "stat_name [] $046 >tmp_buffer &24 move> "stat_comment [] $05E >tmp_buffer &40 move> "chan_name_1 [] $086 >tmp_buffer &10 move> "chan_name_2 [] $090 >tmp_buffer &10 move> "chan_name_3 [] $09A >tmp_buffer &10 move> "chan_name_4 [] $0A4 >tmp_buffer &10 move> "chan_sensor_1 [] $0AE >tmp_buffer &12 move> "chan_sensor_2 [] $0BA >tmp_buffer &12 move> "chan_sensor_3 [] $0C6 >tmp_buffer &12 move> "chan_sensor_4 [] $0D2 >tmp_buffer &12 move> "chan_sensor_nr_1 [] $0DE >tmp_buffer &12 move> "chan_sensor_nr_2 [] $0EA >tmp_buffer &12 move> "chan_sensor_nr_3 [] $0F6 >tmp_buffer &12 move> "chan_sensor_nr_4 [] $102 >tmp_buffer &12 move> "chan_comment_1 [] $10E >tmp_buffer &40 move> "chan_comment_2 [] $136 >tmp_buffer &40 move> "chan_comment_3 [] $15E >tmp_buffer &40 move> "chan_comment_4 [] $186 >tmp_buffer &40 move> #passcal_sc_tag #passcal_sc_cmd put_meta_info ; Variable next_entry Variable entry Variable next_e_drv Variable e_drv : skip_prev_sequ get_reset_disk next_entry off 0 read_block dup Dir_ptr ! fall_asleep BEGIN BEGIN next_e_drv @ e_drv ! next_entry @ entry ! curr_drive @ next_e_drv ! get_dir_entry next_entry ! entry @ 0> UNTIL next_entry @ WHILE entry @ e_drv @ *file [] >dos_cnt + @ u< 0= IF 6 diskerror THEN entry @ data_index ! entry_nr increment REPEAT drop entry @ data_index ! ; : write_header data_index @ alloc_block >dat_buffer std_type_info passcal_sc passcal_ds passcal_fd ; : write_trailer flush-adc curr_drive @ drive str_sync_info str_event_info str_end_info fill_data_block data_index @ put_dir_entry ; : resume_state dup data_index ! alloc_block >dat_buffer str_sync_info seconds @ dup str_sec_info str_sec_info str_reset_info curr_drive @ _start_disk @ <> IF dir_offset decrement entry_nr decrement 1- THEN drop ; : start_sequence _circular @ IF message" (3) circular debugging, data will be lost!" THEN ticks @ last_command ! flush skip_prev_sequ Samples 4 #invalid fill buf_state off _sec/mark @ sec/mark_val ! _rec_resume @ IF data_index @ last_index @ 1+ resume_state false ELSE curr_drive @ _start_disk ! write_header true THEN flush-erom last_command off ; : stop_sequence ticks @ last_command ! write_trailer 0 data_index @! _main_size ! flush fall_asleep _rec_resume off flush-erom burst_value off last_command off ; : led_server led_display @ led_hidden @ xor IF led_display @ dup 0= IF 0 blinkrate 0 led! THEN dup 1+ 0= IF 0 blinkrate -1 led! THEN dup 0 > IF dup blinkrate THEN 0 send_morse $80000000 xor dup led_display ! led_hidden ! THEN led_message @ 1+ IF led_message @ dup IF &15 blinkrate send_morse ELSE led_hidden @ $80000000 xor led_display ! drop THEN led_message on THEN 2 sec feed_watchdog #250ms sleep ; : halted? 'sema swap at @ -1 = ; : wdog_server escape_all @ IF 0 ELSE ticks @ 1 max THEN last_reboot ! last_access off last_command off BEGIN #100ms sleep last_reboot @ ?dup IF #max_boot + ticks @ u< IF message" (10) mbs-reboot is stuck, rebooting" err_boot THEN THEN last_reboot @ 0= UNTIL BEGIN _synctime @ adc_sec @ seconds @ over - 1 > and and IF message" (77) ADC-converter not present, rebooting" err_boot THEN buf_cnt off INT_ADC @ ADC_INT = led_server INT_ADC @ ADC_INT = AND buf_cnt @ 0= AND IF message" (77) ADC-converter not present, rebooting" err_boot THEN ticks @ last_access @ ?dup IF 2dup - nip #max_access u> IF message" (11) disk-access is stuck, rebooting" err_boot THEN THEN last_command @ ?dup IF 2dup - nip #max_command u> IF message" (12) rec-command is stuck, rebooting" err_boot THEN THEN drop adc_task halted? IF err_boot THEN disk_task halted? IF err_boot THEN sequ_task halted? IF err_boot THEN erom_task halted? IF err_boot THEN REPEAT ; #max_uns Constant #forever : depth? depth u< ; : >expect Pad 1+ swap expect Span @ Pad c! BL Pad count + c! Pad ; : stack_prompt cr #Tib @ 0= IF clear EXIT THEN depth dup 8 > IF ." ... " drop 8 THEN ?FOR r@ pick . NEXT ; : not_from_file file-load? ABORT" (55) mask can only be used from terminal" ; : add_year now sec>date swap >r >r 2drop 2drop r> over r> < - ; : $$ 1+ Pad &19 + over - 0 max bl skip drop 1- convert dup @ ?" .:/" 0= over Pad &19 + u< not or ABORT" (32) mask requires numeric input" ; : $$.$$_$$:$$:$$? &14 backspaces &14 >expect dup @ IF >r 0 0 r> $$ 3 FOR 0 swap $$ NEXT nip EXIT THEN 0= ; : $$.$$.$$_$$:$$:$$? &17 backspaces &17 >expect dup @ IF >r 0 0 r> $$ 4 FOR 0 swap $$ NEXT nip EXIT THEN 0= ; : new_time? 5 depth? ?dup ?EXIT not_from_file ." dd.mm hh:mm:ss" $$.$$_$$:$$:$$? dup ?EXIT 1 backspaces ." dd.mm hh:mm:ss" ; : new_date? 6 depth? ?dup ?EXIT not_from_file ." dd.mm.yy hh:mm:ss" $$.$$.$$_$$:$$:$$? dup ?EXIT 1 backspaces ." dd.mm.yy hh:mm:ss" ; : get_time new_time? dup 0=EXIT drop -rot swap >r >r -rot r> -rot r> -rot add_year date>sec ; : get_date new_date? dup 0=EXIT drop 3 pick >r -rot swap >r >r nip -rot r> -rot r> -rot r> dup &97 < IF &2000 ELSE &1900 THEN + date>sec ; 0 CONSTANT Elength sys 2 CONSTANT Ehere sys 3 CONSTANT Eoldhere sys : ?erom_full here 'tod @ - #maxerom u< ?EXIT true ABORT" (76) E2PROM full, use NEW to erase" ; : .license ?cr #harddisk case? IF ." hard_disk " EXIT THEN #compress case? IF ." data_compression " EXIT THEN #sediment case? IF ." HF_seismik " EXIT THEN #refraction case? IF ." refraction_seismic " EXIT THEN ." option_" . ; : .?interval ." EVERY SEC MIN FOR SEC MIN INTERVAL" ; : ?interv depth? ?EXIT .?interval abort ; : (rec_finished BEGIN false escape_all @! ABORT" (4) measurement program abandoned" key? IF key #ctrl-C = ABORT" (4) measurement program abandoned" THEN _rec_enable @ WHILE #250ms sleep REPEAT ; HF100 definitions : ?interactive ." MEASURE INTERACTIVE" cr ." returns control to the input terminal after reset." ; : interactive ; ' interactive _program ! : ?new ." erases all user definitions" ; : new _rec_enable @ ABORT" (41) NEW not while recording" [ HF100 ] ['] interactive _program ! [ FORTH ] Eoldhere syserom@ (forget ; : ?boot ." reboots and starts the last defined measurement program" ; : boot boot ; : ?measure ." MEASURE saves all user definitions in E2PROM." cr ." After reset or power on will be executed." ; : measure _rec_enable @ ABORT" (41) MEASURE not while recording" ?erom_full ' _program ! Ehere syserom@ here over - dup 0< IF 2drop ELSE bounds ?DO I @ I >erom syserom! pause LOOP THEN here Ehere syserom! here >erom Elength syserom! [ ' HF100 >body ] Literal dup @ swap >erom syserom! flush-erom evalidate empty-errors ; : ?def ." DEF ... parameters ... END-DEF" cr ." compiles a user definition under " ; : def dtr? 0<> may_sleep ! ?erom_full : postpone (rec_finished ; : ?end-def ." DEF ... parameters ... END-DEF" cr ." compiles a user definition under " ; : end-def may_sleep on postpone ; ; immediate : ?license ." LICENSE activates option N." cr ." LICENSE without parameters displays activated options." ; : license _rec_enable @ ABORT" (41) LICENSE not while recording" 3 depth? IF dup #licenses u< 0= ABORT" (33) LICENSE invalid option number" set_license evalidate flush-erom THEN #licenses 0 DO I check_license IF I .license THEN LOOP ; : ?continuous ." deletes last interval definition" ; : continuous _rec_enable @ ABORT" (41) CONTINUOUS not while recording" #max_int _every ! #max_int _for ! ; : ?every .?interval ; : every _rec_enable @ ABORT" (41) EVERY not while recording" 0 ; : ?sec .?interval ; : sec _rec_enable @ ABORT" (41) SEC not while recording" 2 ?interv + ; : ?min .?interval ; : min _rec_enable @ ABORT" (41) MIN not while recording" 2 ?interv &60 * + ; : ?for .?interval ; : for _rec_enable @ ABORT" (41) FOR not while recording" 1 ?interv 0 ; : ?interval .?interval ; : interval _rec_enable @ ABORT" (41) INTERVAL not while recording" 2 ?interv 1 [ FORTH ] max [ HF100 ] dup _for ! [ FORTH ] max [ HF100 ] _every ! ; Forth definitions : trigger_on triggeron _trigger on ; : trigger_off triggeroff _trigger off ; : rec_period? _start @ _stop @ u< now _stop @ u< and ; : rec_off now _stop ! trigger_off ; : rec_default _start off #forever _stop ! ; : (disk_full buf_adc off NOP_INT INT_ADC ! _disk_full on rec_off message" (60) disks full" ; : .stop _trigger @ IF ." external" EXIT THEN #forever _stop @ = IF ." endless" EXIT THEN _stop @ .time&date ; : .start _trigger @ IF ." external" EXIT THEN _start @ 0= IF ." immediately" EXIT THEN _start @ .time&date ; : .release now _release @ u> IF ." not active" EXIT THEN _release @ .time&date ; HF100 definitions : ?start ." START" ; : start _rec_enable @ ABORT" (41) START not while recording" 5 depth? 0= IF .start THEN trigger_off get_time ?dup 0=exit _start ! ; : ?stop ." STOP" ; : stop _rec_enable @ ABORT" (41) STOP not while recording" 5 depth? 0= IF .stop THEN trigger_off get_time ?dup 0=exit _stop ! ; : ?endless ." erases START and STOP time" ; : endless _rec_enable @ ABORT" (41) ENDLESS not while recording" rec_default ; : ?external ." activates start/stop by external trigger signal" ; : external _rec_enable @ ABORT" (41) EXTERNAL not while recording" trigger_on rec_default ; : ?release ." RELEASE" ; : release _rec_enable @ ABORT" (41) RELEASE not while recording" 5 depth? 0= IF .release THEN get_time ?dup 0=exit dup _release ! setrelease ; Forth definitions : .min.sec ?dup IF &60 /mod ?dup IF . ." min " THEN . ." sec" THEN ; : .intervall _every @ _for @ = IF ." continuous" ELSE ." Every " _every @ .min.sec ." For " _for @ .min.sec THEN ; : .program _program @ ?dup IF .name ELSE ." interactive" THEN ; : disk_capacity 0 drv_count ?FOR *file [] >dos_cnt r@ + @ 1- #blk_size * 0 max + NEXT 0 max 2/ 0 curr_drive @ ?FOR curr_drive @ 1- r@ - *file [] >dos_cnt + @ 1- #blk_size * 0 max + NEXT data_index @ _main_size @ max 1- #blk_size * + 2/ ; : select_rates dup &20 < ABORT" (34) RATE samplerate not supported" empty-filters mark-time &16 bits dup &3750 > IF scale &7500 > IF &10 encode EXIT THEN &20 encode EXIT THEN dup &1500 > IF drop single/2 clip &40 encode EXIT THEN >r hb136 &17 &100 r@ &93 < IF hb4 2* THEN r@ &187 < IF hb3 2* THEN r@ &375 < IF hb2 swap 1+ swap 2* THEN r> &750 < IF hb1 2* THEN sharp/2 swap bits clip encode ; : "word? [char] " word dup c@ ; : (experiment ("lit "exp_name &24 passcalstring ; : (comment ("lit "exp_comment &40 passcalstring ; : .channeldata "chan_name_1 [] over &11 * + .string space "chan_sensor_1 [] over &13 * + .string space "chan_sensor_nr_1 [] over &13 * + .string space "chan_comment_1 [] over &41 * + .string drop ; variable sequencer HF100 definitions Forth : settings rs232_sema lock cr ." Date & Unit " now .time&date ." " .serialnumber cr ." Synchronized " _SyncTime @ ?dup IF .time&date ELSE ." No" THEN cr ." Channels " _channels @ 1+ . ." : " samples/sec dup &62 = IF drop ." 62.5 " ELSE . THEN ." Hz, " bits/sample . ." bits" cr ." Gain " _channels @ dup FOR dup r@ - chan_gain 2* 1+ . NEXT drop cr ." Capacity " disk_capacity _SkewTime @ IF nip . ." KB data, disk closed" ELSE over swap - swap . ." KB total, " . ." remaining" THEN cr ." Start " .start cr ." Stop " .stop cr ." Interval " .intervall cr ." Release " .release cr ." Program " .program _rec_enable @ IF Sequencer @ IF ." active" ELSE ." halted" THEN THEN cr ." Experiment " "exp_name .string cr ." Comment " "exp_comment .string rs232_sema unlock ; : ?ms ." MS converts milliseconds into frequency for use with RATE." ; : ms &1000 swap / ; : ?rate ." RATE sets the effective sampling rate of the system" cr ." N may be 62, 125, 250, 500, 1000, 2500, 5000 or 10000" cr ." or 1 MS, 2 MS, 4 MS, 8 MS or 16 MS." ; : rate _rec_enable @ ABORT" (41) RATE not while recording" 1 depth? 0= ABORT" (50) RATE needs a parameter" bits/sample >r select_rates &100000 over / set_adcclk IF dup _sample_period ! [ ' decimate >body ] Literal _filters [] #filters >move FP @ _filters [] #filters + ! &10 / _sec/mark ! rdrop EXIT THEN _filters addr [ ' decimate >body ] Literal #filters cmove _filters [] #filters + @ FP ! r> bits ABORT" (46) RATE samplerate has not been licensed" ; : ?gain ." GAIN sets the preamplifier gain of to ." cr ." may be between 1 and 31." ; : gain _rec_enable @ ABORT" (41) GAIN not while recording" 2 depth? 0= ABORT" (50) GAIN needs two parameters" swap dup &31 u> ABORT" (31) GAIN range 1 to 31" 1- 0 max 2/ swap gain ; : ?channels ." <1-4> CHANNELS" ; : channels _rec_enable @ ABORT" (41) CHANNELS not while recording" 1 depth? 0= ABORT" (50) CHANNELS needs a parameter" 1- dup 3 u> ABORT" (30) CHANNELS range 1 to 4" channels ; : ?experiment ." EXPERIMENT " ; : experiment state @ IF postpone (experiment ," EXIT THEN "word? IF "exp_name &24 passcalstring EXIT THEN drop "exp_name .string ; immediate : ?comment ." COMMENT " ; : comment state @ IF postpone (comment ," EXIT THEN "word? IF "exp_comment &40 passcalstring EXIT THEN drop "exp_comment .string ; immediate HF100 definitions Vocabulary Passcal : ? words ; : ?forth only forth also definitions ; : ?passcal ." activates a sub-menue for defining PASSCAL name strings." ; Passcal definitions : exit HF100 ; : ?exit ." returns to the main menue." ; : ? words ; : ?expnumber ." ExpNumber" ; : ExpNumber _rec_enable @ ABORT" (41) ExpNumber not while recording" state @ ABORT" (54) ExpNumber can't be used in a definition" 1 depth? 0= ABORT" (50) ExpNumber needs a parameter" s>d <# # # #> uncount "exp_number [] 2 passcalstring ; immediate : ?expname ." ExpName <24-chars>" ; : ExpName _rec_enable @ ABORT" (41) ExpName not while recording" state @ ABORT" (54) ExpName can't be used in a definition" word" "exp_name &24 passcalstring ; immediate : ?expcomment ." ExpComment <40-chars>" ; : ExpComment _rec_enable @ ABORT" (41) ExpComment not while recording" state @ ABORT" (54) ExpComment can't be used in a definition" word" "exp_comment &40 passcalstring ; immediate : ?statnumber ." StatNumber sets station number" ; : StatNumber _rec_enable @ ABORT" (41) StatNumber not while recording" state @ ABORT" (54) StatNumber can't be used in a definition" 1 depth? 0= ABORT" (50) StatNumber needs a parameter" s>d <# # # # # #> uncount "stat_number [] 4 passcalstring ; immediate : ?statname ." StatName <24-chars> sets station name" ; : StatName _rec_enable @ ABORT" (41) StatName not while recording" state @ ABORT" (54) StatName can't be used in a definition" word" "stat_name &24 passcalstring ; immediate : ?statcomment ." StatComment <40-chars> sets station comment" ; : StatComment _rec_enable @ ABORT" (41) StatComment not while recording" state @ ABORT" (54) StatComment can't be used in a definition" word" "stat_comment &40 passcalstring ; immediate : ?channame ." ChanName <10-chars> sets name of channel N" ; : ChanName _rec_enable @ ABORT" (41) ChanName not while recording" state @ ABORT" (54) ChanName can't be used in a definition" 1 depth? 0= ABORT" (50) ChanName needs a parameter" 1 - 3 umin &11 * >r word" "chan_name_1 [] r> + &10 passcalstring ; immediate : ?chansensor ." ChanSensor <12-chars> sets sensor of channel N" ; : ChanSensor _rec_enable @ ABORT" (41) ChanSensor not while recording" state @ ABORT" (54) ChanSensor can't be used in a definition" 1 depth? 0= ABORT" (50) ChanSensor needs a parameter" 1 - 3 umin &13 * >r word" "chan_sensor_1 [] r> + &12 passcalstring ; immediate : ?chansensornumber ." ChanSensorNumber <12-chars> sets sensor number" ; : ChanSensorNumber _rec_enable @ ABORT" (41) ChanSensorNumber not while recording" state @ ABORT" (54) ChanSensorNumber can't be used in a definition" 1 depth? 0= ABORT" (50) ChanSensorNumber needs a parameter" 1 - 3 umin &13 * >r word" "chan_sensor_nr_1 [] r> + &12 passcalstring ; immediate : ?chancomment ." ChanComment <40-chars> sets comment for channel N" ; : ChanComment _rec_enable @ ABORT" (41) ChanComment not while recording" state @ ABORT" (54) ChanComment can't be used in a definition" 1 depth? 0= ABORT" (50) ChanComment needs a parameter" 1 - 3 umin &41 * >r word" "chan_comment_1 [] r> + &40 passcalstring ; immediate : ?passcal? ." displays setting of PASSCAL name strings" ; : passcal? RS232_sema lock cr ." Experiment number : " "exp_number .string cr ." Experiment name : " "exp_name .string cr ." Experiment comment : " "exp_comment .string cr ." Station number : " "stat_number .string cr ." Station name : " "stat_name .string cr ." Station comment : " "stat_comment .string cr cr ." Channel parameters" cr ." No Name Sensor Sensor # Comment" _channels @ 1+ 0 DO cr I 1+ 2 u.r space I .channeldata LOOP 2 spaces RS232_sema unlock ; Forth definitions : (close now _SkewTime ! log_skew [ HF100 ] ['] interactive _program ! [ Forth ] flush-erom ; &666 ms Constant #666ms : go_active str_event_info 1 sec/mark_cnt ! buf_adc on ADC_INT INT_ADC ! #250ms led_display ! true pin5! ; : go_passive NOP_INT INT_ADC ! false pin5! 0 Spill @! IF #100ms led_display ! message" (75) skipping data due to slow card" flush-adc ticks @ last_command ! save-buffers last_command off std_mesg_info THEN #666ms led_display ! flush-adc ; : interval_handling now 1+ _start @ - _every @ mod ?dup IF 1- _for @ < ELSE 1 THEN halted @ 0= and spill @ 0= and Sequencer @ 2dup <> IF 2dup -1 = swap 0= or IF go_passive Sequencer off THEN over 1 = IF dup 2 <> IF false pin5! #666ms led_display ! #666ms sleep THEN go_active 1 Sequencer ! THEN over -1 = IF dup 1- IF go_active THEN Sequencer on THEN THEN 2drop ; &100 CONSTANT boot_time : disk_prefetch curr_drive @ drive 0 block drop ; : set_mode _rec_enable @ IF _trigger @ trigger? 0= and IF 0 setstart power_down THEN _start @ now boot_time + 1+ u> IF _start @ boot_time - setstart power_down THEN ELSE _synctime @ lowbat? OR IF 0 setstart power_down THEN THEN ; : wait_for_start? #250ms sleep _rec_enable @ 0= _disk_full @ OR _SkewTime @ OR IF true EXIT THEN _trigger @ IF trigger? 0= EXIT THEN _start @ _stop @ u> IF false EXIT THEN now 2+ _start @ = IF disk_prefetch THEN now 1+ _start @ u< ; : wait_for_stop? #250ms sleep lowbat? IF escape_all on trigger_off message" (61) battery low" [ HF100 ] ['] interactive _program ! [ Forth ] false EXIT THEN _trigger @ IF trigger? EXIT THEN now _stop @ u< ; : finish_resume _disk_full @ _SkewTime @ or 0= _rec_resume @ and 0=exit start_sequence drop stop_sequence message" (21) finishing recording" ; : wait_for_start BEGIN wait_for_start? WHILE finish_resume false rw_button 0<> _SyncTime @ and IF message" (7) control-pin active, executing SKEW" rec_off print-errors #morse_w led_message ! BEGIN led_message @ 1+ WHILE pause REPEAT cr ." waiting for a synchronisation pulse..." adc_sec off (watchdog link_watchdog skew 2 sec feed_watchdog my_(watchdog link_watchdog init_seconds #100ms led_display ! (close led_display on #morse_o led_message ! cr THEN may_sleep @ dtr? 0= and IF set_mode THEN REPEAT ; : wait_for_stop halted off spill off 2 sequencer ! interval_handling BEGIN wait_for_stop? WHILE interval_handling true rw_button IF message" (6) control-pin active, executing END" rec_off THEN REPEAT halted on interval_handling ; Semaphor kick_sequ : sequencing dos_blocks kick_sequ wait BEGIN #250ms sleep flush-erom wait_for_start rec_period? IF #100ms led_display ! start_sequence 0= IF message" (20) resuming recording" THEN wait_for_stop #100ms led_display ! stop_sequence led_display on ELSE fall_asleep THEN _circular off _trigger @ _rec_enable ! rec_default REPEAT ; : reset_sequ_task Sequ_task cancel Sequ_task roundrobin spawn sequencing ; : booting_done last_reboot off kick_sequ signal ; LABEL prefix AR2 *) AR1 CMPI, LO IF, 0 # AR1 LDI, RETSU, THEN, AR2 AR1 LDI, AR1 *++) AR5 LDI, 1 # AR5 SUBI, 0 # R0 LDI, DO, AR3 AR0 LDI, R0 AR0 ADDI, 1 # R0 ADDI, AR0 *) AR0 LDI, AR1 *++) R1 LDI, $20 # R1 CMPI, Z IF, $20 # AR0 CMPI, HI IF, 0 # AR1 LDI, RETSU, THEN, ELSE, $3F # R1 CMPI, NZ IF, AR0 R1 XOR, NZ IF, 0 # AR1 LDI, RETSU, THEN, THEN, THEN, AR5 LOOP, -1 # AR1 LDI, RETSU, END-CODE CODE prefix? AR1 POP, AR3 PUSH, AR1 AR3 LDI, AR1 POP, prefix # CALL, NEXTD, AR1 AR2 LDI, AR3 POP, NOP, END-CODE : strpos? -rot dup ?FOR 3dup rot prefix? IF rot drop rdrop exit THEN 1- swap 1+ swap pause NEXT rot drop ; : no_comment 2dup drop_prefix prefix? IF drop 0 exit THEN 2dup drop_token strpos? 0= IF drop exit THEN nip over - ; CODE ASC_LEN 1 # AR2 CMPI, 1 # AR2 SUBI, HS IF, DO, AR3 AR0 LDI, AR2 AR0 ADDI, AR0 *) AR0 LDI, $20 # AR0 CMPI, HI IF, 1 # AR2 ADDI, NEXT, THEN, AR2 LOOP, THEN, 0 # AR2 LDI, NEXT, END-CODE : calluna_lowpower reset_adapter scan_drives 3 FOR 3 r@ - disk_present? IF 3 r@ - set_adapter WAKE_UP PCMCIA LOCK $74 PCM_IO_SCR ! $AA PCM_IO_SNR ! $17 PCM_IO_CYLL ! $33 PCM_IO_CYLH ! $00 PCM_IO_DHR ! $88 PCM_IO_CMD ! BEGIN pause PCM_IO_STAT @ #BUSY AND 0= UNTIL PCMCIA UNLOCK FALL_ASLEEP THEN NEXT ; : calluna_normal reset_adapter scan_drives 3 FOR 3 r@ - disk_present? IF 3 r@ - set_adapter WAKE_UP PCMCIA LOCK $74 PCM_IO_SCR ! $AA PCM_IO_SNR ! $17 PCM_IO_CYLL ! $00 PCM_IO_CYLH ! $00 PCM_IO_DHR ! $88 PCM_IO_CMD ! BEGIN pause PCM_IO_STAT @ #BUSY AND 0= UNTIL PCMCIA UNLOCK FALL_ASLEEP THEN NEXT ; : evaluate_sys_file reset_sequ_task flush scan_drives #STRING LOG_NAME DIR_COPY RAW_BLOCKS pad heap over - dos_load flush fall_asleep dup IF _rec_resume off _rec_enable off THEN dup IF message" (2) loading MBS.SYS-file" asc_len dup ." ( " . no_comment asc_len dup ." bytes / " . ." code )" booting_done Forth also HF100 evaluate previous HF100 ELSE 2drop booting_done THEN ; : (rec _SkewTime @ ABORT" (45) REC disks have been closed" _disk_full @ ABORT" (60) REC disks full" _start @ 0= IF now _start ! THEN _rec_enable on may_sleep on (rec_finished ; : (format now _InitTime ! #100ms led_display ! dtr? 0<> may_sleep ! _SkewTime off calluna_lowpower lock_drives kick_sequ signal led_display on drv_count 0= over or _SkewTime ! ABORT" (51) FORMAT no disk(s) inserted" drv_count 0= ABORT" (52) FORMAT can't format any disks" seek_back _disk_full off empty-errors drv_count cr u. ." card(s) locked for recording." ; : .dcf77_pin cr ." using the signal on the auxiliary input plug" cr ." pin-3 active_low, pin-10 active_high" ; HF100 definitions : ?rec ." activates MBS for recording." ; : rec State @ IF postpone (rec EXIT THEN _rec_enable @ ABORT" (41) REC not while recording" _SyncTime @ 0= ABORT" (40) REC not synchronized" _SkewTime @ ABORT" (45) REC disks have been closed" _disk_full @ ABORT" (60) REC disks full" _start @ 0= IF now _start ! THEN _rec_enable on may_sleep on ; immediate : ?halt ." halts recording of data temporarily." ; : halt _rec_enable @ 0= ABORT" (42) HALT use only while recording" halted @ ABORT" (43) HALT use only after resume" halted on ; : ?resume ." resumes recording of data temporarily." ; : resume _rec_enable @ 0= ABORT" (42) RESUME use only while recording" halted @ 0= ABORT" (44) RESUME use only after halt" halted off ; : ?end ." terminates data recording." ; : end State @ ?EXIT _rec_enable @ 0=exit rec_off BEGIN PAUSE _rec_enable @ 0= UNTIL ; immediate : ?repair ." repairs sectors with CRC-Errors on PCM-Flash-cards" ; : repair _rec_enable @ ABORT" (41) REPAIR not while recording" _SyncTime @ ABORT" (47) REPAIR not while synchronized" 1 depth? 0= ABORT" (50) REPAIR needs a parameter" 1- dup 3 u> ABORT" (30) REPAIR range 1 to 4" reset_sequ_task reset_adapter scan_drives dup disk_present? 0= ABORT" (51) REPAIR no disk(s) inserted" cr ." press CTRL-C to abort." #100ms led_display ! repair_drive led_display on flush fall_asleep kick_sequ signal ; : ?synchronize ." ( day month year hour minute second ] SYNCHRONIZE" cr ." sets time and date and waits for a synchronisation pulse" .dcf77_pin cr ." and formats cards" ; : synchronize _rec_enable @ ABORT" (41) SYNCHRONIZE not while recording" get_date ?dup 0=exit reset_sequ_task adc_sec off dup _SyncTime ! settime #morse_w led_message ! Seconds off cr ." waiting for a synchronisation pulse..." BEGIN Seconds @ pause UNTIL ." synchronized" init_seconds (format #morse_o led_message ! ; : ?dcf77 ." synchronizes the clock and sets time and date" .dcf77_pin cr ." and formats cards" ; : dcf77 _rec_enable @ ABORT" (41) DCF77 not while recording" reset_sequ_task adc_sec off #morse_w led_message ! dcf77_init cr ." synchronized " #morse_s led_message ! wait_59th ." time and date: " dcf77_exec init_seconds (format #morse_o led_message ! ; : ?format ." formats cards, cards with the same synchronisation time can't be " cr ." distinguished later on!" ; : format _rec_enable @ ABORT" (41) FORMAT not while recording" _SyncTime @ 0= ABORT" (40) FORMAT not synchronized" reset_sequ_task (format #morse_o led_message ! ; : ?close ." closes storage cards without writing a skew value." ; : close _rec_enable @ ABORT" (41) CLOSE not while recording" reset_sequ_task #no_skew #100ms led_display ! (close led_display on kick_sequ signal #morse_o led_message ! ; Forth definitions CODE wait_for_sec IE PUSH, ETINT0 # IE LDI, T1CTRL SPLIT # AR1 LDI, $010 # AR1 LSH, # AR1 OR, SECFLAG #) AR0 LDI, BEGIN, (WATCHDOG # CALL, SECFLAG #) AR0 LDI, #SECFLAG # AR0 TSTB, NZ UNTIL, AR2 AR1 *) STI, 0 # IE LDI, NOP, NOP, NEXTD, IE POP, AR3 AR2 LDI, AR3 POP, END-CODE : patch_skew -1 T1PERIOD ! BEGIN $02C2 wait_for_sec SETDCFINT $0202 wait_for_sec XF1@ 3 sleep XF1@ and 3 sleep XF1@ and SETSECINT UNTIL T1CTR @ &4800 /MOD SWAP &2399 > - &1000 MOD DUP &500 > 0=EXIT &1000 - ; HF100 definitions : ?skew ." displays and writes clock skew to disks" ; : skew _rec_enable @ ABORT" (41) SKEW not while recording" _SyncTime @ 0= ABORT" (40) SKEW not synchronized" reset_sequ_task cr print-errors #morse_w led_message ! BEGIN led_message @ 1+ WHILE pause REPEAT cr ." waiting for a synchronisation pulse..." adc_sec off (watchdog link_watchdog patch_skew 2 sec feed_watchdog my_(watchdog link_watchdog init_seconds #100ms led_display ! (close led_display on calluna_normal kick_sequ signal #morse_o led_message ! ; : ?drift ." displays clock skew only" ; : drift _rec_enable @ ABORT" (41) DRIFT not while recording" _SyncTime @ 0= ABORT" (40) DRIFT not synchronized" cr ." waiting for a synchronisation pulse..." adc_sec off (watchdog link_watchdog patch_skew 2 sec feed_watchdog my_(watchdog link_watchdog init_seconds cr ." deviation " . ." ms" ; Forth : ?load ." MBS.SYS file" ; : load _rec_enable @ ABORT" (41) LOAD not while recording" state @ ABORT" (54) LOAD can't be used in a definition" not_from_file _rec_enable @ ABORT" (41) LOAD not while recording" reset_adapter 0 card_present? 0= ABORT" (53) LOAD insert card in slot #1 first" evaluate_sys_file ; Forth definitions variable show_zero variable show_adju variable show_shift variable show_offs : init_var get_disk_dir off block_alert off burst_value off data_index off curr_drive off last_index off last_pointer off Buf_adc off sequencer off halted on 1 raw_blk_size ! #max_int sys_byte ! #max_blk main_sec ! buf_show on buf_in off buf_out off may_sleep on led_display on led_message on led_hidden off show_zero off show_adju off show_shift off show_offs off &591 pixels ! ; : init_nv_disk _last_block_off _disk_entry off _start_disk off _rec_resume off _disk_full off _SkewTime on 1 _main_size ! ; : init_nv_var init_nv_disk _ADC_controls off _ADC_controls [] 1 + off _ADC_controls [] 2 + off _ADC_controls [] 3 + off -&14 _bits ! 1 _sec/mark ! #max_int _for ! #max_int _every ! #forever _stop ! _start off _channels off _rec_enable off _release off _trigger off _boot_delay off _SyncTime off _InitTime off _circular off #sediment check_license IF &10000 [ HF100 ] rate [ FORTH ] ELSE #refraction check_license IF &1000 [ HF100 ] rate [ FORTH ] THEN THEN empty-errors [ HF100 ] ['] interactive _program ! [ FORTH ] Eoldhere syserom@ (forget flush-erom ; : evaluate_cards dos_blocks skip_prev_sequ curr_drive @ lock_device data_index @ dup 1- block_alert @ = IF _disk_full on dup _main_size ! ELSE dup block_range @ = IF get_disk_dir on entry_nr @ disk_entry ! ELSE dup _main_size ! THEN THEN drop curr_drive @ dup drive _start_disk ! _SkewTime off _rec_resume off offset @ write_log ; : repair_state reset_sequ_task buf_adc off NOP_INT INT_ADC ! flush-adc flush led_display on data_index @ IF stop_sequence THEN Adc_task cancel init_var init_nv_disk scan_drives _SkewTime @ IF 3 FOR 3 r@ - >r r@ disk_present? IF r@ cr ." card " 1+ u. ." restoring information" r@ true format_drive r@ 0= IF evaluate_sys_file THEN r@ header_sys_file r@ #no_skew dos_blocks 0 read_block init_header 0 write_block flush THEN rdrop NEXT THEN evaluate_cards message" (23) settings restored, rebooting" err_boot ; $0000 Constant #year $0100 Constant #month $0200 Constant #day $0300 Constant #hour $0400 Constant #min $0500 Constant #sec $0d00 Constant #channels $0e00 Constant #rate_hi $0f00 Constant #rate_lo $2000 Constant #monitor $2100 Constant #clear_text $2200 Constant #reset_ega : send-word $A5 ctx wsplit swap ctx ctx ; : code_cmd 2* 1 or ; : code_data -2 and ; : CodeWord wsplit >r swap r> or code_cmd send-word or code_cmd send-word ; : CodeByte $ff and or code_cmd send-word ; : send-time now sec>date &1900 - #year swap CodeByte #month swap CodeByte #day swap CodeByte #hour swap CodeByte #min swap CodeByte #sec swap CodeByte ; : send-header #clear_text 0 CodeByte #reset_ega 0 CodeByte #channels _channels @ 1+ CodeByte #rate_lo #rate_hi samples/sec CodeWord #monitor over CodeByte ; variable buf_own : modify_gain show_shift @ + 0 max bits/sample 2- min show_shift ! ; : toggle_adju show_adju @ 0= show_adju ! 0 0 BEGIN swap over buf_base + @ + swap 1+ dup pixels @ 1- > UNTIL drop 6 ashift pixels @ / 6 ashift show_offs ! ; : toggle_zero show_zero @ 0= show_zero ! ; : ctrl-c? True dtr? 0=EXIT 0= key? 0=EXIT drop key dup [char] + = IF 1 modify_gain THEN dup [char] - = IF -1 modify_gain THEN dup &13 = IF toggle_zero THEN dup bl = IF toggle_adju THEN dup &9 = IF show_shift off show_zero off show_adju off THEN #ctrl-C = ; : view_screens show_zero off show_adju off show_shift off show_offs off buf_base pixels @ 0 fill 0 modify_gain BEGIN buf_in off buf_out off buf_own off send-time 0 BEGIN BEGIN pause buf_own @ buf_in @ < UNTIL ctrl-c? IF drop exit THEN buf_own @++ buf_base + @ dup >r 8 ashift show_offs @ dup -&11 ashift 1+ 2/ - r> + show_offs ! show_adju @ IF show_offs @ -3 ashift 1+ 2/ - THEN &8 bits/sample - show_shift @ + ashift show_zero @ IF buf_own @ 1 and 0= and THEN $7fff min -$8000 max code_data send-word 1+ dup pixels @ 1- > UNTIL drop REPEAT ; : eval_pixel_width &591 pixels ! 0 0 >r BEGIN key? WHILE rdrop key >r r@ #ctrl-C = IF rdrop drop exit THEN r@ &10 = IF rdrop #pixels_max min pixels ! exit THEN r@ $2F > WHILE r@ $40 < WHILE &10 * r@ $30 - + REPEAT rdrop drop ; &1000 ms Constant #1sec : ShowData _rec_enable @ 0= swap over IF reset_sequ_task ADC_INT INT_ADC ! THEN #esc ctx ." \show" cr #1sec sleep eval_pixel_width send-header pixels @ 1+ buf_len ! _channels @ 1+ swap - buf_show ! view_screens buf_show on buf_in off buf_out off #1sec sleep IF NOP_INT INT_ADC ! flush-adc kick_sequ signal THEN ; hf100 definitions : ?show ." SHOW channel (use only with MBSEGA client)" ; : show dtr? 0=EXIT 1 depth? 0= ABORT" (40) SHOW needs a parameter" dup 1- dup 3 u> ABORT" (30) SHOW range 1 to 4" _channels @ u> ABORT" (56) SHOW channel not active" ." press CTRL-C to finish." ShowData ; forth definitions Constant #version : forget-application ." found valid update, erasing old firmware" empty-erom boot ; : .who ." MBS-FIRMWARE " ; : link_server ['] (disk_full 'disk_full ! [ HF100 ] ['] settings 'settings ! [ Forth ] ['] std_fall_asleep IS fall_asleep ['] std_wake_up IS wake_up ['] pcmcia_r/w IS r/w ['] pcmcia_diskerror IS diskerror #lowbatflag intenable ; : set_register _SyncTime @ 0= IF rec_default _rec_enable off seconds off 0 setrelease THEN my_tickerint tint0 ! nop_int int_adc ! init_seconds fall_asleep adcq_empty samples/sec set_adcclk drop _filters addr [ ' decimate >body ] Literal #filters cmove _filters [] #filters + @ FP ! _channels @ channels setsecint 1 cts! dos_blocks ; : init_tasks disk_task Priority spawn server [ nexttask disk_task at ] Literal [ 'pause disk_task at ] Literal ! pause adc_task disk_task spawn sampling pause sequ_task RoundRobin spawn sequencing ; : boot_message decimal cr .WHO ." VER_" #version .VERSION #date .DATE .COPYRIGHT cr watchdog? IF ." boot " ELSE ." cold " THEN .TIME ; : message_queue dtr? 0=exit escape_all @ ?exit _rec_enable @ 0= errors? and IF cr print-errors cr ." empty message queue" False boot_y/n IF empty-errors THEN THEN ; : mbs Only Forth Status off ['] stack_prompt is prompt only previous HF100 also definitions ; : seek_curr_block _last_block_@ /drive dup curr_drive ! *file [] >dos_off + @ - #blk_size / last_index ! ; : escape_nv_delay? escape_all off true key? 0=exit not key bl = 0=exit message" (0) space-key detected" cr ." abort escape-boot-sequence (recommended) " TRUE boot_y/n ?exit cr ." ERASE MBS-STATE (all user-configuration) " FALSE boot_y/n 0=exit escape_all on init_nv_var ; : perform_nv_delay escape_all @ IF drop exit THEN _boot_delay @ 0= IF drop exit THEN _boot_delay @ $100 = over and IF message" (5) unrecoverable error, shutdown" _boot_delay off _rec_enable off 0 setstart power_down THEN _boot_delay @ 2* 2* message" (24) boot_delay" ?FOR #250ms sleep key? IF key 2drop false THEN dup 0= IF ." skipped" drop rdrop EXIT THEN NEXT drop ; : user_program? _program @ dup 0=EXIT [ HF100 ] ['] interactive [ FORTH ] = 0= ; : init #romversion &270 = IF $4000 $883879 ! $0100 $883887 ! $0040 $883895 ! THEN init-buffers #max_int buffers drop ['] quit 'unknown ! init_name dup count 1+ nip token swap cmove escape_nv_delay? perform_nv_delay init_var wdog_task RoundRobin spawn wdog_server pause #max_boot 2* sec feed_watchdog my_(watchdog link_watchdog link_server set_register init_tasks boot_message message_queue mbs 0 escape_all @! IF booting_done quit THEN escape_all @ 0= _boot_delay @ and $080 = IF message" (22) trying to restore settings" repair_state THEN seek_curr_block true rw_button IF booting_done quit THEN _SyncTime @ 0= 0 card_present? and IF evaluate_sys_file quit THEN booting_done user_program? IF cr .program ." started" _program @ execute cr .program ." finished" [ HF100 ] ['] interactive _program ! [ Forth ] THEN quit ; autoboot init init_nv_var boot