--- taqoz.spin2 2021-09-15 22:02:21.134585195 +1000 +++ taqoz.spin2.orig 2021-09-15 21:53:15.380506603 +1000 @@ -1,70 +1,70 @@ -CON -_xtlfreq = 25_000_000 -_clkfreq = 200_000_000 -XIN = _xtlfreq -xmode = 3 ' 2 for xtal, 3 for osc' -CPUHZ = _clkfreq '200_000_000 ' desired CPU clock frequency' -baud_rate = 921600 ' console baud rate - timing value calculated at startup' -morestops = 0 ' extra stop bits for USB or terminal esp. at higher baud rates -bootms = 1000 - -'#######################################################################' -' P2.inc -'#######################################################################' -CON - -{ -_XTALFREQ = 25_000_000 ' crystal frequency - _XDIV = 5 '\ '\ crystal divider to give 5.0MHz - _XMUL = 40 '| 200MHz '| crystal / div * mul to give 200MHz - _XDIVP = 1 '/ '/ crystal / div * mul /divp to give 200MHz - _XOSC = %10 'OSC ' %00=OFF, %01=OSC, %10=15pF, %11=30pF - _XSEL = %11 'XI+PLL ' %00=rcfast(20+MHz), %01=rcslow(~20KHz), %10=XI(5ms), %11=XI+PLL(10ms) - _XPPPP = ((_XDIVP>>1) + 15) & $F ' 1->15, 2->0, 4->1, 6->2...30->14 - _CLOCKFREQ = _XTALFREQ / _XDIV * _XMUL / _XDIVP ' internal clock frequency - _SETFREQ = 1<<24 + (_XDIV-1)<<18 + (_XMUL-1)<<8 + _XPPPP<<4 + _XOSC<<2 ' %0000_000e_dddddd_mmmmmmmmmm_pppp_cc_00 ' setup oscillator - _ENAFREQ = _SETFREQ + _XSEL ' %0000_000e_dddddd_mmmmmmmmmm_pppp_cc_ss ' enable oscillator -} - -' XIDIV XIMUL VCODIV -' CLOCK MODE = %E_DDDD_DDMM_MMMM_MMMM_PPPP_CCSS -PLLEN = %1_0000_0000_0000_0000_0000_0000 -NOXI = %0_0000_0000_0000_0000_0000_0000 -PF0 = %0_0000_0000_0000_0000_0000_0100 -PF15 = %0_0000_0000_0000_0000_0000_1000 -PF30 = %0_0000_0000_0000_0000_0000_1100 - -_RCFAST1 = %0_0000_0000_0000_0000_0000_0000 -_RCSLOW1 = %0_0000_0000_0000_0000_0000_0001 -XINCLK = %0_0000_0000_0000_0000_0000_0010 ' use XIN -PLLCLK = %0_0000_0000_0000_0000_0000_0011 ' use PLL - -' The PLL output frequency will be Freq(VCO) if %PPPP = 15, else Freq(VCO) / (%PPPP + 1) / 2. -XIDIV = 1 ' crystal/osc input divider' -VCODIV = 1 -CLKMUL = CPUHZ/(XIN/XIDIV) -CLKCFG = 1<<24+(XIDIV-1)<<18+(CLKMUL-1)<<8+((VCODIV-2)&$0F)<<4+PF15 - - - -baudval = (CPUHZ/baud_rate)<<16 - - - -' SERIAL COMS -rx_pin = 63 'pin serial receiver -tx_pin = 62 'pin serial transmitter -' SPI FLASH -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) -' SD CARD -sd_cs = spi_ck -sd_ck = spi_cs -sd_di = spi_di -sd_do = spi_do - +CON +_clkfreq = 200_000_000 +_xinfreq = 20_000_000 +XIN = _xinfreq +xmode = 3 ' 2 for xtal, 3 for osc' +CPUHZ = _clkfreq '200_000_000 ' desired CPU clock frequency' +baud_rate = 921600 ' console baud rate - timing value calculated at startup' +morestops = 2 ' extra stop bits for USB or terminal esp. at higher baud rates +bootms = 1000 + +'#######################################################################' +' P2.inc +'#######################################################################' +CON + +{ +_XTALFREQ = 20_000_000 ' crystal frequency + _XDIV = 4 '\ '\ crystal divider to give 5.0MHz + _XMUL = 72 '| 180MHz '| crystal / div * mul to give 360MHz + _XDIVP = 2 '/ '/ crystal / div * mul /divp to give 180MHz + _XOSC = %10 'OSC ' %00=OFF, %01=OSC, %10=15pF, %11=30pF + _XSEL = %11 'XI+PLL ' %00=rcfast(20+MHz), %01=rcslow(~20KHz), %10=XI(5ms), %11=XI+PLL(10ms) + _XPPPP = ((_XDIVP>>1) + 15) & $F ' 1->15, 2->0, 4->1, 6->2...30->14 + _CLOCKFREQ = _XTALFREQ / _XDIV * _XMUL / _XDIVP ' internal clock frequency + _SETFREQ = 1<<24 + (_XDIV-1)<<18 + (_XMUL-1)<<8 + _XPPPP<<4 + _XOSC<<2 ' %0000_000e_dddddd_mmmmmmmmmm_pppp_cc_00 ' setup oscillator + _ENAFREQ = _SETFREQ + _XSEL ' %0000_000e_dddddd_mmmmmmmmmm_pppp_cc_ss ' enable oscillator +} + +' XIDIV XIMUL VCODIV +' CLOCK MODE = %E_DDDD_DDMM_MMMM_MMMM_PPPP_CCSS +PLLEN = %1_0000_0000_0000_0000_0000_0000 +NOXI = %0_0000_0000_0000_0000_0000_0000 +PF0 = %0_0000_0000_0000_0000_0000_0100 +PF15 = %0_0000_0000_0000_0000_0000_1000 +PF30 = %0_0000_0000_0000_0000_0000_1100 + +_RCFAST1 = %0_0000_0000_0000_0000_0000_0000 +_RCSLOW1 = %0_0000_0000_0000_0000_0000_0001 +XINCLK = %0_0000_0000_0000_0000_0000_0010 ' use XIN +PLLCLK = %0_0000_0000_0000_0000_0000_0011 ' use PLL + +' The PLL output frequency will be Freq(VCO) if %PPPP = 15, else Freq(VCO) / (%PPPP + 1) / 2. +XIDIV = 1 ' crystal/osc input divider' +VCODIV = 1 +CLKMUL = CPUHZ/(XIN/XIDIV) +CLKCFG = 1<<24+(XIDIV-1)<<18+(CLKMUL-1)<<8+((VCODIV-2)&$0F)<<4+PF15 + + + +baudval = (cpuhz/baud_rate)<<16 + + + +' SERIAL COMS +rx_pin = 63 'pin serial receiver +tx_pin = 62 'pin serial transmitter +' SPI FLASH +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) +' SD CARD +sd_cs = spi_ck +sd_ck = spi_cs +sd_di = spi_di +sd_do = spi_do + '#######################################################################' ' memmap.inc '#######################################################################' @@ -159,65 +159,65 @@ 7F500 RX BUFFERS (768) 7F800 FILE BUFFERS (2K) } - - -{ I/O PINS -P63 RXD -P62 TXD -P61 SFCS SDCK -P60 SFCK SDCS -P59 SFDI SDDI -P58 SFDO SDDO -P57 SDA -P56 SCL -- -P55 -P54 PS2CLK -P53 PS2DAT -P52 VS -P51 RED -P50 GRN -P49 BLU -P48 HS -- -P47 -P46 -P45 -P44 -P43 -P42 -P41 -P40 -- -P39 -P38 -P37 -P36 -P35 -P34 -P33 -P32 - -_VGACFG long $03020100 ''$33323130 ' VGA RGBH pins on P48..P52 - long $04 ''$34 ' VSYNCH' -_VGAINIT long @vgainit ' VGA code ' -_VGASET long round(fset) -_KBCFG long $3635 ' PS/2 CLK,DAT' 54,53 - - - -} - -'************* VGA & KEYBOARD ************* ' - -vgacog = 7 ' vga runs in this cog ' - -DAT ' STAGE 1 - BOOT TIME INITIALIZATION ' - - orgh 0 - org - jmp #initsys - + + +{ I/O PINS +P63 RXD +P62 TXD +P61 SFCS SDCK +P60 SFCK SDCS +P59 SFDI SDDI +P58 SFDO SDDO +P57 SDA +P56 SCL +- +P55 +P54 PS2CLK +P53 PS2DAT +P52 VS +P51 RED +P50 GRN +P49 BLU +P48 HS +- +P47 +P46 +P45 +P44 +P43 +P42 +P41 +P40 +- +P39 +P38 +P37 +P36 +P35 +P34 +P33 +P32 + +_VGACFG long $03020100 ''$33323130 ' VGA RGBH pins on P48..P52 + long $04 ''$34 ' VSYNCH' +_VGAINIT long @vgainit ' VGA code ' +_VGASET long round(fset) +_KBCFG long $3635 ' PS/2 CLK,DAT' 54,53 + + + +} + +'************* VGA & KEYBOARD ************* ' + +vgacog = 7 ' vga runs in this cog ' + +DAT ' STAGE 1 - BOOT TIME INITIALIZATION ' + + orgh 0 + org + jmp #initsys + '**************** configuration block **************** ' '' @@ -232,7 +232,7 @@ _CLKCFG long CLKCFG '$012C_B3FF $014CB3FC ' ' *** SERIAL/VGA/KEYBOARD *** ' -_baud long baud_rate +_BAUD long baud_rate _VGACFG long $03020100 '$33323130 ' VGA RGBH pins on P48..P52 (set long to 0 to disable vga) long $04 ' VSYNCH' _VGAINIT long @vgainit ' VGA code ' @@ -265,482 +265,482 @@ mbxs res 64 ' inp0 out0 inp1 out1 etc ' -' $0200 TAQOZ task registers -'#######################################################################' -' init.inc -'#######################################################################' - - orgh _hubcode - -InitTaqoz - drvh #tx_pin - rdlong PTRA,#@_IDLE - cogid X - tjnz X,#.j1 -' COG 0 CONSOLE ' - call #InitSerial - rdlong PTRA,#@_TERMINAL ' ONLY COG 0 IS BEING INITIALIZED - SETUP Forth boot' -.j1 call #@INITSTKS - jmp #doNEXT - - - ' *** TRACE *** -{ -TAQOZ# !SP TRACE 100 300 SWAP - NOP UNTRACE --- - 7288 : F864 - 728A : F92C 1( 00000064 ) - 728C : 007F 2( 0000012C 00000064 ) - 728E : 008C 2( 00000064 0000012C ) - 7290 : 0051 1( 000000C8 ) - 7292 : 1324 1( 000000C8 ) ok - - IP : CODE STACK DEPTH( TOP SECOND etc ) - 728E : 008C 2( 00000064 0000012C ) - -} - -CON -' DEBUG "REGISTERS" - set to high cog memory' - -traceL = $1EF -xreg = traceL-1 -hr0 = traceL-2 -hr1 = traceL-3 -hr2 = traceL-4 -dbtab = traceL-5 - -DAT -' TRACE -TRACE rdlong doNext,##TRACER ' Replace 1st instruction of doNEXt with a call to TRACING' - mov traceL,#0 - ret ' !!! use discrete ret to delay before returning to doNEXT' -TRACER call #\TRACING -UNTRACE rdlong doNext,##TRACING - ret - - -'''''''''''''''''''''''''''''''''' -{ -1A28 : 0055 EXIT 3( 0000CD42 0000007B DEADBEEF ) -32C0 : 32AD 3( 0000CD42 0000007B DEADBEEF ) -32AC : 007B DUP 3( 0000CD42 0000007B DEADBEEF ) -32AE : 00E2 W@ 4( 0000CD42 0000CD42 0000007B DEADBEEF ) -} - -TRACING - rdword x,PTRA++ ' read word code instruction - cmp PTRA,traceL wc - if_c ret - call #DBIP ' PRINT IP ' - call #DBNAME ' PRINT NAME' - -DBPRTSTK mov hr0,depth wz ' PRINT STACK' - if_z ret - mov hr1,#32 ' ALIGN' - call #DBTABS - mov hr0,depth - call #DBPRTH - mov hr2,depth - mov hr0,#"(" - call #DBTX - mov xreg,a - call #DBPRTL - djz hr2,#DBPE - mov xreg,b - call #DBPRTL - djz hr2,#DBPE - mov xreg,c - call #DBPRTL - djz hr2,#DBPE - mov xreg,d - call #DBPRTL -DBPE mov hr0,#")" - jmp #DBTX - -' PRINT HEX CHARACTER' -DBPRTH add hr0,#$30 'convert bin to hex' - cmp hr0,#$3A wc - if_nc add hr0,#7 - jmp #DBTX - -' PRINT LONG ' -DBPRTL mov hr1,#8 ' 8 DIGITS' -DBPRTD ' print digits ' ' print hr1 digits from left in xreg - call #DBSPACE -DBPLP mov hr0,xreg - shr hr0,#28 ' get next msd' - call #DBPRTH - rol xreg,#4 ' next digit' - djnz hr1,#DBPLP -DBSPACE mov hr0,#$20 ' SPACE' - jmp #DBTX - -' PRINT 5 DIGIT ADDRESS ' -DBPRTA mov hr1,#5 - shl xreg,#12 - JMP #DBPRTD - -DBPRTW mov hr1,#4 - shl xreg,#16 - JMP #DBPRTD - -' PRINT CODE NAME - search the dictionary for a code match ' -' 0DE00: 03 44 55 50 74 00 04 4F 56 45 52 78 00 03 33 52 '.DUPt..OVERx..3R' -DBNAME - rdlong hr2,##registers+names ' dictionary -DBFLP rdword hr0,hr2 wz ' read count and 1st char or link' - if_z jmp #DBWHAT - and hr0,#$1F ' check count' - add hr0,hr2 - add hr0,#1 ' point to CPA' - rdword xreg,hr0 ' read its CFA - cmp xreg,x wz ' matched to CFA in x ?' - if_z jmp #DBFOUND ' print it' - add xreg,#1 - cmp xreg,x wz ' matched to CFA+1 (jump to) in x ?' - if_z jmp #DBFOUND ' print it' - mov hr2,hr0 - add hr2,#2 ' point to next name' - jmp #DBFLP -DBWHAT - cmp x,#_LONG wz - if_z jmp #DBPRT32 - cmp x,#_WORD wz - if_z jmp #DBPRT16 - cmp x,##w wc - if_c ret - cmp x,##_IF wc - if_nc ret - mov hr1,#3 - mov xreg,x - shl xreg,#32-10 - shr xreg,#2 -DBPRTLIT - call #DBPRE - jmp #DBPRTD -DBPRT16 call #DBPRE - rdword xreg,PTRA - jmp #DBPRTW -DBPRT32 call #DBPRE - rdlong xreg,PTRA - jmp #DBPRTL -DBPRE mov hr0,#"$" - jmp #DBTX - -DBFOUND rdbyte hr1,hr2 ' pointing to NFA - and hr1,#$1F ' read count -.L0 add hr2,#1 ' point to next char - rdbyte hr0,hr2 wc ' read next char -'' if_c mov hr0,"?" -'' cmp hr0,#$20 wc -'' if_c mov hr0,"?" - call #DBTX ' output char - _ret_ djnz hr1,#.L0 -{ -w = $1800 ' wordcode offset for 10-bit literals 0..1023 - _IF = $1C00 ' IF relative forward branch 0 to 127 words - _UNTIL = $1C80 ' UNTIL relative reverse branch 0 to 127 words -GO = $1D00 -GOBACK = $1D80 -'opunused = $1D00 ' ???? could use' -rg = $1E00 ' task/cog register 8-bit offset - -} - -DBSPACES call #DBSPACE - _ret_ djnz hr1,#DBSPACES -{ -DBFAIL mov hr1,#16 - jmp #DBSPACES -} - -DBTABS cmp dbtab,hr1 wc - if_nc ret - call #DBSPACE - jmp #DBTABS - -DBINDENT mov hr1,retptr - sub hr1,#retstk - jmp #DBSPACES - -DBIP call #DBCR - mov xreg,PTRA ' print IP ' - sub xreg,#2 ' compensate for ptra++' - call #DBPRTA - mov hr0,#":" - call #DBTX - call #DBINDENT - mov xreg,X ' print wordcode in X ' - jmp #DBPRTW - - -' PRINT CRLF ' -DBCR mov hr0,#$0D - call #DBTX - mov hr0,#$0A - call #DBTX - _ret_ mov dbtab,#0 - - ' -DBTX bith hr0,#8+(15<<5) -.l0 testp #tx_pin wc '..wait for buffer empty - if_nc jmp #.l0 - add dbtab,#1 - _ret_ wypin hr0,#tx_pin '..send byte - -{ -DBINIT - rdlong hr0,#@_CPUHZ - rdlong hr1,#@_baud - qdiv hr0,hr1 - getqx hr0 - shl hr0,#16 - add hr0,#7 - _ret_ wxpin hr0,#tx_pin -} - -'#######################################################################' -' taqoz.inc -'#######################################################################' - -'******************************************************************************* -'* * -'* TAQOZ - Tachyon Forth for the Parallax P2 CPU ROM * -'* * -'******************************************************************************* - - -CON - - sys_clk = CPUHZ - nscnt = 100000/(sys_clk/1000000) - -' 180524 - implement 10-bit short literals and 9-bit task register addresses for compact fat32 variables' -{ -( ADDRESSES USE FOR CODED OPS ) -01800-01BFF shorts (0..1023) -01C00-01CFF conditional relative branch -01D00-01DFF unconditional relative branch -01E00-01FFF register index (0..511) -} - w = $1800 ' wordcode offset for 10-bit literals 0..1023 - _IF = $1C00 ' IF relative forward branch 0 to 127 words - _UNTIL = $1C80 ' UNTIL relative reverse branch 0 to 127 words - GO = $1D00 - GOBACK = $1D80 - 'opunused = $1D00 ' ???? could use' - rg = $1E00 ' task/cog register 8-bit offset - - - tasks = registers+$D0 ' 2 longs/task * 8 cogs - - SKIPZ = _IF+01 ' short-form for _IF+01' - - ex = 1 ' EXITs (jump to hub wordcode instead of call) - - _FALSE = w+0 ' quick constants ' - _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 - - - numpadsz = 44 ' 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 = 44 ' any word including binary numbers up to n characters (1 count, 1 terminator) - tasksz = 8 ' 8 bytes/task RUN[2] FLAG[1] - - - WW = $FFFF - ' defs for TAQOZ ' -'#######################################################################' -' version.p2a -'#######################################################################' -dat - orgh - -taqoz_version long 2_8 -taqoz_time long 210401_1230 -taqoz_name byte "CHIP" ' use exactly 4 characters = 1 long' - -{ -210401 Adjusted us and ms to compensate for the literal as well so that 3 us = 3us -210330 Added "drvh tx_pin" in reset (COG0 is initialized last and might take too long) - Added WSTX routine for WS2812 -210329 Removed LSBOUT MSBOUT MSBIN and replaced with RCLIO -210308 Modified SPIRX to use smartpin assisted clocking for sysclk/4 data rates -210306 Added waitx clkdly in place of nop in SPI clocking ( reordered the cog registers to fit this in in the SPI section) - Changed CONEMIT to check tx ready before sending for faster throughput - added a timeout just in case -210302 renamed EXIT; to +EXIT since it appends an EXIT (jump bit) to the previous instruction if it can. - Use EXIT; to always append an EXIT and stop compilation - an normal unoptimized ; in other words - $ prefixed hex numbers are always comverted to upper case HEX so now $beef will work etc - -210219 Updated PRINT" and PRINT$ to handle \ controls including a \$nn for hex - Extended TRACE to include code jump (code+1) match and display literals (10,16,32-bit) - Added lower case support for hex numbers. -210208 Modify FLASH BACKUP to include size at start of block etc to work with 2nd stage loader - -210207 remove dummy $0D transmit on serial init (EMIT sends first then waits anyway) - Add a new delayms value to prevent UB3 garble during power-up -201123 Force 1k5 pullups on SCL/SDA and change FLTx to DRVH - The external pullups are not fitted on the P2D2ed, and the UB3 loads a low speed using its weak pullups -200621 Change title to emphasize TAQOZ RELOADED and incorporate ROM version in .VER -200604 Add scl contention to I2C.START -2005xx Fix I2C timing and scl contention issues. -200412 Added return stack indenting to TRACE module - Replaced GET$ control key processing with table lookup so user code - can write new functions to a control key with CTRL! -200410 Implemented V2.5 which rearranges the memory map optimized to: - * Maximise threaded code space in PAGE0 with unimpeded flow into PAGE1 - * Relocate dictionary to end of PAGE1 by default - * CONFIG backup is now at the end of PAGE1 after the dictionary - * BACKUP MBR defaults to 128K size - * CODED ops are now sandwiched between cog/hubexec and threaded. - * Data area in PAGE0 in otherwise unused 2k CODED ops memory area -200409 Fixed Dictionary link mechanism to handle relative addressing (moving dictionary) - Added relative jump code for ELSE instead of an absolute address code -200408 Extended TRACER to print long IP and also an address window limit - Fixed DECOMPILER to handle extended code -200405 Added extended pagin mode to threaded code that allows it to reach beyond 64k. - Code is compiled as normal any words that are created outside page 0, the first 64k - then have a page attribute set in the header plus one extra CPA byte. - Any references to extended code are preceded with a PAGEx wordcode - Added ^Y to list the complete dictionary -200328 Restored kernel EXIT and renamed high-level optimizer EXIT to EXIT; - Changed 1ms CRLF delay to only delay with serial console -200326 - implemented high precision 4 cycle interruptable timing delays in us, ms, s -200325 - Change lastkey variable to KEY@ to fetch last 4 keys - Added 1ms delay to each CRLF (mainly to help the UB3 chip ) -200324 - Optimizd 2DROP and 3DROP as hubexec - -200317 - Changed datptr to ptrb - improved pushx/popx - Added trace module -200310 Improved LEN$, and added COGMOD and LOADMOD -200222 Improve console routines such as PROMPT etc for Interactive Assembler extensions -200210 Add SIGN using SIGNX -20XXXX Added link field for dictionary linking and hiding - -190705 - Unified branch and loop stack so that FOR and DO both push loop IP, index, and limit. -190112 -Changed arrangement of hubexec code and put it back after cog code so threaded simply builds up to $FC00 max. -This speeds up doNEXT as well. -Data pointer set to $1.2000 -} - ' version header ' -'#######################################################################' -' variables.p2a -'#######################################################################' -CON -dcnt = 0 - -DAT -'************************************* HUB REGISTERS ************************************** - - org 0 -' register offsets within "registers". Access as REG,delim ... REG,base ... etc -' -' Minimum registers required for a new task - other registers after the ' ---- are not needed other than by the console -temp res 12 ' general purpose -double res 4 ' hold high word of double -' @16 -uemit res 2 ' emit vector 0 = default -ukey res 2 ' key vector -keypoll res 2 ' poll user routines - low priority background task -base res 2 ' current number base + backup location during overrides -baudcnt res 4 ' SERIN SEROUT baud cnt value where baud = clkfreq/baudcnt each cog can have it's own -uswitch res 4 ' target parameter used in CASE structures -' @32 -fflags res 2 ' echo,linenums,ipmode,leadspaces,prset,striplf,sign,comp,defining - -CON ' fflags bit fields ' - echoF = 0 - okF = 1 ' disable OK response' - ackF = 2 ' --- response inhibit ' - lineF = 3 ' disable newline ' - ipF = 4 ' interpret this number in IP format where a "." separates bytes - signF = 5 - compF = 6 - defF = 7 - passF = 8 - -DAT -keycol res 1 ' maintains column position of key input - -wordcnt res 1 ' length of current word (which is still null terminated) -wordbuf res wordsz ' words from the input stream are assembled here -' numpad may continue to build backwards into wordbuf for special cases such as long binary numnbers -numpad res numpadsz ' Number print format routines assemble digit characters here builds from end - 18,446,744,073,709,551,615 -padwr res 1 ' write index (builds characters down from lsb to msb in MODULO style) - res 1 - -pflg res 1 -pbase res 1 - -' $80 -keychar res 8 ' override for key character - up to 8 chars in one long lsb first -outchar res 8 ' output mailbox ' - - -delim res 2 ' the delimiter used in text input and a save location -prefix res 1 ' NUMBER input prefix -suffix res 1 ' NUMBER input suffix - -uprompt res 2 ' pointer to code to execute when Forth prompts for a new line -uaccept res 2 ' pointer to code to execute when Forth accepts a line to interpret (0=ok) -unum res 2 ' User number processing routine - executed if number failed and UNUM <> 0 -ufind res 2 ' runs extended dictionary search if set after failing precompiled dictionary search - - - - -' -' ------ console only registers not required for other tasks --- can be accessed as globals -' - - -' these 4 variables are cleared as an array of 10 bytes -anumber res 4 ' Assembled number from input -hnumber res 4 ' high word of double number' -bnumber res 4 ' part of IP notation number' -digits res 1 ' number of digits in current number that has just been processed -dpl res 1 ' Position of the decimal point if encountered (else zero) - -'createvec res 2 ' If set will execute user create routines rather than the kernel's (CREATE revectored) - -dmm res 12 ' dump "fetch' vectors to allow dump to access special devices -dmp res 2 ' DUMP vector - -''''''''''''''''''''''' fixed ''''''''''''''''''''''''''' - - -oldnames res 4 ' backup of names used at start of TAQOZ load -names res 4 ' start of dictionary (builds down) -oldhere res 4 ' Used by TAQOZ word to backup current here to determine code size at end of load -here res 4 ' pointer to compilation area (overwrites VM image) -codes res 4 ' current code compilation pointer (updates "here" or is reset by it) -autovec res 4 ' user autostart address if non-zero - called from within terminal -'' -cold res 2 ' pattern to detect if this is a cold or warm start ($A55A ) -errors res 2 -linenum res 2 -atrs res 1 ' definition header attributes (pub/pri/pre) ' - res 1 -spincnt res 2 ' Used by spinner to rotate busy symbol - res 2 ' word count -mrd res 4 ' memory read' -athen res 4 -endreg res 1 - ' defs for TAQOZ variables ' +' $0200 TAQOZ task registers +'#######################################################################' +' init.inc +'#######################################################################' + + orgh _hubcode + +InitTaqoz + drvh #tx_pin + rdlong PTRA,#@_IDLE + cogid X + tjnz X,#.j1 +' COG 0 CONSOLE ' + call #InitSerial + rdlong PTRA,#@_TERMINAL ' ONLY COG 0 IS BEING INITIALIZED - SETUP Forth boot' +.j1 call #@INITSTKS + jmp #doNEXT + + + ' *** TRACE *** +{ +TAQOZ# !SP TRACE 100 300 SWAP - NOP UNTRACE --- + 7288 : F864 + 728A : F92C 1( 00000064 ) + 728C : 007F 2( 0000012C 00000064 ) + 728E : 008C 2( 00000064 0000012C ) + 7290 : 0051 1( 000000C8 ) + 7292 : 1324 1( 000000C8 ) ok + + IP : CODE STACK DEPTH( TOP SECOND etc ) + 728E : 008C 2( 00000064 0000012C ) + +} + +CON +' DEBUG "REGISTERS" - set to high cog memory' + +traceL = $1EF +xreg = traceL-1 +hr0 = traceL-2 +hr1 = traceL-3 +hr2 = traceL-4 +dbtab = traceL-5 + +DAT +' TRACE +TRACE rdlong doNext,##TRACER ' Replace 1st instruction of doNEXt with a call to TRACING' + mov traceL,#0 + ret ' !!! use discrete ret to delay before returning to doNEXT' +TRACER call #\TRACING +UNTRACE rdlong doNext,##TRACING + ret + + +'''''''''''''''''''''''''''''''''' +{ +1A28 : 0055 EXIT 3( 0000CD42 0000007B DEADBEEF ) +32C0 : 32AD 3( 0000CD42 0000007B DEADBEEF ) +32AC : 007B DUP 3( 0000CD42 0000007B DEADBEEF ) +32AE : 00E2 W@ 4( 0000CD42 0000CD42 0000007B DEADBEEF ) +} + +TRACING + rdword x,PTRA++ ' read word code instruction + cmp PTRA,traceL wc + if_c ret + call #DBIP ' PRINT IP ' + call #DBNAME ' PRINT NAME' + +DBPRTSTK mov hr0,depth wz ' PRINT STACK' + if_z ret + mov hr1,#32 ' ALIGN' + call #DBTABS + mov hr0,depth + call #DBPRTH + mov hr2,depth + mov hr0,#"(" + call #DBTX + mov xreg,a + call #DBPRTL + djz hr2,#DBPE + mov xreg,b + call #DBPRTL + djz hr2,#DBPE + mov xreg,c + call #DBPRTL + djz hr2,#DBPE + mov xreg,d + call #DBPRTL +DBPE mov hr0,#")" + jmp #DBTX + +' PRINT HEX CHARACTER' +DBPRTH add hr0,#$30 'convert bin to hex' + cmp hr0,#$3A wc + if_nc add hr0,#7 + jmp #DBTX + +' PRINT LONG ' +DBPRTL mov hr1,#8 ' 8 DIGITS' +DBPRTD ' print digits ' ' print hr1 digits from left in xreg + call #DBSPACE +DBPLP mov hr0,xreg + shr hr0,#28 ' get next msd' + call #DBPRTH + rol xreg,#4 ' next digit' + djnz hr1,#DBPLP +DBSPACE mov hr0,#$20 ' SPACE' + jmp #DBTX + +' PRINT 5 DIGIT ADDRESS ' +DBPRTA mov hr1,#5 + shl xreg,#12 + JMP #DBPRTD + +DBPRTW mov hr1,#4 + shl xreg,#16 + JMP #DBPRTD + +' PRINT CODE NAME - search the dictionary for a code match ' +' 0DE00: 03 44 55 50 74 00 04 4F 56 45 52 78 00 03 33 52 '.DUPt..OVERx..3R' +DBNAME + rdlong hr2,##registers+names ' dictionary +DBFLP rdword hr0,hr2 wz ' read count and 1st char or link' + if_z jmp #DBWHAT + and hr0,#$1F ' check count' + add hr0,hr2 + add hr0,#1 ' point to CPA' + rdword xreg,hr0 ' read its CFA + cmp xreg,x wz ' matched to CFA in x ?' + if_z jmp #DBFOUND ' print it' + add xreg,#1 + cmp xreg,x wz ' matched to CFA+1 (jump to) in x ?' + if_z jmp #DBFOUND ' print it' + mov hr2,hr0 + add hr2,#2 ' point to next name' + jmp #DBFLP +DBWHAT + cmp x,#_LONG wz + if_z jmp #DBPRT32 + cmp x,#_WORD wz + if_z jmp #DBPRT16 + cmp x,##w wc + if_c ret + cmp x,##_IF wc + if_nc ret + mov hr1,#3 + mov xreg,x + shl xreg,#32-10 + shr xreg,#2 +DBPRTLIT + call #DBPRE + jmp #DBPRTD +DBPRT16 call #DBPRE + rdword xreg,PTRA + jmp #DBPRTW +DBPRT32 call #DBPRE + rdlong xreg,PTRA + jmp #DBPRTL +DBPRE mov hr0,#"$" + jmp #DBTX + +DBFOUND rdbyte hr1,hr2 ' pointing to NFA + and hr1,#$1F ' read count +.L0 add hr2,#1 ' point to next char + rdbyte hr0,hr2 wc ' read next char +'' if_c mov hr0,"?" +'' cmp hr0,#$20 wc +'' if_c mov hr0,"?" + call #DBTX ' output char + _ret_ djnz hr1,#.L0 +{ +w = $1800 ' wordcode offset for 10-bit literals 0..1023 + _IF = $1C00 ' IF relative forward branch 0 to 127 words + _UNTIL = $1C80 ' UNTIL relative reverse branch 0 to 127 words +GO = $1D00 +GOBACK = $1D80 +'opunused = $1D00 ' ???? could use' +rg = $1E00 ' task/cog register 8-bit offset + +} + +DBSPACES call #DBSPACE + _ret_ djnz hr1,#DBSPACES +{ +DBFAIL mov hr1,#16 + jmp #DBSPACES +} + +DBTABS cmp dbtab,hr1 wc + if_nc ret + call #DBSPACE + jmp #DBTABS + +DBINDENT mov hr1,retptr + sub hr1,#retstk + jmp #DBSPACES + +DBIP call #DBCR + mov xreg,PTRA ' print IP ' + sub xreg,#2 ' compensate for ptra++' + call #DBPRTA + mov hr0,#":" + call #DBTX + call #DBINDENT + mov xreg,X ' print wordcode in X ' + jmp #DBPRTW + + +' PRINT CRLF ' +DBCR mov hr0,#$0D + call #DBTX + mov hr0,#$0A + call #DBTX + _ret_ mov dbtab,#0 + + ' +DBTX bith hr0,#8+(15<<5) +.l0 testp #tx_pin wc '..wait for buffer empty + if_nc jmp #.l0 + add dbtab,#1 + _ret_ wypin hr0,#tx_pin '..send byte + +{ +DBINIT + rdlong hr0,#@_CPUHZ + rdlong hr1,#@_BAUD + qdiv hr0,hr1 + getqx hr0 + shl hr0,#16 + add hr0,#7 + _ret_ wxpin hr0,#tx_pin +} + +'#######################################################################' +' taqoz.inc +'#######################################################################' + +'******************************************************************************* +'* * +'* TAQOZ - Tachyon Forth for the Parallax P2 CPU ROM * +'* * +'******************************************************************************* + + +CON + + sys_clk = CPUHZ + nscnt = 100000/(sys_clk/1000000) + +' 180524 - implement 10-bit short literals and 9-bit task register addresses for compact fat32 variables' +{ +( ADDRESSES USE FOR CODED OPS ) +01800-01BFF shorts (0..1023) +01C00-01CFF conditional relative branch +01D00-01DFF unconditional relative branch +01E00-01FFF register index (0..511) +} + w = $1800 ' wordcode offset for 10-bit literals 0..1023 + _IF = $1C00 ' IF relative forward branch 0 to 127 words + _UNTIL = $1C80 ' UNTIL relative reverse branch 0 to 127 words + GO = $1D00 + GOBACK = $1D80 + 'opunused = $1D00 ' ???? could use' + rg = $1E00 ' task/cog register 8-bit offset + + + tasks = registers+$D0 ' 2 longs/task * 8 cogs + + SKIPZ = _IF+01 ' short-form for _IF+01' + + ex = 1 ' EXITs (jump to hub wordcode instead of call) + + _FALSE = w+0 ' quick constants ' + _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 + + + numpadsz = 44 ' 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 = 44 ' any word including binary numbers up to n characters (1 count, 1 terminator) + tasksz = 8 ' 8 bytes/task RUN[2] FLAG[1] + + + WW = $FFFF + ' defs for TAQOZ ' +'#######################################################################' +' version.p2a +'#######################################################################' +dat + orgh + +taqoz_version long 2_8 +taqoz_time long 210401_1230 +taqoz_name byte "CHIP" ' use exactly 4 characters = 1 long' + +{ +210401 Adjusted us and ms to compensate for the literal as well so that 3 us = 3us +210330 Added "drvh tx_pin" in reset (COG0 is initialized last and might take too long) + Added WSTX routine for WS2812 +210329 Removed LSBOUT MSBOUT MSBIN and replaced with RCLIO +210308 Modified SPIRX to use smartpin assisted clocking for sysclk/4 data rates +210306 Added waitx clkdly in place of nop in SPI clocking ( reordered the cog registers to fit this in in the SPI section) + Changed CONEMIT to check tx ready before sending for faster throughput - added a timeout just in case +210302 renamed EXIT; to +EXIT since it appends an EXIT (jump bit) to the previous instruction if it can. + Use EXIT; to always append an EXIT and stop compilation - an normal unoptimized ; in other words + $ prefixed hex numbers are always comverted to upper case HEX so now $beef will work etc + +210219 Updated PRINT" and PRINT$ to handle \ controls including a \$nn for hex + Extended TRACE to include code jump (code+1) match and display literals (10,16,32-bit) + Added lower case support for hex numbers. +210208 Modify FLASH BACKUP to include size at start of block etc to work with 2nd stage loader + +210207 remove dummy $0D transmit on serial init (EMIT sends first then waits anyway) + Add a new delayms value to prevent UB3 garble during power-up +201123 Force 1k5 pullups on SCL/SDA and change FLTx to DRVH + The external pullups are not fitted on the P2D2ed, and the UB3 loads a low speed using its weak pullups +200621 Change title to emphasize TAQOZ RELOADED and incorporate ROM version in .VER +200604 Add scl contention to I2C.START +2005xx Fix I2C timing and scl contention issues. +200412 Added return stack indenting to TRACE module + Replaced GET$ control key processing with table lookup so user code + can write new functions to a control key with CTRL! +200410 Implemented V2.5 which rearranges the memory map optimized to: + * Maximise threaded code space in PAGE0 with unimpeded flow into PAGE1 + * Relocate dictionary to end of PAGE1 by default + * CONFIG backup is now at the end of PAGE1 after the dictionary + * BACKUP MBR defaults to 128K size + * CODED ops are now sandwiched between cog/hubexec and threaded. + * Data area in PAGE0 in otherwise unused 2k CODED ops memory area +200409 Fixed Dictionary link mechanism to handle relative addressing (moving dictionary) + Added relative jump code for ELSE instead of an absolute address code +200408 Extended TRACER to print long IP and also an address window limit + Fixed DECOMPILER to handle extended code +200405 Added extended pagin mode to threaded code that allows it to reach beyond 64k. + Code is compiled as normal any words that are created outside page 0, the first 64k + then have a page attribute set in the header plus one extra CPA byte. + Any references to extended code are preceded with a PAGEx wordcode + Added ^Y to list the complete dictionary +200328 Restored kernel EXIT and renamed high-level optimizer EXIT to EXIT; + Changed 1ms CRLF delay to only delay with serial console +200326 - implemented high precision 4 cycle interruptable timing delays in us, ms, s +200325 - Change lastkey variable to KEY@ to fetch last 4 keys + Added 1ms delay to each CRLF (mainly to help the UB3 chip ) +200324 - Optimizd 2DROP and 3DROP as hubexec + +200317 - Changed datptr to ptrb - improved pushx/popx + Added trace module +200310 Improved LEN$, and added COGMOD and LOADMOD +200222 Improve console routines such as PROMPT etc for Interactive Assembler extensions +200210 Add SIGN using SIGNX +20XXXX Added link field for dictionary linking and hiding + +190705 - Unified branch and loop stack so that FOR and DO both push loop IP, index, and limit. +190112 +Changed arrangement of hubexec code and put it back after cog code so threaded simply builds up to $FC00 max. +This speeds up doNEXT as well. +Data pointer set to $1.2000 +} + ' version header ' +'#######################################################################' +' variables.p2a +'#######################################################################' +CON +dcnt = 0 + +DAT +'************************************* HUB REGISTERS ************************************** + + org 0 +' register offsets within "registers". Access as REG,delim ... REG,base ... etc +' +' Minimum registers required for a new task - other registers after the ' ---- are not needed other than by the console +temp res 12 ' general purpose +double res 4 ' hold high word of double +' @16 +uemit res 2 ' emit vector 0 = default +ukey res 2 ' key vector +keypoll res 2 ' poll user routines - low priority background task +base res 2 ' current number base + backup location during overrides +baudcnt res 4 ' SERIN SEROUT baud cnt value where baud = clkfreq/baudcnt each cog can have it's own +uswitch res 4 ' target parameter used in CASE structures +' @32 +fflags res 2 ' echo,linenums,ipmode,leadspaces,prset,striplf,sign,comp,defining + +CON ' fflags bit fields ' + echoF = 0 + okF = 1 ' disable OK response' + ackF = 2 ' --- response inhibit ' + lineF = 3 ' disable newline ' + ipF = 4 ' interpret this number in IP format where a "." separates bytes + signF = 5 + compF = 6 + defF = 7 + passF = 8 + +DAT +keycol res 1 ' maintains column position of key input + +wordcnt res 1 ' length of current word (which is still null terminated) +wordbuf res wordsz ' words from the input stream are assembled here +' numpad may continue to build backwards into wordbuf for special cases such as long binary numnbers +numpad res numpadsz ' Number print format routines assemble digit characters here builds from end - 18,446,744,073,709,551,615 +padwr res 1 ' write index (builds characters down from lsb to msb in MODULO style) + res 1 + +pflg res 1 +pbase res 1 + +' $80 +keychar res 8 ' override for key character - up to 8 chars in one long lsb first +outchar res 8 ' output mailbox ' + + +delim res 2 ' the delimiter used in text input and a save location +prefix res 1 ' NUMBER input prefix +suffix res 1 ' NUMBER input suffix + +uprompt res 2 ' pointer to code to execute when Forth prompts for a new line +uaccept res 2 ' pointer to code to execute when Forth accepts a line to interpret (0=ok) +unum res 2 ' User number processing routine - executed if number failed and UNUM <> 0 +ufind res 2 ' runs extended dictionary search if set after failing precompiled dictionary search + + + + +' +' ------ console only registers not required for other tasks --- can be accessed as globals +' + + +' these 4 variables are cleared as an array of 10 bytes +anumber res 4 ' Assembled number from input +hnumber res 4 ' high word of double number' +bnumber res 4 ' part of IP notation number' +digits res 1 ' number of digits in current number that has just been processed +dpl res 1 ' Position of the decimal point if encountered (else zero) + +'createvec res 2 ' If set will execute user create routines rather than the kernel's (CREATE revectored) + +dmm res 12 ' dump "fetch' vectors to allow dump to access special devices +dmp res 2 ' DUMP vector + +''''''''''''''''''''''' fixed ''''''''''''''''''''''''''' + + +oldnames res 4 ' backup of names used at start of TAQOZ load +names res 4 ' start of dictionary (builds down) +oldhere res 4 ' Used by TAQOZ word to backup current here to determine code size at end of load +here res 4 ' pointer to compilation area (overwrites VM image) +codes res 4 ' current code compilation pointer (updates "here" or is reset by it) +autovec res 4 ' user autostart address if non-zero - called from within terminal +'' +cold res 2 ' pattern to detect if this is a cold or warm start ($A55A ) +errors res 2 +linenum res 2 +atrs res 1 ' definition header attributes (pub/pri/pre) ' + res 1 +spincnt res 2 ' Used by spinner to rotate busy symbol + res 2 ' word count +mrd res 4 ' memory read' +athen res 4 +endreg res 0 + ' defs for TAQOZ variables ' '#######################################################################' ' kernel.p2a '#######################################################################' @@ -1740,123 +1740,123 @@ jmp #DROP2 - -'********************** SPI READ/WRITE ********************* -' - -' SPIRX ( dst cnt -- ) -' Read bytes in from SPI to memory -' high speed SD SPI read at sysclk/4 = 50MHz read speed @200MHz clock -' the clock timing is positioned just before SPIRX so runtime sw can find and adjust this -' Timing: -' TAQOZ# BUFFERS 512 LAP SPIRX LAP .LAP --- 19,800 cycles= 61,875ns @320MHz ok -' -'clkdly long 0 ' normally left at zero for no extra delay -'sddly long 8 ' 4 @80MHz, 6 @160MHz, 8 @240MHz, 10 at 320MHz -'sdhl long $2_0004 ' pulses 2 cycles high, 2 low for fast 4 cycle bit-rate -SPIRX ' ( b:dst a:cnt -- ) - wrfast #0,b ' setup to write to dest - call #SPISET -.l0 wypin #32,sck ' trigger 32 clocks - waitx sddly ' delay (set to 8 for 200MHz) - rep x,#32 ' x=2 for fast or 3 for slower - testp miso wc ' 4 cycle/bit read - rcl r1,#1 ' shift in next bit - waitx clkdly ' optional extra wait instruction for modified SPIRX - movbyts r1,#%00011011 ' rearrange bytes - wflong r1 ' save four bytes in one long - djnz a,#.l0 ' for long count -SPIXX drvl sck ' probably not necessary!! - wrpin #0,sck ' disable smartpin - jmp #\DROP2 ' discard dst and cnt - -SPISET shr a,#2 ' convert byte count to longs - getbyte x,sdhl,#2 ' adjust rep loop for slower settings - cmp x,#2 wz ' rep 2 or 3 instructions - if_nz mov x,#3 ' 3 for slower tranfers using extra waitx - fltl sck - wrpin #%01_001000,sck ' pulse mode for sck - drvl sck - _ret_ wxpin sdhl,sck ' set sck hilo period - - -' Write bytes from memory to SPI ' -' SPITX ( src bytes -- ) ' 474.6us/512 -SPITXE drvl ss - drvl sck -SPITX rdfast #0,b -.L0 rfbyte X - shl X,#24 - mov r1,#8 - call #SPIW - djnz a,#.L0 - jmp #DROP2 - - - - -' Read 32-bits from SPI' -SPIRDL rep #9,#32 - skip #1 -' SPIRD ( dat -- dat+rd ) -SPIRD rep #7,#8 ' 8 bits - outnot sck ' clock (low high) - waitx clkdly - outnot sck -RWAIT waitx clkdly - nop - testp miso wc ' read data from card - rcl a,#1 ' shift in msb first - ret - - -{ -' SMARTPINS? TRY CLOCKING ENABLED C=1 in %CIOHHHLLL ? -SPICLKS drvh mosi - rep #1,#16 - drvnot sck - ret -} -' Write SD Command -SPIWRC and a,#$3F - or a,#$40 ' SD commands start with a %01cccccc' -' SPIWB ( byte -- ) -' Shift 8 bits from data[0..7] out and leave data on stack (restored with other bytes zeroed) -' Clock polarity is determined at entry - leave low for low/high clock -' data rate is 1/8 of the system clock ' -' @200MHz - 10ns setup 20ns clock high 20ns hold - -' -SPIWR8 shl a,#24 ' left justify 8-bit data s - mov r1,#8 -SPIWR drvl ss ' always chip select - drvl sck - call #DROP ' POP VALUE ' -SPIW - rep #5,r1 - rol X,#1 wc ' output next msb - drvc mosi ' xDDDxDDDx' - drvnot sck ' ---C---C-- - waitx clkdly - drvnot sck - ret - -' SPIWL ( long -- ) ' write 32 bits -SPIWRL mov r1,#32 - jmp #SPIWR - -' SPIWM ( long -- ) ' write 24 bits -SPIWM shl a,#8 - mov r1,#24 - jmp #SPIWR - -' SPIWW ( word -- ) ' write 16 bits -SPIWR16 shl a,#16 - mov r1,#16 - jmp #SPIWR - -SPICE drvh ss - _ret_ drvh sck ' P2 shares clock as ce with other boot devices' - + +'********************** SPI READ/WRITE ********************* +' + +' SPIRX ( dst cnt -- ) +' Read bytes in from SPI to memory +' high speed SD SPI read at sysclk/4 = 50MHz read speed @200MHz clock +' the clock timing is positioned just before SPIRX so runtime sw can find and adjust this +' Timing: +' TAQOZ# BUFFERS 512 LAP SPIRX LAP .LAP --- 19,800 cycles= 61,875ns @320MHz ok +' +'clkdly long 0 ' normally left at zero for no extra delay +'sddly long 8 ' 4 @80MHz, 6 @160MHz, 8 @240MHz, 10 at 320MHz +'sdhl long $2_0004 ' pulses 2 cycles high, 2 low for fast 4 cycle bit-rate +SPIRX ' ( b:dst a:cnt -- ) + wrfast #0,b ' setup to write to dest + call #SPISET +.l0 wypin #32,sck ' trigger 32 clocks + waitx sddly ' delay (set to 8 for 200MHz) + rep x,#32 ' x=2 for fast or 3 for slower + testp miso wc ' 4 cycle/bit read + rcl r1,#1 ' shift in next bit + waitx clkdly ' optional extra wait instruction for modified SPIRX + movbyts r1,#%00011011 ' rearrange bytes + wflong r1 ' save four bytes in one long + djnz a,#.l0 ' for long count +SPIXX drvl sck ' probably not necessary!! + wrpin #0,sck ' disable smartpin + jmp #\DROP2 ' discard dst and cnt + +SPISET shr a,#2 ' convert byte count to longs + getbyte x,sdhl,#2 ' adjust rep loop for slower settings + cmp x,#2 wz ' rep 2 or 3 instructions + if_nz mov x,#3 ' 3 for slower tranfers using extra waitx + fltl sck + wrpin #%01_001000,sck ' pulse mode for sck + drvl sck + _ret_ wxpin sdhl,sck ' set sck hilo period + + +' Write bytes from memory to SPI ' +' SPITX ( src bytes -- ) ' 474.6us/512 +SPITXE drvl ss + drvl sck +SPITX rdfast #0,b +.L0 rfbyte X + shl X,#24 + mov r1,#8 + call #SPIW + djnz a,#.L0 + jmp #DROP2 + + + + +' Read 32-bits from SPI' +SPIRDL rep #9,#32 + skip #1 +' SPIRD ( dat -- dat+rd ) +SPIRD rep #7,#8 ' 8 bits + outnot sck ' clock (low high) + waitx clkdly + outnot sck +RWAIT waitx clkdly + nop + testp miso wc ' read data from card + rcl a,#1 ' shift in msb first + ret + + +{ +' SMARTPINS? TRY CLOCKING ENABLED C=1 in %CIOHHHLLL ? +SPICLKS drvh mosi + rep #1,#16 + drvnot sck + ret +} +' Write SD Command +SPIWRC and a,#$3F + or a,#$40 ' SD commands start with a %01cccccc' +' SPIWB ( byte -- ) +' Shift 8 bits from data[0..7] out and leave data on stack (restored with other bytes zeroed) +' Clock polarity is determined at entry - leave low for low/high clock +' data rate is 1/8 of the system clock ' +' @200MHz - 10ns setup 20ns clock high 20ns hold - +' +SPIWR8 shl a,#24 ' left justify 8-bit data s + mov r1,#8 +SPIWR drvl ss ' always chip select + drvl sck + call #DROP ' POP VALUE ' +SPIW + rep #5,r1 + rol X,#1 wc ' output next msb + drvc mosi ' xDDDxDDDx' + drvnot sck ' ---C---C-- + waitx clkdly + drvnot sck + ret + +' SPIWL ( long -- ) ' write 32 bits +SPIWRL mov r1,#32 + jmp #SPIWR + +' SPIWM ( long -- ) ' write 24 bits +SPIWM shl a,#8 + mov r1,#24 + jmp #SPIWR + +' SPIWW ( word -- ) ' write 16 bits +SPIWR16 shl a,#16 + mov r1,#16 + jmp #SPIWR + +SPICE drvh ss + _ret_ drvh sck ' P2 shares clock as ce with other boot devices' + COGMOD @@ -1867,256 +1867,256 @@ ENDCOG fit 496 '' doesn't seem to work!!!! - ' TAQOZ COG CODE' -'#######################################################################' -' vga-multi.p2a for Rev B/C -'#######################################################################' - -'****************************** -'* VGA 640 x 360 x 8bpp-lut * -' -' PBJ: 181022 Adapted for TAQOZ -' -' 210125 - disable if vgacfg long is 0 -' 190725 - 640x360 mode for 1080p -' 190726 - 640x360 mode for 720p' -' 190627 - MULTI MODE PROGRAMMBLE ' -' -'****************************** - -' VGA HEADER -CON -intensity = 80 '0..128 - -bmpint = $0 ' 256 byte header - mostly free but top half may have bmp header written' -hcnt = $4 ' hub variable word with current horz count (line)' -vcnt = $6 ' hub variable word with current vert count (frame)' - - -vlines = 360 - -fclk = float(CPUHZ) -fpixn = 25_175_000 '37_125_000 -fpix = float(fpixn) -fset = (fpix / fclk * 2.0) * float($4000_0000) - -DAT org - -vgainit jmp #vgainit2 - -' ----------------------------------VGA PARAMETER TABLE------------------------------------------------- -' NOTE: these locations are temporary and may be moved into a more logical sequence once completed' -' The hub locations may be updated and these locations become part of the cog registers when the cog is started ' -' Reading the hub locations will not reveal the values that are updated by the vga cog itself. -' -' -' 01 ' -_hpixels long 640 -_vlines long 480 -' 03 FP,SY,BP,DIV -v_bs byte 16,96,48,1 '5,5,20,2 -' 04 ' -_fpix long fpixn ' pixel frequency' -_fset long round(fset) ' pixel nco value' -_palette long bmporg+$100 ' address of palette (normally $FC00)' -_screen long bmporg+$500 ' address of screen (normally $10000)' -' 08 $7F01 = output X3, X2, X1, X0 on all four DAC channels' -m_bs long $7F010000+55 'before sync 32-bit immediate -m_sn long $7F010000+20 'sync -m_bv long $7F010000+110 'before visible -' 11 ' -bpp long 8 ' bits/plane -'*1 note: The pixel parameter is calculated and added during init' -' 12 '%0111_0001_eppp_xxxx 32-bit immediate $xxxxxxxx -m_vi long $7F01_0000 ' *1 -' 13 %0111_1000_eppp_bbbb - 8-bit RFLONG LUT $xxxxxxxx -m_rf long $7F08_0000 ' *1 -' 14 ' -_hbytes long 640 -dacmode_s long %0000_0000_000_1011000000000_01_00000_0+vgacog<<8 'hsync is 123-ohm, 3.3V -dacmode_c long %0000_0000_000_1011100000000_01_00000_0+vgacog<<8 'R/G/B are 75-ohm, 2.0V - - -'rdfast ##w*h*bpp/32/16,##@video_buffer ' wraps ~253KB bitmap (longs/16) -' pub 1080p 1920 1080 1 VRES 148,500,000 VCLK 88 44 148 HSYN 4 5 36 VSYN ; -' -' ------------------------------------------------------------------------------------------------------ -{ P2B -0111 dddd eppp 001a bbbb RFLONG -> 32 x 1-bit LUT 32 out %PONMLKJI_HGFEDCBA_ponmlkji_hgfedcba -0111 dddd eppp 010a bbbb RFLONG -> 16 x 2-bit LUT 32 out %PONMLKJI_HGFEDCBA_ponmlkji_hgfedcba -0111 dddd eppp 011a bbbb RFLONG -> 8 x 4-bit LUT 32 out %PONMLKJI_HGFEDCBA_ponmlkji_hgfedcba -0111 dddd eppp 1000 bbbb RFLONG -> 4 x 8-bit LUT 32 out %PONMLKJI_HGFEDCBA_ponmlkji_hgfedcba -} - -vgainit2 - mov vx,bpp ' encode bits per pixel as a shift value 0..3 ' - encod vx -'' setbyte m_rf,vx,#2 ' set streamer mode based on bits per pixel (1,2,4,8)' - xor vx,#3 ' flip shift value so that 8 bpp = 0 (3,2,1,0) - mov _hbytes,_hpixels ' and calculate bytes per horizontal line ' - shr _hbytes,vx ' 1920 mono -> 240 etc ' - - mov _hblks,_hbytes ' setup rdfast blocks for default vertical scaling off' - shr _hblks,#6 ' per line basis - add _hblks,#1 - getbyte vx,v_bs,#3 ' rdfast the whole frame if there is no vertical scaling involved' - cmp vx,#1 wz ' otherwise if scaling <> 1 ' - if_ne jmp #.l0 - mov _hblks,_hpixels ' then setup rdfast blocks on a frame basis' - mul _hblks,_vlines - shr _hblks,vy - shr _hblks,#6 - -.l0 setword m_vi,#0,#0 ' setup visible pixels streamer word' - add m_vi,_hpixels - - setword m_rf,#0,#0 ' setup display pixels streamer word - add m_rf,_hpixels ' add in pixels' - - call #loadpal - ' cmod 65_4_321_0' ' VGA - setcmod #%01_0_000_0 'enable vga colorspace conversion - rdbyte vx,#@_VGACFG ' read hsync - wrpin dacmode_s,vx 'enable dac modes in selected pins - dirh vx - rdbyte vx,#@_VGACFG+1 ' blue PIN - wrpin dacmode_c,vx - dirh vx - rdbyte vx,#@_VGACFG+2 ' green PIN - wrpin dacmode_c,vx - dirh vx - rdbyte vx,#@_VGACFG+3 ' red PIN - wrpin dacmode_c,vx - dirh vx - rdbyte vsync,#@_VGACFG+4 ' vsynch PIN - drvl vsync -' -' XCONT D31..16 = INSTRUCTION, D15..0 = NCO ROLLERS, S=SUB-MODE -' Field loop -' -field - rdfast _hblks,_screen ' default rdfast for whole screen ' - getbyte vx,v_bs,#2 'top blanks - call #blank - mov vx,_vlines 'set visible lines - mov scrptr,_screen -line getbyte vy,v_bs,#3 ' vert scale (duplicate lines)' - cmp vy,#1 wz -linerep - if_ne rdfast _hblks,scrptr ' only rdfast for a line if vertical scaling ' - call #hsync 'do horizontal sync - xcont m_rf,#0 'visible line - djnz vy,#linerep - - add _hcnt,#1 ' increment horizontal line count ' - wrword _hcnt,##bmporg+hcnt ' and update hub' - add scrptr,_hbytes ' advance scaling screen ptr to next line' - djnz vx,#line ' another line? - - getbyte vx,v_bs,#0 ' bottom blanks - call #blank - drvnot vsync ' vertical sync on - add _vcnt,#1 ' increment frame count' - wrword _vcnt,##bmporg+vcnt ' update hub' - mov _hcnt,#0 ' reset horizontal line count every vsynch ' - getbyte vx,v_bs,#1 ' sync blanks - call #blank - drvnot vsync ' sync off - call #loadpal ' continually update palette in case it has changed' - jmp #field 'loop -' -' Subroutines -' -blank call #hsync 'blank lines - xcont m_vi,#0 - _ret_ djnz vx,#blank - -hsync xcont m_bs,#0 'horizontal sync - xcont m_sn,#1 - _ret_ xcont m_bv,#0 - - -' Load palette from hub into lut ' -loadpal - mov vx,_fset - setxfrq vx 'set transfer frequency - - mov vx,#0 - rdfast #0,_palette 'load .bmp palette into lut - rep @.end,#$100 ' 256 colors - rflong vy - shl vy,#8 - wrlut vy,vx - add vx,#1 -.end - rdbyte vx,##bmporg+bmpint ' update intensity' - shl vx,#8 - setcq vx - shl vx,#8 - setci vx - shl vx,#8 - setcy vx - ret - -{ iterative parameter update - mov vy,vcnt - cmp vy,#10 wcz - if_lt add vy,#1 - alts (d),vy - rdlong vx,at_hpixels - - - mode dacs pins base S/# description dac output - ---- ---- ---- ---- ------ --------------------------- -------------------- -%0000_dddd_xppp_pppx config DDS/Goertzel LUT $xxxxxxxx - -%0001_dddd_eppp_pppx %00r00 1-bit RFBYTE, r=reorder $000000xx, %aaaaaaaa -%0001_dddd_eppp_ppxx %00r01 2-bit RFBYTE, r=reorder $000000xx, %babababa -%0001_dddd_eppp_pxxx %00r10 4-bit RFBYTE, r=reorder $000000xx, %dcbadcba -%0001_dddd_eppp_xxxx %00011 8-bit RFBYTE $000000xx -%0001_dddd_eppp_xxxx %01rgb 8-bit RFBYTE LUMA8 $RRGGBB00 -%0001_dddd_eppp_xxxx %10xxx 8-bit RFBYTE RGBI8 $RRGGBB00 -%0001_dddd_eppp_xxxx %11xxx 8-bit RFBYTE RGB8 (3:3:2) $RRGGBB00 - -%0010_dddd_eppp_xxxx %0 16-bit RFWORD $0000xxxx -%0010_dddd_eppp_xxxx %1 16-bit RFWORD RGB16 (5:6:5) $RRGGBB00 - -%0011_dddd_eppp_xxxx %0 32-bit RFLONG $xxxxxxxx -%0011_dddd_eppp_xxxx %1 32-bit RFLONG RGB24 (8:8:8) $RRGGBB00 - -%0100_dddd_eppp_bbbb %rxx 1-bit RFLONG LUT, r=reorder $xxxxxxxx -%0101_dddd_eppp_bbbb %rxx 2-bit RFLONG LUT, r=reorder $xxxxxxxx -%0110_dddd_eppp_bbbb %rxx 4-bit RFLONG LUT, r=reorder $xxxxxxxx -%0111_dddd_eppp_bbbb - 8-bit RFLONG LUT $xxxxxxxx - -%1000_dddd_eppp_bbbb 1-bit immediate LUT $xxxxxxxx -%1001_dddd_eppp_bbbb 2-bit immediate LUT $xxxxxxxx -%1010_dddd_eppp_bbbb 4-bit immediate LUT $xxxxxxxx -%1011_dddd_eppp_bbbb 8-bit immediate LUT $xxxxxxxx - -%1100_dddd_eppp_xxxx 32-bit immediate $xxxxxxxx - -%1101_xxxx_xppp_pppx %r00 1-pin -> WFBYTE, r=reorder -%1101_xxxx_xppp_ppxx %r01 2-pin -> WFBYTE, r=reorder -%1101_xxxx_xppp_pxxx %r10 4-pin -> WFBYTE, r=reorder -%1101_xxxx_xppp_xxxx %11 8-pin -> WFBYTE - -%1110_xxxx_xppp_xxxx - 16-pin -> WFWORD - -%1111_xxxx_xppp_xxxx - 32-pin -> WFLONG - - - -} -vsync res 1 -vx res 1 -vy res 1 -_hblks res 1 -_vcnt res 1 -_hcnt res 1 -scrptr res 1 - ' VGA COG CODE' - + ' TAQOZ COG CODE' +'#######################################################################' +' vga-multi.p2a for Rev B/C +'#######################################################################' + +'****************************** +'* VGA 640 x 360 x 8bpp-lut * +' +' PBJ: 181022 Adapted for TAQOZ +' +' 210125 - disable if vgacfg long is 0 +' 190725 - 640x360 mode for 1080p +' 190726 - 640x360 mode for 720p' +' 190627 - MULTI MODE PROGRAMMBLE ' +' +'****************************** + +' VGA HEADER +CON +intensity = 80 '0..128 + +bmpint = $0 ' 256 byte header - mostly free but top half may have bmp header written' +hcnt = $4 ' hub variable word with current horz count (line)' +vcnt = $6 ' hub variable word with current vert count (frame)' + + +vlines = 360 + +fclk = float(CPUHZ) +fpixn = 25_175_000 '37_125_000 +fpix = float(fpixn) +fset = (fpix / fclk * 2.0) * float($4000_0000) + +DAT org + +vgainit jmp #vgainit2 + +' ----------------------------------VGA PARAMETER TABLE------------------------------------------------- +' NOTE: these locations are temporary and may be moved into a more logical sequence once completed' +' The hub locations may be updated and these locations become part of the cog registers when the cog is started ' +' Reading the hub locations will not reveal the values that are updated by the vga cog itself. +' +' +' 01 ' +_hpixels long 640 +_vlines long 480 +' 03 FP,SY,BP,DIV +v_bs byte 16,96,48,1 '5,5,20,2 +' 04 ' +_fpix long fpixn ' pixel frequency' +_fset long round(fset) ' pixel nco value' +_palette long bmporg+$100 ' address of palette (normally $FC00)' +_screen long bmporg+$500 ' address of screen (normally $10000)' +' 08 $7F01 = output X3, X2, X1, X0 on all four DAC channels' +m_bs long $7F010000+55 'before sync 32-bit immediate +m_sn long $7F010000+20 'sync +m_bv long $7F010000+110 'before visible +' 11 ' +bpp long 8 ' bits/plane +'*1 note: The pixel parameter is calculated and added during init' +' 12 '%0111_0001_eppp_xxxx 32-bit immediate $xxxxxxxx +m_vi long $7F01_0000 ' *1 +' 13 %0111_1000_eppp_bbbb - 8-bit RFLONG LUT $xxxxxxxx +m_rf long $7F08_0000 ' *1 +' 14 ' +_hbytes long 640 +dacmode_s long %0000_0000_000_1011000000000_01_00000_0+vgacog<<8 'hsync is 123-ohm, 3.3V +dacmode_c long %0000_0000_000_1011100000000_01_00000_0+vgacog<<8 'R/G/B are 75-ohm, 2.0V + + +'rdfast ##w*h*bpp/32/16,##@video_buffer ' wraps ~253KB bitmap (longs/16) +' pub 1080p 1920 1080 1 VRES 148,500,000 VCLK 88 44 148 HSYN 4 5 36 VSYN ; +' +' ------------------------------------------------------------------------------------------------------ +{ P2B +0111 dddd eppp 001a bbbb RFLONG -> 32 x 1-bit LUT 32 out %PONMLKJI_HGFEDCBA_ponmlkji_hgfedcba +0111 dddd eppp 010a bbbb RFLONG -> 16 x 2-bit LUT 32 out %PONMLKJI_HGFEDCBA_ponmlkji_hgfedcba +0111 dddd eppp 011a bbbb RFLONG -> 8 x 4-bit LUT 32 out %PONMLKJI_HGFEDCBA_ponmlkji_hgfedcba +0111 dddd eppp 1000 bbbb RFLONG -> 4 x 8-bit LUT 32 out %PONMLKJI_HGFEDCBA_ponmlkji_hgfedcba +} + +vgainit2 + mov vx,bpp ' encode bits per pixel as a shift value 0..3 ' + encod vx +'' setbyte m_rf,vx,#2 ' set streamer mode based on bits per pixel (1,2,4,8)' + xor vx,#3 ' flip shift value so that 8 bpp = 0 (3,2,1,0) + mov _hbytes,_hpixels ' and calculate bytes per horizontal line ' + shr _hbytes,vx ' 1920 mono -> 240 etc ' + + mov _hblks,_hbytes ' setup rdfast blocks for default vertical scaling off' + shr _hblks,#6 ' per line basis + add _hblks,#1 + getbyte vx,v_bs,#3 ' rdfast the whole frame if there is no vertical scaling involved' + cmp vx,#1 wz ' otherwise if scaling <> 1 ' + if_ne jmp #.l0 + mov _hblks,_hpixels ' then setup rdfast blocks on a frame basis' + mul _hblks,_vlines + shr _hblks,vy + shr _hblks,#6 + +.l0 setword m_vi,#0,#0 ' setup visible pixels streamer word' + add m_vi,_hpixels + + setword m_rf,#0,#0 ' setup display pixels streamer word + add m_rf,_hpixels ' add in pixels' + + call #loadpal + ' cmod 65_4_321_0' ' VGA + setcmod #%01_0_000_0 'enable vga colorspace conversion + rdbyte vx,#@_VGACFG ' read hsync + wrpin dacmode_s,vx 'enable dac modes in selected pins + dirh vx + rdbyte vx,#@_VGACFG+1 ' blue PIN + wrpin dacmode_c,vx + dirh vx + rdbyte vx,#@_VGACFG+2 ' green PIN + wrpin dacmode_c,vx + dirh vx + rdbyte vx,#@_VGACFG+3 ' red PIN + wrpin dacmode_c,vx + dirh vx + rdbyte vsync,#@_VGACFG+4 ' vsynch PIN + drvl vsync +' +' XCONT D31..16 = INSTRUCTION, D15..0 = NCO ROLLERS, S=SUB-MODE +' Field loop +' +field + rdfast _hblks,_screen ' default rdfast for whole screen ' + getbyte vx,v_bs,#2 'top blanks + call #blank + mov vx,_vlines 'set visible lines + mov scrptr,_screen +line getbyte vy,v_bs,#3 ' vert scale (duplicate lines)' + cmp vy,#1 wz +linerep + if_ne rdfast _hblks,scrptr ' only rdfast for a line if vertical scaling ' + call #hsync 'do horizontal sync + xcont m_rf,#0 'visible line + djnz vy,#linerep + + add _hcnt,#1 ' increment horizontal line count ' + wrword _hcnt,##bmporg+hcnt ' and update hub' + add scrptr,_hbytes ' advance scaling screen ptr to next line' + djnz vx,#line ' another line? + + getbyte vx,v_bs,#0 ' bottom blanks + call #blank + drvnot vsync ' vertical sync on + add _vcnt,#1 ' increment frame count' + wrword _vcnt,##bmporg+vcnt ' update hub' + mov _hcnt,#0 ' reset horizontal line count every vsynch ' + getbyte vx,v_bs,#1 ' sync blanks + call #blank + drvnot vsync ' sync off + call #loadpal ' continually update palette in case it has changed' + jmp #field 'loop +' +' Subroutines +' +blank call #hsync 'blank lines + xcont m_vi,#0 + _ret_ djnz vx,#blank + +hsync xcont m_bs,#0 'horizontal sync + xcont m_sn,#1 + _ret_ xcont m_bv,#0 + + +' Load palette from hub into lut ' +loadpal + mov vx,_fset + setxfrq vx 'set transfer frequency + + mov vx,#0 + rdfast #0,_palette 'load .bmp palette into lut + rep @.end,#$100 ' 256 colors + rflong vy + shl vy,#8 + wrlut vy,vx + add vx,#1 +.end + rdbyte vx,##bmporg+bmpint ' update intensity' + shl vx,#8 + setcq vx + shl vx,#8 + setci vx + shl vx,#8 + setcy vx + ret + +{ iterative parameter update + mov vy,vcnt + cmp vy,#10 wcz + if_lt add vy,#1 + alts (d),vy + rdlong vx,at_hpixels + + + mode dacs pins base S/# description dac output + ---- ---- ---- ---- ------ --------------------------- -------------------- +%0000_dddd_xppp_pppx config DDS/Goertzel LUT $xxxxxxxx + +%0001_dddd_eppp_pppx %00r00 1-bit RFBYTE, r=reorder $000000xx, %aaaaaaaa +%0001_dddd_eppp_ppxx %00r01 2-bit RFBYTE, r=reorder $000000xx, %babababa +%0001_dddd_eppp_pxxx %00r10 4-bit RFBYTE, r=reorder $000000xx, %dcbadcba +%0001_dddd_eppp_xxxx %00011 8-bit RFBYTE $000000xx +%0001_dddd_eppp_xxxx %01rgb 8-bit RFBYTE LUMA8 $RRGGBB00 +%0001_dddd_eppp_xxxx %10xxx 8-bit RFBYTE RGBI8 $RRGGBB00 +%0001_dddd_eppp_xxxx %11xxx 8-bit RFBYTE RGB8 (3:3:2) $RRGGBB00 + +%0010_dddd_eppp_xxxx %0 16-bit RFWORD $0000xxxx +%0010_dddd_eppp_xxxx %1 16-bit RFWORD RGB16 (5:6:5) $RRGGBB00 + +%0011_dddd_eppp_xxxx %0 32-bit RFLONG $xxxxxxxx +%0011_dddd_eppp_xxxx %1 32-bit RFLONG RGB24 (8:8:8) $RRGGBB00 + +%0100_dddd_eppp_bbbb %rxx 1-bit RFLONG LUT, r=reorder $xxxxxxxx +%0101_dddd_eppp_bbbb %rxx 2-bit RFLONG LUT, r=reorder $xxxxxxxx +%0110_dddd_eppp_bbbb %rxx 4-bit RFLONG LUT, r=reorder $xxxxxxxx +%0111_dddd_eppp_bbbb - 8-bit RFLONG LUT $xxxxxxxx + +%1000_dddd_eppp_bbbb 1-bit immediate LUT $xxxxxxxx +%1001_dddd_eppp_bbbb 2-bit immediate LUT $xxxxxxxx +%1010_dddd_eppp_bbbb 4-bit immediate LUT $xxxxxxxx +%1011_dddd_eppp_bbbb 8-bit immediate LUT $xxxxxxxx + +%1100_dddd_eppp_xxxx 32-bit immediate $xxxxxxxx + +%1101_xxxx_xppp_pppx %r00 1-pin -> WFBYTE, r=reorder +%1101_xxxx_xppp_ppxx %r01 2-pin -> WFBYTE, r=reorder +%1101_xxxx_xppp_pxxx %r10 4-pin -> WFBYTE, r=reorder +%1101_xxxx_xppp_xxxx %11 8-pin -> WFBYTE + +%1110_xxxx_xppp_xxxx - 16-pin -> WFWORD + +%1111_xxxx_xppp_xxxx - 32-pin -> WFLONG + + + +} +vsync res 1 +vx res 1 +vy res 1 +_hblks res 1 +_vcnt res 1 +_hcnt res 1 +scrptr res 1 + ' VGA COG CODE' + '#######################################################################' ' hubexec.p2a '#######################################################################' @@ -3189,3576 +3189,3577 @@ or _COG7,#0 wz if_nz coginit #7,_COG7 coginit #0,_RESET - 'HUBEXEC CODE AFTER WORDCODE ' - - - ' *** I2C SUPPORT *** ' - -CON -i2cack = 0 -i2cbusy = 1 - -DAT -I2CSTART -I2CRESTART - mov x,##$800 ' 1K5 PULLUP MODE - wrpin x,sdapin ' 1k5 PULLUP on SDA - wrpin x,sclpin ' 1k5 PULLUP on SCL - - decod r0,#22 -.l0 drvh sclpin ' scl should be floating, but checked it is available - testp sclpin wc - 'if_nc jmp #.l0 -if_nc djnz r0,#.l0 ' time out waiting for SCL to float (ok, delay depends on pin selected!!!??) - waitx i2cdly - drvh sdapin ' let sda float - waitx i2cdly - drvh sclpin ' set scl high - waitx i2cdly - drvl sdapin ' sda low = start - bith tflgs,#i2cbusy ' flag busy - waitx i2cdly - waitx i2cdly - drvl sclpin ' scl low ready - _ret_ waitx i2cdly ' hold off any data transmission immediately after start - - -I2CSTOP -' mov x,##$800 ' 1K5 PULLUP MODE -' wrpin x,sdapin ' 1k5 PULLUP on SDA -' wrpin x,sclpin ' 1k5 PULLUP on SCL - - decod r0,#22 - drvl sdapin -.l0 drvh sclpin - testp sclpin wc ' make sure it's not being stretched - 'if_nc jmp #.l0 - if_nc djnz r0,#.l0 - waitx i2cdly - drvh sclpin - 'flth sclpin - waitx i2cdly - drvh sdapin - 'flth sdapin - waitx i2cdly - _ret_ bitl tflgs,#i2cbusy - -{ -I2CSTOP -.l0 flth sclpin - testp sclpin wc ' make sure it's not being stretched - if_nc jmp #.l0 - flth sdapin ' should already be floated...' - waitx i2cdly ' wait for clock high for a period' - drvl sclpin ' SCL LOW' - waitx i2cdly - drvl sdapin ' SDA LOW ' - waitx i2cdly - flth sclpin ' now I2C preconditioned for stop bit' - waitx i2cdly - flth sdapin ' SDA LOW>HIGH WHILE SCL HIGH = STOP' - waitx i2cdly - _ret_ bitl tflgs,#i2cbusy -} -' clock pulse with setup and hold - also reads data wc ' -I2CCLOCK - decod r0,#18 - waitx i2cdly - drvh sclpin ' scl high for sharp pullup - 'flth sclpin ' then float to let the pullup work' -.l0 testp sclpin wc ' wait while scl is low' -' if_nc jmp #.l0 - if_nc djnz r0,#.l0 - waitx i2cdly - testp sdapin wc ' read SDA into wc' - waitx i2cdly - drvl sclpin - _ret_ waitx i2cdly - -I2CWR '( data -- ack ) - waitx i2cdly - shl a,#24 ' msb first' - mov r2,#8 -.l0 shl a,#1 wc - drvc sdapin ' drive low or high hard - ''if_c flth sdapin ' remove cmos pullup if high' - call #I2CCLOCK - djnz r2,#.l0 - drvh sdapin - call #I2CCLOCK - _ret_ muxc a,#$FF ' return with ack state as 0 or $FF' - -I2CRD ' ( ack -- data ) - drvh sdapin - waitx i2cdly ' 200528 - mov r2,#8 -.l0 call #I2CCLOCK - rcl a,#1 - djnz r2,#.l0 - testb a,#8 wc ' write out ack bit' - if_nc drvl sdapin ' only drive if low' - call #I2CCLOCK - drvh sdapin - drvh sclpin - _ret_ zerox a,#8 ' mask out ack from data' - -'#######################################################################' -' serial.p2a -'#######################################################################' - - -InitSerial drvh #tx_pin ' force high ' - wrpin #$7C,#tx_pin ' asynchronous transmit - wrpin #$3E,#rx_pin ' asynchronous receive -'SETBAUD ' calculate baud timing at runtime' - rdlong r0,#@_CPUHZ ' read from config table in low hub' - rdlong r1,#@_baud - qdiv r0,r1 ' cpuhz/baud' - getqx r0 - shl r0,#16 ' (cpuhz/baud)<<16' - add r0,#7 ' add 8 data bits - wxpin r0,#rx_pin ' write config baud ticks and 8 data - add r0,#morestops ' ADD 2 MORE STOP BITS FOR TX 191120 ' - wxpin r0,#tx_pin ' baud 8 data - wypin #$0D,#tx_pin ' kick off transmit empty flag' - - dirh #rx_pin ' enable smartpin mode' - rdpin rxdat,#rx_pin wc ' clear rx? - setint1 #0 ' disable int0' - mov rxwrC,#0 - mov rxrdC,#0 - bmask rxlong,#31 ' invalid codes' - - setse1 #%110<<6+rx_pin ' set se1 to trigger on rx char event????? - mov ijmp1,##@taqoz_rxisr ' set int1 jump vector to receive buffer - setint1 #4 ' Enable int0 to trigger on se1' - ret - -' -' ( SERIAL RECEIVE INTERRUPT SERVICE ROUTINE )' 47! -' -taqoz_rxisr - rdpin rxdat,#rx_pin ' recv byte (bits31:24) from rx pin - shr rxdat,#24 ' right justify' - shl rxlong,#8 ' maintain a 4 character deep sequence long' - or rxlong,rxdat ' update history word' - mov rxptr,rxwrC ' update write pointer' - add rxptr,##rxbuffers - wrbyte rxdat,rxptr ' write char to buffer' - incmod rxwrC,##rxsize-1 ' update write index' - cmp rxdat,#$1C wc ' don't check sequences if not a certain control - if_nc reti1 - '' - cmp rxlong,#0 wz - if_z jmp #RST - cmp rxdat,#$14 wc ' ignore control chars < $14 ' - if_c reti1 - cmp rxlong,##$14141414 wz ' check ^T^T^T^T for force TRACE sequence' - if_z call #TRACE - if_z reti1 - cmp rxlong,##$15151515 wz ' check ^U^U^U^U for force UNTRACE sequence' - if_z call #UNTRACE ' The TRACING locations has the default doNEXT instruction' - if_z reti1 - cmp rxlong,##$1B1B1B1B wz ' check esc esc esc esc sequence' -RST if_z coginit #0,#0 ' force reset ' - cmp rxlong,##$1A1A1A1A wz ' check for ^Z^Z^Z^Z sequence ' - if_z decod rxdat,#28 ' reboot via hub' - if_z hubset rxdat - reti1 - -' TAQOZ interface ' -' Read the next character from the serial rx buffer or return with null if empty -' Note: INTERNAL - called by CONKEY -READRX cmp rxrdC,rxwrC wz ' check head/tail - if_z jmp #PUSHACC ' return with null if empty' - mov r1,rxrdC ' save current read index ' - add r1,##rxbuffers ' index into the rx buffer' - rdbyte u,r1 ' read the data' - incmod rxrdC,##rxsize-1 ' and update read index with wrap' -rr1 jmp #PUSHACC - -{ *** P2 INTERRUPTS *** -When an interrupt event occurs, certain conditions must be met before the interrupt branch can happen: - -ALTxx / CRCNIB / SCA / SCAS / GETXACC / SETQ / SETQ2 / XORO32 / XBYTE must not be executing -AUGS must not be executing or waiting for a S/# instruction -AUGD must not be executing or waiting for a D/# instruction -REP must not be executing or active -STALLI must not be executing or active -The cog must not be stalled in any WAITx instruction -} -{ TESTING ISR OVERHEAD DURING IDLE AND DURING RX EVENTS -: Q 30,000,000 LAP FOR NEXT LAP .LAP ; -1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890 -} - - -'#######################################################################' -' threads.twc -'#######################################################################' - - orgh THREADS - - -{ *** OUTPUT OPERATIONS *** } - -SPACE word _BL - ' memory save?' -EMIT word _WORD,MOUTST+2,FETCH,w+20,BITS,_IF+07,DUP,MOUTST,_WORD,MOUTST+2,WINC,_0,MOUTST - word rg+uemit,QJMP,CONEMIT,EXIT -MOUTST word _LONG - long 0 - word CSTORE,EXIT -' MOUT ( addr -- ) Save output to memory address' -MOUT word _WORD,MOUTST+2,STORE,EXIT - -{ -'EMIT word rg+uemit,QJMP,CONEMIT,EXIT - 'word rg+uemit,WFETCH,QDUP,_IF+01,AJMP,CONEMIT,EXIT -} -' CON - select console output' -_CON word _0 -' EMIT! ( cfa -- ) Set the emit vector or 0 to fall through to CONEMIT -EMITST word rg+uemit,WSTORE,EXIT -EMITFT word rg+uemit,WFETCH,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 (1) -QEMIT word w+echoF,CHKFLG,SKIPNZ,EMIT+ex -DROPEX word DROP -NOOP word 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,EXIT - - -' ACCEPTED -OK word PRTSTR - byte " ok",0 -CRLF word CR -LF word w+$0A,EMIT,EXIT - -'' word rg+uemit,WFETCH,IFEXIT,_1,ms,EXIT - -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 MASK,rg+fflags,BITQ,EXIT -CLRFLG word MASK,rg+fflags,CLR,EXIT -SETFLG word MASK,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 - - -' U*/ ( u1 u2 div1 -- res ) -' CLKHZ 1.333333 1,000,000 LAP */ LAP .LAP 35.200us ok -' UMULDIV word ROT2,UMMUL,ROT,UMDIV,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 - - -FETCHX word FETCH,EXIT - - - - - -''''''''''''''''''' CONSTANTS ''''''''''''''''''''' - -W1000000 - word CONL - long 1000000 -W1000 word CONL - long 1000 - -CLKHZ word w+$14,FETCH,EXIT -CLKMHZ word CLKHZ,_LONG - long 1000000 - word UDIVIDE,EXIT - -_BMP word CONL - long bmporg - -' @VGA ( n -- addr )' return with VGA parameter table address -_VGA word _SHL2 - word _LONG - long @vgainit - word PLUS,EXIT - -BUFFERS word CONL - long SDBUFS ''$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 - - - - -'''' 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 byte -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 - -'ag1 word ATCODES,SWAP,MINUS,_SHR1,DEC1,_WORD,GOBACK,_OR,COMPW+ex - - -''' UNTIL ( flg -- ) -_UNTIL_ word UNMARK -unt00 word w+$BE,_EQ,_IF+(badthen-unt1)/2 -unt1 word ATCODES,SWAP,MINUS,_SHR1,INC - '' relative cond branch wordcode - 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/GO to be replacd later with a goto (addr+ex) - word _WORD,GO,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 - resolve IF and ELSE -_THEN_ word ATCODES,rg+athen,STORE - word UNMARK '( addr tag ) - ' - ' ( addr tag ) resolve structure branch - '' ELSE THEN ? - -' create a jump wordcode in ELSE to this position - word DUP,w+$1E,_EQ,_IF+05 - word DROP ' discard tag' - word ATCODES,INC,SWAP,WSTOREX+ex -{ -' create a relative jump (paging compatible)' - word DUP,w+$1E,_EQ,_IF+12 - word DROP,ATCODES,OVER,MINUS,_SHR1,DEC - word _WORD,GO,PLUS,SWAP,CSTORE,EXIT -} - '' IF THEN ? - word w+$1F,_EQ,_IF+07 - '' update an IF to branch to here - 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,EXIT ''+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" 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 - - -COMPA word DUP,_SHR16,QDUP,_IF+05,_WORD,PAGE0,SWAP,MINUS,COMPWX -COMPW -' ( wordcode -- ) append this wordcode to next free code location + append EXIT (without counting) -COMPWX word ATCODES,WALIGN,WSTORE - word _2,rg+codes,PLUSST -'' 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,FETCH,_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 ( -- ) --- executes preceding code to make it available for any immediate words following -GRAB word w+EXIT,COMPW ' append an EXIT - word ATHERE,DUP,rg+codes,STORE,ACALL ' execute and release preceding code in text line - word EXIT - - - - -' NFA' ( -- nfaptr ) -' COMPILE ( not used in this version ) -NFATICK - word _GETWORD,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' -' Traverse name field to point to CPA field -' CPA ( nfa -- cpa ) -NFACPA word CFETCHINC,QDUP,_IF+04,w+cntm,_AND,PLUS,EXIT,_1,PLUS,EXIT - -' ( nfa -- extflg ) Get ext flag as 0 or 1 -XNFAQ word CFETCH,_5,_SHR,_AND1,EXIT - -' NFA ( nfa -- nfa2 ) Traverse from NFA to next NFA but allow for extended CPA -NFANFA - word DUP,NFACPA,INC2 - ' add in extra byte if extended' - word SWAP,XNFAQ,PLUS,EXIT - - -' ( -- cfa ) Find the address of the following word - zero if not found or its CFA -TICK word NFATICK -' 200406 allows for larger CPA field using paged calls -' CFA ( nfa -- cfa )' -NFACFA word DUP,ZEXIT,DUP,NFACPA,SWAP,XNFAQ,_IF+04,FETCH,w+24,BITS,EXIT,WFETCH,EXIT - -' ' ( -- cfa, ) -ATICK word TICK,LITCOMP+ex - - -SUBNAMES ' ( bytes -- ) Allocate names memory that builds down - word NEGATE,rg+names,PLUSST,EXIT - -WALIGN word INC,_1,_ANDN,EXIT - -_ALIGNL word _4 -' ALIGN ( address align -- val00 ) -_ALIGN word DEC,SWAP,OVERPLUS,SWAP,_ANDN,EXIT - - -' HERE ( -- addr ) Address of next compilation location -ATHERE word rg+here,FETCH,EXIT -' ( -- atradr ) --- point to the attribute byte in the header of the latest name - -ATATR -' @WORDS ( -- addr ) Point to dictionary (grows down) -ATNAMES word rg+names,FETCH,EXIT - -' @CODES ( -- addr ) Point to code compilation memory -ATCODES word rg+codes,FETCH,EXIT - -' SETORG ( addr -- ) -SETORG word DUP,rg+here,STORE,rg+codes,STORE,EXIT - -' Set the CPA field of a new header prior to creating the name -SETCPA word ATCODES,ATNAMES,OVER,_SHR16 - word _IF+05,_3,MINUS,MSTORE,_3,SUBNAMES+ex - word DEC2,WSTORE,_2,SUBNAMES+ex - -' Set page attribute of the latest word if outside of page 0 -SETPAG word ATCODES,_SHR16,ZEXIT,w+$20,ATNAMES,SET,EXIT - - -' CREATEWORD - create a name in the dictionary using the next word encountered in the stream -'' cnt,name,atr,cpa -CREATEWORD - word _GETWORD ' ( str ) read the next word -' CREATE$ ( gstr -- ) (only works with GETWORD strings which are preceded by a count byte) -CREATESTR - ' skip empty string ' - word DUPCFT,SKIPNZ,DROPEX+ex - ' Start building header - setup CPA field right now ' - word SETCPA - ' 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,SUBNAMES - '' copy it across - word ATNAMES,SWAP,CMOVE,SETPAG - '' delineate start of dictionary (in case pointer is lost) - word _0,ATNAMES,_4,MINUS,STORE - word EXIT - -{ - '' check for dictionary full ( less than 64 bytes ) - word ATNAMES,ATHERE - word w+64,PLUS,LT,ZEXIT,PRTSTR - byte " Dictionary full! ",0 - word ERROR+ex -} - -' CREATE: - Create a name in the dictionary and compile 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,SETHDR,_0,COMPL+ex - -' #= -'_CON10 word GRAB,CREATEWORD,SETHDR,w+$1FF,_AND,_WORD,w,PLUS,ATNAMES,NFACPA,WSTOREX+ex - -' := -_CONST word GRAB,CREATEWORD,SETHDR,w+CONL -DCOMP word COMPW,COMPL,_0,ALLOT+ex - - - -' Identical to a constant except the call address is slightly different so a FORGET knows it can release the data area -_DATCON word GRAB,CREATEWORD,SETHDR - word w+DATCON,DCOMP+ex - -PRIVATE word w+priatr -DEFATR word rg+atrs,CSTORE,EXIT -PUBLIC word _0,DEFATR+ex - - -' GETATR ( -- code ) -GETATR word ATNAMES,_6,_SHR,EXIT - -' Create a new entry in the dictionary but also prevent any execution of code -' : - -NEWDEF word CREATEWORD -REDEF word w+defF,SETFLG+ex ' flag that we have entered a definition - - -PUBDEF word _0,SDEF+ex -'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+$C0,_ANDN,_OR,ATNAMES,CSTORE,EXIT - word _6,_SHL,w+$C0,ATNAMES,CLR,ATNAMES,SET,EXIT - -'' merge in extra attributes -SETHDR word rg+atrs,CFETCH,SETATR+ex - -' Update "here" pointer to point to current free position which "codes" pointer is now at -' - - -HARDEXIT word w+EXIT,COMPW,UNDEF+ex ' compile an EXIT - -ENDDEF - 'word w+EXIT,COMPW ' compile an EXIT - word EXITS -UNDEF word w+defF,CLRFLG,ALLOCATED+ex ' end definition and lock allocated bytes - -'' The ; and EXIT optimizer will only compile an EXIT if it cannot modify the last call to a jump' -EXITS word ATCODES,DEC2,WFETCH ' read last word compiled (could be end of a string too)' - word DUP,_WORD,THREADS,_WORD,$F800-1,WITHIN ' must be threaded code range (but could be a literal)' - word SWAP,_1,_AND,_ZEQ,_AND ' must not have b0 set either - word ATCODES,rg+athen,FETCH,_NEQ,_AND ' not on a THEN ; combo where athen = @CODES ' - word _IF+09,ATCODES,DEC2,DUP,WFETCH,_1,_OR,SWAP,WSTORE,EXIT - word w+EXIT,COMPW,EXIT - -{ - -pre EXITS - @CODES W@ 2- W@ $800 ' !SP WITHIN - IF @CODES W@ 2- DUP W@ 1 OR SWAP W! - ELSE ' EXIT [C] [W] - THEN - ; -} -' [C] force compilation of the next word -COMPILES - word w+compF,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 - -' ' -INCASE word _WORD,ISWITHIN,COMPW,_IF_+ex - -' SWITCH>< ( from to -- flg ).. -ISWITHIN - word SWFETCH,ROT2 -' ( 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 - - - -{ Table vectoring - -index a table of vectors and jump to that vector -A table limit is supplied as well as a default vector - - Usage: - VECTORS - ...... ) -Sample: - 4 LOOKUP BELL \ an index of 4 or more will default to BELL - INDEX0 INDEX1 INDEX2 INDEX3 \ 0 to 3 will execute corresponding vectors - -} -{ -' LOOKUP -' VECTORS ( index range -- ) -VECTORS - word OVER,GT,_ZEQ,_IF+02,DROP,MINUS1 ' limit index to range or -1 (.>0) -.L0 word INC,_SHL1,RPOP,PLUS,WFETCH,ACALL,EXIT - -} - - - - - -{ *** MOVES & FILLS *** } -' 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,PUSHR,B2W,RPOP -W2L word _SHL8 -B2W word _SHL8,ORX+ex - - -' CTYPE ( str cnt -- ) -CTYPE word ADO,IX,CFETCH,AEMIT,LOOP,EXIT -' CTYPE word ADO,IX,CFETCH,TOCHAR,EMIT,LOOP,EXIT - -{ ----------------------------------------------------------------- - Parallax P2 .:.:--TAQOZ--:.:. V1.2 'CHIP' 190104-2300 ----------------------------------------------------------------- -} -' .VER -PRTVER - word PRTSTR - '12345678901234567890123456789012345678901234567890123456789011' - byte " Parallax P2 *TAQOZ RELOADED sIDE* V",0 - word _WORD,@taqoz_version,FETCH - word PRTAST - byte "#~#.# '",0 - word _WORD,@taqoz_name,_4,CTYPE,w+"'",EMIT - word SPACE,_LONG - long $FC262 - word w+10,CTYPE - word SPACE,PRTCLK,SPACE - word _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.. - -200303 - added link control 00,80, -} -_WORDS word rg+delim+1,CFETCH,w+$0D,_NEQ,_IF+01,dwords+ex -' track maximum line width & clear words & word count -WORDS word rg+spincnt,CLRL -MWORDS - word ATNAMES,DUP,PRTADR - '' new line? -.l0 word rg+spincnt+1,CFETCH,w+$5A,GT,_IF+03,CRLF,rg+spincnt+1,CLRC - word rg+spincnt,CFETCH,_IF+05,rg+spincnt,DUP,CDEC,CFETCH,_IF+(.linked-.l3)/2 -.l3 word DUPCFT,_IF+(.linked-.l2)/2 -.l2 word rg+spincnt+2,WINC - '' get length and track line width - word DUPCFT,w+cntm,_AND,INC,rg+spincnt+1,CPLUSST - '' DISPLAY name - word DUP,CFETCHINC,w+cntm,_AND,CTYPE,SPACE,NFANFA,.l0+ex - '' check for link field -.linked '' dlink? add dlink offset to current ptr - word DUP,WFETCH,_WORD,$8000,_AND,_IF+05,DUP,INC2,WFETCH,PLUS,.l0+ex - word DROP,rg+spincnt+2,WFETCH,SPACE,PRTDEC+ex - -QWORDS word w+80,rg+spincnt,STORE,MWORDS+ex - - - -_datsav long 0 -_datorg long datram -_datptr long datram - -ORGPTR word _WORD,_datptr,EXIT -ATORG word _WORD,_datorg,EXIT -' orglen' -DATLEN word ATDAT,ATORG,FETCH,MINUS,EXIT -' org@ ' -ATDAT word ORGPTR,FETCHX+ex -' !org ' -INITORG word _WORD,_datsav,FETCH -' org ' -DATORG word QDUP,_IF+09 - word ATDAT,_WORD,_datsav,STORE ' backup org ' - word DUP,ATORG,STORE,ORGPTR,STORE - word EXIT - -' pub res ( bytes -- ) _datptr +! ; -dres word dres1,COMMENT+ex -dres1 word GRAB,_WORD,_datptr,PLUSST,EXIT - -' pre words [C] GRAB 2* [C] BYTES ; -' pre LONGS [C] GRAB 4* [C] BYTES ; -' pre BYTES ( bytes -- ) [C] GRAB DATPTR SWAP res [C] DATCON ; -dlongs word GRAB,_SHL1 -dwords word GRAB,_SHL1 -dbytes word GRAB,ATDAT,SWAP,dres1,_DATCON+ex -dbyte word _1,dbytes+ex -dword word _2,dbytes+ex -dlong word _4,dbytes+ex - - - - -'#######################################################################' -' debug.twc -'#######################################################################' - -{ 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 -{ -daoff long 0 -'' DUMP# ( virtual -- ) Use virtual address in dump listing rather than real address -DUMPO word _WORD,daoff,STORE,EXIT - -PRTADR word CRLF,w+"$",EMIT,PRTADL,PRTSTR - byte " .. ",0 - -} -PRTADR word CRLF,PRTADL -PRTCOL word w+":",EMIT,SPACE+ex - -PRTADL word DUP,w+20,_SHR - word _IF+01,PRTLONG+ex '' xxxx_xxxx: long format - word DUP,_SHR16,PRTHEX,PRTWORD+ex '' xxxxx: short format - - -'' *** MEMORY READ FUNCTIONS *** - -DCFETCH word rg+dmm,FETCH,QDUP,_IF+02,EXECUTE,EXIT -.L0 word CFETCH,EXIT -DWFETCH word rg+dmm+4,FETCH,QDUP,_IF+02,EXECUTE,EXIT -.L0 word WFETCH,EXIT -DFETCH word rg+dmm+8,FETCH,QDUP,_IF+02,EXECUTE,EXIT -.L0 word FETCHX+ex -{ -'' DMP: reads in memory functions to use (defaults to hubram) -SETDMP word RPOP,rg+dmm,_6,CMOVE,EXIT -} -' DUMP! ( 'C@ 'W@ '@ -- ) -DUMPST word rg+dmm+8,STORE,rg+dmm+4,STORE,rg+dmm,STORE,EXIT - -DUMP word rg+dmp,WFETCH,rg+dmp,CLRW,QDUP,SKIPZ,AJMP,DUMPB+ex - -DMPA word IX,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 -DMPASC word DUMPASC - word _16,PLOOP -RAM word rg+dmm,w+16,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 DMPASC+ex - -{ DUMP as LONGs } -DUMPL word ADO - word DMPA,ADO,IX,DFETCH,PRTLONG,DSPACE,_4,PLOOP - word DMPASC+ex - -{ DUMP as ASCII WIDE } -DUMPAW word w+128,DUMPS+ex -{ DUMP as ASCII } -DUMPA word w+64 -DUMPS word ROT2 - word ADO - word IX,PRTADR - word IX,OVER,ATYPE - word DUP,PLOOP,DROP - word RAM+ex -ATYPE word ADO,IX,DCFETCH,AEMIT,LOOP,EXIT - -' Dump the ASCII representation (or a dot) for 16 bytes' -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 - - -DBHD word CRLF,_4,SPACES+ex - -' Print the stack(s) and dump the registers - also called by hitting D during text input -DEBUG_ word rg+linenum,CLRW - word PRTSTKS - word DBHD,PRTSTR - byte "COG ",0 - word _0,w+$28,COGDUMP - word DBHD,PRTSTR - byte "REGS ",0 - word rg+temp,w+$100,DUMPW - word DBHD,PRTSTR - byte "CODE ",0 - word ATHERE,_32,MINUS,w+64,DUMPW - word DBHD,PRTSTR - byte "WORDS",0 - word ATNAMES,w+$40,DUMPB - word DBHD,PRTSTR - byte "I/O",0 - word lsio - word CRLF+ex - -{ -PRTP word PRTSTRN - byte $0D,"P:",0 - word EXIT -} -lsio word w+"P",PRTHD,w+64,_0,DO,IX,w+10,DIVIDE,PRINT,LOOP - word w+"P",PRTHD,w+64,_0,DO,IX,w+10,UMOD,PRINT,LOOP - ' SAVE DIR & OUT STATES ' - word w+OUTA,COGFETCH,w+OUTB,COGFETCH - word w+DIRA,COGFETCH,w+DIRB,COGFETCH - ' DISPLAY I/O STATE as l=low input, h=high input, L=low output, H=high output' - word w+"?",PRTHD,w+64,_0,DO - word IX,PINTEST,_AND1 - word IX,MASK,w+DIRA,IX,_5,_SHR,PLUS,COGFETCH,_AND,_IF+01,INC2 - word _WORD,lhstr,PLUS,CFETCH,EMIT,LOOP - ' FLOAT TEST ' - word w+"=",PRTHD,w+62,_0,DO - word IX,LOW,w+200,WAIT,IX,_FLOAT,w+200,WAIT,IX,PINTEST,_AND1,_SHL1 - word IX,HIGH,w+200,WAIT,IX,_FLOAT,w+200,WAIT,IX,PINTEST,_AND1,_OR - word _WORD,dustr,PLUS,CFETCH,EMIT,LOOP - word w+DIRB,COGSTORE,w+DIRA,COGSTORE - word w+OUTB,COGSTORE,w+OUTA,COGSTORE - word EXIT - -dustr byte "d~?u" -lhstr byte "lhLH" -{ -PRTHD word PRTSTRN - byte $0D,"=:",0 - word EXIT -} -PRTHD word CRLF,EMIT,w+":",EMIT,EXIT - - -ELAPSED -LAPCAL word LAPFETCH,LAP,LAP,LAPFETCH,MINUS,EXIT -{ -: .CLK - CLKHZ 1 M // 0= - IF CLKHZ 1 M U/ . ." MHz" ELSE CLKHZ .DECL ." Hz" THEN - ; - -: .LAP - LAP@ LAP LAP LAP@ - - ( cycles/clkhz ) - DUP .DECL ." cycles = " - 1,000,000 CLKHZ 1000 U/ */ ( scale cycles to nanoseconds ) - .DECL ." ns @" .CLK - ; -} -MILLION word CONL - long 1000000 - -PRTCLK word CLKHZ,DUP,MILLION,UMOD,_IF+05 - word PRTDECL,PRTSTR - byte "Hz ",0 - word EXIT - word MILLION,UDIVIDE,PRINT,PRTSTR - byte "MHz",0 - word EXIT - -PRTMS -PRTLAP word LAPCAL -PRTCYC word DUP,PRTDECL,PRTSTR - byte " cycles= ",0 - word MILLION,CLKHZ,w+1000,UDIVIDE,UMULDIV,PRTDECL,PRTSTR - byte "ns @",0,0 - word PRTCLK+ex - -PRTLAPS word LAPCAL,SWAP,UDIVIDE,PRTCYC - -{ -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 -} - -QSTACKS - word _DEPTH,w+32,GT,ZEXIT,INITSP,EXIT - -PRTSTK word PRTSTRN - byte " DATA STACK (",0 - word _DEPTH,DUP,PRINT1 - word ZEXIT - word _DEPTH,w+32,_MIN,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 PRTSTRN - 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 -{ -TRACE word _WORD,TRACER,FETCH,_WORD,doNEXT,COGSTORE,EXIT -UNTRACE word _WORD,TRACING,FETCH,_WORD,doNEXT,COGSTORE,EXIT -} - -'#######################################################################' -' print.twc -'#######################################################################' - -QCHAR word DUP,_BL,w+$7E,WITHIN+ex -TOCHAR word QCHAR,_ZEQ,_IF+02,DROP,w+$20,EXIT - -' @PAD ( -- addr ) pointer to current position in number pad -ATPAD word rg+padwr,CFETCH,rg+numpad,PLUS,EXIT - -' >CHAR ( val -- ch ) convert binary value to an ASCII character -BINASC word w+$3F,_AND,w+"0",PLUS,DUP,w+"9" ' convert to "0".."9" - word GT,_7,_AND,PLUS ' convert to "A".. - word DUP,w+$5D,GT,ZEXIT,_3,PLUS,EXIT ' skip symbols to go to "a".. - -' <# ' resets number pad write index to end of pad -LHASH word w+numpadsz,rg+padwr,CSTORE,_0 -''' -' HOLD ( char -- ) -HOLD word rg+padwr,CDEC,ATPAD,CSTOREX+ex - - -' # ( n1 -- n2 ) convert the next ls digit of a double to a char and prepend to number string -HASH word rg+double,FETCH,GETBASE,UMDIVMOD64,rg+double,STORE - word SWAP,BINASC,HOLD+ex - ' conversion digits exhausted, use zeros or spaces - -' #S ( d1 -- 0 ) Convert all digits -HASHS word HASH,DUP,_ZEQ,_UNTIL+04,EXIT - -' #> ( n1 -- caddr ) -RHASH word DROP,ATPAD,rg+double,CLRL,EXIT - -' ( d1 -- n1 ) ' Store high long of double for formating -DNUM word rg+double -STOREX word STORE,EXIT - - -PRTSP word PRT,SPACE+ex - -' . ( 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 GETCHR,QDUP,_IF+02,EMIT,PRINTSTR+ex -pstrxt word DROP,RAM+ex - -GETCHR word CFETCHINC - word DUP,w+"\",_EQ,ZEXIT - word DROP,CFETCHINC,_SWITCH - word w+"n",ISEQ,_IF+02,CRLF,GETCHR+ex ' n CRLF - word w+"t",ISEQ,_IF+02,w+9,EXIT ' t TAB - word w+"f",ISEQ,_IF+02,w+12,EXIT ' f FF CLS - word w+"r",ISEQ,_IF+02,w+13,EXIT ' r CR - word w+"[",ISEQ,_IF+04,w+$1B,EMIT,w+"[",EXIT ' [ ESC [ - word w+"e",ISEQ,_IF+02,w+$1B,EXIT ' e ESC - word w+$27,ISEQ,_IF+02,w+$22,EXIT ' ' " - word w+$20,ISEQ,_IF+03,w+8,SPACES,GETCHR+ex ' SP 8 SPACES - word w+"$",ISEQ,_IF+10,CFETCHINC,TOHEX,_4,_SHL ' $nn HEX value - word SWAP,CFETCHINC,TOHEX,ROT,_OR,EXIT - ' A..Z for 6 to 32 spaces - word SWFETCH,DUP,w+"A",w+"Z",WITHIN,ZEXIT ' A..Z 6 to 32 SPACES - word w+$41-6,MINUS,SPACES,GETCHR+ex - -TOHEX word w+"0",MINUS,DUP,w+9,GT,ZEXIT,w+7,MINUS,EXIT -' (PRINT") -PRTSTRN word CRLF -' Print inline string -PRTSTR word RPOP -ps1 word GETCHR,QDUP,_IF+02,EMIT,ps1+ex 'GOBACK+5 ''.lp+ex - word WALIGN,PUSHR,EXIT - -{ -\' – single quote, needed for character literals -\" – double quote, needed for string literals -\\ – backslash -\0 – Unicode character 0 -\a – Alert (character 7) -\b – Backspace (character 8) -\f – Form feed (character 12) -\n – New line (character 10) -\r – Carriage return (character 13) -\t – Horizontal tab (character 9) -\v – Vertical quote (character 11) -\uxxxx – Unicode escape sequence for character with hex value xxxx -\xn[n][n][n] – Unicode escape sequence for character with hex value nnnn (variable length version of \uxxxx) -\Uxxxxxxxx – Unicode escape sequence for character with hex value xxxxxxxx (for generating surrogates) - -} - -' 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 - - PFLG - -| 4 -\ 2 -~ 1 Suppress leading zeros - -TAQOZ# 12 .AS" 5|" 00012 ok -TAQOZ# 12 .AS" 5|\" 12 ok -} -' DZEQ word DUP2,_OR,_ZEQ,EXIT - -' process a single .AS char ( numl numh char ) -ASCHAR word _SWITCH,_4,rg+pflg,BITQ,_NOT,_4,rg+pflg,CLR,_IF+(ASCMD-.L3)/2 -.L3 word w+"|",ISEQ,_IF+04,_4 -SETP word rg+pflg,SET,EXIT - word w+"~",ISEQ,_IF+02,_1,SETP+ex - word w+"\",ISEQ,_IF+02,_2,SETP+ex - '' suppress leading zeros?' - word DZEQ,_1,rg+pflg,BITQ,_AND,IFEXIT - '' Convert a digit?' - word w+"#",ISEQ,_IF+(ASONE-.L0)/2 -.L0 '' null? spaces? ( numl numh ) ' -AHASH word DZEQ,_2,rg+pflg,BITQ,_AND,_IF+02,w+$20,HOLD+ex - '' extract lsd from double and convert and insert as ASCII - word rg+pbase,CFETCH,UMDIVMOD64,ROT,BINASC,HOLD+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,HOLD+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 -{ -pub .AS ( num format -- ) - 12 REG @ SWAP pflg C~ 10 pbase C! - <# DUP LEN$ 1- OVER+ FROM -1 BY LEN$ - FOR I C@ AS# NEXT DROP - #> PRINT$ - ; -} - '' find end of string and push next instruction onto return' -PRTAST word RPOP,DUP,STRLEN,INC2,_1,_ANDN,OVERPLUS,PUSHR - - 'word DROP,PRT+ex - - '' ( num fmtstr ) clear format and select decimal' -PRTAS word rg+pflg,CLRC,w+10,rg+pbase,CSTORE - '' ( numl fmtstr )' -'word rg+double,FETCH,SWAP - '' start conversion and point to end of fmtend to start from there back' - '' ( numl fmtstr fmtend )' - word LHASH,DUP,STRLEN,DEC,OVERPLUS - '' ( fmtend numl numh fmtstr )' - word ROT2,rg+double,FETCH,SWAP - '' step through ( fmtend numl numh ) ' - word STRLEN,FOR,THIRD,CFETCH,ASCHAR,ROT,DEC,ROT2,forNEXT - word DROP2,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 - -'#######################################################################' -' numbers.twc -'#######################################################################' - -{ *** 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 - -HEXa2A word rg+prefix,CFETCH,w+"$",_EQ,ZEXIT -' pub a>A ( ch -- ch ) DUP 'a' 'z' WITHIN IF $20 - THEN ; -a2A word DUP,w+"a",w+"z",WITHIN,ZEXIT,w+$20,MINUS,EXIT - -{ *** STRING TO NUMBER CONVERSION *** } - -' DECIMAL? '3 -DECQ word w+"0",w+"9",WITHIN+ex -' HEX? ' -HEXQ word HEXa2A,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 HEXa2A - 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 - -$FFFFFFFF -4294967295 - -DOUBLE NUMBERS - use a dot at end of number to signify double-precision (or >32bits) -$DEADBEEFBABECAFE. -18446744073709551615d. -} - -OVEQ word THIRD,_EQ,EXIT - -' ': DM* ( d. n -- d. ) -ROT SWAP 3RD UM* ROT 4TH * + ROT DROP ; -DMMUL word ROT2,SWAP,THIRD,UMMUL,ROT,FOURTH,MULTIPLY,PLUS,ROT,DROP,EXIT -FETCH2 word DUP,FETCH,SWAP,INC4,FETCH,EXIT -STORE2 word SWAP,OVER,INC4,STORE,STORE,EXIT - -DNUMQ word rg+suffix,CFETCH,w+".",_EQ,EXIT - -_NUMBER ' ( str -- value digits | false ) - word rg+4,CLRL ' REG0L = 0 - word w+signF,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+signF,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 - word w+"$",OVEQ,_IF+02,HEX,INC ' $nnnn - set hex base - flag true - 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 OVER,w+".",_EQ,_OR ' allow decimal point suffix (double) 190124' - 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 - '' shift double number up one digit and merge -nmok word rg+anumber,FETCH2,GETBASE,DMMUL ' shift anumber left one digit (base) - word ROT2,PLUS,SWAP,rg+anumber,STORE2 ' 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 and push number onto stack - 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+signF,CHKFLG,QNEGATE -'!!!! need to be able to negate double number !!!!' - word DNUMQ,_IF+04,rg+hnumber,FETCH,ROT,EXIT - word SWAP,EXIT ' all good, return with number and true - -' NUMBER processing -try to convert a string to a number -NUMBER ' ( str -- value digits | false ) - ' process control prefix i.e. ^A - word DUP,STRLEN,_2,_EQ - word OVER,CFETCH,w+"^",_EQ,_AND,_IF+06 ' ^ch Accept caret char as char - word INC,CFETCH,w+$1F,_AND,_1,EXIT ' control character processed - single digit - '' process character literal i.e. "A" -ch01 word DUP,STRLEN,_3,_EQ - word OVER,CFETCH,DUP,w+$22,_EQ,SWAP,w+$27,_EQ ' ASCII character literal "A" or 'A' - 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+(dpl-anumber+1),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 - -'#######################################################################' -' console.twc -'#######################################################################' - - -{ *** 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+79,EMITS -CLRWORD word rg+wordcnt,w+wordsz,ERASE,EXIT - -' PUTCH ( ch -- ) write a character into the next free position in the word buffer -PUTCHAR word rg+wordcnt,CFETCHINC,PLUS,CSTOREX+ex -' PUTCH+' ( ch -- ) PUTCH and advance -PUTCHARPL - word PUTCHAR,rg+wordcnt,DUPCFT,INC - word w+wordsz,UMOD,SWAP,CSTOREX+ex - -' HEXASC ( hex -- ascii )' -HEXASC word BITS4,w+$30,PLUS,DUP,w+$39,GT,w+7,_AND,PLUS,EXIT - -' Function keys execute immediately and search dictionary for matching :xx where xx = hex code' -' Define function for F12 -> pub :FC ; -FNCKEY - word w+":",PUTCHARPL - word DUP,_4,_SHR,HEXASC,PUTCHARPL - word HEXASC,PUTCHARPL,w+$0D -' -' As characters are accepted from the input stream, checks need to be made for delimiters, -doCHAR ' ( char -- flg ) Process char into wordbuf and flag true if all done -' editing commands etc. 123us/CHAR, 184us/CTRL -' ignore null - word DUP,ZEXIT -' Replace DEL with BS - word w+$7F,OVER,_EQ,_IF+02,DROP,_8 -' delimiter is always last character - word DUP,rg+delim+1,CSTORE -' check for 8-bit special characters as FNCKEYs ' - word DUP,w+$80,_AND,_IF+01,FNCKEY+ex -' only check for control characters - word DUP,w+$20,LT,_IF+01,CTLKEY+ex - ' PROCESS CHARACTER -CHARKEY - word w+echoF,CHKFLG,_ZEQ,_IF+02,DUP,EMIT ' don't echo if we don't want it - 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 ..... - word PUTCHARPL,FALX+ex ' put a character into the word buffer - - -' -' PROCESS CONTROL CHARACTERS -' - -BLKDMP word _0,DUP,w+$100,DUMPB,w+$100,PLUS,KEY,w+$1B,_EQ,_UNTIL+09,EXIT -RSTSTK word INITSP,_LONG - long $DEADBEEF - word _0,EXIT -ESCKEY word INC,SCRUB+ex -TABKEY word DROP,_9,EMIT,rg+wordcnt,CFETCH,EXIT -BACKSP word rg+wordcnt,CFETCH,ZEXIT ' don't backspace on empty word - word _8,EMIT,SPACE,_8,EMIT ' backspace and clear - word rg+wordcnt,CDEC,_0,PUTCHAR+ex ' null previous char -CARKEY word INC,EXIT -COLDKY word COLDST -RSTKEY word RESET,EXIT -CONSOL word _CON+ex -STKKEY word DROP,PRTSTK,CRLF,_0,EXIT -TRACEK word TRACE,EXIT -UNTKEY word UNTRACE,EXIT - -' CTRL! ( fnc key -- )' -CTLSTO word ATCTRL,WSTORE,EXIT -ATCTRL word w+$1F,_AND,_SHL1,_WORD,keytbl,PLUS,EXIT - -' lookup ctrls in table but precede with a false flag -' -CTLKEY word _0,SWAP,ATCTRL,WFETCH - word QDUP,ZEXIT,AJMP - -' CONTROL KEY LOOKUP TABLE -' @ A B C D E F G' -keytbl - word 000000,000000,BLKDMP,RSTKEY,000000,000000,000000,BELL -' H I J K L M N O' - word BACKSP,TABKEY,000000,COLDKY,CLS ,CARKEY,000000,000000 -' P Q R S T U V W' - word CONSOL,STKKEY,RESTORE,RSTSTK,TRACEK,UNTKEY,PRTVER,QWORDS -' X Y Z [ \ ] ^ _' - word CARKEY,WORDS, COLDKY,ESCKEY,CRLF ,000000,000000,DEBUG_ - - -' GET$ ( -- str )' -' Build a delimited word in wordbuf for wordcnt and return immediately upon a valid delimiter -_GETWORD ' ( -- str ) -' Erase the word buffer & preceding count - word CLRWORD -' get another character - word WKEY,doCHAR,_UNTIL+03 - word rg+wordbuf,EXIT - - -{ ****************** DICTIONARY SEARCH ********************** } - -' SEARCH ( str -- nfaptr ) ' cstr points to the count+strinw+null -SEARCH - word rg+ufind,QJMP ' use alternative method if enabled (hash search) - word ATNAMES,FINDSTR - word EXIT -{ -SEARCH - word rg+ufind,QJMP ' use alternative method if enabled (hash search) - word rg+context,FETCH,FINDSTR,QDUP,IFEXIT - word ATNAMES,FINDSTR - word EXIT -} -DROPFEX word DROP,FALX+ex ' can't backspace anymore, bell - -{ -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 ' clear this cog's task registers -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 (but not with P2) - word ATID,WFETCH ' fetch cog's task variable - word QDUP,_UNTIL+09 ' 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$ " - -PROSTR byte "TAQOZ",0,0,0,0,0,0,0,0,0,0,0 - -PROMPT - ' execute user prompt code - word rg+uprompt,WFETCH,QDUP,_IF+02,ACALL,EXIT 'trl1+ex - word rg+linenum,WFETCH,QDUP,_IF+05 - ' just display line and increment # - word CR,PRTDEC4,rg+linenum,WINC,SPACES3+ex - ' Prompt with version and base - word _WORD,PROSTR,PRINTSTR - ' prompt char = base %#$ etc - word GETBASE,_WORD,radix,PLUS,CFETCH,EMIT,SPACE+ex - -' COLD - Force defaults -COLDST -' initialize task registers -' free memory backup - word rg+0,w+$100,ERASE ' init task registers' - word _WORD,codeorg ' init code pointers' - word DUP,rg+here,STORE,rg+oldhere,STORE - word datcold,DATORG ' init data pointer' - word wordcold,rg+names,STORE ' init dictionary pointer' -' reset cold start -XCOLD word _CON,PRTSTR - byte "x",$0D,$0A," *Cold start* ",0 - word _WORD,$A55A,rg+cold,WSTOREX+ex - -' CONSTANTS' -wordcold - word CONL - long dictorg -datcold - word CONL - long extvars 'datram - -' read last 4 keys' -KEYFETCH - word w+rxlong,COGFETCH,EXIT - - - { *** MAIN TERMINAL CONSOLE *** } - - -TERMINAL -'' word w+"?",CONTXI - word InitRP,INITSP - word w+_OPTIONS+1,CFETCH,w+10,MUL16,ms -' word _WORD,bootms,ms - ' performing a check for a saved session - word rg+cold,WFETCH,_WORD,$A55A,_NEQ,SKIPZ,COLDST - word _CON - word rg+keypoll,CLRW,rg+uaccept,CLRW - word rg+linenum,CLRW -' word _1,rg+fflags,WSTORE -' word _GETRND,rg+bootsig,STORE - ' ^A abort autostart with ^A -'' word w+@lastkey,CFETCH,_1,_NEQ,_IF+11 - word KEYFETCH,BITS8,_1,_NEQ,_IF+11 - ' check for an AUTORUN - word rg+autovec,WFETCH,QDUP,_IF+02,ACALL,TRM1+ex - ' Show VERSION with optional CLS (default CR) - word CRLF,PRTDASH,CRLF,DECIMAL,PRTVER -TRM1 ' echo on & default delimiter - word w+echoF,CLRFLG,_BL,rg+delim,CSTORE - ' Stop compilation -CONSOLE word InitRP,SCRUB,CRLF,w+defF,CLRFLG - ' - ' **************************************************************** - ' *** Main console line loop - get a new line (word by word) *** - ' **************************************************************** - ' - ' reset temporary code compilation pointer & prompt -LINELP word ATHERE,rg+codes,STORE,PROMPT - ' Main console loop - read a word and process -WORDLP word QSTACKS - word _GETWORD,w+passF,CLRFLG -' 200525 make any word that ends in a _ into a comment that is ignored ' - word rg+wordcnt,DUP,CFETCH,PLUS,CFETCH,w+$5F,_EQ,_IF+02,DROP,chkeol+ex - - ' 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,SEARCH,QDUP,_IF+(TRYNUM-foundword)/2 - ' found the word in the dictionary - compile or execute? - - -foundword - ' point to attribute word (CNT,,ATR,CPA) - word DUP,NFACFA ' ( cpa cfa ) - ' is the immediate bit set? - word SWAP,CFETCH,_6,_SHR,w+preatr,_EQ - ' and not forced to [C] compile, then EXECUTE NOW! - word w+compF,CHKFLG,_ZEQ,_AND,_IF+02,EXECUTE,chkeol+ex - -compword - ' or else COMPILE the wordcode(s) for this word & reset - word COMPA,w+compF,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+uaccept,WFETCH,QDUP,_IF+02,ACALL,eol01+ex - word w+ackF,CHKFLG,SKIPNZ,ACK - ' Simple CRLF if in a definition or interactive? -eol01 word DUP,w+defF,CHKFLG,_AND,SKIPZ,CRLF - ' do not execute if still defining -eol02 word w+defF,CHKFLG,_ZEQ,_AND - ' wait until CR to execute compiled codes - word _UNTIL+(execs-WORDLP)/2 -execs ' EXECUTE CODE from user input (append an EXIT first) - word _WORD,EOL+ex,COMPW - word w+EXIT,COMPW - ' execute wordcodes from beginning -execinp word ATHERE,EXECUTE - ' skip OK response if in line mode - 'word rg+linenum,WFETCH,SKIPNZ,OK,LINELP+ex - word w+okF,CHKFLG,SKIPNZ,OK,LINELP+ex - -' user or deferred code -EOL word _NOP,_NOP,_NOP,_NOP - word w+_NOP,_WORD,EOL,WSTORE,EXIT - - -ACK word PRTSTR - byte " --- ",0 - word EXIT -'ACCSTR byte " --- ",0,0,0 - - ' **************************************************************** - - -TRYNUM ' Attempt to process this word as a number but check for special literals first (^ ' etc) - word rg+wordbuf,NUMBER,_IF+06 - ' is it a number? ( value digits ) -compnum ' COMPILE THE NUMBER - word DNUMQ,_IF+02,SWAP,LITCOMP, LITCOMP,chkeol+ex - - ' Unknown word or number - try converting case first time -UNKNOWN word w+passF,CHKFLG,_ZEQ - word _IF+05,w+passF,SETFLG - word rg+wordbuf,TOUPPER,trm4+ex - ' UNKNOWN - try unum vector if set - unum routine should return with true if successful or false if failed - word rg+unum,WFETCH,QDUP,_IF+03,ACALL,_IF+01,chkeol+ex -' -' Failed all searches and conversions!!!! -' - ' interactive or in the middle of a definition? - word w+defF,CHKFLG,_AND,_IF+(HUH-nfdef)/2 - ' Display position in line of error -nfdef word PRTSTR - byte 9,9," error in ",0 - '' display latest definition - word ATNAMES,CFETCHINC,w+cntm,_AND,CTYPE,PRTSTR - byte " at ",0 - ' Spit out offending word - word rg+wordbuf,PRINTSTR,SPACE - ' discard but echo remainder of line -.L0 word WKEY,DUP,_13,_NEQ,_IF+02,EMIT,.L0+ex,DROP - 'word DEBUG_ - - ' count errors and force a new line to display error -ERROR word rg+errors,WINC '',CR,w+$10A,EMIT -ERRSTR word PRTSTR - byte " *error* ",7,$0D,$0A,$0B,0 - ' - ' force a new line to prevent overwrite then return to console -ERROUT word w+$10A,EMIT,DISCARD,INITSP,_END,CONSOLE+ex - -'pri ?ERROR ( cond n -- ) IF .AS" ERROR# #~# " R> DROP CONSOLE EXIT THEN DROP ; -QERROR word SWAP,SKIPNZ,DROPEX+ex -ERRMSG word PRTSTR - byte " ERROR - ",0 - word PRINTSTR,ERROUT+ex - - ' as-you-go error prompt in interactive mode -HUH word PRTSTR - byte " ??? ",0 - 'word rg+linenum,WFETCH,_IF+03,CR,w+$10A,EMIT - word w+okF,CHKFLG,_IF+03,CR,w+$10A,EMIT - word WORDLP+ex - - word _COGID -MBXOUT word rg+outchar,CFETCH,_UNTIL+03,rg+outchar,CSTORE,EXIT -MBXKEY word - -' MBX use mailbox for console -MBX word _WORD,MBXOUT,rg+uemit,WSTORE,_WORD,MBXKEY,rg+ukey,WSTORE,EXIT - -' disable serial port ' -MBO word w+63,MUTE,w+62 -MUTE word _PIN,F,_0,_WRPIN,EXIT - - -' KEY! ( ch -- ) Force a character as the next KEY read -PUTKEY word rg+keychar,STOREX+ex - -SOFTKEY word rg+keychar,CFETCH,QDUP,ZEXIT ' read a "key" that was forced with KEY! - word RPOP,DROP - word rg+keychar+4,FETCH,DUP,_SHR8,rg+keychar+4,STORE - word w+24,_SHL - word rg+keychar,FETCH,_SHR8,_OR,rg+keychar,STORE - word EXIT - -USRKEY word rg+ukey,WFETCH,QDUP,ZEXIT - word RPOP,DROP - word ACALL,DUP,IFEXIT,DOPOLL+ex - - -QSEND word w+outchar,CFETCH,QDUP,ZEXIT,w+outchar,CLRC,CONEMIT,EXIT - -' KEY ( -- ch ) if ch is zero then no key was read -KEY word QSEND - word SOFTKEY,USRKEY -CONKEY word READRX -DOKEY word DUP,_IF+07,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 - -{ -long mrd -pub MKEY mrd @ C@ mrd ++ DUP 0= IF ukey W~ THEN ; -pub MSAVE - mrd ! - BEGIN - WKEY DUP mrd @ ! - $0D = IF CR mrd @ .L 8 SPACES mrd @ 4 - @ $44_4E_45_0D = ELSE 0 THEN - mrd ++ - UNTIL - ; -pub MLOAD mrd ! ' MKEY ukey W! ; -pub TAQOZ ---- receive source file following the TAQOZ directive directly into memory - $1.0000 MSAVE - $1.0000 MLOAD tAQOZ -} - -MKEY word rg+mrd,FETCH,CFETCH,rg+mrd,LINC,DUP,IFEXIT,rg+ukey,CLRW,EXIT - -' MSAVE ( dst -- ) -MSAVE word QDUP,ZEXIT,rg+mrd,STORE -.l0 word WKEY,DUP,rg+mrd,FETCH,STORE - word w+$0D,_EQ,_IF+(.l4-.l2)/2 -.l2 word 'CR '',rg+mrd,FETCH,PRTL,_8,SPACES - word rg+mrd,FETCH,_4,MINUS,FETCH,_LONG - long $44_4E_45_0A - word _LONG - long $44_4E_45_0D ' END (checked on trailing CR) - - word WITHIN,.l1+ex -.l4 word _0 -.l1 word rg+mrd,LINC,_UNTIL+(.l3-.l0)/2 -.l3 word EXIT - -' MLOAD ( src -- ) -MLOAD word QDUP,ZEXIT,rg+mrd,STORE,_WORD,MKEY,rg+ukey,WSTORE,EXIT - - -' ECHO ( on/off -- )' -'_ECHO word w+echof,MASK,rg+fflags,ROT,BITST,EXIT - -SKIPLF word DUP,w+$0A,_EQ,_IF+02,DROP,_13,CONEMIT,EXIT - -FL word _WORD,MBUF+2,STORE,EXIT - -MBUF word CONL - long $6_0000 - -' TAQOZ marks the start of a block of source code to be compiled in block mode -' -_TAQOZ - word MBUF,_IF+06 - word MBUF,MSAVE - word MBUF,MLOAD - word w+100,ms - - 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+oldhere,STORE - ' reset line# to 1 to active - word _1,rg+linenum,WSTORE,w+$0F,rg+fflags,CSTORE - word _WORD,SKIPLF,EMITST - ' backup dictionary pointer -' word ATNAMES,rg+oldnames,STORE - ' time the load - word _GETCNT,rg+spincnt,STOREX+ex - -' end of block load mode TAQOZ END -' - ' return to console -_END word rg+fflags,CLRC,_0,EMITST - ' 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+oldhere,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,CLKHZ,w+1000,UDIVIDE,UDIVIDE,PRTDECL,PRTSTR - byte "ms ",0 - word _2,CLRFLG+ex - - -'#######################################################################' -' flash.twc -'#######################################################################' - -'''''''''''''''''''''''''''''''''''''''''''''''''''' -' SERIAL FLASH -'''''''''''''''''''''''''''''''''''''''''''''''''''' -' TO DO - remove hard references to SPI Flash pins' -' sck mosi miso ss' - -' ADDRESS OF TAQOZ BACKUP/RESTORE IN FLASH' -BRORG word CONL - long flashpart -SFSIG word CONL - long flashsig - - - '' WRITE ENABLE -SFWE word SFBSY,w+6,SFCMD -SFCMD -_SFPINS word _LONG -_sfck byte spi_ck -_sfdi byte spi_di -_sfdo byte spi_do -_sfcs byte spi_cs - word SPIPINS,SPIWR8,EXIT - - '' Set which pins are used by Serial Flash ( &cs.so.si.ck -- ) -SFPINS word _WORD,_sfck,STOREX+ex - - -SFWD word _4,SFCMD+ex -' SF? ' -SFSTAT word _5 -SFRD1 word SFCMD,_0,SPIRD -SFEX word SPICE,EXIT - - - - '' ( Read serial Flash serial number ) -SFSID word w+$4B,SFCMD -SFRDD word _0,SPIRDL,SPIRDL -SFRDL word _0,SPIRDL,SFEX+ex - '' ( Read serial Flash Jedec ID ) -SFJID word w+$9F,SFCMD,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,SFEX+ex - - '' SFWRP SFWRPAGE ( src dst -- ) -SFWRPAGE word w+$02,SFWE,SPIWM,w+256,SPITX,SFEX+ex -'' SFERPAGE ( page pages -- ) -SFERPAGE - word ADO,IX,_16,_SHL,SFER64,w+200,ms,LOOP,EXIT - -'' pub BACKUP $0F.0000 SFER64 200 ms " TAQO" @ 4 ! 0 $0F.0000 $1.0000 SFWRS ; - - '' BACKUP the first 128K of memory into flash -BACKUP word SFJID,DUP,INC,_AND,ZEXIT 'EXIT IF BLANK ID' - word W+flashpage,_3,SFERPAGE - word _0,DEC2,DEC2 - word w+128,KB,OVER,STORE ' patch in size for flash loader at start of image - ' word _WORD,brstr,FETCH,STORE - word BRORG,w+128,KB -''SFWRS ( hubsrc sfdst cnt -- ) -SFWRS word ROT,SWAP,ADO,IX,OVER,SFWRPAGE,SPINNER,w+256,PLUS,w+256,PLOOP,DROPEX+ex - - '' SFRDW ( -- data16 ) -SFRDW word _0,SPIRD,_0,SPIRD,_SHL8,ORX+ex - - '' SFR ( addr -- ) -SFRD word _3,SFCMD,SPIWM,EXIT - -brstr byte "TAQO" - - '' RESTORE TAQOZ from FLASH by copying to $2.0000 first' -RESTORE word SFSIG,SFFETCH,_WORD,brstr,FETCH,_EQ,ZEXIT - word BRORG,_0,w+128,KB - '' ( sfadr dst cnt -- ) '' read block from SF to RAM -SFRDS word ROT,SFRD,SPIRX ',DROP '',SFEX+ex -SPIX word SPICE,EXIT - - '' SFC@ -SFCFETCH - word SFRD,_0,SPIRD,SFEX+ex - ''pub SFW@ -SFWFETCH - word SFRD,SFRDW,SFEX+ex - - ''pub SF@ ( addr -- long ) -SFFETCH word SFRD,SFRDW,SFRDW,_SHL16,_OR,SFEX+ex - - '' SF Select Serial Flash as memory for DUMP words -'SF word SETDMP,SFCFETCH,SFWFETCH,SFFETCH -SF word _WORD,SFCFETCH,_WORD,SFWFETCH,_WORD,SFFETCH,DUMPST+ex - - -{ - - -spi_cmd8 = $FC164 -spi_cmd = $FC168 -spi_in = $FC188 - -romi = $fc2b8 -romx = $fc2b8 -romy = $fc2b8 -romz = $fc2b8 - -SFBOOT ' Flash boot code to copy TAQOZ image @ $E0000 from Flash to RAM - loc PTRA,\#$E0000 - loc PTRB,\#0 - mov pa,#32 - mov pb,#$0E0000_03 - call #\spi_cmd - decod romy,#17 'ready to input 128kB from SPI - wrfast #0,#0 'ready to write bytes to hub -.data call #\spi_in 'get byte - wfbyte romx - djnz romy,#.data - drvh #spi_cs - jmp #\0 - - - -} - ' sdcard -codeorg - -'#######################################################################' -' dictionary.twc -'#######################################################################' - -'************************************************************************************ -'************************************** DICTIONARY ********************************** -'************************************************************************************ - -{ -The dictionary is comprised of contiguous headers separated from code memory -and can be placed anywhere convenient although the default in in the first 64k. -New header records are added to the start of the dictionary so that the previous -immediately follows etc right to the last valid entry terminated by a 00 00 -indicating a count of zero with a null terminator - the end of the dictionary - -0CBA9: MAIN !RXB .RXB ?? SYSINFO .DEVICES .USAGE .UBYTES SFBYTES lsi2c .I2C .ASBYTES .MODULES CRLF+ -?PINS ?PIN FCACHE SRRDS srinc .SR SRID SR! SRW! SRC! SRWRS SRWRP !SR SRRD SR SR@ SRW@ SRC@ -*SPIRAM* DECOMP SEENFA SEE SEECFA ?NAME .NAME ?THENS .SEE ?LOOPS ?DOS CASE? ?GOTO .LCON ?CRLF -fad? if? -if +if .LIT .W10 -ind +ind INDENT .STR .W: .ASC .D $ 'EMIT (DS) (LC) (.") (AS) (") -(S) (R) (IF) (L) (W) SEE@ @SEE @SEE+ @SEE++ eflg? dflg? wsrc 79 -@WORDS $40 DUMP --- -0CBA9: 04 4D 41 49 4E E0 5F 04 21 52 58 42 D6 5F 04 2E '.MAIN._.!RXB._..' -0CBB9: 52 58 42 CE 5F 02 3F 3F 48 5F 07 53 59 53 49 4E 'RXB._.??H_.SYSIN' -0CBC9: 46 4F 48 5F 08 2E 44 45 56 49 43 45 53 8A 5E 06 'FOH_..DEVICES.^.' -0CBD9: 2E 55 53 41 47 45 06 5E 47 2E 55 42 59 54 45 53 '.USAGE.^G.UBYTES' ok - -The first byte is the 5-bit name count plus the 3 attribute bits b7..b5 followed by -the name and then the 16-bit CFA (code field address) -The header record for MAIN is 04 4D 41 49 4E E0 5F -04 = 4 character name with no attributes -4D 41 49 3E = "MAIN" -E0 5F = $5FE0 = CODE ADDRESS - -The last entry: ------- ATR NAME CFA TERMINATOR -0EA43: 03 45 4E 44 BA 28 00 00 00 00 00 00 00 00 00 00 '.END.(..........' ok - -A special LINK header starts with 00 $80 followed by the link to the header to skip to -This is used mainly to hide sections of the dictionary which can be revealed by simply -overwriting the 00 80 with a valid dummy header such as 01 5F -200409 - Dlink only needs to have msb set of 2nd byte, so therefore could be: -00 80 or 01 DF = _ etc - - - -b7 b6 b5 b4 b3 b2 b1 b0 --atr- ex ----charcount- -ate 00 = public -atr 01 = private -atr 10 = pre-emptive -atr 11 = cli -pg 0 = 16-bit CPA -pg 1 = 24-bit CPA -} -CON - cntm = $1F ' mask for nfa count byte to mask off atrs' - pg = 5 ' If set indicates that the CPA is 24-bits long - - - ' Dictionary header attribute flags - pubatr = 0 ' $00 normal public attribute - priatr = 1 ' $40 private - header can be reclaimed - preatr = 2 ' $80 preemptive - executes immediately - cliatr = 3 ' $C0 command line interactive but compiles in definition - -'' -'' attach these attributes to count bytes in dictionary i.e. byte 2+im,"IF" -'' - im = preatr<<6 'lexicon immediate bit - pr = priatr<<6 'private (flagged for removal from the dictionary) - cli = cliatr<<6 - - -DAT - -{ *** DICTIONARY *** } - - - orgh dictorg ' Manually optimized to set end of dictionary in memory ' - - '' ATR+CNT,NAME,CFA - byte 3, "DUP" - word DUP - byte 4, "OVER" - word OVER - byte 3, "3RD" - word THIRD - byte 3, "4TH" - word FOURTH - byte 5, "OVER+" - word OVERPLUS - byte 4, "SWAP" - word SWAP - byte 3, "ROT" - word ROT - byte 4, "-ROT" - word ROT2 - byte 4, "ROT4" - word ROT4 - byte 5, "-ROT4" - word RROT4 - byte 4, "DROP" - word DROP - byte 5, "2DROP" - word DROP2 - byte 5, "3DROP" - word DROP3 - byte 3, "NIP" - word NIP - byte 5, "2SWAP" - word DSWAP - byte 4, "2DUP" - word DUP2 - byte 4, "?DUP" - word QDUP - -' BITWISE LOGIC - byte 3, "AND" - word _AND - byte 4, "ANDN" - word _ANDN - byte 2, "OR" - word _OR - byte 3, "XOR" - word _XOR - byte 3, "NOT" - word _NOT - -' SHIFT' - byte 3, "ROL" - word _ROL - byte 3, "ROR" - word _ROR - - byte 4, "ROR?" - word _RORQ -'' byte 4, "WRCH" -'' word WRCH - - - byte 2, ">>" - word _SHR - byte 2, "<<" - word _SHL - byte 3, "SAR" - word _SAR - byte 2, "2/" - word _SHR1 - byte 2, "2*" - word _SHL1 - byte 2, "4/" - word _SHR2 - byte 2, "4*" - word _SHL2 - - byte 4, "16<<" - word _SHL16 - byte 3, "8<<" - word _SHL8 - byte 3, "9<<" - word _SHL9 - byte 4, "16>>" - word _SHR16 - byte 3, "8>>" - word _SHR8 - byte 3, "9>>" - word _SHR9 - - byte 3, "REV" - word _REV - byte 4, "CREV" - word _REVB - byte 7, "MOVBYTS" - word _MOVBYTS - - byte 2, "|<" - word MASK - byte 2, ">|" - word ENCODE - - byte 5, "BMASK" - word _BMASK - - byte 2, "1&" - word _AND1 - byte 2, ">N" - word BITS4 - byte 2, ">B" - word BITS8 - byte 2, ">9" - word BITS9 - byte 2, ">W" - word TOW - byte 4, "BITS" - word BITS - byte 4, "SIGN" - word TOSIGN - byte 7, "HUBEXEC" - word HUBEXEC1 - -' COMPARISON - byte 1, "=" - word _EQ - byte 2, "<>" - word _NEQ - - byte 2, "0=" - word _ZEQ - byte 3, "0<>" - word _ZNE - byte 2, "0<" - word _ZLT - byte 1, "<" - word LT - byte 2, "U<" - word _ULT - byte 1, ">" - word GT - byte 2, "U>" - word UGT - byte 2, "<=" - word LTEQ - byte 2, "=>" - word EQGT - byte 6, "WITHIN" - word WITHIN - - byte 5, "DUPC@" - word DUPCFT - - byte 2, "C@" - word CFETCH - byte 2, "W@" - word WFETCH - byte 1, "@" - word FETCH - byte 3, "C+!" - word CPLUSST - byte 2, "C!" - word CSTORE - byte 4, "C@++" - word CFETCHINC - byte 3, "W+!" - word WPLUSST - byte 2, "W!" - word WSTORE - byte 2, "+!" - word PLUSST - byte 1, "!" - word STORE - byte 2, "M!" - word MSTORE - - byte 2, "D@" - word FETCH2 - byte 2, "D!" - word STORE2 - byte 6, "DWIDTH" - word DWIDTH - - byte 4, "BIT!" - word BITST - byte 3, "SET" - word SET - byte 3, "CLR" - word CLR - byte 4, "SET?" - word BITQ - -' MATHS - byte 2, "1+" - word INC - byte 2, "1-" - word DEC - byte 2, "2+" - word INC2 - byte 2, "2-" - word DEC2 - byte 2, "4+" - word INC4 - byte 1, "+" - word PLUS - byte 1, "-" - word MINUS - byte 3, "b++" - word bINC - byte 3, "UM*" - word UMMUL - byte 1, "*" - word MULTIPLY - byte 2, "W*" - word MUL16 - byte 3, "LW*" - word LWMUL - byte 3, "DM*" - word DMMUL - - - byte 1, "/" - word DIVIDE - byte 2, "U/" - word UDIVIDE - byte 3, "U//" - word UDIVMOD - byte 3, "UM/" - word UMDIV - byte 2, "//" - word UMOD - byte 2, "*/" - word MULDIV - byte 3, "U*/" - word UMULDIV - byte 4, "UM//" - word UMDIVMOD64 - byte 7, "QROTATE" - word ROTATE - byte 7, "QVECTOR" - word VECTOR - byte 3, "LOG" - word LOG - byte 3, "EXP" - word EXP - byte 5, "GETQY" - word _GETQY - byte 5, "QFRAC" - word _QFRAC - - - byte 3, "C++" - word CINC - byte 3, "C--" - word CDEC - byte 3, "W++" - word WINC - byte 3, "W--" - word WDEC - byte 2, "++" - word LINC - byte 2, "--" - word LDEC - - byte 3, "RND" - word _RND - byte 6, "GETRND" - word _GETRND - byte 4, "SQRT" - word _SQRT - byte 7, "SETDACS" - word _SETDACS - - byte 1, "~" - word CLRL - byte 2, "~~" - word SETL - byte 2, "W~" - word CLRW - byte 3, "W~~" - word SETW - byte 2, "C~" - word CLRC - byte 3, "C~~" - word SETC - - byte 3, "L>S" - word L2S - byte 3, "L>W" - word L2W - byte 3, "W>B" - word W2B - byte 3, "W>L" - word W2L - byte 3, "B>W" - word B2W - byte 3, "B>L" - word B2L -'' byte 5, "SIGNW" -'' word SIGNW - - byte 4, "MINS" - word _MINS - byte 4, "MAXS" - word _MAXS - byte 3, "MIN" - word _MIN - byte 3, "MAX" - word _MAX - - byte 3, "ABS" - word _ABS - - byte 7, "-NEGATE" - word MNEGATE - byte 7, "?NEGATE" - word QNEGATE - byte 6, "NEGATE" - word NEGATE - - -' CONSTANTS ' - byte 2, "-1" - word MINUS1 - byte 2, "ON" - word MINUS1 - byte 4, "TRUE" - word MINUS1 - - byte 5, "FALSE" - word _0 - byte 3, "OFF" - word _0 - - - -' STRUCTURES - byte 4+im, "GOTO" - word GOTO - byte 2+im, "IF" - word _IF_ - byte 4+im, "ELSE" - word _ELSE_ - byte 4+im, "THEN" - word _THEN_ - 'byte 5, "ENDIF" +im - 'word _THEN_ - byte 5+im, "BEGIN" - word _BEGIN_ - byte 5+im, "UNTIL" - word _UNTIL_ - byte 5+im, "AGAIN" - word _AGAIN_ - byte 5+im, "WHILE" - word _IF_ - byte 6+im, "REPEAT" - word _REPEAT_ - - byte 6, "SWITCH" - word _SWITCH - byte 5, "CASE@" - word SWFETCH - -'' byte 5, "CASE=" -'' word ISEQ -'' - byte 6+im, "" - word INCASE - byte 5+im, "BREAK" - word ISEND - byte 4+im, "CASE" - word _CASE - -' LOOPS' - byte 3, "ADO" - word ADO - byte 2, "DO" - word DO - byte 4, "LOOP" - word LOOP - byte 5, "+LOOP" - word PLOOP - byte 6, "UNLOOP" - word UNLOOP - - byte 3, "FOR" - word FOR - byte 4, "NEXT" - word forNEXT - byte 5, "?NEXT" - word QNEXT - byte 1, "I" - word IX - byte 1, "J" - word J - byte 5, "LEAVE" - word LEAVE - byte 6, "?LEAVE" - word QLEAVE - byte 3, "IC@" - word ICFETCH - byte 2, "I+" - word IPLUS - byte 6, "BOUNDS" - word BOUNDS - - -' -------------I/O--------------- - - byte 1, "H" - word H - byte 1, "L" - word L - byte 1, "T" - word _T - byte 1, "F" - word F - byte 1, "R" - word R - byte 4, "HIGH" - word HIGH - byte 3, "LOW" - word LOW - byte 5, "FLOAT" - word _FLOAT -{ - byte 6, "MSBOUT" - word MSBOUT - byte 6, "LSBOUT" - word LSBOUT - byte 5, "MSBIN" - word MSBIN -} - byte 5, "RCLIO" - word RCLIO - byte 4, "PIN!" - word PINST - byte 4, "PIN@" - word PINTEST - - byte 4, "WSTX" - word WSTX - -' SMARTPIN INSTRUCTIONS - byte 5, "WRPIN" - word _WRPIN - byte 5, "WXPIN" - word _WXPIN - byte 5, "WYPIN" - word _WYPIN - - byte 5, "RDPIN" - word _RDPIN - byte 5, "RQPIN" - word _RQPIN - byte 5, "AKPIN" - word _AKPIN - byte 6, "RDPINC" - word _RDPINC - - byte 7, "WAITPIN" - word WAITPIN - - byte 5, "WRACK" - word WRACK - - - - byte 3, "PIN" - word _PIN - byte 4, "@PIN" - word _ATPIN - - byte 5, "WAITX" - word _WAITX - byte 6, "SETCT1" - word _SETCT1 - byte 7, "WAITCT1" - word _WAITCT1 - -{ - byte 6, "SETSE1" - word _SETSE1 - byte 6, "SETSE2" - word _SETSE2 - byte 6, "SETSE3" - word _SETSE3 - byte 6, "SETSE4" - word _SETSE4 - - byte 7, "WAITSE1" - word _WAITSE1 - byte 7, "WAITSE2" - word _WAITSE2 - byte 7, "WAITSE3" - word _WAITSE3 - byte 7, "WAITSE4" - word _WAITSE4 -} - - - byte 6, "REBOOT" - word REBOOT - byte 5, "RESET" - word RESET - byte 5, "0EXIT" - word ZEXIT - byte 4, "EXIT" - word EXIT - byte 5+im, "+EXIT" - word EXITS - byte 5+im, "EXIT;" - word HARDEXIT -'' byte 6, "SKIPNZ" -'' word SKIPNZ - - byte 3, "NOP" - word NOOP - byte 7, "EXECUTE" - word EXECUTE - byte 4, "CALL" - word ACALL - byte 4, "JUMP" - word AJMP - byte 6, "COGMOD" - word COGMOD - byte 7, "LOADMOD" - word LOADMOD - - byte 2, ">R" - word PUSHR - byte 2, "R>" - word RPOP - byte 2, ">L" - word PUSHL - byte 2, "L>" - word LPOP - byte 3, "!SP" - word INITSP - byte 5, "DEPTH" - word _DEPTH - - byte 3, "P2?" - word REVQ - - byte 4, "COG@" - word COGFETCH - byte 4, "COG!" - word COGSTORE - byte 4, "LUT@" - word LUTFETCH - byte 4, "LUT!" - word LUTSTORE - - byte 5, "COGID" - word _COGID - byte 7, "COGINIT" - word _COGINIT - byte 7, "COGSTOP" - word _COGSTOP - - byte 6, "NEWCOG" - word NEWCOG1 - - byte 6, "COGATN" - word _COGATN - byte 7, "POLLATN" - word _POLLATN - byte 6, "SETEDG" - word _SETEDG - byte 7, "POLLEDG" - word _POLLEDG - - - byte 03, "BMP" - word _BMP - byte 06, "CLKMHZ" - word CLKMHZ - byte 3, "KEY" - word KEY - byte 4, "WKEY" - word WKEY - byte 4, "KEY!" - word PUTKEY - byte 4, "KEY@" - word KEYFETCH - - byte 7, "keypoll" - word rg+keypoll - - byte 3, "CON" - word _CON - byte 4, "MOUT" - word MOUT - byte 4, "NONE" - word NONE - byte 3, "COM" - word _COM - byte 5, "CTRL!" - word CTLSTO - - - byte 7, "DISCARD" - word DISCARD - - byte 6, "CONKEY" - word CONKEY - byte 7, "CONEMIT" - word CONEMIT - byte 6, "SEROUT" - word SEROUT - byte 3, "MBX" - word MBX - byte 3, "MBO" - word MBO - - byte 5, ".EMIT" - word AEMIT - byte 4, "EMIT" - word EMIT - byte 5, "EMITS" - word EMITS - - byte 5, "EMIT!" - word EMITST - byte 5, "EMIT@" - word EMITFT - - byte 4, "CRLF" - word CRLF - byte 2, "CR" - word CR - byte 3, "CLS" - word CLS -{ - byte 3, "DOT" - word DOT -} - byte 5, "SPACE" - word SPACE - byte 6, "SPACES" - word SPACES - -' DUMP MEMORY - byte 3, "RAM" - word RAM - byte 5, "DUMP!" - word DUMPST - byte 4, "DUMP" - word DUMP - byte 5, "DUMPW" - word DUMPW - byte 5, "DUMPL" - word DUMPL - byte 5, "DUMPA" - word DUMPA - byte 6, "DUMPAW" - word DUMPAW - byte 2, "QD" - word QD - byte 2, "QW" - word QW - - byte 6, "?ERROR" - word QERROR - byte 7, "CONSOLE" - word CONSOLE - byte 6, "PROMPT" - word PROMPT - byte 3, "EOL" - word EOL - byte 5, "DEBUG" - word DEBUG_ - byte 4, "lsio" - word lsio - byte 5, "TRACE" - word TRACE - byte 7, "UNTRACE" - word UNTRACE - byte 3, "COG" - word _COG - byte 3, "LUT" - word _LUT - - byte 2, "KB" - word KB - byte 2, "MB" - word MB - byte 1, "M" - word M - - -' PRINTING - - byte 1, "." - word PRTSP - byte 5, "PRINT" - word PRT - - byte 3, ".AS" - word PRTAS - byte 4+im, ".AS",$22 - word PRTASR - - byte 5, ".DECL" - word PRTDECL - byte 5, ".DEC4" - word PRTDEC4 -'' byte 5, ".DEC2" -'' word PRTDEC2 - -'' byte c, "@PAD" -'' word ATPAD - byte 4, "HOLD" - word HOLD -'' byte 5, ">CHAR" -'' word BINASC - byte 2, "#>" - word RHASH - byte 2, "<#" - word LHASH - byte 1, "#" - word HASH - byte 2, "#S" - word HASHS - byte 3, "" - word DNUM - - byte 2, "U." - word UPRT - byte 4, ".DEC" - word PRTDEC - byte 4, ".BIN" - word PRTBIN - - byte 2, ".H" - word PRTHEX - byte 2, ".B" - word PRTB - byte 5, ".BYTE" - word PRTBYTE - byte 2, ".W" - word PRTW - byte 5, ".WORD" - word PRTWORD - byte 2, ".L" - word PRTL - byte 5, ".LONG" - word PRTLONG - - byte 5, ".ADDR" - word PRTADR - byte 5, ".ADRX" - word PRTADL - - - byte 6, "PRINT$" - word PRINTSTR - byte 4, "LEN$" - word STRLEN - - byte 6, "UPPER$" - word TOUPPER - - byte 1+im, $22 - word _STRING_ - byte 2+im, $2E,$22 - word _PSTR_ ' ." - byte 6+im, "PRINT",$22 - word _PSTR_ - byte 5, "CTYPE" - word CTYPE - - byte 6, "NUMBER" - word NUMBER - - - byte 5, "?EXIT" - word IFEXIT - - -' MEMORY BLOCKS -'' byte 5, "DATA?" -'' word DATAQ - byte 5, "ERASE" - word ERASE - byte 6, "LERASE" - word LERASE - byte 4, "FILL" - word CFILL - byte 5, "CMOVE" - word CMOVE - byte 6, "A" - word a2A - byte 6, ">UPPER" - word TOUPPER - - -' DICTIONARY - byte 1, "W" - word QWORDS - byte 5, "WORDS" - word WORDS - byte 6, "@WORDS" - word ATNAMES - byte 4, "GET$" - word _GETWORD - byte 6, "SEARCH" - word SEARCH - byte 5, "ufind" - word rg+ufind - byte 3, "$>#" - word NUMBER - - byte 7, "uprompt" - word rg+uprompt - byte 7, "uaccept" - word rg+uaccept - byte 4, "unum" - word rg+unum - - - -' VARIABLES - byte 5, "uemit" - word rg+uemit - byte 4, "ukey" - word rg+ukey -'' byte 4, "char" -'' word w+@lastkey - byte 5, "delim" - word rg+delim - byte 5, "names" - word rg+names - - byte 4, "TASK" - word TASK - byte 3, "REG" - word ATREG - byte 5, "@WORD" - word rg+wordbuf - byte 4, "SPIN" - word SPINNER - - -' | compile byte || compile word , compile long -' byte 1+im, "|" -' word CCOMP - byte 2+im, "||" - word WCOMP - byte 1+im, "," - word LCOMP - byte 3+im, "[W]" - word COMPW - byte 3+im, "[",$22,"]" - word COMPSTR - - byte 5, "NULL$" - word NULLSTR - byte 2, "$!" - word STRST - byte 2, "$=" - word STREQ -' byte 6, ">UPPER" -' word TOUPPER - - -' DEFINITIONS -' - - byte 5, "(ASM)" - word _ASM - byte 6, "(CODE)" - word _CODE -'' byte 7, "(FORTH)" -'' word _FORTH - - byte 5, "FIND$" - word FINDSTR - byte 6+im, "FORGET" - word FORGET - byte 7+im, "CREATE$" - word CREATEWORD - byte 7+im, "CREATE:" - word CREATE - byte 3+im, "VAR" - word _VAR - - byte 3+im, "pub" - word PUBDEF - byte 3+im, "pri" - word PRIDEF - byte 3+im, "pre" - word PREDEF - byte 6+im, "public" - word PUBLIC - byte 7+im, "private" - word PRIVATE - -{ - byte 6+im, "module" - word MODDEF -} - byte 1+im, ":" - word NEWDEF - byte 1+im, ";" - word ENDDEF - byte 1+im, "[" - word UNDEF - byte 1+im, "]" - word REDEF - byte 1+im, "'" - word ATICK - -'' byte 2+im, ":=" -'' word _CON9 - byte 2+im, ":=" - word _CONST - byte 3, ":=!" - word CONST - byte 5, "ALIGN" - word _ALIGN - - byte 6+im, "DATCON" - word _DATCON - - byte 5, "ALLOT" - word ALLOT - byte 4, "HERE" - word ATHERE - byte 5, "@HERE" - word rg+here - byte 6, "@CODES" - word ATCODES 'rg+codes - byte 6, "SETORG" - word SETORG - byte 5, "uhere" - word rg+here - byte 6, "uwords" - word rg+names - byte 5, "flags" - word rg+fflags - - - byte 6, "orglen" - word DATLEN - byte 4, "org@" - word ATDAT - byte 4, "!org" - word INITORG - byte 3, "org" - word DATORG - byte 5+im, "bytes" - word dbytes - byte 5+im, "words" - word _words - byte 5+im, "longs" - word dlongs - byte 4+im, "byte" - word dbyte - byte 4+im, "word" - word dword - byte 4+im, "long" - word dlong - byte 3+im, "res" - word dres - - byte 3+im, "[C]" - word COMPILES - byte 4+im, "GRAB" - word GRAB - byte 3, "[G]" - word GRAB - - -' FIELDS ( NAME-FIELD CODE-POINTER CODE-FIELD ) - byte 4+im, "NFA'" - word _NFATICK - byte 4, "NFA+" - word NFANFA - byte 3, "CPA" - word NFACPA - byte 3, "CFA" - word NFACFA - - -' COMMENTS - byte 1+im, "\" - word COMMENT - byte 3+im, "---" - word COMMENT - byte 1+im, "(" - word PAREN - byte 1+im, "{" - word BRACE - byte 1+im, "}" - word NOOP - -' CONDITIONAL COMPILATION ( conditionally ignore as comment ) - - byte 6+im, "IFNDEF" - word IFNDEF - byte 5+im, "IFDEF" - word IFDEF - - -'' byte 4, "IDLE" -'' word IDLE - - byte 4, ".VER" - word PRTVER - byte 5, "TAQOZ" - word _TAQOZ - byte 5, "MSAVE" - word MSAVE - byte 5, "MLOAD" - word MLOAD - byte 2, "FL" - word FL - - byte 4, "TERM" - word TERMINAL - byte 4+im, "AUTO" - word AUTORUN - - byte 5, "SPIRD" - word SPIRD - byte 5, "SPIRL" - word SPIRDL - byte 5, "SPIWR" - word SPIWR - byte 5, "SPIWB" - word SPIWR8 - byte 5, "SPICE" - word SPICE - byte 5, "SPIWC" - word SPIWRC - byte 5, "SPIWW" - word SPIWR16 - byte 5, "SPIWM" - word SPIWM - byte 5, "SPIWL" - word SPIWRL - byte 7, "SPIPINS" - word SPIPINS - byte 5, "SPIRX" - word SPIRX - byte 6, "SPITXE" - word SPITXE - byte 5, "SPITX" - word SPITX - byte 4, "CLKS" - word CLKS - - byte 5, "TXDAT" - word _TXDAT - - - byte 8, "I2C.STOP" - word I2CSTOP - byte 9, "I2C.START" - word I2CSTART - byte 11, "I2C.RESTART" - word I2CRESTART - byte 6, "I2C.WR" - word I2CWR - byte 6, "I2C.RD" - word I2CRD - -{ - byte 5, "CLKIN" - word CLKIN - byte 6, "CLKOUT" - word CLKOUT - byte 3, "CLK" - word CLOCK -} - -{ - byte 5, "WSLED" - word WSLED -} - byte 4, "WAIT" - word WAIT - - byte 6, "CLKDIV" - word CLKDIV - byte 6, "RCSLOW" - word RCSLOW_ - - - byte 6, "HUBSET" - word _HUBSET - byte 2, "WP" - word WP - byte 2, "WE" - word WE - - - byte 5, "CLKHZ" - word CLKHZ - - byte 5, "ERROR" - word ERROR - - byte 6, "SFPINS" - word SFPINS - byte 3, "SF?" - word SFSTAT - byte 4, "SFWE" - word SFWE - byte 5, "SFCMD" ' SFINS ' - word SFCMD - byte 4, "SFWD" - word SFWD - byte 5, "SFSID" - word SFSID - byte 5, "SFJID" - word SFJID - byte 5, "SFER4" - word SFER4 - byte 6, "SFER32" - word SFER32 - byte 6, "SFER64" - word SFER64 - byte 4, "SFER" - word SFERALL - byte 5, "SFERP" - word SFERPAGE - byte 5, "SFWRP" - word SFWRPAGE - - byte 4, "SFBU" - word BACKUP - byte 4, "SFRE" - word RESTORE - byte 5, "SFRDS" - word SFRDS - - byte 5, "SFWRS" - word SFWRS - byte 4, "SFC@" - word SFCFETCH - byte 4, "SFW@" - word SFWFETCH - byte 3, "SF@" - word SFFETCH - byte 2, "SF" - word SF - byte 3, ".SF" - word PRTSF - - byte 10, "*SPIFLASH*" - word NOOP - - byte 6, "outbox" - word w+outchar - byte 5, "inbox" - word w+keychar - - - byte 7, "BUFFERS" - word BUFFERS - byte 4, "@VGA" - word _VGA - - - byte 3, "END" - word _END - long 0 -enddict - alignl - - -{{ -+------------------------------------------------------------------------------------------------------------------------------+ -| TERMS OF USE: MIT License | -+------------------------------------------------------------------------------------------------------------------------------+ -|Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation | -|files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, | -|modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software| -|is furnished to do so, subject to the following conditions: | -| | -|The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.| -| | -|THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE | -|WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR | -|COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, | -|ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. | -+------------------------------------------------------------------------------------------------------------------------------+ -}} + 'HUBEXEC CODE AFTER WORDCODE ' + + + ' *** I2C SUPPORT *** ' + +CON +i2cack = 0 +i2cbusy = 1 + +DAT +I2CSTART +I2CRESTART + mov x,##$800 ' 1K5 PULLUP MODE + wrpin x,sdapin ' 1k5 PULLUP on SDA + wrpin x,sclpin ' 1k5 PULLUP on SCL + + decod r0,#22 +.l0 drvh sclpin ' scl should be floating, but checked it is available + testp sclpin wc + 'if_nc jmp #.l0 +if_nc djnz r0,#.l0 ' time out waiting for SCL to float (ok, delay depends on pin selected!!!??) + waitx i2cdly + drvh sdapin ' let sda float + waitx i2cdly + drvh sclpin ' set scl high + waitx i2cdly + drvl sdapin ' sda low = start + bith tflgs,#i2cbusy ' flag busy + waitx i2cdly + waitx i2cdly + drvl sclpin ' scl low ready + _ret_ waitx i2cdly ' hold off any data transmission immediately after start + + +I2CSTOP +' mov x,##$800 ' 1K5 PULLUP MODE +' wrpin x,sdapin ' 1k5 PULLUP on SDA +' wrpin x,sclpin ' 1k5 PULLUP on SCL + + decod r0,#22 + drvl sdapin +.l0 drvh sclpin + testp sclpin wc ' make sure it's not being stretched + 'if_nc jmp #.l0 + if_nc djnz r0,#.l0 + waitx i2cdly + drvh sclpin + 'flth sclpin + waitx i2cdly + drvh sdapin + 'flth sdapin + waitx i2cdly + _ret_ bitl tflgs,#i2cbusy + +{ +I2CSTOP +.l0 flth sclpin + testp sclpin wc ' make sure it's not being stretched + if_nc jmp #.l0 + flth sdapin ' should already be floated...' + waitx i2cdly ' wait for clock high for a period' + drvl sclpin ' SCL LOW' + waitx i2cdly + drvl sdapin ' SDA LOW ' + waitx i2cdly + flth sclpin ' now I2C preconditioned for stop bit' + waitx i2cdly + flth sdapin ' SDA LOW>HIGH WHILE SCL HIGH = STOP' + waitx i2cdly + _ret_ bitl tflgs,#i2cbusy +} +' clock pulse with setup and hold - also reads data wc ' +I2CCLOCK + decod r0,#18 + waitx i2cdly + drvh sclpin ' scl high for sharp pullup + 'flth sclpin ' then float to let the pullup work' +.l0 testp sclpin wc ' wait while scl is low' +' if_nc jmp #.l0 + if_nc djnz r0,#.l0 + waitx i2cdly + testp sdapin wc ' read SDA into wc' + waitx i2cdly + drvl sclpin + _ret_ waitx i2cdly + +I2CWR '( data -- ack ) + waitx i2cdly + shl a,#24 ' msb first' + mov r2,#8 +.l0 shl a,#1 wc + drvc sdapin ' drive low or high hard + ''if_c flth sdapin ' remove cmos pullup if high' + call #I2CCLOCK + djnz r2,#.l0 + drvh sdapin + call #I2CCLOCK + _ret_ muxc a,#$FF ' return with ack state as 0 or $FF' + +I2CRD ' ( ack -- data ) + drvh sdapin + waitx i2cdly ' 200528 + mov r2,#8 +.l0 call #I2CCLOCK + rcl a,#1 + djnz r2,#.l0 + testb a,#8 wc ' write out ack bit' + if_nc drvl sdapin ' only drive if low' + call #I2CCLOCK + drvh sdapin + drvh sclpin + _ret_ zerox a,#8 ' mask out ack from data' + +'#######################################################################' +' serial.p2a +'#######################################################################' + + +InitSerial drvh #tx_pin ' force high ' + wrpin #$7C,#tx_pin ' asynchronous transmit + wrpin #$3E,#rx_pin ' asynchronous receive +'SETBAUD ' calculate baud timing at runtime' + rdlong r0,#@_CPUHZ ' read from config table in low hub' + rdlong r1,#@_BAUD + qdiv r0,r1 ' cpuhz/baud' + getqx r0 + shl r0,#16 ' (cpuhz/baud)<<16' + add r0,#7 ' add 8 data bits + wxpin r0,#rx_pin ' write config baud ticks and 8 data + add r0,#morestops ' ADD 2 MORE STOP BITS FOR TX 191120 ' + wxpin r0,#tx_pin ' baud 8 data + wypin #$0D,#tx_pin ' kick off transmit empty flag' + + dirh #rx_pin ' enable smartpin mode' + rdpin rxdat,#rx_pin wc ' clear rx? + setint1 #0 ' disable int0' + mov rxwrC,#0 + mov rxrdC,#0 + bmask rxlong,#31 ' invalid codes' + + setse1 #%110<<6+rx_pin ' set se1 to trigger on rx char event????? + mov ijmp1,##@taqoz_rxisr ' set int1 jump vector to receive buffer + setint1 #4 ' Enable int0 to trigger on se1' + ret + +' +' ( SERIAL RECEIVE INTERRUPT SERVICE ROUTINE )' 47! +' +taqoz_rxisr + rdpin rxdat,#rx_pin ' recv byte (bits31:24) from rx pin + shr rxdat,#24 ' right justify' + shl rxlong,#8 ' maintain a 4 character deep sequence long' + or rxlong,rxdat ' update history word' + mov rxptr,rxwrC ' update write pointer' + add rxptr,##rxbuffers + wrbyte rxdat,rxptr ' write char to buffer' + incmod rxwrC,##rxsize-1 ' update write index' + cmp rxdat,#$1C wc ' don't check sequences if not a certain control + if_nc reti1 + '' + cmp rxlong,#0 wz + if_z jmp #RST + cmp rxdat,#$14 wc ' ignore control chars < $14 ' + if_c reti1 + cmp rxlong,##$14141414 wz ' check ^T^T^T^T for force TRACE sequence' + if_z call #TRACE + if_z reti1 + cmp rxlong,##$15151515 wz ' check ^U^U^U^U for force UNTRACE sequence' + if_z call #UNTRACE ' The TRACING locations has the default doNEXT instruction' + if_z reti1 + cmp rxlong,##$1B1B1B1B wz ' check esc esc esc esc sequence' +RST if_z coginit #0,#0 ' force reset ' + cmp rxlong,##$1A1A1A1A wz ' check for ^Z^Z^Z^Z sequence ' + if_z decod rxdat,#28 ' reboot via hub' + if_z hubset rxdat + reti1 + +' TAQOZ interface ' +' Read the next character from the serial rx buffer or return with null if empty +' Note: INTERNAL - called by CONKEY +READRX cmp rxrdC,rxwrC wz ' check head/tail + if_z jmp #PUSHACC ' return with null if empty' + mov r1,rxrdC ' save current read index ' + add r1,##rxbuffers ' index into the rx buffer' + rdbyte u,r1 ' read the data' + incmod rxrdC,##rxsize-1 ' and update read index with wrap' +rr1 jmp #PUSHACC + +{ *** P2 INTERRUPTS *** +When an interrupt event occurs, certain conditions must be met before the interrupt branch can happen: + +ALTxx / CRCNIB / SCA / SCAS / GETXACC / SETQ / SETQ2 / XORO32 / XBYTE must not be executing +AUGS must not be executing or waiting for a S/# instruction +AUGD must not be executing or waiting for a D/# instruction +REP must not be executing or active +STALLI must not be executing or active +The cog must not be stalled in any WAITx instruction +} +{ TESTING ISR OVERHEAD DURING IDLE AND DURING RX EVENTS +: Q 30,000,000 LAP FOR NEXT LAP .LAP ; +1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890 +} + + +'#######################################################################' +' threads.twc +'#######################################################################' + + orgh THREADS + + +{ *** OUTPUT OPERATIONS *** } + +SPACE word _BL + ' memory save?' +EMIT word _WORD,MOUTST+2,FETCH,w+20,BITS,_IF+07,DUP,MOUTST,_WORD,MOUTST+2,WINC,_0,MOUTST + word rg+uemit,QJMP,CONEMIT,EXIT +MOUTST word _LONG + long 0 + word CSTORE,EXIT +' MOUT ( addr -- ) Save output to memory address' +MOUT word _WORD,MOUTST+2,STORE,EXIT + +{ +'EMIT word rg+uemit,QJMP,CONEMIT,EXIT + 'word rg+uemit,WFETCH,QDUP,_IF+01,AJMP,CONEMIT,EXIT +} +' CON - select console output' +_CON word _0 +' EMIT! ( cfa -- ) Set the emit vector or 0 to fall through to CONEMIT +EMITST word rg+uemit,WSTORE,EXIT +EMITFT word rg+uemit,WFETCH,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 (1) +QEMIT word w+echoF,CHKFLG,SKIPNZ,EMIT+ex +DROPEX word DROP +NOOP word 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,EXIT + + +' ACCEPTED +OK word PRTSTR + byte " ok",0 +CRLF word CR +LF word w+$0A,EMIT,EXIT + +'' word rg+uemit,WFETCH,IFEXIT,_1,ms,EXIT + +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 MASK,rg+fflags,BITQ,EXIT +CLRFLG word MASK,rg+fflags,CLR,EXIT +SETFLG word MASK,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 + + +' U*/ ( u1 u2 div1 -- res ) +' CLKHZ 1.333333 1,000,000 LAP */ LAP .LAP 35.200us ok +' UMULDIV word ROT2,UMMUL,ROT,UMDIV,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 + + +FETCHX word FETCH,EXIT + + + + + +''''''''''''''''''' CONSTANTS ''''''''''''''''''''' + +W1000000 + word CONL + long 1000000 +W1000 word CONL + long 1000 + +CLKHZ word w+$14,FETCH,EXIT +CLKMHZ word CLKHZ,_LONG + long 1000000 + word UDIVIDE,EXIT + +_BMP word CONL + long bmporg + +' @VGA ( n -- addr )' return with VGA parameter table address +_VGA word _SHL2 + word _LONG + long @vgainit + word PLUS,EXIT + +BUFFERS word CONL + long SDBUFS ''$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 + + + + +'''' 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 byte +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 + +'ag1 word ATCODES,SWAP,MINUS,_SHR1,DEC1,_WORD,GOBACK,_OR,COMPW+ex + + +''' UNTIL ( flg -- ) +_UNTIL_ word UNMARK +unt00 word w+$BE,_EQ,_IF+(badthen-unt1)/2 +unt1 word ATCODES,SWAP,MINUS,_SHR1,INC + '' relative cond branch wordcode + 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/GO to be replacd later with a goto (addr+ex) + word _WORD,GO,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 - resolve IF and ELSE +_THEN_ word ATCODES,rg+athen,STORE + word UNMARK '( addr tag ) + ' + ' ( addr tag ) resolve structure branch + '' ELSE THEN ? + +' create a jump wordcode in ELSE to this position + word DUP,w+$1E,_EQ,_IF+05 + word DROP ' discard tag' + word ATCODES,INC,SWAP,WSTOREX+ex +{ +' create a relative jump (paging compatible)' + word DUP,w+$1E,_EQ,_IF+12 + word DROP,ATCODES,OVER,MINUS,_SHR1,DEC + word _WORD,GO,PLUS,SWAP,CSTORE,EXIT +} + '' IF THEN ? + word w+$1F,_EQ,_IF+07 + '' update an IF to branch to here + 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,EXIT ''+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" 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 + + +COMPA word DUP,_SHR16,QDUP,_IF+05,_WORD,PAGE0,SWAP,MINUS,COMPWX +COMPW +' ( wordcode -- ) append this wordcode to next free code location + append EXIT (without counting) +COMPWX word ATCODES,WALIGN,WSTORE + word _2,rg+codes,PLUSST +'' 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,FETCH,_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 ( -- ) --- executes preceding code to make it available for any immediate words following +GRAB word w+EXIT,COMPW ' append an EXIT + word ATHERE,DUP,rg+codes,STORE,ACALL ' execute and release preceding code in text line + word EXIT + + + + +' NFA' ( -- nfaptr ) +' COMPILE ( not used in this version ) +NFATICK + word _GETWORD,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' +' Traverse name field to point to CPA field +' CPA ( nfa -- cpa ) +NFACPA word CFETCHINC,QDUP,_IF+04,w+cntm,_AND,PLUS,EXIT,_1,PLUS,EXIT + +' ( nfa -- extflg ) Get ext flag as 0 or 1 +XNFAQ word CFETCH,_5,_SHR,_AND1,EXIT + +' NFA ( nfa -- nfa2 ) Traverse from NFA to next NFA but allow for extended CPA +NFANFA + word DUP,NFACPA,INC2 + ' add in extra byte if extended' + word SWAP,XNFAQ,PLUS,EXIT + + +' ( -- cfa ) Find the address of the following word - zero if not found or its CFA +TICK word NFATICK +' 200406 allows for larger CPA field using paged calls +' CFA ( nfa -- cfa )' +NFACFA word DUP,ZEXIT,DUP,NFACPA,SWAP,XNFAQ,_IF+04,FETCH,w+24,BITS,EXIT,WFETCH,EXIT + +' ' ( -- cfa, ) +ATICK word TICK,LITCOMP+ex + + +SUBNAMES ' ( bytes -- ) Allocate names memory that builds down + word NEGATE,rg+names,PLUSST,EXIT + +WALIGN word INC,_1,_ANDN,EXIT + +_ALIGNL word _4 +' ALIGN ( address align -- val00 ) +_ALIGN word DEC,SWAP,OVERPLUS,SWAP,_ANDN,EXIT + + +' HERE ( -- addr ) Address of next compilation location +ATHERE word rg+here,FETCH,EXIT +' ( -- atradr ) --- point to the attribute byte in the header of the latest name + +ATATR +' @WORDS ( -- addr ) Point to dictionary (grows down) +ATNAMES word rg+names,FETCH,EXIT + +' @CODES ( -- addr ) Point to code compilation memory +ATCODES word rg+codes,FETCH,EXIT + +' SETORG ( addr -- ) +SETORG word DUP,rg+here,STORE,rg+codes,STORE,EXIT + +' Set the CPA field of a new header prior to creating the name +SETCPA word ATCODES,ATNAMES,OVER,_SHR16 + word _IF+05,_3,MINUS,MSTORE,_3,SUBNAMES+ex + word DEC2,WSTORE,_2,SUBNAMES+ex + +' Set page attribute of the latest word if outside of page 0 +SETPAG word ATCODES,_SHR16,ZEXIT,w+$20,ATNAMES,SET,EXIT + + +' CREATEWORD - create a name in the dictionary using the next word encountered in the stream +'' cnt,name,atr,cpa +CREATEWORD + word _GETWORD ' ( str ) read the next word +' CREATE$ ( gstr -- ) (only works with GETWORD strings which are preceded by a count byte) +CREATESTR + ' skip empty string ' + word DUPCFT,SKIPNZ,DROPEX+ex + ' Start building header - setup CPA field right now ' + word SETCPA + ' 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,SUBNAMES + '' copy it across + word ATNAMES,SWAP,CMOVE,SETPAG + '' delineate start of dictionary (in case pointer is lost) + word _0,ATNAMES,_4,MINUS,STORE + word EXIT + +{ + '' check for dictionary full ( less than 64 bytes ) + word ATNAMES,ATHERE + word w+64,PLUS,LT,ZEXIT,PRTSTR + byte " Dictionary full! ",0 + word ERROR+ex +} + +' CREATE: - Create a name in the dictionary and compile 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,SETHDR,_0,COMPL+ex + +' #= +'_CON10 word GRAB,CREATEWORD,SETHDR,w+$1FF,_AND,_WORD,w,PLUS,ATNAMES,NFACPA,WSTOREX+ex + +' := +_CONST word GRAB,CREATEWORD,SETHDR,w+CONL +DCOMP word COMPW,COMPL,_0,ALLOT+ex + + + +' Identical to a constant except the call address is slightly different so a FORGET knows it can release the data area +_DATCON word GRAB,CREATEWORD,SETHDR + word w+DATCON,DCOMP+ex + +PRIVATE word w+priatr +DEFATR word rg+atrs,CSTORE,EXIT +PUBLIC word _0,DEFATR+ex + + +' GETATR ( -- code ) +GETATR word ATNAMES,_6,_SHR,EXIT + +' Create a new entry in the dictionary but also prevent any execution of code +' : + +NEWDEF word CREATEWORD +REDEF word w+defF,SETFLG+ex ' flag that we have entered a definition + + +PUBDEF word _0,SDEF+ex +'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+$C0,_ANDN,_OR,ATNAMES,CSTORE,EXIT + word _6,_SHL,w+$C0,ATNAMES,CLR,ATNAMES,SET,EXIT + +'' merge in extra attributes +SETHDR word rg+atrs,CFETCH,SETATR+ex + +' Update "here" pointer to point to current free position which "codes" pointer is now at +' + + +HARDEXIT word w+EXIT,COMPW,UNDEF+ex ' compile an EXIT + +ENDDEF + 'word w+EXIT,COMPW ' compile an EXIT + word EXITS +UNDEF word w+defF,CLRFLG,ALLOCATED+ex ' end definition and lock allocated bytes + +'' The ; and EXIT optimizer will only compile an EXIT if it cannot modify the last call to a jump' +EXITS word ATCODES,DEC2,WFETCH ' read last word compiled (could be end of a string too)' + word DUP,_WORD,THREADS,_WORD,$F800-1,WITHIN ' must be threaded code range (but could be a literal)' + word SWAP,_1,_AND,_ZEQ,_AND ' must not have b0 set either + word ATCODES,rg+athen,FETCH,_NEQ,_AND ' not on a THEN ; combo where athen = @CODES ' + word _IF+09,ATCODES,DEC2,DUP,WFETCH,_1,_OR,SWAP,WSTORE,EXIT + word w+EXIT,COMPW,EXIT + +{ + +pre EXITS + @CODES W@ 2- W@ $800 ' !SP WITHIN + IF @CODES W@ 2- DUP W@ 1 OR SWAP W! + ELSE ' EXIT [C] [W] + THEN + ; +} +' [C] force compilation of the next word +COMPILES + word w+compF,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 + +' ' +INCASE word _WORD,ISWITHIN,COMPW,_IF_+ex + +' SWITCH>< ( from to -- flg ).. +ISWITHIN + word SWFETCH,ROT2 +' ( 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 + + + +{ Table vectoring - +index a table of vectors and jump to that vector +A table limit is supplied as well as a default vector + + Usage: + VECTORS + ...... ) +Sample: + 4 LOOKUP BELL \ an index of 4 or more will default to BELL + INDEX0 INDEX1 INDEX2 INDEX3 \ 0 to 3 will execute corresponding vectors + +} +{ +' LOOKUP +' VECTORS ( index range -- ) +VECTORS + word OVER,GT,_ZEQ,_IF+02,DROP,MINUS1 ' limit index to range or -1 (.>0) +.L0 word INC,_SHL1,RPOP,PLUS,WFETCH,ACALL,EXIT + +} + + + + + +{ *** MOVES & FILLS *** } +' 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,PUSHR,B2W,RPOP +W2L word _SHL8 +B2W word _SHL8,ORX+ex + + +' CTYPE ( str cnt -- ) +CTYPE word ADO,IX,CFETCH,AEMIT,LOOP,EXIT +' CTYPE word ADO,IX,CFETCH,TOCHAR,EMIT,LOOP,EXIT + +{ +---------------------------------------------------------------- + Parallax P2 .:.:--TAQOZ--:.:. V1.2 'CHIP' 190104-2300 +---------------------------------------------------------------- +} +' .VER +PRTVER + word PRTSTR + '12345678901234567890123456789012345678901234567890123456789011' + byte " Parallax P2 *TAQOZ RELOADED sIDE* V",0 + word _WORD,@taqoz_version,FETCH + word PRTAST + byte "#~#.# '",0 + word _WORD,@taqoz_name,_4,CTYPE,w+"'",EMIT + word SPACE,_LONG + long $FC262 + word w+10,CTYPE + word SPACE,PRTCLK,SPACE + word _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.. + +200303 - added link control 00,80, +} +_WORDS word rg+delim+1,CFETCH,w+$0D,_NEQ,_IF+01,dwords+ex +' track maximum line width & clear words & word count +WORDS word rg+spincnt,CLRL +MWORDS + word ATNAMES,DUP,PRTADR + '' new line? +.l0 word rg+spincnt+1,CFETCH,w+$5A,GT,_IF+03,CRLF,rg+spincnt+1,CLRC + word rg+spincnt,CFETCH,_IF+05,rg+spincnt,DUP,CDEC,CFETCH,_IF+(.linked-.l3)/2 +.l3 word DUPCFT,_IF+(.linked-.l2)/2 +.l2 word rg+spincnt+2,WINC + '' get length and track line width + word DUPCFT,w+cntm,_AND,INC,rg+spincnt+1,CPLUSST + '' DISPLAY name + word DUP,CFETCHINC,w+cntm,_AND,CTYPE,SPACE,NFANFA,.l0+ex + '' check for link field +.linked '' dlink? add dlink offset to current ptr + word DUP,WFETCH,_WORD,$8000,_AND,_IF+05,DUP,INC2,WFETCH,PLUS,.l0+ex + word DROP,rg+spincnt+2,WFETCH,SPACE,PRTDEC+ex + +QWORDS word w+80,rg+spincnt,STORE,MWORDS+ex + + + +_datsav long 0 +_datorg long datram +_datptr long datram + +ORGPTR word _WORD,_datptr,EXIT +ATORG word _WORD,_datorg,EXIT +' orglen' +DATLEN word ATDAT,ATORG,FETCH,MINUS,EXIT +' org@ ' +ATDAT word ORGPTR,FETCHX+ex +' !org ' +INITORG word _WORD,_datsav,FETCH +' org ' +DATORG word QDUP,_IF+09 + word ATDAT,_WORD,_datsav,STORE ' backup org ' + word DUP,ATORG,STORE,ORGPTR,STORE + word EXIT + +' pub res ( bytes -- ) _datptr +! ; +dres word dres1,COMMENT+ex +dres1 word GRAB,_WORD,_datptr,PLUSST,EXIT + +' pre words [C] GRAB 2* [C] BYTES ; +' pre LONGS [C] GRAB 4* [C] BYTES ; +' pre BYTES ( bytes -- ) [C] GRAB DATPTR SWAP res [C] DATCON ; +dlongs word GRAB,_SHL1 +dwords word GRAB,_SHL1 +dbytes word GRAB,ATDAT,SWAP,dres1,_DATCON+ex +dbyte word _1,dbytes+ex +dword word _2,dbytes+ex +dlong word _4,dbytes+ex + + + + +'#######################################################################' +' debug.twc +'#######################################################################' + +{ 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 +{ +daoff long 0 +'' DUMP# ( virtual -- ) Use virtual address in dump listing rather than real address +DUMPO word _WORD,daoff,STORE,EXIT + +PRTADR word CRLF,w+"$",EMIT,PRTADL,PRTSTR + byte " .. ",0 + +} +PRTADR word CRLF,PRTADL +PRTCOL word w+":",EMIT,SPACE+ex + +PRTADL word DUP,w+20,_SHR + word _IF+01,PRTLONG+ex '' xxxx_xxxx: long format + word DUP,_SHR16,PRTHEX,PRTWORD+ex '' xxxxx: short format + + +'' *** MEMORY READ FUNCTIONS *** + +DCFETCH word rg+dmm,FETCH,QDUP,_IF+02,EXECUTE,EXIT +.L0 word CFETCH,EXIT +DWFETCH word rg+dmm+4,FETCH,QDUP,_IF+02,EXECUTE,EXIT +.L0 word WFETCH,EXIT +DFETCH word rg+dmm+8,FETCH,QDUP,_IF+02,EXECUTE,EXIT +.L0 word FETCHX+ex +{ +'' DMP: reads in memory functions to use (defaults to hubram) +SETDMP word RPOP,rg+dmm,_6,CMOVE,EXIT +} +' DUMP! ( 'C@ 'W@ '@ -- ) +DUMPST word rg+dmm+8,STORE,rg+dmm+4,STORE,rg+dmm,STORE,EXIT + +DUMP word rg+dmp,WFETCH,rg+dmp,CLRW,QDUP,SKIPZ,AJMP,DUMPB+ex + +DMPA word IX,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 +DMPASC word DUMPASC + word _16,PLOOP +RAM word rg+dmm,w+16,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 DMPASC+ex + +{ DUMP as LONGs } +DUMPL word ADO + word DMPA,ADO,IX,DFETCH,PRTLONG,DSPACE,_4,PLOOP + word DMPASC+ex + +{ DUMP as ASCII WIDE } +DUMPAW word w+128,DUMPS+ex +{ DUMP as ASCII } +DUMPA word w+64 +DUMPS word ROT2 + word ADO + word IX,PRTADR + word IX,OVER,ATYPE + word DUP,PLOOP,DROP + word RAM+ex +ATYPE word ADO,IX,DCFETCH,AEMIT,LOOP,EXIT + +' Dump the ASCII representation (or a dot) for 16 bytes' +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 + + +DBHD word CRLF,_4,SPACES+ex + +' Print the stack(s) and dump the registers - also called by hitting D during text input +DEBUG_ word rg+linenum,CLRW + word PRTSTKS + word DBHD,PRTSTR + byte "COG ",0 + word _0,w+$28,COGDUMP + word DBHD,PRTSTR + byte "REGS ",0 + word rg+temp,w+$100,DUMPW + word DBHD,PRTSTR + byte "CODE ",0 + word ATHERE,_32,MINUS,w+64,DUMPW + word DBHD,PRTSTR + byte "WORDS",0 + word ATNAMES,w+$40,DUMPB + word DBHD,PRTSTR + byte "I/O",0 + word lsio + word CRLF+ex + +{ +PRTP word PRTSTRN + byte $0D,"P:",0 + word EXIT +} +lsio word w+"P",PRTHD,w+64,_0,DO,IX,w+10,DIVIDE,PRINT,LOOP + word w+"P",PRTHD,w+64,_0,DO,IX,w+10,UMOD,PRINT,LOOP + ' SAVE DIR & OUT STATES ' + word w+OUTA,COGFETCH,w+OUTB,COGFETCH + word w+DIRA,COGFETCH,w+DIRB,COGFETCH + ' DISPLAY I/O STATE as l=low input, h=high input, L=low output, H=high output' + word w+"?",PRTHD,w+64,_0,DO + word IX,PINTEST,_AND1 + word IX,MASK,w+DIRA,IX,_5,_SHR,PLUS,COGFETCH,_AND,_IF+01,INC2 + word _WORD,lhstr,PLUS,CFETCH,EMIT,LOOP + ' FLOAT TEST ' + word w+"=",PRTHD,w+62,_0,DO + word IX,LOW,w+200,WAIT,IX,_FLOAT,w+200,WAIT,IX,PINTEST,_AND1,_SHL1 + word IX,HIGH,w+200,WAIT,IX,_FLOAT,w+200,WAIT,IX,PINTEST,_AND1,_OR + word _WORD,dustr,PLUS,CFETCH,EMIT,LOOP + word w+DIRB,COGSTORE,w+DIRA,COGSTORE + word w+OUTB,COGSTORE,w+OUTA,COGSTORE + word EXIT + +dustr byte "d~?u" +lhstr byte "lhLH" +{ +PRTHD word PRTSTRN + byte $0D,"=:",0 + word EXIT +} +PRTHD word CRLF,EMIT,w+":",EMIT,EXIT + + +ELAPSED +LAPCAL word LAPFETCH,LAP,LAP,LAPFETCH,MINUS,EXIT +{ +: .CLK + CLKHZ 1 M // 0= + IF CLKHZ 1 M U/ . ." MHz" ELSE CLKHZ .DECL ." Hz" THEN + ; + +: .LAP + LAP@ LAP LAP LAP@ - + ( cycles/clkhz ) + DUP .DECL ." cycles = " + 1,000,000 CLKHZ 1000 U/ */ ( scale cycles to nanoseconds ) + .DECL ." ns @" .CLK + ; +} +MILLION word CONL + long 1000000 + +PRTCLK word CLKHZ,DUP,MILLION,UMOD,_IF+05 + word PRTDECL,PRTSTR + byte "Hz ",0 + word EXIT + word MILLION,UDIVIDE,PRINT,PRTSTR + byte "MHz",0 + word EXIT + +PRTMS +PRTLAP word LAPCAL +PRTCYC word DUP,PRTDECL,PRTSTR + byte " cycles= ",0 + word MILLION,CLKHZ,w+1000,UDIVIDE,UMULDIV,PRTDECL,PRTSTR + byte "ns @",0,0 + word PRTCLK+ex + +PRTLAPS word LAPCAL,SWAP,UDIVIDE,PRTCYC + +{ +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 +} + +QSTACKS + word _DEPTH,w+32,GT,ZEXIT,INITSP,EXIT + +PRTSTK word PRTSTRN + byte " DATA STACK (",0 + word _DEPTH,DUP,PRINT1 + word ZEXIT + word _DEPTH,w+32,_MIN,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 PRTSTRN + 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 +{ +TRACE word _WORD,TRACER,FETCH,_WORD,doNEXT,COGSTORE,EXIT +UNTRACE word _WORD,TRACING,FETCH,_WORD,doNEXT,COGSTORE,EXIT +} + +'#######################################################################' +' print.twc +'#######################################################################' + +QCHAR word DUP,_BL,w+$7E,WITHIN+ex +TOCHAR word QCHAR,_ZEQ,_IF+02,DROP,w+$20,EXIT + +' @PAD ( -- addr ) pointer to current position in number pad +ATPAD word rg+padwr,CFETCH,rg+numpad,PLUS,EXIT + +' >CHAR ( val -- ch ) convert binary value to an ASCII character +BINASC word w+$3F,_AND,w+"0",PLUS,DUP,w+"9" ' convert to "0".."9" + word GT,_7,_AND,PLUS ' convert to "A".. + word DUP,w+$5D,GT,ZEXIT,_3,PLUS,EXIT ' skip symbols to go to "a".. + +' <# ' resets number pad write index to end of pad +LHASH word w+numpadsz,rg+padwr,CSTORE,_0 +''' +' HOLD ( char -- ) +HOLD word rg+padwr,CDEC,ATPAD,CSTOREX+ex + + +' # ( n1 -- n2 ) convert the next ls digit of a double to a char and prepend to number string +HASH word rg+double,FETCH,GETBASE,UMDIVMOD64,rg+double,STORE + word SWAP,BINASC,HOLD+ex + ' conversion digits exhausted, use zeros or spaces + +' #S ( d1 -- 0 ) Convert all digits +HASHS word HASH,DUP,_ZEQ,_UNTIL+04,EXIT + +' #> ( n1 -- caddr ) +RHASH word DROP,ATPAD,rg+double,CLRL,EXIT + +' ( d1 -- n1 ) ' Store high long of double for formating +DNUM word rg+double +STOREX word STORE,EXIT + + +PRTSP word PRT,SPACE+ex + +' . ( 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 GETCHR,QDUP,_IF+02,EMIT,PRINTSTR+ex +pstrxt word DROP,RAM+ex + +GETCHR word CFETCHINC + word DUP,w+"\",_EQ,ZEXIT + word DROP,CFETCHINC,_SWITCH + word w+"n",ISEQ,_IF+02,CRLF,GETCHR+ex ' n CRLF + word w+"t",ISEQ,_IF+02,w+9,EXIT ' t TAB + word w+"f",ISEQ,_IF+02,w+12,EXIT ' f FF CLS + word w+"r",ISEQ,_IF+02,w+13,EXIT ' r CR + word w+"[",ISEQ,_IF+04,w+$1B,EMIT,w+"[",EXIT ' [ ESC [ + word w+"e",ISEQ,_IF+02,w+$1B,EXIT ' e ESC + word w+$27,ISEQ,_IF+02,w+$22,EXIT ' ' " + word w+$20,ISEQ,_IF+03,w+8,SPACES,GETCHR+ex ' SP 8 SPACES + word w+"$",ISEQ,_IF+10,CFETCHINC,TOHEX,_4,_SHL ' $nn HEX value + word SWAP,CFETCHINC,TOHEX,ROT,_OR,EXIT + ' A..Z for 6 to 32 spaces + word SWFETCH,DUP,w+"A",w+"Z",WITHIN,ZEXIT ' A..Z 6 to 32 SPACES + word w+$41-6,MINUS,SPACES,GETCHR+ex + +TOHEX word w+"0",MINUS,DUP,w+9,GT,ZEXIT,w+7,MINUS,EXIT +' (PRINT") +PRTSTRN word CRLF +' Print inline string +PRTSTR word RPOP +ps1 word GETCHR,QDUP,_IF+02,EMIT,ps1+ex 'GOBACK+5 ''.lp+ex + word WALIGN,PUSHR,EXIT + +{ +\' – single quote, needed for character literals +\" – double quote, needed for string literals +\\ – backslash +\0 – Unicode character 0 +\a – Alert (character 7) +\b – Backspace (character 8) +\f – Form feed (character 12) +\n – New line (character 10) +\r – Carriage return (character 13) +\t – Horizontal tab (character 9) +\v – Vertical quote (character 11) +\uxxxx – Unicode escape sequence for character with hex value xxxx +\xn[n][n][n] – Unicode escape sequence for character with hex value nnnn (variable length version of \uxxxx) +\Uxxxxxxxx – Unicode escape sequence for character with hex value xxxxxxxx (for generating surrogates) + +} + +' 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 + + PFLG + +| 4 +\ 2 +~ 1 Suppress leading zeros + +TAQOZ# 12 .AS" 5|" 00012 ok +TAQOZ# 12 .AS" 5|\" 12 ok +} +' DZEQ word DUP2,_OR,_ZEQ,EXIT + +' process a single .AS char ( numl numh char ) +ASCHAR word _SWITCH,_4,rg+pflg,BITQ,_NOT,_4,rg+pflg,CLR,_IF+(ASCMD-.L3)/2 +.L3 word w+"|",ISEQ,_IF+04,_4 +SETP word rg+pflg,SET,EXIT + word w+"~",ISEQ,_IF+02,_1,SETP+ex + word w+"\",ISEQ,_IF+02,_2,SETP+ex + '' suppress leading zeros?' + word DZEQ,_1,rg+pflg,BITQ,_AND,IFEXIT + '' Convert a digit?' + word w+"#",ISEQ,_IF+(ASONE-.L0)/2 +.L0 '' null? spaces? ( numl numh ) ' +AHASH word DZEQ,_2,rg+pflg,BITQ,_AND,_IF+02,w+$20,HOLD+ex + '' extract lsd from double and convert and insert as ASCII + word rg+pbase,CFETCH,UMDIVMOD64,ROT,BINASC,HOLD+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,HOLD+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 +{ +pub .AS ( num format -- ) + 12 REG @ SWAP pflg C~ 10 pbase C! + <# DUP LEN$ 1- OVER+ FROM -1 BY LEN$ + FOR I C@ AS# NEXT DROP + #> PRINT$ + ; +} + '' find end of string and push next instruction onto return' +PRTAST word RPOP,DUP,STRLEN,INC2,_1,_ANDN,OVERPLUS,PUSHR + + 'word DROP,PRT+ex + + '' ( num fmtstr ) clear format and select decimal' +PRTAS word rg+pflg,CLRC,w+10,rg+pbase,CSTORE + '' ( numl fmtstr )' +'word rg+double,FETCH,SWAP + '' start conversion and point to end of fmtend to start from there back' + '' ( numl fmtstr fmtend )' + word LHASH,DUP,STRLEN,DEC,OVERPLUS + '' ( fmtend numl numh fmtstr )' + word ROT2,rg+double,FETCH,SWAP + '' step through ( fmtend numl numh ) ' + word STRLEN,FOR,THIRD,CFETCH,ASCHAR,ROT,DEC,ROT2,forNEXT + word DROP2,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 + +'#######################################################################' +' numbers.twc +'#######################################################################' + +{ *** 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 + +HEXa2A word rg+prefix,CFETCH,w+"$",_EQ,ZEXIT +' pub a>A ( ch -- ch ) DUP 'a' 'z' WITHIN IF $20 - THEN ; +a2A word DUP,w+"a",w+"z",WITHIN,ZEXIT,w+$20,MINUS,EXIT + +{ *** STRING TO NUMBER CONVERSION *** } + +' DECIMAL? '3 +DECQ word w+"0",w+"9",WITHIN+ex +' HEX? ' +HEXQ word HEXa2A,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 HEXa2A + 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 + +$FFFFFFFF +4294967295 + +DOUBLE NUMBERS - use a dot at end of number to signify double-precision (or >32bits) +$DEADBEEFBABECAFE. +18446744073709551615d. +} + +OVEQ word THIRD,_EQ,EXIT + +' ': DM* ( d. n -- d. ) -ROT SWAP 3RD UM* ROT 4TH * + ROT DROP ; +DMMUL word ROT2,SWAP,THIRD,UMMUL,ROT,FOURTH,MULTIPLY,PLUS,ROT,DROP,EXIT +FETCH2 word DUP,FETCH,SWAP,INC4,FETCH,EXIT +STORE2 word SWAP,OVER,INC4,STORE,STORE,EXIT + +DNUMQ word rg+suffix,CFETCH,w+".",_EQ,EXIT + +_NUMBER ' ( str -- value digits | false ) + word rg+4,CLRL ' REG0L = 0 + word w+signF,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+signF,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 + word w+"$",OVEQ,_IF+02,HEX,INC ' $nnnn - set hex base - flag true + 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 OVER,w+".",_EQ,_OR ' allow decimal point suffix (double) 190124' + 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 + '' shift double number up one digit and merge +nmok word rg+anumber,FETCH2,GETBASE,DMMUL ' shift anumber left one digit (base) + word ROT2,PLUS,SWAP,rg+anumber,STORE2 ' 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 and push number onto stack + 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+signF,CHKFLG,QNEGATE +'!!!! need to be able to negate double number !!!!' + word DNUMQ,_IF+04,rg+hnumber,FETCH,ROT,EXIT + word SWAP,EXIT ' all good, return with number and true + +' NUMBER processing -try to convert a string to a number +NUMBER ' ( str -- value digits | false ) + ' process control prefix i.e. ^A + word DUP,STRLEN,_2,_EQ + word OVER,CFETCH,w+"^",_EQ,_AND,_IF+06 ' ^ch Accept caret char as char + word INC,CFETCH,w+$1F,_AND,_1,EXIT ' control character processed - single digit + '' process character literal i.e. "A" +ch01 word DUP,STRLEN,_3,_EQ + word OVER,CFETCH,DUP,w+$22,_EQ,SWAP,w+$27,_EQ ' ASCII character literal "A" or 'A' + 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+(dpl-anumber+1),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 + +'#######################################################################' +' console.twc +'#######################################################################' + + +{ *** 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+79,EMITS +CLRWORD word rg+wordcnt,w+wordsz,ERASE,EXIT + +' PUTCH ( ch -- ) write a character into the next free position in the word buffer +PUTCHAR word rg+wordcnt,CFETCHINC,PLUS,CSTOREX+ex +' PUTCH+' ( ch -- ) PUTCH and advance +PUTCHARPL + word PUTCHAR,rg+wordcnt,DUPCFT,INC + word w+wordsz,UMOD,SWAP,CSTOREX+ex + +' HEXASC ( hex -- ascii )' +HEXASC word BITS4,w+$30,PLUS,DUP,w+$39,GT,w+7,_AND,PLUS,EXIT + +' Function keys execute immediately and search dictionary for matching :xx where xx = hex code' +' Define function for F12 -> pub :FC ; +FNCKEY + word w+":",PUTCHARPL + word DUP,_4,_SHR,HEXASC,PUTCHARPL + word HEXASC,PUTCHARPL,w+$0D +' +' As characters are accepted from the input stream, checks need to be made for delimiters, +doCHAR ' ( char -- flg ) Process char into wordbuf and flag true if all done +' editing commands etc. 123us/CHAR, 184us/CTRL +' ignore null + word DUP,ZEXIT +' Replace DEL with BS + word w+$7F,OVER,_EQ,_IF+02,DROP,_8 +' delimiter is always last character + word DUP,rg+delim+1,CSTORE +' check for 8-bit special characters as FNCKEYs ' + word DUP,w+$80,_AND,_IF+01,FNCKEY+ex +' only check for control characters + word DUP,w+$20,LT,_IF+01,CTLKEY+ex + ' PROCESS CHARACTER +CHARKEY + word w+echoF,CHKFLG,_ZEQ,_IF+02,DUP,EMIT ' don't echo if we don't want it + 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 ..... + word PUTCHARPL,FALX+ex ' put a character into the word buffer + + +' +' PROCESS CONTROL CHARACTERS +' + +BLKDMP word _0,DUP,w+$100,DUMPB,w+$100,PLUS,KEY,w+$1B,_EQ,_UNTIL+09,EXIT +RSTSTK word INITSP,_LONG + long $DEADBEEF + word _0,EXIT +ESCKEY word INC,SCRUB+ex +TABKEY word DROP,_9,EMIT,rg+wordcnt,CFETCH,EXIT +BACKSP word rg+wordcnt,CFETCH,ZEXIT ' don't backspace on empty word + word _8,EMIT,SPACE,_8,EMIT ' backspace and clear + word rg+wordcnt,CDEC,_0,PUTCHAR+ex ' null previous char +CARKEY word INC,EXIT +COLDKY word COLDST +RSTKEY word RESET,EXIT +CONSOL word _CON+ex +STKKEY word DROP,PRTSTK,CRLF,_0,EXIT +TRACEK word TRACE,EXIT +UNTKEY word UNTRACE,EXIT + +' CTRL! ( fnc key -- )' +CTLSTO word ATCTRL,WSTORE,EXIT +ATCTRL word w+$1F,_AND,_SHL1,_WORD,keytbl,PLUS,EXIT + +' lookup ctrls in table but precede with a false flag +' +CTLKEY word _0,SWAP,ATCTRL,WFETCH + word QDUP,ZEXIT,AJMP + +' CONTROL KEY LOOKUP TABLE +' @ A B C D E F G' +keytbl + word 000000,000000,BLKDMP,RSTKEY,000000,000000,000000,BELL +' H I J K L M N O' + word BACKSP,TABKEY,000000,COLDKY,CLS ,CARKEY,000000,000000 +' P Q R S T U V W' + word CONSOL,STKKEY,RESTORE,RSTSTK,TRACEK,UNTKEY,PRTVER,QWORDS +' X Y Z [ \ ] ^ _' + word CARKEY,WORDS, COLDKY,ESCKEY,CRLF ,000000,000000,DEBUG_ + + +' GET$ ( -- str )' +' Build a delimited word in wordbuf for wordcnt and return immediately upon a valid delimiter +_GETWORD ' ( -- str ) +' Erase the word buffer & preceding count + word CLRWORD +' get another character + word WKEY,doCHAR,_UNTIL+03 + word rg+wordbuf,EXIT + + +{ ****************** DICTIONARY SEARCH ********************** } + +' SEARCH ( str -- nfaptr ) ' cstr points to the count+strinw+null +SEARCH + word rg+ufind,QJMP ' use alternative method if enabled (hash search) + word ATNAMES,FINDSTR + word EXIT +{ +SEARCH + word rg+ufind,QJMP ' use alternative method if enabled (hash search) + word rg+context,FETCH,FINDSTR,QDUP,IFEXIT + word ATNAMES,FINDSTR + word EXIT +} +DROPFEX word DROP,FALX+ex ' can't backspace anymore, bell + +{ +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 ' clear this cog's task registers +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 (but not with P2) + word ATID,WFETCH ' fetch cog's task variable + word QDUP,_UNTIL+09 ' 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$ " + +PROSTR byte "TAQOZ",0,0,0,0,0,0,0,0,0,0,0 + +PROMPT + ' execute user prompt code + word rg+uprompt,WFETCH,QDUP,_IF+02,ACALL,EXIT 'trl1+ex + word rg+linenum,WFETCH,QDUP,_IF+05 + ' just display line and increment # + word CR,PRTDEC4,rg+linenum,WINC,SPACES3+ex + ' Prompt with version and base + word _WORD,PROSTR,PRINTSTR + ' prompt char = base %#$ etc + word GETBASE,_WORD,radix,PLUS,CFETCH,EMIT,SPACE+ex + +' COLD - Force defaults +COLDST +' initialize task registers +' free memory backup + word rg+0,w+$100,ERASE ' init task registers' + word _WORD,codeorg ' init code pointers' + word DUP,rg+here,STORE,rg+oldhere,STORE + word datcold,DATORG ' init data pointer' + word wordcold,rg+names,STORE ' init dictionary pointer' +' reset cold start +XCOLD word _CON,PRTSTR + byte "x",$0D,$0A," *Cold start* ",0 + word _WORD,$A55A,rg+cold,WSTOREX+ex + +' CONSTANTS' +wordcold + word CONL + long dictorg +datcold + word CONL + long extvars 'datram + +' read last 4 keys' +KEYFETCH + word w+rxlong,COGFETCH,EXIT + + + { *** MAIN TERMINAL CONSOLE *** } + + +TERMINAL +'' word w+"?",CONTXI + word InitRP,INITSP + word w+_OPTIONS+1,CFETCH,w+10,MUL16,ms +' word _WORD,bootms,ms + ' performing a check for a saved session + word rg+cold,WFETCH,_WORD,$A55A,_NEQ,SKIPZ,COLDST + word _CON + word rg+keypoll,CLRW,rg+uaccept,CLRW + word rg+linenum,CLRW +' word _1,rg+fflags,WSTORE +' word _GETRND,rg+bootsig,STORE + ' ^A abort autostart with ^A +'' word w+@lastkey,CFETCH,_1,_NEQ,_IF+11 + word KEYFETCH,BITS8,_1,_NEQ,_IF+11 + ' check for an AUTORUN + word rg+autovec,WFETCH,QDUP,_IF+02,ACALL,TRM1+ex + ' Show VERSION with optional CLS (default CR) + word CRLF,PRTDASH,CRLF,DECIMAL,PRTVER +TRM1 ' echo on & default delimiter + word w+echoF,CLRFLG,_BL,rg+delim,CSTORE + ' Stop compilation +CONSOLE word InitRP,SCRUB,CRLF,w+defF,CLRFLG + ' + ' **************************************************************** + ' *** Main console line loop - get a new line (word by word) *** + ' **************************************************************** + ' + ' reset temporary code compilation pointer & prompt +LINELP word ATHERE,rg+codes,STORE,PROMPT + ' Main console loop - read a word and process +WORDLP word QSTACKS + word _GETWORD,w+passF,CLRFLG +' 200525 make any word that ends in a _ into a comment that is ignored ' + word rg+wordcnt,DUP,CFETCH,PLUS,CFETCH,w+$5F,_EQ,_IF+02,DROP,chkeol+ex + + ' 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,SEARCH,QDUP,_IF+(TRYNUM-foundword)/2 + ' found the word in the dictionary - compile or execute? + + +foundword + ' point to attribute word (CNT,,ATR,CPA) + word DUP,NFACFA ' ( cpa cfa ) + ' is the immediate bit set? + word SWAP,CFETCH,_6,_SHR,w+preatr,_EQ + ' and not forced to [C] compile, then EXECUTE NOW! + word w+compF,CHKFLG,_ZEQ,_AND,_IF+02,EXECUTE,chkeol+ex + +compword + ' or else COMPILE the wordcode(s) for this word & reset + word COMPA,w+compF,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+uaccept,WFETCH,QDUP,_IF+02,ACALL,eol01+ex + word w+ackF,CHKFLG,SKIPNZ,ACK + ' Simple CRLF if in a definition or interactive? +eol01 word DUP,w+defF,CHKFLG,_AND,SKIPZ,CRLF + ' do not execute if still defining +eol02 word w+defF,CHKFLG,_ZEQ,_AND + ' wait until CR to execute compiled codes + word _UNTIL+(execs-WORDLP)/2 +execs ' EXECUTE CODE from user input (append an EXIT first) + word _WORD,EOL+ex,COMPW + word w+EXIT,COMPW + ' execute wordcodes from beginning +execinp word ATHERE,EXECUTE + ' skip OK response if in line mode + 'word rg+linenum,WFETCH,SKIPNZ,OK,LINELP+ex + word w+okF,CHKFLG,SKIPNZ,OK,LINELP+ex + +' user or deferred code +EOL word _NOP,_NOP,_NOP,_NOP + word w+_NOP,_WORD,EOL,WSTORE,EXIT + + +ACK word PRTSTR + byte " --- ",0 + word EXIT +'ACCSTR byte " --- ",0,0,0 + + ' **************************************************************** + + +TRYNUM ' Attempt to process this word as a number but check for special literals first (^ ' etc) + word rg+wordbuf,NUMBER,_IF+06 + ' is it a number? ( value digits ) +compnum ' COMPILE THE NUMBER + word DNUMQ,_IF+02,SWAP,LITCOMP, LITCOMP,chkeol+ex + + ' Unknown word or number - try converting case first time +UNKNOWN word w+passF,CHKFLG,_ZEQ + word _IF+05,w+passF,SETFLG + word rg+wordbuf,TOUPPER,trm4+ex + ' UNKNOWN - try unum vector if set - unum routine should return with true if successful or false if failed + word rg+unum,WFETCH,QDUP,_IF+03,ACALL,_IF+01,chkeol+ex +' +' Failed all searches and conversions!!!! +' + ' interactive or in the middle of a definition? + word w+defF,CHKFLG,_AND,_IF+(HUH-nfdef)/2 + ' Display position in line of error +nfdef word PRTSTR + byte 9,9," error in ",0 + '' display latest definition + word ATNAMES,CFETCHINC,w+cntm,_AND,CTYPE,PRTSTR + byte " at ",0 + ' Spit out offending word + word rg+wordbuf,PRINTSTR,SPACE + ' discard but echo remainder of line +.L0 word WKEY,DUP,_13,_NEQ,_IF+02,EMIT,.L0+ex,DROP + 'word DEBUG_ + + ' count errors and force a new line to display error +ERROR word rg+errors,WINC '',CR,w+$10A,EMIT +ERRSTR word PRTSTR + byte " *error* ",7,$0D,$0A,$0B,0 + ' + ' force a new line to prevent overwrite then return to console +ERROUT word w+$10A,EMIT,DISCARD,INITSP,_END,CONSOLE+ex + +'pri ?ERROR ( cond n -- ) IF .AS" ERROR# #~# " R> DROP CONSOLE EXIT THEN DROP ; +QERROR word SWAP,SKIPNZ,DROPEX+ex +ERRMSG word PRTSTR + byte " ERROR - ",0 + word PRINTSTR,ERROUT+ex + + ' as-you-go error prompt in interactive mode +HUH word PRTSTR + byte " ??? ",0 + 'word rg+linenum,WFETCH,_IF+03,CR,w+$10A,EMIT + word w+okF,CHKFLG,_IF+03,CR,w+$10A,EMIT + word WORDLP+ex + + word _COGID +MBXOUT word rg+outchar,CFETCH,_UNTIL+03,rg+outchar,CSTORE,EXIT +MBXKEY word + +' MBX use mailbox for console +MBX word _WORD,MBXOUT,rg+uemit,WSTORE,_WORD,MBXKEY,rg+ukey,WSTORE,EXIT + +' disable serial port ' +MBO word w+63,MUTE,w+62 +MUTE word _PIN,F,_0,_WRPIN,EXIT + + +' KEY! ( ch -- ) Force a character as the next KEY read +PUTKEY word rg+keychar,STOREX+ex + +SOFTKEY word rg+keychar,CFETCH,QDUP,ZEXIT ' read a "key" that was forced with KEY! + word RPOP,DROP + word rg+keychar+4,FETCH,DUP,_SHR8,rg+keychar+4,STORE + word w+24,_SHL + word rg+keychar,FETCH,_SHR8,_OR,rg+keychar,STORE + word EXIT + +USRKEY word rg+ukey,WFETCH,QDUP,ZEXIT + word RPOP,DROP + word ACALL,DUP,IFEXIT,DOPOLL+ex + + +QSEND word w+outchar,CFETCH,QDUP,ZEXIT,w+outchar,CLRC,CONEMIT,EXIT + +' KEY ( -- ch ) if ch is zero then no key was read +KEY word QSEND + word SOFTKEY,USRKEY +CONKEY word READRX +DOKEY word DUP,_IF+07,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 + +{ +long mrd +pub MKEY mrd @ C@ mrd ++ DUP 0= IF ukey W~ THEN ; +pub MSAVE + mrd ! + BEGIN + WKEY DUP mrd @ ! + $0D = IF CR mrd @ .L 8 SPACES mrd @ 4 - @ $44_4E_45_0D = ELSE 0 THEN + mrd ++ + UNTIL + ; +pub MLOAD mrd ! ' MKEY ukey W! ; +pub TAQOZ +--- receive source file following the TAQOZ directive directly into memory + $1.0000 MSAVE + $1.0000 MLOAD tAQOZ +} + +MKEY word rg+mrd,FETCH,CFETCH,rg+mrd,LINC,DUP,IFEXIT,rg+ukey,CLRW,EXIT + +' MSAVE ( dst -- ) +MSAVE word QDUP,ZEXIT,rg+mrd,STORE +.l0 word WKEY,DUP,rg+mrd,FETCH,STORE + word w+$0D,_EQ,_IF+(.l4-.l2)/2 +.l2 word 'CR '',rg+mrd,FETCH,PRTL,_8,SPACES + word rg+mrd,FETCH,_4,MINUS,FETCH,_LONG + long $44_4E_45_0A + word _LONG + long $44_4E_45_0D ' END (checked on trailing CR) + + word WITHIN,.l1+ex +.l4 word _0 +.l1 word rg+mrd,LINC,_UNTIL+(.l3-.l0)/2 +.l3 word EXIT + +' MLOAD ( src -- ) +MLOAD word QDUP,ZEXIT,rg+mrd,STORE,_WORD,MKEY,rg+ukey,WSTORE,EXIT + + +' ECHO ( on/off -- )' +'_ECHO word w+echof,MASK,rg+fflags,ROT,BITST,EXIT + +SKIPLF word DUP,w+$0A,_EQ,_IF+02,DROP,_13,CONEMIT,EXIT + +FL word _WORD,MBUF+2,STORE,EXIT + +MBUF word CONL + long $6_0000 + +' TAQOZ marks the start of a block of source code to be compiled in block mode +' +_TAQOZ + word MBUF,_IF+06 + word MBUF,MSAVE + word MBUF,MLOAD + word w+100,ms + + 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+oldhere,STORE + ' reset line# to 1 to active + word _1,rg+linenum,WSTORE,w+$0F,rg+fflags,CSTORE + word _WORD,SKIPLF,EMITST + ' backup dictionary pointer +' word ATNAMES,rg+oldnames,STORE + ' time the load + word _GETCNT,rg+spincnt,STOREX+ex + +' end of block load mode TAQOZ END +' + ' return to console +_END word rg+fflags,CLRC,_0,EMITST + ' 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+oldhere,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,CLKHZ,w+1000,UDIVIDE,UDIVIDE,PRTDECL,PRTSTR + byte "ms ",0 + word _2,CLRFLG+ex + + +'#######################################################################' +' flash.twc +'#######################################################################' + +'''''''''''''''''''''''''''''''''''''''''''''''''''' +' SERIAL FLASH +'''''''''''''''''''''''''''''''''''''''''''''''''''' +' TO DO - remove hard references to SPI Flash pins' +' sck mosi miso ss' + +' ADDRESS OF TAQOZ BACKUP/RESTORE IN FLASH' +BRORG word CONL + long flashpart +SFSIG word CONL + long flashsig + + + '' WRITE ENABLE +SFWE word SFBSY,w+6,SFCMD +SFCMD +_SFPINS word _LONG +_sfck byte spi_ck +_sfdi byte spi_di +_sfdo byte spi_do +_sfcs byte spi_cs + word SPIPINS,SPIWR8,EXIT + + '' Set which pins are used by Serial Flash ( &cs.so.si.ck -- ) +SFPINS word _WORD,_sfck,STOREX+ex + + +SFWD word _4,SFCMD+ex +' SF? ' +SFSTAT word _5 +SFRD1 word SFCMD,_0,SPIRD +SFEX word SPICE,EXIT + + + + '' ( Read serial Flash serial number ) +SFSID word w+$4B,SFCMD +SFRDD word _0,SPIRDL,SPIRDL +SFRDL word _0,SPIRDL,SFEX+ex + '' ( Read serial Flash Jedec ID ) +SFJID word w+$9F,SFCMD,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,SFEX+ex + + '' SFWRP SFWRPAGE ( src dst -- ) +SFWRPAGE word w+$02,SFWE,SPIWM,w+256,SPITX,SFEX+ex +'' SFERPAGE ( page pages -- ) +SFERPAGE + word ADO,IX,_16,_SHL,SFER64,w+200,ms,LOOP,EXIT + +'' pub BACKUP $0F.0000 SFER64 200 ms " TAQO" @ 4 ! 0 $0F.0000 $1.0000 SFWRS ; + + '' BACKUP the first 128K of memory into flash +BACKUP word SFJID,DUP,INC,_AND,ZEXIT 'EXIT IF BLANK ID' + word W+flashpage,_3,SFERPAGE + word _0,DEC2,DEC2 + word w+128,KB,OVER,STORE ' patch in size for flash loader at start of image + ' word _WORD,brstr,FETCH,STORE + word BRORG,w+128,KB +''SFWRS ( hubsrc sfdst cnt -- ) +SFWRS word ROT,SWAP,ADO,IX,OVER,SFWRPAGE,SPINNER,w+256,PLUS,w+256,PLOOP,DROPEX+ex + + '' SFRDW ( -- data16 ) +SFRDW word _0,SPIRD,_0,SPIRD,_SHL8,ORX+ex + + '' SFR ( addr -- ) +SFRD word _3,SFCMD,SPIWM,EXIT + +brstr byte "TAQO" + + '' RESTORE TAQOZ from FLASH by copying to $2.0000 first' +RESTORE word SFSIG,SFFETCH,_WORD,brstr,FETCH,_EQ,ZEXIT + word BRORG,_0,w+128,KB + '' ( sfadr dst cnt -- ) '' read block from SF to RAM +SFRDS word ROT,SFRD,SPIRX ',DROP '',SFEX+ex +SPIX word SPICE,EXIT + + '' SFC@ +SFCFETCH + word SFRD,_0,SPIRD,SFEX+ex + ''pub SFW@ +SFWFETCH + word SFRD,SFRDW,SFEX+ex + + ''pub SF@ ( addr -- long ) +SFFETCH word SFRD,SFRDW,SFRDW,_SHL16,_OR,SFEX+ex + + '' SF Select Serial Flash as memory for DUMP words +'SF word SETDMP,SFCFETCH,SFWFETCH,SFFETCH +SF word _WORD,SFCFETCH,_WORD,SFWFETCH,_WORD,SFFETCH,DUMPST+ex + + +{ + + +spi_cmd8 = $FC164 +spi_cmd = $FC168 +spi_in = $FC188 + +romi = $fc2b8 +romx = $fc2b8 +romy = $fc2b8 +romz = $fc2b8 + +SFBOOT ' Flash boot code to copy TAQOZ image @ $E0000 from Flash to RAM + loc PTRA,\#$E0000 + loc PTRB,\#0 + mov pa,#32 + mov pb,#$0E0000_03 + call #\spi_cmd + decod romy,#17 'ready to input 128kB from SPI + wrfast #0,#0 'ready to write bytes to hub +.data call #\spi_in 'get byte + wfbyte romx + djnz romy,#.data + drvh #spi_cs + jmp #\0 + + + +} + ' sdcard +codeorg + +'#######################################################################' +' dictionary.twc +'#######################################################################' + +'************************************************************************************ +'************************************** DICTIONARY ********************************** +'************************************************************************************ + +{ +The dictionary is comprised of contiguous headers separated from code memory +and can be placed anywhere convenient although the default in in the first 64k. +New header records are added to the start of the dictionary so that the previous +immediately follows etc right to the last valid entry terminated by a 00 00 +indicating a count of zero with a null terminator - the end of the dictionary + +0CBA9: MAIN !RXB .RXB ?? SYSINFO .DEVICES .USAGE .UBYTES SFBYTES lsi2c .I2C .ASBYTES .MODULES CRLF+ +?PINS ?PIN FCACHE SRRDS srinc .SR SRID SR! SRW! SRC! SRWRS SRWRP !SR SRRD SR SR@ SRW@ SRC@ +*SPIRAM* DECOMP SEENFA SEE SEECFA ?NAME .NAME ?THENS .SEE ?LOOPS ?DOS CASE? ?GOTO .LCON ?CRLF +fad? if? -if +if .LIT .W10 -ind +ind INDENT .STR .W: .ASC .D $ 'EMIT (DS) (LC) (.") (AS) (") +(S) (R) (IF) (L) (W) SEE@ @SEE @SEE+ @SEE++ eflg? dflg? wsrc 79 +@WORDS $40 DUMP --- +0CBA9: 04 4D 41 49 4E E0 5F 04 21 52 58 42 D6 5F 04 2E '.MAIN._.!RXB._..' +0CBB9: 52 58 42 CE 5F 02 3F 3F 48 5F 07 53 59 53 49 4E 'RXB._.??H_.SYSIN' +0CBC9: 46 4F 48 5F 08 2E 44 45 56 49 43 45 53 8A 5E 06 'FOH_..DEVICES.^.' +0CBD9: 2E 55 53 41 47 45 06 5E 47 2E 55 42 59 54 45 53 '.USAGE.^G.UBYTES' ok + +The first byte is the 5-bit name count plus the 3 attribute bits b7..b5 followed by +the name and then the 16-bit CFA (code field address) +The header record for MAIN is 04 4D 41 49 4E E0 5F +04 = 4 character name with no attributes +4D 41 49 3E = "MAIN" +E0 5F = $5FE0 = CODE ADDRESS + +The last entry: +------ ATR NAME CFA TERMINATOR +0EA43: 03 45 4E 44 BA 28 00 00 00 00 00 00 00 00 00 00 '.END.(..........' ok + +A special LINK header starts with 00 $80 followed by the link to the header to skip to +This is used mainly to hide sections of the dictionary which can be revealed by simply +overwriting the 00 80 with a valid dummy header such as 01 5F +200409 - Dlink only needs to have msb set of 2nd byte, so therefore could be: +00 80 or 01 DF = _ etc + + + +b7 b6 b5 b4 b3 b2 b1 b0 +-atr- ex ----charcount- +ate 00 = public +atr 01 = private +atr 10 = pre-emptive +atr 11 = cli +pg 0 = 16-bit CPA +pg 1 = 24-bit CPA +} +CON + cntm = $1F ' mask for nfa count byte to mask off atrs' + pg = 5 ' If set indicates that the CPA is 24-bits long + + + ' Dictionary header attribute flags + pubatr = 0 ' $00 normal public attribute + priatr = 1 ' $40 private - header can be reclaimed + preatr = 2 ' $80 preemptive - executes immediately + cliatr = 3 ' $C0 command line interactive but compiles in definition + +'' +'' attach these attributes to count bytes in dictionary i.e. byte 2+im,"IF" +'' + im = preatr<<6 'lexicon immediate bit + pr = priatr<<6 'private (flagged for removal from the dictionary) + cli = cliatr<<6 + + +DAT + +{ *** DICTIONARY *** } + + + orgh dictorg ' Manually optimized to set end of dictionary in memory ' + + '' ATR+CNT,NAME,CFA + byte 3, "DUP" + word DUP + byte 4, "OVER" + word OVER + byte 3, "3RD" + word THIRD + byte 3, "4TH" + word FOURTH + byte 5, "OVER+" + word OVERPLUS + byte 4, "SWAP" + word SWAP + byte 3, "ROT" + word ROT + byte 4, "-ROT" + word ROT2 + byte 4, "ROT4" + word ROT4 + byte 5, "-ROT4" + word RROT4 + byte 4, "DROP" + word DROP + byte 5, "2DROP" + word DROP2 + byte 5, "3DROP" + word DROP3 + byte 3, "NIP" + word NIP + byte 5, "2SWAP" + word DSWAP + byte 4, "2DUP" + word DUP2 + byte 4, "?DUP" + word QDUP + +' BITWISE LOGIC + byte 3, "AND" + word _AND + byte 4, "ANDN" + word _ANDN + byte 2, "OR" + word _OR + byte 3, "XOR" + word _XOR + byte 3, "NOT" + word _NOT + +' SHIFT' + byte 3, "ROL" + word _ROL + byte 3, "ROR" + word _ROR + + byte 4, "ROR?" + word _RORQ +'' byte 4, "WRCH" +'' word WRCH + + + byte 2, ">>" + word _SHR + byte 2, "<<" + word _SHL + byte 3, "SAR" + word _SAR + byte 2, "2/" + word _SHR1 + byte 2, "2*" + word _SHL1 + byte 2, "4/" + word _SHR2 + byte 2, "4*" + word _SHL2 + + byte 4, "16<<" + word _SHL16 + byte 3, "8<<" + word _SHL8 + byte 3, "9<<" + word _SHL9 + byte 4, "16>>" + word _SHR16 + byte 3, "8>>" + word _SHR8 + byte 3, "9>>" + word _SHR9 + + byte 3, "REV" + word _REV + byte 4, "CREV" + word _REVB + byte 7, "MOVBYTS" + word _MOVBYTS + + byte 2, "|<" + word MASK + byte 2, ">|" + word ENCODE + + byte 5, "BMASK" + word _BMASK + + byte 2, "1&" + word _AND1 + byte 2, ">N" + word BITS4 + byte 2, ">B" + word BITS8 + byte 2, ">9" + word BITS9 + byte 2, ">W" + word TOW + byte 4, "BITS" + word BITS + byte 4, "SIGN" + word TOSIGN + byte 7, "HUBEXEC" + word HUBEXEC1 + +' COMPARISON + byte 1, "=" + word _EQ + byte 2, "<>" + word _NEQ + + byte 2, "0=" + word _ZEQ + byte 3, "0<>" + word _ZNE + byte 2, "0<" + word _ZLT + byte 1, "<" + word LT + byte 2, "U<" + word _ULT + byte 1, ">" + word GT + byte 2, "U>" + word UGT + byte 2, "<=" + word LTEQ + byte 2, "=>" + word EQGT + byte 6, "WITHIN" + word WITHIN + + byte 5, "DUPC@" + word DUPCFT + + byte 2, "C@" + word CFETCH + byte 2, "W@" + word WFETCH + byte 1, "@" + word FETCH + byte 3, "C+!" + word CPLUSST + byte 2, "C!" + word CSTORE + byte 4, "C@++" + word CFETCHINC + byte 3, "W+!" + word WPLUSST + byte 2, "W!" + word WSTORE + byte 2, "+!" + word PLUSST + byte 1, "!" + word STORE + byte 2, "M!" + word MSTORE + + byte 2, "D@" + word FETCH2 + byte 2, "D!" + word STORE2 + byte 6, "DWIDTH" + word DWIDTH + + byte 4, "BIT!" + word BITST + byte 3, "SET" + word SET + byte 3, "CLR" + word CLR + byte 4, "SET?" + word BITQ + +' MATHS + byte 2, "1+" + word INC + byte 2, "1-" + word DEC + byte 2, "2+" + word INC2 + byte 2, "2-" + word DEC2 + byte 2, "4+" + word INC4 + byte 1, "+" + word PLUS + byte 1, "-" + word MINUS + byte 3, "b++" + word bINC + byte 3, "UM*" + word UMMUL + byte 1, "*" + word MULTIPLY + byte 2, "W*" + word MUL16 + byte 3, "LW*" + word LWMUL + byte 3, "DM*" + word DMMUL + + + byte 1, "/" + word DIVIDE + byte 2, "U/" + word UDIVIDE + byte 3, "U//" + word UDIVMOD + byte 3, "UM/" + word UMDIV + byte 2, "//" + word UMOD + byte 2, "*/" + word MULDIV + byte 3, "U*/" + word UMULDIV + byte 4, "UM//" + word UMDIVMOD64 + byte 7, "QROTATE" + word ROTATE + byte 7, "QVECTOR" + word VECTOR + byte 3, "LOG" + word LOG + byte 3, "EXP" + word EXP + byte 5, "GETQY" + word _GETQY + byte 5, "QFRAC" + word _QFRAC + + + byte 3, "C++" + word CINC + byte 3, "C--" + word CDEC + byte 3, "W++" + word WINC + byte 3, "W--" + word WDEC + byte 2, "++" + word LINC + byte 2, "--" + word LDEC + + byte 3, "RND" + word _RND + byte 6, "GETRND" + word _GETRND + byte 4, "SQRT" + word _SQRT + byte 7, "SETDACS" + word _SETDACS + + byte 1, "~" + word CLRL + byte 2, "~~" + word SETL + byte 2, "W~" + word CLRW + byte 3, "W~~" + word SETW + byte 2, "C~" + word CLRC + byte 3, "C~~" + word SETC + + byte 3, "L>S" + word L2S + byte 3, "L>W" + word L2W + byte 3, "W>B" + word W2B + byte 3, "W>L" + word W2L + byte 3, "B>W" + word B2W + byte 3, "B>L" + word B2L +'' byte 5, "SIGNW" +'' word SIGNW + + byte 4, "MINS" + word _MINS + byte 4, "MAXS" + word _MAXS + byte 3, "MIN" + word _MIN + byte 3, "MAX" + word _MAX + + byte 3, "ABS" + word _ABS + + byte 7, "-NEGATE" + word MNEGATE + byte 7, "?NEGATE" + word QNEGATE + byte 6, "NEGATE" + word NEGATE + + +' CONSTANTS ' + byte 2, "-1" + word MINUS1 + byte 2, "ON" + word MINUS1 + byte 4, "TRUE" + word MINUS1 + + byte 5, "FALSE" + word _0 + byte 3, "OFF" + word _0 + + + +' STRUCTURES + byte 4+im, "GOTO" + word GOTO + byte 2+im, "IF" + word _IF_ + byte 4+im, "ELSE" + word _ELSE_ + byte 4+im, "THEN" + word _THEN_ + 'byte 5, "ENDIF" +im + 'word _THEN_ + byte 5+im, "BEGIN" + word _BEGIN_ + byte 5+im, "UNTIL" + word _UNTIL_ + byte 5+im, "AGAIN" + word _AGAIN_ + byte 5+im, "WHILE" + word _IF_ + byte 6+im, "REPEAT" + word _REPEAT_ + + byte 6, "SWITCH" + word _SWITCH + byte 5, "CASE@" + word SWFETCH + +'' byte 5, "CASE=" +'' word ISEQ +'' + byte 6+im, "" + word INCASE + byte 5+im, "BREAK" + word ISEND + byte 4+im, "CASE" + word _CASE + +' LOOPS' + byte 3, "ADO" + word ADO + byte 2, "DO" + word DO + byte 4, "LOOP" + word LOOP + byte 5, "+LOOP" + word PLOOP + byte 6, "UNLOOP" + word UNLOOP + + byte 3, "FOR" + word FOR + byte 4, "NEXT" + word forNEXT + byte 5, "?NEXT" + word QNEXT + byte 1, "I" + word IX + byte 1, "J" + word J + byte 5, "LEAVE" + word LEAVE + byte 6, "?LEAVE" + word QLEAVE + byte 3, "IC@" + word ICFETCH + byte 2, "I+" + word IPLUS + byte 6, "BOUNDS" + word BOUNDS + + +' -------------I/O--------------- + + byte 1, "H" + word H + byte 1, "L" + word L + byte 1, "T" + word _T + byte 1, "F" + word F + byte 1, "R" + word R + byte 4, "HIGH" + word HIGH + byte 3, "LOW" + word LOW + byte 5, "FLOAT" + word _FLOAT +{ + byte 6, "MSBOUT" + word MSBOUT + byte 6, "LSBOUT" + word LSBOUT + byte 5, "MSBIN" + word MSBIN +} + byte 5, "RCLIO" + word RCLIO + byte 4, "PIN!" + word PINST + byte 4, "PIN@" + word PINTEST + + byte 4, "WSTX" + word WSTX + +' SMARTPIN INSTRUCTIONS + byte 5, "WRPIN" + word _WRPIN + byte 5, "WXPIN" + word _WXPIN + byte 5, "WYPIN" + word _WYPIN + + byte 5, "RDPIN" + word _RDPIN + byte 5, "RQPIN" + word _RQPIN + byte 5, "AKPIN" + word _AKPIN + byte 6, "RDPINC" + word _RDPINC + + byte 7, "WAITPIN" + word WAITPIN + + byte 5, "WRACK" + word WRACK + + + + byte 3, "PIN" + word _PIN + byte 4, "@PIN" + word _ATPIN + + byte 5, "WAITX" + word _WAITX + byte 6, "SETCT1" + word _SETCT1 + byte 7, "WAITCT1" + word _WAITCT1 + +{ + byte 6, "SETSE1" + word _SETSE1 + byte 6, "SETSE2" + word _SETSE2 + byte 6, "SETSE3" + word _SETSE3 + byte 6, "SETSE4" + word _SETSE4 + + byte 7, "WAITSE1" + word _WAITSE1 + byte 7, "WAITSE2" + word _WAITSE2 + byte 7, "WAITSE3" + word _WAITSE3 + byte 7, "WAITSE4" + word _WAITSE4 +} + + + byte 6, "REBOOT" + word REBOOT + byte 5, "RESET" + word RESET + byte 5, "0EXIT" + word ZEXIT + byte 4, "EXIT" + word EXIT + byte 5+im, "+EXIT" + word EXITS + byte 5+im, "EXIT;" + word HARDEXIT +'' byte 6, "SKIPNZ" +'' word SKIPNZ + + byte 3, "NOP" + word NOOP + byte 7, "EXECUTE" + word EXECUTE + byte 4, "CALL" + word ACALL + byte 4, "JUMP" + word AJMP + byte 6, "COGMOD" + word COGMOD + byte 7, "LOADMOD" + word LOADMOD + + byte 2, ">R" + word PUSHR + byte 2, "R>" + word RPOP + byte 2, ">L" + word PUSHL + byte 2, "L>" + word LPOP + byte 3, "!SP" + word INITSP + byte 5, "DEPTH" + word _DEPTH + + byte 3, "P2?" + word REVQ + + byte 4, "COG@" + word COGFETCH + byte 4, "COG!" + word COGSTORE + byte 4, "LUT@" + word LUTFETCH + byte 4, "LUT!" + word LUTSTORE + + byte 5, "COGID" + word _COGID + byte 7, "COGINIT" + word _COGINIT + byte 7, "COGSTOP" + word _COGSTOP + + byte 6, "NEWCOG" + word NEWCOG1 + + byte 6, "COGATN" + word _COGATN + byte 7, "POLLATN" + word _POLLATN + byte 6, "SETEDG" + word _SETEDG + byte 7, "POLLEDG" + word _POLLEDG + + + byte 03, "BMP" + word _BMP + byte 06, "CLKMHZ" + word CLKMHZ + byte 3, "KEY" + word KEY + byte 4, "WKEY" + word WKEY + byte 4, "KEY!" + word PUTKEY + byte 4, "KEY@" + word KEYFETCH + + byte 7, "keypoll" + word rg+keypoll + + byte 3, "CON" + word _CON + byte 4, "MOUT" + word MOUT + byte 4, "NONE" + word NONE + byte 3, "COM" + word _COM + byte 5, "CTRL!" + word CTLSTO + + + byte 7, "DISCARD" + word DISCARD + + byte 6, "CONKEY" + word CONKEY + byte 7, "CONEMIT" + word CONEMIT + byte 6, "SEROUT" + word SEROUT + byte 3, "MBX" + word MBX + byte 3, "MBO" + word MBO + + byte 5, ".EMIT" + word AEMIT + byte 4, "EMIT" + word EMIT + byte 5, "EMITS" + word EMITS + + byte 5, "EMIT!" + word EMITST + byte 5, "EMIT@" + word EMITFT + + byte 4, "CRLF" + word CRLF + byte 2, "CR" + word CR + byte 3, "CLS" + word CLS +{ + byte 3, "DOT" + word DOT +} + byte 5, "SPACE" + word SPACE + byte 6, "SPACES" + word SPACES + +' DUMP MEMORY + byte 3, "RAM" + word RAM + byte 5, "DUMP!" + word DUMPST + byte 4, "DUMP" + word DUMP + byte 5, "DUMPW" + word DUMPW + byte 5, "DUMPL" + word DUMPL + byte 5, "DUMPA" + word DUMPA + byte 6, "DUMPAW" + word DUMPAW + byte 2, "QD" + word QD + byte 2, "QW" + word QW + + byte 6, "?ERROR" + word QERROR + byte 7, "CONSOLE" + word CONSOLE + byte 6, "PROMPT" + word PROMPT + byte 3, "EOL" + word EOL + byte 5, "DEBUG" + word DEBUG_ + byte 4, "lsio" + word lsio + byte 5, "TRACE" + word TRACE + byte 7, "UNTRACE" + word UNTRACE + byte 3, "COG" + word _COG + byte 3, "LUT" + word _LUT + + byte 2, "KB" + word KB + byte 2, "MB" + word MB + byte 1, "M" + word M + + +' PRINTING + + byte 1, "." + word PRTSP + byte 5, "PRINT" + word PRT + + byte 3, ".AS" + word PRTAS + byte 4+im, ".AS",$22 + word PRTASR + + byte 5, ".DECL" + word PRTDECL + byte 5, ".DEC4" + word PRTDEC4 +'' byte 5, ".DEC2" +'' word PRTDEC2 + +'' byte c, "@PAD" +'' word ATPAD + byte 4, "HOLD" + word HOLD +'' byte 5, ">CHAR" +'' word BINASC + byte 2, "#>" + word RHASH + byte 2, "<#" + word LHASH + byte 1, "#" + word HASH + byte 2, "#S" + word HASHS + byte 3, "" + word DNUM + + byte 2, "U." + word UPRT + byte 4, ".DEC" + word PRTDEC + byte 4, ".BIN" + word PRTBIN + + byte 2, ".H" + word PRTHEX + byte 2, ".B" + word PRTB + byte 5, ".BYTE" + word PRTBYTE + byte 2, ".W" + word PRTW + byte 5, ".WORD" + word PRTWORD + byte 2, ".L" + word PRTL + byte 5, ".LONG" + word PRTLONG + + byte 5, ".ADDR" + word PRTADR + byte 5, ".ADRX" + word PRTADL + + + byte 6, "PRINT$" + word PRINTSTR + byte 4, "LEN$" + word STRLEN + + byte 6, "UPPER$" + word TOUPPER + + byte 1+im, $22 + word _STRING_ + byte 2+im, $2E,$22 + word _PSTR_ ' ." + byte 6+im, "PRINT",$22 + word _PSTR_ + byte 5, "CTYPE" + word CTYPE + + byte 6, "NUMBER" + word NUMBER + + + byte 5, "?EXIT" + word IFEXIT + + +' MEMORY BLOCKS +'' byte 5, "DATA?" +'' word DATAQ + byte 5, "ERASE" + word ERASE + byte 6, "LERASE" + word LERASE + byte 4, "FILL" + word CFILL + byte 5, "CMOVE" + word CMOVE + byte 6, "A" + word a2A + byte 6, ">UPPER" + word TOUPPER + + +' DICTIONARY + byte 1, "W" + word QWORDS + byte 5, "WORDS" + word WORDS + byte 6, "@WORDS" + word ATNAMES + byte 4, "GET$" + word _GETWORD + byte 6, "SEARCH" + word SEARCH + byte 5, "ufind" + word rg+ufind + byte 3, "$>#" + word NUMBER + + byte 7, "uprompt" + word rg+uprompt + byte 7, "uaccept" + word rg+uaccept + byte 4, "unum" + word rg+unum + + + +' VARIABLES + byte 5, "uemit" + word rg+uemit + byte 4, "ukey" + word rg+ukey +'' byte 4, "char" +'' word w+@lastkey + byte 5, "delim" + word rg+delim + byte 5, "names" + word rg+names + + byte 4, "TASK" + word TASK + byte 3, "REG" + word ATREG + byte 5, "@WORD" + word rg+wordbuf + byte 4, "SPIN" + word SPINNER + + +' | compile byte || compile word , compile long +' byte 1+im, "|" +' word CCOMP + byte 2+im, "||" + word WCOMP + byte 1+im, "," + word LCOMP + byte 3+im, "[W]" + word COMPW + byte 3+im, "[",$22,"]" + word COMPSTR + + byte 5, "NULL$" + word NULLSTR + byte 2, "$!" + word STRST + byte 2, "$=" + word STREQ +' byte 6, ">UPPER" +' word TOUPPER + + +' DEFINITIONS +' + + byte 5, "(ASM)" + word _ASM + byte 6, "(CODE)" + word _CODE +'' byte 7, "(FORTH)" +'' word _FORTH + + byte 5, "FIND$" + word FINDSTR + byte 6+im, "FORGET" + word FORGET + byte 7+im, "CREATE$" + word CREATEWORD + byte 7+im, "CREATE:" + word CREATE + byte 3+im, "VAR" + word _VAR + + byte 3+im, "pub" + word PUBDEF + byte 3+im, "pri" + word PRIDEF + byte 3+im, "pre" + word PREDEF + byte 6+im, "public" + word PUBLIC + byte 7+im, "private" + word PRIVATE + +{ + byte 6+im, "module" + word MODDEF +} + byte 1+im, ":" + word NEWDEF + byte 1+im, ";" + word ENDDEF + byte 1+im, "[" + word UNDEF + byte 1+im, "]" + word REDEF + byte 1+im, "'" + word ATICK + +'' byte 2+im, ":=" +'' word _CON9 + byte 2+im, ":=" + word _CONST + byte 3, ":=!" + word CONST + byte 5, "ALIGN" + word _ALIGN + + byte 6+im, "DATCON" + word _DATCON + + byte 5, "ALLOT" + word ALLOT + byte 4, "HERE" + word ATHERE + byte 5, "@HERE" + word rg+here + byte 6, "@CODES" + word ATCODES 'rg+codes + byte 6, "SETORG" + word SETORG + byte 5, "uhere" + word rg+here + byte 6, "uwords" + word rg+names + byte 5, "flags" + word rg+fflags + + + byte 6, "orglen" + word DATLEN + byte 4, "org@" + word ATDAT + byte 4, "!org" + word INITORG + byte 3, "org" + word DATORG + byte 5+im, "bytes" + word dbytes + byte 5+im, "words" + word _words + byte 5+im, "longs" + word dlongs + byte 4+im, "byte" + word dbyte + byte 4+im, "word" + word dword + byte 4+im, "long" + word dlong + byte 3+im, "res" + word dres + + byte 3+im, "[C]" + word COMPILES + byte 4+im, "GRAB" + word GRAB + byte 3, "[G]" + word GRAB + + +' FIELDS ( NAME-FIELD CODE-POINTER CODE-FIELD ) + byte 4+im, "NFA'" + word _NFATICK + byte 4, "NFA+" + word NFANFA + byte 3, "CPA" + word NFACPA + byte 3, "CFA" + word NFACFA + + +' COMMENTS + byte 1+im, "\" + word COMMENT + byte 3+im, "---" + word COMMENT + byte 1+im, "(" + word PAREN + byte 1+im, "{" + word BRACE + byte 1+im, "}" + word NOOP + +' CONDITIONAL COMPILATION ( conditionally ignore as comment ) + + byte 6+im, "IFNDEF" + word IFNDEF + byte 5+im, "IFDEF" + word IFDEF + + +'' byte 4, "IDLE" +'' word IDLE + + byte 4, ".VER" + word PRTVER + byte 5, "TAQOZ" + word _TAQOZ + byte 5, "MSAVE" + word MSAVE + byte 5, "MLOAD" + word MLOAD + byte 2, "FL" + word FL + + byte 4, "TERM" + word TERMINAL + byte 4+im, "AUTO" + word AUTORUN + + byte 5, "SPIRD" + word SPIRD + byte 5, "SPIRL" + word SPIRDL + byte 5, "SPIWR" + word SPIWR + byte 5, "SPIWB" + word SPIWR8 + byte 5, "SPICE" + word SPICE + byte 5, "SPIWC" + word SPIWRC + byte 5, "SPIWW" + word SPIWR16 + byte 5, "SPIWM" + word SPIWM + byte 5, "SPIWL" + word SPIWRL + byte 7, "SPIPINS" + word SPIPINS + byte 5, "SPIRX" + word SPIRX + byte 6, "SPITXE" + word SPITXE + byte 5, "SPITX" + word SPITX + byte 4, "CLKS" + word CLKS + + byte 5, "TXDAT" + word _TXDAT + + + byte 8, "I2C.STOP" + word I2CSTOP + byte 9, "I2C.START" + word I2CSTART + byte 11, "I2C.RESTART" + word I2CRESTART + byte 6, "I2C.WR" + word I2CWR + byte 6, "I2C.RD" + word I2CRD + +{ + byte 5, "CLKIN" + word CLKIN + byte 6, "CLKOUT" + word CLKOUT + byte 3, "CLK" + word CLOCK +} + +{ + byte 5, "WSLED" + word WSLED +} + byte 4, "WAIT" + word WAIT + + byte 6, "CLKDIV" + word CLKDIV + byte 6, "RCSLOW" + word RCSLOW_ + + + byte 6, "HUBSET" + word _HUBSET + byte 2, "WP" + word WP + byte 2, "WE" + word WE + + + byte 5, "CLKHZ" + word CLKHZ + + byte 5, "ERROR" + word ERROR + + byte 6, "SFPINS" + word SFPINS + byte 3, "SF?" + word SFSTAT + byte 4, "SFWE" + word SFWE + byte 5, "SFCMD" ' SFINS ' + word SFCMD + byte 4, "SFWD" + word SFWD + byte 5, "SFSID" + word SFSID + byte 5, "SFJID" + word SFJID + byte 5, "SFER4" + word SFER4 + byte 6, "SFER32" + word SFER32 + byte 6, "SFER64" + word SFER64 + byte 4, "SFER" + word SFERALL + byte 5, "SFERP" + word SFERPAGE + byte 5, "SFWRP" + word SFWRPAGE + + byte 4, "SFBU" + word BACKUP + byte 4, "SFRE" + word RESTORE + byte 5, "SFRDS" + word SFRDS + + byte 5, "SFWRS" + word SFWRS + byte 4, "SFC@" + word SFCFETCH + byte 4, "SFW@" + word SFWFETCH + byte 3, "SF@" + word SFFETCH + byte 2, "SF" + word SF + byte 3, ".SF" + word PRTSF + + byte 10, "*SPIFLASH*" + word NOOP + + byte 6, "outbox" + word w+outchar + byte 5, "inbox" + word w+keychar + + + byte 7, "BUFFERS" + word BUFFERS + byte 4, "@VGA" + word _VGA + + + byte 3, "END" + word _END + long 0 +enddict + alignl + + +{{ ++------------------------------------------------------------------------------------------------------------------------------+ +| TERMS OF USE: MIT License | ++------------------------------------------------------------------------------------------------------------------------------+ +|Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation | +|files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, | +|modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software| +|is furnished to do so, subject to the following conditions: | +| | +|The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.| +| | +|THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE | +|WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR | +|COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, | +|ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. | ++------------------------------------------------------------------------------------------------------------------------------+ +}} +