; ----------------------------------------------------------------------
; compiled with MACROASSEMBLER AS (http://john.ccac.rwth-aachen.de:8000/as/)
; ----------------------------------------------------------------------
- .cpu MSP430X
- .include "mspregister.mac" ;
-; macexp off ; uncomment to hide macro results
-
-VER .equ "V207"
;-------------------------------------------------------------------------------
; Vingt fois sur le métier remettez votre ouvrage,
;===============================================================================
;===============================================================================
; before assembling or programming you must set TARGET in param1 (SHIFT+F8)
-; according to the TARGET "switched" below
+; according to the selected TARGET below
;===============================================================================
;===============================================================================
+VER .equ "V209" ; FORTH version
+
+ macexp off ; uncomment to hide macro results in forthMSP430FR.lst
+
;-------------------------------------------------------------------------------
-; TARGETS kernel ; sizes are for 8MHz, DTC=1, 3WIRES (XON/XOFF)
+; TARGETS kernel ; sizes are for 8MHz, DTC=1, THREADS=1, 3WIRES (XON/XOFF)
;-------------------------------------------------------------------------------
-; ;INFO+ VECT + MAIN
-;MSP_EXP430FR5739 ; compile for MSP-EXP430FR5739 launchpad ; 22 + 2 + 3916 bytes
-;MSP_EXP430FR5969 ; compile for MSP-EXP430FR5969 launchpad ; 22 + 2 + 3892 bytes
-MSP_EXP430FR5994 ;; compile for MSP-EXP430FR5994 launchpad ; 22 + 2 + 3918 bytes
-;MSP_EXP430FR6989 ; compile for MSP-EXP430FR6989 launchpad ; 22 + 2 + 3928 bytes
-;MSP_EXP430FR4133 ; compile for MSP-EXP430FR4133 launchpad ; 22 + 2 + 3958 bytes
-;MSP_EXP430FR2355 ; compile for MSP-EXP430FR2355 launchpad ; 22 + 2 + 3894 bytes
-;MSP_EXP430FR2433 ; compile for MSP-EXP430FR2433 launchpad ; 22 + 2 + 3880 bytes
-;CHIPSTICK_FR2433 ; compile for the "CHIPSTICK" of M. Ken BOAK ; 22 + 2 + 3880 bytes
+; ;INFO+VECTOR+ MAIN
+;MSP_EXP430FR5739 ; compile for MSP-EXP430FR5739 launchpad ; 24 + 2 + 3844 bytes
+;MSP_EXP430FR5969 ; compile for MSP-EXP430FR5969 launchpad ; 24 + 2 + 3820 bytes
+;MSP_EXP430FR5994 ; compile for MSP-EXP430FR5994 launchpad ; 24 + 2 + 3846 bytes
+;MSP_EXP430FR6989 ; compile for MSP-EXP430FR6989 launchpad ; 24 + 2 + 3856 bytes
+;MSP_EXP430FR4133 ; compile for MSP-EXP430FR4133 launchpad ; 24 + 2 + 3886 bytes
+;MSP_EXP430FR2355 ; compile for MSP-EXP430FR2355 launchpad ; 24 + 2 + 3822 bytes
+;MSP_EXP430FR2433 ; compile for MSP-EXP430FR2433 launchpad ; 24 + 2 + 3808 bytes
+CHIPSTICK_FR2433 ;; compile for the "CHIPSTICK" of M. Ken BOAK ; 24 + 2 + 3808 bytes
; choose DTC (Direct Threaded Code) model, if you don't know, choose 1
DTC .equ 1 ; DTC model 1 : DOCOL = CALL rDOCOL 14 cycles 1 word shortest DTC model
; DTC model 3 : inlined DOCOL 9 cycles 4 words fastest
THREADS .equ 16 ; 1, 2 , 4 , 8 , 16, 32 search entries in dictionnary.
- ; +0, +28, +40, +56, +90, +154 bytes, usefull to speed compilation;
+ ; +0, +42, +54, +70, +104, +168 bytes, usefull to speed up compilation;
; choose 16
-FREQUENCY .equ 16 ; fully tested at 0.5,1,2,4,8,16 (and 24 for MSP430FR57xx and MSP430FR2355) MHz
+FREQUENCY .equ 16 ; fully tested at 0.25,0.5,1,2,4,8,16 MHz (+ 24 MHz for MSP430FR57xx,MSP430FR2355)
;-------------------------------------------------------------------------------
; KERNEL ADD-ON SWITCHES
;-------------------------------------------------------------------------------
-MSP430ASSEMBLER ;; + 1814 bytes : adds embedded assembler with TI syntax; without, you can do all but all much more slowly...
-CONDCOMP ;; + 324 bytes : adds conditionnal compilation : MARKER [UNDEFINED] [DEFINED] [IF] [ELSE] [THEN] COMPARE
-NONAME ;; + 64 bytes : adds :NONAME CODENNM (CODENoNaMe)
-LOWERCASE ;; + 46 bytes : enables to write strings in lowercase (whose VT100 set_up sequences...)
-FIXPOINT_INPUT ;; + 78 bytes : adds the interpretation input for S15.16 numbers, mandatory for FIXPOINT ADD-ON
+CONDCOMP ;; + 368 bytes : adds conditionnal compilation : COMPARE [DEFINED] [UNDEFINED] [IF] [ELSE] [THEN] MARKER
+MSP430ASSEMBLER ;; + 1828 bytes : adds embedded assembler with TI syntax; without, you can do all but all much more slowly...
+EXTENDED_ASM ;; + 1886 bytes : adds extended assembler for programming or data access beyond $FFFF.
+NONAME ;; + 54 bytes : adds :NONAME CODENNM (CODENoNaMe)
VOCABULARY_SET ;; + 104 bytes : adds words: VOCABULARY FORTH ASSEMBLER ALSO PREVIOUS ONLY DEFINITIONS (FORTH83)
-SD_CARD_LOADER ;; + 1748 bytes : to LOAD source files from SD_card
-SD_CARD_READ_WRITE ;; + 1192 bytes : to read, create, write and del files + source files direct copy from PC to SD_Card
-BOOTLOADER ;; + 66 bytes : adds to <reset> a bootstrap to SD_CARD\BOOT.4TH.
-;QUIETBOOT ; + 2 bytes : to perform bootload without displaying.
+DOUBLE_INPUT ;; + 74 bytes : adds the interpretation input for double numbers (dot numbers)
+FIXPOINT_INPUT ;; + 120 bytes : adds the interpretation input for Q15.16 numbers, mandatory for FIXPOINT ADD-ON
+;SD_CARD_LOADER ; + 1748 bytes : to LOAD source files from SD_card
+;SD_CARD_READ_WRITE ; + 1192 bytes : to read, create, write and del files + copy text files from PC to SD_Card
+;BOOTLOADER ; + 72 bytes : includes to <reset> the SD_CARD\BOOT.4TH file as bootloader.
+;QUIETBOOT ; + 2 bytes : to perform bootloader without displaying.
;TOTAL ; + 4 bytes : to save also R4 to R7 registers during interrupts.
;-------------------------------------------------------------------------------
-; OPTIONAL KERNEL ADD-ON SWITCHES (that can be downloaded later) >-----------------------+
-; Tip: when added here, ADD-ONs become protected against WIPE and Deep Reset... |
+; OPTIONAL ADD-ON SWITCHES (that can be downloaded later) >-----------------------+
+; when added here, ADD-ONs become protected against WIPE and Deep Reset... |
;------------------------------------------------------------------------------- v
;UARTtoI2C ; to redirect source file to a I2C TERMINAL FastForth device UART2IIC.f
-;FIXPOINT ; + 422/528 bytes (MPY/noMPY): add HOLDS F+ F- F/ F* F#S F. S>F 2@ 2CONSTANT FIXPOINT.f
+;FIXPOINT ; + 422/528 bytes add HOLDS F+ F- F/ F* F#S F. S>F 2@ 2CONSTANT FIXPOINT.f
UTILITY ;; + 434/524 bytes (1/16threads) : add .S .RS WORDS U.R DUMP ? UTILITY.f
-SD_TOOLS ;; + 142 bytes for trivial DIR, FAT, CLUSTER and SECTOR view, adds UTILITY SD_TOOLS.f
-;ANS_CORE_COMPLIANT ; + 902 bytes : required to pass coretest.4th ; (includes items below) ANS_COMP.f
-;ARITHMETIC ; + 358 bytes : add S>D M* SM/REM FM/MOD * /MOD / MOD */MOD /MOD */
-;DOUBLE ; + 130 bytes : add 2@ 2! 2DUP 2SWAP 2OVER
-;ALIGNMENT ; + 24 bytes : add ALIGN ALIGNED
-;PORTABILITY ; + 46 bytes : add CHARS CHAR+ CELLS CELL+
-
+;SD_TOOLS ; + 142 bytes for trivial DIR, FAT, CLUSTER and SECTOR view, adds UTILITY SD_TOOLS.f
+;ANS_CORE_COMPLEMENT ; + 924 bytes : required to pass coretest.4th ; (includes items below) ANS_COMP.f
;-------------------------------------------------------------------------------
; FAST FORTH TERMINAL configuration
;-------------------------------------------------------------------------------
-
-TERMINALBAUDRATE .equ 921600 ; choose value considering the frequency and the UART2USB bridge, see explanations below.
- .include "TERMINALBAUDRATE.inc"
-
;HALFDUPLEX ; to use FAST FORTH with half duplex terminal
-
+TERMINALBAUDRATE .equ 115200 ; choose value considering the frequency and the UART2USB bridge, see explanations below.
TERMINAL3WIRES ;; enable 3 wires (GND,TX,RX) with XON/XOFF software flow control (PL2303TA/HXD, CP2102)
-TERMINAL4WIRES ;; + 16 bytes enable 4 wires with hardware flow control on RX with RTS (PL2303TA/HXD, FT232RL)
+TERMINAL4WIRES ;; + 12 bytes enable 4 wires with hardware flow control on RX with RTS (PL2303TA/HXD, FT232RL)
; this RTS pin may be permanently wired on SBWTCK/TEST pin without disturbing SBW 2 wires programming
;TERMINAL5WIRES ; + 6 bytes enable 5 wires with hardware flow control on RX/TX with RTS/CTS (PL2303TA/HXD, FT232RL)...
-; if you uncomment TERMINAL3WIRES, you have a XON/XOFF terminal (software flow control)
-; if you uncomment TERMINAL5WIRES, you have a RTS/CTS terminal (hardware flow control); mandatory option if you also want to perform binary transfers
-; if you uncomment TERMINAL3WIRES + TERMINAL4WIRES, you have a XON/XOFF + RTS terminal; sufficient option to dowload with hardware control flow
-; if you uncomment TERMINAL3WIRES + TERMINAL5WIRES, you have a XON/XOFF + RTS/CTS terminal
+;===============================================================================
+; Software control flow XON/XOFF configuration:
+;===============================================================================
+; Launchpad --- UARTtoUSB device
+; RX <-- TX
+; TX --> RX
+; GND <-> GND
+; TERATERM config terminal : NewLine receive : AUTO,
+; NewLine transmit : CR+LF
+; Size : 128 chars x 49 lines (adjust lines to your display)
+
+; TERATERM config serial port : TERMINALBAUDRATE value,
+; 8 bits, no parity, 1 Stop bit,
+; XON/XOFF flow control,
+; delay = 0ms/line, 0ms/char
+
+; don't forget : save new TERATERM configuration !
; --------------------------------------------------------------------------------------------
; Only two usb2uart bridges correctly handle XON / XOFF: cp2102 and pl2303.
; --------------------------------------------------------------------------------------------
-
-
-
; the best and cheapest: UARTtoUSB cable with Prolific PL2303HXD (or PL2303TA)
-; works wel in 3 WIRES (XON/XOF) and 4WIRES (GND,RX,TX,RTS) config
+; works well in 3 WIRES (XON/XOFF) and 4WIRES (GND,RX,TX,RTS) config
; --------------------------------------------------------------------------------------------
; PL2303TA 4 wires CABLE PL2303HXD 6 wires CABLE
; pads upside: 3V3,txd,rxd,gnd,5V pads upside: gnd, 3V3,txd,rxd,5V
; downside: cts,dcd,dsr,rts,dtr downside: rts,cts
; --------------------------------------------------------------------------------------------
-; WARNING ! if you use PL2303TA/HXD cable as supply, open box before to weld red wire on 3v3 pad !
+; WARNING ! if you use PL2303TA/HXD cable as supply, open the box before to weld red wire on 3v3 pad !
; --------------------------------------------------------------------------------------------
; 9600,19200,38400,57600 (250kHz)
; + 115200,134400 (500kHz)
; + 1843200,2457600 (8MHz,PL2303HXD)
; + 3MBds (16MHz,PL2303TA)
; + 3MBds,4MBds,5MBds (16MHz,PL2303HXD)
-; + 6MBds (MSP430FR57xx family,24MHz)
-
+; + 6MBds (MSP430FR57xx,MSP430FR2355 families,24MHz)
; UARTtoUSB module with Silabs CP2102 (supply current = 20 mA)
; ---------------------------------------------------------------------------------------------------
; + 460800 (2MHz)
; + 921600 (4MHz,8MHz,16MHz,24MHz)
+;===============================================================================
+; Hardware control flow configuration: RTS is wired on UART2USB CTS pin
+;===============================================================================
-; Launchpad --- UARTtoUSB device
+; Launchpad <-> UARTtoUSB
; RX <-- TX
; TX --> RX
+; RTS --> CTS (see launchpad.asm for RTS selected pin)
; GND <-> GND
; TERATERM config terminal : NewLine receive : AUTO,
; TERATERM config serial port : TERMINALBAUDRATE value,
; 8bits, no parity, 1Stopbit,
-; XON/XOFF flow control,
+; Hardware flow control,
; delay = 0ms/line, 0ms/char
; don't forget : save new TERATERM configuration !
-
-;===============================================================================
-; Hardware control flow configuration: RTS is wired on UART2USB CTS pin
-;===============================================================================
-
-; Launchpad <-> UARTtoUSB
-; RX <-- TX
-; TX --> RX
-; RTS --> CTS
-; GND <-> GND
-
-; notice that the control flow seems not necessary for TX (CTS pin)
+; notice that the control flow seems not necessary for TX (CTS <-- RTS)
; UARTtoUSB module with PL2303TA/HXD
; --------------------------------------------------------------------------------------------
-; WARNING ! if you use PL2303HXD cable as supply, open box before to weld red wire on 3v3 pad !
+; WARNING ! if you use PL2303TA/HXD cable as supply, open the box before to weld red wire on 3v3 pad !
; --------------------------------------------------------------------------------------------
; 9600,19200,38400,57600 (250kHz)
; + 115200,134400 (500kHz)
; + 4000000,5000000 (16MHz)
; + 6000000 (24MHz)
-
; UARTtoUSB module with FTDI FT232RL (FT230X don't work correctly)
; ------------------------------------------------------------------------------
; WARNING ! buy a FT232RL module with a switch 5V/3V3 and select 3V3 !
; + 460800 (2MHz)
; + 921600 (4,8,16 MHz)
-; TERATERM config terminal : NewLine receive : AUTO,
-; NewLine transmit : CR+LF
-; Size : 128 chars x 49 lines (adjust lines to your display)
-
-; TERATERM config serial port : TERMINALBAUDRATE value,
-; 8bits, no parity, 1Stopbit,
-; Hardware flow control,
-; delay = 0ms/line, 0ms/char
-
-; don't forget : save new TERATERM configuration !
-
-; ------------------------------------------------------------------------------
-; UARTtoBluetooth 4.2 module (RN4870/RN4871 MIKROE click 2543/2544) at 921600 bds
; ------------------------------------------------------------------------------
; UARTtoBluetooth 2.0 module (RN42 sparkfun bluesmirf) at 921600bds
; ------------------------------------------------------------------------------
; Hardware flow control or software flow control or ...no flow control!
; delay = 0ms/line, 0ms/char
-; in fact, compared to using a UART USB bridge, only the COMx port is to be updated.
; don't forget : save new TERATERM configuration !
+; in fact, compared to using a UART USB bridge, only the COMx port is to be updated.
; ------------------------------------------------------------------------------
- .include "Device.inc" ; to define target config: I/O, memory, SFR, vectors, TERMINAL eUSCI, SD_Card eUSCI, LF_XTAL,
-
- .include "ForthThreads.mac" ; init vocabulary pointers
+ .include "ThingsInFirst.inc" ; to define target config: I/O, memory, SFR, vectors, TERMINAL eUSCI, SD_Card eUSCI, LF_XTAL,
;-------------------------------------------------------------------------------
; DTCforthMSP430FR5xxx RAM memory map:
;-------------------------------------------------------------------------------
+;-------------------------------------
; name words ; comment
-
+;-------------------------------------
;LSTACK = L0 = LEAVEPTR ; ----- RAM_ORG
; |
LSTACK_SIZE .equ 16 ; | grows up
; |
;RSTACK=R0 ; ----- RAM_ORG + $E0
+;-------------------------------------
; names bytes ; comments
-
+;-------------------------------------
;PAD ; ----- RAM_ORG + $E4
; |
PAD_LEN .equ 84 ; | grows up (ans spec. : PAD >= 84 chars)
;
; ----- RAM_ORG + $2FF
-
LSTACK .equ RAM_ORG
LEAVEPTR .equ LSTACK ; Leave-stack pointer
PSTACK .equ LSTACK+(LSTACK_SIZE*2)+(PSTACK_SIZE*2)
BASE_HOLD .equ HOLDS_ORG+HOLD_SIZE
-
; ----------------------------------------------------
; RAM_ORG + $1B2 : RAM VARIABLES
; ----------------------------------------------------
-
HP .equ BASE_HOLD ; HOLD ptr
-CAPS .equ BASE_HOLD+2
+CAPS .equ BASE_HOLD+2 ; CAPS ON = 32, CAPS OFF = 0
LAST_NFA .equ BASE_HOLD+4 ; NFA, VOC_PFA, CFA, PSP of last created word
LAST_THREAD .equ BASE_HOLD+6 ; used by QREVEAL
LAST_CFA .equ BASE_HOLD+8
CURRENT .equ BASE_HOLD+40 ; CURRENT dictionnary ptr
BASE .equ BASE_HOLD+42
LINE .equ BASE_HOLD+44 ; line in interpretation (initialized by NOECHO)
+
; --------------------------------------------------------------;
; RAM_ORG + $1E0 : free for user after source file compilation ;
; --------------------------------------------------------------;
ASMFW1 .equ BASE_HOLD+54
ASMFW2 .equ BASE_HOLD+56
ASMFW3 .equ BASE_HOLD+58
+RPT_WORD .equ BASE_HOLD+60
; ----------------------------------;
-; RAM_ORG + $1EE : free for user ;
+; RAM_ORG + $1F0 : free for user ;
; ----------------------------------;
-
; --------------------------------------------------
; RAM_ORG + $1FC : RAM SD_CARD SD_BUF 4 + 512 bytes
; --------------------------------------------------
SD_BUF .equ BASE_HOLD+78
SD_BUFEND .equ SD_BUF + 200h ; 512bytes
-
;-------------------------------------------------------------------------------
; INFO(DCBA) >= 256 bytes memory map (FRAM) :
;-------------------------------------------------------------------------------
; --------------------------
; FRAM INFO KERNEL CONSTANTS
; --------------------------
-
INI_THREAD .word THREADS ; used by ADDON_UTILITY.f
TERMBRW_RST .word TERMBRW_INI ; set by TERMINALBAUDRATE.inc
TERMMCTLW_RST .word TERMMCTLW_INI ; set by TERMINALBAUDRATE.inc
FREQ_KHZ .word FREQUENCY*1000 ; user use
.ENDIF
-SAVE_SYSRSTIV .word 05 ; value to identify first start after core recompiling
+SAVE_SYSRSTIV .word 0 ; value to identify first start after core recompiling
LPM_MODE .word CPUOFF+GIE ; LPM0 is the default mode
;LPM_MODE .word CPUOFF+GIE+SCG0 ; LPM1 is the default mode (disable FLL)
INIDP .word ROMDICT ; define RST_STATE
INIVOC .word lastvoclink ; define RST_STATE
-GPFLAGS .word 0 ; always usefull
+FORTHVERSION .word VERSIO ;
+FORTHADDON .word FADDON ;
.word RXON ; user use
.word RXOFF ; user use
.ENDIF ; SD_CARD_READ_WRITE
.ENDIF ; SD_CARD_LOADER
-
-
; -------------------------------
; VARIABLES that should be in RAM
; -------------------------------
; ---------------------------------------
FirstHandle .equ SD_FAT_LEVEL+22
-
; ---------------------------------------
; Handle structure
; ---------------------------------------
SDIB_ORG .equ PAD_ORG
SD_END .equ LoadStackEnd
-SD_LEN .equ SD_END-SD_ORG
.ELSE ; RAM_Size >= 2k all is in RAM
.ENDIF ; RAM_Size
+SD_LEN .equ SD_END-SD_ORG
.ENDIF ; SD_CARD_LOADER
;-------------------------------------------------------------------------------
; DEFINING EXECUTIVE WORDS - DTC model
;-------------------------------------------------------------------------------
-
-;-------------------------------------------------------------------------------
; very nice FAST FORTH added feature:
;-------------------------------------------------------------------------------
; as IP is always computed from the PC value, we can place low level to high level
rDODOES .reg r4
rDOCON .reg r5
rDOVAR .reg r6
-rDOCOL .reg R7 ; COLD defines xdocol as R7 content
+rDOCOL .reg R7
-L .reg R7
-M .reg r6 ; ex. PUSHM L,N
-N .reg r5
-P .reg r4
+R .reg r4
+Q .reg r5
+P .reg r6
+M .reg R7
; Scratch registers
Y .reg R8
TOS .reg R14 ; first PSP cell
PSP .reg R15 ; PSP = Parameters Stack Pointer (stack data)
+
mNEXT .MACRO ; return for low level words (written in assembler)
MOV @IP+,PC ; 4 fetch code address into PC, IP=PFA
.ENDM ; 4 cycles,1word = ITC -2cycles -1 word
.word $+2 ; 0 cycle
.ENDM ; 0 cycle, 1 word
+mSEMI .MACRO
+ MOV @RSP+,IP
+ MOV @IP+,PC
+ .ENDM
+
+;-------------------------------------------------------------------------------
+; mDODOES leave on parameter stack the PFA of a CREATE definition and execute Master word
+;-------------------------------------------------------------------------------
+
+mDODOES .MACRO ; compiled by DOES>
+ CALL rDODOES ; CALL xdodoes
+ .ENDM ; 1 word, 19 cycles (ITC-2)
+
+DODOES .equ 1284h ; 4 CALL rDODOES ; [rDODOES] is defind as xdodoes by COLD
+
+xdodoes ; -- a-addr ; 4 for CALL rDODOES
+ SUB #2,PSP ; 1
+ MOV TOS,0(PSP) ; 3 save TOS on parameters stack
+ MOV @RSP+,TOS ; 2 TOS = CFA address of master word, i.e. address of its first cell after DOES>
+ PUSH IP ; 3 save IP on return stack
+ MOV @TOS+,IP ; 2 IP = CFA of Master word, TOS = BODY address of created word
+ MOV @IP+,PC ; 4 Execute Master word
+
+;-------------------------------------------------------------------------------
+; mDOCON leave on parameter stack the [PFA] of a CONSTANT definition
+;-------------------------------------------------------------------------------
+
+mDOCON .MACRO ; compiled by CONSTANT
+ CALL rDOCON ; 1 word, 16 cycles (ITC+4)
+ .ENDM ;
+
+DOCON .equ 1285h ; 4 CALL rDOCON ; [rDOCON] is defined as xdocon by COLD
+
+xdocon ; -- constant ; 4 for CALL rDOCON
+ SUB #2,PSP ; 1
+ MOV TOS,0(PSP) ; 3 save TOS on parameters stack
+ MOV @RSP+,TOS ; 2 TOS = CFA address of master word CONSTANT
+ MOV @TOS,TOS ; 2 TOS = CONSTANT value
+ MOV @IP+,PC ; 4 execute next word
+ ; 16 = ITC (+4)
+
+;-------------------------------------------------------------------------------
+; mDOVAR leave on parameter stack the PFA of a VARIABLE definition
+;-------------------------------------------------------------------------------
+
+mDOVAR .MACRO ; compiled by VARIABLE
+ CALL rDOVAR ; 1 word, 14 cycles (ITC+4)
+ .ENDM ;
+
+DOVAR .equ 1286h ; CALL rDOVAR ; [rDOVAR] is defined as xdovar by COLD
+
+;https://forth-standard.org/standard/core/Rfrom
+;C R> -- x R: x -- pop from return stack ; CALL #RFROM performs DOVAR
+ FORTHWORD "R>"
+xdovar
+RFROM SUB #2,PSP ; 1
+ MOV TOS,0(PSP) ; 3
+ MOV @RSP+,TOS ; 2
+ mNEXT ; 4
.SWITCH DTC
.CASE 1 ; DOCOL = CALL rDOCOL
;-------------------------------------------------------------------------------
-
xdocol MOV @RSP+,W ; 2
PUSH IP ; 3 save old IP on return stack
MOV W,IP ; 1 set new IP to PFA
; 10 cycles
ASMtoFORTH .MACRO ; compiled by LO2HI
- CALL #EXIT ; 2 words, 10 cycles
- .ENDM ;
+ CALL #EXIT ; 10 cycles
+ .ENDM ; 2 words, 10 cycles
mDOCOL .MACRO ; compiled by : and by colon
- CALL rDOCOL ; 1 word, 14 cycles (CALL included) = ITC+4
- .ENDM ;
+ CALL rDOCOL ; 10 [rDOCOL] = xdocol
+ .ENDM ; 1 word, 14 cycles (CALL included) = ITC+4
-DOCOL1 .equ 1287h ; 4 CALL R7
+DOCOL1 .equ 1287h ; 4 CALL rDOCOL
;-------------------------------------------------------------------------------
.CASE 2 ; DOCOL = PUSH IP + CALL rEXIT
;-------------------------------------------------------------------------------
-rEXIT .reg R7 ; COLD defines EXIT as R7 content
-
ASMtoFORTH .MACRO ; compiled by LO2HI
- CALL rEXIT ; 1 word, 10 cycles
- .ENDM ;
+ CALL rDOCOL ; 10 [rDOCOL] = EXIT
+ .ENDM ; 1 word, 10 cycles
mDOCOL .MACRO ; compiled by : and by COLON
PUSH IP ; 3
- CALL rEXIT ; 10
+ CALL rDOCOL ; 10 [rDOCOL] = EXIT
.ENDM ; 2 words, 13 cycles = ITC+3
DOCOL1 .equ 120Dh ; 3 PUSH IP
-DOCOL2 .equ 1287h ; 4 CALL rEXIT
+DOCOL2 .equ 1287h ; 4 CALL rDOCOL
;-------------------------------------------------------------------------------
.CASE 3 ; inlined DOCOL
;-------------------------------------------------------------------------------
-R .reg R7 ; Scratch register
-
ASMtoFORTH .MACRO ; compiled by LO2HI
MOV PC,IP ; 1
ADD #4,IP ; 1
.ENDCASE ; DTC
;-------------------------------------------------------------------------------
-; mDOVAR leave on parameter stack the PFA of a VARIABLE definition
-;-------------------------------------------------------------------------------
-
-mDOVAR .MACRO ; compiled by VARIABLE
- CALL rDOVAR ; 1 word, 14 cycles (ITC+4)
- .ENDM ;
-
-DOVAR .equ 1286h ; CALL rDOVAR ; [rDOVAR] is defined as RFROM by COLD
-
-
-;-------------------------------------------------------------------------------
-; mDOCON leave on parameter stack the [PFA] of a CONSTANT definition
-;-------------------------------------------------------------------------------
-
-mDOCON .MACRO ; compiled by CONSTANT
- CALL rDOCON ; 1 word, 16 cycles (ITC+4)
- .ENDM ;
-
-DOCON .equ 1285h ; 4 CALL rDOCON ; [rDOCON] is defined as xdocon by COLD
-
-xdocon ; -- constant ; 4 for CALL rDOCON
- SUB #2,PSP ; 1
- MOV TOS,0(PSP) ; 3 save TOS on parameters stack
- MOV @RSP+,TOS ; 2 TOS = CFA address of master word CONSTANT
- MOV @TOS,TOS ; 2 TOS = CONSTANT value
- MOV @IP+,PC ; 4 execute next word
- ; 16 = ITC (+4)
-
-;-------------------------------------------------------------------------------
-; mDODOES leave on parameter stack the PFA of a CREATE definition and execute Master word
-;-------------------------------------------------------------------------------
-
-mDODOES .MACRO ; compiled by DOES>
- CALL rDODOES ; CALL xdodoes
- .ENDM ; 1 word, 19 cycles (ITC-2)
-
-DODOES .equ 1284h ; 4 CALL rDODOES ; [rDODOES] is defind as xdodoes by COLD
-
-xdodoes ; -- a-addr ; 4 for CALL rDODOES
- SUB #2,PSP ; 1
- MOV TOS,0(PSP) ; 3 save TOS on parameters stack
- MOV @RSP+,TOS ; 2 TOS = CFA address of master word, i.e. address of its first cell after DOES>
- PUSH IP ; 3 save IP on return stack
- MOV @TOS+,IP ; 2 IP = CFA of Master word, TOS = BODY address of created word
- MOV @IP+,PC ; 4 Execute Master word
-
-;-------------------------------------------------------------------------------
; INTERPRETER LOGIC
;-------------------------------------------------------------------------------
MOV @PSP+,TOS
mNEXT
-;https://forth-standard.org/standard/core/Rfrom
-;C R> -- x R: x -- pop from return stack ; CALL #RFROM performs DOVAR
- FORTHWORD "R>"
-RFROM SUB #2,PSP ; 1
- MOV TOS,0(PSP) ; 3
- MOV @RSP+,TOS ; 2
- mNEXT ; 4
+; moved to rDOVAR
+;;https://forth-standard.org/standard/core/Rfrom
+;;C R> -- x R: x -- pop from return stack ; CALL #RFROM performs DOVAR
+; FORTHWORD "R>"
+;RFROM SUB #2,PSP ; 1
+; MOV TOS,0(PSP) ; 3
+; MOV @RSP+,TOS ; 2
+; mNEXT ; 4
;https://forth-standard.org/standard/core/RFetch
;C R@ -- x R: x -- x fetch from rtn stk
;C DABS d1 -- |d1| absolute value
FORTHWORD "DABS"
DABBS AND #-1,TOS ; clear V, set N
- JGE DABBSEND ; JMP if positive
+ JGE DABBSEND ; if positive
DNEGATE XOR #-1,0(PSP)
XOR #-1,TOS
ADD #1,0(PSP)
FORTHWORD "<"
LESS MOV @PSP+,W ;2 W=n1
SUB TOS,W ;1 W=n1-n2 flags set
-LESSNEXT JL TOSTRUE ;2 signed
+ JL TOSTRUE ;2 signed
JGE TOSFALSE ;2 --> +5
;https://forth-standard.org/standard/core/more
;C > n1 n2 -- flag test n1>n2, signed
FORTHWORD ">"
GREATER SUB @PSP+,TOS ;2 TOS=n2-n1
- JMP LESSNEXT
-
-;-------------------------------------------------------------------------------
-; BRANCH and LOOP OPERATORS
-;-------------------------------------------------------------------------------
-
-;Z branch -- branch always
-BRAN MOV @IP,IP ; 2
- mNEXT ; 4
-
-;Z ?branch x -- branch if TOS = zero
-QBRAN CMP #0,TOS ; 1 test TOS value
-QBRAN1 MOV @PSP+,TOS ; 2 pop new TOS value (doesn't change flags)
- JZ bran ; 2 if TOS was zero, take the branch = 11 cycles
- ADD #2,IP ; 1 else skip the branch destination
- mNEXT ; 4 ==> branch not taken = 10 cycles
-
-;Z 0?branch x -- branch if TOS <> zero
-QZBRAN SUB #1,TOS ; 1 borrow (clear cy) if TOS was 0
- SUBC TOS,TOS ; 1 TOS=-1 if borrow was set
- JMP QBRAN1 ; 2
-
-
-;Z (do) n1|u1 n2|u2 -- R: -- sys1 sys2 run-time code for DO
-; n1|u1=limit, n2|u2=index
-xdo MOV #8000h,X ;2 compute 8000h-limit "fudge factor"
- SUB @PSP+,X ;2
- MOV TOS,Y ;1 loop ctr = index+fudge
- MOV @PSP+,TOS ;2 pop new TOS
- ADD X,Y ;1
- PUSHM #2,X ;4 PUSHM X,Y, i.e. PUSHM LIMIT, INDEX
- mNEXT ;4
-
-;Z (+loop) n -- R: sys1 sys2 -- | sys1 sys2
-; run-time code for +LOOP
-; Add n to the loop index. If loop terminates, clean up the
-; return stack and skip the branch. Else take the inline branch.
-xploop ADD TOS,0(RSP) ;4 increment INDEX by TOS value
- MOV @PSP+,TOS ;2 get new TOS, doesn't change flags
-xloopnext BIT #100h,SR ;2 is overflow bit set?
- JZ bran ;2 no overflow = loop
- ADD #2,IP ;1 overflow = loop done, skip branch ofs
-UNXLOOP ADD #4,RSP ;1 empty RSP
- mNEXT ;4 16~ taken or not taken xloop/loop
-
-
-;Z (loop) R: sys1 sys2 -- | sys1 sys2
-; run-time code for LOOP
-; Add 1 to the loop index. If loop terminates, clean up the
-; return stack and skip the branch. Else take the inline branch.
-; Note that LOOP terminates when index=8000h.
-xloop ADD #1,0(RSP) ;4 increment INDEX
- JMP xloopnext ;2
-
-;https://forth-standard.org/standard/core/UNLOOP
-;C UNLOOP -- R: sys1 sys2 -- drop loop parms
- FORTHWORD "UNLOOP"
-UNLOOP JMP UNXLOOP
-
-;https://forth-standard.org/standard/core/I
-;C I -- n R: sys1 sys2 -- sys1 sys2
-;C get the innermost loop index
- FORTHWORD "I"
-II SUB #2,PSP ;1 make room in TOS
- MOV TOS,0(PSP) ;3
- MOV @RSP,TOS ;2 index = loopctr - fudge
- SUB 2(RSP),TOS ;3
- mNEXT ;4 13~
-
-;https://forth-standard.org/standard/core/J
-;C J -- n R: 4*sys -- 4*sys
-;C get the second loop index
- FORTHWORD "J"
-JJ SUB #2,PSP ; make room in TOS
- MOV TOS,0(PSP)
- MOV 4(RSP),TOS ; index = loopctr - fudge
- SUB 6(RSP),TOS
- mNEXT
+ JL TOSTRUE ;2 signed
+ JGE TOSFALSE ;2 --> +5
;-------------------------------------------------------------------------------
; SYSTEM CONSTANTS
;-------------------------------------------------------------------------------
; ANS complement OPTION
;-------------------------------------------------------------------------------
- .IFDEF ANS_CORE_COMPLIANT
+ .IFDEF ANS_CORE_COMPLEMENT
.include "ADDON/ANS_COMPLEMENT.asm"
- .ELSEIF
-
-;-------------------------------------------------------------------------------
-; ALIGNMENT OPERATORS OPTION
-;-------------------------------------------------------------------------------
- .IFDEF ALIGNMENT ; included in ANS_COMPLEMENT
- .include "ADDON/ALIGNMENT.asm"
- .ENDIF ; ALIGNMENT
-
-;-------------------------------------------------------------------------------
-; PORTABILITY OPERATORS OPTION
-;-------------------------------------------------------------------------------
- .IFDEF PORTABILITY
- .include "ADDON/PORTABILITY.asm"
- .ENDIF ; PORTABILITY
-
-;-------------------------------------------------------------------------------
-; DOUBLE OPERATORS OPTION
-;-------------------------------------------------------------------------------
- .IFDEF DOUBLE ; included in ANS_COMPLEMENT
- .include "ADDON/DOUBLE.asm"
- .ENDIF ; DOUBLE
-
-;-------------------------------------------------------------------------------
-; ARITHMETIC OPERATORS OPTION
-;-------------------------------------------------------------------------------
- .IFDEF ARITHMETIC ; included in ANS_COMPLEMENT
- .include "/ADDON/ARITHMETIC.asm"
- .ENDIF ; ARITHMETIC
-
.ENDIF ; ANS_COMPLEMENT
;-------------------------------------------------------------------------------
JLO TODIGIT1 ;2 U<
ADD #7,W ;2
TODIGIT1 ADD #30h,W ;2
-HOLDW SUB #1,&HP ;3 store W=char --> -[HP]
+HOLDW SUB #1,&HP ;4 store W=char --> -[HP]
MOV &HP,Y ;3
MOV.B W,0(Y) ;3
mNEXT ;4 26 words
JNZ NUM1 ;2
CMP #0,TOS ;1 then test ud2hi (generally true)
JNZ NUM1 ;2
- MOV @RSP+,IP ;2
- mNEXT ;4 10 words, about 241/417 cycles/char
+ mSEMI ;6 10 words, about 241/417 cycles/char
;https://forth-standard.org/standard/core/num-end
;C #> udlo:udhi -- c-addr u end conversion, get string
;-------------------------------------------------------------------------------
;https://forth-standard.org/standard/core/HERE
-;C HERE -- addr returns dictionary ptr
+;C HERE -- addr returns memory ptr
FORTHWORD "HERE"
HERE SUB #2,PSP
MOV TOS,0(PSP)
mNEXT
;https://forth-standard.org/standard/core/ALLOT
-;C ALLOT n -- allocate n bytes in dict
+;C ALLOT n -- allocate n bytes
FORTHWORD "ALLOT"
ALLOT ADD TOS,&DDP
MOV @PSP+,TOS
mNEXT
;https://forth-standard.org/standard/core/CComma
-;C C, char -- append char to dict
+;C C, char -- append char
FORTHWORD "C,"
CCOMMA MOV &DDP,W
MOV.B TOS,0(W)
MOV @PSP+,TOS
mNEXT
+;-------------------------------------------------------------------------------
+; BRANCH and LOOP OPERATORS
+;-------------------------------------------------------------------------------
+
+;Z branch -- branch always
+BRAN MOV @IP,IP ; 2
+ mNEXT ; 4
+
+;Z ?branch x -- branch if TOS = zero
+QBRAN CMP #0,TOS ; 1 test TOS value
+QBRAN1 MOV @PSP+,TOS ; 2 pop new TOS value (doesn't change flags)
+ JZ bran ; 2 if TOS was zero, take the branch = 11 cycles
+ ADD #2,IP ; 1 else skip the branch destination
+ mNEXT ; 4 ==> branch not taken = 10 cycles
+
+;Z 0?branch x -- branch if TOS <> zero
+QZBRAN SUB #1,TOS ; 1 borrow (clear cy) if TOS was 0
+ SUBC TOS,TOS ; 1 TOS=-1 if borrow was set
+ JMP QBRAN1 ; 2
+
+
+;Z (do) n1|u1 n2|u2 -- R: -- sys1 sys2 run-time code for DO
+; n1|u1=limit, n2|u2=index
+xdo MOV #8000h,X ;2 compute 8000h-limit "fudge factor"
+ SUB @PSP+,X ;2
+ MOV TOS,Y ;1 loop ctr = index+fudge
+ MOV @PSP+,TOS ;2 pop new TOS
+ ADD X,Y ;1
+ PUSHM #2,X ;4 PUSHM X,Y, i.e. PUSHM LIMIT, INDEX
+ mNEXT ;4
+
+;Z (+loop) n -- R: sys1 sys2 -- | sys1 sys2
+; run-time code for +LOOP
+; Add n to the loop index. If loop terminates, clean up the
+; return stack and skip the branch. Else take the inline branch.
+xploop ADD TOS,0(RSP) ;4 increment INDEX by TOS value
+ MOV @PSP+,TOS ;2 get new TOS, doesn't change flags
+xloopnext BIT #100h,SR ;2 is overflow bit set?
+ JZ bran ;2 no overflow = loop
+ ADD #2,IP ;1 overflow = loop done, skip branch ofs
+UNXLOOP ADD #4,RSP ;1 empty RSP
+ mNEXT ;4 16~ taken or not taken xloop/loop
+
+
+;Z (loop) R: sys1 sys2 -- | sys1 sys2
+; run-time code for LOOP
+; Add 1 to the loop index. If loop terminates, clean up the
+; return stack and skip the branch. Else take the inline branch.
+; Note that LOOP terminates when index=8000h.
+xloop ADD #1,0(RSP) ;4 increment INDEX
+ JMP xloopnext ;2
+
+;https://forth-standard.org/standard/core/UNLOOP
+;C UNLOOP -- R: sys1 sys2 -- drop loop parms
+ FORTHWORD "UNLOOP"
+UNLOOP JMP UNXLOOP
+
+;https://forth-standard.org/standard/core/I
+;C I -- n R: sys1 sys2 -- sys1 sys2
+;C get the innermost loop index
+ FORTHWORD "I"
+II SUB #2,PSP ;1 make room in TOS
+ MOV TOS,0(PSP) ;3
+ MOV @RSP,TOS ;2 index = loopctr - fudge
+ SUB 2(RSP),TOS ;3
+ mNEXT ;4 13~
+
+;https://forth-standard.org/standard/core/J
+;C J -- n R: 4*sys -- 4*sys
+;C get the second loop index
+ FORTHWORD "J"
+JJ SUB #2,PSP ; make room in TOS
+ MOV TOS,0(PSP)
+ MOV 4(RSP),TOS ; index = loopctr - fudge
+ SUB 6(RSP),TOS
+ mNEXT
+
; ------------------------------------------------------------------------------
; TERMINAL I/O, input part
; ------------------------------------------------------------------------------
PFAKEY .word BODYKEY ; Parameter Field Address (PFA) of KEY, with default value
BODYKEY MOV &TERM_RXBUF,Y ; empty buffer
SUB #2,PSP ; 1 push old TOS..
- MOV TOS,0(PSP) ; 4 ..onto stack
+ MOV TOS,0(PSP) ; 3 ..onto stack
CALL #RXON
KEYLOOP BIT #UCRXIFG,&TERM_IFG ; loop if bit0 = 0 in interupt flag register
JZ KEYLOOP ;
.IFDEF SD_CARD_LOADER
.include "forthMSP430FR_SD_ACCEPT.asm"
-DEFER_ACCEPT ; CIB (Current Input Buffer) and ACCEPT must to be redirected for SD_LOAD usage
.ENDIF
- .IFNDEF DEFER_ACCEPT
-
-; : REFILL TIB DUP TIB_LEN ACCEPT ; -- TIB TIB len shared by QUIT and [ELSE]
-REFILL SUB #6,PSP ;2
- MOV TOS,4(PSP) ;3
- MOV #TIB_LEN,TOS ;2
- MOV #TIB_ORG,0(PSP) ;4
- MOV @PSP,2(PSP) ;4
- JMP ACCEPT ;2
+ .IFDEF DEFER_ACCEPT
;https://forth-standard.org/standard/core/ACCEPT
;C ACCEPT addr addr len -- addr len' get line at addr to interpret len' chars
FORTHWORD "ACCEPT"
-ACCEPT
+ACCEPT MOV @PC+,PC ;3 Code Field Address (CFA) of ACCEPT
+PFAACCEPT .word BODYACCEPT ; Parameter Field Address (PFA) of ACCEPT
+BODYACCEPT ; BODY of ACCEPT = default execution of ACCEPT
.ELSE
-; CIB -- addr of Current Input Buffer
- FORTHWORD "CIB" ; constant, may be redirected as SDIB_ORG by OPEN.
-FCIB mDOCON ; Code Field Address (CFA) of FCIB
-PFACIB .WORD TIB_ORG ; Parameter Field Address (PFA) of FCIB
-
-; : REFILL CIB DUP TIB_LEN ACCEPT ; -- CIB CIB len shared by QUIT and [ELSE]
-REFILL SUB #6,PSP ;2
- MOV TOS,4(PSP) ;3
- MOV #TIB_LEN,TOS ;2
- MOV &PFACIB,0(PSP) ;5
- MOV @PSP,2(PSP) ;4
- JMP ACCEPT ;2
-
;https://forth-standard.org/standard/core/ACCEPT
;C ACCEPT addr addr len -- addr len' get line at addr to interpret len' chars
FORTHWORD "ACCEPT"
-ACCEPT MOV @PC+,PC ;3 Code Field Address (CFA) of ACCEPT
-PFAACCEPT .word BODYACCEPT ; Parameter Field Address (PFA) of ACCEPT
-BODYACCEPT ; BODY of ACCEPT = default execution of ACCEPT
+ACCEPT
- .ENDIF ; DEFER_ACCEPT
+ .ENDIF
.IFDEF HALFDUPLEX ; to use FAST FORTH with half duplex input terminal (bluetooth or wifi connexion)
MOV #0Dh,T ;2 T = 'CR' to speed up char loop in part II > prepare stack and registers for TERMINAL_INT use
MOV #20h,S ;2 S = 'BL' to speed up char loop in part II )
MOV #AYEMIT_RET,IP ;2 IP = return for YEMIT )
- BIT #UCRXIFG,&TERM_IFG ;3 RX_Int ?
+ BIT #UCRXIFG,&TERM_IFG ;3 RX_Int ?
JZ ACCEPTNEXT ;2 no : case of quiet input terminal
- MOV &TERM_RXBUF,Y ;3 yes: clear RX_Int
+ MOV &TERM_RXBUF,Y ;3 yes: clear RX_Int
CMP #0Ah,Y ;2 received char = LF ? (end of downloading ?)
JNZ RXON ;2 no : send XON then RET to AKEYREAD1 to process first char of new line.
ACCEPTNEXT ADD #2,RSP ;1 replace XON_ret = AKEYREAD1 by XON_ret = SLEEP
- MOV #SLEEP,X ;2
+ MOV #SLEEP,X ;2
PUSHM #5,IP ;7 r-- ACCEPT_ret XOFF_ret YEMIT_ret 'BL' 'CR' bound XON_ret
; ----------------------------------;
+
+; ----------------------------------;
RXON ;
; ----------------------------------;
.IFDEF TERMINAL3WIRES ;
RET ;4 to BACKGND (End of file download or quiet input) or AKEYREAD1 (get next line of file downloading)
; ----------------------------------; ...or user defined
-
; ----------------------------------;
RXOFF ;
; ----------------------------------;
RET ;4 to ENDACCEPT, ...or user defined
; ----------------------------------;
-
; ----------------------------------;
ASMWORD "SLEEP" ; may be redirected
SLEEP MOV @PC+,PC ;3 Code Field Address (CFA) of SLEEP
PFASLEEP .word BODYSLEEP ; Parameter Field Address (PFA) of SLEEP, with default value
-BODYSLEEP BIS &LPM_MODE,SR ;3 enter in LPMx sleep mode with GIE=1
+BODYSLEEP
+ BIS &LPM_MODE,SR ;3 enter in LPMx sleep mode with GIE=1
; ----------------------------------; default FAST FORTH mode (for its input terminal use) : LPM0.
;###############################################################################################################
JMP SLEEP ;2 here is the return for any interrupts, else TERMINAL_INT :-)
; ==================================;
-
; **********************************;
TERMINAL_INT ; <--- TEMR RX interrupt vector, delayed by the LPMx wake up time
; **********************************; if wake up time increases, max bauds rate decreases...
; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
AKEYREAD1 CMP.B S,Y ;1 printable char ?
JHS ASTORETEST ;2 yes
- CMP.B T,Y ;1 char = CR ?
+ CMP.B T,Y ;1 CR ?
JZ RXOFF ;2 then RET to ENDACCEPT
; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;+ 4 to send RXOFF
; stops the first stopwatch ;= first bottleneck, best case result: 27~ + LPMx wake_up time..
JZ YEMIT1 ; 2 yes: send echo then loopback
MOV.B Y,0(TOS) ; 3 no: store char @ Ptr, send echo then loopback
ADD #1,TOS ; 1 increment Ptr
-YEMIT1
+YEMIT1 ;
BIT #UCTXIFG,&TERM_IFG ; 3 wait the sending end of previous char, useless at high baudrates
JZ YEMIT1 ; 2 but there's no point in wanting to save time here:
-YEMIT2
+YEMIT2 ;
.IFDEF TERMINAL5WIRES ;
BIT.B #CTS,&HANDSHAKIN ; 3
JNZ YEMIT2 ; 2
- .ENDIF
+ .ENDIF ;
YEMIT ; hi7/4~ lo:12/9~ send/send_not echo to terminal
.word 4882h ; 4882h = MOV Y,&<next_adr>
.word TERM_TXBUF ; 3
mNEXT ; 4
; ----------------------------------;
AYEMIT_RET FORTHtoASM ; 0 YEMII NEXT address
- SUB #2,IP ; 1 set YEMIT NEXT address to AYEMIT_RET
+ SUB #2,IP ; 1 reset YEMIT NEXT address to AYEMIT_RET
WAITaKEY BIT #UCRXIFG,&TERM_IFG ; 3 new char in TERMRXBUF ?
JNZ AKEYREAD ; 2 yes
JZ WAITaKEY ; 2 no
; ----------------------------------;
ENDACCEPT ; --- Org Ptr r-- ACCEPT_ret
; ----------------------------------;
- MOV #LPM0+GIE,&LPM_MODE ; reset LPM_MODE to default mode LPM0 for next line of input stream
CMP #0,&LINE ; if LINE <> 0...
JZ ACCEPTEND ;
ADD #1,&LINE ; ...increment LINE
ACCEPTEND SUB @PSP+,TOS ; -- len'
MOV @RSP+,IP ; 2 return to INTERPRET with GIE=0: FORTH is protected against any interrupt...
- .IFDEF TOTAL
+ .IFDEF TOTAL ;
POPM #4,R7 ;6 pop R4,R5,R6,R7
- .ENDIF
+ .ENDIF ;
+; ----------------------------------;
+ MOV #LPM0+GIE,&LPM_MODE ; reset LPM_MODE to default mode LPM0 for next line of input stream
+; ----------------------------------;
mNEXT ; ...until next falling down to LPMx mode of (ACCEPT) part1,
; **********************************; i.e. when the FORTH interpreter has no more to do.
+ .IFDEF DEFER_ACCEPT
+
+; CIB -- addr of Current Input Buffer
+ FORTHWORD "CIB" ; constant, may be redirected as SDIB_ORG by OPEN.
+FCIB mDOCON ; Code Field Address (CFA) of FCIB
+PFACIB .WORD TIB_ORG ; Parameter Field Address (PFA) of FCIB
+
+; : REFILL CIB DUP TIB_LEN ACCEPT ; -- CIB CIB len shared by QUIT and [ELSE]
+REFILL SUB #6,PSP ;2
+ MOV TOS,4(PSP) ;3
+ MOV #TIB_LEN,TOS ;2
+ MOV &PFACIB,0(PSP) ;5
+ MOV @PSP,2(PSP) ;4
+ JMP ACCEPT ;2
+
+ .ELSE
+
+; : REFILL TIB DUP TIB_LEN ACCEPT ; -- TIB TIB len shared by QUIT and [ELSE]
+REFILL SUB #6,PSP ;2
+ MOV TOS,4(PSP) ;3
+ MOV #TIB_LEN,TOS ;2
+ MOV #TIB_ORG,0(PSP) ;4
+ MOV @PSP,2(PSP) ;4
+ JMP ACCEPT ;2
+
+ .ENDIF
+
; ------------------------------------------------------------------------------
; TERMINAL I/O, output part
; ------------------------------------------------------------------------------
FORTHWORD "TYPE"
TYPE CMP #0,TOS
JZ TWODROP ; abort fonction
- .word 0151Eh ;5 PUSM TOS,IP R-- len,IP
+ PUSHM #2,TOS ;4 R-- len,IP
MOV #TYPE_NEXT,IP
-TYPELOOP MOV @PSP,Y ;2 -- adr adr ; 30~ char loop
+TYPELOOP MOV @PSP,Y ;2 -- adr x ; 30~ char loop
MOV.B @Y+,TOS ;2
MOV Y,0(PSP) ;3 -- adr+1 char
SUB #2,PSP ;1 emit consumes one cell
ADDC #0,IP ; 1 -- addr u IP=addr+u aligned
mNEXT ; 4 16~
- .IFDEF LOWERCASE
-
- FORTHWORD "CAPS_ON"
-CAPS_ON MOV #-1,&CAPS ; state by default
- mNEXT
-
- FORTHWORD "CAPS_OFF"
-CAPS_OFF MOV #0,&CAPS
- mNEXT
-
-;https://forth-standard.org/standard/core/Sq
-;C S" -- compile in-line string
- FORTHWORDIMM "S\34" ; immediate
-SQUOTE mDOCOL
- .word lit,XSQUOTE,COMMA
-SQUOTE1 .word CAPS_OFF
- .word lit,'"',WORDD ; -- c-addr (= HERE)
- .word CAPS_ON
-
- .ELSE
-
;https://forth-standard.org/standard/core/Sq
;C S" -- compile in-line string
FORTHWORDIMM "S\34" ; immediate
-SQUOTE mDOCOL
+SQUOTE MOV #0,&CAPS ; CAPS OFF
+ mDOCOL
.word lit,XSQUOTE,COMMA
-SQUOTE1 .word lit,'"',WORDD ; -- c-addr (= HERE)
-
- .ENDIF ; LOWERCASE
-
+SQUOTE1 .word lit,'"',WORDD ; -- c-addr (= HERE)
FORTHtoASM
MOV @RSP+,IP
+ MOV #32,&CAPS ; CAPS ON
MOV.B @TOS,TOS ; -- u
SUB #1,TOS ; -1 byte
ADD TOS,&DDP
;https://forth-standard.org/standard/core/WORD
;C WORD char -- addr Z=1 if len=0
-; parse a word delimited by char separator
-; "word" is capitalized
-; TOIN is the relative displacement in the ascii string
+; parse a word delimited by char separator, by default "word" is capitalized
FORTHWORD "WORD"
WORDD MOV #SOURCE_LEN,S ;2 -- separator
MOV @S+,X ;2 X = str_len
JZ SKIPCHARLOO ;2 -- separator if yes
SCANWORD SUB #1,W ;1
MOV #96,T ;2 T = 96 = ascii(a)-1 (test value set in a register before SCANWORD loop)
-
SCANWORDLOO ; -- separator 15/23 cycles loop for upper/lower case char... write words in upper case !
MOV.B S,0(Y) ;3 first time make room in dst for word length, then put char @ dst.
CMP W,X ;1 str_ptr = str_end ?
ADD #1,Y ;1 increment dst just before test loop
CMP.B S,T ;1 char U< 'a' ? ('a'-1 U>= char) this condition is tested at each loop
JC SCANWORDLOO ;2 15~ upper case char loop
- .IFDEF LOWERCASE ;
-QCAPS CMP #0,&CAPS ;3 CAPS is OFF ? (available only for ABORT" ." .( )
- JZ SCANWORDLOO ;2 yes, don't convert lower to upper case
- .ENDIF ; LOWERCASE ; here CAPS is ON
CMP.B #123,S ;2 char U>= 'z'+1 ?
JC SCANWORDLOO ;2 if yes
- SUB.B #32,S ;2 convert lowercase char to uppercase
- JMP SCANWORDLOO ;2
+ SUB.B &CAPS,S ;3 convert lowercase char to uppercase if CAPS ON (CAPS=32)
+ JMP SCANWORDLOO ;2 24~ lower case char loop
SCANWORDEND
SUB &SOURCE_ADR,W ;3 -- separator W=str_ptr - str_org = new >IN (first char separator next)
MOV W,&TOIN ;3 update >IN
;https://forth-standard.org/standard/core/FIND
;C FIND c-addr -- c-addr 0 if not found ; flag Z=1
-;C xt -1 if found ; flag Z=0
-;C xt 1 if immediate ; flag Z=0
+;C CFA -1 if found ; flag Z=0
+;C CFA 1 if immediate ; flag Z=0
; compare WORD at c-addr (HERE) with each of words in each of listed vocabularies in CONTEXT
; FIND to WORDLOOP : 14/20 cycles,
-; mismatch word loop: 13 cycles on len, +8 cycles on first char,
+; mismatch word loop: 13 cycles on len, +7 cycles on first char,
; +10 cycles char loop,
; VOCLOOP : 12/18 cycles,
; WORDFOUND to end : 21 cycles.
LENCOMP CMP.B rDOCON,Y ;1 compare lenght
JNZ WORDLOOP ;2 -- ???? NFA 13~ word loop on lenght mismatch
MOV S,W ;1 W=c-addr
-CHARLOOP ADD #1,W ;1
-CHARCOMP CMP.B @X+,0(W) ;4 compare chars
- JNZ WORDLOOP ;2 -- ???? NFA 21~ word loop on first char mismatch
+CHARCOMP CMP.B @X+,1(W) ;4 compare chars
+ JNZ WORDLOOP ;2 -- ???? NFA 20~ word loop on first char mismatch
+ ADD #1,W ;1
SUB.B #1,Y ;1 decr count
- JNZ CHARLOOP ;2 -- ???? NFA 10~ char loop
+ JNZ CHARCOMP ;2 -- ???? NFA 10~ char loop
WORDFOUND BIT #1,X ;1
ADDC #0,X ;1
.IFDEF MPY_32
;https://forth-standard.org/standard/core/toNUMBER
-;C convert a string to double number until count2 = 0 or until not convertible char
-;C >NUMBER ud1lo|ud1hi addr1 count1 -- ud2lo|ud2hi addr2 count2
+;C convert a string to double number until cnt2 = 0 or until not convertible char
+;C >NUMBER ud1lo ud1hi addr1 cnt1 -- ud2lo ud2hi addr2 cnt2
FORTHWORD ">NUMBER" ; 23 cycles + 32/34 cycles DEC/HEX char loop
-TONUMBER MOV @PSP+,S ;2 S = adr
- MOV @PSP+,Y ;2 Y = ud1hi
- MOV @PSP,X ;2 X = ud1lo
- SUB #4,PSP ;1
+TONUMBER MOV @PSP+,S ;2 -- ud1lo ud1hi cnt1 S = addr1
+ MOV @PSP+,Y ;2 -- ud1lo cnt1 Y = ud1hi
+ MOV @PSP,X ;2 -- x cnt1 X = ud1lo
+ SUB #4,PSP ;1 -- x x x cnt
MOV &BASE,T ;3
-TONUMLOOP MOV.B @S,W ;2 -- ud1lo ud1hi adr count W=char
-DDIGITQ SUB.B #30h,W ;2 skip all chars < '0'
- CMP.B #10,W ;2 char was U< 10 ?
- JLO DDIGITQNEXT ;2 no
+TONUMLOOP MOV.B @S,W ;2 -- x x x cnt W=char
+DDIGITQ SUB.B #30h,W ;2 skip all chars < '0'
+ CMP.B #10,W ;2 char was U< 10 (U< ':') ?
+ JLO DDIGITQNEXT ;2 no
SUB.B #7,W ;2
CMP.B #10,W ;2
- JLO TONUMEND ;2 skip all chars between "9" and "A"
-DDIGITQNEXT CMP T,W ;1 digit-base
- JHS TONUMEND ;2 -- ud1lo ud1hi adr count abort if < 0 or >= base
- MOV X,&MPY32L ;3 Load 1st operand (ud1lo)
- MOV Y,&MPY32H ;3 Load 1st operand (ud1hi)
- MOV T,&OP2 ;3 Load 2nd operand with BASE
- MOV &RES0,X ;3 lo result in X (ud2lo)
- MOV &RES1,Y ;3 hi result in Y (ud2hi)
- ADD W,X ;1 ud2lo + digit
- ADDC #0,Y ;1 ud2hi + carry
-TONUMPLUS ADD #1,S ;1 -- ud1lo ud1hi adr+1 count S=adr+1
- SUB #1,TOS ;1 -- ud1lo ud1hi adr+1 count-1
- JNZ TONUMLOOP ;2 if count <>0
-TONUMEND MOV S,0(PSP) ;3 -- ud1lo ud1hi adr2 count2
- MOV Y,2(PSP) ;3 -- ud1lo ud2hi adr2 count2
- MOV X,4(PSP) ;3 -- ud2lo ud2hi adr2 count2
+ JLO TONUMEND ;2 -- x x x cnt exit for all chars between "9" and "A"
+DDIGITQNEXT CMP T,W ;1 digit-base
+ JHS TONUMEND ;2 -- x x x cnt exit if < 0 or >= base
+ MOV X,&MPY32L ;3 Load 1st operand (ud1lo)
+ MOV Y,&MPY32H ;3 Load 1st operand (ud1hi)
+ MOV T,&OP2 ;3 Load 2nd operand with BASE
+ MOV &RES0,X ;3 lo result in X (ud2lo)
+ MOV &RES1,Y ;3 hi result in Y (ud2hi)
+ ADD W,X ;1 ud2lo + digit
+ ADDC #0,Y ;1 ud2hi + carry
+TONUMPLUS ADD #1,S ;1 adr+1
+ SUB #1,TOS ;1 -- x x x cnt cnt-1
+ JNZ TONUMLOOP ;2 if count <>0
+TONUMEND MOV S,0(PSP) ;3 -- x x addr2 cnt2
+ MOV Y,2(PSP) ;3 -- x ud2hi addr2 cnt2
+ MOV X,4(PSP) ;3 -- ud2lo ud2hi addr2 cnt2
mNEXT ;4 41 words
; ?NUMBER makes the interface between >NUMBER and INTERPRET; it's a subset of INTERPRET.
; convert a string to a signed number; FORTH 2012 prefixes $, %, # are recognized
; 32 bits numbers (with decimal point) and fixed point signed numbers (with a comma) are recognized.
-; prefixes # % $ - are processed before calling >NUMBER
+; prefixes # % $ and - are processed before calling >NUMBER
; not convertible chars '.' (double) and ',' (fixed point) are processed as >NUMBER exits
-;Z ?NUMBER c-addr -- n -1 if convert ok ; flag Z=0
-;Z c-addr -- c-addr 0 if convert ko ; flag Z=1
-QNUMBER BIC #UF9,SR ;2 reset flag UF9, before use as decimal point flag
+;Z ?NUMBER addr -- n|d -1 if convert ok ; flag Z=0, UF9=1 if double
+;Z addr -- addr 0 if convert ko ; flag Z=1
+QNUMBER
+ .IFDEF DOUBLE_NUMBERS
+ BIC #UF9,SR ;2 reset flag UF9, before use as double number flag
+ .ENDIF
MOV &BASE,T ;3 T=BASE
MOV #0,S ;1 S=sign of result
PUSHM #3,IP ;5 R-- IP sign base
- MOV #QNUMNEXT,IP ;2 set QNUMNEXT as return from >NUMBER
+ MOV #TONUMEXIT,IP ;2 set TONUMEXIT as return from >NUMBER
MOV #0,X ;1 X=ud1lo
MOV #0,Y ;1 Y=ud1hi
- SUB #8,PSP ;1 -- x x x x c-addr save TOS and make room for >NUMBER
- MOV TOS,6(PSP) ;3 -- c-addr x x x c-addr
+ SUB #8,PSP ;1 -- x x x x addr save TOS and make room for >NUMBER
+ MOV TOS,6(PSP) ;3 -- addr x x x addr
MOV TOS,S ;1 S=addrr
- MOV.B @S+,TOS ;2 -- c-addr x x x cnt TOS=count
- MOV.B @S,W ;2 W=char
- SUB.B #',',W ;2
- JHS QSIGN ;2 for current base, and for ',' or '.' process
- SUB.B #1,W ;1
-QBINARY MOV #2,T ;3 preset base 2
- ADD.B #8,W ;1 '%' + 8 = '-' binary number ?
+ MOV.B @S+,TOS ;2 -- addr x x x cnt TOS=count
+QNUMLDCHAR MOV.B @S,W ;2 W=char
+ CMP.B #'-',W ;2
+ JLO QBINARY ;2 jump if char < '-'
+ JNZ DDIGITQ ;2 -- addr x x x cnt jump if char > '-'
+ MOV #-1,2(RSP) ;3 R-- IP sign base set sign flag
+ JMP TONUMPLUS ;2
+QBINARY MOV #2,T ;1 preset base 2
+ SUB.B #'%',W ;2 binary number ?
JZ PREFIXED ;2
-QDECIMAL ADD #8,T ;4
- ADD.B #2,W ;1 '#' + 2 = '%' decimal number ?
+QDECIMAL ADD #8,T ;1
+ ADD.B #2,W ;1 decimal number ?
JZ PREFIXED ;2
-QHEXA MOV #16,T ;4
- SUB.B #1,W ;2 '$' - 1 = '#' hex number ?
- JNZ TONUMLOOP ;2 -- c-addr ud=0 x x other cases will cause >NUMBER error
+QHEXA MOV #16,T ;1
+ SUB.B #1,W ;1 hex number ?
+ JNZ TONUMLOOP ;2 -- addr x x x cnt other cases will cause >NUMBER exit
PREFIXED ADD #1,S ;1
- SUB #1,TOS ;1 -- c-addr ud=0 x count S=adr+1 TOS=count-1
- MOV.B @S,W ;2 X=2th char, W=adr
- SUB.B #',',W ;2
-QSIGN CMP.B #1,W ;1
- JNZ TONUMLOOP ;2 for positive number and for , or . process
- MOV #-1,2(RSP) ;3 R-- IP sign base
- JMP TONUMPLUS ;2
-; ----------------------------------;40
-QNUMNEXT FORTHtoASM ; -- c-addr ud2lo-hi addr2 cnt2 R-- IP sign BASE S=addr2
- CMP #0,TOS ;1 cnt2=0 : conversion is ok ?
- JZ QNUMNEXT1 ;2 yes
- BIT #UF9,SR ;2 already flagged? (to discard repeated points or repeated commas)
- JNZ QNUMNEXT1 ;2 abort
+ SUB #1,TOS ;1 -- addr x x x cnt-1 S=adr+1 TOS=count-1
+ JMP QNUMLDCHAR ;2
+; ----------------------------------;
+TONUMEXIT FORTHtoASM ; -- addr ud2lo-hi addr2 cnt2 R-- IP sign BASE S=addr2
+; ----------------------------------;
+ .IFDEF DOUBLE_NUMBERS ; plus 11 words
+ JZ QNUMNEXT ;2 if conversion is ok
+ BIT #UF9,SR ;2 already 1 ?
+ JNZ QNUMNEXT ;2 yes, goto QNUMNEXT, exit then abort on conv. error
BIS #UF9,SR ;2 set double number flag
- .IFDEF FIXPOINT_INPUT ;
-; ----------------------------------;48
-QQNUMDP CMP.B #'.',0(S) ;4 rejected char by >NUMBER = decimal point ?
- JNZ QQcomma ;2 no
- SUB #2,IP ;1 yes: set QNUMNEXT as return from >NUMBER
- JMP TONUMPLUS ;2 loop back to >NUMBER to terminate conversion
-QQcomma CMP.B #',',0(S) ;5 rejected char by >NUMBER is a comma ?
- JNZ QNUMNEXT1 ;2 no
-S15Q16 MOV TOS,W ;1 -- c-addr ud2lo x x x yes W=cnt2
- MOV #0,X ;1 -- c-addr ud2lo x 0 x init X = ud2lo' = 0
-S15Q16LOOP MOV X,2(PSP) ;3 -- c-addr ud2lo ud2lo' ud2lo' x 0(PSP) = ud2lo'
+ .ENDIF ;
+ .IFDEF DOUBLE_INPUT
+ SUB #2,IP ;1 reset TONUMEXIT as return from >NUMBER
+ CMP.B #'.',0(S) ;4 rejected char by >NUMBER = decimal point ?
+ JZ TONUMPLUS ;2 yes: loop back to >NUMBER to terminate conversion
+ .ENDIF
+ .IFDEF FIXPOINT_INPUT ; plus 40 words
+ CMP.B #',',0(S) ;4 rejected char by >NUMBER is a comma ?
+ JNZ QNUMNEXT ;2 no, goto QNUMNEXT, exit then abort on conv. error
+S15Q16 MOV TOS,W ;1 -- addr ud2lo x x x yes W=cnt2
+ MOV #0,X ;1 -- addr ud2lo x 0 x init X = ud2lo' = 0
+S15Q16LOOP MOV X,2(PSP) ;3 -- addr ud2lo ud2lo' ud2lo' x 0(PSP) = ud2lo'
SUB.B #1,W ;1 decrement cnt2
MOV W,X ;1 X = cnt2-1
ADD S,X ;1 X = end_of_string-1, first...
CMP.B #10,X ;2
JLO QS15Q16DIGI ;2
SUB.B #7,X ;2
- CMP.B #10,X ;2
- JLO S15Q16EOC ;2 skip all chars between "9" and "A"
+ CMP.B #10,X ;2 to skip all chars between "9" and "A"
+ JLO S15Q16EOC ;2 ens of conversion
QS15Q16DIGI CMP T,X ;1 R-- IP sign BASE is X a digit ?
- JHS S15Q16EOC ;2 -- c-addr ud2lo ud2lo' x ud2lo' if no
- MOV X,0(PSP) ;3 -- c-addr ud2lo ud2lo' digit x
- MOV T,TOS ;1 -- c-addr ud2lo ud2lo' digit base R-- IP sign base
+ JHS S15Q16EOC ;2 -- addr ud2lo ud2lo' x ud2lo' if no goto QNUMNEXT (abort then)
+ MOV X,0(PSP) ;3 -- addr ud2lo ud2lo' digit x
+ MOV T,TOS ;1 -- addr ud2lo ud2lo' digit base R-- IP sign base
PUSHM #3,S ;6 PUSH S,T,W: R-- IP sign base addr2 base cnt2
- CALL #MUSMOD ;4 -- c-addr ud2lo ur uqlo uqhi
+ CALL #MUSMOD ;4 -- addr ud2lo ur uqlo uqhi
POPM #3,S ;6 restore W,T,S: R-- IP sign BASE
JMP S15Q16LOOP ;2 W=cnt
-S15Q16EOC MOV 4(PSP),2(PSP) ;5 -- c-addr ud2lo ud2hi uqlo x ud2lo from >NUMBER part1 becomes here ud2hi=S15 part2
- MOV @PSP,4(PSP) ;4 -- c-addr ud2lo ud2hi x x uqlo becomes ud2lo
- MOV W,TOS ;1 -- c-addr ud2lo ud2hi x cnt2
- CMP.B #0,TOS ;1 TOS = 0 if end of conversion char = ',' (happy end)
- .ELSE ; no FIXPOINT_INPUT
+S15Q16EOC MOV 4(PSP),2(PSP) ;5 -- addr ud2lo ud2hi uqlo x ud2lo from >NUMBER part1 becomes here ud2hi part of Q15.16
+ MOV @PSP,4(PSP) ;4 -- addr ud2lo ud2hi x x uqlo becomes ud2lo part of Q15.16
+ MOV W,TOS ;1 -- addr ud2lo ud2hi x cnt2
+ CMP.B #0,TOS ;1 TOS = 0 if end of conversion (happy end)
+ .ENDIF ;
; ----------------------------------;
-QQNUMDP CMP.B #'.',0(S) ;4 rejected char by >NUMBER = decimal point ?
- JNZ QNUMNEXT1 ;2 no
- SUB #2,IP ;1 yes: set QNUMNEXT address as >NUMBER return
- JMP TONUMPLUS ;2 loop back to >NUMBER to terminate conversion
- .ENDIF; endof FIXPOINT_INPUT;
-; ----------------------------------;54
-QNUMNEXT1 POPM #3,IP ;4 -- c-addr ud2lo-hi x cnt2 POPM T,S,IP S = sign flag = {-1;0}
- MOV S,TOS ;1 -- c-addr ud2lo-hi x sign
+QNUMNEXT POPM #3,IP ;4 -- addr ud2lo-hi x cnt2 POPM T,S,IP S = sign flag = {-1;0}
+ MOV S,TOS ;1 -- addr ud2lo-hi x sign
MOV T,&BASE ;3
- JZ QNUMOK ;2 -- c-addr ud2lo-hi x sign conversion OK
-QNUMKO ADD #6,PSP ;1 -- c-addr sign
- AND #0,TOS ;1 -- c-addr ff TOS=0 and Z=1 ==> conversion ko
+ JZ QNUMOK ;2 -- addr ud2lo-hi x sign conversion OK
+QNUMKO
+ .IFDEF DOUBLE_NUMBERS ;
+ BIC #UF9,SR ;2 reset flag UF9, before use as double number flag
+ .ENDIF
+ ADD #6,PSP ;1 -- addr sign
+ AND #0,TOS ;1 -- addr ff TOS=0 and Z=1 ==> conversion ko
mNEXT ;4
-; ----------------------------------;63
-QNUMOK ADD #2,PSP ;1 -- c-addr ud2lo-hi cnt2
+; ----------------------------------;
+ .IFDEF DOUBLE_NUMBERS
+QNUMOK ADD #2,PSP ;1 -- addr ud2lo-hi cnt2
MOV 2(PSP),4(PSP) ; -- udlo udlo udhi sign
- MOV @PSP+,0(PSP) ;4 -- udlo udhi sign note : PSP is incremented before write back !!!
+ MOV @PSP+,0(PSP) ;4 -- udlo udhi sign note : PSP is incremented before write back !!!
XOR #-1,TOS ;1 -- udlo udhi inv(sign)
JNZ QDOUBLE ;2 if jump : TOS=-1 and Z=0 ==> conversion ok
Q2NEGATE XOR #-1,TOS ;1 -- udlo udhi tf
QDOUBLE BIT #UF9,SR ;2 decimal point added ?
JNZ QNUMEND ;2 leave double
ADD #2,PSP ;1 leave number
-QNUMEND mNEXT ;4 TOS=-1 and Z=0 ==> conversion ok
-; ----------------------------------;85/125 words
-
- .ELSE ; no hardware HRDWMPY
+QNUMEND mNEXT ;4 TOS=-1 and Z=0 ==> conversion ok
+ .ELSE
+QNUMOK ADD #4,PSP ;1 -- addr ud2lo sign
+ MOV @PSP+,0(PSP) ;4 -- udlo sign note : PSP is incremented before write back !!!
+ XOR #-1,TOS ;1 -- udlo inv(sign)
+ JNZ QNUMEND ;2 if jump : TOS=-1 and Z=0 ==> conversion ok
+QNEGATE XOR #-1,0(PSP) ;3
+ ADD #1,0(PSP) ;3 -- n tf
+ XOR #-1,TOS ;1 -- udlo udhi tf TOS=-1 and Z=0
+QNUMEND mNEXT ;4 TOS=-1 and Z=0 ==> conversion ok
+ .ENDIF ; DOUBLE_NUMBERS
+; ----------------------------------;128 words
+ .ELSE ; no hardware MPY
; T.I. SIGNED MULTIPLY SUBROUTINE: U1 x U2 -> Ud
;https://forth-standard.org/standard/core/UMTimes
mNEXT ;4 50/82 words/cycles, W = BASE
; convert a string to a signed number
-;Z ?NUMBER c-addr -- n -1 if convert ok ; flag Z=0
-;Z c-addr -- c-addr 0 if convert ko ; flag Z=1
+;Z ?NUMBER addr -- n|d -1 if convert ok ; flag Z=0, UF9=1 if double
+;Z addr -- addr 0 if convert ko ; flag Z=1
; FORTH 2012 prefixes $, %, # are recognised
; 32 bits numbers (with decimal point) are recognised
; with FIXPOINT_INPUT switched ON, fixed point signed numbers (with a comma) are recognised.
; prefixes # % $ - are processed before calling >NUMBER, decimal point and comma are >NUMBER exits
; FORTHWORD "?NUMBER"
-QNUMBER BIC #UF9,SR ;2 reset flag UF9 used here as decimal point flag
+QNUMBER
+ .IFDEF DOUBLE_NUMBERS
+ BIC #UF9,SR ;2 reset flag UF9, before use as double number flag
+ .ENDIF
MOV &BASE,T ;3 T=BASE
MOV #0,S ;1
PUSHM #3,IP ;5 R-- IP sign base
- MOV #QNUMNEXT,IP ;2 define >NUMBER return
+ MOV #TONUMEXIT,IP ;2 define >NUMBER return
MOV T,W ;1 W=BASE
- SUB #8,PSP ;1 -- x x x x c-addr
- MOV TOS,6(PSP) ;3 -- c-addr x x x c-addr
+ SUB #8,PSP ;1 -- x x x x addr
+ MOV TOS,6(PSP) ;3 -- addr x x x addr
MOV #0,4(PSP) ;3
- MOV #0,2(PSP) ;3 -- c-addr ud=0 x c-addr
+ MOV #0,2(PSP) ;3 -- addr ud=0 x addr
MOV TOS,S ;1
- MOV.B @S+,T ;2 -- c-addr ud=0 x x S=adr, T=count
- MOV.B @S,X ;2 X=char
- SUB.B #',',X ;2
- JHS QSIGN ;2 for current base, and for ',' or '.' process
- SUB.B #1,X ;1
+ MOV.B @S+,T ;2 -- addr ud=0 x x S=adr, T=count
+QNUMLDCHAR MOV.B @S,X ;2 X=char
+ CMP.B #'-',X ;2
+ JLO QBINARY ;2 if char < '-'
+ JNZ DDIGITQ ;2 if char > '-'
+ MOV #-1,2(RSP) ;3 R-- IP sign base
+ JMP TONUMPLUS ;2
QBINARY MOV #2,W ;1 preset base 2
- ADD.B #8,X ;1 '%' + 8 = '-' binary number ?
+ SUB.B #'%',X ;2 binary number ?
JZ PREFIXED ;2
QDECIMAL ADD #8,W ;1
- ADD.B #2,X ;1 '#' + 2 = '%' decimal number ?
+ ADD.B #2,X ;1 decimal number ?
JZ PREFIXED ;2
QHEXA MOV #16,W ;1
- SUB.B #1,X ;2 '$' - 1 = '#' hex number ?
- JNZ TONUMLOOP ;2 -- c-addr ud=0 x x other cases will cause error
+ SUB.B #1,X ;2 hex number ?
+ JNZ TONUMLOOP ;2 -- addr ud=0 x x other cases will cause >NUMBER exit
PREFIXED ADD #1,S ;1
- SUB #1,T ;1 -- c-addr ud=0 x x S=adr+1 T=count-1
- MOV.B @S,X ;2 X=2th char, W=adr
- SUB.B #',',X ;2
-QSIGN CMP.B #1,X ;1 char= '-' ?
- JNZ TONUMLOOP ;2 no (positive number or ',' or '.' )
- MOV #-1,2(RSP) ;3 R-- IP sign base
- JMP TONUMPLUS ;2
-; ----------------------------------;45
-QNUMNEXT FORTHtoASM ; -- c-addr ud2lo-hi addr2 cnt2 R-- IP sign BASE S=addr2,T=cnt2
- CMP #0,TOS ;1 cnt2=0 ? conversion is ok ?
- JZ QNUMNEXT1 ;2 yes (neither comma nor point in string)
+ SUB #1,T ;1 -- addr ud=0 x x S=adr+1 T=count-1
+ JMP QNUMLDCHAR ;
+; ----------------------------------;42
+TONUMEXIT FORTHtoASM ; -- addr ud2lo-hi addr2 cnt2 R-- IP sign BASE S=addr2,T=cnt2
+; ----------------------------------;
+ .IFDEF DOUBLE_NUMBERS
+ JZ QNUMNEXT ;2 if conversion is ok
BIT #UF9,SR ;2 already flagged? (to discard repeated points or repeated commas)
- JNZ QNUMNEXT1 ;2 abort
+ JNZ QNUMNEXT ;2 yes, exit then abort on conv. error
BIS #UF9,SR ;2 set double number flag
- .IFDEF FIXPOINT_INPUT
-; ----------------------------------;
-QNUMDP CMP.B #'.',0(S) ;4 rejected char by >NUMBER is a decimal point ?
- JNZ QS15Q16 ;2 no
-QNUMDPFOUND SUB #2,IP ;1 yes set >NUMBER return address
- JMP TONUMPLUS ;2 to terminate conversion
-QS15Q16 CMP.B #',',0(S) ;5 rejected char by >NUMBER is a comma ?
- JNZ QNUMNEXT1 ;2 no
-S15Q16 MOV #0,X ;1 -- c-addr ud2lo x 0 x init ud2lo' = 0
-S15Q16LOOP MOV X,2(PSP) ;3 -- c-addr ud2lo ud2lo' ud2lo' x X = 0(PSP) = ud2lo'
+ .ENDIF
+ .IFDEF DOUBLE_INPUT
+ SUB #2,IP ;1 reset TONUMEXIT as >NUMBER return address
+ CMP.B #'.',0(S) ;4 rejected char by >NUMBER is a decimal point ?
+ JZ TONUMPLUS ;2 to terminate conversion
+ .ENDIF
+ .IFDEF FIXPOINT_INPUT ;
+ CMP.B #',',0(S) ;5 rejected char by >NUMBER is a comma ?
+ JNZ QNUMNEXT ;2 no, exit then abort on conv. error
+S15Q16 MOV #0,X ;1 -- addr ud2lo x 0 x init ud2lo' = 0
+S15Q16LOOP MOV X,2(PSP) ;3 -- addr ud2lo ud2lo' ud2lo' x X = 0(PSP) = ud2lo'
SUB.B #1,T ;1 decrement cnt2
MOV T,X ;1 X = cnt2-1
ADD S,X ;1 X = end_of_string-1, first...
CMP.B #10,X ;2
JLO S15Q16EOC ;2
QS15Q16DIGI CMP W,X ;1 R-- IP sign BASE, W=BASE, is X a digit ?
- JHS S15Q16EOC ;2 -- c-addr ud2lo ud2lo' x ud2lo' if no
- MOV X,0(PSP) ;3 -- c-addr ud2lo ud2lo' digit x
- MOV W,TOS ;1 -- c-addr ud2lo ud2lo' digit base R-- IP sign base
- PUSHM #3,S ;5 PUSH S,T,W: R-- IP sign base addr2 cnt2 base
- CALL #MUSMOD ;4 -- c-addr ud2lo ur uqlo uqhi
+ JHS S15Q16EOC ;2 -- addr ud2lo ud2lo' x ud2lo' if no
+ MOV X,0(PSP) ;3 -- addr ud2lo ud2lo' digit x
+ MOV W,TOS ;1 -- addr ud2lo ud2lo' digit base R-- IP sign base
+ PUSHM #3,S ;5 PUSH S,T,W: R-- IP sign base addr2 cnt2 base
+ CALL #MUSMOD ;4 -- addr ud2lo ur uqlo uqhi
POPM #3,S ;5 restore W,T,S: R-- IP sign BASE
JMP S15Q16LOOP ;2 W=cnt
-S15Q16EOC MOV 4(PSP),2(PSP) ;5 -- c-addr ud2lo ud2lo uqlo x ud2lo from >NUMBER part1 becomes here ud2hi=S15 part2
- MOV @PSP,4(PSP) ;4 -- c-addr ud2lo ud2hi x x uqlo becomes ud2lo
- MOV T,TOS ;1 -- c-addr ud2lo ud2hi x cnt2
+S15Q16EOC MOV 4(PSP),2(PSP) ;5 -- addr ud2lo ud2lo uqlo x ud2lo from >NUMBER part1 becomes here ud2hi=S15 part2
+ MOV @PSP,4(PSP) ;4 -- addr ud2lo ud2hi x x uqlo becomes ud2lo
+ MOV T,TOS ;1 -- addr ud2lo ud2hi x cnt2
CMP.B #0,TOS ;1 TOS = 0 if end of conversion char = ',' (happy end)
- .ELSE ; no FIXPOINT_INPUT
-; ----------------------------------;
-QNUMDP CMP.B #'.',0(S) ;4 rejected char by >NUMBER is a decimal point ?
- JNZ QNUMNEXT1 ;2 no
-QNUMDPFOUND SUB #2,IP ;1 set >NUMBER return address
- JMP TONUMPLUS ;2 to terminate conversion
- .ENDIF; endof FIXPOINT_INPUT
+ .ENDIF
; ----------------------------------;97
-QNUMNEXT1 POPM #3,IP ;4 -- c-addr ud2lo-hi x cnt2 POPM T,S,IP S = sign flag = {-1;0}
- MOV S,TOS ;1 -- c-addr ud2lo-hi x sign
+QNUMNEXT POPM #3,IP ;4 -- addr ud2lo-hi x cnt2 POPM T,S,IP S = sign flag = {-1;0}
+ MOV S,TOS ;1 -- addr ud2lo-hi x sign
MOV T,&BASE ;3
- JZ QNUMOK ;2 -- c-addr ud2lo-hi x sign conversion OK
-QNUMKO ADD #6,PSP ;1 -- c-addr sign
- AND #0,TOS ;1 -- c-addr ff TOS=0 and Z=1 ==> conversion ko
+ JZ QNUMOK ;2 -- addr ud2lo-hi x sign conversion OK
+QNUMKO
+ .IFDEF DOUBLE_NUMBERS
+ BIC #UF9,SR
+ .ENDIF
+ ADD #6,PSP ;1 -- addr sign
+ AND #0,TOS ;1 -- addr ff TOS=0 and Z=1 ==> conversion ko
mNEXT ;4
; ----------------------------------;
-QNUMOK ADD #2,PSP ;1 -- c-addr ud2lo-hi sign
+ .IFDEF DOUBLE_NUMBERS
+QNUMOK ADD #2,PSP ;1 -- addr ud2lo ud2hi sign
MOV 2(PSP),4(PSP) ; -- udlo udlo udhi sign
MOV @PSP+,0(PSP) ;4 -- udlo udhi sign note : PSP is incremented before write back !!!
XOR #-1,TOS ;1 -- udlo udhi inv(sign)
JNZ QDOUBLE ;2 if jump : TOS=-1 and Z=0 ==> conversion ok
Q2NEGATE XOR #-1,TOS ;1 -- udlo udhi tf
- XOR #-1,2(PSP) ;3 -- dlo-1 dhi-1 tf
- XOR #-1,0(PSP) ;3 -- dlo-1 udhi tf
- ADD #1,2(PSP) ;3 -- dlo dhi-1 tf
+ XOR #-1,2(PSP) ;3
+ XOR #-1,0(PSP) ;3
+ ADD #1,2(PSP) ;3
ADDC #0,0(PSP) ;3 -- dlo dhi tf
-QDOUBLE BIT #UF9,SR ;2 decimal point added ?
- JNZ QNUMEND ;2 leave double
- ADD #2,PSP ;1 leave number
-QNUMEND mNEXT ;4 TOS=-1 and Z=0 ==> conversion ok
+QDOUBLE BIT #UF9,SR ;2 -- dlo dhi tf decimal point added ?
+ JNZ QNUMEND ;2 -- dlo dhi tf leave double
+ ADD #2,PSP ;1 -- dlo tf leave number, Z=0
+QNUMEND mNEXT ;4 TOS=-1 and Z=0 ==> conversion ok
+ .ELSE
+QNUMOK ADD #4,PSP ;1 -- addr ud2lo sign
+ MOV @PSP+,0(PSP) ;4 -- udlo sign note : PSP is incremented before write back !!!
+ XOR #-1,TOS ;1 -- udlo udhi inv(sign)
+ JNZ QNUMEND ;2 if jump : TOS=-1 and Z=0 ==> conversion ok
+QNEGATE XOR #-1,0(PSP) ;3
+ ADD #1,0(PSP) ;3 -- n tf
+ XOR #-1,TOS ;1 -- udlo udhi tf TOS=-1 and Z=0
+QNUMEND mNEXT ;4 TOS=-1 and Z=0 ==> conversion ok
+ .ENDIF ; DOUBLE_NUMBERS
; ----------------------------------;128 words
-
- .ENDIF ; of Hardware MPY
+ .ENDIF ; of Hardware/Software MPY
;https://forth-standard.org/standard/core/EXECUTE
;C EXECUTE i*x xt -- j*x execute Forth word at 'xt'
mNEXT ;4 15~
;https://forth-standard.org/standard/core/LITERAL
-;C LITERAL (n|d) -- append single numeric literal if compiling state
-; (n|d) -- append double numeric literal if compiling state and if UF9<>0 (not ANS)
+;C LITERAL n -- append single numeric literal if compiling state
+; d -- append double numeric literal if compiling state and if UF9<>0 (not ANS)
FORTHWORDIMM "LITERAL" ; immediate
LITERAL CMP #0,&STATE ;3
JZ LITERALEND ;2 if not immediate, leave n|d on the stack
MOV #lit,0(W) ;4
MOV TOS,2(W) ;3
MOV @PSP+,TOS ;2
+ .IFDEF DOUBLE_NUMBERS
BIT #UF9,SR ;2
BIC #UF9,SR ;2
- JNZ LITERAL1 ;2
-LITERALEND mNEXT ;4 30~
+ JZ LITERALEND ;2
+ MOV 2(W),X ;3
+ MOV TOS,2(W) ;3
+ MOV X,TOS ;1
+ JMP LITERAL1 ;2
+ .ENDIF
+LITERALEND mNEXT ;4
;https://forth-standard.org/standard/core/COUNT
;C COUNT c-addr1 -- adr len counted->adr/len
mNEXT ;4 15~
; : SETIB SOURCE 2! 0 >IN ! ; ; org len -- set Input Buffer, shared by INTERPRET and [ELSE]
-SETIB MOV #0,&TOIN ;
- MOV TOS,&SOURCE_LEN ; -- org len
+SETIB MOV TOS,&SOURCE_LEN ; -- org len
MOV @PSP+,&SOURCE_ADR ; -- len
MOV @PSP+,TOS ; --
+ MOV #0,&TOIN ;
mNEXT ;
;C INTERPRET i*x addr u -- j*x interpret given buffer
MOV @RSP+,&TOIN ;4
MOV @RSP+,&SOURCE_ADR ;4
MOV @RSP+,&SOURCE_LEN ;4
- MOV @RSP+,IP ;2
- mNEXT
+ mSEMI
- .IFDEF BOOTLOAD ; Boot loader requires Conditional Compilation
+ .IFDEF DEFER_QUIT ; defined in ThingsInFirst.inc
-QUIT0 MOV #0,&SAVE_SYSRSTIV
- MOV #RSTACK,RSP
- MOV #LSTACK,&LEAVEPTR
- MOV #0,&STATE
+QUIT0 MOV #0,&SAVE_SYSRSTIV ; clear SAVE_SYSRSTIV, usefull for next ABORT...
+ MOV #RSTACK,RSP ; ANS mandatory for QUIT
+ MOV #LSTACK,&LEAVEPTR ;
+ MOV #0,&STATE ; ANS mandatory for QUIT
mNEXT
;c BOOT -- load BOOT.4th file from SD_Card then loop to QUIT1
FORTHWORD "BOOT"
-; ----------------------------------;
-; BOOTSTRAP TEST ;
-; ----------------------------------;
- CMP #0,&SAVE_SYSRSTIV ; if WARM
- JZ BODYQUIT ; no boostrap, default QUIT instead
+ CMP #0,&SAVE_SYSRSTIV ; = 0 if WARM
+ JZ BODYQUIT ; no boostrap if no reset event, default QUIT instead
BIT.B #SD_CD,&SD_CDIN ; SD_memory in SD_Card module ?
JNZ BODYQUIT ; if not, no bootstrap, default QUIT instead
-; ----------------------------------;
-; BOOTSTRAP ; on SYSRSTIV <> 0
-; ----------------------------------;
SUB #2,PSP ;
MOV TOS,0(PSP) ;
- MOV &SAVE_SYSRSTIV,TOS ; -- SAVE_SYSRSTIV enabling test of exceptions in BOOT.4th
+ MOV &SAVE_SYSRSTIV,TOS ; -- SAVE_SYSRSTIV TOS = reset event, for tests in BOOT.4TH
ASMtoFORTH ;
- .IFDEF QUIETBOOT ;
- .word NOECHO ; warning ! your BOOT.4TH must to be finished with ECHO command!
- .ENDIF ;
- .word QUIT0 ; does reset SAVE_SYSRSTIV before LOAD BOOT.4th in case of ABORT !
+ .IFDEF QUIETBOOT ;
+ .word NOECHO ; warning ! your BOOT.4TH must to be finished with ECHO command!
+ .ENDIF ;
+ .word QUIT0 ;
.word XSQUOTE ; -- addr u
- .byte 15,"LOAD\34 BOOT.4TH\34" ; issues error 2 if no such file...
+ .byte 15,"LOAD\34 BOOT.4TH\34" ; LOAD" BOOT.4TH" issues error 2 if no such file...
.word BRAN,QUIT4 ; to interpret this string
; ----------------------------------;
QUIT MOV @PC+,PC ;3 Code Field Address (CFA) of QUIT
PFAQUIT .word BODYQUIT ; Parameter Field Address (PFA) of QUIT
BODYQUIT ASMtoFORTH ; BODY of QUIT = default execution of QUIT
- .word QUIT0
+ .word QUIT0 ;
.ELSE ; if no BOOTLOADER, QUIT is not DEFERred
;https://forth-standard.org/standard/core/QUIT
;c QUIT -- interpret line by line the input stream
FORTHWORD "QUIT"
-QUIT MOV #0,&SAVE_SYSRSTIV ; clear SAVE_SYSRSTIV, usefull for next ABORT...
- MOV #RSTACK,RSP ; ANS mandatory
+QUIT
+QUIT0 MOV #0,&SAVE_SYSRSTIV ; clear SAVE_SYSRSTIV, usefull for next ABORT...
+ MOV #RSTACK,RSP ; ANS mandatory for QUIT
MOV #LSTACK,&LEAVEPTR ;
- MOV #0,&STATE ; ANS mandatory
- ASMtoFORTH
-
- .ENDIF ; bootloader
+ MOV #0,&STATE ; ANS mandatory for QUIT
+ ASMtoFORTH ;
-QUIT1 .word XSQUOTE
+ .ENDIF
+
+QUIT1 .word XSQUOTE ;
.byte 5,13,10,"ok " ; CR+LF + Forth prompt
QUIT2 .word TYPE ; display it
- .word REFILL ;
-QUIT3 .word SPACE
-QUIT4 .word INTERPRET
- .word DEPTH,ZEROLESS
- .word XSQUOTE
- .byte 13,"stack empty! "
- .word QABORT
- .word lit,FRAM_FULL,HERE,ULESS
- .word XSQUOTE
- .byte 11,"FRAM full! "
- .word QABORT
- .word FSTATE,FETCH
- .word QBRAN,QUIT1 ; case of interpretion state
- .word XSQUOTE ; case of compilation state
- .byte 5,13,10," " ; CR+LF + 3 blanks
+ .word REFILL ; refill input buffer (one line)
+QUIT3 .word SPACE ;
+QUIT4 .word INTERPRET ; interpret this line
+ .word DEPTH,ZEROLESS ; stack empty test
+ .word XSQUOTE ; ABORT" stack empty! "
+ .byte 13,"stack empty! ";
+ .word QABORT ;
+QUIT5 .word lit,FRAM_FULL,HERE,ULESS ; FRAM full test
+ .word XSQUOTE ; ABORT" FRAM full! "
+ .byte 11,"FRAM full! ";
+ .word QABORT ;
+QUIT6 .word FSTATE,FETCH ; STATE @
+ .word QBRAN,QUIT1 ; 0= case of interpretion state
+ .word XSQUOTE ; 0<> case of compilation state
+ .byte 5,13,10," " ; CR+LF + 3 spaces
.word BRAN,QUIT2
;https://forth-standard.org/standard/core/ABORT
ABORT MOV #PSTACK,PSP
JMP QUIT
-WIP_DEFER ; WIPE resets ALL factory primary DEFERred words
- MOV #BODYWARM,&PFAWARM ; ' WARM >BODY IS WARM default init
- MOV #BODYSLEEP,&PFASLEEP ; MOV #SLEEP,X ADD #4,X MOV X,-2(X) default background task
-QAB_DEFER ; QABORT resets some primary DEFERred words
- MOV #BODYEMIT,&PFAEMIT ;4 ' EMIT >BODY IS EMIT default console output
- MOV #BODYCR,&PFACR ;4 ' CR >BODY IS CR default CR
- MOV #BODYKEY,&PFAKEY ;4 ' KEY >BODY IS KEY default KEY
-
- .IFDEF DEFER_ACCEPT ; true if SD_LOADER
- MOV #BODYACCEPT,&PFAACCEPT ;4 ' ACCEPT >BODY IS ACCEPT
- MOV #TIB_ORG,&PFACIB ;4 TIB_ORG TO CIB (Current Input Buffer)
- .ENDIF
- .IFDEF MSP430ASSEMBLER ; reset all 6 branch labels
- MOV #10,Y
- MOV Y,&BASE
-RAZASM MOV #0,ASMLABELS(Y) ; begins with last label...
- SUB #2,Y
- JHS RAZASM ; out of loop when Y = -2...
- .ELSE
- MOV #10,&BASE ;4
- .ENDIF
- RET
-
-RefillUSBtime .equ int(frequency*2730) ; 2730*frequency ==> 65520 @ max freq (24MHz)
-
-THREEDROP ADD #4,PSP
- MOV @PSP+,TOS
- mNEXT
+;https://forth-standard.org/standard/core/ABORTq
+;C ABORT" i*x flag -- i*x R: j*x -- j*x flag=0
+;C i*x flag -- R: j*x -- flag<>0
+ FORTHWORDIMM "ABORT\34" ; immediate
+ABORTQUOTE mDOCOL ; ABORT address + 10
+ .word SQUOTE
+ .word lit,QABORT,COMMA
+ .word EXIT
-;Z ?ABORT f c-addr u -- abort & print msg
+; define run-time part of ABORT"
+;Z ?ABORT f c-addr u -- abort & print msg,
; FORTHWORD "?ABORT"
QABORT CMP #0,2(PSP) ; -- f c-addr u flag test
- JZ THREEDROP
-; ----------------------------------;
-QABORTYES MOV #4882h,&YEMIT ; restore default YEMIT = set ECHO
-; ----------------------------------;
-QABORT_SDCARD ;
-; ----------------------------------;
- .IFDEF SD_CARD_LOADER ; close all handles
- MOV &CurrentHdl,T
-QABORTCLOSE CMP #0,T
- JZ QABORTCLOSEND
- MOV.B #0,HDLB_Token(T)
- MOV @T,T
- JMP QABORTCLOSE
-QABORTCLOSEND
- .ENDIF
-; ----------------------------------;
-QABORTYESNOECHO ; <== WARM jumps here
+ JNZ QABORTYES ;
+THREEDROP ADD #4,PSP ;
+ MOV @PSP+,TOS ;
+ mNEXT ;
+; ----------------------------------; QABORTYES = QABORT + 14
+QABORTYES CALL #QAB_DEFER ; init some variables, see WIPE
; ----------------------------------;
- CALL #QAB_DEFER
+QABORT_SDCARD ; close all handles
; ----------------------------------;
-QABORTTERM ; wait the end of source file downloading
+ .IFDEF SD_CARD_LOADER ;
+ MOV &CurrentHdl,T ;
+QABORTCLOSE CMP #0,T ;
+ JZ QABORTCLOSEND ;
+ MOV.B #0,HDLB_Token(T) ;
+ MOV @T,T ;
+ JMP QABORTCLOSE ;
+QABORTCLOSEND ;
+ .ENDIF ;
; ----------------------------------;
- .IFDEF TERMINAL3WIRES ;
- BIT #UCTXIFG,&TERM_IFG ; TX buffer empty ?
- JZ QABORTTERM ; no
+QABORT_TERM ; wait the end of downloading source file
; ----------------------------------;
- MOV #17,&TERM_TXBUF ; yes move XON char into TX_buf
- .ENDIF ;
- .IFDEF TERMINAL4WIRES ;
- BIC.B #RTS,&HANDSHAKOUT ; set /RTS low (connected to /CTS pin of UARTtoUSB bridge)
- .ENDIF ;
-QABORTLOOP BIC #UCRXIFG,&TERM_IFG ; reset TERMIFG(UCRXIFG)
- MOV #RefillUSBtime,Y ; 2730*36 = 98 ms : PL2303TA seems to be the slower USB device to refill its TX buffer.
-QABUSBLOOPJ MOV #8,X ; 1~ <-------+
- ADD X,X ; 1~ | linux seems very very slow... ==> 2730*68 = 185ms
+ CALL #RXON ; send XON and/or set RTS low
+QABORTLOOP BIC #UCRXIFG,&TERM_IFG ; clear UCRXIFG
+ MOV #int(frequency*2730),Y ; 2730*frequency ==> 65520 @ 24MHz
+QABUSBLOOPJ MOV #8,X ; 1~ <-------+ windows 10 seems very slow... ==> 2730*36 = 98ms delay
+ ADD X,X ; 1~ | linux seems very very slow... ==> 2730*69 = 188ms delay
QABUSBLOOPI NOP ; 1~ <---+ |
SUB #1,X ; 1~ | |
- JNZ QABUSBLOOPI ; 2~ > 4~ loop -+ |
+ JNZ QABUSBLOOPI ; 2~ 4~ loop ---+ |
SUB #1,Y ; 1~ |
- JNZ QABUSBLOOPJ ; 2~ --> 36~ loop --+
- BIT #UCRXIFG,&TERM_IFG ; 4 new char in TERMRXBUF after refill time out ?
- JNZ QABORTLOOP ; 2 yes, the input stream (download source file) is still active
-; ----------------------------------;
-; Display ABORT message ; no, the input stream is quiet (end of download source file)
+ JNZ QABUSBLOOPJ ; 2~ 36~/69~ loop --+
+ BIT #UCRXIFG,&TERM_IFG ; 4 new char in TERMRXBUF after refill delay ?
+ JNZ QABORTLOOP ; 2 yes, the input stream is still active: loop back
+; ----------------------------------; no, end of downloading source file
+; Display ABORT" message ; in reverse video mode
; ----------------------------------;
+QABORT_DISPLAY ; <== WARM jumps here
mDOCOL ;
+ .word lit,LINE,FETCH ;
+ .word ECHO ;
.word XSQUOTE ; -- c-addr u c-addr1 u1
.byte 4,27,"[7m" ; type ESC[7m
.word TYPE ; -- c-addr u set reverse video
-ERRLINE .word lit,LINE,FETCH,QDUP; if LINE <> 0
- .word QBRAN,ERRLINE_END
- .word ECHO ;
- .word XSQUOTE ; displays the line where error occured
+ .word QDUP ; if LINE <> 0
+ .word QBRAN,ERRLINE_END; if LINE = 0
+ERRLINE .word XSQUOTE ; else displays the line where error occured
.byte 5,"line:" ;
.word TYPE ;
.word ONEMINUS ;
.word TYPE ; -- set normal video
; ----------------------------------;
.word PWR_STATE ; remove all words beyond PWR_HERE
- .IFDEF LOWERCASE ;
- .word CAPS_ON ;
- .ENDIF ;
- .word ABORT ; no return
+FABORT .word ABORT ; no return; FABORT = BRACTICK-8
; ----------------------------------;
-;https://forth-standard.org/standard/core/ABORTq
-;C ABORT" i*x flag -- i*x R: j*x -- j*x flag=0
-;C i*x flag -- R: j*x -- flag<>0
- FORTHWORDIMM "ABORT\34" ; immediate
-ABORTQUOTE mDOCOL
- .word SQUOTE
- .word lit,QABORT,COMMA
- .word EXIT
+;-------------------------------------------------------------------------------
+; COMPILER
+;-------------------------------------------------------------------------------
+
+;https://forth-standard.org/standard/core/BracketTick
+;C ['] <name> -- find word & compile it as literal
+ FORTHWORDIMM "[']" ; immediate word, i.e. word executed during compilation
+BRACTICK mDOCOL
+ .word TICK ; get xt of <name>
+ .word lit,lit,COMMA ; append LIT action
+ .word COMMA,EXIT ; append xt literal
;https://forth-standard.org/standard/core/Tick
;C ' -- xt find word in dictionary and leave on stack its execution address
;https://forth-standard.org/standard/block/bs
; \ -- backslash
; everything up to the end of the current line is a comment.
- FORTHWORDIMM "\\" ; immediate
-BACKSLASH MOV &SOURCE_LEN,&TOIN ;
+ FORTHWORDIMM "\\" ; immediate
+BACKSLASH MOV &SOURCE_LEN,&TOIN ;
mNEXT
-;-------------------------------------------------------------------------------
-; COMPILER
-;-------------------------------------------------------------------------------
-
;https://forth-standard.org/standard/core/Bracket
;C [ -- enter interpretative state
FORTHWORDIMM "[" ; immediate
RIGHTBRACKET MOV #-1,&STATE
mNEXT
-;https://forth-standard.org/standard/core/BracketTick
-;C ['] <name> -- find word & compile it as literal
- FORTHWORDIMM "[']" ; immediate word, i.e. word executed during compilation
-BRACTICK mDOCOL
- .word TICK ; get xt of <name>
- .word lit,lit,COMMA ; append LIT action
- .word COMMA,EXIT ; append xt literal
-
;https://forth-standard.org/standard/core/DEFERStore
-;C DEFER! xt CFA_DEFER -- ; store xt to the address after DODEFER
+;C DEFER! xt CFA_DEFER -- ; store xt into the PFA of DEFERed word
; FORTHWORD "DEFER!"
DEFERSTORE MOV @PSP+,2(TOS) ; -- CFA_DEFER xt --> [CFA_DEFER+2]
MOV @PSP+,TOS ; --
; or in a definition : ... ['] U. IS DISPLAY ...
; KEY, EMIT, CR, ACCEPT and WARM are examples of DEFERred words
-; as IS replaces the PFA value of a "PFA word", it may be also used with VARIABLE and CONSTANT words...
+; as IS replaces the PFA value of any word, it may be also used as TO for VARIABLE and CONSTANT words...
FORTHWORDIMM "IS" ; immediate
IS mDOCOL
- .word FSTATE,FETCH
- .word QBRAN,IS_EXEC
-IS_COMPILE .word BRACTICK ; find the word, compile its CFA as literal
- .word lit,DEFERSTORE,COMMA ; compile DEFERSTORE
- .word EXIT
-IS_EXEC .word TICK,DEFERSTORE ; find the word, leave its CFA on the stack and execute DEFERSTORE
- .word EXIT
+ .word FSTATE,FETCH ; STATE @
+ .word QBRAN,IS_EXEC ; if = 0
+IS_COMPILE .word BRACTICK ; find the word, compile its CFA as literal
+ .word lit,DEFERSTORE,COMMA; compile DEFERSTORE
+ .word EXIT ;
+IS_EXEC .word TICK,DEFERSTORE ; find the word, leave its CFA on the stack and
+ .word EXIT ; put it into PFA of DEFERed word, then exit.
;https://forth-standard.org/standard/core/IMMEDIATE
;C IMMEDIATE -- make last definition immediate
.word lit,COMMA
POST1 .word COMMA,EXIT
-;;Z ?REVEAL -- if no stack mismatch, link this created word in the CURRENT vocabulary
-; FORTHWORD "REVEAL"
-QREVEAL CMP PSP,&LAST_PSP ; Check SP with its saved value by :
- JZ GOOD_CSP ; if no stack mismatch.
-BAD_CSP mDOCOL
- .word XSQUOTE
- .byte 15,"stack mismatch!"
-FQABORTYES .word QABORTYES
-
;https://forth-standard.org/standard/core/Semi
;C ; -- end a colon definition
FORTHWORDIMM ";" ; immediate
FORTHWORD ":NONAME"
COLONNONAME SUB #2,PSP
MOV TOS,0(PSP)
- MOV &DDP,TOS
+ MOV &DDP,TOS ; -- xt
MOV TOS,W ; W=CFA
- MOV #PAIN,X ; PAIN is a read only register in all MSP430 devices...
- MOV X,Y ; so, MOV Y,0(X) writes to this read only register = lure for semicolon LAST_THREAD REVEAL...
- ADD #2,Y ; so, MOV @X,-2(Y) writes to the same register = lure for semicolon LAST_NFA REVEAL...
+ MOV #PAIN,X ;2 MOV Y,0(X) writes to PAIN read only register = first lure for semicolon REVEAL...
+ MOV #PAOUT,Y ;2 MOV @X,-2(Y) writes to PAIN register = 2th lure for semicolon REVEAL...
CALL #HEADEREND ; ...because we don't want write a preamble of word in dictionnary!
.ENDIF ; NONAME
+
+;-----------------------------------; common part of NONAME and :
COLONNEXT
.SWITCH DTC
.CASE 1
MOV #-1,&STATE ; enter compiling state
SAVE_PSP MOV PSP,&LAST_PSP ; save PSP for check compiling, used by QREVEAL
PFA_DEFER mNEXT
+;-----------------------------------;
+
;https://forth-standard.org/standard/core/Colon
;C : <name> -- begin a colon definition
COLON PUSH #COLONNEXT ; define COLONNEXT as RET for HEADER
; HEADER create an header for a new word. Max count of chars = 126
-; common code for VARIABLE, CONSTANT, CREATE, DEFER, :, MARKER, CODE, ASM.
+; common code for DEFER, VARIABLE, CONSTANT, CREATE, :, MARKER, CODE, ASM.
; doesn't link the created word in vocabulary.
HEADER mDOCOL
- .word CELLPLUSALIGN ; ALIGN then make room for LFA
+ .word CELLPLUSALIGN ; align and make room for LFA
.word FBLANK,WORDD ;
FORTHtoASM ; -- HERE HERE is the NFA of this new word
+ MOV @RSP+,IP
MOV TOS,Y ;
MOV.B @TOS+,W ; -- xxx W=Count_of_chars Y=NFA
BIS.B #1,W ; -- xxx W=count is always odd
ADD TOS,X ; -- xxx TOS= Thread X=VOC_PFAx = thread x of VOC_PFA of CURRENT
.ENDCASE
MOV @PSP+,TOS ; --
- MOV @RSP+,IP
- MOV #4030h,0(W) ;4 by default, HEADER create a DEFERred word: CFA = MOV @PC+,PC = BR...
- MOV #PFA_DEFER,2(W) ;4 by default, HEADER create a DEFERred word: PFA = address of NEXT to do nothing.
+ MOV #4030h,0(W) ;4 by default, HEADER create a DEFERred word: CFA = MOV @PC+,PC = BR mNEXT
+ MOV #PFA_DEFER,2(W) ;4 by default, HEADER create a DEFERred word: PFA = address of mNEXT to do nothing.
-HEADEREND MOV Y,&LAST_NFA ; -- NFA --> LAST_NFA used by QREVEAL, IMMEDIATE
+HEADEREND MOV Y,&LAST_NFA ; -- NFA --> LAST_NFA used by QREVEAL, IMMEDIATE, MARKER
MOV X,&LAST_THREAD ; -- VOC_PFAx --> LAST_THREAD used by QREVEAL
MOV W,&LAST_CFA ; -- HERE=CFA --> LAST_CFA used by DOES>, RECURSE
ADD #4,W ; -- by default make room for two words...
MOV W,&DDP ; --
- RET ; 23 words, W is the new DDP value )
+ RET ; 30 words, W is the new DDP value )
; X is LAST_THREAD > used by VARIABLE, CONSTANT, CREATE, DEFER and :
; Y is NFA )
+ .IFDEF CONDCOMP
+; ------------------------------------------------------------------------------
+; forthMSP430FR : CONDITIONNAL COMPILATION
+; ------------------------------------------------------------------------------
+ .include "forthMSP430FR_CONDCOMP.asm"
+
+ ; compile COMPARE [THEN] [ELSE] [IF] [UNDEFINED] [DEFINED] MARKER
+
+; ------------------------------------------------------------------------------
+ .ENDIF
+
+GOOD_CSP MOV &LAST_NFA,Y ; GOOD_CSP is the end of word MARKER
+ MOV &LAST_THREAD,X ;
+REVEAL MOV @X,-2(Y) ; [LAST_THREAD] --> LFA (for NONAME: [LAST_THREAD] --> PAIN)
+ MOV Y,0(X) ; LAST_NFA --> [LAST_THREAD] (for NONAME: LAST_NFA --> PAIN)
+ mNEXT
+
+;;Z ?REVEAL -- if no stack mismatch, link this new word in the CURRENT vocabulary
+; FORTHWORD "REVEAL"
+QREVEAL CMP PSP,&LAST_PSP ; Check SP with its saved value by :
+ JZ GOOD_CSP ; if no stack mismatch.
+BAD_CSP mDOCOL
+ .word XSQUOTE
+ .byte 15,"stack mismatch!"
+FQABORTYES .word QABORTYES
+
;https://forth-standard.org/standard/core/VARIABLE
;C VARIABLE <name> -- define a Forth VARIABLE
FORTHWORD "VARIABLE"
DOES MOV &LAST_CFA,W ; W = CFA of CREATEd word
MOV #DODOES,0(W) ; replace CFA (DOCON) by new CFA (DODOES)
MOV IP,2(W) ; replace PFA by the address after DOES> as execution address
- MOV @RSP+,IP ; exit of the new created word
- mNEXT
+ mSEMI ; exit of the new created word
;https://forth-standard.org/standard/core/DEFER
;C DEFER "<spaces>name" --
;Execute the xt that name is set to execute, i.e. NEXT (nothing),
;until the phrase ' word IS name is executed, causing a new value of xt to be assigned to name.
-; FORTHWORD "DEFER"
-;DEFER CALL #HEADER ; that create a secondary DEFERred word (whithout subsequent code)
-; JMP REVEAL
-
FORTHWORD "DEFER"
DEFER PUSH #REVEAL ; to link created DEFER word in vocabulary
- JMP HEADER ; that create a secondary DEFERred word (whithout subsequent code)
+ JMP HEADER ; that create a secondary DEFERed word (whithout default code)
;https://forth-standard.org/standard/core/toBODY
; >BODY -- addr leave BODY of a CREATEd word or of a primary DEFERred word
ADD #4,TOS
mNEXT
- .IFDEF CONDCOMP
-
-; ------------------------------------------------------------------------------
-; forthMSP430FR : CONDITIONNAL COMPILATION
-; ------------------------------------------------------------------------------
- .include "forthMSP430FR_CONDCOMP.asm"
-
- ; compile the words: COMPARE [THEN] [ELSE] [IF] [UNDEFINED] [DEFINED] MARKER
-
- .ENDIF ; CONDCOMP
-
-GOOD_CSP MOV &LAST_NFA,Y ; GOOD_CSP is the end of word MARKER
- MOV &LAST_THREAD,X ;
-REVEAL MOV @X,-2(Y) ; [LAST_THREAD] --> LFA (for NONAME: [LAST_THREAD] --> PAIN)
- MOV Y,0(X) ; LAST_NFA --> [LAST_THREAD] (for NONAME: LAST_NFA --> PAIN)
- mNEXT
-
; ------------------------------------------------------------------------------
; CONTROL STRUCTURES
; ------------------------------------------------------------------------------
REPEAT mDOCOL
.word AGAIN,THEN,EXIT
-;https://forth-standard.org/standard/core/
-
+;https://forth-standard.org/standard/core/DO
;C DO -- DOadr L: -- 0
FORTHWORDIMM "DO" ; immediate
DO SUB #2,PSP ;
;C LOOP DOadr -- L-- an an-1 .. a1 0
FORTHWORDIMM "LOOP" ; immediate
LOO MOV #xloop,X
-ENDLOOP ADD #4,&DDP ; make room to compile two words
+LOOPNEXT ADD #4,&DDP ; make room to compile two words
MOV &DDP,W
MOV X,-4(W) ; xloop --> HERE
MOV TOS,-2(W) ; DOadr --> HERE+2
SUB #2,&LEAVEPTR ; --
MOV @TOS,TOS ; -- first LeaveStack value
CMP #0,TOS ; -- = value left by DO ?
- JZ ENDLOOPEND
+ JZ LOOPEND
MOV W,0(TOS) ; move adr after loop as UNLOOP adr
JMP LEAVELOOP
-ENDLOOPEND MOV @PSP+,TOS
+LOOPEND MOV @PSP+,TOS
mNEXT
;https://forth-standard.org/standard/core/PlusLOOP
;C +LOOP adrs -- L-- an an-1 .. a1 0
FORTHWORDIMM "+LOOP" ; immediate
PLUSLOOP MOV #xploop,X
- JMP ENDLOOP
+ JMP LOOPNEXT
;https://forth-standard.org/standard/core/LEAVE
;C LEAVE -- L: -- adrs
LEAV MOV &DDP,W ; compile three words
MOV #UNLOOP,0(W) ; [HERE] = UNLOOP
MOV #BRAN,2(W) ; [HERE+2] = BRAN
- ADD #6,&DDP ; [HERE+4] = take word for AfterLOOPadr
+ ADD #6,&DDP ; [HERE+4] = After LOOP adr
ADD #2,&LEAVEPTR
ADD #4,W
MOV &LEAVEPTR,X
; WORDS SET for VOCABULARY, not ANS compliant
;-------------------------------------------------------------------------------
-;X VOCABULARY -- create a vocabulary
+;X VOCABULARY -- create a vocabulary, up to 7 vocabularies in CONTEXT
.IFDEF VOCABULARY_SET
VOCABULOOP .word lit,0,COMMA
.word xloop,VOCABULOOP
.ENDCASE
- .word HERE ; link via LASTVOC the future created vocabularies
+ .word HERE ; link via LASTVOC the future created vocabulary
.word LIT,LASTVOC,DUP
.word FETCH,COMMA ; compile [LASTVOC] to HERE+
.word STORE ; store (HERE - CELL) to LASTVOC
.word FORTH,ONLY,DEFINITIONS
FORTHtoASM ; -- BODY IP is free
MOV @TOS+,W ; -- BODY+2 W = old VOCLINK = VLK
- MOV W,&LASTVOC ; -- BODY+2 restore LASTVOC
+ MOV W,&LASTVOC ; restore LASTVOC
MOV @TOS,TOS ; -- OLD_DP
MOV TOS,&DDP ; -- DP restore DP
; then restore words link(s) with it value < old DP
MARKVOC .word lastvoclink ; initialised by forthMSP430FR.asm as voclink value
MARKDP .word ROMDICT ; initialised by forthMSP430FR.asm as DP value
- FORTHWORD "RST_STATE" ; executed by <reset>, reinitializes dictionary in state defined by RST_HERE;
-RST_STATE MOV &INIVOC,&MARKVOC ; INI value saved in FRAM
- MOV &INIDP,&MARKDP ; INI value saved in FRAM
+ FORTHWORD "RST_STATE" ; executed by <reset>, reinitializes dictionary in state defined by RST_HERE
+RST_STATE MOV &INIVOC,&MARKVOC ; INIT value above (FRAM value)
+ MOV &INIDP,&MARKDP ; INIT value above (FRAM value)
JMP PWR_STATE
FORTHWORD "PWR_HERE" ; define dictionnary bound for power ON
PWR_HERE MOV &LASTVOC,&MARKVOC
MOV &DDP,&MARKDP
- mNEXT
+NEXT_ADR mNEXT
FORTHWORD "RST_HERE" ; define dictionnary bound for <reset>...
RST_HERE MOV &LASTVOC,&INIVOC
MOV &DDP,&INIDP
- JMP PWR_HERE ; ...and also for power ON...
+ JMP PWR_HERE ; ...and obviously same bound for power ON...
- FORTHWORD "WIPE" ; restore the program as it was in forthMSP430FR.txt file
+ FORTHWORD "WIPE" ; restore the program as it was in forthMSP430FR.txt file
WIPE ; reset JTAG and BSL signatures ; unlock JTAG, SBW and BSL
- MOV #16,X ; max known SIGNATURES length = 16
-SIGNLOOP SUB #2,X
- MOV #-1,SIGNATURES(X) ; reset signature; WARNING ! DON'T CHANGE THIS IMMEDIATE VALUE !
- JNZ SIGNLOOP
- CALL #WIP_DEFER ; set default execute part of all factory primary DEFERred words
- MOV #ROMDICT,&INIDP ; reinit this 2 factory values
- MOV #lastvoclink,&INIVOC
- JMP RST_STATE ; then execute RST_STATE and PWR_STATE
+ MOV #16,X ; max known SIGNATURES length = 16
+SIGNLOO SUB #2,X
+ MOV #-1,SIGNATURES(X) ; reset signature; WARNING ! DON'T CHANGE IMMEDIATE VALUE !
+ JNZ SIGNLOO
+ MOV #BODYSLEEP,&PFASLEEP ;4 MOV #SLEEP,X ADD #4,X MOV X,-2(X), restore default background task
+ MOV #BODYWARM,&PFAWARM ;4 ' WARM >BODY IS WARM, restore default WARM
+; MOV #WARMTYPE,&BODYWARM+2
+ .IFDEF DEFER_QUIT ; true if BOOTLOADER
+ MOV #BODYQUIT,&PFAQUIT ;4 ' QUIT >BODY IS QUIT
+ .ENDIF
+ MOV #lastvoclink,&INIVOC ; reinit this 2 factory values
+ MOV #ROMDICT,&INIDP
+ PUSH #RST_STATE ; define the next of WIPE
+;-----------------------------------;
+; WIPE, QABORT common subroutine ; <--- ?ABORT calls here
+;-----------------------------------;
+QAB_DEFER
+ MOV #BODYEMIT,&PFAEMIT ;4 ' EMIT >BODY IS EMIT default console output
+ MOV #BODYCR,&PFACR ;4 ' CR >BODY IS CR default CR
+ MOV #BODYKEY,&PFAKEY ;4 ' KEY >BODY IS KEY default KEY
+ .IFDEF DEFER_ACCEPT ; true if SD_LOADER
+ MOV #BODYACCEPT,&PFAACCEPT ;4 ' ACCEPT >BODY IS ACCEPT
+ MOV #TIB_ORG,&PFACIB ;4 TIB_ORG TO CIB (Current Input Buffer)
+ .ENDIF
+;-----------------------------------;
+; WIPE, QABORT, COLD common subrouti; <--- COLD, reset and PUC calls here
+;-----------------------------------;
+RST_INIT
+ MOV #CPUOFF+GIE,&LPM_MODE ; set LPM0
+ .SWITCH DTC
+ .CASE 1
+ MOV #xdocol,rDOCOL
+ .CASE 2
+ MOV #EXIT,rDOCOL
+ .ENDCASE
+ MOV #xdovar,rDOVAR
+ MOV #xdocon,rDOCON
+ MOV #xdodoes,rDODOES
+ .IFDEF MSP430ASSEMBLER ; reset all 6 branch labels
+ MOV #10,Y
+ MOV Y,&BASE
+CLRASMLABEL
+ MOV #0,ASMLABELS(Y) ; begins with last label...
+ SUB #2,Y
+ JHS CLRASMLABEL ; out of loop when Y = -2...
+ .ELSE
+ MOV #10,&BASE ;4
+ .ENDIF
+ MOV #32,&CAPS ; init CAPS ON
+ RET
+;---------------------------------------;
; --------------------------------------------------------------------------------
; forthMSP430FR : WARM
; --------------------------------------------------------------------------------
;Z WARM -- ; deferred word, enabling the initialisation of your application
- ; by defining this word: : START \ for all next RESET events
- ; ...init app here...
- ; LIT RECURSE IS WARM \ START is executed between
- ; ['] WARM >BODY EXECUTE ; \ WARM and BODYWARM
-
FORTHWORD "WARM"
WARM MOV @PC+,PC ;3 Code Field Address (CFA) of WARM
PFAWARM .word BODYWARM ; Parameter Field Address of WARM, may be redirected.
-BODYWARM ; BODY of WARM (default execution of WARM)
+BODYWARM MOV @PC+,IP
+ .word WARMTYPE ; define next step for WIPE,RST_STATE,PWR_STATE, etc.
;=================================================================================
; WARM 1: activates I/O: inputs and outputs are active only here (hiZ before here)
;=================================================================================
; Moved in WARM area to be redirected in your app START routine,
; enabling you full control of the I/O RESET state.
;=================================================================================
- MOV #WARMTYPE,IP ; define unique next step for WIPE,RST_STATE,PWR_STATE, etc.
MOV &SAVE_SYSRSTIV,TOS ;
- CMP #0,TOS ; RESET event ?
- JNZ RST_EVENT ; RESET event
- mNEXT ; WARM event: goto WARM 2 (don't reinit TERM and SD_CARD I/O's)
+ CMP #0,TOS ; WARM event ?
+ JZ NEXT_ADR ; yes continue with WARMTYPE
;---------------------------------------------------------------------------------
-; RESET 8: test DEEP RESET before init TERMINAL I/O
+; RESET 7: test DEEP RESET before init TERMINAL I/O
;---------------------------------------------------------------------------------
RST_EVENT
BIT.B #TXD,&TERM_IN ; TERM_TXD wired to GND via 4k7 resistor ?
XOR #-1,TOS ; yes : force DEEP_RST (RESET + WIPE)
ADD #1,TOS ; to display SAVE_SYSRSTIV as negative value
;---------------------------------------------------------------------------------
-; RESET 9: INIT TERMINAL I/O
+; RESET 8: INIT TERMINAL I/O
;---------------------------------------------------------------------------------
RST_TERM_IO ;
BIS.B #TERM_BUS,&TERM_SEL ; Configure pins TXD & RXD for TERM_UART
;---------------------------------------------------------------------------------
-; RESET 10: optionnaly INIT SD_Card
+; RESET 9: INIT SD_Card
;---------------------------------------------------------------------------------
.IFDEF SD_CARD_LOADER ;
BIT.B #SD_CD,&SD_CDIN ; SD_memory in SD_Card module ?
MOV #0,SD_ORG(X) ; 3
JNZ ClearSDdata ; 2
.ENDIF
- .include "forthMSP430FR_SD_INIT.asm"; doesn't use TOS
+ .include "forthMSP430FR_SD_INIT.asm"; no use IP,TOS
.ENDIF
;---------------------------------------------------------------------------------
-; RESET 11: Select POWER_ON|<reset>|DEEP_RST
+; RESET 10, RESET events handler: Select POWER_ON|<reset>|DEEP_RST
;---------------------------------------------------------------------------------
RST_SEL CMP #0Ah,TOS ; reset event = security violation: access of protected areas.
- JZ WIPE ; Add WIPE to this reset to do DEEP_RST --------------
+ JZ WIPE ; Add WIPE to this reset to do DEEP_RST
CMP #16h,TOS ; reset event > software POR : failure or DEEP_RST request
JHS WIPE ; U>= ; Add WIPE to this reset to do DEEP_RST
- CMP #2,TOS ; reset event = Brownout ?
- JNZ RST_STATE ; else execute RST_STATE, return to WARMTYPE
+ CMP #2,TOS ; reset event = BOR ?
JZ PWR_STATE ; yes execute PWR_STATE, return to WARMTYPE
+ JNZ RST_STATE ; else execute RST_STATE, return to WARMTYPE
;---------------------------------------------------------------------------------
; WARM 2: type message on console output
;---------------------------------------------------------------------------------
-WARMTYPE .word XSQUOTE ;
+WARMTYPE .word ECHO
+ .word XSQUOTE ;
.byte 6,13,1Bh,"[7m#" ; CR + cmd "reverse video" + #
.word TYPE ;
.word DOT ; display signed SAVE_SYSRSTIV
.word LIT,SIGNATURES,HERE,MINUS,UDOT
.word XSQUOTE ;
.byte 11,"bytes free ";
- .word QABORTYESNOECHO ;
-
-
+ .word QABORT_DISPLAY ;
-;Z COLD -- performs a software reset
- FORTHWORD "COLD"
-COLD BIT #1,&TERM_STATW ; TERM_UART is busy ?
- JNZ COLD ; if yes
- MOV #0A500h+PMMSWBOR,&PMMCTL0 ; performs reset next address
+;Z COLD -- performs a software reset (SYSRSTIV = 6)
+ FORTHWORD "COLD"
+COLD BIT #1,&TERM_STATW ; TERM_UART is busy ?
+ JNZ COLD ; if yes
+ MOV #0A500h+PMMSWBOR,&PMMCTL0 ; performs reset next address
-RESET
;---------------------------------------------------------------------------------
; RESET 1: Initialisation limited to FastForth usage : I/O, RAM, RTC
; all unused I/O are set as input with pullup resistor
;---------------------------------------------------------------------------------
- .include "Target.asm" ; include target specific FastForth init code
+RESET .include "TargetInit.asm" ; include target specific FastForth init code
;---------------------------------------------------------------------------------
; RESET 2: init RAM
;---------------------------------------------------------------------------------
MOV #RAM_LEN,X
-INITRAM SUB #2,X
+INITRAMLOOP SUB #2,X
MOV #0,RAM_ORG(X)
- JNZ INITRAM ; 6~ loop
+ JNZ INITRAMLOOP ; 6~ loop
;---------------------------------------------------------------------------------
-; RESET 3: fill all interrupt vectors with RESET
-;---------------------------------------------------------------------------------
- MOV #VECT_LEN,X ;2 length of vectors area
-RESETINT SUB #2,X ;1
- MOV #RESET,VECT_ORG(X) ;4 begin at end of area
- JNZ RESETINT ;2 endloop when VECT_ORG(X) = VECT_ORG
-;---------------------------------------------------------------------------------
-; RESET 4: set TERMINAL vector interrupt and LPM0 mode for terminal use
+; RESET 3: set all interrupt vectors
;---------------------------------------------------------------------------------
+ MOV #VECT_LEN,X ;2 length of vectors area
+VECTORLOOP SUB #2,X ;1
+ MOV #RESET,VECT_ORG(X) ;4 begin at end of area
+ JNZ VECTORLOOP ;2 endloop when VECT_ORG(X) = VECT_ORG
MOV #TERMINAL_INT,&TERM_VEC
- MOV #CPUOFF+GIE,&LPM_MODE ; set LPM0
;---------------------------------------------------------------------------------
-; RESET 5: INIT TERM_UART UC
+; RESET 4: INIT TERM_UART UC
;---------------------------------------------------------------------------------
MOV #0081h,&TERM_CTLW0 ; UC SWRST + UCLK = SMCLK
MOV &TERMBRW_RST,&TERM_BRW ; RST value in FRAM
BIC #UCSWRST,&TERM_CTLW0 ; release from reset...
BIS #UCRXIE,&TERM_IE ; ... then enable RX interrupt for wake up on terminal input
;-------------------------------------------------------------------------------
-; RESET 6: optionnal INIT SD_CARD UC
+; RESET 5: optionnal INIT SD_CARD UC
;-------------------------------------------------------------------------------
- .IFDEF SD_CARD_LOADER ;
- MOV #0A981h,&SD_CTLW0 ; UCxxCTL1 = CKPH, MSB, MST, SPI_3, SMCLK + UCSWRST
- MOV #FREQUENCY*3,&SD_BRW ; UCxxBRW init SPI CLK = 333 kHz ( < 400 kHz) for SD_Card init
- BIS.B #SD_CS,&SD_CSDIR ; SD_CS as output high
- BIS #SD_BUS,&SD_SEL ; Configure pins as SIMO, SOMI & SCK (PxDIR.y are controlled by eUSCI module)
- BIC #1,&SD_CTLW0 ; release eUSCI from reset
+ .IFDEF SD_CARD_LOADER ;
+ MOV #0A981h,&SD_CTLW0 ; UCxxCTL1 = CKPH, MSB, MST, SPI_3, SMCLK + UCSWRST
+ MOV #FREQUENCY*3,&SD_BRW ; UCxxBRW init SPI CLK = 333 kHz ( < 400 kHz) for SD_Card init
+ BIS.B #SD_CS,&SD_CSDIR ; SD_CS as output high
+ BIS #SD_BUS,&SD_SEL ; Configure pins as SIMO, SOMI & SCK (PxDIR.y are controlled by eUSCI module)
+ BIC #1,&SD_CTLW0 ; release eUSCI from reset
.ENDIF
;---------------------------------------------------------------------------------
-; RESET 7: INIT FORTH machine
+; RESET 6: INIT FORTH machine
;---------------------------------------------------------------------------------
- MOV #RSTACK,RSP ; init return stack
- MOV #PSTACK,PSP ; init parameter stack
- .SWITCH DTC
- .CASE 1
- MOV #xdocol,rDOCOL ;
- .CASE 2
- MOV #EXIT,rEXIT
- .CASE 3 ; inlined DOCOL, do nothing here
- .ENDCASE
- MOV #RFROM,rDOVAR
- MOV #xdocon,rDOCON
- MOV #xdodoes,rDODOES
+ MOV #PSTACK,PSP ; init parameter stack
+ MOV #RSTACK,RSP ; init return stack
+ PUSH #WARM
+ JMP RST_INIT
- MOV #10,&BASE ; init BASE
- MOV #-1,&CAPS ; init CAPS ON
- JMP WARM
;-------------------------------------------------------------------------------
; ASSEMBLER OPTION
;-------------------------------------------------------------------------------
.IFDEF MSP430ASSEMBLER
- .include "forthMSP430FR_ASM.asm"
+ .IFDEF EXTENDED_ASM
+ .include "forthMSP430FR_EXTD_ASM.asm"
+ .ELSE
+ .include "forthMSP430FR_ASM.asm"
+ .ENDIF
+ .ENDIF
+
+;-------------------------------------------------------------------------------
+; FIXED POINT OPERATORS OPTION
+;-------------------------------------------------------------------------------
+ .IFDEF FIXPOINT
+ .include "ADDON/FIXPOINT.asm"
.ENDIF
;-------------------------------------------------------------------------------
.ENDIF
;-------------------------------------------------------------------------------
-; FIXED POINT OPERATORS OPTION
-;-------------------------------------------------------------------------------
- .IFDEF FIXPOINT
- .include "ADDON/FIXPOINT.asm"
- .ENDIF
-
-;-------------------------------------------------------------------------------
-; ADD HERE YOUR PROGRAM TO BE INTEGRATED IN CORE (protected against WIPE)
+; ADD HERE YOUR CODE TO BE INTEGRATED IN KERNEL (protected against WIPE)
;vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-; ADD HERE YOUR PROGRAM TO BE INTEGRATED IN CORE (protected against WIPE)
+; ADD HERE YOUR CODE TO BE INTEGRATED IN KERNEL (protected against WIPE)
;-------------------------------------------------------------------------------
;-------------------------------------------------------------------------------
; RESOLVE ASSEMBLY PTR
;-------------------------------------------------------------------------------
- .include "ResolveThreads.mac"
-
-
- .org 0FFFEh
- .word reset
-
+ .include "ThingsInLast.inc"
OSDN Git Service
