forthMSP430FR.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 ; compiled with MACROASSEMBLER AS (http://john.ccac.rwth-aachen.de:8000/as/)
  22 ; ----------------------------------------------------------------------
  23     .cpu MSP430X
  24     .include "mspregister.mac" ;
  25 ;    macexp off             ; uncomment to hide macro results
  26
  27 VER .equ "V206"
  28
  29 ;-------------------------------------------------------------------------------
  30 ; Vingt fois sur le métier remettez votre ouvrage,
  31 ; Polissez-le sans cesse, et le repolissez,
  32 ; Ajoutez quelquefois, et souvent effacez.
  33 ;                                                        Boileau, L'Art poétique
  34 ;-------------------------------------------------------------------------------
  35
  36 ;===============================================================================
  37 ;===============================================================================
  38 ; before assembling or programming you must set TARGET in param1 (SHIFT+F8)
  39 ; according to the TARGET "switched" below
  40 ;===============================================================================
  41 ;===============================================================================
  42
  43 ;-------------------------------------------------------------------------------
  44 ; TARGETS kernel    ; sizes are for 8MHz, DTC=2, 3WIRES (XON/XOFF)
  45 ;-------------------------------------------------------------------------------
  46 ;                                                                   ;INFO + MAIN
  47 ;MSP_EXP430FR5739   ; compile for MSP-EXP430FR5739 launchpad        ;  26 + 3976 bytes
  48 MSP_EXP430FR5969   ; compile for MSP-EXP430FR5969 launchpad        ;  26 + 3966 bytes
  49 ;MSP_EXP430FR5994   ;; compile for MSP-EXP430FR5994 launchpad        ;  26 + 3984 bytes
  50 ;MSP_EXP430FR6989   ; compile for MSP-EXP430FR6989 launchpad        ;  26 + 3994 bytes
  51 ;MSP_EXP430FR4133   ; compile for MSP-EXP430FR4133 launchpad        ;  26 + 4028 bytes
  52 ;MSP_EXP430FR2433   ; compile for MSP-EXP430FR2433 launchpad        ;  26 + 3946 bytes
  53 ;CHIPSTICK_FR2433   ; compile for the "CHIPSTICK" of M. Ken BOAK    ;  26 + 3938 bytes
  54 ;MSP_EXP430FR2355   ; compile for MSP-EXP430FR2355 launchpad        ;  26 + 3960 bytes
  55
  56 ; choose DTC (Direct Threaded Code) model, if you don't know, choose 2
  57 DTC .equ 2  ; DTC model 1 : DOCOL = CALL rDOCOL           14 cycles 1 word      shortest DTC model
  58             ; DTC model 2 : DOCOL = PUSH IP, CALL rEXIT   13 cycles 2 words     good compromize for mix FORTH/ASM code
  59             ; DTC model 3 : inlined DOCOL                  9 cycles 4 words     fastest
  60
  61 THREADS     .equ 16 ;  1,  2 ,  4 ,  8 ,  16,  32  search entries in dictionnary.
  62                     ; +0, +28, +40, +56, +90, +154 bytes, usefull to speed compilation;
  63                     ; choose 16
  64
  65 FREQUENCY   .equ 16  ; fully tested at 0.25,0.5,1,2,4,8,16 (and 24 for MSP430FR57xx) MHz
  66
  67 ;-------------------------------------------------------------------------------
  68 ; KERNEL ADD-ON SWITCHES
  69 ;-------------------------------------------------------------------------------
  70 MSP430ASSEMBLER     ;; + 1814 bytes : adds embedded assembler with TI syntax; without, you can do all but all much more slowly...
  71 CONDCOMP            ;; +  324 bytes : adds conditionnal compilation : MARKER [UNDEFINED] [DEFINED] [IF] [ELSE] [THEN] COMPARE
  72 FIXPOINT_INPUT      ;; +   78 bytes : adds the interpretation input for Q15.16 numbers
  73 LOWERCASE           ;; +   46 bytes : enables to write strings in lowercase.
  74 VOCABULARY_SET      ;; +  104 bytes : adds words: VOCABULARY FORTH ASSEMBLER ALSO PREVIOUS ONLY DEFINITIONS (FORTH83)
  75 ;SD_CARD_LOADER      ;; + 1748 bytes : to LOAD source files from SD_card
  76 ;SD_CARD_READ_WRITE  ;; + 1192 bytes : to read, create, write and del files + source files direct copy from PC to SD_Card
  77 NONAME              ; +   64 bytes : adds :NONAME CODENN (CODENoNaMe)
  78 ;BOOTLOADER          ; +   72 bytes : adds to <reset> a bootstrap to SD_CARD\BOOT.4TH.
  79 ;QUIETBOOT           ; +    2 bytes : to perform bootload without displaying.
  80 ;TOTAL               ; +    4 bytes : to save R4 to R7 registers during interrupts.
  81
  82 ;-------------------------------------------------------------------------------
  83 ; OPTIONAL KERNEL ADD-ON SWITCHES (thatcan be downloaded later)                 >------------------+
  84 ; Tip: when added here, ADD-ONs become protected against WIPE and Deep Reset...                    |
  85 ;-------------------------------------------------------------------------------                   v
  86 ;UARTtoI2C           ;                to redirect source file to a I2C TERMINAL FastForth device UART2IIC.f
  87 ;FIXPOINT            ; +  452 bytes : add Q15.16 words HOLDS F+ F- F/ F* F#S F. S>F 2@ 2CONSTANT FIXPOINT.f
  88 UTILITY             ;; +  426/508 bytes : add .S .RS WORDS U.R DUMP ?                            UTILITY.f
  89 ;SD_TOOLS            ;; +  126 bytes for trivial DIR, FAT, CLUSTER and SECTOR view, adds UTILITY  SD_TOOLS.f
  90 ;ANS_CORE_COMPLIANT  ; +  876 bytes : required to pass coretest.4th ; (includes items below)     ANS_COMP.f
  91 ;ARITHMETIC          ; +  358 bytes : add S>D M* SM/REM FM/MOD * /MOD / MOD */MOD /MOD */
  92 ;DOUBLE              ; +  130 bytes : add 2@ 2! 2DUP 2SWAP 2OVER
  93 ;ALIGNMENT           ; +   24 bytes : add ALIGN ALIGNED
  94 ;PORTABILITY         ; +   46 bytes : add CHARS CHAR+ CELLS CELL+
  95
  96
  97 ;-------------------------------------------------------------------------------
  98 ; FAST FORTH TERMINAL configuration
  99 ;-------------------------------------------------------------------------------
 100
 101 TERMINALBAUDRATE    .equ 5000000 ; choose value considering the frequency and the UART2USB bridge, see explanations below.
 102                     .include "TERMINALBAUDRATE.inc"
 103
 104 ;HALFDUPLEX          ; to use FAST FORTH with half duplex terminal
 105
 106 TERMINAL3WIRES      ;;               enable 3 wires (GND,TX,RX) with XON/XOFF software flow control (PL2303TA/HXD, CP2102)
 107 TERMINAL4WIRES      ;; + 18 bytes    enable 4 wires with hardware flow control on RX with RTS (PL2303TA/HXD, FT232RL)
 108 ;                                    this RTS pin may be permanently wired on SBWTCK/TEST pin without disturbing SBW 2 wires programming
 109 ;TERMINAL5WIRES      ; +  6 bytes    enable 5 wires with hardware flow control on RX/TX with RTS/CTS (PL2303TA/HXD, FT232RL)...
 110
 111 ; if you uncomment TERMINAL3WIRES, you have a XON/XOFF terminal (software flow control)
 112 ; if you uncomment TERMINAL5WIRES, you have a RTS/CTS terminal (hardware flow control); mandatory option if you also want to perform binary transfers
 113 ; if you uncomment TERMINAL3WIRES + TERMINAL4WIRES, you have a XON/XOFF + RTS terminal; sufficient option to dowload with hardware control flow
 114 ; if you uncomment TERMINAL3WIRES + TERMINAL5WIRES, you have a XON/XOFF + RTS/CTS terminal
 115
 116
 117 ; --------------------------------------------------------------------------------------------
 118 ; Only two usb2uart bridges correctly handle XON / XOFF: cp2102 and pl2303.
 119 ; --------------------------------------------------------------------------------------------
 120
 121
 122
 123 ; the best and cheapest: UARTtoUSB cable with Prolific PL2303HXD (or PL2303TA)
 124 ; works wel in 3 WIRES (XON/XOF) and 4WIRES (GND,RX,TX,RTS) config
 125 ; --------------------------------------------------------------------------------------------
 126 ;       PL2303TA 4 wires CABLE                         PL2303HXD 6 wires CABLE
 127 ; pads upside: 3V3,txd,rxd,gnd,5V               pads upside: gnd, 3V3,txd,rxd,5V
 128 ;    downside: cts,dcd,dsr,rts,dtr                 downside:     rts,cts
 129 ; --------------------------------------------------------------------------------------------
 130 ; WARNING ! if you use PL2303TA/HXD cable as supply, open box before to weld red wire on 3v3 pad !
 131 ; --------------------------------------------------------------------------------------------
 132 ; 9600,19200,38400,57600    (250kHz)
 133 ; + 115200,134400           (500kHz)
 134 ; + 201600,230400,268800    (1MHz)
 135 ; + 403200,460800,614400    (2MHz)
 136 ; + 806400,921600,1228800   (4MHz)
 137 ; + 2457600                 (8MHz,PL2303TA)
 138 ; + 1843200,2457600         (8MHz,PL2303HXD)
 139 ; + 3MBds                   (16MHz,PL2303TA)
 140 ; + 3MBds,4MBds,5MBds       (16MHz,PL2303HXD)
 141 ; + 6MBds                   (MSP430FR57xx family,24MHz)
 142
 143
 144 ; UARTtoUSB module with Silabs CP2102 (supply current = 20 mA)
 145 ; ---------------------------------------------------------------------------------------------------
 146 ; WARNING ! if you use it as supply, buy a CP2102 module with a VCC switch 5V/3V3 and swith on 3V3 !
 147 ; ---------------------------------------------------------------------------------------------------
 148 ; 9600,19200,38400 (250kHz)
 149 ; + 57600 (500kHz)
 150 ; + 115200,134400,230400 (1MHz)
 151 ; + 460800 (2MHz)
 152 ; + 921600 (4MHz,8MHz,16MHz,24MHz)
 153
 154
 155 ; Launchpad --- UARTtoUSB device
 156 ;        RX <-- TX
 157 ;        TX --> RX
 158 ;       GND <-> GND
 159
 160 ; TERATERM config terminal      : NewLine receive : AUTO,
 161 ;                                 NewLine transmit : CR+LF
 162 ;                                 Size : 128 chars x 49 lines (adjust lines to your display)
 163
 164 ; TERATERM config serial port   : TERMINALBAUDRATE value,
 165 ;                                 8bits, no parity, 1Stopbit,
 166 ;                                 XON/XOFF flow control,
 167 ;                                 delay = 0ms/line, 0ms/char
 168
 169 ; don't forget : save new TERATERM configuration !
 170
 171
 172 ;===============================================================================
 173 ; Hardware control flow configuration: RTS is wired on UART2USB CTS pin
 174 ;===============================================================================
 175
 176 ; Launchpad <-> UARTtoUSB
 177 ;        RX <-- TX
 178 ;        TX --> RX
 179 ;       RTS --> CTS
 180 ;       GND <-> GND
 181
 182 ; notice that the control flow seems not necessary for TX (CTS pin)
 183
 184 ; UARTtoUSB module with PL2303TA/HXD
 185 ; --------------------------------------------------------------------------------------------
 186 ; WARNING ! if you use PL2303HXD cable as supply, open box before to weld red wire on 3v3 pad !
 187 ; --------------------------------------------------------------------------------------------
 188 ; 9600,19200,38400,57600    (250kHz)
 189 ; + 115200,134400           (500kHz)
 190 ; + 201600,230400,268800    (1MHz)
 191 ; + 403200,460800,614400    (2MHz)
 192 ; + 806400,921600,1228800   (4MHz)
 193 ; + 2457600,3000000         (8MHz)
 194 ; + 4000000,5000000         (16MHz)
 195 ; + 6000000                 (24MHz)
 196
 197
 198 ; UARTtoUSB module with FTDI FT232RL (FT230X don't work correctly)
 199 ; ------------------------------------------------------------------------------
 200 ; WARNING ! buy a FT232RL module with a switch 5V/3V3 and select 3V3 !
 201 ; ------------------------------------------------------------------------------
 202 ; 9600,19200,38400,57600,115200 (500kHz)
 203 ; + 230400 (1MHz)
 204 ; + 460800 (2MHz)
 205 ; + 921600 (4,8,16 MHz)
 206
 207 ; TERATERM config terminal      : NewLine receive : AUTO,
 208 ;                                 NewLine transmit : CR+LF
 209 ;                                 Size : 128 chars x 49 lines (adjust lines to your display)
 210
 211 ; TERATERM config serial port   : TERMINALBAUDRATE value,
 212 ;                                 8bits, no parity, 1Stopbit,
 213 ;                                 Hardware flow control,
 214 ;                                 delay = 0ms/line, 0ms/char
 215
 216 ; don't forget : save new TERATERM configuration !
 217
 218 ; ------------------------------------------------------------------------------
 219 ; UARTtoBluetooth 4.2 module (RN4870/RN4871 MIKROE click 2543/2544) at 921600 bds
 220 ; ------------------------------------------------------------------------------
 221 ; UARTtoBluetooth 2.0 module (RN42 sparkfun bluesmirf) at 921600bds
 222 ; ------------------------------------------------------------------------------
 223 ; 9600,19200,38400,57600,115200 (500kHz)
 224 ; + 230400 (1MHz)
 225 ; + 460800 (2MHz)
 226 ; + 921600 (4,8,16 MHz)
 227
 228 ; RN42 config : connect RN41/RN42 module on teraterm, via USBtoUART bridge,
 229 ; -----------   8n1, 115200 bds, no flow control, echo on
 230 ;               $$$         // enter control mode, response: AOK
 231 ;               SU,92       // set 921600 bds, response: AOK
 232 ;               R,1         // reset module to take effect
 233 ;
 234 ;               connect RN42 module on FastForth target
 235 ;               add new bluetooth device on windows, password=1234
 236 ;               open the created output COMx port with TERATERM at 921600bds
 237
 238
 239 ; TERATERM config terminal      : NewLine receive : AUTO,
 240 ;                                 NewLine transmit : CR+LF
 241 ;                                 Size : 128 chars x 49 lines (adjust lines to your display)
 242
 243 ; TERATERM config serial port   : TERMINALBAUDRATE value,
 244 ;                                 8bits, no parity, 1Stopbit,
 245 ;                                 Hardware flow control or software flow control or ...no flow control!
 246 ;                                 delay = 0ms/line, 0ms/char
 247
 248 ; in fact, compared to using a UART USB bridge, only the COMx port is to be updated.
 249 ; don't forget : save new TERATERM configuration !
 250
 251 ; ------------------------------------------------------------------------------
 252
 253     .include "Device.inc" ; to define target config: I/O, memory, SFR, vectors, TERMINAL eUSCI, SD_Card eUSCI, LF_XTAL,
 254
 255     .include "ForthThreads.mac" ; init vocabulary pointers
 256
 257 ;-------------------------------------------------------------------------------
 258 ; DTCforthMSP430FR5xxx RAM memory map:
 259 ;-------------------------------------------------------------------------------
 260
 261 ; name              words   ; comment
 262
 263 ;LSTACK = L0 = LEAVEPTR     ; ----- RAMSTART
 264                             ; |
 265 LSTACK_SIZE .equ    16      ; | grows up
 266                             ; V
 267                             ; ^
 268 PSTACK_SIZE .equ    48      ; | grows down
 269                             ; |
 270 ;PSTACK=S0                  ; ----- RAMSTART + $80
 271                             ; ^
 272 RSTACK_SIZE .equ    48      ; | grows down
 273                             ; |
 274 ;RSTACK=R0                  ; ----- RAMSTART + $E0
 275
 276 ; names             bytes   ; comments
 277
 278 ;PAD                        ; ----- RAMSTART + $E4
 279                             ; |
 280 PAD_LEN     .equ    84      ; | grows up    (ans spec. : PAD >= 84 chars)
 281                             ; v
 282 ;PAD_END                    ; ----- RAMSTART + $138
 283 ;TIB-4                      ;       TIB_I2CADR
 284 ;TIB-2                      ;       TIB_I2CCNT
 285 ;TIB                        ; ----- RAMSTART + $13C
 286                             ; |
 287 TIB_LEN     .equ    84      ; | grows up    (ans spec. : TIB >= 80 chars)
 288                             ; v
 289 ;HOLDS_ORG                  ; ------RAMSTART + $190
 290                             ; ^
 291 HOLD_SIZE   .equ    34      ; | grows down  (ans spec. : HOLD_SIZE >= (2*n) + 2 char, with n = 16 bits/cell
 292                             ; |
 293 ;BASE_HOLD                  ; ----- RAMSTART + $1B2
 294                             ;
 295 ; variables system          ;
 296                             ;
 297                             ; ----- RAMSTART + $1E4
 298                             ;
 299                             ;       24 bytes free
 300                             ;
 301 ; variables system END      ; ----- RAMSTART + $1FC
 302                             ;       SD_BUF_I2CADR
 303                             ;       SD_BUF_I2CCNT
 304 ;SD_BUF                     ; ----- RAMSTART + $200
 305                             ;
 306                             ; 512 bytes buffer
 307                             ;
 308                             ; ----- RAMSTART + $2FF
 309
 310
 311 LSTACK          .equ RAMSTART
 312 LEAVEPTR        .equ LSTACK             ; Leave-stack pointer
 313 PSTACK          .equ LSTACK+(LSTACK_SIZE*2)+(PSTACK_SIZE*2)
 314 RSTACK          .equ PSTACK+(RSTACK_SIZE*2)
 315 PAD_I2CADR      .equ PAD_ORG-4
 316 PAD_I2CCNT      .equ PAD_ORG-2
 317 PAD_ORG         .equ RSTACK+4
 318 TIB_I2CADR      .equ TIB_ORG-4
 319 TIB_I2CCNT      .equ TIB_ORG-2
 320 TIB_ORG         .equ PAD_ORG+PAD_LEN+4
 321 HOLDS_ORG       .equ TIB_ORG+TIB_LEN
 322
 323 BASE_HOLD       .equ HOLDS_ORG+HOLD_SIZE
 324
 325
 326 ; ----------------------------------------------------
 327 ; RAMSTART + $1B2 : RAM VARIABLES
 328 ; ----------------------------------------------------
 329
 330 HP              .equ BASE_HOLD      ; HOLD ptr
 331 CAPS            .equ BASE_HOLD+2
 332 LAST_NFA        .equ BASE_HOLD+4    ; NFA, VOC_PFA, CFA, PSP of last created word
 333 LAST_THREAD     .equ BASE_HOLD+6    ; used by QREVEAL
 334 LAST_CFA        .equ BASE_HOLD+8
 335 LAST_PSP        .equ BASE_HOLD+10
 336 STATE           .equ BASE_HOLD+12   ; Interpreter state
 337 SOURCE          .equ BASE_HOLD+14
 338 SOURCE_LEN      .equ BASE_HOLD+14
 339 SOURCE_ADR      .equ BASE_HOLD+16   ; len, addr of input stream
 340 TOIN            .equ BASE_HOLD+18   ; CurrentInputBuffer pointer
 341 DDP             .equ BASE_HOLD+20   ; dictionnary pointer
 342 LASTVOC         .equ BASE_HOLD+22   ; keep VOC-LINK
 343 CONTEXT         .equ BASE_HOLD+24   ; CONTEXT dictionnary space (8 CELLS)
 344 CURRENT         .equ BASE_HOLD+40   ; CURRENT dictionnary ptr
 345 BASE            .equ BASE_HOLD+42
 346 LINE            .equ BASE_HOLD+44   ; line in interpretation (initialized by NOECHO)
 347 ; --------------------------------------------------------------;
 348 ; RAMSTART + $1E0 : free for user after source file compilation  ;
 349 ; --------------------------------------------------------------;
 350 SAV_CURRENT     .equ BASE_HOLD+46   ; preserve CURRENT during create assembler words
 351 ASMBW1          .equ BASE_HOLD+48
 352 ASMBW2          .equ BASE_HOLD+50
 353 ASMBW3          .equ BASE_HOLD+52
 354 ASMFW1          .equ BASE_HOLD+54
 355 ASMFW2          .equ BASE_HOLD+56
 356 ASMFW3          .equ BASE_HOLD+58
 357 ; ----------------------------------;
 358 ; RAMSTART + $1EE : free for user    ;
 359 ; ----------------------------------;
 360
 361
 362 ; --------------------------------------------------
 363 ; RAMSTART + $1FC : RAM SD_CARD SD_BUF 4 + 512 bytes
 364 ; --------------------------------------------------
 365 SD_BUF_I2CADR   .equ SD_BUF-4
 366 SD_BUF_I2CCNT   .equ SD_BUF-2
 367 SD_BUF          .equ BASE_HOLD+78
 368 SD_BUFEND       .equ SD_BUF + 200h   ; 512bytes
 369
 370
 371 ;-------------------------------------------------------------------------------
 372 ; INFO(DCBA) >= 256 bytes memory map:
 373 ;-------------------------------------------------------------------------------
 374
 375     .org    INFOSTART
 376
 377 ; --------------------------
 378 ; FRAM INFO KERNEL CONSTANTS
 379 ; --------------------------
 380
 381 INI_THREAD      .word THREADS               ; used by ADDON_UTILITY.f
 382 TERMBRW_RST     .word TERMBRW_INI           ; set by TERMINALBAUDRATE.inc
 383 TERMMCTLW_RST   .word TERMMCTLW_INI         ; set by TERMINALBAUDRATE.inc
 384
 385     .IF FREQUENCY = 0.25
 386 FREQ_KHZ        .word 250                   ;
 387     .ELSEIF FREQUENCY = 0.5
 388 FREQ_KHZ        .word 500                   ;
 389     .ELSE
 390 FREQ_KHZ        .word FREQUENCY*1000        ; user use
 391     .ENDIF
 392
 393 SAVE_SYSRSTIV   .word 05                    ; value to identify first start after core recompiling
 394 LPM_MODE        .word CPUOFF+GIE            ; LPM0 is the default mode
 395 ;LPM_MODE        .word CPUOFF+GIE+SCG0       ; LPM1 is the default mode (disable FLL)
 396 INIDP           .word ROMDICT               ; define RST_STATE
 397 INIVOC          .word lastvoclink           ; define RST_STATE
 398
 399                 .word RXON                   ; user use
 400                 .word RXOFF                  ; user use
 401
 402     .IFDEF SD_CARD_LOADER
 403                 .word ReadSectorWX          ; used by ADDON_SD_TOOLS.f
 404         .IFDEF SD_CARD_READ_WRITE
 405                 .word WriteSectorWX         ; used by ADDON_SD_TOOLS.f
 406         .ELSEIF
 407                 .word 0
 408         .ENDIF ; SD_CARD_READ_WRITE
 409     .ELSEIF
 410                 .word 0,0
 411     .ENDIF ; SD_CARD_LOADER
 412 GPFLAGS         .word 0
 413
 414 INFO_BASE_END
 415
 416 ; ------------------------------
 417 ; VARIABLES that could be in RAM
 418 ; ------------------------------
 419
 420     .IFDEF RAM_1K       ; if RAM = 1K (FR57xx) the variables below are in INFO space (FRAM)
 421     .org INFO_BASE_END
 422     .ELSE               ; if RAM >= 2k the variables below are in RAM
 423     .org SD_BUFEND
 424                 .word 0 ; guard
 425     .ENDIF
 426
 427     .IFDEF SD_CARD_LOADER
 428
 429 SD_ORG_DATA
 430
 431 ; ---------------------------------------
 432 ; FAT FileSystemInfos
 433 ; ---------------------------------------
 434 FATtype         .equ SD_ORG_DATA+0
 435 BS_FirstSectorL .equ SD_ORG_DATA+2  ; init by SD_Init, used by RW_Sector_CMD
 436 BS_FirstSectorH .equ SD_ORG_DATA+4  ; init by SD_Init, used by RW_Sector_CMD
 437 OrgFAT1         .equ SD_ORG_DATA+6  ; init by SD_Init,
 438 FATSize         .equ SD_ORG_DATA+8  ; init by SD_Init,
 439 OrgFAT2         .equ SD_ORG_DATA+10 ; init by SD_Init,
 440 OrgRootDIR      .equ SD_ORG_DATA+12 ; init by SD_Init, (FAT16 specific)
 441 OrgClusters     .equ SD_ORG_DATA+14 ; init by SD_Init, Sector of Cluster 0
 442 SecPerClus      .equ SD_ORG_DATA+16 ; init by SD_Init, byte size
 443
 444 SD_LOW_LEVEL    .equ SD_ORG_DATA+18
 445 ; ---------------------------------------
 446 ; SD command
 447 ; ---------------------------------------
 448 SD_CMD_FRM      .equ SD_LOW_LEVEL   ; SD_CMDx inverted frame ${CRC7,ll,LL,hh,HH,CMD}
 449 SectorL         .equ SD_LOW_LEVEL+6
 450 SectorH         .equ SD_LOW_LEVEL+8
 451
 452 ; ---------------------------------------
 453 ; SD_BUF management
 454 ; ---------------------------------------
 455 BufferPtr       .equ SD_LOW_LEVEL+10
 456 BufferLen       .equ SD_LOW_LEVEL+12
 457
 458 SD_FAT_LEVEL    .equ SD_LOW_LEVEL+14
 459 ; ---------------------------------------
 460 ; FAT entry
 461 ; ---------------------------------------
 462 ClusterL        .equ SD_FAT_LEVEL     ;
 463 ClusterH        .equ SD_FAT_LEVEL+2   ;
 464 NewClusterL     .equ SD_FAT_LEVEL+4   ;
 465 NewClusterH     .equ SD_FAT_LEVEL+6   ;
 466 CurFATsector    .equ SD_FAT_LEVEL+8   ; current FATSector of last free cluster
 467
 468 ; ---------------------------------------
 469 ; DIR entry
 470 ; ---------------------------------------
 471 DIRClusterL     .equ SD_FAT_LEVEL+10    ; contains the Cluster of current directory ; = 1 as FAT16 root directory
 472 DIRClusterH     .equ SD_FAT_LEVEL+12    ; contains the Cluster of current directory ; = 1 as FAT16 root directory
 473 EntryOfst       .equ SD_FAT_LEVEL+14
 474
 475 ; ---------------------------------------
 476 ; Handle Pointer
 477 ; ---------------------------------------
 478 CurrentHdl      .equ SD_FAT_LEVEL+16    ; contains the address of the last opened file structure, or 0
 479
 480 ; ---------------------------------------
 481 ; Load file operation
 482 ; ---------------------------------------
 483
 484 pathname        .equ SD_FAT_LEVEL+18    ; start address
 485 EndOfPath       .equ SD_FAT_LEVEL+20    ; end address
 486
 487 ; ---------------------------------------
 488
 489 FirstHandle     .equ SD_FAT_LEVEL+30
 490
 491 ; ---------------------------------------
 492 ; Handle structure
 493 ; ---------------------------------------
 494 ; three handle tokens :
 495 ; HDLB_Token= 0 : free handle
 496 ;           = 1 : file to read
 497 ;           = 2 : file updated (write)
 498 ;           =-1 : LOAD"ed file (source file)
 499
 500 ; offset values
 501 HDLW_PrevHDL    .equ 0  ; previous handle
 502 HDLB_Token      .equ 2  ; token
 503 HDLB_ClustOfst  .equ 3  ; Current sector offset in current cluster (Byte)
 504 HDLL_DIRsect    .equ 4  ; Dir SectorL
 505 HDLH_DIRsect    .equ 6  ; Dir SectorH
 506 HDLW_DIRofst    .equ 8  ; SD_BUF offset of Dir entry
 507 HDLL_FirstClus  .equ 10 ; File First ClusterLo (identify the file)
 508 HDLH_FirstClus  .equ 12 ; File First ClusterHi (identify the file)
 509 HDLL_CurClust   .equ 14 ; Current ClusterLo
 510 HDLH_CurClust   .equ 16 ; Current ClusterHi
 511 HDLL_CurSize    .equ 18 ; written size / not yet read size (Long)
 512 HDLH_CurSize    .equ 20 ; written size / not yet read size (Long)
 513 HDLW_BUFofst    .equ 22 ; SD_BUF offset ; used by LOAD"
 514
 515
 516     .IFDEF RAM_1K ; RAM_Size = 1k: due to the lack of RAM, PAD is SDIB
 517
 518 HandleMax       .equ 5 ; and not 8 to respect INFO size (FRAM)
 519 HandleLenght    .equ 24
 520 HandleEnd       .equ FirstHandle+handleMax*HandleLenght
 521
 522 LOADPTR         .equ HandleEnd
 523 LOAD_STACK      .equ HandleEnd+2
 524 LOADSTACK_SIZE  .equ HandleMax+1    ; make room for 3 words * handles
 525 LoadStackEnd    .equ LOAD_STACK+LOADSTACK_SIZE*6
 526
 527 SDIB_I2CADR     .equ PAD_ORG-4
 528 SDIB_I2CCNT     .equ PAD_ORG-2
 529 SDIB_ORG        .equ PAD_ORG
 530
 531 SD_END_DATA     .equ LoadStackEnd
 532 SD_LEN_DATA     .equ SD_END_DATA-SD_ORG_DATA
 533
 534     .ELSEIF     ; RAM_Size > 1k all is in RAM
 535
 536 HandleMax       .equ 8
 537 HandleLenght    .equ 24
 538 HandleEnd       .equ FirstHandle+handleMax*HandleLenght
 539
 540 LOADPTR         .equ HandleEnd
 541 LOAD_STACK      .equ HandleEnd+2
 542 LOADSTACK_SIZE  .equ HandleMax+1    ; make room for 3 words * handles
 543 LoadStackEnd    .equ LOAD_STACK+LOADSTACK_SIZE*6 ; 3 words by handle
 544
 545 SDIB_I2CADR     .equ SDIB_ORG-4
 546 SDIB_I2CCNT     .equ SDIB_ORG-2
 547 SDIB_ORG        .equ LoadStackEnd+4
 548 SDIB_LEN        .equ 84             ; = TIB_LEN = PAD_LEN
 549
 550 SD_END_DATA     .equ SDIB_ORG+SDIB_LEN
 551
 552     .ENDIF ; RAM_Size
 553
 554
 555     .ENDIF ; SD_CARD_LOADER
 556
 557
 558 ;-------------------------------------------------------------------------------
 559 ; DTCforthMSP430FR5xxx program (FRAM) memory
 560 ;-------------------------------------------------------------------------------
 561
 562     .org    PROGRAMSTART
 563
 564 ;-------------------------------------------------------------------------------
 565 ; DEFINING EXECUTIVE WORDS - DTC model
 566 ;-------------------------------------------------------------------------------
 567
 568 ;-------------------------------------------------------------------------------
 569 ; very nice FAST FORTH added feature:
 570 ;-------------------------------------------------------------------------------
 571 ; as IP is always computed from the PC value, we can place low level to high level
 572 ; switches "COLON" or "LO2HI" anywhere in a word, i.e. not only at its beginning
 573 ; as ITC competitors.
 574 ;-------------------------------------------------------------------------------
 575
 576 RSP         .reg    R1      ; RSP = Return Stack Pointer (return stack)
 577
 578 ; DOxxx registers           ; must be saved before use and restored after use
 579 rDODOES     .reg    r4
 580 rDOCON      .reg    r5
 581 rDOVAR      .reg    r6
 582 rDOCOL      .reg    R7      ; COLD defines xdocol as R7 content
 583
 584 L           .reg    R7
 585 M           .reg    r6      ; ex. PUSHM L,N
 586 N           .reg    r5
 587 P           .reg    r4
 588
 589 ; Scratch registers
 590 Y           .reg    R8
 591 X           .reg    R9
 592 W           .reg    R10
 593 T           .reg    R11
 594 S           .reg    R12
 595
 596 ; Forth virtual machine
 597 IP          .reg    R13      ; interpretative pointer
 598 TOS         .reg    R14      ; first PSP cell
 599 PSP         .reg    R15      ; PSP = Parameters Stack Pointer (stack data)
 600
 601 mNEXT       .MACRO          ; return for low level words (written in assembler)
 602             MOV @IP+,PC     ; 4 fetch code address into PC, IP=PFA
 603             .ENDM           ; 4 cycles,1word = ITC -2cycles -1 word
 604
 605 NEXT        .equ    4D30h   ; 4 MOV @IP+,PC
 606
 607 FORTHtoASM  .MACRO          ; compiled by HI2LO
 608             .word   $+2     ; 0 cycle
 609             .ENDM           ; 0 cycle, 1 word
 610
 611
 612
 613     .SWITCH DTC
 614 ;-------------------------------------------------------------------------------
 615     .CASE 1 ; DOCOL = CALL rDOCOL
 616 ;-------------------------------------------------------------------------------
 617
 618
 619 xdocol      MOV @RSP+,W     ; 2
 620             PUSH IP         ; 3     save old IP on return stack
 621             MOV W,IP        ; 1     set new IP to PFA
 622             MOV @IP+,PC     ; 4     = NEXT
 623                             ; 10 cycles
 624
 625 ASMtoFORTH  .MACRO          ; compiled by LO2HI
 626             CALL #EXIT      ; 2 words, 10 cycles
 627             .ENDM           ;
 628
 629 mDOCOL      .MACRO          ; compiled by : and by colon
 630             CALL rDOCOL     ; 1 word, 14 cycles (CALL included) = ITC+4
 631             .ENDM           ;
 632
 633 DOCOL1      .equ    1287h   ; 4 CALL R7
 634
 635 ;-------------------------------------------------------------------------------
 636     .CASE 2 ; DOCOL = PUSH IP + CALL rEXIT
 637 ;-------------------------------------------------------------------------------
 638
 639 rEXIT       .reg    R7      ; COLD defines EXIT as R7 content
 640
 641 ASMtoFORTH  .MACRO          ; compiled by LO2HI
 642             CALL rEXIT      ; 1 word, 10 cycles
 643             .ENDM           ;
 644
 645 mDOCOL      .MACRO          ; compiled by : and by COLON
 646             PUSH IP         ; 3
 647             CALL rEXIT      ; 10
 648             .ENDM           ; 2 words, 13 cycles = ITC+3
 649
 650 DOCOL1      .equ    120Dh   ; 3 PUSH IP
 651 DOCOL2      .equ    1287h   ; 4 CALL rEXIT
 652
 653 ;-------------------------------------------------------------------------------
 654     .CASE 3 ; inlined DOCOL
 655 ;-------------------------------------------------------------------------------
 656
 657 R           .reg    R7      ; Scratch register
 658
 659 ASMtoFORTH  .MACRO          ; compiled by LO2HI
 660             MOV PC,IP       ; 1
 661             ADD #4,IP       ; 1
 662             MOV @IP+,PC     ; 4 NEXT
 663             .ENDM           ; 6 cycles, 3 words
 664
 665 mDOCOL      .MACRO          ; compiled by : and by COLON
 666             PUSH IP         ; 3
 667             MOV PC,IP       ; 1
 668             ADD #4,IP       ; 1
 669             MOV @IP+,PC     ; 4 NEXT
 670             .ENDM           ; 4 words, 9 cycles (ITC-1)
 671
 672 DOCOL1      .equ    120Dh   ; 3 PUSH IP
 673 DOCOL2      .equ    400Dh   ; 1 MOV PC,IP
 674 DOCOL3      .equ    522Dh   ; 1 ADD #4,IP
 675
 676     .ENDCASE ; DTC
 677
 678 ;-------------------------------------------------------------------------------
 679 ; mDOVAR leave on parameter stack the PFA of a VARIABLE definition
 680 ;-------------------------------------------------------------------------------
 681
 682 mDOVAR      .MACRO          ; compiled by VARIABLE
 683             CALL rDOVAR     ; 1 word, 14 cycles (ITC+4)
 684             .ENDM           ;
 685
 686 DOVAR       .equ    1286h   ; CALL rDOVAR ; [rDOVAR] is defined as RFROM by COLD
 687
 688
 689 ;-------------------------------------------------------------------------------
 690 ; mDOCON  leave on parameter stack the [PFA] of a CONSTANT definition
 691 ;-------------------------------------------------------------------------------
 692
 693 mDOCON      .MACRO          ; compiled by CONSTANT
 694             CALL rDOCON     ; 1 word, 16 cycles (ITC+4)
 695             .ENDM           ;
 696
 697 DOCON       .equ    1285h   ; 4 CALL rDOCON ; [rDOCON] is defined as xdocon by COLD
 698
 699 xdocon  ;   -- constant     ; 4 for CALL rDOCON
 700             SUB #2,PSP      ; 1
 701             MOV TOS,0(PSP)  ; 3 save TOS on parameters stack
 702             MOV @RSP+,TOS   ; 2 TOS = CFA address of master word CONSTANT
 703             MOV @TOS,TOS    ; 2 TOS = CONSTANT value
 704             MOV @IP+,PC     ; 4 execute next word
 705                             ; 16 = ITC (+4)
 706
 707 ;-------------------------------------------------------------------------------
 708 ; mDODOES  leave on parameter stack the PFA of a CREATE definition and execute Master word
 709 ;-------------------------------------------------------------------------------
 710
 711 mDODOES     .MACRO          ; compiled  by DOES>
 712             CALL rDODOES    ;    CALL xdodoes
 713             .ENDM           ; 1 word, 19 cycles (ITC-2)
 714
 715 DODOES      .equ    1284h   ; 4 CALL rDODOES ; [rDODOES] is defind as xdodoes by COLD
 716
 717 xdodoes   ; -- a-addr       ; 4 for CALL rDODOES
 718             SUB #2,PSP      ; 1
 719             MOV TOS,0(PSP)  ; 3 save TOS on parameters stack
 720             MOV @RSP+,TOS   ; 2 TOS = CFA address of master word, i.e. address of its first cell after DOES>
 721             PUSH IP         ; 3 save IP on return stack
 722             MOV @TOS+,IP    ; 2 IP = CFA of Master word, TOS = BODY address of created word
 723             MOV @IP+,PC     ; 4 Execute Master word
 724
 725 ;-------------------------------------------------------------------------------
 726 ; INTERPRETER LOGIC
 727 ;-------------------------------------------------------------------------------
 728
 729 ;https://forth-standard.org/standard/core/EXIT
 730 ;C EXIT     --      exit a colon definition; CALL #EXIT performs ASMtoFORTH (10 cycles)
 731 ;                                            JMP #EXIT performs EXIT
 732             FORTHWORD "EXIT"
 733 EXIT        MOV @RSP+,IP        ; 2 pop previous IP (or next PC) from return stack
 734             MOV @IP+,PC         ; 4 = NEXT
 735                                 ; 6 = ITC - 2
 736
 737 ;Z lit      -- x    fetch inline literal to stack
 738 ; This is the execution part of LITERAL.
 739             FORTHWORD "LIT"
 740 lit         SUB #2,PSP          ; 2  push old TOS..
 741             MOV TOS,0(PSP)      ; 3  ..onto stack
 742             MOV @IP+,TOS        ; 2  fetch new TOS value
 743             MOV @IP+,PC         ; 4  NEXT
 744                                 ; 11 = ITC - 2
 745
 746 ;-------------------------------------------------------------------------------
 747 ; STACK OPERATIONS
 748 ;-------------------------------------------------------------------------------
 749
 750 ;https://forth-standard.org/standard/core/DUP
 751 ;C DUP      x -- x x      duplicate top of stack
 752             FORTHWORD "DUP"
 753 DUP         SUB #2,PSP          ; 2  push old TOS..
 754             MOV TOS,0(PSP)      ; 3  ..onto stack
 755             mNEXT               ; 4
 756
 757 ;https://forth-standard.org/standard/core/qDUP
 758 ;C ?DUP     x -- 0 | x x    DUP if nonzero
 759             FORTHWORD "?DUP"
 760 QDUP        CMP #0,TOS          ; 2  test for TOS nonzero
 761             JNZ DUP             ; 2
 762             mNEXT               ; 4
 763
 764 ;https://forth-standard.org/standard/core/DROP
 765 ;C DROP     x --          drop top of stack
 766             FORTHWORD "DROP"
 767 DROP        MOV @PSP+,TOS       ; 2
 768             mNEXT               ; 4
 769
 770 ;https://forth-standard.org/standard/core/NIP
 771 ;C NIP      x1 x2 -- x2         Drop the first item below the top of stack
 772             FORTHWORD "NIP"
 773 NIP         ADD #2,PSP          ; 1
 774             mNEXT               ; 4
 775
 776 ;https://forth-standard.org/standard/core/SWAP
 777 ;C SWAP     x1 x2 -- x2 x1    swap top two items
 778             FORTHWORD "SWAP"
 779 SWAP        MOV @PSP,W          ; 2
 780             MOV TOS,0(PSP)      ; 3
 781             MOV W,TOS           ; 1
 782             mNEXT               ; 4
 783
 784 ;https://forth-standard.org/standard/core/OVER
 785 ;C OVER    x1 x2 -- x1 x2 x1
 786             FORTHWORD "OVER"
 787 OVER        MOV TOS,-2(PSP)     ; 3 -- x1 (x2) x2
 788             MOV @PSP,TOS        ; 2 -- x1 (x2) x1
 789             SUB #2,PSP          ; 2 -- x1 x2 x1
 790             mNEXT               ; 4
 791
 792 ;https://forth-standard.org/standard/core/ROT
 793 ;C ROT    x1 x2 x3 -- x2 x3 x1
 794             FORTHWORD "ROT"
 795 ROT         MOV @PSP,W          ; 2 fetch x2
 796             MOV TOS,0(PSP)      ; 3 store x3
 797             MOV 2(PSP),TOS      ; 3 fetch x1
 798             MOV W,2(PSP)        ; 3 store x2
 799             mNEXT               ; 4
 800
 801 ;https://forth-standard.org/standard/core/toR
 802 ;C >R    x --   R: -- x   push to return stack
 803             FORTHWORD ">R"
 804 TOR         PUSH TOS
 805             MOV @PSP+,TOS
 806             mNEXT
 807
 808 ;https://forth-standard.org/standard/core/Rfrom
 809 ;C R>    -- x    R: x --   pop from return stack ; CALL #RFROM performs DOVAR
 810             FORTHWORD "R>"
 811 RFROM       SUB #2,PSP          ; 1
 812             MOV TOS,0(PSP)      ; 3
 813             MOV @RSP+,TOS       ; 2
 814             mNEXT               ; 4
 815
 816 ;https://forth-standard.org/standard/core/RFetch
 817 ;C R@    -- x     R: x -- x   fetch from rtn stk
 818             FORTHWORD "R@"
 819 RFETCH      SUB #2,PSP
 820             MOV TOS,0(PSP)
 821             MOV @RSP,TOS
 822             mNEXT
 823
 824 ;https://forth-standard.org/standard/core/DEPTH
 825 ;C DEPTH    -- +n        number of items on stack, must leave 0 if stack empty
 826             FORTHWORD "DEPTH"
 827 DEPTH       MOV TOS,-2(PSP)
 828             MOV #PSTACK,TOS
 829             SUB PSP,TOS       ; PSP-S0--> TOS
 830             SUB #2,PSP        ; post decrement stack...
 831             RRA TOS           ; TOS/2   --> TOS
 832             mNEXT
 833
 834 ;-------------------------------------------------------------------------------
 835 ; MEMORY OPERATIONS
 836 ;-------------------------------------------------------------------------------
 837
 838 ;https://forth-standard.org/standard/core/Fetch
 839 ;C @       a-addr -- x   fetch cell from memory
 840             FORTHWORD "@"
 841 FETCH       MOV @TOS,TOS
 842             mNEXT
 843
 844 ;https://forth-standard.org/standard/core/Store
 845 ;C !        x a-addr --   store cell in memory
 846             FORTHWORD "!"
 847 STORE       MOV @PSP+,0(TOS)    ;4
 848             MOV @PSP+,TOS       ;2
 849             mNEXT               ;4
 850
 851 ;https://forth-standard.org/standard/core/CFetch
 852 ;C C@     c-addr -- char   fetch char from memory
 853             FORTHWORD "C@"
 854 CFETCH      MOV.B @TOS,TOS      ;2
 855             mNEXT               ;4
 856
 857 ;https://forth-standard.org/standard/core/CStore
 858 ;C C!      char c-addr --    store char in memory
 859             FORTHWORD "C!"
 860 CSTORE      MOV.B @PSP+,0(TOS)  ;4
 861             ADD #1,PSP          ;1
 862             MOV @PSP+,TOS       ;2
 863             mNEXT
 864
 865 ;-------------------------------------------------------------------------------
 866 ; ARITHMETIC OPERATIONS
 867 ;-------------------------------------------------------------------------------
 868
 869 ;https://forth-standard.org/standard/core/Plus
 870 ;C +       n1/u1 n2/u2 -- n3/u3     add n1+n2
 871             FORTHWORD "+"
 872 PLUS        ADD @PSP+,TOS
 873             mNEXT
 874
 875 ;https://forth-standard.org/standard/core/Minus
 876 ;C -      n1/u1 n2/u2 -- n3/u3      n3 = n1-n2
 877             FORTHWORD "-"
 878 MINUS       SUB @PSP+,TOS   ;2  -- n2-n1
 879 NEGATE      XOR #-1,TOS     ;1
 880             ADD #1,TOS      ;1  -- n3 = -(n2-n1)
 881             mNEXT
 882
 883 ;https://forth-standard.org/standard/core/OnePlus
 884 ;C 1+      n1/u1 -- n2/u2       add 1 to TOS
 885             FORTHWORD "1+"
 886 ONEPLUS     ADD #1,TOS
 887             mNEXT
 888
 889 ;https://forth-standard.org/standard/core/OneMinus
 890 ;C 1-      n1/u1 -- n2/u2     subtract 1 from TOS
 891             FORTHWORD "1-"
 892 ONEMINUS    SUB #1,TOS
 893             mNEXT
 894
 895 ;https://forth-standard.org/standard/double/DABS
 896 ;C DABS     d1 -- |d1|     absolute value
 897             FORTHWORD "DABS"
 898 DABBS       AND #-1,TOS     ; clear V, set N
 899             JGE DABBSEND    ; JMP if positive
 900 DNEGATE     XOR #-1,0(PSP)
 901             XOR #-1,TOS
 902             ADD #1,0(PSP)
 903             ADDC #0,TOS
 904 DABBSEND    mNEXT
 905
 906 ;-------------------------------------------------------------------------------
 907 ; COMPARAISON OPERATIONS
 908 ;-------------------------------------------------------------------------------
 909
 910 ;https://forth-standard.org/standard/core/ZeroEqual
 911 ;C 0=     n/u -- flag    return true if TOS=0
 912             FORTHWORD "0="
 913 ZEROEQUAL   SUB #1,TOS      ; borrow (clear cy) if TOS was 0
 914             SUBC TOS,TOS    ; TOS=-1 if borrow was set
 915             mNEXT
 916
 917 ;https://forth-standard.org/standard/core/Zeroless
 918 ;C 0<     n -- flag      true if TOS negative
 919             FORTHWORD "0<"
 920 ZEROLESS    ADD TOS,TOS     ;1 set carry if TOS negative
 921             SUBC TOS,TOS    ;1 TOS=-1 if carry was clear
 922             XOR #-1,TOS     ;1 TOS=-1 if carry was set
 923             mNEXT
 924
 925 ;https://forth-standard.org/standard/core/Equal
 926 ;C =      x1 x2 -- flag         test x1=x2
 927             FORTHWORD "="
 928 EQUAL       SUB @PSP+,TOS   ;2
 929             JNZ TOSFALSE    ;2 --> +4
 930 TOSTRUE     MOV #-1,TOS     ;1
 931             mNEXT           ;4
 932
 933 ;https://forth-standard.org/standard/core/less
 934 ;C <      n1 n2 -- flag        test n1<n2, signed
 935             FORTHWORD "<"
 936 LESS        MOV @PSP+,W     ;2 W=n1
 937             SUB TOS,W       ;1 W=n1-n2 flags set
 938 LESSNEXT    JL TOSTRUE      ;2
 939 TOSFALSE    MOV #0,TOS      ;1
 940             mNEXT           ;4
 941
 942 ;https://forth-standard.org/standard/core/more
 943 ;C >     n1 n2 -- flag         test n1>n2, signed
 944             FORTHWORD ">"
 945 GREATER     SUB @PSP+,TOS   ;2 TOS=n2-n1
 946             JMP LESSNEXT
 947
 948 ;https://forth-standard.org/standard/core/Zeromore
 949 ;C 0>     n -- flag      true if TOS positive
 950             FORTHWORD "0>"
 951 ZEROMORE    CMP #1,TOS
 952             JGE TOSTRUE
 953             JMP TOSFALSE
 954
 955 ;https://forth-standard.org/standard/core/Uless
 956 ;C U<    u1 u2 -- flag       test u1<u2, unsigned
 957             FORTHWORD "U<"
 958 ULESS       MOV @PSP+,W     ;2
 959             SUB TOS,W       ;1 u1-u2 in W, carry clear if borrow
 960             JNC TOSTRUE     ;2
 961             JMP TOSFALSE
 962
 963 ;-------------------------------------------------------------------------------
 964 ; BRANCH and LOOP OPERATORS
 965 ;-------------------------------------------------------------------------------
 966
 967 ;Z branch   --                  branch always
 968 BRAN        MOV @IP,IP      ; 2
 969             mNEXT           ; 4
 970
 971 ;Z ?branch   x --              branch if TOS = zero
 972 QBRAN       CMP #0,TOS      ; 1  test TOS value
 973 QBRAN1      MOV @PSP+,TOS   ; 2  pop new TOS value (doesn't change flags)
 974             JZ bran         ; 2  if TOS was zero, take the branch = 11 cycles
 975             ADD #2,IP       ; 1  else skip the branch destination
 976             mNEXT           ; 4  ==> branch not taken = 10 cycles
 977
 978 ;Z 0?branch   x --              branch if TOS <> zero
 979 QZBRAN      SUB #1,TOS      ; 1 borrow (clear cy) if TOS was 0
 980             SUBC TOS,TOS    ; 1 TOS=-1 if borrow was set
 981             JMP QBRAN1      ; 2
 982
 983
 984 ;Z (do)    n1|u1 n2|u2 --  R: -- sys1 sys2      run-time code for DO
 985 ;                                               n1|u1=limit, n2|u2=index
 986 xdo         MOV #8000h,X    ;2 compute 8000h-limit "fudge factor"
 987             SUB @PSP+,X     ;2
 988             MOV TOS,Y       ;1 loop ctr = index+fudge
 989             MOV @PSP+,TOS   ;2 pop new TOS
 990             ADD X,Y         ;1
 991             PUSHM #2,X      ;4 PUSHM X,Y, i.e. PUSHM LIMIT, INDEX
 992             mNEXT           ;4
 993
 994 ;Z (+loop)   n --   R: sys1 sys2 --  | sys1 sys2
 995 ;                        run-time code for +LOOP
 996 ; Add n to the loop index.  If loop terminates, clean up the
 997 ; return stack and skip the branch. Else take the inline branch.
 998 xploop      ADD TOS,0(RSP)  ;4 increment INDEX by TOS value
 999             MOV @PSP+,TOS   ;2 get new TOS, doesn't change flags
1000 xloopnext   BIT #100h,SR    ;2 is overflow bit set?
1001             JZ bran         ;2 no overflow = loop
1002             ADD #2,IP       ;1 overflow = loop done, skip branch ofs
1003 UNXLOOP     ADD #4,RSP      ;1 empty RSP
1004             mNEXT           ;4 16~ taken or not taken xloop/loop
1005
1006
1007 ;Z (loop)   R: sys1 sys2 --  | sys1 sys2
1008 ;                        run-time code for LOOP
1009 ; Add 1 to the loop index.  If loop terminates, clean up the
1010 ; return stack and skip the branch.  Else take the inline branch.
1011 ; Note that LOOP terminates when index=8000h.
1012 xloop       ADD #1,0(RSP)   ;4 increment INDEX
1013             JMP xloopnext   ;2
1014
1015 ;https://forth-standard.org/standard/core/UNLOOP
1016 ;C UNLOOP   --   R: sys1 sys2 --  drop loop parms
1017             FORTHWORD "UNLOOP"
1018 UNLOOP      JMP UNXLOOP
1019
1020 ;https://forth-standard.org/standard/core/I
1021 ;C I        -- n   R: sys1 sys2 -- sys1 sys2
1022 ;C                  get the innermost loop index
1023             FORTHWORD "I"
1024 II          SUB #2,PSP      ;1 make room in TOS
1025             MOV TOS,0(PSP)  ;3
1026             MOV @RSP,TOS    ;2 index = loopctr - fudge
1027             SUB 2(RSP),TOS  ;3
1028             mNEXT           ;4 13~
1029
1030 ;https://forth-standard.org/standard/core/J
1031 ;C J        -- n   R: 4*sys -- 4*sys
1032 ;C                  get the second loop index
1033             FORTHWORD "J"
1034 JJ          SUB #2,PSP      ; make room in TOS
1035             MOV TOS,0(PSP)
1036             MOV 4(RSP),TOS  ; index = loopctr - fudge
1037             SUB 6(RSP),TOS
1038             mNEXT
1039
1040 ;-------------------------------------------------------------------------------
1041 ; SYSTEM  CONSTANTS
1042 ;-------------------------------------------------------------------------------
1043
1044 ;https://forth-standard.org/standard/core/BL
1045 ;C BL      -- char            an ASCII space
1046             FORTHWORD "BL"
1047 FBLANK       mDOCON
1048             .word   32
1049
1050 ;-------------------------------------------------------------------------------
1051 ; SYSTEM VARIABLES
1052 ;-------------------------------------------------------------------------------
1053
1054 ;https://forth-standard.org/standard/core/BASE
1055 ;C BASE    -- a-addr       holds conversion radix
1056             FORTHWORD "BASE"
1057 FBASE       mDOCON
1058             .word   BASE    ; VARIABLE address in RAM space
1059
1060 ;https://forth-standard.org/standard/core/STATE
1061 ;C STATE   -- a-addr       holds compiler state
1062             FORTHWORD "STATE"
1063 FSTATE      mDOCON
1064             .word   STATE   ; VARIABLE address in RAM space
1065
1066 ;-------------------------------------------------------------------------------
1067 ; ANS complement OPTION
1068 ;-------------------------------------------------------------------------------
1069     .IFDEF ANS_CORE_COMPLIANT
1070     .include "ADDON\ANS_COMPLEMENT.asm"
1071     .ELSEIF
1072
1073 ;-------------------------------------------------------------------------------
1074 ; ALIGNMENT OPERATORS OPTION
1075 ;-------------------------------------------------------------------------------
1076         .IFDEF ALIGNMENT ; included in ANS_COMPLEMENT
1077         .include "ADDON\ALIGNMENT.asm"
1078         .ENDIF ; ALIGNMENT
1079
1080 ;-------------------------------------------------------------------------------
1081 ; PORTABILITY OPERATORS OPTION
1082 ;-------------------------------------------------------------------------------
1083         .IFDEF PORTABILITY
1084         .include "ADDON\PORTABILITY.asm"
1085         .ENDIF ; PORTABILITY
1086
1087 ;-------------------------------------------------------------------------------
1088 ; DOUBLE OPERATORS OPTION
1089 ;-------------------------------------------------------------------------------
1090         .IFDEF DOUBLE ; included in ANS_COMPLEMENT
1091         .include "ADDON\DOUBLE.asm"
1092         .ENDIF ; DOUBLE
1093
1094 ;-------------------------------------------------------------------------------
1095 ; ARITHMETIC OPERATORS OPTION
1096 ;-------------------------------------------------------------------------------
1097         .IFDEF ARITHMETIC ; included in ANS_COMPLEMENT
1098         .include "ADDON\ARITHMETIC.asm"
1099         .ENDIF ; ARITHMETIC
1100
1101     .ENDIF ; ANS_COMPLEMENT
1102
1103 ;-------------------------------------------------------------------------------
1104 ; NUMERIC OUTPUT
1105 ;-------------------------------------------------------------------------------
1106
1107 ; Numeric conversion is done last digit first, so
1108 ; the output buffer is built backwards in memory.
1109
1110 ;https://forth-standard.org/standard/core/num-start
1111 ;C <#    --       begin numeric conversion (initialize Hold Pointer)
1112             FORTHWORD "<#"
1113 LESSNUM     MOV #BASE_HOLD,&HP
1114             mNEXT
1115
1116 ;https://forth-standard.org/standard/core/UMDivMOD
1117 ; UM/MOD   udlo|udhi u1 -- r q   unsigned 32/16->16
1118             FORTHWORD "UM/MOD"
1119 UMSLASHMOD  PUSH #DROP          ;3 as return address for MU/MOD
1120
1121 ; unsigned 32-BIT DiViDend : 16-BIT DIVisor --> 32-BIT QUOTient, 16-BIT REMainder
1122 ; 2 times faster if DVDhi = 0 (it's the general case)
1123
1124 ; reg     division        MU/MOD      NUM
1125 ; -----------------------------------------
1126 ; S     = DVDlo (15-0)  = ud1lo     = ud1lo
1127 ; TOS   = DVDhi (31-16) = ud1hi     = ud1hi
1128 ; T     = DIVlo         = BASE
1129 ; W     = REMlo         = REMlo     = digit --> char --> -[HP]
1130 ; X     = QUOTlo        = ud2lo     = ud2lo
1131 ; Y     = QUOThi        = ud2hi     = ud2hi
1132 ; rDODOES = count
1133
1134 ; MU/MOD        DVDlo DVDhi DIVlo -- REMlo QUOTlo QUOThi, used by fixpoint and #
1135 MUSMOD      MOV TOS,T           ;1 T = DIVlo
1136             MOV @PSP,TOS        ;2 TOS = DVDhi
1137             MOV 2(PSP),S        ;3 S = DVDlo
1138 MUSMOD1     MOV #0,W            ;1  W = REMlo = 0
1139 MUSMOD2     MOV #32,rDODOES     ;2  init loop count
1140             CMP #0,TOS          ;1  DVDhi=0 ?
1141             JNZ MDIV1           ;2  no
1142             RRA rDODOES         ;1  yes:loop count / 2
1143             MOV S,TOS           ;1      DVDhi <-- DVDlo
1144             MOV #0,S            ;1      DVDlo <-- 0
1145             MOV #0,X            ;1      QUOTlo <-- 0 (to do QUOThi = 0 at the end of division)
1146 MDIV1       CMP T,W             ;1  REMlo U>= DIVlo ?
1147             JNC MDIV2           ;2  no : carry is reset
1148             SUB T,W             ;1  yes: REMlo - DIVlo ; carry is set after soustraction!
1149 MDIV2       ADDC X,X            ;1  RLC quotLO
1150             ADDC Y,Y            ;1  RLC quotHI
1151             SUB #1,rDODOES      ;1  Decrement loop counter
1152             JN ENDMDIV          ;2
1153             ADD S,S             ;1  RLA DVDlo
1154             ADDC TOS,TOS        ;1  RLC DVDhi
1155             ADDC W,W            ;1  RLC REMlo
1156             JNC MDIV1           ;2
1157             SUB T,W             ;1  REMlo - DIVlo
1158             BIS #1,SR           ;1  SETC
1159             JMP MDIV2           ;2
1160 ENDMDIV     MOV #xdodoes,rDODOES;2  restore rDODOES
1161             MOV W,2(PSP)        ;3  REMlo in 2(PSP)
1162             MOV X,0(PSP)        ;3  QUOTlo in 0(PSP)
1163             MOV Y,TOS           ;1  QUOThi in TOS
1164             RET                 ;4  35 words, about 252/473 cycles, not FORTH executable !
1165
1166 ;https://forth-standard.org/standard/core/num
1167 ;C #     ud1lo ud1hi -- ud2lo ud2hi          convert 1 digit of output
1168             FORTHWORD "#"
1169 NUM         MOV &BASE,T         ;3                      T = Divisor
1170 NUM1        MOV @PSP,S          ;2 -- DVDlo DVDhi       S = DVDlo
1171             SUB #2,PSP          ;1 -- DVDlo x DVDhi     TOS = DVDhi
1172             CALL #MUSMOD1       ;4 -- REMlo QUOTlo QUOThi
1173             MOV @PSP+,0(PSP)    ;4 -- QUOTlo QUOThi
1174 TODIGIT     CMP.B #10,W         ;2  W = REMlo
1175             JLO TODIGIT1        ;2  U<
1176             ADD #7,W            ;2
1177 TODIGIT1    ADD #30h,W          ;2
1178 HOLDW       SUB #1,&HP          ;3  store W=char --> -[HP]
1179             MOV &HP,Y           ;3
1180             MOV.B W,0(Y)        ;3
1181             mNEXT               ;4  26 words
1182
1183 ;https://forth-standard.org/standard/core/numS
1184 ;C #S    udlo:udhi -- udlo:udhi=0       convert remaining digits
1185             FORTHWORD "#S"
1186 NUMS        mDOCOL
1187             .word   NUM         ;       X=QUOTlo
1188             FORTHtoASM          ;
1189             SUB #2,IP           ;1      restore NUM return
1190             CMP #0,X            ;1      test ud2lo first (generally true)
1191             JNZ NUM1            ;2
1192             CMP #0,TOS          ;1      then test ud2hi (generally false)
1193             JNZ NUM1            ;2
1194             MOV @RSP+,IP        ;2
1195             mNEXT               ;4 10 words, about 241/417 cycles/char
1196
1197 ;https://forth-standard.org/standard/core/num-end
1198 ;C #>    udlo:udhi -- c-addr u    end conversion, get string
1199             FORTHWORD "#>"
1200 NUMGREATER  MOV &HP,0(PSP)
1201             MOV #BASE_HOLD,TOS
1202             SUB @PSP,TOS
1203             mNEXT
1204
1205 ;https://forth-standard.org/standard/core/HOLD
1206 ;C HOLD  char --        add char to output string
1207             FORTHWORD "HOLD"
1208 HOLD        MOV TOS,W           ;1
1209             MOV @PSP+,TOS       ;2
1210             JMP HOLDW           ;15
1211
1212 ;https://forth-standard.org/standard/core/SIGN
1213 ;C SIGN  n --           add minus sign if n<0
1214             FORTHWORD "SIGN"
1215 SIGN        CMP #0,TOS
1216             MOV @PSP+,TOS
1217             MOV #'-',W
1218             JN HOLDW        ; 0<
1219             mNEXT
1220
1221 ;https://forth-standard.org/standard/core/Ud
1222 ;C U.    u --           display u (unsigned)
1223             FORTHWORD "U."
1224 UDOT        mDOCOL
1225             .word   LESSNUM,lit,0,NUMS,NUMGREATER,TYPE,SPACE,EXIT
1226
1227 ;https://forth-standard.org/standard/double/Dd
1228 ;C D.     dlo dhi --           display d (signed)
1229             FORTHWORD "D."
1230 DDOT         mDOCOL
1231             .word   LESSNUM,SWAP,OVER,DABBS,NUMS
1232             .word   ROT,SIGN,NUMGREATER,TYPE,SPACE,EXIT
1233
1234 ;https://forth-standard.org/standard/core/d
1235 ;C .     n --           display n (signed)
1236             FORTHWORD "."
1237 DOT         CMP #0,TOS
1238             JGE UDOT
1239             SUB #2,PSP
1240             MOV TOS,0(PSP)
1241             MOV #-1,TOS         ; extend sign
1242             JMP DDOT
1243
1244 ;-------------------------------------------------------------------------------
1245 ; DICTIONARY MANAGEMENT
1246 ;-------------------------------------------------------------------------------
1247
1248 ;https://forth-standard.org/standard/core/HERE
1249 ;C HERE    -- addr      returns dictionary ptr
1250             FORTHWORD "HERE"
1251 HERE        SUB #2,PSP
1252             MOV TOS,0(PSP)
1253             MOV &DDP,TOS
1254             mNEXT
1255
1256 ;https://forth-standard.org/standard/core/ALLOT
1257 ;C ALLOT   n --         allocate n bytes in dict
1258             FORTHWORD "ALLOT"
1259 ALLOT       ADD TOS,&DDP
1260             MOV @PSP+,TOS
1261             mNEXT
1262
1263 ;https://forth-standard.org/standard/core/CComma
1264 ;C C,   char --        append char to dict
1265             FORTHWORD "C,"
1266 CCOMMA      MOV &DDP,W
1267             MOV.B TOS,0(W)
1268             ADD #1,&DDP
1269             MOV @PSP+,TOS
1270             mNEXT
1271
1272 ; ------------------------------------------------------------------------------
1273 ; TERMINAL I/O, input part
1274 ; ------------------------------------------------------------------------------
1275
1276
1277 ;https://forth-standard.org/standard/core/KEY
1278 ;C KEY      -- c      wait character from input device ; primary DEFERred word
1279             FORTHWORD "KEY"
1280 KEY         MOV @PC+,PC
1281             .word   BODYKEY
1282 BODYKEY     MOV &TERMRXBUF,Y        ; empty buffer
1283             SUB #2,PSP              ; 1  push old TOS..
1284             MOV TOS,0(PSP)          ; 4  ..onto stack
1285             CALL #RXON
1286 KEYLOOP     BIT #UCRXIFG,&TERMIFG   ; loop if bit0 = 0 in interupt flag register
1287             JZ KEYLOOP              ;
1288             MOV &TERMRXBUF,TOS      ;
1289             CALL #RXOFF             ;
1290             mNEXT
1291
1292 ;-------------------------------------------------------------------------------
1293 ; INTERPRETER INPUT, the kernel of kernel !
1294 ;-------------------------------------------------------------------------------
1295
1296     .IFDEF SD_CARD_LOADER
1297     .include "forthMSP430FR_SD_ACCEPT.asm"
1298 DEFER_INPUT ; CIB (Current Input Buffer) and ACCEPT must to be redirected for SD_LOAD usage
1299     .ENDIF
1300
1301     .IFDEF DEFER_INPUT
1302
1303 ; CIB           --  addr          of Current Input Buffer
1304             FORTHWORD "CIB"
1305 FCIB        mDOCON
1306             .WORD    TIB_ORG        ; constant, may be DEFERred as SDIB_ORG by OPEN.
1307
1308 ; : REFILL CIB DUP TIB_LEN ACCEPT ;   -- CIB CIB len    shared by QUIT and [ELSE]
1309 REFILL      SUB #6,PSP              ;2
1310             MOV TOS,4(PSP)          ;3
1311             MOV #TIB_LEN,TOS        ;2
1312             MOV &FCIB+2,0(PSP)      ;5
1313             MOV @PSP,2(PSP)         ;4
1314             JMP ACCEPT              ;2
1315
1316 ;https://forth-standard.org/standard/core/ACCEPT
1317 ;C ACCEPT  addr addr len -- addr len'  get line at addr to interpret len' chars
1318             FORTHWORD "ACCEPT"
1319 ACCEPT      MOV @PC+,PC             ;3
1320             .word   BODYACCEPT
1321 BODYACCEPT
1322
1323     .ELSE
1324
1325 ; : REFILL TIB DUP TIB_LEN ACCEPT ;   -- TIB TIB len    shared by QUIT and [ELSE]
1326 REFILL      SUB #6,PSP              ;2
1327             MOV TOS,4(PSP)          ;3
1328             MOV #TIB_LEN,TOS        ;2
1329             MOV #TIB_ORG,0(PSP)     ;4
1330             MOV @PSP,2(PSP)         ;4
1331             JMP ACCEPT              ;2
1332
1333 ;https://forth-standard.org/standard/core/ACCEPT
1334 ;C ACCEPT  addr addr len -- addr len'  get line at addr to interpret len' chars
1335             FORTHWORD "ACCEPT"
1336 ACCEPT
1337
1338     .ENDIF ; DEFER_INPUT
1339
1340     .IFDEF  HALFDUPLEX  ; to use FAST FORTH with half duplex input terminal (bluetooth or wifi connexion)
1341
1342     .include "forthMSP430FR_HALFDUPLEX.asm"
1343
1344     .ELSE   ; to use FAST FORTH with full duplex terminal (USBtoUART bridge)
1345
1346 ; con speed of TERMINAL link, there are three bottlenecks :
1347 ; 1- time to send XOFF/RTS_high on CR (CR+LF=EOL), first emergency.
1348 ; 2- the char loop time,
1349 ; 3- the time between sending XON/RTS_low and clearing UCRXIFG on first received char,
1350 ; everything must be done to reduce these times, taking into account the necessity of switching to SLEEP (LPMx mode).
1351 ; ----------------------------------;
1352 ; (ACCEPT) I prepare TERMINAL_INT   ;
1353 ; ----------------------------------;
1354     .IFDEF TOTAL
1355             .word 1537h             ;6              push R7,R6,R5,R4
1356     .ENDIF                          ;
1357             MOV #ENDACCEPT,S        ;2              S = ACCEPT XOFF return
1358             MOV #AKEYREAD1,T        ;2              T = default XON return
1359             PUSHM #3,IP             ;5              PUSHM IP,S,T, as IP ret, XOFF ret, XON ret
1360             MOV TOS,W               ;1 -- addr len
1361             MOV @PSP,TOS            ;2 -- org ptr                                             )
1362             ADD TOS,W               ;1 -- org ptr   W=Bound                                   )
1363             MOV #0Dh,T              ;2              T = 'CR' to speed up char loop in part II  > prepare stack and registers
1364             MOV #20h,S              ;2              S = 'BL' to speed up char loop in part II )  for TERMINAL_INT use
1365             MOV #AYEMIT_RET,IP      ;2              IP = return for YEMIT                     )
1366             BIT #UCRXIFG,&TERMIFG   ;3              RX_Int ?
1367             JZ ACCEPTNEXT           ;2              no : case of quiet input terminal
1368             MOV &TERMRXBUF,Y        ;3              yes: clear RX_Int
1369             CMP #0Ah,Y              ;2                   received char = LF ? (end of downloading ?)
1370             JNZ RXON                ;2                   no : RXON return = AKEYREAD1, to process first char of new line.
1371 ACCEPTNEXT  ADD #2,RSP              ;1                   yes: remove AKEYREAD1 as XON return,
1372             MOV #SLEEP,X            ;2                        and set XON return = SLEEP
1373             PUSHM #5,IP             ;7                        PUSHM IP,S,T,W,X before SLEEP (and so WAKE on any interrupts)
1374 ; ----------------------------------;
1375 RXON                                ;
1376 ; ----------------------------------;
1377     .IFDEF TERMINAL3WIRES           ;
1378 ;    .IF TERMINALBAUDRATE/FREQUENCY <230400
1379 RXON_LOOP   BIT #UCTXIFG,&TERMIFG   ;3  wait the sending end of XON, useless at high baudrates
1380             JZ RXON_LOOP            ;2
1381 ;    .ENDIF
1382             MOV #17,&TERMTXBUF      ;4  move char XON into TX_buf
1383     .ENDIF                          ;
1384     .IFDEF TERMINAL4WIRES           ;
1385             BIC.B #RTS,&HANDSHAKOUT ;4  set RTS low
1386     .ENDIF                          ;
1387 ; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
1388 ; starts first and 3th stopwatches  ;
1389 ; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
1390             RET                     ;4  to BACKGND (End of file download or quiet input) or AKEYREAD1 (get next line of file downloading)
1391 ; ----------------------------------;   ...or user defined
1392
1393
1394 ; ----------------------------------;
1395 RXOFF                               ;
1396 ; ----------------------------------;
1397     .IFDEF TERMINAL3WIRES           ;
1398             MOV #19,&TERMTXBUF      ;4 move XOFF char into TX_buf
1399     .ENDIF                          ;
1400     .IFDEF TERMINAL4WIRES           ;
1401             BIS.B #RTS,&HANDSHAKOUT ;4 set RTS high
1402     .ENDIF                          ;
1403             RET                     ;4 to ENDACCEPT, ...or user defined
1404 ; ----------------------------------;
1405
1406
1407 ; ----------------------------------;
1408     ASMWORD "SLEEP"                 ; may be redirected
1409 SLEEP       MOV @PC+,PC             ;3
1410             .word   BODYSLEEP      ;
1411 BODYSLEEP  BIS &LPM_MODE,SR        ;3  enter in LPMx sleep mode with GIE=1
1412 ; ----------------------------------;   default FAST FORTH mode (for its input terminal use) : LPM0.
1413
1414 ;###############################################################################################################
1415 ;###############################################################################################################
1416
1417 ; ### #     # ####### ####### ######  ######  #     # ######  #######  #####     #     # ####### ######  #######
1418 ;  #  ##    #    #    #       #     # #     # #     # #     #    #    #     #    #     # #       #     # #
1419 ;  #  # #   #    #    #       #     # #     # #     # #     #    #    #          #     # #       #     # #
1420 ;  #  #  #  #    #    #####   ######  ######  #     # ######     #     #####     ####### #####   ######  #####
1421 ;  #  #   # #    #    #       #   #   #   #   #     # #          #          #    #     # #       #   #   #
1422 ;  #  #    ##    #    #       #    #  #    #  #     # #          #    #     #    #     # #       #    #  #
1423 ; ### #     #    #    ####### #     # #     #  #####  #          #     #####     #     # ####### #     # #######
1424
1425 ;###############################################################################################################
1426 ;###############################################################################################################
1427
1428
1429 ; here, Fast FORTH sleeps, waiting any interrupt.
1430 ; IP,S,T,W,X,Y registers (R13 to R8) are free for any interrupt routine...
1431 ; ...and so PSP and RSP stacks with their rules of use.
1432 ; remember: in any interrupt routine you must include : BIC #0x78,0(RSP) before RETI
1433 ;           to force return to SLEEP.
1434 ;           or (bad idea ? previous SR flags are lost) simply : ADD #2 RSP, then RET instead of RETI
1435
1436
1437 ; ==================================;
1438             JMP SLEEP               ;2  here is the return for any interrupts, else TERMINAL_INT  :-)
1439 ; ==================================;
1440
1441
1442 ; **********************************;
1443 TERMINAL_INT                        ; <--- TEMR RX interrupt vector, delayed by the LPMx wake up time
1444 ; **********************************;      if wake up time increases, max bauds rate decreases...
1445 ; (ACCEPT) part II under interrupt  ; Org Ptr -- len'
1446 ; ----------------------------------;
1447             ADD #4,RSP              ;1  remove SR and PC from stack, SR flags are lost (unused by FORTH interpreter)
1448             POPM #4,IP              ;6  POPM W=buffer_bound, T=0Dh,S=20h, IP=AYEMIT_RET
1449 ; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
1450 ; starts the 2th stopwatch          ;
1451 ; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
1452 AKEYREAD    MOV.B &TERMRXBUF,Y      ;3  read character into Y, UCRXIFG is cleared
1453 ; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
1454 ; stops the 3th stopwatch           ; 3th bottleneck result : 17~ + LPMx wake_up time ( + 5~ XON loop if F/Bds<230400 )
1455 ; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
1456 AKEYREAD1
1457             CMP.B S,Y               ;1      printable char ?
1458             JHS ASTORETEST          ;2      yes
1459             CMP.B T,Y               ;1      char = CR ?
1460             JZ RXOFF                ;2      then RET to ENDACCEPT
1461 ; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;+ 4    to send RXOFF
1462 ; stops the first stopwatch         ;=      first bottleneck, best case result: 27~ + LPMx wake_up time..
1463 ; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;       ...or 14~ in case of empty line
1464             CMP.B #8,Y              ;1      char = BS ?
1465             JNE WAITaKEY            ;2      case of other control chars
1466 ; ----------------------------------;
1467 ; start of backspace                ;       made only by an human
1468 ; ----------------------------------;
1469             CMP @PSP,TOS            ;       Ptr = Org ?
1470             JZ WAITaKEY             ;       yes: do nothing
1471             SUB #1,TOS              ;       no : dec Ptr
1472             JMP YEMIT1              ;       send BS
1473 ; ----------------------------------;
1474 ; end of backspace                  ;
1475 ; ----------------------------------;
1476 ASTORETEST  CMP W,TOS               ; 1 Bound is reached ?
1477             JZ YEMIT1               ; 2 yes: send echo then loopback
1478             MOV.B Y,0(TOS)          ; 3 no: store char @ Ptr, send echo then loopback
1479             ADD #1,TOS              ; 1     increment Ptr
1480 YEMIT1
1481 ;    .IF TERMINALBAUDRATE/FREQUENCY <230401
1482             BIT #UCTXIFG,&TERMIFG   ; 3 wait the sending end of previous char (sent before ACCEPT), useless at high baudrates
1483             JZ YEMIT1               ; 2
1484 ;    .ENDIF
1485 YEMIT2
1486     .IFDEF  TERMINAL5WIRES          ;
1487             BIT.B #CTS,&HANDSHAKIN  ; 3
1488             JNZ YEMIT2              ; 2
1489     .ENDIF
1490 YEMIT                               ; hi7/4~ lo:12/9~ send/send_not  echo to terminal
1491             .word   4882h           ; 4882h = MOV Y,&<next_adr>
1492             .word   TERMTXBUF       ; 3
1493             mNEXT                   ; 4
1494 ; ----------------------------------;
1495 AYEMIT_RET  FORTHtoASM              ; 0     YEMII NEXT address; NOP9
1496             SUB #2,IP               ; 1 set YEMIT NEXT address to AYEMIT_RET
1497 WAITaKEY    BIT #UCRXIFG,&TERMIFG   ; 3 new char in TERMRXBUF ?
1498             JNZ AKEYREAD            ; 2 yes
1499             JZ WAITaKEY             ; 2 no
1500 ; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
1501 ; stops the 2th stopwatch           ; best case result: 26~/22~ (with/without echo) ==> 385/455 kBds/MHz
1502 ; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
1503
1504 ; ----------------------------------;
1505 ENDACCEPT                           ; <--- XOFF return address
1506 ; ----------------------------------;
1507             MOV #LPM0+GIE,&LPM_MODE ; reset LPM_MODE to default mode LPM0 for next line of input stream
1508             CMP #0,&LINE            ; if LINE <> 0...
1509             JZ ACCEPTEND            ;
1510             ADD #1,&LINE            ; ...increment LINE
1511 ACCEPTEND   SUB @PSP+,TOS           ; Org Ptr -- len'
1512             MOV @RSP+,IP            ; 2 and continue with INTERPRET with GIE=0.
1513                                     ; So FORTH machine is protected against any interrupt...
1514     .IFDEF TOTAL
1515             POPM #4,R7              ;6              pop R4,R5,R6,R7
1516     .ENDIF
1517             mNEXT                   ; ...until next falling down to LPMx mode of (ACCEPT) part1,
1518 ; **********************************;    i.e. when the FORTH interpreter has no more to do.
1519
1520 ; ------------------------------------------------------------------------------
1521 ; TERMINAL I/O, output part
1522 ; ------------------------------------------------------------------------------
1523
1524 ;https://forth-standard.org/standard/core/EMIT
1525 ;C EMIT     c --    output character to the output device ; primary DEFERred word
1526             FORTHWORD "EMIT"
1527 EMIT        MOV @PC+,PC             ;3  15~
1528             .word   BODYEMIT
1529 BODYEMIT   MOV TOS,Y               ; 1
1530             MOV @PSP+,TOS           ; 2
1531             JMP YEMIT1              ;9  12~
1532
1533     .ENDIF  ; HALFDUPLEX
1534
1535
1536 ;Z ECHO     --      connect console output (default)
1537             FORTHWORD "ECHO"
1538 ECHO        MOV #4882h,&YEMIT       ; 4882h = MOV Y,&<next_adr>
1539             MOV #0,&LINE            ;
1540             mNEXT
1541
1542 ;Z NOECHO   --      disconnect console output
1543             FORTHWORD "NOECHO"
1544 NOECHO      MOV #NEXT,&YEMIT        ;  NEXT = 4030h = MOV @IP+,PC
1545             MOV #1,&LINE            ;
1546             mNEXT
1547
1548 ;https://forth-standard.org/standard/core/SPACE
1549 ;C SPACE   --               output a space
1550             FORTHWORD "SPACE"
1551 SPACE       SUB #2,PSP              ;1
1552             MOV TOS,0(PSP)          ;3
1553             MOV #20h,TOS            ;2
1554             JMP EMIT                ;17~  23~
1555
1556 ;https://forth-standard.org/standard/core/SPACES
1557 ;C SPACES   n --            output n spaces
1558             FORTHWORD "SPACES"
1559 SPACES      CMP #0,TOS
1560             JZ ONEDROP
1561             PUSH IP
1562             MOV #SPACESNEXT,IP
1563             JMP SPACE               ;25~
1564 SPACESNEXT  FORTHtoASM
1565             SUB #2,IP               ;1
1566             SUB #1,TOS              ;1
1567             JNZ SPACE               ;25~ ==> 27~ by space ==> 2.963 MBds @ 8 MHz
1568 DROPEXIT    MOV @RSP+,IP            ;
1569 ONEDROP     MOV @PSP+,TOS           ; --         drop n
1570             mNEXT                   ;
1571
1572 ;https://forth-standard.org/standard/core/TYPE
1573 ;C TYPE    adr len --     type line to terminal
1574             FORTHWORD "TYPE"
1575 TYPE        CMP #0,TOS
1576             JZ TWODROP              ; abort fonction
1577             .word   0151Eh          ;5 PUSM TOS,IP      R-- len,IP
1578             MOV #TYPE_NEXT,IP
1579 TYPELOOP    MOV @PSP,Y              ;2 -- adr adr       ; 30~ char loop
1580             MOV.B @Y+,TOS           ;2
1581             MOV Y,0(PSP)            ;3 -- adr+1 char
1582             SUB #2,PSP              ;1 emit consumes one cell
1583             JMP EMIT                ;15
1584 TYPE_NEXT   FORTHtoASM
1585             SUB #2,IP               ;1
1586             SUB #1,2(RSP)           ;4 len-1
1587             JNZ TYPELOOP            ;2
1588             POPM #2,TOS             ;4 POPM IP,TOS
1589 TWODROP     ADD #2,PSP              ;
1590             MOV @PSP+,TOS           ; --
1591             mNEXT                   ;
1592
1593 ;https://forth-standard.org/standard/core/CR
1594 ;C CR      --               send CR to the output device
1595             FORTHWORD "CR"
1596 CR          MOV @PC+,PC
1597             .word   BODYCR
1598 BODYCR     mDOCOL
1599             .word   XSQUOTE
1600             .byte   2,13,10
1601             .word   TYPE,EXIT
1602
1603 ; ------------------------------------------------------------------------------
1604 ; STRINGS PROCESSING
1605 ; ------------------------------------------------------------------------------
1606
1607 ;Z (S")     -- addr u   run-time code for S"
1608 ; get address and length of string.
1609 XSQUOTE     SUB #4,PSP              ; 1 -- x x TOS      ; push old TOS on stack
1610             MOV TOS,2(PSP)          ; 3 -- TOS x x      ; and reserve one cell on stack
1611             MOV.B @IP+,TOS          ; 2 -- x u          ; u = lenght of string
1612             MOV IP,0(PSP)           ; 3 -- addr u
1613             ADD TOS,IP              ; 1 -- addr u       IP=addr+u=addr(end_of_string)
1614             BIT #1,IP               ; 1 -- addr u       IP=addr+u   Carry set/clear if odd/even
1615             ADDC #0,IP              ; 1 -- addr u       IP=addr+u aligned
1616             mNEXT                   ; 4  16~
1617
1618     .IFDEF LOWERCASE
1619
1620             FORTHWORD "CAPS_ON"
1621 CAPS_ON     MOV #-1,&CAPS           ; state by default
1622             mNEXT
1623
1624             FORTHWORD "CAPS_OFF"
1625 CAPS_OFF    MOV #0,&CAPS
1626             mNEXT
1627
1628 ;https://forth-standard.org/standard/core/Sq
1629 ;C S"       --             compile in-line string
1630             FORTHWORDIMM "S\34"     ; immediate
1631 SQUOTE      mDOCOL
1632             .word   lit,XSQUOTE,COMMA
1633 SQUOTE1     .word   CAPS_OFF
1634             .word   lit,'"',WORDD   ; -- c-addr (= HERE)
1635             .word   CAPS_ON
1636
1637     .ELSE
1638
1639 ;https://forth-standard.org/standard/core/Sq
1640 ;C S"       --             compile in-line string
1641             FORTHWORDIMM "S\34"     ; immediate
1642 SQUOTE      mDOCOL
1643             .word   lit,XSQUOTE,COMMA
1644 SQUOTE1     .word   lit,'"',WORDD ; -- c-addr (= HERE)
1645
1646     .ENDIF ; LOWERCASE
1647
1648             FORTHtoASM
1649             MOV @RSP+,IP
1650             MOV.B @TOS,TOS          ; -- u
1651             SUB #1,TOS              ;   -1 byte
1652             ADD TOS,&DDP
1653             MOV @PSP+,TOS
1654 CELLPLUSALIGN
1655             BIT #1,&DDP             ;3 carry set if 1
1656             ADDC #2,&DDP            ;4  +2 bytes
1657             mNEXT
1658
1659 ;https://forth-standard.org/standard/core/Dotq
1660 ;C ."       --              compile string to print
1661             FORTHWORDIMM ".\34"     ; immediate
1662 DOTQUOTE    mDOCOL
1663             .word   SQUOTE
1664             .word   lit,TYPE,COMMA,EXIT
1665
1666 ;-------------------------------------------------------------------------------
1667 ; INTERPRETER
1668 ;-------------------------------------------------------------------------------
1669
1670 ;https://forth-standard.org/standard/core/WORD
1671 ;C WORD   char -- addr        Z=1 if len=0
1672 ; parse a word delimited by char separator
1673 ;                                   "word" is capitalized
1674 ;                                   TOIN is the relative displacement in the ascii string
1675 ;                                   separator filled line = 25 cycles + 7 cycles by char
1676             FORTHWORD "WORD"
1677 WORDD       MOV #SOURCE_LEN,S       ;2 -- separator
1678             MOV @S+,X               ;2               X = str_len
1679             MOV @S+,W               ;2               W = str_org
1680             ADD W,X                 ;1               W = str_org    X = str_org + str_len = str_end
1681             ADD @S+,W               ;2               W = str_org + >IN = str_ptr    X = str_end
1682             MOV @S,Y                ;2 -- separator  W = str_ptr    X = str_end     Y = HERE, as dst_ptr
1683 SKIPCHARLOO CMP W,X                 ;1               str_ptr = str_end ?
1684             JZ EOL_END              ;2 -- separator  if yes : End Of Line !
1685             CMP.B @W+,TOS           ;2               does char = separator ?
1686             JZ SKIPCHARLOO          ;2 -- separator  if yes
1687 SCANWORD    SUB #1,W                ;1
1688             MOV #96,T               ;2              T = 96 = ascii(a)-1 (test value set in a register before SCANWORD loop)
1689 SCANWORDLOO                         ; -- separator  15/23 cycles loop for upper/lower case char... write words in upper case !
1690             MOV.B S,0(Y)            ;3              first time make room in dst for word length, then put char @ dst.
1691             CMP W,X                 ;1              str_ptr = str_end ?
1692             JZ SCANWORDEND          ;2              if yes
1693             MOV.B @W+,S             ;2
1694             CMP.B S,TOS             ;1              does char = separator ?
1695             JZ SCANWORDEND          ;2              if yes
1696             ADD #1,Y                ;1              increment dst just before test loop
1697             CMP.B S,T               ;1              char U< 'a' ?  ('a'-1 U>= char) this condition is tested at each loop
1698             JC SCANWORDLOO          ;2              15~ upper case char loop
1699     .IFDEF LOWERCASE                ;
1700 QCAPS       CMP #0,&CAPS            ;3              CAPS is OFF ? (case available only for ABORT" ." .( )
1701             JZ SCANWORDLOO          ;2              yes
1702     .ENDIF ; LOWERCASE              ;               here CAPS is ON (other cases)
1703             CMP.B #123,S            ;2              char U>= 'z'+1 ?
1704             JC SCANWORDLOO          ;2              if yes
1705             SUB.B #32,S             ;2              convert lowercase char to uppercase
1706             JMP SCANWORDLOO         ;2
1707
1708 SCANWORDEND SUB &SOURCE_ADR,W       ;3 -- separator  W=str_ptr - str_org = new >IN (first char separator next)
1709             MOV W,&TOIN             ;3               update >IN
1710 EOL_END     MOV &DDP,TOS            ;3 -- c-addr
1711             SUB TOS,Y               ;1               Y=Word_Length
1712             MOV.B Y,0(TOS)          ;3
1713             mNEXT                   ;4 -- c-addr     40 words      Z=1 <==> lenght=0 <==> EOL
1714
1715
1716 ;https://forth-standard.org/standard/core/FIND
1717 ;C FIND   c-addr -- c-addr 0   if not found ; flag Z=1
1718 ;C                  xt -1      if found     ; flag Z=0
1719 ;C                  xt  1      if immediate ; flag Z=0
1720 ; compare WORD at c-addr (HERE)  with each of words in each of listed vocabularies in CONTEXT
1721 ; FIND to WORDLOOP  : 14/20 cycles,
1722 ; mismatch word loop: 13 cycles on len, +8 cycles on first char,
1723 ;                     +10 cycles char loop,
1724 ; VOCLOOP           : 12/18 cycles,
1725 ; WORDFOUND to end  : 21 cycles.
1726 ; note: with 16 threads vocabularies, FIND takes about 75% of CORETEST.4th processing time
1727             FORTHWORD "FIND"
1728 FIND        SUB #2,PSP              ;1 -- ???? c-addr       reserve one cell here, not at FINDEND because interacts with flag Z
1729             MOV TOS,S               ;1                      S=c-addr
1730             MOV.B @S,rDOCON         ;2                      R5= string count
1731             MOV.B #80h,rDODOES      ;2                      R4= immediate mask
1732             MOV #CONTEXT,T          ;2
1733 VOCLOOP     MOV @T+,TOS             ;2 -- ???? VOC_PFA      T=CTXT+2
1734             CMP #0,TOS              ;1                      no more vocabulary in CONTEXT ?
1735             JZ FINDEND              ;2 -- ???? 0            yes ==> exit; Z=1
1736     .SWITCH THREADS
1737     .CASE   1
1738     .ELSECASE                       ;                       search thread add 6cycles  5words
1739 MAKETHREAD  MOV.B 1(S),Y            ;3 -- ???? VOC_PFA0     S=c-addr Y=CHAR0
1740             AND.B #(THREADS-1)*2,Y  ;2 -- ???? VOC_PFA0     Y=thread offset
1741             ADD Y,TOS               ;1 -- ???? VOC_PFAx
1742     .ENDCASE
1743             ADD #2,TOS              ;1 -- ???? VOC_PFA+2
1744 WORDLOOP    MOV -2(TOS),TOS         ;3 -- ???? [VOC_PFA]    [VOC_PFA] first, then [LFA]
1745             CMP #0,TOS              ;1 -- ???? NFA          no more word in the thread ?
1746             JZ VOCLOOP              ;2 -- ???? NFA          yes ==> search next voc in context
1747             MOV TOS,X               ;1
1748             MOV.B @X+,Y             ;2                      TOS=NFA,X=NFA+1,Y=NFA_char
1749             BIC.B rDODOES,Y         ;1                      hide Immediate bit
1750 LENCOMP     CMP.B rDOCON,Y          ;1                      compare lenght
1751             JNZ WORDLOOP            ;2 -- ???? NFA          13~ word loop on lenght mismatch
1752             MOV S,W                 ;1                      W=c-addr
1753 CHARLOOP    ADD #1,W                ;1
1754 CHARCOMP    CMP.B @X+,0(W)          ;4                      compare chars
1755             JNZ WORDLOOP            ;2 -- ???? NFA          21~ word loop on first char mismatch
1756             SUB.B #1,Y              ;1                      decr count
1757             JNZ CHARLOOP            ;2 -- ???? NFA          10~ char loop
1758
1759 WORDFOUND   BIT #1,X                ;1
1760             ADDC #0,X               ;1
1761             MOV X,S                 ;1                      S=aligned CFA
1762             MOV.B @TOS,W            ;2 -- ???? NFA          W=NFA_first_char
1763             MOV #1,TOS              ;1 -- ???? 1            preset immediate flag
1764             CMP.B #0,W              ;1                      W is negative if immediate flag
1765             JN FINDEND              ;2 -- ???? 1
1766             SUB #2,TOS              ;1 -- ???? -1
1767 FINDEND     MOV S,0(PSP)            ;3 not found: -- c-addr 0                           flag Z=1
1768                                     ;      found: -- xt -1|+1 (not immediate|immediate) flag Z=0
1769             MOV #xdocon,rDOCON      ;2
1770             MOV #xdodoes,rDODOES    ;2
1771             mNEXT                   ;4 42/47 words
1772
1773     .IFDEF MPY_32
1774
1775 ;https://forth-standard.org/standard/core/toNUMBER
1776 ;C  convert a string to double number until count2 = 0 or until not convertible char
1777 ;C >NUMBER  ud1lo|ud1hi addr1 count1 -- ud2lo|ud2hi addr2 count2
1778             FORTHWORD ">NUMBER"     ; 23 cycles + 32/34 cycles DEC/HEX char loop
1779 TONUMBER    MOV @PSP+,S             ;2                          S = adr
1780             MOV @PSP+,Y             ;2                          Y = ud1hi
1781             MOV @PSP,X              ;2                          X = ud1lo
1782             SUB #4,PSP              ;1
1783             MOV &BASE,T             ;3
1784 TONUMLOOP   MOV.B @S,W              ;2 -- ud1lo ud1hi adr count W=char
1785 DDIGITQ     SUB.B #30h,W            ;2                          skip all chars < '0'
1786             CMP.B #10,W             ;2                          char was U< "10" ?
1787             JLO DDIGITQNEXT         ;2                          no
1788             SUB.B #7,W              ;2                          skip all chars between "9" and "A"
1789             CMP.B #10,W             ;2
1790             JLO TONUMEND            ;2
1791 DDIGITQNEXT CMP T,W                 ;1                          digit-base
1792             JHS TONUMEND            ;2 -- ud1lo ud1hi adr count abort if < 0 or >= base
1793             MOV X,&MPY32L           ;3                          Load 1st operand (ud1lo)
1794             MOV Y,&MPY32H           ;3                          Load 1st operand (ud1hi)
1795             MOV T,&OP2              ;3                          Load 2nd operand with BASE
1796             MOV &RES0,X             ;3                          lo result in X (ud2lo)
1797             MOV &RES1,Y             ;3                          hi result in Y (ud2hi)
1798             ADD W,X                 ;1                          ud2lo + digit
1799             ADDC #0,Y               ;1                          ud2hi + carry
1800 TONUMPLUS   ADD #1,S                ;1 -- ud1lo ud1hi adr count S=adr+1
1801             SUB #1,TOS              ;1 -- ud1lo ud1hi adr count-1
1802             JNZ TONUMLOOP           ;2                          if count <>0
1803             MOV Y,2(PSP)            ;3 -- ud2lo ud2hi adr count2
1804 TONUMEND    MOV S,0(PSP)            ;3 -- ud2lo ud2hi addr2 count2
1805             MOV X,4(PSP)            ;3 -- ud2lo ud1hi adr count2
1806             mNEXT                   ;4 38 words
1807
1808
1809 ; ?NUMBER makes the interface between >NUMBER and INTERPRET; it's a subset of INTERPRET.
1810 ; convert a string to a signed number; FORTH 2012 prefixes $, %, # are recognized
1811 ; 32 bits numbers (with decimal point) and fixed point signed numbers (with a comma) are recognized.
1812 ; prefixes # % $ - are processed before calling >NUMBER
1813 ; not convertible chars '.' (double) and ',' (fixed point) are processed as >NUMBER exits
1814 ;Z ?NUMBER  c-addr -- n -1      if convert ok ; flag Z=0
1815 ;Z          c-addr -- c-addr 0  if convert ko ; flag Z=1
1816 QNUMBER     MOV #0,S                ;1
1817             MOV &BASE,T             ;3                          T=BASE
1818             BIC #UF9,SR             ;2                          reset flag UF9, before use as decimal point flag
1819             .word   152Dh           ;5                          R-- IP sign base
1820             MOV #0,X                ;1                          X=ud1lo
1821             MOV #0,Y                ;1                          Y=ud1hi
1822             MOV #QNUMNEXT,IP        ;2                          return from >NUMBER
1823             SUB #8,PSP              ;1 -- x x x x c-addr        save TOS and make room for >NUMBER
1824             MOV TOS,6(PSP)          ;3 -- c-addr x x x c-addr
1825             MOV TOS,S               ;1                          S=addrr
1826             MOV.B @S+,TOS           ;2 -- c-addr x x x cnt      TOS=count
1827             MOV.B @S,W              ;2                          W=char
1828             SUB.B #',',W            ;2
1829             JHS QSIGN               ;2                          for current base, and for ',' or '.' process
1830             SUB.B #1,W              ;1
1831 QBINARY     MOV #2,T                ;3                              preset base 2
1832             ADD.B #8,W              ;1                          '%' + 8 = '-'   binary number ?
1833             JZ PREFIXED             ;2
1834 QDECIMAL    ADD #8,T                ;4
1835             ADD.B #2,W              ;1                          '#' + 2 = '%'   decimal number ?
1836             JZ PREFIXED             ;2
1837 QHEXA       MOV #16,T               ;4
1838             SUB.B #1,W              ;2                          '$' - 1 = '#'   hex number ?
1839             JNZ TONUMLOOP           ;2 -- c-addr ud=0 x x       other cases will cause error
1840 PREFIXED    ADD #1,S                ;1
1841             SUB #1,TOS              ;1 -- c-addr ud=0 x count   S=adr+1 TOS=count-1
1842             MOV.B @S,W              ;2                          X=2th char, W=adr
1843             SUB.B #',',W            ;2
1844 QSIGN       CMP.B #1,W              ;1
1845             JNZ TONUMLOOP           ;2                          for positive number and for , or . process
1846             MOV #-1,2(RSP)          ;3                          R-- IP sign base
1847             JMP TONUMPLUS           ;2
1848 ; ----------------------------------; 39
1849 QNUMNEXT    FORTHtoASM              ;  -- c-addr ud2lo-hi addr2 cnt2    R-- IP sign BASE    S=addr2
1850             CMP #0,TOS              ;1                                  cnt2=0 : conversion is ok ?
1851             JZ QNUMNEXT1            ;2                                  yes
1852             BIT #UF9,SR             ;2                                  already flagged double ?
1853                                     ;                                   ( test to discard repeated points or repeated commas)
1854             JNZ QNUMNEXT1           ;2                                  abort
1855             BIS #UF9,SR             ;2                                  set double number flag
1856
1857     .IFDEF FIXPOINT_INPUT
1858
1859 QQNUMDP     CMP.B #'.',0(S)         ;4                                  rejected char by >NUMBER = decimal point ?
1860             JNZ QQcomma             ;2                                  no
1861             SUB #2,IP               ;1                                  yes: reset QNUMNEXT address as >NUMBER return
1862             JMP TONUMPLUS           ;2                                      loop back to >NUMBER to terminate conversion
1863 QQcomma     CMP.B #',',0(S)         ;5                                  rejected char by >NUMBER is a comma ?
1864             JNZ QNUMNEXT1           ;2                                  no
1865 S15Q16      MOV TOS,W               ;1 -- c-addr ud2lo x x x            yes   W=cnt2
1866             MOV #0,X                ;1 -- c-addr ud2lo x 0 x            init X = ud2lo' = 0
1867 S15Q16LOOP  MOV X,2(PSP)            ;3 -- c-addr ud2lo ud2lo' ud2lo' x  0(PSP) = ud2lo'
1868             SUB.B #1,W              ;1                                  decrement cnt2
1869             MOV W,X                 ;1                                  X = cnt2-1
1870             ADD S,X                 ;1                                  X = end_of_string-1, first...
1871             MOV.B @X,X              ;2                                  X = last char of string, first...
1872             SUB #30h,X              ;2                                  char --> digit conversion
1873             CMP.B #10,X             ;2
1874             JLO QS15Q16DIGI         ;2
1875             SUB.B #7,X              ;2
1876             CMP.B #10,X             ;2
1877             JLO S15Q16EOC           ;2
1878 QS15Q16DIGI CMP T,X                 ;1                                  R-- IP sign BASE    is X a digit ?
1879             JHS S15Q16EOC           ;2 -- c-addr ud2lo ud2lo' x ud2lo'  if no
1880             MOV X,0(PSP)            ;3 -- c-addr ud2lo ud2lo' digit x
1881             MOV T,TOS               ;1 -- c-addr ud2lo ud2lo' digit     base R-- IP sign base
1882             .word 152Ch             ;6                                  PUSH S,T,W: R-- IP sign base addr2 base cnt2
1883             CALL #MUSMOD            ;4 -- c-addr ud2lo ur uqlo uqhi
1884             .word 172Ah             ;6                                  restore W,T,S: R-- IP sign BASE
1885             JMP S15Q16LOOP          ;2                                  W=cnt
1886 S15Q16EOC   MOV 4(PSP),2(PSP)       ;5 -- c-addr ud2lo ud2hi uqlo x     ud2lo from >NUMBER part1 becomes here ud2hi=S15 part2
1887             MOV @PSP,4(PSP)         ;4 -- c-addr ud2lo ud2hi x x        uqlo becomes ud2lo
1888             MOV W,TOS               ;1 -- c-addr ud2lo ud2hi x cnt2
1889             CMP.B #0,TOS            ;1                                  TOS = 0 if end of conversion char = ',' (happy end)
1890
1891     .ELSE ; no FIXPOINT_INPUT
1892
1893 QQNUMDP     CMP.B #'.',0(S)         ;4                                  rejected char by >NUMBER = decimal point ?
1894             JNZ QNUMNEXT1           ;2                                  no
1895             SUB #2,IP               ;1                                  yes: set QNUMNEXT address as >NUMBER return
1896             JMP TONUMPLUS           ;2                                      loop back to >NUMBER to terminate conversion
1897
1898     .ENDIF
1899
1900 ; ----------------------------------;88
1901 QNUMNEXT1   POPM #3,IP              ;4 -- c-addr ud2lo-hi x cnt2        POPM T,S,IP  S = sign flag = {-1;0}
1902             MOV S,TOS               ;1 -- c-addr ud2lo-hi x sign
1903             MOV T,&BASE             ;3
1904             JZ QNUMOK               ;2 -- c-addr ud2lo-hi x sign        conversion OK
1905 QNUMKO      ADD #6,PSP              ;1 -- c-addr sign
1906             AND #0,TOS              ;1 -- c-addr ff                     TOS=0 and Z=1 ==> conversion ko
1907             mNEXT                   ;4
1908 ; ----------------------------------;97
1909 QNUMOK      ADD #2,PSP              ;1 -- c-addr ud2lo-hi cnt2
1910             MOV 2(PSP),4(PSP)       ;  -- udlo udlo udhi sign
1911             MOV @PSP+,0(PSP)        ;4 -- udlo udhi sign              note : PSP is incremented before write back !!!
1912             XOR #-1,TOS             ;1 -- udlo udhi inv(sign)
1913             JNZ QDOUBLE             ;2                      if jump : TOS=-1 and Z=0 ==> conversion ok
1914 Q2NEGATE    XOR #-1,TOS             ;1 -- udlo udhi tf
1915             XOR #-1,2(PSP)          ;3 -- dlo-1 dhi-1 tf
1916             XOR #-1,0(PSP)          ;3 -- dlo-1 udhi tf
1917             ADD #1,2(PSP)           ;3 -- dlo dhi-1 tf
1918             ADDC #0,0(PSP)          ;3 -- dlo dhi tf
1919 QDOUBLE     BIT #UF9,SR             ;2                      decimal point added ?
1920             JNZ QNUMEND             ;2                      leave double
1921             ADD #2,PSP              ;1                      leave number
1922 QNUMEND    mNEXT                    ;4                      TOS=-1 and Z=0 ==> conversion ok
1923 ; ----------------------------------;119 words
1924
1925     .ELSE ; no hardware HRDWMPY
1926
1927 ; T.I. SIGNED MULTIPLY SUBROUTINE: U1 x U2 -> Ud
1928
1929 ;https://forth-standard.org/standard/core/UMTimes
1930 ;C UM*     u1 u2 -- ud   unsigned 16x16->32 mult.
1931             FORTHWORD "UM*"
1932 UMSTAR      MOV @PSP,S              ;2 MDlo
1933 UMSTAR1     MOV #0,T                ;1 MDhi=0
1934             MOV #0,X                ;1 RES0=0
1935             MOV #0,Y                ;1 RES1=0
1936             MOV #1,W                ;1 BIT TEST REGISTER
1937 UMSTARLOOP  BIT W,TOS               ;1 TEST ACTUAL BIT MRlo
1938             JZ UMSTARNEXT           ;2 IF 0: DO NOTHING
1939             ADD S,X                 ;1 IF 1: ADD MDlo TO RES0
1940             ADDC T,Y                ;1      ADDC MDhi TO RES1
1941 UMSTARNEXT  ADD S,S                 ;1 (RLA LSBs) MDlo x 2
1942             ADDC T,T                ;1 (RLC MSBs) MDhi x 2
1943             ADD W,W                 ;1 (RLA) NEXT BIT TO TEST
1944             JNC UMSTARLOOP          ;2 IF BIT IN CARRY: FINISHED    10~ loop
1945             MOV X,0(PSP)            ;3 low result on stack
1946             MOV Y,TOS               ;1 high result in TOS
1947             mNEXT                   ;4 17 words
1948
1949 ;https://forth-standard.org/standard/core/toNUMBER
1950 ;C  convert a string to double number until count2 = 0 or until not convertible char
1951 ;C >NUMBER  ud1lo|ud1hi addr1 count1 -- ud2lo|ud2hi addr2 count2
1952             FORTHWORD ">NUMBER"
1953 TONUMBER    MOV @PSP,S              ;                           S=adr
1954             MOV TOS,T               ;                           T=count
1955 TONUMLOOP   MOV.B @S,X              ; -- ud1lo ud1hi x x        X=char
1956 DDIGITQ     SUB.B #30h,  X          ;2                          skip all chars < '0'
1957             CMP.B #10,X             ;                           char was > "9" ?
1958             JLO DDIGITQNEXT         ; -- ud1lo ud1hi x x        no: good end
1959             SUB.B #07,X             ;2                          skip all chars between "9" and "A"
1960             CMP.B #10,X             ;2                          char was < "A" ?
1961             JLO TONUMEND            ;2                          yes: bad end
1962 DDIGITQNEXT CMP &BASE,X             ; -- ud1lo ud1hi x x        digit-base
1963             JHS TONUMEND            ; U>=
1964 UDSTAR      .word 154Dh             ; -- ud1lo ud1hi x x        R-- IP adr count x digit        PSUHM IP,S,T,W,X
1965             MOV 2(PSP),S            ; -- ud1lo ud1hi x x        S=ud1hi
1966             MOV &BASE,TOS           ; -- ud1lo ud1hi x base
1967             MOV #UMSTARNEXT1,IP     ;
1968 UMSTARONE   JMP UMSTAR1             ; ud1hi * base -- x ud3hi   X=ud3lo
1969 UMSTARNEXT1 FORTHtoASM              ; -- ud1lo ud1hi x ud3hi
1970             MOV X,2(RSP)            ;                           R-- IP adr count ud3lo digit
1971             MOV 4(PSP),S            ; -- ud1lo ud1hi x ud3hi    S=ud1lo
1972             MOV &BASE,TOS           ; -- ud1lo ud1hi x base
1973             MOV #UMSTARNEXT2,IP     ;
1974 UMSTARTWO   JMP UMSTAR1             ; ud1lo * base -- x ud4hi   X=ud4lo
1975 UMSTARNEXT2 FORTHtoASM              ; -- ud1lo ud1hi x ud4hi    r-- IP adr count ud3lo digit
1976             ADD @RSP+,X             ; -- ud1lo ud1hi x ud4hi    X = ud4lo+digit = ud2lo
1977 MPLUS       ADDC @RSP+,TOS          ; -- ud1lo ud1hi x ud2hi    TOS = ud4hi+ud3lo+carry = ud2hi
1978             MOV X,4(PSP)            ; -- ud2lo ud1hi x ud2hi
1979             MOV TOS,2(PSP)          ; -- ud2lo ud2hi x x        R-- IP adr count
1980             POPM #3,IP              ; -- ud2lo ud2hi x x        T=count, S=adr  POPM T,S,IP
1981 TONUMPLUS   ADD #1,S                ;
1982             SUB #1,T                ;
1983             JNZ TONUMLOOP           ; -- ud2lo ud2hi x x        S=adr+1, T=count-1, X=ud2lo
1984 TONUMEND    MOV S,0(PSP)            ; -- ud2lo ud2hi adr2 count2
1985             MOV T,TOS               ; -- ud2lo ud2hi adr2 count2
1986             mNEXT                   ; 46 words
1987
1988 ; convert a string to a signed number
1989 ;Z ?NUMBER  c-addr -- n -1      if convert ok ; flag Z=0
1990 ;Z          c-addr -- c-addr 0  if convert ko ; flag Z=1
1991 ; FORTH 2012 prefixes $, %, # are recognised
1992 ; 32 bits numbers (with decimal point) are recognised
1993 ; with FIXPOINT_INPUT switched ON, fixed point signed numbers (with a comma) are recognised.
1994 ; prefixes # % $ - are processed before calling >NUMBER, decimal point and comma are >NUMBER exits
1995 ;            FORTHWORD "?NUMBER"
1996 QNUMBER     MOV #0,S                ;1
1997             MOV &BASE,T             ;3          T=BASE
1998             BIC #UF9,SR             ;2          reset flag UF9 used here as decimal point flag
1999             .word 152Dh             ;5          R-- IP sign base
2000             MOV #QNUMNEXT,IP        ;2          define >NUMBER return
2001             SUB #8,PSP              ;1 -- x x x x c-addr
2002             MOV TOS,6(PSP)          ;3 -- c-addr x x x c-addr
2003             MOV #0,4(PSP)           ;3
2004             MOV #0,2(PSP)           ;3 -- c-addr ud=0 x c-addr
2005             MOV TOS,S               ;1
2006             MOV.B @S+,T             ;2 -- c-addr ud=0 x x   S=adr, T=count
2007             MOV.B @S,X              ;2                      X=char
2008             SUB.B #',',X            ;2
2009             JHS QSIGN               ;2                      for current base, and for ',' or '.' process
2010             SUB.B #1,X              ;1
2011 QBINARY     MOV #2,&BASE            ;3                      preset base 2
2012             ADD.B #8,X              ;1                      '%' + 8 = '-'   binary number ?
2013             JZ PREFIXED             ;2
2014 QDECIMAL    ADD #8,&BASE            ;4
2015             ADD.B #2,X              ;1                      '#' + 2 = '%'   decimal number ?
2016             JZ PREFIXED             ;2
2017 QHEXA       MOV #16,&BASE           ;4
2018             SUB.B #1,X              ;2                      '$' - 1 = '#'   hex number ?
2019             JNZ TONUMLOOP           ;2 -- c-addr ud=0 x x   other cases will cause error
2020 PREFIXED    ADD #1,S                ;1
2021             SUB #1,T                ;1 -- c-addr ud=0 x x   S=adr+1 T=count-1
2022             MOV.B @S,X              ;2                      X=2th char, W=adr
2023             SUB.B #',',X            ;2
2024 QSIGN       CMP.B #1,X              ;1
2025             JNZ TONUMLOOP           ;2                      for positive number and for , or . process
2026             MOV #-1,2(RSP)          ;3                      R-- IP sign base
2027             JMP TONUMPLUS           ;2
2028 ; ----------------------------------;45
2029 QNUMNEXT    FORTHtoASM              ;  -- c-addr ud2lo-hi addr2 cnt2    R-- IP sign BASE    S=addr2,T=cnt2
2030             CMP #0,TOS              ;1                                  cnt2=0 ? conversion is ok ?
2031             JZ QNUMNEXT1            ;2                                  yes
2032             BIT #UF9,SR             ;2                                  already flagged double ?
2033                                     ;                                   ( test to discard repeated points or repeated commas)
2034             JNZ QNUMNEXT1           ;2                                  abort
2035             BIS #UF9,SR             ;2                                  set double number flag
2036 ; ----------------------------------;
2037
2038     .IFDEF FIXPOINT_INPUT
2039
2040 QNUMDP      CMP.B #'.',0(S)         ;4                                  rejected char by >NUMBER is a decimal point ?
2041             JNZ QS15Q16             ;2                                  no
2042 QNUMDPFOUND SUB #2,IP               ;1                                      set >NUMBER return address
2043             JMP TONUMPLUS           ;2                                      to terminate conversion
2044 QS15Q16     CMP.B #',',0(S)         ;5                                  rejected char by >NUMBER is a comma ?
2045             JNZ QNUMNEXT1           ;2                                  no
2046 S15Q16      MOV T,W                 ;1 -- c-addr ud2lo x x x            W=cnt2
2047             MOV &BASE,T             ;3                                  T=current base
2048             MOV #0,X                ;1 -- c-addr ud2lo x 0 x            init ud2lo' = 0
2049 S15Q16LOOP  MOV X,2(PSP)            ;3 -- c-addr ud2lo ud2lo' ud2lo' x  X = 0(PSP) = ud2lo'
2050             SUB.B #1,W              ;1                                  decrement cnt2
2051             MOV W,X                 ;1                                  X = cnt2-1
2052             ADD S,X                 ;1                                  X = end_of_string-1, first...
2053             MOV.B @X,X              ;2                                  X = last char of string, first...
2054             SUB #30h,X              ;2                                  char --> digit conversion
2055             CMP.B #10,X             ;2
2056             JLO QS15Q16DIGI         ;2
2057             SUB.B #7,X              ;2
2058             CMP.B #10,X             ;2
2059             JLO S15Q16EOC           ;2
2060 QS15Q16DIGI CMP T,X                 ;1                                  R-- IP sign BASE    is X a digit ?
2061             JHS S15Q16EOC           ;2 -- c-addr ud2lo ud2lo' x ud2lo'  if no
2062             MOV X,0(PSP)            ;3 -- c-addr ud2lo ud2lo' digit x
2063             MOV T,TOS               ;1 -- c-addr ud2lo ud2lo' digit     base R-- IP sign base
2064             .word 152Ch             ;6                                  PUSH S,T,W: R-- IP sign base addr2 base cnt2
2065             CALL #MUSMOD            ;4 -- c-addr ud2lo ur uqlo uqhi
2066             .word 172Ah             ;6                                  restore W,T,S: R-- IP sign BASE
2067             JMP S15Q16LOOP          ;2                                  W=cnt
2068 S15Q16EOC   MOV 4(PSP),2(PSP)       ;5 -- c-addr ud2lo ud2lo uqlo x     ud2lo from >NUMBER part1 becomes here ud2hi=S15 part2
2069             MOV @PSP,4(PSP)         ;4 -- c-addr ud2lo ud2hi x x        uqlo becomes ud2lo
2070             MOV W,TOS               ;1 -- c-addr ud2lo ud2hi x cnt2
2071             CMP.B #0,TOS            ;1                                  TOS = 0 if end of conversion char = ',' (happy end)
2072
2073     .ELSE ; no FIXPOINT_INPUT
2074
2075 QNUMDP      CMP.B #'.',0(S)         ;4                                  rejected char by >NUMBER is a decimal point ?
2076             JNZ QNUMNEXT1           ;2                                  no
2077 QNUMDPFOUND SUB #2,IP               ;1                                      set >NUMBER return address
2078             JMP TONUMPLUS           ;2                                      to terminate conversion
2079
2080     .ENDIF
2081
2082 ; ----------------------------------;97
2083 QNUMNEXT1   POPM #3,IP              ;4 -- c-addr ud2lo-hi x cnt2        POPM T,S,IP   S = sign flag = {-1;0}
2084             MOV S,TOS               ;1 -- c-addr ud2lo-hi x sign
2085             MOV T,&BASE             ;3
2086             JZ QNUMOK               ;2 -- c-addr ud2lo-hi x sign        conversion OK
2087 QNUMKO      ADD #6,PSP              ;1 -- c-addr sign
2088             AND #0,TOS              ;1 -- c-addr ff                     TOS=0 and Z=1 ==> conversion ko
2089             mNEXT                   ;4
2090 ; ----------------------------------;
2091 QNUMOK      ADD #2,PSP              ;1 -- c-addr ud2lo-hi sign
2092             MOV 2(PSP),4(PSP)       ;  -- udlo udlo udhi sign
2093             MOV @PSP+,0(PSP)        ;4 -- udlo udhi sign                note : PSP is incremented before write back !!!
2094             XOR #-1,TOS             ;1 -- udlo udhi inv(sign)
2095             JNZ QDOUBLE             ;2                                  if jump : TOS=-1 and Z=0 ==> conversion ok
2096 Q2NEGATE    XOR #-1,TOS             ;1 -- udlo udhi tf
2097             XOR #-1,2(PSP)          ;3 -- dlo-1 dhi-1 tf
2098             XOR #-1,0(PSP)          ;3 -- dlo-1 udhi tf
2099             ADD #1,2(PSP)           ;3 -- dlo dhi-1 tf
2100             ADDC #0,0(PSP)          ;3 -- dlo dhi tf
2101 QDOUBLE     BIT #UF9,SR             ;2      decimal point added ?
2102             JNZ QNUMEND             ;2      leave double
2103             ADD #2,PSP              ;1      leave number
2104 QNUMEND     mNEXT                   ;4                           TOS=-1 and Z=0 ==> conversion ok
2105 ; ----------------------------------;128 words
2106
2107     .ENDIF ; HRDWMPY
2108
2109 ;https://forth-standard.org/standard/core/EXECUTE
2110 ;C EXECUTE   i*x xt -- j*x   execute Forth word at 'xt'
2111             FORTHWORD "EXECUTE"
2112 EXECUTE     MOV TOS,W               ; 1 put word address into W
2113             MOV @PSP+,TOS           ; 2 fetch new TOS
2114             MOV W,PC                ; 3 fetch code address into PC
2115
2116 ;https://forth-standard.org/standard/core/Comma
2117 ;C ,    x --           append cell to dict
2118             FORTHWORD ","
2119 COMMA       MOV &DDP,W              ;3
2120             ADD #2,&DDP             ;3
2121             MOV TOS,0(W)            ;3
2122             MOV @PSP+,TOS           ;2
2123             mNEXT                   ;4 15~
2124
2125 ;https://forth-standard.org/standard/core/LITERAL
2126 ;C LITERAL  (n|d) --        append single numeric literal if compiling state
2127 ;           (n|d) --        append double numeric literal if compiling state and if UF9<>0 (not ANS)
2128             FORTHWORDIMM "LITERAL"  ; immediate
2129 LITERAL     CMP #0,&STATE           ;3
2130             JZ LITERALEND           ;2 if not immediate, leave n|d on the stack
2131 LITERAL1    MOV &DDP,W              ;3
2132             ADD #4,&DDP             ;3
2133             MOV #lit,0(W)           ;4
2134             MOV TOS,2(W)            ;3
2135             MOV @PSP+,TOS           ;2
2136             BIT #UF9,SR             ;2
2137             BIC #UF9,SR             ;2
2138             JNZ LITERAL1            ;2
2139 LITERALEND  mNEXT                   ;4 30~
2140
2141 ;https://forth-standard.org/standard/core/COUNT
2142 ;C COUNT   c-addr1 -- adr len   counted->adr/len
2143             FORTHWORD "COUNT"
2144 COUNT       SUB #2,PSP              ;1
2145             ADD #1,TOS              ;1
2146             MOV TOS,0(PSP)          ;3
2147             MOV.B -1(TOS),TOS       ;3
2148             mNEXT                   ;4 15~
2149
2150 ; : SETIB SOURCE 2! 0 >IN ! ;       ; org len --        set Input Buffer, shared by INTERPRET and [ELSE]
2151 SETIB       MOV #0,&TOIN            ;
2152             MOV TOS,&SOURCE_LEN     ; -- org len
2153             MOV @PSP+,&SOURCE_ADR   ; -- len
2154             MOV @PSP+,TOS           ; --
2155             mNEXT                   ;
2156
2157 ;C INTERPRET    i*x addr u -- j*x      interpret given buffer
2158 ; This is the common factor of EVALUATE and QUIT.
2159 ; set addr u as input buffer then parse it word by word
2160 INTERPRET   mDOCOL                  ;
2161             .word   SETIB           ;               set Input buffer pointers SOURCE_LEN, SOURCE_ORG clear >IN
2162 INTLOOP     .word   FBLANK,WORDD    ; -- c-addr     Z = End Of Line
2163             FORTHtoASM              ;
2164             MOV #INTFINDNEXT,IP     ;2              define INTFINDNEXT as FIND return
2165             JNZ FIND                ;2              if EOL not reached
2166             JMP DROPEXIT            ;               if EOL reached
2167
2168 INTFINDNEXT FORTHtoASM              ; -- c-addr fl  Z = not found
2169             MOV TOS,W               ;               W = flag =(-1|0|+1)  as (normal|not_found|immediate)
2170             MOV @PSP+,TOS           ; -- c-addr
2171             MOV #INTQNUMNEXT,IP     ;2              define QNUMBER return
2172             JZ QNUMBER              ;2 c-addr --    if not found search a number
2173             MOV #INTLOOP,IP         ;2              define (EXECUTE | COMMA) return
2174             XOR &STATE,W            ;3
2175             JZ COMMA                ;2 c-addr --    if W xor STATE = 0 compile xt then loop back to INTLOOP
2176             JNZ EXECUTE             ;2 c-addr --    if W xor STATE <>0 execute xt then loop back to INTLOOP
2177
2178 INTQNUMNEXT FORTHtoASM              ;  -- n|c-addr fl   Z = not a number, SR(UF9) double number request
2179             MOV @PSP+,TOS           ;2
2180             MOV #INTLOOP,IP         ;2 -- n|c-addr  define LITERAL return
2181             JNZ LITERAL             ;2 n --         execute LITERAL then loop back to INTLOOP
2182 NotFoundExe ADD.B #1,0(TOS)         ;3 c-addr --    Not a Number : incr string count to add '?'
2183             MOV.B @TOS,Y            ;2
2184             ADD TOS,Y               ;1
2185             MOV.B #'?',0(Y)         ;5              add '?' to end of word string
2186             MOV #FQABORTYES,IP      ;2              define COUNT return
2187             JMP COUNT               ;2 -- addr len  36 words
2188
2189 ;https://forth-standard.org/standard/core/EVALUATE
2190 ; EVALUATE          \ i*x c-addr u -- j*x  interpret string
2191             FORTHWORD "EVALUATE"
2192 EVALUATE    MOV #SOURCE_LEN,X       ;2
2193             MOV @X+,S               ;2 S = SOURCE_LEN
2194             MOV @X+,T               ;2 T = SOURCE_ADR
2195             MOV @X+,W               ;2 W = TOIN
2196             PUSHM #4,IP             ;6 PUSHM IP,S,T,W
2197             ASMtoFORTH
2198             .word   INTERPRET
2199             FORTHtoASM
2200             MOV @RSP+,&TOIN         ;4
2201             MOV @RSP+,&SOURCE_ADR   ;4
2202             MOV @RSP+,&SOURCE_LEN   ;4
2203             MOV @RSP+,IP            ;2
2204             mNEXT
2205
2206     .IFDEF BOOTLOAD ; Boot loader requires Conditional Compilation
2207 ;c BOOT  --  jump to bootstrap then continues with (QUIT)
2208         FORTHWORD "BOOT"
2209 BOOT    MOV #RSTACK,RSP
2210         MOV #LSTACK,&LEAVEPTR
2211         MOV #0,&STATE
2212 ; ----------------------------------;
2213 ; BOOTSTRAP TEST                    ;
2214 ; ----------------------------------;
2215     CMP #0,&SAVE_SYSRSTIV           ; if WARM
2216     JZ QUIT0                        ; no boostrap
2217     BIT.B #SD_CD,&SD_CDIN           ; SD_memory in SD_Card module ?
2218     JNZ QUIT0                       ; no
2219 ; ----------------------------------;
2220 ; BOOTSTRAP                         ; on SYSRSTIV <> 0
2221 ; ----------------------------------;
2222     SUB #2,PSP                      ;
2223     MOV TOS,0(PSP)                  ;
2224     MOV &SAVE_SYSRSTIV,TOS          ;
2225     MOV #0,&SAVE_SYSRSTIV           ;
2226     ASMtoFORTH                      ;
2227     .IFDEF QUIETBOOT
2228     .word NOECHO                    ; warning ! your BOOT.4TH must to be finished with ECHO command!
2229     .ENDIF
2230     .word XSQUOTE                   ; -- addr u
2231     .byte 15,"LOAD\34 BOOT.4TH\34"  ; issues error 2 if no such file...
2232     .word BRAN,QUIT4                ;
2233 ; ----------------------------------;
2234
2235 ;https://forth-standard.org/standard/core/QUIT
2236 ;c QUIT  --     interpret line by line the input stream, primary DEFERred word
2237         FORTHWORD "QUIT"
2238 QUIT    MOV @PC+,PC
2239         .word   BODYQUIT           ; this word may be replaced by BOOT
2240 BODYQUIT
2241
2242     .ELSE ; no BOOTLOADER, QUIT is not DEFERred
2243 ;https://forth-standard.org/standard/core/QUIT
2244 ;c QUIT  --     interpret line by line the input stream
2245         FORTHWORD "QUIT"
2246 QUIT
2247
2248             MOV #RSTACK,RSP
2249             MOV #LSTACK,&LEAVEPTR
2250             MOV #0,&STATE
2251     .ENDIF
2252 QUIT0       MOV #0,&SAVE_SYSRSTIV   ;
2253             ASMtoFORTH
2254 QUIT1       .word   XSQUOTE
2255             .byte   5,13,10,"ok "   ; CR+LF + Forth prompt
2256 QUIT2       .word   TYPE            ; display it
2257             .word   REFILL
2258 QUIT3       .word   SPACE
2259 QUIT4       .word   INTERPRET
2260             .word   DEPTH,ZEROLESS
2261             .word   XSQUOTE
2262             .byte   13,"stack empty! "
2263             .word   QABORT
2264             .word   lit,FRAM_FULL,HERE,ULESS
2265             .word   XSQUOTE
2266             .byte   11,"FRAM full! "
2267             .word   QABORT
2268             .word   FSTATE,FETCH
2269             .word   QBRAN,QUIT1     ; case of interpretion state
2270             .word   XSQUOTE         ; case of compilation state
2271             .byte   5,13,10,"   "   ; CR+LF + 3 blanks
2272             .word   BRAN,QUIT2
2273
2274 ;https://forth-standard.org/standard/core/ABORT
2275 ;C ABORT    i*x --   R: j*x --   clear stack & QUIT
2276             FORTHWORD "ABORT"
2277 ABORT       MOV #PSTACK,PSP
2278             JMP QUIT
2279
2280 WIP_DEFER   ; WIPE resets ALL factory primary DEFERred words
2281             MOV #BODYWARM,&WARM+2      ; (WARM) is WARM    kill user interrupts init
2282             MOV #BODYSLEEP,&SLEEP+2    ; (SLEEP) is SLEEP  kill user background task
2283 QAB_DEFER   ; QABORT resets some primary DEFERred words
2284             MOV #BODYEMIT,&EMIT+2      ;4 (EMIT) is EMIT   default console output
2285             MOV #BODYCR,&CR+2          ;4 (CR) is CR       default CR
2286             MOV #BODYKEY,&KEY+2        ;4 (KEY) is KEY     default KEY
2287
2288     .IFDEF DEFER_INPUT                  ;  true if SD_LOADER
2289             MOV #TIB_ORG,&FCIB+2        ;4 TIB is CIB  (Current Input Buffer)
2290             MOV #BODYACCEPT,&ACCEPT+2  ;4 (ACCEPT) is ACCEPT
2291     .ENDIF
2292     .IFDEF MSP430ASSEMBLER          ; reset all branch labels
2293             MOV #10,Y
2294             MOV Y,&BASE
2295 RAZASM      MOV #0,ASMFW1(Y)
2296             SUB #2,Y
2297             JHS RAZASM
2298     .ELSE
2299             MOV #10,&BASE           ;4
2300     .ENDIF
2301             MOV #10,&BASE           ;4
2302             RET
2303
2304 RefillUSBtime .equ int(frequency*2730) ; 2730*frequency ==> 65520 @ max freq (24MHz)
2305
2306 ;Z ?ABORT   f c-addr u --      abort & print msg
2307 ;            FORTHWORD "?ABORT"
2308 QABORT      CMP #0,2(PSP)           ; -- f c-addr u         flag test
2309             JNZ QABORTYES
2310 THREEDROP   ADD #4,PSP
2311             MOV @PSP+,TOS
2312             mNEXT
2313
2314 QABORTYES   MOV #4882h,&YEMIT       ;                       restore default YEMIT = set ECHO
2315
2316     .IFDEF SD_CARD_LOADER           ; close all handles
2317             MOV &CurrentHdl,T
2318 QABORTCLOSE CMP #0,T
2319             JZ QABORTCLOSEND
2320             MOV.B #0,HDLB_Token(T)
2321             MOV @T,T
2322             JMP QABORTCLOSE
2323 QABORTCLOSEND
2324
2325     .ENDIF
2326 ; ----------------------------------;
2327 QABORTYESNOECHO                     ; <== WARM jumps here, thus, if NOECHO, TERMINAL can be disconnected without freezing the app
2328 ; ----------------------------------;
2329             CALL #QAB_DEFER         ; restore default part of primary DEFERred words ....except WARM and SLEEP.
2330 ; ----------------------------------;
2331 QABORTTERM                          ; wait the end of source file downloading
2332 ; ----------------------------------;
2333     .IFDEF TERMINAL3WIRES           ;
2334             BIT #UCTXIFG,&TERMIFG   ; TX buffer empty ?
2335             JZ QABORTTERM           ; no
2336             MOV #17,&TERMTXBUF      ; yes move XON char into TX_buf
2337     .ENDIF                          ;
2338     .IFDEF TERMINAL4WIRES           ;
2339             BIC.B #RTS,&HANDSHAKOUT ; set /RTS low (connected to /CTS pin of UARTtoUSB bridge)
2340     .ENDIF                          ;
2341 QABORTLOOP  BIC #UCRXIFG,&TERMIFG   ; reset TERMIFG(UCRXIFG)
2342             MOV #RefillUSBtime,Y    ; 2730*36 = 98 ms : PL2303TA seems to be the slower USB device to refill its TX buffer.
2343 QABUSBLOOPJ MOV #8,X                ; 1~        <-------+
2344 QABUSBLOOPI NOP                     ; 1~        <---+   |
2345             SUB #1,X                ; 1~            |   |
2346             JNZ QABUSBLOOPI         ; 2~ > 4~ loop -+   |
2347             SUB #1,Y                ; 1~                |
2348             JNZ QABUSBLOOPJ         ; 2~ --> 36~ loop --+
2349             BIT #UCRXIFG,&TERMIFG   ; 4 new char in TERMXBUF after refill time out ?
2350             JNZ QABORTLOOP          ; 2 yes, the input stream (download source file) is still active
2351 ; ----------------------------------;
2352 ; Display WARM/ABORT message        ;   no, the input stream is quiet (end of download source file)
2353 ; ----------------------------------;
2354             mDOCOL                  ;
2355             .word   XSQUOTE         ; -- c-addr u c-addr1 u1
2356             .byte   4,27,"[7m"      ;
2357             .word   TYPE            ; -- c-addr u       set reverse video
2358 ERRLINE     .word   lit,LINE,FETCH,QDUP;       if LINE <> 0
2359             .word   QBRAN,ERRLINE_END
2360             .word   XSQUOTE         ;       displays the line where error occured
2361             .byte   5,"line:"       ;
2362             .word   TYPE            ;
2363             .word   ONEMINUS,UDOT   ;
2364             .word   ECHO            ;
2365 ERRLINE_END .word   TYPE            ; --                type abort message
2366             .word   XSQUOTE         ; -- c-addr2 u2
2367             .byte   4,27,"[0m"      ;
2368             .word   TYPE            ; --                set normal video
2369 ; ----------------------------------;
2370             .word   PWR_STATE       ; remove all words beyond PWR_HERE
2371     .IFDEF LOWERCASE                ;
2372             .word   CAPS_ON         ;
2373     .ENDIF                          ;
2374             .word   ABORT           ; no return
2375 ; ----------------------------------;
2376
2377 ;https://forth-standard.org/standard/core/ABORTq
2378 ;C ABORT"  i*x flag -- i*x   R: j*x -- j*x  flag=0
2379 ;C         i*x flag --       R: j*x --      flag<>0
2380             FORTHWORDIMM "ABORT\34"        ; immediate
2381 ABORTQUOTE  mDOCOL
2382             .word   SQUOTE
2383             .word   lit,QABORT,COMMA
2384             .word   EXIT
2385
2386 ;https://forth-standard.org/standard/core/Tick
2387 ;C '    -- xt           find word in dictionary and leave on stack its execution address
2388             FORTHWORD "'"
2389 TICK        mDOCOL          ; separator -- xt
2390             .word   FBLANK,WORDD,FIND    ; Z=1 if not found
2391             .word   QBRAN,NotFound
2392             .word   EXIT
2393 NotFound    .word   NotFoundExe          ; in INTERPRET
2394
2395 ;https://forth-standard.org/standard/block/bs
2396 ; \         --      backslash
2397 ; everything up to the end of the current line is a comment.
2398             FORTHWORDIMM "\\"      ; immediate
2399 BACKSLASH   MOV &SOURCE_LEN,&TOIN       ;
2400             mNEXT
2401
2402 ;-------------------------------------------------------------------------------
2403 ; COMPILER
2404 ;-------------------------------------------------------------------------------
2405
2406 ;https://forth-standard.org/standard/core/Bracket
2407 ;C [        --      enter interpretative state
2408                 FORTHWORDIMM "["    ; immediate
2409 LEFTBRACKET     MOV #0,&STATE
2410                 mNEXT
2411
2412 ;https://forth-standard.org/standard/core/right-bracket
2413 ;C ]        --      enter compiling state
2414                 FORTHWORD "]"
2415 RIGHTBRACKET    MOV  #-1,&STATE
2416                 mNEXT
2417
2418 ;https://forth-standard.org/standard/core/BracketTick
2419 ;C ['] <name>        --         find word & compile it as literal
2420             FORTHWORDIMM "[']"      ; immediate word, i.e. word executed during compilation
2421 BRACTICK    mDOCOL
2422             .word   TICK            ; get xt of <name>
2423             .word   lit,lit,COMMA   ; append LIT action
2424             .word   COMMA,EXIT      ; append xt literal
2425
2426 ;https://forth-standard.org/standard/core/DEFERStore
2427 ;C DEFER!       xt CFA_DEFER --     ; store xt to the address after DODEFER
2428 ;                FORTHWORD "DEFER!"
2429 DEFERSTORE  MOV @PSP+,2(TOS)        ; -- CFA_DEFER          xt --> [CFA_DEFER+2]
2430             MOV @PSP+,TOS           ; --
2431             mNEXT
2432
2433 ;https://forth-standard.org/standard/core/IS
2434 ;C IS <name>        xt --
2435 ; used as is :
2436 ; DEFER DISPLAY                         create a "do nothing" definition (2 CELLS)
2437 ; inline command : ' U. IS DISPLAY      U. becomes the runtime of the word DISPLAY
2438 ; or in a definition : ... ['] U. IS DISPLAY ...
2439 ; KEY, EMIT, CR, ACCEPT and WARM are examples of DEFERred words
2440
2441 ; as IS replaces the PFA value of a "PFA word", it may be also used with VARIABLE and CONSTANT words...
2442
2443             FORTHWORDIMM "IS"       ; immediate
2444 IS          mDOCOL
2445             .word   FSTATE,FETCH
2446             .word   QBRAN,IS_EXEC
2447 IS_COMPILE  .word   BRACTICK             ; find the word, compile its CFA as literal
2448             .word   lit,DEFERSTORE,COMMA ; compile DEFERSTORE
2449             .word   EXIT
2450 IS_EXEC     .word   TICK,DEFERSTORE     ; find the word, leave its CFA on the stack and execute DEFERSTORE
2451             .word   EXIT
2452
2453 ;https://forth-standard.org/standard/core/IMMEDIATE
2454 ;C IMMEDIATE        --   make last definition immediate
2455             FORTHWORD "IMMEDIATE"
2456 IMMEDIATE   MOV &LAST_NFA,W
2457             BIS.B #80h,0(W)
2458             mNEXT
2459
2460 ;https://forth-standard.org/standard/core/RECURSE
2461 ;C RECURSE  --      recurse to current definition (compile current definition)
2462             FORTHWORDIMM "RECURSE"  ; immediate
2463 RECURSE     MOV &DDP,X              ;
2464             MOV &LAST_CFA,0(X)      ;
2465             ADD #2,&DDP             ;
2466             mNEXT
2467
2468 ;https://forth-standard.org/standard/core/POSTPONE
2469             FORTHWORDIMM "POSTPONE" ; immediate
2470 POSTPONE    mDOCOL
2471             .word   FBLANK,WORDD,FIND,QDUP
2472             .word   QBRAN,NotFound
2473             .word   ZEROLESS        ; immediate ?
2474             .word   QBRAN,POST1     ; yes
2475             .word   lit,lit,COMMA,COMMA
2476             .word   lit,COMMA
2477 POST1       .word   COMMA,EXIT
2478
2479 ;;Z ?REVEAL   --      if no stack mismatch, link this created word in the CURRENT vocabulary
2480 ;            FORTHWORD "REVEAL"
2481 QREVEAL     CMP PSP,&LAST_PSP       ; Check SP with its saved value by :
2482             JZ GOOD_CSP             ; if no stack mismatch.
2483 BAD_CSP     mDOCOL
2484             .word   XSQUOTE
2485             .byte   15,"stack mismatch!"
2486 FQABORTYES  .word   QABORTYES
2487
2488 ;https://forth-standard.org/standard/core/Semi
2489 ;C ;            --      end a colon definition
2490             FORTHWORDIMM ";"        ; immediate
2491 SEMICOLON   CMP #0,&STATE           ; in interpret mode semicolon becomes a comment separator
2492             JZ BACKSLASH            ; tip: ";" is transparent to the preprocessor, so semicolon comments are kept in file.4th
2493             mDOCOL                  ; compile mode
2494             .word   lit,EXIT,COMMA
2495             .word   QREVEAL,LEFTBRACKET,EXIT
2496
2497     .IFDEF NONAME
2498 ;https://forth-standard.org/standard/core/ColonNONAME
2499 ;CE :NONAME        -- xt
2500         FORTHWORD ":NONAME"
2501 COLONNONAME SUB #2,PSP
2502             MOV TOS,0(PSP)
2503             MOV &DDP,TOS
2504             MOV TOS,W
2505             MOV #PAIN,X             ; PAIN is a read only register in all MSP430FRxxxx devices...
2506             MOV X,Y                 ; so, MOV Y,0(X) writes to a read only register = lure for semicolon LAST_THREAD REVEAL...
2507             ADD #2,Y                ; so, MOV @X,-2(Y) writes to same register = lure for semicolon LAST_NFA REVEAL...
2508             CALL #HEADEREND         ; ...because we don't want write preamble of word in dictionnary!
2509     .ENDIF ; NONAME
2510 COLONNEXT
2511     .SWITCH DTC
2512     .CASE 1
2513             MOV #DOCOL1,-4(W)       ; compile CALL rDOCOL
2514             SUB #2,&DDP
2515     .CASE 2
2516             MOV #DOCOL1,-4(W)       ; compile PUSH IP       3~
2517             MOV #DOCOL2,-2(W)       ; compile CALL rEXIT
2518     .CASE 3 ; inlined DOCOL
2519             MOV #DOCOL1,-4(W)       ; compile PUSH IP       3~
2520             MOV #DOCOL2,-2(W)       ; compile MOV PC,IP     1~
2521             MOV #DOCOL3,0(W)        ; compile ADD #4,IP     1~
2522             MOV #NEXT,+2(W)         ; compile MOV @IP+,PC   4~
2523             ADD #4,&DDP
2524     .ENDCASE ; of DTC
2525             MOV #-1,&STATE          ; enter compiling state
2526 SAVE_PSP    MOV PSP,&LAST_PSP       ; save PSP for check compiling, used by QREVEAL
2527 PFA_DEFER   mNEXT
2528
2529 ;https://forth-standard.org/standard/core/Colon
2530 ;C : <name>     --      begin a colon definition
2531             FORTHWORD ":"
2532 COLON       PUSH #COLONNEXT         ; define COLONNEXT as RET for HEADER
2533
2534 ; HEADER        create an header for a new word. Max count of chars = 126
2535 ;               common code for VARIABLE, CONSTANT, CREATE, DEFER, :, MARKER, CODE, ASM.
2536 ;               don't link created word in vocabulary.
2537 HEADER      mDOCOL
2538             .word CELLPLUSALIGN     ;               ALIGN then make room for LFA
2539             .word FBLANK,WORDD      ;
2540             FORTHtoASM              ; -- HERE       HERE is the NFA of this new word
2541             MOV TOS,Y               ;
2542             MOV.B @TOS+,W           ; -- xxx        W=Count_of_chars    Y=NFA
2543             BIS.B #1,W              ; -- xxx        W=count is always odd
2544             ADD.B #1,W              ; -- xxx        W=add one byte for length
2545             ADD Y,W                 ; -- xxx        W=Aligned_CFA
2546             MOV &CURRENT,X          ; -- xxx        X=VOC_BODY of CURRENT    Y=NFA
2547     .SWITCH THREADS
2548     .CASE   1                       ;               nothing to do
2549     .ELSECASE                       ;               multithreading add 5~ 4words
2550             MOV.B @TOS,TOS          ; -- xxx        TOS=first CHAR of new word
2551             AND #(THREADS-1)*2,TOS  ; -- xxx        TOS= Thread offset
2552             ADD TOS,X               ; -- xxx        TOS= Thread   X=VOC_PFAx = thread x of VOC_PFA of CURRENT
2553     .ENDCASE
2554             MOV @PSP+,TOS           ; --
2555             MOV @RSP+,IP
2556             MOV #4030h,0(W)        ;4              by default, HEADER create a DEFERred word: CFA = MOV @PC+,PC = BR...
2557             MOV #PFA_DEFER,2(W)    ;4              by default, HEADER create a DEFERred word: PFA = address of NEXT to do nothing.
2558
2559 HEADEREND   MOV Y,&LAST_NFA         ; --            NFA --> LAST_NFA            used by QREVEAL, IMMEDIATE
2560             MOV X,&LAST_THREAD      ; --            VOC_PFAx --> LAST_THREAD    used by QREVEAL
2561             MOV W,&LAST_CFA         ; --            HERE=CFA --> LAST_CFA       used by DOES>, RECURSE
2562             ADD #4,W                ; --            by default make room for two words...
2563             MOV W,&DDP              ; --
2564             RET                     ; 23 words, W is the new DDP value )
2565                                     ;           X is LAST_THREAD       > used by VARIABLE, CONSTANT, CREATE, DEFER and :
2566                                     ;           Y is NFA               )
2567
2568 ;https://forth-standard.org/standard/core/VARIABLE
2569 ;C VARIABLE <name>       --                      define a Forth VARIABLE
2570             FORTHWORD "VARIABLE"
2571 VARIABLE    CALL #HEADER            ; W = DDP = CFA + 2 words
2572             MOV #DOVAR,-4(W)        ;   CFA = DOVAR
2573             JMP REVEAL              ;   PFA is undefined
2574
2575 ;https://forth-standard.org/standard/core/CONSTANT
2576 ;C CONSTANT <name>     n --                      define a Forth CONSTANT (it's also an alias of VALUE)
2577             FORTHWORD "CONSTANT"
2578 CONSTANT    CALL #HEADER            ; W = DDP = CFA + 2 words
2579             MOV #DOCON,-4(W)        ;   CFA = DOCON
2580             MOV TOS,-2(W)           ;   PFA = n
2581             MOV @PSP+,TOS
2582             JMP REVEAL
2583
2584 ;;https://forth-standard.org/standard/core/VALUE
2585 ;;( x "<spaces>name" -- )                      define a Forth VALUE
2586 ;;Skip leading space delimiters. Parse name delimited by a space.
2587 ;;Create a definition for name with the execution semantics defined below,
2588 ;;with an initial value equal to x.
2589 ;
2590 ;;name Execution: ( -- x )
2591 ;;Place x on the stack. The value of x is that given when name was created,
2592 ;;until the phrase x TO name is executed, causing a new value of x to be assigned to name.
2593 ;
2594 ;            FORTHWORD "VALUE"       ; VALUE is an alias of CONSTANT
2595 ;            JMP CONSTANT
2596 ;
2597 ;;TO name Run-time: ( x -- )
2598 ;;Assign the value x to name.
2599 ;
2600 ;            FORTHWORDIMM "TO"       ; TO is an alias of IS
2601 ;            JMP IS
2602
2603 ; usage : SDIB_ORG IS CIB           ; modify Current_Input_Buffer address to read a SD file sector
2604 ;         ...
2605 ;         TIB_ORG IS CIB            ; restore Terminal_Input_Buffer address as Current_Input_Buffer address
2606
2607 ;https://forth-standard.org/standard/core/CREATE
2608 ;C CREATE <name>        --          define a CONSTANT with its next address
2609 ; Execution: ( -- a-addr )          ; a-addr is the address of name's data field
2610 ;                                   ; the execution semantics of name may be extended by using DOES>
2611             FORTHWORD "CREATE"
2612 CREATE      CALL #HEADER            ; --        W = DDP
2613             MOV #DOCON,-4(W)        ;4  CFA = DOCON
2614             MOV W,-2(W)             ;3  PFA = next address
2615             JMP REVEAL
2616
2617 ;https://forth-standard.org/standard/core/DOES
2618 ;C DOES>    --          set action for the latest CREATEd definition
2619             FORTHWORD "DOES>"
2620 DOES        MOV &LAST_CFA,W         ; W = CFA of CREATEd word
2621             MOV #DODOES,0(W)        ; replace CFA (DOCON) by new CFA (DODOES)
2622             MOV IP,2(W)             ; replace PFA by the address after DOES> as execution address
2623             MOV @RSP+,IP            ; exit of the new created word
2624             mNEXT
2625
2626 ;https://forth-standard.org/standard/core/DEFER
2627 ;C DEFER "<spaces>name"   --
2628 ;Skip leading space delimiters. Parse name delimited by a space.
2629 ;Create a definition for name with the execution semantics defined below.
2630
2631 ;name Execution:   --
2632 ;Execute the xt that name is set to execute, i.e. NEXT (nothing),
2633 ;until the phrase ' word IS name is executed, causing a new value of xt to be assigned to name.
2634
2635             FORTHWORD "DEFER"
2636 DEFER       CALL #HEADER             ; that create a secondary DEFERred word (whithout subsequent code)
2637 ;            MOV #4030h,-4(W)        ;4  CFA = MOV @PC+,PC = BR...
2638 ;            MOV #PFA_DEFER,-2(W)    ;4  PFA = address of NEXT: created word does nothing by default
2639             JMP REVEAL
2640
2641 ;https://forth-standard.org/standard/core/toBODY
2642 ; >BODY     -- PFA      leave BODY of a CREATEd or a primary DEFERred word
2643             FORTHWORD ">BODY"
2644             ADD     #4,TOS
2645             mNEXT
2646
2647     .IFDEF CONDCOMP
2648
2649 ; ------------------------------------------------------------------------------
2650 ; forthMSP430FR :  CONDITIONNAL COMPILATION
2651 ; ------------------------------------------------------------------------------
2652     .include "forthMSP430FR_CONDCOMP.asm"
2653
2654             ; compile the words: COMPARE [THEN] [ELSE] [IF] [UNDEFINED] [DEFINED] MARKER
2655
2656     .ENDIF  ; CONDCOMP
2657
2658 GOOD_CSP    MOV &LAST_NFA,Y             ; GOOD_CSP is the end of word MARKER
2659             MOV &LAST_THREAD,X          ;
2660 REVEAL      MOV @X,-2(Y)                ; [LAST_THREAD] --> LFA
2661             MOV Y,0(X)                  ; LAST_NFA --> [LAST_THREAD]
2662             mNEXT
2663
2664 ; ------------------------------------------------------------------------------
2665 ; CONTROL STRUCTURES
2666 ; ------------------------------------------------------------------------------
2667 ; THEN and BEGIN compile nothing
2668 ; DO compile one word
2669 ; IF, ELSE, AGAIN, UNTIL, WHILE, REPEAT, LOOP & +LOOP compile two words
2670 ; LEAVE compile three words
2671
2672 ;https://forth-standard.org/standard/core/IF
2673 ;C IF       -- IFadr    initialize conditional forward branch
2674             FORTHWORDIMM "IF"       ; immediate
2675 IFF         SUB #2,PSP              ;
2676             MOV TOS,0(PSP)          ;
2677             MOV &DDP,TOS            ; -- HERE
2678             ADD #4,&DDP             ;           compile one word, reserve one word
2679             MOV #QBRAN,0(TOS)       ; -- HERE   compile QBRAN
2680 CELLPLUS    ADD #2,TOS              ; -- HERE+2=IFadr
2681             mNEXT
2682
2683 ;https://forth-standard.org/standard/core/ELSE
2684 ;C ELSE     IFadr -- ELSEadr        resolve forward IF branch, leave ELSEadr on stack
2685             FORTHWORDIMM "ELSE"     ; immediate
2686 ELSS        ADD #4,&DDP             ; make room to compile two words
2687             MOV &DDP,W              ; W=HERE+4
2688             MOV #bran,-4(W)
2689             MOV W,0(TOS)            ; HERE+4 ==> [IFadr]
2690             SUB #2,W                ; HERE+2
2691             MOV W,TOS               ; -- ELSEadr
2692             mNEXT
2693
2694 ;https://forth-standard.org/standard/core/THEN
2695 ;C THEN     IFadr --                resolve forward branch
2696             FORTHWORDIMM "THEN"     ; immediate
2697 THEN        MOV &DDP,0(TOS)         ; -- IFadr
2698             MOV @PSP+,TOS           ; --
2699             mNEXT
2700
2701 ;https://forth-standard.org/standard/core/BEGIN
2702 ;C BEGIN    -- BEGINadr             initialize backward branch
2703             FORTHWORDIMM "BEGIN"    ; immediate
2704 BEGIN       MOV #HERE,PC            ; BR HERE
2705
2706 ;https://forth-standard.org/standard/core/UNTIL
2707 ;C UNTIL    BEGINadr --             resolve conditional backward branch
2708             FORTHWORDIMM "UNTIL"    ; immediate
2709 UNTIL       MOV #qbran,X
2710 UNTIL1      ADD #4,&DDP             ; compile two words
2711             MOV &DDP,W              ; W = HERE
2712             MOV X,-4(W)             ; compile Bran or qbran at HERE
2713             MOV TOS,-2(W)           ; compile bakcward adr at HERE+2
2714             MOV @PSP+,TOS
2715             mNEXT
2716
2717 ;https://forth-standard.org/standard/core/AGAIN
2718 ;X AGAIN    BEGINadr --             resolve uncondionnal backward branch
2719             FORTHWORDIMM "AGAIN"    ; immediate
2720 AGAIN       MOV #bran,X
2721             JMP UNTIL1
2722
2723 ;https://forth-standard.org/standard/core/WHILE
2724 ;C WHILE    BEGINadr -- WHILEadr BEGINadr
2725             FORTHWORDIMM "WHILE"    ; immediate
2726 WHILE       mDOCOL
2727             .word   IFF,SWAP,EXIT
2728
2729 ;https://forth-standard.org/standard/core/REPEAT
2730 ;C REPEAT   WHILEadr BEGINadr --     resolve WHILE loop
2731             FORTHWORDIMM "REPEAT"   ; immediate
2732 REPEAT      mDOCOL
2733             .word   AGAIN,THEN,EXIT
2734
2735 ;https://forth-standard.org/standard/core/
2736
2737 ;C DO       -- DOadr   L: -- 0
2738             FORTHWORDIMM "DO"       ; immediate
2739 DO          SUB #2,PSP              ;
2740             MOV TOS,0(PSP)          ;
2741             ADD #2,&DDP             ;   make room to compile xdo
2742             MOV &DDP,TOS            ; -- HERE+2
2743             MOV #xdo,-2(TOS)        ;   compile xdo
2744             ADD #2,&LEAVEPTR        ; -- HERE+2     LEAVEPTR+2
2745             MOV &LEAVEPTR,W         ;
2746             MOV #0,0(W)             ; -- HERE+2     L-- 0
2747             mNEXT
2748
2749 ;https://forth-standard.org/standard/core/LOOP
2750 ;C LOOP    DOadr --         L-- an an-1 .. a1 0
2751             FORTHWORDIMM "LOOP"     ; immediate
2752 LOO         MOV #xloop,X
2753 ENDLOOP     ADD #4,&DDP             ; make room to compile two words
2754             MOV &DDP,W
2755             MOV X,-4(W)             ; xloop --> HERE
2756             MOV TOS,-2(W)           ; DOadr --> HERE+2
2757 ; resolve all "leave" adr
2758 LEAVELOOP   MOV &LEAVEPTR,TOS       ; -- Adr of top LeaveStack cell
2759             SUB #2,&LEAVEPTR        ; --
2760             MOV @TOS,TOS            ; -- first LeaveStack value
2761             CMP #0,TOS              ; -- = value left by DO ?
2762             JZ ENDLOOPEND
2763             MOV W,0(TOS)            ; move adr after loop as UNLOOP adr
2764             JMP LEAVELOOP
2765 ENDLOOPEND  MOV @PSP+,TOS
2766             mNEXT
2767
2768 ;https://forth-standard.org/standard/core/PlusLOOP
2769 ;C +LOOP   adrs --   L-- an an-1 .. a1 0
2770             FORTHWORDIMM "+LOOP"    ; immediate
2771 PLUSLOOP    MOV #xploop,X
2772             JMP ENDLOOP
2773
2774 ;https://forth-standard.org/standard/core/LEAVE
2775 ;C LEAVE    --    L: -- adrs
2776             FORTHWORDIMM "LEAVE"    ; immediate
2777 LEAV        MOV &DDP,W              ; compile three words
2778             MOV #UNLOOP,0(W)        ; [HERE] = UNLOOP
2779             MOV #BRAN,2(W)          ; [HERE+2] = BRAN
2780             ADD #6,&DDP             ; [HERE+4] = take word for AfterLOOPadr
2781             ADD #2,&LEAVEPTR
2782             ADD #4,W
2783             MOV &LEAVEPTR,X
2784             MOV W,0(X)              ; leave HERE+4 on LEAVEPTR stack
2785             mNEXT
2786
2787 ;https://forth-standard.org/standard/core/MOVE
2788 ;C MOVE    addr1 addr2 u --     smart move
2789 ;             VERSION FOR 1 ADDRESS UNIT = 1 CHAR
2790             FORTHWORD "MOVE"
2791 MOVE        MOV TOS,W           ; 1
2792             MOV @PSP+,Y         ; dest adrs
2793             MOV @PSP+,X         ; src adrs
2794             MOV @PSP+,TOS       ; pop new TOS
2795             CMP #0,W
2796             JZ MOVE_X           ; already made !
2797             CMP X,Y             ; Y-X ; dst - src
2798             JZ MOVE_X           ; already made !
2799             JC MOVEUP           ; U>= if dst > src
2800 MOVEDOWN    MOV.B @X+,0(Y)      ; if X=src > Y=dst copy W bytes down
2801             ADD #1,Y
2802             SUB #1,W
2803             JNZ MOVEDOWN
2804             mNEXT
2805 MOVEUP      ADD W,Y             ; start at end
2806             ADD W,X
2807 MOVUP1      SUB #1,X
2808             SUB #1,Y
2809 MOVUP2      MOV.B @X,0(Y)       ; if X=src < Y=dst copy W bytes up
2810             SUB #1,W
2811             JNZ MOVUP1
2812 MOVE_X      mNEXT
2813
2814 ;-------------------------------------------------------------------------------
2815 ; WORDS SET for VOCABULARY, not ANS compliant
2816 ;-------------------------------------------------------------------------------
2817
2818 ;X VOCABULARY       -- create a vocabulary
2819
2820     .IFDEF VOCABULARY_SET
2821
2822             FORTHWORD "VOCABULARY"
2823 VOCABULARY  mDOCOL
2824             .word   CREATE
2825     .SWITCH THREADS
2826     .CASE   1
2827             .word   lit,0,COMMA             ; will keep the NFA of the last word of the future created vocabularies
2828     .ELSECASE
2829             .word   lit,THREADS,lit,0,xdo
2830 VOCABULOOP  .word   lit,0,COMMA
2831             .word   xloop,VOCABULOOP
2832     .ENDCASE
2833             .word   HERE                    ; link via LASTVOC the future created vocabularies
2834             .word   LIT,LASTVOC,DUP
2835             .word   FETCH,COMMA             ; compile [LASTVOC] to HERE+
2836             .word   STORE                   ; store (HERE - CELL) to LASTVOC
2837             .word   DOES                    ; compile CFA and PFA for the future defined vocabulary
2838
2839     .ENDIF ; VOCABULARY_SET
2840
2841 VOCDOES     .word   LIT,CONTEXT,STORE
2842             .word   EXIT
2843
2844 ;X  FORTH    --                         ; set FORTH the first context vocabulary; FORTH is and must be the first vocabulary
2845     .IFDEF VOCABULARY_SET
2846             FORTHWORD "FORTH"
2847     .ENDIF ; VOCABULARY_SET
2848 FORTH       mDODOES                     ; leave BODYFORTH on the stack and run VOCDOES
2849             .word   VOCDOES
2850 BODYFORTH   .word   lastforthword
2851     .SWITCH THREADS
2852     .CASE   2
2853             .word   lastforthword1
2854     .CASE   4
2855             .word   lastforthword1
2856             .word   lastforthword2
2857             .word   lastforthword3
2858     .CASE   8
2859             .word   lastforthword1
2860             .word   lastforthword2
2861             .word   lastforthword3
2862             .word   lastforthword4
2863             .word   lastforthword5
2864             .word   lastforthword6
2865             .word   lastforthword7
2866     .CASE   16
2867             .word   lastforthword1
2868             .word   lastforthword2
2869             .word   lastforthword3
2870             .word   lastforthword4
2871             .word   lastforthword5
2872             .word   lastforthword6
2873             .word   lastforthword7
2874             .word   lastforthword8
2875             .word   lastforthword9
2876             .word   lastforthword10
2877             .word   lastforthword11
2878             .word   lastforthword12
2879             .word   lastforthword13
2880             .word   lastforthword14
2881             .word   lastforthword15
2882     .CASE   32
2883             .word   lastforthword1
2884             .word   lastforthword2
2885             .word   lastforthword3
2886             .word   lastforthword4
2887             .word   lastforthword5
2888             .word   lastforthword6
2889             .word   lastforthword7
2890             .word   lastforthword8
2891             .word   lastforthword9
2892             .word   lastforthword10
2893             .word   lastforthword11
2894             .word   lastforthword12
2895             .word   lastforthword13
2896             .word   lastforthword14
2897             .word   lastforthword15
2898             .word   lastforthword16
2899             .word   lastforthword17
2900             .word   lastforthword18
2901             .word   lastforthword19
2902             .word   lastforthword20
2903             .word   lastforthword21
2904             .word   lastforthword22
2905             .word   lastforthword23
2906             .word   lastforthword24
2907             .word   lastforthword25
2908             .word   lastforthword26
2909             .word   lastforthword27
2910             .word   lastforthword28
2911             .word   lastforthword29
2912             .word   lastforthword30
2913             .word   lastforthword31
2914
2915     .ELSECASE   ; = CASE 1
2916     .ENDCASE
2917             .word   voclink         ; here, voclink = 0
2918 voclink         .set    $-2
2919
2920 ;X  ALSO    --                  make room to put a vocabulary as first in context
2921     .IFDEF VOCABULARY_SET
2922             FORTHWORD "ALSO"
2923     .ENDIF ; VOCABULARY_SET
2924 ALSO        MOV #12,W               ; -- move up 6 words, 8th word of CONTEXT area must remain to 0
2925             MOV #CONTEXT,X          ; X=src
2926             MOV #CONTEXT+2,Y        ; Y=dst
2927             JMP MOVEUP              ; src < dst
2928
2929 ;X  PREVIOUS   --               pop last vocabulary out of context
2930     .IFDEF VOCABULARY_SET
2931             FORTHWORD "PREVIOUS"
2932     .ENDIF ; VOCABULARY_SET
2933 PREVIOUS    MOV #14,W               ; move down 7 words, with recopy of the 8th word equal to 0
2934             MOV #CONTEXT+2,X        ; X=src
2935             MOV #CONTEXT,Y          ; Y=dst
2936             JMP MOVEDOWN            ; src > dst
2937
2938 ;X ONLY     --      cut context list to access only first vocabulary, ex.: FORTH ONLY
2939     .IFDEF VOCABULARY_SET
2940             FORTHWORD "ONLY"
2941     .ENDIF ; VOCABULARY_SET
2942 ONLY        MOV #0,&CONTEXT+2
2943             mNEXT
2944
2945 ;X DEFINITIONS  --      set last context vocabulary as entry for further defining words
2946     .IFDEF VOCABULARY_SET
2947             FORTHWORD "DEFINITIONS"
2948     .ENDIF ; VOCABULARY_SET
2949 DEFINITIONS  MOV &CONTEXT,&CURRENT
2950             mNEXT
2951
2952 ;-------------------------------------------------------------------------------
2953 ; IMPROVED ON/OFF AND RESET
2954 ;-------------------------------------------------------------------------------
2955
2956 STATE_DOES  ; execution part of PWR_STATE ; sorry, doesn't restore search order pointers
2957             .word   FORTH,ONLY,DEFINITIONS
2958             FORTHtoASM              ; -- BODY       IP is free
2959             MOV @TOS+,W             ; -- BODY+2     W = old VOCLINK = VLK
2960             MOV W,&LASTVOC          ; -- BODY+2     restore LASTVOC
2961             MOV @TOS,TOS            ; -- OLD_DP
2962             MOV TOS,&DDP            ; -- OLD_DP     restore DP
2963                                     ; then restore words link(s) with it value < old DP
2964     .SWITCH THREADS
2965     .CASE   1 ; mono thread vocabularies
2966 MARKALLVOC  MOV W,Y                 ; -- OLD_DP      W=VLK   Y=VLK
2967 MRKWORDLOOP MOV -2(Y),Y             ; -- OLD_DP      W=VLK   Y=NFA
2968             CMP Y,TOS               ; -- OLD_DP      CMP = TOS-Y : OLD_DP-NFA
2969             JNC MRKWORDLOOP         ;                loop back if TOS<Y : OLD_DP<NFA
2970             MOV Y,-2(W)             ;                W=VLK   X=THD   Y=NFA   refresh thread with good NFA
2971             MOV @W,W                ; -- OLD_DP      W=[VLK] = next voclink
2972             CMP #0,W                ; -- OLD_DP      W=[VLK] = next voclink   end of vocs ?
2973             JNZ MARKALLVOC          ; -- OLD_DP      W=VLK                   no : loopback
2974
2975     .ELSECASE ; multi threads vocabularies
2976 MARKALLVOC  MOV #THREADS,IP         ; -- OLD_DP      W=VLK
2977             MOV W,X                 ; -- OLD_DP      W=VLK   X=VLK
2978 MRKTHRDLOOP MOV X,Y                 ; -- OLD_DP      W=VLK   X=VLK   Y=VLK
2979             SUB #2,X                ; -- OLD_DP      W=VLK   X=THD (thread ((case-2)to0))
2980 MRKWORDLOOP MOV -2(Y),Y             ; -- OLD_DP      W=VLK   Y=NFA
2981             CMP Y,TOS               ; -- OLD_DP      CMP = TOS-Y : OLD_DP-NFA
2982             JNC MRKWORDLOOP         ;               loop back if TOS<Y : OLD_DP<NFA
2983 MARKTHREAD  MOV Y,0(X)              ;               W=VLK   X=THD   Y=NFA   refresh thread with good NFA
2984             SUB #1,IP               ; -- OLD_DP      W=VLK   X=THD   Y=NFA   IP=CFT-1
2985             JNZ MRKTHRDLOOP         ;                       loopback to compare NFA in next thread (thread-1)
2986             MOV @W,W                ; -- OLD_DP      W=[VLK] = next voclink
2987             CMP #0,W                ; -- OLD_DP      W=[VLK] = next voclink   end of vocs ?
2988             JNZ MARKALLVOC          ; -- OLD_DP      W=VLK                   no : loopback
2989
2990     .ENDCASE ; of THREADS           ; -- DDP
2991             MOV     @PSP+,TOS       ;
2992             MOV     @RSP+,IP        ;
2993             mNEXT                   ;
2994
2995             FORTHWORD "PWR_STATE"   ; executed by power ON, reinitializes dictionary in state defined by PWR_HERE
2996 PWR_STATE   mDODOES                 ; DOES part of MARKER : resets pointers DP, voclink and latest
2997             .word   STATE_DOES      ; execution vector of PWR_STATE
2998 MARKVOC     .word   lastvoclink     ; initialised by forthMSP430FR.asm as voclink value
2999 MARKDP      .word   ROMDICT         ; initialised by forthMSP430FR.asm as DP value
3000
3001             FORTHWORD "RST_STATE"   ; executed by <reset>, reinitializes dictionary in state defined by RST_HERE;
3002 RST_STATE   MOV &INIVOC,&MARKVOC    ; INI value saved in FRAM
3003             MOV &INIDP,&MARKDP      ; INI value saved in FRAM
3004             JMP PWR_STATE
3005
3006             FORTHWORD "PWR_HERE"    ; define dictionnary bound for power ON
3007 PWR_HERE    MOV &LASTVOC,&MARKVOC
3008             MOV &DDP,&MARKDP
3009             mNEXT
3010
3011             FORTHWORD "RST_HERE"    ; define dictionnary bound for <reset>...
3012 RST_HERE    MOV &LASTVOC,&INIVOC
3013             MOV &DDP,&INIDP
3014             JMP PWR_HERE            ; ...and also for power ON...
3015
3016 ;            FORTHWORD "WIPE"        ; restore the program as it was in forthMSP430FR.txt file
3017 ;WIPE        MOV #SIGNATURES,X       ; reset JTAG and BSL signatures   ; unlock JTAG, SBW and BSL
3018 ;SIGNLOOP    MOV #-1,0(X)            ; reset signature; WARNING ! DON'T CHANGE THIS IMMEDIATE VALUE !
3019 ;            ADD #2,X
3020 ;            CMP #INTVECT,X
3021 ;            JNZ SIGNLOOP
3022 ;            CALL #WIP_DEFER         ; set default execute part of all factory primary DEFERred words
3023 ;            MOV #ROMDICT,&INIDP     ; reinit this 2 factory values
3024 ;            MOV #lastvoclink,&INIVOC
3025 ;            JMP RST_STATE           ; then execute RST_STATE and PWR_STATE
3026
3027             FORTHWORD "WIPE"        ; restore the program as it was in forthMSP430FR.txt file
3028 WIPE                                ; reset JTAG and BSL signatures   ; unlock JTAG, SBW and BSL
3029             MOV #16,X               ; max known SIGNATURES length = 10
3030 SIGNLOOP    SUB #2,X
3031             MOV #-1,SIGNATURES(X)   ; reset signature; WARNING ! DON'T CHANGE THIS IMMEDIATE VALUE !
3032             JNZ SIGNLOOP
3033             CALL #WIP_DEFER         ; set default execute part of all factory primary DEFERred words
3034             MOV #ROMDICT,&INIDP     ; reinit this 2 factory values
3035             MOV #lastvoclink,&INIVOC
3036             JMP RST_STATE           ; then execute RST_STATE and PWR_STATE
3037
3038 ; ------------------------------------------------------------------------------
3039 ; forthMSP430FR : WARM
3040 ; ------------------------------------------------------------------------------
3041
3042 ;Z WARM   --    ; deferred word used to init your application
3043                 ; define this word:  : START ...init app here... LIT RECURSE IS WARM (WARM) ;
3044             FORTHWORD "WARM"
3045 WARM        MOV @PC+,PC                 ;3
3046             .word   BODYWARM
3047 BODYWARM
3048 ;            SUB     #4,PSP
3049 ;            MOV     &SYSSNIV,0(PSP)
3050 ;            MOV     &SYSUNIV,2(PSP)
3051             MOV     &SAVE_SYSRSTIV,TOS  ; to display it
3052             mDOCOL
3053             .word   XSQUOTE             ;
3054             .byte   6,13,1Bh,"[7m#"     ; CR + cmd "reverse video" + #
3055             .word   TYPE                ;
3056             .word   DOT                 ; display signed SAVE_SYSRSTIV
3057 ;            .word   DOT                 ; display SYSSNIV
3058 ;            .word   DOT                 ; display SYSUNIV
3059             .word   XSQUOTE
3060             .byte   31,"FastForth ",VER," (C)J.M.Thoorens "
3061             .word   TYPE
3062             .word   LIT,FRAM_FULL,HERE,MINUS,UDOT
3063             .word   XSQUOTE         ;
3064             .byte   11,"bytes free ";
3065             .word   QABORTYESNOECHO     ; NOECHO state enables any app to execute COLD or WARM without terminal connexion
3066
3067
3068
3069 ;-------------------------------------------------------------------------------
3070 ; RESET : Initialisation limited to FORTH usage : I/O, RAM, RTC
3071 ; all unused I/O are set as input with pullup resistor
3072 ;-------------------------------------------------------------------------------
3073
3074 ;Z COLD     --      performs a software reset
3075             FORTHWORD "COLD"
3076 COLD        MOV #0A500h+PMMSWBOR,&PMMCTL0
3077
3078 RESET
3079     .include "Target.asm"   ; include target specific init code
3080
3081
3082 ; fill all interrupt vectors with RESET
3083             MOV #VECTLEN,X          ; length of vectors area
3084 RESETINT    SUB #2,X
3085             MOV #RESET,INTVECT(X)   ; begin at end of area
3086             JNZ RESETINT            ; endloop when INTVECT(X) = INTVECT
3087
3088 ; reset default TERMINAL vector interrupt and LPM0 mode for terminal use
3089             MOV #TERMINAL_INT,&TERMVEC
3090             MOV #CPUOFF+GIE,&LPM_MODE
3091
3092 ; init RAM
3093             MOV #RAMLEN,X
3094 INITRAM     SUB #2,X
3095             MOV #0,RAMSTART(X)
3096             JNZ INITRAM             ; 6~ loop
3097
3098 ;-------------------------------------------------------------------------------
3099 ; RESET : INIT FORTH machine
3100 ;-------------------------------------------------------------------------------
3101             MOV #RSTACK,RSP         ; init return stack
3102             MOV #PSTACK,PSP         ; init parameter stack
3103     .SWITCH DTC
3104     .CASE 1
3105             MOV #xdocol,rDOCOL      ;
3106     .CASE 2
3107             MOV #EXIT,rEXIT
3108     .CASE 3                         ; inlined DOCOL, do nothing here
3109     .ENDCASE
3110             MOV #RFROM,rDOVAR
3111             MOV #xdocon,rDOCON
3112             MOV #xdodoes,rDODOES
3113
3114             MOV #10,&BASE           ; init BASE
3115             MOV #-1,&CAPS           ; init CAPS ON
3116
3117 ;-------------------------------------------------------------------------------
3118 ; RESET : test TERM_TXD before init TERM_UART  I/O
3119 ;-------------------------------------------------------------------------------
3120     BIC #LOCKLPM5,&PM5CTL0          ; activate all previous I/O settings before DEEP_RST test
3121     MOV &SAVE_SYSRSTIV,Y            ;3
3122     BIT.B #TXD,&TERM_IN             ; TERM_TXD wired to GND via 4k7 resistor ?
3123     JNZ TERM_INIT                   ; no
3124     XOR #-1,Y                       ;1 yes : force DEEP_RST (WIPE + COLD)
3125     ADD #1,Y                        ;1       to display SAVE_SYSRSTIV as negative value
3126     MOV Y,&SAVE_SYSRSTIV            ;3 save
3127
3128 TERM_INIT
3129 ;-------------------------------------------------------------------------------
3130 ; RESET : INIT TERM_UART
3131 ;-------------------------------------------------------------------------------
3132     MOV #0081h,&TERMCTLW0           ; Configure TERM_UART  UCLK = SMCLK
3133     MOV &TERMBRW_RST,&TERMBRW       ; RST value in FRAM
3134     MOV &TERMMCTLW_RST,&TERMMCTLW   ; RST value in FRAM
3135     BIS.B #TERM_BUS,&TERM_SEL       ; Configure pins TXD & RXD for TERM_UART (PORTx_SEL0 xor PORTx_SEL1)
3136                                     ; TERM_DIR is controlled by eUSCI_Ax module
3137     BIC #UCSWRST,&TERMCTLW0         ; release from reset...
3138     BIS #UCRXIE,&TERMIE             ; ... then enable RX interrupt for wake up on terminal input
3139
3140 ;-------------------------------------------------------------------------------
3141 ; RESET : Select  POWER_ON|<reset>|DEEP_RST from Y = SAVE_SYSRSTIV
3142 ;-------------------------------------------------------------------------------
3143
3144 SelectReset MOV #COLD_END,IP    ; define return of WIPE,RST_STATE,PWR_STATE
3145             CMP #0Ah,Y          ; reset event = security violation BOR ???? not documented...
3146             JZ WIPE             ; Add WIPE to this reset to do DEEP_RST     --------------
3147             CMP #16h,Y          ; reset event > software POR : failure or DEEP_RST request
3148             JHS WIPE            ; U>= ; Add WIPE to this reset to do DEEP_RST
3149             CMP #2,Y            ; reset event = Brownout ?
3150             JNZ RST_STATE       ; else  execute RST_STATE, return to COLD_END
3151             JZ  PWR_STATE       ; yes   execute PWR_STATE, return to COLD_END
3152
3153 ;-------------------------------------------------------------------------------
3154 ; RESET : INIT SD_Card option
3155 ;-------------------------------------------------------------------------------
3156 COLD_END
3157     .IFNDEF SD_CARD_LOADER      ;
3158         .word   WARM            ; the next step
3159     .ELSE
3160         FORTHtoASM
3161         .IFDEF RAM_1K           ; case of MSP430FR57xx
3162         MOV #0,&CurrentHDL      ; init this FRAM area to pass QABORT
3163         .ENDIF
3164         BIT.B #SD_CD,&SD_CDIN   ; SD_memory in SD_Card module ?
3165         JNZ WARM                ; no
3166     .include "forthMSP430FR_SD_INIT.asm";
3167         JMP WARM
3168     .ENDIF
3169
3170 ;-------------------------------------------------------------------------------
3171 ; ASSEMBLER OPTION
3172 ;-------------------------------------------------------------------------------
3173     .IFDEF MSP430ASSEMBLER
3174     .include "forthMSP430FR_ASM.asm"
3175     .ENDIF
3176
3177 ;-------------------------------------------------------------------------------
3178 ; SD CARD FAT OPTIONS
3179 ;-------------------------------------------------------------------------------
3180     .IFDEF SD_CARD_LOADER
3181     .include "forthMSP430FR_SD_LowLvl.asm"  ; SD primitives
3182     .include "forthMSP430FR_SD_LOAD.asm"    ; SD LOAD driver
3183     ;---------------------------------------------------------------------------
3184     ; SD CARD READ WRITE
3185     ;---------------------------------------------------------------------------
3186         .IFDEF SD_CARD_READ_WRITE
3187         .include "forthMSP430FR_SD_RW.asm"  ; SD Read/Write driver
3188         .ENDIF
3189         ;-----------------------------------------------------------------------
3190         ; SD TOOLS
3191         ;-----------------------------------------------------------------------
3192         .IFDEF SD_TOOLS
3193         .include "ADDON/SD_TOOLS.asm"
3194         .ENDIF
3195     .ENDIF
3196
3197 ;-------------------------------------------------------------------------------
3198 ; UTILITY WORDS OPTION
3199 ;-------------------------------------------------------------------------------
3200     .IFDEF UTILITY
3201     .include "ADDON/UTILITY.asm"
3202     .ENDIF
3203
3204 ;-------------------------------------------------------------------------------
3205 ; FIXED POINT OPERATORS OPTION
3206 ;-------------------------------------------------------------------------------
3207     .IFDEF FIXPOINT
3208     .include "ADDON/FIXPOINT.asm"
3209     .ENDIF
3210
3211 ;-------------------------------------------------------------------------------
3212 ; UART to I2C bridge OPTION
3213 ;-------------------------------------------------------------------------------
3214     .IFDEF UARTtoI2C    ; redirects TERMINAL on to I2C address
3215     .include "ADDON/UART2MI2C.asm"
3216     .ENDIF
3217
3218 ;-------------------------------------------------------------------------------
3219 ; ADD HERE YOUR PROGRAM TO BE INTEGRATED IN CORE (protected against WIPE)
3220 ;vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
3221
3222 ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
3223
3224 ;-------------------------------------------------------------------------------
3225 ; RESOLVE ASSEMBLY PTR
3226 ;-------------------------------------------------------------------------------
3227
3228     .include "ResolveThreads.mac"
3229
3230
3231     .org 0FFFEh
3232     .word reset
3233