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