forthMSP430FR_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_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 ;;Z SKIP      char -- addr               ; skip all occurring character 'char' in input stream
  47 ;            FORTHWORD "SKIP"            ; used by assembler to parse input stream
  48 SKIP:       MOV     #SOURCE_LEN,Y       ;
  49             MOV     @Y+,X               ; -- char       X=length
  50             MOV     @Y,W                ; -- char       X=length    W=org
  51             ADD     W,X                 ; -- char       X=End       W=org
  52             ADD     &TOIN,W             ; -- char       X=End       W=ptr
  53 SKIPLOOP:   CMP     W,X                 ; -- char       ptr=End ?
  54             JZ      SKIPEND             ; -- char       yes
  55             CMP.B   @W+,TOS             ; -- char       does character match?
  56             JZ      SKIPLOOP            ; -- char       yes
  57 SKIPNEXT:   SUB     #1,W                ; -- char
  58 SKIPEND:    MOV     W,TOS               ; -- addr
  59             SUB     @Y,W                ; -- addr       W=Ptr-Org=Toin
  60             MOV     W,&TOIN             ;
  61             mNEXT
  62
  63 ; ----------------------------------------------------------------------
  64 ; DTCforthMSP430FR5xxx ASSEMBLER : search argument "xxxx", IP is free
  65 ; ----------------------------------------------------------------------
  66
  67 SearchARG                               ; separator -- n|d or abort" not found"
  68 ; ----------------------------------------------------------------------
  69 ; Search ARG of "#xxxx,"                ; <== PARAM10
  70 ; Search ARG of "&xxxx,"                ; <== PARAM111
  71 ; Search ARG of "xxxx(REG),"            ; <== PARAM130
  72 ; Search ARG of ",&xxxx"                ; <== PARAM111 <== PARAM20
  73 ; Search ARG of ",xxxx(REG)"            ; <== PARAM210
  74             PUSHM #2,S                  ;                   PUSHM S,T
  75             ASMtoFORTH                  ; -- separator      search word first
  76             .word   WORDD,FIND          ; -- c-addr
  77             .word   QTBRAN,SearchARGW   ; -- c-addr         if found
  78             .word   QNUMBER             ;
  79             .word   QFBRAN,NotFound     ; -- c-addr         ABORT if not found
  80 FsearchEnd  .word   SearchEnd           ; -- value          goto end if number found
  81 SearchARGW  FORTHtoASM                  ; -- xt             xt = CFA
  82             MOV     @TOS,X
  83 QDOVAR      CMP     #DOVAR,X
  84             JNZ     QDOCON
  85             ADD     #2,TOS              ; remplace CFA by PFA for VARIABLE words
  86             JMP     SearchEnd
  87 QDOCON      CMP     #DOCON,X
  88             JNZ     QDODOES
  89             MOV     2(TOS),TOS          ; remplace CFA by [PFA] for CONSTANT (and CREATEd) words
  90             JMP     SearchEnd
  91 QDODOES     CMP     #DODOES,X
  92             JNZ     SearchEnd
  93             ADD     #4,TOS              ; leave BODY address for DOES words
  94 SearchEnd   POPM    #2,S                ; POPM T,S
  95             RET                         ;
  96
  97 ; ----------------------------------------------------------------------
  98 ; DTCforthMSP430FR5xxx ASSEMBLER : search REG
  99 ; ----------------------------------------------------------------------
 100
 101 ; compute "xxxx(REG),"          ; <== PARAM130
 102 ; compute ",xxxx(REG)"          ; <== PARAM210
 103 ComputeARGParenREG
 104             MOV #'(',TOS        ; -- "("        as WORD separator to find xxxx of "xxxx(REG),"
 105             CALL #SearchARG     ; -- xxxx       aborted if not found
 106             MOV &DDP,X
 107             ADD #2,&DDP
 108             MOV TOS,0(X)        ; -- xxxx       compile xxxx
 109             MOV #')',TOS        ; -- ")"        prepare separator to search REG of "xxxx(REG)"
 110
 111 ; search REG of "xxxx(REG),"    separator = ')'  ;
 112 ; search REG of ",xxxx(REG)"    separator = ')'  ;
 113 ; search REG of "@REG,"         separator = ','  ; <== PARAM120
 114 ; search REG of "@REG+,"        separator = '+'  ; <== PARAM121
 115 ; search REG of "REG,"          separator = ','  ; <== PARAM13
 116 ; search REG of ",REG"          separator = ' '  ; <== PARAM21
 117
 118 SearchREG   PUSHM #2,S          ;               PUSHM S,T
 119             PUSH &TOIN          ; -- separator  save >IN
 120             ADD #1,&TOIN        ;               skip "R"
 121             ASMtoFORTH          ;               search xx of Rxx
 122             .word WORDD,QNUMBER ;
 123             .word QFBRAN,NOTaREG; -- xxxx       if Not a Number
 124             FORTHtoASM          ; -- c-addr     number is found
 125             ADD #2,RSP          ;               remove >IN
 126             CMP #16,TOS         ; -- 000R       register > 15 ?
 127             JHS BOUNDERROR      ;               yes : abort
 128             JLO SearchEnd       ; -- 000R       Z=0 ==> found
 129
 130 NOTaREG     FORTHtoASM          ; -- c-addr     Z=1
 131             MOV @RSP+,&TOIN     ; -- c-addr          restore >IN
 132             JMP SearchEnd       ; -- c_addr     Z=1 ==> not a register
 133
 134
 135 ; ----------------------------------------------------------------------
 136 ; DTCforthMSP430FR5xxx ASSEMBLER : INTERPRET FIRST OPERAND
 137 ; ----------------------------------------------------------------------
 138
 139 ; PARAM1     separator --                   ; parse input buffer until separator and compute first operand of opcode
 140                                             ; sep is comma for src and space for dst .
 141
 142 PARAM1      mDOCOL                          ; -- sep
 143             .word   FBLANK,SKIP             ; -- sep c-addr
 144             FORTHtoASM                      ; -- sep c-addr
 145             MOV     #0,S                    ; -- sep c-addr        reset ASMTYPE
 146             MOV     &DDP,T                  ; -- sep c-addr        HERE --> OPCODEADR (opcode is preset to its address !)
 147             ADD     #2,&DDP                 ; -- sep c-addr        cell allot for opcode
 148             MOV.B   @TOS,W                  ; -- sep c-addr        W=first char of instruction code
 149             MOV     @PSP+,TOS               ; -- sep               W=c-addr
 150             CMP.B   #'#',W                  ; -- sep               W=first char
 151             JNE     PARAM11
 152
 153 ; "#" found : case of "#xxxx,"
 154 PARAM10     ADD     #1,&TOIN                ; -- sep        skip # prefix
 155             CALL    #SearchARG              ; -- xxxx       abort if not found
 156
 157 PARAM100    CMP #0,TOS                      ; -- xxxx       = 0 ?
 158             JNE PARAM101
 159 ; case of "#0,"
 160             MOV #0300h,S                    ; -- 0          example : MOV #0,dst <=> MOV R3,dst
 161             JMP PARAMENDOF
 162
 163 PARAM101    CMP #1,TOS                      ; -- xxxx       = 1 ?
 164             JNE PARAM102
 165 ; case of "#1,"
 166             MOV #0310h,S                    ; -- 1          example : MOV #1,dst <=> MOV 0(R3),dst
 167             JMP PARAMENDOF
 168
 169 PARAM102    CMP #2,TOS                      ; -- xxxx       = 2 ?
 170             JNE PARAM104
 171 ; case of "#2,"
 172             MOV #0320h,S                    ; -- 2          ASMTYPE = 0320h  example : MOV #2, <=> MOV @R3,
 173             JMP PARAMENDOF
 174
 175 PARAM104    CMP #4,TOS                      ; -- xxxx       = 4 ?
 176             JNE PARAM108
 177 ; case of "#4,"
 178             MOV #0220h,S                    ; -- 4          ASMTYPE = 0220h  example : MOV #4, <=> MOV @SR,
 179             JMP PARAMENDOF
 180
 181 PARAM108    CMP #8,TOS                      ; -- xxxx       = 8 ?
 182             JNE PARAM10M1
 183 ; case of "#8,"
 184             MOV #0230h,S                    ; -- 8          ASMTYPE = 0230h  example : MOV #8, <=> MOV @SR+,
 185             JMP PARAMENDOF
 186
 187 PARAM10M1   CMP #-1,TOS                     ; -- xxxx       = -1 ?
 188             JNE PARAM1000
 189 ; case of "#-1,"
 190             MOV #0330h,S                    ; -- -1         ASMTYPE = 0330h  example : XOR #-1 <=> XOR @R3+,
 191             JMP PARAMENDOF
 192
 193 ; case of all others "#xxxx,"               ; -- xxxx
 194 PARAM1000   MOV #0030h,S                    ; -- xxxx       add immediate code type : @PC+,
 195
 196 ; case of "&xxxx,"                          ; <== PARAM110
 197 ; case of ",&xxxx"                          ; <== PARAM20
 198 StoreArg    MOV &DDP,X                      ; -- xxxx
 199             ADD #2,&DDP                     ;               cell allot for arg
 200
 201 StoreTOS                                    ; <== TYPE1DOES
 202    MOV TOS,0(X)                             ;               compile arg
 203 ; endcase of all "&xxxx"                    ;
 204 ; endcase of all "#xxxx"                    ; <== PARAM101,102,104,108,10M1
 205 ; endcase of all "REG"|"@REG"|"@REG+"       ; <== PARAM124
 206 PARAMENDOF  MOV @PSP+,TOS                   ; --
 207             MOV @RSP+,IP
 208             mNEXT                           ; --
 209 ; ------------------------------------------
 210
 211 PARAM11     CMP.B   #'&',W                  ; -- sep
 212             JNE     PARAM12
 213
 214 ; case of "&xxxx,"                          ; -- sep        search for "&xxxx,"
 215 PARAM110    MOV     #0210h,S                ; -- sep        set code type : xxxx(SR) with AS=0b01 ==> x210h (and SR=0 !)
 216
 217 ; case of "&xxxx,"
 218 ; case of ",&xxxx"                          ; <== PARAM20
 219 PARAM111    ADD     #1,&TOIN                ; -- sep        skip "&" prefix
 220             CALL    #SearchARG              ; -- arg        abort if not found
 221             JMP     StoreArg                ; --            then ret
 222 ; ------------------------------------------
 223
 224 PARAM12     CMP.B   #'@',W                  ; -- sep
 225             JNE     PARAM13
 226
 227 ; case of "@REG,"|"@REG+,"
 228 PARAM120    MOV     #0020h,S                ; -- sep        init ASMTYPE with indirect code type : AS=0b10
 229             ADD     #1,&TOIN                ; -- sep        skip "@" prefix
 230             CALL    #SearchREG              ;               Z = not found
 231             JNZ     PARAM123                ; -- value      REG of "@REG," found
 232
 233 ; case of "@REG+,"                          ; -- c-addr     REG of "@REG" not found, search REG of "@REG+"
 234 PARAM121    ADD     #0010h,S                ;               change ASMTYPE from @REG to @REG+ type
 235             MOV     #'+',TOS                ; -- "+"        as WORD separator to find REG of "@REG+,"
 236             CALL    #SearchREG              ; -- value|c-addr   X = flag
 237
 238 ; case of "@REG+,"                          ;
 239 ; case of "xxxx(REG),"                      ; <== PARAM130
 240                                             ;               cases of double separator:   +, and ),
 241 PARAM122    CMP     &SOURCE_LEN,&TOIN       ;               test OPCODE II parameter ending by REG+ or (REG) without comma,
 242             JZ      PARAM123                ;               i.e. >IN = SOURCE_LEN : don't skip char CR !
 243             ADD     #1,&TOIN                ; -- 000R       skip "," ready for the second operand search
 244
 245 ; case of "@REG+,"
 246 ; case of "xxxx(REG),"
 247 ; case of "@REG,"                           ; <== PARAM120
 248 ; case of "REG,"                            ; <== PARAM13
 249 PARAM123    SWPB    TOS                     ; 000R -- 0R00  swap bytes because it's not a dst REG typeI (not a 2 ops inst.)
 250
 251 ; case of "@REG+,"                          ; -- 0R00                   (src REG typeI)
 252 ; case of "xxxx(REG),"                      ; -- 0R00                   (src REG typeI or dst REG typeII)
 253 ; case of "@REG,"                           ; -- 0R00                   (src REG typeI)
 254 ; case of "REG,"                            ; -- 0R00                   (src REG typeI or dst REG typeII)
 255
 256
 257
 258 ; case of ",REG"                            ; -- 000R   <== PARAM21     (dst REG typeI)
 259 ; case of ",xxxx(REG)"                      ; -- 000R   <== PARAM210    (dst REG typeI)
 260 PARAM124    ADD     TOS,S                   ; -- 0R00|000R
 261             JMP     PARAMENDOF
 262 ; ------------------------------------------
 263
 264 ; case of "REG,"|"xxxx(REG),"               ;               first, searg REG of "REG,"
 265 PARAM13     CALL    #SearchREG              ; -- sep        save >IN for second parsing (case of "xxxx(REG),")
 266             JNZ     PARAM123                ; -- 000R       REG of "REG," found, S=ASMTYPE=0
 267
 268 ; case of "xxxx(REG),"                      ; -- c-addr     "REG," not found
 269 PARAM130    ADD     #0010h,S         ;               AS=0b01 for indexing address
 270             CALL    #ComputeARGparenREG     ;               compile xxxx and search REG of "(REG)"
 271             JMP     PARAM122                ;
 272
 273 ; ----------------------------------------------------------------------
 274 ; DTCforthMSP430FR5xxx ASSEMBLER : INTERPRET 2th OPERAND
 275 ; ----------------------------------------------------------------------
 276
 277 ; PARAM2     --                             ; parse input buffer until BL and compute this 2th operand
 278 PARAM2      mDOCOL                          ;
 279             .word   FBLANK,SKIP             ;               skip space(s) between "arg1," and "arg2" if any; use not S,T.
 280             FORTHtoASM                      ; -- c-addr     search for '&' of "&xxxx
 281             CMP.B   #'&',0(TOS)             ;
 282             MOV     #20h,TOS                ; -- " "        as WORD separator to find xxxx of ",&xxxx"
 283             JNE     PARAM21                 ;               '&' not found
 284
 285 ; case of ",&xxxx"                          ;
 286 PARAM20     ADD     #0082h,S                ;               change ASMTYPE : AD=1, dst = R2
 287             JMP     PARAM111                ; -- " "
 288 ; ------------------------------------------
 289
 290 ; case of ",REG"|",xxxx(REG)                ; -- " "        first, search REG of ",REG"
 291 PARAM21     CALL    #SearchREG              ;
 292             JNZ     PARAM124                ; -- 000R       REG of ",REG" found
 293
 294 ; case of ",xxxx(REG)                       ; -- c-addr     REG not found
 295 PARAM210    ADD     #0080h,S                ;               set AD=1
 296             CALL    #ComputeARGparenREG     ;               compile argument xxxx and search REG of "(REG)"
 297             JMP     PARAM124                ; -- 000R       REG of "(REG) found
 298
 299
 300 ; ----------------------------------------------------------------------
 301 ; DTCforthMSP430FR5xxx ASSEMBLER: OPCODES TYPE 0 : zero operand     f:-)
 302 ; ----------------------------------------------------------------------
 303             asmword "RETI"
 304             mDOCOL
 305             .word   lit,1300h,COMMA,EXIT
 306
 307 ; ----------------------------------------------------------------------
 308 ; DTCforthMSP430FR5xxx ASSEMBLER: OPCODES TYPE I : double operand
 309 ; ----------------------------------------------------------------------
 310 ;                                               OPCODE(FEDC)
 311 ; OPCODE(code) for TYPE I                          = 0bxxxx             opcode I
 312 ;                                                   OPCODE(BA98)
 313 ;                                                      = 0bxxxx         src register
 314 ;                                                       OPCODE(7)       AD (dst addr type)
 315 ;                                                          = 0b0        register
 316 ;                                                          = 0b1        x(Rn),&adr
 317 ;                                                        OPCODE(6)      size
 318 ; OPCODE(B)  for TYPE I or TYPE II                          = 0b0       word
 319 ;                                                           = 0b1       byte
 320 ;                                                         OPCODE(54)    AS (src addr type)
 321 ; OPCODE(AS) for TYPE I or OPCODE(AD) for TYPE II            = 0b00     register
 322 ;                                                            = 0b01     x(Rn),&adr
 323 ;                                                            = 0b10     @Rn
 324 ;                                                            = 0b11     @Rn+
 325 ;                                                           OPCODE(3210)
 326 ; OPCODE(dst) for TYPE I or TYPE II                            = 0bxxxx dst register
 327 ; ----------------------------------------------------------------------
 328
 329 ; TYPE1DOES     -- PFADOES      search and compute PARAM1 & PARAM2 as src and dst operands then compile instruction
 330 TYPE1DOES                                   ; -- PFADOES
 331             .word   lit,','                 ; -- PFADOES ","        char separator for PARAM1
 332             .word   PARAM1                  ; -- PFADOES
 333             .word   PARAM2                  ; -- PFADOES            char separator (BL) included in PARAM2
 334             FORTHtoASM                      ; -- PFADOES
 335 MAKEOPCODE  MOV     @TOS,TOS                ; -- opcode             part of instruction
 336             BIS     S,TOS                   ; -- opcode             opcode is complete
 337             MOV     T,X                     ; -- opcode             X= OPCODEADR to compile opcode
 338             JMP     StoreTOS                ;                       then EXIT
 339
 340             asmword "MOV"
 341             mDODOES
 342             .word   TYPE1DOES,4000h
 343
 344             asmword "MOV.B"
 345             mDODOES
 346             .word   TYPE1DOES,4040h
 347
 348             asmword "ADD"
 349             mDODOES
 350             .word   TYPE1DOES,5000h
 351
 352             asmword "ADD.B"
 353             mDODOES
 354             .word   TYPE1DOES,5040h
 355
 356             asmword "ADDC"
 357             mDODOES
 358             .word   TYPE1DOES,6000h
 359
 360             asmword "ADDC.B"
 361             mDODOES
 362             .word   TYPE1DOES,6040h
 363
 364             asmword "SUBC"
 365             mDODOES
 366             .word   TYPE1DOES,7000h
 367
 368             asmword "SUBC.B"
 369             mDODOES
 370             .word   TYPE1DOES,7040h
 371
 372             asmword "SUB"
 373             mDODOES
 374             .word   TYPE1DOES,8000h
 375
 376             asmword "SUB.B"
 377             mDODOES
 378             .word   TYPE1DOES,8040h
 379
 380             asmword "CMP"
 381             mDODOES
 382             .word   TYPE1DOES,9000h
 383
 384             asmword "CMP.B"
 385             mDODOES
 386             .word   TYPE1DOES,9040h
 387
 388             asmword "DADD"
 389             mDODOES
 390             .word   TYPE1DOES,0A000h
 391
 392             asmword "DADD.B"
 393             mDODOES
 394             .word   TYPE1DOES,0A040h
 395
 396             asmword "BIT"
 397             mDODOES
 398             .word   TYPE1DOES,0B000h
 399
 400             asmword "BIT.B"
 401             mDODOES
 402             .word   TYPE1DOES,0B040h
 403
 404             asmword "BIC"
 405             mDODOES
 406             .word   TYPE1DOES,0C000h
 407
 408             asmword "BIC.B"
 409             mDODOES
 410             .word   TYPE1DOES,0C040h
 411
 412             asmword "BIS"
 413             mDODOES
 414             .word   TYPE1DOES,0D000h
 415
 416             asmword "BIS.B"
 417             mDODOES
 418             .word   TYPE1DOES,0D040h
 419
 420             asmword "XOR"
 421             mDODOES
 422             .word   TYPE1DOES,0E000h
 423
 424             asmword "XOR.B"
 425             mDODOES
 426             .word   TYPE1DOES,0E040h
 427
 428             asmword "AND"
 429             mDODOES
 430             .word   TYPE1DOES,0F000h
 431
 432             asmword "AND.B"
 433             mDODOES
 434             .word   TYPE1DOES,0F040h
 435
 436 ; ----------------------------------------------------------------------
 437 ; DTCforthMSP430FR5xxx ASSEMBLER, OPCODES TYPE II : single operand
 438 ; ----------------------------------------------------------------------
 439 ;                                               OPCODE(FEDCBA987)       opcodeII
 440 ; OPCODE(code) for TYPE II                         = 0bxxxxxxxxx
 441 ;                                                        OPCODE(6)      size
 442 ; OPCODE(B)  for TYPE I or TYPE II                          = 0b0       word
 443 ;                                                           = 0b1       byte
 444 ;                                                         OPCODE(54)    (dst addr type)
 445 ; OPCODE(AS) for TYPE I or OPCODE(AD) for TYPE II            = 0b00     register
 446 ;                                                            = 0b01     x(Rn),&adr
 447 ;                                                            = 0b10     @Rn
 448 ;                                                            = 0b11     @Rn+
 449 ;                                                           OPCODE(3210)
 450 ; OPCODE(dst) for TYPE I or TYPE II                            = 0bxxxx dst register
 451 ; ----------------------------------------------------------------------
 452
 453 ; TYPE2DOES     -- PFADOES          search and compute PARAM1 as dst operand then compile instruction
 454 TYPE2DOES                                   ; -- PFADOES
 455             .word   FBLANK                  ;               char separator for PARAM1
 456             .word   PARAM1
 457             FORTHtoASM                      ; -- PFADOES
 458             MOV     S,W                     ;
 459             AND     #0070h,S                ;             keep B/W & AS infos in ASMTYPE
 460             SWPB    W                       ;             (REG org --> REG dst)
 461             AND     #000Fh,W                ;             keep REG
 462 BIS_ASMTYPE BIS     W,S                     ; -- PFADOES  add it in ASMTYPE
 463             JMP     MAKEOPCODE              ; -- then end
 464
 465             asmword "RRC"          ; Rotate Right through Carry ( word)
 466             mDODOES
 467             .word   TYPE2DOES,1000h
 468
 469             asmword "RRC.B"         ; Rotate Right through Carry ( byte)
 470             mDODOES
 471             .word   TYPE2DOES,1040h
 472
 473             asmword "SWPB"          ; Swap bytes
 474             mDODOES
 475             .word   TYPE2DOES,1080h
 476
 477             asmword "RRA"
 478             mDODOES
 479             .word   TYPE2DOES,1100h
 480
 481             asmword "RRA.B"
 482             mDODOES
 483             .word   TYPE2DOES,1140h
 484
 485             asmword "SXT"
 486             mDODOES
 487             .word   TYPE2DOES,1180h
 488
 489             asmword "PUSH"
 490             mDODOES
 491             .word   TYPE2DOES,1200h
 492
 493             asmword "PUSH.B"
 494             mDODOES
 495             .word   TYPE2DOES,1240h
 496
 497             asmword "CALL"
 498             mDODOES
 499             .word   TYPE2DOES,1280h
 500
 501
 502 BOUNDERRWM1 ADD     #1,W                    ; <== RRAM|RRUM|RRCM|RLAM error
 503 BOUNDERRORW MOV     W,TOS                   ; <== PUSHM|POPM|ASM_branch error
 504 BOUNDERROR                                  ; <== REG number error
 505             mDOCOL                          ; -- n      n = value out of bounds
 506             .word   DOT,XSQUOTE
 507             .byte   13,"out of bounds"
 508             .word   QABORTYES
 509
 510 ; --------------------------------------------------------------------------------
 511 ; DTCforthMSP430FR5xxx ASSEMBLER, OPCODES TYPE III : PUSHM|POPM|RLAM|RRAM|RRUM|RRCM
 512 ; --------------------------------------------------------------------------------
 513 ; PUSHM, syntax:    PUSHM #n,REG  with 0 < n < 17
 514 ; POPM syntax:       POPM #n,REG  with 0 < n < 17
 515
 516
 517 ; PUSHM order : PSP,TOS, IP,  S,  T,  W,  X,  Y, rEXIT,rDOVAR,rDOCON, rDODOES, R3, SR,RSP, PC
 518 ; PUSHM order : R15,R14,R13,R12,R11,R10, R9, R8,  R7  ,  R6  ,  R5  ,   R4   , R3, R2, R1, R0
 519
 520 ; example : PUSHM #6,IP pushes IP,S,T,W,X,Y registers to return stack
 521 ;
 522 ; POPM  order :  PC,RSP, SR, R3, rDODOES,rDOCON,rDOVAR,rEXIT,  Y,  X,  W,  T,  S, IP,TOS,PSP
 523 ; POPM  order :  R0, R1, R2, R3,   R4   ,  R5  ,  R6  ,  R7 , R8, R9,R10,R11,R12,R13,R14,R15
 524
 525 ; example : POPM #6,IP   pulls Y,X,W,T,S,IP registers from return stack
 526
 527 ; RxxM syntax: RxxM #n,REG  with 0 < n < 5
 528
 529 ; TYPE3DOES      -- PFADOES        parse input stream to search : "   #N, REG " as operands of RLAM|RRAM|RRUM|RRCM
 530 TYPE3DOES                                   ; -- PFADOES
 531             .word   FBLANK,SKIP             ;                       skip spaces if any
 532             FORTHtoASM                      ; -- PFADOES c-addr
 533             MOV     #0,S                    ;                       init ASMTYPE=0
 534             MOV     &DDP,T                  ;                       init OPCODEADR=DP
 535             ADD     #2,&DDP                 ;                       make room for opcode
 536             ADD     #1,&TOIN                ;                       skip "#"
 537             MOV     #',',TOS                ; -- PFADOES ","
 538             PUSHM   #2,S                    ;               PUSHM S,T
 539             ASMtoFORTH
 540             .word   WORDD,QNUMBER
 541             .word   QFBRAN,NotFound          ;                       ABORT
 542             FORTHtoASM
 543             POPM  #2,S                      ;               POPM T,S
 544             ASMtoFORTH
 545             .word   PARAM2                  ; -- PFADOES 0x000N     S=ASMTYPE = 0x000R
 546             FORTHtoASM
 547             MOV     TOS,W                   ; -- PFADOES n          W = n
 548             MOV     @PSP+,TOS               ; -- PFADOES
 549             SUB     #1,W                    ;                       W = n floored to 0
 550             JN      BOUNDERRWM1
 551             MOV     @TOS,X                  ;                       X=OPCODE
 552             RLAM    #4,X                    ;                       OPCODE bit 1000h --> C
 553             JNC     RxxMINSTRU              ;
 554 PxxxINSTRU  MOV     S,Y                     ;                       S=REG, Y=REG to test
 555             RLAM    #3,X                    ;                       OPCODE bit 0200h --> C
 556             JNC     PUSHMINSTRU             ;                       W=n-1 Y=REG
 557 POPMINSTRU  SUB     W,S                     ;                       to make POPM opcode, compute first REG to POP; TI is complicated....
 558 PUSHMINSTRU SUB     W,Y                     ;                       Y=REG-(n-1)
 559             CMP     #16,Y
 560             JHS     BOUNDERRWM1             ;                       JC=JHS    (U>=)
 561             RLAM    #4,W                    ;                       W = n << 4
 562             JMP     BIS_ASMTYPE             ; PFADOES --
 563 RxxMINSTRU  CMP     #4,W                    ;
 564             JHS     BOUNDERRWM1             ;                       JC=JHS    (U>=)
 565             SWPB    W                       ; -- PFADOES            W = n << 8
 566             RLAM    #2,W                    ;                       W = N << 10
 567             JMP     BIS_ASMTYPE             ; PFADOES --
 568
 569             asmword "RRCM"
 570             mDODOES
 571             .word   TYPE3DOES,0050h
 572
 573             asmword "RRAM"
 574             mDODOES
 575             .word   TYPE3DOES,0150h
 576
 577             asmword "RLAM"
 578             mDODOES
 579             .word   TYPE3DOES,0250h
 580
 581             asmword "RRUM"
 582             mDODOES
 583             .word   TYPE3DOES,0350h
 584
 585             asmword "PUSHM"
 586             mDODOES
 587             .word   TYPE3DOES,1500h
 588
 589             asmword "POPM"
 590             mDODOES
 591             .word   TYPE3DOES,1700h
 592
 593 ; ----------------------------------------------------------------------
 594 ; DTCforthMSP430FR5xxx ASSEMBLER, CONDITIONAL BRANCHS
 595 ; ----------------------------------------------------------------------
 596 ;                       ASSEMBLER       FORTH         OPCODE(FEDC)
 597 ; OPCODE(code) for TYPE JNE,JNZ         0<>, <>     = 0x20xx + (offset AND 3FF) ; branch if Z = 0
 598 ; OPCODE(code) for TYPE JEQ,JZ          0=, =       = 0x24xx + (offset AND 3FF) ; branch if Z = 1
 599 ; OPCODE(code) for TYPE JNC,JLO         U<          = 0x28xx + (offset AND 3FF) ; branch if C = 0
 600 ; OPCODE(code) for TYPE JC,JHS          U>=         = 0x2Cxx + (offset AND 3FF) ; branch if C = 1
 601 ; OPCODE(code) for TYPE JN              0<          = 0x30xx + (offset AND 3FF) ; branch if N = 1
 602 ; OPCODE(code) for TYPE JGE             >=          = 0x34xx + (offset AND 3FF) ; branch if (N xor V) = 0
 603 ; OPCODE(code) for TYPE JL              <           = 0x38xx + (offset AND 3FF) ; branch if (N xor V) = 1
 604 ; OPCODE(code) for TYPE JMP                         = 0x3Cxx + (offset AND 3FF)
 605
 606 CODE_JMP    mDOCON                      ; branch always
 607             .word   3C00h
 608
 609             asmword "S>="               ; if >= assertion (opposite of jump if < )
 610             mDOCON
 611             .word   3800h
 612
 613             asmword "S<"                ; if < assertion
 614             mDOCON
 615             .word   3400h
 616
 617             asmword "0>="               ; if 0>= assertion  ; use only with IF UNTIL WHILE !
 618             mDOCON
 619             .word   3000h
 620
 621             asmword "0<"                ; jump if 0<        ; use only with ?JMP ?GOTO !
 622             mDOCON
 623             .word   3000h
 624
 625             asmword "U<"                ; if U< assertion
 626             mDOCON
 627             .word   2C00h
 628
 629             asmword "U>="               ; if U>= assertion
 630             mDOCON
 631             .word   2800h
 632
 633             asmword "0<>"               ; if <>0 assertion
 634             mDOCON
 635             .word   2400h
 636
 637             asmword "0="                ; if =0 assertion
 638             mDOCON
 639             .word   2000h
 640
 641 ;ASM IF      OPCODE -- @OPCODE1
 642             asmword "IF"
 643 ASM_IF      MOV     &DDP,W
 644             MOV     TOS,0(W)            ; compile incomplete opcode
 645             ADD     #2,&DDP
 646             MOV     W,TOS
 647             mNEXT
 648
 649 ;ASM THEN     @OPCODE --        resolve forward branch
 650             asmword "THEN"
 651 ASM_THEN    MOV     &DDP,W              ; -- @OPCODE   W=dst
 652             MOV     TOS,Y               ;               Y=@OPCODE
 653 ASM_THEN1   MOV     @PSP+,TOS           ; --
 654             MOV     Y,X                 ;
 655             ADD     #2,X                ; --        Y=@OPCODE   W=dst   X=src+2
 656             SUB     X,W                 ; --        Y=@OPCODE   W=dst-src+2=displacement*2 (bytes)
 657             RRA     W                   ; --        Y=@OPCODE   W=displacement (words)
 658             CMP     #512,W
 659             JC      BOUNDERRORW         ; (JHS) unsigned branch if u> 511
 660             BIS     W,0(Y)              ; --       [@OPCODE]=OPCODE completed
 661             mNEXT
 662
 663 ;C ELSE     @OPCODE1 -- @OPCODE2    branch for IF..ELSE
 664             asmword "ELSE"
 665 ASM_ELSE    MOV     &DDP,W              ; --        W=HERE
 666             MOV     #3C00h,0(W)         ;           compile unconditionnal branch
 667             ADD     #2,&DDP             ; --        DP+2
 668             SUB     #2,PSP
 669             MOV     W,0(PSP)            ; -- @OPCODE2 @OPCODE1
 670             JMP     ASM_THEN            ; -- @OPCODE2
 671
 672 ;C BEGIN    -- @BEGIN                   same as FORTH counterpart
 673
 674 ;C UNTIL    @BEGIN OPCODE --   resolve conditional backward branch
 675             asmword "UNTIL"
 676 ASM_UNTIL   MOV     @PSP+,W             ;  -- OPCODE           W=dst
 677 ASM_UNTIL1  MOV     TOS,Y
 678             MOV     @PSP+,TOS           ;  --
 679             MOV     &DDP,X              ;  --       Y=OPCODE   X=HERE  W=dst
 680             SUB     #2,W                ;  --       Y=OPCODE   X=HERE  W=dst-2
 681             SUB     X,W                 ;  --       Y=OPCODE   X=src   W=src-dst-2=displacement (bytes)
 682             RRA     W                   ;  --       Y=OPCODE   X=HERE  W=displacement (words)
 683             CMP     #-512,W
 684             JL      BOUNDERRORW         ; signed branch if < -512
 685             AND     #3FFh,W             ;  --       Y=OPCODE   X=HERE  W=troncated negative displacement (words)
 686             BIS     W,Y                 ;  --       Y=OPCODE (completed)
 687             MOV     Y,0(X)
 688             ADD     #2,&DDP
 689             mNEXT
 690
 691 ;X AGAIN    @BEGIN --      uncond'l backward branch
 692 ;   unconditional backward branch
 693             asmword "AGAIN"
 694 ASM_AGAIN   mDOCOL                      ; -- @BEGIN
 695             .word   CODE_JMP            ; -- @BEGIN opcode
 696             .word   ASM_UNTIL           ; --
 697             .word   EXIT                ; --
 698
 699 ;C WHILE    @BEGIN OPCODE -- @WHILE @BEGIN
 700             asmword "WHILE"
 701 ASM_WHILE   mDOCOL                      ; -- @BEGIN OPCODE
 702             .word   ASM_IF              ; -- @BEGIN @WHILE
 703             .word   SWAP                ; -- @WHILE @BEGIN
 704             .word   EXIT
 705
 706 ;C REPEAT   @WHILE @BEGIN --     resolve WHILE loop
 707             asmword "REPEAT"
 708 ASM_REPEAT  mDOCOL                      ; -- @WHILE @BEGIN
 709             .word   CODE_JMP            ; -- @WHILE @BEGIN opcode
 710             .word   ASM_UNTIL           ; -- @WHILE
 711             .word   ASM_THEN            ; --
 712             .word   EXIT
 713
 714 ; ------------------------------------------------------------------------------------------
 715 ; DTCforthMSP430FR5xxx ASSEMBLER : branch up to 3 backward labels and up to 3 forward labels
 716 ; ------------------------------------------------------------------------------------------
 717 ; used for non canonical branchs, as BASIC language: "goto line x"
 718 ; when a branch to label is resolved, it's ready for new use
 719
 720 BACKWARDDOES        ;
 721     FORTHtoASM
 722     MOV @RSP+,IP
 723     MOV @TOS,TOS
 724     MOV TOS,Y       ; Y = ASMBWx
 725     MOV @PSP+,TOS   ;
 726     MOV @Y,W        ;               W = [ASMBWx]
 727     CMP #0,W        ;               W = 0 ?
 728     MOV #0,0(Y)     ;               clear [ASMBWx] for next use
 729 BACKWUSE            ; -- OPCODE
 730     JNZ ASM_UNTIL1
 731 BACKWSET            ; --
 732     MOV &DDP,0(Y)   ;               [ASMBWx] = DDP
 733     mNEXT
 734
 735 ; backward label 1
 736             asmword "BW1"
 737             mdodoes
 738             .word BACKWARDDOES
 739             .word ASMBW1    ; in RAM
 740
 741 ; backward label 2
 742             asmword "BW2"
 743             mdodoes
 744             .word BACKWARDDOES
 745             .word ASMBW2    ; in RAM
 746
 747 ; backward label 3
 748             asmword "BW3"
 749             mdodoes
 750             .word BACKWARDDOES
 751             .word ASMBW3    ; in RAM
 752
 753 FORWARDDOES
 754     FORTHtoASM
 755     MOV @RSP+,IP
 756     MOV &DDP,W      ;
 757     MOV @TOS,TOS
 758     MOV @TOS,Y      ;               Y=[ASMFWx]
 759     CMP #0,Y        ;               ASMFWx = 0 ? (FWx is free?)
 760     MOV #0,0(TOS)   ;               clear [ASMFWx] for next use
 761 FORWUSE             ; PFA -- @OPCODE
 762     JNZ ASM_THEN1   ;               no
 763 FORWSET             ; OPCODE PFA --
 764     MOV @PSP+,0(W)  ; -- PFA        compile incomplete opcode
 765     ADD #2,&DDP     ;               increment DDP
 766     MOV W,0(TOS)    ;               store @OPCODE into ASMFWx
 767     MOV @PSP+,TOS   ;   --
 768     mNEXT
 769
 770
 771 ; forward label 1
 772             asmword "FW1"
 773             mdodoes
 774             .word FORWARDDOES
 775             .word ASMFW1    ; in RAM
 776
 777 ; forward label 2
 778             asmword "FW2"
 779             mdodoes
 780             .word FORWARDDOES
 781             .word ASMFW2    ; in RAM
 782
 783 ; forward label 3
 784             asmword "FW3"
 785             mdodoes
 786             .word FORWARDDOES
 787             .word ASMFW3    ; in RAM
 788
 789
 790 ; invert FORTH conditionnal branch      FORTH_JMP_OPCODE -- LABEL_JMP_OPCODE
 791 INVJMP      CMP #3000h,TOS
 792             JZ INVJMPEND    ; case of JN, do nothing
 793             XOR #0400h,TOS  ; case of: JNZ<-->JZ  JNC<-->JC  JL<-->JGE
 794             BIT #1000h,TOS  ; 3xxxh case ?
 795             JZ  INVJMPEND   ; no
 796             XOR #0800h,TOS  ; complementary action for JL<-->JGE
 797 INVJMPEND   mNEXT
 798
 799 ;ASM    GOTO <label>                   --       unconditionnal branch to label
 800             asmword "GOTO"
 801             mDOCOL
 802             .word   CODE_JMP,TICK   ;  -- OPCODE CFA<label>
 803             .word   EXECUTE,EXIT
 804
 805 ;ASM    <cond> ?GOTO <label>    OPCODE --       conditionnal branch to label
 806             asmword "?GOTO"
 807             mDOCOL
 808             .word   INVJMP,TICK     ;  -- OPCODE CFA<label>
 809             .word   EXECUTE,EXIT
 810
 811 ; ----------------------------------------------------------------
 812 ; DTCforthMSP430FR5xxx ASSEMBLER : branch to a previous definition
 813 ; ----------------------------------------------------------------
 814
 815 ;ASM    JMP <word>          ;        --       unconditionnal branch to a previous definition
 816             asmword "JMP"
 817 JUMP        mDOCOL
 818             .word   TICK            ; -- @BACKWARD
 819             .word   ASM_AGAIN,EXIT
 820
 821
 822 ;ASM    <cond> ?JMP <word>  ;  OPCODE --       conditionnal branch to a previous definition
 823             asmword "?JMP"
 824             mDOCOL
 825             .word   INVJMP,TICK,SWAP    ;
 826             .word   ASM_UNTIL,EXIT
 827
 828