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