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 '#######################################################################' ' *** MEMORY MAP *** ' registers = $0200 'Variables used by kernel + general-purpose _hubcode = $0400 ' start of TAQOZ code' NOCODES = $2000 ' variables - code addresses here are decoded' THREADS = NOCODEs+$A00 dictorg = $1F280-$C0 ' dictionary can be moved elsewhere at runtime' cfgbackup = $1FF40 ' backup of page 0 config for $0C0 bytes' extvars = w ' EXTEND variables ' datram = $7E000 ' start of data memory (PERHAPS)- user variables ' rxbuffers = $7F500 ' SERIAL RX buffer rxsize = $0300 SDBUFS = $7F800 ' allocate 4 sector buffers' bmporg = $33100 '$32B00 ' start of bmp header, palette, and bitmap data ' ' ****** FLASH ******* flashpart = $10000 ' Area in serial Flash where an image of TAQOZ can be backed up to' flashpage = flashpart>>16 flashsig = flashpart+$1FFFC ' Offsets in LUT for stacks datstk = $000 ' 32 deep' lpstk = $020 ' 190705 combines loop and branch stack - always 3 longs for DO or FOR ' brastk = $030 retstk = $040 ' 64 deep' lutfree = $080 auxstk = $080 ' The LUT is essentially free from $80 onwards ' LMOVE buffer - no need to allocate more as there is not much speed increase' lmbuf = $180 lmsz = $200-lmbuf { ************* NEW ************* V2.5 ---------TAQOZ DATA-------- 00000-0007F CONFIG 00080-001FF SPARE (384) 00200-003FF REGISTERS (512) -----------ASSEMBLY------------------ 00400 COG IMAGES 00E34-017FF HUBEXEC (Forth and system) -------- CODED OPS ------------- ( 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) ( MEMORY USE 2k) 01800 EXTEND/TIA/TIM VARIABLES ------- THREADED CODE ------ 02000->>>>> THREADS <<<<<-1FF30 DICTIONARY 1FF40 CONFIG BACKUP (TAQOZ free to grow into page 1 or further) --------- SPARE------------- 20000-32AFF SPARE 77824 (Or TAQOZ or BMV BUFFER) --------- VIDEO --------- ( USAGE VARIES BUT STANDARD VGA SHOWN ) 33100-331FF BMP HEADER 33200-335FF PALETTE 33600-6BA00 SCREEN 360p --------USER DATA----------- 7E000 USER DATA --------BUFFERS------------- 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 '**************** configuration block **************** ' '' byte "P2 " ' 8 character ID' _OPTIONS byte %0000_0011 ' options SD,FLASH byte 100 ' boot ms/10' byte 0,0 ' *** CLOCK *** ' _XIN long XIN ' input freqency' _CPUHZ long CPUHZ ' final clock ' _CLKCFG long CLKCFG '$012C_B3FF $014CB3FC ' ' *** SERIAL/VGA/KEYBOARD *** ' _BAUDD 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 ' _VGASET long round(fset) _KBCFG long $3635 ' PS/2 CLK,DAT' 54,53 ' org $0080 ' *** RESET VECTORS *** ' _RESET long @RESET _IDLE long @IDLE _TERMINAL long @TERMINAL ' COG0 TASK' _COG1 long 0 ' COG1 TASK ( 0=none ) _COG2 long 0 _COG3 long 0 _COG4 long 0 _COG5 long 0 _COG6 long 0 _COG7 long 0 ' ****************** GLOBAL VARIABLES ******************' ' ' global variables located in first 1k of memory (10-bit literal)' ' ' org $00C0 ' mailboxes for all 8 cogs ' 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 { TAQOZ# 0 BEGIN 1+ AGAIN --- 08850 : 884F IF 4(00B7FAED 0000007E 0000007E 0000007E ) } TRACE rdlong doNext,##TRACER ' Replace 1st instruction of doNEXt with a call to TRACING' _ret_ mov traceL,#0 TRACER call #\TRACING UNTRACE _ret_ rdlong doNext,##TRACING ' reset doNext instruction back to normal ' TRACING rdword x,PTRA++ ' read word code instruction cmp PTRA,traceL wcz ' only list those above limit if_c_or_z ret call #DBIP ' PRINT IP ' cmp x,##threads wc if_nc andn x,#1 call #DBNAME ' PRINT NAME' DBPRTSTK mov hr0,ptrb wz ' PRINT STACK' sub hr0,#datstk wz if_z ret mov hr1,#32 ' ALIGN' call #DBTABS mov hr0,ptrb sub hr0,#datstk call #DBPRTH mov hr2,ptrb sub hr0,#datstk 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 CODE NAME - search the dictionary for a code match in the CPA field' ' 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 ' 00 00 = END of dictionary and hr0,#$1F ' use count to point to CPA' add hr0,hr2 add hr0,#1 ' hr0 points to CPA' ( cnt,,CPA[2] ) rdword xreg,hr0 ' read its CFA cmp xreg,x wz ' matched to CFA in x ?' if_z jmp #DBFOUND ' print it' mov hr2,hr0 add hr2,#2 ' point to next name' jmp #DBFLP DBWHAT ' couldn't find it in the dictionary cmp x,#_LONG wz ' 32-bit literal? if_z jmp #DBPRT32 cmp x,#_WORD wz ' 16-bit literal? if_z jmp #DBPRT16 cmp x,##w wc ' encoded 10-bit literal? if_c ret cmp x,##_IF wc ' An IF ? if_nc jmp #DBIF mov hr1,#3 ' 10-bit encoded literal 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 ' read next char call #DBTX ' output char _ret_ djnz hr1,#.L0 DBIF mov hr0,#"I" call #DBTX mov hr0,#"F" jmp #DBTX { 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 } ' Print IP address and wordcode DBIP call #DBCR mov xreg,PTRA ' print IP ' sub xreg,#2 ' compensate for ptra++' call #DBPRTA mov hr0,#":" call #DBTX call #DBSPACE mov xreg,X ' print wordcode in X ' call #DBPRTW jmp #DBINDENT ''''''''''''' DBSPACES call #DBSPACE _ret_ djnz hr1,#DBSPACES DBTABS cmp dbtab,hr1 wc if_nc ret call #DBSPACE jmp #DBTABS DBINDENT mov hr1,retptr sub hr1,#retstk fle hr1,#16 ' limit indent jmp #DBSPACES ' PRINT CRLF ' DBCR mov hr0,#$0D call #DBTX mov hr0,#$0A call #DBTX _ret_ mov dbtab,#0 ' PRINT HEX CHARACTER' DBPRTH add hr0,#$30 'convert bin to hex' cmp hr0,#$3A wc if_nc add hr0,#7 jmp #DBTX ' PRINT 5 DIGIT ADDRESS ' DBPRTA mov hr1,#5 shl xreg,#12 JMP #DBPRTD ' PRINT 16-bit WORD DBPRTW mov hr1,#4 shl xreg,#16 JMP #DBPRTD ' 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' ' 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 } { CAPTURE WORDCODE USAGE FROM 0000.$CFFF using 32-bit counters at $4.0000 } CON CAPBUF = $40000 CAPLEN = $D000*4 DAT ' TRACE RUNCAP _ret_ rdlong doNext,##RUNCAPS ' Replace 1st instruction of doNEXt with a call to RUNCAPS' ''' this instruction copied into doNext RUNCAPS call #\RUNCOUNT ''' UNCAP _ret_ rdlong doNext,##RUNCOUNT ' reset doNext instruction back to normal ''' runtime wordcode capture - use address to index into the capture counters RUNCOUNT rdword x,PTRA++ ' do what doNext would do - read a wordcode mov y,x ' use this to index into the counter shl y,#2 ' as a 32-bit long add y,##CAPBUF ' from the buffer start rdlong r2,y ' read the counter add r2,#1 ' increment that counter _ret_ wrlong r2,y ' update and contine '#######################################################################' ' 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 = NOCODES ' wordcode offset for 10-bit literals 0..1023 _IF = w+$400 ' IF relative forward branch 0 to 127 words _UNTIL = w+$480 ' UNTIL relative reverse branch 0 to 127 words _GO = w+$500 GOBACK = w+$580 _QIF = w+$600 rg = w+$800 ' task/cog register 8-bit offset 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] ' defs for TAQOZ ' '#######################################################################' ' version.p2a '#######################################################################' dat orgh taqoz_version custom byte $20 ' single character suffix for custom patches patch byte 0 minor byte 10 major byte 2 taqoz_time long 210812_1000 taqoz_name byte "CHIP" ' use exactly 4 characters = 1 long' { TO DO: Add delay option to TRACE or single step via another cog. CHANGE LOG 210812 Modify LOADMOD to load and run COGMOD Add 4DROP 210623 Removed depth processing from stack operations. Streamlined stack operations. 210617 Combined conditional and unconditional branch code (DROP does not affect x anymore) 210616 optimized stack yet again - separate DROP and use POPX 210615 2.9.3 Added TUCK, optimized stack words 210612 Added ?DUPE and ?IF 210610 2.9.2 Added DUPE word with tests in DROP and NIP 210609 2.9.1 Added cli mode Fixed LFILL (deleted hubexec code and added a modifier to CFILL) Modified 2:1 instructions such + to use a for the result and fast NIP. 210608 Incorporated a CARRY operation Modified instructions to wc via DROPWC Added UM/ 210603 Rearrange task REG variables to free up the first 32 as temps and locals and update EXTEND to calculate addres of unamed registers 210530 Add L@ and R@ stack words 210522 2.8.10 Added RUNCAP which counts each instruction used. 210521 2.8.9 Add LFILL 210520 2.8.8 Patch EMIT with 2 spare NOPS, second one for MOUT Limit indent of TRACE Fix bug in ??? response (was dropping one item) 210512 2.8.7 Patch ELSE to generate relative jumps 210511 2.8.6 Patch AGAIN and GOTO to account for paging 210510 2.8.5 Fix TRACE module to correctly handle bit 0 only with threaded code 210506 2.8.4 Force absolute addressing for kernel calls and jumps as P2ASM.FTH reads these 210503 2.8.3 Modify WSTX so that an address of 0 will clear the LEDs 210501 2.8.2 Change to sematic versioning use major.minor.patch numbering Allow for small negative values to be encoded as a short literal (negs constant) 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 '#######################################################################' 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 32 ' general purpose 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 ' print AS flags pbase res 1 ' print number base double res 4 ' hold high word of print double 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 number variables TO DPL are cleared as an array 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) ' dcnt res 1 spincnt res 2 ' Used by spinner to rotate busy symbol res 2 ' word count MWORDS mrd res 4 ' memory read' athen res 4 endreg res 0 tasks res 32 ' 2 longs/task * 8 cogs ' defs for TAQOZ variables ' '#######################################################################' ' kernel.p2a '#######################################################################' CON negs = 8 DAT '********************************************************************************************************* '************************************** TACHYON COG KERNEL *********************************************** '********************************************************************************************************* ' PTRA = Instruction Pointer' ' PTRB = Data stack LUT pointer ' org 0 RESET jmp #@InitTaqoz '********************************** data ************************************* ' 200401 - changed use and order of config registers ' ' ' *** COG TASK REGISTER POINTER *** ' @1 regptr long registers ' used by REG wordcode to 9-bit index into registers ' *** SPI PINS *** ' ' @2' sck long spi_ck ' P2 clock pin' mosi long spi_di ' P2 Data out pin' miso long spi_do ' P2 Data in pin' ss long spi_cs ' P2 Slave select pin' '6 clkdly long 0 ' SPI clock waitx delay sddly long 8 ' sd clock delay sdhl long $2_0004 ' *** I2C PINS *** sclpin long 56 sdapin long 57 i2cdly long 80 ' default 400kHz speed @200MHz hubexec (trim)' txpin long tx_pin pinreg long 0 ' PIN - access via PIN operation' u ACC long 0 ' accumulator register cleared to zero before instruction' xx x long 0 yy y R0 long 0 zz R1 long 0 R2 long 0 R3 long 0 R4 long 0 carry long 0 ' *** Stack pointers *** (DATA, RETURN, LOOP, AUX)' ' ptrb = datptr' auxptr long auxstk ' auxptr L stack lpptr long lpstk ' loop stack (index and limits)' retptr long retstk ' return stack pointer to LUT 'depth long 0 ' data stack depth' lap1 long 0 ' LAP timing registers' lap2 long 0 seed long 1 deltaR long 0 ' delay count (hubexec)' tflgs long 0 ' internal bit flags ' Serial RX isr variables ' rxlong long 0 ' last 4 characters for KEY@' rxwrC long 0 ' RX write index - updated by ISR' rxrdC long 0 ' RX read index - updated by READRX rxdat long 0 ' temp rx isr data' rxptr long 0 ' temp rx isr buffer ptr' ' *** COG STACKS *** ' ' top of data stack registers (init with some check values) a long $DEADBEE1 ' tos' b long $DEADBEE2 ' 2nd' c long $DEADBEE3 ' 3rd' d long $DEADBEE4 ' 4th' ' top of loop stack registers - looping using a fast loop address index long 0 ' loop index I ' limit long 0 ' limit of DO loop ' loopip long 0 ' branch back address' ' *** CONSTANTS *** ' M1 long -1 ' -1 or $FFFF_FFFF ' ' wordcode order: ASM,HUBEXEC,THREADED SHORT,IF/UNTIL,GO,REG ' constants used by doNEXT decode coded long w-1-negs ' all encoded instructions and data shorts long w+$400-1 '_IF-1 ifuntils long _IF+$100-1 '_GO-1 gotoes long _GO+$100-1 qifs long _QIF+$100-1 threaded long rg+$200 ' threaded code starts from here after tokens/variables '******************** MAIN KERNEL CODE *********************** ' ' ' main Forth wordcode interpreter - PTRA = Instruction Pointer ' ' ' $x000..$x3FF 10-bit encoded literal ' also $17F8..$17FF as -8 to -1 doSHORT signx x,#10 ' sign extend and push 10-bit literal doPUSHX call #\PUSHX skip #1 '***************************** MAIN WORDCODE EXECUTION LOOP *************************** ' { Cog and hubexec code sits below "threaded" and only have a 4 instruction overhead via doCALL Then codes below "coded" format wordcode as opposed to a call address are processed as threaded Otherwise coded wordcode will be decoded in order of: 10-bit short literal ; branching ; reg index 1234567.1234567.1234567.1234567.1234567.1234567.1234567.1234567.1234567.1234567.1234567.1234567.1234567.1234567. Minimum cycle time for simple _ret_ call is 25 cycles } ' ' cycles (19-26 for calls) doCALL call x ' x4 STEP 4: could call cog or hub code - use ret to return doNEXT rdword x,PTRA++ ' x9-16 STEP 1: read word code instruction doCODE cmpr x,coded wc ' x2 STEP 2: wordcode below threaded are cog or hubexex - just call if_nc jmp #\doCALL ' x4 STEP 3: just call if it is asm code - either cog or in hubexec range below wordcodes ' cmp x,threaded wc if_nc jmp #\ENTER ' x4 enter threaded code ' in between - must be coded ' cmpr x,shorts wc ' if less than shorts $1BFF then.. if_nc jmp #\doSHORT ' $X000+lit - short 10-bit literal cmpr x,ifuntils wc if_nc jmp #\doIFUNTIL ' $x4xx IF UNTIL conditional relative branch code cmpr x,gotoes wc if_nc jmp #\doGOTO ' $x5xx unconditional branches (esp in paged mem)' cmpr x,qifs wc if_nc jmp #\doQIF ' ' anything else is a register offset ' REG ( -- addr ) ' $x600..$x7FF - the 9-bit offset is relative to the regptr for that task doREG zerox x,#9-1 ' $1E00+reg use 9-bits as offset from regptr add x,regptr jmp #doPUSHX ' and push this address ' ?IF doQIF tjnz a,#doNEXT ' ?IF entry point and x,#$7F ' ' IF/WHILE/UNTIL $x400 ' $x4FF Conditional branch with 7-bit + sign word displacement doIFUNTIL mov y,a ' hold flag call #DROP ' drop flag tjnz y,#doNEXT ' continue w/o jumping ' take the jump - X has instruction wordcode ' Unconditional relative branch doGOTO test x,#$80 wz ' reverse jump? nz and x,#$7F ' mask displacement shl x,#1 ' index as words sumnz PTRA,x ' +/- jump jmp #doNEXT ' V2.4 200407 PAGING WORDCODES - Index easily calculated and compiled ' PAGE7 add acc,#1 ' These higher pages are probably unnecessary' PAGE6 add acc,#1 PAGE5 add acc,#1 PAGE4 add acc,#1 PAGE3 add acc,#1 PAGE2 add acc,#1 PAGE1 add acc,#1 PAGE0 rdword x,PTRA++ ' read ' setbyte x,acc,#2 ' set b16..b23 of address mov acc,#0 ' Call wordcode - Save IP and load with new IP from call : 31* ENTER test X,#1 wz ' bit0 is the jump/call bit (all wordcode is word aligned) andn X,#1 ' word align if_z wrlut PTRA,retptr ' save old IP onto return stack if b0 = 0 otherwise skip mov PTRA,X ' jump to new wordcode (PTRA = IP) if_z ijnz retptr,#doNEXT ' post increment ptr and jump straight to doNEXT jmp #\doNEXT ' otherwise this is not high level call '###################################################################################' { *** CONSTANTS & VARIABLES *** } { Constants and variables etc are standalone fragments preceded by an opcode then the parameters, either a long or the addess of the parameter field. They are called from the main program so that if the constant were changed it would be global } ' INLINE: ' Push the pointer to the inline varible and return AVAR mov X,PTRA ' return with the pointer to the variable call #\PUSHX jmp #\EXIT ' This entry is used for constants that point to the DATA area - FORGETable by signature ADATCON nop ACONL rdlong X,PTRA ' read 32-bit constant literal call #\PUSHX EXIT sub retptr,#1 ' 26* ' _ret_ rdlut PTRA,retptr ' 0EXIT ( flg -- ) Exit if flg is false (or zero) Used in place of IF......THEN EXIT as false would just end up exiting ZEXIT call #\POPX if_z jmp #\EXIT ret ' ?EXIT ( flg -- ) Exit if flg is true IFEXIT call #\POPX if_nz jmp #\EXIT _NOP ret ' execute assembly code following this ASM instruction as a call and EXIT' ' CODE: end ' _CODE call PTRA AEXIT jmp #\EXIT ' ' ASM: FORTH: ' _ASM jmp PTRA ' IP = PTRA which now points to assembly co de' ' interruptable count loop used for timing instructions ' ' INS ( cnt -- )' delay cnt*4 (+overhead) cycles INS djnz a,#INS jmp #\DROP ' timing utility word - used in pairs to capture timing - reported with .LAP LAP mov lap2,lap1 ' stack previous LAP count' _ret_ getct lap1 ' get current count' 'TAQOZ# " HELLO WORLD!" LAP COGMOD LAP .LAP --- 105 cycles= 525ns @200MHz o' ' LEN$ ( str -- len ) STRLEN rdfast #0,a mov a,#0 .L0 rfbyte x wcz ' read a byte if_nc_and_nz ijnz a,#.L0 ' continue while not 0 or not >$7F' ret DAT { *** STACK OPERATORS *** } { *** LITERALS *** } { Literals can be coded either as a 10-bit field of a short literal wordcode (inc extra -1 to -8) or as a _WORD wordcode followed by a 16-bit word or as a _LONG wordcode followed by a 32-bit long TAQOZ# LAP 12 LAP .LAP --- 49 cycles= 245ns @200MHz ok TAQOZ# LAP -3 LAP .LAP --- 49 cycles= 245ns @200MHz ok TAQOZ# LAP 1234 LAP .LAP --- 42 cycles= 210ns @200MHz ok TAQOZ# LAP 123456 LAP .LAP --- 50 cycles= 250ns @200MHz ok TAQOZ# LAP 123456. LAP .LAP --- 99 cycles= 495ns @200MHz ok TAQOZ# LAP 2DROP LAP .LAP --- 33 cycles= 165ns @200MHz ok TAQOZ# LAP DROP LAP .LAP --- 41 cycles= 205ns @200MHz ok TAQOZ# LAP 3DROP LAP .LAP --- 41 cycles= 205ns @200MHz ok TAQOZ# 12 LAP 12 LAP .LAP --- 49 cycles= 245ns @200MHz ok TAQOZ# 12 LAP -3 LAP .LAP --- 49 cycles= 245ns @200MHz ok TAQOZ# 12 LAP 1234 LAP .LAP --- 57 cycles= 285ns @200MHz ok TAQOZ# 12 LAP 123456 LAP .LAP --- 58 cycles= 290ns @200MHz ok TAQOZ# 12 LAP 123456. LAP .LAP --- 114 cycles= 570ns @200MHz ok } ' -1 ( -- -1 )' 56* _TRUE MINUS1 bmask u,#31 PUSHACC mov x,u ' Push the accumulator onto the stack then zero it skip #%111 ' ' Push a 32-bit literal onto the datastack by reading in the next 4 bytes : *57 ' _LONG rdlong X,PTRA++ ' read the long that follows and update IP' skip #1 ' ' Read a 16-bit inline literal and push it onto the stack : *49 ' _WORD rdword x,PTRA++ ' read the word that follows and update IP' ' ' PUSH x onto data stack ' PUSHX wrlut d,ptrb++ ' save bottom of register stack into lut memory mov d,c ' push 4 top items held in registers mov c,b mov b,a mov a,x ' replace a with X (DEFAULT) _ret_ sub u,u wc ' zero ACC and clear C' QDUPE _ret_ mov dups,a ' don't DUPE if val = 0 DUPE _ret_ add dups,#1 ' set DUPE flag dups long 0 ' DUPE counter/flag ' Pop the data stack using fixed size register stack in COG memory ' overflow stack in lut ram : returns with wz for tos in x POPX mov x,a wz ' save a into X wz tjnz dups,#duped ' A FAST DUP WAS USED mov a,b ' ripple registers a b c d ' mov b,c ' now ripple drop last 2 registers mov c,d _ret_ rdlut d,--ptrb ' pop from lut stack into bottom of register stack ''' DROPZ mov u,#0 ' DROP and reset accumulator DROP mov a,b ' always replace top with 2nd NIP tjnz dups,#duped ' but don't drop anything if duped muxc carry,#1 ' update Forth carry flag from CPU mov b,c ' now ripple drop last 2 registers mov c,d _ret_ rdlut d,--ptrb ' pop from lut stack into bottom of register stack duped _ret_ sub dups,#1 ' count off the fast dupe '2DROP ( n1 n2 -- ) 48! DROP2 muxc carry,#1 mov a,c mov b,d rdlut c,--ptrb _ret_ rdlut d,--ptrb ' ?DUP ( n1 -- n1 n1 | 0 ) DUP n1 if non-zero QDUP tjz a,#_NOP ' DUP ( n1 - n1 n1 ) Duplicate the top item on the stack - 48 cycles DUP mov x,a ' Read directly from the top of the data stack jmp #\PUSHX ' Push the internal X register onto the datastack ' 2DUP ( n1 n2 -- n1 n2 n1 n2 )' DUP2 call #OVER skip #1 ' TUCK ( b a -- a b a ) TUCK call #SWAP ' OVER ( n1 n2 -- n1 n2 n1 ) - 48cy OVER mov x,b 'read second data item and push jmp #\PUSHX ' 3RD ( n1 n2 n3 -- n1 n2 n3 n1 ) Copy the c item onto the stack THIRD mov x,c ' read third data item jmp #\PUSHX ' 4TH ( n1 n2 n3 n4 -- n1 n2 n3 n4 n1 ) Copy the 4th item onto the stack - 48cy FOURTH mov x,d jmp #\PUSHX ' OVER+ ( n1 n2 -- n1 n2+n1 )' : 17* OVERPLUS _ret_ add a,b ' BOUNDS ( n1 n2 -- n2+n1 n1 ) == OVER + SWAP : 25* BOUNDS add a,b ' SWAP ( n1 n2 -- n2 n1 ) Swap the top two items : 25* SWAP mov x,b mov b,a PUTX _ret_ mov a,x ' -ROT ( c b a -- a c b ) : 41* ROT2 call #ROT ' ROT ( a b c -- b c a ) : 25* ROT mov x,c mov c,b mov b,a _ret_ mov a,x { ROT2 mov x,a mov a,b mov b,c _ret_ mov c,x } { *** AUX STACK *** } ' >L and L> are retasked as a general-purpose stack - nothing to do with the old loop stack' ' >L ( n -- ) 33* PUSHL wrlut a,auxptr ijnz auxptr,#DROP ' L> ( -- n )' 41* LPOP sub auxptr,#1 rdlut X,auxptr jmp #PUSHX { *** RETURN STACK *** } {HELP >R ( n -- ) Push n onto the return stack x49} PUSHR wrlut a,retptr ijnz retptr,#DROP {HELP R> ( -- n ) Pop n from the return stack x41} RPOP sub retptr,#1 rdlut X,retptr jmp #PUSHX ' Push X onto the data stack as a { *** ARITHMETIC *** } ' 1+ INC _ret_ add a,#1 ' 2+ ' INC2 _ret_ add a,#2 ' 4+ ' INC4 _ret_ add a,#4 ' 1- ' DEC _ret_ sub a,#1 ' 2- ' DEC2 _ret_ sub a,#2 ' - ( n1 n2 -- n3 ) Subtract n2 from n1 MINUS subr a,b wc jmp #\NIP ' + ( n1 n2 -- n3 ) Add top two stack items together and replace with result PLUS add a,b wc jmp #\NIP ' -NEGATE ( n1 sn -- n1 | -n1 ) negate n1 if the sign of sn is negative (used in signed divide op) MNEGATE shr a,#31 wc ' ?NEGATE ( n1 flg -- n2 ) negate n1 if flg is true QNEGATE tjz a,#DROP call #DROP ' NEGATE ( n1 -- n2 ) equivalent to n2 = 0-n1 NEGATE _ret_ neg a ' ABS ( n -- abs ) _ABS _ret_ abs a,a ' W* ( w1 w2 -- u ) 16x16 multiply MUL16 mul a,b jmp #NIP ' Fast cog stub of UMDIVMOD64 hubexec ' umdmlp rep #6,acc shl r1, #1 wc ' dividend msb rcl r2, #1 wc rcl c, #1 ' hi bit from dividend cmpsub c, r0 wc ' cmp divisor ( R0 - a & c set if a => R0 ) rcl b, #1 wc ' R1 = quotient l rcl a, #1 ' R2 = quotient h ret { *** BOOLEAN *** } { ' INVERT ( n1 -- n2 ) bitwise invert n1 and replace with result n2 INVERT add a,#1 jmp #NEGATE } ' BITS ( n1 bits -- n2 ) Masking off least sig bits BITS decod a sub a,#1 _AND and a,b wc jmp #NIP _ANDN andn b,a wc jmp #DROP _OR or a,b wc jmp #NIP _XOR xor a,b wc jmp #NIP { *** shift operators *** } { *** RIGHT SHIFT *** } ' SHR ( n1 cnt -- n2 ) Shift n1 right by count (5 lsbs ) _SHR shr b,a wc jmp #DROP ' 16>> _SHR16 _ret_ shr a,#16 ' 9>> _SHR9 _ret_ shr a,#9 ' 8>> _SHR8 _ret_ shr a,#8 ' 4/ 2>> _SHR2 _ret_ shr a,#2 ' 2/ ( n1 -- n1/2 ) 1>> _SHR1 _ret_ shr a,#1 { ' ROR? ( n1 cnt -- n1>>cnt carry )' _RORQ ror b,a wc if_nc mov a,#0 ret } ' ROR ( n1 cnt -- n1>>cnt )' _ROR ror b,a wc jmp #DROP ' SAR ( n1 cnt -- n1>>>cnt)' _SAR sar b,a wc jmp #DROP { ' SIGNW ( word -- long )' Extend sign of 16-bit word SIGNW _ret_ signx a,#15 '' shl a,#16 '' _ret_ sar a,#16 } { *** LEFT SHIFT *** } ' << ( n1 bits -- n2 ) _SHL shl b,a wc jmp #DROP ' ROL ( n1 bits -- n2 ) _ROL rol b,a wc jmp #DROP ' 16<< ( n1 -- n2 ) _SHL16 _ret_ shl a,#16 ' 9<< ( n1 -- n2 ) ' shift a 16bits left _SHL9 _ret_ shl a,#9 ' 8<< ( n1 -- n2 ) ' shift a 8bits left _SHL8 _ret_ shl a,#8 ' 4* _SHL2 _ret_ shl a,#2 ' 2* ( n1 -- n2 ) shift n1 left one bit (equiv to multiply by 2) _SHL1 _ret_ shl a,#1 wc { ' REV>> 'P1 STYLE REV _REVSHR rev b shr b,#a jmp #DROP } ' REVB ( b1 -- b2 ) Reverse byte _REVB shl a,#24 ' REV ( n1 -- n2 ) Reverse bits 0..31 --> 31..0 _REV _ret_ rev a { *** MASKING *** } ' BMASK ( n -- mask )' 8 -> $1FF _BMASK _ret_ bmask a ' MASK ( bitpos -- bitmask \ only the lower 5 bits of bitpos are taken, regardless of the higher bits ) MASK _ret_ decod a ' >| ENCODE ( mask -- bitpos ) Encode the msb to 0..31 ( $7F --> 6 ) ENCODE _ret_ encod a '' FAST MASKING ' 1& ' _AND1 _ret_ and a,#1 ' >N ( n -- nibble ) mask n to a nibble BITS4 _ret_ and a,#$0F ' >B ( n -- nibble ) mask n to a byte BITS8 _ret_ and a,#$FF ' >9 BITS9 _ret_ and a,#$1FF ' >W Convert to a 16-bit word unsigned' TOW _ret_ zerox a,#16-1 ' SIGN ( val bitpos -- sval ) Extend sign from bitpos ($FC 7 sign .L --- $FFFF_FFFC) TOSIGN signx b,a jmp #DROP { *** COMPARISON *** } ' Basic instructions from which other comparison instructions are built from ' = ( n1 n2 -- flg ) true if n1 is equal to n2 : _EQ call #POPX sub a,X ' n1 == 0 if equal ' 0= ( n -- flg ) true if n = 0 : 400ns @80 _ZEQ tjz a,#SETTRUE _ret_ mov a,#0 ' 0<> ( n -- flg ) true if n <> 0 (promote n to boolean) : 400ns @80 _ZNE tjz a,#z1 SETTRUE _ret_ bmask a,#31 z1 ret ' <> ( n1 n2 -- flg ) true if n1 <> n2 : 48cyc _NEQ sub a,b wcz if_nz bmask a,#31 jmp #NIP ' 0< ( n -- flg ) true if n < 0 (negative) : 32cyc _ZLT _ret_ sar a,#31 ' NOT ( n -- !n ) invert bits of n : 350ns @80 _NOT _ret_ not a ' signed MIN returns the minimum of the two values _MINS fles a,b wc jmp #NIP _MAXS fges a,b wc jmp #NIP ' unsigned MIN returns the minimum of the two values _MIN fle a,b wc jmp #NIP _MAX fge a,b wc jmp #NIP { *** MEMORY *** } ' C@++ ( caddr -- caddr+1 byte ) fetch byte character and increment address CFETCHINC rdbyte X,a ijnz a,#PUSHX ' C@ ( caddr -- byte ) Fetch a byte from hub memory : 500ns @80 CFETCH _ret_ rdbyte a,a ' W@ ( waddr -- word ) Fetch a word from hub memory WFETCH _ret_ rdword a,a ' @ ( addr -- long ) Fetch a long from hub memory FETCH _ret_ rdlong a,a ' M!' MSTORE wmlong b,a jmp #DROP2 ' C+! ( n caddr -- ) add n to byte at hub addr : 88! CPLUSST rdbyte X,a ' read in word from adress add b,X ' add to contents of address - cascade ' C! ( n caddr -- ) store n to byte at addr : 72! CSTORE wrbyte b,a ' write the byte using address on the a jmp #DROP2 ' W+! ( n waddr -- ) add n to word at hub addr WPLUSST rdword X,a ' read in word from address add b,X ' W! ( n waddr -- ) store n:b to word at addr:a WSTORE wrword b,a jmp #DROP2 ' +! ( n addr -- ) add n to long at hub addr PLUSST rdlong X,a ' read in long from address add b,X ' ! ( n addr -- ) store n to long at addr STORE wrlong b,a jmp #DROP2 ' LUT@ ( addr -- data ) : 400ns LUTFETCH _ret_ rdlut a,a ' LUT! ( data addr -- ) : 900ns LUTSTORE wrlut b,a jmp #DROP2 ' COG@ ( addr -- long )' COGFETCH alts a,#0 _ret_ mov a,0_0 ' COG! ( long addr -- )' '' COG! ( long addr -- ) Store a long to cog memory COGSTORE altd a,#0 mov 0_0,b jmp #DROP2 { *** BLOCK MOVE & FILL *** } ' BLOCK MOVE ' ' 171219 64K in 19.866ms using rep vs 24.872ms using djnz ' $40000 DUP $10000 LAP CMOVE LAP .LAP --- 1,589,344 cycles= 6,357,376ns @250MHz ok ' RCMOVE bytes from source to destination primitive - TAQOZ# $4.0000 $1.0000 LAP ERASE LAP .LAP --- 131,200 cycles= 656,000ns @200MHz ok ' ( addr bytes -- ) 'ERASE call #PUSHACC ' put a zero on the stack LFILL mov M1,M1 wc ' force c flg ' FILL ( addr cnt fillch -- ) CFILL muxc xfill,#2 ' modify s field of wfbyte to a wflong wrfast #0,c rep #1,b xfill wfbyte a jmp #DROP3 { *** LOOPING *** } ' I ( -- index ) read the loop index IX mov X,index jmp #PUSHX ' IC@ ( -- byte ) ICFETCH rdbyte X,index jmp #PUSHX ' I+ ( n -- n+I ) fast index offset i.e. table I+ IPLUS _ret_ add a,index ' IC~ experimental word only - clear byte at index location ICZ _ret_ wrbyte #0,index { FOR NEXT TAQOZ# 1,000,000 LAP FOR NEXT LAP .LAP --- 32,000,096 cycles= 106,666,986ns @300MHz ok TAQOZ# 1,000,000 0 LAP DO LOOP LAP .LAP --- 32,000,105 cycles= 106,667,016ns @300MHz ok TAQOZ# 1000000 0 lap do loop lap .lap --- 32,000,114 cycles= 160,000,570ns @200MHz ok } ' +LOOP ( n1 -- ) PLOOP call #POPX ' get loop increment add index,X ' add to index sub index,#1 ' compensate so we can drop through to LOOP ' LOOP ' LOOP add index,#1 ' increment index cmps limit,index wcz if_a mov PTRA,loopip ' Branch to the address that is saved in branch stack if_a ret UNLOOP sub lpptr,#1 ' pop loop index' rdlut index,lpptr sub lpptr,#1 ' pop loop limit' rdlut limit,lpptr sub lpptr,#1 ' pop loop branch IP ' _ret_ rdlut loopip,lpptr { FOR NEXT has a 97* cycle overhead each NEXT loop takes 32* cycles So a minimum 1 FOR NEXT takes 129* cycles } ' ?NEXT ( flg -- ) Same as NEXT except terminate early if flag is true and return with flag QNEXT tjz a,#.L0 '' mov a,index jmp #UNLOOP .L0 call #DROP ' NEXT ( -- ) Decrement count (on loop stack) and loop until 0, then pop loop stack forNEXT add index,#1 ' 190705 - maintain index, use limit for count ' djz limit,#UNLOOP ' exit loop _ret_ mov PTRA,loopip ' loop again { incmod index,limit wcz } { *** SMART PINS *** } { WRPIN D/#,S/# - Set smart pin S/# mode to D/# WXPIN D/#,S/# - Set smart pin S/# parameter X to D/# WYPIN D/#,S/# - Set smart pin S/# parameter Y to D/# RDPIN D,S/# - Get smart pin S/# result Z into D V30 WRPIN D/#,S/# - Set smart pin S/# mode to D/#, acknowledge pin WXPIN D/#,S/# - Set smart pin S/# parameter X to D/#, ack WYPIN D/#,S/# - Set smart pin S/# parameter Y to D/#, ack RDPIN D,S/# {WC} - Get smart pin S/# result Z into D, flag into C, ack RQPIN D,S/# {WC} - Get smart pin S/# result Z into D, flag into C, don't ack AKPIN S/# - Acknowledge pin S/# } ' 160620-2300 - MODIFIED SMARTPIN OPS TO USE "pinreg" for faster access ' WRPIN D/#,S/# - Set smart pin S/# mode to D/#, acknowledge pin ' WRPIN ( dst -- ) _WRPIN wrpin a,pinreg jmp #DROP ' WXPIN D/#,S/# - Set smart pin S/# parameter X to D/#, ack ' WXPIN ( dst -- ) _WXPIN wxpin a,pinreg jmp #DROP ' WYPIN D/#,S/# - Set smart pin S/# parameter Y to D/#, ack ' WYPIN ( dst -- ) _WYPIN wypin a,pinreg jmp #DROP ' RDPIN D,S/# {WC} - Get smart pin S/# result Z into D, flag into C, ack ' RDPIN ( -- res ) _RDPIN rdpin X,pinreg jmp #PUSHX _RDPINC rdpin X,pinreg wc if_c sub u,#1 jmp #PUSHACC ' RQPIN D,S/# {WC} - Get smart pin S/# result Z into D, flag into C, don't ack ' RQPIN ( -- res ) _RQPIN rqpin X,pinreg jmp #PUSHX ' AKPIN S/# - Acknowledge pin S/# ' AKPIN ( -- ) _AKPIN _ret_ wrpin #1,pinreg { ' BEGIN RDPIN $80 AND 0= UNTIL WAITPIN rdpin X,pinreg testb X,#7 wz if_nz jmp #WAITPIN ret } WAITPIN testp pinreg wc if_nc jmp #WAITPIN ret { *** I/O ACCESS *** } ' Fast pin operations via PIN pinreg ' H - set the PIN high - fast as the parameter is in the pinreg H _ret_ drvh pinreg ' L - set the PIN low - fast as the parameter is in the pinreg L _ret_ drvl pinreg ' T - toggle the pinreg PIN ' _T _ret_ drvnot pinreg ' F - float PIN F _ret_ dirl pinreg ' R - read PIN R testp pinreg wc if_c sub u,#1 jmp #PUSHACC { ' MSBOUT ( data pin -- data*2 pin ) MSBOUT shl b,#1 wc _ret_ drvc a ' LSBOUT ( data pin -- data*2 pin ) LSBOUT shr b,#1 wc _ret_ drvc a ' MSBIN ( data pin -- data/2 pin ) MSBIN testp a wc _ret_ rcr b,#1 } ' RCL ( da) RCLIO test pinreg wc rcl a,#1 wc _ret_ drvc a ' PIN! ( dat pin -- ) PINST testb b,#0 wc drvc a jmp #DROP2 ' normal pin operations via stack ' HIGH ( pin -- ) HIGH drvh a jmp #DROP ' LOW ( pin -- ) LOW drvl a jmp #DROP ' FLOAT ( pin -- ) _FLOAT dirl a jmp #DROP ' PIN@ ( bit -- state ) PINTEST testp a wc ' read pin state into carry' _ret_ muxc a,M1 DAT '************************************* SERIAL I/O ************************************** 'SEROUT mov txpin,a ' jmp #DROP CONEMIT bith a,#8+(15<<5) ' add stopbits (up to 16)' decod x,#20 ' timeout just in case .l1 testp txpin wc '..wait for buffer empty if_nc djnz x,#.l1 wypin a,txpin jmp #DROP '********************** 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 #POPX ' 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' { mov xx,#6 calld PA,#\LOADMOD } ' Use CALLD PA,#LOADRUN - asm code must load xx with count LOADMOD setq xx rdlong COGMOD,PA nop COGMOD ' ' Code modules can be loaded here and run at cog exec speed ' 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' '#######################################################################' ' hubexec.p2a '#######################################################################' ' '***************************************** HUBEXEC CODE *************************** ' orgh alignl _hubexec INITSTKS call #\INITSP mov auxptr,#auxstk INITLP mov lpptr,#lpstk INITRP _ret_ mov retptr,#retstk ' !SP - init the data stack pointer INITSP mov ptrb,#datstk ' ptrb = datptr' _ret_ mov a,#"?" ' return with ? in tos for empty stack' ' _ret_ mov depth,#0 ' 3DROP ( n1 n2 n3 -- ) 48! DROP4 rdlut d,--ptrb DROP3 muxc carry,#1 ' sub depth,#3 wc 'if_c jmp #INITSP mov a,d rdlut b,--ptrb rdlut c,--ptrb _ret_ rdlut d,--ptrb DEBUGGER ret setint1 #0 ''' jmp #\_Start_Monitor 'silicon rev A/B detect REVQ mov pa, #1 xoro32 pa cmp pa, 0-0 wc 'C = 1 if revA (D = $42a01290 S = $50ad0021), C = 0 if revB (D = $84908405 S = $62690201) if_c mov x, #"A" 'revA if_nc mov x, #"B" 'revB jmp #pushx ' V2.9 introduces a carry register _CARRY mov X,carry jmp #PUSHX ' Registers can be used just like variables and the interpreted kernel uses some for itself ' 128+ bytes are reserved. Since the registers are pointed to by "regptr" they can relocated ' REG ( index -- addr ) Find the address of the register ATREG _ret_ add a,regptr LAPFETCH mov X,lap1 sub X,lap2 jmp #pushx ' COGSTOP ( cog -- ) _COGSTOP cogstop a jmp #DROP ' COGINIT ( addr cog -- ) coginit a,b jmp #DROP2 ' COGATN ( mask -- ) _COGATN cogatn a jmp #DROP ' POLLATN ( -- flg ) _POLLATN pollatn wc if_c sub u,#1 jmp #PUSHACC '' SETEDG ( edge pin -- ) add 4 to edge for lock _SETEDG shl b,#6 add a,b setse1 a jmp #DROP2 '' POLLEDG ( -- flg ) _POLLEDG pollse1 wc if_c sub u,#1 jmp #PUSHACC ' *** DELAY TIMING *** ' ' s ( w -- ) delay for w seconds ' secs mul a,#125 shl a,#3 ' ms ( w -- ) delay for w milliseconds ' ms mul a,#125 ' fast *1,000 ' shl a,#3 ' full 32-bit *8 ' ' us ( n -- ) delay for n microseconds ' us qmul a,#(CPUHZ/4_000_000) ' 4 cycle ins cnts' getqx a sub a,#44 wc ' changed from 29 to account for literal as well if_nc jmp #INS ' cog: djnz a,#INS jmp #DROP 'us mul a,#(CPUHZ/1000000) ' <---- changed at high level clock set' '' sub a,#57 wc ' compensate for overhead' ' WAIT ( clks -- ) WAIT if_nc waitx a jmp #DROP ' ' CYCLES ( cycles -- ) ' CYCLES mov deltaR,a jmp #DROP ' ' DELAY ' DELAY _ret_ waitx deltaR ' DELAYS ( cnt -- )' DELAYS waitx deltaR djnz a,#DELAYS jmp #DROP _GETCNT GETCT X jmp #PUSHX ' getms ( --- ms ) ' Return with millisecond count _GETms rdlong r1,#@_CPUHZ ' Read system clock freq qdiv r1,##1000 getqx r1 ' r1 = clocks/ms getct y wc ' read 64-bit system counter getct x stalli setq y qdiv x,r1 ' ms = count/clocks_per_ms getqx x allowi jmp #PUSHX 'PASM call PTRA ' some smartpin support for high level ' @PIN ( -- pin ) _ATPIN mov X,pinreg jmp #PUSHX '' PIN ( pin -- ) _PIN mov pinreg,a jmp #DROP { _CLK mov tepin,a jmp #DROP } ' WRACK ( data -- ) Write smartpin data and wait for empty then ack WRACK wypin a,pinreg .wait testp pinreg wc '..wait for buffer empty if_nc jmp #.wait akpin pinreg '..acknowledge pin jmp #DROP _RND xoro32 seed mov X,seed jmp #PUSHX ' SKIPNZ ( flg -- ) Skip if flg is true ( replace 0= IF xxx THEN ) SKIPNZ tjz a,#.L0 add PTRA,#2 .L0 jmp #DROP ' > ( n1 n2 -- flg ) GT cmps a,b wc jmp #CFLG ' < ( n1 n2 -- flg ) LT cmps b,a wc jmp #CFLG ' U< ( u1 u2 -- flg ) _ULT cmp b,a wc CFLG subx a,a jmp #NIP '' a=a,b=b,c=c,d=d '' b++ bINC _ret_ add b,#1 ' MOVBYTS ( n1 mask -- n1 ) _MOVBYTS movbyts b,a jmp #\DROP ' ROT4 ( a b c d -- b c d a ) ROT4 mov X,d mov d,c mov c,b mov b,a _ret_ mov a,x ' -ROT4 ( a b c d -- d a b c )' reverse rotate to the 4th item RROT4 mov X,d mov a,b mov b,c mov c,d _ret_ mov d,x ' HUBEXEC LOOPS ' J ( -- index ) read the loop index J mov X,lpptr sub X,#1 rdlut X,X jmp #PUSHX ' ADO = BOUNDS DO - just a quick and direct way as BOUNDS is most often never used elsewhere ' ADO ( from cnt -- ) ADO call #BOUNDS ' DO ( to from -- ) stack and update: index limit loopip DO call #POPX mov acc,x ' overwrite acc from starting default of 0 ' '' ' FOR ( count -- ) Setup FOR...NEXT loop for count where default starting index = acc = 0 FOR wrlut loopip,lpptr ' stack previous loop regs' add lpptr,#1 wrlut limit,lpptr add lpptr,#1 wrlut index,lpptr add lpptr,#1 mov loopip,PTRA ' update loop registers' mov index,acc mov limit,a ' limit of DO or count of FOR ' jmp #DROPZ { TAQOZ# LAP J LAP .LAP --- 48 cycles= 240ns @200MHz ok TAQOZ# 1000000 lap for next lap .lap --- 32,000,089 cycles= 160,000,445ns @200MHz ok TAQOZ# 1000000 0 lap do loop lap .lap --- 32,000,122 cycles= 160,000,610ns @200MHz ok } ' R@ ( -- n ) RFETCH mov X,retptr jmp #XFETCH ' L@ ( -- n ) LFETCH mov X,auxptr XFETCH sub X,#1 rdlut X,X jmp #PUSHX '#######################################################################' ' cordic.p2a '#######################################################################' DAT '''''''''''''' CORDIC ''''''''''''' '''''''''''''' CORDIC ''''''''''''' ' ' cordic moved to hubexec since there is only a few cycles penalty due to pipeline ' ' MULTIPLY qmul a,b getqx b getqy carry jmp #DROP ' UM* ( u1 u2 -- ud. ) ' DESC: unsigned 32bit * 32bit multiply -- 64bit result UMMUL qmul a,b getqx b _ret_ getqy a { ' ( dbldiv. divisor -- quotient )' UMDIV setq b qdiv c,a getqx c ' getqy b jmp #DROP2 } ' Multiply u1 by u2 and divide the double product by div1' ' U*/ ( u1 u2 div1 -- res ) UMULDIV qmul c,b ' u1*u2 ' getqx c ' get double product' getqy b ' UM/ ( d. dvsr -- res )' UMDIV setq b qdiv c,a ' and divide double product by div1' getqx c ' get quotient' jmp #DROP2 ' code */ ( s1 s2 d3 -- res ) 208! MULDIV mov zz,c xor zz,b abs c,c abs b,b qmul c,b getqx c getqy b ' 64-bit divedend setq b qdiv c,a getqx c getqy b mov zz,zz wc negc c,c jmp #DROP2 ' // ( n1 mod -- rem ) MOD n1 UMOD qdiv b,a getqx a getqy b jmp #DROP ' U// ( dvdn dvsr -- rem quot ) UDIVMOD qdiv b,a getqx a _ret_ getqy b ' U/ ( u1 u2 -- quot ) UDIVIDE qdiv b,a getqx b jmp #DROP ' UM// ( ud u2 -- rem quot ) UMDIVMOD setq b qdiv c,a getqx b getqy c jmp #DROP ' GETQY _GETQY getqy x jmp #PUSHX ' QFRAC _QFRAC qfrac b,a getqx b jmp #DROP ' SQRT ( d. -- sqrt ) _SQRT qsqrt b,a getqx b jmp #DROP ' QVECTOR ( x y -- len th )' VECTOR qvector b,a getqx b _ret_ getqy a ' Begin CORDIC rotation of point (D, SETQ value or 32'b0) by angle S. ' GETQX/GETQY retrieves X/Y. ' QROTATE ( x y z -- x y ) ROTATE setq b qrotate c,a getqx c getqy b jmp #DROP ' LOG LOG qlog a _ret_ getqx a ' EXP EXP qexp a _ret_ getqx a { For convenience, two different divide instructions exist, each with an optional SETQ prefix instruction which establishes a non-0 value for one 32-bit part of the 64-bit numerator: QDIV D/#,S,# - Divide {$00000000:D} by S ...or... SETQ Q/# - Set top part of numerator QDIV D/#,S,# - Divide {Q:D} by S ...or... QFRAC D/#,S,# - Divide {D:$00000000} by S ...or... SETQ Q/# - Set bottom part of numerator QFRAC D/#,S,# - Divide {D:Q} by S To get the results: GETQX quotient GETQY remainder } '' D! ( d. addr -- ) DSTORE wrlong c,a add a,#4 wrlong b,a jmp #DROP3 '' D@ ( addr -- d. ) DFETCH rdlong r1,a ' read low 32-bits add a,#4 rdlong X,a ' read high ' mov a,r1 ' set low' jmp #PUSHX ' push high ' D+ ( d1. d2. -- d3. ) DPLUS add d,b wc addx c,a jmp #DROP2 DMINUS sub d,b wc subx c,a jmp #DROP2 ' D<< ( d. n -0 d2. ) DSHL rol c,a mov x,c shl b,a decod a sub a,#1 andn b,a andn c,a and x,a or b,x jmp #DROP { ' ': 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 } CON srcbuf = lutfree+32 DAT { @rogloh code doublenibbles rep #14, readburst rdlut b, ptra++ getword a, b, #1 movbyts b, #%%1100 mov pb, b shl pb, #4 setq nibblemask muxq b, pb wrlut b, ptrb++ movbyts a, #%%1100 mov pb, a shl pb, #4 setq nibblemask muxq a, pb wrlut a, ptrb++ ret nibblemask long $0ff00ff0 } { ' 3ms per frame QVGA-->VGA FULL-SCREEN upscaler - ' ( src scr -- src+640 scr ) DWIDTH setq2 #32-1 ' copy into LUT rdlong lutfree,##DWLUT jmp #lutfree+$200 ' and run DWLUT setq2 #80-1 rdlong srcbuf,b ' read all of source ' mov r3,#srcbuf ' set lut src mov r1,#lmbuf ' set lut dst rep #18,#80 rdlut u,r3 ' read 4 bytes of source add r3,#1 getbyte X,u,#0 ' get byte setbyte X,u,#1 ' double it up shr u,#8 ' next byte setbyte X,u,#2 ' set it setbyte X,u,#3 ' double it up wrlut X,r1 ' save in lut shr u,#8 add r1,#1 ' update dst ptr getbyte X,u,#0 ' get byte setbyte X,u,#1 ' double it up shr u,#8 ' next byte setbyte X,u,#2 ' set it setbyte X,u,#3 ' double it up wrlut X,r1 ' save in lut shr u,#8 add r1,#1 ' update dst ptr setq2 #160-1 ' write out result to screen dst wrlong lmbuf,a add a,##640 ' double lines as well' setq2 #160-1 ' write out result to screen dst wrlong lmbuf,a _ret_ add a,##640 } '''''''''''''''''''''''''''''''''''''''''''''''''''''''' { 18446744073709551615 10000000000000000000 .L --- $89E8_0000 ok #10000000000000000000. HEX BEGIN CRLF 2DUP .DEC CR 3 TABS 2DUP D. 10 UD// 2DUP OR 0= UNTIL 2DROP 10000000000000000000 8AC7230489E80000 1000000000000000000 DE0B6B3A7640000 100000000000000000 16345785D8A0000 10000000000000000 2386F26FC10000 1000000000000000 38D7EA4C68000 100000000000000 5AF3107A4000 10000000000000 9184E72A000 1000000000000 E8D4A51000 100000000000 174876E800 10000000000 2540BE400 1000000000 3B9ACA00 100000000 5F5E100 10000000 989680 1000000 F4240 100000 186A0 10000 2710 1000 3E8 100 64 10 A 1 1 ok ' BINDEC ( d. -- addr ) BINDEC moV R4.##dectbl rdlong x,r4 add r4,#4 rdlong y,r4 add r4,#4 sub b,x wc subx a,y wc if_c add b,x wc if_c addx a,y if_nc } ' TAQOZ# 12345678 1000 LAP LW* LAP .LAP --- 56 cycles= 280ns @200MHz ok ' ' LW* ( mclong mpword -- result. ) Multiply a long by 16-bits and return 48-bits LWMUL mov x,b mov y,a getword b,x,#1 mul b,y getword a,b,#1 shl b,#16 mul y,x add b,y wc _ret_ addx a,#0 ' main division sub - called both by U/ and U// ' double div, single divisor ' By specifing bits and left justifying the routine can be adapted and run faster ' CLKHZ 1234 LAP U// LAP .LAP 27.400us ok --> 18.800us ' UM// ' UM/MOD64 ( Dbl.dividend divisor -- remainder Dbl.quotient) UMDIVMOD64 mov u,#32 UMDIVMOD32 add u,#32 mov R0, a ' R0 = divisor mov R1, c ' R1R2 = dividend mov R2, b mov c, #0 ' remainder jmp #umdmlp ' fast cog stub { udmlp shl R1, #1 wc ' dividend msb rcl R2, #1 wc rcl c, #1 ' hi bit from dividend cmpsub c, R0 wc ' cmp divisor ( R0 - a & c set if a => R0 ) rcl b, #1 wc ' R1 = quotient l rcl a, #1 ' R2 = quotient h _ret_ djnz u,#udmlp } ' DSWAP ( n1 n2 n3 n4 -- n3 n4 n1 n2 ) DSWAP mov R0,a mov R1,b mov a,c mov b,d mov c,R0 _ret_ mov d,R1 ' SPIPINS ( &cs.mi.mo.ck -- ) Setup I/O pins to be used for SPI instructions ' SPIPINS getbyte sck,a,#0 getbyte mosi,a,#1 getbyte miso,a,#2 getbyte ss,a,#3 drvl sck ' clock high/low ? (testing) drvh ss ' chip select high drvh mosi ' mosi high drvl ss ' pulse cs to clock other device dirl miso ' input drvh ss jmp #DROP ' CLKS ( cnt -- ) CLKS drvl sck ' idle low drvh mosi ' with MOSI high ' shl a,#1 ' 2 edges/clock' .l1 drvnot sck djnz a,#.l1 jmp #DROP { PAFETCH mov X,INA jmp #PUSHX PBFETCH mov X,INB jmp #PUSHX PASTORE mov OUTA,a jmp #DROP PBSTORE mov OUTA,a jmp #DROP DACLR andn DIRA,a jmp #DROP DBCLR andn DIRB,a jmp #DROP ' ( mask -- ) PASET or OUTA,a DASET or DIRA,a jmp #DROP PBSET or OUTB,a DBSET or DIRB,a jmp #DROP PACLR andn OUTA,a jmp #DASET PBCLR andn OUTB,a jmp #DBSET } { *** COG ACCESS *** } _COGID cogid X jmp #PUSHX '' _COGINIT ( dest cog -- ) _COGINIT coginit a,b jmp #DROP2 NEWCOG1 coginit a,##@RESET jmp #DROP '' WAITX ( cycles -- ) _WAITX waitx a jmp #DROP '' SETCT1 ( delta -- ) Calculate and set the cnt delta and waitcnt _SETCT1 mov deltaR,a getct X addct1 X,deltaR jmp #DROP '' WAITCT1 ( -- ) _WAITCT1 waitct1 getct X _ret_ addct1 X,deltaR { _SETSE1 setse1 a jmp #DROP _SETSE2 setse2 a jmp #DROP _SETSE3 setse3 a jmp #DROP _SETSE4 setse4 a jmp #DROP _WAITSE1 _ret_ waitse1 _WAITSE2 _ret_ waitse2 _WAITSE3 _ret_ waitse3 _WAITSE4 _ret_ waitse4 } { ' OUTCLR ( iomask -- ) Clear multiple bits on the output OUTCLRA andn OUTA,a or DIRA,a jmp #DROP '' OUTSET ( iomask -- ) Set multiple bits on the output OUTSETA or OUTA,a ' OUTPUTS ( iomask -- ) Set selected port pins to outputs or DIRA,a jmp #DROP ' INPUTS ( iomask -- ) Set selected port pins to inputs INPUTSA andn DIRA,a jmp #DROP } ' L2S ( n -- lsb9 h ) specialized operation for filesystem addresses ( splits off 9 lsbs ) L2S mov X,a and a,#$1FF shr X,#9 jmp #PUSHX ' L2W word DUP,TOW,SWAP,_SHR16,EXIT { ' SHIFT from INPUT - Assembles with last bit received as msb - needs SHR to right justify if asynch data ' SHRINP ( pin dat -- pin dat/2 ) SHRINP testp b wc rcr a,#1 ret } { SHIFT to OUT - This is optimized for when you are sending out multiple bits as in asynchronous serial data or I2C Shift data one bit right into output via iomask - leave mask & shifted data on stack (looping) 400ns execution time including wordcode read and execute or 200ns/bit with REPS } { ' SHROUT ( pin dat -- iomask dat/2 ) SHROUT shr a,#1 wc ' Shift right and get lsb drvc b ret } ' WSTX ( array cnt -- ) ' Will transmit a whole array of bytes each back to back in WS2812 timing format ' An address of 0 indicates that the leds should be blanked ' A zero is transmitted as 400ns high by 800ns low (+/-150ns) ' A one is transmitted as 800ns high by 400ns low ' WSTX rdlong r3,#@_CPUHZ qdiv r3,##2500000 ' 1/3 bit timing 400ns getqx r3 WSLP tjz b,#WS0 ' if address=0 then just clear the leds rdbyte acc,b ' read next byte add b,#1 WS0 shl acc,#24 mov r1,#8 WSLP2 drvh pinreg waitx r3 shl acc,#1 wc drvc pinreg waitx r3 drvl pinreg waitx r3 djnz r1,#WSLP2 djnz a,#WSLP jmp #DROP2 ' BIT! BITST call #POPX tjz X,#CLR ' SET ( mask addr -- ) Set bit(s) in hub long SET rdlong X,a or X,b wrlong X,a jmp #DROP2 ' CLR ( mask addr -- ) Clear bit(s) in hub long CLR rdlong X,a andn X,b wrlong X,a jmp #DROP2 ' SET? ( mask addr -- flg ) Test single bit of a long in memory BITQ rdlong a,a and b,a wz ' if_nz mov b,M1 if_nz bmask b,#31 jmp #DROP ' ~~ ( addr -- ) set long SETL sub u,#1 ' ~ ( addr -- ) clear long CLRL wrlong u,a jmp #DROPZ ' W~~ ( addr -- ) set word SETW sub u,#1 ' W~ ( addr -- ) clear word CLRW wrword u,a jmp #DROPZ ' C~~ ( addr -- ) set byte SETC sub u,#1 ' C~ ( addr -- ) clear byte CLRC wrbyte u,a jmp #DROPZ { ' M* ( 32b 16b -- 32b )' MUL3216 mov prod, v1 sar prod, #16 mul prod, v2 shl prod, #16 mul v1, v2 add prod, v1 jmp #DROP } ' D0= ( n -- flg )' DZEQ mov X,a or X,b wz if_z sub X,#1 if_nz mov X,#0 jmp #PUSHX AJMP mov PTRA,a ' jump to address on top of the data stack jmp #DROP ' Enter code or threaded code at address EXECUTE ' ( addr -- ) call #POPX cmp x,##threaded wc if_c pop R1 if_c jmp #doCODE wrlut PTRA,retptr add retptr,#1 _ret_ mov PTRA,X ' jump to new wordcode (PTRA = IP) ACALL call #POPX ' get wordcode into X pop R1 ' discard return address and jump back and use interpreter jmp #doCODE ' Inline vector check and exeute !!!! needs to be able to handle hubexec !!!! ' ?JMP ( adr -- ) QJMP rdword X,a wz ' read contents of vector if_nz mov PTRA,X jmp #DROP QCALL call #POPX rdword X,X wz ' read contents of vector if_nz jmp #ENTER ret { ENTER test X,#1 wz ' bit0 is the jump/call bit (all wordcode is word aligned) andn X,#1 ' word align if_z wrlut PTRA,retptr ' save IP onto return stack if b0 = 0 otherwise skip if_z add retptr,#1 mov PTRA,X ' jump to new wordcode (PTRA = IP) jmp #doNEXT } ' ?LEAVE ( flg -- ) --- leave on next LOOP if true' QLEAVE call #POPX if_z ret ' LEAVE - make the loop index = to the limit so that it will leave on the next LOOP LEAVE mov limit,index _ret_ add limit,#1 ' DUPC@ ( addr -- addr data ) DUPCFT rdbyte X,a jmp #PUSHX ' Push the internal X register onto the datastack _DEPTH 'mov X,depth mov x,ptrb sub x,#datstk jmp #PUSHX _SETDACS setdacs a jmp #DROP _GETRND getrnd X jmp #PUSHX _HUBSET hubset a jmp #DROP { ' **************** emit support ' TXDAT ( buf cnt -- ) write byte buffer direct to WYPIN _TXDAT rdfast #0,b .L1 rfbyte X ' a byte at a time' bith a,#8+(15<<5) wypin X,pinreg .wait testp pinreg wc '..wait for buffer empty if_nc jmp #.wait akpin pinreg '..acknowledge pin djnz a,#.L1 jmp #DROP2 } { DICTIONARY 00.D000: 03 44 55 50 6B 00 04 32 44 55 50 6D 00 04 4F 56 .DUPk..2DUPm..OV 00.D010: 45 52 6E 00 04 44 52 4F 50 61 00 05 32 44 52 4F ERn..DROPa..2DRO 00.D020: 50 60 00 04 53 57 41 50 75 00 05 32 53 57 41 50 P..SWAPu..2SWAP 00.D030: 50 0D 03 52 4F 54 7A 00 04 2D 52 4F 54 79 00 03 P..ROTz..-ROTy.. } { ATR(765):CNT(43210),,CFA ' ' Find string in dictionary is written in code and takes around 1us/word r3 = cnt+1st char of source for faster searches ' ' r1 r2 ' } FINDSTR ' ( b:str a:dict -- nfaptr | false ) mov r3,b .l0 add r3,#1 ' find terminator ' rdbyte X,r3 wz if_nz jmp #.l0 sub r3,b ' r3 = len rdbyte x,b ' read in 1st char shl x,#8 or r3,x ' ch.cnt = fast 16-bit search pattern ' fstlp mov r2,a ' R2 = dict mov r1,b ' R1 = source rdword x,r2 wcz ' read in dict count + 1st char' if_z jmp #fstfail ' end of dictionary?' ( 00 00 ) if_c jmp #dlink ' dictionary link' ( 00 $80 ) andn x,#$E0 ' mask out atrs from count (x= ch.cnt) cmp x,r3 wz ' compare count+1st char ' if_nz jmp #fstskip ' no match, go to next word mov r4,r3 ' matched on cnt + 1st char' and r4,#cntm ' now match rest if needed' sub r4,#1 wz ' matched if single else setup' if_z jmp #fstmatch add r1,#1 ' skip into 2nd char' add r2,#2 fstrem rdbyte r0,r1 ' read in char from source ' add r1,#1 ' hub has to wait anyway so get ready for next source byte rdbyte x,r2 ' read in a character from the dictionary add r2,#1 cmp x,r0 wz ' are they the same? if_nz jmp #fstskip ' skip if not same' djnz r4,#fstrem ' continue for remainder' fstmatch 'mov b,a ' NIP jmp #NIP ' found it ' fstskip rdbyte X,a ' read dict cnt to skip to next header ' testb X,#pg wc ' Is this an extended page address header and X,#cntm ' 03,D,U,P,CFAL,CFAH addx a,X ' add extra page byte if page attribute set add a,#3 ' skip over CPA to next header' jmp #fstlp fstfail mov b,#0 jmp #DROP ' DICTIONARY LINK ' ' dictionary links are headers that have a zero count and a negative character ($00 $80)' ' The next 16-bit field is read and the dictionary continues from there' ' 200409 - make the 16-bit field relative so simply add it to the dictionary ptr' dlink add r2,#2 ' dlink pointer rdword x,r2 ' new dictionary offset' add a,x jmp #fstlp { '---' Define a new routine that can load COGMOD memory from hub LOADMOD ''( src len -- ) setq a rdlong COGMOD,b 'read longs into cog' call #DROP2 jmp #COGMOD } { REGVAR POP X rdbyte X,X add X,regptr jmp #PUSHX } { " ABCDEFGHIKLMNOPQRSTUVWXYZ$@!+- _abcdefghijklmnopqrstuvwxyz{|}~ #J%&'()*,./0123456789:;<=>?[\]^" 0 -ROT BEGIN DUP C@ WHILE OVER OVER C@ = IF 2DROP EXIT THEN ROT 1+ -ROT 1+ REPEAT ; } { ' LOOKIN ( val array -- index ) LOOKIN mov R1,b mov b,#0 ' init result index .L0 rdbyte X,a wz if_z mov b,#0 if_z jmp #DROP add b,#1 ' inc result index cmp X,R1 wz if_z jmp #DROP add a,#1 jmp #.L0 _LOOKUP '( index array -- value ) add b,a rdbyte b,b jmp #DROP } { ' SPIRD ( dat -- dat+rd ) SPIRD outnot sck ' clock (low high) nop nop outnot sck nop nop testp miso wc ' read data from card outnot sck ' clock (low high) rcl a,#1 ' shift in msb first outnot sck nop nop testp miso wc ' read data from card outnot sck ' clock (low high) rcl a,#1 ' shift in msb first outnot sck nop nop testp miso wc ' read data from card outnot sck ' clock (low high) rcl a,#1 ' shift in msb first outnot sck nop nop testp miso wc ' read data from card outnot sck ' clock (low high) rcl a,#1 ' shift in msb first outnot sck nop nop testp miso wc ' read data from card outnot sck ' clock (low high) rcl a,#1 ' shift in msb first outnot sck nop nop testp miso wc ' read data from card outnot sck ' clock (low high) rcl a,#1 ' shift in msb first outnot sck nop nop testp miso wc ' read data from card outnot sck ' clock (low high) rcl a,#1 ' shift in msb first outnot sck nop nop testp miso wc ' read data from card rcl a,#1 ret '} LACAP '( addr cnt scale a/b -- ) mov yy,#1 ' one ins/cap' tjz b,#$+12 mov yy,#2 ' +waitx = two ins/cap ' sub b,#1 mov xx,#6 calld PA,#\LOADMOD setd COGMOD+3,a wrfast #0,d rep yy,c ' loop 1 or 2 ins for cnt in c wflong INA ' capture port to hub buffer waitx b jmp #\DROP4 HUBEXEC1 ret ' marker for end of HUBEXEC code itself (not used)' ' long 0[64] ' space for new hubexec routines' initsys hubset #0 ' SWITCH TO RCFAST' mov hr1,_CLKCFG hubset hr1 waitx ##20_000_000/100 ' wait ~10ms for crystal+PLL to stabilize or hr1,#xmode ' use PLL bits' hubset hr1 drvh #tx_pin or _VGACFG,#0 wz ' ignore VGA if no pins assigned (all zeros) if_nz coginit #vgacog,_VGAINIT or _COG1,#0 wz ' user specified startup code for cogs 1...7 ' if_nz coginit #1,_COG1 or _COG2,#0 wz if_nz coginit #2,_COG2 or _COG3,#0 wz if_nz coginit #3,_COG3 or _COG4,#0 wz if_nz coginit #4,_COG4 or _COG5,#0 wz if_nz coginit #5,_COG5 or _COG6,#0 wz if_nz coginit #6,_COG6 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 ' invalidate 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 } '#######################################################################' ' misc.twc '#######################################################################' orgh THREADS { *** OUTPUT OPERATIONS *** } ' NOTE: SPACE must be the first of the threaded words - used as a marker' SPACE word _BL ' spare NOPs for EMIT extensions and MOUT' EMIT word NOOP,NOOP word rg+uemit,QJMP,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 ACONL long 1000000 W1000 word ACONL 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 ACONL long SDBUFS ''$F000 ROM word ACONL long $0F_C000 IRQVEC word ACONL 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 { 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 ---------------------------------------------------------------- taqoz_version patch byte 1 minor byte 8 major word 2 } ' .VER PRTVER word PRTSTR '12345678901234567890123456789012345678901234567890123456789011' byte " TAQOZ Forth for Parallax P2 Multicore MCU V",0 word _WORD,@major,CFETCH,PRT,DOT word _WORD,@minor,CFETCH,PRT,DOT word _WORD,@patch,CFETCH,PRT word _WORD,@custom,CFETCH,EMIT 'word _WORD,@taqoz_version 'word _WORD,PRTAST 'byte "#~#.#.# '",0 word SPACE,PRTTICK,_WORD,@taqoz_name,_4,CTYPE,PRTTICK word SPACE, _WORD,@taqoz_time,FETCH,PRTAST byte "6|-4| ",0 ' Print ROM version and clkfreq' word _LONG long $FC262 word w+10,CTYPE,SPACE,PRTCLK,SPACE word CRLF+ex 'PRTTICK '' word w+"'",EMIT+ex 'DOT word w+".",EMIT+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 { *** COMMENTING *** } '' \ ( -- ) '' Ignore following text till the end of line. '' IMMED COMMENT word rg+delim+1,CFETCH,_13,_NEQ,ZEXIT ' ignore is this is an empty line .L0 word WKEY,DUP,QEMIT,_13,_EQ,_UNTIL+06 ' terminate comment on a CR word _13,rg+keychar,STOREX+ex ' force a CR back into the key stream on exit PAREN word WKEY,DUP,QEMIT,w+")",_EQ,_UNTIL+06,EXIT IFDEF word NFATICK,_ZEQ,ZEXIT,BRACE+ex IFNDEF word NFATICK,ZEXIT '''' ' Block comments - allow nested operation '''' BRACE word _1 ' allow nesting by counting braces .LP word WKEY ' keep reading each char until we have a matching closing brace word DUP,w+"{",_EQ,_IF+03,DROP,INC,.LP+ex ' add up opening braces word w+"}",_EQ,SKIPZ,DEC ' count down closing braces word DUP,_ZEQ,_UNTIL+15,DROPEX+ex ' 06,F,O,R,G,E,T,CODEL,CODEH FORGET word NFATICK,GRAB,QDUP,_IF+17 word DUP,DUPCFT,PLUS,_3,PLUS,rg+names,STORE word DUPCFT,PLUS,INC,WFETCH,DUP,rg+here,STORE word w+EXIT,SWAP,WSTOREX+ex NOTFOUND word PRTSTR byte " not found ",0 word EXIT '''' 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,COMPA+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 AVAR,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 ' COMPILE AN ADDRESS AND A PRECEDING PAGE CODE IF NEEDED ' 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 ( codeadr -- ) ' SETCPA word ATNAMES,OVER,_SHR16 ' compile a 3 byte CPA if code is outside page0 word _IF+05,_3,MINUS,MSTORE,_3,SUBNAMES+ex ' else compile a 16-bit CPA ' 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 & allocating header - setup CPA field right now (2 or 3 bytes depending upon code ptr) word ATCODES,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+AVAR,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+ACONL 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+ADATCON,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 CLIDEF word w+cliatr,SDEF,_WORD,GRAB,COMPW,EXIT 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 ' CASE= ( val -- flg ) ISEQ word SWFETCH,_EQ,EXIT ' CASE ( compare -- ) _CASE word _WORD,ISEQ,COMPW,_IF_+ex ' BREAK ISEND word EXITS,_THEN_,ALLOCATED+ex '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 _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] ADATCON ; 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 DLFETCH 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,DLFETCH,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 ACONL 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,DFETCH,GETBASE,DMMUL ' shift anumber left one digit (base) word ROT2,PLUS,SWAP,rg+anumber,DSTORE ' 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,w+negs,PLUS,w+negs,_ULT,_IF+04,_WORD,w,PLUS,COMPW+ex 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 ' Compile _WORDS,<16-bits> ' .L2 ' Compile short literal directly word _WORD,w,PLUS,COMPW+ex ' Compile encoded literal' '#######################################################################' ' 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 word 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 ACONL long dictorg datcold word ACONL 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 (compile 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 but test for ^X 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? { Dictionary name attributes 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 } foundword ' \ point to attribute word (CNT,,ATR,CPA) word DUP,NFACFA ' ( nfa cfa ) ' \ IMMEDIATE is the IMMEDIATE bit set? word SWAP,CFETCH,_6,_SHR,DUP,w+preatr,_EQ ' \ ... and not forced to [C] compile, then EXECUTE NOW! word w+compF,CHKFLG,_ZEQ,_AND,_IF+03,DROP,EXECUTE,chkeol+ex ' \ is this CLI execute only? word w+cliatr,_EQ,w+defF,CHKFLG,_ZEQ word _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,DUP,_IF+(eol01-.L0)/2 ' \ Yes, process user uaccept option if set .L0 word LAP,rg+uaccept,WFETCH,QDUP,_IF+02,ACALL,eol01+ex ' \ default is to ACK respond unless defining etc word w+ackF,CHKFLG,SKIPNZ,ACK ' \ Simple CRLF if in a definition or interactive? eol01 word DUP,w+defF,CHKFLG,_AND,SKIPZ,CRLF ' \ execute only if not defining word w+defF,CHKFLG,_ZEQ,_AND,_UNTIL+(execs-WORDLP)/2 execs ' \ EXECUTE CODE from user input (append an EOL/EXIT first) word _WORD,EOL+ex,COMPW ' \ execute wordcodes from beginning execinp word ATHERE,EXECUTE ' \ skip OK response if in line mode 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 ' \ Acknowledge user input 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,_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 } MSAVES word _WORD,MOUTST+2,FETCH,w+20,BITS,ZEXIT word DUP,MOUTST,_WORD,MOUTST+2,WINC,_0 MOUTST word _LONG long 0 word CSTORE,EXIT ' MOUT ( addr -- ) Save output to memory address' MOUT word DUP,_WORD,MOUTST+2,STORE ' 210520 - patch MSAVE as a jump into EMIT (spare NOP) word _IF+XX,_WORD,MSAVES+ex MOUT1 word _WORD,EMIT+2,WSTORE,EXIT word _WORD,NOOP,MOUT1+ex ' Read a character from memory file ' 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 word _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 ACONL 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 ACONL long flashpart SFSIG word ACONL 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, "DUPE" word DUPE byte 5, "?DUPE" word QDUPE 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 4, "TUCK" word TUCK 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 5, "4DROP" word DROP4 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 UMDIVMOD byte 4, "UD//" 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 3, "IC~" word ICZ 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, "R@" word RFETCH byte 2, ">L" word PUSHL byte 2, "L>" word LPOP byte 2, "L@" word LFETCH byte 3, "!SP" word INITSP byte 5, "DEPTH" word _DEPTH byte 2, "D@" word DFETCH byte 2, "D!" word DSTORE byte 2, "D+" word DPLUS byte 2, "D-" word DMINUS byte 3, "D<<" word DSHL 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 ' *** REGISTER *** ' 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 6, "RUNCAP" word RUNCAP byte 5, "UNCAP" word UNCAP 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 5, "LFILL" word LFILL 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 3+im, "cli" word CLIDEF 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, "INIT" 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 5, "CARRY" word _CARRY byte 6, "outbox" word w+outchar byte 5, "inbox" word w+keychar byte 7, "BUFFERS" word BUFFERS byte 3, "END" word _END long 0 ' end of dictionary link code' enddict alignl { hdr "END" } {{ +------------------------------------------------------------------------------------------------------------------------------+ | 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. | +------------------------------------------------------------------------------------------------------------------------------+ }}