CON ' Ray, Peter, this little 'Load new ROM' routine rewrites the built-in ' ..16KB ROM with what is being assembled into $FC000..$FFFFF. After ' ..running it, you'll have a new ROM. To update the ROM image again, ' ..you'll need to power-cycle the FPGA board to get it to reload the ' ..original image which permits loading the whole 1024KB again. {{ *********************** CHANGELOG ************************** '' RR20180512 v134a Combine: ROM_Booter v33d, LSD_v133i, SD2_133jx, TAQOZ BOOTROM(7) '' CG20180513 c Update booter '' RR20180513 c_001 Use booter's ao baud value for Monitor '' 002 Disable interrupts and smart pins on P0 & P1, but don't stop uart '' v134d '' ef Cmd_G coginit if addr $FC000, clockmax=200MHz, add nops/waitx to sendrecv '' may want to change the SD fail destination??? PJ20180514 V134e Implement buffered serial interrupts ^D from TAQOZ switches to DEBUGGER Add LF to LMM DEBUGGER (CRLF is standard line ending) '' RR20180515 v135b Add LF in other places; SD cogstop on failure '' cd Add load SD file "R"UN; SDinit to check for pullup '' e use "." in R as 8.3; add hubset #1 before cogstop '' f if Sd fails, jmp to shut_down in booter, now does cogid/cogstop '' parse R '' g add Chip's latest booter '' h Chip's latest; rearrange; remove delay1ms in serialinit & taqoz PBJ180516 v136 Adding in high level SD support, not complete but has virtual SD memory layer. Can load in full version of Tachyon with SD support using Ray's SD loader TAQOZ will reboot if four ESCs are entered in sequence (usually I use break detect) BIG BUG NOTICE!!! SD fail should not stop cog as application may be on Flash - Check Flash before SD '' RR20180516 v136c fix in _HubRxString; push/pop around pa use in _SDcard_Init; reset at _start_sdcard ??? '' RR20180517 v136d move and fname+2 ##$00FFFFFF from _Run_SDfile to search_dir '' use _str_hdg in _HubList (and for TAQOZ) '' remove reset_pins call in _Start_SDcard '' e _str_hdg add _str_dash; delay before calling taqoz '' f _HubList extra space ea 4 bytes '' RR20180519 v136m combine ROM_Booter_base_v32g; if SD fails boot,jmp #try_serial; Peter to add latest TAQOZ '' _str_hdg has dump header '' + tweek for P2ASM compiler; alignl long alignment after _str_hdg; _parsehex skip "_" 138PBJ Combine 137PBJ a remove delay1ms before monitor calls taqoz; jmp to _Enter_TAQOZ; remove _str_hdg Need to: Cmd_G use hubset ##$1000_0000 for FC000 +delay1ms (done) Taqoz to monitor needs to shutdown cogs Monitor to taqoz calls entry_taqoz and no 1ms delay (done) reset_booter ??? ???? Command9 needs to respect lmm_bufad not ##_HUBBUF ??? _HUBBUF use ROM (FC000 ???) (done) Cmd_X hex mode monitor/list option (done) "X" remove heading (done) SD add write sector ??? no space! monitor to repeat list (done) on its own??? '' RR20180520 138b command8 reply1=05 missing wz '' LL command replaces X (done) '' c add write_sector, command24, writeblock not verified!! '' overflowed ROM so use $FC000 for _HUBBUF '' d try to repeat list for next addr '' make G a call instead of a jump '' e tweeks to SD '' comment out write sd '' cmd_r result "="/"!"for passed/failed '' f mod _start/load/run_SDcard '' ##hubdata use _hubdata '' RR20180524 139 include ROM_Booter_base_138f.spin2 & RR139a (X) '' 139C w Chip pasted code ''----------------------------------------------------------------------------- '' 140_a List uses xxxxx: was xxxxx- '' R & L, List L[L] --> M[L] '' _e List xxxxx- does not require L/M '' _f use decod for PTN_SECCLU (needs TAQOZ 140e !!!) '' _g add TAQOZ 140F '' _gx remove unused labels fail etc '' _hx reorg SD routines '' RR20180526 140i proposed final SD & Monitor '' k fix SD timeout for dead/missing SD card w pullup. CMD0=10ms@35MHz '' RR20180527 v141 proposed final SD & Monitor '' PBJ20180527 Added SD and FAT32 routines **************************************************************** }} ' ' ' Load new ROM and wait for next reset ' dat org loc ptra,#$FC000 'ready to enter new data into rom .lp rdbyte byte_data,ptra++ 'get new rom byte setbyte rom_write,byte_data,#2 'install into command hubset rom_write 'do rom write command add rom_write,#1 'inc address in command djnz byte_count,#.lp 'loop until 16KB loaded into rom jmp #$ 'wait for reset rom_write long $30000000 'rom write command byte_count long $4000 'number of rom bytes byte_data res 1 'byte buffer '**************************************** '* * '* Propeller 2 ROM Booter * '* * '* 5/28/2018 - v32i * '* * '**************************************** CON ver = "A" 'Prop123-A9 / BeMicro-A9, 8 cogs, 64 smart pins ' ver = "B" 'DE2-115 ' ver = "C" 'DE0-Nano / DE0-Nano Bare ' ver = "D" 'BeMicro-A2 ' ver = "E" 'Prop123-A7 ' ver = "F" 'Prop123-A9 / BeMicro-A9, 16 cogs, 12 smart pins rx_pin = 63 'pin serial receiver tx_pin = 62 'pin serial transmitter spi_cs = 61 'pin SPI memory select (also sd_ck) spi_ck = 60 'pin SPI memory clock (also sd_cs) spi_di = 59 'pin SPI memory data in (also sd_di) spi_do = 58 'pin SPI memory data out (also sd_do) rx_ths = 1 'pin autobaud time high states rx_tne = 0 'pin autobaud time negative edges cog_spi = $000 'cog SPI program start cog_start = $100 'cog code start cog_base64 = $180 'cog base64 start lut_buff = $000 'lut serial receive buffer lut_btop = $00F 'lut serial receive buffer top lut_start = $010 'lut code start spi_ok = 0 'bit flags cmd_on = 1 ser_no = 2 rc_max = 30_000_000 'max frequency of RC oscillator DAT ' ' '******************************************* '* Cog init - overwritten by SPI program * '******************************************* ' orgh $FC000 org ' ' ' Seed xoroshiro 128** using delta-sigma ADC bits from calibration mode ' wrpin ##$00100000,#rx_pin 'put rx pin in adc gio calibration mode mov x,#50 'ready to seed 50 times with 31 bits .seed rep #2,#31 'get 31 bits (31*4 clocks = 124/20 = ~6us) testp #rx_pin wc rcl y,#1 bith y,#31 'seed via hubset hubset y djnz x,#.seed wrpin #0,#rx_pin 'return rx pin to normal mode ' ' ' Move code into position ' setq #cog_end-cog_code-1 'move cog code into position rdlong cog_start,##@cog_code setq2 #lut_end-lut_code-1 'move lut code into position rdlong lut_start,##@lut_code ' ' ' Make 256-byte base64 lookup table ' setq #$FF>>2 'reset table in hub wrlong ##$FFFFFFFF,#0 callpa #"A",#fill26 '"A".."Z" --> $00..$19 callpa #"a",#fill26 '"a".."z" --> $1A..$33 mov x,#10 '"0".."9" --> $34..$3D callpa #"0",#fill wrbyte #$3E,#"+" '"+" --> $3E wrbyte #$3F,#"/" '"/" --> $3F setq #$FF>>2 'load table into cog rdlong cog_base64,#0 ' ' ' If pull-up on spi_di then try serial ' callpa #spi_di,#check_pullup if_c jmp #reset_serial ' ' ' If pull-up on spi_cs then try to load from SPI memory ' callpa #spi_cs,#check_pullup if_c jmp #try_spi ' ' ' If pull-up on spi_ck (also sd_cs) then try to load from SD card ' callpa #spi_ck,#check_pullup if_c jmp #@_start_sdcard ' ' ' If no pull-down on spi_di then try serial ' jmp #try_serial ' ' ' Try to load from SPI memory ' try_spi drvh #spi_cs 'drive spi_cs high drvl #spi_ck 'drive spi_ck low neg pb,#1 'set command bits to all 1's drvh #spi_do 'drive spi_do high in case quad/dual mode callpa #2,#spi_cmd 'send exit-quad command callpa #8,#spi_cmd 'send exit-quad command callpa #16,#spi_cmd 'send exit-dual command fltl #spi_do 'float spi_do callpb #$66,#spi_cmd8 'send reset-enable command callpb #$99,#spi_cmd8 'send reset command waitx ##rc_max/20_000 'wait 50us callpb #$04,#spi_cmd8 'send write-disable command to clear WEL .wait callpb #$05,#spi_cmd8 'send read-status command call #spi_in 'get status testbn x,#1 wz 'if WEL high, no SPI memory (z=0) if_nz jmp #.fail testbn x,#0 wz 'if BUSY high, wait for erase/write to finish if_nz jmp #.wait mov pa,#32 'send read-from-start command callpb #$03,#spi_cmd decod y,#10 'ready to input $400 bytes from SPI wrfast #0,#0 'ready to write bytes to hub .data call #spi_in 'get byte wfbyte x 'store byte into hub djnz y,#.data 'loop for next byte (y=0 after) rdfast #0,#0 'ready to read longs from hub rep @.sum,#$100 'ready to read and sum $100 longs rflong z 'read long add y,z 'sum long .sum cmp y,csum wz 'verify checksum, z=1 if okay bitz flags,#spi_ok 'if program verified, set spi_ok flag .fail ' ' ' If SPI failed, check for pull-up on spi_ck (also sd_cs) ' if_nz callpa #spi_ck,#check_pullup 'if no SPI program, check for pull-up on spi_ck (also sd_cs) if_nz_and_c jmp #@_start_sdcard 'if no SPI program and pull-up on spi_ck, try to load from SD card jmp #try_serial 'try serial ' ' ' Fill table ' fill26 mov x,#26 'ready to fill "A".."Z"/"a".."z" entries fill wrfast #0,pa 'set table pointer rep @.v,x 'fill entries with ascending values wfbyte .v add .v,#1 .v _ret_ cmp 0,#0 'bottom byte used as a counter fit cog_start 'make sure below cog code ' ' '************** '* Cog code * '************** ' org cog_start cog_code ' ' ' Try serial if no pull-down on spi_di ' else, run SPI program if valid or float SPI pins and shut down ' try_serial testb flags,#spi_ok wz 'SPI program? if_nz fltl #spi_cs 'if no SPI program, float SPI pins if_nz fltl #spi_ck if_z setq #$FF 'if SPI program, move it into cog $000..$0FF if_z rdlong 0,#0 drvh #spi_di 'check pull-down on spi_di, leave floating callpa #spi_di,#check_pulldn 'c=0 if pull-down if_nc jmp #serial_done 'if pull-down on spi_di, boot if SPI okay (z=1) or shut down jmp #reset_serial 'else try serial ' ' ' Check pin pull-up ' check_pullup drvl pa 'drive pin low check_pulldn waitx #30*1 'wait >1us fltl pa 'float pin waitx #30*5 'wait >5us _ret_ testp pa wc 'sample pin ' ' ' SPI long/byte out ' spi_cmd8 mov pa,#8 'ready to send 8 bits spi_cmd drvh #spi_cs 'cs pin high rol pb,#24 'msb-justify byte drvl #spi_cs 'cs pin low .out rol pb,#1 wc 'get bit to send drvc #spi_di 'drive data-in pin to bit drvh #spi_ck 'drive clock pin high drvl #spi_ck 'drive clock pin low _ret_ djnz pa,#.out 'loop to output bits, return when done ' ' ' SPI byte in ' spi_in rep @.in,#8 'ready to input a byte drvh #spi_ck 'drive clock pin high drvl #spi_ck 'drive clock pin low testp #spi_do wc 'sample data-out pin ('testp' is from before 'drvh') rcl x,#1 'save data bit .in ret ' ' ' Autobaud ISR - detects initial "> " ' ' falls |--7---| ' $3E --> ..10011111001..10000001001.. ' highs |-5--| ' autobaud_isr rdpin a0,#rx_tne '2 get fall-to-fall time (7x if $3E) rdpin a1,#rx_ths '2 get high time (5x if $3E) cmpr a0,limit wc '2 make sure both measurements are within limit if_nc cmpr a1,limit wc '2 scas a0,norm0 '2 if they are within 1/35th of each other, $3E if_nc cmpr a1,0 wc '2 scas a1,norm1 '2 if_nc cmpr a0,0 wc '2 if_c reti1 '2/4 if not $3E, exit resi1 '4 got $3E, resume on next interrupt akpin #rx_tne '2 acknowledge pin mul a0,baud0 '2 compute baud rate setbyte a0,#7,#0 '2 set word size to 8 bits wxpin a0,#rx_pin '2 set receiver baud rate and word size wxpin a0,#tx_pin '2 set transmitter baud rate and word size resi1 '4 resume on next interrupt dirh #rx_pin '2 enable receiver before next start bit wrpin mtpe,#rx_tne '2 change rx_tne to measure positive edges setse1 #%110<<6+rx_pin '2 set se1 to trigger on rx_pin high resi1 '4 resume on next interrupt ' ' ' Receiver ISR - detects maintenance ">" chrs ' ' rises |--7---| ' $3E --> ..10011111001.. ' rdpin a1,#rx_tne '2 get rise-to-rise time (7x if $3E) rdpin a2,#rx_pin wc '2 get received chr shr a2,#32-8 '2 shift to lsb justify cmp a2,#">" wz '2 autobaud chr? if_nz wrlut a2,head '2 if not, write byte to circular buffer in lut if_nz incmod head,#lut_btop '2 ..increment buffer head if_nz reti1 '2/4 ..exit mul a1,baud0 '2 autobaud chr, compute baud rate setbyte a1,#7,#0 '2 set word size to 8 bits wxpin a1,#rx_pin '2 set receiver baud rate and word size wxpin a1,#tx_pin '2 set transmitter baud rate and word size reti1 '4 exit limit long $58E4 'count limit ($58E4 = 1.3889, keeps SCAS within $7FFF w/norm1) norm0 long $41D4*5/7 'fall-to-fall normalization factor norm1 long $41D4*7/5 'high-time normalization factor ($41D4 = 1.0 + 1/(7*5)) baud0 long $1_0000/7 '7x baud computation factor ' ' ' Constants / initialized variables ' timeout_per long rc_max/10 '100ms timeout for serial receive timeout_cnt long 600 '60s timeout for serial completion mtxf long %111<<11+%01_11110_0 'asynchronous serial transmit, float on high mths long %0_110_0_000<<24+%00_10001_0 'time high states on pin[-2] (pin 63 in case of pin 1) mtne long %1_111_1_111<<24+%00_10011_0 'time neg edges on pin[-1] (pin 63 in case of pin 0) mtpe long %0_111_0_111<<24+%00_10011_0 'time pos edges on pin[-1] (pin 63 in case of pin 0) flags long 0 'bit flags text_prop byte "porP" 'text text_chk byte "khC_" text_clk byte "klC_" text_hex byte "xeH_" text_txt byte "txT_" text_ver byte 13,10,"Prop_Ver ",ver,13,10,0,0 text_sta byte ".",0,0,0 csum byte "Prop" 'checksum hexchrs long %00000000_00000000_00000000_00000000 long %00000011_11111111_00000000_00000000 '"0".."9" long %00000000_00000000_00000000_01111110 '"A".."F" long %00000000_00000000_00000000_01111110 '"a".."f" long %00000000_00000000_00000000_00000000 long %00000000_00000000_00000000_00000000 long %00000000_00000000_00000000_00000000 long %00000000_00000000_00000000_00000000 whitechrs long %00000000_00000000_00100110_00000000 'cr, lf, tab long %00100000_00000000_00000000_00000001 '"=", space long %00000000_00000000_00000000_00000000 long %00000000_00000000_00000000_00000000 long %00000000_00000000_00000000_00000000 long %00000000_00000000_00000000_00000000 long %00000000_00000000_00000000_00000000 long %00000000_00000000_00000000_00000000 cog_end ' ' ' Uninitialized variables ' i res 1 'universal x res 1 y res 1 z res 1 checksum res 1 'checksum bytemask res 1 a0 res 1 'serial autobaud/receiver ISR a1 res 1 a2 res 1 head res 1 'serial receiver buffer tail res 1 fit cog_base64 'make sure below cog_base64 ' ' '************** '* Lut code * '************** ' org $200 + lut_start lut_code ' ' ' Reset serial autobaud/receiver interrupt ' reset_serial andn dira,#%11 'disable timing measurements for autobaud setint1 #0 'disable int1 mov head,#0 'reset serial buffer pointers mov tail,#0 dirl #rx_pin 'disable receiver wrpin #%00_11111_0,#rx_pin 'configure rx_pin for asynchronous receive, always input wrpin #%01_11110_0,#tx_pin 'configure tx_pin for asynchronous transmit, always output dirh #tx_pin 'enable transmitter wrpin mths,#rx_ths 'configure rx_ths for timing high states wrpin mtne,#rx_tne 'configure rx_tne for timing negative edges wxpin #1,#rx_tne 'report each cycle wypin #0,#rx_tne 'measure fall to fall setse1 #%110<<6+rx_tne 'set se1 to trigger on rx_tne high mov ijmp1,#autobaud_isr 'set int1 jump vector to autobaud ISR setint1 #4 'set int1 to trigger on se1 (rx_tne high) or dira,#%11 'enable timing measurements for autobaud ' ' ' Attempt to get serial command ' get_command getct x 'reset serial timeout in case SPI program ready addct1 x,timeout_per mov z,#0 'reset string buffer .byte call #get_rx 'get byte cmp x,#$1B wz 'esc? if_z jmp #@_start_taqoz cmp x,#$04 wz 'ctrl-d? if_z jmp #@_start_monitor rolbyte y,z,#3 'scroll byte into 2-long/8-byte string buffer rolbyte z,x,#0 cmp y,text_prop wz '"Prop"? if_nz jmp #.byte cmp z,text_txt wz '"_Txt"? if_z jmp #command_txt cmp z,text_hex wz '"_Hex"? if_z jmp #command_hex cmp z,text_clk wz '"_Clk"? if_z jmp #command_clk cmp z,text_chk wz '"_Chk"? if_nz jmp #.byte ' ' ' Command - check device ' command_chk call #match_device 'receive and check INA/INB filter values mov i,#text_ver 'transmit version string call #transmit jmp #get_command 'get next command ' ' ' Command - clock setup ' command_clk call #match_device 'receive and check INA/INB filter values call #get_hex 'get clock setting if_nc jmp #get_command 'if not hex, error, wait for another command mov text_sta,#"." 'transmit acknowledgement character call #transmit_sta zerox x,#24 'clear non-clock bits mov y,x 'switch to partial setting, but in RC fast mode andn y,#%11 hubset y waitx ##rc_max/200 'wait 5ms hubset x 'switch to full setting jmp #reset_serial 'restart serial at new setting, get next command ' ' ' Command - text load ' command_txt call #match_device 'receive and check INA/INB filter values mov i,#0 'reset bit counter .chr call #get_rx 'get byte altb x,#whitechrs 'whitespace? testbn 0,x wz if_nz jmp #.chr 'if whitespace, get another byte altgb x,#cog_base64 'lookup base64 value in table getbyte y testbn y,#7 wz 'if msb set, not base64 chr if_z shl z,#6 'if base64 chr, shift data buffer up 6 bits if_z or z,y '..or in new value if_z add i,#6 '..add 6 into bit counter if_z cmpsub i,#8 wc '..if bit counter >= 8, subtract 8, byte ready if_z_and_c mov x,z '....get data buffer value if_z_and_c shr x,i '....shift down to justify byte if_z_and_c wfbyte x '....write byte to hub if_z_and_c movbyts x,#%%0000 '....replicate byte within long if_z_and_c and x,bytemask '....mask current byte position if_z_and_c add checksum,x '....add into checksum if_z_and_c rol bytemask,#8 '....update byte position mask if_z jmp #.chr '..loop for next chr decmod tail,#lut_btop 'not base64 chr, repoint to prior chr jmp #end_of_data 'done ' ' ' Command - hex load ' command_hex call #match_device 'receive and check INA/INB filter values .byte call #get_hex 'get hex byte if_c wfbyte x 'if hex, write byte to hub if_c movbyts x,#%%0000 '..replicate byte within long if_c and x,bytemask '..mask current byte position if_c add checksum,x '..add into checksum if_c rol bytemask,#8 '..update byte position mask if_c jmp #.byte '..loop for next byte (followed by end_of_data) ' ' ' End of data for text/hex load - get "~" and launch code ' end_of_data call #get_chr 'end of data, check terminus chr cmp x,#"~" wz 'if "~", run program if_z jmp #.run cmp x,#"?" wz 'if not "?", error, wait for another command if_nz jmp #get_command xor checksum,csum wz 'test checksum if_z mov text_sta,#"." '(okay) if_nz mov text_sta,#"!" '(error) call #transmit_sta 'transmit status character tjnz checksum,#get_command 'if error, wait for another command .run call #reset_pins 'reset smart pins coginit #0,#$00000 'relaunch cog from $00000 ' ' ' Get and check INA/INB mask and data values ' match_device bith flags,#cmd_on 'command on, enable serial timeout for SPI program mov i,#ina 'check INA first .pair call #get_hex 'get hex mask if_nc jmp #get_command 'if not hex, error, wait for another command mov z,x wz 'got mask if_nz wrpin mtxf,#tx_pin 'if mask non-0, make tx_pin float on high alts i 'point to INA/INB and z,ina 'mask INA/INB call #get_hex 'get hex data if_nc jmp #get_command 'if not hex, wait for another command cmp z,x wz 'test for match if_nz jmp #get_command 'if mismatch, wait for another command bitnot i,#0 wcz 'toggle INA/INB pointer if_nc jmp #.pair 'if INA checked, loop to check INB mov checksum,#0 'reset checksum mov bytemask,#$FF 'reset bytemask _ret_ wrfast #0,#0 'ready to load data bytes into hub ' ' ' Get hex value, c=1 if hex ' get_hex call #get_chr 'get chr call #.check 'check for hex if_nc jmp #.prior 'if not hex, repoint to chr, c=0 mov y,x 'got first hex digit .digit call #.get 'get any additional hex digits if_c rolnib y,x,#0 if_c jmp #.digit mov x,y 'done, set result modcz _set,0 wc 'c=1 for hex .prior _ret_ decmod tail,#lut_btop 'repoint to chr, exit .get call #get_rx 'get byte .check altb x,#hexchrs 'check for hex testb 0,x wc if_nc ret 'if not hex, c=0 testbn x,#6 wz 'hex, "0".."9"? if_nz add x,#9 'if not, make $A..$F _ret_ and x,#$F 'isolate nibble, c=1 ' ' ' Get chr after any whitespace ' get_chr call #get_rx 'get byte altb x,#whitechrs 'whitespace? testbn 0,x wz if_nz jmp #get_chr 'if whitespace, get another byte ret ' ' ' Get serial byte ' get_rx_res getct x 'reset timer addct1 x,timeout_per get_rx jct1 #.timeout 'timeout? cmp head,tail wz 'byte received? if_z jmp #get_rx 'loop until timeout or byte received rdlut x,tail 'get byte from circular buffer in lut _ret_ incmod tail,#lut_btop 'increment buffer tail .timeout testb flags,#spi_ok wz 'timeout, SPI program? testb flags,#cmd_on wc 'command on? if_nz_or_c djnz timeout_cnt,#get_rx_res 'if no SPI program or command on, try until 60s (serial_done follows) ' ' ' Serial done ' on entry, z=1 if SPI program ' serial_done call #reset_pins 'reset pins if_z jmp #0 'if SPI program, run it, else shut down shut_down cogid x 'get cogid (in case jumped to from outside) hubset #1 'set 20KHz oscillator cogstop x 'shut down cog (floats pins) ' ' ' Transmit message ' transmit_sta mov i,#text_sta 'point to status character transmit setd i,#1 'set auto-increment for altgb mov y,a0 'wait 16 bit periods to allow host turn-around time shr y,#16-4+2 'shr 16 gets clocks/bit, -4 gets 16 bits, +2 gets 4 clocks/djnz djnz y,#$ 'y=0 after (djnz allows interrupts, unlike waitx) .byte altgb y,i 'get next byte of string, increment y getbyte z _ret_ tjnz z,#.send 'if zero, done .send wypin z,#tx_pin 'send byte waitx #1 'accommodate wypin -> rdpin latency .wait rdpin z,#tx_pin wc 'wait for transmit done if_c jmp #.wait jmp #.byte 'loop for more bytes ' ' ' Reset smart pins ' reset_pins setint1 #0 'disable int1 andn dira,#%11 'reset smart pins (avoids output on mode clears) zerox dirb,#29 '..but leave spi pins in current state wrpin #0,#rx_ths 'clear rx_ths mode wrpin #0,#rx_tne 'clear rx_tne mode wrpin #0,#rx_pin 'clear rx_pin mode _ret_ wrpin #0,#tx_pin 'clear tx_pin mode lut_end CON '------------------------------------------------------------------------------------------------ _clockmax = 200_000_000 ' max clock freq _clockfreq = 80_000_000 _clockfpga = 20_000_000 _cpufreq = rc_max delay1s = _cpufreq ' 1s (xtal * pll) delay10ms = _cpufreq / 100 ' 10ms delay1ms = _cpufreq / 1_000 ' 1ms delay5us = _cpufreq / 200_000 ' 5us _baud = 115_200 _bitper = (_cpufreq / _baud) << 16 + 7 ' 115200 baud, 8 bits _txmode = %0000_0000_000_0000000000000_01_11110_0 'async tx mode, output enabled for smart output _rxmode = %0000_0000_000_0000000000000_00_11111_0 'async rx mode, input enabled for smart input '------------------------------------------------------------------------------------------------ sd_ck = spi_cs 'pin SD Card clock sd_cs = spi_ck 'pin SD Card select sd_di = spi_di 'pin SD Card MOSI sd_do = spi_do 'pin SD Card MISO '------------------------------------------------------------------------------------------------ ' ASCII equates '------------------------------------------------------------------------------------------------ _CLS_ = $0C '$00 ' clear screen _BS_ = $08 _LF_ = $0A _CR_ = $0D _TAQOZ_ = $1B ' goto TAQOZ '------------------------------------------------------------------------------------------------ '------------------------------------------------------------------------------------------------ ' HUB ADDRESSES '------------------------------------------------------------------------------------------------ _HUBROM = $FC000 ' ROM $FC000 _HUBBUF = $FC000 ' overwrite Booter _HUBBUFSIZE = 80 ' RxString default size for _HUBBUF '------------------------------------------------------------------------------------------------ DAT ''============[ COG VARIABLES - SD BOOT]======================================== org $1C0 ' place the variables in cog $1C0-$1DF cmdout res 1 ' The 8b CMDxx | $40 cmdpar res 1 ' The 32b parameters cmdcrc res 1 ' The 8b CRC (must be valid for CMD0 & CMD8) cmdpar2 res 1 ' SDV1=$0, SDV2=$40000000 cmdtype res 1 ' reply is R1=1, R3=3, R7=7, else 0 reply res 1 ' R1 reply (moved to replyR1 when R3/R7 32b reply here) replyR1 res 1 ' R1 reply (8b saved when R3/R7 32b reply follows) dataout res 1 ' 8/32 bit data being shifted out bytescnt res 1 ' #bytes to send/recv bitscnt res 1 ' #bits to be shifted in/out ctr1 res 1 timeout res 1 ' = starttime + delay spare res 1 skiprun res 1 ' 1= skip load/run mbr/vol & load/no-run fname '\ 1=SDV1, 2=SDV2(byte address), 3=SDHC/SDV2(block address) blocksh res 1 '/ block shift 0/9 bits clustersh res 1 ' sectors/cluster SHL 'n' bits vol_begin res 1 '$0000_2000 ' Ptn0: first sector of PTN fsi_begin res 1 '$0000_2001 ' Ptn0: sector of file system info fat_begin res 1 '$0000_3122 ' Ptn0: first sector of FAT table dir_begin res 1' $0000_4000 ' Ptn0: first sector of DATA is DIR table dat_begin res 1 '$0000_4580 $0000_54C0' Ptn0: first sector of file's DATA ptn_size res 1 '$0008_0000 ' file-size 32KB = 64<<9 sectors _bufad res 1 _blocknr res 1 _sectors res 1 _entries res 1 bufad res 1 ' ptr sector buffer blocknr res 1 ' sector# fname res 3 ' 8+3+1 _hubdata res 1 fit $1E0 ''============[ COG VARIABLES - MONITOR]======================================== org $1E0 ' place the variables in cog $1E0-$1EF ''-------[ LMM parameters, etc ]------------------------------------------------ lmm_x res 1 ' parameter passed to/from LMM routine (typically a value) lmm_f res 1 ' parameter passed to LMM routine (function options; returns unchanged) lmm_p res 1 ' parameter passed to/from LMM routine (typically a hub/cog ptr/addr) lmm_p2 res 1 ' parameter passed to/from LMM routine (typically a 2nd hub/cog address) lmm_c res 1 ' parameter passed to/from LMM routine (typically a count) ''-------[ LMM additional workareas ]------------------------------------------- lmm_w res 1 ' workarea (never saved - short term use between calls, except _HubTx) lmm_tx res 1 ' _HubTx lmm_hx res 1 ' _HubHex/_HubString lmm_hx2 res 1 ' _HubHex lmm_hc res 1 ' " lmm_lx res 1 ' _HubList lmm_lf res 1 ' " lmm_lp res 1 ' " lmm_lp2 res 1 ' " lmm_lc res 1 ' " lmm_bufad res 1 ' _HubRxString fit $1F0 ''=======[ ^^^^^ End of COG Variables ^^^^^ ]=================================== '' +--------------------------------------------------------------------------+ '' | Cluso's Minimal SD Boot Test for P2 (c)2012-2018 "Cluso99" (Ray Rodrick)| '' +--------------------------------------------------------------------------+ '' RR20180505 v128a add into ROM_v131b ''============================[ CON ]============================================================ CON _csum = ("P" + "r"<<8 + "o"<<16 + "p"<<24) ' "Prop" checksum (reversed) _csum2 = ("P" + "r"<<8 + "o"<<16 + "P"<<24) ' "ProP" checksum (reversed) _fname1a = ("_" + "B"<<8 + "O"<<16 + "O"<<24) '\\ filename... _fname1b = ("T" + "_"<<8 + "P"<<16 + "2"<<24) '|| 8.3 +$00 _fname1c = ("B" + "I"<<8 + "X"<<16 + $00<<24) '// _fname2c = ("B" + "I"<<8 + "Y"<<16 + $00<<24) '// mbr_begin = 0 ' first sector of disk $0000_0000 '------------------------------------------------------------------------------------------------ ' COG & LUT & HUB ADDRESSES '------------------------------------------------------------------------------------------------ hubdata = $0_0000 ' expands up (512byte sectors) max_size = (512-16)*1024 ' max file_size(bytes) that can be loaded cog_start0 = $000 ' cog code start cog_len = 512-16 ' cog code length cog_len80 = 512/4 ' 512 bytes (sector) '------------------------------------------------------------------------------------------------ ' SD Commands & Responses... '------------------------------------------------------------------------------------------------ ' Command Argument Response/Data Description CMD0 = 0 +$40 ' 0 R1 - GO_IDLE_STATE *Reqs valid CRC ' CMD1 = 1 +$40 ' 0 R1 - SEND_OP_COND ACMD41 = 41 +$40 ' $4000_0000 R1 - APP_SEND_OP_COND *Reqs CMD55 first CMD8 = 8 +$40 ' 0 R1+R7 - SEND_IF_COND *Reqs valid CRC CMD9 = 9 +$40 ' 0 R1 Y SEND_CSD CMD10 = 10 +$40 ' 0 R1 Y SEND_CID ' CMD12 = 12 +$40 ' 0 R2 - STOP_TRANSMISSION CMD16 = 16 +$40 ' BlkLen[31:0] R1 - SET_BLOCKLEN CMD17 = 17 +$40 ' Addr[31:0] R1 Y READ_SINGLE_BLOCK ' CMD18 = 18 +$40 ' Addr[31:0] R1 Y READ_MULTIPLE_BLOCK ' CMD23 = 23 +$40 ' NoBlks[15:0] R1 - SET_BLOCK_COUNT ' ACMD23 = 23 +$40 ' NoBlks[22:0] R1 - SET_WR_BLOCK_ERASE_COUNT *Reqs CMD55 first ' CMD24 = 24 +$40 ' Addr[31:0] R1 Y* WRITE_BLOCK ' CMD25 = 25 +$40 ' Addr[31:0] R1 Y* WRITE_MULTIPLE_BLOCK CMD55 = 55 +$40 ' 0 R1 - APP_CMD *Prefix for ACMD41/ACMD23 CMD58 = 58 +$40 ' 0 R1+R3 - READ_OCR ' R1 response: $FF = busy/wait (0-8 bytes?) ' b7: 0 (msb first) ' b6: Parameter Error ' b5: Address Error ' b4: Erase Sequence Error ' b3: Command CRC Error ' b2: Illegal Command ' b1: Erase Reset ' b0: In Idle State ' R1b response: ??? ' R3 response: R1 + OCR(32b) ' R7 response: R1($01) + 32b(b11..b0 = $1AA = SDC V2 2V7-3V6, else reject) ' ' DataPacket: DataToken(1byte) + DataBlock(1-2048bytes) + CRC(2bytes) ' DataToken: $FE = CMD17/18/24 (read'1'block/read'n'blocks/write'1'block) ' $FC = CMD25 (write'n'blocks) ' $FD = CMD25 StopToken (Single byte packet without data or CRC) ' ErrorToken: Single Byte Reply ' b7-b5: 000 ' b4: Card Locked ' b3: Out of Range ' b2: Card ECC failed ' b1: CC Error ' b0: Error ' DataResponse: ' b7-b4: xxx0 ' $x5: Data Accepted ' $xB: Data Rejected - CRC Error ' $xD: Data Rejected - Write Error DAT ''################################################################################################ ''## SD Card - HUBEXEC code... ## ''################################################################################################ orgh '+-------[ SD: Initialise/Locate/Load/Run a file from SD ]---------------------+ <--- SD: init/locate/load/run a file ---> '+ On Entry: + '+ fname[3]: filename[11] 8+3 without "." (will be $0 terminated) + '+ Call Format: + '+ CALL #@_Run_SDfile ' + < call: init/locate/load/run a file > '+ On Return: + '+ "NZ" if error, else does not return + '+-----------------------------------------------------------------------------+ '+-----------------------------------------------------------------------------+ _Start_SDcard call #@_SDcard_Init ' initialise & read CSD/CID mov skiprun, #0 ' load/run MBR/VOL code if_e call #@_readMBR ' read MBR/VOL/FSI/FAT if_e call #@_readDIR ' read directory for filenames '' mov skiprun, #0 ' load/run (already 0) if_e call #@_readFILE ' read/load/run the file JMP #try_serial ' failed: so go back and try serial '+-----------------------------------------------------------------------------+ _Run_SDfile call #@_SDcard_Init ' initialise & read CSD/CID '' mov skiprun, #1 ' do not load/run MBR/VOL code if_e call #@_readMBR1 ' read MBR/VOL/FSI/FAT (don't run) if_e call #@_searchDIR ' search dir for mov skiprun, #0 ' load/run if_e call #@_readFILE ' read/load/run the file RET ' return "NZ" = failed, "Z" if loaded ok '+-----------------------------------------------------------------------------+ _Load_SDfile call #@_SDcard_Init ' initialise & read CSD/CID '' mov skiprun, #1 ' do not load/run MBR/VOL code if_e call #@_readMBR1 ' read MBR/VOL/FSI/FAT (don't run) if_e call #@_searchDIR ' search dir for '' mov skiprun, #1 ' do not load/run (already 1) if_e call #@_readFILE ' read/load the file RET ' return "NZ" = failed, "Z" if loaded ok '+-----------------------------------------------------------------------------+ '+-------[ SD Card Initialisation ]--------------------------------------------+ <--- SD initialisation ---> '+ On Entry: + '+ Call Format: + '+ CALL #@_SDcard_Init ' + < call: sd initialise > '+ On Return: + '+ hub $0 = CSD[16] + CID[16] ' csd/cid data + '+ Returns "Z" if ok, "NZ" if error + '+-----------------------------------------------------------------------------+ '+-----------------------------------------------------------------------------+ '+ SD/SDHC/sdxc SPI Initialisation + '+-----------------------------------------------------------------------------+ '+ Send >74 clocks with /CS=1 & DI=1 starting & ending with CLK=0 + '+-----------------------------------------------------------------------------+ _SDcard_Init mov _hubdata, #hubdata ' init hub data ptr=$0 push pa '\ save pa mov pa, #sd_cs '| ensure we have an SD card call #@check_pullup '| (pullup on cs) pop pa '| restore pa if_nc jmp #@_fail '_pullup '/ drvh #sd_cs ' cs=1 & output drvl #sd_ck ' ck=0 & output drvh #sd_di ' di=1 & output mov ctr1, #(96*2) .count waitx ##delay5us '\ 5us+5us (ie 100KHz) outnot #sd_ck '| CLK=0-->1-->0 djnz ctr1, #.count '/ waitx ##delay5us ' CLK=0 (idle) & /CS=1 '+-----------------------------------------------------------------------------+ '+ Software Reset: + '+ CMD0, PAR=$0, CRC=$95, REPLY=R1($01) + '+-----------------------------------------------------------------------------+ .Command0 getct timeout '\ set timeout up to CMD9 add timeout, ##delay10ms '/ mov ctr1, #10 ' try a few times .again0 mov cmdout, #CMD0 mov cmdpar, #0 mov cmdcrc, #$95 '+-----------------------------------------------------------------------------+ call #@_cmdR1 ' /CS=0, send cmd, recv R1, /CS=1 '+-----------------------------------------------------------------------------+ if_nc add timeout, ##delay1s ' increase timeout to 1s '\ $01(idle): SD/MMC, not fully validated if_nc jmp #.Command8 '/ $00(good): (dane card response) '+-----------------------------------------------------------------------------+ waitx ##delay5us ' delay 5us djnz ctr1, #.again0 ' n: try again? jmp #@_fail '00 ' '+=============================================================================+ ' we know we now have an SD/MMC card but its not fully validated yet... '+-----------------------------------------------------------------------------+ '+ Check Voltage: + '+ CMD8, PAR=$1AA, CRC=$87, REPLY=R1($01)+R7($xx1AA) ($05=try SDV1) + '+-----------------------------------------------------------------------------+ .Command8 mov cmdout, #CMD8 mov cmdpar, #$1AA mov cmdcrc, #$87 '+-----------------------------------------------------------------------------+ call #@_cmdR1R7 ' /CS=0, send cmd, recv R1+R7, /CS=1 '+-----------------------------------------------------------------------------+ if_c_or_z jmp #.illegal ' j if <> $01 (not idle) .idle and reply, ##$FFF '\ cmp reply, #$1AA wz '/ R7[11:0]=$1AA ? mov cmdpar2, ##$40000000 ' preset for SDV2 if_ne jmp #@_fail '98 ' n: unknown R7 jmp #.Command55 ' y: CMD55+ACMD41($4000_0000) .illegal cmp replyR1, #$05 wz ' $05(illegal cmd) ? if_ne jmp #@_fail '08 ' <>$01/$05 (not idle/illegal) mov cmdpar2, #0 ' try SDV1 ' CMD55+ACMD41($0) fall thru '+-----------------------------------------------------------------------------+ '+ Prefix to ACMD41 & ACMD23: + '+ CMD55, PAR=$0, CRC=$xx, REPLY=R1($01) + '+-----------------------------------------------------------------------------+ .Command55 mov cmdout, #CMD55 ' mov cmdpar, #0 ' '+-----------------------------------------------------------------------------+ call #@_cmdRZA41 ' /CS=0, send cmd, recv R1, /CS=0(ena) '+-----------------------------------------------------------------------------+ if_c_or_z jmp #@_fail '55 ' <>$01 (not idle) ' fall thru '+-----------------------------------------------------------------------------+ '+ Check SDV1/SDV2: (follows CMD55) + '+ ACMD41, PAR=$0, CRC=$xx, REPLY=R1($00) SD-V1 + '+ ACMD41, PAR=$40000000, CRC=$xx, REPLY=R1($00) SD-V2 + '+-----------------------------------------------------------------------------+ .CommandA41 mov cmdout, #ACMD41 ' mov cmdpar, cmdpar2 ' SDV1=0 / SDV2=$40000000 '+-----------------------------------------------------------------------------+ call #@_cmdR1 ' /CS=0, send cmd, recv R1, /CS=1 '+-----------------------------------------------------------------------------+ if_nc_and_nz jmp #.Command55 ' =$01(busy): CMD55+CMD41 again if_c jmp #@_fail '41 ' <>$00/$01: error cmp cmdpar2, #0 wz ' SDV1 ? if_z mov blocksh, #9 ' y: #1 SDV1(byte address) if_z jmp #.Command16 ' y: SDV1 does not use CMD58 ' SDV2 fall thru '+-----------------------------------------------------------------------------+ '+ Check OCR CCS bit: + '+ CMD58, PAR=$0, CRC=$xx, REPLY=R1($00)+R3(b30=1) + '+-----------------------------------------------------------------------------+ .Command58 mov cmdout, #CMD58 ' SDHC ? mov cmdpar, #0 ' '+-----------------------------------------------------------------------------+ call #@_cmdR1R3 ' /CS=0, send cmd, recv R1+R3, /CS=1 '+-----------------------------------------------------------------------------+ if_c_or_nz jmp #@_fail '58 ' <>$00(good): error testbn reply, #30 wz ' bit30=CCS=1? $40000000? if_z mov blocksh, #9 ' n: #2 SDV2(byte address) if_nz mov blocksh, #0 ' y: #3 SDHC/SDV2(block address) '' if_nz jmp #.Command9x ' y: does not req cmd16? ????????? ' SDV2(byte) fall thru '+-----------------------------------------------------------------------------+ '+ Force block size to 512 bytes: + '+ CMD16, PAR=$200, CRC=$xx, REPLY=R1($00) + '+-----------------------------------------------------------------------------+ .Command16 mov cmdout, #CMD16 ' force blocksize=512bytes mov cmdpar, ##512 ' 512 bytes '+-----------------------------------------------------------------------------+ call #@_cmdR1 ' /CS=0, send cmd, recv R1, /CS=1 '+-----------------------------------------------------------------------------+ if_nc_and_nz jmp #.Command16 ' =$01(idle): again if_c_or_nz jmp #@_fail '16 ' <>$00(good): error '+-----------------------------------------------------------------------------+ .Command9x mov _bufad, _hubdata ' where to store data mov bufad, _bufad ' where to store CSD/CID '+-----------------------------------------------------------------------------+ '+ Read CSD register (16 bytes): + '+ CMD9, PAR=$0, CRC=$xx, REPLY=R1($00) + '+-----------------------------------------------------------------------------+ .Command9 mov cmdout, #CMD9 ' read CSD register call #@_readREG ' '+-----------------------------------------------------------------------------+ '+ Read CID register (16 bytes): + '+ CMD10, PAR=$0, CRC=$xx, REPLY=R1($00) + '+-----------------------------------------------------------------------------+ .Command10 mov cmdout, #CMD10 ' read CID register call #@_readREG ' '+-----------------------------------------------------------------------------+ _RET_ MODZ _set wz ' "Z" = success '+=============================================================================+ '+-------[ SD: Read MBR/VBR/FSI/FAT ]------------------------------------------+ <--- SD: read mbr/vol/fsi/fat ---> '+ On Entry: + '+ skiprun: #0 = load/run boot code if found on MBR/VOL + '+ #1 = do not load/run boot code on MBR/VOL + '+ Call Format: + '+ CALL #@_readMBR ' + < call: read mbr/vol/fsi/fat > '+ On Return: + '+ DOES NOT RETURN if skiprun = #0 and code found on MBR/VOL + '+ Returns: "Z" if ok, "NZ" if error + '+-----------------------------------------------------------------------------+ '+-----------------------------------------------------------------------------+ '+ Read MBR/VBR (Sector 0): + '+-----------------------------------------------------------------------------+ _readMBR1 mov skiprun, #1 ' do not load/run MBR/VOL code _readMBR mov _blocknr, #mbr_begin ' VBR/MBR = SECTOR 0 call #@_readSECTOR ' read sector skip skiprun ' skips next instr if #1 call #@_validateCSUM ' valid -> load & run '+-----------------------------------------------------------------------------+ '+ Validate MBR (PTN0 table & signature) + '+ +$1BE[16] = = Ptn0 Table... + '+ verify +$1BE+$0[1] = $00/$80 = Ptn0 State + '+ verify +$1BE+$4[1] = $0B/$0C = Ptn0 Type + '+ calc +$1BE+$8[4] = = Ptn0 StartSector# --> vol_begin + '+ calc +$1BE+$C[4] = = Ptn0 SectorSize --> ptn_size + '+ verify +$1FE[2] = $55AA = signature + '+-----------------------------------------------------------------------------+ ._validateMBR mov bufad, _bufad ' MBR hub addr add bufad, #$1BE ' offset to PTN0 table rdbyte reply, bufad ' ptn_state and reply, #$7F cmp reply, #0 wz ' $00/80? inactive/active if_ne jmp #@_fail '_mbr ' add bufad, #$4 ' offset to ptn_type rdbyte reply, bufad ' ptn_type cmp reply, #$0C wz ' $0C=FAT32(LBA) if_ne cmp reply, #$0B wz ' $0B=FAT32(<=2TB) '''' if_ne cmp reply, #$07 wz ' $07=exFAT Do not allow!!! if_ne jmp #@_fail '_mbr ' add bufad, #($1FE-$1BE-$4) ' offset to $55AA signature rdword reply, bufad ' read cmp reply, ##$AA_55 wz ' we read it reversed! if_ne jmp #@_fail '_mbr ' mov bufad, _bufad ' MBR hub addr add bufad, #$1BE ' offset to PTN0 table '+-----------------------------------------------------------------------------+ '+ Calculate the raw sector address (LBA) for the VOL sector (vol_begin)... + '+ vol_begin = LBA begin ptn0 $1BE+$08[4] (reversed & not long aligned!!!)+ '+-----------------------------------------------------------------------------+ add bufad, #$08 ' offset to start sector LBA rdlong vol_begin, bufad ' read '+-----------------------------------------------------------------------------+ '+ Calculate the partition size in sectors + '+ ptn_size = #sectors in ptn0 $1BE+$0C[4] (reversed & not long aligned!!!)+ '+-----------------------------------------------------------------------------+ add bufad, #($0C-$08) ' offset to PTN0 size rdlong ptn_size, bufad ' read '+-----------------------------------------------------------------------------+ '+-----------------------------------------------------------------------------+ '+ Read VOL (Sector x): + '+-----------------------------------------------------------------------------+ ._readVOL mov _blocknr, vol_begin ' VOL SECTOR# call #@_readSECTOR ' read sector skip skiprun ' skips next instr if #1 call #@_validateCSUM ' valid -> load & run '+-----------------------------------------------------------------------------+ ' Validate VOL... + ' verify +$00B[2] = 512 = #Bytes/Sector + ' calc +$00D[1] = = #Sectors/Cluster 64? --> clustersh + ' calc +$00E[2] = #ResvSectors --> PTN0RESV + ' verify +$010[1] = 2 = #NoOfFATs PTN0NFATS + ' ??? +$020[4] = #Sectors/PTN --> =ptn_size? + ' calc +$024[4] = #Sectors/FAT --> PTN0SECFAT + ' calc +$030[2] = #FileSystemInfo --> fsi_begin + ' verify +$1FE[2] = $55AA = signature + ' + ' calc fat_begin = vol_begin + PTN0RESV + ' calc dir_begin = fat_begin + (PTN0SECFAT * 2) + '+-----------------------------------------------------------------------------+ ._validateVOL mov bufad, _bufad ' VOL hub locn add bufad, #$0B '\ offset to bytes/sector rdword reply, bufad '| read cmp reply, ##512 wz '| if_ne jmp #@_fail '_vol '/ add bufad, #($0D-$0B) ' offset to #Sectors/Cluster rdbyte clustersh, bufad '\ calc as shift left 'n' encod clustersh '/ add bufad, #($0E-$0D) ' offset to #ResvSectors rdword fat_begin, bufad '\ start of FAT table add fat_begin, vol_begin '/ add bufad, #($10-$0E) '\ offset to #nooffats rdbyte reply, bufad '| read cmp reply, #2 wz '| $02 PTN0NFATS if_ne jmp #@_fail '_vol '/ add bufad, #($24-$10) ' offset to #Sectors/FAT rdlong dir_begin, bufad '\ start of DATA (DIR table) shl dir_begin, #1 '| *2 add dir_begin, fat_begin '/ +base add bufad, #($30-$24) ' offset to #FileSystemSector rdword fsi_begin, bufad ' read add fsi_begin, vol_begin ' add vol_begin add bufad, #($1FE-$30) ' offset to $55AA signature rdword reply, bufad ' read cmp reply, ##$AA_55 wz ' we read it reversed! if_ne jmp #@_fail '_vol ' '+-----------------------------------------------------------------------------+ '+-----------------------------------------------------------------------------+ '+ Read FSI (Sector x): + '+-----------------------------------------------------------------------------+ ._readFSI mov _blocknr, fsi_begin ' FSI SECTOR# call #@_readSECTOR ' read sector '+-----------------------------------------------------------------------------+ '+ Validate FSI... + '+ verify +$000[4] = "RRaR" = signature + '+ verify +$1E4[4] = "rrAa" = signature + '+ verify +$1FE[2] = $55AA = signature + '+-----------------------------------------------------------------------------+ ._validateFSI mov bufad, _bufad ' FSI hub locn rdlong reply, bufad ' read cmp reply, ##$41615252 wz ' "RRaA" signature (reversed) add bufad, #$1E4 ' offset to signature rdlong reply, bufad ' read if_e cmp reply, ##$61417272 wz ' "rrAa" signature (reversed) add bufad, #($1FE-$1E4) ' offset to signature rdword reply, bufad ' read if_e cmp reply, ##$AA_55 wz ' $55AA signature (reversed) if_ne jmp #@_fail '_fsi ' '+-----------------------------------------------------------------------------+ '+-----------------------------------------------------------------------------+ '+ Read FAT (Sector x): + '+-----------------------------------------------------------------------------+ ._readFAT mov _blocknr, fat_begin ' FAT SECTOR# call #@_readSECTOR ' read sector '+-----------------------------------------------------------------------------+ '+ Validate FAT... + '+ nothing to validate + '+-----------------------------------------------------------------------------+ _RET_ MODZ _set wz ' "Z" = success '+=============================================================================+ '+-----------------------------------------------------------------------------+ '+ Read DIR (n Sectors): Search for "<_fname/_fname2>" + '+-----------------------------------------------------------------------------+ _readDIR mov fname, ##_fname1a ' copy _fname1 -> fname mov fname+1, ##_fname1b ' mov fname+2, ##_fname1c ' call #@_searchDIR ' search dir for if_e RET ' return "Z" = found mov fname+2, ##_fname2c ' new fname ext call #@_searchDIR ' search dir for RET ' return "Z" = found, else "NZ" '+=============================================================================+ '+-------[ SD: Search Root Directory for <_fname> entry ]----------------------+ <--- SD: search root directory ---> '+ On Entry: + '+ fname[3]: filename[11] 8+3 without "." + '+ Call Format: + '+ CALL #@_searchDIR ' + < call: search root directory > '+ On Return: + '+ "Z" if found, and sets + '+ dat_begin = first native sector of file's data + '+ _sectors = file size in bytes + '+ "NZ" if not found / error + '+-----------------------------------------------------------------------------+ _searchDIR and fname+2, ##$00FFFFFF ' 12th char must be $00 mov _blocknr, dir_begin ' DIR SECTOR# decod _sectors, clustersh ' max sectors to scan (1 cluster) .search_next call #@_readSECTOR ' read sector '+-----------------------------------------------------------------------------+ '+ Walk Directory: (read DIR sectors) + '+ 16 x 32byte DIR(fname) entries per DIR sector + '+ +$00[1] = $00 = empty + '+ => $80 = deleted file + '+ search +$00[11] = 8.3 filename + '+ verify +$0B[1] = FileAttrib AND $D8,check $00 + '+ $01=read,02=hidden,04=system,08=volume,0F=longfile,10=dir,20=archive+ '+ calc +$14[2] = FAT32: 1st cluster# HI -\-> cluster + '+ calc +$1A[2] = FAT32: 1st cluster# LO -/ + '+ calc +$1C[4] = FAT32: FileSize in bytes --> file_size + '+ calc dat_begin = dir_begin + ((cluster-2)<<6) + '+-----------------------------------------------------------------------------+ ' scan dir sector for files... .walk_dir mov _entries, #16 ' 16*32byte file entries mov bufad, _bufad ' dir hub locn ' scan this sector for filename entry... .scan rdlong reply, bufad '\ check this entry cmp reply, #0 wz '| $0 = empty? if_ne jmp #.check '| n: _RET_ MODZ _clr wz '/ return "NZ" = not found .check cmp reply, fname wz '| check fname... add bufad, #4 '| rdlong reply, bufad '| if_e cmp reply, fname+1 wz '| add bufad, #4 '| rdlong reply, bufad '| and reply, ##$D8FFFFFF '| check atts b7+6+4+3 if_e cmp reply, fname+2 wz '| if_e jmp #.found '/ found! add bufad, #(32-8) ' next entry djnz _entries, #.scan ' "NZ" not found this sector '+-----------------------------------------------------------------------------+ add _blocknr, #1 ' next sector# _RET_ djnz _sectors, #.search_next ' return "NZ" = not found '+-----------------------------------------------------------------------------+ '+ set: cluster = +$14[2] +$1A[2] + '+ filesize = +$1C[4] + '+ sector = ((cluster-2)< '+ On Entry: + '+ dat_begin = first native sector of file's data + '+ _sectors = file size in bytes + '+ Call Format: + '+ CALL #@_readFILE ' + < call: load/run file > '+ On Return: + '+ "NZ" if error, else does not return + '+-----------------------------------------------------------------------------+ '+-----------------------------------------------------------------------------+ '+ Read FILE (n Sectors): File "<_fname/_fname2>" + '+-----------------------------------------------------------------------------+ _readFILE mov _blocknr, dat_begin ' DAT SECTOR# ' convert _sectors = file_size (bytes) into sectors to read fle _sectors, ##max_size ' limit max size to load add _sectors, #511 ' +sector if extra bytes shr _sectors, #9 ' sectors=file_size/512 ' load file's data - multiple sector(s) call #@_readSECTOR ' read sector djz _sectors, #.done .nextsector call #@_readnxtSECTOR ' read sector(s) djnz _sectors, #.nextsector .done cmp skiprun, #1 wz ' skip running? if_e RET ' return "Z" = successful load ' else fall thru & run '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' load Cog & jmp #$000 ._success setq #cog_len-1 ' length -1 rdlong cog_start0, _hubdata ' copy loaded code into cog jmp #$0 ' execute loaded cog code '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' load cog & jmp #$020 _success80 setq #cog_len80-1 ' length -1 rdlong cog_start0, _hubdata ' copy loaded code into cog jmp #$020 ' execute loaded cog code from $080+ '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '+-----------------------------------------------------------------------------+ '+ Read Sector: + '+-----------------------------------------------------------------------------+ _readnxtSECTOR add _blocknr, #1 ' next sector# _readnxtSLOT add _bufad, ##512 ' next data slot _readSECTOR mov blocknr, _blocknr ' sector# mov bufad, _bufad ' where to store data '+-----------------------------------------------------------------------------+ '+ Read Block/Sector: (512 bytes) + '+ CMD17, PAR=blocknr, CRC=$xx, REPLY=R1($??) +n*$FF +($FE+block+CRC16) + '+-----------------------------------------------------------------------------+ .Command17 mov bytescnt, ##512 ' read block (no. bytes) mov cmdout, #CMD17 ' mov cmdpar, blocknr ' shl cmdpar, blocksh ' <<0 or <<9 '+-----------------------------------------------------------------------------+ call #@_readBLOCK ' read 512 bytes '+-----------------------------------------------------------------------------+ RET ' "Z" = success '+=============================================================================+ '+-----------------------------------------------------------------------------+ '+ Read Block/Sector: (512 bytes) + '+ CMD9, PAR=$0, CRC=$xx, REPLY=R1($00) + '+ CMD10, PAR=$0, CRC=$xx, REPLY=R1($00) + '+ CMD17, PAR=blocknr, CRC=$xx, REPLY=R1($??) +n*$FF +($FE+block+CRC16) + '+-----------------------------------------------------------------------------+ _readREG mov bytescnt, #16 ' CMD9,10: CSD,CID register mov cmdpar, #0 ' PAR=$0, 16 bytes _readBLOCK ' CMD17: PAR=sector, 512 bytes getct timeout '\ set timeout for cmd9,10,17 add timeout, ##delay1s '/ '+-----------------------------------------------------------------------------+ call #@_cmdRZtoken ' /CS=0, send cmd, recv R1, /CS=0(ena) if_nz jmp #@_fail '17 ' <>$00(good): error '+-----------------------------------------------------------------------------+ call #@_getreply ' n*$FF+$FE cmp reply, #$FE wz ' $FE=valid Data Token if_nz jmp #@_fail '97 ' '+-----------------------------------------------------------------------------+ .readbyte call #@_recvbyte ' read data byte wrbyte reply, bufad ' save byte add bufad, #1 ' bufad++ djnz bytescnt, #.readbyte ' byte-- call #@_recvbyte ' read CRC16 1/2 call #@_recvbyte ' read CRC16 2/2 ' NOTE: CRC16 not checked - do we want to do this? ?????????? '' outl #sd_ck ' CLK=0 (idle) already=0 outh #sd_cs ' /CS=1 (disable) _RET_ MODZ _set wz ' "Z" = success '+=============================================================================+ '+-----------------------------------------------------------------------------+ '+ SEND: CMDx, PARx, CRCx, GET REPLY + '+-----------------------------------------------------------------------------+ _cmdRZA41 ' CMD55: R1 response _cmdRZtoken ' CMD9,10,17,24: R1+$FE response mov cmdtype, #1 ' returns w /CS=0(ena) jmp #@_cmdxx ' _cmdR1R3 ' CMD58: R1+R3 response _cmdR1R7 ' CMD8: R1+R7 response _cmdR1 ' CMD0,A41,16: R1 response mov cmdtype, #0 ' returns w /CS=1(disabled) _cmdxx ' '+-----------------------------------------------------------------------------+ outl #sd_cs ' /CS=0 (enable) '+-----------------------------------------------------------------------------+ call #@_sendFF ' send $FF byte first mov dataout, cmdout ' CMD call #@_sendbyte ' send cmd byte mov dataout, cmdpar ' Parameter call #@_sendlong ' send 4 bytes (MSB first) mov dataout, cmdcrc ' CRC call #@_sendbyte ' send crc byte '+-----------------------------------------------------------------------------+ call #@_getreply ' recv R1/R1+R3/R1+R7/RZ..+Token '+-----------------------------------------------------------------------------+ '' outl #sd_ck ' CLK=0 (idle) already=0 skip cmdtype '\ skips next instr if #1 outh #sd_cs '| /CS=1(disable) if reqd RET '/ else /CS=0 cmdRZA41/cmdRZtoken '+=============================================================================+ '+-----------------------------------------------------------------------------+ '+ READ REPLY: R1/R1+R3/R1+R7/R1+token + '+-----------------------------------------------------------------------------+ _getreply call #@_recvbyte ' recv R1 byte cmp reply, #$FF wz ' reply=$FF=busy ? if_nz jmp #.doneR1 ' n: ' timeout set in CMD0(for CMD0,8,55,A41,58,16) and CMD9,10,17(readblock) getct replyR1 '\ timeout ? cmp replyR1, timeout wc '| c if < timeout if_c jmp #@_getreply '| n: try again jmp #@_fail '90 '/ timeout: .doneR1 mov replyR1, reply ' save R1/Token reply '+-----------------------------------------------------------------------------+ cmp cmdout, #CMD8 wz if_nz cmp cmdout, #CMD58 wz if_nz jmp #.end ' ret if not CMD8/CMD58 '+-----------------------------------------------------------------------------+ call #@_recvlong ' R7=CMD8=volts/R3=CMD58=OCR '+-----------------------------------------------------------------------------+ .end '\ returns with... '| nc+z replyR1=$00(success) test replyR1, #1 wz '| nc+nz replyR1=$01(idle) _RET_ cmpr replyR1, #$01 wc '/ c replyR1>$01(error) '+=============================================================================+ '+-----------------------------------------------------------------------------+ '+ SD SPI Send/Recv Routines... (write/read byte/long simultaneously) + '+ /CS=0 & CLK=0 on both entry and exit + '+-----------------------------------------------------------------------------+ _recvlong neg dataout, #1 ' call here to Recv a Long (+send 1's) _sendlong mov bitscnt, #32 ' call here to Send a Long (long=32bits) jmp #@_sendrecv ' _sendFF ' call here to Send $FF Byte _recvbyte neg dataout, #1 ' call here to Recv a Byte (+send 1's) _sendbyte rol dataout, #24 ' call here to Send a Byte (msbit first) mov bitscnt, #8 ' (byte=8bits) _sendrecv mov reply, #0 ' clear reply ' 8+15 low/high clk cycles (8.7MHz@200MHz, 1.3MHz@30MHz) .nextbit rol dataout, #1 wc ' \ prepare output bit (DI=0/1).. outl #sd_ck ' | CLK=0 (already 0 first time) outc #sd_di ' / write output bit: output on CLK falling edge waitx #2 ' | setup time to be safe outh #sd_ck ' \ CLK=1 waitx #3 ' | setup time to be safe testp #sd_do wc ' | read input bit: sample on CLK rising edge rcl reply, #1 ' / accum DO input bits djnz bitscnt, #.nextbit ' 8/32 bits? _RET_ outl #sd_ck ' CLK=0 on exit '+=============================================================================+ '+-----------------------------------------------------------------------------+ _fail _RET_ MODCZ _set,_clr wcz ' C & NZ = fail '+=============================================================================+ ''%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ''%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ''%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% '' +--------------------------------------------------------------------------+ '' | Cluso's LMM_SerialDebugger for P2 (c)2013-2018 "Cluso99" (Ray Rodrick)| '' +--------------------------------------------------------------------------+ '' RR20180512 v133i LSD_v131i ''============================[ CON ]============================================================ CON ''----------------------------------------------------------------------------------------------- '' LMM DEBUGGER - SUPPORTED COMMANDS ''----------------------------------------------------------------------------------------------- '' xxxxxx - xx xx xx xx ... DOWNLOAD: to cog/lut/hub {addr1} following {byte(s)} '' xxxxxx [.xxxxxx] L LIST: from cog/lut/hub {addr1} to < {addr2} '' xxxxxx G GOTO: to cog/lut/hub {addr1} '' Q QUIT: Quit Rom Monitor and return to the User Program '' Rffffffffxxx RUN: Run file from SD '' TAQOZ: goto TAQOZ ''----------------------------------------------------------------------------------------------- '' LMM DEBUGGER - CALL Modes...(not all modes supported) ''----------------------------------------------------------------------------------------------- _MODE = $F << 5 ' mode bits defining the call b8..b5 (b4..b0 are modifier options) _SHIFT = 5 ' shr # to extract mode bits _HEX_ = 2 << 5 ' hex... _REV_ = 1 << 4 ' - reverse byte order _SP = 1 << 3 ' - space between hex output pairs '_DIGITS = 7..0 where 8->0 ' - no. of digits to display _LIST = 3 << 5 ' LIST memory line (1/4 longs) from cog/hub _ADDR2 = 1 << 4 ' 1= use lmm_p2 as to-address _LONG_ = 1 << 1 ' 1=display longs xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx _TXSTRING = 4 << 5 ' tx string (nul terminated) from hub _RXSTRING = 5 << 5 ' rx string _ECHO_ = 1 << 4 ' - echo char _PROMPT = 1 << 3 ' - prompt (lmm_x) _ADDR = 1 << 2 ' - addr of string buffer supplied _NOLF = 1 << 1 ' - strip _MONITOR = 7 << 5 ' goto rom monitor '------------------------------------------------------------------------------------------------ DAT ''################################################################################################ ''## LMM Monitor - HUBEXEC code... ## ''################################################################################################ orgh ''----------------------------------------------------------------------------------------------- '' RESET BOOTER SERIAL INTERRUPTS & AUTOBAUD - KEEP SMART UART RUNNING ''----------------------------------------------------------------------------------------------- _reset_booter setint1 #0 ' disable int1 andn dira,#3 ' reset smart pins on P0 & P1 wrpin #0,#rx_ths ' clear P1 rx_ths mode _RET_ wrpin #0,#rx_tne ' clear P0 rx_tne mode ''=============================================================================================== ''-------[ Start Monitor ]----------------------------------------------------- <--- start monitor ---> _Start_Monitor call #@_reset_booter ' reset the booters interrupts and autobaud _Enter_Monitor mov lmm_bufad, ##_HUBBUF ' addr of hub buffer (_HubRxString) mov lmm_x, #_CR_ ' we have to prime send buffer empty flag, wypin lmm_x, #tx_pin ' ... so send to tx pin ''--------------------------------------------------------------------------------------------------- ' this code displays a version string (it's not required) _Redo_Monitor call #@_HubTxStrVer ' send version string ''--------------------------------------------------------------------------------------------------- ' call the Monitor (because we need a return address set) .monitor call #@_HubMonitor ' to the monitor/debugger jmp #.monitor ' loop back in case of "Q" ''=============================================================================================== ''-------[ Serial Routines (uses SmartPins) ]---------------------------------- <--- serial initialise ---> ''_SerialInit '' On Entry: '' lmm_x = _bitper ' tx & rx bit period + #(bits-1) '' lmm_bufad = 'bufad' ' hubbuf addr for use by _HubRxString '' Call Format: '' CALL #@_SerialAddr ' use default _HUBBUF < call: serial initilise> '' CALL #@_SerialBaud ' use default _bitper < call: serial initilise> '' CALL #@_SerialInit ' provide addr & baud < call: serial initilise> '' On Return: '' lmm_x = #CR ' (changed) ''-------------------------------------------------------------------------------------------------- _SerialAddr mov lmm_bufad, ##_HUBBUF ' addr of hub buffer (_HubRxString) _SerialBaud mov lmm_x, ##_bitper ' 115200 baud, 8 bits _SerialInit wrpin ##_txmode, #tx_pin ' set asynchronous tx mode in smart pin tx wxpin lmm_x, #tx_pin ' set tx bit period + #(bits-1) dirh #tx_pin ' enable smart pin tx wrpin ##_rxmode, #rx_pin ' set asynchronous rx mode in smart pin rx wxpin lmm_x, #rx_pin ' set rx bit period + #(bits-1) dirh #rx_pin ' enable smart pin rx mov lmm_x, #_CR_ ' we have to prime send buffer empty flag, wypin lmm_x, #tx_pin ' ... so send to tx pin RET wcz ' <--- return to calling routine ---> ''=============================================================================================== ''-------[ Display Char(s) ]--------------------------------------------------- <--- display char(s) ---> ''_HubTx ' '' On Entry: '' lmm_x = char(s) ' char(s): up to 4 chars; B0 first; terminates '' ' if =$0, tx one '' Call Format: '' CALL #@_HubTxCR ' preloads cr+lf < call: display char(s)> '' CALL #@_HubTxRev ' reverses lmm_x < call: display char(s)> '' CALL #@_HubTx ' < call: display char(s)> '' On Return: '' lmm_x = -same- ' char(s): (unchanged) ''-------------------------------------------------------------------------------------------------- _HubTxCR mov lmm_x, ##(_CR_<<24+_LF_<<16) ' (gets reversed) _HubTxRev movbyts lmm_x, #%%0123 ' reversed _HubTx MOV lmm_w, lmm_x ' < push: 'x' #0 > ' ---------------------------------------- .send testp #tx_pin wc ' wait for buffer empty on tx pin if_nc jmp #.send ' wypin lmm_x, #tx_pin ' send byte (bits7:0) to tx pin shr lmm_x, #8 wz ' any more chars to send? if_nz jmp #.send '> br back: (nz = another char in lmm_x) ' ---------------------------------------- MOV lmm_x, lmm_w ' < pop: 'x' #0 > RET wcz ' <--- return to calling routine ---> ''=============================================================================================== ''-------[ Rx: Receive a char ]------------------------------------------------ <--- receive char ---> ''_HubRx '' On Entry: '' lmm_x = -anything- ' value: '' Call Format: '' CALL #@_HubRx ' < call: receive char> '' On Return: '' lmm_x = char ' char: input char ''-------------------------------------------------------------------------------------------------- _HubRx ' <--- receive char ---> .recv testp #rx_pin wc ' char ready? if_nc jmp #.recv ' rdpin lmm_x, #rx_pin ' recv byte (bits31:24) from rx pin shr lmm_x, #24 ' shift rx bits RET wcz ' <--- return to calling routine ---> ''=============================================================================================== ''-------[ Display Hex ]------------------------------------------------------- <--- display hex ---> ''_HubHex ' '' On Entry: '' lmm_f = _HEX_ [+options] ' mode: #_HEX_[+_REV_][+_SP][+_ndigits] '' ' 'n' digits = 7..0 where 0 = 8 digits '' lmm_x = char(s) ' char(s): '' Call Format: '' CALL #@_HubHexRev ' reverse lmm_x < call: display hex > '' CALL #@_HubHex8 ' hex 8 digits < call: display hex > '' CALL #@_HubHex ' < call: display hex > '' On Return: '' lmm_f = -same- ' mode: (unchanged) '' lmm_x = -same- ' char(s): (unchanged) ''-------------------------------------------------------------------------------------------------- _HubHexRev movbyts lmm_x, #%%0123 ' reversed _HubHex8 mov lmm_f, #_HEX_+0 ' 8 digits _HubHex MOV lmm_hx, lmm_x ' < push: 'x' #0 > MOV lmm_hc, lmm_c ' < push: 'c' #1 > ' ---------------------------------------- test lmm_f, #_REV_ wz ' reverse mode? if_nz movbyts lmm_x, #%%0123 ' y: reverse bytes mov lmm_c, lmm_f '\ CTR = ... and lmm_c, #7 wz '| ... 'n' digits ... if_z mov lmm_c, #8 '/ ... if 0, then 8 mov lmm_w, #8 '\ nibbles to... sub lmm_w, lmm_c wz '| ... ... if_nz shl lmm_w, #2 '| ... *4 ... if_nz rol lmm_x, lmm_w '/ ... discard ' ---------------------------------------- .next rol lmm_x, #4 '\ next nibble ... MOV lmm_hx2, lmm_x '| ... save ... < push: 'x' #2 > and lmm_x, #$0F '| ... extract ... or lmm_x, #"0" '| ... convert ... cmp lmm_x, #":" wc '| ... ... if_nc add lmm_x, #("A"-"9"-1) '/ ... now 0-9,A-F CALL #@_HubTx ' < call: display char(s)> ' ---------------------------------------- test lmm_f, #_SP wz ' hex space mode? test lmm_c, #1 wc ' c if odd count if_z_or_nc jmp #.nospace '> br: (no space reqd) mov lmm_x, #" " ' " " CALL #@_HubTx ' < call: transmit char(s)> ' ---------------------------------------- .nospace MOV lmm_x, lmm_hx2 ' ... restore ... < pop: 'x' #2 > djnz lmm_c, #.next '> CTR-- ' ---------------------------------------- MOV lmm_c, lmm_hc ' < pop: 'c' #1 > MOV lmm_x, lmm_hx ' < pop: 'x' #0 > RET wcz ' <--- return to calling routine ---> ''=============================================================================================== ''-------[ Display String, terminated ]---------------------------------- <--- display string ---> ''_HubTxString ' '' On Entry: '' lmm_p = 'addr' ' addr: string (hub ptr) '' Call Format: '' CALL #@_HubTxStrVer ' display version < call: display string> '' CALL #@_HubTxString ' < call: display string> '' On Return: '' lmm_p = 'addr' (next string) ' addr: (hub ptr to next string) ''-------------------------------------------------------------------------------------------------- _HubTxStrVer mov lmm_p, ##_str_vers ' send version string, $00 terminated _HubTxString MOV lmm_hx, lmm_x ' < push: 'x' #0 > ' ---------------------------------------- .loop rdbyte lmm_x, lmm_p wz ' get char from string: nul? add lmm_p, #1 ' PTR++ if_z jmp #.return '> br fwd: (returns to calling program) CALL #@_HubTx ' < call: transmit char(s)> jmp #.loop ' br back ' ---------------------------------------- .return MOV lmm_x, lmm_hx ' < pop: 'x' #0 > RET wcz ' <--- return to calling routine ---> ''=============================================================================================== ''-------[ LIST a line(s) ]---------------------------------------------------- <--- LIST a line(s) ---> ''_HubList '' On Entry: '' lmm_f = #_LIST [+options] ' mode: _LIST[+_ADDR2][+_LONG_] '' lmm_p = 'addr' (from) ' addr: from cog addr / hub ptr '' lmm_p2 = 'addr2' (to) (optional) ' addr2: to cog addr / hub ptr (if _ADDR2 specified) '' Call Format: '' CALL #@_HubListA2 ' _LIST+_ADDR2 < call: LIST a line > '' CALL #@_HubList ' < call: LIST a line > '' On Return: '' lmm_f = same except _HDG off ' mode: same except _HDG will be off '' lmm_p = addr++ (from) ' addr: next from cog addr / hub ptr '' lmm_p2 = addr2++/same (to) ' addr2: next to addr -OR- unchanged ''--------------------------------------------------------------------------------------------------- _HubListA2H mov lmm_f, #_LIST+_ADDR2 ' list addr2 _HubList MOV lmm_lx, lmm_x '\ save params MOV lmm_lf, lmm_f '| MOV lmm_lp, lmm_p '| MOV lmm_lp2,lmm_p '| orig {addr} MOV lmm_lc, lmm_c '/ test lmm_f, #_ADDR2 wz ' nz if {addr2} mode if_z mov lmm_p2, lmm_p ' n: replace {addr2} <-- {addr} ' ---------------------------------------- ' ===LOOPS HERE FOR MULTIPLE LINES=== _HubListLoop ' ---------------------------------------- ' ===DISPLAY LINE: ADDR=== MOV lmm_p, lmm_lp ' restore 'addr' cmp lmm_p, ##$3FF wcz ' z|c if =<$3FF = cog/lut mode? ' hub: if_a mov lmm_f, #_HEX_+5 ' set hex mode with 5 digits ' cog: if_be mov lmm_f, #_HEX_+3 ' set hex mode with 3 digits if_be mov lmm_x, ##(" "+" "<<8) ' " " if_be CALL #@_HubTx ' < call: transmit char(s) > ' display address mov lmm_x, lmm_p ' set cog/lut/hub address (for displaying) CALL #@_HubHex ' < call: display hex > mov lmm_x, ##(":"+" "<<8) ' ": " CALL #@_HubTx ' < call: transmit char(s) > ' ---------------------------------------- ' ===DISPLAY 4x HEX LONGS=== ' lmm_p = ptr to 1st long test lmm_lf, #_LONG_ wz ' long or byte mode if_nz mov lmm_f, #_HEX_+0 ' set hex with 8(=0) digits if_z mov lmm_f, #_HEX_+_REV_+_SP+0 ' set hex reversed space mode with 8(=0) digits mov lmm_c, #4 ' set 4 longs ' read a long from cog/lut/hub into lmm_x pointed to by lmm_p and inc lmm_p .long4 CALL #_RdLongCogHub ' < call: read cog/hub long > CALL #@_HubHex ' < call: display hex> mov lmm_x, #" " ' extra space CALL #@_HubTx ' < call: transmit char(s) > djnz lmm_c, #.long4 ' (4 longs)-- ' ---------------------------------------- ' ===DISPLAY ASCII=== mov lmm_c, #4 ' set 4 longs MOV lmm_p, lmm_lp ' restore {addr} mov lmm_x, ##(" "+"'"<<8) ' " '" CALL #@_HubTx ' < call: transmit char(s) > ' ------------------------ ' read a long from cog/lut/hub into lmm_x pointed to by lmm_p and inc lmm_p .asciiloop CALL #_RdLongCogHub ' < call: read cog/hub long > test lmm_lf, #_LONG_ wz ' long mode? if_nz movbyts lmm_x, #%%0123 ' y: reverse bytes ' convert 4 bytes to visible mov lmm_f, #4 ' (lmm_f as temp byte counter) .convert mov lmm_w, lmm_x ' duplicate andn lmm_x, #$FF ' clear lower byte and lmm_w, #$FF ' extract lower byte cmp lmm_w, #" " wc ' c if <$20: invisible? if_c mov lmm_w, #"." ' y: replace cmp lmm_w, #$7F wc ' c if <$7F: visible? if_nc mov lmm_w, #"." ' n: replace or lmm_x, lmm_w ' replace lower byte ror lmm_x, #8 ' next byte djnz lmm_f, #.convert ' (lmm_f as temp byte counter) CALL #@_HubTx ' 4 ascii bytes < call: transmit char(s)> djnz lmm_c, #.asciiloop ' (longs count)-- mov lmm_x, ##("'"+_CR_<<8+_LF_<<16) ' "'" CALL #@_HubTx ' < call: transmit char(s)> MOV lmm_lp, lmm_p ' save new {addr} ' ---------------------------------------- ' ===MULTIPLE LINES ?=== cmp lmm_p, lmm_p2 wc ' c if addr < addr2 if_b jmp #_HubListLoop ' n: another line ' ---------------------------------------- ' calculate how far 'addr' advanced and advance 'addr2' by the same amount sub lmm_p2,lmm_lp2 ' {addr2} - orig {addr} add lmm_p2,lmm_p ' + final {addr} mov lmm_lp2, lmm_p2 ' save new {addr2} ' ---------------------------------------- MOV lmm_x, lmm_lx '\ restore params MOV lmm_f, lmm_lf '| '' MOV lmm_p, lmm_lp '| \(already done) '' MOV lmm_p2,lmm_lp2 '| / MOV lmm_c, lmm_lc '/ ' ---------------------------------------- RET wcz ' <--- return to calling routine ---> ''=============================================================================================== ''-------[ Receive String ]---------------------------------------------------- <--- receive string ---> ''_HubRxString '' On Entry: '' lmm_f = #_RXSTRING [+options] ' mode: #_RXSTRING[+_ECHO_][+_PROMPT][+_ADDR][+_NOLF] '' lmm_x = char(s) (optional) ' prompt: char(s) '' lmm_p = 'bufad' (optional) ' addr: input string (hub ptr) '' lmm_bufad = 'bufad' (default) ' addr: input string (hub ptr) '' Call Format: '' CALL #@_HubRxStrMon ' presets lmm_x & lmm_f < call: receive string > '' CALL #@_HubRxString ' < call: receive string > '' On Return: '' lmm_f = -same- ' mode: (unchanged) '' lmm_x = -same- ' '' lmm_p = 'addr' ' addr: input string (hub ptr) '' lmm_c = 'count' ' count: char(s) entered (incl , excl ) ''-------------------------------------------------------------------------------------------------- _HubRxStrMon mov lmm_x, #"*" ' prompt mov lmm_f, #_RXSTRING+_ECHO_+_PROMPT ' params _HubRxString MOV lmm_hx, lmm_x ' < push: 'x' #0 > ' ---------------------------------------- test lmm_f, #_PROMPT wz ' prompt ? if_z jmp #.noprompt ' n: ' Display prompt char(s) in lmm_x CALL #@_HubTx ' < call: transmit char(s) > ' setup the hub string address ptr .noprompt test lmm_f, #_ADDR wz ' {addr} supplied option ? if_z mov lmm_p, lmm_bufad ' n: use default hub buffer ' receive char(s) terminated in mov lmm_c, #0 ' set char count=0 .loop CALL #@_HubRx ' < call: receive char > cmp lmm_x, #_LF_ wz ' ? if_nz jmp #.notlf ' n: test lmm_f, #_NOLF wz ' strip ? if_nz jmp #.loop ' y: .notlf cmp lmm_x, #_BS_ wz ' ? if_z cmp lmm_c, #0 wz ' start of input ? if_z jmp #.loop ' y: skip cmp lmm_c, #_HUBBUFSIZE-2 wc ' c if < end-of-buf ? if_nc cmp lmm_x, #_BS_ wz ' ? if_nc_and_nz cmp lmm_x, #_CR_ wz ' ? if_nc_and_nz jmp #.loop ' j if buf full + not not (ignore) wrbyte lmm_x, lmm_p ' push input char to buf (don't inc ptr yet) test lmm_f, #_ECHO_ wz ' echo? if_z jmp #.noecho ' n: cmp lmm_x, #_BS_ wz ' ? if_z mov lmm_x, ##(_BS_+" "<<8+_BS_<<16) ' y: echo " " CALL #@_HubTx ' < call: transmit char(s) > cmp lmm_x, #_CR_ wz ' ? if_z mov lmm_x, #_LF_ ' y: follow with if_z CALL #@_HubTx ' rdbyte lmm_x, lmm_p ' restore input char .noecho cmp lmm_x, #_BS_ wz ' ? if_z sub lmm_p, #1 ' y: PTR-- if_z sub lmm_c, #1 ' y: CTR-- if_z jmp #.loop ' y: .notbs add lmm_p, #1 ' PTR++ add lmm_c, #1 ' CTR++ cmp lmm_x, #_CR_ wz ' ? if_nz jmp #.loop ' n: ' have a buffer with followed by terminated mov lmm_x, #0 '\ load $0 (nul) wrbyte lmm_x, lmm_p '/ push to buf sub lmm_p, lmm_c ' reset PTR to start of string ' ---------------------------------------- MOV lmm_x, lmm_hx ' < pop: 'x' #0 > RET wcz ' <--- return to calling routine ---> ''=============================================================================================== ''-------[ Monitor: DebugMonitor]---------------------------------------------- <--- monitor/debug ---> ''_HubMonitor '' lmm_bufad = 'bufad' ' hubbuf addr for use by _HubRxString '' Call Format: ' '' CALL #@_HubMonitor ' < call: monitor/debug> ''-------------------------------------------------------------------------------------------------- _HubMonitor CALL #@_HubRxStrMon ' < call: recv string > ' get optionl 1st param: [xxxxxx] hex/addr {addr} followed by 'cmd' .parse CALL #@_ParseHex ' < call: parse hex > '--------------------------------------------------------------- ' returns: lmm_x=addr(hex), lmm_c=digitcount, lmm_p=ptrnextchar ' lmm_w=next non-hex char with lcase converted to ucase '--------------------------------------------------------------- ' check commands w/o {addr} first cmp lmm_w, #_CR_ wz ' ? repeat LIST if_e jmp #@_Cmd_CR ' cmp lmm_w, #_TAQOZ_ wz ' ? TAQOZ if_e jmp #@_Enter_TAQOZ ' cmp lmm_w, #"L" wz ' "L" ? Load a file, don't run if_ne cmp lmm_w, #"R" wz ' "R" ? Run a file (Load & Run) if_e jmp #@_Cmd_Run ' cmp lmm_w, #"Q" wz ' "Q" ? QUIT if_e RET wcz ' y: return to caller <--- return to calling routine ---> '--------------------------------------- ' check commands w optional {addr} before cmd char cmp lmm_w, #"-" wz ' "-" ? LIST if_e jmp #@_Cmd_List ' cmp lmm_w, #":" wz ' ":" ? Download if_e jmp #@_Download ' cmp lmm_w, #"G" wz ' "G" ? GOSUB if_e jmp #@_Cmd_G ' '------------------------------------------------------- _Cmd_What mov lmm_x, ##("?"+_CR_<<8+_LF_<<16) ' unknown CALL #@_HubTx ' jmp #@_HubMonitor ' '------------------------------------------------------- _Cmd_CR ' repeat previous LIST command mov lmm_w, lmm_lf ' check valid list saved and lmm_w, #_MODE ' cmp lmm_w, #_LIST wz ' if_ne jmp #@_Cmd_What ' invalid mov lmm_f, lmm_lf '\ restore last saved list params mov lmm_p, lmm_lp '| mov lmm_p2, lmm_lp2 '/ CALL #@_HubList ' jmp #@_HubMonitor ' '------------------------------------------------------- ' LIST: get optional 2nd param: [yyyyyy] {addr2} optionally followed by "L" (L=long) _Cmd_List mov lmm_lp, lmm_x ' save {addr} mov lmm_lp2, #0 ' set {addr2} =0 cmp lmm_c, #4 wc ' c if digitcount <4 ? if_nc bith lmm_lp, #20 ' $1_xxxxx trick forces hub :) if_nc bith lmm_lp2, #20 ' $1_xxxxx trick forces hub :) '--------------------------------------- CALL #@_ParseHex ' < call: parse hex > '--------------------------------------------------------------- ' returns: lmm_x=addr(hex), lmm_c=digitcount, lmm_p=ptrnextchar ' lmm_w=next non-hex char with lcase converted to ucase '--------------------------------------------------------------- cmp lmm_c, #0 wz ' {addr2} ? if_z jmp #.list ' or lmm_lp2, lmm_x ' save {addr2} keep b20 '------------------------------------------------------- ' lmm_lp='addr', lmm_lp2='addr2', lmm_lc='digitcount of param1 '------------------------------------------------------- .list mov lmm_p, lmm_lp ' {addr} mov lmm_p2, lmm_lp2 ' {addr2} '--------------------------------------- cmp lmm_w, #"L" wz ' "L" ? LIST longs if_e mov lmm_f, #_LIST+_ADDR2+_LONG_ ' list addr2 in longs if_ne mov lmm_f, #_LIST+_ADDR2 ' list addr2 in bytes CALL #@_HubList ' jmp #@_HubMonitor ' '------------------------------------------------------- _Cmd_G ' xxxxxxG GOSUB cog/lut/hub address POP lmm_w ' pop stack cmp lmm_x, ##$FC000 wz ' is it a ROM reboot? if_z waitx ##delay1ms ' allow char to get out if_z hubset ##$1000_0000 ' y: reboot h/w CALL lmm_x ' call cog/lut/hub addr in lmm_x (not #lmm_x) jmp #@_HubMonitor ' '------------------------------------------------------- _Cmd_Run ' R ' Run filename "ffffffff.xxx" from SD ' ' L ' Load filename "ffffffff.xxx" from SD mov lmm_f, lmm_w ' save optional "L" call #@_ParseFname ' get filename.. mov fname, lmm_x ' call #@_ParseFname ' mov fname+1,lmm_x ' cmp lmm_w, #"." wz ' skipover "." ? if_z add lmm_p, #1 ' call #@_ParseFname ' mov fname+2,lmm_x ' cmp lmm_f, #"R" wz ' run? if_ne jmp #.load ' .run CALL #@_Run_SDfile ' run from SD jmp #.done ' .load CALL #@_LOAD_SDfile ' load from SD .done if_e mov lmm_x, ##("="+_CR_<<8+_LF_<<16) ' passed run if_ne mov lmm_x, ##("!"+_CR_<<8+_LF_<<16) ' failed run! CALL #@_HubTx ' jmp #@_HubMonitor ''=============================================================================================== ''-------[ Download Command ]-------------------------------------------------- <--- download command ---> '' On Entry: '' '--------------------------------------------------------------- '' ' lmm_x=addr(hex), lmm_c=digitcount, lmm_p=ptrnextchar '' '--------------------------------------------------------------- '' lmm_x = 'addr(hex)' ' addr(hex): download addr in cog/hub '' lmm_c = 'count' ' count: count of chars in 'addr' for cog/hub '' lmm_p = 'addr' ' addr: ptr to string (hub) '' lmm_p2 = ???? ' addr2: '' Call Format: '' CALL #@_Download ' < call: download command > '' On Return: '' ???? ''-------------------------------------------------------------------------------------------------- '' [xx]xxx : xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx ['xxxxxxxxxxxxxxxx'] ''-------------------------------------------------------------------------------------------------- _Download mov lmm_p2, lmm_x ' save download addr(hex) cmp lmm_c, #4 wc ' c if <4 digits (cog/lut?) if_nc bith lmm_p2, #31 ' n: set 'hub' .loop CALL #@_ParseHex ' get next hex value '--------------------------------------------------------------- ' returns: lmm_x=value(hex), lmm_c=digitcount, lmm_p=ptrnextchar ' lmm_w=next non-hex char with lcase converted to ucase '--------------------------------------------------------------- cmp lmm_c, #0 wz ' any input? if_z jmp #@_HubMonitor ' n: done so back to monitor testb lmm_p2, #31 wc ' hub? if_c jmp #.hub ' y: ' cog/lut ' get a long or 4 bytes for cog/lut cmp lmm_c, #8 wc ' c if <8 chars? if_nc jmp #.gotlong ' n: .getmore CALL #@_ParseHex2 ' get another hex byte cmp lmm_c, #8 wc ' c if <8 chars? if_nc jmp #.got4bytes ' n: cmp lmm_w, #_CR_ wz ' ? if_ne jmp #.getmore ' n: .got4bytes movbyts lmm_x, #%%0123 ' reverse bytes .gotlong cmp lmm_p2, #$1FF wcz ' c|z if <$200 (cog?) if_c_or_z jmp #.cog ' y: .lut wrlut lmm_x, lmm_p2 ' write a long to lut add lmm_p2, #1 ' PTR++ jmp #.loop ' write 'long' from lmm_x into cog 'addr' in lmm_p2.. don't forget we are in hubexec! .cog altd lmm_p2 '\ set PTR mov 0-0, lmm_x '/ write a long to cog add lmm_p2, #1 ' PTR++ jmp #.loop .hub cmp lmm_c, #3 wc ' c if <3 chars (byte) if_c wrbyte lmm_x, lmm_p2 ' write a byte to hub if_c add lmm_p2, #1 ' PTR++ (+1) if_c jmp #.loop cmp lmm_c, #5 wc ' c if <5 chars (word) if_c wrword lmm_x, lmm_p2 ' write a word to hub if_c add lmm_p2, #2 ' PTR++ (+2) if_c jmp #.loop wrlong lmm_x, lmm_p2 ' write a long to hub add lmm_p2, #4 ' PTR++ (+4) jmp #.loop ''=============================================================================================== ''-------[ Read Cog/Lut/Hub Long ]--------------------------------------------- <--- read: cog/lut/hub long ---> ''_RdLongCogHub '' On Entry: '' lmm_x = -anything- ' 'long': '' lmm_p = 'addr' ' 'addr': cog/lut addr / hub ptr '' Call Format: '' CALL #@_RdLongCogHub ' < call: read cog/lut/hub long > '' On Return: '' lmm_x = 'long' ' 'long': read from cog/hub '' lmm_p = 'addr++' ' 'addr++' cog/lut addr++ / hub ptr++ '--------------------------------------------------------------------------------------------------- _RdLongCogHub ' <--- read: cog/lut/hub long ---> cmp lmm_p, ##$3FF wcz ' z|c if =<$3FF = cog/lut mode? ' read the 'long' into lmm_x from hub 'addr' in lmm_p if_a rdlong lmm_x, lmm_p '\ read a long (hub) if_a add lmm_p, #4 '| PTR++ if_a RET WCZ '/ cmp lmm_p, #$1FF wcz ' z|c if =<$3FF = cog mode? ' read the 'long' into lmm_x from lut 'addr' in lmm_p if_a rdlut lmm_x, lmm_p '\ read a long (lut) if_a add lmm_p, #1 '| PTR++ if_a RET WCZ '/ ' read the 'long' into lmm_x from cog 'addr' in lmm_p.. ' don't forget we are executing from hub (hubexec) if_be alts lmm_p '\ set PTR if_be mov lmm_x, 0-0 '| read a long (cog) if_be add lmm_p, #1 '| PTR++ RET WCZ '/ ''=============================================================================================== ''-------[ Parse hex input ]--------------------------------------------------- <--- parse hex input ---> ''_ParseHex '' On Entry: '' lmm_x = -anything-/'hex' ' 'hex': ---/prev hex value '' lmm_c = -anything-/'count' ' 'count': ---/prev count '' lmm_p = 'addr' ' 'addr': ptr to string (hub) '' lmm_w = -anything- ' '' Call Format: '' CALL #@_ParseHex ' < call: parse hex > '' On Return: '' lmm_x = 'hex' ' 'hex': hex value '' lmm_c = 'count' ' 'count': of hex digits '' lmm_p = 'addr++' ' 'addr': ptr past next non-hex char '' lmm_w = 'ucase' ' 'ucase': next non-hex char in ucase ''-------------------------------------------------------------------------------------------------- _ParseHex ' <--- parse hex input ---> mov lmm_x, #0 ' preset hex=0 mov lmm_c, #0 ' preset count=0 _ParseHex2 rdbyte lmm_w, lmm_p '\ read a char from string cmp lmm_w, #" " wz '| " " ? if_e add lmm_p, #1 '| y: PTR++ if_e jmp #@_ParseHex2 '/ skip .loop rdbyte lmm_w, lmm_p ' read a char from string cmp lmm_w, #"_" wz ' "_" ? if_e add lmm_p, #1 ' y: PTR++ if_e jmp #.loop ' y: skip "_" cmp lmm_w, #"0" wc ' c if <"0" if_b jmp #.done ' j if not hex cmp lmm_w, #"9"+1 wc ' c if "0"-"9" if_b jmp #.num ' y: 0-9 or lmm_w, #$20 ' force lower case a-z cmp lmm_w, #"a" wc ' c if <"a" if_b jmp #.nothex ' j if not hex cmp lmm_w, #"f"+1 wc ' c if <"g" if_nc jmp #.nothex ' j if not hex sub lmm_w, #("A"-"9"-1) ' convert from A-F/a-f .num and lmm_w, #$0F ' extract valid nibble shl lmm_x, #4 ' shift nibbles or lmm_x, lmm_w ' and add nibble add lmm_p, #1 ' PTR++ add lmm_c, #1 ' CTR++ jmp #.loop ' ' ---------------------------------------- .nothex rdbyte lmm_w, lmm_p ' re-read the non-hex char cmp lmm_w, #$60 wc ' c if < lower case columns if_nc andn lmm_w, #$20 ' converts to uppercase columns .done cmp lmm_x, #_CR_ wc ' ? (don't skip over ) if_ne add lmm_p, #1 ' n: PTR++ (skip over non-hex char) RET wcz ' <--- return to calling routine ---> ''=============================================================================================== ''-------[ Parse ]-------------------------------------------------- <--- parse filename ---> '' On Entry: '' lmm_x = -anything- ' -anything- '' lmm_c = -anything- ' -anything- '' lmm_p = 'addr' ' 'addr': ptr to string (hub) '' lmm_w = -anything- ' '' Call Format: '' CALL #@_ParseFname ' < call: parse filename > '' On Return: '' lmm_x = 'fname' ' 'fname': 4 chars of filename '' lmm_c = -undefined- ' '' lmm_p = 'addr++' ' 'addr': '' lmm_w = _undefined- ' ''-------------------------------------------------------------------------------------------------- _ParseFname mov lmm_c, #4 ' 4 chars per call mov lmm_x, #0 .loop rdbyte lmm_w, lmm_p ' get a char cmp lmm_w, #"." wz if_ne cmp lmm_w, #_CR_ wz if_ne or lmm_x, lmm_w ' insert char.. if_e or lmm_x, #" " ' .. or space.. ror lmm_x, #8 ' .. & rotate byte if_ne add lmm_p, #1 ' PTR++ if_ne rdbyte lmm_w, lmm_p ' get a char _RET_ djnz lmm_c, #.loop ' <4 chars ''=============================================================================================== _str_vers byte "P2-MONITOR V1.0",$0D,$0A,0 ''=============================================================================================== alignl '******************************************************************************* '* * '* TAQOZ - Tachyon Forth for the Parallax P2 CPU ROM * '* * '******************************************************************************* CON '''''''''''''' SERIAL BUFFERS '''''''''' rxbuffers = $180 rxrd = $0C rxwr = $0E rxsize = $0E80 codeorg = $1000 ramdict = $B400 ' dictionary can be moved elsewhere at runtime' sys_clk = 80_000_000 nscnt = 100000/(sys_clk/1000000) '' baud_rate = 115200 '' baudval = (sys_clk/baud_rate)<<16 ' 180524 - implement 10-bit short literals and 9-bit task register addresses for compact fat32 variables' w = $F800 ' wordcode offset for 10-bit literals _IF = $FC00 ' IF relative forward branch 0 to 127 words _UNTIL = $FC80 ' UNTIL relative reverse branch 0 to 127 words opunused = $FD00 rg = $FE00 ' task/cog register 8-bit offset fat = $FF00 registers = rg 'Variables used by kernel + general-purpose tasks = rg+$D0 ' 2 longs/task * 8 cogs SKIPZ = _IF+01 ex = 1 ' EXITs (jump to hub wordcode instead of call) _FALSE = w+0 _0 = w+0 _1 = w+1 _2 = w+2 _3 = w+3 _4 = w+4 _5 = w+5 _6 = w+6 _7 = w+7 _8 = w+8 _9 = w+9 _13 = w+13 _16 = w+16 _32 = w+32 _BL = w+32 CON ' Offsets in LUT for stacks datstk = $000 brastk = $020 lpstk = $030 retstk = $040 ' The LUT is essentially free from $80 onwards CON lastkey = $00F0 ' written to directly from serialrx to hub ram ( reuse blank "R1" location ) numpadsz = 26 ' We really only need a large buffer for when long binary numbers with separators are used ' 26 digits for double number 18,446,744,073,709,551,615 wordsz = 39 ' any word up to 37 characters (1 count, 1 terminator) tasksz = 8 ' 8 bytes/task RUN[2] FLAG[1] ' fflags echo = 1 'linenums = 2 ' prepend line number to each new line ipmode = 4 ' interpret this number in IP format where a "." separates bytes prset = $10 ' private headers set as default sign = $20 comp = $40 ' force compilation of the current word - resets each time defining = $80 CON flashpins = spi_cs<<24+spi_do<<16+spi_di<<8+spi_ck sdpins = sd_cs<<24+sd_do<<16+sd_di<<8+sd_ck WW = $FFFF cntm = $1F ' mask for nfa count byte to mask off atrs' ' Dictionary header attribute flags pubatr = 0 priatr = 1 preatr = 2 modatr = 3 maxlen = 15 im = preatr<<6 'lexicon immediate bit pr = priatr<<6 'private (can be removed from the dictionary) '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' DAT orgh alignw ''-------[ Start TAQOZ ]----------------------------------------------------- <--- start TAQOZr ---> _Start_TAQOZ call #@_reset_booter ' reset the booters interrupts and autobaud _Enter_TAQOZ ''--------------------------------------------------------------------------------------------------- loc PTRA,#_hubrom ' copy all of ROM to low 64K' loc PTRB,#$C000 rep #2,##$1000 rdlong fx,PTRA++ wrlong fx,PTRB++ 'mov fx,##_ReEnter_TAQOZ & WW 'wrlong fx,#4 _ReEnter_TAQOZ { coginit #7,##@RESET coginit #6,##@RESET coginit #5,##@RESET coginit #4,##@RESET coginit #3,##@RESET coginit #2,##@RESET coginit #1,##@RESET } coginit #0,##@RESET dat orgh taqoz_version long 1_0 taqoz_time long 180530_0135 taqoz_name byte "142 " ' use exactly 4 characters = 1 long' { to do READ & WRITE BLOCKS OF SPI FLASH add RUN (NEWCOG and TASK !) } orgh { *** OUTPUT OPERATIONS *** } SPACE word _BL EMIT word rg+linenum,WFETCH word _IF+06,DUP,w+$0A,_EQ,_IF+02,DROP,_13 word rg+uemit,QJMP word CONEMIT,EXIT SPACES3 word _3 SPACES word _BL,SWAP ' ' EMITS ( ch cnt -- ) EMITS word QDUP,_IF+04,FOR,DUP,EMIT,forNEXT,DROPEX+ex ' ?EMIT ,( ch -- ) suppress emitting the character if echo flag is off QEMIT word w+echo,CHKFLG,SKIPZ,EMIT+ex DROPEX word DROP,EXIT ' mov txpin,#tx_pin _CON word rg+uemit,CLRL,EXIT ' direct output to a smartpin (after init) _COM word _PIN,_WORD,WRACK SETEMIT word rg+uemit WSTOREX word WSTORE,EXIT NONE word w+DROP,SETEMIT+ex SETKEY word rg+ukey,WSTOREX+ex CLS word w+$0C,EMIT+ex BELL word w+7,EMIT+ex SPINNER word rg+spincnt,CFETCH,_3,_SHR,_3,_AND word _STRING byte "|/-\ ",0 word PLUS,CFETCH word EMIT,_8,EMIT,rg+spincnt,CINC,_1,ms+ex ' ACCEPTED OK word PRTSTR byte " ok",0 CRLF word CR LF word w+$0A,EMIT+ex CR word _13,EMIT+ex ' emit printable ASCII or a dot otherwise AEMIT word QCHAR,_ZEQ word _IF+02,DROP DOT word w+".",EMIT+ex SCORE word w+"_",EMIT+ex PRTTICK word w+"'",EMIT+ex CHKFLG word rg+fflags,BITQ,EXIT CLRFLG word rg+fflags,CLR,EXIT SETFLG word rg+fflags,SET,EXIT ' U> SWAP U< ; UGT word SWAP,_ULT,EXIT ' <= ( n1 n2 -- flg ) LTEQ word SWAP ' => ( n1 n2 -- flg ) 1- > ; EQGT word DEC,GT,EXIT DIVIDE word OVER,_ABS,OVER,_ABS,UDIVIDE,ROT2,_XOR,MNEGATE,EXIT ' */ ( u1 u2 div1 -- res ) ' CLKHZ 1.333333 1,000,000 LAP */ LAP .LAP 35.200us ok MULDIV word ROT2,UMMUL,ROT,UMDIVMOD64,DROP,NIP,EXIT ' C-- CDEC word MINUS1,CINC+2+ex ' C++ CINC word _1,SWAP,CPLUSST,EXIT ' W-- WDEC word MINUS1,WINC+2+ex ' W++ WINC word _1,SWAP,WPLUSST,EXIT ' -- LDEC word MINUS1,LINC+2+ex ' ++ LINC word _1,SWAP,PLUSST,EXIT 'BOOTQ word rg+bootsig FETCHX word FETCH,EXIT ''''''''''''''''''' SMARTPIN MODES ''''''''''''''''' { %AAAA_BBBB_FFF_PPPPPPPPPPPPP_TT_MMMMM_0 %AAAA: �� �A�� "! input selector %BBBB: �� �B�� "! input selector %FFF: �� �A�� "! and �� �B�� "! input logic/filtering (after �� �A�� "! and �� �B�� "! input selectors) %P..P: low-level pin control (needs final silicon to fully operate) %TT: pin DIR/OUT control (default = %00) %MMMMM: 00000 = smart pin off (default) ( * OUT signal overridden ) 00 100* = pulse/cycle output 00 101* = transition output 00 110* = NCO frequency 00 111* = NCO duty 01 000* = PWM triangle 01 001* = PWM sawtooth } MUTE word _ATPIN,_FLOAT,_0,_WRPIN,EXIT MHZ word W1000,MUL16 KHZ word W1000,MUL16 HZ word NCOCNT NCO word w+%01_00110 ' ( Y X mode -- ) mode prescaler value ' SMART ( n mode -- ) SETNCO word _SHL1,_ATPIN,LOW,_WRPIN,_1,_WXPIN,_WYPIN,EXIT ' DUTY ( val -- ) $4E 100.1110 DUTY word w+%01_00111,SETNCO+ex ' -1/2 /CLKHZ/20000 == HZCON ' NCOCNT ( freq -- ncocnt ) HZCON #10000 */ ; HZCON word CONL long 536870 NCOCNT word HZCON,_WORD,10000,MULDIV,EXIT ' BLINK ( pin -- ) BLINK word _PIN,_2,HZ+ex '--- TRIANGLE PWM MODE ' PWM ( duty frame div -- ) @PIN LOW $50 WRPIN SWAP 16 << + WXPIN WYPIN ; PWM word w+$50 PWM1 word L,_WRPIN,SWAP,_SHL16,PLUS,_WXPIN,_WYPIN,EXIT SAW word w+$52,PWM1+ex ' SAW ( duty frame div -- ) @PIN LOW $50 WRPIN SWAP 16 << + WXPIN WYPIN ; ns word _WORD,nscnt,UDIVIDE,EXIT ' transistion mode ' PW ( width -- ) PW word L,w+%01_00101_0,_WRPIN,_WXPIN,EXIT PULSE word _1 PULSES word _WYPIN,EXIT ' HILO ( high low -- ) HILO word L,w+%01_00100_0,_WRPIN,SWAP,OVERPLUS,SWAP,_SHL16,_OR,_WXPIN,EXIT ''''''''''''''' SERIAL MODES '''''''''''''''''' DL word w+tepin,COGFETCH,EXIT ' BIT ( n -- ) Set bit length of serial smartpin interface BIT word DEC,w+tepin,COGSTORE,EXIT TXD word H,w+$7C ' BAUD ( baud mode -- ) BAUDST word _WRPIN,CLKHZ,SWAP,UDIVIDE,_SHL16,DL,_ZEQ,_IF+02,_8,BIT,DL,PLUS,_WXPIN,EXIT RXD word w+$3E,BAUDST+ex { TRANSMITTING ASYNCH TAQOZ# 34 PIN 8 BIT 115200 TXD ok TAQOZ# $55 WYPIN ok TAQOZ# $41 WYPIN ok TAQOZ# @NAMES 4 TXDAT ok } ' 1098 7654 321 0987654321098 76 54321 0 ' 0 0001 000 0000000000000 01 11100 0 ' D/# = %AAAA_BBBB_FFF_PPPPPPPPPPPPP_TT_MMMMM_0 ' 11100* = sync serial transmit (A-data, B-clock) ' SYNTX ( bits -- ) L $100.0078 WRPIN 1- $20 OR WXPIN ; SYNTX word w+$78 { pub TX WYPIN ; pub SERIAL ( pin -- ) PIN ' TX uemit W! ; } ''''''''''''''''''' CONSTANTS ''''''''''''''''''''' W1000000 word CONL long 1000000 W1000 word CONL long 1000 CLKHZ word CONL long sys_clk CLKKHZ word CONL long sys_clk/1000 CLKMHZ word CONL long sys_clk/1000000 ' ADDRESS OF TAQOZ BACKUP/RESTORE IN FLASH' BRORG word CONL long $F0000 BUFFERS word CONL long $F000 ROM word CONL long $0F_C000 IRQVEC word CONL long $0F_FFE0 { %0000_000E_DDDD_DDMM_MMMM_MMMM_PPPP_CCSS Set clock generator mode %0001_0000_0000_0000_0000_0000_0000_0000 Hard reset, reboots chip %001P_0000_0000_0000_0000_0000_0000_0000 Set write-protect of last 16KB RAM to P %01RR_0000_0000_0000_0000_0000_0LLT_TTTT Set filter R to length L and tap T %1DDD_DDDD_DDDD_DDDD_DDDD_DDDD_DDDD_DDDD Seed Xoroshiro128+ PRNG with D } REBOOT word w+1,HUBSW+ex WE word w+2,HUBSW+ex WP word w+3 HUBSW word w+28,_SHL HUBEX word _HUBSET,EXIT ' 1=80MZ 2=40MHZ 3=20MHZ 4=10MHZ 5=5MHZ CLKDIV word _1,_MAX,w+$1FF,SWAP,_SHR,HUBEX+ex RCSLOW word _1,HUBEX+ex { pub 50MHZ $9F HUBSET ; pub 45.4MHZ $8F HUBSET ; pub 62.5MHZ $C7 HUBSET ; } { *** NUMBER BASE *** } ' change the default number bases BIN word w+2 SETBASE word rg+base CSTOREX word CSTORE,EXIT DECIMAL word w+10,SETBASE+ex HEX word w+16,SETBASE+ex GETBASE word rg+BASE,CFETCH,EXIT ' >UPPER ( str1 -- ) Convert lower-case letters to upper-case TULP word INC TOUPPER word DUPCFT,QDUP,_IF+08 ' end of string? word w+"a",w+"z",WITHIN word _UNTIL+08 word w+$E0,OVER,CPLUSST,TULP+ex ' convert case (subtract $20) word DROPEX+ex { *** STRING TO NUMBER CONVERSION *** } DECQ word w+"0",w+"9",WITHIN+ex HEXQ word w+"A",w+"F",WITHIN+ex ' functional test for now - optimize later ' Convert ASCII value as a digit to a numeric value - only interested in bases up to 16 at present ' TODIGIT ' ( char -- val true | false ) word DUP,DECQ,_IF+04 ',td8 ' only work with 0..9,A..F word w+"0",MINUS TRUEX word _TRUE,EXIT ' pass decimal digits td8 word DUP,HEXQ,_IF+03 ',td2 word w+$37,MINUS,TRUEX+ex ' pass hex digits td2 word DROP FALX word _FALSE,EXIT { Try to convert a string to a number Allow all kinds of symbols but these are the rules for it to be treated as a number. 1. Leading character must be either a recognized prefix or a decimal digit 2. If trailing character is a recognized suffix then the first character must be a decimal digit Acceptable forms are: $1000 hex number 1000h #1000 decimal number 1000d %1000 binary number 1000b Also as long as the first character and last character are valid (0..9,prefix,suffix) then any symbols me be mixed in the number i.e. 11:59 11.59 #5_000_000 } OVEQ word THIRD,_EQ,EXIT _NUMBER ' ( str -- value digits | false ) word rg+4,CLRL ' REG0L = 0 word w+sign,CLRflg ' clear sign snlp word DUP,STRLEN,OVERPLUS,DEC,CFETCH,rg+suffix,CSTORE ' save suffix (assume string has count byte) word DUPCFT,w+"-",_EQ,_IF+03 ' save SIGN word w+sign,SETFLG,INC ' and use string without sign ' prefix may come after the sign word DUPCFT,DUP,rg+prefix,CSTORE ' save prefix (it may or may not be) ' PREFIX HANDLER ' ( str ch ) word _FALSE ' preset prefix flag = false ' $nnnn - set hex base - flag true word w+"$",OVEQ,_IF+02,HEX,INC word w+"#",OVEQ,_IF+02,DECIMAL,INC ' as does # - also set decimal base word w+"%",OVEQ,_IF+02,BIN,INC ' as does % - also set binary base word w+"&",OVEQ,_IF+05,DECIMAL,INC ' as does & - also set decimal base and IP notation word w+$80,rg+bnumber+3,CSTORE ' this forces "." symbols to work the same as ":" ' ( str ch flg ) word DUP,_IF+03,ROT,INC,ROT2 ' adjust string pointer to skip prefix ' ( str ch flg ) word SWAP,DECQ,_OR ' 0..9 forces processing as a number '' ( str flg ) flg is true if a prefix is found OR the first character is 0..9 word SKIPNZ,DROPFEX+ex ' ( -- false ) ' Give up now, it isn't a candiate '' ( str ) ' so far, so good, now check suffix ' SUFFIX HANDLER - must end in 0..9 or A..F or valid suffix word rg+suffix,CFETCH word DUP,DECQ ' 0..9 word OVER,HEXQ,_OR ' A..F ( str sfx flg ) true if still a digit word w+"h",OVEQ,_IF+02,HEX,INC ' h = HEX word w+"b",OVEQ,_IF+02,BIN,INC ' b = BINARY word SWAP,w+"d",_EQ,_IF+02,DECIMAL,INC ' d = DECIMAL word SKIPNZ,DROPFEX+ex ' bad suffix, no good ' so far the prefix and suffx have been checked prior to attempt a number conversion ' From here on there must be at least one valid digit for a number to be accepted ' DIGIT EXTRACTION & ACCUMULATION nmlp word DUPCFT,DUP,_IF+(nmend-nm1)/2 ' while there is another character nm1 word TODIGIT,_IF+(nmsym-nm2)/2 ' convert to a digit? or else check symbol ' a digit has been found but is it valid for this base? ' ( str val ) nm2 word DUP,GETBASE,DEC,GT,_IF+02 FALX2 word DROP2,FALX+ex ' a digit but exceeded base nmok word rg+anumber,FETCH,GETBASE,MULTIPLY ' shift anumber left one digit (base) word PLUS,rg+anumber,STORE ' and merge in new digit word rg+digits,CINC ' update number of digits nmnxt word INC,nmlp+ex ' update str and loop ' character was not a digit - check for valid symbols (keep it simple for now) ' SYMBOLS nmsym word DUPCFT,w+":",_EQ ' : ENTER word OVER,CFETCH,w+".",_EQ ' . dot word DUP,_IF+04,rg+digits,CFETCH,rg+dpl,CSTORE ' remember last decimal place ns01 word rg+bnumber,FETCH,_ZNE,_AND,_OR word _IF+10 ' Use : as special byte shift for IP notation etc nmsym1 word rg+bnumber,FETCH word rg+anumber,FETCH,PLUS,_SHL8 word rg+bnumber,STORE,rg+anumber,CLRL ' accumulate & number in bnumber nmsym2 word nmnxt+ex ' just ignore other symbols for now ' nmend ' end of string - check word DROP2,rg+digits,CFETCH,DUP,ZEXIT ' return with false if there are no digits word rg+anumber,FETCH,rg+bnumber,FETCH,PLUS word w+sign,CHKFLG,QNEGATE word SWAP,EXIT ' all good, return with number and true ' NUMBER processing -try to convert a string to a number NUMBER ' ( str -- value digits | false ) ' process control prefix i.e. ^A word DUP,STRLEN,_2,_EQ word OVER,CFETCH,w+"^",_EQ,_AND,_IF+06 ' ^ch Accept caret char as char word INC,CFETCH,w+$1F,_AND,_1,EXIT ' control character processed - single digit ' process character literal i.e. "A" ch01 word DUP,STRLEN,_3,_EQ word OVER,CFETCH,DUP,w+$22,_EQ,SWAP,w+$27,_EQ word _OR,_AND,_IF+04 ' "ch" or 'ch' Accept as an ASCII literal ascch word INC,CFETCH,_1,EXIT ' It wasn't an ASCII literal, process as a number ch02 word rg+anumber,w+10,ERASE ' zero out assembled number (double), digits, dpl word GETBASE,rg+base+1,CSTORE ' backup current base as it may be overridden word _NUMBER '( str -- digits num | false ) nmb1 word rg+base+1,CFETCH,SETBASE+ex ' restore default base before returning ' QFNUM ( -- flg ) Test if word is a fast prefixed number QFNUM 'word _TRUE,rg+wordbuf,DUP,STRLEN,ADO,IX,CFETCH,DECQ,_AND,LOOP,QDUP,IFEXIT word rg+wordbuf,CFETCH,w+"#",w+"%",WITHIN ' Numeric prefixes? word rg+wordbuf-1,CFETCH,_2,GT,_AND ' and more than 2 characters? (inc term) word rg+wordbuf-1,DUPCFT,PLUS,CFETCH ' and last char is a digit or hex digit? word DUP,DECQ ' decimal digit? word SWAP,HEXQ,_OR,_AND ' hex digit? word EXIT { *** COMPILER EXTENSIONS *** } ' Most of these words are acted upon immediately rather than compiled as they are ' part of the "compiler" in that they create the necessary structures ' ''' dumb compiler for literals - improve later - just needs to optimize the number of bytes needed LITCOMP ' ( n -- ) compile the literal according to size word DUP,_SHR16,_IF+07 ' Compile long word w+_LONG,COMPW ' compile the _LONG instruction word DUP,_SHR16,SWAP,COMPW,COMPW+ex ' compile the long itself ' Compile 2 bytes - 16bits .L1 word DUP,W+10,_SHR,_IF+03 ' 10 BIT LITERAL?' word w+_WORD,COMPW,COMPW+ex .L2 ' Compile short literal directly word _WORD,w,PLUS,COMPW+ex '''' BEGIN as in BEGIN...AGAIN or BEGIN...UNTIL generate branch for BEGIN _BEGIN_ word ATCODES,w+$BE ''' ''' MARK ( addr tag -- tag&addr ) Merge tag and addr by shifting tag into hi word MARK word w+24,_SHL ORX word _OR,EXIT ' UNMARK ( tag&addr -- addr tag ) UNMARK word DUP,MINUS1,_SHR8,_AND,SWAP,w+24,_SHR,EXIT ''' REPEAT if mark is $1F preceded by $BE mark _REPEAT_ word SWAP,_AGAIN_,_THEN_+ex ''' AGAIN if mark is $BE _AGAIN_ __AGAIN word UNMARK word w+$BE,_EQ,_IF+(badthen-ag1)/2 ' ( addr bc -- ) compile the wordcode and calculate the branch back ag1 word INC,COMPW+ex ''' UNTIL ( flg -- ) _UNTIL_ word UNMARK unt00 word w+$BE,_EQ,_IF+(badthen-unt1)/2 unt1 word ATCODES,SWAP,MINUS,_SHR1,INC word _WORD,_UNTIL,_OR,COMPW+ex ''' IF as in IF...THEN or IF...ELSE...THEN ''' WHILE _IF_ word ATCODES,w+$1F,MARK word _WORD,_IF,COMPW+ex ' compile an IF and a dummy branch (else/then will set) GOTO word ATCODES,w+$1E,MARK '' compile a dummy NOP to be replacd later with a goto (addr+ex) word w+_NOP,COMPW+ex ' ELSE _ELSE_ word UNMARK ' ( addr tag ) '' does this match an IF? word w+$1F,_EQ,_IF+(badthen-.L0)/2 '' mark the else to be processed on a THEN .L0 word GOTO ' '' get the IF addr and proceed as if it were a THEN word SWAP,w+$1F,MARK ' THEN _THEN_ word UNMARK '( addr tag ) ' ' ( addr tag ) resolve structure branch '' ELSE THEN ? word DUP,w+$1E,_EQ,_IF+05 word DROP,ATCODES,INC,SWAP,WSTOREX+ex '' IF THEN ? word w+$1F,_EQ,_IF+8 '' update IF's branch word ATCODES,OVER,MINUS,_SHR1,DEC,SWAP,CSTOREX+ex ' badthen word PRTSTR byte " Structure mismatch! ",0 word ERROR,DROPEX+ex ''''''''''''''''''''' STRINGS '''''''''''''''''''''''''' ' NULL$ NULLSTR word VARB,0 ' $! ( str1 str2 -- ) STRST word OVER,STRLEN,INC,CMOVE,EXIT ' $= ( str1 str2 -- flg ) STREQ word OVER,STRLEN,OVER,STRLEN,_EQ word _IF+14,DUP,STRLEN,ADO word CFETCHINC,IX,CFETCH,_NEQ,_IF+03,DROP,_0,LEAVE,LOOP,_ZNE,EXIT word DROP2,FALSE+ex ' STR ( -- n ) Leave address of inline string on stack and skip to next instruction _STRING word RPOP,DUP,STRLEN,OVERPLUS,INC,WALIGN,AJMP ' " string" Compile a literal string - no length restriction - any codes can be included except the delimiter " _STRING_ '' compile wordcodes for string word _WORD,_STRING,COMPW,COMPSTR+ex ' Print inline string PRTSTR word RPOP .lp word CFETCHINC,QDUP,_IF+02,EMIT,.lp+ex word WALIGN,PUSHR,EXIT ' PRINT" HELLO WORLD" Compile a literal print string - no length restriction - any codes can be included except the delimiter " _PSTR_ word _WORD,PRTSTR,COMPW COMPSTR word WKEY,DUP,QEMIT ' echo string word DUP,w+$22,_NEQ,_IF+02,COMPC,COMPSTR+ex '' word align end of string with an extra null word ATCODES,_1,_AND,_ZEQ,_IF+02,_0,COMPC word DROP,_0 COMPC word ATCODES,WSTORE '' advance code write address by 1 word rg+codes,LINC,COMPX+ex ' ( wordcode -- ) append this wordcode to next free code location + append EXIT (without counting) COMPW word ATCODES,WALIGN,WSTORE word _2,rg+codes,WPLUSST '' word WALIGN '' advance code write address by 2 '' word rg+codes,STORE '' compile an EXIT after the latest codes COMPX word w+EXIT,ATCODES,WSTOREX+ex ' C, or | ( n -- ) IMMEDIATE --- compile a byte into code and allocate CCOMP word GRAB,COMPC,rg+codes,WFETCH,_1,_AND,IFEXIT,ALLOCATED+ex ' W, or || ( n -- ) WCOMP word GRAB,WCOMMA+ex ' , ( n -- ) Compile a long literal LCOMP word GRAB COMPL word DUP,COMPW,_SHR16 WCOMMA word COMPW,ALLOCATED+ex ' ALLOT ( bytes -- ) ALLOT word rg+codes,PLUSST,ALLOCATED+ex ' lock in compiled code so far - do not release but set new "here" to the end of these codes ALLOCATED word ATCODES,rg+here,STOREX+ex ' GRAB ( -- ) \ IMMEDIATE --- executes preceding code to make it available for any immediate words following GRAB word w+EXIT,COMPW ' append an EXIT word ATHERE,DUP,rg+codes,STORE,ACALL ' execute and release preceding code in text line word EXIT ' NFA' ( -- nfaptr ) ' COMPILE ( not used in this version ) NFATICK word _GETWORD,DEC,SEARCH+ex _NFATICK word NFATICK,LITCOMP+ex ' The CPA is the address of the word code stored in the header that points to the code to execute ' 03,D,U,P,CPAL,CPAH' ' CPA ( nfa -- cpa ) NFACPA word CFETCHINC,w+cntm,_AND,PLUS,EXIT ' ' ( -- pfa ) Find the address of the following word - zero if not found or its CFA/PFA TICK word NFATICK ' CFA ( nfa -- cfa )' NFACFA word DUP,ZEXIT,NFACPA,WFETCH,EXIT ATICK word TICK,LITCOMP+ex WALIGN word INC,_1,_ANDN,EXIT _ALIGNL word _4 ' ALIGN ( address align -- val00 ) 1- SWAP OVER + SWAP ANDN ; _ALIGN word DEC,SWAP,OVERPLUS,SWAP,_ANDN,EXIT {HELP _HERE ( -- addr ) Address of next compilation location } ATHERE word rg+here,WFETCH,EXIT ' ( -- atradr ) --- point to the attribute byte in the header of the latest name ATATR ATNAMES word rg+names,FETCHX+ex ATCODES word rg+codes,WFETCH,EXIT ' CREATEWORD - create a name in the dictionary using the next word encountered '' cnt,name,atr,cpa CREATEWORD word _GETWORD ' ( str ) read the next word ' CREATE$ ( str -- ) CREATESTR ' skip empty string ' word DUPCFT,SKIPNZ,DROPEX+ex ' ' get attribute ' word rg+fflags,CFETCH,w+prset,_AND ' setup CPA field right now ' word ATCODES,ATNAMES,DEC2,WSTORE ' build up a header in the word buffer then copy across ' get string count ( str ) word DEC,DUP,CFETCH,INC ' ( c+str size )' ' ( str size ) update names ptr by backwards count + cpa field word DUP,INC2,NEGATE,rg+names,PLUSST '' copy it across word ATNAMES,SWAP,CMOVE '' check for dictionary full ( less than 64 bytes ) word ATNAMES,ATHERE word w+64,PLUS,LT,ZEXIT,PRTSTR byte " Dictionary full! ",0 word ERROR+ex ' CREATE - Create a name in the dictionary and also a VARIABLE code entry - or revectored through NOP CREATE word _NOP,CREATEWORD,w+VARB,COMPW,_0,ALLOT+ex ' Change the value of a constant ' pub ==! ( val 'con -- ) 2+ ! ; CONST word INC2,STOREX+ex _VAR word CREATE,_0,COMPL+ex ' := _CON9 word GRAB,CREATEWORD,BITS9,_WORD,w,PLUS,ATNAMES,NFACPA,WSTOREX+ex ' == _CONST word GRAB,CREATEWORD,w+CONL DCOMP word COMPW,COMPL,_0,ALLOT+ex ' Identical to a constant except the call address is slightly different so a FORGET can release the data area _DATCON word GRAB,CREATEWORD word w+DATCON,DCOMP+ex ' GETATR ( -- code ) GETATR word ATNAMES,_6,_SHR,EXIT ' Create a new entry in the dictionary but also prevent any execution of code ' : PUBDEF NEWDEF word CREATEWORD REDEF word w+defining,SETFLG+ex ' flag that we have entered a definition 'MODDEF word w+modatr,SDEF+ex PREDEF word w+preatr,SDEF+ex PRIDEF word w+priatr SDEF word NEWDEF ' SETATR ( code -- ) SETATR word _6,_SHL,ATNAMES,CFETCH,w+cntm,_AND,_OR,ATNAMES,CSTORE,EXIT ' Update "here" pointer to point to current free position which "codes" pointer is now at ' Also unsmudge the headers tag ' ENDDEF word w+EXIT,COMPW ' compile an EXIT UNDEF word w+defining,CLRFLG,ALLOCATED+ex ' end definition and lock allocated bytes ' [C] force compilation of the next word COMPILES word w+comp,SETFLG+ex ' ************** CASE STATEMENTS *********************8 ' SWITCH ( val -- ) _SWITCH word rg+uswitch,STOREX+ex ' SWITCH@ ( -- val ) SWFETCH word rg+uswitch,FETCHX+ex ' SWITCH= ( val -- flg ) ISEQ word SWFETCH,_EQ,EXIT ' CASE ( compare -- ) _CASE word _WORD,ISEQ,COMPW,_IF_+ex ' BREAK ISEND word w+EXIT,COMPW,_THEN_,ALLOCATED+ex ' SWITCH>< ( from to -- flg ).. ISWITHIN word SWFETCH,ROT2,WITHIN+ex { Table vectoring - index a table of vectors and jump to that vector A table limit is supplied as well as a default vector Usage: VECTORS ...... ) Sample: 4 LOOKUP BELL \ an index of 4 or more will default to BELL INDEX0 INDEX1 INDEX2 INDEX3 \ 0 to 3 will execute corresponding vectors } { ' LOOKUP ' VECTORS ( index range -- ) VECTORS word OVER,GT,_ZEQ,_IF+02,DROP,MINUS1 ' limit index to range or -1 (.>0) .L0 word INC,_SHL1,RPOP,PLUS,WFETCH,ACALL,EXIT } ' ( n lo hi -- flg ) true if n is within range of low and high inclusive WITHIN word INC,OVER,MINUS,PUSHR word MINUS,RPOP,_ULT WT1 word _ZNE,EXIT { *** MOVES & FILLS *** } ' D during text input DEBUG word PRTSTKS word PRTSTR byte $0D,$0A,"REGS ",0 word rg+temp,w+$100,DUMPW word PRTSTR byte $0D,$0A,"CODE ",0 word ATHERE,_32,MINUS,w+64,DUMPW word PRTSTR byte $0D,$0A,"WORDS",0 word ATNAMES,w+$40,DUMPB word CRLF,lsio word CRLF+ex PRTP word CRLF,PRTSTR byte $0D,"P:",0 word EXIT lsio word PRTP word w+62,_0,DO,IX,w+10,DIVIDE,PRINT,LOOP word PRTP word w+62,_0,DO,IX,w+10,UMOD,PRINT,LOOP word CRLF,PRTSTR byte $0D,"=:",0 word w+62,_0,DO word IX,LOW,w+200,WAIT,IX,_FLOAT,w+200,WAIT,IX,PINTEST,_1,_AND,_SHL1 word IX,HIGH,w+200,WAIT,IX,_FLOAT,w+200,WAIT,IX,PINTEST,_1,_AND,_OR word _STRING byte "d~ch ",0 word PLUS,CFETCH,EMIT,LOOP word EXIT QCHAR word DUP,_BL,w+$7E,WITHIN+ex TOCHAR word QCHAR,_ZEQ,_IF+02,DROP,w+$20,EXIT ' @PAD ( -- addr ) pointer to current position in number pad ATPAD word rg+padwr,CFETCH,rg+numpad,PLUS,EXIT ' >CHAR ( val -- ch ) convert binary value to an ASCII character BINASC word w+$3F,_AND,w+"0",PLUS,DUP,w+"9" ' convert to "0".."9" word GT,_7,_AND,PLUS ' convert to "A".. word DUP,w+$5D,GT,ZEXIT,_3,PLUS,EXIT ' skip symbols to go to "a".. ' <# ' resets number pad write index to end of pad LHASH word w+numpadsz,rg+padwr,CSTORE,_0 ''' ' HOLD ( char -- ) HOLD word rg+padwr,CDEC,ATPAD,CSTOREX+ex ' # ( n1 -- n2 ) convert the next ls digit of a double to a char and prepend to number string HASH word rg+double,FETCH,GETBASE,UMDIVMOD64,rg+double,STORE word SWAP,BINASC,HOLD+ex ' conversion digits exhausted, use zeros or spaces ' #S ( d1 -- 0 ) Convert all digits HASHS word HASH,DUP,_ZEQ,_UNTIL+04,EXIT ' #> ( n1 -- caddr ) RHASH word DROP,ATPAD,rg+double,CLRL,EXIT ' ( d1 -- n1 ) ' Store high long of double for formating DNUM word rg+double STOREX word STORE,EXIT ' . ( n -- ) Print the number off the stack PRINT PRT word DUP,_ZLT,_IF+03,w+"-",EMIT,NEGATE ''' ' U. ( n -- ) Print an unsigned number UPRT word LHASH,HASHS,RHASH ''' ' PRINT$ ( adr -- ) Print the null or 8th bit terminated string - stops on any non-printable character PRINTSTR word DUP,INC,SWAP,DCFETCH,QDUP,_IF+02,EMIT,PRINTSTR+ex pstrxt word DROP,RAM+ex ' since printing a 32-bit binary number with formatting can be quite long, this one prints directly PRTBIN word w+"%",EMIT,_BL,FOR,DUP,w+31,_SHR,w+"0",PLUS,EMIT,_SHL1,forNEXT,DROPEX+ex { .AS" Format string spec: # Convert one digit (default is decimal) ~ Toggle leading zero suppression \ pad leading zeros with spaces $| Hexadecimal *| Convert all remaining digits 4| Convert 4 digits } DZEQ word DUP2,_OR,_ZEQ,EXIT AHASH word DZEQ,_2,rg+pflg,BITQ,_AND,_IF+02,w+$20,HOLD+ex,rg+pbase,CFETCH,UMDIVMOD64,ROT,BINASC,HOLD+ex ASHASH word _SWITCH,_4,rg+pflg,BITQ,_NOT,_4,rg+pflg,CLR,_IF+(ASCMD-.L3)/2 .L3 word w+"|",ISEQ,_IF+04,_4,rg+pflg,SET,EXIT word w+"~",ISEQ,_IF+03,rg+pflg,CINC,EXIT word w+"\",ISEQ,_IF+04,_2,rg+pflg,SET,EXIT word DZEQ,_1,rg+pflg,BITQ,_AND,IFEXIT word w+"#",ISEQ,_IF+(ASONE-.L0)/2 .L0 word AHASH+ex '' $| command - hexadecimal ASCMD word w+"$",ISEQ,_IF+03,_16,rg+pbase,CSTOREX+ex '' n| multiple # command 3 TO 9 word SWFETCH,w+"3",w+"9",WITHIN,_IF+07,SWFETCH,w+"0",MINUS,FOR,AHASH,forNEXT,EXIT '' *| Convert remaining digits .L2 word w+"*",ISEQ,_IF+05,DUP2,_OR,ZEXIT,AHASH,.L2+ex '' [| send an escape word w+"[",ISEQ,_IF+02,w+$1B,AHOLD+ex '' @| treat simply as ASCII word w+"@",ISEQ,_IF+03,OVER,BITS8,AHOLD+ex '' literal character ASONE word SWFETCH,HOLD+ex AHOLD word TOCHAR,HOLD+ex PRTAST word RPOP,DUP,STRLEN,INC2,_1,_ANDN,OVERPLUS,PUSHR PRTAS word rg+pflg,CLRC,w+10,rg+pbase,CSTORE word rg+double,FETCH,SWAP,LHASH,DUP,STRLEN word DEC,OVERPLUS,rg+pfmt,STORE,STRLEN word FOR,rg+pfmt,FETCH,CFETCH,ASHASH,rg+pfmt,LDEC,forNEXT word DROP,RHASH,PRINTSTR+ex PRTASR word _WORD,PRTAST,COMPW,COMPSTR+ex PRTDECL word PRTAST byte "##,###,###,##~#",0 word EXIT PRTDEC4 word PRTAST byte "###\#",0 word EXIT PRTDEC2 word PRTAST byte ".##",0 word EXIT { PRTDEC2D word PRTAST byte "##.",0 word EXIT } ' Print decimal with at least a single digit PRTDEC word PRTAST byte "*|#",0 word EXIT '--------------------------------------------------- { *** CONSOLE INPUT HANDLERS *** } { Replaced traditional parse function with realtime stream parsing Each word is acted upon when a delimiter is encountered and this also allows for interactive error checking and even autocompletion. } ' SCRUB --- scrub out any temporary compiled code, restore the code pointers etc. SCRUB word ATHERE,rg+codes,STORE word rg+wordcnt,CLRC,rg+wordbuf,CLRC '' restore end-of-line delimiter to a CR word _13,rg+delim+1,CSTORE '' print long line of dashes PRTDASH word CR,w+"-",w+64,EMITS+ex ' ( ch -- ) write a character into the next free position in the word buffer PUTCHAR word rg+wordcnt,CFETCHINC,PLUS,CSTOREX+ex PUTCHARPL word PUTCHAR,rg+wordcnt,DUPCFT,INC word w+wordsz,UMOD,SWAP,CSTOREX+ex ' As characters are accepted from the input stream, checks need to be made for delimiters, ' editing commands etc. 123us/CHAR, 184us/CTRL doCHAR ' ( char -- flg ) Process char into wordbuf and flag true if all done ' ignore null word DUP,ZEXIT ' delimiter is always last character word DUP,rg+delim+1,CSTORE ' Replace DEL with BS word w+$7F,OVER,_EQ,_IF+02,DROP,_8 ' only check for control characters dch1 word DUP,_BL,LT,_IF+(ischar-ctrls)/2 ' ' PROCESS CONTROL CHARACTERS ' ctrls '' discard LF word w+$0A,OVER,_EQ,SKIPZ,DROPFEX+ex '' ^W WORDS word w+$17,OVER,_EQ,_IF+04,DROP,WORDS,CRLF,FALX+ex '' ^R FIXDICT '' word w+$12,OVER,_EQ,_IF+03,DROP,FIXDICT,FALX+ex ' ^X reeXecute previous compiled line word w+$18,OVER,_EQ,_IF+02,DROP,TRUEX+ex '' ^C RESET word _3,OVER,_EQ,SKIPZ,RESET ' ^R RESTORE word w+$12,OVER,_EQ,_IF+03,DROP,RESTORE,TERMINAL '' ^V VERSION word w+$16,OVER,_EQ,_IF+02,PRTVER,CONSOLE+ex ' ^D DEBUGGER word _4,OVER,_EQ,_IF+03,DROP,DEBUGGER,FALX+ex ' ^? DEBUG word w+$1F,OVER,_EQ,_IF+03,DROP,DEBUG,FALX+ex ' ^Q print top stack word w+$11,OVER,_EQ,_IF+04,DROP,PRTSTK,CRLF,FALX+ex ' ^S clear Stack word w+$13,OVER,_EQ,_IF+03,DROP,INITSP,FALX+ex ' ^B Block dump word _2,OVER,_EQ,_IF+06,DROP word _0,w+$100,_SHL8 word DUMPB,FALX+ex ' ^Z^Z cold start word w+$1A,OVER,_EQ '''rg,prevch+1,CFETCH,w+$1A,_EQ,_AND word _IF+03,DROP,COLDST,RESET '''SCRUB,FALX+ex ignore2 word w+$1B,OVER,_EQ,_IF+03,DROP,SCRUB,TRUEX+ex ' ESC will cancel line ig01 word _9,OVER,_EQ,_IF+02,EMIT,_BL ' TAB - substitute with a space ig02 word w+$1C,OVER,_EQ,_IF+03,DROP,CRLF,_BL ' ^| - multi-line interactive ig03 word _13,OVER,_EQ,_IF+02,DROP,TRUEX+ex ' CR - Return & indicate completion ig04 ' word _8,OVER,_EQ,_IF+(ischar-bksp1)/2 ' BKSP - null out last char bksp1 word rg+wordcnt,CFETCH,_IF+09 ' don't backspace on empty word bksp2 word EMIT,SPACE,_8,EMIT ' backspace and clear word rg+wordcnt,CDEC,_0,PUTCHAR ' null previous char word FALX+ex '' ' bksp3 word _7,EMIT,DROPFEX+ex ' can't backspace anymore, bell ' ischar word w+echo,CHKFLG,_IF+02,DUP,EMIT ' don't echo if we don't want it .L0 word rg+delim,CFETCH,OVER,_EQ ' delimiter? (always accept a blank) word OVER,_BL,_EQ,_OR,_IF+04,DROP,rg+wordcnt,CFETCH,EXIT ' true if trailing delimiter - all done (flg=cnt) ' ' otherwise build text in wordbuf - null terminated with a preceding count ..... .L1 word PUTCHARPL,FALX+ex ' put a character into the word buffer ' Build a delimited word in wordbuf for wordcnt and return immediately upon a valid delimiter _GETWORD ' ( -- str ) ' Erase the word buffer & preceding count word rg+wordcnt,w+wordsz,ERASE 'word w+6,PEN ' get another character word WKEY,doCHAR,_UNTIL+03 'word PLAIN word rg+wordbuf,EXIT { ****************** DICTIONARY SEARCH ********************** } ' SEARCH ( cstr -- nfaptr ) ' cstr points to the count+strinw+null SEARCH word rg+ufind,QJMP ' use alternative method if enabled (hash search) word DUP,ATNAMES,FINDSTR word QDUP,_IF+02,NIP,EXIT ' found it - return now with result DROPFEX word DROP,FALX+ex ' not found in dictionary ' Discard the current line DISCARD dslp word KEY,_ZEQ,_UNTIL+03 ' fast discard ds01 word w+20,ms,KEY,_ZEQ,_UNTIL+08,EXIT ' pause and check and repeat if necessarys ATID word _COGID ' TASK ( cog -- addr ) Return with address of task control register in "tasks" TASK word _3,_SHL,_WORD,tasks,PLUS,EXIT { TASK RECORD 0 ENTRY CODE ADDRESS 4 flags } IDLE word INITSTKS word ATID,_8,ERASE idlp word _1,ATID,_3,PLUS,CPLUSST ' increment task+3 to indicate Tachyon running word w+10,ms ' do nothing for a bit - saves power word ATID,WFETCH ' fetch cog's task variable word QDUP,_UNTIL+11 ' until it is non-zero word ACALL ' Execute word ATID,CLRW ' clear run address only if it has returned back to idle word IDLE+ex AUTORUN word TICK,rg+autovec,WSTOREX+ex radix byte "01%34567o9#BCDEF$ " '' List line number if enabled PROMPT '' execute user prompt code word rg+uprompt,WFETCH,QDUP,_IF+02,ACALL,trl1+ex word rg+linenum,WFETCH,_IF+08 '' display line# word CR,rg+linenum,WFETCH,PRTDEC4,SPACES3 '' increment line# word rg+linenum,WINC,EXIT '' Prompt with version and base word PRTSTR byte "TAQOZ",0 '' prompt char = base %#$ etc word GETBASE,_WORD,radix,PLUS,CFETCH,EMIT,SPACE+ex ' COLD Force factory defaults COLDST FIXDICT ' Copy dictionary from ROM to area just before copied ROM in bank 0' word _LONG long romdict word _LONG long ramdict word _WORD,enddict-romdict,CMOVE '' initialize task registers word rg+0,w+$100,ERASE '' free memory backup word _WORD,codeorg word DUP,rg+here,STORE,rg+here-4,STORE word _word,endcode,DATORG word _LONG long ramdict word rg+names,STORE '' word DUP,rg+names,STORE,rg+oldnames,STORE ' reset cold start XCOLD word _CON,PRTSTR byte "x",$0D,$0A," Cold start",0 word _WORD,$A55A,rg+cold,WSTOREX+ex { *** MAIN TERMINAL CONSOLE *** } TERMINAL word InitRP,INITSP ' Init the internal stack and setup external stack space word WP,w+50,ms ' a little startup delay (also wait for serial cog) word w+$10,w+$160,ERASE '' performing a check for a saved session word rg+cold,WFETCH,_WORD,$A55A,_NEQ,SKIPZ,COLDST word _CON word rg+keypoll,CLRW,rg+accept,CLRW word rg+linenum,CLRW word _1,rg+fflags,WSTORE '' Show VERSION with optional CLS (default CR) 'word w+3,PEN word CRLF 'word REVERSE word PRTDASH,CRLF,PRTVER '' word _GETRND,rg+bootsig,STORE '' ^A abort autostart with ^A word w+lastkey,CFETCH,_1,_NEQ,_IF+(CS1-.L0)/2 '' check for an AUTORUN word rg+autovec,WFETCH,QDUP,SKIPZ,ACALL '' Set the rx buffer size .L0 word DECIMAL '' echo on word w+echo,rg+fflags,CSTORE '' default delimiter is a space character word _BL,rg+delim,CSTORE '' word MOUNT '' word w+"!",w+rxbuffers,CSTORE ' CONSOLE word InitRP,SCRUB,CRLF '',PLAIN '' Stop compilation CS1 word w+defining,CLRFLG ' ' *** Main console line loop - get a new line (word by word) *** ' '------------------------------------------------------------- LINELP word PROMPT '' reset temporary code compilation pointer trl1 word ATHERE,rg+codes,STORE ' '' Main console loop - read a word and process WORDLP word _GETWORD word _4,rg+fflags+1,CLR '' ignore empty string word CFETCH,_ZEQ,_IF+(EVAL-.L0)/2 '' ^X then repeat last line .L0 word rg+delim+1,CFETCH,w+$18,_NEQ,_IF+(execinp-.L2)/2 '' Otherwise process ENTER .L2 word rg+delim+1,CFETCH,_13,_NEQ,_IF+(chkeol-EVAL)/2 '' good, try to process this as a number first (for speed) EVAL word QFNUM,_ZEQ,_IF+(TRYNUM-trm4)/2 '' otherwise search the dicitonary for a match (as a counted string) trm4 word rg+wordbuf,DEC,SEARCH '' found it word QDUP,_IF+(TRYNUM-foundword)/2 '' found the word in the dictionary - compile or execute? foundword ' point to attribute word (CNT,,ATR,CPA) word DUP,NFACFA ' ( cpa cfa ) '' is the immediate bit set? word SWAP,CFETCH,_6,_SHR,w+preatr,_EQ '' and comp flag off (not forced to compile with [COMPILE]) word w+comp,CHKFLG,_ZEQ,_AND '' Fetch and EXECUTE code immediately word _IF+02,ACALL,chkeol+ex compword '' or else COMPILE the wordcode(s) for this word word COMPW '' reset any forced compile mode via [COMPILE] word w+comp,CLRFLG '' *** END OF LINE CHECK *** chkeol word rg+delim+1,CFETCH,_13,_EQ word DUP,_IF+(eol01-.L0)/2 '' Yes, put a space between any user input and response .L0 word rg+accept,WFETCH,SKIPNZ,SPACE '' word PROMPT '' and are we in a definition or interactive? eol01 word DUP,w+defining,CHKFLG,_AND '' If not interactive then CRLF (no other response) word SKIPZ,CRLF '' do not execute if still defining eol02 word w+defining,CHKFLG,_ZEQ,_AND '' wait until CR to execute compiled codes word _UNTIL+(.L0-WORDLP)/2 .L0 execs '' EXECUTE CODE from user input (append an EXIT first) word w+EXIT,COMPW '' execute wordcodes from beginning execinp word ATHERE,ACALL '' execute accept vector if 0<> word rg+accept,WFETCH,QDUP,_IF+02,ACALL,LINELP+ex word rg+linenum,WFETCH,SKIPNZ,OK,LINELP+ex '------------------------------------------------------------- TRYNUM '' Attempt to process this word as a number but check for special literals first (^ ' etc) word rg+wordbuf,NUMBER,_IF+02 '' is it a number? ( value digits ) compnum word LITCOMP,chkeol+ex '' Unknown word or number - try converting case first time UNKNOWN word rg+fflags+1,CFETCH,_4,_AND,_ZEQ word _IF+06,_4,rg+fflags+1,CPLUSST word rg+wordbuf,TOUPPER,trm4+ex '' UNKNOWN - try unum vector if set word rg+unum,WFETCH,QDUP,_IF+02,ACALL,chkeol+ex ' ' Failed all searches and conversions!!!! ' '' interactive or in the middle of a definition? word w+defining,rg+fflags,CFETCH,_AND,_IF+(HUH-nfdef)/2 '' Display position in line of error nfdef word PRTSTR byte 9,9," error in ",0 word ATNAMES,INC,PRINTSTR,PRTSTR byte " at ",0 '' Spit out offending word word rg+wordbuf,PRINTSTR,SPACE '' discard but echo remainder of line .L0 word KEY,DUP,_13,_NEQ,_IF+02,EMIT,.L0+ex .L1 word DROP '' count errors and force a new line to display error ERROR word rg+errors,WINC,w+$10A,EMIT ERRSTR word PRTSTR byte " *error* ",7,$0D,$0A,$0B,0 ' '' force a new line to prevent overwrite then return to console word w+$10A,EMIT,DISCARD,INITSP,_END,CONSOLE+ex ' as-you-go error prompt in interactive mode HUH word PRTSTR byte " ??? ",0 word WORDLP+ex PRTSTK word CRLF,PRTSTR byte " DATA STACK (",0 word _DEPTH,DUP,PRINT1 word ZEXIT word _DEPTH,DUP,_0 word DO,CRLF,IX,INC,PRINT,SPACES3,DEC,DUP,INC4,LUTFETCH,DUP,PRTL,SPACES3,PRINT,LOOP word DROPEX+ex PRINT1 word PRINT,w+")",EMIT+ex PRTSTKS word PRTSTK PRTRET word CRLF,PRTSTR byte " RETURN (",0 word w+retstk,w+retptr PRTSTKX word COGFETCH,DUP2,SWAP,MINUS,PRINT1 DMPSTK word SPACES3,SWAP .L0 word DUP2,_NEQ,_IF+06,DUP,LUTFETCH,SPACE,PRTL,INC,.L0+ex,DROP2,EXIT ' KEY! ( ch -- ) Force a character as the next KEY read PUTKEY word rg+keychar,STOREX+ex ' KEY ( -- ch ) if ch is zero then no key was read KEY word rg+keychar,CFETCH,QDUP,_IF+06 ' read a "key" that was forced with KEY! word rg+keychar,FETCH,_SHR8,rg+keychar,STORE,CHKKEY+ex word rg+ukey,WFETCH,_IF+06,rg+ukey,WFETCH,ACALL word DUP,IFEXIT,DOPOLL+ex CONKEY word READRX DOKEY word DUP,_IF+07 word BITS8,DUP,_ZEQ,ZEXIT ' return as if non-zero word w+$0100,PLUS,EXIT ' otherwise add $100 to a null ' DOPOLL word rg+keypoll,QJMP ' execute background polling while waiting for input word EXIT ' keep a track of the position of the this key on the input line (useful for assembler etc) CHKKEY word rg+keycol,CINC,DUP,_13,_EQ,ZEXIT,rg+keycol,CLRC,EXIT ' background polling while waiting for a key ' WKEY ( -- ch ) wait for a key and return with character WKEY word KEY,QDUP,_UNTIL+03,BITS8,EXIT { *** COMMENTING *** } '' \ ( -- ) '' Ignore following text till the end of line. '' IMMED COMMENT word rg+delim+1,CFETCH,_13,_NEQ,ZEXIT ' ignore is this is an empty line .L0 word KEY,_13,_EQ,_UNTIL+04 ' terminate comment on a CR word _13,rg+keychar,STOREX+ex ' force a CR back into the key stream on exit PAREN word KEY,DUP,QEMIT,w+")",_EQ,_UNTIL+06,EXIT IFDEF word NFATICK,_ZEQ,ZEXIT,BRACE+ex IFNDEF word NFATICK,ZEXIT '''' ' Block comments - allow nested operation '''' BRACE word _1 ' allow nesting by counting braces .LP word WKEY ' keep reading each char until we have a matching closing brace word DUP,w+"{",_EQ,_IF+03,DROP,INC,.LP+ex ' add up opening braces word w+"}",_EQ,SKIPZ,DEC ' count down closing braces word DUP,_ZEQ,_UNTIL+15,DROPEX+ex ' 06,F,O,R,G,E,T,CODEL,CODEH FORGET word NFATICK,GRAB,QDUP,_IF+17 word DUP,DUPCFT,PLUS,_3,PLUS,rg+names,STORE word DUPCFT,PLUS,INC,WFETCH,DUP,rg+here,STORE word w+EXIT,SWAP,WSTOREX+ex NOTFOUND word PRTSTR byte " not found ",0 word EXIT ' >W TOW word w+16,BITS,EXIT ' L>W L2W word DUP,TOW,SWAP,_SHR16,EXIT ' W>B ( word bytel byteh ) W2B word DUP,BITS8,SWAP,_SHR8,BITS8,EXIT B2L word B2W,PUSHL,B2W,LPOP W2L word _SHL8 B2W word _SHL8,ORX+ex ' CTYPE ( str cnt -- ) CTYPE word ADO,IX,CFETCH,TOCHAR,EMIT,LOOP,EXIT ' .VER PRTVER word PRTSTR '12345678901234567890123456789012345678901234567890123456789011' byte " Parallax P2 .:.:--TAQOZ--:.:. V",0 word _WORD,@taqoz_version,FETCH,PRTAST byte "#~#.#--",0 word _WORD,@taqoz_name,_4,CTYPE word w+9,SPACES,_WORD,@taqoz_time,FETCH,PRTAST byte "6|-4|",0 word CRLF+ex { 00.2488: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ DICTIONARY 00.D000: 03 44 55 50 6B 00 04 32 44 55 50 6D 00 04 4F 56 .DUPk..2DUPm..OV 00.D010: 45 52 6E 00 04 44 52 4F 50 61 00 05 32 44 52 4F ERn..DROPa..2DRO 00.D020: 50 60 00 04 53 57 41 50 75 00 05 32 53 57 41 50 P..SWAPu..2SWAP 00.D030: 50 0D 03 52 4F 54 7A 00 04 2D 52 4F 54 79 00 03 P..ROTz..-ROTy.. } WORDS word CRLF,ATNAMES word rg+spincnt,CLRL .l0 word rg+spincnt,WFETCH,w+70,GT,_IF+03,CRLF,rg+spincnt,CLRW word DUPCFT,_IF+17 word rg+spincnt+2,WINC ' track width ' word DUPCFT,w+cntm,_AND,INC,rg+spincnt,WPLUSST word DUP,CFETCHINC,w+cntm,_AND,CTYPE,SPACE,NFACPA,INC2,.l0+ex word DROP,rg+spincnt+2,WFETCH,SPACE,PRTDEC+ex { PRT3S word LHASH,HASH,HASH,HASH,w+".",HOLD,HASHS,RHASH,PSTR+ex PRTF word CLKHZ,_WORD,10000,UDIVIDE,DUP,w+100,UMOD,_IF+02 word PRT3S,.L0+ex word w+100,UDIVIDE,PRINT .L0 word PRTSTR byte "MHz",0 word EXIT } ELAPSED LAPCAL word LAPFETCH,LAP,LAP,LAPFETCH,MINUS,EXIT ' .LAP LAP@ LAP LAP LAP@ - DUP DEC . ." cycles = " PRTLAP word LAPCAL PRTCYC word DUP,DECIMAL,PRINT,PRTSTR byte " cycles = ",0,0 '' DUP CLKHZ < IF 100 * 3 >> ELSE REPLAP word DUP,CLKHZ,LT,_IF+17,w+100,MULTIPLY,_3,_SHR,.L0+ex '' CLKHZ U// PRINT DOT #1000 CLKHZ */ PRINT ." sec" EXIT THEN word CLKHZ,UDIVMOD,PRINT,DOT,W1000,CLKHZ,MULDIV,PRINT,PRTSTR byte "sec",0 word EXIT '' DUP #999999 > IF #1,000,000 U// PRINT DOT #1000 U/ PRINT ." ms " EXIT THEN .L0 word DUP,W1000000,EQGT,_IF+11,W1000000,UDIVMOD,PRINT,DOT,W1000,UDIVIDE,PRINT,PRTSTR byte "ms ",0 word EXIT ' DUP #999 > IF #1,000 U// PRINT DOT PRINT ." us" EXIT THEN .L1 word DUP,W1000,EQGT,_IF+09,W1000,UDIVMOD,PRINT,DOT,PRINT,PRTSTR byte "us ",0 word EXIT ' PRINT ." ns " .L2 word PRINT,PRTSTR byte "ns ",0 word EXIT ' .ms LAP@ LAP LAP LAP@ - ~l ; PRTMS word LAPCAL,REPLAP+ex _datorg long endcode&$FFFF _datptr long endcode&$FFFF ATDAT word _WORD,_datptr,FETCHX+ex DATORG word DUP,_WORD,_datorg word STORE,_WORD,_datptr,STOREX+ex ' pub res ( bytes -- ) _datptr +! ; dres word _WORD,_datptr,PLUSST,EXIT ' pre words [C] GRAB 2* [C] BYTES ; ' pre LONGS [C] GRAB 4* [C] BYTES ; ' pre BYTES ( bytes -- ) [C] GRAB DATPTR SWAP res [C] DATCON ; dlongs word GRAB,_SHL1 dwords word GRAB,_SHL1 dbytes word GRAB,ATDAT,SWAP,dres,_DATCON+ex dbyte word _1,dbytes+ex dword word _2,dbytes+ex dlong word _4,dbytes+ex _ECHO word w+echo,rg+fflags,ROT,BITST,EXIT ' TAQOZ marks the start of a block of source code to be compiled in block mode ' _TAQOZ word PRTVER '' disable background keypoll during load & reset error count word rg+keypoll,CLRW,rg+errors,CLRW '' remember code position for reporting word ATHERE,rg+fromhere,STORE '' reset line# to 1 to active word _1,rg+linenum,WSTORE,_0,_ECHO '' backup dictionary pointer '' word ATNAMES,rg+oldnames,STORE '' time the load word _GETCNT,rg+spincnt,STOREX+ex ' end of block load mode TAQOZ END ' _END word _TRUE,_ECHO '' read linenum and clear to exit line mode word rg+linenum,WFETCH,rg+linenum,CLRW word CRLF,PRTDEC,PRTSTR byte " lines and ",0 word ATHERE,rg+fromhere,FETCH,MINUS,PRTDECL,PRTSTR byte " bytes compiled, with ",0 word rg+errors,WFETCH,PRTDEC,PRTSTR byte " errors in ",0 '' report compile time word _GETCNT,rg+spincnt,FETCH,MINUS,CLKKHZ,UDIVIDE,PRTDECL,PRTSTR byte "ms ",0 word _2,CLRFLG+ex '''''''''''''''''''''''''''''''''''''''''''''''''''' ' SERIAL FLASH '''''''''''''''''''''''''''''''''''''''''''''''''''' ''( &cs.so.si.ck -- ) SFPINS word _WORD,_sfpins,STOREX+ex SFWE word SFBSY,w+6,SFINS SFINS word _LONG _sfpins long flashpins word SPIPINS,SPICE,SPIWR8,EXIT '' SFWE ( ins -- ) SFWD word _4,SPINNER+ex SFSTAT word _5 SFRD1 word SFINS,_0,SPIRD,SPIX+ex ''( Read serial Flash serial number ) SFSID word w+$4B,SFINS SFRDD word _0,SPIRDL,SPIRDL SFRDL word _0,SPIRDL,SPIX+ex ''( Read serial Flash Jedec ID ) SFJID word w+$9F,SFINS,SFRDL+ex PRTSF word SFJID,PRTL,SPACE,SFSID,PRTL,SCORE,PRTL+ex ''( addr -- ) SFER4 word w+$20 SFER word SFWE,SPIWM,SPICE SFBSY word SFSTAT,_ZEQ,_UNTIL+03,EXIT ''( addr -- ) SFER32 word w+$52,SFER+ex '' SFER64K ( addr -- ) SFER64 word w+$D8,SFER+ex SFERALL word w+$C7,SFWE,SPIX+ex '' SFWRPAGE ( src dst -- ) SFWRPAGE word w+$02,SFWE,SPIWM,w+256,SPITX,SPIX+ex '' BACKUP the first 64K of memory into flash BACKUP word SFJID,DUP,INC,_AND,ZEXIT 'EXIT IF BLANK ID' '' Write block 0 to Flash block 0 word BRORG,SFER64 word _WORD,brstr,FETCH,_4,STORE word _0,BRORG,w+64,KB ''SFWRS ( hubsrc sfdst cnt -- ) SFWRS word ROT,SWAP,ADO,IX,OVER,SFWRPAGE,SPINNER,w+256,PLUS,w+256,PLOOP,DROPEX+ex SFRDW word _0,SPIRD,_0,SPIRD,_SHL8,ORX+ex '' SFR ( addr -- ) SFRD word _3,SFINS,SPIWM,EXIT brstr byte "TAQO" '' RESTORE TAQOZ from FLASH by copying to $1.0000 first' RESTORE word BRORG,INC4,SFFETCH,_WORD,brstr,FETCH,_EQ,ZEXIT '' word BRORG,_WORD,$1000,PLUS,_WORD,$1000,_WORD,$F000,SFRDS,EXIT word _WORD,$1000,BRORG,OVERPLUS,SWAP,_WORD,$F000 '' ( sfadr dst cnt -- ) '' read block from SF to RAM SFRDS word ROT,SFRD,SPIRX SPIX word SPICE,EXIT { '' SFRDS ( sfsrc hubdst bytes -- ) SFRDS word ROT,SFRD,ADO,_0,SPIRD,IX,CSTORE,LOOP,SPIX+ex } '' SFC@ SFCFETCH word SFRD,_0,SPIRD,SPIX+ex ''pub SFW@ SFWFETCH word SFRD,SFRDW,SPIX+ex ''pub SF@ ( addr -- long ) SFFETCH word SFRD,SFRDW,SFRDW,_SHL16,_OR,SPIX+ex '' SF Select Serial Flash as memory for DUMP words SF word SETDMP,SFCFETCH,SFWFETCH,SFFETCH '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''' SD CARD SUPPORT ''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' CON SDCS = w|sd_cs SDCK = w|sd_ck SDBUFS = $10000 dtk = w|$FE BLKSIZ = w|512 DAT _sdpins word CONL long sdpins SDBUF word CONL long SDBUFS ' pub SD? ( -- flg ) *SDCS PIN L 200 WAIT F 200 WAIT R H ; SDQ word SDCS,_PIN,L,w+200,WAIT,F,w+200,WAIT,R,H,EXIT ' pri SDCLK SDCLK word MINUS1,SPIWR8,EXIT SDCLK3 word SDCLK SDCLK2 word SDCLK,SDCLK+ex ' pri TOKEN ( marker -- flgX ) TOKEN word _WORD,20000 tklp word OVER,_0,SPIRD,_NEQ,_IF+07,DEC,DUP,_ZEQ,_IF+02,NIP,EXIT word tklp+ex word DROP2,TRUE,EXIT ' pub ACMD ( data acmd -- res ) ACMD word _0,w+55,CMD,DROP ' pub CMD ( data cmd -- res ) CMD word DUP,w+sdcmd,CSTORE word _sdpins,SPIPINS,SDCLK word SPIWRC,SPIWRL word w+sdcrc,CFETCH,SPIWR8,RSTCRC SDRES word _0,w+1000,FOR,SPIRD,BITS8,DUP,w+$FF,_NEQ,QNEXT,DROP,EXIT 'SDRES word _0,SPIRD,BITS8,DUP,w+$FF,_NEQ,_UNTIL+06,EXIT ' pri STAT@ ( -- stat ) SDSTAT word _0,w+13,CMD,SDRES,_SHL8,ORX+ex { '' pri SDERR? ( -- flg ; return SD bit flag errors) SDERRQ word _0,SDQ,_ZEQ,_1,_AND,_OR word w+_sdrd,FETCH,_ZEQ,_2,_AND,_OR word w+_sdwr,FETCH,_ZEQ,_4,_AND,_OR word w+ocr,FETCH,_ZEQ,_8,_AND,_OR word EXIT } '' pri SD4@ ( -- long ) SDRD4 word _0,SPIRD,SPIRD,SPIRD,SPIRD,EXIT '' pri SDDAT! ( adr -- ) read info into memory SDDATST word dtk,TOKEN,_IF+08,w+16,ADO,_0,SPIRD,IX,CSTORE,LOOP,SDCLK3+ex word DROPEX+ex RSTCRC word w+$95 SETCRC word w+sdcrc,CSTORE,EXIT INITSX word w+sdcmd,SETC word _5,FOR,RSTCRC,_0,_0,CMD,_1,_EQ,QNEXT,ZEXIT word _5,FOR,w+$87,SETCRC,w+$1AA,_8,CMD,_1,_EQ,QNEXT,ZEXIT word SDRD4,w+$1AA,_EQ,ZEXIT word _0,_WORD,1000,_0,DO word w+30,MASK,w+41,ACMD,_IF+09,SPICE,SDCK,_PIN,w+200,FOR,H,L,forNEXT,isd1+ex word INC,LEAVE isd1 word LOOP,ZEXIT word _0,w+58,CMD,IFEXIT,SDRD4,DUP,w+ocr,STORE,ZEXIT word _0,w+10,CMD,_ZEQ,_IF+02,w+cid,SDDATST word _0,w+9,CMD,_ZEQ,ZEXIT,w+csd,SDDATST+ex '' Initialise the SD card in SPI mode and return with the OCR '' pub !SD ( -- ocr|false ) INITSD word _sdpins,SPIPINS word w+sdvars,w+(sdend-sdvars),ERASE word SDBUF,_4,_SHL9,ERASE ' erase all n file buffers word w+_sector,w+16,w+$FF,CFILL word SDQ,_IF+10,SDCLK3,w+20,FOR,INITSX,w+sdcmd,CFETCH,w+9,_EQ,QNEXT,DROP word w+ocr,FETCHX+ex '' Write from src to xdst in the SD '' pub SDWR ( src sect -- flg ) SDWR word SDCLK3 word w+24,CMD,_ZEQ,_IF+11 word SDCLK3,dtk,SPIWR8,BLKSIZ,SPITX word _0,TOKEN,w+$FF,TOKEN,_AND,sdwr1+ex word _FALSE sdwr1 word DUP,w+_sdwr,STORE,SPIX+ex '' pub FLUSH ( force -- ) wrflg C@ OR IF SDBUF @sector @ SDWR DROP wrflg C~ THEN ; FLUSH word w+wrflg,CFETCH,_OR,ZEXIT word SDBUF,w+_sector,FETCH,SDWR,DROP,w+wrflg,CLRC,EXIT '' pri SDRDBK ( dst -- ) BLKSIZ SPIRX sdsum ! 0 SPIRD SPIRD 1 OR ; SDRDBK word BLKSIZ,SPIRX,w+sdsum,STORE,_0,SPIRD,SPIRD,_1,ORX+ex { pri SDRDBLK ( dst -- crc|flg ) BLKSIZ SPI>BUF --- read crc and force as true flag 0 SPIRD SPIRD 1 OR ; } '' pub SECTOR ( sect -- sdbuf ) SECTOR word DUP,w+_sector,FETCH,_EQ,_IF+02,DROP,SDBUF+ex SECTORF word _0,FLUSH,DUP,w+_sector,STORE,SDBUF,SDRD,SDBUF,EXIT '' pub SDRD ( sector dst -- ) SDRD word SWAP,w+17,CMD,DUP,_ZEQ,_IF+11 word DROP,SDRES,dtk,_EQ,_IF+02,SDRDBK,sdrd1+ex word SDCLK2,SDSTAT,DROP2,_0 sdrd1 word SDCLK,DUP,w+_sdrd,STORE,w+seccrc,STORE,SPIX+ex '' pub SDRDS ( sector dst cnt -- crc | false ) ' convert cnt to sectors ' SDRDS word BLKSIZ,_ALIGN,_SHR9 ' multiblock read -- command not accepted ' word ROT2,SWAP,w+18,CMD,_IF+03,DROP2,_FALSE,.sd1+ex ' process read token and read block if available ' word SDRES,dtk,_EQ,_IF+09,SWAP,FOR,DUP,SDRDBK,BLKSIZ,PLUS,forNEXT,.sd1+ex ' ELSE ' word DROP2,SDCLK2,SDSTAT,DROP,SPICE,_FALSE .sd1 word SDCLK,SPICE word DUP,w+_sdrd,STORE word _0,w+12,CMD,_ZEQ,_UNTIL+05,SPIX+ex '' SDWRS ( hubsrc sdadr cnt -- ) SDWRS word BLKSIZ,_ALIGN,_SHR9 word ADO,DUP,IX,SECTOR,BLKSIZ,CMOVE word _1,FLUSH,BLKSIZ,PLUS,LOOP,DROPEX+ex SDADRW word w+wrflg,SETC '' pub SDADR ( xaddr -- addr ) L>S ( @SECTOR + ) SECTOR SDBUF + ; SDADR word L2S,w+opensect,FETCH,PLUS,SECTOR,PLUS,EXIT '' pub SD@ ( xaddr -- long ) RDSDA @ ; SDFETCH word SDADR,FETCH,EXIT SDSTORE word SDADRW,STORE,EXIT SDCFETCH word SDADR,CFETCH,EXIT SDCSTORE word SDADRW,CSTORE,EXIT SDWFETCH word SDADR,WFETCH,EXIT SD word SETDMP,SDCFETCH,SDWFETCH,SDFETCH '' @FAT ( fat# -- sector ) ATFAT word w+sectfat,FETCH,MULTIPLY word ATBOOT,w+rsvd,WFETCH,PLUS,PLUS,EXIT ATROOT word w+rootdir,FETCHX+ex ATBOOT word w+partitions+8,FETCHX+ex '' cd! ( sect str -- ) ' CDST word w+cwdsect,STOREX+ex RDFAT word ATBOOT,SECTORF,w+fat32,w+90,CMOVE 'word w+sectclust,CFETCH,ENCODE,w+clshift,CSTORE word w+rsvd,WFETCH,w+sectfat,FETCH,w+fats,CFETCH,MULTIPLY word w+rootcl,FETCH,DEC2 word CLSECT2,PLUS,PLUS word w+rootdir,STORE '' save time by precalculating FAT table addresses word _0,ATFAT,w+fat1,STORE,_1,ATFAT,w+fat1+4,STORE word EXIT '' CLUST>SECT ( clust# -- sector ) CLSECT word w+rootcl,FETCH,MINUS CLSECT2 word w+sectclust,CFETCH,MULTIPLY,ATBOOT,PLUS,EXIT AMOUNT word SDQ,ZEXIT,w+mounted,CFETCH,IFEXIT MOUNT word INITSD,_ZEQ,_IF+01,ERRSTR+ex word _0,SECTORF,w+$1FE,PLUS,WFETCH,_WORD,$AA55,_EQ word ZEXIT word w+fat32,w+(fatend-fat32),ERASE word w+$1BE,SDBUF,PLUS,w+partitions,w+64,CMOVE word RDFAT,ROOT,w+mounted,SETC PRTFAT word w+cid,_8,ATYPE word SPACE,w+serial,FETCH,PRTLONG,SPACE word w+volname,w+11,CTYPE word w+sectclust,CFETCH,_SHR1,PRINT,w+"k",EMIT word SPACE,w+sdsize,FETCH,W+11,_SHR,PRTDECL,w+"M",EMIT+ex ' DIR ' PRTDIR word AMOUNT word _0,FOPEN,CRLF,PRTFAT word ATROOT,_SHL9,w+sectclust,CFETCH,_SHL9,ADO word IX,SDFETCH,_IF+(.L2-.L1)/2 .L1 word CRLF,IX,SDADR,DUP,w+8,CTYPE word DUP,_8,PLUS,DUP,CFETCH,w+$20,_NEQ,_IF+05 word DOT,DUP,_3,CTYPE,.L0+ex word _4,SPACES .L0 word SPACE,SWAP,FSECT,PRTL word SPACES3,IX,SDADR,PRTDATE word SPACES3,w+fsize-8,PLUS,FETCH,PRTDECL .L2 word w+32,PLOOP,CRLF+ex '' .DATE ( diradr -- ) PRTDATE word DUP,w+fdate,PLUS,WFETCH word DUP,_SHR9,_WORD,1980,PLUS,PRTDEC4 word DUP,_5,_SHR,BITS4,PRTDEC2,w+$1F,_AND,PRTDEC2 '' word w+ftime,PLUS,WFETCH,DUP,w+11,_SHR,PRTDEC2 word _5,_SHR,w+$3F,_AND,PRTDEC2+ex ' FSECT ( diradr -- sector )' FSECT word w+fclstl,OVERPLUS,WFETCH,SWAP,w+fclsth,PLUS,WFETCH,W2L C2S word w+rootcl,FETCH,MINUS,w+sectclust,CFETCH,MULTIPLY,ATROOT,PLUS,EXIT ROOT word ATROOT ' FOPEN ( sect -- ) FOPEN word w+_fread,CLRL,w+opensect,STOREX+ex FLOAD word FOPEN,rg+ukey,WFETCH,w+fkey,WSTORE word _WORD,FGET,SETKEY+ex FGET word w+_fread,FETCH,SDCFETCH,QDUP,_ZEQ word _IF+08,w+fkey,WFETCH,QDUP word _IF+04,SETKEY,w+fkey,CLRW,FALX+ex word w+_fread,LINC+ex ' FREAD ( sdsrc hubdst bytes -- )' FREAD word _ALIGNL,ADO,IX,OVERPLUS,SDFETCH,IX,STORE FLOOP word _4,PLOOP,DROP,EXIT ' FWRITE ( hubsrc sddst bytes -- )' FWRITE word _ALIGNL,ADO,IX,OVERPLUS,FETCH,IX,SDSTORE,FLOOP+ex { ' RENAME THE CURRENTLY OPEN FILE' RENAME : FNAME GETWORD FNAME word GETWORD To print a file: $1B780 FOPEN 0 SD PRINT$ } '''''''''''''''''''''''''''''' ' SD CARD '''''''''''''''''''''''''''''' org $0010 '...$0110' sdvars ocr res 4 cid res 16 csd res 16 sdcrc res 1 sdcmd res 1 _sdrd res 4 _sdwr res 4 sdsum res 4 wrflg wrflgs res 4 seccrc res 16 _sector res 16 mounted res 1 partitions res 64 opensect res 4 ' starting sector of open file' _fread res 4 fkey res 2 sdend '''''''''''''''''''''''''''''' ' FAT32 '''''''''''''''''''''''''''''' fat32 res 3 oemname res 8 '' res 8 bytesect res 2 '' res 2 sectclust res 1 rsvd res 2 fats res 1 res 15 sdsize res 4 ' Number of sectors * byte/sect (512) = capacity' '' res 4 sectfat res 4 ' Number of sectors per FAT table' res 2 ' fatflags' res 2 ' fatver' rootcl res 4 ' Cluster Number of the Start of the Root Directory' res 2 ' info = Sector Number of the FileSystem Information Sector (from part start) res 2 ' boot = Sector Number of the Backup Boot Sector (from part start) res 12 ' offset 64 res 3 serial res 4 ' serial number of partition volname res 11 ' volume name fatname res 8 ' always FAT32 - (don't trust) ' 96 ' '''''''''''''''''''''''''''''' ' create room for some system variables in this table rootdir res 4 ' sector address of root directory fat1 res 4 fat2 res 4 cwdsect res 4 'cwdstr res 16 fatend '''''''''''''''''''''''''''''' ' DIRECTORY STRUCTURE' '''''''''''''''''''''''''''''' org 0 fnam res 8 fext res 3 fatr res 1 res 1 ' MUST BE 00' fcms res 1 fctime res 2 fcdate res 2 fadate res 2 fclsth res 2 ftime res 2 fdate res 2 fclstl res 2 fsize res 4 ' '***************************************** HUBEXEC CODE *************************** ' orgh alignw _hubexec ' !SP - init the data stack pointer INITSP mov datptr,#datstk mov depth,#0 _ret_ mov tos,##$DEADBEEF ' marker { dirl #rx_pin 'disable receiver wrpin #%00_11111_0,#rx_pin 'configure rx_pin for asynchronous receive, always input wrpin #%01_11110_0,#tx_pin 'configure tx_pin for asynchronous transmit, always output dirh #tx_pin 'enable transmitter } InitTaqoz cogid fx loc PTRA,#@IDLE&$FFFF ' default startup into Instruction Pointer tjnz fx,#INITSTKS ' COG 0 CONSOLE ' dirh #tx_pin 'set tx output high wypin #$0D,#tx_pin loc PTRA,#@TERMINAL&$FFFF dirh #rx_pin 'setse1 #%001_111111 rdpin fz,#rx_pin wc ' clear rx? setint1 #0 mov rxwrC,#0 wrlong rxwrC,#rxrd setse1 #%110<<6+rx_pin 'set se1 to trigger on rx char event????? mov ijmp1,##@taqoz_rxisr 'set int1 jump vector to receive buffer setint1 #4 INITSTKS call #INITSP INITLP mov lpptr,#lpstk mov braptr,#brastk INITRP _ret_ mov retptr,#retstk taqoz_rxisr shl rxlong,#8 rdpin fz,#rx_pin ' recv byte (bits31:24) from rx pin shr fz,#24 or rxlong,fz wz cmp rxlong,##$1B1B1B1B wz ' esc esc esc esc break' if_z coginit #0,##@RESET mov rxwrP,rxwrC add rxwrP,#rxbuffers wrbyte fz,rxwrP incmod rxwrC,##rxsize-1 wrword rxwrC,#rxwr reti1 '_rxrd long rxrd '_rxwr long rxwr READRX rdword r0,#rxrd cmp r0,rxwrC wz if_z jmp #@rr1 mov r1,r0 add r1,#rxbuffers rdbyte acc,r1 incmod r0,##rxsize-1 wrword r0,#rxrd rr1 jmp #PUSHACC DEBUGGER setint1 #0 jmp #\_Start_Monitor ' \ forces absolute address ' ' Registers can be used just like variables and the interpreted kernel uses some for itself ' 128+ bytes are reserved. Since the registers are pointed to by "regptr" they can relocated ' REG ( index -- addr ) Find the address of the register ATREG _ret_ add tos,regptr LAPFETCH mov fx,lap1 sub fx,lap2 jmp #pushx ' COGSTOP ( cog -- ) _COGSTOP cogstop tos jmp #DROP ' COGINIT ( addr cog -- ) coginit tos,tos1 jmp #DROP2 ' COGATN ( mask -- ) _COGATN cogatn tos jmp #DROP ' POLLATN ( -- flg ) _POLLATN pollatn wc if_c sub acc,#1 jmp #PUSHACC '' SETEDG ( edge pin -- ) add 4 to edge for lock _SETEDG shl tos+1,#6 add tos,tos+1 setse1 tos jmp #DROP2 '' POLLEDG ( -- flg ) _POLLEDG pollse1 wc if_c sub acc,#1 jmp #PUSHACC WAIT ''( clks -- ) waitx tos jmp #DROP _GETCNT GETCT fx jmp #PUSHX ' some smartpin support for high level ' @PIN ( -- pin ) _ATPIN mov fx,pinreg jmp #PUSHX '' PIN ( pin -- ) _PIN mov pinreg,tos jmp #DROP _CLK mov tepin,tos jmp #DROP ' WRACK ( data -- ) Write smartpin data and wait for empty then ack WRACK wypin tos,pinreg .wait testp pinreg wc '..wait for buffer empty if_nc jmp #.wait akpin pinreg '..acknowledge pin jmp #DROP _RND xoro32 seed mov fx,seed jmp #PUSHX ' SKIPNZ ( flg -- ) Skip if flg is true ( replace 0= IF xxx THEN ) SKIPNZ tjz tos,#.L0 add PTRA,#2 .L0 jmp #DROP ' > ( n1 n2 -- flg ) GT cmps tos,tos1 wc jmp #CFLG ' < ( n1 n2 -- flg ) LT cmps tos1,tos wc jmp #CFLG ' U< ( u1 u2 -- flg ) _ULT cmp tos1,tos wc CFLG subx tos1,tos1 jmp #DROP ' main division sub - called both by U/ and U// ' double div, single divisor ' By specifing bits and left justifying the routine can be adapted and run faster ' CLKHZ 1234 LAP U// LAP .LAP 27.400us ok --> 18.800us ' UM/MOD64 ( Dbl.dividend divisor -- remainder Dbl.quotient) UMDIVMOD64 mov ACC,#32 UMDIVMOD32 add ACC,#32 mov R0, tos ' R0 = divisor mov R1, tos2 ' R1R2 = dividend mov R2, tos1 mov tos2, #0 ' remainder udmlp shl R1, #1 wc ' dividend msb rcl R2, #1 wc rcl tos2, #1 ' hi bit from dividend cmpsub tos2, R0 wc ' cmp divisor ( R0 - tos & c set if tos => R0 ) rcl tos1, #1 wc ' R1 = quotient l rcl tos, #1 ' R2 = quotient h _ret_ djnz ACC,#udmlp ' DSWAP ( n1 n2 n3 n4 -- n3 n4 n1 n2 ) DSWAP mov R0,tos mov R1,tos1 mov tos,tos2 mov tos1,tos3 mov tos2,R0 _ret_ mov tos3,R1 SPIPINS ' ( long --- ) sets bit numbers for SPI mode from bytes in long as cs.mi.mo.ck call #.SPSET drvl fx ' clock low mov sck,fx ' setup SCK clock ' call #.SPSET drvh fx ' leave high mov mosi,fx ' setup MOSI data to slave ' call #.SPSET dirl fx ' input mov miso,fx ' MISO ' call #.SPSET drvh fx ' chip select high mov ss,fx ' SS jmp #DROP .SPSET mov fx,tos and fx,#$FF _ret_ ror tos,#8 { PAFETCH mov fx,INA jmp #PUSHX PBFETCH mov fx,INB jmp #PUSHX PASTORE mov OUTA,tos jmp #DROP PBSTORE mov OUTA,tos jmp #DROP DACLR andn DIRA,tos jmp #DROP DBCLR andn DIRB,tos jmp #DROP ' ( mask -- ) PASET or OUTA,tos DASET or DIRA,tos jmp #DROP PBSET or OUTB,tos DBSET or DIRB,tos jmp #DROP PACLR andn OUTA,tos jmp #DASET PBCLR andn OUTB,tos jmp #DBSET } { *** COG ACCESS *** } COGFETCH alts tos,#0 _ret_ mov tos,0_0 '' COG! ( long addr -- ) Store a long to cog memory COGSTORE altd tos,#0 mov 0_0,tos+1 jmp #DROP2 _COGID cogid fx jmp #PUSHX '' _COGINIT ( dest cog -- ) _COGINIT coginit tos,tos1 jmp #DROP2 '' DELTA ( delta -- ) Calculate and set the cnt delta and waitcnt DELTA call #POPX mov deltaR,fx '' WAITCNT ( -- ) WAITCNTS _ret_ waitx deltaR '' continue from last count (must be called before target is reached) { ' OUTCLR ( iomask -- ) Clear multiple bits on the output OUTCLRA andn OUTA,tos or DIRA,tos jmp #DROP '' OUTSET ( iomask -- ) Set multiple bits on the output OUTSETA or OUTA,tos ' OUTPUTS ( iomask -- ) Set selected port pins to outputs or DIRA,tos jmp #DROP ' INPUTS ( iomask -- ) Set selected port pins to inputs INPUTSA andn DIRA,tos jmp #DROP } ' L2S ( n -- lsb9 h ) specialized operation for filesystem addresses L2S mov fx,tos and tos,#$1FF shr fx,#9 jmp #PUSHX ' L2W word DUP,TOW,SWAP,_SHR16,EXIT { ' SHIFT from INPUT - Assembles with last bit received as msb - needs SHR to right justify if asynch data ' SHRINP ( pin dat -- pin dat/2 ) SHRINP testp tos1 wc rcr tos,#1 ret } { SHIFT to OUT - This is optimized for when you are sending out multiple bits as in asynchronous serial data or I2C Shift data one bit right into output via iomask - leave mask & shifted data on stack (looping) 400ns execution time including wordcode read and execute or 200ns/bit with REPS } { ' SHROUT ( pin dat -- iomask dat/2 ) SHROUT shr tos,#1 wc ' Shift right and get lsb drvc tos1 ret } BITST call #POPX tjz fx,#CLR ' SET ( mask addr -- ) Set bit(s) in hub long SET rdlong fx,tos or fx,tos1 wrlong fx,tos jmp #DROP2 ' CLR ( mask addr -- ) Clear bit(s) in hub long CLR rdlong fx,tos andn fx,tos1 wrlong fx,tos jmp #DROP2 ' SET? ( mask caddr -- flg ) Test single bit of a byte in memory BITQ rdlong tos,tos and tos1,tos wz if_nz mov tos1,M1 jmp #DROP ' ~~ ( addr -- ) set long SETL sub ACC,#1 ' ~ ( addr -- ) clear long CLRL wrlong ACC,tos jmp #DROP ' W~~ ( addr -- ) set word SETW sub ACC,#1 ' W~ ( addr -- ) clear word CLRW wrword ACC,tos jmp #DROP ' C~~ ( addr -- ) set byte SETC sub ACC,#1 ' C~ ( addr -- ) clear byte CLRC wrbyte ACC,tos jmp #DROP ' Inline vector check and exeute !!!! needs to be able to handle hubexec !!!! ' ?JMP ( adr -- ) QJMP rdword fx,tos wz ' read contents of vector if_nz mov PTRA,fx jmp #DROP ' SQRT ( d. -- sqrt ) _SQRT qsqrt tos+1,tos getqx tos+1 jmp #DROP { _INCMOD '( mod dst -- ) incmod tos,tos+1 jmp #DROP2 } _SETDACS setdacs tos jmp #DROP _GETRND getrnd fx jmp #PUSHX _HUBSET hubset tos jmp #DROP ' WS2812 ( array ledcnt -- ) pin is in cog "pinreg" - line RET is done at HL, not here ' Will transmit a whole array of 24-bit words each back to back in WS2812 timing format ' line idles low and resets/synchs with low =>50us ' A zero is transmitted as 400ns high by 850ns low (+/-150ns) ' A one is transmitted as 800ns high by 450ns low HHL ' The low period between each led is about 400ns longer but inconsequential ' <30us/LED wsdly long sys_clk/2500000 WSLED rdbyte r2,##wsdly sub tos1,#1 ' offset for 24-bit long alignment .l2 rdlong fx,tos1 ' read next long add tos1,#3 ' but leds are 3 bytes apart mov r1,#24 ' write all 24 bits .lp shl fx,#1 wc ' get next bit drvh pinreg ' always clock tx pin high for at least 400ns waitx r2 ' 400ns drvc pinreg ' output data bit waitx r2 ' delay again, (data is either high or low) drvl pinreg ' always needs to go low in the last third of the cycle waitx r2 '-20' djnz r1,#.lp djnz tos,#.l2 ' read the next long as long as we can (tos = count) jmp #DROP2 ' tx line left low to synch - discard stack parameters, all done. { ' VER ( -- verptr ) GETVER loc PA,#@version mov fx,PA jmp #PUSHX } { DICTIONARY 00.D000: 03 44 55 50 6B 00 04 32 44 55 50 6D 00 04 4F 56 .DUPk..2DUPm..OV 00.D010: 45 52 6E 00 04 44 52 4F 50 61 00 05 32 44 52 4F ERn..DROPa..2DRO 00.D020: 50 60 00 04 53 57 41 50 75 00 05 32 53 57 41 50 P..SWAPu..2SWAP 00.D030: 50 0D 03 52 4F 54 7A 00 04 2D 52 4F 54 79 00 03 P..ROTz..-ROTy.. } { ATR(765):CNT(43210),,CFA ' ' Find string in dictionary is written in code and takes around 1us/word ' r3 = cnt+1st char of source ' ' r1 r2 ' } FINDSTR ' ( cstr dict -- nfaptr | false ) rdword r3,tos1 ' read in count and 1st char fstlp mov r2,tos ' R2 = dict word ptr ' mov r1,tos1 ' R1 = source rdword fx,r2 wz ' read in count + 1st char' if_z jmp #fstfail ' end of dictionary?' andn fx,#$E0 ' mask out atrs from count cmp fx,r3 wz ' compare count+1st char ' if_nz jmp #fstskip ' no match, go to next word mov r4,r3 ' matched on cnt + 1st char' and r4,#cntm ' now match rest if needed' sub r4,#1 wz ' matched if single else setup' if_z jmp #fstmatch add r1,#2 ' skip into 2nd char' add r2,#2 fstrem rdbyte r0,r1 ' read in char from source ' add r1,#1 ' hub has to wait anyway so get ready for next source byte rdbyte fx,r2 ' read in a character from the dictionary add r2,#1 cmp fx,r0 wz ' are they the same? if_nz jmp #fstskip ' skip if not same' djnz r4,#fstrem ' continue for remainder' fstmatch mov tos1,tos ' NIP jmp #DROP ' found it fstskip rdbyte fx,tos ' read cnt to skip to next header ' and fx,#cntm ' 03,D,U,P,CFAL,CFAH add tos,fx add tos,#3 ' skip over CPA to next header' jmp #fstlp fstfail mov tos1,#0 jmp #DROP _DEPTH mov fx,depth jmp #PUSHX { REGVAR POP fx rdbyte fx,fx add fx,regptr jmp #PUSHX } { " ABCDEFGHIKLMNOPQRSTUVWXYZ$@!+- _abcdefghijklmnopqrstuvwxyz{|}~ #J%&'()*,./0123456789:;<=>?[\]^" 0 -ROT BEGIN DUP C@ WHILE OVER OVER C@ = IF 2DROP EXIT THEN ROT 1+ -ROT 1+ REPEAT ; } { ' LOOKIN ( val array -- index ) LOOKIN mov R1,tos1 mov tos1,#0 ' init result index .L0 rdbyte fx,tos wz if_z mov tos1,#0 if_z jmp #DROP add tos1,#1 ' inc result index cmp fx,R1 wz if_z jmp #DROP add tos,#1 jmp #.L0 _LOOKUP '( index array -- value ) add tos1,tos rdbyte tos1,tos1 jmp #DROP } NEWCOG coginit tos,##@RESET jmp #DROP { dPRTIP call #dCRLF '' mov P,PTRA '' shr P,#16 call #dPRTWORD mov P,PTRA jmp #dPRTWORD dPRTX mov R1,#$20 call #TX mov P,fx dPRTWORD mov R1,P shr R1,#12 call #HEXASC mov R1,P shr R1,#8 call #HEXASC mov R1,P shr R1,#4 call #HEXASC mov R1,P call #HEXASC mov R1,#$20 call #TX ret ' HEXASC and R1,#$0F add R1,#$30 cmp R1,#$3A wc if_nc add R1,#7 TX wypin R1,#tx_pin '..send byte .wait testp #tx_pin wc '..wait for buffer empty if_nc jmp #.wait akpin #tx_pin '..acknowledge pin waitx #200 ret dCRLF mov R1,#$0D call #TX mov R1,#$0A jmp #TX '} endcode '************************************* HUB REGISTERS ************************************** org 0 ' register offsets within "registers". Access as REG,delim ... REG,base ... etc ' ' Minimum registers required for a new task - other registers after the ' ---- are not needed other than by the console temp res 12 ' general purpose double res 4 ' hold high word of double ' @16 uemit res 2 ' emit vector 0 = default ukey res 2 ' key vector keypoll res 2 ' poll user routines - low priority background task base res 2 ' current number base + backup location during overrides baudcnt res 4 ' SERIN SEROUT baud cnt value where baud = clkfreq/baudcnt each cog can have it's own uswitch res 4 ' target parameter used in CASE structures ' @32 fflags res 2 ' echo,linenums,ipmode,leadspaces,prset,striplf,sign,comp,defining keycol res 1 ' maintains column position of key input wordcnt res 1 ' length of current word (which is still null terminated) wordbuf res wordsz ' words from the input stream are assembled here ' numpad may continue to build backwards into wordbuf for special cases such as long binary numnbers numpad res numpadsz ' Number print format routines assemble digit characters here builds from end - 18,446,744,073,709,551,615 padwr res 1 ' write index (builds characters down from lsb to msb in MODULO style) 'leader res 1 pflg res 1 pbase res 1 pfmt res 4 delim res 2 ' the delimiter used in text input and a save location dcnt res 1 prefix res 1 ' NUMBER input prefix uprompt res 2 ' pointer to code to execute when Forth prompts for a new line accept res 2 ' pointer to code to execute when Forth accepts a line to interpret (0=ok) keychar res 4 ' override for key character suffix res 1 ' NUMBER input suffix res 3 unum res 2 ' User number processing routine - executed if number failed and UNUM <> 0 ufind res 2 ' runs extended dictionary search if set after failing precompiled dictionary search ' ' ------ console only registers not required for other tasks --- can be accessed as globals ' ' these 4 variables are cleared as an array of 10 bytes anumber res 4 ' Assembled number from input bnumber res 4 digits res 1 ' number of digits in current number that has just been processed dpl res 1 ' Position of the decimal point if encountered (else zero) 'createvec res 2 ' If set will execute user create routines rather than the kernel's (CREATE revectored) dmm res 6 ' dump "fetch' vectors to allow dump to access special devices dmp res 2 ' DUMP vector ''''''''''''''''''''''' fixed '''''''''''''''''''''''''''' 'rxptr res 4 ' Pointer to the terminal receive buffer - read & write index precedes 'rxsz res 2 oldnames res 4 ' backup of names used at start of TAQOZ load names res 4 ' start of dictionary (builds down) fromhere res 4 ' Used by TAQOZ word to backup current here to determine code size at end of load here res 4 ' pointer to compilation area (overwrites VM image) codes res 4 ' current code compilation pointer (updates "here" or is reset by it) 'bootsig res 4 autovec res 4 ' user autostart address if non-zero - called from within terminal cold res 2 ' pattern to detect if this is a cold or warm start ($A55A ) errors res 2 linenum res 2 'lines res 2 prevch res 2 ' used to detect LF only sequences vs CRLF to perform auto CR spincnt res 2 ' Used by spinner to rotate busy symbol res 2 ' word count endreg res 0 '********************************************************************************************************* '************************************** TACHYON COG KERNEL *********************************************** '********************************************************************************************************* org 0 RESET call #@InitTaqoz jmp #doNEXT '********************************** data ************************************* ' Registers used by PASM modules to hold parameters such as I/O masks and bit counts etc ' COG 2 sck REG0 long 0 mosi REG1 long 0 miso REG2 long 0 ss REG3 long 0 REG4 long 0 long 0 long 0 ' $00E0 ' COG 9 = TASK REGISTER POINTER regptr long registers ' used by REG ACC long 0 fx long 0 R0 long 0 R1 long 0 P R2 long 0 R3 long 0 R4 deltaR long 0 ' COG 17 STACK POINTERS datptr long 0 ' data stack pointer to LUT braptr long 0 ' branch stack pointer to LUT lpptr long 0 retptr long 0 ' return stack pointer to LUT ' COG 21 depth long 0 lap1 long 0 lap2 long 0 ' #0024 pinreg long 0 tepin long 0 pinticks long sys_clk / 1000000 ' set default 1Mbaud ' #0027 clockpins long 0 ' I/O mask for CLOCK instruction clkdly long 0 ' #0029 rx isr variables rxlong long 0 fz long 0 rxwrP long 0 rxwrC long 0 ' *** COG STACKS *** ' top of data stack registers tos long $DEADBEE1 tos1 long $DEADBEE2 tos2 long $DEADBEE3 tos3 long $DEADBEE4 ' top of loop stack registers limit1 long 0 index long 0 limit2 long 0 index2 long 0 branchadr long 0 seed long 1 AJMP mov PTRA,tos ' jump to address on top of the data stack jmp #DROP ACALL call #POPX ' get wordcode into X pop R1 ' discard return address and jump back and use interpreter jmp #doCODE ' main Forth wordcode interpreter - PTRA = Instruction Pointer ' wordcode order: ASM,THREADED,HUBEXEC,IF,UNTIL,REG,LIT9 '' { w = $F800 ' wordcode offset for 10-bit literals _IF = $FC00 ' IF relative forward branch 0 to 127 words _UNTIL = $FC80 ' UNTIL relative reverse branch 0 to 127 words opunused = $FD00 rg = $FE00 ' task/cog register 8-bit offset fat = $FF00 } ' constants used by doNEXT decode cogadr long 496 threaded long (_hubexec-1)&$FFFF calls long $F800-1 shorts long $FC00-1 branches long $FD00-1 doCALL call fx ' could call cog or hub code - use ret to return doNEXT rdword fx,PTRA++ ' read word code instruction doCODE cmp cogadr,fx wc ' wordcode below $1F0 are cog addresses - just call if_nc jmp #doCALL cmp threaded,fx wc ' just call if it is asm code - either cog or in hubexec range below wordcodes if_nc jmp #THREAD ' if not then just execute as threaded code - needs to save IP cmp calls,fx wc ' special opcodes? (at high end for branches, short literals, registers etc) if_nc jmp #doCALL ' hubexec - execute as cog code ' cmp shorts,fx wc ' if_nc jmp #doSHORT ' LIT short 9-bit literal cmp branches,fx wc if_nc jmp #doBRANCH ' IF UNTIL conditional relative branch code ' ' REG OP ( -- addr ) - the byte offset is relative to the regptr for that task doREG zerox fx,#8 add fx,regptr jmp #doPUSHX doSHORT zerox fx,#9 ' push 10-bit literal doPUSHX call #PUSHX jmp #doNEXT ' Call wordcode - Save IP and load with new IP from call ' THREAD test fx,#1 wz ' bit0 is the jump/call bit andn fx,#1 ' word align if_z wrlut PTRA,retptr ' save IP onto return stack if_z add retptr,#1 mov PTRA,fx ' jump to new wordcode (PTRA = IP) jmp #doNEXT ' ' Conditional with 7-bit signed word displacement doBRANCH tjnz tos,#dj1 ' discard flag and continue w/o jumping ' take the jump - X has instruction wordcode test fx,#$80 wz ' reverse jump? nz and fx,#$7F ' mask displacement shl fx,#1 ' index as words sumnz PTRA,fx ' +/- jump dj1 call #DROP ' discard condition flag jmp #doNEXT { dPRTPA mov R1,PA jmp #TXR1 } '###################################################################################' _ASM call PTRA jmp #EXIT STRLEN ' ( str -- len ) rdfast #0,tos mov tos,#0 .L0 rfbyte R0 ' read a byte sub R0,#1 ' end is either a null or anything >$7F cmp R0,#$7E wc if_c add tos,#1 if_c jmp #.L0 ret ' ?EXIT ( flg -- ) Exit if flg is true IFEXIT call #POPX if_nz jmp #EXIT ret ' 0EXIT ( flg -- ) Exit if flg is false (or zero) Used in place of IF......THEN EXIT as false would just end up exiting ZEXIT call #POPX if_nz ret EXIT sub retptr,#1 _ret_ rdlut PTRA,retptr { *** STACK OPERATORS *** } ' NIP ( n1 n2 -- n2 ) : 600ns NIP mov tos1,tos jmp #DROP ' 3DROP ( n1 n2 n3 -- ) : 1.2us DROP3 call #POPX ' 2DROP ( n1 n2 -- ) : 800ns DROP2 call #POPX ' DROP ( n -- ) : 500ns : 400ns DROP ' Pop the data stack using fixed size register stack in COG memory (allows fast direct access for operations) ' overflow stack in hub ram and reduces the size of the cog stack to 4 POPX ' wz tjz depth,#_NOP ' don't pop beyond bottom of stack mov fx,tos wz ' pop old tos into X mov tos,tos1 mov tos1,tos2 mov tos2,tos3 sub depth,#1 ' maintain depth count sub datptr,#1 ' stack pointer _ret_ rdlut tos3,datptr ' pop from lut stack into register stack _NOP ret ' ?DUP ( n1 -- n1 n1 | 0 ) DUP n1 if non-zero QDUP tjz tos,#_NOP ' DUP ( n1 - n1 n1 ) Duplicate the top item on the stack - 48 cycles DUP mov fx,tos ' Read directly from the top of the data stack jmp #PUSHX ' Push the internal X register onto the datastack OVERPLUS _ret_ add tos,tos1 DUP2 call #OVER ' OVER ( n1 n2 -- n1 n2 n1 ) - 1us OVER mov fx,tos1 'read second data item and push jmp #PUSHX ' tos2 ( n1 n2 n3 -- n1 n2 n3 n1 ) Copy the tos2 item onto the stack THIRD mov fx,tos2 ' read third data item jmp #PUSHX ' 4TH ( n1 n2 n3 n4 -- n1 n2 n3 n4 n1 ) Copy the 4th item onto the stack - 1.2us FOURTH mov fx,tos3 jmp #PUSHX ' BOUNDS ( n1 n2 -- n2+n1 n1 ) == OVER + SWAP BOUNDS add tos,tos1 ' SWAP ( n1 n2 -- n2 n1 ) Swap the top two items SWAP mov fx,tos1 SWAPX mov tos1,tos PUTX _ret_ mov tos,fx ' -ROT ( a b c -- c a b ) ROT2 call #ROT ' ROT ( a b c -- b c a ) ROT mov fx,tos2 mov tos2,tos1 jmp #SWAPX { *** ARITHMETIC *** } ' - ( n1 n2 -- n3 ) Subtract n2 from n1 MINUS neg tos ' (note: save one long by negating and adding) ' + ( n1 n2 -- n3 ) Add top two stack items together and replace with result PLUS add tos1,tos wc jmp #DROP ' 2- DEC2 _ret_ sub tos,#2 ' 1- DEC _ret_ sub tos,#1 ' 4+ INC4 _ret_ add tos,#4 ' 2+ INC2 _ret_ add tos,#2 ' 1+ INC _ret_ add tos,#1 ' -NEGATE ( n1 sn -- n1 | -n1 ) negate n1 if the sign of sn is negative (used in signed divide op) MNEGATE shr tos,#31 ' ?NEGATE ( n1 flg -- n2 ) negate n1 if flg is true QNEGATE tjz tos,#DROP call #POPX ' NEGATE ( n1 -- n2 ) equivalent to n2 = 0-n1 NEGATE _ret_ neg tos { *** BOOLEAN *** } { ' INVERT ( n1 -- n2 ) bitwise invert n1 and replace with result n2 INVERT add tos,#1 jmp #NEGATE } ' BITS ( n1 bits -- n2 ) BITS decod tos sub tos,#1 _AND and tos1,tos jmp #DROP _ANDN andn tos1,tos jmp #DROP _OR or tos1,tos jmp #DROP _XOR xor tos1,tos jmp #DROP { ' mainly for testing instructions' _ZEROX zerox tos1,tos jmp #DROP } ' *** shift operators *** ' *** RIGHT SHIFT *** ' SHR ( n1 cnt -- n2 ) Shift n1 right by count (5 lsbs ) _SHR shr tos1,tos jmp #DROP ' 16>> _SHR16 _ret_ shr tos,#16 ' 9>> _SHR9 _ret_ shr tos,#9 ' 8>> _SHR8 _ret_ shr tos,#8 ' 4/ _SHR2 _ret_ shr tos,#2 ' 2/ ( n1 -- n1/2 ) _SHR1 _ret_ shr tos,#1 _ROR ror tos1,tos jmp #DROP _SAR sar tos1,tos jmp #DROP ' *** LEFT SHIFT *** ' << ( n1 bits -- n2 ) _SHL shl tos1,tos jmp #DROP ' ROL ( n1 bits -- n2 ) _ROL rol tos1,tos jmp #DROP _SHL16 _ret_ shl tos,#16 _SHL9 _ret_ shl tos,#9 ' 8<< _SHL8 _ret_ shl tos,#8 ' 4* _SHL2 _ret_ shl tos,#2 ' 2* ( n1 -- n2 ) shift n1 left one bit (equiv to multiply by 2) _SHL1 _ret_ shl tos,#1 ' REV ( n1 -- n2 ) Reverse bits 0..31 --> 31..0 _REV _ret_ rev tos '_BMASK bmask tos ' MASK ( bitpos -- bitmask \ only the lower 5 bits of bitpos are taken, regardless of the higher bits ) MASK _ret_ decod tos ' ENCODE ( mask -- bitpos ) ENCODE _ret_ encod tos '' FAST MASKING ' 4BITS ( n -- nibble ) mask n to a nibble BITS4 _ret_ and tos,#$0F ' 8BITS ( n -- nibble ) mask n to a byte BITS8 _ret_ and tos,#$FF ' 9BITS BITS9 _ret_ and tos,#$1FF { *** COMPARISON *** } ' Basic instructions from which other comparison instructions are built from ' = ( n1 n2 -- flg ) true if n1 is equal to n2 : 700ns @80 _EQ call #POPX sub tos,fx ' n1 == 0 if equal ' 0= ( n -- flg ) true if n = 0 : 400ns @80 _ZEQ tjz tos,#SETTRUE _ret_ mov tos,#0 ' 0<> ( n -- flg ) true if n <> 0 (promote n to boolean) : 400ns @80 _ZNE tjz tos,#z1 SETTRUE _ret_ mov tos,M1 z1 ret ' <> ( n1 n2 -- flg ) true if n1 <> n2 : 600ns @80 _NEQ sub tos1,tos wz if_nz mov tos1,M1 jmp #DROP ' 0< ( n -- flg ) true if n < 0 (negative) : 400ns @80 _ZLT _ret_ sar tos,#31 ' NOT ( n -- !n ) invert bits of n : 350ns @80 _NOT _ret_ not tos ' ABS ( n -- abs ) _ABS _ret_ abs tos,tos MULTIPLY qmul tos,tos1 getqx tos1 jmp #DROP MUL16 mul tos1,tos jmp #DROP ' UM* ( u1 u2 -- u1*u2L u1*u2H ) ' DESC: unsigned 32bit * 32bit multiply -- 64bit result UMMUL qmul tos,tos1 getqx tos1 _ret_ getqy tos ' U// ( dvdn dvsr -- rem quot ) UDIVMOD qdiv tos1,tos getqx tos _ret_ getqy tos1 ' MOD ( n1 mod -- rem ) UMOD call #UDIVMOD jmp #DROP ' U/ ( u1 u2 -- quot ) UDIVIDE qdiv tos1,tos getqx tos1 jmp #DROP ' signed MIN returns the minimum of the two values _MINS fles tos1,tos jmp #DROP _MAXS fges tos1,tos jmp #DROP ' unsigned MIN returns the minimum of the two values _MIN fle tos1,tos jmp #DROP _MAX fge tos1,tos jmp #DROP { *** MEMORY *** } ' C@++ ( caddr -- caddr+1 byte ) fetch byte character and increment address CFETCHINC mov fx,tos ' dup the address call #PUSHX add tos1,#1 ' inc the backup address ' C@ ( caddr -- byte ) Fetch a byte from hub memory : 500ns @80 CFETCH _ret_ rdbyte tos,tos ' DUPC@ DUPCFT rdbyte fx,tos jmp #PUSHX ' Push the internal fx register onto the datastack ' W@ ( waddr -- word ) Fetch a word from hub memory WFETCH _ret_ rdword tos,tos ' @ ( addr -- long ) Fetch a long from hub memory FETCH _ret_ rdlong tos,tos ' C+! ( n caddr -- ) add n to byte at hub addr : 1.2us @80 CPLUSST rdbyte fx,tos ' read in word from adress add tos1,fx ' add to contents of address - cascade ' C! ( n caddr -- ) store n to byte at addr : 1us @80 CSTORE wrbyte tos1,tos ' write the byte using address on the tos jmp #DROP2 ' W+! ( n waddr -- ) add n to word at hub addr WPLUSST rdword fx,tos ' read in word from address add tos1,fx ' W! ( n waddr -- ) store n to word at addr WSTORE wrword tos1,tos jmp #DROP2 ' +! ( n addr -- ) add n to long at hub addr PLUSST rdlong fx,tos ' read in long from address add tos1,fx ' ! ( n addr -- ) store n to long at addr STORE wrlong tos1,tos jmp #DROP2 ' LUT@ ( addr -- data ) : 400ns LUTFETCH _ret_ rdlut tos,tos ' LUT! ( data addr -- ) : 900ns LUTSTORE wrlut tos1,tos jmp #DROP2 ' BLOCK MOVE ' ' 171219 64K in 19.866ms using rep vs 24.872ms using djnz ' RCMOVE bytes from source to destination primitive - $6.0000 $1.0000 LAP ERASE LAP DECIMAL .LAP 131208 cycles = 1.640ms/64K ' ( addr bytes -- ) ERASE call #PUSHACC ' ( addr cnt fillch -- ) CFILL wrfast tos1,tos2 rep @.L0,tos1 wfbyte tos .L0 jmp #DROP3 ' Test for non-zero data in memory block ' DATA? ( addr longs -- flg ) DATAQ rdfast #0,tos1 rep @.L0,tos rflong fx or ACC,fx .L0 mov tos1,ACC jmp #DROP ' I ( -- index ) read the loop index IX mov fx,index jmp #PUSHX ' J ( -- index ) read the loop index J mov fx,index2 jmp #PUSHX ' IC@ ( -- byte ) ICFETCH rdbyte fx,index jmp #PUSHX ' I+ ( n -- n+I ) fast index offset i.e. table I+ IPLUS _ret_ add tos,index { *** BRANCH & LOOP *** } ' ADO = BOUNDS DO - just a quick and direct way as BOUNDS is most often never used elsewhere ' ADO ( from cnt -- ) ADO call #BOUNDS ' ' DO ( to from -- ) DO call #SWAP call #PUSHL ' PUSH index onto loop stack ' ' FOR ( count -- ) Setup FOR...NEXT loop for count ' FOR wrlut branchadr,braptr add braptr,#1 mov branchadr,PTRA ' >L ( n -- ) Push n onto the loop stack jmp #PUSHL ' L> ( -- n ) Pop n from the loop stack LPOP call #LPOPX ' Pop loop stack into X jmp #PUSHX ' Push X onto the data stack as tos ' +LOOP ( n1 -- ) PLOOP call #POPX ' get loop increment add index,fx ' add to index sub index,#1 ' compensate so we can drop through to LOOP ' The comparison above is between the call insn (wr) at DELTA and the jump insn (nr) at POPX_ret, ' this will always be carry set. The call itself is indirect. ' LOOP add index,#1 ' increment index cmps limit1,index wcz BRANCH if_a mov PTRA,branchadr ' Branch to the address that is saved in branch stack if_a ret call #LPOPX ' discard the limit POPBRANCH sub braptr,#1 cmp braptr,#brastk wc if_c mov braptr,#brastk rdlut branchadr,braptr jmp #LPOPX ' discard the index ' then next loop and its branch address ' ?NEXT ( flg -- index ) Same as NEXT except terminate early if flag is true and return with flag QNEXT mov tos,tos wz if_nz jmp #POPBRANCH sub index,#1 wcz if_nz mov PTRA,branchadr if_nz jmp #DROP ' discard flag and continye looping jmp #POPBRANCH ' NEXT ( -- ) Decrement count (on loop stack) and loop until 0, then pop loop stack forNEXT djz index,#POPBRANCH ' exit loop _ret_ mov PTRA,branchadr ' loop again ' LEAVE - make the loop index = to the limit so that it will leave on the next LOOP LEAVE mov index,limit1 _ret_ sub index,#1 {HELP >R ( n -- ) Push n onto the return stack } PUSHR wrlut tos,retptr add retptr,#1 jmp #DROP {HELP R> ( -- n ) Pop n from the return stack } RPOP sub retptr,#1 rdlut fx,retptr jmp #PUSHX ' Push X onto the data stack as tos LPOPX mov fx,index mov index,limit1 mov limit1,index2 mov index2,limit2 sub lpptr,#1 _ret_ rdlut limit2,lpptr ' 171231 - mod so that index is on top/last ' limit -> index ' index -> limit ' limit2 -> indexJ ' index2 -> limitJ ' stack ' >L ( tos -- ) Push tos onto the loop stack and drop tos PUSHL wrlut limit2,lpptr ' push bottom register to stack add lpptr,#1 mov limit2,index2 ' ripple registers mov index2,limit1 mov limit1,index mov index,tos jmp #POPX { *** LITERALS *** } ' LITERALS are stored unaligned in big endian format which faciliates cascading byte reads to accumulate the full number ' ( -- 32bits ) Push a 32-bit literal onto the datastack by reading in the next 4 bytes (non-aligned) _LONG rdlong fx,PTRA++ jmp #PUSHX ' Read an inline word literal and push it onto the stack ' _WORD rdword fx,PTRA++ jmp #PUSHX _TRUE MINUS1 sub ACC,#1 PUSHACC mov fx,ACC ' Push the accumulator onto the stack then zero it PUSHX mov ACC,#0 ' clear it for next operation wrlut tos3,datptr ' save bottom of register stack into lut memory add datptr,#1 mov tos3,tos2 ' push 4 top items held in registers mov tos2,tos1 mov tos1,tos mov tos,fx ' replace tos with X (DEFAULT) add depth,#1 ' the depth variable indexes bytes in LUT _ret_ modcz 0,0 wc ' clear C for some operations that use this to determine behaviour { *** CONSTANTS & VARIABLES *** } { Constants and variables etc are standalone fragments preceded by an opcode then the parameters, either a long or the addess of the parameter field. They are called from the main program and only use the IP to get the result. } DATCON nop ' This entry is used for constants that point to the DATA area - FORGETable by signature CONL rdlong fx,PTRA call #PUSHX jmp #EXIT { CONW rdword fx,PTRA call #PUSHX jmp #EXIT } ' INLINE: VARB mov fx,PTRA call #PUSHX jmp #EXIT { *** SMART PINS *** } { WRPIN D/#,S/# - Set smart pin S/# mode to D/# WXPIN D/#,S/# - Set smart pin S/# parameter X to D/# WYPIN D/#,S/# - Set smart pin S/# parameter Y to D/# RDPIN D,S/# - Get smart pin S/# result Z into D V30 WRPIN D/#,S/# - Set smart pin S/# mode to D/#, acknowledge pin WXPIN D/#,S/# - Set smart pin S/# parameter X to D/#, ack WYPIN D/#,S/# - Set smart pin S/# parameter Y to D/#, ack RDPIN D,S/# {WC} - Get smart pin S/# result Z into D, flag into C, ack RQPIN D,S/# {WC} - Get smart pin S/# result Z into D, flag into C, don't ack AKPIN S/# - Acknowledge pin S/# } ' 160620-2300 - MODIFIED SMARTPIN OPS TO USE "pinreg" for faster access ' WRPIN D/#,S/# - Set smart pin S/# mode to D/#, acknowledge pin ' WRPIN ( dst -- ) _WRPIN wrpin tos,pinreg jmp #DROP ' WXPIN D/#,S/# - Set smart pin S/# parameter X to D/#, ack ' WXPIN ( dst -- ) _WXPIN wxpin tos,pinreg jmp #DROP ' WYPIN D/#,S/# - Set smart pin S/# parameter Y to D/#, ack ' WYPIN ( dst -- ) _WYPIN wypin tos,pinreg jmp #DROP ' RDPIN D,S/# {WC} - Get smart pin S/# result Z into D, flag into C, ack ' RDPIN ( -- res ) _RDPIN rdpin fx,pinreg jmp #PUSHX ' RQPIN D,S/# {WC} - Get smart pin S/# result Z into D, flag into C, don't ack ' RQPIN ( -- res ) _RQPIN rqpin fx,pinreg jmp #PUSHX ' AKPIN S/# - Acknowledge pin S/# ' AKPIN ( -- ) _AKPIN _ret_ wrpin #1,pinreg ' BEGIN RDPIN $80 AND 0= UNTIL WAITPIN rdpin fx,pinreg testb fx,#7 wz if_nz jmp #WAITPIN ret ' TXDAT ( buf cnt -- ) write buffer direct to WYPIN _TXDAT rdfast #0,tos+1 '' rep @.end,tos .L1 rfbyte fx wypin fx,pinreg .wait testp pinreg wc '..wait for buffer empty if_nc jmp #.wait akpin pinreg '..acknowledge pin djnz tos,#.L1 .end jmp #DROP2 { *** I/O ACCESS *** } ' Fast pin operations via PIN pinreg ' H - set the PIN high - fast as the parameter is in the pinreg H _ret_ drvh pinreg ' L - set the PIN low - fast as the parameter is in the pinreg L _ret_ drvl pinreg _T _ret_ drvnot pinreg ' F - float pin F _ret_ dirl pinreg ' R - read pin R testp pinreg wc if_c sub ACC,#1 jmp #PUSHACC ' normal pin operations via stack ' HIGH ( pin -- ) HIGH drvh tos jmp #DROP ' LOW ( pin -- ) LOW drvl tos jmp #DROP ' FLOAT ( pin -- ) _FLOAT dirl tos jmp #DROP ' PIN@ ( bit -- state ) PINTEST testp tos wc _ret_ muxc tos,M1 M1 long -1 '************************************* SERIAL I/O ************************************** SEROUT mov txpin,tos jmp #DROP CONEMIT mov R1,tos TXR1 mov txpin,#tx_pin wypin r1,txpin '..send byte waitx #0 .wait testp txpin wc '..wait for buffer empty if_nc jmp #.wait jmp #DROP txpin long tx_pin '********************** SPI READ/WRITE ********************* ' 461.7us/512 ' SPI>BUF ( dst cnt -- sum ) SPIRX wrfast #0,tos1 mov tos1,#0 .L0 rep @.end,#8 ' 8 bits outnot sck ' clock (low high or low high) outnot sck testp miso wc ' read data from card rcl r1,#1 ' shift in msb first .end wfbyte r1 add tos1,r1 djnz tos,#.L0 jmp #DROP SPIRDL rep @sre1,#32 skip #1 ' SPIRD ( dat -- dat+rd ) SPIRD rep @sre1,#8 ' 8 bits outnot sck ' clock (low high) outnot sck testp miso wc ' read data from card rcl tos,#1 ' shift in msb first sre1 ret ' 474.6us/512 ' SPITX ( src bytes -- ) SPITXE drvl ss SPITX rdfast #0,tos1 .L0 rfbyte r1 shl r1,#24 rep @.L1 , #8 rol r1,#1 wc ' output next msb outc mosi outnot sck ' clock outnot sck ' clock .L1 djnz tos,#.L0 jmp #DROP2 SPIWRL mov r1,#32 jmp #SPIWR SPIWM shl tos,#8 mov r1,#24 jmp #SPIWR SPIWR16 shl tos,#16 mov r1,#16 jmp #SPIWR ' Write SD Command SPIWRC and tos,#$3F or tos,#$40 ' SPIWR8 ( byte -- ) ' Shift 8 bits from data[0..7] out and leave data on stack (restored with other bytes zeroed) ' SPIWR8 shl tos , #24 ' left justify 8-bit data s mov r1,#8 SPIWR drvl ss ' chip enable rep @.L1 , r1 rol tos,#1 wc ' output next msb outc mosi outnot sck ' clock outnot sck ' clock .L1 jmp #DROP SPICE _ret_ outh ss ' I2C support ' CLKOUT ( iobit dat -- iobit dat2 ) REG6=iomask ) Shift msb bit out, clock high, clock low CLKOUT outl tos+1 ' ensure output will be active low drvl clockpins shl tos,#1 wc dirnc tos+1 ' make it an output if it is a low else float ' CLOCK ( REG6=iomask ) Toggle multiple bits on the output) CLOCK outnot clockpins tjz clkdly,#ckx mov fx,clkdly _ret_ djnz fx,#$ ckx ret ' $01CA ' CLKIN ( iomask dat -- iomask dat2 ) CLKIN dirl tos+1 testp tos+1 wc rcl tos,#1 jmp #CLOCK ' timing utility word LAP mov lap2,lap1 _ret_ getct lap1 ENDCOG fit 496 '************************************************************************************ '************************************** DICTIONARY ********************************** '************************************************************************************ { *** DICTIONARY *** } orgh romdict ' The count field is left blank but filled in at cold boot so that these do not need to be calculated when defining ' '' CNT,NAME,ATR,addr16 byte 3, "DUP" word DUP byte 4, "OVER" word OVER byte 4, "SWAP" word SWAP byte 3, "ROT" word ROT byte 4, "-ROT" word ROT2 byte 4, "DROP" word DROP byte 3, "3RD" word THIRD byte 3, "4TH" word FOURTH byte 5, "2DROP" word DROP2 byte 5, "3DROP" word DROP3 byte 3, "NIP" word NIP byte 5, "2SWAP" word DSWAP byte 4, "2DUP" word DUP2 byte 4, "?DUP" word QDUP ' BITWISE LOGIC byte 3, "AND" word _AND byte 4, "ANDN" word _ANDN byte 2, "OR" word _OR byte 3, "XOR" word _XOR '' byte 5, "ZEROX" '' word _ZEROX ' SHIFT' byte 3, "ROL" word _ROL byte 3, "ROR" word _ROR byte 2, ">>" word _SHR byte 2, "<<" word _SHL byte 3, "SAR" word _SAR byte 2, "2/" word _SHR1 byte 2, "2*" word _SHL1 byte 2, "4/" word _SHR2 byte 2, "4*" word _SHL2 byte 3, "8<<" word _SHL8 byte 4, "16>>" word _SHR16 byte 3, "8>>" word _SHR8 byte 3, "9<<" word _SHL9 byte 3, "9>>" word _SHR9 byte 3, "REV" word _REV byte 2, "|<" word MASK byte 2, ">|" word ENCODE byte 2, ">N" word BITS4 byte 2, ">B" word BITS8 byte 2, ">9" word BITS9 byte 4, "BITS" word BITS byte 3, "NOT" word _NOT ' COMPARISON byte 1, "=" word _EQ byte 2, "<>" word _NEQ byte 2, "0=" word _ZEQ byte 3, "0<>" word _ZNE byte 2, "0<" word _ZLT byte 1, "<" word LT byte 2, "U<" word _ULT byte 1, ">" word GT byte 2, "U>" word UGT byte 2, "<=" word LTEQ byte 2, "=>" word EQGT byte 6, "WITHIN" word WITHIN byte 5, "DUPC@" word DUPCFT byte 2, "C@" word CFETCH byte 2, "W@" word WFETCH byte 1, "@" word FETCH byte 3, "C+!" word CPLUSST byte 2, "C!" word CSTORE byte 4, "C@++" word CFETCHINC byte 3, "W+!" word WPLUSST byte 2, "W!" word WSTORE byte 2, "+!" word PLUSST byte 1, "!" word STORE byte 4, "BIT!" word BITST byte 3, "SET" word SET byte 3, "CLR" word CLR byte 4, "SET?" word BITQ ' MATHS byte 2, "1+" word INC byte 2, "1-" word DEC byte 2, "2+" word INC2 byte 2, "2-" word DEC2 byte 2, "4+" word INC4 byte 1, "+" word PLUS byte 1, "-" word MINUS byte 3, "UM*" word UMMUL byte 1, "*" word MULTIPLY byte 2, "W*" word MUL16 byte 1, "/" word DIVIDE byte 2, "U/" word UDIVIDE byte 3, "U//" word UDIVMOD byte 2, "//" word UMOD byte 2, "*/" word MULDIV byte 4, "UM//" word UMDIVMOD64 byte 3, "C++" word CINC byte 3, "C--" word CDEC byte 3, "W++" word WINC byte 3, "W--" word WDEC byte 2, "++" word LINC byte 2, "--" word LDEC byte 3, "RND" word _RND byte 6, "GETRND" word _GETRND byte 4, "SQRT" word _SQRT byte 7, "SETDACS" word _SETDACS byte 1, "~" word CLRL byte 2, "~~" word SETL byte 2, "W~" word CLRW byte 3, "W~~" word SETW byte 2, "C~" word CLRC byte 3, "C~~" word SETC byte 3, "L>S" word L2S byte 2, ">W" word TOW byte 3, "L>W" word L2W byte 3, "W>B" word W2B byte 3, "W>L" word W2L byte 3, "B>W" word B2W byte 3, "B>L" word B2L byte 4, "MINS" word _MINS byte 4, "MAXS" word _MAXS byte 3, "MIN" word _MIN byte 3, "MAX" word _MAX byte 3, "ABS" word _ABS byte 7, "-NEGATE" word MNEGATE byte 7, "?NEGATE" word QNEGATE byte 6, "NEGATE" word NEGATE ' CONSTANTS ' byte 2, "ON" word MINUS1 byte 4, "TRUE" word MINUS1 byte 2, "-1" word MINUS1 byte 5, "FALSE" word _0 byte 3, "OFF" word _0 ' STRUCTURES byte 4+im, "GOTO" word GOTO byte 2+im, "IF" word _IF_ byte 4+im, "ELSE" word _ELSE_ byte 4+im, "THEN" word _THEN_ 'byte 5, "ENDIF" +im 'word _THEN_ byte 5+im, "BEGIN" word _BEGIN_ byte 5+im, "UNTIL" word _UNTIL_ byte 5+im, "AGAIN" word _AGAIN_ byte 5+im, "WHILE" word _IF_ byte 6+im, "REPEAT" word _REPEAT_ byte 6, "SWITCH" word _SWITCH byte 5, "CASE@" word SWFETCH byte 5, "CASE=" word ISEQ byte 5, "CASE>" word ISWITHIN byte 5+im, "BREAK" word ISEND byte 4+im, "CASE" word _CASE ' LOOPS' byte 3, "ADO" word ADO byte 2, "DO" word DO byte 4, "LOOP" word LOOP byte 5, "+LOOP" word PLOOP byte 3, "FOR" word FOR byte 4, "NEXT" word forNEXT byte 5, "?NEXT" word QNEXT byte 1, "I" word IX byte 1, "J" word J byte 5, "LEAVE" word LEAVE byte 3, "IC@" word ICFETCH byte 2, "I+" word IPLUS byte 6, "BOUNDS" word BOUNDS ' -------------I/O--------------- byte 1, "H" word H byte 1, "L" word L byte 1, "T" word _T byte 1, "F" word F byte 1, "R" word R byte 4, "HIGH" word HIGH byte 3, "LOW" word LOW byte 5, "FLOAT" word _FLOAT byte 4, "PIN@" word PINTEST '' byte 6, "SHROUT" '' word SHROUT '' byte 6, "SHRINP" '' word SHRINP ' SMARTPIN INSTRUCTIONS byte 5, "WRPIN" word _WRPIN byte 5, "WXPIN" word _WXPIN byte 5, "WYPIN" word _WYPIN byte 5, "RDPIN" word _RDPIN byte 5, "RQPIN" word _RQPIN byte 5, "AKPIN" word _AKPIN byte 7, "WAITPIN" word WAITPIN byte 5, "WRACK" word WRACK byte 3, "PIN" word _PIN byte 4, "@PIN" word _ATPIN byte 2, "ns" word ns byte 2, "PW" word PW byte 5, "PULSE" word PULSE byte 6, "PULSES" word PULSES byte 4, "HILO" word HILO ' SMARTPIN NCO/PWM byte 4, "DUTY" word DUTY byte 3, "NCO" word NCO byte 2, "HZ" word HZ byte 3, "KHZ" word KHZ byte 3, "MHZ" word MHZ byte 4, "MUTE" word MUTE byte 5, "BLINK" word BLINK byte 3, "PWM" word PWM byte 3, "SAW" word SAW ' SMARTPIN ASYNCH byte 3, "BIT" word BIT byte 4, "BAUD" word BAUDST byte 3, "TXD" word TXD byte 3, "RXD" word RXD byte 5, "TXDAT" word _TXDAT { byte c, "PA@" word PAFETCH byte c, "PB@" word PBFETCH byte c, "PA!" word PASTORE byte c, "PB!" word PBSTORE byte c, "DACLR" word DACLR byte c, "DBCLR" word DBCLR byte c, "PASET" word PASET byte c, "DASET" word DASET byte c, "PBSET" word PBSET byte c, "DBSET" word DBSET byte c, "PACLR" word PACLR byte c, "PBCLR" word PBCLR } byte 5, "WAITX" word DELTA byte 7, "WAITCNT" word WAITCNTS byte 6, "REBOOT" word REBOOT byte 5, "RESET" word RESET byte 5, "0EXIT" word ZEXIT byte 4, "EXIT" word EXIT '' byte 6, "SKIPNZ" '' word SKIPNZ byte 3, "NOP" word _NOP byte 4, "CALL" word ACALL byte 4, "JUMP" word AJMP byte 2, ">R" word PUSHR byte 2, "R>" word RPOP byte 2, ">L" word PUSHL byte 2, "L>" word LPOP byte 3, "!SP" word INITSP byte 5, "DEPTH" word _DEPTH byte 4, "COG@" word COGFETCH byte 4, "COG!" word COGSTORE byte 4, "LUT@" word LUTFETCH byte 4, "LUT!" word LUTSTORE byte 5, "COGID" word _COGID byte 7, "COGINIT" word _COGINIT byte 7, "COGSTOP" word _COGSTOP byte 6, "NEWCOG" word NEWCOG byte 6, "COGATN" word _COGATN byte 7, "POLLATN" word _POLLATN byte 6, "SETEDG" word _SETEDG byte 7, "POLLEDG" word _POLLEDG byte 3, "KEY" word KEY byte 4, "WKEY" word WKEY byte 4, "KEY!" word PUTKEY '' byte 7, "keypoll" '' word rg+keypoll byte 3, "CON" word _CON byte 4, "NONE" word NONE byte 3, "COM" word _COM '' byte 7, "DISCARD" '' word DISCARD byte 6, "CONKEY" word CONKEY byte 7, "CONEMIT" word CONEMIT byte 6, "SEROUT" word SEROUT byte 4, "EMIT" word EMIT byte 5, "EMITS" word EMITS byte 4, "CRLF" word CRLF byte 2, "CR" word CR byte 3, "CLS" word CLS { byte 3, "DOT" word DOT } byte 5, "SPACE" word SPACE byte 6, "SPACES" word SPACES ' DUMP MEMORY byte 3, "RAM" word RAM byte 5, "DUMP:" word SETDMP byte 4, "DUMP" word DUMP byte 5, "DUMPW" word DUMPW byte 5, "DUMPL" word DUMPL byte 5, "DUMPA" word DUMPA byte 6, "DUMPAW" word DUMPAW byte 2, "QD" word QD byte 2, "QW" word QW byte 5, "DEBUG" word DEBUG byte 4, "lsio" word lsio byte 3, "COG" word _COG byte 3, "LUT" word _LUT byte 2, "KB" word KB byte 2, "MB" word MB byte 1, "M" word M ' PRINTING byte 1, "." word PRT byte 5, "PRINT" word PRT byte 3, ".AS" word PRTAS byte 4+im, ".AS",$22 word PRTASR byte 5, ".DECL" word PRTDECL byte 5, ".DEC4" word PRTDEC4 '' byte 5, ".DEC2" '' word PRTDEC2 '' byte c, "@PAD" '' word ATPAD byte 4, "HOLD" word HOLD '' byte 5, ">CHAR" '' word BINASC byte 2, "#>" word RHASH byte 2, "<#" word LHASH byte 1, "#" word HASH byte 2, "#S" word HASHS byte 3, "" word DNUM byte 2, "U." word UPRT byte 4, ".DEC" word PRTDEC byte 4, ".BIN" word PRTBIN byte 2, ".H" word PRTHEX byte 2, ".B" word PRTB byte 5, ".BYTE" word PRTBYTE byte 2, ".W" word PRTW byte 5, ".WORD" word PRTWORD byte 2, ".L" word PRTL byte 5, ".LONG" word PRTLONG byte 5, ".ADDR" word PRTADR byte 6, "PRINT$" word PRINTSTR byte 4, "LEN$" word STRLEN byte 1+im, $22 word _STRING_ byte 2+im, $2E,$22 word _PSTR_ ' ." byte 5, "CTYPE" word CTYPE byte 5, "?EXIT" word IFEXIT '' byte c, "MOVBYTES" '' word _MOVBYTES ' MEMORY BLOCKS byte 5, "DATA?" word DATAQ byte 5, "ERASE" word ERASE byte 4, "FILL" word CFILL byte 5, "CMOVE" word CMOVE byte 6, "#" word NUMBER byte 5, "@DATA" word ATDAT byte 4, "HERE" word ATHERE byte 5, "@HERE" word rg+here byte 6, "@CODES" word rg+codes ' TABLES '' byte 6, "LOOKIN" '' word LOOKIN '' byte 6, "LOOKUP" '' word _LOOKUP ' VARIABLES byte 5, "uemit" word rg+uemit byte 4, "ukey" word rg+ukey byte 4, "char" word w+lastkey byte 5, "delim" word rg+delim byte 5, "names" word rg+names byte 4, "TASK" word TASK byte 3, "REG" word ATREG byte 5, "@WORD" word rg+wordbuf byte 4, "SPIN" word SPINNER ' | compile byte || compile word , compile long byte 1+im, "|" word CCOMP byte 2+im, "||" word WCOMP byte 1+im, "," word LCOMP byte 3+im, "[W]" word COMPW byte 3+im, "[",$22,"]" word COMPSTR byte 5, "NULL$" word NULLSTR byte 2, "$!" word STRST byte 2, "$=" word STREQ ' DEFINITIONS ' byte 3, "ASM" word _ASM byte 6+im, "FORGET" word FORGET byte 7+im, "CREATE$" word CREATEWORD byte 6+im, "CREATE" word CREATE byte 3+im, "VAR" word _VAR byte 3+im, "pub" word PUBDEF byte 3+im, "pri" word PRIDEF byte 3+im, "pre" word PREDEF { byte 6+im, "module" word MODDEF } byte 1+im, ":" word NEWDEF byte 1+im, ";" word ENDDEF byte 1+im, "[" word UNDEF byte 1+im, "]" word REDEF byte 1+im, "'" word ATICK '' byte 2+im, ":=" '' word _CON9 byte 2+im, ":=" word _CONST byte 3, "==!" word CONST byte 5, "ALIGN" word _ALIGN byte 6+im, "DATCON" word _DATCON byte 5, "ALLOT" word ALLOT byte 3, "org" word DATORG byte 5+im, "bytes" word dbytes byte 5+im, "words" word dwords byte 5+im, "longs" word dlongs byte 4+im, "byte" word dbyte byte 4+im, "word" word dword byte 4+im, "long" word dlong byte 3, "res" word dres byte 3+im, "[C]" word COMPILES byte 4+im, "GRAB" word GRAB ' FIELDS ( NAME-FIELD CODE-POINTER CODE-FIELD ) byte 4+im, "NFA'" word _NFATICK byte 3, "CPA" word NFACPA byte 3, "CFA" word NFACFA ' COMMENTS byte 1+im, "\" word COMMENT byte 3+im, "---" word COMMENT byte 1+im, "(" word PAREN byte 1+im, "{" word BRACE byte 1+im, "}" word _NOP ' CONDITIONAL COMPILATION ( conditionally ignore as comment ) byte 6+im, "IFNDEF" word IFNDEF byte 5+im, "IFDEF" word IFDEF '' byte 4, "IDLE" '' word IDLE '' byte 4, ".VER" '' word PRTVER byte 5, "TAQOZ" word _TAQOZ byte 4, "TERM" word TERMINAL byte 4+im, "AUTO" word AUTORUN byte 5, "SPIRD" word SPIRD byte 6, "SPIRDL" word SPIRDL byte 5, "SPIWB" word SPIWR8 byte 5, "SPICE" word SPICE byte 5, "SPIWC" word SPIWRC byte 5, "SPIWW" word SPIWR16 byte 5, "SPIWM" word SPIWM byte 5, "SPIWL" word SPIWRL byte 7, "SPIPINS" word SPIPINS byte 5, "SPIRX" word SPIRX byte 6, "SPITXE" word SPITXE byte 5, "SPITX" word SPITX { byte 5, "CLKIN" word CLKIN byte 6, "CLKOUT" word CLKOUT byte 5, "CLOCK" word CLOCK } byte 5, "WSLED" word WSLED byte 4, "WAIT" word WAIT byte 6, "CLKDIV" word CLKDIV byte 6, "RCSLOW" word RCSLOW byte 6, "HUBSET" word _HUBSET byte 2, "WP" word WP byte 2, "WE" word WE byte 5, "CLKHZ" word CLKHZ '' byte 6, "CLKMHZ" '' word CLKMHZ { byte 7, "BUFFERS" word BUFFERS byte 3, "ROM" word ROM byte 6, "IRQVEC" word IRQVEC byte 4, "PTRA" word w+PTRA byte 4, "PTRB" word w+PTRB byte 4, "DIRA" word w+DIRA byte 4, "DIRB" word w+DIRB byte 4, "OUTA" word w+OUTA byte 4, "OUTB" word w+OUTB byte 3, "INA" word w+INA byte 3, "INB" word w+INB } byte 5, "ERROR" word ERROR byte 6, "SFPINS" word SFPINS byte 3, "SF?" word SFSTAT byte 4, "SFWE" word SFWE byte 5, "SFINS" word SFINS byte 4, "SFWD" word SFWD byte 5, "SFSID" word SFSID byte 5, "SFJID" word SFJID byte 5, "SFER4" word SFER4 byte 6, "SFER32" word SFER32 byte 6, "SFER64" word SFER64 byte 7, "SFERASE" word SFERALL byte 6, "SFWRPG" word SFWRPAGE byte 6, "BACKUP" word BACKUP byte 7, "RESTORE" word RESTORE byte 5, "SFRDS" word SFRDS byte 5, "SFWRS" word SFWRS byte 4, "SFC@" word SFCFETCH byte 4, "SFW@" word SFWFETCH byte 3, "SF@" word SFFETCH byte 2, "SF" word SF byte 3, ".SF" word PRTSF byte 5, "SDBUF" word SDBUF byte 6, "sdpins" word _sdpins byte 5, "MOUNT" word MOUNT byte 3, "DIR" word PRTDIR byte 3, "!SD" word INITSD byte 3, "!SX" word INITSX byte 3, "SD?" word SDQ byte 3, "CMD" word CMD byte 4, "ACMD" word ACMD '' byte 3, "csd" '' word csd byte 3, "cid" word w+cid byte 4, "SDWR" word SDWR byte 5, "SDRDS" word SDRDS byte 5, "SDWRS" word SDWRS byte 5, "FLUSH" word FLUSH byte 5, "FOPEN" word FOPEN byte 5, "FLOAD" word FLOAD byte 4, "FGET" word FGET byte 5, "FREAD" word FREAD byte 6, "FWRITE" word FWRITE byte 6, "SECTOR" word SECTOR byte 4, "SDRD" word SDRD byte 5, "SDRDS" word SDRDS byte 5, "SDADR" word SDADR byte 3, "SD@" word SDFETCH byte 3, "SD!" word SDSTORE byte 4, "SDC@" word SDCFETCH byte 4, "SDC!" word SDCSTORE byte 4, "SDW@" word SDWFETCH byte 2, "SD" word SD '' byte 5, "RDFAT" '' word RDFAT byte 4, "@FAT" word ATFAT byte 5, "@BOOT" word ATBOOT byte 5, "@ROOT" word ATROOT '' byte 7, "CL>SECT" '' word CLSECT byte 3, "fat" word w+fat32 byte 3, "END" word _END long 0 enddict alignl {{ +------------------------------------------------------------------------------------------------------------------------------+ | TERMS OF USE: MIT License | +------------------------------------------------------------------------------------------------------------------------------+ |Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation | |files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, | |modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software| |is furnished to do so, subject to the following conditions: | | | |The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.| | | |THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE | |WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR | |COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, | |ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. | +------------------------------------------------------------------------------------------------------------------------------+ }}