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