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