TACHYON { EXTEND.fth } pri EXTEND.fth ." Primary extensions to TACHYON kernel - 121214.1900 " ; " !!!!!!!!!!!!!!!!!!!!! REQUIRES LATEST KERNEL V2.0 121012.2200 upwards !!!!!!!!!!!!!" DROP : LEMIT DUP $0A <> IF $100 OR 2* (EMIT) ELSE DROP THEN ; \ Define these two symbols as dummy definitions so that Forth will do nothing except affect echo - they are meant for HS-SerialRxL \ start of load symbol - Intercepted by HS-SerialRxL and will automatically strip comments etc : [~ 1 flags CLR ' LEMIT uemit W! ; \ end of load symbol - Intercepted by HS-SerialRxL will revert back to transparent mode : ]~ 1 flags SET 0 uemit W! ; [~ \ If HS-SerialRxL is used then it will already be filtering out all comments and redundancies because it just saw [~ { ******************* TACHYON FORTH KERNEL EXTENSIONS + I2C BUS ROUTINES ********************* LOADSTATS: CODE @$4881 - bytes added = 2945 and 14207 bytes free NAMES @$26ED - bytes added = 1303 and 2793 bytes free CHANGELOG: 121214 - Replaced I2CPINS using CONSTANT method in place of using variables - Modified I2CBUS to read from odd addresses which keep the "read" bit active 121122 - Updated SEROUT to fix start bit timing at high baud rates 121113 - Added LOCAL and RELEASE and reference words 121028 - Modified and added U@ and U! for unaligned long fetch and store using CMOVE 121010 - Modify BACKUP to suit remapped kernel 121003 - List modules on reboot - prevent additional timertasks from starting automatically 120929 - Fixed typo bug in EE@ 120928 - Add list control key for QWORDS, WORDS etc 120927 - Added enhanced WORDS, PFA>NFA, and enhanced TASKS 120923 - Added BINARYDUMP which generates an Prop binary compatible Intel hex dump of Tachyon and all loaded modules 120919 - Added kernel module support to enable faster PWM! table updates (now 233us) - Added U@ for unaligned long fetches - Added MODULES which will list out all ".fth" names in the dictionary 120918 - Added EFILL and BACKUP now backs up the first 32K of EEPROM before overwriting if 64K is available - RESTORE will restore the previous from the top 32K of EEPROM if it is available 120917 - Added linenumbers to kernel - Modified ' (TICK) to allow it to be used inside definitions - so adjust extensions accordlingly 120916 - Just decided that the background timer task really needs to be running at startup automatically! - I can see a need for chaining AUTORUN vectors... 120915 - Add LBIT! - Include Multi-channel PWM task - Add task support words with expanded operation via kernel from 120915.2330 - Add counter & background function tasks 120913.0900 - Added MASKS, DAC!. Fixed HZ modes to ensure pin is set low first. 120911.2250 - Added V2 mods - removed ATR' and PFA' - added IDUMP to dump in Intel Hex format - Added MAP to display memory as one byte per 64 bytes OR'ed. 120909.2200 - Modified I2CBUS to sacn at 100kHz and added extra slow I2C words 120909.1200 - Added COGREG constants for easy reference - BACKUP V2 correctly - detects which version to compile 120904.1111 - Tweaked I2C bus to run at 400kHz 120901.1430 - Reversed order of changelog - Changed names of BAUD and BAUDRATE to SERBAUD (SERIN/SEROUT) and CONBAUD (console) 120829.1620 - Added XLOAD plus modified EEPROM routines so that long addresses automatically select another device 120828.1245 - Added PINS? which lists out each of the Prop's I/O, it's direction and state 120827.0900 - Removed TASK and replaced with more general method RUN 120826.0200 - Added TASK and COGINIT, moved >PFA to kernel 120824.1700 - Fixed bug when W>B stack standardization took place 120820.2300 - Updated I/O words in kernel 120815.1000 - BAUDRATE now changes Tachyon's default baudrate at startup - NOVGA will stop the VGA cog 120814.1200 - Added minor words 120813.1400 - Added Spin/C style ++ -- ~ ~~ operators 1208xx - Added CTR manipulation words including HZ etc. 120810.2150 - Added SERIN, .NUM enhanced, added ?BACKUP which will check for errors first 120809.1200 - Added .NUM which formats numbers according to a specifier word - Added enhanced version of SPRS from the Intro page. 120808.1800 - Changed >CFA to >PFA (more correct) - Changed I2C! to I2C!? as it returns an ack flag - Readded I2C! which does not return a flag 120807.1830 - Added I2CPINS and EEPROM to allow for redirection or setting the default } HEX \ Toggle the "immediate" tag of the latest name in the dictionary pri IMMEDIATE names W@ DUP STRLEN + DUP C@ $20 XOR SWAP C! ; \ For nothing more than being able to copy&paste from the terminal and back in again without tripping on "ok" pri ok ; \ quick and easy way to ignore Google footer when "selecting all" from webpage pri Published BEGIN KEY $0D = UNTIL CR ; IMMEDIATE \ separator for readability pri ... ; IMMEDIATE \ Print the index formatted on a new line pub .INDEX CR I .WORD ." : " ; pub SPACES ( cnt -- ) FOR SPACE NEXT ; \ Unaligned fetch and store long LONG navar pub U! ( long addr -- ) SWAP navar ! navar SWAP 4 CMOVE ; pub U@ ( addr -- long ) navar 4 CMOVE navar @ ; \ Kernel now includes L> 2DROP POPMARK R> DROP ; 1 { Saving stack parameters to local variables can simplify the stack manipulation required A specified number of parameters are removed and copied to the local variables area but first the existing local variables are pushed up so that they are saved and can be restored with a RELEASE } TABLE locals $40 ALLOT \ space for up to 16 locals pri @X ( index -- ) 2* 2* locals + ; pub X1 locals @ ; pub X2 1 @X @ ; pub X3 2 @X @ ; pub X4 3 @X @ ; pub LOCAL ( n -- ) locals OVER @X 3RD 2* 2* $40 SWAP - NFA ( pfa -- nfa ) names W@ 1+ BEGIN DUP NFA>CFA >PFA 3RD = IF NIP EXIT THEN NFA>CFA 3 + DUP C@ 0= UNTIL 2DROP 0 ; \ Return with the clock frequency (Normally 80,000,000) pub CLKFREQ ( -- freq ) 0 @ ; pub COGREG! ( dat ix -- ) COGREG COG! ; pub COGREG@ ( ix -- dat ) COGREG COG@ ; \ Define COGREG constants for most SPI operations 0 CONSTANT @SCK 1 CONSTANT @MOSI 2 CONSTANT @MISO 3 CONSTANT @CNT \ Setup COGREGS with 4 parameters for most module functions plus set DIR for clock and data out \ USAGE: 8 #DI #DO #CLK COGREGS pub COGREGS ( cnt miso mosi clk -- ) DUP OUTCLR @SCK COGREG! DUP OUTCLR @MOSI COGREG! @MISO COGREG! @CNT COGREG! ; \ Note: The "par" address must be word aligned. pub COGINIT ( cog code par -- ) #18 SHL SWAP 4 SHL OR OR %000011_0011_1111_000000000_000000010 STACKS 9 SHL + PASM DROP ; ( *** COG TASK CONTROL *** ) \ Run a task in the specified cog (assumes Tachyon is preloaded and has not been assigned yet (IDLE) \ Usage: ' >PFA 4 RUN \ NOTE: V2 changes ' to return with the actual PFA (most sensible), so it's: ' 4 RUN \ V2.0 120915+ now uses 8 bytes per task rather than 2. The run address is not cleared. Use ATN for commands. \ Find the next available cog that's free to run a task (ready and in IDLE) pub TASK? ( -- task ) 8 BEGIN 1- DUP TASK @ $1.0000 = OVER 0< OR UNTIL ; \ USAGE: ' MYTASK TASK? RUN pub RUN ( pfa cog -- ) DUP 0 7 WITHIN IF TASK W! ELSE CR ." Error - cog out of range " THEN ; ( *** INTERTASK COMMUNICATIONS *** ) { USAGE: Communications can be effected by means of an equivalent to KEY and EMIT which are used in serial communications. So rather than these the indexable words ENQ@ adn ATN! } ( To listen for a command ) \ ATN? ( -- cmd ) read in a command from the tasks variable and return with it and also clear the tasks variable pub ATN? \ alias for newer command ATN@ pub ATN@ ( -- cmd ) COGID TASK 4 + DUP W@ 0 ROT W! \ Clear the command (ack) ; ( To send a response ) pub ENQ! ( data -- ) COGID TASK 6 + W! ; ( To talk to tasks in other cogs ) \ Use this in place of "cmd n RUN" pub ATN! ( cmd cog -- ) TASK 4 + W! ; ( To listen to tasks in other cogs ) pub ENQ@ ( cog -- data ) TASK 6 + DUP W@ 0 ROT W! \ clear data (ack) ; \ List tasks pub TASKS 8 0 DO I TASK 2+ C@ DUP IF .INDEX I TASK W@ ?DUP IF PFA>NFA DUP .STR BL SWAP STRLEN - SPACES ELSE ." IDLE" #28 SPACES THEN THEN I COGID = DUP IF .INDEX ." CONSOLE" #25 SPACES THEN OR IF I TASK DUP W@ .WORD SPACE 2+ 6 ADO I C@ .BYTE SPACE LOOP THEN LOOP ; \ ********************************* pub ALIGN ( n align -- n1 ) 1- SWAP OVER + SWAP ANDN ; ; \ Type out a string for cnt pub TYPE ( str cnt -- ) ADO I C@ EMIT LOOP ; \ Simple PIN set and clear operations - also set's pin to an output pub PINSET ( pin -- ) MASK OUTSET ; pub PINCLR ( pin -- ) MASK OUTCLR ; \ Switch PIN to an input pub PININP ( pin -- ) MASK INPUTS ; \ Build up a mask using a starting pin number and the number of consecutive pins \ Useage: #16 8 MASKS CONSTANT dbus pub MASKS ( pin cnt -- mask ) 0 ROT ROT ADO I MASK OR LOOP ; \ Set or clear the bits of a long in memory that match the bit mask. pub LBIT! ( mask addr state -- ) >L SWAP OVER @ L> IF OR ELSE SWAP ANDN THEN SWAP ! ; \ Fill longs at addr for long cnt with longval pub LONGFILL ( addr cnt longval -- ) 3RD ! \ Store long at start address OVER 4 + \ Set destination as next long address SWAP 1- 2* 2* \ Adjust to byte count less the first long CMOVE \ and copy over and over itself ; \ Modulo remainder of n1/mod pub MOD ( n1 mod -- rem ) U/MOD DROP ; \ Program pausing - (NOTE: these definitions are cascaded, do not separate) pub second ( n1 - ) pub seconds ( n1 -- ) 1000d * ms ; pub COPY$ ( str1 str2 -- ) OVER STRLEN 1+ CMOVE ; pub COMPARE$ ( str1 str2 cnt -- flg ) ADO C@++ I C@ <> IF DROP 0 LEAVE THEN LOOP 0<> ; pub |< ( bit -- mask ) MASK ; pub >| ( mask -- bit ) BL 0 DO 2/ DUP 0= IF DROP I LEAVE THEN LOOP ; \ true if n1 is equal to or greater than n2 pub => ( n1 n2 -- flg ) 1- > ; pub <= ( n1 n2 -- flg ) SWAP => ; \ Increment and decrement variables pub ++ ( addr -- ) 1 SWAP +! ; pub -- ( addr -- ) -1 SWAP +! ; pub W++ ( addr -- ) 1 SWAP W+! ; pub W-- ( addr -- ) -1 SWAP W+! ; pub C++ ( addr -- ) 1 SWAP C+! ; pub C-- ( addr -- ) -1 SWAP C+! ; \ Clear and set variable pub ~ ( addr -- ) 0 SWAP ! ; pub ~~ ( addr -- ) -1 SWAP ! ; pub W~ ( addr -- ) 0 SWAP W! ; pub W~~ ( addr -- ) -1 SWAP W! ; pub C~ ( addr -- ) 0 SWAP C! ; pub C~~ ( addr -- ) -1 SWAP C! ; \ Fetch long and print number pub @. ( addr -- ) @ U. ; pri LISTKEY ( flg -- flg ) KEY? IF DUP BL = IF DROP KEY $1B = OR EXIT THEN DUP 1B = IF 2DROP TRUE EXIT THEN DROP THEN DROP ; \ Quick WORDS - a simpler and more compact listing of the current dictionary pub QWORDS CR 0 names W@ BEGIN 1+ \ Each V2 entry now includes a count byte - so skip this SWAP OVER STRLEN + 1+ DUP #100 > IF CR DROP OVER STRLEN 1+ THEN SWAP DUP .STR BL EMIT NFA>CFA 2+ SWAP 1+ SWAP DUP C@ 0= DUP IF SWAP 1+ DUP C@ 0= ROT AND THEN LISTKEY UNTIL 2DROP CR ; TABLE atrs "$" | "r" | ":" | "W" | "?" | "?" | "?" | "?" | pub .ATRS DUP $40 AND IF ." c" ELSE ." ." THEN DUP $20 AND IF ." I" ELSE ." ." THEN DUP $10 AND IF ." x" ELSE ." ." THEN 7 AND atrs + C@ EMIT SPACE ; { byte DUP,CFETCH,ZEQ,DUP,_IF,07,SWAP,INC,DUP,CFETCH,ZEQ,ROT,_AND,_IF,@wd03-@wd02 wd02 byte DROP,XCALL,xCR,EXIT wd03 byte XCALL,xCR,DUP,XCALL,xPRTWORD,XCALL,xPRTSTR,": ",0 byte INC,DUP,XCALL,xNFACFA,DEC,DUP,_3 byte ADO,XCALL,xI,CFETCH,XCALL,xPRTBYTE,XCALL,xSPACE,LOOP byte _3,PLUS,SWAP,XCALL,xPSTR,XCALL,xSPACE,_AGAIN,@wd04-@wdlp wd04 } "?" NFA' WORDS 1+ C! \ disable reference to kernel WORDS pub WORDS CR ." NFA PFA EXT ATRS NAME " CR ." ----------------------- " \ 23F3 52F3 Y9B ...: WORDS names W@ 1+ BEGIN CR DUP .WORD SPACE DUP NFA>CFA ( nfa cfa ) DUP >PFA .WORD SPACE DUP C@ ' (XCALL) = IF DUP 1+ C@ ." X" .BYTE ELSE DUP C@ ' (YCALL) = IF DUP 1+ C@ ." Y" .BYTE ELSE 3 SPACES THEN THEN SPACE DUP 1- C@ .ATRS SWAP .STR 9 EMIT 3 + DUP C@ 0= DUP IF SWAP 1+ DUP C@ 0= ROT AND THEN LISTKEY UNTIL DROP ; pub MODULES CR ." MODULES LOADED: " names W@ BEGIN DUP C@ 4 > IF DUP C@ 3 - OVER + U@ $6874662E = IF DUP NFA>CFA >PFA CR .WORD ." : " DUP 1+ DUP .STR STRLEN #20 SWAP - SPACES \ display the module name and try to line up the description DUP NFA>CFA C@++ SWAP C@ EXECUTE \ execute the .fth word as it will display it's description THEN THEN 1+ NFA>CFA 2+ DUP C@ 0= UNTIL DROP CR ; : .MAP DUP 0= IF DROP ." .." EXIT THEN DUP $FF = IF DROP ." ##" EXIT THEN .BYTE ; \ Map memory in 64 byte chunks by OR'ing bytes and printing byte result/64 bytes : MAP ( src cnt -- ) ADO CR I .WORD ." : " I $400 ADO 0 I #64 ADO I C@ + LOOP 6 SHR .MAP SPACE #64 +LOOP $400 +LOOP ; : RMAP 0 $8000 MAP ; ( *** PBASIC STYLE SERIAL I/O *** ) \ Set the baudrate for SEROUT and SERIN \ baudcnt is a task register so each cog can have it's own baudrate (if used) pub SERBAUD ( baud -- ) CLKFREQ SWAP / baudcnt ! ; \ Bit-bashed Serial output - transmit asynchronous data \ Fixed start bit timing \ Code size: 18 bytes \ Tested to 250K baud pub SEROUT ( data pin -- ) MASK DUP OUTSET \ ensure pin is an output (very first time perhaps) SWAP 2* \ Include start bit (0) baudcnt @ DELTA \ setup delay and wait 9 FOR WAITCNT SHROUT NEXT \ data bits DROP WAITCNT OUTSET \ final stop bit ; \ Bit-bashed Serial input - receive asynchronous data pub SERIN ( pin -- data ) MASK DUP INPUTS DUP baudcnt @ 2/ SWAP WAITPNE DELTA baudcnt @ DELTA \ delay to sample 1 bit later in 1st data bit 0 8 FOR SHRINP WAITCNT NEXT NIP #24 SHR \ right justify 8-bit data ; \ Change output device back to the default CONSOLE pub CON uemit W~ ; ( *** CONVERSION *** ) \ Conversion between longs, words, bytes : >W ( long -- word ) $FFFF AND ; : >B ( word -- byte ) $FF AND ; : L>W ( long - loword hiword ) DUP >W SWAP #16 SHR ; : W>B ( word - lobyte hibyte ) DUP >B SWAP 8 SHR >B ; : W>L ( loword hiword -- long ) #16 SHL OR ; : B>W ( lobyte hibyte -- word ) 8 SHL OR ; : B>L ( lobyte byte2 byte3 byte4 -- long ) B>W >L B>W L> W>L ; ( *** NUMBER PRINT FORMATING *** ) { Format the number as to it's base, the number of digits, whether it's signed, and should it have separators This is a very versatile print number routine and can be incorporated into other print words A single word is passed with options: b07..00 = base b13..08 = digits b14 = force separators (decimals have a , every 3 places while others have a _ every 4 places) b15 = force sign (always + or - depending upon the number) Usage: $C00A will force separators, sign, no leading zeros (0 digits), and a base of 10 i.e. 0 @ $C00A .NUM +80,000,000 ok $4810 will force separators, no sign, and 8 digits with a base of 16 i.e. 0 @ $4810 .NUM 04C4_B400 ok } \ Check and insert separators (subfunction of .NUM) pri (SEP) I IF 1 REG C@ $40 AND 0EXIT base C@ 10d = IF I 3 MOD 0= IF "," HOLD THEN ELSE I 4 MOD 0= IF "_" HOLD THEN THEN THEN ; { - testing VARIABLE sep pri InitSep ( digits base -- digits base ) DUP #10 = IF $2C03 sep W! THEN DUP ":" = IF DROP #10 $3A02 sep W! THEN DUP "/" = IF DROP #10 $2F02 sep W! THEN } pub .NUM ( sign+sep+digits;base -- ) W>B SWAP \ InitSep base C@ >L \ backup base base C! 0 REG C~ \ clear prefix for sign DUP 1 REG C! \ save sign+sep+digits byte DUP $80 AND \ signed? IF OVER 0< IF "-" ELSE "+" THEN 0 REG C! THEN <# $3F AND ?DUP IF 0 DO (SEP) # LOOP ELSE $20 0 DO (SEP) # DUP 0= IF LEAVE THEN LOOP THEN 0 REG C@ ?DUP IF HOLD THEN #> .STR L> base C! ; pub U.N ( data digits -- ) <# FOR # NEXT #> .STR ; pub .LAP LAPCNT DUP #999,999 > IF #1,000 / " ms" ELSE " us" THEN SWAP $400A .NUM .STR ; ( *** EXAMINE SPECIAL PURPOSE REGISTERS *** ) pri REG$ ( index -- addr ) 2 SHL " PAR CNT INA INB OUTAOUTBDIRADIRBCTRACTRBFRQAFRQBPHSAPHSBVCFGVSCL" + ; \ Dump the cog's SPRs with labels pub SPRS $10 0 DO CR I $1F0 + .WORD ." : " I REG$ 4 ADO I C@ EMIT LOOP ." = $" I SFR@ DUP $4810 .NUM ." %" $6002 .NUM LOOP ; pri .PIN MASK AND 0<> 1 AND IF ." 1" ELSE ." *" THEN ; \ List out each of the Prop's I/O pins & their direction) pub PINS? CR ." +----------u----------+" P@ DIRA COG@ #16 0 DO CR ." P" I $20A .NUM DUP I MASK AND IF ." -->" ELSE ." <--" THEN SPACE OVER I .PIN 5 SPACES OVER #31 I - .PIN DUP #31 I - MASK AND IF ." <-- P" ELSE ." --> P" THEN #31 I - $20A .NUM LOOP CR ." +---------------------+" 2DROP ; ( *** COUNTERS *** ) { USAGE: A #19 APIN #1000 HZ B #28 APIN DUTY 7 PLLDIV $4000_0000 FRQ } BYTE ctr \ latch the selected counter A or B (0 or 1) pri CTR ( -- addr ) CTRA ctr C@ + ; pri CTR! ( val -- ) CTR COG! ; pri CTR@ ( -- val ) CTR COG@ ; { Select the desired target CTR A or B before use } pub A ctr C~ ; pub B 1 ctr C! ; \ Set NCO counter mode pub NCO 4 pub CTRMODE ( n -- ) #26 SHL \ Shift n left 26 bits CTR@ \ Read current CTR so we can OR our data in with it $1F #26 SHL \ Mask out $1F<<26 bits ready for OR'ing ANDN \ mask it OR \ blend in our value CTR! \ save it to the current CTR ; \ Duty counter mode pub DUTY 6 CTRMODE ; pub PLL 2 CTRMODE ; pub PLLDIV ( n -- ) #23 SHL \ move up to the PLLDIV field in the CTR CTR@ \ mask out this field ready for merging 7 #23 SHL ANDN OR \ merge it CTR! \ save it ; pub APIN ( pin -- ) \ Set the APIN of the current CTR DUP PINCLR CTR@ $1F ANDN OR CTR! ; pub BPIN ( pin -- ) \ Set the BPIN of the current CTR DUP PINCLR 9 SHL CTR@ $1F 9 SHL ANDN OR CTR! ; pub FRQ ( n -- ) \ Set the value of the current FRQ (A or B) FRQA ctr C@ + COG! ; \ Write an 8-bit value to the pin as a duty cycle - filter output for a voltage pub DAC! ( byte pin -- ) DUP PINCLR APIN DUTY #24 SHL FRQ ; { Generate frequencies via NCO mode - only need to select A or B beforehand Pin number can be changed anytime Multiply hz by 53.6870912 to convert from Hz to FRQ value NOTE: Some of these definitions cascade into the next rather than call and exit } pub MHZ ( MHz -- ) #1000 * pub KHZ ( khz -- ) #1000 * pub HZ ( hz -- ) NCO ... DUP #53 * SWAP #10000 / #6871 * + ... FRQ ; pub MUTE OFF CTRMODE ; ( *** BACKGROUND COG FUNCTIONS *** ) { COUNTER TIMERS - BACKGROUND COG POLLING Soft timers are primarily count down to zero and stop with an optional autoexecute vector Elapsed runtime time is also maintained TIMER STRUCTURE: 00: timer long in milliseconds 04: timeout vector 06: flags or data USAGE: ( Create 8 countdown timers and assign a BLINKY function to timer 0 ) \ NOTE: this first part is started up automatically in 120916 onwards. \ Allocate space for 8 timers at 8 bytes each TABLE mytimers #64 ALLOT \ pass parameters to start timer task mytimers 8 RUNTIMERS \ demo LED flasher which takes 5 seconds before it starts flashing every 100ms WORD blinky : BLINKY #16 PIN@ 0= #16 PIN! \ toggle pin 16 blinky W@ 0 TIMEOUT \ reload timer ; \ Setup the timeout vector for TIMER 0 ' BLINKY 0 ALARM \ Write a reload value to timer's memory which we can change anytime #100 blinky W! \ Setup timer 0 to timeout in 5 seconds #5,000 0 TIMEOUT } LONG runtime WORD timers BYTE timercnt pub TIMER ( channel -- addr ) 3 SHL timers W@ + ; pub TIMEOUT ( ms channel -- ) TIMER ! ; pub TIMEOUT? ( channel -- flg ) TIMER @ 0= ; pub ALARM ( pfa channel -- ) TIMER 4 + W! ; pri TIMERTASK runtime ~ 0 TIMER timercnt C@ 3 SHL ERASE \ clear out garbage CLKFREQ #1000 / DELTA \ every millisecond BEGIN \ 172us / outer loop measured with a blinky timer 1 runtime +! \ elapsed time since last reset timercnt C@ 0 DO I TIMER @ ?DUP \ count if it's non-zero IF 1- DUP I TIMER ! \ update 0= IF I TIMER 4 + W@ ?DUP \ on timeout check for action IF CALL THEN THEN \ execute if set THEN LOOP WAITCNT AGAIN ; pub RUNTIMERS ( table cnt -- ) timercnt C! timers W! ' TIMERTASK TASK? RUN ; ( *** 8 channel 8-bit PWM *** ) { This method scans through a byte wide table of 256 entries to update 1 to 8 channels at a time. The table is written with bit patterns to determine when an output should be on or off. The 256 byte length of the table determines it's resolution which is 8-bits. In this example a PWM module is used (13 PASM instructions) to bit-bash the outputs directly from the table. Since it is running directly from the cog it is capable of much higher speed than bytecode alone. This version is set to run up to 8 channels of 8-bit PWM at 1kHz (Tested to 5kHz) Use kernel V2.0 120913.1845 upwards USAGE: ( implement 8 PWM channels on P0..P7 ) \ setup area for PWM values TABLE pwm #256 ALLOT \ Set the frequecy #1000 PWMFREQ \ Start up PWM using from P0 for 8 channels 0 8 pwm RUNPWM \ Set PWM channel 0 for 50% $80 0 PWM! \ Set PWM channel 7 for 25% #25 % 7 PWM! } BYTE pwmpins,pwmchans WORD pwmtbl,pwmfreq \ Task that runs the PWM engine in a COG pri PWMCOG pwmpins C@ pwmchans C@ MASKS OUTCLR pwmtbl W@ 0 COGREG! pwmpins C@ 1 COGREG! [PWM] \ load PWM runtime module pwmfreq W@ RUNMOD \ and run it ; \ Start up a task to run the multichannel PWM "object" \ ' PWMCOG CONSTANT #pwmcog pub RUNPWM ( pin channels table -- ) pwmtbl W! pwmchans C! pwmpins C! ' PWMCOG TASK? RUN ; \ Convert a frequency to counts for use in WAITCNT : PWMFREQ ( hz -- ) CLKFREQ SWAP / 8 SHR pwmfreq W! ; \ PWM Runtime interface words \ Write table pattern required for this channel's duty cycle \ Execution time is about 2.3ms as it writes in the patterns in the 256 byte table IFNDEF [PWM!] pub PWM! ( duty8 channel -- ) MASK pwmtbl W@ 3RD ADO I C@ OVER OR IC! DROP LOOP \ Set ON times in table pwmtbl W@ ROT + pwmtbl W@ $100 + SWAP DO I C@ OVER ANDN IC! DROP LOOP \ Set OFF times in remainder of table DROP ; } IFNDEF PWM! \ New kernel module method to speed-up updates = 233us total pub PWM! ( duty8 channel -- ) MASK pwmtbl W@ [PWM!] RUNMOD ; } pub % ( %duty -- dutyval ) 8 SHL #100 / ; ( *** I2C BUS *** ) { I2C bus routines are bit-bashed and run at a bus speed of 400kHz. This is a standard single master with no clock stretching used } \ I/O "Constants" - variable to allow for redirection #P28 |< CONSTANT SCL #P29 |< CONSTANT SDA \ Assign the Prop's EEPROM pins (default) pub EEPROM #P29 #P28 \ Assign the pins to use for the I2C bus pub I2CPINS ( sda scl -- ) MASK ' SCL 1+ ! MASK ' SDA 1+ ! ; \ I2C START CONDITION also makes I2C pins outputs \ : I2CST \ ** deprecated in favor of readability pub I2CSTART SCL @SCK COGREG! \ setup clock SDA INPUTS SCL OUTSET SDA OUTCLR SCL OUTCLR ; \ I2C STOP CONDITION also releases I2C lines \ : I2CSP \ ** deprecated in favor of readability pub I2CSTOP SDA OUTCLR SCL OUTSET SDA INPUTS ; \ Write a byte to the I2C bus and return with the ack flag \ This routine runs at an I2C speed of 400kHz pub I2C!? ( data -- flg ) \ write a byte to the I2C bus and return with the ack (0=ack) #24 REV \ put into lsb first format for SHROUT SDA DUP OUTSET SWAP \ data masks 8 FOR SHROUT \ Shift out next data bit CLOCK NOP CLOCK NEXT \ loop DROP DUP INPUTS \ Float SDA CLOCK IN 0<> CLOCK \ ack clock ; \ Write to the I2C bus but ignore the ack \ This version has a faster cycle time as it clocks but does not check for ack pub I2C! ( data -- ) \ write a byte to the I2C bus #24 REV \ put into lsb first format for SHROUT SDA DUP OUTSET SWAP \ data masks 8 FOR SHROUT \ Shift out next data bit CLOCK NOP CLOCK NEXT \ loop DROP INPUTS \ Float SDA CLOCK NOP CLOCK \ dummy ack clock ; \ Fetch a byte from the I2C bus - mirror ack signal 0 in = 0 out pub I2C@ ( ack -- data ) SDA DUP INPUTS 0 ( ack iomask dat ) 8 FOR CLOCK SHRINP CLOCK NEXT ROT 0= IF OVER OUTCLR THEN CLOCK NOP CLOCK SWAP INPUTS #24 SHR #24 REV ; \ SLOW I2C! (100kHz) \ This routine runs at a slow I2C speed of >125kHz pub SI2C!? ( data -- ) \ write a byte to the I2C bus and return with the ack (0=ack) #24 REV \ put into lsb first format for SHROUT SCL SWAP SDA DUP OUTSET SWAP \ position clock and data masks ( scl sda dat ) 8 FOR SHROUT \ Shift out next data bit 3RD OUTSET 3RD OUTCLR \ clock NEXT \ loop DROP DUP INPUTS \ Float SDA OVER OUTSET IN SWAP OUTCLR \ ack clock ; pub SI2C! SI2C!? DROP ; \ SLOW I2C@ (100kHz) \ Fetch a byte from the I2C bus - mirror ack signal 0 in = 0 out pub SI2C@ ( ack -- data ) SDA DUP INPUTS 0 ( ack iomask dat ) 8 FOR CLOCK 0 DROP SHRINP CLOCK 0 DROP NEXT ROT 0= IF OVER OUTCLR THEN CLOCK 0 DROP CLOCK SWAP INPUTS #24 SHR #24 REV ; ( Scan I2C bus at 100kHz for devices and report ) pub I2CBUS I2CSTOP $100 0 DO I2CSTART I I2C!? 0= I2CSTART I SI2C!? 0= IF CR IF ." Fast" ELSE ." Slow" THEN ." Device at " I .WORD 2 SPACES I2CSTART I 1+ SI2C! 8 FOR 0 SI2C@ .BYTE SPACE NEXT 1 SI2C@ I2CSTOP THEN DROP 2 +LOOP ; ( *** EEPROM *** ) \ EEPROM addressing - select default device and write 16-bit address \ Updated to take an address >64K and automatically select the next device \ REG #29 = device latch (taken from long address) pri @EE ( addr -- flg ) I2CSTOP L>W 2* $A0 + DUP #29 REG C! I2CSTART I2C!? OVER 8 SHR I2C!? OR SWAP I2C!? OR ; \ Switch EEPROM to read mode pri EERD ( -- flg ) I2CSTART #29 REG C@ 1+ I2C!? ; \ Store byte to EEPROM pub EE! ( byte addr -- ) @EE DROP I2C! I2CSTOP ; \ Fetch byte from EEPROM pub EE@ ( addr -- byte ) @EE DROP EERD DROP 1 SI2C@ I2CSTOP ; \ read last byte (no ack) and stop pri ENDRD ( -- ) 1 SI2C@ DROP I2CSTOP ; \ Hex dump of EEPROM - uses sequential EEPROM reading so use word buffer to hold 16 bytes for ASCII column pub EDUMP ( addr cnt -- ) I2CSTOP OVER @EE EERD OR IF 2DROP ." BAD RESPONSE FROM EEPROM " ELSE ADO .INDEX word $10 ADO 0 I2C@ DUP .BYTE SPACE I C! LOOP 2 SPACES word $10 ADO I C@ DUP BL $7E WITHIN IF EMIT ELSE DROP ." ." THEN LOOP #16 +LOOP ENDRD THEN ; \ Will backup 32K to EEPROM in 4.963 seconds \ Save a block of RAM to EEPROM pub ESAVE ( ram eeprom cnt -- ) $3F + $3F ANDN \ round up to nearest 64 byte page ROT SWAP \ use ram address for loop index ADO BEGIN DUP @EE 0= UNTIL 0 I #64 ADO I C@ I2C!? OR LOOP I2CSTOP \ Write 64 bytes and check acks IF $0D EMIT ." FAIL @" DUP .WORD THEN SPINNER \ Just let the poor human know we're busy #64 + #64 +LOOP DROP ; \ byte by byte method - safer for non-page aligned addresses and counts pub ESAVEB ( ram eeprom cnt -- ) ADO C@++ I EE! 5 ms SPINNER LOOP DROP ; \ Load a block of EEPROM to RAM \ Will load 32K from EEPROM in 4.325sec pub ELOAD ( eeprom ram cnt -- ) ROT BEGIN @EE 0= UNTIL EERD DROP \ select the device - might have to wait ADO 0 I2C@ I C! LOOP \ sequential reading from EEPROM into RAM ENDRD \ signal last byte read ; $7FC0 CONSTANT eebuf \ Just need a page aligned area in RAM - this should be ok pub EECOPY ( eesrc eedst cnt -- ) ADO DUP eebuf #64 ELOAD eebuf I #64 ESAVE 5 ms #64 + #64 +LOOP DROP ; pub EFILL ( src cnt ch -- ) SWAP 0 DO ( src ch ) BEGIN OVER @EE 0= UNTIL $40 FOR DUP I2C! NEXT I2CSTOP SWAP $40 + SWAP $40 +LOOP 2DROP ; pub EVERIFY ( ram cnt -- ) OVER @EE DROP EERD DROP ADO 0 I2C@ DUP I C@ <> IF .INDEX I C@ .BYTE SPACE .BYTE ELSE DROP THEN LOOP ENDRD ; pub 64K? ( -- flg ) VER $8006 + EE@ \ hold onto high memory byte VER 6 + EE@ \ read low memory byte DUP 1+ VER $8006 + EE! \ write modified version to high memory 5 ms VER 6 + EE@ = \ low memory should still different (original) SWAP VER $8006 + EE! \ restore original byte 5 ms ; \ V2 - Backup the current Tachyon Forth session pub BACKUP EEPROM 64K? IF 0 $8000 $7FC0 EECOPY THEN \ backup first 32K of EEPROM if 64 is available 0 0 NFA' *end* $40 ALIGN OVER - ESAVE ; \ Only backup if there are no errors recorded pub ?BACKUP errors C@ ?EXIT BACKUP ; \ This will restore the previous backup from the top 32K if it is a 64K EEPROM pub RESTORE 64K? VER 2+ EE@ VER $8002 + EE@ = AND IF $8000 0 $7FC0 EECOPY REBOOT THEN ; \ Set TACHYON's baudrate for next reboot (or hit ^C or send break to reboot now) pub CONBAUD ( baud -- ) VER 8 + SWAP OVER ! 4 ADO I C@ I EE! #10 ms LOOP ; pub INTERRUPT ( state index -- ) MASK VER #12 + ROT LBIT! ; pub INTVEC ( addr index -- ) 2 SHL VER #16 + + W! ; pub INTMASK ( mask -- ) 9 COGREG! ; pub INH ( on/off -- ) 9 COGREG@ #31 MASK ROT IF OR ELSE ANDN THEN 9 COGREG! ; { 00 clkfreq 04 clkmode 05 chksum 06 pbase 08 vbase 0A dbase 0C pcurr 0E dcurr } BYTE cksum \ Dump memory in Intel hex format so that a binary can be created on a PC \ but calculate the checksum of a Propeller binary image first : IDUMP ( src cnt --- ) BEGIN OVER @EE 0= UNTIL EERD DROP ADO cksum C~ \ Proceed with Intel hex dump CR ":" EMIT #16 DUP cksum C+! .BYTE I $FF AND cksum C+! I 8 SHR $FF AND cksum C+! I $FFFF AND .WORD 0 .BYTE I #16 ADO 0 I2C@ DUP cksum C+! .BYTE LOOP cksum C@ NEGATE .BYTE #16 +LOOP CR ." :00000001FF" CR ENDRD ; \ Fix the binary header and checksum so that the Spin tool will recognize the final binary pub FIXCKSUM ( src cnt -- ) 2DUP + DUP 8 W! 8 + $0A W! \ vbase = end; dbase = end+8 $0A W@ 4 + $0E W! \ dcurr = dbase+4 cksum C~ 5 C~ \ zero our cksum and the header's checksum 0 0 $10 ESAVEB OVER @EE DROP EERD DROP ADO 0 I2C@ cksum C+! LOOP \ add up all the bytes in memory ENDRD $14 cksum C@ - 5 EE! \ adjust and update header's checksum ; \ Adjust and dump the current Tachyon binary image in Intel hex format for conversion at the PC end to a bin file pub BINARYDUMP 0 HERE $FF + $FF ANDN 2DUP FIXCKSUM IDUMP ; \ ************************************************ pub .RUNTIME CR ." Runtime since last reset = " runtime @ $400A .NUM ." ms " ; pub .VECTORS 0 XCALLS 800 ADO I W@ 0= 1 AND + 2 +LOOP CR ." CALLS: " .DEC ." vectors free" ; pri .added ?DUP IF ." (" .DEC ." bytes added)" THEN ; pri .free ." with " .DEC ." bytes free" ; pub END CR CR ." End of source code, " lines W@ .DEC ." lines processed and " errors W@ DUP IF BELL THEN .DEC ." errors found " CR ." Load time = " .LAP 2 flags CLR CR pub STATS CR ." NAMES: $" names W@ DUP .WORD ." ..." NFA' *end* DUP .WORD ." for " OVER - DUP .DEC names 2- W@ OVER - .added names W@ XCALLS $804 + - .free ( namesize ) CR ." CODE: $" 0 .WORD ." ..." HERE .WORD ." for " HERE SWAP - .DEC HERE here 2- W@ - .added $8000 HERE - .free .VECTORS CR BELL ; pub INFO .VER CR ." Clock frequency = " CLKFREQ $400A .NUM MODULES CR ." Tasks " TASKS CR ." Status " STATS CR ." I2C BUS SCAN " I2CBUS CR CR ." I/O Port states " PINS? CR ." Special function registers " SPRS \ CR ." Hub RAM Memory map " 0 $8000 MAP ; \ Setup the background timer task with 8 timers TABLE exttimers #64 ALLOT \ Startup code for background pub BOOT TASK? 7 = IF exttimers 8 RUNTIMERS THEN STATS MODULES ; \ pub COLD 7 STOP COLD ; AUTORUN BOOT ]~ \ HS-SerialRxL will intercept this and stop filtering comments etc and return to transparent mode END \ preset some defaults before backup A ... EEPROM ... 9600d SERBAUD runtime ~ ?BACKUP