; ---------------------------------------------------------------------- ; 4e4th is a Forth based on CamelForth ; for the Texas Instruments MSP430 ; ; This program is free software; you can redistribute it and/or modify ; it under the terms of the GNU General Public License as published by ; the Free Software Foundation; either version 3 of the License, or ; (at your option) any later version. ; ; This program is distributed in the hope that it will be useful, ; but WITHOUT ANY WARRANTY; without even the implied warranty of ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ; GNU General Public License for more details. ; ; You should have received a copy of the GNU General Public License ; along with this program. If not, see . ; ; See LICENSE TERMS in Brads file readme.txt as well. ; ---------------------------------------------------------------------- ; 4e-core430.s43 - Machine Language Primitives (CPU Instruction Set) ; ---------------------------------------------------------------------- ; Revision History ; 1 mar 09 bjr - changed Flash write and erase primitives to correctly ; write RAM outside Info Flash and Main Flash address limits. ; ---------------------------------------------------------------------- ; INTERPRETER LOGIC ; ITC NEXT is defined as ; MOV @IP+,W ; 2 fetch word address into W ; MOV @W+,PC ; 2 fetch code address into PC, W=PFA ;C EXECUTE i*x xt -- j*x execute Forth word at 'xt' HEADER EXECUTE,7,'EXECUTE',DOCODE MOV TOS,W ; 1 put word address into W MOV @PSP+,TOS ; 2 fetch new TOS MOV @W+,PC ; 2 fetch code address into PC, W=PFA ;Z lit -- x fetch inline literal to stack ; This is the primtive compiled by LITERAL. HEADER lit,3,'lit',DOCODE SUB #2,PSP ; 1 push old TOS.. MOV TOS,0(PSP) ; 4 ..onto stack MOV @IP+,TOS ; 2 fetch new TOS value NEXT ; 4 ;C EXIT -- exit a colon definition HEADER EXIT,4,'EXIT',DOCODE MOV @RSP+,IP ; 2 pop old IP from return stack NEXT ; 4 ; ---------------------------------------------------------------------- ; DEFINING WORDS - ROMable ITC model ; DOCOLON enters a new high-level thread (colon definition.) ; (internal code fragment, not a Forth word) PUBLIC DOCOLON DOCOLON: PUSH IP ; 3 save old IP on return stack MOV W,IP ; 1 set new IP to PFA NEXT ; 4 ;C VARIABLE -- define a Forth VARIABLE ; CREATE CELL ALLOT ; ; Action of ROMable variable is the same as CREATE; it builds a ; constant holding the RAM address. See CREATE in hilvl430.s43. HEADER VARIABLE,8,'VARIABLE',DOCOLON DW CREATE,CELL,ALLOT,EXIT ;C CONSTANT -- define a Forth constant ; (machine code fragment) ; Note that the constant is stored in Code space. HEADER CONSTANT,8,'CONSTANT',DOCOLON DW BUILDS,ICOMMA,XDOES ; DOCON, code action of CONSTANT, ; entered with W=Parameter Field Adrs ; This is also the action of VARIABLE (Harvard model) ; This is also the action of CREATE (Harvard model) PUBLIC DOCON PUBLIC docreate PUBLIC DOVAR docreate: ; -- a-addr ; ROMable CREATE fetches address from PFA DOVAR: ; -- a-addr ; ROMable VARIABLE fetches address from PFA DOCON: ; -- x ; CONSTANT fetches cell from PFA to TOS SUB #2,PSP ; make room on stack MOV TOS,0(PSP) MOV @W,TOS ; fetch from parameter field to TOS NEXT ; DOCREATE's action is for a table in RAM. ; DOROM is the code action for a table in ROM; ; it returns the address of the parameter field. PUBLIC DOROM DOROM: ; -- a-addr ; Table in ROM: get PFA into TOS SUB #2,PSP MOV TOS,0(PSP) MOV W,TOS NEXT ;Z USER n -- define user variable 'n' ; (machine code fragment) Flashable model HEADER USER,4,'USER',DOCOLON DW BUILDS,ICOMMA,XDOES PUBLIC DOUSER DOUSER: ; -- a-addr ; add constant to User Pointer, result in TOS SUB #2,PSP MOV TOS,0(PSP) MOV @W,TOS ADD &UP,TOS NEXT ; DOALIAS used to build a word which performs the action of ; another word. Its action is to fetch the "alias" CFA from ; the parameter field, and execute that, e.g. DOES> I@ EXECUTE ; ; This is currently used only within the Forth kernel. PUBLIC DOALIAS DOALIAS: ; -- ; fetch CFA of word to execute MOV @W,W ; 2 fetch from parameter field to W MOV @W+,PC ; 2 fetch code address into PC, W=PFA ; DODOES is the code action of a DOES> clause. For ITC Forth: ; defined word: CFA: doescode ; PFA: parameter field ; ; doescode: MOV #DODOES,PC ; 16-bit direct jump, in two cells ; high-level thread ; ; Note that we use JMP DODOES instead of CALL #DODOES because we can ; efficiently obtain the thread address. DODOES is entered with W=PFA. ; It enters the high-level thread with the address of the parameter ; field on top of stack. PUBLIC dodoes dodoes: ; -- a-addr ; 3 for MOV #DODOES,PC SUB #2,PSP ; 1 make room on stack MOV TOS,0(PSP) ; 4 MOV W,TOS ; 1 put defined word's PFA in TOS PUSH IP ; 3 save old IP on return stack MOV -2(W),IP ; 3 fetch adrs of doescode from defined word ADD #4,IP ; 1 skip MOV instruction to get thread adrs NEXT ; 4 ; OPTION 1 ; OPTION 2 ; MOV #DODOES,PC 3 ; CALL #DODOES 5 ; ... ; ... ; PUSH IP 3 ; POP W 2 ; MOVE -2(W),IP 3 ; PUSH IP 3 ; ADD #4,IP 1 ; MOV W,IP 1 ; ---------------------------------------------------------------------- ; STACK OPERATIONS ;C DUP x -- x x duplicate top of stack HEADER DUP,3,'DUP',DOCODE PUSHTOS: SUB #2,PSP ; 1 push old TOS.. MOV TOS,0(PSP) ; 4 ..onto stack NEXT ; 4 ;C ?DUP x -- 0 | x x DUP if nonzero HEADER QDUP,4,'?DUP',DOCODE CMP #0,TOS ; 1 test for TOS nonzero JNZ PUSHTOS ; 2 NODUP: NEXT ; 4 ;C DROP x -- drop top of stack HEADER DROP,4,'DROP',DOCODE MOV @PSP+,TOS ; 2 NEXT ; 4 ;C SWAP x1 x2 -- x2 x1 swap top two items HEADER SWAP,4,'SWAP',DOCODE MOV @PSP,W ; 2 MOV TOS,0(PSP) ; 4 MOV W,TOS ; 1 NEXT ; 4 ;C OVER x1 x2 -- x1 x2 x1 per stack diagram HEADER OVER,4,'OVER',DOCODE MOV @PSP,W ; 2 SUB #2,PSP ; 2 MOV TOS,0(PSP) ; 4 MOV W,TOS ; 1 NEXT ; 4 ;C ROT x1 x2 x3 -- x2 x3 x1 per stack diagram HEADER ROT,3,'ROT',DOCODE MOV @PSP,W ; 2 fetch x2 MOV TOS,0(PSP) ; 4 store x3 MOV 2(PSP),TOS ; 3 fetch x1 MOV W,2(PSP) ; 4 store x2 NEXT ; 4 ;X NIP x1 x2 -- x2 per stack diagram HEADER NIP,3,'NIP',DOCODE ADD #2,PSP ; 1 NEXT ; 4 ; Das funktioniert, weil TOS im Register ist. ; TOS beleibt dort unverändert, derweil der PSP um eins erhöht wird. ; Das entspricht einem DROP ohne den TOS neu zu laden. ; cool. mk ;C >R x -- R: -- x push to return stack HEADER TOR,2,'>R',DOCODE PUSH TOS MOV @PSP+,TOS NEXT ;C R> -- x R: x -- pop from return stack HEADER RFROM,2,'R>',DOCODE SUB #2,PSP ; 2 MOV TOS,0(PSP) ; 4 MOV @RSP+,TOS NEXT ;C R@ -- x R: x -- x fetch from rtn stk HEADER RFETCH,2,'R@',DOCODE SUB #2,PSP MOV TOS,0(PSP) MOV @RSP,TOS NEXT ;Z SP@ -- a-addr get data stack pointer HEADER SPFETCH,3,'SP@',DOCODE SUB #2,PSP MOV TOS,0(PSP) MOV PSP,TOS NEXT ;Z SP! a-addr -- set data stack pointer HEADER SPSTORE,3,'SP!',DOCODE MOV TOS,PSP MOV @PSP+,TOS ; 2 NEXT ;Z RP@ -- a-addr get return stack pointer HEADER RPFETCH,3,'RP@',DOCODE SUB #2,PSP MOV TOS,0(PSP) MOV RSP,TOS NEXT ;Z RP! a-addr -- set return stack pointer HEADER RPSTORE,3,'RP!',DOCODE MOV TOS,RSP MOV @PSP+,TOS ; 2 NEXT ;X TUCK x1 x2 -- x2 x1 x2 per stack diagram HEADER TUCK,4,'TUCK',DOCOLON DC16 SWAP,OVER,EXIT ; ---------------------------------------------------------------------- ; MEMORY OPERATIONS ;C @ a-addr -- x fetch cell from memory HEADER FETCH,1,'@',DOCODE MOV @TOS,TOS NEXT ;C ! x a-addr -- store cell in memory HEADER STORE,1,'!',DOCODE MOV @PSP+,0(TOS) MOV @PSP+,TOS NEXT ;C C@ c-addr -- char fetch char from memory HEADER CFETCH,2,'C@',DOCODE MOV.B @TOS,TOS NEXT ;C C! char c-addr -- store char in memory HEADER CSTORE,2,'C!',DOCODE MOV @PSP+,W MOV.B W,0(TOS) MOV @PSP+,TOS NEXT ; FLASH MEMORY OPERATIONS ; Note that an I! or IC! to a RAM address >FLASHSTART will work -- it ; will enable the flash, write the RAM, and then disable the flash. ; An FLERASE to a RAM address will merely clear that one RAM cell. ;Z FLERASE a-addr n -- erase n bytes of flash, full segment sizes. HEADER FLERASE,7,'FLERASE',DOCODE MOV @PSP+,W ; get address in W ADD W,TOS ; TOS=end adrs (first unerased adrs) FLE_1: CMP TOS,W ; adr-end JC FLE_X ; if no borrow, adr>=end, do not erase ; is it within Main flash? CMP #USERFLASHSTART,W ; flash start JNC FLE_VEC ; if borrow, adrend, check if vec FLE_VEC ; danger!! only for MSPG2553 apps ; is it within interrupt vector flash? CMP #ISRSTART,W ; flash start JNC FLE_INFO ; if borrow, adrend, check if Info ; /danger FLE_INFO: ; is it within Info flash? CMP #INFOSTART,W JNC FLE_X ; if borrow, adrend, do not erase FLE_OK: ; Address is either in Main flash, or in Info flash. ; Segment Erase from flash. ; Assumes ACCVIE = NMIIE = OFIE = 0, watchdog disabled. ; Per section 5.3.2 of MSP430 Family User's Guide PUSH sr DINT ; Disable interrupts MOV #FWKEY,&FCTL3 ; Clear LOCK MOV #FWKEY+ERASE,&FCTL1 ; Enable segment erase MOV #-1,0(W) ; Dummy write in segment to erase MOV #FWKEY,&FCTL1 ; Done. Clear erase command. MOV #FWKEY+LOCK,&FCTL3 ; Done, set LOCK ; EINT ; Enable interrupts POP sr ; Advance flash pointer by 512 bytes or 128 bytes ; is it within Main flash? CMP #USERFLASHSTART,W JNC FL_INFO ; if borrow, adrend, must be Info ADD #(MAINSEG-INFOSEG),W FL_INFO: ADD #INFOSEG,W JMP FLE_1 ; continue till past end or outside limits FLE_X: MOV @PSP+,TOS NEXT ; Program Space (Flash) operators ;Z I! x a-addr -- store cell in Instruction memory HEADER ISTORE,2,'I!',DOCODE MOV @PSP+,W ; get data to write BIT #1,TOS JNZ IST_X ; if not even address, do not write CMP @TOS,W JZ IST_X ; if memory is desired value, do not write ; is it within Main flash? CMP #USERFLASHSTART,TOS JNC IST_INFO ; if borrow, adrend, check if Info IST_INFO: ; is it within Info flash? CMP #INFOSTART,TOS JNC IST_RAM ; if borrow, adrend, assume it's RAM IST_OK: ; Address is either in Main flash, or in Info flash. ; Byte/word write from flash. ; Assumes location to write is already erased ; Assumes ACCVIE = NMIIE = OFIE = 0, watchdog disabled. ; Per section 5.3.3 of MSP430 Family User's Guide PUSH sr DINT ; Disable interrupts MOV #FWKEY,&FCTL3 ; Clear LOCK MOV #FWKEY+WRT,&FCTL1 ; Enable write IST_RAM: ; If RAM, jump here to write. FCTL1,FCTL3,EINT are superfluous MOV W,0(TOS) ; Write word to flash location MOV #FWKEY,&FCTL1 ; Done. Clear WRT. MOV #FWKEY+LOCK,&FCTL3 ; Set LOCK ; EINT ; Enable interrupts POP sr IST_X: MOV @PSP+,TOS ; pop new TOS NEXT ;Z IC! x a-addr -- store char in Instruction memory HEADER ICSTORE,3,'IC!',DOCODE MOV @PSP+,W ; get data to write CMP.B @TOS,W JZ IST_X ; if memory is desired value, do not write ; is it within Main flash? CMP #USERFLASHSTART,TOS JNC ICST_INFO ; if borrow, adrend, check if Info ICST_INFO: ; is it within Info flash? CMP #INFOSTART,TOS JNC ICST_RAM ; if borrow, adrend, assume it's RAM ICST_OK: ; Address is either in Main flash, or in Info flash. ; Byte/word write from flash. ; Assumes location to write is already erased ; Assumes ACCVIE = NMIIE = OFIE = 0, watchdog disabled. ; Per section 5.3.3 of MSP430 Family User's Guide PUSH sr DINT ; Disable interrupts MOV #FWKEY,&FCTL3 ; Clear LOCK MOV #FWKEY+WRT,&FCTL1 ; Enable write ICST_RAM: ; If RAM, jump here to write. FCTL1,FCTL3,EINT are superfluous MOV.B W,0(TOS) ; Write byte to flash location MOV #FWKEY,&FCTL1 ; Done. Clear WRT. MOV #FWKEY+LOCK,&FCTL3 ; Set LOCK ; EINT ; Enable interrupts POP sr JMP IST_X /* ;Z I@ a-addr -- x fetch cell from Instruction memory HEADER IFETCH,2,'I@',FETCH+2 ;Z IC@ a-addr -- x fetch char from Instruction memory HEADER ICFETCH,3,'IC@',CFETCH+2 */ #define IFETCH FETCH #define ICFETCH CFETCH ;Z D->I c-addr1 c-addr2 u -- move Data->Code ; Block move from Data space to Code space. Flashable. ; For the MSP430, this uses a "smart" algorithm that uses word writes, ; rather than byte writes, whenever possible. Note that byte reads ; are used for the source, so it need not be aligned. HEADER DTOI,4,'D->I',DOCODE MOV @PSP+,W ; dest adrs MOV @PSP+,X ; src adrs CMP #0,TOS JZ DTOI_X DTOI_LOOP: ; Begin flash write sequence PUSH sr DINT ; Disable interrupts MOV #FWKEY,&FCTL3 ; Clear LOCK MOV #FWKEY+WRT,&FCTL1 ; Enable write ; If length is 1, or dest. address is odd, do a byte write. ; Else, do a word write. CMP #1,TOS JZ DTOI_BYTE BIT #1,W JNZ DTOI_BYTE DTOI_WORD: MOV.B @X+,Y ; get low byte of word MOV.B @X+,Q ; get high byte of word SWPB Q BIS Q,Y ; merge bytes MOV.W Y,0(W) ; write byte to dest ADD #2,W SUB #1,TOS ; another 1 will be subtracted below JMP DTOI_END DTOI_BYTE: MOV.B @X+,0(W) ; copy byte from src to dest ADD #1,W DTOI_END: ; End flash write sequence MOV #FWKEY,&FCTL1 ; Done. Clear WRT. MOV #FWKEY+LOCK,&FCTL3 ; Set LOCK ; EINT ; Enable interrupts POP sr SUB #1,TOS JNZ DTOI_LOOP DTOI_X: MOV @PSP+,TOS ; pop new TOS NEXT ; ---------------------------------------------------------------------- ; ARITHMETIC OPERATIONS ;C + n1/u1 n2/u2 -- n3/u3 add n1+n2 HEADER PLUS,1,'+',DOCODE ADD @PSP+,TOS NEXT ;C +! n/u a-addr -- add cell to memory HEADER PLUSSTORE,2,'+!',DOCODE ADD @PSP+,0(TOS) MOV @PSP+,TOS NEXT ;X M+ d n -- d add single to double HEADER MPLUS,2,'M+',DOCODE ADD TOS,2(PSP) ADDC #0,0(PSP) MOV @PSP+,TOS NEXT ;C - n1/u1 n2/u2 -- n3/u3 subtract n1-n2 HEADER MINUS,1,'-',DOCODE MOV @PSP+,W SUB TOS,W MOV W,TOS NEXT ;C AND x1 x2 -- x3 logical AND HEADER ANDD,3,'AND',DOCODE AND @PSP+,TOS NEXT ;C OR x1 x2 -- x3 logical OR HEADER ORR,2,'OR',DOCODE BIS @PSP+,TOS NEXT ;C XOR x1 x2 -- x3 logical XOR HEADER XORR,3,'XOR',DOCODE XOR @PSP+,TOS NEXT ;C INVERT x1 -- x2 bitwise inversion HEADER INVERT,6,'INVERT',DOCODE XOR #-1,TOS NEXT ;C NEGATE x1 -- x2 two's complement HEADER NEGATE,6,'NEGATE',DOCODE XOR #-1,TOS ADD #1,TOS NEXT ;C 1+ n1/u1 -- n2/u2 add 1 to TOS HEADER ONEPLUS,2,'1+',DOCODE ADD #1,TOS NEXT ;C 1- n1/u1 -- n2/u2 subtract 1 from TOS HEADER ONEMINUS,2,'1-',DOCODE SUB #1,TOS NEXT ;Z >< x1 -- x2 swap bytes (not ANSI) HEADER SWAPBYTES,2,'><',DOCODE SWPB TOS NEXT ;C 2* x1 -- x2 arithmetic left shift HEADER TWOSTAR,2,'2*',DOCODE ADD TOS,TOS NEXT ;C 2/ x1 -- x2 arithmetic right shift HEADER TWOSLASH,2,'2/',DOCODE RRA TOS NEXT ;C LSHIFT x1 u -- x2 logical L shift u places HEADER LSHIFT,6,'LSHIFT',DOCODE MOV @PSP+,W AND #1Fh,TOS ; no need to shift more than 16 JZ LSH_X LSH_1: ADD W,W SUB #1,TOS JNZ LSH_1 LSH_X: MOV W,TOS NEXT ;C RSHIFT x1 u -- x2 logical R shift u places HEADER RSHIFT,6,'RSHIFT',DOCODE MOV @PSP+,W AND #1Fh,TOS ; no need to shift more than 16 JZ RSH_X RSH_1: CLRC RRC W SUB #1,TOS JNZ RSH_1 RSH_X: MOV W,TOS NEXT ; ---------------------------------------------------------------------- ; COMPARISON OPERATIONS ;C 0= n/u -- flag return true if TOS=0 HEADER ZEROEQUAL,2,'0=',DOCODE SUB #1,TOS ; borrow (clear cy) if TOS was 0 SUBC TOS,TOS ; TOS=-1 if borrow was set NEXT ;C 0< n -- flag true if TOS negative HEADER ZEROLESS,2,'0<',DOCODE ADD TOS,TOS ; set cy if TOS negative SUBC TOS,TOS ; TOS=-1 if carry was clear XOR #-1,TOS ; TOS=-1 if carry was set NEXT ;C = x1 x2 -- flag test x1=x2 HEADER EQUAL,1,'=',DOCODE MOV @PSP+,W SUB TOS,W ; x1-x2 in W, flags set JZ TOSTRUE TOSFALSE: MOV #0,TOS NEXT ;X <> x1 x2 -- flag test not eq (not ANSI) HEADER NOTEQUAL,2,'<>',DOCOLON DW EQUAL,ZEROEQUAL,EXIT ;C < n1 n2 -- flag test n1 n1 n2 -- flag test n1>n2, signed HEADER GREATER,1,'>',DOCOLON DW SWAP,LESS,EXIT ;C U< u1 u2 -- flag test u1 u1 u2 -- flag u1>u2 unsgd (not ANSI) HEADER UGREATER,2,'U>',DOCOLON DW SWAP,ULESS,EXIT ;C RLA n1 -- n2 f rotate left through carry, true if carry set HEADER RLAA,3,'RLA',DOCODE RLA TOS ; shift left PUSH SR SUB #2,PSP ; 1 push old TOS.. MOV TOS,0(PSP) ; 4 ..onto stack POP SR JC TOSTRUE JMP TOSFALSE ; ---------------------------------------------------------------------- ; LOOP AND BRANCH OPERATIONS ; These use relative branch addresses: a branch is ADD @IP,IP ;Z branch -- branch always HEADER bran,6,'branch',DOCODE dobran: ADD @IP,IP ; 2 NEXT ; 4 ;Z ?branch x -- branch if TOS zero HEADER qbran,7,'?branch',DOCODE ADD #0,TOS ; 1 test TOS value MOV @PSP+,TOS ; 2 pop new TOS value (doesn't change flags) JZ dobran ; 2 if TOS was zero, take the branch ADD #2,IP ; 1 else skip the branch destination NEXT ; 4 ;Z (do) n1|u1 n2|u2 -- R: -- sys1 sys2 run-time code for DO ; '83 and ANSI standard loops terminate when the boundary of ; limit-1 and limit is crossed, in either direction. This can ; be conveniently implemented by making the limit 8000h, so that ; arithmetic overflow logic can detect crossing. I learned this ; trick from Laxen & Perry F83. ; fudge factor = 8000h-limit, to be added to the start value. HEADER xdo,4,'(do)',DOCODE SUB #4,RSP ; push old loop values on return stack MOV LIMIT,2(RSP) MOV INDEX,0(RSP) MOV #8000h,LIMIT ; compute 8000h-limit "fudge factor" SUB @PSP+,LIMIT MOV TOS,INDEX ; loop ctr = index+fudge ADD LIMIT,INDEX MOV @PSP+,TOS ; pop new TOS NEXT ;Z (loop) R: sys1 sys2 -- | sys1 sys2 run-time code for LOOP ; Add 1 to the loop index. If loop terminates, clean up the ; return stack and skip the branch. Else take the inline branch. ; Note that LOOP terminates when index=8000h. HEADER xloop,6,'(loop)',DOCODE ADD #1,INDEX BIT #100h,SR ; is overflow bit set? JZ dobran ; no overflow = loop ADD #2,IP ; overflow = loop done, skip branch ofs MOV @RSP+,INDEX ; restore old loop values MOV @RSP+,LIMIT NEXT ;Z (+loop) n -- R: sys1 sys2 -- | sys1 sys2 run-time code for +LOOP ; Add n to the loop index. If loop terminates, clean up the ; return stack and skip the branch. Else take the inline branch. HEADER xplusloop,7,'(+loop)',DOCODE ADD TOS,INDEX MOV @PSP+,TOS ; get new TOS, doesn't change flags BIT #100h,SR ; is overflow bit set? JZ dobran ; no overflow = loop ADD #2,IP ; overflow = loop done, skip branch ofs MOV @RSP+,INDEX ; restore old loop values MOV @RSP+,LIMIT NEXT ;C I -- n R: sys1 sys2 -- sys1 sys2 get the innermost loop index HEADER II,1,'I',DOCODE SUB #2,PSP ; make room in TOS MOV TOS,0(PSP) MOV INDEX,TOS ; index = loopctr - fudge SUB LIMIT,TOS NEXT ;C J -- n R: 4*sys -- 4*sys get the second loop index HEADER JJ,1,'J',DOCODE SUB #2,PSP ; make room in TOS MOV TOS,0(PSP) MOV @RSP,TOS ; index = loopctr - fudge SUB 2(RSP),TOS NEXT ;C UNLOOP -- R: sys1 sys2 -- drop loop parms HEADER UNLOOP,6,'UNLOOP',DOCODE MOV @RSP+,INDEX ; restore old loop values MOV @RSP+,LIMIT NEXT ; ---------------------------------------------------------------------- ; MULTIPLY AND DIVIDE ;C UM* u1 u2 -- ud unsigned 16x16->32 mult. HEADER UMSTAR,3,'UM*',DOCODE ; IROP1 = TOS register MOV @PSP,IROP2L ; get u1, leave room on stack ; ; T.I. SIGNED MULTIPLY SUBROUTINE: IROP1 x IROP2L -> IRACM|IRACL MPYU: CLR IRACL ; 0 -> LSBs RESULT CLR IRACM ; 0 -> MSBs RESULT ; UNSIGNED MULTIPLY AND ACCUMULATE SUBROUTINE: ; (IROP1 x IROP2L) + IRACM|IRACL -> IRACM|IRACL MACU: CLR IROP2M ; MSBs MULTIPLIER MOV #1,IRBT ; BIT TEST REGISTER L$002: BIT IRBT,IROP1 ; TEST ACTUAL BIT JZ L$01 ; IF 0: DO NOTHING ADD IROP2L,IRACL ; IF 1: ADD MULTIPLIER TO RESULT ADDC IROP2M,IRACM L$01: RLA IROP2L ; MULTIPLIER x 2 RLC IROP2M ; RLA IRBT ; NEXT BIT TO TEST JNC L$002 ; IF BIT IN CARRY: FINISHED ; END T.I. ROUTINE section 5.1.1 of MSP430 Family Application Reports MOV IRACL,0(PSP) ; low result on stack MOV IRACM,TOS ; high result in TOS NEXT ;C UM/MOD ud u1 -- u2 u3 unsigned 32/16->16 HEADER UMSLASHMOD,6,'UM/MOD',DOCODE ; IROP1 = TOS register MOV @PSP+,IROP2M ; get ud hi MOV @PSP,IROP2L ; get ud lo, leave room on stack ; ; T.I. UNSIGNED DIVISION SUBROUTINE 32-BIT BY 16-BIT ; IROP2M|IROP2L : IROP1 -> IRACL REMAINDER IN IROP2M ; RETURN: CARRY = 0: OK CARRY = 1: QUOTIENT > 16 BITS DIVIDE: CLR IRACL ; CLEAR RESULT MOV #17,IRBT ; INITIALIZE LOOP COUNTER DIV1: CMP IROP1,IROP2M ; JLO DIV2 SUB IROP1,IROP2M DIV2: RLC IRACL JC DIV4 ; Error: result > 16 bits DEC IRBT ; Decrement loop counter JZ DIV3 ; Is 0: terminate w/o error RLA IROP2L RLC IROP2M JNC DIV1 SUB IROP1,IROP2M SETC JMP DIV2 DIV3: CLRC ; No error, C = 0 DIV4: ; Error indication in C ; END T.I. ROUTINE Section 5.1.5 of MSP430 Family Application Reports MOV IROP2M,0(PSP) ; remainder on stack MOV IRACL,TOS ; quotient in TOS NEXT ; ---------------------------------------------------------------------- ; BLOCK AND STRING OPERATIONS ;C FILL c-addr u char -- fill memory with char HEADER FILL,4,'FILL',DOCODE MOV @PSP+,X ; count MOV @PSP+,W ; address CMP #0,X JZ FILL_X FILL_1: MOV.B TOS,0(W) ; store char in memory ADD #1,W SUB #1,X JNZ FILL_1 FILL_X: MOV @PSP+,TOS ; pop new TOS NEXT ;X CMOVE c-addr1 c-addr2 u -- move from bottom ; as defined in the ANSI optional String word set ; On byte machines, CMOVE and CMOVE> are logical ; factors of MOVE. They are easy to implement on ; CPUs which have a block-move instruction. HEADER CMOVE,5,'CMOVE',DOCODE MOV @PSP+,W ; dest adrs MOV @PSP+,X ; src adrs CMP #0,TOS JZ CMOVE_X CMOVE_1: MOV.B @X+,0(W) ; copy byte ADD #1,W SUB #1,TOS JNZ CMOVE_1 CMOVE_X: MOV @PSP+,TOS ; pop new TOS NEXT ;X CMOVE> c-addr1 c-addr2 u -- move from top ; as defined in the ANSI optional String word set HEADER CMOVEUP,6,'CMOVE>',DOCODE MOV @PSP+,W ; dest adrs MOV @PSP+,X ; src adrs CMP #0,TOS JZ CMOVU_X ADD TOS,W ; start at end ADD TOS,X CMOVU_1: SUB #1,X SUB #1,W MOV.B @X,0(W) ; copy byte SUB #1,TOS JNZ CMOVU_1 CMOVU_X: MOV @PSP+,TOS ; pop new TOS NEXT ;Z I->D c-addr1 c-addr2 u -- move Code->Data ; Block move from Code space to Data space. ; On the MSP430, this is the same as CMOVE. HEADER ITOD,4,'I->D',CMOVE+2 ;Z SKIP c-addr u c -- c-addr' u' skip matching chars ; Although SKIP, SCAN, and S= are perhaps not the ideal factors ; of WORD and FIND, they closely follow the string operations ; available on many CPUs, and so are easy to implement and fast. HEADER SKIP,4,'SKIP',DOCODE MOV @PSP+,X ; get count MOV @PSP,W ; get address, leave space on stack CMP #0,X JZ SKIP_X SKIP_1: CMP.B @W,TOS ; does character match? JNZ SKIP_X ; no, we are done ADD #1,W SUB #1,X JNZ SKIP_1 SKIP_X: MOV W,0(PSP) ; store updated address on stack MOV X,TOS ; updated count to TOS NEXT ;Z SCAN c-addr u c -- c-addr' u' find matching char HEADER SCAN,4,'SCAN',DOCODE MOV @PSP+,X ; get count MOV @PSP,W ; get address, leave space on stack CMP #0,X JZ SCAN_X SCAN_1: CMP.B @W,TOS ; does character match? JZ SCAN_X ; yes, we are done ADD #1,W SUB #1,X JNZ SCAN_1 SCAN_X: MOV W,0(PSP) ; store updated address on stack MOV X,TOS ; updated count to TOS NEXT ;Z S= c-addr1 c-addr2 u -- n string compare ;Z S= n<0: s10: s1>s2 HEADER SEQUAL,2,'S=',DOCODE MOV @PSP+,W ; adrs2 MOV @PSP+,X ; adrs1 CMP #0,TOS JZ SEQU_X SEQU_1: CMP.B @W+,0(X) ; compare char1-char2 JNZ SMISMATCH ADD #1,X SUB #1,TOS JNZ SEQU_1 ; no mismatch found, strings are equal, TOS=0 JMP SEQU_X ; mismatch found, CY clear if borrow set (s10: s1>s2 ; For Harvard model, c-addr1 is Data, c-addr2 is Header. ; On MSP430, both use the same fetch instruction, so N= is the same as S=. HEADER NEQUAL,2,'N=',SEQUAL+2 ; ---------------------------------------------------------------------- ;C KEY -- c get character from keyboard; vectored HEADER KEY,3,'KEY',DOCOLON DW USERKEY,FETCH,EXECUTE,EXIT ;C EMIT c -- output character to console; vectored HEADER EMIT,4,'EMIT',DOCOLON DW USEREMIT,FETCH,EXECUTE,EXIT ;X KEY? -- f return true if char waiting HEADER KEYQ,4,'KEY?',DOCODE SUB #2,PSP ; 1 push old TOS.. MOV TOS,0(PSP) ; 4 ..onto stack BIT.B #UCA0RXIFG,&IFG2 JNZ TOSTRUE JMP TOSFALSE ;X ZERO -- 0 put zero on stack. Often usesd word. HEADER ZERO,4,'ZERO',DOCON DW 0 ; finis