forthMSP430FR_ASM.asm

   1 ; -*- coding: utf-8 -*-
   2
   3 ; ----------------------------------------------------------------------
   4 ;forthMSP430FR_asm.asm 1584 bytes
   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 3 successive Searches: ARG, ARG+Offset, ARG-offset
  35 ; part I: search symbolic ARG,
  36 ; leave PFA of VARIABLE, [PFA] of CONSTANT, User_Parameter_Field_Address of MARKER_DOES, CFA for all others.
  37 SearchARGn  PUSH &TOIN              ;4                  push TOIN for iterative SearchARGn
  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             SUB #1287h,S            ;                   if CFA is DOVAR ?
  44             JZ ARGFOUND             ; -- addr           yes, PFA = adr of VARIABLE
  45             ADD #1,S                ;                   is CFA is DOCON ?
  46             JNZ QMARKER             ;                   no
  47             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             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             ADD #8,TOS              ; -- UPFA+2         skip room for DP, RET_ADR  2+(2+2) bytes +2 !
  55         .ENDIF                      ;
  56 ISOTHER     SUB #2,TOS              ; -- ARG            for all other cases
  57 ARGFOUND    ADD #2,RSP              ;                   remove TOIN
  58             MOV @RSP+,PC            ;24                 SR(Z)=0 if ARG found
  59 ; Part II: search numeric ARG if symbolic ARG not found
  60 SRCHARGNUM  .word QNUMBER           ;
  61             .word QFBRAN,ARGNOTFOUND; -- addr
  62             .word ARGFOUND          ; -- ARG
  63 ARGNOTFOUND mNEXTADR                ; -- addr
  64             MOV @RSP+,&TOIN         ;                   restore TOIN
  65             MOV @RSP+,PC            ;32                 return to caller with 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 ARG without offset
  83             JNZ SrchEnd             ; -- ARG        if ARG found
  84             MOV #'+',TOS            ; -- '+'
  85             CALL #SearchARGn        ;               2th: search ARG + offset
  86             JNZ ArgPlusOfst         ; -- ARG        if ARG of ARG+offset found
  87             MOV #'-',TOS            ; -- '-'
  88             CALL #SearchARGn        ;               3th: search ARG - offset
  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             mASM2FORTH              ;               search offset
  93             .word WORDD,QNUMBER     ; -- Ofst|c-addr flag
  94             .word QFBRAN,FNOTFOUND  ; -- c-addr     no return, see TICK
  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 ; ----------------------------------------------------------------------
 101 ; DTCforthMSP430FR5xxx ASSEMBLER : search REG
 102 ; ----------------------------------------------------------------------
 103 ; compute index of "xxxx(REG),"     ; <== PARAM1IDX, sep=','
 104 ; compute index of ",xxxx(REG)"     ; <== PARAM2IDX, sep=' '
 105 CompIdxSrchRn                       ; addr -- Rn|addr
 106             CALL #SearchIndex       ; -- xxxx       aborted if not found
 107             MOV &DP,X
 108             MOV TOS,0(X)            ; -- xxxx       compile ARG xxxx
 109             ADD #2,&DP
 110             MOV #')',TOS            ; -- ")"        prepare separator to search REG of "xxxx(REG)"
 111 ; search REG of "xxxx(REG),"
 112 ; search REG of ",xxxx(REG)"
 113 ; search REG of "@REG,"   sep = ',' ; <== PARAM1AT
 114 SkipRSrchRn ADD #1,&TOIN            ;               skip 'R' in input buffer
 115 ; search REG of "@REG+,"  sep = '+' ; <== PARAM1ATPL
 116 ; search REG of "REG,"    sep = ',' ; <== PARAM1REG
 117 ; search REG of ",REG"    sep = ' ' ; <== PARAM2REG
 118 SearchRn    MOV &TOIN,W             ;3
 119             PUSHM #4,IP             ;               PUSHM IP,S,T,W as IP_RET,OPCODE,OPCODEADR,TOIN
 120             mASM2FORTH              ;               search xx of Rxx
 121             .word WORDD,QNUMBER     ;
 122             .word QFBRAN,REGNOTFOUND; -- xxxx       SR(Z)=1 if Not a Number
 123             mNEXTADR                ; -- Rn         number is found
 124             CMP #16,TOS             ; -- Rn
 125             JNC SrchEnd             ; -- Rn         SR(Z)=0, Rn found,
 126             JC  REGNUM_ERR          ;               abort if Rn out of bounds
 127
 128 REGNOTFOUND mNEXTADR                ; -- addr       SR(Z)=1, (used in case of @REG not found),
 129             MOV @RSP,&TOIN          ; -- addr       restore TOIN, ready for next SearchRn
 130             JMP SrchEnd             ; -- addr       SR(Z)=1 ==> not a register
 131
 132 ; ----------------------------------------------------------------------
 133 ; DTCforthMSP430FR5xxx ASSEMBLER : INTERPRET FIRST OPERAND
 134 ; ----------------------------------------------------------------------
 135 ; PARAM1     separator --           ; parse input buffer until separator and compute first operand of opcode
 136                                     ;               sep is "," for src TYPE II and " " for dst (TYPE II).
 137 PARAM1      JNZ QPARAM1SHARP        ; -- sep        if prefix <> 'R'
 138 ;PARAM1REG
 139             CALL #SearchRn          ;               case of "REG,"
 140             JNZ SWAPREG             ; -- 000R       REG of "REG," found, S=OPCODE=0
 141 ; ----------------------------------;
 142 QPARAM1SHARP CMP.B #'#',W           ; -- sep        W=first char
 143             JNE QPARAM1AMP
 144 ;PARAM1SHARP
 145             CALL #SearchARG         ; -- xxxx       abort if not found
 146             MOV #0300h,S            ;               OPCODE = 0300h : MOV #0,dst is coded MOV R3,dst
 147             CMP #0,TOS              ; -- xxxx       #0 ?
 148             JZ PARAMENDOF
 149             MOV #0310h,S            ;               OPCODE = 0310h : MOV #1,dst is coded MOV 0(R3),dst
 150             CMP #1,TOS              ; -- xxxx       #1 ?
 151             JZ PARAMENDOF
 152             MOV #0320h,S            ;               OPCODE = 0320h : MOV #2,dst is coded MOV @R3,dst
 153             CMP #2,TOS              ; -- xxxx       #2 ?
 154             JZ PARAMENDOF
 155             MOV #0330h,S            ;               OPCODE = 0330h : MOV #-1,dst is coded MOV @R3+,dst
 156             CMP #-1,TOS             ; -- xxxx       #-1 ?
 157             JZ PARAMENDOF
 158             MOV #0220h,S            ;               OPCODE = 0220h : MOV #4,dst is coded MOV @R2,dst
 159             CMP #4,TOS              ; -- xxxx       #4 ?
 160             JZ PARAMENDOF
 161             MOV #0230h,S            ;               OPCODE = 0230h : MOV #8,dst is coded MOV @R2+,dst
 162             CMP #8,TOS              ; -- xxxx       #8 ?
 163             JZ PARAMENDOF
 164             MOV #0030h,S            ; -- xxxx       for all other cases : MOV @PC+,dst
 165 ; endcase of "&xxxx,"               ;               <== PARAM1AMP
 166 ; endcase of ",&xxxx"               ;               <== PARAMXAMP <== PARAM2AMP
 167 StoreArg    MOV &DP,X               ;
 168             ADD #2,&DP              ;               cell allot for arg
 169             MOV TOS,0(X)            ;               compile arg
 170             JMP PARAMENDOF
 171 ; ----------------------------------;
 172 QPARAM1AMP  CMP.B #'&',W            ; -- sep
 173             JNE QPARAM1AT
 174 ; case of "&xxxx,"                  ;               search for "&xxxx,"
 175 PARAM1AMP   MOV #0210h,S            ;               set code type : xxxx(R2) with AS=0b01 ==> x210h
 176 ; case of "&xxxx,"|",&xxxx"         ;               <== PARAM2AMP
 177 PARAMXAMP   CALL #SearchARG         ;
 178             JMP StoreArg            ; --            then ret
 179 ; ----------------------------------;
 180 QPARAM1AT   CMP.B #'@',W            ; -- sep
 181             JNE PARAM1IDX
 182 ; case of "@REG,"|"@REG+,"
 183 PARAM1AT    MOV #0020h,S            ; -- sep        init OPCODE with indirect code type : AS=0b10
 184             CALL #SkipRSrchRn       ;               Z = not found
 185             JNZ SWAPREG             ; -- Rn         REG of "@REG," found
 186 ; case of "@REG+,"                  ; -- addr       search REG of "@REG+"
 187 PARAM1ATPL  MOV #'+',TOS            ; -- sep
 188             CALL #SearchRn          ;
 189             JNZ PARAM1ATPLX         ; -- Rn         REG found
 190 ; ----------------------------------;               REG not found
 191 ; case of "xxxx(REG),"              ; -- sep        OPCODE I
 192 ; case of "xxxx(REG)"               ; -- sep        OPCODE II
 193 PARAM1IDX   CALL #CompIdxSrchRn     ; -- 000R       compile index xxxx and search REG of "(REG)", abort if xxxx not found
 194 ; case of "@REG+,"|"xxxx(REG),"     ;               <== PARAM1ATPL OPCODE I
 195 ; case of "@REG+"|"xxxx(REG)"       ;               <== PARAM1ATPL OPCODE II
 196 PARAM1ATPLX BIS #0010h,S            ;               AS=0b01 for indexing address, AS=0b11 for @REG+
 197             MOV #3FFFh,W            ;2              4000h = first OPCODE type I
 198             CMP S,W                 ;1              with OPCODE II @REG or xxxx(REG) don't skip CR !
 199             ADDC #0,&TOIN           ;1              with OPCODE I, @REG+, or xxxx(REG), skip "," ready for the second operand search
 200 ; endcase of "@REG,"                ; -- 000R       <== PARAM1AT
 201 ; endcase of "REG,"                 ; -- 000R       <== PARAM1REG
 202 SWAPREG     SWPB TOS                ; -- 0R00       swap bytes because it's not a dst REG typeI (not a 2 ops inst.)
 203 ; endcase of ",REG"                 ; -- 0R0D       <== PARAM2REG (dst REG typeI)
 204 ; endcase of ",xxxx(REG)"           ; -- 0R0D       <== PARAM2IDX (dst REG typeI)
 205 OPCODEPLREG ADD TOS,S               ; -- 0R00|0R0D
 206 ; endcase of all                    ;               <== PARAM1SHARP PARAM1AMP PARAM2AMP
 207 PARAMENDOF  MOV @PSP+,TOS           ; --
 208             MOV @IP+,PC             ; --            S=OPCODE,T=OPCODEADR
 209 ; ----------------------------------;
 210
 211 ; ----------------------------------------------------------------------
 212 ; DTCforthMSP430FR5xxx ASSEMBLER : INTERPRET 2th OPERAND
 213 ; ----------------------------------------------------------------------
 214 PARAM2      JNZ     QPARAM2AMP      ; -- sep        if prefix <> 'R'
 215 PARAM2REG   CALL    #SearchRn       ; -- sep        case of ",REG"
 216             JNZ     OPCODEPLREG     ; -- 000D       REG of ",REG" found
 217 ; ----------------------------------;
 218 QPARAM2AMP  CMP.B   #'&',W          ;
 219             JNZ     PARAM2IDX       ;               '&' not found
 220 ; case of ",&xxxx"                  ;
 221 PARAM2AMP   BIS     #0082h,S        ;               change OPCODE : AD=1, dst = R2
 222             JMP     PARAMXAMP       ; -- ' '
 223 ; ----------------------------------;
 224 ; case of ",xxxx(REG)               ; -- sep
 225 PARAM2IDX   BIS     #0080h,S        ;               set AD=1
 226             CALL    #CompIdxSrchRn  ;               compile index xxxx and search REG of ",xxxx(REG)", abort if xxxx not found
 227             JNZ     OPCODEPLREG     ; -- 000D       if REG found
 228             MOV     #NOTFOUND,PC    ;               does ABORT" ?"
 229 ; ----------------------------------;
 230
 231 ; ----------------------------------------------------------------------------------------
 232 ; DTCforthMSP430FR5xxx ASSEMBLER: reset OPCODE in S reg, set OPCODE addr in T reg,
 233 ; move Prefix in W reg, skip prefix in input buffer. Flag SR(Z)=1 if prefix = 'R'.
 234 ; ----------------------------------------------------------------------------------------
 235 InitAndSkipPrfx
 236             MOV #0,S                ;                   reset OPCODE
 237             MOV &DP,T               ;                   HERE --> OPCODEADR
 238             ADD #2,&DP              ;                   cell allot for opcode
 239 ; SkipPrfx                          ; --                skip all occurring char 'BL', plus one prefix
 240 SkipPrfx    MOV #20h,W              ; --                W=BL
 241             MOV &TOIN,X             ; --
 242             ADD &SOURCE_ORG,X       ;
 243 SKIPLOOP    CMP.B @X+,W             ; --                W=BL  does character match?
 244             JZ SKIPLOOP             ; --
 245             MOV.B -1(X),W           ;                   W=prefix
 246             SUB &SOURCE_ORG,X       ; --
 247             MOV X,&TOIN             ; --                >IN points after prefix
 248             CMP.B #'R',W            ;                   preset SR(Z)=1 if prefix = 'R'
 249             MOV @IP+,PC             ; 4
 250
 251 ; ----------------------------------------------------------------------
 252 ; DTCforthMSP430FR5xxx ASSEMBLER: OPCODE TYPE 0 : zero operand      :-)
 253 ; ----------------------------------------------------------------------
 254             asmword "RETI"
 255             mDOCOL
 256             .word   lit,1300h,COMMA,EXIT
 257
 258 ; ----------------------------------------------------------------------
 259 ; DTCforthMSP430FR5xxx ASSEMBLER: OPCODES TYPE I : double operand
 260 ; ----------------------------------------------------------------------
 261 ;               OPCODE(FEDC)
 262 ; OPCODE(code)     = 0bxxxx             opcode
 263 ;                   OPCODE(BA98)
 264 ;                      = 0bxxxx         src_register,
 265 ;                       OPCODE(7)       AD (dst addr type)
 266 ;                          = 0b0        ,register
 267 ;                          = 0b1        ,x(Rn),&adr
 268 ;                        OPCODE(6)      size
 269 ; OPCODE(B)                 = 0b0       word
 270 ;                           = 0b1       byte
 271 ;                         OPCODE(54)    AS (src addr type)
 272 ; OPCODE(AS)                 = 0b00     register,
 273 ;                            = 0b01     x(Rn),&adr,
 274 ;                            = 0b10     @Rn,
 275 ;                            = 0b11     @Rn+,
 276 ;                           OPCODE(3210)
 277 ; OPCODE(dst)                  = 0bxxxx ,dst_register
 278 ; ----------------------------------------------------------------------
 279
 280 ; TYPE1DOES     -- BODYDOES      search and compute PARAM1 & PARAM2 as src and dst operands then compile instruction
 281 TYPE1DOES   .word   lit,','         ; -- sep
 282             .word   InitAndSkipPrfx ;                       init S=0, T=DP, DP=DP+2 then skip prefix, SR(Z)=1 if prefix = 'R'
 283             .word   PARAM1          ; -- BODYDOES           S=OPCODE,T=OPCODEADR
 284             .word   BL,SkipPrfx     ; -- sep                SR(Z)=1 if prefix = 'R'
 285             .word   PARAM2          ; -- BODYDOES           S=OPCODE,T=OPCODEADR
 286             mNEXTADR                ;
 287 MAKEOPCODE  MOV     @RSP+,IP
 288             BIS     @TOS,S          ; -- opcode             generic opcode + customized S
 289             MOV     S,0(T)          ; -- opcode             store complete opcode
 290             JMP     PARAMENDOF      ; --                    then EXIT
 291
 292             asmword "MOV"
 293             CALL rDODOES
 294             .word   TYPE1DOES,4000h
 295             asmword "MOV.B"
 296             CALL rDODOES
 297             .word   TYPE1DOES,4040h
 298             asmword "ADD"
 299             CALL rDODOES
 300             .word   TYPE1DOES,5000h
 301             asmword "ADD.B"
 302             CALL rDODOES
 303             .word   TYPE1DOES,5040h
 304             asmword "ADDC"
 305             CALL rDODOES
 306             .word   TYPE1DOES,6000h
 307             asmword "ADDC.B"
 308             CALL rDODOES
 309             .word   TYPE1DOES,6040h
 310             asmword "SUBC"
 311             CALL rDODOES
 312             .word   TYPE1DOES,7000h
 313             asmword "SUBC.B"
 314             CALL rDODOES
 315             .word   TYPE1DOES,7040h
 316             asmword "SUB"
 317             CALL rDODOES
 318             .word   TYPE1DOES,8000h
 319             asmword "SUB.B"
 320             CALL rDODOES
 321             .word   TYPE1DOES,8040h
 322             asmword "CMP"
 323             CALL rDODOES
 324             .word   TYPE1DOES,9000h
 325             asmword "CMP.B"
 326             CALL rDODOES
 327             .word   TYPE1DOES,9040h
 328             asmword "DADD"
 329             CALL rDODOES
 330             .word   TYPE1DOES,0A000h
 331             asmword "DADD.B"
 332             CALL rDODOES
 333             .word   TYPE1DOES,0A040h
 334             asmword "BIT"
 335             CALL rDODOES
 336             .word   TYPE1DOES,0B000h
 337             asmword "BIT.B"
 338             CALL rDODOES
 339             .word   TYPE1DOES,0B040h
 340             asmword "BIC"
 341             CALL rDODOES
 342             .word   TYPE1DOES,0C000h
 343             asmword "BIC.B"
 344             CALL rDODOES
 345             .word   TYPE1DOES,0C040h
 346             asmword "BIS"
 347             CALL rDODOES
 348             .word   TYPE1DOES,0D000h
 349             asmword "BIS.B"
 350             CALL rDODOES
 351             .word   TYPE1DOES,0D040h
 352             asmword "XOR"
 353             CALL rDODOES
 354             .word   TYPE1DOES,0E000h
 355             asmword "XOR.B"
 356             CALL rDODOES
 357             .word   TYPE1DOES,0E040h
 358             asmword "AND"
 359             CALL rDODOES
 360             .word   TYPE1DOES,0F000h
 361             asmword "AND.B"
 362             CALL rDODOES
 363             .word   TYPE1DOES,0F040h
 364
 365 ; ----------------------------------------------------------------------
 366 ; DTCforthMSP430FR5xxx ASSEMBLER, OPCODES TYPE II : single operand
 367 ; ----------------------------------------------------------------------
 368 ;               OPCODE(FEDCBA987)
 369 ; OPCODE(code)     = 0bxxxxxxxxx
 370 ;                        OPCODE(6)      size
 371 ; OPCODE(B)                 = 0b0       word
 372 ;                           = 0b1       byte
 373 ;                         OPCODE(54)    (dst addr type)
 374 ; OPCODE(AS)                 = 0b00     register
 375 ;                            = 0b01     x(Rn),&adr
 376 ;                            = 0b10     @Rn
 377 ;                            = 0b11     @Rn+
 378 ;                           OPCODE(3210)
 379 ; OPCODE(dst)                  = 0bxxxx dst register
 380 ; ----------------------------------------------------------------------
 381
 382 TYPE2DOES                           ; -- BODYDOES
 383             .word   BL              ; -- BODYDOES ' '
 384             .word   InitAndSkipPrfx ;
 385             .word   PARAM1          ; -- BODYDOES       S=OPCODE,T=OPCODEADR
 386             mNEXTADR                ;
 387             MOV     S,W             ;
 388             AND     #0070h,S        ;                   keep B/W & AS infos in OPCODE
 389             SWPB    W               ;                   (REG org --> REG dst)
 390             AND     #000Fh,W        ;                   keep REG
 391 BIS_ASMTYPE BIS     W,S             ; -- BODYDOES       add it in OPCODE
 392             JMP     MAKEOPCODE      ; -- then end
 393
 394             asmword "RRC"           ; Rotate Right through Carry ( word)
 395             CALL rDODOES
 396             .word   TYPE2DOES,1000h
 397             asmword "RRC.B"         ; Rotate Right through Carry ( byte)
 398             CALL rDODOES
 399             .word   TYPE2DOES,1040h
 400             asmword "SWPB"          ; Swap bytes
 401             CALL rDODOES
 402             .word   TYPE2DOES,1080h
 403             asmword "RRA"
 404             CALL rDODOES
 405             .word   TYPE2DOES,1100h
 406             asmword "RRA.B"
 407             CALL rDODOES
 408             .word   TYPE2DOES,1140h
 409             asmword "SXT"
 410             CALL rDODOES
 411             .word   TYPE2DOES,1180h
 412             asmword "PUSH"
 413             CALL rDODOES
 414             .word   TYPE2DOES,1200h
 415             asmword "PUSH.B"
 416             CALL rDODOES
 417             .word   TYPE2DOES,1240h
 418             asmword "CALL"
 419             CALL rDODOES
 420             .word   TYPE2DOES,1280h
 421
 422 ; ----------------------------------------------------------------------
 423 ; errors output
 424 ; ----------------------------------------------------------------------
 425
 426 MUL_REG_ERR ADD     #1,W            ; <== PUSHM|POPM|RRAM|RRUM|RRCM|RLAM error
 427 BRANCH_ERR  MOV     W,TOS           ; <== ASM_branch error
 428 REGNUM_ERR                          ; <== REG number error
 429             mASM2FORTH              ; -- n      n = value out of bounds
 430             .word   DOT,XSQUOTE
 431             .byte 13,"out of bounds"
 432             .word   QABORT_YES
 433
 434 ; ----------------------------------------------------------------------
 435 ; DTCforthMSP430FR5xxx ASSEMBLER, CONDITIONAL BRANCHS
 436 ; ----------------------------------------------------------------------
 437 ;                       ASSEMBLER       FORTH         OPCODE(FEDC)
 438 ; OPCODE(code) for TYPE JNE,JNZ         0<>, <>     = 0x20xx + (offset AND 3FF) ; branch if Z = 0
 439 ; OPCODE(code) for TYPE JEQ,JZ          0=, =       = 0x24xx + (offset AND 3FF) ; branch if Z = 1
 440 ; OPCODE(code) for TYPE JNC,JLO         U<          = 0x28xx + (offset AND 3FF) ; branch if C = 0
 441 ; OPCODE(code) for TYPE JC,JHS          U>=         = 0x2Cxx + (offset AND 3FF) ; branch if C = 1
 442 ; OPCODE(code) for TYPE JN              0<          = 0x30xx + (offset AND 3FF) ; branch if N = 1
 443 ; OPCODE(code) for TYPE JGE             >=          = 0x34xx + (offset AND 3FF) ; branch if (N xor V) = 0
 444 ; OPCODE(code) for TYPE JL              <           = 0x38xx + (offset AND 3FF) ; branch if (N xor V) = 1
 445 ; OPCODE(code) for TYPE JMP                         = 0x3Cxx + (offset AND 3FF)
 446
 447             asmword "S>="           ; if >= assertion (opposite of jump if < )
 448             CALL rDOCON
 449             .word   3800h
 450
 451             asmword "S<"            ; if < assertion
 452             CALL rDOCON
 453             .word   3400h
 454
 455             asmword "0>="           ; if 0>= assertion  ; use only with IF UNTIL WHILE !
 456             CALL rDOCON
 457             .word   3000h
 458
 459             asmword "0<"            ; jump if 0<        ; use only with ?GOTO !
 460             CALL rDOCON
 461             .word   3000h
 462
 463             asmword "U<"            ; if U< assertion
 464             CALL rDOCON
 465             .word   2C00h
 466
 467             asmword "U>="           ; if U>= assertion
 468             CALL rDOCON
 469             .word   2800h
 470
 471             asmword "0<>"           ; if <>0 assertion
 472             CALL rDOCON
 473             .word   2400h
 474
 475             asmword "0="            ; if =0 assertion
 476             CALL rDOCON
 477             .word   2000h
 478
 479 ;ASM IF      OPCODE -- @OPCODE1
 480             asmword "IF"
 481 ASM_IF      MOV     &DP,W
 482             MOV     TOS,0(W)        ; compile incomplete opcode
 483             ADD     #2,&DP
 484             MOV     W,TOS
 485             MOV     @IP+,PC
 486
 487 ;ASM THEN     @OPCODE --        resolve forward branch
 488             asmword "THEN"
 489 ASM_THEN    MOV     &DP,W           ; -- @OPCODE    W=dst
 490             MOV     TOS,Y           ;               Y=@OPCODE
 491 ASM_THEN1   MOV     @PSP+,TOS       ; --
 492             MOV     Y,X             ;
 493             ADD     #2,X            ; --        Y=@OPCODE   W=dst   X=src+2
 494             SUB     X,W             ; --        Y=@OPCODE   W=dst-src+2=displacement (bytes)
 495             CMP     #1023,W
 496             JC      BRANCH_ERR      ;           (JHS) unsigned branch if displ. > 1022 bytes
 497             RRA     W               ; --        Y=@OPCODE   W=displacement (words)
 498             BIS     W,0(Y)          ; --        [@OPCODE]=OPCODE completed
 499             MOV     @IP+,PC
 500
 501 ; ELSE      @OPCODE1 -- @OPCODE2    branch for IF..ELSE
 502             asmword "ELSE"
 503             MOV     &DP,W           ; --        W=HERE
 504             MOV     #3C00h,0(W)     ;           compile unconditionnal branch
 505             ADD     #2,&DP          ; --        DP+2
 506             SUB     #2,PSP
 507             MOV     W,0(PSP)        ; -- @OPCODE2 @OPCODE1
 508             JMP     ASM_THEN        ; -- @OPCODE2
 509
 510 ; BEGIN     -- BEGINadr             initialize backward branch
 511             asmword "BEGIN"
 512 HERE        SUB #2,PSP
 513             MOV TOS,0(PSP)
 514             MOV &DP,TOS
 515             MOV @IP+,PC
 516
 517 ; UNTIL     @BEGIN OPCODE --   resolve conditional backward branch
 518             asmword "UNTIL"
 519             MOV     @PSP+,W         ;  -- OPCODE                        W=@BEGIN
 520 ASM_UNTIL1  MOV     TOS,Y           ;               Y=OPCODE            W=@BEGIN
 521 ASM_UNTIL2  MOV     @PSP+,TOS       ;  --
 522             MOV     &DP,X           ;  --           Y=OPCODE    X=HERE  W=dst
 523             SUB     #2,W            ;  --           Y=OPCODE    X=HERE  W=dst-2
 524             SUB     X,W             ;  --           Y=OPCODE    X=src   W=src-dst-2=displacement (bytes)
 525             CMP     #-1024,W        ;
 526             JL      BRANCH_ERR      ;               signed branch if displ. < -1024 bytes
 527             RRA     W               ;  --           Y=OPCODE    X=HERE  W=displacement (words)
 528             AND     #3FFh,W         ;  --           Y=OPCODE   X=HERE  W=troncated negative displacement (words)
 529             BIS     W,Y             ;  --           Y=OPCODE (completed)
 530             MOV     Y,0(X)
 531             ADD     #2,&DP
 532             MOV     @IP+,PC
 533
 534 ; AGAIN     @BEGIN --      uncond'l backward branch
 535 ;   unconditional backward branch
 536             asmword "AGAIN"
 537 ASM_AGAIN   MOV TOS,W               ;               W=@BEGIN
 538             MOV #3C00h,Y            ;               Y = asmcode JMP
 539             JMP ASM_UNTIL2          ;
 540
 541 ; WHILE     @BEGIN OPCODE -- @WHILE @BEGIN
 542             asmword "WHILE"
 543             mDOCOL                  ; -- @BEGIN OPCODE
 544             .word   ASM_IF,SWAP,EXIT
 545
 546 ; REPEAT    @WHILE @BEGIN --     resolve WHILE loop
 547             asmword "REPEAT"
 548             mDOCOL                  ; -- @WHILE @BEGIN
 549             .word   ASM_AGAIN,ASM_THEN,EXIT
 550
 551 ; ------------------------------------------------------------------------------------------
 552 ; DTCforthMSP430FR5xxx ASSEMBLER : branch up to 3 backward labels and up to 3 forward labels
 553 ; ------------------------------------------------------------------------------------------
 554 ; used for non canonical branchs, as BASIC language: "goto line x"
 555 ; labels BWx and FWx must be set at the beginning of line (>IN < 8).
 556 ; FWx can resolve only one previous GOTO|?GOTO FWx.
 557 ; BWx can resolve any subsequent GOTO|?GOTO BWx.
 558
 559 BACKWDOES   mNEXTADR
 560             MOV @RSP+,IP            ;
 561             MOV @TOS,TOS
 562             MOV TOS,Y               ; -- BODY       Y = BWx addr
 563             MOV @PSP+,TOS           ; --
 564             MOV @Y,W                ;               W = LABEL
 565             CMP #8,&TOIN            ;               are we colon 8 or more ?
 566             JC ASM_UNTIL1           ;               yes, use this label
 567             MOV &DP,0(Y)            ;               no, set LABEL = DP
 568             MOV @IP+,PC
 569
 570 ; backward label 1
 571             asmword "BW1"
 572             CALL rDODOES            ; CFA
 573             .word BACKWDOES         ; PFA
 574             .word ASMBW1            ; in RAM
 575 ; backward label 2
 576             asmword "BW2"
 577             CALL rDODOES
 578             .word BACKWDOES
 579             .word ASMBW2            ; in RAM
 580 ; backward label 3
 581             asmword "BW3"
 582             CALL rDODOES
 583             .word BACKWDOES
 584             .word ASMBW3            ; in RAM
 585
 586 FORWDOES    mNEXTADR
 587             MOV @RSP+,IP
 588             MOV &DP,W               ;
 589             MOV @TOS,TOS
 590             MOV @TOS,Y              ; -- BODY       Y=@OPCODE of FWx
 591             MOV #0,0(TOS)           ;               V3.9: clear @OPCODE of FWx to avoid jmp resolution without label
 592             CMP #8,&TOIN            ;               are we colon 8 or more ?
 593 FORWUSE     JNC ASM_THEN1           ;               no: resolve FWx with W=DP, Y=@OPCODE
 594 FORWSET     MOV @PSP+,0(W)          ;               yes compile opcode (without displacement)
 595             ADD #2,&DP              ;                   increment DP
 596             MOV W,0(TOS)            ;                   store @OPCODE into BODY of FWx
 597             MOV @PSP+,TOS           ; --
 598             MOV @IP+,PC
 599
 600 ; forward label 1
 601             asmword "FW1"
 602             CALL rDODOES            ; CFA
 603             .word FORWDOES          ; PFA
 604             .word ASMFW1            ; in RAM
 605 ; forward label 2
 606             asmword "FW2"
 607             CALL rDODOES
 608             .word FORWDOES
 609             .word ASMFW3            ; in RAM
 610 ; forward label 3
 611             asmword "FW3"
 612             CALL rDODOES
 613             .word FORWDOES
 614             .word ASMFW3            ; in RAM
 615
 616 ;ASM    GOTO <label>                   --       unconditionnal branch to label
 617             asmword "GOTO"
 618             SUB #2,PSP
 619             MOV TOS,0(PSP)
 620             MOV #3C00h,TOS          ;  -- JMP_OPCODE
 621 GOTONEXT    mDOCOL
 622             .word   TICK            ;  -- OPCODE CFA<label>
 623             .word   EXECUTE,EXIT
 624
 625 ;ASM    <cond> ?GOTO <label>    OPCODE --       conditionnal branch to label
 626             asmword "?GOTO"
 627 INVJMP      CMP #3000h,TOS          ; invert code jump process
 628             JZ GOTONEXT             ; case of JN, do nothing
 629             XOR #0400h,TOS          ; case of: JNZ<-->JZ  JNC<-->JC  JL<-->JGE
 630             BIT #1000h,TOS          ; 3xxxh case ?
 631             JZ  GOTONEXT            ; no
 632             XOR #0800h,TOS          ; complementary action for JL<-->JGE
 633             JMP GOTONEXT
 634
 635 ; --------------------------------------------------------------------------------
 636 ; DTCforthMSP430FR5xxx ASSEMBLER, OPCODES TYPE III : PUSHM|POPM|RLAM|RRAM|RRUM|RRCM
 637 ; --------------------------------------------------------------------------------
 638 ; PUSHM, syntax:    PUSHM #n,REG  with 0 < n < 17
 639 ; POPM syntax:       POPM #n,REG  with 0 < n < 17
 640
 641
 642 ; PUSHM order : PSP,TOS, IP,  S,  T,  W,  X,  Y, rEXIT,rDOVAR,rDOCON, rDODOES, R3, SR,RSP, PC
 643 ; PUSHM order : R15,R14,R13,R12,R11,R10, R9, R8,  R7  ,  R6  ,  R5  ,   R4   , R3, R2, R1, R0
 644
 645 ; example : PUSHM #6,IP pushes IP,S,T,W,X,Y registers to return stack
 646 ;
 647 ; POPM  order :  PC,RSP, SR, R3, rDODOES,rDOCON,rDOVAR,rEXIT,  Y,  X,  W,  T,  S, IP,TOS,PSP
 648 ; POPM  order :  R0, R1, R2, R3,   R4   ,  R5  ,  R6  ,  R7 , R8, R9,R10,R11,R12,R13,R14,R15
 649
 650 ; example : POPM #6,IP   pulls Y,X,W,T,S,IP registers from return stack
 651
 652 ; RxxM syntax: RxxM #n,REG  with 0 < n < 5
 653
 654 TYPE3DOES                           ; -- BODYDOES
 655             .word   LIT,','         ; -- BODYDOES ','
 656             .word   SkipPrfx        ;
 657             .word   WORDD,QNUMBER   ;
 658             .word   QFBRAN,FNOTFOUND;                       see INTERPRET
 659             .word   BL              ; -- BODYDOES n ' '
 660             .word   InitAndSkipPrfx ; -- BODYDOES n ' '
 661             .word   PARAM2          ; -- BODYDOES n         S=OPCODE = 0x000R
 662             mNEXTADR
 663             MOV     TOS,W           ; -- BODYDOES n         W = n
 664             MOV     @PSP+,TOS       ; -- BODYDOES
 665             SUB     #1,W            ;                       W = n floored to 0
 666             JN      MUL_REG_ERR
 667             MOV     @TOS,X          ;                       X=OPCODE
 668             RLAM    #4,X            ;                       OPCODE bit 1000h --> C
 669             JNC     RxxMINSTRU      ;                       if bit 1000h = 0
 670 PxxxINSTRU  MOV     S,Y             ;                       S=REG, Y=REG to test
 671             RLAM    #3,X            ;                       OPCODE bit 0200h --> C
 672             JNC     PUSHMINSTRU     ;                       W=n-1 Y=REG
 673 POPMINSTRU  SUB     W,S             ;                       to make POPM opcode, compute first REG to POP; TI is complicated....
 674 PUSHMINSTRU SUB     W,Y             ;                       Y=REG-(n-1)
 675             CMP     #16,Y
 676             JC      MUL_REG_ERR     ;                       JC=JHS    (U>=)
 677             RLAM    #4,W            ;                       W = n << 4
 678             JMP     BIS_ASMTYPE     ; BODYDOES --
 679 RxxMINSTRU  CMP     #4,W            ;
 680             JC      MUL_REG_ERR     ;                       JC=JHS    (U>=)
 681             SWPB    W               ;                       W = n << 8
 682             RLAM    #2,W            ;                       W = N << 10
 683             JMP     BIS_ASMTYPE     ; BODYDOES --
 684
 685             asmword "RRCM"
 686             CALL rDODOES
 687             .word   TYPE3DOES,0050h
 688             asmword "RRAM"
 689             CALL rDODOES
 690             .word   TYPE3DOES,0150h
 691             asmword "RLAM"
 692             CALL rDODOES
 693             .word   TYPE3DOES,0250h
 694             asmword "RRUM"
 695             CALL rDODOES
 696             .word   TYPE3DOES,0350h
 697             asmword "PUSHM"
 698             CALL rDODOES
 699             .word   TYPE3DOES,1500h
 700             asmword "POPM"
 701             CALL rDODOES
 702             .word   TYPE3DOES,1700h
 703
 704     .IFDEF LARGE_CODE
 705             asmword "RRCM.A"
 706             CALL rDODOES
 707             .word   TYPE3DOES,0040h
 708             asmword "RRAM.A"
 709             CALL rDODOES
 710             .word   TYPE3DOES,0140h
 711             asmword "RLAM.A"
 712             CALL rDODOES
 713             .word   TYPE3DOES,0240h
 714             asmword "RRUM.A"
 715             CALL rDODOES
 716             .word   TYPE3DOES,0340h
 717             asmword "PUSHM.A"
 718             CALL rDODOES
 719             .word   TYPE3DOES,1400h
 720             asmword "POPM.A"
 721             CALL rDODOES
 722             .word   TYPE3DOES,1600h
 723
 724 ; --------------------------------------------------------------------------------
 725 ; DTCforthMSP430FR5xxx ASSEMBLER:  OPCODE TYPE III bis: CALLA (without extended word)
 726 ; --------------------------------------------------------------------------------
 727 ; absolute and immediate instructions must be written as $x.xxxx  (DOUBLE numbers with dot)
 728 ; indexed instructions must be written as $xxxx(REG)
 729 ; --------------------------------------------------------------------------------
 730             asmword "CALLA"
 731             mDOCOL
 732             .word   BL              ; -- sep
 733             .word   InitAndSkipPrfx ; -- sep    SR(Z)=1 if prefix = 'R'
 734             mNEXTADR
 735             MOV @RSP+,IP
 736 CALLA0      MOV #134h,S             ;           134h<<4 = 1340h = opcode for CALLA Rn
 737             JNZ CALLA1              ; -- sep    if prefix <> 'R'
 738 CALLA01     CALL #SearchRn          ; -- Rn
 739 CALLA02     RLAM #4,S               ;           (opcode>>4)<<4 = opcode
 740             BIS TOS,S               ;           update opcode with Rn|$x
 741             MOV S,0(T)              ;           store opcode
 742             MOV @PSP+,TOS           ; --
 743             MOV @IP+,PC             ;
 744 ;-----------------------------------;
 745 CALLA1      ADD #2,S                ; -- sep    136h<<4 = opcode for CALLA @REG
 746             CMP.B #'@',W            ;           Search @REG
 747             JNZ CALLA2              ;
 748 CALLA11     CALL #SkipRSrchRn       ;
 749             JNZ  CALLA02            ;           if REG found, update opcode
 750 ;-----------------------------------;
 751             ADD #1,S                ;           137h<<4 = opcode for CALLA @REG+
 752             MOV #'+',TOS            ; -- sep
 753             JMP CALLA01             ;
 754 ;-----------------------------------;
 755 CALLA2      ADD #2,&DP              ; -- sep    make room for xxxx of #$x.xxxx|&$x.xxxx|$xxxx(REG)
 756             CMP.B #'#',W            ;
 757             JNZ CALLA3
 758             MOV #13Bh,S             ;           13Bh<<4 = opcode for CALLA #$x.xxxx
 759 CALLA21     CALL #SearchARG         ; -- Lo Hi
 760             MOV @PSP+,2(T)          ; -- Hi     store $xxxx of #$x.xxxx|&$x.xxxx
 761             JMP CALLA02             ;           update opcode with $x. and store opcode
 762 ;-----------------------------------;
 763 CALLA3      CMP.B #'&',W            ; -- sep
 764             JNZ CALLA4              ;
 765             ADD #2,S                ;           138h<<4 = opcode for CALLA &$x.xxxx
 766             JMP CALLA21
 767 ;-----------------------------------;
 768 CALLA4      SUB #1,S                ;           135h<<4 = opcode for CALLA $xxxx(REG)
 769 CALLA41     CALL #SearchIndex       ; -- n
 770             MOV TOS,2(T)            ; -- n      store $xxxx of $xxxx(REG)
 771             MOV #')',TOS            ; -- sep
 772             JMP CALLA11             ;           search Rn and update opcode
 773
 774 ; ===============================================================
 775 ; to allow data access beyond $FFFF
 776 ; ===============================================================
 777
 778 ; MOVA #$x.xxxx|&$x.xxxx|$xxxx(Rs)|Rs|@Rs|@Rs+ , &$x.xxxx|$xxxx(Rd)|Rd
 779 ; ADDA (#$x.xxxx|Rs , Rd)
 780 ; CMPA (#$x.xxxx|Rs , Rd)
 781 ; SUBA (#$x.xxxx|Rs , Rd)
 782
 783 ; first argument process ACMS1
 784 ;-----------------------------------;
 785 ACMS1       MOV @PSP+,S             ; -- sep        S=BODYDOES
 786             MOV @S,S                ;               S=opcode
 787 ;-----------------------------------;
 788 ACMS10      JNZ ACMS11              ; -- sep        if prefix <> 'R'
 789 ACMS101     CALL #SearchRn          ; -- Rn
 790 ACMS102     RLAM #4,TOS             ;               8<<src
 791             RLAM #4,TOS             ;
 792 ACMS103     BIS S,TOS               ;               update opcode with src|dst
 793             MOV TOS,0(T)            ;               save opcode
 794             MOV T,TOS               ; -- OPCODE_addr
 795             MOV @IP+,PC             ;
 796 ;-----------------------------------;
 797 ACMS11      CMP.B #'#',W            ; -- sep        X=addr
 798             JNE MOVA12              ;
 799             BIC #40h,S              ;               set #opcode
 800 ACMS111     ADD #2,&DP              ;               make room for low #$xxxx|&$xxxx|$xxxx(REG)
 801             CALL #SearchARG         ; -- Lo Hi
 802             MOV @PSP+,2(T)          ; -- Hi         store $xxxx of #$x.xxxx|&$x.xxxx|$xxxx(REG)
 803             AND #0Fh,TOS            ; -- Hi         sel Hi src
 804             JMP ACMS102             ;
 805 ;-----------------------------------;
 806 MOVA12      CMP.B #'&',W            ; -- sep         case of MOVA &$x.xxxx
 807             JNZ MOVA13              ;
 808             XOR #00E0h,S            ;               set MOVA &$x.xxxx, opcode
 809             JMP ACMS111             ;
 810 ;-----------------------------------;
 811 MOVA13      BIC #00F0h,S            ;               set MOVA @REG, opcode
 812             CMP.B #'@',W            ; -- sep
 813             JNZ MOVA14              ;
 814             CALL #SkipRSrchRn       ; -- Rn
 815             JNZ ACMS102             ;               if @REG found
 816             BIS #0010h,S            ;               set @REG+ opcode
 817             MOV #'+',TOS            ; -- '+'
 818 MOVA131     CALL #SearchRn          ; -- Rn         case of MOVA @REG+,|MOVA $x.xxxx(REG),
 819 MOVA132     ADD #1,&TOIN            ;               skip "," ready for the second operand search
 820             JMP ACMS102             ;
 821 ;-----------------------------------;
 822 MOVA14      BIS #0030h,S            ; -- sep        set xxxx(REG), opcode
 823             ADD #2,&DP              ;               make room for first $xxxx of $xxxx(REG),
 824             CALL #SearchIndex       ; -- n
 825             MOV TOS,2(T)            ; -- n          store $xxxx as 2th word
 826             MOV #')',TOS            ; -- ')'
 827             CALL #SkipRSrchRn       ; -- Rn
 828             JMP MOVA132             ;
 829
 830 ; 2th argument process ACMS2
 831 ;-----------------------------------; -- OPCODE_addr sep
 832 ACMS2       MOV @PSP+,T             ; -- sep        T=OPCODE_addr
 833             MOV @T,S                ;               S=opcode
 834 ;-----------------------------------;
 835 ACMS21      JNZ MOVA22              ; -- sep        if prefix <> 'R'
 836 ACMS211     CALL #SearchRn          ; -- Rn
 837             JMP ACMS103             ;
 838 ;-----------------------------------;
 839 MOVA22      BIC #0F0h,S             ; -- sep
 840             ADD #2,&DP              ;               make room for $xxxx
 841             CMP.B #'&',W            ;
 842             JNZ MOVA23              ;
 843             BIS #060h,S             ;               set ,&$x.xxxx opcode
 844             CALL #SearchARG         ; -- Lo Hi
 845             MOV @PSP+,2(T)          ; -- Hi         store $xxxx as 2th word
 846             JMP ACMS103             ;               update opcode with dst $x and write opcode
 847 ;-----------------------------------;
 848 MOVA23      BIS #070h,S             ;               set ,xxxx(REG) opcode
 849             CALL #SearchIndex       ; -- n
 850             MOV TOS,2(T)            ; -- n          write $xxxx of ,$xxxx(REG) as 2th word
 851             MOV #')',TOS            ; -- ")"        as WORD separator to find REG of "xxxx(REG),"
 852             CALL #SkipRSrchRn       ; -- Rn
 853             JMP ACMS103
 854
 855 ; --------------------------------------------------------------------------------
 856 ; DTCforthMSP430FR5xxx ASSEMBLER, OPCODES IV 2 operands: Adda|Cmpa|Mova|Suba (without extended word)
 857 ; --------------------------------------------------------------------------------
 858 ; absolute and immediate instructions must be written as $x.xxxx  (DOUBLE numbers)
 859 ; indexed instructions must be written as $.xxxx(REG) (DOUBLE numbers)
 860 ; --------------------------------------------------------------------------------
 861 TYPE4DOES   .word   lit,','         ; -- BODYDOES ","        char separator for PARAM1
 862             .word   InitAndSkipPRFX ;                       SR(Z)=1 if prefix = 'R'
 863             .word   ACMS1           ; -- OPCODE_addr
 864             .word   BL,SkipPRFX     ;                       SR(Z)=1 if prefix = 'R'
 865             .word   ACMS2           ; -- OPCODE_addr
 866             .word   DROPEXIT
 867
 868             asmword "MOVA"
 869             CALL rDODOES
 870             .word   TYPE4DOES,00C0h
 871             asmword "CMPA"
 872             CALL rDODOES
 873             .word   TYPE4DOES,00D0h
 874             asmword "ADDA"
 875             CALL rDODOES
 876             .word   TYPE4DOES,00E0h
 877             asmword "SUBA"
 878             CALL rDODOES
 879             .word   TYPE4DOES,00F0h
 880     .ENDIF ; LARGE_CODE