forthMSP430FR_EXTD_ASM.asm

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