Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
7235 lines (5980 sloc) 266 KB
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<filename> as 8.3; add hubset #1 before cogstop
'' f if Sd fails, jmp to shut_down in booter, now does cogid/cogstop
'' parse R<filename>
'' 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 <lf> 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 <cr> to repeat list (done)
<esc> 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 <cr> 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<fname>)
'' 139C w Chip pasted code
''-----------------------------------------------------------------------------
'' 140_a List uses xxxxx: was xxxxx-
'' R<filename> & L<fileanem>, 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 ' <esc> 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 <file> (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 <fname>
mov skiprun, #0 ' load/run <file>
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 <fname>
'' mov skiprun, #1 ' do not load/run <file> (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 <fname>
if_e RET ' return "Z" = found
mov fname+2, ##_fname2c ' new fname ext
call #@_searchDIR ' search dir for <fname2>
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 <file> found, and sets +
'+ dat_begin = first native sector of file's data +
'+ _sectors = file size in bytes +
'+ "NZ" if <file> 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)<<clustersh)+base +
'+ where clustersh=encod(sectors/cluster), base=dir_begin+
'+-----------------------------------------------------------------------------+
.found add bufad, #($14-8) ' ptr to 1st cluster hi
rdword dat_begin, bufad ' read
shl dat_begin, #16 ' bytes 3&2
add bufad, #($1A-$14) ' ptr to 1st cluster lo
rdword reply, bufad ' read
or dat_begin, reply ' bytes 3-0
' convert to sector#
sub dat_begin, #2 '\ correct cluster addr(-2)
shl dat_begin, clustersh '| convert to sector <<6?
add dat_begin, dir_begin '/ +base
' read filesize(bytes)
add bufad, #($1C-$1A) '\ _sectors <-- filesize
_RET_ rdlong _sectors, bufad '/ return "Z" = found
'+=============================================================================+
'+-----------------------------------------------------------------------------+
'+ Validate MBR/VOL CSUM $080-$17F="Prop". If valid, copy to Cog & Run +
'+-----------------------------------------------------------------------------+
_validateCSUM mov bufad, #$17C ' check long at $17C
rdlong reply, bufad '
cmp reply, ##_csum wz ' ="Prop"?
if_e jmp #@_success80 ' y: go load it
cmp reply, ##_csum2 wz ' ="ProP"? sector/size?
if_ne RET ' return "NZ" = not found
' ----------------------------------------
mov bufad, #$174 ' get sector start
rdlong dat_begin, bufad '
mov bufad, #$178 ' get length(bytes)
rdlong _sectors, bufad ' simulate file found
' ' fall thru to _readFILE
'+-------[ SD: Read File ]-----------------------------------------------------+ <--- SD: load/run file --->
'+ 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 ... <cr> DOWNLOAD: to cog/lut/hub {addr1} following {byte(s)}
'' xxxxxx [.xxxxxx] L <cr> LIST: from cog/lut/hub {addr1} to < {addr2}
'' xxxxxx G <cr> GOTO: to cog/lut/hub {addr1}
'' Q <cr> QUIT: Quit Rom Monitor and return to the User Program
'' Rffffffffxxx<cr> RUN: Run file from SD
'' <esc><cr> 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 <lf>
_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 <cr> 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<cr>"
''===============================================================================================
''-------[ 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 <cr> 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; <nul> terminates
'' ' if =$0, tx one <nul>
'' 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) ' <cr><lf> (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, <nul> 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) ' "'"<cr><lf>
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 <cr>, excl <nul>)
''--------------------------------------------------------------------------------------------------
_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 <cr>
mov lmm_c, #0 ' set char count=0
.loop CALL #@_HubRx ' < call: receive char >
cmp lmm_x, #_LF_ wz ' <lf> ?
if_nz jmp #.notlf ' n:
test lmm_f, #_NOLF wz ' strip <lf> ?
if_nz jmp #.loop ' y:
.notlf cmp lmm_x, #_BS_ wz ' <bs> ?
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 ' <bs> ?
if_nc_and_nz cmp lmm_x, #_CR_ wz ' <cr> ?
if_nc_and_nz jmp #.loop ' j if buf full + not <bs> not <cr> (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 ' <bs> ?
if_z mov lmm_x, ##(_BS_+" "<<8+_BS_<<16) ' y: echo <bs>" "<bs>
CALL #@_HubTx ' < call: transmit char(s) >
cmp lmm_x, #_CR_ wz ' <cr> ?
if_z mov lmm_x, #_LF_ ' y: follow <cr> with <lf>
if_z CALL #@_HubTx '
rdbyte lmm_x, lmm_p ' restore input char
.noecho cmp lmm_x, #_BS_ wz ' <bs> ?
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 ' <cr> ?
if_nz jmp #.loop ' n:
' have a buffer with <cr> followed by <nul> 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 ' <cr>? repeat LIST
if_e jmp #@_Cmd_CR '
cmp lmm_w, #_TAQOZ_ wz ' <esc>? 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<cr> 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<filename.xtn><cr> ' Run filename "ffffffff.xxx" from SD
' ' L<filename.xtn><cr> ' 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 <filename> from SD
jmp #.done '
.load CALL #@_LOAD_SDfile ' load <filename> 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'] <cr>
''--------------------------------------------------------------------------------------------------
_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 ' <cr>?
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 <spaces>
.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 ' <cr>? (don't skip over <cr>)
if_ne add lmm_p, #1 ' n: PTR++ (skip over non-hex char)
RET wcz ' <--- return to calling routine --->
''===============================================================================================
''-------[ Parse <filename> ]-------------------------------------------------- <--- 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'
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 <control> 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' ( <name> -- 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
' ' <name> ( -- 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 <name> - 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
' : <name>
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:
<limit> VECTORS <vector if over>
<vector0> <vector1> ...... <vectorx>)
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 *** }
' <CMOVE ( src dst cnt -- ) byte move in reverse from the ends to the start
RCMOVE word ROT,OVERPLUS,DEC,ROT,THIRD,PLUS,DEC,ROT,pRCMOVE,EXIT
{ *** TIMING *** }
secs word W1000,MUL16
' ms ( n -- ) Wait for n milliseconds
ms word QDUP,ZEXIT,_LONG
long sys_clk/1000
word MULTIPLY,WAIT,EXIT
us word CLKMHZ,MUL16,w+485,MINUS,WAIT,EXIT
M word W1000000,MULTIPLY,EXIT
MB word KB
KB word w+10,_SHL,EXIT
{ debug print routines - also used by DUMP etc }
{HELP .HEX ( n -- ) print nibble n as a hex character }
PRTHEX ' ( n -- ) print n (0..$0F) as a hex character
word BITS4,w+"0",PLUS,DUP,w+$39,GT,_IF+02,_7,PLUS,EMIT+ex
HEXSYM word w+"$",EMIT+ex
PRTB word HEXSYM
{HELP .BYTE ( n -- ) print n as 2 hex characters }
PRTBYTE word DUP,_4,_SHR,PRTHEX,PRTHEX+ex
PRTW word HEXSYM
{HELP .WORD ( n -- ) print n as 4 hex characters }
PRTWORD word DUP,_SHR8
word PRTBYTE,PRTBYTE+ex
PRTL word HEXSYM
{HELP .LONG ( n -- ) print n as 8 hex characters }
PRTLONG word DUP,_SHR16,PRTWORD
word SCORE,PRTWORD+ex
DCFETCH word rg+dmm,WFETCH,QDUP,_IF+02,ACALL,EXIT
.L0 word CFETCH,EXIT
DWFETCH word rg+dmm+2,WFETCH,QDUP,_IF+02,ACALL,EXIT
.L0 word WFETCH,EXIT
DFETCH word rg+dmm+4,WFETCH,QDUP,_IF+02,ACALL,EXIT
.L0 word FETCHX+ex
SETDMP word RPOP,rg+dmm,_6,CMOVE,EXIT
DUMP word rg+dmp,WFETCH,rg+dmp,CLRW,QDUP,SKIPZ,AJMP,DUMPB+ex
DMPA word PRTADR,IX,_16,rg+dcnt,CLRC,EXIT
DSPACE word SPACE,rg+dcnt,CINC,rg+dcnt,CFETCH,_3,_AND,IFEXIT,SPACE+ex
{ QUICK DUMP }
QD word w+$20
'' DUMP ( addr cnt -- ) Hex dump of hub RAM - }
DUMPB word ADO
word DMPA,ADO,IX,DCFETCH,PRTBYTE,DSPACE,LOOP
DMPLP word DUMPASC
word _16,PLOOP
RAM word rg+dmm,_8,ERASE,EXIT
' QUICK WORD DUMP '
QW word w+$20
{ DUMP as WORDs }
DUMPW word ADO
word DMPA,ADO,IX,DWFETCH,PRTWORD,DSPACE,_2,PLOOP
word DMPLP+ex
{ DUMP as LONGs }
DUMPL word ADO
word DMPA,ADO,IX,DFETCH,PRTLONG,DSPACE,_4,PLOOP
word DMPLP+ex
{ DUMP as ASCII WIDE }
DUMPAW word w+128,DUMPS+ex
{ DUMP as ASCII }
DUMPA word w+64
DUMPS word ROT2
word ADO
word PRTADR
word IX,OVER,ATYPE
word DUP,PLOOP,DROP
word RAM+ex
ATYPE word ADO,IX,DCFETCH,AEMIT,LOOP,EXIT
PRTADR word CRLF,IX,DUP,_SHR16,DUP,_IF+03,DROP,PRTLONG,PRTCOL+ex,PRTHEX,PRTWORD
PRTCOL word w+":",EMIT,SPACE+ex
DUMPASC word SPACES3,PRTTICK,IX,_16,ADO,IX,DCFETCH,AEMIT,LOOP,PRTTICK+ex
_LUT word w+LUTFETCH,COGSET+ex
_COG word w+COGFETCH
COGSET word _WORD,COGLUT,WSTORE,_WORD,COGDUMP,rg+dmp,WSTOREX+ex
COGDUMP
word ADO,IX,_7,_AND,_ZEQ,_IF+09,CRLF,SPACE,SPACE,IX,_SHR8,PRTHEX,IX,PRTBYTE,PRTCOL
'' word IX,_3,_AND,SKIPNZ,SPACE
word IX
COGLUT word COGFETCH,PRTLONG,DSPACE,LOOP,EXIT
' Print the stack(s) and dump the registers - also called by hitting <ctrl>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
' <D> ( 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,<NAME>,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 <name> -- ) [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 <source> 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