forthMSP430FR_EXTD_ASM.asm

   1     ; -*- coding: utf-8 -*-
   2 ;
   3 ; ----------------------------------------------------------------------
   4 ;forthMSP430FR_EXTD_ASM.asm
   5 ; ----------------------------------------------------------------------
   6
   7 ; ----------------------------------------------------------------------
   8 ;       MOV(.B) SR,dst   is coded as follow : MOV(.B) R2,dst            ; 1 cycle,  one word    AS=00   (register mode)
   9 ;       MOV(.B) #0,dst   is coded as follow : MOV(.B) R3,dst            ; 1 cycle,  one word    AS=00   (register mode)
  10 ;       MOV(.B) #1,dst   is coded as follow : MOV(.B) (R3),dst          ; 1 cycle,  one word    AS=01   ( x(reg)  mode)
  11 ;       MOV(.B) #4,dst   is coded as follow : MOV(.B) @R2,dst           ; 1 cycle,  one word    AS=10   ( @reg    mode)
  12 ;       MOV(.B) #2,dst   is coded as follow : MOV(.B) @R3,dst           ; 1 cycle,  one word    AS=10   ( @reg    mode)
  13 ;       MOV(.B) #8,dst   is coded as follow : MOV(.B) @R2+,dst          ; 1 cycle,  one word    AS=11   ( @reg+   mode)
  14 ;       MOV(.B) #-1,dst  is coded as follow : MOV(.B) @R3+,dst          ; 1 cycle,  one word    AS=11   ( @reg+   mode)
  15 ; ----------------------------------------------------------------------
  16 ;       MOV(.B) &EDE,dst is coded as follow : MOV(.B) EDE(R2),dst       ; 3 cycles, two words   AS=01   ( x(reg)  mode)
  17 ;       MOV(.B) #xxxx,dst is coded as follow: MOV(.B) @PC+,dst          ; 2 cycles, two words   AS=11   ( @reg+   mode)
  18 ; ----------------------------------------------------------------------
  19
  20 ; PUSHM order : PSP,TOS, IP,  S,  T,  W,  X,  Y, rDOVAR,rDOCON,rDODOES, rDOCOL, R3, SR,RSP, PC
  21 ; PUSHM order : R15,R14,R13,R12,R11,R10, R9, R8,  R7   ,  R6  ,  R5   ,   R4  , R3, R2, R1, R0
  22
  23 ; example : PUSHM #6,IP pushes IP,S,T,W,X,Y registers to return stack
  24 ;
  25 ; POPM  order :  PC,RSP, SR, R3, rDOCOL,rDODOES,rDOCON,rDOVAR,  Y,  X,  W,  T,  S, IP,TOS,PSP
  26 ; POPM  order :  R0, R1, R2, R3,   R4  ,  R5   ,  R6  ,  R7  , R8, R9,R10,R11,R12,R13,R14,R15
  27
  28 ; example : POPM #6,IP   pop Y,X,W,T,S,IP registers from return stack
  29
  30 ; ----------------------------------------------------------------------
  31 ; DTCforthMSP430FR5xxx ASSEMBLER : search argument "xxxx"
  32 ; ----------------------------------------------------------------------
  33
  34 ; common code for maxi 3 successive SearchARG: SearchARG, SearchARG+Offset, SearchARG-offset
  35 ; leave PFA of VARIABLE, [PFA] of CONSTANT, User_Parameter_Field_Address of MARKER_DOES, CFA for all others.
  36 ; if the ARGument is not found after those three SearchARg, the 'not found' error is issued by SrchOfst.
  37 SearchARGn  PUSH &TOIN              ;                   push TOIN for iterative SearchARGn if any
  38             mASM2FORTH              ; -- sep            sep =  ','|'('|' '
  39             .word WORDD,FIND        ; -- addr           search definition
  40             .word QFBRAN,SRCHARGNUM ; -- addr           if not found
  41             mNEXTADR                ; -- CFA            of this definition
  42             MOV @TOS+,S             ; -- PFA            S=DOxxx
  43 QDOVAR      SUB #1287h,S            ;                   if CFA is DOVAR ?
  44 ISDOVAR     JZ ARGFOUND             ; -- addr           yes, PFA = adr of VARIABLE
  45 QDOCON      ADD #1,S                ;                   is CFA is DOCON ?
  46             JNZ QMARKER             ;                   no
  47 ISDOCON     MOV @TOS,TOS            ; -- cte            yes, TOS = constant
  48             JMP ARGFOUND            ; -- cte
  49 QMARKER     CMP #MARKER_DOES,0(TOS) ; -- PFA            search if PFA = [MARKER_DOES]
  50             JNZ ISOTHER             ; -- PFA
  51         .IFDEF VOCABULARY_SET       ; -- PFA
  52 ISMARKER    ADD #30,TOS             ; -- UPFA+2         skip room for DP, CURRENT, CONTEXT(8), null_word, LASTVOC, RET_ADR 2+(2+2+16+2+2+2) bytes +2 !
  53         .ELSE                       ;
  54 ISMARKER    ADD #8,TOS              ; -- UPFA+2         skip room for DP, RET_ADR  2+(2+2) bytes +2 !
  55         .ENDIF                      ;
  56 ISOTHER     SUB #2,TOS              ; -- CFA|UPFA       UPFA = MARKER_DOES User_Parameter_Field_Address
  57 ARGFOUND    ADD #2,RSP              ;                   remove TOIN
  58             MOV @RSP+,PC            ;24                 SR(Z)=0 if ARG found
  59
  60 SRCHARGNUM  .word QNUMBER           ;
  61             .word QFBRAN,ARGNOTFOUND; -- addr
  62             .word ARGFOUND          ; -- value
  63 ARGNOTFOUND mNEXTADR                ; -- addr
  64             MOV @RSP+,&TOIN         ;                   restore TOIN
  65             MOV @RSP+,PC            ;32                 SR(Z)=1 if ARG not found
  66 ; ----------------------------------;
  67
  68 ; ----------------------------------;
  69 SearchIndex
  70 ; Search index of "xxxx(REG),"      ; <== CompIdxSrchRn <== PARAM1IDX
  71 ; Search index of ",xxxx(REG)"      ; <== CompIdxSrchRn <== PARAM2IDX
  72 ; Search index of "xxxx(REG),"      ; <== CALLA, MOVA
  73 ; Search index of ",xxxx(REG)"      ; <== MOVA
  74             SUB #1,&TOIN            ;               move >IN back one (unskip first_char)
  75             MOV #'(',TOS            ; addr -- "("   as WORD separator to find xxxx of "xxxx(REG),"
  76 SearchARG                           ; sep -- n|d    or abort" not found"
  77 ; Search ARG of "#xxxx,"            ; <== PARAM1SHARP   sep = ','
  78 ; Search ARG of "&xxxx,"            ; <== PARAMXAMP     sep = ','
  79 ; Search ARG of ",&xxxx"            ; <== PARAMXAMP <== PARAM2AMP   sep = ' '
  80             MOV TOS,W               ;
  81             PUSHM #4,IP             ; -- sep        PUSHM IP,S,T,W as IP_RET,OPCODE,OPCODEADR,sep
  82             CALL #SearchARGn        ;               first search argument without offset
  83             JNZ SrchEnd             ; -- ARG        if ARG found
  84 SearchArgPl MOV #'+',TOS            ; -- '+'
  85             CALL #SearchARGn        ;               2th search argument with '+' as separator
  86             JNZ ArgPlusOfst         ; -- ARG        if ARG of ARG+offset found
  87 SearchArgMi MOV #'-',TOS            ; -- '-'
  88             CALL #SearchARGn        ;               3th search argument with '-' as separator
  89             SUB #1,&TOIN            ;               to handle offset with its minus sign
  90 ArgPlusOfst PUSH TOS                ; -- ARG        R-- IP_RET,OPCODE,OPCODEADR,sep,ARG
  91             MOV 2(RSP),TOS          ; -- sep        reload offset sep
  92 SrchOfst    mASM2FORTH              ;
  93             .word WORDD,QNUMBER     ; -- Ofst|c-addr flag
  94             .word QFBRAN,FNOTFOUND  ; -- c-addr     no return, see INTERPRET
  95             mNEXTADR                ; -- Ofst
  96             ADD @RSP+,TOS           ; -- Arg+Ofst
  97 SrchEnd     POPM #4,IP              ;               POPM W,T,S,IP     common return for SearchARG and SearchRn
  98             MOV @RSP+,PC            ;66
  99
 100 ; Arg_Double_to_single conversion needed only for OPCODE type V|VI, 2th pass.
 101 ARGD2S      BIT #UF9,SR             ; -- Lo Hi
 102             JZ ARGD2SEND
 103             MOV @PSP+,TOS           ; -- Lo         skip hi
 104 ARGD2SEND   MOV @RSP+,PC            ;
 105
 106 ; ----------------------------------------------------------------------
 107 ; DTCforthMSP430FR5xxx ASSEMBLER : search REG
 108 ; ----------------------------------------------------------------------
 109 ; compute index of "xxxx(REG),"     ; <== PARAM1IDX, sep=','
 110 ; compute index of ",xxxx(REG)"     ; <== PARAM2IDX, sep=' '
 111 CompIdxSrchRn                       ; addr -- Rn|addr
 112             CALL #SearchIndex       ; -- xxxx       aborted if not found
 113             CALL #ARGD2S            ;               skip arg_hi if DOUBLE
 114             MOV &DP,X
 115             MOV TOS,0(X)            ; -- xxxx       compile ARG xxxx
 116             ADD #2,&DP
 117             MOV #')',TOS            ; -- ")"        prepare separator to search REG of "xxxx(REG)"
 118 ; search REG of "xxxx(REG),"
 119 ; search REG of ",xxxx(REG)"
 120 ; search REG of "@REG,"   sep = ',' ; <== PARAM1AT
 121 SkipRSrchRn ADD #1,&TOIN            ;               skip 'R' in input buffer
 122 ; search REG of "@REG+,"  sep = '+' ; <== PARAM1ATPL
 123 ; search REG of "REG,"    sep = ',' ; <== PARAM1REG
 124 ; search REG of ",REG"    sep = ' ' ; <== PARAM2REG
 125 SearchRn    MOV &TOIN,W             ;
 126             PUSHM #4,IP             ;               PUSHM IP,S,T,W as IP_RET,OPCODE,OPCODEADR,TOIN
 127             mASM2FORTH              ;               search xx of Rxx
 128             .word WORDD,QNUMBER     ;
 129             .word QFBRAN,REGNOTFOUND; -- xxxx       SR(Z)=1 if Not a Number
 130             mNEXTADR                ; -- Rn         number is found
 131             CMP #16,TOS             ; -- Rn
 132             JNC SrchEnd             ; -- Rn         SR(Z)=0, Rn found,
 133             JC  REGNUM_ERR          ;               abort if Rn out of bounds
 134
 135 REGNOTFOUND mNEXTADR                ; -- addr       SR(Z)=1, (used in case of @REG not found),
 136             MOV @RSP,&TOIN          ; -- addr       restore TOIN, ready for next SearchRn
 137             JMP SrchEnd             ; -- addr       SR(Z)=1 ==> not a register
 138
 139 ; ----------------------------------------------------------------------
 140 ; DTCforthMSP430FR5xxx ASSEMBLER : INTERPRET FIRST OPERAND
 141 ; ----------------------------------------------------------------------
 142 ; PARAM1     separator --           ; parse input buffer until separator and compute first operand of opcode
 143                                     ;               sep is "," for src TYPE II and " " for dst (TYPE II).
 144 PARAM1      JNZ QPARAM1SHARP        ; -- sep        if prefix <> 'R'
 145 PARAM1REG   CALL #SearchRn          ;               case of "REG,"
 146             JNZ SWAPREG             ; -- 000R       REG of "REG," found, S=OPCODE=0
 147 ; ----------------------------------;
 148 QPARAM1SHARP CMP.B #'#',W           ; -- sep        W=first char
 149             JNE QPARAM1AMP
 150 PARAM1SHARP CALL #SearchARG         ; -- xxxx       abort if not found
 151             CALL #ARGD2S            ;               skip arg_hi of OPCODE type V
 152             MOV #0300h,S            ;               OPCODE = 0300h : MOV #0,dst is coded MOV R3,dst
 153             CMP #0,TOS              ; -- xxxx       #0 ?
 154             JZ PARAMENDOF
 155             MOV #0310h,S            ;               OPCODE = 0310h : MOV #1,dst is coded MOV 0(R3),dst
 156             CMP #1,TOS              ; -- xxxx       #1 ?
 157             JZ PARAMENDOF
 158             MOV #0320h,S            ;               OPCODE = 0320h : MOV #2,dst is coded MOV @R3,dst
 159             CMP #2,TOS              ; -- xxxx       #2 ?
 160             JZ PARAMENDOF
 161             MOV #0330h,S            ;               OPCODE = 0330h : MOV #-1,dst is coded MOV @R3+,dst
 162             CMP #-1,TOS             ; -- xxxx       #-1 ?
 163             JZ PARAMENDOF
 164             MOV #0220h,S            ;               OPCODE = 0220h : MOV #4,dst is coded MOV @R2,dst
 165             CMP #4,TOS              ; -- xxxx       #4 ?
 166             JZ PARAMENDOF
 167             MOV #0230h,S            ;               OPCODE = 0230h : MOV #8,dst is coded MOV @R2+,dst
 168             CMP #8,TOS              ; -- xxxx       #8 ?
 169             JZ PARAMENDOF
 170 SHARPOTHERS MOV #0030h,S            ; -- xxxx       for all other cases : MOV @PC+,dst
 171 ; endcase of "&xxxx,"               ;               <== PARAM1AMP
 172 ; endcase of ",&xxxx"               ;               <== PARAMXAMP <== PARAM2AMP
 173 StoreArg    MOV &DP,X               ;
 174             ADD #2,&DP              ;               cell allot for arg
 175             MOV TOS,0(X)            ;               compile arg
 176             JMP PARAMENDOF
 177 ; ----------------------------------;
 178 QPARAM1AMP  CMP.B #'&',W            ; -- sep
 179             JNE QPARAM1AT
 180 ; case of "&xxxx,"                  ;               search for "&xxxx,"
 181 PARAM1AMP   MOV #0210h,S            ;               set code type : xxxx(R2) with AS=0b01 ==> x210h
 182 ; case of "&xxxx,"|",&xxxx"         ;               <== PARAM2AMP
 183 PARAMXAMP   CALL #SearchARG         ;
 184             CALL #ARGD2S            ;               skip arg_hi of OPCODE type V
 185             JMP StoreArg            ; --            then ret
 186 ; ----------------------------------;
 187 QPARAM1AT   CMP.B #'@',W            ; -- sep
 188             JNE PARAM1IDX
 189 ; case of "@REG,"|"@REG+,"
 190 PARAM1AT    MOV #0020h,S            ; -- sep        init OPCODE with indirect code type : AS=0b10
 191             CALL #SkipRSrchRn       ;               Z = not found
 192             JNZ SWAPREG             ; -- Rn         REG of "@REG," found
 193 ; case of "@REG+,"                  ; -- addr       search REG of "@REG+"
 194 PARAM1ATPL  MOV #'+',TOS            ; -- sep
 195             CALL #SearchRn          ;
 196             JNZ PARAM1ATPLX         ; -- Rn         REG found
 197 ; ----------------------------------;               REG not found
 198 ; case of "xxxx(REG),"              ; -- sep        OPCODE I
 199 ; case of "xxxx(REG)"               ; -- sep        OPCODE II
 200 PARAM1IDX   CALL #CompIdxSrchRn     ; -- 000R       compile index xxxx and search REG of "(REG)", abort if xxxx not found
 201 ; case of "@REG+,"|"xxxx(REG),"     ;               <== PARAM1ATPL OPCODE I
 202 ; case of "@REG+"|"xxxx(REG)"       ;               <== PARAM1ATPL OPCODE II
 203 PARAM1ATPLX BIS #0010h,S            ;               AS=0b01 for indexing address, AS=0b11 for @REG+
 204             MOV #3FFFh,W            ;2              4000h = first OPCODE type I
 205             CMP S,W                 ;1              with OPCODE II @REG or xxxx(REG) don't skip CR !
 206             ADDC #0,&TOIN           ;1              with OPCODE I, @REG+, or xxxx(REG), skip "," ready for the second operand search
 207 ; endcase of "@REG,"                ; -- 000R       <== PARAM1AT
 208 ; endcase of "REG,"                 ; -- 000R       <== PARAM1REG
 209 SWAPREG     SWPB TOS                ; -- 0R00       swap bytes because it's not a dst REG typeI (not a 2 ops inst.)
 210 ; endcase of ",REG"                 ; -- 0R0D       <== PARAM2REG (dst REG typeI)
 211 ; endcase of ",xxxx(REG)"           ; -- 0R0D       <== PARAM2IDX (dst REG typeI)
 212 OPCODEPLREG ADD TOS,S               ; -- 0R00|0R0D
 213 ; endcase of all                    ;               <== PARAM1SHARP PARAM1AMP PARAM2AMP
 214 PARAMENDOF  MOV @PSP+,TOS           ; --
 215             MOV @IP+,PC             ; --            S=OPCODE,T=OPCODEADR
 216 ; ----------------------------------;
 217
 218 ; ----------------------------------------------------------------------
 219 ; DTCforthMSP430FR5xxx ASSEMBLER : INTERPRET 2th OPERAND
 220 ; ----------------------------------------------------------------------
 221 PARAM2      JNZ     QPARAM2AMP      ; -- sep        if prefix <> 'R'
 222 PARAM2REG   CALL    #SearchRn       ; -- sep        case of ",REG"
 223             JNZ     OPCODEPLREG     ; -- 000D       REG of ",REG" found
 224 ; ----------------------------------;
 225 QPARAM2AMP  CMP.B   #'&',W          ;
 226             JNZ     PARAM2IDX       ;               '&' not found
 227 ; case of ",&xxxx"                  ;
 228 PARAM2AMP   BIS     #0082h,S        ;               change OPCODE : AD=1, dst = R2
 229             JMP     PARAMXAMP       ; -- ' '
 230 ; ----------------------------------;
 231 ; case of ",xxxx(REG)               ; -- sep
 232 PARAM2IDX   BIS     #0080h,S        ;               set AD=1
 233             CALL    #CompIdxSrchRn  ;               compile index xxxx and search REG of ",xxxx(REG)", abort if xxxx not found
 234             JNZ     OPCODEPLREG     ; -- 000D       if REG found
 235             MOV     #NOTFOUND,PC    ;               does ABORT" ?"
 236 ; ----------------------------------;
 237
 238 ; ----------------------------------------------------------------------------------------
 239 ; DTCforthMSP430FR5xxx ASSEMBLER: reset OPCODE in S reg, set OPCODE addr in T reg,
 240 ; move Prefix in W reg, skip prefix in input buffer. Flag SR(Z)=1 if prefix = 'R'.
 241 ; ----------------------------------------------------------------------------------------
 242 InitAndSkipPrfx
 243             MOV #0,S                ;                   reset OPCODE
 244             MOV &DP,T               ;                   HERE --> OPCODEADR
 245             ADD #2,&DP              ;                   cell allot for opcode
 246 ; SkipPrfx                          ; --                skip all occurring char 'BL', plus one prefix
 247 SkipPrfx    MOV #20h,W              ; --                W=BL
 248             MOV &TOIN,X             ; --
 249             ADD &SOURCE_ORG,X       ;
 250 SKIPLOOP    CMP.B @X+,W             ; --                W=BL  does character match?
 251             JZ SKIPLOOP             ; --
 252             MOV.B -1(X),W           ;                   W=prefix
 253             SUB &SOURCE_ORG,X       ; --
 254             MOV X,&TOIN             ; --                >IN points after prefix
 255             CMP.B #'R',W            ;                   preset SR(Z)=1 if prefix = 'R'
 256             MOV @IP+,PC             ; 4
 257
 258 ; ----------------------------------------------------------------------
 259 ; DTCforthMSP430FR5xxx ASSEMBLER: OPCODE TYPE 0 : zero operand      :-)
 260 ; ----------------------------------------------------------------------
 261             asmword "RETI"
 262             mDOCOL
 263             .word   lit,1300h,COMMA,EXIT
 264
 265 ; ----------------------------------------------------------------------
 266 ; DTCforthMSP430FR5xxx ASSEMBLER: OPCODES TYPE I : double operand
 267 ; ----------------------------------------------------------------------
 268 ;               OPCODE(FEDC)
 269 ; OPCODE(code)     = 0bxxxx             opcode
 270 ;                   OPCODE(BA98)
 271 ;                      = 0bxxxx         src_register,
 272 ;                       OPCODE(7)       AD (dst addr type)
 273 ;                          = 0b0        ,register
 274 ;                          = 0b1        ,x(Rn),&adr
 275 ;                        OPCODE(6)      size
 276 ; OPCODE(B)                 = 0b0       word
 277 ;                           = 0b1       byte
 278 ;                         OPCODE(54)    AS (src addr type)
 279 ; OPCODE(AS)                 = 0b00     register,
 280 ;                            = 0b01     x(Rn),&adr,
 281 ;                            = 0b10     @Rn,
 282 ;                            = 0b11     @Rn+,
 283 ;                           OPCODE(3210)
 284 ; OPCODE(dst)                  = 0bxxxx ,dst_register
 285 ; ----------------------------------------------------------------------
 286
 287 ; TYPE1DOES     -- BODYDOES      search and compute PARAM1 & PARAM2 as src and dst operands then compile instruction
 288 TYPE1DOES   .word   lit,','
 289             .word   InitAndSkipPrfx ;                       init S=0, T=DP, DP=DP+2 then skip prefix, SR(Z)=1 if prefix = 'R'
 290             .word   PARAM1          ; -- BODYDOES           S=OPCODE,T=OPCODEADR
 291             .word   BL,SkipPrfx     ;                       SR(Z)=1 if prefix = 'R'
 292             .word   PARAM2          ; -- BODYDOES           S=OPCODE,T=OPCODEADR
 293             mNEXTADR                ;
 294 MAKEOPCODE  MOV     @RSP+,IP
 295             BIS     @TOS,S          ; -- opcode             generic opcode + customized S
 296             MOV     S,0(T)          ; -- opcode             store complete opcode
 297             JMP     PARAMENDOF      ; --                    then EXIT
 298
 299             asmword "MOV"
 300             CALL rDODOES
 301             .word   TYPE1DOES,4000h
 302             asmword "MOV.B"
 303             CALL rDODOES
 304             .word   TYPE1DOES,4040h
 305             asmword "ADD"
 306             CALL rDODOES
 307             .word   TYPE1DOES,5000h
 308             asmword "ADD.B"
 309             CALL rDODOES
 310             .word   TYPE1DOES,5040h
 311             asmword "ADDC"
 312             CALL rDODOES
 313             .word   TYPE1DOES,6000h
 314             asmword "ADDC.B"
 315             CALL rDODOES
 316             .word   TYPE1DOES,6040h
 317             asmword "SUBC"
 318             CALL rDODOES
 319             .word   TYPE1DOES,7000h
 320             asmword "SUBC.B"
 321             CALL rDODOES
 322             .word   TYPE1DOES,7040h
 323             asmword "SUB"
 324             CALL rDODOES
 325             .word   TYPE1DOES,8000h
 326             asmword "SUB.B"
 327             CALL rDODOES
 328             .word   TYPE1DOES,8040h
 329             asmword "CMP"
 330             CALL rDODOES
 331             .word   TYPE1DOES,9000h
 332             asmword "CMP.B"
 333             CALL rDODOES
 334             .word   TYPE1DOES,9040h
 335             asmword "DADD"
 336             CALL rDODOES
 337             .word   TYPE1DOES,0A000h
 338             asmword "DADD.B"
 339             CALL rDODOES
 340             .word   TYPE1DOES,0A040h
 341             asmword "BIT"
 342             CALL rDODOES
 343             .word   TYPE1DOES,0B000h
 344             asmword "BIT.B"
 345             CALL rDODOES
 346             .word   TYPE1DOES,0B040h
 347             asmword "BIC"
 348             CALL rDODOES
 349             .word   TYPE1DOES,0C000h
 350             asmword "BIC.B"
 351             CALL rDODOES
 352             .word   TYPE1DOES,0C040h
 353             asmword "BIS"
 354             CALL rDODOES
 355             .word   TYPE1DOES,0D000h
 356             asmword "BIS.B"
 357             CALL rDODOES
 358             .word   TYPE1DOES,0D040h
 359             asmword "XOR"
 360             CALL rDODOES
 361             .word   TYPE1DOES,0E000h
 362             asmword "XOR.B"
 363             CALL rDODOES
 364             .word   TYPE1DOES,0E040h
 365             asmword "AND"
 366             CALL rDODOES
 367             .word   TYPE1DOES,0F000h
 368             asmword "AND.B"
 369             CALL rDODOES
 370             .word   TYPE1DOES,0F040h
 371
 372 ; ----------------------------------------------------------------------
 373 ; DTCforthMSP430FR5xxx ASSEMBLER, OPCODES TYPE II : single operand
 374 ; ----------------------------------------------------------------------
 375 ;               OPCODE(FEDCBA987)
 376 ; OPCODE(code)     = 0bxxxxxxxxx
 377 ;                        OPCODE(6)      size
 378 ; OPCODE(B)                 = 0b0       word
 379 ;                           = 0b1       byte
 380 ;                         OPCODE(54)    (dst addr type)
 381 ; OPCODE(AS)                 = 0b00     register
 382 ;                            = 0b01     x(Rn),&adr
 383 ;                            = 0b10     @Rn
 384 ;                            = 0b11     @Rn+
 385 ;                           OPCODE(3210)
 386 ; OPCODE(dst)                  = 0bxxxx dst register
 387 ; ----------------------------------------------------------------------
 388
 389 TYPE2DOES                           ; -- BODYDOES
 390             .word   BL              ; -- BODYDOES ' '
 391             .word   InitAndSkipPrfx ;
 392             .word   PARAM1          ; -- BODYDOES       S=OPCODE,T=OPCODEADR
 393             mNEXTADR                ;
 394             MOV     S,W             ;
 395             AND     #0070h,S        ;                   keep B/W & AS infos in OPCODE
 396             SWPB    W               ;                   (REG org --> REG dst)
 397             AND     #000Fh,W        ;                   keep REG
 398 BIS_ASMTYPE BIS     W,S             ; -- BODYDOES       add it in OPCODE
 399             JMP     MAKEOPCODE      ; -- then end
 400
 401             asmword "RRC"           ; Rotate Right through Carry ( word)
 402             CALL rDODOES
 403             .word   TYPE2DOES,1000h
 404             asmword "RRC.B"         ; Rotate Right through Carry ( byte)
 405             CALL rDODOES
 406             .word   TYPE2DOES,1040h
 407             asmword "SWPB"          ; Swap bytes
 408             CALL rDODOES
 409             .word   TYPE2DOES,1080h
 410             asmword "RRA"
 411             CALL rDODOES
 412             .word   TYPE2DOES,1100h
 413             asmword "RRA.B"
 414             CALL rDODOES
 415             .word   TYPE2DOES,1140h
 416             asmword "SXT"
 417             CALL rDODOES
 418             .word   TYPE2DOES,1180h
 419             asmword "PUSH"
 420             CALL rDODOES
 421             .word   TYPE2DOES,1200h
 422             asmword "PUSH.B"
 423             CALL rDODOES
 424             .word   TYPE2DOES,1240h
 425             asmword "CALL"
 426             CALL rDODOES
 427             .word   TYPE2DOES,1280h
 428
 429 ; ----------------------------------------------------------------------
 430 ; errors output
 431 ; ----------------------------------------------------------------------
 432
 433 MUL_REG_ERR ADD     #1,W            ; <== PUSHM|POPM|RRAM|RRUM|RRCM|RLAM error
 434 BRANCH_ERR  MOV     W,TOS           ; <== ASM_branch error
 435 REGNUM_ERR                          ; <== REG number error
 436             mASM2FORTH              ; -- n      n = value out of bounds
 437             .word   DOT,XSQUOTE
 438             .byte 13,"out of bounds"
 439             .word   QABORT_YES
 440
 441 ; ----------------------------------------------------------------------
 442 ; DTCforthMSP430FR5xxx ASSEMBLER, CONDITIONAL BRANCHS
 443 ; ----------------------------------------------------------------------
 444 ;                       ASSEMBLER       FORTH         OPCODE(FEDC)
 445 ; OPCODE(code) for TYPE JNE,JNZ         0<>, <>     = 0x20xx + (offset AND 3FF) ; branch if Z = 0
 446 ; OPCODE(code) for TYPE JEQ,JZ          0=, =       = 0x24xx + (offset AND 3FF) ; branch if Z = 1
 447 ; OPCODE(code) for TYPE JNC,JLO         U<          = 0x28xx + (offset AND 3FF) ; branch if C = 0
 448 ; OPCODE(code) for TYPE JC,JHS          U>=         = 0x2Cxx + (offset AND 3FF) ; branch if C = 1
 449 ; OPCODE(code) for TYPE JN              0<          = 0x30xx + (offset AND 3FF) ; branch if N = 1
 450 ; OPCODE(code) for TYPE JGE             >=          = 0x34xx + (offset AND 3FF) ; branch if (N xor V) = 0
 451 ; OPCODE(code) for TYPE JL              <           = 0x38xx + (offset AND 3FF) ; branch if (N xor V) = 1
 452 ; OPCODE(code) for TYPE JMP                         = 0x3Cxx + (offset AND 3FF)
 453
 454             asmword "S>="           ; if >= assertion (opposite of jump if < )
 455             CALL rDOCON
 456             .word   3800h
 457
 458             asmword "S<"            ; if < assertion
 459             CALL rDOCON
 460             .word   3400h
 461
 462             asmword "0>="           ; if 0>= assertion  ; use only with IF UNTIL WHILE !
 463             CALL rDOCON
 464             .word   3000h
 465
 466             asmword "0<"            ; jump if 0<        ; use only with ?GOTO !
 467             CALL rDOCON
 468             .word   3000h
 469
 470             asmword "U<"            ; if U< assertion
 471             CALL rDOCON
 472             .word   2C00h
 473
 474             asmword "U>="           ; if U>= assertion
 475             CALL rDOCON
 476             .word   2800h
 477
 478             asmword "0<>"           ; if <>0 assertion
 479             CALL rDOCON
 480             .word   2400h
 481
 482             asmword "0="            ; if =0 assertion
 483             CALL rDOCON
 484             .word   2000h
 485
 486 ;ASM IF      OPCODE -- @OPCODE1
 487             asmword "IF"
 488 ASM_IF      MOV     &DP,W
 489             MOV     TOS,0(W)        ; compile incomplete opcode
 490             ADD     #2,&DP
 491             MOV     W,TOS
 492             MOV     @IP+,PC
 493
 494 ;ASM THEN     @OPCODE --        resolve forward branch
 495             asmword "THEN"
 496 ASM_THEN    MOV     &DP,W           ; -- @OPCODE    W=dst
 497             MOV     TOS,Y           ;               Y=@OPCODE
 498 ASM_THEN1   MOV     @PSP+,TOS       ; --
 499             MOV     Y,X             ;
 500             ADD     #2,X            ; --        Y=@OPCODE   W=dst   X=src+2
 501             SUB     X,W             ; --        Y=@OPCODE   W=dst-src+2=displacement (bytes)
 502             CMP     #1023,W
 503             JC      BRANCH_ERR      ;           (JHS) unsigned branch if displ. > 1022 bytes
 504             RRA     W               ; --        Y=@OPCODE   W=displacement (words)
 505             BIS     W,0(Y)          ; --        [@OPCODE]=OPCODE completed
 506             MOV     @IP+,PC
 507
 508 ; ELSE      @OPCODE1 -- @OPCODE2    branch for IF..ELSE
 509             asmword "ELSE"
 510 ASM_ELSE    MOV     &DP,W           ; --        W=HERE
 511             MOV     #3C00h,0(W)     ;           compile unconditionnal branch
 512             ADD     #2,&DP          ; --        DP+2
 513             SUB     #2,PSP
 514             MOV     W,0(PSP)        ; -- @OPCODE2 @OPCODE1
 515             JMP     ASM_THEN        ; -- @OPCODE2
 516
 517 ; BEGIN     -- BEGINadr             initialize backward branch
 518             asmword "BEGIN"
 519 HERE        SUB #2,PSP
 520             MOV TOS,0(PSP)
 521             MOV &DP,TOS
 522             MOV @IP+,PC
 523
 524 ; UNTIL     @BEGIN OPCODE --   resolve conditional backward branch
 525             asmword "UNTIL"
 526 ASM_UNTIL   MOV     @PSP+,W         ;  -- OPCODE                        W=@BEGIN
 527 ASM_UNTIL1  MOV     TOS,Y           ;               Y=OPCODE            W=@BEGIN
 528 ASM_UNTIL2  MOV     @PSP+,TOS       ;  --
 529             MOV     &DP,X           ;  --           Y=OPCODE    X=HERE  W=dst
 530             SUB     #2,W            ;  --           Y=OPCODE    X=HERE  W=dst-2
 531             SUB     X,W             ;  --           Y=OPCODE    X=src   W=src-dst-2=displacement (bytes)
 532             CMP     #-1024,W        ;
 533             JL      BRANCH_ERR      ;               signed branch if displ. < -1024 bytes
 534             RRA     W               ;  --           Y=OPCODE    X=HERE  W=displacement (words)
 535             AND     #3FFh,W         ;  --           Y=OPCODE   X=HERE  W=troncated negative displacement (words)
 536             BIS     W,Y             ;  --           Y=OPCODE (completed)
 537             MOV     Y,0(X)
 538             ADD     #2,&DP
 539             MOV     @IP+,PC
 540
 541 ; AGAIN     @BEGIN --      uncond'l backward branch
 542 ;   unconditional backward branch
 543             asmword "AGAIN"
 544 ASM_AGAIN   MOV TOS,W               ;               W=@BEGIN
 545             MOV #3C00h,Y            ;               Y = asmcode JMP
 546             JMP ASM_UNTIL2          ;
 547
 548 ; WHILE     @BEGIN OPCODE -- @WHILE @BEGIN
 549             asmword "WHILE"
 550 ASM_WHILE   mDOCOL                  ; -- @BEGIN OPCODE
 551             .word   ASM_IF,SWAP,EXIT
 552
 553 ; REPEAT    @WHILE @BEGIN --     resolve WHILE loop
 554             asmword "REPEAT"
 555 ASM_REPEAT  mDOCOL                  ; -- @WHILE @BEGIN
 556             .word   ASM_AGAIN,ASM_THEN,EXIT
 557
 558 ; ------------------------------------------------------------------------------------------
 559 ; DTCforthMSP430FR5xxx ASSEMBLER : branch up to 3 backward labels and up to 3 forward labels
 560 ; ------------------------------------------------------------------------------------------
 561 ; used for non canonical branchs, as BASIC language: "goto line x"
 562 ; labels BWx and FWx must be set at the beginning of line (>IN < 8).
 563 ; FWx can resolve only one previous GOTO|?GOTO FWx.
 564 ; BWx can resolve any subsequent GOTO|?GOTO BWx.
 565
 566 BACKWDOES   mNEXTADR
 567             MOV @RSP+,IP            ;
 568             MOV @TOS,TOS
 569             MOV TOS,Y               ; -- BODY       Y = BWx addr
 570             MOV @PSP+,TOS           ; --
 571             MOV @Y,W                ;               W = LABEL
 572             CMP #8,&TOIN            ;               are we colon 8 or more ?
 573 BACKWUSE    JC ASM_UNTIL1           ;               yes, use this label
 574 BACKWSET    MOV &DP,0(Y)            ;               no, set LABEL = DP
 575             MOV @IP+,PC
 576
 577 ; backward label 1
 578             asmword "BW1"
 579             CALL rDODOES            ; CFA
 580             .word BACKWDOES         ; PFA
 581             .word ASMBW1            ; in RAM
 582 ; backward label 2
 583             asmword "BW2"
 584             CALL rDODOES
 585             .word BACKWDOES
 586             .word ASMBW2            ; in RAM
 587 ; backward label 3
 588             asmword "BW3"
 589             CALL rDODOES
 590             .word BACKWDOES
 591             .word ASMBW3            ; in RAM
 592
 593 FORWDOES    mNEXTADR
 594             MOV @RSP+,IP
 595             MOV &DP,W               ;
 596             MOV @TOS,TOS
 597             MOV @TOS,Y              ; -- BODY       Y=@OPCODE of FWx
 598             MOV #0,0(TOS)           ;               V3.9: clear @OPCODE of FWx to avoid jmp resolution without label
 599             CMP #8,&TOIN            ;               are we colon 8 or more ?
 600 FORWUSE     JNC ASM_THEN1           ;               no: resolve FWx with W=DP, Y=@OPCODE
 601 FORWSET     MOV @PSP+,0(W)          ;               yes compile opcode (without displacement)
 602             ADD #2,&DP              ;                   increment DP
 603             MOV W,0(TOS)            ;                   store @OPCODE into BODY of FWx
 604             MOV @PSP+,TOS           ; --
 605             MOV @IP+,PC
 606
 607 ; forward label 1
 608             asmword "FW1"
 609             CALL rDODOES            ; CFA
 610             .word FORWDOES          ; PFA
 611             .word ASMFW1            ; in RAM
 612 ; forward label 2
 613             asmword "FW2"
 614             CALL rDODOES
 615             .word FORWDOES
 616             .word ASMFW3            ; in RAM
 617 ; forward label 3
 618             asmword "FW3"
 619             CALL rDODOES
 620             .word FORWDOES
 621             .word ASMFW3            ; in RAM
 622
 623 ;ASM    GOTO <label>                   --       unconditionnal branch to label
 624             asmword "GOTO"
 625             SUB #2,PSP
 626             MOV TOS,0(PSP)
 627             MOV #3C00h,TOS          ;  -- JMP_OPCODE
 628 GOTONEXT    mDOCOL
 629             .word   TICK            ;  -- OPCODE CFA<label>
 630             .word   EXECUTE,EXIT
 631
 632 ;ASM    <cond> ?GOTO <label>    OPCODE --       conditionnal branch to label
 633             asmword "?GOTO"
 634 INVJMP      CMP #3000h,TOS          ; invert code jump process
 635             JZ GOTONEXT             ; case of JN, do nothing
 636             XOR #0400h,TOS          ; case of: JNZ<-->JZ  JNC<-->JC  JL<-->JGE
 637             BIT #1000h,TOS          ; 3xxxh case ?
 638             JZ  GOTONEXT            ; no
 639             XOR #0800h,TOS          ; complementary action for JL<-->JGE
 640             JMP GOTONEXT
 641
 642 ; --------------------------------------------------------------------------------
 643 ; DTCforthMSP430FR5xxx ASSEMBLER, OPCODES TYPE III : PUSHM|POPM|RLAM|RRAM|RRUM|RRCM
 644 ; --------------------------------------------------------------------------------
 645 ; PUSHM, syntax:    PUSHM #n,REG  with 0 < n < 17
 646 ; POPM syntax:       POPM #n,REG  with 0 < n < 17
 647
 648
 649 ; PUSHM order : PSP,TOS, IP,  S,  T,  W,  X,  Y, rEXIT,rDOVAR,rDOCON, rDODOES, R3, SR,RSP, PC
 650 ; PUSHM order : R15,R14,R13,R12,R11,R10, R9, R8,  R7  ,  R6  ,  R5  ,   R4   , R3, R2, R1, R0
 651
 652 ; example : PUSHM #6,IP pushes IP,S,T,W,X,Y registers to return stack
 653 ;
 654 ; POPM  order :  PC,RSP, SR, R3, rDODOES,rDOCON,rDOVAR,rEXIT,  Y,  X,  W,  T,  S, IP,TOS,PSP
 655 ; POPM  order :  R0, R1, R2, R3,   R4   ,  R5  ,  R6  ,  R7 , R8, R9,R10,R11,R12,R13,R14,R15
 656
 657 ; example : POPM #6,IP   pulls Y,X,W,T,S,IP registers from return stack
 658
 659 ; RxxM syntax: RxxM #n,REG  with 0 < n < 5
 660
 661 TYPE3DOES                           ; -- BODYDOES
 662             .word   LIT,','         ; -- BODYDOES ','
 663             .word   SkipPrfx        ;
 664             .word   WORDD,QNUMBER   ;
 665             .word   QFBRAN,FNOTFOUND;                       see INTERPRET
 666             .word   BL              ; -- BODYDOES n ' '
 667             .word   InitAndSkipPrfx ; -- BODYDOES n ' '
 668             .word   PARAM2          ; -- BODYDOES n         S=OPCODE = 0x000R
 669             mNEXTADR
 670             MOV     TOS,W           ; -- BODYDOES n         W = n
 671             MOV     @PSP+,TOS       ; -- BODYDOES
 672             SUB     #1,W            ;                       W = n floored to 0
 673             JN      MUL_REG_ERR
 674             MOV     @TOS,X          ;                       X=OPCODE
 675             RLAM    #4,X            ;                       OPCODE bit 1000h --> C
 676             JNC     RxxMINSTRU      ;                       if bit 1000h = 0
 677 PxxxINSTRU  MOV     S,Y             ;                       S=REG, Y=REG to test
 678             RLAM    #3,X            ;                       OPCODE bit 0200h --> C
 679             JNC     PUSHMINSTRU     ;                       W=n-1 Y=REG
 680 POPMINSTRU  SUB     W,S             ;                       to make POPM opcode, compute first REG to POP; TI is complicated....
 681 PUSHMINSTRU SUB     W,Y             ;                       Y=REG-(n-1)
 682             CMP     #16,Y
 683             JC      MUL_REG_ERR     ;                       JC=JHS    (U>=)
 684             RLAM    #4,W            ;                       W = n << 4
 685             JMP     BIS_ASMTYPE     ; BODYDOES --
 686 RxxMINSTRU  CMP     #4,W            ;
 687             JC      MUL_REG_ERR     ;                       JC=JHS    (U>=)
 688             SWPB    W               ;                       W = n << 8
 689             RLAM    #2,W            ;                       W = N << 10
 690             JMP     BIS_ASMTYPE     ; BODYDOES --
 691
 692             asmword "RRCM"
 693             CALL rDODOES
 694             .word   TYPE3DOES,0050h
 695             asmword "RRAM"
 696             CALL rDODOES
 697             .word   TYPE3DOES,0150h
 698             asmword "RLAM"
 699             CALL rDODOES
 700             .word   TYPE3DOES,0250h
 701             asmword "RRUM"
 702             CALL rDODOES
 703             .word   TYPE3DOES,0350h
 704             asmword "PUSHM"
 705             CALL rDODOES
 706             .word   TYPE3DOES,1500h
 707             asmword "POPM"
 708             CALL rDODOES
 709             .word   TYPE3DOES,1700h
 710             asmword "RRCM.A"
 711             CALL rDODOES
 712             .word   TYPE3DOES,0040h
 713             asmword "RRAM.A"
 714             CALL rDODOES
 715             .word   TYPE3DOES,0140h
 716             asmword "RLAM.A"
 717             CALL rDODOES
 718             .word   TYPE3DOES,0240h
 719             asmword "RRUM.A"
 720             CALL rDODOES
 721             .word   TYPE3DOES,0340h
 722             asmword "PUSHM.A"
 723             CALL rDODOES
 724             .word   TYPE3DOES,1400h
 725             asmword "POPM.A"
 726             CALL rDODOES
 727             .word   TYPE3DOES,1600h
 728
 729 ; --------------------------------------------------------------------------------
 730 ; DTCforthMSP430FR5xxx ASSEMBLER:  OPCODE TYPE III bis: CALLA (without extended word)
 731 ; --------------------------------------------------------------------------------
 732 ; absolute and immediate instructions must be written as $x.xxxx  (DOUBLE numbers with dot)
 733 ; indexed instructions must be written as $xxxx(REG)
 734 ; --------------------------------------------------------------------------------
 735             asmword "CALLA"
 736             mDOCOL
 737             .word   BL              ; -- sep
 738             .word   InitAndSkipPrfx ; -- sep    SR(Z)=1 if prefix = 'R'
 739             mNEXTADR
 740             MOV @RSP+,IP
 741 CALLA0      MOV #134h,S             ;           134h<<4 = 1340h = opcode for CALLA Rn
 742             JNZ CALLA1              ; -- sep    if prefix <> 'R'
 743 CALLA01     CALL #SearchRn          ; -- Rn
 744 CALLA02     RLAM #4,S               ;           (opcode>>4)<<4 = opcode
 745             BIS TOS,S               ;           update opcode with Rn|$x
 746             MOV S,0(T)              ;           store opcode
 747             MOV @PSP+,TOS           ; --
 748             MOV @IP+,PC             ;
 749 ;-----------------------------------;
 750 CALLA1      ADD #2,S                ; -- sep    136h<<4 = opcode for CALLA @REG
 751             CMP.B #'@',W            ;           Search @REG
 752             JNZ CALLA2              ;
 753 CALLA11     CALL #SkipRSrchRn       ;
 754             JNZ  CALLA02            ;           if REG found, update opcode
 755 ;-----------------------------------;
 756             ADD #1,S                ;           137h<<4 = opcode for CALLA @REG+
 757             MOV #'+',TOS            ; -- sep
 758             JMP CALLA01             ;
 759 ;-----------------------------------;
 760 CALLA2      ADD #2,&DP              ; -- sep    make room for xxxx of #$x.xxxx|&$x.xxxx|$xxxx(REG)
 761             CMP.B #'#',W            ;
 762             JNZ CALLA3
 763             MOV #13Bh,S             ;           13Bh<<4 = opcode for CALLA #$x.xxxx
 764 CALLA21     CALL #SearchARG         ; -- Lo Hi
 765             MOV @PSP+,2(T)          ; -- Hi     store $xxxx of #$x.xxxx|&$x.xxxx
 766             JMP CALLA02             ;           update opcode with $x. and store opcode
 767 ;-----------------------------------;
 768 CALLA3      CMP.B #'&',W            ; -- sep
 769             JNZ CALLA4              ;
 770             ADD #2,S                ;           138h<<4 = opcode for CALLA &$x.xxxx
 771             JMP CALLA21
 772 ;-----------------------------------;
 773 CALLA4      SUB #1,S                ;           135h<<4 = opcode for CALLA $xxxx(REG)
 774 CALLA41     CALL #SearchIndex       ; -- n
 775             MOV TOS,2(T)            ; -- n      store $xxxx of $xxxx(REG)
 776             MOV #')',TOS            ; -- sep
 777             JMP CALLA11             ;           search Rn and update opcode
 778
 779 ; ===============================================================
 780 ; to allow data access beyond $FFFF
 781 ; ===============================================================
 782
 783 ; MOVA #$x.xxxx|&$x.xxxx|$xxxx(Rs)|Rs|@Rs|@Rs+ , &$x.xxxx|$xxxx(Rd)|Rd
 784 ; ADDA (#$x.xxxx|Rs , Rd)
 785 ; CMPA (#$x.xxxx|Rs , Rd)
 786 ; SUBA (#$x.xxxx|Rs , Rd)
 787
 788 ; first argument process ACMS1
 789 ;-----------------------------------;
 790 ACMS1       MOV @PSP+,S             ; -- sep        S=BODYDOES
 791             MOV @S,S                ;               S=opcode
 792 ;-----------------------------------;
 793 ACMS10      JNZ ACMS11              ; -- sep        if prefix <> 'R'
 794 ACMS101     CALL #SearchRn          ; -- Rn
 795 ACMS102     RLAM #4,TOS             ;               8<<src
 796             RLAM #4,TOS             ;
 797 ACMS103     BIS S,TOS               ;               update opcode with src|dst
 798             MOV TOS,0(T)            ;               save opcode
 799             MOV T,TOS               ; -- OPCODE_addr
 800             MOV @IP+,PC             ;
 801 ;-----------------------------------;
 802 ACMS11      CMP.B #'#',W            ; -- sep        X=addr
 803             JNE MOVA12              ;
 804             BIC #40h,S              ;               set #opcode
 805 ACMS111     ADD #2,&DP              ;               make room for low #$xxxx|&$xxxx|$xxxx(REG)
 806             CALL #SearchARG         ; -- Lo Hi
 807             MOV @PSP+,2(T)          ; -- Hi         store $xxxx of #$x.xxxx|&$x.xxxx|$xxxx(REG)
 808             AND #0Fh,TOS            ; -- Hi         sel Hi src
 809             JMP ACMS102             ;
 810 ;-----------------------------------;
 811 MOVA12      CMP.B #'&',W            ; -- sep         case of MOVA &$x.xxxx
 812             JNZ MOVA13              ;
 813             XOR #00E0h,S            ;               set MOVA &$x.xxxx, opcode
 814             JMP ACMS111             ;
 815 ;-----------------------------------;
 816 MOVA13      BIC #00F0h,S            ;               set MOVA @REG, opcode
 817             CMP.B #'@',W            ; -- sep
 818             JNZ MOVA14              ;
 819             CALL #SkipRSrchRn       ; -- Rn
 820             JNZ ACMS102             ;               if @REG found
 821             BIS #0010h,S            ;               set @REG+ opcode
 822             MOV #'+',TOS            ; -- '+'
 823 MOVA131     CALL #SearchRn          ; -- Rn         case of MOVA @REG+,|MOVA $x.xxxx(REG),
 824 MOVA132     ADD #1,&TOIN            ;               skip "," ready for the second operand search
 825             JMP ACMS102             ;
 826 ;-----------------------------------;
 827 MOVA14      BIS #0030h,S            ; -- sep        set xxxx(REG), opcode
 828             ADD #2,&DP              ;               make room for first $xxxx of $xxxx(REG),
 829             CALL #SearchIndex       ; -- n
 830             MOV TOS,2(T)            ; -- n          store $xxxx as 2th word
 831             MOV #')',TOS            ; -- ')'
 832             CALL #SkipRSrchRn       ; -- Rn
 833             JMP MOVA132             ;
 834
 835 ; 2th argument process ACMS2
 836 ;-----------------------------------; -- OPCODE_addr sep
 837 ACMS2       MOV @PSP+,T             ; -- sep        T=OPCODE_addr
 838             MOV @T,S                ;               S=opcode
 839 ;-----------------------------------;
 840 ACMS21      JNZ MOVA22              ; -- sep        if prefix <> 'R'
 841 ACMS211     CALL #SearchRn          ; -- Rn
 842             JMP ACMS103             ;
 843 ;-----------------------------------;
 844 MOVA22      BIC #0F0h,S             ; -- sep
 845             ADD #2,&DP              ;               make room for $xxxx
 846             CMP.B #'&',W            ;
 847             JNZ MOVA23              ;
 848             BIS #060h,S             ;               set ,&$x.xxxx opcode
 849             CALL #SearchARG         ; -- Lo Hi
 850             MOV @PSP+,2(T)          ; -- Hi         store $xxxx as 2th word
 851             JMP ACMS103             ;               update opcode with dst $x and write opcode
 852 ;-----------------------------------;
 853 MOVA23      BIS #070h,S             ;               set ,xxxx(REG) opcode
 854             CALL #SearchIndex       ; -- n
 855             MOV TOS,2(T)            ; -- n          write $xxxx of ,$xxxx(REG) as 2th word
 856             MOV #')',TOS            ; -- ")"        as WORD separator to find REG of "xxxx(REG),"
 857             CALL #SkipRSrchRn       ; -- Rn
 858             JMP ACMS103
 859
 860 ; --------------------------------------------------------------------------------
 861 ; DTCforthMSP430FR5xxx ASSEMBLER, OPCODES IV 2 operands: Adda|Cmpa|Mova|Suba (without extended word)
 862 ; --------------------------------------------------------------------------------
 863 ; absolute and immediate instructions must be written as $x.xxxx  (DOUBLE numbers)
 864 ; indexed instructions must be written as $.xxxx(REG) (DOUBLE numbers)
 865 ; --------------------------------------------------------------------------------
 866 TYPE4DOES   .word   lit,','         ; -- BODYDOES ","        char separator for PARAM1
 867             .word   InitAndSkipPRFX ;                       SR(Z)=1 if prefix = 'R'
 868             .word   ACMS1           ; -- OPCODE_addr
 869             .word   BL,SkipPRFX     ;                       SR(Z)=1 if prefix = 'R'
 870             .word   ACMS2           ; -- OPCODE_addr
 871             .word   DROPEXIT
 872
 873             asmword "MOVA"
 874             CALL rDODOES
 875             .word   TYPE4DOES,00C0h
 876             asmword "CMPA"
 877             CALL rDODOES
 878             .word   TYPE4DOES,00D0h
 879             asmword "ADDA"
 880             CALL rDODOES
 881             .word   TYPE4DOES,00E0h
 882             asmword "SUBA"
 883             CALL rDODOES
 884             .word   TYPE4DOES,00F0h
 885
 886
 887 ; PRMX1 is used for OPCODES type V (double operand) and OPCODES type VI (single operand) extended instructions
 888
 889 PRMX1       MOV #1800h,S            ;                   init S=Extended word
 890 ;-----------------------------------;
 891 PRMX10      JNZ PRMX11              ; -- sep        if prefix <> 'R'
 892 PRMX101     CALL #SearchRn          ; -- Rn             Rn of REG; call SearchRn  only to update >IN
 893 PRMX102     MOV S,TOS               ; -- EW             init|update Extended word
 894 PRMX103     MOV @IP+,PC             ; -- Ext_Word
 895 ;-----------------------------------;
 896 PRMX11      CMP.B #'#',W            ; -- sep
 897             JNZ PRMX12
 898 PRMX111     CALL #SearchARG         ; -- Lo Hi          search $x.xxxx of #x.xxxx,
 899             ADD #2,PSP              ; -- Hi             pop unused low word
 900 PRMX113     AND #0Fh,TOS            ;
 901 PRMX114     RLAM #3,TOS
 902             RLAM #4,TOS             ; -- 7<<Hi
 903 PRMX115     BIS TOS,S               ;                   update extended word with srcHi
 904             JMP PRMX102
 905 ;-----------------------------------;
 906 PRMX12      CMP.B #'&',W            ; -- sep
 907             JZ PRMX111
 908 ;-----------------------------------;
 909 PRMX13      CMP.B #'@',W            ; -- sep
 910             JNZ PRMX14
 911 PRMX131     CALL #SkipRSrchRn       ; -- Rn             Rn of @REG,
 912             JNZ PRMX102             ;                   if Rn found
 913 ;-----------------------------------;
 914             MOV #'+',TOS            ; -- '+'
 915 PRMX133     CALL #SearchRn          ; -- Rn             Rn of @REG+,
 916 PRMX134     CMP &SOURCE_LEN,&TOIN   ;                   test case of TYPE VI first parameter without ','
 917             JZ PRMX102              ;                   don't take the risk of skipping CR !
 918             ADD #1,&TOIN            ;                   skip ',' ready to search 2th operand
 919             JMP PRMX102             ;
 920 ;-----------------------------------;
 921 PRMX14      CALL #SearchIndex       ; -- n
 922             MOV TOS,0(PSP)          ; -- Hi Hi
 923 PRMX141     MOV #')',TOS            ; -- Hi ')'
 924             CALL #SkipRSrchRn       ; -- Hi Rn
 925             MOV @PSP+,TOS           ; -- Hi
 926             AND #0Fh,TOS
 927             BIS TOS,S
 928             JMP PRMX134
 929 ;-----------------------------------;
 930
 931 ; PRMX2 is used for OPCODES type V (double operand) extended instructions
 932
 933 ;-----------------------------------;
 934 PRMX2       MOV @PSP+,S             ; -- addr     S=Extended_Word
 935 ;-----------------------------------;
 936 PRMX20      JZ  PRMX102             ; -- sep        if prefix <> 'R'
 937 ;-----------------------------------;
 938 PRMX21      CMP.B #'&',W            ;
 939             JNZ PRMX22              ;
 940 PRMX211     CALL #SearchARG         ; -- Lo Hi
 941 PRMX213     ADD #2,PSP              ; -- hi       pop low word
 942             AND #0Fh,TOS            ; -- Hi
 943             JMP PRMX115             ;               update Extended word with dst_Hi
 944 ;-----------------------------------;
 945 PRMX22      CALL #SearchIndex       ; -- n
 946             JMP PRMX213
 947
 948 ;-----------------------------------;
 949 ; UPDATE_eXtendedWord
 950 ;-----------------------------------;
 951 UPDATE_XW                           ;   BODYDOES >IN Extended_Word -- BODYDOES+2
 952             MOV @PSP+,&TOIN         ; -- BODYDOES EW    restore >IN at the start of instruction string
 953             MOV &DP,T               ;
 954             ADD #2,&DP              ;                   make room for extended word
 955             MOV TOS,S               ;                   S = Extended_Word
 956             MOV @PSP+,TOS           ;
 957             BIS &RPT_WORD,S         ;                   update Extended_word with RPT_WORD
 958             MOV #0,&RPT_WORD        ;                   clear RPT_WORD
 959             BIS @TOS+,S             ; -- BODYDOES+2     update Extended_word with [BODYDOES] = A/L bit
 960             MOV S,0(T)              ;                   store extended word
 961             MOV @IP+,PC             ;
 962 ;-----------------------------------;
 963
 964 ; --------------------------------------------------------------------------------
 965 ; DTCforthMSP430FR5xxx ASSEMBLER, OPCODES V extended double operand
 966 ; --------------------------------------------------------------------------------
 967 ; absolute and immediate instructions must be written as $x.xxxx  (DOUBLE numbers)
 968 ; indexed instructions must be written as $.xxxx(REG) (DOUBLE numbers)
 969 ; --------------------------------------------------------------------------------
 970
 971
 972 ; these instructions below are processed in two pass:
 973 ; pass 1: extended word process by TYPE5DOES with [BODYDOES] value
 974 ; pass 2: instruction process by TYPE1DOES with [BODYDOES+2] value
 975 ; all numeric arguments must be written as DOUBLE numbers (including a point) : $x.xxxx
 976
 977 TYPE5DOES                               ; -- BODYDOES
 978             .word   LIT,TOIN,FETCH      ; -- BODYDOES >IN
 979             .word   lit,','
 980             .word   SkipPrfx,PRMX1      ; -- BODYDOES >IN ','            char separator for PRMX1
 981             .word   BL,SkipPrfx,PRMX2   ; -- BODYDOES >IN Extended_Word
 982             .word   UPDATE_XW           ; -- BODYDOES+2              >IN is restored ready for 2th pass
 983             .word   BRAN,TYPE1DOES      ; -- BODYDOES+2              2th pass: completes instruction with opcode = [BODYDOES+2]
 984
 985             asmword "MOVX"
 986             CALL rDODOES
 987             .word   TYPE5DOES   ; [PFADOES] = TYPE5DOES
 988             .word   40h         ; [BODYDOES] = A/L bit
 989             .word   4000h       ; [BODYDOES+2] = OPCODE
 990             asmword "MOVX.A"
 991             CALL rDODOES
 992             .word   TYPE5DOES,0,4040h
 993             asmword "MOVX.B"
 994             CALL rDODOES
 995             .word   TYPE5DOES,40h,4040h
 996             asmword "ADDX"
 997             CALL rDODOES
 998             .word   TYPE5DOES,40h,5000h
 999             asmword "ADDX.A"
1000             CALL rDODOES
1001             .word   TYPE5DOES,0,5040h
1002             asmword "ADDX.B"
1003             CALL rDODOES
1004             .word   TYPE5DOES,40h,5040h
1005             asmword "ADDCX"
1006             CALL rDODOES
1007             .word   TYPE5DOES,40h,6000h
1008             asmword "ADDCX.A"
1009             CALL rDODOES
1010             .word   TYPE5DOES,0,6040h
1011             asmword "ADDCX.B"
1012             CALL rDODOES
1013             .word   TYPE5DOES,40h,6040h
1014             asmword "SUBCX"
1015             CALL rDODOES
1016             .word   TYPE5DOES,40h,7000h
1017             asmword "SUBCX.A"
1018             CALL rDODOES
1019             .word   TYPE5DOES,0,7040h
1020             asmword "SUBCX.B"
1021             CALL rDODOES
1022             .word   TYPE5DOES,40h,7040h
1023             asmword "SUBX"
1024             CALL rDODOES
1025             .word   TYPE5DOES,40h,8000h
1026             asmword "SUBX.A"
1027             CALL rDODOES
1028             .word   TYPE5DOES,0,8040h
1029             asmword "SUBX.B"
1030             CALL rDODOES
1031             .word   TYPE5DOES,40h,8040h
1032             asmword "CMPX"
1033             CALL rDODOES
1034             .word   TYPE5DOES,40h,9000h
1035             asmword "CMPX.A"
1036             CALL rDODOES
1037             .word   TYPE5DOES,0,9040h
1038             asmword "CMPX.B"
1039             CALL rDODOES
1040             .word   TYPE5DOES,40h,9040h
1041             asmword "DADDX"
1042             CALL rDODOES
1043             .word   TYPE5DOES,40h,0A000h
1044             asmword "DADDX.A"
1045             CALL rDODOES
1046             .word   TYPE5DOES,0,0A040h
1047             asmword "DADDX.B"
1048             CALL rDODOES
1049             .word   TYPE5DOES,40h,0A040h
1050             asmword "BITX"
1051             CALL rDODOES
1052             .word   TYPE5DOES,40h,0B000h
1053             asmword "BITX.A"
1054             CALL rDODOES
1055             .word   TYPE5DOES,0,0B040h
1056             asmword "BITX.B"
1057             CALL rDODOES
1058             .word   TYPE5DOES,40h,0B040h
1059             asmword "BICX"
1060             CALL rDODOES
1061             .word   TYPE5DOES,40h,0C000h
1062             asmword "BICX.A"
1063             CALL rDODOES
1064             .word   TYPE5DOES,0,0C040h
1065             asmword "BICX.B"
1066             CALL rDODOES
1067             .word   TYPE5DOES,40h,0C040h
1068             asmword "BISX"
1069             CALL rDODOES
1070             .word   TYPE5DOES,40h,0D000h
1071             asmword "BISX.A"
1072             CALL rDODOES
1073             .word   TYPE5DOES,0,0D040h
1074             asmword "BISX.B"
1075             CALL rDODOES
1076             .word   TYPE5DOES,40h,0D040h
1077             asmword "XORX"
1078             CALL rDODOES
1079             .word   TYPE5DOES,40h,0E000h
1080             asmword "XORX.A"
1081             CALL rDODOES
1082             .word   TYPE5DOES,0,0E040h
1083             asmword "XORX.B"
1084             CALL rDODOES
1085             .word   TYPE5DOES,40h,0E040h
1086             asmword "ANDX"
1087             CALL rDODOES
1088             .word   TYPE5DOES,40h,0F000h
1089             asmword "ANDX.A"
1090             CALL rDODOES
1091             .word   TYPE5DOES,0,0F040h
1092             asmword "ANDX.B"
1093             CALL rDODOES
1094             .word   TYPE5DOES,40h,0F040h
1095
1096 ; --------------------------------------------------------------------------------
1097 ; DTCforthMSP430FR5xxx ASSEMBLER, OPCODES VI extended single operand (take count of RPT)
1098 ; --------------------------------------------------------------------------------
1099 ; absolute and immediate instructions must be written as $x.xxxx  (DOUBLE numbers)
1100 ; indexed instructions must be written as $.xxxx(REG) (DOUBLE numbers)
1101 ; --------------------------------------------------------------------------------
1102
1103 ; these instructions below are processed in two pass:
1104 ; pass 1: extended word process by TYPE6DOES with [BODYDOES] value
1105 ; pass 2: instruction process by TYPE2DOES with [BODYDOES+2] value
1106 ; all numeric arguments must be written as DOUBLE numbers (including a point) : $x.xxxx
1107
1108 TYPE6DOES                               ; -- BODYDOES
1109             .word   LIT,TOIN,FETCH      ; -- BODYDOES >IN
1110             .word   BL,SkipPrfx,PRMX1   ; -- BODYDOES >IN Extended_Word
1111             .word   UPDATE_XW           ; -- BODYDOES+2
1112             .word   BRAN,TYPE2DOES      ; -- BODYDOES+2         pass 2: completes instruction with opcode = [BODYDOES+2]
1113
1114             asmword "RRCX"              ; ZC=0; RRCX Rx,Rx may be repeated by prefix RPT #n|Rn
1115             CALL rDODOES
1116             .word   TYPE6DOES,40h,1000h
1117             asmword "RRCX.A"            ; ZC=0; RRCX.A Rx may be repeated by prefix RPT #n|Rn
1118             CALL rDODOES
1119             .word   TYPE6DOES,0,1040h
1120             asmword "RRCX.B"            ; ZC=0; RRCX.B Rx may be repeated by prefix RPT #n|Rn
1121             CALL rDODOES
1122             .word   TYPE6DOES,40h,1040h
1123             asmword "RRUX"              ; ZC=1; RRUX Rx may be repeated by prefix RPT #n|Rn
1124             CALL rDODOES
1125             .word   TYPE6DOES,140h,1000h
1126             asmword "RRUX.A"            ; ZC=1; RRUX.A Rx may be repeated by prefix RPT #n|Rn
1127             CALL rDODOES
1128             .word   TYPE6DOES,100h,1040h
1129             asmword "RRUX.B"            ; ZC=1; RRUX.B Rx may be repeated by prefix RPT #n|Rn
1130             CALL rDODOES
1131             .word   TYPE6DOES,140h,1040h
1132             asmword "SWPBX"
1133             CALL rDODOES
1134             .word   TYPE6DOES,40h,1080h
1135             asmword "SWPBX.A"
1136             CALL rDODOES
1137             .word   TYPE6DOES,0,1080h
1138             asmword "RRAX"
1139             CALL rDODOES
1140             .word   TYPE6DOES,40h,1100h
1141             asmword "RRAX.A"
1142             CALL rDODOES
1143             .word   TYPE6DOES,0,1140h
1144             asmword "RRAX.B"
1145             CALL rDODOES
1146             .word   TYPE6DOES,40h,1140h
1147             asmword "SXTX"
1148             CALL rDODOES
1149             .word   TYPE6DOES,40h,1180h
1150             asmword "SXTX.A"
1151             CALL rDODOES
1152             .word   TYPE6DOES,0,1180h
1153             asmword "PUSHX"
1154             CALL rDODOES
1155             .word   TYPE6DOES,40h,1200h
1156             asmword "PUSHX.A"
1157             CALL rDODOES
1158             .word   TYPE6DOES,0,1240h
1159             asmword "PUSHX.B"
1160             CALL rDODOES
1161             .word   TYPE6DOES,40h,1240h
1162
1163 ; ----------------------------------------------------------------------
1164 ; DTCforthMSP430FR5xxx ASSEMBLER, RPT instruction before REG|REG,REG eXtended instructions
1165 ; ----------------------------------------------------------------------
1166 ; RPT #1 is coded 0 in repetition count field (count n-1)
1167 ; please note that "RPT Rn" with [Rn]=0 has same effect as "RPT #1"
1168
1169 RPT_WORD    .word 0
1170
1171             asmword "RPT"           ; RPT #n | RPT Rn     repeat n | [Rn] times modulo 16
1172             mDOCOL
1173             .word   BL,SkipPrfx     ; -- sep
1174             mNEXTADR                ;
1175             JNZ RPT1                ; -- sep        if prefix <> 'R'
1176             CALL #SearchRn          ; -- Rn
1177             BIS #80h,TOS            ; -- $008R  R=Rn
1178             JMP RPT2
1179 RPT1        CALL #SearchARG         ; -- $xxxx
1180             SUB #1,TOS              ; -- n-1
1181             AND #0Fh,TOS            ; -- $000x
1182 RPT2        MOV TOS,&RPT_WORD
1183             MOV @PSP+,TOS
1184             MOV @RSP+,IP
1185             MOV @IP+,PC