; -*- coding: utf-8 -*- ; http://patorjk.com/software/taag/#p=display&f=Banner&t=Fast Forth ; Fast Forth For Texas Instrument MSP430FRxxxx FRAM devices ; Copyright (C) <2017> ; ; 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 . ; ---------------------------------------------------------------------- ;forthMSP430FR_EXTD_ASM.asm ; ---------------------------------------------------------------------- ; ---------------------------------------------------------------------- ; MOV(.B) #0, dst is coded as follow : MOV(.B) R3, dst ; 1 cycle, one word As=00 register mode ; MOV(.B) #1, dst is coded as follow : MOV(.B) 0(R3), dst ; 2 cycles, one word AS=01 x(reg) mode ; MOV(.B) #2, dst is coded as follow : MOV(.B) @R3, dst ; 2 cycles, one word AS=10 @reg mode ; MOV(.B) #4, dst is coded as follow : MOV(.B) @R2, dst ; 2 cycles, one word AS=10 @reg mode ; MOV(.B) #8, dst is coded as follow : MOV(.B) @R2+, dst ; 2 cycles, one word AS=11 @reg+ mode ; MOV(.B) #-1,dst is coded as follow : MOV(.B) @R3+, dst ; 2 cycles, one word AS=11 ; MOV(.B) #xxxx,dst is coded a follow : MOV(.B) @PC+, dst ; 2 cycles, two words AS=11 @reg+ mode ; MOV(.B) &EDE,&TON is coded as follow: MOV(.B) EDE(R2),TON(R2) ; (R2=0), three words AS=01, AD=1 x(reg) mode ; ---------------------------------------------------------------------- ; PUSHM order : PSP,TOS, IP, S, T, W, X, Y, rEXIT,rDOVAR,rDOCON, rDODOES, R3, SR,RSP, PC ; PUSHM order : R15,R14,R13,R12,R11,R10, R9, R8, R7 , R6 , R5 , R4 , R3, R2, R1, R0 ; example : PUSHM #6,IP pushes IP,S,T,W,X,Y registers to return stack ; ; POPM order : PC,RSP, SR, R3, rDODOES,rDOCON,rDOVAR,rEXIT, Y, X, W, T, S, IP,TOS,PSP ; POPM order : R0, R1, R2, R3, R4 , R5 , R6 , R7 , R8, R9,R10,R11,R12,R13,R14,R15 ; example : POPM #6,IP pop Y,X,W,T,S,IP registers from return stack ; ---------------------------------------------------------------------- ; DTCforthMSP430FR5xxx ASSEMBLER : search argument "xxxx", IP is free ; ---------------------------------------------------------------------- ;SearchARG ; separator -- n|d or abort" not found" ;; Search ARG of "#xxxx," ; <== PARAM10 ;; Search ARG of "&xxxx," ; <== PARAM111 ;; Search ARG of "xxxx(REG)," ; <== PARAM130 ;; Search ARG of ",&xxxx" ; <== PARAM111 <== PARAM20 ;; Search ARG of ",xxxx(REG)" ; <== PARAM210 ; PUSHM #2,S ; PUSHM S,T as OPCODE, OPCODEADR ; ASMtoFORTH ; -- separator search word first ; .word WORDD,FIND ; -- addr ; .word QTBRAN,SearchARGW ; -- addr if word found ; .word QNUMBER ; ; .word QFBRAN,NotFound ; -- addr ABORT if not found ;FSearchEnd .word SearchEnd ; -- value goto SearchEnd if number found ;SearchARGW FORTHtoASM ; -- xt xt = CFA ; MOV @TOS+,X ; -- PFA ;QDODOES SUB #DODOES,X ; DODOES = 1284h ; JNZ QDOCON ; ; ADD #2,TOS ; -- BODY leave BODY address for DOES words ; JMP SearchEnd ; ;QDOCON CMP #1,X ; -- PFA DOCON = 1285h ; JNZ QDOVAR ; ; MOV @TOS,TOS ; -- cte replace PFA by [PFA] for CONSTANT and CREATE words ; JMP SearchEnd ; ;QDOVAR CMP #2,X ; -- PFA DOVAR = 1286h ; JZ SearchEnd ; if DOVAR nothing to do ; SUB #2,TOS ; -- CFA replace PFA by CFA for all other words ;SearchEnd POPM #2,S ; POPM T,S ; RET ; SearchARG ; separator -- n|d or abort" not found" ; Search ARG of "#xxxx," ; <== PARAM10 ; Search ARG of "&xxxx," ; <== PARAM111 ; Search ARG of "xxxx(REG)," ; <== PARAM130 ; Search ARG of ",&xxxx" ; <== PARAM111 <== PARAM20 ; Search ARG of ",xxxx(REG)" ; <== PARAM210 PUSHM #2,S ; PUSHM S,T as OPCODE, OPCODEADR ASMtoFORTH ; -- separator search word first .word WORDD,FIND ; -- addr .word QTBRAN,SearchARGW ; -- addr if word found .word QNUMBER ; .word QFBRAN,NotFound ; -- addr ABORT if not found FSearchEnd .word SearchEnd ; -- value goto SearchEnd if number found SearchARGW FORTHtoASM ; -- xt xt = CFA MOV @TOS+,X ; -- PFA QDOVAR SUB #DOVAR,X ; DOVAR = 1286h JZ SearchEnd ; ADD #1,X ; -- PFA DOCON = 1285h JNZ QDODOES ; MOV @TOS,TOS ; -- cte JMP SearchEnd ; QDODOES ADD #2,TOS ; -- BODY leave BODY address for DOES words ADD #1,X ; DODOES = 1284h JZ SearchEnd ; SUB #4,TOS ; -- CFA SearchEnd POPM #2,S ; POPM T,S RET ; ; Arg_Double_to_single conversion needed only for OPCODE type V|VI, 2th pass. ARGD2S BIT #UF9,SR ; -- Lo Hi JZ ARGD2SEND MOV @PSP+,TOS ; -- Lo skip hi ARGD2SEND RET ; ---------------------------------------------------------------------- ; DTCforthMSP430FR5xxx ASSEMBLER : search REG ; ---------------------------------------------------------------------- ; compute arg of "xxxx(REG)," ; <== PARAM130, sep=',' ; compute arg of ",xxxx(REG)" ; <== PARAM210, sep=' ' ComputeARGParenREG ; sep -- Rn MOV #'(',TOS ; -- "(" as WORD separator to find xxxx of "xxxx(REG)," CALL #SearchARG ; -- xxxx aborted if not found CALL #ARGD2S ; skip arg_hi if DOUBLE MOV &DDP,X ADD #2,&DDP MOV TOS,0(X) ; -- xxxx compile xxxx MOV #')',TOS ; -- ")" prepare separator to search REG of "xxxx(REG)" ; search REG of "xxxx(REG)," separator = ')' ; search REG of ",xxxx(REG)" separator = ')' ; search REG of "@REG," separator = ',' <== PARAM120 ; search REG of "@REG+," separator = '+' <== PARAM121 ; search REG of "REG," separator = ',' <== PARAM13 ; search REG of ",REG" separator = BL <== PARAM21 SearchREG PUSHM #2,S ; PUSHM S,T as OPCODE, OPCODEADR PUSH &TOIN ; -- sep save >IN ADD #1,&TOIN ; skip "R" ASMtoFORTH ; search xx of Rxx .word WORDD,QNUMBER ; .word QFBRAN,NOTaREG ; -- xxxx if Not a Number FORTHtoASM ; -- Rn number is found ADD #2,RSP ; remove >IN CMP #16,TOS ; -- Rn JHS BOUNDERROR ; abort if Rn out of bounds JLO SearchEnd ; -- Rn Z=0 ==> found NOTaREG FORTHtoASM ; -- addr Z=1 MOV @RSP+,&TOIN ; -- addr restore >IN JMP SearchEnd ; -- addr Z=1 ==> not a register ; ---------------------------------------------------------------------- ; DTCforthMSP430FR5xxx ASSEMBLER : INTERPRET FIRST OPERAND ; ---------------------------------------------------------------------- ; PARAM1 is used for OPCODES type I (double operand) and OPCODES type II (single operand) instructions ; PARAM1 is used for OPCODES type V (double operand) and OPCODES type VI (single operand) extended instructions ; PARAM1 separator -- ; parse input buffer until separator and compute first operand of opcode ; sep is comma for src and space for dst . PARAM1 mDOCOL ; -- sep OPCODES types I|V sep = ',' OPCODES types II|VI sep = ' ' .word FBLANK,SKIP ; -- sep addr FORTHtoASM ; -- sep addr MOV #0,S ; -- sep addr reset OPCODE MOV &DDP,T ; -- sep addr HERE --> OPCODEADR (opcode is preset to its address !) ADD #2,&DDP ; -- sep addr cell allot for opcode MOV.B @TOS,W ; -- sep addr W=first char of instruction code MOV @PSP+,TOS ; -- sep W=c-addr CMP.B #'#',W ; -- sep W=first char JNE PARAM11 ; "#" found : case of "#xxxx," PARAM10 ADD #1,&TOIN ; -- sep skip # prefix CALL #SearchARG ; -- xxxx abort if not found CALL #ARGD2S ; skip arg_hi of OPCODE type V MOV #0300h,S ; OPCODE = 0300h : MOV #0,dst is coded MOV R3,dst CMP #0,TOS ; -- xxxx #0 ? JZ PARAMENDOF MOV #0310h,S ; OPCODE = 0310h : MOV #1,dst is coded MOV 0(R3),dst CMP #1,TOS ; -- xxxx #1 ? JZ PARAMENDOF MOV #0320h,S ; OPCODE = 0320h : MOV #2,dst is coded MOV @R3,dst CMP #2,TOS ; -- xxxx #2 ? JZ PARAMENDOF MOV #0220h,S ; OPCODE = 0220h : MOV #4,dst is coded MOV @R2,dst CMP #4,TOS ; -- xxxx #4 ? JZ PARAMENDOF MOV #0230h,S ; OPCODE = 0230h : MOV #8,dst is coded MOV @R2+,dst CMP #8,TOS ; -- xxxx #8 ? JZ PARAMENDOF MOV #0330h,S ; -- -1 OPCODE = 0330h : MOV #-1,dst is coded MOV @R3+,dst CMP #-1,TOS ; -- xxxx #-1 ? JZ PARAMENDOF MOV #0030h,S ; -- xxxx for all other cases : MOV @PC+,dst ; case of "&xxxx," ; <== PARAM110 ; case of ",&xxxx" ; <== PARAM20 StoreArg MOV &DDP,X ; ADD #2,&DDP ; cell allot for arg StoreTOS ; <== TYPE1DOES MOV TOS,0(X) ; compile arg ; endcase of all "&xxxx" ; ; endcase of all "#xxxx" ; <== PARAM101,102,104,108,10M1 ; endcase of all "REG"|"@REG"|"@REG+" <== PARAM124 PARAMENDOF MOV @PSP+,TOS ; -- MOV @RSP+,IP ; mNEXT ; -- S=OPCODE,T=OPCODEADR ; ----------------------------------; PARAM11 CMP.B #'&',W ; -- sep JNE PARAM12 ; case of "&xxxx," ; -- sep search for "&xxxx," PARAM110 MOV #0210h,S ; -- sep set code type : xxxx(SR) with AS=0b01 ==> x210h (and SR=0 !) ; case of "&xxxx," ; case of ",&xxxx" ; <== PARAM20 PARAM111 ADD #1,&TOIN ; -- sep skip "&" prefix CALL #SearchARG ; -- arg abort if not found CALL #ARGD2S ; skip arg_hi of opcode type V JMP StoreArg ; -- then ret ; ----------------------------------; PARAM12 CMP.B #'@',W ; -- sep JNE PARAM13 ; case of "@REG,"|"@REG+," PARAM120 MOV #0020h,S ; -- sep init OPCODE with indirect code type : AS=0b10 ADD #1,&TOIN ; -- sep skip "@" prefix CALL #SearchREG ; Z = not found JNZ PARAM123 ; -- value REG of "@REG," found ; case of "@REG+," ; -- addr REG of "@REG" not found, search REG of "@REG+" PARAM121 ADD #0010h,S ; change OPCODE from @REG to @REG+ type MOV #'+',TOS ; -- "+" as WORD separator to find REG of "@REG+," CALL #SearchREG ; -- value|addr X = flag ; case of "@REG+," ; ; case of "xxxx(REG)," ; <== PARAM130 ; case of double separator: +, and ), PARAM122 CMP &SOURCE_LEN,&TOIN ; test OPCODE II parameter ending by REG+ or (REG) without comma, JZ PARAM123 ; i.e. >IN = SOURCE_LEN : don't skip char CR ! ADD #1,&TOIN ; -- 000R skip "," ready for the second operand search ; case of "@REG+," ; case of "xxxx(REG)," ; case of "@REG," ; -- 000R <== PARAM120 ; case of "REG," ; -- 000R <== PARAM13 PARAM123 SWPB TOS ; -- 0R00 swap bytes because it's not a dst REG typeI (not a 2 ops inst.) ; case of "@REG+," ; -- 0R00 (src REG typeI) ; case of "xxxx(REG)," ; -- 0R00 (src REG typeI or dst REG typeII) ; case of "@REG," ; -- 0R00 (src REG typeI) ; case of "REG," ; -- 0R00 (src REG typeI or dst REG typeII) ; case of ",REG" ; -- 000R <== PARAM21 (dst REG typeI) ; case of ",xxxx(REG)" ; -- 000R <== PARAM210 (dst REG typeI) PARAM124 ADD TOS,S ; -- 0R00|000R JMP PARAMENDOF ; ----------------------------------; ; case of "REG,"|"xxxx(REG)," ; first, searg REG of "REG," PARAM13 CALL #SearchREG ; -- sep save >IN for second parsing (case of "xxxx(REG),") JNZ PARAM123 ; -- 000R REG of "REG," found, S=OPCODE=0 ; case of "xxxx(REG)," ; -- c-addr "REG," not found PARAM130 ADD #0010h,S ; AS=0b01 for indexing address CALL #ComputeARGparenREG; compile xxxx and search REG of "(REG)" JMP PARAM122 ; ; ---------------------------------------------------------------------- ; DTCforthMSP430FR5xxx ASSEMBLER : INTERPRET 2th OPERAND ; ---------------------------------------------------------------------- PARAM3 ; for OPCODES TYPE III MOV #0,S ; init OPCODE=0 MOV &DDP,T ; T=OPCODEADR ADD #2,&DDP ; make room for opcode ; ----------------------------------; PARAM2 mDOCOL ; parse input buffer until BL and compute this 2th operand .word FBLANK,SKIP ; skip space(s) between "arg1," and "arg2" if any; use not S,T. FORTHtoASM ; -- c-addr search for '&' of "&xxxx CMP.B #'&',0(TOS) ; MOV #20h,TOS ; -- ' ' as WORD separator to find xxxx of ",&xxxx" JNE PARAM21 ; '&' not found ; case of ",&xxxx" ; PARAM20 ADD #0082h,S ; change OPCODE : AD=1, dst = R2 JMP PARAM111 ; -- ' ' ; ----------------------------------; ; case of ",REG"|",xxxx(REG) ; -- ' ' first, search REG of ",REG" PARAM21 CALL #SearchREG ; JNZ PARAM124 ; -- 000R REG of ",REG" found ; case of ",xxxx(REG) ; -- addr REG not found PARAM210 ADD #0080h,S ; set AD=1 CALL #ComputeARGparenREG; compile argument xxxx and search REG of "(REG)" JMP PARAM124 ; -- 000R REG of "(REG) found ; ---------------------------------------------------------------------- ; DTCforthMSP430FR5xxx ASSEMBLER: OPCODE TYPE 0 : zero operand f:-) ; ---------------------------------------------------------------------- asmword "RETI" mDOCOL .word lit,1300h,COMMA,EXIT ; ---------------------------------------------------------------------- ; DTCforthMSP430FR5xxx ASSEMBLER: OPCODES TYPE I : double operand ; ---------------------------------------------------------------------- ; OPCODE(FEDC) ; OPCODE(code) for TYPE I = 0bxxxx opcode I ; OPCODE(BA98) ; = 0bxxxx src register ; OPCODE(7) AD (dst addr type) ; = 0b0 register ; = 0b1 x(Rn),&adr ; OPCODE(6) size ; OPCODE(B) for TYPE I or TYPE II = 0b0 word ; = 0b1 byte ; OPCODE(54) AS (src addr type) ; OPCODE(AS) for TYPE I or OPCODE(AD) for TYPE II = 0b00 register ; = 0b01 x(Rn),&adr ; = 0b10 @Rn ; = 0b11 @Rn+ ; OPCODE(3210) ; OPCODE(dst) for TYPE I or TYPE II = 0bxxxx dst register ; ---------------------------------------------------------------------- ; TYPE1DOES -- BODYDOES search and compute PARAM1 & PARAM2 as src and dst operands then compile instruction TYPE1DOES .word lit,',',PARAM1 ; -- BODYDOES .word PARAM2 ; -- BODYDOES char separator (BL) included in PARAM2 FORTHtoASM ; MAKEOPCODE MOV T,X ; -- opcode X= OPCODEADR to compile opcode MOV @TOS,TOS ; -- opcode part of instruction BIS S,TOS ; -- opcode opcode is complete JMP StoreTOS ; -- then EXIT asmword "MOV" mDODOES .word TYPE1DOES,4000h asmword "MOV.B" mDODOES .word TYPE1DOES,4040h asmword "ADD" mDODOES .word TYPE1DOES,5000h asmword "ADD.B" mDODOES .word TYPE1DOES,5040h asmword "ADDC" mDODOES .word TYPE1DOES,6000h asmword "ADDC.B" mDODOES .word TYPE1DOES,6040h asmword "SUBC" mDODOES .word TYPE1DOES,7000h asmword "SUBC.B" mDODOES .word TYPE1DOES,7040h asmword "SUB" mDODOES .word TYPE1DOES,8000h asmword "SUB.B" mDODOES .word TYPE1DOES,8040h asmword "CMP" mDODOES .word TYPE1DOES,9000h asmword "CMP.B" mDODOES .word TYPE1DOES,9040h asmword "DADD" mDODOES .word TYPE1DOES,0A000h asmword "DADD.B" mDODOES .word TYPE1DOES,0A040h asmword "BIT" mDODOES .word TYPE1DOES,0B000h asmword "BIT.B" mDODOES .word TYPE1DOES,0B040h asmword "BIC" mDODOES .word TYPE1DOES,0C000h asmword "BIC.B" mDODOES .word TYPE1DOES,0C040h asmword "BIS" mDODOES .word TYPE1DOES,0D000h asmword "BIS.B" mDODOES .word TYPE1DOES,0D040h asmword "XOR" mDODOES .word TYPE1DOES,0E000h asmword "XOR.B" mDODOES .word TYPE1DOES,0E040h asmword "AND" mDODOES .word TYPE1DOES,0F000h asmword "AND.B" mDODOES .word TYPE1DOES,0F040h ; ---------------------------------------------------------------------- ; DTCforthMSP430FR5xxx ASSEMBLER, OPCODES TYPE II : single operand ; ---------------------------------------------------------------------- ; OPCODE(FEDCBA987) opcodeII ; OPCODE(code) for TYPE II = 0bxxxxxxxxx ; OPCODE(6) size ; OPCODE(B) for TYPE I or TYPE II = 0b0 word ; = 0b1 byte ; OPCODE(54) (dst addr type) ; OPCODE(AS) for TYPE I or OPCODE(AD) for TYPE II = 0b00 register ; = 0b01 x(Rn),&adr ; = 0b10 @Rn ; = 0b11 @Rn+ ; OPCODE(3210) ; OPCODE(dst) for TYPE I or TYPE II = 0bxxxx dst register ; ---------------------------------------------------------------------- TYPE2DOES .word FBLANK,PARAM1 ; -- BODYDOES FORTHtoASM ; MOV S,W ; AND #0070h,S ; keep B/W & AS infos in OPCODE SWPB W ; (REG org --> REG dst) AND #000Fh,W ; keep REG BIS_ASMTYPE BIS W,S ; -- BODYDOES add it in OPCODE JMP MAKEOPCODE ; -- then end asmword "RRC" ; Rotate Right through Carry ( word) mDODOES .word TYPE2DOES,1000h asmword "RRC.B" ; Rotate Right through Carry ( byte) mDODOES .word TYPE2DOES,1040h asmword "SWPB" ; Swap bytes mDODOES .word TYPE2DOES,1080h asmword "RRA" mDODOES .word TYPE2DOES,1100h asmword "RRA.B" mDODOES .word TYPE2DOES,1140h asmword "SXT" mDODOES .word TYPE2DOES,1180h asmword "PUSH" mDODOES .word TYPE2DOES,1200h asmword "PUSH.B" mDODOES .word TYPE2DOES,1240h asmword "CALL" mDODOES .word TYPE2DOES,1280h BOUNDERRWM1 ADD #1,W ; <== RRAM|RRUM|RRCM|RLAM error BOUNDERRORW MOV W,TOS ; <== PUSHM|POPM|ASM_branch error BOUNDERROR ; <== REG number error mDOCOL ; -- n n = value out of bounds .word DOT,XSQUOTE .byte 13,"out of bounds" .word QABORTYES ; -------------------------------------------------------------------------------- ; DTCforthMSP430FR5xxx ASSEMBLER, OPCODES TYPE III : PUSHM|POPM|RLAM|RRAM|RRUM|RRCM ; -------------------------------------------------------------------------------- ; PUSHM, syntax: PUSHM #n,REG with 0 < n < 17 ; POPM syntax: POPM #n,REG with 0 < n < 17 ; PUSHM order : PSP,TOS, IP, S, T, W, X, Y, rEXIT,rDOVAR,rDOCON, rDODOES, R3, SR,RSP, PC ; PUSHM order : R15,R14,R13,R12,R11,R10, R9, R8, R7 , R6 , R5 , R4 , R3, R2, R1, R0 ; example : PUSHM #6,IP pushes IP,S,T,W,X,Y registers to return stack ; ; POPM order : PC,RSP, SR, R3, rDODOES,rDOCON,rDOVAR,rEXIT, Y, X, W, T, S, IP,TOS,PSP ; POPM order : R0, R1, R2, R3, R4 , R5 , R6 , R7 , R8, R9,R10,R11,R12,R13,R14,R15 ; example : POPM #6,IP pulls Y,X,W,T,S,IP registers from return stack ; RxxM syntax: RxxM #n,REG with 0 < n < 5 TYPE3DOES .word FBLANK,SKIP ; skip spaces if any FORTHtoASM ; -- BODYDOES c-addr ADD #1,&TOIN ; skip "#" MOV #',',TOS ; -- BODYDOES "," ASMtoFORTH .word WORDD,QNUMBER .word QFBRAN,NotFound ; ABORT .word PARAM3 ; -- BODYDOES 0x000N S=OPCODE = 0x000R FORTHtoASM MOV TOS,W ; -- BODYDOES n W = n MOV @PSP+,TOS ; -- BODYDOES SUB #1,W ; W = n floored to 0 JN BOUNDERRWM1 MOV @TOS,X ; X=OPCODE RLAM #4,X ; OPCODE bit 1000h --> C JNC RxxMINSTRU ; if bit 1000h = 0 PxxxINSTRU MOV S,Y ; S=REG, Y=REG to test RLAM #3,X ; OPCODE bit 0200h --> C JNC PUSHMINSTRU ; W=n-1 Y=REG POPMINSTRU SUB W,S ; to make POPM opcode, compute first REG to POP; TI is complicated.... PUSHMINSTRU SUB W,Y ; Y=REG-(n-1) CMP #16,Y JHS BOUNDERRWM1 ; JC=JHS (U>=) RLAM #4,W ; W = n << 4 JMP BIS_ASMTYPE ; BODYDOES -- RxxMINSTRU CMP #4,W ; JHS BOUNDERRWM1 ; JC=JHS (U>=) SWPB W ; -- BODYDOES W = n << 8 RLAM #2,W ; W = N << 10 JMP BIS_ASMTYPE ; BODYDOES -- asmword "RRCM.A" mDODOES .word TYPE3DOES,0040h asmword "RRCM" mDODOES .word TYPE3DOES,0050h asmword "RRAM.A" mDODOES .word TYPE3DOES,0140h asmword "RRAM" mDODOES .word TYPE3DOES,0150h asmword "RLAM.A" mDODOES .word TYPE3DOES,0240h asmword "RLAM" mDODOES .word TYPE3DOES,0250h asmword "RRUM.A" mDODOES .word TYPE3DOES,0340h asmword "RRUM" mDODOES .word TYPE3DOES,0350h asmword "PUSHM.A" mDODOES .word TYPE3DOES,1400h asmword "PUSHM" mDODOES .word TYPE3DOES,1500h asmword "POPM.A" mDODOES .word TYPE3DOES,1600h asmword "POPM" mDODOES .word TYPE3DOES,1700h ; ---------------------------------------------------------------------- ; DTCforthMSP430FR5xxx ASSEMBLER, CONDITIONAL BRANCHS ; ---------------------------------------------------------------------- ; ASSEMBLER FORTH OPCODE(FEDC) ; OPCODE(code) for TYPE JNE,JNZ 0<>, <> = 0x20xx + (offset AND 3FF) ; branch if Z = 0 ; OPCODE(code) for TYPE JEQ,JZ 0=, = = 0x24xx + (offset AND 3FF) ; branch if Z = 1 ; OPCODE(code) for TYPE JNC,JLO U< = 0x28xx + (offset AND 3FF) ; branch if C = 0 ; OPCODE(code) for TYPE JC,JHS U>= = 0x2Cxx + (offset AND 3FF) ; branch if C = 1 ; OPCODE(code) for TYPE JN 0< = 0x30xx + (offset AND 3FF) ; branch if N = 1 ; OPCODE(code) for TYPE JGE >= = 0x34xx + (offset AND 3FF) ; branch if (N xor V) = 0 ; OPCODE(code) for TYPE JL < = 0x38xx + (offset AND 3FF) ; branch if (N xor V) = 1 ; OPCODE(code) for TYPE JMP = 0x3Cxx + (offset AND 3FF) asmword "S>=" ; if >= assertion (opposite of jump if < ) mDOCON .word 3800h asmword "S<" ; if < assertion mDOCON .word 3400h asmword "0>=" ; if 0>= assertion ; use only with IF UNTIL WHILE ! mDOCON .word 3000h asmword "0<" ; jump if 0< ; use only with ?JMP ?GOTO ! mDOCON .word 3000h asmword "U<" ; if U< assertion mDOCON .word 2C00h asmword "U>=" ; if U>= assertion mDOCON .word 2800h asmword "0<>" ; if <>0 assertion mDOCON .word 2400h asmword "0=" ; if =0 assertion mDOCON .word 2000h ;ASM IF OPCODE -- @OPCODE1 asmword "IF" ASM_IF MOV &DDP,W MOV TOS,0(W) ; compile incomplete opcode ADD #2,&DDP MOV W,TOS mNEXT ;ASM THEN @OPCODE -- resolve forward branch asmword "THEN" ASM_THEN MOV &DDP,W ; -- @OPCODE W=dst MOV TOS,Y ; Y=@OPCODE ASM_THEN1 MOV @PSP+,TOS ; -- MOV Y,X ; ADD #2,X ; -- Y=@OPCODE W=dst X=src+2 SUB X,W ; -- Y=@OPCODE W=dst-src+2=displacement*2 (bytes) RRA W ; -- Y=@OPCODE W=displacement (words) CMP #512,W JC BOUNDERRORW ; (JHS) unsigned branch if u> 511 BIS W,0(Y) ; -- [@OPCODE]=OPCODE completed mNEXT ;C ELSE @OPCODE1 -- @OPCODE2 branch for IF..ELSE asmword "ELSE" ASM_ELSE MOV &DDP,W ; -- W=HERE MOV #3C00h,0(W) ; compile unconditionnal branch ADD #2,&DDP ; -- DP+2 SUB #2,PSP MOV W,0(PSP) ; -- @OPCODE2 @OPCODE1 JMP ASM_THEN ; -- @OPCODE2 ;C BEGIN -- @BEGIN same as FORTH counterpart ;C UNTIL @BEGIN OPCODE -- resolve conditional backward branch asmword "UNTIL" ASM_UNTIL MOV @PSP+,W ; -- OPCODE W=@BEGIN ASM_UNTIL1 MOV TOS,Y ; Y=OPCODE W=@BEGIN ASM_UNTIL2 MOV @PSP+,TOS ; -- MOV &DDP,X ; -- Y=OPCODE X=HERE W=dst SUB #2,W ; -- Y=OPCODE X=HERE W=dst-2 SUB X,W ; -- Y=OPCODE X=src W=src-dst-2=displacement (bytes) RRA W ; -- Y=OPCODE X=HERE W=displacement (words) CMP #-512,W JL BOUNDERRORW ; signed branch if < -512 AND #3FFh,W ; -- Y=OPCODE X=HERE W=troncated negative displacement (words) BIS W,Y ; -- Y=OPCODE (completed) MOV Y,0(X) ADD #2,&DDP mNEXT ;X AGAIN @BEGIN -- uncond'l backward branch ; unconditional backward branch asmword "AGAIN" ASM_AGAIN MOV TOS,W ; W=@BEGIN MOV #3C00h,Y ; Y = asmcode JMP JMP ASM_UNTIL2 ; ;C WHILE @BEGIN OPCODE -- @WHILE @BEGIN asmword "WHILE" ASM_WHILE mDOCOL ; -- @BEGIN OPCODE .word ASM_IF,SWAP,EXIT ;C REPEAT @WHILE @BEGIN -- resolve WHILE loop asmword "REPEAT" ASM_REPEAT mDOCOL ; -- @WHILE @BEGIN .word ASM_AGAIN,ASM_THEN,EXIT ; ------------------------------------------------------------------------------------------ ; DTCforthMSP430FR5xxx ASSEMBLER : branch up to 3 backward labels and up to 3 forward labels ; ------------------------------------------------------------------------------------------ ; used for non canonical branchs, as BASIC language: "goto line x" ; labels BWx and FWx must be set at the beginning of line (>IN < 8). ; FWx at the beginning of a line can resolve only one previous GOTO|?GOTO FWx. ; BWx at the beginning of a line can be resolved by any subsequent GOTO|?GOTO BWx. BACKWDOES FORTHtoASM MOV @RSP+,IP ; MOV TOS,Y ; -- PFA Y = ASMBWx addr MOV @PSP+,TOS ; -- MOV @Y,W ; W = LABEL CMP #8,&TOIN ; are we colon 8 or more ? BACKWUSE JHS ASM_UNTIL1 ; yes, use this label BACKWSET MOV &DDP,0(Y) ; no, set LABEL = DP mNEXT ; backward label 1 asmword "BW1" mdodoes .word BACKWDOES .word 0 ; backward label 2 asmword "BW2" mdodoes .word BACKWDOES .word 0 ; backward label 3 asmword "BW3" mdodoes .word BACKWDOES .word 0 FORWDOES FORTHtoASM MOV @RSP+,IP MOV &DDP,W ; MOV @TOS,Y ; -- PFA Y=[ASMFWx] CMP #8,&TOIN ; are we colon 8 or more ? FORWUSE JLO ASM_THEN1 ; no: resolve FWx with W=DDP, Y=ASMFWx FORWSET MOV @PSP+,0(W) ; yes compile incomplete opcode ADD #2,&DDP ; increment DDP MOV W,0(TOS) ; store @OPCODE into ASMFWx MOV @PSP+,TOS ; -- mNEXT ; forward label 1 asmword "FW1" mdodoes .word FORWDOES .word 0 ; forward label 2 asmword "FW2" mdodoes .word FORWDOES .word 0 ; forward label 3 asmword "FW3" mdodoes .word FORWDOES .word 0 ;ASM ?GOTO