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