forthMSP430FR_EXTD_ASM.asm

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