; You should have received a copy of the GNU General Public License
; along with this program. If not, see <http://www.gnu.org/licenses/>.
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; assembled with MACROASSEMBLER AS (http://john.ccac.rwth-aachen.de:8000/as/)
-; ----------------------------------------------------------------------
-
+;-------------------------------------------------------------------------------
.cpu MSP430
.include "mspregister.mac" ;
; macexp off ; unrem to hide macro results
-;----------------------------------------------------------------------------------------------------------
-; Vingt fois sur le métier remettez votre ouvrage,
+;-------------------------------------------------------------------------------
+; Vingt fois sur le métier remettez votre ouvrage,
; Polissez-le sans cesse, et le repolissez,
-; Ajoutez quelquefois, et souvent effacez.
-; Boileau, L'Art poétique
-;----------------------------------------------------------------------------------------------------------
-
-;==========================================================================================================
-; FAST FORTH challenge: time to load, interpret, compile and execute 31136 bytes source file "CORETEST.4th"
-;==========================================================================================================
-; Look at a FAST FORTH competitor @24MHZ, 115200 Bds without flow control, delay=50ms/line ==> result: 54s.
-;==========================================================================================================
-; FAST FORTH on a MSP430FR5738 @500kHz UART 115200 Bds, PL2303TA/HXD, download speed measured by TERATERM
-; real bytes rate without UART connexion : 11.36 kbytes/s ==> 113600 Bds instead of 115200 Bds expected
-; real bytes rate without echo (half duplex) : 3.19 kbytes/s ==> result: 9.75s.
-; process time @ 1MHz = 2/(1/3.19 - 1/11.36) = 8.86 kbytes/s of source file.
-;==========================================================================================================
-; test on a MSP430FR5738 @24MHz UART 6 Mbds via si8622EC-B-IS iso, 1m of cable, PL2303HXD, TERATERM, COREi7
-; download CORETESTx20.4th without UART connexion : 165 kbytes/s ==> 1.65 MBds instead of 6 MBds expected
-; without echo (half duplex), best of 10 downloads: 123.5 kbytes/s ==> result: 0.25s ==> 200 times faster!
-;----------------------------------------------------------------------------------------------------------
-
-;===============================================================================================
-;===============================================================================================
-; before assembling or programming you must set DEVICE in param1 and TARGET in param2 (SHIFT+F8)
-; according to the TARGET "switched" below
-; example : your TARGET = MSP_EXP430FR5969 (notice the underscore) ==> DEVICE = MSP430FR5969
-;===============================================================================================
-;===============================================================================================
-
-;-----------------------------------------------------------------------------------------------
-; TARGET configuration SWITCHES ; bytes values are measured for DTC=1, 8MHz 2457600 bds settings
-;-----------------------------------------------------------------------------------------------
-; TOTAL - SUM of (INFO+RAM +VECTORS) = MAIN PROG
-;MSP_EXP430FR5739 ; compile for MSP-EXP430FR5739 launchpad ; 4136 - 160 ( 24 + 86 + 50 ) = 3976 bytes
-MSP_EXP430FR5969 ; compile for MSP-EXP430FR5969 launchpad ; 4104 - 162 ( 24 + 86 + 52 ) = 3942 bytes
-;MSP_EXP430FR5994 ; compile for MSP-EXP430FR5994 launchpad ; 4138 - 186 ( 24 + 86 + 76 ) = 3952 bytes
-;MSP_EXP430FR6989 ; compile for MSP-EXP430FR6989 launchpad ; 4136 - 168 ( 24 + 86 + 58 ) = 3968 bytes
-;MSP_EXP430FR4133 ; compile for MSP-EXP430FR4133 launchpad ; 4168 - 140 ( 24 + 86 + 30 ) = 4028 bytes
-;CHIPSTICK_FR2433 ; compile for the "CHIPSTICK" of M. Ken BOAK ; 4070 - 148 ( 24 + 86 + 38 ) = 3932 bytes
+; Ajoutez quelquefois, et souvent effacez.
+; Boileau, L'Art poétique
+;-------------------------------------------------------------------------------
+
+;===============================================================================
+;===============================================================================
+;before assembling or programming you must copy your TARGET in param1 (SHIFT+F8)
+;===============================================================================
+;===============================================================================
+
+;-------------------------------------------------------------------------------
+; TARGET configuration SWITCHES ; bytes values are for DTC=1, 8MHz 2457600 bds XON/XOFF
+;-------------------------------------------------------------------------------
+; TOTAL - SUM of (INFO+RAM +VECTORS) = MAIN PROG
+;MSP_EXP430FR5739 ;; MSP-EXP430FR5739 launchpad ; 4154 - 160 ( 24 + 86 + 50 ) = 3994 bytes
+;MSP_EXP430FR5969 ; MSP-EXP430FR5969 launchpad ; 4136 - 162 ( 24 + 86 + 52 ) = 3974 bytes
+MSP_EXP430FR5994 ; MSP-EXP430FR5994 launchpad ; 4172 - 186 ( 24 + 86 + 76 ) = 3986 bytes
+;MSP_EXP430FR6989 ; MSP-EXP430FR6989 launchpad ; 4170 - 168 ( 24 + 86 + 58 ) = 4002 bytes
+;MSP_EXP430FR4133 ; MSP-EXP430FR4133 launchpad ; 4180 - 140 ( 24 + 86 + 30 ) = 4040 bytes
+;CHIPSTICK_FR2433 ; "CHIPSTICK" of M. Ken BOAK ; 4096 - 148 ( 24 + 86 + 38 ) = 3948 bytes
+;MY_MSP430FR5738 ; my MSP430FR5738 miniboards ; 4100 - 160 ( 24 + 86 + 50 ) = 3940 bytes
+;MY_MSP430FR5738_1 ; MYMSP430FR5738_1 miniboard ; 4100 - 160 ( 24 + 86 + 50 ) = 3940 bytes
+;MY_MSP430FR5948 ; my MSP430FR5948 miniboard ; 4110 - 162 ( 24 + 86 + 52 ) = 3948 bytes
+;MY_MSP430FR5948_1 ; my MSP430FR5948_1 miniboard ; 4122 - 162 ( 24 + 86 + 52 ) = 3960 bytes
+;JMJ_BOX ; JMJ_BOX MSP430FR5738 ; 4088 - 160 ( 24 + 86 + 50 ) = 3928 bytes
+;PA8_PA_MSP430 ; PA8_PA_MSP430 MSP430FR5738 ; 4088 - 160 ( 24 + 86 + 50 ) = 3928 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 2 : DOCOL = PUSH IP, CALL rEXIT 13 cycles 2 words good compromize for mix FORTH/ASM code
- ; DTC model 3 : inlined DOCOL 9 cycles 4 words fastest
+DTC .equ 2 ; DTC model 1 : DOCOL = CALL rDOCOL 14 cycles 1 word shortest DTC model
+ ; DTC model 2 : DOCOL = PUSH IP, CALL rEXIT 13 cycles 2 words good compromize for mix FORTH/ASM code
+ ; DTC model 3 : inlined DOCOL 9 cycles 4 words fastest
-FREQUENCY .equ 16 ; fully tested at 0.5,1,2,4,8,16 (and 24 for MSP430FR57xx) MHz
-THREADS .equ 16 ; 1, 4, 8, 16, 32 search entries in dictionnary. 16 is an optimum: speed up to 8 the interpretation.
+FREQUENCY .equ 16 ; fully tested at 0.25,0.5,1,2,4,8,16 (and 24 for MSP430FR57xx) MHz
+THREADS .equ 16 ; 1, 4, 8, 16, 32 search entries in dictionnary. 16 is the good compromise between speed and size.
; +40, +66, +90, +154 bytes
-TERMINALBAUDRATE .equ 3000000 ; choose value considering the frequency and the bridge uart/USB, see explanations below.
-TERMINALXONXOFF ;; to allow XON/XOFF flow control (PL2303TA/CP2102 devices)
-;TERMINALCTSRTS ; to allow Hardware flow control (FT232RL device)
+TERMINALBAUDRATE .equ 921600 ; choose value considering the frequency and the UART2USB bridge, see choices below.
+
+ ; select a minima one item below, input terminal don't work if no flow control.
+TERMINALXONXOFF ; set 3 wires (GND,RX,TX) XON/XOFF software flow control; unselect if you plan to use binary flows
+TERMINALCTSRTS ; +12 bytes to set 4 wires (GND,RX,TX,RTS) hardware input flow control
- .include "Target.inc" ; to define target config: I/O, memory, SFR, vectors, TERMINAL eUSCI, SD_Card eUSCI, LF_XTAL,
+ .include "Target.inc" ; to define target config: I/O, memory, SFR, vectors, TERMINAL eUSCI, SD_Card eUSCI, LF_XTAL,
+ ; but only for FAST FORTH core use, not for your FAST FORTH application.
-;-----------------------------------------------------------------------
-; KERNEL ADD-ON SWITCHES ;
-;-----------------------------------------------------------------------
-MSP430ASSEMBLER ; + 1896 bytes : add embedded assembler with TI syntax; without, you can do all but all much more slowly...
-;SD_CARD_LOADER ; + 1776 bytes to LOAD source files from SD_card
-;SD_CARD_READ_WRITE ; + 1162 bytes to create, read, write, close and del files, + copy file from PC to SD_Card
+;-------------------------------------------------------------------------------
+; KERNEL ADD-ON SWITCHES
+;-------------------------------------------------------------------------------
+CONDCOMP ;; + 354 bytes : add conditionnal compilation : [UNDEFINED] [DEFINED] [IF] [ELSE] [THEN], strongly recommended.
+MSP430ASSEMBLER ;; + 1894 bytes : add embedded assembler with TI syntax; without, you can do all but all much more slowly...
+SD_CARD_LOADER ;; + 1834 bytes : to LOAD source files from SD_card
+SD_CARD_READ_WRITE ;; + 1176 bytes : to read, create, write and del files + source files direct copy from PC to SD_Card
+BOOTLOADER ; + 50 bytes : add a bootstrap to SD_CARD\BOOT.4TH.
;VOCABULARY_SET ; + 108 bytes : add VOCABULARY FORTH ASSEMBLER ALSO PREVIOUS ONLY DEFINITIONS (FORTH83, not ANSI)
-;LOWERCASE ; + 30 bytes : enable to EMIT strings in lowercase.
+;LOWERCASE ; + 30 bytes : enable to write strings in lowercase.
;BACKSPACE_ERASE ; + 24 bytes : replace BS by ERASE, for visual comfort
-;-------------------------------------------------------------------------------------------------
-; OPTIONAL KERNELL ADD-ON SWITCHES, because their source file can be downloaded later >----------------+
-;------------------------------------------------------------------------------------------------- |
-; v
-;UTILITY ; + 404 bytes : add .S WORDS U.R DUMP ? UTILITY.f
-;SD_TOOLS ; + 126 bytes for trivial DIR, FAT, CLUSTER and SECTOR view, needs UTILITY SD_TOOLS.f
-;ANS_CORE_COMPLIANT ; + 876 bytes : required to pass coretest.4th ; (includes items below) COMPxMPY.f (x = H or S)
-;ARITHMETIC ; + 358 bytes : add S>D M* SM/REM FM/MOD * /MOD / MOD */MOD /MOD */ ARITxMPY.f (x = H or S)
-;DOUBLE ; + 130 bytes : add 2@ 2! 2DUP 2SWAP 2OVER DOUBLE.f
-;ALIGNMENT ; + 24 bytes : add ALIGN ALIGNED ALIGN.f
-;PORTABILITY ; + 46 bytes : add CHARS CHAR+ CELLS CELL+ PORTABLE.f
-
-
-
-;=================================================================
-; XON/XOFF control flow configuration ; up to 285kBd/MHz with ECHO
-;=================================================================
-; notice: these specified baud rates perform downloads error free.
-
-; the cheapest and best : UARTtoUSB cable with Prolific PL2303TA (supply current = 8 mA) or PL2303HXD
-; ---------------------------------------------------------------------------------------------------
-; WARNING ! if you use it as supply for your target, open box before to weld red wire on 3v3 pad !
-; ---------------------------------------------------------------------------------------------------
-; 9600,19200,38400,57600,115200,134400 (500kHz)
-; + 161280,201600,230400,268800 (1MHz)
+;-------------------------------------------------------------------------------
+; OPTIONAL KERNELL ADD-ON SWITCHES (can be downloaded later) >------------------+
+; Tip: when switched ON below, ADD-ONs become protected against WIPE and Deep Reset... |
+;------------------------------------------------------------------------------- v
+;UTILITY ; + 412/494 bytes : add .S .RS WORDS U.R DUMP ? UTILITY.f
+;SD_TOOLS ; + 126 bytes for trivial DIR, FAT, CLUSTER and SECTOR view, adds UTILITY SD_TOOLS.f
+;ANS_CORE_COMPLIANT ; + 876 bytes : required to pass coretest.4th ; (includes items below) COMPxMPY.f (x = H or S)
+;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+
+
+
+;===============================================================================
+; XON/XOFF control flow configuration ; up to 322kBd/MHz with ECHO
+;===============================================================================
+
+; Only two usb2uart bridges correctly handle XON/XOFF: cp2102 and pl2303.
+
+; the best and cheapest: UARTtoUSB cable with Prolific PL2303TA (supply current = 8 mA) or PL2303HXD
+; ...but pl2303HXD cable have not the 3.3V pin...
+; I bought a cable pl2303TA plus a cable pl2303HXD, and I recovered the 6-wire cable of the HXD to weld it on
+; the TA. I obtain a PL2303TA cable with GND, 3.3V, RX TX, CTS and RTS.
+;==============================================================================================================
+;==============================================================================================================
+; About pl2303 USB2UART bridge: XON/XOFF no longer works with new driver v3.8.12.0 (03/03/2017)...
+; So, get on web the previous PL2303_Prolific_DriverInstaller_v1160.exe (or .zip) and save it before install.
+;==============================================================================================================
+;==============================================================================================================
+; --------------------------------------------------------------------------------------------
+; WARNING ! if you use PL2303TA cable as supply, open box before to weld red wire on 3v3 pad !
+; --------------------------------------------------------------------------------------------
+; 9600,19200,38400,57600 (250kHz)
+; + 115200,134400 (500kHz)
+; + 201600,230400,268800 (1MHz)
; + 403200,460800,614400 (2MHz)
; + 806400,921600,1228800 (4MHz)
; + 2457600 (8MHz)
; UARTtoUSB module with Silabs CP2102 (supply current = 20 mA)
; ---------------------------------------------------------------------------------------------------
-; WARNING ! if you use it as supply for your target, connect VCC on the wire 3v3 !
+; WARNING ! if you use it as supply, buy a CP2102 module with a VCC switch 5V/3V3 and swith on 3V3 !
; ---------------------------------------------------------------------------------------------------
-; 9600,19200,38400,57600 (500kHz)
-; + 115200 (1MHz)
-; + 230400 (2MHz)
-; + 460800 (4MHz)
-; + 921600,1382400,1843200 (8MHz,16MHz,24MHz)
-; notice that you must program the CP2102 device to add speeds 1382400, 1843200 bds.
+; 9600,19200,38400 (250kHz)
+; + 57600 (500kHz)
+; + 115200,134400,230400 (1MHz)
+; + 460800 (2MHz)
+; + 921600 (4MHz)
+; + 1382400,1843200 (8MHz) (must be reprogrammed)
+; + 4000000 (16MHz,24MHz) (must be reprogrammed)
+; ...But beyond 921600 bds, while the download is done without errors, some chars issued by FAST FORTH are lost ...
; Launchpad --- UARTtoUSB device
; RX <-- TX
; NewLine transmit : CR+LF
; Size : 128 chars x 49 lines (adjust lines to your display)
-; TERATERM config serial port : 9600 to 6000000 Bds,
+; TERATERM config serial port : TERMINALBAUDRATE value,
; 8bits, no parity, 1Stopbit,
; XON/XOFF flow control,
; delay = 0ms/line, 0ms/char
; don't forget : save new TERATERM configuration !
-;=================================================================
-; Hardware control flow configuration with FT232RL device only
-;=================================================================
-
-; UARTtoUSB module with FTDI FT232RL
-;===============================================================================================
-; WARNING ! buy a FT232RL module with a switch 5V/3V3 and select 3V3 !
-;===============================================================================================
-; 9600,19200,38400,57600,115200 (500kHz)
-; + 230400 (1MHz)
-; + 460800 (2MHz)
-; + 921600 (4,8,16 MHz)
+;===============================================================================
+; Hardware control flow configuration: RTS is wired on UART2USB CTS pin
+;===============================================================================
-; Launchpad UARTtoUSB device
+; Launchpad <-> UARTtoUSB
; RX <-- TX
; TX --> RX
; RTS --> CTS
; notice that the control flow seems not necessary for TX
+; UARTtoUSB module with PL2303TA/HXD
+; --------------------------------------------------------------------------------------------
+; WARNING ! if you use PL2303TA cable as supply, open box before to weld red wire on 3v3 pad !
+; --------------------------------------------------------------------------------------------
+; 9600,19200,38400,57600,115200,134400 (500kHz)
+; + 201600,230400,268800 (1MHz)
+; + 403200,460800,614400 (2MHz)
+; + 806400,921600,1228800 (4MHz)
+; + 2457600 (8MHz)
+; + 3000000 (16MHz, 24MHz with MSP430FR57xx))
+
+
+; UARTtoUSB module with FTDI FT232RL (FT230X don't work correctly)
+;-------------------------------------------------------------------------------
+; WARNING ! buy a FT232RL module with a switch 5V/3V3 and select 3V3 !
+;-------------------------------------------------------------------------------
+; 9600,19200,38400,57600,115200 (500kHz)
+; + 230400 (1MHz)
+; + 460800 (2MHz)
+; + 921600 (4,8,16 MHz)
+
; TERATERM config terminal : NewLine receive : AUTO,
-; NewLine transmit : CR+LF (so FT232RL can test its CTS line during transmit LF)
+; NewLine transmit : CR+LF
; Size : 128 chars x 49 lines (adjust lines to your display)
-; TERATERM config serial port : 9600 to 921600 Bds,
+; 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 !
-
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; DTCforthMSP430FR5xxx Init vocabulary pointers:
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
.IF THREADS = 1
.include "ForthThreads.mac"
.ENDIF
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; DTCforthMSP430FR5xxx RAM memory map:
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; name words ; comment
-;LSTACK=L0 ; ----- 1C00
+;LSTACK = L0 = LEAVEPTR ; ----- RAMSTART
; |
LSTACK_SIZE .equ 16 ; | grows up
; |
; |
PSTACK_SIZE .equ 48 ; | grows down
; |
-;PSTACK=S0 ; ----- 1C80
+;PSTACK=S0 ; ----- RAMSTART + $80
;
; ^
; |
RSTACK_SIZE .equ 48 ; | grows down
; |
-;RSTACK=R0 ; ---- 1CE0
+;RSTACK=R0 ; ----- RAMSTART + $E0
; aligned buffers only required for terminal tasks.
; names bytes ; comments
-;PAD ; ----- 1CE2
+;PAD ; ----- RAMSTART + $E2
; |
-PAD_SIZE .equ 84 ; | grows up (ans spec. : PAD >= 84 chars)
+PAD_LEN .equ 84 ; | grows up (ans spec. : PAD >= 84 chars)
; |
; v
- ; ------1D36
-;TIB ; ----- 1D38
+ ; ----- RAMSTART + $136
+;TIB ; ----- RAMSTART + $138
; |
-TIB_SIZE .equ 80 ; | grows up (ans spec. : TIB >= 80 chars)
+TIB_LEN .equ 80 ; | grows up (ans spec. : TIB >= 80 chars)
; |
; v
; ^
; |
HOLD_SIZE .equ 34 ; | grows down (ans spec. : HOLD_SIZE >= (2*n) + 2 char, with n = 16 bits/cell
; |
-;BASE_HOLD ; ----- 1DAA
- ; |
-; variables systme ; | grows up
- ; |
- ; v
-;BUFFER ; ----- 1DDC
-;INPUT_BUFFER ; 512 bytes buffer
- ; ----- 1FDC
+;BASE_HOLD ; ----- RAMSTART + $1AA
+ ;
+; variables system ;
+ ;
+ ; ----- RAMSTART + $1DC
+ ;
+ ; 32 bytes free
+ ;
+;BUFFER-2 ; ----- RAMSTART + $1FD
+;BUFFER ; ----- RAMSTART + $200
+ ;
+ ; 512 bytes buffer
+ ;
+ ; ----- RAMSTART + $2FF
LSTACK .equ RAMSTART
+LEAVEPTR .equ LSTACK ; Leave-stack pointer
PSTACK .equ LSTACK+(LSTACK_SIZE*2)+(PSTACK_SIZE*2)
RSTACK .equ PSTACK+(RSTACK_SIZE*2)
-PAD .equ RSTACK+2
-TIB .equ PAD+PAD_SIZE+2
-BASE_HOLD .equ TIB+TIB_SIZE+HOLD_SIZE
+PAD_ORG .equ RSTACK+2
+TIB_ORG .equ PAD_ORG+PAD_LEN+2
+BASE_HOLD .equ TIB_ORG+TIB_LEN+HOLD_SIZE
; ----------------------------------
.org BASE_HOLD
HP .word 0 ; HOLD ptr
-LEAVEPTR .word 0 ; Leave-stack pointer
-LAST_NFA .word 0 ; NFA, VOC_PFA, LFA, CFA, CSP of last created word
-LAST_THREAD .word 0
+CAPS .word 0
+LAST_NFA .word 0 ; NFA, VOC_PFA, LFA, CFA, PSP of last created word
+LAST_THREAD .word 0 ; used by QREVEAL
LAST_CFA .word 0
-LAST_CSP .word 0
+LAST_PSP .word 0
STATE .word 0 ; Interpreter state
ASM_CURRENT .word 0 ; preserve CURRENT during create assembler words
OPCODE .word 0 ; OPCODE adr
CURRENT .word 0 ; CURRENT dictionnary ptr
CONTEXT .word 0,0,0,0,0,0,0,0 ; CONTEXT dictionnary space (8 CELLS)
BASE .word 0
-CAPS .word 0
+ .word 0 ; user free use
.word 0,0,0,0,0,0,0,0 ; user free use
.word 0,0,0,0,0,0,0,0 ; user free use
-
-
; ------------------------------
; RAM SD_CARD BUFFER 2+512 bytes
; ------------------------------
- .word 0 ; to init BufferPtr down to -2 (to skip a CR, for example)
+ .word 0 ; to able init BufferPtr down to -2 (to skip a CR, for example)
BUFFER
-BUFEND .equ BUFFER + 200h
+BUFEND .equ BUFFER + 200h ; 512bytes
-; ----------------------------------------------------------------------
+
+;-------------------------------------------------------------------------------
; INFO(DCBA) >= 256 bytes memory map:
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
.org INFOSTART
INI_THREAD .word THREADS ; used by ADDON_UTILITY.f
INI_TERM .word TERMINAL_INT ; used by RESET
- .IF FREQUENCY = 0.5
+ .IF FREQUENCY = 0.25
+FREQ_KHZ .word 250 ; user use
+ .ELSEIF FREQUENCY = 0.5
FREQ_KHZ .word 500 ; user use
.ELSE
FREQ_KHZ .word FREQUENCY*1000 ; user use
.ENDIF
HECTOBAUDS .word TERMINALBAUDRATE/100 ; user use
-SAVE_SYSRSTIV .word -3 ; to perform DEEP_RST after FastForth compiling
+SAVE_SYSRSTIV .word 05 ; value to identify FAST FORTH first start after core recompiling
LPM_MODE .word CPUOFF+GIE ; LPM0 is the default mode
INIDP .word ROMDICT ; define RST_STATE
INIVOC .word lastvoclink ; define RST_STATE
- .word XON ; user use
- .word XOFF ; user use
+ .word RXON ; user use
+ .word RXOFF ; user use
.IFDEF SD_CARD_LOADER
.word ReadSectorWX ; used by ADDON_SD_TOOLS.f
.ELSEIF
.word 0
.ENDIF ; SD_CARD_READ_WRITE
- .ELSEIF
+ .ELSEIF
.word 0,0
.ENDIF ; SD_CARD_LOADER
; ------------------------------
; VARIABLES that could be in RAM
; ------------------------------
- .IFNDEF RAM_1K ; if RAM = 1K the variables below stay in FRAM
+ .IFNDEF RAM_1K ; if RAM = 1K (FR57xx) the variables below stay in FRAM
.org BUFEND ; else in RAM beyond BUFFER
.ENDIF
SD_ORG_DATA
.word 0 ; guard word
; ---------------------------------------
-; FAT16 FileSystemInfos
+; FAT16 FileSystemInfos
; ---------------------------------------
FATtype .word 0
BS_FirstSectorL .word 0 ; init by SD_Init, used by RW_Sector_CMD
BS_FirstSectorH .word 0 ; init by SD_Init, used by RW_Sector_CMD
-OrgFAT1 .word 0 ; init by SD_Init,
+OrgFAT1 .word 0 ; init by SD_Init,
FATSize .word 0 ; init by SD_Init,
OrgFAT2 .word 0 ; init by SD_Init,
-OrgRootDIR .word 0 ; init by SD_Init, (FAT16 specific)
+OrgRootDIR .word 0 ; init by SD_Init, (FAT16 specific)
OrgClusters .word 0 ; init by SD_Init, Sector of Cluster 0
SecPerClus .word 0 ; init by SD_Init, byte size
; ---------------------------------------
; SD command
; ---------------------------------------
-SD_CMD_FRM .byte 0,0,0,0,0,0 ; SD_CMDx inverted frame ${CRC7,ll,LL,hh,HH,CMD}
+SD_CMD_FRM .byte 0,0,0,0,0,0 ; SD_CMDx inverted frame ${CRC7,ll,LL,hh,HH,CMD}
SectorL .word 0
SectorH .word 0
; ---------------------------------------
ClusterL .word 0 ;
ClusterH .word 0 ;
-NewClusterL .word 0 ;
-NewClusterH .word 0 ;
-FATsector .word 0 ; not used
+NewClusterL .word 0 ;
+NewClusterH .word 0 ;
CurFATsector .word 0 ; current FATSector of last free cluster
; ---------------------------------------
; ---------------------------------------
SAVEtsLEN .word 0 ; of previous ACCEPT
SAVEtsPTR .word 0 ; of previous ACCEPT
-MemSectorL .word 0 ;
-MemSectorH .word 0 ;
+ .word 0 ;
+ .word 0 ;
+ .word 0
; ---------------------------------------
; Handle structure
; ---------------------------------------
-; three handle tokens :
+; three handle tokens :
; HDLB_Token= 0 : free handle
; = 1 : file to read
; = 2 : file updated (write)
HDLW_BUFofst .equ 22 ; BUFFER offset ; used by LOAD"
- .IFDEF RAM_1K ; RAM_Size = 1k
+ .IFDEF RAM_1K ; RAM_Size = 1k, no SDIB due to the lack of RAM
+FirstHandle
HandleMax .equ 7
HandleLenght .equ 24
+HandleEnd .equ FirstHandle+handleMax*HandleLenght
-;OpenedFirstFile ; structure "openedFile"
-FirstHandle .word 0,0,0,0,0,0,0,0,0,0,0,0
- .word 0,0,0,0,0,0,0,0,0,0,0,0
- .word 0,0,0,0,0,0,0,0,0,0,0,0
- .word 0,0,0,0,0,0,0,0,0,0,0,0
- .word 0,0,0,0,0,0,0,0,0,0,0,0
- .word 0,0,0,0,0,0,0,0,0,0,0,0
- .word 0,0,0,0,0,0,0,0,0,0,0,0
-HandleEnd
+ .org HandleEnd
.ELSEIF ; RAM_Size >= 2k
+FirstHandle
HandleMax .equ 8
HandleLenght .equ 24
+HandleEnd .equ FirstHandle+handleMax*HandleLenght
-;OpenedFirstFile ; structure "openedFile"
-FirstHandle .word 0,0,0,0,0,0,0,0,0,0,0,0
- .word 0,0,0,0,0,0,0,0,0,0,0,0
- .word 0,0,0,0,0,0,0,0,0,0,0,0
- .word 0,0,0,0,0,0,0,0,0,0,0,0
- .word 0,0,0,0,0,0,0,0,0,0,0,0
- .word 0,0,0,0,0,0,0,0,0,0,0,0
- .word 0,0,0,0,0,0,0,0,0,0,0,0
- .word 0,0,0,0,0,0,0,0,0,0,0,0
-HandleEnd
-
-
+ .org HandleEnd
SDIB
-SDIB_SIZE .equ 84
+SDIB_LEN .equ 84
- .org SDIB+SDIB_SIZE
+ .org SDIB+SDIB_LEN
.ENDIF ; RAM_Size
-SD_END_DATA
-
.ENDIF ; SD_CARD_LOADER
-; ----------------------------------------------------------------------
-; DTCforthMSP430FR5xxx REGISTER USAGE
-; ----------------------------------------------------------------------
-
- .SWITCH DTC
- .CASE 1 ; DOCOL = CALL rDOCOL
-
-RSP .reg SP ; RSP = Return Stack Pointer (return stack)
-
-; DOxxx registers ; must be saved before use and restored after use
-rDODOES .reg r4
-rDOCON .reg r5
-rDOVAR .reg r6
-rDOCOL .reg R7
-
-; Scratch registers
-Y .reg R8
-X .reg R9
-W .reg R10
-T .reg R11
-S .reg R12
-
-; Forth virtual machine
-IP .reg R13 ; interpretative pointer
-TOS .reg R14 ; first PSP cell
-PSP .reg R15 ; PSP = Parameters Stack Pointer (stack data)
-
- .CASE 2 ; DOCOL = PUSH IP + CALL rEXIT
-RSP .reg SP ; RSP = Return Stack Pointer (return stack)
+SD_END_DATA ; used by SD_INIT to init SD_ram area
-; DOxxx registers ; must be saved before use and restored after use
-rDODOES .reg r4
-rDOCON .reg r5
-rDOVAR .reg r6
-rEXIT .reg R7
+;-------------------------------------------------------------------------------
+; DTCforthMSP430FR5xxx program (FRAM) memory
+;-------------------------------------------------------------------------------
-; Scratch registers
-Y .reg R8
-X .reg R9
-W .reg R10
-T .reg R11
-S .reg R12
+ .org PROGRAMSTART
-; Forth virtual machine
-IP .reg R13 ; interpretative pointer
-TOS .reg R14 ; first PSP cell
-PSP .reg R15 ; PSP = Parameters Stack Pointer (stack data)
+;-------------------------------------------------------------------------------
+; DEFINING EXECUTIVE WORDS - DTC model
+;-------------------------------------------------------------------------------
- .CASE 3 ; INLINED DOCOL
+;-------------------------------------------------------------------------------
+; very nice FAST FORTH added feature:
+;-------------------------------------------------------------------------------
+; as IP is computed from the PC value, we can place low level to high level
+; switches "COLON" or "LO2HI" anywhere in a word, i.e. not only at its beginning.
+;-------------------------------------------------------------------------------
-RSP .reg SP ; RSP = Return Stack Pointer (return stack)
+RSP .reg R1 ; RSP = Return Stack Pointer (return stack)
; DOxxx registers ; must be saved before use and restored after use
rDODOES .reg r4
rDOVAR .reg r6
; Scratch registers
-R .reg R7
-Y .reg R8
-X .reg R9
+Y .reg R8
+X .reg R9
W .reg R10
T .reg R11
S .reg R12
TOS .reg R14 ; first PSP cell
PSP .reg R15 ; PSP = Parameters Stack Pointer (stack data)
- .ENDCASE ; DTC
-
-; ----------------------------------------------------------------------
-; DTCforthMSP430FR5xxx program (FRAM) memory
-; ----------------------------------------------------------------------
-
- .org PROGRAMSTART
-
-; ----------------------------------------------------------------------
-; DEFINING EXECUTIVE WORDS - DTC model
-; ----------------------------------------------------------------------
-
-; ----------------------------------------------------------------------
-; very nice FAST FORTH added feature:
-; ----------------------------------------------------------------------
-; as IP is calculated from the PC value we can place the low to high level
-; switches "COLON" or "LO2HI" anywhere in a word, i.e. not only at its beginning.
-; ----------------------------------------------------------------------
-
-
- .SWITCH DTC
- .CASE 1 ; DOCOL = CALL rDOCOL
-
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
-ASMtoFORTH .MACRO ; compiled by LO2HI
- CALL #EXIT ;
- .ENDM ; 2 words, 10~
-DOCOL1 .equ 1287h ; 4 CALL R7 ; [R7] is set as xdocol by COLD
-mDOCOL .MACRO ; compiled by : and by colon
- CALL R7 ;
- .ENDM ; 14~ 1 word
+ .SWITCH DTC
+;-------------------------------------------------------------------------------
+ .CASE 1 ; DOCOL = CALL rDOCOL
+;-------------------------------------------------------------------------------
+
+rDOCOL .reg R7 ; COLD defines xdocol as R7 content
-xdocol ; 4 for CALL rDOCOL
- MOV @RSP+,W ; 2
+xdocol MOV @RSP+,W ; 2
PUSH IP ; 3 save old IP on return stack
MOV W,IP ; 1 set new IP to PFA
MOV @IP+,PC ; 4 = NEXT
- ; 14 = ITC +4
+ ; 10 cycles
- .CASE 2 ; DOCOL = PUSH IP + CALL rEXIT
+ASMtoFORTH .MACRO ; compiled by LO2HI
+ CALL #EXIT ; 2 words, 10 cycles
+ .ENDM ;
-mNEXT .MACRO
- MOV @IP+,PC ; 4 fetch code address into PC, IP=PFA
- .ENDM ; 4cycles,1word = ITC -2cycles -1 word
+mDOCOL .MACRO ; compiled by : and by colon
+ CALL R7 ; 1 word, 14 cycles (CALL included) = ITC+4
+ .ENDM ;
-NEXT .equ 4D30h ; 4 MOV @IP+,PC
+DOCOL1 .equ 1287h ; 4 CALL R7
-FORTHtoASM .MACRO ; compiled by HI2LO
- .word $+2 ; 0 cycle
- .ENDM ; 0 cycle, 1 word
+;-------------------------------------------------------------------------------
+ .CASE 2 ; DOCOL = PUSH IP + CALL rEXIT
+;-------------------------------------------------------------------------------
+
+rEXIT .reg R7 ; COLD defines EXIT as R7 content
ASMtoFORTH .MACRO ; compiled by LO2HI
- CALL rEXIT ; CALL EXIT
- .ENDM ; 10 cycles, 1 word
+ CALL rEXIT ; 1 word, 10 cycles
+ .ENDM ;
mDOCOL .MACRO ; compiled by : and by COLON
PUSH IP ; 3
- CALL rEXIT ; 10 CALL EXIT
- .ENDM ; 13 cycles (ITC+3), two words
+ CALL rEXIT ; 10
+ .ENDM ; 2 words, 13 cycles = ITC+3
DOCOL1 .equ 120Dh ; 3 PUSH IP
-DOCOL2 .equ 1287h ; 4 CALL rEXIT ; [rEXIT] is set as EXIT by COLD
+DOCOL2 .equ 1287h ; 4 CALL rEXIT
+;-------------------------------------------------------------------------------
.CASE 3 ; inlined DOCOL
+;-------------------------------------------------------------------------------
-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
-
-NEXT .equ 4D30h ; 4 MOV @IP+,PC
-
-FORTHtoASM .MACRO ; compiled by HI2LO
- .word $+2 ; 0 cycle
- .ENDM ; 0 cycle, 1 word
+R .reg R7 ; Scratch register
ASMtoFORTH .MACRO ; compiled by LO2HI
- MOV PC,IP ; 1
- ADD #4,IP ; 1
+ MOV PC,IP ; 1
+ ADD #4,IP ; 1
MOV @IP+,PC ; 4 NEXT
.ENDM ; 6 cycles, 3 words
mDOCOL .MACRO ; compiled by : and by COLON
- PUSH IP ; 3
- MOV PC,IP ; 1
- ADD #4,IP ; 1
+ PUSH IP ; 3
+ MOV PC,IP ; 1
+ ADD #4,IP ; 1
MOV @IP+,PC ; 4 NEXT
- .ENDM ; 9 cycles (ITC -1), 4 words
+ .ENDM ; 4 words, 9 cycles (ITC-1)
DOCOL1 .equ 120Dh ; 3 PUSH IP
DOCOL2 .equ 400Dh ; 1 MOV PC,IP
-DOCOL3 .equ 522Dh ; 1 ADD #4,IP
+DOCOL3 .equ 522Dh ; 1 ADD #4,IP
.ENDCASE ; DTC
+;-------------------------------------------------------------------------------
; mDOVAR leave on parameter stack the PFA of a VARIABLE definition
+;-------------------------------------------------------------------------------
mDOVAR .MACRO ; compiled by VARIABLE
- CALL rDOVAR ; CALL RFROM
- .ENDM ; 14 cycles (ITC+4), 1 word
+ CALL rDOVAR ; 1 word, 14 cycles (ITC+4)
+ .ENDM ;
-DOVAR .equ 1286h ; 4 CALL rDOVAR ; [rDOVAR] is set as RFROM by COLD
+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 ; CALL xdocon
- .ENDM ; 16 cycles (ITC+4), 1 word
+ CALL rDOCON ; 1 word, 16 cycles (ITC+4)
+ .ENDM ;
-DOCON .equ 1285h ; 4 CALL rDOCON ; [rDOCON] is set as xdocon by COLD
+DOCON .equ 1285h ; 4 CALL rDOCON ; [rDOCON] is defined as xdocon by COLD
xdocon ; -- constant ; 4 for CALL rDOCON
- SUB #2,PSP ; 1 make room on stack
- MOV TOS,0(PSP) ; 3 push first PSP cell
- MOV @RSP+,TOS ; 2 TOS=CONSTANT address
- MOV @TOS,TOS ; 2 TOS=CONSTANT
+ 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
+;-------------------------------------------------------------------------------
+; 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 ; 19 cycles (ITC-2), 1 word
+ CALL rDODOES ; CALL xdodoes
+ .ENDM ; 1 word, 19 cycles (ITC-2)
-DODOES .equ 1284h ; 4 CALL rDODOES ; [rDODOES] is set as xdodoes by COLD
+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 of created word
+ MOV @TOS+,IP ; 2 IP = CFA of Master word, TOS = BODY address of created word
MOV @IP+,PC ; 4 Execute Master word
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; INTERPRETER LOGIC
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
-;C EXIT -- exit a colon definition; CALL #EXIT performs ASMtoFORTH
+;https://forth-standard.org/standard/core/EXIT
+;C EXIT -- exit a colon definition; CALL #EXIT performs ASMtoFORTH (10 cycles)
FORTHWORD "EXIT"
-EXIT MOV @RSP+,IP ; 2 pop previous IP (or next PC) from return stack
+EXIT: MOV @RSP+,IP ; 2 pop previous IP (or next PC) from return stack
MOV @IP+,PC ; 4 = NEXT
; 6 = ITC - 2
;Z lit -- x fetch inline literal to stack
; This is the primitive compiled by LITERAL.
FORTHWORD "LIT"
-lit SUB #2,PSP ; 2 push old TOS..
+lit: SUB #2,PSP ; 2 push old TOS..
MOV TOS,0(PSP) ; 3 ..onto stack
MOV @IP+,TOS ; 2 fetch new TOS value
MOV @IP+,PC ; 4 NEXT
; 11 = ITC - 2
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; STACK OPERATIONS
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
+;https://forth-standard.org/standard/core/DUP
;C DUP x -- x x duplicate top of stack
FORTHWORD "DUP"
-DUP SUB #2,PSP ; 2 push old TOS..
+DUP: SUB #2,PSP ; 2 push old TOS..
MOV TOS,0(PSP) ; 3 ..onto stack
mNEXT ; 4
+;https://forth-standard.org/standard/core/qDUP
;C ?DUP x -- 0 | x x DUP if nonzero
FORTHWORD "?DUP"
-QDUP CMP #0,TOS ; 2 test for TOS nonzero
+QDUP: CMP #0,TOS ; 2 test for TOS nonzero
JNZ DUP ; 2
mNEXT ; 4
+;https://forth-standard.org/standard/core/DROP
;C DROP x -- drop top of stack
FORTHWORD "DROP"
-DROP MOV @PSP+,TOS ; 2
+DROP: MOV @PSP+,TOS ; 2
mNEXT ; 4
+;https://forth-standard.org/standard/core/NIP
+;C NIP x1 x2 -- x2 Drop the first item below the top of stack
+ FORTHWORD "NIP"
+NIP: ADD #2,PSP ; 1
+ mNEXT ; 4
+
+;https://forth-standard.org/standard/core/SWAP
;C SWAP x1 x2 -- x2 x1 swap top two items
FORTHWORD "SWAP"
-SWAP MOV @PSP,W ; 2
+SWAP: MOV @PSP,W ; 2
MOV TOS,0(PSP) ; 3
MOV W,TOS ; 1
mNEXT ; 4
+;https://forth-standard.org/standard/core/OVER
;C OVER x1 x2 -- x1 x2 x1
FORTHWORD "OVER"
-OVER SUB #2,PSP ; 2 -- x1 x x2
- MOV TOS,0(PSP) ; 3 -- x1 x2 x2
- MOV 2(PSP),TOS ; 2 -- x1 x2 x1
+OVER: MOV TOS,-2(PSP) ; 3 -- x1 (x2) x2
+ MOV @PSP,TOS ; 2 -- x1 (x2) x1
+ SUB #2,PSP ; 2 -- x1 x2 x1
mNEXT ; 4
+;https://forth-standard.org/standard/core/ROT
;C ROT x1 x2 x3 -- x2 x3 x1
FORTHWORD "ROT"
-ROT MOV @PSP,W ; 2 fetch x2
+ROT: MOV @PSP,W ; 2 fetch x2
MOV TOS,0(PSP) ; 3 store x3
MOV 2(PSP),TOS ; 3 fetch x1
MOV W,2(PSP) ; 3 store x2
mNEXT ; 4
+;https://forth-standard.org/standard/core/toR
;C >R x -- R: -- x push to return stack
FORTHWORD ">R"
-TOR PUSH TOS
+TOR: PUSH TOS
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
+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
FORTHWORD "R@"
-RFETCH SUB #2,PSP
+RFETCH: SUB #2,PSP
MOV TOS,0(PSP)
MOV @RSP,TOS
mNEXT
-;;Z SP@ -- a-addr get data stack pointer, must leave PSTACK value if stack empty
-; FORTHWORD "SP@"
-SPFETCH MOV TOS,-2(PSP) ;3
- MOV PSP,TOS ;1
- SUB #2,PSP ;1 post decrement stack...
- mNEXT
-
+;https://forth-standard.org/standard/core/DEPTH
;C DEPTH -- +n number of items on stack, must leave 0 if stack empty
FORTHWORD "DEPTH"
DEPTH: MOV TOS,-2(PSP)
RRA TOS ; TOS/2 --> TOS
mNEXT
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; MEMORY OPERATIONS
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
+;https://forth-standard.org/standard/core/Fetch
;C @ a-addr -- x fetch cell from memory
FORTHWORD "@"
-FETCH MOV @TOS,TOS
+FETCH: MOV @TOS,TOS
mNEXT
-
+;https://forth-standard.org/standard/core/Store
;C ! x a-addr -- store cell in memory
FORTHWORD "!"
-STORE MOV @PSP+,0(TOS) ;4
+STORE: MOV @PSP+,0(TOS) ;4
MOV @PSP+,TOS ;2
mNEXT ;4
+;https://forth-standard.org/standard/core/CFetch
;C C@ c-addr -- char fetch char from memory
FORTHWORD "C@"
-CFETCH MOV.B @TOS,TOS
- mNEXT
-
+CFETCH: MOV.B @TOS,TOS ;2
+ mNEXT ;4
+;https://forth-standard.org/standard/core/CStore
;C C! char c-addr -- store char in memory
FORTHWORD "C!"
-CSTORE MOV @PSP+,W ;2
- MOV.B W,0(TOS) ;3
+CSTORE: MOV.B @PSP+,0(TOS);4
+ ADD #1,PSP ;1
MOV @PSP+,TOS ;2
mNEXT
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; ARITHMETIC OPERATIONS
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
+;https://forth-standard.org/standard/core/Plus
;C + n1/u1 n2/u2 -- n3/u3 add n1+n2
FORTHWORD "+"
-PLUS ADD @PSP+,TOS
+PLUS: ADD @PSP+,TOS
mNEXT
-;C - n1/u1 n2/u2 -- n3/u3 subtract n1-n2
+;https://forth-standard.org/standard/core/Minus
+;C - n1/u1 n2/u2 -- n3/u3 n3 = n1-n2
FORTHWORD "-"
-MINUS MOV @PSP+,W ; 2
- SUB TOS,W ; 1
- MOV W,TOS ; 1
+MINUS: SUB @PSP+,TOS ;2 -- n2-n1
+NEGATE: XOR #-1,TOS ;1
+ONEPLUS: ADD #1,TOS ;1 -- n3 = -(n2-n1)
mNEXT
+;https://forth-standard.org/standard/core/AND
;C AND x1 x2 -- x3 logical AND
FORTHWORD "AND"
-ANDD AND @PSP+,TOS
+ANDD: AND @PSP+,TOS
mNEXT
+;https://forth-standard.org/standard/core/OR
;C OR x1 x2 -- x3 logical OR
FORTHWORD "OR"
-ORR BIS @PSP+,TOS
+ORR: BIS @PSP+,TOS
mNEXT
+;https://forth-standard.org/standard/core/XOR
;C XOR x1 x2 -- x3 logical XOR
FORTHWORD "XOR"
-XORR XOR @PSP+,TOS
+XORR: XOR @PSP+,TOS
mNEXT
+;https://forth-standard.org/standard/core/NEGATE
;C NEGATE x1 -- x2 two's complement
FORTHWORD "NEGATE"
-NEGATE XOR #-1,TOS
- ADD #1,TOS
- mNEXT
+ JMP NEGATE
+;https://forth-standard.org/standard/core/ABS
;C ABS n1 -- +n2 absolute value
FORTHWORD "ABS"
ABBS: CMP #0,TOS ; 1
JN NEGATE
mNEXT
-; ----------------------------------------------------------------------
+;https://forth-standard.org/standard/double/DABS
+;C DABS d1 -- |d1| absolute value
+ FORTHWORD "DABS"
+DABBS: AND #-1,TOS ; clear V, set N
+ JGE DABBSEND ; JMP if positive
+DNEGATE: XOR #-1,0(PSP)
+ XOR #-1,TOS
+ ADD #1,0(PSP)
+ ADDC #0,TOS
+DABBSEND mNEXT
+
+;-------------------------------------------------------------------------------
; COMPARAISON OPERATIONS
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
+;https://forth-standard.org/standard/core/ZeroEqual
;C 0= n/u -- flag return true if TOS=0
FORTHWORD "0="
-ZEROEQUAL SUB #1,TOS ; borrow (clear cy) if TOS was 0
+ZEROEQUAL: SUB #1,TOS ; borrow (clear cy) if TOS was 0
SUBC TOS,TOS ; TOS=-1 if borrow was set
mNEXT
+;https://forth-standard.org/standard/core/Zeroless
;C 0< n -- flag true if TOS negative
FORTHWORD "0<"
-ZEROLESS ADD TOS,TOS ; set carry if TOS negative
- SUBC TOS,TOS ; TOS=-1 if carry was clear
- XOR #-1,TOS ; TOS=-1 if carry was set
+ZEROLESS: ADD TOS,TOS ;1 set carry if TOS negative
+ SUBC TOS,TOS ;1 TOS=-1 if carry was clear
+ XOR #-1,TOS ;1 TOS=-1 if carry was set
mNEXT
+;https://forth-standard.org/standard/core/Zeromore
+;C 0> n -- flag true if TOS positive
+ FORTHWORD "0>"
+ZEROMORE: CMP #1,TOS
+ JGE TOSTRUE
+ JMP TOSFALSE
+
+;https://forth-standard.org/standard/core/Equal
;C = x1 x2 -- flag test x1=x2
FORTHWORD "="
-EQUAL: SUB @PSP+,TOS ; 2
- JNZ TOSFALSE ; 2 --> +4
-TOSTRUE: MOV #-1,TOS ; 2 (MOV @R3+,TOS)
- mNEXT ; 4
+EQUAL: SUB @PSP+,TOS ;2
+ JNZ TOSFALSE ;2 --> +4
+TOSTRUE MOV #-1,TOS ;1
+ mNEXT ;4
+;https://forth-standard.org/standard/core/less
;C < n1 n2 -- flag test n1<n2, signed
FORTHWORD "<"
-LESS: MOV @PSP+,W ; 2 W=n1
- SUB TOS,W ; 1 W=n1-n2 flags set
- JL TOSTRUE ; 2
-TOSFALSE MOV #0,TOS ; 1
- mNEXT ; 4
+LESS: MOV @PSP+,W ;2 W=n1
+ SUB TOS,W ;1 W=n1-n2 flags set
+ JL TOSTRUE ;2
+TOSFALSE MOV #0,TOS ;1
+ mNEXT ;4
+;https://forth-standard.org/standard/core/more
;C > n1 n2 -- flag test n1>n2, signed
FORTHWORD ">"
-GREATER: SUB @PSP+,TOS ; 2 TOS=n2-n1
- JL TOSTRUE ; 2
- MOV #0,TOS ; 1
- mNEXT ; 4
+GREATER: SUB @PSP+,TOS ;2 TOS=n2-n1
+ JL TOSTRUE ;2
+ MOV #0,TOS ;1
+ mNEXT ;4
+;https://forth-standard.org/standard/core/Uless
;C U< u1 u2 -- flag test u1<u2, unsigned
FORTHWORD "U<"
-ULESS: MOV @PSP+,W ; 2
- SUB TOS,W ; 1 u1-u2 in W, cy clear if borrow
- JNC TOSTRUE ; 2
- MOV #0,TOS ; 1
- mNEXT ; 4
+ULESS: MOV @PSP+,W ;2
+ SUB TOS,W ;1 u1-u2 in W, carry clear if borrow
+ JNC TOSTRUE ;2
+ MOV #0,TOS ;1
+ mNEXT ;4
-; ----------------------------------------------------------------------
-; BRANCH and LOOP OPERATIONS
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
+; BRANCH and LOOP OPERATORS
+;-------------------------------------------------------------------------------
;Z branch -- branch always
-; FORTHWORD "BRANCH"
-BRAN MOV @IP,IP ; 2
+BRAN: MOV @IP,IP ; 2
mNEXT ; 4
;Z ?branch x -- branch if TOS = zero
-; FORTHWORD "?BRANCH"
-QBRAN CMP #0,TOS ; 1 test TOS value
- MOV @PSP+,TOS ; 2 pop new TOS value (doesn't change flags)
+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
-; FORTHWORD "(DO)"
-
-xdo MOV #8000h,X ;2 compute 8000h-limit "fudge factor"
+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
; 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.
-; FORTHWORD "(+LOOP)"
-
-xploop ADD TOS,0(RSP) ;4 increment INDEX by TOS value
+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.
-; FORTHWORD "(LOOP)"
-
-xloop ADD #1,0(RSP) ;4 increment INDEX
+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
+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 ; make room in TOS
- MOV TOS,0(PSP)
- MOV @RSP,TOS ; index = loopctr - fudge
- SUB 2(RSP),TOS
- mNEXT
+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
+JJ: SUB #2,PSP ; make room in TOS
MOV TOS,0(PSP)
MOV 4(RSP),TOS ; index = loopctr - fudge
SUB 6(RSP),TOS
mNEXT
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; SYSTEM VARIABLES & CONSTANTS
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
+
+;https://forth-standard.org/standard/core/PAD
+; PAD -- pad address
+ FORTHWORD "PAD"
+PAD mDOCON
+ .WORD PAD_ORG
+
+; TIB -- terminal input buffer address
+ FORTHWORD "TIB"
+TIB mDOCON
+ .WORD TIB_ORG ; constant, may be modified by IS
+; CPL -- terminal input buffer lenght (CPL = Chars Per Line)
+ FORTHWORD "CPL"
+CPL mDOCON
+ .WORD TIB_LEN ; constant, may be modified by IS
+
+;https://forth-standard.org/standard/core/toIN
;C >IN -- a-addr holds offset in input stream
FORTHWORD ">IN"
-FTOIN mDOCON
+FTOIN: mDOCON
.word TOIN ; VARIABLE address in RAM space
+;https://forth-standard.org/standard/core/BASE
;C BASE -- a-addr holds conversion radix
FORTHWORD "BASE"
-FBASE mDOCON
- .word BASE ; VARIABLE address in INFO space
+FBASE: mDOCON
+ .word BASE ; VARIABLE address in RAM space
+;https://forth-standard.org/standard/core/STATE
;C STATE -- a-addr holds compiler state
FORTHWORD "STATE"
-FSTATE mDOCON
+FSTATE: mDOCON
.word STATE ; VARIABLE address in RAM space
+;https://forth-standard.org/standard/core/BL
;C BL -- char an ASCII space
FORTHWORD "BL"
-FBLANK mDOCON
+FBLANK: mDOCON
.word 32
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; MULTIPLY
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
.IFNDEF MPY ; if no hardware MPY
; T.I. SIGNED MULTIPLY SUBROUTINE: U1 x U2 -> Ud
+;https://forth-standard.org/standard/core/UMTimes
;C UM* u1 u2 -- ud unsigned 16x16->32 mult.
FORTHWORD "UM*"
-UMSTAR MOV @PSP,S ; U1 = MULTIPLICANDlo
- MOV #0,W ; 0 -> created MULTIPLICANDhi
- MOV #0,Y ; 0 -> created RESULTlo
- MOV #0,T ; 0 -> created RESULThi
- MOV #1,X ; BIT TEST REGISTER
+UMSTAR: MOV @PSP,S ;2 U1 = MULTIPLICANDlo
+ MOV #0,W ;1 0 -> created MULTIPLICANDhi
+ MOV #0,Y ;1 0 -> created RESULTlo
+ MOV #0,T ;1 0 -> created RESULThi
+ MOV #1,X ;1 BIT TEST REGISTER
UMSTARLOOP BIT X,TOS ;1 TEST ACTUAL BIT MULTIPLIER
JZ UMSTARNEXT ;2 IF 0: DO NOTHING
ADD S,Y ;1 IF 1: ADD MULTIPLICAND TO RESULT
ADDC W,W ;1 (RLC MSBs)
ADD X,X ;1 (RLA) NEXT BIT TO TEST
JNC UMSTARLOOP ;2 IF BIT IN CARRY: FINISHED 10~ loop
- MOV Y,0(PSP) ; low result on stack
- MOV T,TOS ; high result in TOS
+ MOV Y,0(PSP) ;3 low result on stack
+ MOV T,TOS ;1 high result in TOS
mNEXT
- .ENDIF ; hardware MPY
+ .ENDIF ; no hardware MPY
-; ----------------------------------------------------------------------------------------
-; ANS complement OPTION that include ALIGNMENT, PORTABILITY, ARITHMETIC and DOUBLE options
-; ----------------------------------------------------------------------------------------
+;-------------------------------------------------------------------------------
+; ANS complement OPTION
+;-------------------------------------------------------------------------------
.IFDEF ANS_CORE_COMPLIANT
.include "ADDON\ANS_COMPLEMENT.asm"
-; ----------------------------------------------------------------------------------------
-
.ELSEIF
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; ALIGNMENT OPERATORS OPTION
-; ----------------------------------------------------------------------
- .IFDEF ALIGNMENT ; included in ANS_COMPLEMENT
- .include "ADDON\ALIGNMENT.asm"
- .ENDIF ; ALIGNMENT
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
+ .IFDEF ALIGNMENT ; included in ANS_COMPLEMENT
+ .include "ADDON\ALIGNMENT.asm"
+ .ENDIF ; ALIGNMENT
+
+;-------------------------------------------------------------------------------
; PORTABILITY OPERATORS OPTION
-; ----------------------------------------------------------------------
- .IFDEF PORTABILITY
- .include "ADDON\PORTABILITY.asm"
- .ENDIF ; PORTABILITY
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
+ .IFDEF PORTABILITY
+ .include "ADDON\PORTABILITY.asm"
+ .ENDIF ; PORTABILITY
+
+;-------------------------------------------------------------------------------
; ARITHMETIC OPERATORS OPTION
-; ----------------------------------------------------------------------
- .IFDEF ARITHMETIC ; included in ANS_COMPLEMENT
- .include "ADDON\ARITHMETIC.asm"
- .ENDIF ; ARITHMETIC
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
+ .IFDEF ARITHMETIC ; included in ANS_COMPLEMENT
+ .include "ADDON\ARITHMETIC.asm"
+ .ENDIF ; ARITHMETIC
+
+;-------------------------------------------------------------------------------
; DOUBLE OPERATORS OPTION
-; ----------------------------------------------------------------------
- .IFDEF DOUBLE ; included in ANS_COMPLEMENT
- .include "ADDON\DOUBLE.asm"
- .ENDIF ; DOUBLE
+;-------------------------------------------------------------------------------
+ .IFDEF DOUBLE ; included in ANS_COMPLEMENT
+ .include "ADDON\DOUBLE.asm"
+ .ENDIF ; DOUBLE
-; ----------------------------------------------------------------------------------------
.ENDIF ; ANS_COMPLEMENT
-; ----------------------------------------------------------------------------------------
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; NUMERIC OUTPUT
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; Numeric conversion is done last digit first, so
; the output buffer is built backwards in memory.
-;C <# -- begin numeric conversion (initialize Hold Pointer in PAD area)
+;https://forth-standard.org/standard/core/num-start
+;C <# -- begin numeric conversion (initialize Hold Pointer)
FORTHWORD "<#"
LESSNUM: MOV #BASE_HOLD,&HP
mNEXT
; unsigned 32-BIT DIVIDEND : 16-BIT DIVISOR --> 32-BIT QUOTIENT, 16-BIT REMAINDER
-; DVDhi|DVDlo : DVR --> QUOThi|QUOTlo, REMAINDER
-; then REMAINDER is converted in ASCII char
-; about 2 times faster if ud1 < 65536 (it's the general case)
-
-; input registers :
-; T = DIVISOR
-; S = DVDlo
-; W = DVDhi
-; output registers :
-; W = remainder
-; X = QUOTlo
-; Y = QUOThi
-; saved registers :
-; IP = count
-; TOS = DVD48
-
-UDIVQ32 ; use S,T,W,X,Y
- .word 151Eh ;4 PUSHM TOS,IP (1+1 push,TOS=Eh): save all no scratch registers before use
- MOV #0,TOS ;1 TOS = DVD48 = 0
- MOV #32,IP ;3 init loop count
- CMP #0,W ;1 DVDhi <> 0 ?
+; DVDhi|DVDlo : DIVlo --> QUOThi|QUOTlo REMlo
+; then REMlo is converted in ASCII char
+; 2 times faster if DVDhi = 0 (it's the general case)
+
+; Input: division NUM
+; -----------------------------
+; S = DVDlo (15-0) = ud1lo
+; TOS = DVDhi (31-16) = ud1hi
+; W = REMAINDER(15-0)
+; T = DIVlo = BASE
+; rDODOES = count
+
+; Output: division NUM
+; -----------------------------
+; X = QUOTlo = ud2lo
+; Y = QUOThi = ud2hi
+; W = REMlo = digit --> char --> -[HP]
+
+;https://forth-standard.org/standard/core/num
+;C # ud1lo ud1hi -- ud2lo ud2hi convert 1 digit of output
+ FORTHWORD "#"
+NUM MOV @PSP,S ;2 TOS = DVDhi, S = DVDlo
+ MOV.B &BASE,T ;3 T = DIVlo
+ MOV #0,W ;1 W = REMlo = 0
+ MOV #32,rDODOES ;2 init loop count
+ CMP #0,TOS ;1 DVDhi <> 0 ?
JNZ MDIV1 ;2 yes
- RRA IP ;1 no: loop count / 2
- MOV S,W ;1 DVD = DVD<<16
- MOV #0,S ;1
- MOV #0,X ;1 QUOTlo = 0
-MDIV1: CMP T,TOS ;1 DVD48 > divisor ?
- JNC MDIV2 ;2 U<
- SUB T,TOS ;1 DVD48 - DVR
-MDIV2: ADDC X,X ;1 RLC quotLO
- ADDC Y,Y ;1 RLC quotHI
- SUB #1,IP ;1 Decrement loop counter
- JN ENDMDIVIDE ;2 If 0< --> end
+ RRA rDODOES ;1 no: loop count / 2
+ MOV S,TOS ;1 DVDhi <-- DVDlo
+ MOV #0,S ;1 DVDlo <-- 0
+ MOV #0,X ;1 QUOTlo <-- 0 (to do QUOThi = 0 at the end of division)
+MDIV1: CMP T,W ;1 REMlo U>= DIVlo ?
+ JNC MDIV2 ;2 no
+ SUB T,W ;1 REMlo - DIVlo
+MDIV2: ADDC X,X ;1 RLC QUOTlo
+ ADDC Y,Y ;1 RLC QUOThi
+ SUB #1,rDODOES ;1 Decrement loop counter
+ JN ENDMDIV ;2 If 0< --> end
ADD S,S ;1 RLA DVDlo
- ADDC W,W ;1 RLC DVDhi
- ADDC TOS,TOS ;1 RLC DVD48
+ ADDC TOS,TOS ;1 RLC DVDhi
+ ADDC W,W ;1 RLC REMlo
JNC MDIV1 ;2 14~ loop
- SUB T,TOS ;1 DVD48 - DVR
+ SUB T,W ;1 REMlo - DIVlo
BIS #1,SR ;1 SETC
JMP MDIV2 ;2 14~ loop
-ENDMDIVIDE MOV TOS,W ;1 DVD48 ==> W = remainder
- .word 171Dh ;4 POPM IP, TOS
- RET ;4 27 words
-
-
-;C # ud1lo:ud1hi -- ud2lo:ud2hi convert 1 digit of output
- FORTHWORD "#"
-NUM MOV &BASE,T ;3 T = Divisor
- MOV @PSP,S ;2 S = DVDlo
- MOV TOS,W ;1 TOS ==> W = DVDhi
- CALL #UDIVQ32 ;4 use S,T,W,X,Y
+ENDMDIV MOV #xdodoes,rDODOES;2 restore rDODOES
MOV X,0(PSP) ;3 QUOTlo in 0(PSP)
MOV Y,TOS ;1 QUOThi in TOS
-TODIGIT CMP.B #10,W ;2 W = REMAINDER
+TODIGIT CMP.B #10,W ;2 W = REMlo
JLO TODIGIT1 ;2 U<
ADD #7,W ;2
TODIGIT1 ADD #30h,W ;2
HOLDW SUB #1,&HP ;3 store W=char --> -[HP]
MOV &HP,Y ;3
MOV.B W,0(Y) ;3
- mNEXT ;4 23 words, about 290/490 cycles/char
+ mNEXT ;4 45 words, about 270/492 cycles/char
+;https://forth-standard.org/standard/core/numS
;C #S udlo:udhi -- udlo:udhi=0 convert remaining digits
FORTHWORD "#S"
-NUMS mDOCOL
+NUMS: mDOCOL
.word NUM ;
-NUMS1 FORTHtoASM ;
- SUB #2,IP ;1 define NUM return
- CMP #0,X ;1 test udlo first
+ FORTHtoASM ;
+ SUB #2,IP ;1 restore NUM return
+ CMP #0,X ;1 test ud2lo first (generally true)
JNZ NUM ;2
- CMP #0,TOS ;1 then udhi
+ CMP #0,TOS ;1 then test ud2hi (generally false)
JNZ NUM ;2
-NUMSEND MOV @RSP+,IP ;2
- mNEXT ;4
+ MOV @RSP+,IP ;2
+ mNEXT ;4 about 280/505 cycles/char
+;https://forth-standard.org/standard/core/num-end
;C #> udlo:udhi=0 -- c-addr u end conversion, get string
FORTHWORD "#>"
NUMGREATER: MOV &HP,0(PSP)
SUB @PSP,TOS
mNEXT
+;https://forth-standard.org/standard/core/HOLD
;C HOLD char -- add char to output string
FORTHWORD "HOLD"
HOLD: MOV TOS,W ;1
MOV @PSP+,TOS ;2
JMP HOLDW ;15
+;https://forth-standard.org/standard/core/SIGN
;C SIGN n -- add minus sign if n<0
FORTHWORD "SIGN"
SIGN: CMP #0,TOS
JN HOLDW ; 0<
mNEXT
-;C UD. udlo udhi -- display ud (unsigned)
- FORTHWORD "UD."
-UDDOT: mDOCOL
- .word LESSNUM,NUMS,NUMGREATER,TYPE
- .word SPACE,EXIT
-
+;https://forth-standard.org/standard/core/Ud
;C U. u -- display u (unsigned)
FORTHWORD "U."
-UDOT: SUB #2,PSP
- MOV TOS,0(PSP)
- MOV #0,TOS
- JMP UDDOT
-
-;C DABS d1 -- |d1| absolute value
-; FORTHWORD "DABS"
-DABBS: BIT #8000h,TOS ; 1
- JZ DABBSEND
- XOR #-1,0(PSP)
- XOR #-1,TOS
- ADD #1,0(PSP)
- ADDC #0,TOS
-DABBSEND mNEXT
+UDOT: mDOCOL
+ .word LESSNUM,lit,0,NUMS,NUMGREATER,TYPE,SPACE,EXIT
+;https://forth-standard.org/standard/double/Dd
;C D. dlo dhi -- display d (signed)
FORTHWORD "D."
DDOT: mDOCOL
.word LESSNUM,SWAP,OVER,DABBS,NUMS
.word ROT,SIGN,NUMGREATER,TYPE,SPACE,EXIT
+;https://forth-standard.org/standard/core/d
;C . n -- display n (signed)
FORTHWORD "."
-DOT: BIT #8000h,TOS
- JZ UDOT
+DOT: CMP #0,TOS
+ JGE UDOT
SUB #2,PSP
- MOV #-1,TOS
+ MOV TOS,0(PSP)
+ MOV #-1,TOS ; extend sign
JMP DDOT
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; DICTIONARY MANAGEMENT
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
+;https://forth-standard.org/standard/core/HERE
;C HERE -- addr returns dictionary ptr
FORTHWORD "HERE"
-HERE SUB #2,PSP
+HERE: SUB #2,PSP
MOV TOS,0(PSP)
MOV &DDP,TOS
mNEXT
+;https://forth-standard.org/standard/core/ALLOT
;C ALLOT n -- allocate n bytes in dict
FORTHWORD "ALLOT"
-ALLOT ADD TOS,&DDP
+ALLOT: ADD TOS,&DDP
MOV @PSP+,TOS
mNEXT
+;https://forth-standard.org/standard/core/CComma
;C C, char -- append char to dict
FORTHWORD "C,"
-CCOMMA MOV &DDP,W
+CCOMMA: MOV &DDP,W
MOV.B TOS,0(W)
ADD #1,&DDP
MOV @PSP+,TOS
;Z (KEY?) -- c get character from the terminal
; FORTHWORD "(KEY?)"
-PARENKEYTST SUB #2,PSP ; 1 push old TOS..
+PARENKEYTST: SUB #2,PSP ; 1 push old TOS..
MOV TOS,0(PSP) ; 4 ..onto stack
- CALL #XON
+ CALL #RXON
KEYLOOP BIT #UCRXIFG,&TERMIFG ; loop if bit0 = 0 in interupt flag register
JZ KEYLOOP ;
MOV &TERMRXBUF,TOS ;
- CALL #XOFF ;
+ CALL #RXOFF ;
mNEXT
;F KEY? -- c get character from input device ; deferred word
; FORTHWORD "KEY?"
-KEYTST MOV #PARENKEYTST,PC
+;KEYTST: MOV #PARENKEYTST,PC
;Z (KEY) -- c get character from the terminal
FORTHWORD "(KEY)"
-PARENKEY MOV &TERMRXBUF,Y ; empty buffer
+PARENKEY: MOV &TERMRXBUF,Y ; empty buffer
JMP PARENKEYTST
+;https://forth-standard.org/standard/core/KEY
;C KEY -- c wait character from input device ; deferred word
FORTHWORD "KEY"
-KEY MOV #PARENKEY,PC
+KEY: MOV #PARENKEY,PC
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; INTERPRETER INPUT, the kernel of kernel !
-; ----------------------------------------------------------------------
-
- .IFDEF SD_CARD_LOADER ; ACCEPT becomes a DEFERred word
+;-------------------------------------------------------------------------------
- .include "forthMSP430FR_SD_ACCEPT.asm" ; that creates SD_ACCEPT and (SD_ACCEPT)
+ .IFDEF SD_CARD_LOADER
+ .include "forthMSP430FR_SD_ACCEPT.asm" ; that creates SD_ACCEPT
+ .ENDIF ; SD_CARD_LOADER
- .ELSE ; ACCEPT is not a DEFERred word
-;C ACCEPT addr len -- len' get line at addr to interpret len' chars
+;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 #PARENACCEPT,PC
- .ENDIF
+;C (ACCEPT) addr addr len -- addr len' get len' (up to len) chars from terminal (TERATERM.EXE) via USBtoUART bridge
+ FORTHWORD "(ACCEPT)"
+PARENACCEPT
; con speed of TERMINAL link, there are three bottlenecks :
; 1- time to send XOFF/RTS_high on CR (CR+LF=EOL), first emergency.
; 2- the char loop time,
; 3- the time between sending XON/RTS_low and clearing UCRXIFG on first received char,
-; everything must be done to reduce these times, taking into account the necessity of switching to Standby (LPMx mode).
+; everything must be done to reduce these times, taking into account the necessity of switching to SLEEP (LPMx mode).
; --------------------------------------;
; (ACCEPT) part I: prepare TERMINAL_INT ;
; --------------------------------------;
- MOV #ENDACCEPT,S ;2 S = XOFF return
+ MOV #ENDACCEPT,S ;2 S = ACCEPT XOFF return
MOV #AKEYREAD1,T ;2 T = default XON return
+; .word 1537h ;6 in advance, we can also save R7 to R4
.word 152Dh ;5 PUSHM IP,S,T, as IP ret, XOFF ret, XON ret
MOV TOS,W ;1 -- addr len
MOV @PSP,TOS ;2 -- org ptr )
- ADD TOS,W ;1 -- org ptr W=Bound )
+ ADD TOS,W ;1 -- org ptr W=Bound )
MOV #0Dh,T ;2 T = 'CR' to speed up char loop in part II > prepare stack and registers
MOV #20h,S ;2 S = 'BL' to speed up char loop in part II ) for TERMINAL_INT use
MOV #AYEMIT_RET,IP ;2 IP = return for YEMIT )
BIT #UCRXIFG,&TERMIFG ;3 RX_Int ?
- JZ ACCEPTNEXT ;2 no : case of FORTH init or input terminal quiet
+ JZ ACCEPTNEXT ;2 no : case of quiet input terminal
MOV &TERMRXBUF,Y ;3 yes: clear RX_Int
- CMP #0Ah,Y ;2 received char = LF ? (end of downloading ?)
- JNZ XON ;2 no : process char (first char of a new line).
-ACCEPTNEXT ADD #2,RSP ;1 nothing to do, remove previous XON return address,
- MOV #LPMx_LOOP,X ;2 and set good XON return to force the shutdown in sleep mode
- .word 154Dh ;7 PUSHM IP,S,T,W,X
+ CMP #0Ah,Y ;2 received char = LF ? (end of downloading ?)
+ JNZ RXON ;2 no : RXON return = AKEYREAD1, to process first char of new line.
+ACCEPTNEXT ADD #2,RSP ;1 yes: remove AKEYREAD1 as XON return,
+ MOV #SLEEP,X ;2 and set XON return = SLEEP
+ .word 154Dh ;7 PUSHM IP,S,T,W,X before SLEEP (and so WAKE on any interrupts)
+; --------------------------------------;
; ======================================;
-XON ;
+RXON: ;
; ======================================;
.IFDEF TERMINALXONXOFF ;
MOV #17,&TERMTXBUF ;4 move char XON into TX_buf
- .IF TERMINALBAUDRATE/FREQUENCY <230400
-XON_LOOP BIT #UCTXIFG,&TERMIFG ;3 wait the sending end of previous char, useless at high baudrates
- JZ XON_LOOP ;2
- .ENDIF
.ENDIF ;
.IFDEF TERMINALCTSRTS ;
BIC.B #RTS,&HANDSHAKOUT ;4 set RTS low
.ENDIF ;
+ .IFDEF TERMINALXONXOFF ;
+ .IF TERMINALBAUDRATE/FREQUENCY <230400
+RXON_LOOP BIT #UCTXIFG,&TERMIFG ;3 wait the sending end of XON, useless at high baudrates
+ JZ RXON_LOOP ;2
+ .ENDIF ;
+ .ENDIF ;
; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
; starts first and 3th stopwatches ;
; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
- RET ;4 to LPMx_LOOP or AKEYREAD1, ...or user defined
-; --------------------------------------;
+ RET ;4 to BACKGND (End of file download or quiet input) or AKEYREAD1 (get next line of file downloading)
+; --------------------------------------; ...or user defined
+
+; ASMWORD "RXON"
+; JMP RXON
+; ASMWORD "RXOFF"
; ======================================;
-XOFF ; NOP11
+RXOFF: ; NOP11
; ======================================;
.IFDEF TERMINALXONXOFF ;
MOV #19,&TERMTXBUF ;4 move XOFF char into TX_buf
- .IF TERMINALBAUDRATE/FREQUENCY <230400
-XOFF_LOOP BIT #UCTXIFG,&TERMIFG ;3 wait the sending end of previous char, useless at high baudrates
- JZ XOFF_LOOP ;2
- .ENDIF
.ENDIF ;
.IFDEF TERMINALCTSRTS ;
BIS.B #RTS,&HANDSHAKOUT ;4 set RTS high
.ENDIF ;
+ .IFDEF TERMINALXONXOFF ;
+ .IF TERMINALBAUDRATE/FREQUENCY <230400
+RXOFF_LOOP BIT #UCTXIFG,&TERMIFG ;3 wait the sending end of XOFF, useless at high baudrates
+ JZ RXOFF_LOOP ;2
+ .ENDIF ;
+ .ENDIF ;
RET ;4 to ENDACCEPT, ...or user defined
; --------------------------------------;
-; ======================================;
-LPMx_LOOP ; XON RET address 1 ; NOP100
-; ======================================;
+; --------------------------------------;
+ ASMWORD "SLEEP" ; may be redirected
+SLEEP: ;
+ MOV #PARENSLEEP,PC ;3
+; --------------------------------------;
+
+; --------------------------------------;
+ ASMWORD "(SLEEP)" ;
+PARENSLEEP: ;
BIS &LPM_MODE,SR ;3 enter in LPMx sleep mode with GIE=1
-; --------------------------------------; default mode : LPM0.
+; --------------------------------------; default FAST FORTH mode (for its input terminal use) : LPM0.
+;###############################################################################################################
+;###############################################################################################################
; ### # # ####### ####### ###### ###### # # ###### ####### ##### # # ####### ###### #######
; # ## # # # # # # # # # # # # # # # # # # # #
; # # ## # # # # # # # # # # # # # # # # # #
; ### # # # ####### # # # # ##### # # ##### # # ####### # # #######
+;###############################################################################################################
+;###############################################################################################################
+
; here, Fast FORTH sleeps, waiting any interrupt.
; IP,S,T,W,X,Y registers (R13 to R8) are free for any interrupt routine...
; ...and so PSP and RSP stacks with their rules of use.
-; remember : in any interrupt routine you must include : BIC #0xF8,0(RSP) before RETI
-; to force return to LPMx_LOOP.
+; remember: in any interrupt routine you must include : BIC #0x78,0(RSP) before RETI
+; to force return to SLEEP.
+; or (bad idea ? previous SR flags are lost) simply : ADD #2 RSP, then RET instead of RETI
; ======================================;
- JMP LPMx_LOOP ;2 and here is the return for any interrupts, else TERMINAL_INT :-)
+ JMP SLEEP ;2 here is the return for any interrupts, else TERMINAL_INT :-)
; ======================================;
; **************************************;
-TERMINAL_INT ; <--- UCA0 RX interrupt vector, delayed by the LPMx wake up time
+TERMINAL_INT: ; <--- TEMR RX interrupt vector, delayed by the LPMx wake up time
; **************************************; if wake up time increases, max bauds rate decreases...
; (ACCEPT) part II under interrupt ; Org Ptr -- len'
; --------------------------------------;
- ADD #4,RSP ;1 remove SR and PC from stack
- .word 173Ah ;6 POPM W=bound,T=0Dh,S=20h,IP=AYEMIT_RET
+ ADD #4,RSP ;1 remove SR and PC from stack, SR flags are lost (unused by FORTH interpreter)
+ .word 173Ah ;6 POPM W=buffer_bound,T=0Dh,S=20h,IP=AYEMIT_RET
; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
; starts the 2th stopwatch ;
; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
AKEYREAD1 ; <--- XON RET address 2 ; first emergency: anticipate XOFF on CR as soon as possible
CMP.B T,Y ;1 char = CR ?
- JZ XOFF ;2 then RET to ENDACCEPT
-; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;+ 4
-; stops the first stopwatch ; first bottleneck, best case result: 24~ + LPMx wake_up time..
+ JZ RXOFF ;2 then RET to ENDACCEPT
+; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;+ 4 to send RXOFF
+; stops the first stopwatch ;= first bottleneck, best case result: 24~ + LPMx wake_up time..
; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^; ...or 11~ in case of empty line
CMP.B S,Y ;1 printable char ?
JHS ASTORETEST ;2 yes
CMP.B #8,Y ; char = BS ?
- JNE WAITaKEY
+ JNE WAITaKEY ; case of other control chars
; --------------------------------------;
-; start of backspace ;
+; start of backspace ; made only by an human
; --------------------------------------;
-BACKSPACE CMP @PSP,TOS ; Ptr = Org ?
+ CMP @PSP,TOS ; Ptr = Org ?
JZ WAITaKEY ; yes: do nothing
SUB #1,TOS ; no : dec Ptr
; --------------------------------------;
; --------------------------------------;
; end of backspace ;
; --------------------------------------;
-ASTORETEST CMP W,TOS ; 1 Bound is reached ? (protect against big lines without CR, UNIX like)
- JZ YEMIT ; 2 yes, send echo without store, then loopback
-ASTORE MOV.B Y,0(TOS) ; 3 no, store char @ Ptr before send echo, then loopback
+ASTORETEST CMP W,TOS ; 1 Bound is reached ?
+ JZ YEMIT ; 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
-YEMIT .word 4882h ; hi7/4~ lo:12/4~ send/send_not echo to terminal
+YEMIT: .word 4882h ; hi7/4~ lo:12/4~ send/send_not echo to terminal
.word TERMTXBUF ; 3 MOV Y,&TERMTXBUF
.IF TERMINALBAUDRATE/FREQUENCY <230400
YEMIT1 BIT #UCTXIFG,&TERMIFG ; 3 wait the sending end of previous char, useless at high baudrates
; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
; --------------------------------------;
-ENDACCEPT ; <--- XOFF RET address
+ENDACCEPT ; <--- XOFF return address
; --------------------------------------;
- MOV #LPM0+GIE,&LPM_MODE ; reset LPM_MODE to default mode LPM0
-DROPEXIT SUB @PSP+,TOS ; Org Ptr -- len'
+ MOV #LPM0+GIE,&LPM_MODE ; reset LPM_MODE to default mode LPM0 for next line of input stream
+DROPEXIT
+; .word 1734h ;6 we can also restore R7 to R4
+ SUB @PSP+,TOS ; Org Ptr -- len'
MOV @RSP+,IP ; 2 and continue with INTERPRET with GIE=0.
; So FORTH machine is protected against any interrupt...
mNEXT ; ...until next falling down to LPMx mode of (ACCEPT) part1,
; hardware or software control on TX flow seems not necessary with UARTtoUSB bridges because
; they stop TX when their RX buffer is full. So no problem when the terminal input is echoed to output.
FORTHWORD "(EMIT)"
-PARENEMIT MOV TOS,Y ; 1
+PARENEMIT: MOV TOS,Y ; 1
MOV @PSP+,TOS ; 2
.IF TERMINALBAUDRATE/FREQUENCY >=230400
-YEMIT1 BIT #UCTXIFG,&TERMIFG ; 3 wait the sending end of previous char (usefull for low baudrates)
- JZ YEMIT1 ; 2
+YEMIT2 BIT #UCTXIFG,&TERMIFG ; 3 wait the sending end of previous char (usefull for low baudrates)
+ JZ YEMIT2 ; 2
.ENDIF
- JMP YEMIT
+ JMP YEMIT ;9 12~
+;https://forth-standard.org/standard/core/EMIT
;C EMIT c -- output character to the output device ; deferred word
FORTHWORD "EMIT"
-EMIT MOV #PARENEMIT,PC ; 3
+EMIT: MOV #PARENEMIT,PC ;3 15~
;Z ECHO -- connect console output (default)
FORTHWORD "ECHO"
-ECHO MOV #4882h,&YEMIT ; 4882h = MOV Y,&<next_adr>
+ECHO: MOV #4882h,&YEMIT ; 4882h = MOV Y,&<next_adr>
mNEXT
;Z NOECHO -- disconnect console output
FORTHWORD "NOECHO"
-NOECHO MOV #NEXT,&YEMIT ; NEXT = 4030h = MOV @IP+,PC
+NOECHO: MOV #NEXT,&YEMIT ; NEXT = 4030h = MOV @IP+,PC
mNEXT
; (CR) -- send CR to the output terminal (via EMIT)
FORTHWORD "(CR)"
-PARENCR SUB #2,PSP
+PARENCR: SUB #2,PSP
MOV TOS,0(PSP)
MOV #0Dh,TOS
JMP EMIT
+;https://forth-standard.org/standard/core/CR
;C CR -- send CR to the output device
FORTHWORD "CR"
-CR MOV #PARENCR,PC
+CR: MOV #PARENCR,PC
+;https://forth-standard.org/standard/core/SPACE
;C SPACE -- output a space
FORTHWORD "SPACE"
-SPACE SUB #2,PSP
- MOV TOS,0(PSP)
- MOV #20h,TOS
- JMP EMIT
+SPACE: SUB #2,PSP ;1
+ MOV TOS,0(PSP) ;3
+ MOV #20h,TOS ;2
+ JMP EMIT ;17~ 23~
+;https://forth-standard.org/standard/core/SPACES
;C SPACES n -- output n spaces
FORTHWORD "SPACES"
-SPACES CMP #0,TOS
+SPACES: CMP #0,TOS
JZ SPACESEND
PUSH IP
MOV #SPACESNEXT,IP
- JMP SPACE
+ JMP SPACE ;25~
SPACESNEXT FORTHtoASM
- SUB #2,IP
- SUB #1,TOS
- JNZ SPACE
+ SUB #2,IP ;1
+ SUB #1,TOS ;1
+ JNZ SPACE ;25~ ==> 27~ by space ==> 2.963 MBds @ 8 MHz
MOV @RSP+,IP
SPACESEND MOV @PSP+,TOS
mNEXT
+;https://forth-standard.org/standard/core/TYPE
;C TYPE adr len -- type line to terminal
FORTHWORD "TYPE"
-TYPE CMP #0,TOS
+TYPE: CMP #0,TOS
JZ TWODROP
MOV @PSP,W
ADD TOS,0(PSP)
MOV W,TOS
mDOCOL
.word xdo
-TYPELOOP .word II,CFETCH,EMIT,xloop,TYPELOOP
+TYPELOOP .word II,CFETCH,EMIT,xloop,TYPELOOP ; 13+6+15+16= 50~ char loop ==> 1.6MBds @ 8MHz
.word EXIT
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
FORTHtoASM
MOV @RSP+,IP
MOV.B @TOS,TOS ; -- u
ADD TOS,&DDP
MOV @PSP+,TOS
CELLPLUSALIGN
- BIT #1,&DDP ;3
+ BIT #1,&DDP ;3
ADDC #2,&DDP ;4 +2 bytes
mNEXT
- .IFDEF LOWERCASE
-
- FORTHWORD "CAPS_ON"
-CAPS_ON MOV #-1,&CAPS ; state by default
- mNEXT
+ .ELSE
- FORTHWORD "CAPS_OFF"
-CAPS_OFF MOV #0,&CAPS
+;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 lit,'"',WORDD ; -- c-addr (= HERE)
+ FORTHtoASM
+ MOV @RSP+,IP
+ MOV.B @TOS,TOS ; -- u
+ SUB #1,TOS ; -1 byte
+ ADD TOS,&DDP
+ MOV @PSP+,TOS
+CELLPLUSALIGN
+ BIT #1,&DDP ;3 carry set if 1
+ ADDC #2,&DDP ;4 +2 bytes
mNEXT
-;C ." -- compile string to print
- FORTHWORDIMM ".\34" ; immediate
-DOTQUOTE: mDOCOL
- .word CAPS_OFF
- .word SQUOTE
- .word CAPS_ON
- .word lit,TYPE,COMMA,EXIT
-
- .ELSE
+ .ENDIF ; LOWERCASE
+;https://forth-standard.org/standard/core/Dotq
;C ." -- compile string to print
FORTHWORDIMM ".\34" ; immediate
DOTQUOTE: mDOCOL
.word SQUOTE
.word lit,TYPE,COMMA,EXIT
- .ENDIF ; LOWERCASE
-
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; INTERPRETER
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
+;https://forth-standard.org/standard/core/WORD
;C WORD char -- addr Z=1 if len=0
-; parse a word delimited by char ( and begining usually at [TIB])
-; "word" is capitalized
+; parse a word delimited by char separator
+; "word" is capitalized
; TOIN is the relative displacement into buffer
-; empty line = 25 cycles + 7 cycles by char
+; spaces (as separator) filled line = 25 cycles + 7 cycles by char
FORTHWORD "WORD"
-WORDD MOV #SOURCE_LEN,S ;2 -- separator
+WORDD: MOV #SOURCE_LEN,S ;2 -- separator
MOV @S+,X ;2 X = buf_len
MOV @S+,W ;2 W = buf_org
ADD W,X ;1 W = buf_org X = buf_org + buf_len = buf_end
CMP.B @W+,TOS ;2 does char = separator ?
JZ SKIPCHARLOO ;2 -- separator if yes
SCANWORD SUB #1,W ;1
- MOV #96,T ;2 T = 96 = ascii(a)-1 (test value in register before SCANWORD loop)
+ 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 puts anything in dst word length, then put char @ dst.
CMP W,X ;1 buf_ptr = buf_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 ; enable lowercase strings
+ .IFDEF LOWERCASE ;
QCAPS CMP #0,&CAPS ;3 CAPS is OFF ? (case available only for ABORT" ." .( )
JZ SCANWORDLOO ;2 yes
.ENDIF ; LOWERCASE ; here CAPS is ON (other cases)
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 28~ lower case char loop
+ JMP SCANWORDLOO ;2
SCANWORDEND SUB &SOURCE_ADR,W ;3 -- separator W=buf_ptr - buf_org = new >IN (first char separator next)
MOV W,&TOIN ;3 update >IN
mNEXT ;4 -- c-addr 40 words Z=1 <==> lenght=0 <==> EOL
+;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
; note: with 16 threads vocabularies, FIND takes about 75% of CORETEST.4th processing time
FORTHWORD "FIND"
-FIND SUB #2,PSP ;1 -- ???? c-addr reserve one cell here, not at FINDEND because interacts with flag Z
+FIND: SUB #2,PSP ;1 -- ???? c-addr reserve one cell here, not at FINDEND because interacts with flag Z
MOV TOS,S ;1 S=c-addr
MOV.B @S,rDOCON ;2 R5= string count
MOV.B #80h,rDODOES ;2 R4= immediate mask
- MOV #CONTEXT,T ;2
+ MOV #CONTEXT,T ;2
VOCLOOP MOV @T+,TOS ;2 -- ???? VOC_PFA T=CTXT+2
CMP #0,TOS ;1 no more vocabulary in CONTEXT ?
JZ FINDEND ;2 -- ???? 0 yes ==> exit; Z=1
JNZ WORDLOOP ;2 -- ???? NFA 21~ word loop on first char mismatch
SUB.B #1,Y ;1 decr count
JNZ CHARLOOP ;2 -- ???? NFA 10~ char loop
-WORDFOUND BIT #1,X ;1
+WORDFOUND BIT #1,X ;1
ADDC #0,X ;1
MOV X,S ;1 S=aligned CFA
MOV.B @TOS,W ;2 -- ???? NFA W=NFA_first_char
mNEXT ;4 42/47 words
-
THREEDROP ADD #2,PSP
TWODROP ADD #2,PSP
MOV @PSP+,TOS
mNEXT
-;C convert a string to double number until count = 0 or until not convertible char
+;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
.IFDEF MPY
- FORTHWORD ">NUMBER" ; 23 cycles + 32/34 cycles DEC/HEX char loop
-TONUMBER MOV @PSP+,S ;2 S = adr
+ 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
- MOV &BASE,T ;3
+ 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 > "9" ?
JNZ TONUMLOOP ;2 if count <>0
MOV X,4(PSP) ;3 -- ud2lo ud1hi adr count2
MOV Y,2(PSP) ;3 -- ud2lo ud2hi adr count2
-TONUMEND MOV S,0(PSP) ;3 -- ud2lo ud2hi addr2 count2
+TONUMEND MOV S,0(PSP) ;3 -- ud2lo ud2hi addr2 count2
mNEXT ;4 38 words
; convert a string to a signed number; FORTH 2012 prefixes $, %, # are recognized
-; 32 bits numbers are recognized
-; the decimal point is processed
+; 32 bits numbers (with decimal point) are recognized
;Z ?NUMBER c-addr -- n -1 if convert ok ; flag Z=0
;Z c-addr -- c-addr 0 if convert ko ; flag Z=1
; FORTHWORD "?NUMBER"
-QNUMBER PUSH #0 ;3 -- c-addr
+QNUMBER: PUSH #0 ;3 -- c-addr
PUSH IP ;3
MOV &BASE,T ;3 T=BASE
PUSH T ;3 R-- sign IP base
; ----------------------------------;
-; Added decimal point process ;
-; ----------------------------------;
- BIC #UF1,SR ;2 reset flag UF1 used here as Decimal Point flag
+; decimal point process add-on ;
+; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
+ BIC #UF9,SR ;2 reset flag UF9 used here as Decimal Point flag
MOV.B @TOS,IP ;2 IP = count of chars
- ADD TOS,IP ;1 IP = end address
+ ADD TOS,IP ;1 IP = end address
MOV TOS,S ;1 S = ptr
MOV.B #'.',W ;2 W = '.' = Decimal Point DP
SearchDP CMP S,IP ;1 IP U< S ?
- JLO SearchDPEND ;2
+ JLO SearchDPEND ;2
CMP.B @S+,W ;2 DP found ?
- JNE SearchDP ;2 7~ loop by char
-DPfound BIS #UF1,SR ;2 DP found: set flag UF1
+ JNE SearchDP ;2 7~ loop by char
+DPfound BIS #UF9,SR ;2 DP found: set flag UF9
DPrubLoop MOV.B @S+,-2(S) ;4 rub out decimal point
CMP S,IP ;1 and move left one all susbsequent chars
JHS DPrubLoop ;2 7~ loop by char
SUB.B #1,0(TOS) ;3 and decrement count of chars
SearchDPEND ;
-; ----------------------------------;
+; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
MOV #0,X ;1 X=ud1lo
MOV #0,Y ;1 Y=ud1hi
MOV #QNUMNEXT,IP ;2 return from >NUMBER
SUB #8,PSP ;1 -- x x x x c-addr
MOV TOS,6(PSP) ;3 -- c-addr x x x c-addr
MOV TOS,S ;1 S=addrr
- MOV.B @S+,TOS ;2 -- c-addr x x x cnt
+ MOV.B @S+,TOS ;2 -- c-addr x x x cnt
MOV.B @S,W ;2 W=char
CMP.B #'-',W ;2
JHS QSIGN ;2 speed up for not prefixed numbers
SUB.B #'$',W ;2 = 0 ==> "$" : hex number ?
JZ PREFIXED ;2
QBINARY MOV #2,T ;1 BASE = 2
- SUB.B #1,W ;1 "%" - "$" - 1 = 0 ==> '%' : hex number ?
+ SUB.B #1,W ;1 "%" - "$" - 1 = 0 ==> '%' : bin number ?
JZ PREFIXED ;2
QDECIMAL ADD #8,T ;1 BASE = 10
ADD.B #2,W ;1 "#" - "%" + 2 = 0 ==> '#' : decimal number ?
- JNZ TONUMLOOP ;2 then the conversion return will be ko
+ JNZ TONUMLOOP ;2 if no the conversion return will be ko
PREFIXED ADD #1,S ;1 addr+1 to skip prefix
SUB #1,TOS ;1 -- c-addr x x x cnt-1
MOV.B @S,W ;2 W=2th char, S=adr
QSIGN JNZ TONUMLOOP ;15 + 32/34 cycles DEC/HEX char loop
QSIGNYES ADD #1,S ;1 addr+1 to skip "-"
SUB #1,TOS ;1 -- c-addr x x x cnt-1
- MOV #-1,4(RSP) ;3 R-- sign IP BASE
+ MOV #-1,4(RSP) ;3 R-- sign IP BASE
JMP TONUMLOOP ;15 + 32/34 cycles DEC/HEX char loop
; ----------------------------------;
+
+; ----------------------------------;
QNUMNEXT FORTHtoASM ; -- c-addr ud2lo ud2hi addr2 count2
ADD #2,PSP ;1
CMP #0,TOS ;1 -- c-addr ud2lo ud2hi cnt2 n=0 ? conversion is ok ?
MOV S,&BASE ;3
JZ QNUMOK ;2 -- c-addr ud2lo ud2hi sign conversion OK
QNUMKO ADD #4,PSP ;1 -- c-addr sign
- AND #0,TOS ;1 -- c-addr ff TOS=0 and Z=1 ==> conversion ko
- mNEXT ;4
-
-;; ----------------------------------;
-;; process word conversion ;
-;; ----------------------------------;
-;QNUMOK ADD #2,PSP ; -- c-addr ud2lo sign
-; MOV @PSP+,0(PSP) ;4 -- |n| sign note : PSP is incremented before write back !!!
-; XOR #-1,TOS ;1 -- |n| inv(sign)
-; JNZ QNUMEND ;2 if jump : TOS=-1 and Z=0 ==> conversion ok
-;QNEGATE XOR #-1,0(PSP) ;3 -- n-1 ff else TOS=0
-; ADD #1,0(PSP) ;3 -- n ff
-; XOR #-1,TOS ;1 -- n tf TOS=-1 and Z=0 ==> conversion ok
-;QNUMEND mNEXT ;4
-;; ----------------------------------;
-
+ AND #0,TOS ;1 -- c-addr ff TOS=0 and Z=1 ==> conversion ko
+ mNEXT ;4 69
; ----------------------------------;
-; Select word|double word conversion; -- c-addr ud2lo ud2hi sign
-; ----------------------------------;
-QNUMOK CMP #0,0(PSP) ;3 double number ?
- JNZ PROCESSNUM2 ;2 process double numbers
- BIT #UF1,SR ;2 decimal point added ?
- JNZ PROCESSNUM3 ;2 process double numbers
- CMP #0,TOS ; test sign
- JZ PROCESSNUM ; if unsigned number < 65536
- MOV 2(PSP),W ;
- SUB #1,W ;
- CMP #0,W ;
- JL PROCESSNUM2 ; if number < -32768
-; ----------------------------------;
-; process word conversion ;
-; ----------------------------------;
-PROCESSNUM ADD #2,PSP ; -- c-addr ud2lo sign
- MOV @PSP+,0(PSP) ;4 -- |n| sign note : PSP is incremented before write back !!!
- XOR #-1,TOS ;1 -- |n| inv(sign)
- JNZ QNUMEND ;2 if jump : TOS=-1 and Z=0 ==> conversion ok
-QNEGATE XOR #-1,0(PSP) ;3 -- n-1 ff else TOS=0
- ADD #1,0(PSP) ;3 -- n ff
- XOR #-1,TOS ;1 -- n tf TOS=-1 and Z=0 ==> conversion ok
-QNUMEND mNEXT ;4
-; ----------------------------------;
-; process double word conversion ;
-; ----------------------------------;
-PROCESSNUM2 BIS #UF1,SR ; set UF1 flag (SR(9)), for LITERAL use
-PROCESSNUM3 MOV 2(PSP),4(PSP) ; -- udlo udlo udhi sign
+QNUMOK 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 QNUMEND ;2 if jump : TOS=-1 and Z=0 ==> conversion ok
-Q2NEGATE XOR #-1,2(PSP) ;3 -- dlo-1 dhi-1 ff
- XOR #-1,0(PSP) ;3 -- dlo-1 udhi ff
- ADD #1,2(PSP) ;3 -- dlo dhi-1 ff
- ADDC #0,0(PSP) ;3 -- dlo dhi ff
- XOR #-1,TOS ;1 -- dlo dhi tf
-QNUM2END mNEXT ;4 105 words TOS=-1 and Z=0 ==> conversion ok
+ 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
+ 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 90 words TOS=-1 and Z=0 ==> conversion ok
; ----------------------------------;
.ELSE ; no hardware MPY
FORTHWORD ">NUMBER"
-TONUMBER MOV @PSP,S ; -- ud1lo ud1hi adr count
+TONUMBER: MOV @PSP,S ; -- ud1lo ud1hi adr count
MOV.B @S,S ; -- ud1lo ud1hi adr count S=char
DDIGITQ SUB.B #30h,S ;2 skip all chars < '0'
CMP.B #10,S ; char was > "9" ?
ADDC #0,TOS ; -- ud1lo ud1hi adr ud2lo ud2hi ud2hi + carry
MOV @PSP,6(PSP) ; -- ud2lo ud1hi adr ud2lo ud2hi
MOV TOS,4(PSP) ; -- ud2lo ud2hi adr ud2lo ud2hi
-
.word 171Dh ; -- ud2lo ud2hi adr ud2lo count POPM IP,TOS (1+1 pop,IP=D)
ADD #2,PSP ; -- ud2lo ud2hi adr count
ADD #1,0(PSP) ; -- ud2lo ud2hi adr+1 count
;Z c-addr -- c-addr 0 if convert ko ; flag Z=1
; FORTH 2012 prefixes $, %, # are recognized
; FORTHWORD "?NUMBER"
-QNUMBER PUSH #0 ;3 -- c-addr
+QNUMBER: PUSH #0 ;3 -- c-addr
PUSH IP ;3
- PUSH &BASE ;3 R-- sign IP base
+ PUSH &BASE ;3 R-- sign IP base
; ----------------------------------;
-; Added decimal point process ;
-; ----------------------------------;
- BIC #UF1,SR ;2 reset flag UF1 used here as decimal point flag
+; decimal point process add-on ;
+; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
+ BIC #UF9,SR ;2 reset flag UF9 used here as decimal point flag
MOV.B @TOS,IP ;2 IP = count of chars
- ADD TOS,IP ;1 IP = end address
+ ADD TOS,IP ;1 IP = end address
MOV TOS,S ;1 S = ptr
MOV.B #'.',W ;2 W = '.'
SearchDP CMP S,IP ;1 IP U< S ?
- JLO SearchDPEND ;2
+ JLO SearchDPEND ;2
CMP.B @S+,W ;2 DP found ?
- JNE SearchDP ;2 7~ loop by char
-DPfound BIS #UF1,SR ;2 DP found: set flag UF1
+ JNE SearchDP ;2 7~ loop by char
+DPfound BIS #UF9,SR ;2 DP found: set flag UF9
DPrubLoop MOV.B @S+,-2(S) ;4 rub out decimal point
CMP S,IP ;1 and move left one all susbsequent chars
JHS DPrubLoop ;2 7~ loop by char
SUB.B #1,0(TOS) ;3 and decrement count of chars
SearchDPEND
-; ----------------------------------;
- MOV #QNUMNEXT,IP ;2 return from >NUMBER
+; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
+ MOV #QNUMNEXT,IP ;2 define return from >NUMBER
SUB #8,PSP ;1 -- x x x x c-addr
MOV TOS,6(PSP) ;3 -- c-addr x x x c-addr
MOV #0,4(PSP) ;3
MOV #0,2(PSP) ;3 -- c-addr ud x c-addr
MOV TOS,W ;1
- MOV.B @W+,TOS ;2 -- c-addr ud x count
- MOV W,0(PSP) ;3 -- c-addr ud adr count
+ MOV.B @W+,TOS ;2 -- c-addr ud x count
+ MOV W,0(PSP) ;3 -- c-addr ud adr count
MOV.B @W+,X ;2 X=char
CMP.B #'-',X ;2
JHS QSIGN ;2 speed up for not prefixed numbers
MOV.B @W+,X ;2 X=2th char, W=adr
CMP.B #'-',X ;2
QSIGN JNZ TONUMBER ;2
- MOV #-1,4(RSP) ;3 R-- sign IP BASE
+ MOV #-1,4(RSP) ;3 R-- sign IP BASE
MOV W,0(PSP) ;3
SUB #1,TOS ;1 -- c-addr ud adr+1 count-1
- JMP TONUMBER ;2
+ JMP TONUMBER ;2 69
+; ----------------------------------;
+
; ----------------------------------;
QNUMNEXT FORTHtoASM ; -- c-addr ud2lo ud2hi addr2 count2
ADD #2,PSP ;1
MOV S,&BASE ;3
JZ QNUMOK ;2 -- c-addr ud2lo ud2hi sign conversion OK
QNUMKO ADD #4,PSP ;1 -- c-addr sign
- AND #0,TOS ;1 -- c-addr ff TOS=0 and Z=1 ==> conversion ko
+ AND #0,TOS ;1 -- c-addr ff TOS=0 and Z=1 ==> conversion ko
mNEXT ;4
-
-;; ----------------------------------;
-;; process word conversion ;
-;; ----------------------------------;
-;QNUMOK ADD #2,PSP ; -- c-addr ud2lo sign
-; MOV @PSP+,0(PSP) ;4 -- |n| sign note : PSP is incremented before write back !!!
-; XOR #-1,TOS ;1 -- |n| inv(sign)
-; JNZ QNUMEND ;2 if jump : TOS=-1 and Z=0 ==> conversion ok
-;QNEGATE XOR #-1,0(PSP) ;3 -- n-1 ff else TOS=0
-; ADD #1,0(PSP) ;3 -- n ff
-; XOR #-1,TOS ;1 -- n tf TOS=-1 and Z=0 ==> conversion ok
-;QNUMEND mNEXT ;4
-;; ----------------------------------;
-
-; ----------------------------------;
-; Select word|double word conversion; -- c-addr ud2lo ud2hi sign
; ----------------------------------;
-QNUMOK CMP #0,0(PSP) ;3 double number ?
- JNZ PROCESSNUM2 ;2 process double numbers
- BIT #UF1,SR ;2 decimal point added ?
- JNZ PROCESSNUM3 ;2 process double numbers
- CMP #0,TOS ; test sign
- JZ PROCESSNUM ; if unsigned number < 65536
- MOV 2(PSP),W ;
- SUB #1,W ;
- CMP #0,W ;
- JL PROCESSNUM2 ; if number < -32768
-; ----------------------------------;
-; process word conversion ;
-; ----------------------------------;
-PROCESSNUM ADD #2,PSP ; -- c-addr ud2lo sign
- MOV @PSP+,0(PSP) ;4 -- |n| sign note : PSP is incremented before write back !!!
- XOR #-1,TOS ;1 -- |n| inv(sign)
- JNZ QNUMEND ;2 if jump : TOS=-1 and Z=0 ==> conversion ok
-QNEGATE XOR #-1,0(PSP) ;3 -- n-1 ff else TOS=0
- ADD #1,0(PSP) ;3 -- n ff
- XOR #-1,TOS ;1 -- n tf TOS=-1 and Z=0 ==> conversion ok
-QNUMEND mNEXT ;4
-; ----------------------------------;
-; process double word conversion ;
-; ----------------------------------;
-PROCESSNUM2 BIS #UF1,SR ; set UF1 flag (SR(9)), case of number > word
-PROCESSNUM3 MOV 2(PSP),4(PSP) ; -- udlo udlo udhi sign
+QNUMOK 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 QNUMEND ;2 if jump : TOS=-1 and Z=0 ==> conversion ok
-Q2NEGATE XOR #-1,2(PSP) ;3 -- dlo-1 dhi-1 ff
- XOR #-1,0(PSP) ;3 -- dlo-1 udhi ff
- ADD #1,2(PSP) ;3 -- dlo dhi-1 ff
- ADDC #0,0(PSP) ;3 -- dlo dhi ff
- XOR #-1,TOS ;1 -- dlo dhi tf
-QNUM2END mNEXT ;4 105 words TOS=-1 and Z=0 ==> conversion ok
+ 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
+ ADDC #0,0(PSP) ;3 -- dlo dhi tf
+QDOUBLE BIT #UF9,SR ;2 decimal point added ?
+ JNZ QNUMEND ;2 process double numbers
+ ADD #2,PSP ;
+QNUMEND mNEXT ;4 100 words TOS=-1 and Z=0 ==> conversion ok
; ----------------------------------;
.ENDIF ; MPY
-
+;https://forth-standard.org/standard/core/EXECUTE
;C EXECUTE i*x xt -- j*x execute Forth word at 'xt'
FORTHWORD "EXECUTE"
-EXECUTE MOV TOS,W ; 1 put word address into W
+EXECUTE: MOV TOS,W ; 1 put word address into W
MOV @PSP+,TOS ; 2 fetch new TOS
MOV W,PC ; 3 fetch code address into PC
; 6 = ITC - 1
+;https://forth-standard.org/standard/core/Comma
;C , x -- append cell to dict
FORTHWORD ","
-COMMA MOV &DDP,W ;3
+COMMA: MOV &DDP,W ;3
ADD #2,&DDP ;3
MOV TOS,0(W) ;3
MOV @PSP+,TOS ;2
mNEXT ;4 15~
-;C LITERAL (n|d) -- append single or double numeric literal if compiling state
+;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=1 (not ANS)
FORTHWORDIMM "LITERAL" ; immediate
-LITERAL CMP #0,&STATE ;3
+LITERAL: CMP #0,&STATE ;3
JZ LITERALEND ;2
- BIT #UF1,SR ;2
- JZ LITERAL1 ;2
-LITERAL2 MOV &DDP,W ;3
- ADD #4,&DDP ;3
- MOV #lit,0(W) ;4
- MOV @PSP+,2(W) ;3
LITERAL1 MOV &DDP,W ;3
ADD #4,&DDP ;3
MOV #lit,0(W) ;4
MOV TOS,2(W) ;3
MOV @PSP+,TOS ;2
-LITERALEND mNEXT ;4 24~
+ BIT #UF9,SR ;2
+ BIC #UF9,SR ;2
+ JNZ LITERAL1 ;2
+LITERALEND mNEXT ;4 30~
+;https://forth-standard.org/standard/core/COUNT
;C COUNT c-addr1 -- adr len counted->adr/len
FORTHWORD "COUNT"
COUNT: SUB #2,PSP ;1
;C INTERPRET i*x addr u -- j*x interpret given buffer
; This is the common factor of EVALUATE and QUIT.
-; ref. dpANS-6, 3.4 The Forth Text Interpreter
-
-; FORTHWORD "INTERPRET" ; not used in FORTH 2012
-INTERPRET MOV TOS,&SOURCE_LEN ; -- addr u buffer lentgh ==> ticksource variable
+; Absent from forth 2012
+; set addr, u as input buffer then parse it word by word
+; FORTHWORD "INTERPRET"
+INTERPRET: MOV TOS,&SOURCE_LEN ; -- addr u buffer lentgh ==> ticksource variable
MOV @PSP+,&SOURCE_ADR ; -- u buffer address ==> ticksource+2 variable
MOV @PSP+,TOS ; --
MOV #0,&TOIN ;
mDOCOL ;
INTLOOP .word FBLANK,WORDD ; -- c-addr Z = End Of Line
- FORTHtoASM ;
- MOV #INTFINDNEXT,IP ;2 ddefine INTFINDNEXT as FIND return
+ FORTHtoASM ;
+ MOV #INTFINDNEXT,IP ;2 define INTFINDNEXT as FIND return
JNZ FIND ;2 if EOL not reached
- MOV @RSP+,IP ; --
+ MOV @RSP+,IP ; -- c-addr
MOV @PSP+,TOS ; -- else EOL is reached
mNEXT ; return to QUIT on EOL
INTFINDNEXT FORTHtoASM ; -- c-addr fl Z = not found
MOV TOS,W ; W = flag =(-1|0|+1) as (normal|not_found|immediate)
- MOV @PSP+,TOS ; -- c-addr
+ MOV @PSP+,TOS ; -- c-addr
MOV #INTQNUMNEXT,IP ;2 define QNUMBER return
JZ QNUMBER ;2 c-addr -- if not found search a number
MOV #INTLOOP,IP ;2 define (EXECUTE | COMMA) return
JZ COMMA ;2 c-addr -- if W xor STATE = 0 compile xt then loop back to INTLOOP
JNZ EXECUTE ;2 c-addr -- if W xor STATE <> 0 execute then loop back to INTLOOP
-INTQNUMNEXT FORTHtoASM ; -- n|c-addr fl Z = not a number
+INTQNUMNEXT FORTHtoASM ; -- n|c-addr fl Z = not a number, UF9 = double number request
MOV @PSP+,TOS ;2
MOV #INTLOOP,IP ;2 -- n|c-addr define LITERAL return
JNZ LITERAL ;2 n -- execute LITERAL then loop back to INTLOOP
ADD TOS,Y ;1
MOV.B #'?',0(Y) ;5 add '?' to end of word
MOV #FQABORTYES,IP ;2 define COUNT return
- JMP COUNT ;2 c-addr -- 44 words
+ JMP COUNT ;2 -- addr len 44 words
+;https://forth-standard.org/standard/core/EVALUATE
; EVALUATE \ i*x c-addr u -- j*x interpret string
FORTHWORD "EVALUATE"
-EVALUATE MOV #SOURCE_LEN,X
- PUSH @X+
- PUSH @X+
- PUSH @X+
- PUSH IP
+EVALUATE: MOV #SOURCE_LEN,X ;2
+ MOV @X+,S ;2 S = SOURCE_LEN
+ MOV @X+,T ;2 T = SOURCE_ADR
+ MOV @X+,W ;2 W = TOIN
+ .word 153Dh ;6 PUSHM IP,S,T,W
ASMtoFORTH
.word INTERPRET
FORTHtoASM
- MOV @RSP+,IP ;2
MOV @RSP+,&TOIN ;4
MOV @RSP+,&SOURCE_ADR ;4
MOV @RSP+,&SOURCE_LEN ;4
+ MOV @RSP+,IP ;2
mNEXT
+;https://forth-standard.org/standard/core/QUIT
;c QUIT -- interpret line by line the input stream
FORTHWORD "QUIT"
-QUIT MOV #RSTACK,RSP
+QUIT: MOV #RSTACK,RSP
MOV #LSTACK,&LEAVEPTR
MOV #0,&STATE
- MOV #0,&SAVE_SYSRSTIV ;
+ .IFDEF SD_CARD_LOADER
+ .IFDEF CONDCOMP
+ .IFDEF BOOTLOADER
+; ----------------------------------;
+; BOOTSTRAP TEST ;
+; ----------------------------------;
+ CMP #0,&SAVE_SYSRSTIV ; if WARM
+ JZ QUIT0 ; no boostrap
+ BIT.B #SD_CD,&SD_CDIN ; SD_memory in SD_Card module ?
+ JNZ QUIT0 ; no
+; ----------------------------------;
+; BOOTSTRAP ; on SYSRSTIV <> 0
+; ----------------------------------;
+ SUB #2,PSP ;
+ MOV TOS,0(PSP) ;
+ MOV &SAVE_SYSRSTIV,TOS ;
+ MOV #0,&SAVE_SYSRSTIV ;
+ ASMtoFORTH ;
+ .word NOECHO ; warning ! your BOOT.4TH must to be finish with ECHO command!
+ .word XSQUOTE ; -- addr u
+ .byte 15,"LOAD\34 BOOT.4TH\34" ; issues error 2 if no such file...
+ .word BRAN,QUIT4 ;
+; ----------------------------------;
+ .ENDIF
+ .ENDIF
+ .ENDIF
-QUIT0 ASMtoFORTH
+QUIT0 MOV #0,&SAVE_SYSRSTIV ;
+ ASMtoFORTH
QUIT1 .word XSQUOTE
- .byte 4,13,"ok " ; CR + system prompt
-QUIT2 .word TYPE
-QUIT3 .word lit,TIB,DUP,lit,TIB_SIZE ; -- StringOrg StringOrg len
- .word ACCEPT ; -- StringOrg len'
+ .byte 3,13,"ok" ; CR + system prompt
+QUIT2 .word TYPE,SPACE
+QUIT3 .word TIB,DUP,CPL ; -- StringOrg StringOrg maxlenght
+ .word ACCEPT ; -- StringOrg len' (len' <= maxlenght)
.word SPACE
QUIT4 .word INTERPRET
- .word lit,PSTACK-2,SPFETCH,ULESS
+ .word DEPTH,ZEROLESS
.word XSQUOTE
- .byte 13,"stack empty !"
+ .byte 13,"stack empty! "
.word QABORT
.word lit,FRAM_FULL,HERE,ULESS
.word XSQUOTE
- .byte 11,"FRAM full !"
+ .byte 11,"FRAM full! "
.word QABORT
.word FSTATE,FETCH
.word QBRAN,QUIT1 ; case of interpretion state
.word XSQUOTE ; case of compilation state
- .byte 4,13," " ; CR + 3 spaces
+ .byte 3,13,32,32 ; CR + 2 blanks
.word BRAN,QUIT2
+;https://forth-standard.org/standard/core/ABORT
;C ABORT i*x -- R: j*x -- clear stack & QUIT
FORTHWORD "ABORT"
ABORT: MOV #PSTACK,PSP
;Z ?ABORT f c-addr u -- abort & print msg
; FORTHWORD "?ABORT"
-QABORT CMP #0,2(PSP) ; -- f c-addr u flag test
+QABORT: CMP #0,2(PSP) ; -- f c-addr u flag test
QABORTNO JZ THREEDROP
-QABORTYES MOV #4882h,&YEMIT ; restore default YEMIT = set ECHO
+QABORTYES MOV #4882h,&YEMIT ; -- c-addr u restore default YEMIT = set ECHO
+
.IFDEF SD_CARD_LOADER ; close all handles
- MOV &CurrentHdl,T
-QABORTCLOSE
- CMP #0,T
- JZ QABORTYESNOECHO
- MOV.B #0,HDLB_Token(T)
- MOV @T,T
- JMP QABORTCLOSE
+ MOV &CurrentHdl,T
+QABORTCLOSE CMP #0,T
+ JZ QABORTYESNOECHO
+ MOV.B #0,HDLB_Token(T)
+ MOV @T,T
+ JMP QABORTCLOSE
.ENDIF
- ; -- c-addr u
; ----------------------------------;
QABORTYESNOECHO ; <== WARM jumps here, thus, if NOECHO, TERMINAL can be disconnected without freezing the app
; ----------------------------------;
- CALL #QAB_DEFER ; restore default deferred words ....else WARM.
- .IFDEF MSP430ASSEMBLER ; reset all branch labels
- MOV #0,&CLRBW1
- MOV #0,&CLRBW2
- MOV #0,&CLRBW3
- MOV #0,&CLRFW1
- MOV #0,&CLRFW2
- MOV #0,&CLRFW3
- .ENDIF
-
-
+ CALL #QAB_DEFER ; restore default deferred words ....else WARM and SLEEP.
; ----------------------------------;
QABORTTERM ; wait the end of source file downloading
; ----------------------------------;
MOV #17,&TERMTXBUF ; yes move XON char into TX_buf
.ENDIF ;
.IFDEF TERMINALCTSRTS ;
- BIC.B #RTS,&HANDSHAKOUT ; set /RTS low (connected to /CTS pin of UARTtoUSB bridge)
+ BIC.B #RTS,&HANDSHAKOUT ; set /RTS low (connected to /CTS pin of UARTtoUSB bridge)
.ENDIF ;
QABORTLOOP BIC #UCRXIFG,&TERMIFG ; reset TERMIFG(UCRXIFG)
- MOV #RefillUSBtime,Y ; 2730*28 = 75 ms
-QABUSBLOOPJ ; 28~ loop : PL2303TA seems the slower USB device to refill its buffer.
- MOV #8,X ; 1~
-QABUSBLOOPI ; 3~ loop
- SUB #1,X ; 1~
- JNZ QABUSBLOOPI ; 2~
- SUB #1,Y ; 1~
- JNZ QABUSBLOOPJ ; 2~
- BIT #UCRXIFG,&TERMIFG ; 4 new char in TERMXBUF ?
+ 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~ <-------+
+QABUSBLOOPI NOP ; 1~ <---+ |
+ SUB #1,X ; 1~ | |
+ JNZ QABUSBLOOPI ; 2~ > 4~ loop -+ |
+ SUB #1,Y ; 1~ |
+ JNZ QABUSBLOOPJ ; 2~ --> 36~ loop --+
+ BIT #UCRXIFG,&TERMIFG ; 4 new char in TERMXBUF after refill time out ?
JNZ QABORTLOOP ; 2 yes, the input stream (download source file) is still active
-
; ----------------------------------;
; Display WARM/ABORT message ;
; ----------------------------------;
mDOCOL ; no, the input stream is quiet (end of download source file)
.word XSQUOTE ; -- c-addr u c-addr1 u1
- .byte 4,1Bh,"[7m" ;
+ .byte 4,27,"[7m" ;
.word TYPE ; -- c-addr u set reverse video
.word TYPE ; -- type abort message
.word XSQUOTE ; -- c-addr2 u2
- .byte 4,1Bh,"[0m" ;
+ .byte 4,27,"[0m" ;
.word TYPE ; -- set normal video
.word FORTH,ONLY ; to quit assembler and so to abort any ASSEMBLER definitions
.word DEFINITIONS ; reset CURRENT directory
+ .word PWR_STATE ; wipe, if exist, not well finished definition and its previous MARKER
.IFDEF LOWERCASE
.word CAPS_ON ;
.ENDIF
.word ABORT ;
- .IFDEF LOWERCASE
-
+;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 CAPS_OFF,SQUOTE,CAPS_ON
- .word lit,QABORT,COMMA
- .word EXIT
- .ELSE
-
-;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
+ABORTQUOTE: mDOCOL
.word SQUOTE
.word lit,QABORT,COMMA
- .word EXIT
-
- .ENDIF ; LOWERCASE
+ .word EXIT
-;C ' -- xt find word in dictionary
+;https://forth-standard.org/standard/core/Tick
+;C ' -- xt find word in dictionary and leave on stack its execution address
FORTHWORD "'"
-TICK mDOCOL ; separator -- xt
+TICK: mDOCOL ; separator -- xt
.word FBLANK,WORDD,FIND ; Z=1 if not found
.word QBRAN,NotFound
.word EXIT
NotFound .word NotFoundExe ; in INTERPRET
+;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 ;
+BACKSLASH: MOV &SOURCE_LEN,&TOIN ;
mNEXT
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; COMPILER
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
+
+;https://forth-standard.org/standard/core/Bracket
+;C [ -- enter interpretative state
+ FORTHWORDIMM "[" ; immediate
+LEFTBRACKET: MOV #0,&STATE
+ mNEXT
+
+;https://forth-standard.org/standard/core/right-bracket
+;C ] -- enter compiling state
+ FORTHWORD "]"
+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 also 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
+; FORTHWORD "DEFER!"
+DEFERSTORE: MOV @PSP+,2(TOS) ; -- CFA_DEFER xt --> [CFA_DEFER+2]
+ MOV @PSP+,TOS ; --
+ mNEXT
+
+;https://forth-standard.org/standard/core/IS
+;C IS <name> xt --
+; used as is :
+; DEFER DISPLAY create a "do nothing" definition (2 CELLS)
+; inline command : ' U. IS DISPLAY U. becomes the runtime of the word DISPLAY
+; or in a definition : ... ['] U. IS DISPLAY ...
+; KEY, EMIT, CR, ACCEPT and WARM are DEFERred words
+
+; as IS replaces the PFA value of a "PFA word", it may be also used with 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
+
+;https://forth-standard.org/standard/core/IMMEDIATE
+;C IMMEDIATE -- make last definition immediate
+ FORTHWORD "IMMEDIATE"
+IMMEDIATE: MOV &LAST_NFA,W
+ BIS.B #80h,0(W)
+ mNEXT
+
+;https://forth-standard.org/standard/core/RECURSE
+;C RECURSE -- recurse to current definition (compile current definition)
+ FORTHWORDIMM "RECURSE" ; immediate
+RECURSE: MOV &DDP,X ;
+ MOV &LAST_CFA,0(X) ;
+ ADD #2,&DDP ;
+ mNEXT
+
+
+;https://forth-standard.org/standard/core/POSTPONE
+ FORTHWORDIMM "POSTPONE" ; immediate
+POSTPONE: mDOCOL
+ .word FBLANK,WORDD,FIND,QDUP
+ .word QBRAN,NotFound
+ .word ZEROLESS ; immediate ?
+ .word QBRAN,POST1 ; yes
+ .word lit,lit,COMMA,COMMA
+ .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. See MARKER below
+BAD_CSP mDOCOL
+ .word XSQUOTE
+ .byte 15,"stack mismatch!"
+FQABORTYES .word QABORTYES
; HEADER create an header for a new word. Max count of chars = 126
-; common code for VARIABLE, CONSTANT, CREATE, DEFER, :, CODE, ASM.
+; common code for VARIABLE, CONSTANT, CREATE, DEFER, :, MARKER, CODE, ASM.
; don't link created word in vocabulary.
-
-HEADER mDOCOL
- .word CELLPLUSALIGN ; ALIGN then make room for LFA
- .word FBLANK,WORDD ;
- FORTHtoASM ; -- HERE HERE is the NFA of this new word
- 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.B #1,W ; -- xxx W=add one byte for length
- ADD Y,W ; -- xxx W=Aligned_CFA
- MOV &CURRENT,X ; -- xxx X=VOC_BODY of CURRENT Y=NFA
+HEADER: mDOCOL
+ .word CELLPLUSALIGN ; ALIGN then make room for LFA
+ .word FBLANK,WORDD ;
+ FORTHtoASM ; -- HERE HERE is the NFA of this new word
+ 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.B #1,W ; -- xxx W=add one byte for length
+ ADD Y,W ; -- xxx W=Aligned_CFA
+ MOV &CURRENT,X ; -- xxx X=VOC_BODY of CURRENT Y=NFA
.SWITCH THREADS
.CASE 1 ; nothing to do
.ELSECASE ; multithreading add 5~ 4words
; X is LAST_THREAD > used by VARIABLE, CONSTANT, CREATE, DEFER and :
; Y is NFA )
-BAD_CSP mDOCOL
- .word XSQUOTE
- .byte 15,"stack mismatch!"
-FQABORTYES .word QABORTYES
-
-;;Z ?REVEAL -- link last created word in vocabulary if no stack mismatch
-; FORTHWORD "REVEAL"
-QREVEAL CMP PSP,&LAST_CSP ; check actual SP with saved value by :
- JNZ BAD_CSP ; if stack mismatch
- MOV &LAST_NFA,Y ;
- MOV &LAST_THREAD,X ;
-REVEAL MOV @X,-2(Y) ; [LAST_THREAD] --> LFA
- MOV Y,0(X) ; LAST_NFA --> [LAST_THREAD]
- mNEXT
-
-
+;https://forth-standard.org/standard/core/VARIABLE
;C VARIABLE <name> -- define a Forth VARIABLE
FORTHWORD "VARIABLE"
-VARIABLE CALL #HEADER ; -- W = DDP = CFA + 2 words
- MOV #DOVAR,-4(W)
- JMP REVEAL
+VARIABLE: CALL #HEADER ; W = DDP = CFA + 2 words
+ MOV #DOVAR,-4(W) ; CFA = DOVAR
+ JMP REVEAL ; PFA = undefined
-;C CONSTANT <name> n -- define a Forth CONSTANT
+;https://forth-standard.org/standard/core/CONSTANT
+;C CONSTANT <name> n -- define a Forth CONSTANT (it's also an alias of VALUE)
FORTHWORD "CONSTANT"
-CONSTANT CALL #HEADER ; -- W = DDP
- MOV #DOCON,-4(W) ; compile exec
- MOV TOS,-2(W) ; compile TOS as constant
+CONSTANT: CALL #HEADER ; W = DDP = CFA + 2 words
+ MOV #DOCON,-4(W) ; CFA = DOCON
+ MOV TOS,-2(W) ; PFA = n
MOV @PSP+,TOS
JMP REVEAL
-;C CREATE <name> -- define a CONSTANT with its next address
+;;https://forth-standard.org/standard/core/VALUE
+;;( x "<spaces>name" -- ) define a Forth VALUE
+;;Skip leading space delimiters. Parse name delimited by a space.
+;;Create a definition for name with the execution semantics defined below,
+;;with an initial value equal to x.
+;
+;;name Execution: ( -- x )
+;;Place x on the stack. The value of x is that given when name was created,
+;;until the phrase x TO name is executed, causing a new value of x to be assigned to name.
+;
+;;TO name Run-time: ( x -- )
+;;Assign the value x to name.
+;
+; FORTHWORD "VALUE"
+; JMP CONSTANT
+;
+; FORTHWORDIMM "TO"
+; JMP IS
+
+
+;https://forth-standard.org/standard/core/CREATE
+;C CREATE <name> -- define a CONSTANT with its next address
; Execution: ( -- a-addr ) ; a-addr is the address of name's data field
; ; the execution semantics of name may be extended by using DOES>
FORTHWORD "CREATE"
-CREATE CALL #HEADER ; -- W = DDP
- MOV #DOCON,-4(W) ;4 first CELL = DOCON
- MOV W,-2(W) ;3 second CELL = HERE
+CREATE: CALL #HEADER ; -- W = DDP
+ MOV #DOCON,-4(W) ;4 CFA = DOCON
+ MOV W,-2(W) ;3 PFA = next address
JMP REVEAL
+;https://forth-standard.org/standard/core/DOES
;C DOES> -- set action for the latest CREATEd definition
FORTHWORD "DOES>"
-DOES MOV &LAST_CFA,W ; W = CFA of latest CREATEd word that becomes a master word
- MOV #DODOES,0(W) ; remplace code of CFA (DOCON) by DODOES
- MOV IP,2(W) ; remplace parameter of PFA (HERE) by the address after DOES> as execution address
+DOES: MOV &LAST_CFA,W ; W = CFA of latest CREATEd word that becomes a master word
+ MOV #DODOES,0(W) ; replace old CFA (DOCON) by new CFA (DODOES)
+ MOV IP,2(W) ; replace old PFA by the address after DOES> as execution address
MOV @RSP+,IP ; exit of the new created word
NEXTADR mNEXT
-;X DEFER <name> -- ; create a word to be deferred
+;https://forth-standard.org/standard/core/DEFER
+;C DEFER "<spaces>name" --
+;Skip leading space delimiters. Parse name delimited by a space.
+;Create a definition for name with the execution semantics defined below.
+
+;name Execution: --
+;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"
- CALL #HEADER
- MOV #4030h,-4(W) ;4 first CELL = MOV @PC+,PC = BR...
- MOV #NEXTADR,-2(W) ;4 second CELL = address of mNEXT below : created word does nothing by default
+DEFER: CALL #HEADER
+ MOV #4030h,-4(W) ;4 CFA = MOV @PC+,PC = BR...
+ MOV #NEXTADR,-2(W) ;4 PFA = address of NEXT: created word does nothing by default
JMP REVEAL
-;C [ -- enter interpretative state
- FORTHWORDIMM "[" ; immediate
-LEFTBRACKET MOV #0,&STATE
- mNEXT
-
-;C ] -- enter compiling state
- FORTHWORD "]"
-RIGHTBRACKET MOV #-1,&STATE
- mNEXT
-;C RECURSE -- recurse to current definition (compile current definition)
- FORTHWORDIMM "RECURSE" ; immediate
-RECURSE MOV &DDP,X ;
- MOV &LAST_CFA,0(X) ;
- ADD #2,&DDP ;
- mNEXT
+;https://forth-standard.org/standard/core/Colon
+;C : <name> -- begin a colon definition
+ FORTHWORD ":"
+ COLON: CALL #HEADER
.SWITCH DTC
.CASE 1
-
-;C : <name> -- begin a colon definition
- FORTHWORD ":"
- CALL #HEADER
MOV #DOCOL1,-4(W) ; compile CALL rDOCOL
SUB #2,&DDP
-
.CASE 2
-
-;C : <name> -- begin a colon definition
- FORTHWORD ":"
- CALL #HEADER
MOV #DOCOL1,-4(W) ; compile PUSH IP 3~
MOV #DOCOL2,-2(W) ; compile CALL rEXIT
-
.CASE 3 ; inlined DOCOL
-
-;C : <name> -- begin a colon definition
- FORTHWORD ":"
- CALL #HEADER
MOV #DOCOL1,-4(W) ; compile PUSH IP 3~
MOV #DOCOL2,-2(W) ; compile MOV PC,IP 1~
MOV #DOCOL3,0(W) ; compile ADD #4,IP 1~
MOV #NEXT,+2(W) ; compile MOV @IP+,PC 4~
ADD #4,&DDP
-
- .ENDCASE ; DTC
-
+ .ENDCASE ; of DTC
MOV #-1,&STATE ; enter compiling state
-SAVE_PSP MOV PSP,&LAST_CSP ; save PSP for check compiling, used by QREVEAL
+SAVE_PSP MOV PSP,&LAST_PSP ; save PSP for check compiling, used by QREVEAL
mNEXT
+;https://forth-standard.org/standard/core/Semi
;C ; -- end a colon definition
FORTHWORDIMM ";" ; immediate
-SEMICOLON CMP #0,&STATE ; interpret mode : semicolon becomes a comment separator
- JZ BACKSLASH ; tip: ; it's transparent to the preprocessor, so semicolon comments are kept in file.4th
+SEMICOLON: CMP #0,&STATE ; interpret mode : semicolon becomes a comment separator
+ JZ BACKSLASH ; tip: ";" is transparent to the preprocessor, so semicolon comments are kept in file.4th
mDOCOL ; compile mode
.word lit,EXIT,COMMA
.word QREVEAL,LEFTBRACKET,EXIT
-;C IMMEDIATE -- make last definition immediate
- FORTHWORD "IMMEDIATE"
-IMMEDIATE MOV &LAST_NFA,W
- BIS.B #80h,0(W)
- mNEXT
-
-;X DEFER! xt CFA_DEFER -- ; store xt to the address after DODEFER
-DEFERSTORE MOV @PSP+,2(TOS) ; -- CFA_DEFER xt --> [CFA_DEFER+2]
- MOV @PSP+,TOS ; --
- mNEXT
-
-;X IS <name> xt --
-; used as is :
-; DEFER DISPLAY create a "do nothing" definition (2 CELLS)
-; inline command : ' U. IS DISPLAY U. becomes the runtime of the word DISPLAY
-; or in a definition : ... ['] U. IS DISPLAY ...
-; KEY, EMIT, CR, ACCEPT and WARM are DEFERred 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
-
-;C ['] <name> -- find word & compile it as literal
- FORTHWORDIMM "[']" ; immediate word, i.e. word executed also during compilation
-BRACTICK mDOCOL
- .word TICK ; get xt of <name>
- .word lit,lit,COMMA ; append LIT action
- .word COMMA,EXIT ; append xt literal
-
- FORTHWORDIMM "POSTPONE" ; immediate
-POSTPONE mDOCOL
- .word FBLANK,WORDD,FIND,QDUP
- .word QBRAN,NotFound
- .word ZEROLESS ; immediate ?
- .word QBRAN,POST1 ; yes
- .word lit,lit,COMMA,COMMA
- .word lit,COMMA
-POST1: .word COMMA,EXIT
-
+ .IFDEF CONDCOMP
;; CORE EXT MARKER
;;( "<spaces>name" -- )
;;Skip leading space delimiters. Parse name delimited by a space. Create a definition for name
;;of any structures still existing that could refer to deleted definitions or deallocated data space is
;;not necessarily provided. No other contextual information such as numeric base is affected
-; FORTHWORD "MARKER"
-; CALL #HEADER ;4
-; MOV #DODOES,-4(W) ;4 CFA = DODOES
-; MOV #MARKER_DOES,-2(W) ;4 PFA = MARKER_DOES
-; ADD #4,&DDP ;3
-; MOV &LASTVOC,0(W) ;5 [BODY] = VOCLINK to be restored
-; MOV Y,2(W) ;3 [BODY+2] = NFA
-; SUB #2,2(W) ;4 [BODY+2] = LFA = DP to be restored
-; JMP REVEAL ;2
-
-MARKER_DOES
- .IFDEF VOCABULARY_SET
- .word FORTH,ONLY,DEFINITIONS
- .ENDIF
- FORTHtoASM ; -- BODY IP is free
- MOV @TOS+,W ; -- BODY+2 W= old VOCLINK =VLK
- MOV W,&LASTVOC ; -- BODY+2 restore LASTVOC
- MOV @TOS,TOS ; -- OLD_DP
- MOV TOS,&DDP ; -- OLD_DP restore DP
-
- .SWITCH THREADS
-
- .CASE 1
-MARKALLVOC MOV W,Y ; -- OLD_DP W=VLK Y=VLK
-MRKWORDLOOP MOV -2(Y),Y ; -- OLD_DP W=VLK Y=NFA
- CMP Y,TOS ; -- OLD_DP CMP = TOS-Y : OLD_DP-NFA
- JNC MRKWORDLOOP ; loop back if TOS<Y : OLD_DP<NFA
- MOV Y,-2(W) ; W=VLK X=THD Y=NFA refresh thread with good NFA
- MOV @W,W ; -- OLD_DP W=[VLK] = next voclink
- CMP #0,W ; -- OLD_DP W=[VLK] = next voclink end of vocs ?
- JNZ MARKALLVOC ; -- OLD_DP W=VLK no : loopback
-
- .ELSECASE ; multi threads
-
-MARKALLVOC MOV #THREADS,IP ; -- OLD_DP W=VLK
- MOV W,X ; -- OLD_DP W=VLK X=VLK
-MRKTHRDLOOP MOV X,Y ; -- OLD_DP W=VLK X=VLK Y=VLK
- SUB #2,X ; -- OLD_DP W=VLK X=THD (thread ((case-2)to0))
-MRKWORDLOOP MOV -2(Y),Y ; -- OLD_DP W=VLK Y=NFA
- CMP Y,TOS ; -- OLD_DP CMP = TOS-Y : OLD_DP-NFA
- JNC MRKWORDLOOP ; loop back if TOS<Y : OLD_DP<NFA
-MARKTHREAD MOV Y,0(X) ; W=VLK X=THD Y=NFA refresh thread with good NFA
- SUB #1,IP ; -- OLD_DP W=VLK X=THD Y=NFA IP=CFT-1
- JNZ MRKTHRDLOOP ; loopback to compare NFA in next thread (thread-1)
- MOV @W,W ; -- OLD_DP W=[VLK] = next voclink
- CMP #0,W ; -- OLD_DP W=[VLK] = next voclink end of vocs ?
- JNZ MARKALLVOC ; -- OLD_DP W=VLK no : loopback
-
- .ENDCASE ; THREADS ; -- HERE
+MARKER_DOES FORTHtoASM ; execution part
+ MOV @RSP+,IP ; -- PFA
+ MOV @TOS+,&INIVOC ; set VOC_LINK value for RST_STATE
+ MOV @TOS,&INIDP ; set DP value for RST_STATE
+ MOV @PSP+,TOS ; --
+ JMP RST_STATE ; execute RST_STATE, PWR_STATE then STATE_DOES
+
+ FORTHWORD "MARKER" ; definition part
+ CALL #HEADER ;4 W = DP+4
+ MOV #DODOES,-4(W) ;4 CFA = DODOES
+ MOV #MARKER_DOES,-2(W) ;4 PFA = MARKER_DOES
+ MOV &LASTVOC,0(W) ;5 [BODY] = VOCLINK to be restored
+ SUB #2,Y ;1 Y = LFA
+ MOV Y,2(W) ;3 [BODY+2] = LFA = DP to be restored
+ ADD #4,&DDP ;3
+
+ .ENDIF ; CONDCOMP
+
+GOOD_CSP MOV &LAST_NFA,Y ;
+ MOV &LAST_THREAD,X ;
+REVEAL MOV @X,-2(Y) ; [LAST_THREAD] --> LFA
+ MOV Y,0(X) ; LAST_NFA --> [LAST_THREAD]
+ mNEXT
- MOV @PSP+,TOS ;
- MOV @RSP+,IP ;
- mNEXT ;
-; ----------------------------------;
; ----------------------------------------------------------------------
; CONTROL STRUCTURES
; IF, ELSE, AGAIN, UNTIL, WHILE, REPEAT, LOOP & +LOOP compile two words
; LEAVE compile three words
+;https://forth-standard.org/standard/core/IF
;C IF -- IFadr initialize conditional forward branch
FORTHWORDIMM "IF" ; immediate
-IFF SUB #2,PSP ;
+IFF: SUB #2,PSP ;
MOV TOS,0(PSP) ;
MOV &DDP,TOS ; -- HERE
- MOV #QBRAN,0(TOS) ; -- HERE
- ADD #4,&DDP ; compile two words
+ ADD #4,&DDP ; compile one word, reserve one word
+ MOV #QBRAN,0(TOS) ; -- HERE compile QBRAN
CELLPLUS ADD #2,TOS ; -- HERE+2=IFadr
mNEXT
+
+;https://forth-standard.org/standard/core/ELSE
;C ELSE IFadr -- ELSEadr resolve forward IF branch, leave ELSEadr on stack
FORTHWORDIMM "ELSE" ; immediate
-ELSS MOV &DDP,W
- MOV #bran,0(W)
- ADD #4,W ; W=HERE+4
- MOV W,&DDP ; compile two words
+ELSS: ADD #4,&DDP ; make room to compile two words
+ MOV &DDP,W ; W=HERE+4
+ MOV #bran,-4(W)
MOV W,0(TOS) ; HERE+4 ==> [IFadr]
SUB #2,W ; HERE+2
MOV W,TOS ; -- ELSEadr
mNEXT
+;https://forth-standard.org/standard/core/THEN
;C THEN IFadr -- resolve forward branch
FORTHWORDIMM "THEN" ; immediate
-THEN MOV &DDP,0(TOS) ; -- IFadr
+THEN: MOV &DDP,0(TOS) ; -- IFadr
MOV @PSP+,TOS ; --
mNEXT
+;https://forth-standard.org/standard/core/BEGIN
;C BEGIN -- BEGINadr initialize backward branch
FORTHWORDIMM "BEGIN" ; immediate
-BEGIN MOV #HERE,PC ; BR HERE
+BEGIN: MOV #HERE,PC ; BR HERE
+;https://forth-standard.org/standard/core/UNTIL
;C UNTIL BEGINadr -- resolve conditional backward branch
FORTHWORDIMM "UNTIL" ; immediate
-UNTIL MOV #qbran,X
-UNTIL1 MOV &DDP,W ; W = HERE
- ADD #4,&DDP ; compile two words
- MOV X,0(W) ; compile Bran or qbran at HERE
- MOV TOS,2(W) ; compile bakcward adr at HERE+2
+UNTIL: MOV #qbran,X
+UNTIL1 ADD #4,&DDP ; compile two words
+ MOV &DDP,W ; W = HERE
+ MOV X,-4(W) ; compile Bran or qbran at HERE
+ MOV TOS,-2(W) ; compile bakcward adr at HERE+2
MOV @PSP+,TOS
mNEXT
+;https://forth-standard.org/standard/core/AGAIN
;X AGAIN BEGINadr -- resolve uncondionnal backward branch
FORTHWORDIMM "AGAIN" ; immediate
-AGAIN MOV #bran,X
+AGAIN: MOV #bran,X
JMP UNTIL1
+;https://forth-standard.org/standard/core/WHILE
;C WHILE BEGINadr -- WHILEadr BEGINadr
FORTHWORDIMM "WHILE" ; immediate
-WHILE mDOCOL
+WHILE: mDOCOL
.word IFF,SWAP,EXIT
+;https://forth-standard.org/standard/core/REPEAT
;C REPEAT WHILEadr BEGINadr -- resolve WHILE loop
FORTHWORDIMM "REPEAT" ; immediate
-REPEAT mDOCOL
+REPEAT: mDOCOL
.word AGAIN,THEN,EXIT
+;https://forth-standard.org/standard/core/DO
;C DO -- DOadr L: -- 0
FORTHWORDIMM "DO" ; immediate
-DO SUB #2,PSP ;
+DO: SUB #2,PSP ;
MOV TOS,0(PSP) ;
- MOV &DDP,TOS ; -- HERE
- MOV #xdo,0(TOS)
- ADD #2,TOS ; -- HERE+2
- MOV TOS,&DDP ; compile one word
+ ADD #2,&DDP ; make room to compile xdo
+ MOV &DDP,TOS ; -- HERE+2
+ MOV #xdo,-2(TOS) ; compile xdo
ADD #2,&LEAVEPTR ; -- HERE+2 LEAVEPTR+2
- MOV &LEAVEPTR,W ;
+ MOV &LEAVEPTR,W ;
MOV #0,0(W) ; -- HERE+2 L-- 0
mNEXT
-;C LOOP DOadr -- L-- 0 a1 a2 .. aN
+;https://forth-standard.org/standard/core/LOOP
+;C LOOP DOadr -- L-- an an-1 .. a1 0
FORTHWORDIMM "LOOP" ; immediate
-LOO MOV #xloop,X
-ENDLOOP MOV &DDP,W
- ADD #4,&DDP ; compile two words
- MOV X,0(W) ; xloop --> HERE
- MOV TOS,2(W) ; DOadr --> HERE+2
+LOO: MOV #xloop,X
+ENDLOOP 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
; resolve all "leave" adr
-LEAVELOOP MOV &LEAVEPTR,TOS ; -- Adr of first LeaveStack cell
- SUB #2,&LEAVEPTR ; --
+LEAVELOOP MOV &LEAVEPTR,TOS ; -- Adr of top LeaveStack cell
+ SUB #2,&LEAVEPTR ; --
MOV @TOS,TOS ; -- first LeaveStack value
CMP #0,TOS ; -- = value left by DO ?
JZ ENDLOOPEND
- MOV &DDP,0(TOS) ; move adr after loop as UNLOOP adr
+ MOV W,0(TOS) ; move adr after loop as UNLOOP adr
JMP LEAVELOOP
ENDLOOPEND MOV @PSP+,TOS
mNEXT
-;C +LOOP adrs -- L: 0 a1 a2 .. aN --
+;https://forth-standard.org/standard/core/PlusLOOP
+;C +LOOP adrs -- L-- an an-1 .. a1 0
FORTHWORDIMM "+LOOP" ; immediate
-PLUSLOOP MOV #xploop,X
+PLUSLOOP: MOV #xploop,X
JMP ENDLOOP
+;https://forth-standard.org/standard/core/LEAVE
;C LEAVE -- L: -- adrs
FORTHWORDIMM "LEAVE" ; immediate
-LEAV MOV &DDP,W ; compile three words
+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
MOV W,0(X) ; leave HERE+4 on LEAVEPTR stack
mNEXT
+;https://forth-standard.org/standard/core/MOVE
;C MOVE addr1 addr2 u -- smart move
; VERSION FOR 1 ADDRESS UNIT = 1 CHAR
FORTHWORD "MOVE"
-MOVE MOV TOS,W ; 1
+MOVE: MOV TOS,W ; 1
MOV @PSP+,Y ; dest adrs
MOV @PSP+,X ; src adrs
MOV @PSP+,TOS ; pop new TOS
CMP X,Y ; Y-X ; dst - src
JZ MOVE_X ; already made !
JC MOVEUP ; U>= if dst > src
-MOVEDOWN: MOV.B @X+,0(Y) ; if X=src > Y=dst copy W bytes down
+MOVEDOWN MOV.B @X+,0(Y) ; if X=src > Y=dst copy W bytes down
ADD #1,Y
SUB #1,W
JNZ MOVEDOWN
mNEXT
MOVEUP ADD W,Y ; start at end
ADD W,X
-MOVUP1: SUB #1,X
+MOVUP1 SUB #1,X
SUB #1,Y
MOV.B @X,0(Y) ; if X=src < Y=dst copy W bytes up
SUB #1,W
JNZ MOVUP1
-MOVE_X: mNEXT
+MOVE_X mNEXT
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; WORDS SET for VOCABULARY, not ANS compliant
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
;X VOCABULARY -- create a vocabulary
.IFDEF VOCABULARY_SET
FORTHWORD "VOCABULARY"
-VOCABULARY mDOCOL
+VOCABULARY: mDOCOL
.word CREATE
.SWITCH THREADS
.CASE 1
.word lit,0,COMMA ; will keep the NFA of the last word of the future created vocabularies
- .ELSECASE ; multithreading add 7 words
+ .ELSECASE
.word lit,THREADS,lit,0,xdo
VOCABULOOP .word lit,0,COMMA
.word xloop,VOCABULOOP
.IFDEF VOCABULARY_SET
FORTHWORD "FORTH"
.ENDIF ; VOCABULARY_SET
-FORTH mDODOES ; leave FORTH_BODY on the stack and run VOCDOES
+FORTH: mDODOES ; leave FORTH_BODY on the stack and run VOCDOES
.word VOCDOES
FORTH_BODY .word lastforthword
.SWITCH THREADS
.IFDEF VOCABULARY_SET
FORTHWORD "ALSO"
.ENDIF ; VOCABULARY_SET
-ALSO MOV #12,W ; -- move up 6 words
+ALSO: MOV #14,W ; -- move up 7 words
MOV #CONTEXT,X ; X=src
MOV #CONTEXT+2,Y ; Y=dst
JMP MOVEUP ; src < dst
.IFDEF VOCABULARY_SET
FORTHWORD "PREVIOUS"
.ENDIF ; VOCABULARY_SET
-PREVIOUS MOV #14,W ; -- move down 7 words
+PREVIOUS: MOV #14,W ; -- move down 7 words
MOV #CONTEXT+2,X ; X=src
MOV #CONTEXT,Y ; Y=dst
JMP MOVEDOWN ; src > dst
.IFDEF VOCABULARY_SET
FORTHWORD "ONLY"
.ENDIF ; VOCABULARY_SET
-ONLY MOV #0,&CONTEXT+2
+ONLY: MOV #0,&CONTEXT+2
mNEXT
;X DEFINITIONS -- set last context vocabulary as entry for further defining words
.IFDEF VOCABULARY_SET
FORTHWORD "DEFINITIONS"
.ENDIF ; VOCABULARY_SET
-DEFINITIONS MOV &CONTEXT,&CURRENT
+DEFINITIONS: MOV &CONTEXT,&CURRENT
mNEXT
-; ----------------------------------------------------------------------
-; IMPROVED POWER ON RESET AND INITIALIZATION
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
+; IMPROVED ON/OFF AND RESET
+;-------------------------------------------------------------------------------
+
+STATE_DOES
+ .IFDEF VOCABULARY_SET
+ .word FORTH,ONLY,DEFINITIONS ; doesn't restore search order pointers
+ .ENDIF
+ FORTHtoASM ; -- BODY IP is free
+ MOV @TOS+,W ; -- BODY+2 W = old VOCLINK = VLK
+ MOV W,&LASTVOC ; -- BODY+2 restore LASTVOC
+ MOV @TOS,TOS ; -- OLD_DP
+ MOV TOS,&DDP ; -- OLD_DP restore DP
+
+ .SWITCH THREADS
+ .CASE 1 ; mono thread vocabularies
+MARKALLVOC MOV W,Y ; -- OLD_DP W=VLK Y=VLK
+MRKWORDLOOP MOV -2(Y),Y ; -- OLD_DP W=VLK Y=NFA
+ CMP Y,TOS ; -- OLD_DP CMP = TOS-Y : OLD_DP-NFA
+ JNC MRKWORDLOOP ; loop back if TOS<Y : OLD_DP<NFA
+ MOV Y,-2(W) ; W=VLK X=THD Y=NFA refresh thread with good NFA
+ MOV @W,W ; -- OLD_DP W=[VLK] = next voclink
+ CMP #0,W ; -- OLD_DP W=[VLK] = next voclink end of vocs ?
+ JNZ MARKALLVOC ; -- OLD_DP W=VLK no : loopback
+
+ .ELSECASE ; multi threads vocabularies
+MARKALLVOC MOV #THREADS,IP ; -- OLD_DP W=VLK
+ MOV W,X ; -- OLD_DP W=VLK X=VLK
+MRKTHRDLOOP MOV X,Y ; -- OLD_DP W=VLK X=VLK Y=VLK
+ SUB #2,X ; -- OLD_DP W=VLK X=THD (thread ((case-2)to0))
+MRKWORDLOOP MOV -2(Y),Y ; -- OLD_DP W=VLK Y=NFA
+ CMP Y,TOS ; -- OLD_DP CMP = TOS-Y : OLD_DP-NFA
+ JNC MRKWORDLOOP ; loop back if TOS<Y : OLD_DP<NFA
+MARKTHREAD MOV Y,0(X) ; W=VLK X=THD Y=NFA refresh thread with good NFA
+ SUB #1,IP ; -- OLD_DP W=VLK X=THD Y=NFA IP=CFT-1
+ JNZ MRKTHRDLOOP ; loopback to compare NFA in next thread (thread-1)
+ MOV @W,W ; -- OLD_DP W=[VLK] = next voclink
+ CMP #0,W ; -- OLD_DP W=[VLK] = next voclink end of vocs ?
+ JNZ MARKALLVOC ; -- OLD_DP W=VLK no : loopback
+
+ .ENDCASE ; of THREADS ; -- DDP
+ MOV @PSP+,TOS ;
+ MOV @RSP+,IP ;
+ mNEXT ;
- FORTHWORD "PWR_STATE" ; set dictionary in same state as OFF/ON
-PWR_STATE mDODOES ; DOES part of MARKER : resets pointers DP, voclink and latest
- .word MARKER_DOES ; execution vector of MARKER DOES
-MARKVOC .word lastvoclink ; as voclink value
-MARKDP .word ROMDICT ; as DP value
+ FORTHWORD "PWR_STATE" ; reinitialize dictionary in same state as after OFF/ON
+PWR_STATE: mDODOES ; DOES part of MARKER : resets pointers DP, voclink and latest
+ .word STATE_DOES ; execution vector of PWR_STATE
+MARKVOC .word lastvoclink ; initialised by forthMSP430FR.asm as voclink value
+MARKDP .word ROMDICT ; initialised by forthMSP430FR.asm as DP value
- FORTHWORD "PWR_HERE" ; define dictionary bound for PWR_STATE
-PWR_HERE MOV &DDP,&MARKDP
- MOV &LASTVOC,&MARKVOC
- JMP PWR_STATE
+ FORTHWORD "RST_STATE" ; reinitialize dictionary in same state as after <reset>
+RST_STATE: MOV &INIVOC,&MARKVOC ; INI value saved in FRAM
+ MOV &INIDP,&MARKDP ; INI value saved in FRAM
+ JMP PWR_STATE
- FORTHWORD "RST_STATE" ; set dictionary in same state as <reset>
-RST_STATE MOV &INIDP,&MARKDP
- MOV &INIVOC,&MARKVOC
- JMP PWR_STATE
- FORTHWORD "RST_HERE" ; define dictionary bound for RST_STATE
-RST_HERE MOV &DDP,&INIDP
- MOV &LASTVOC,&INIVOC
- JMP PWR_HERE ; and reset PWR_STATE same as RST_STATE
+ FORTHWORD "PWR_HERE" ; define dictionary bound for power OFF/ON
+PWR_HERE: MOV &LASTVOC,&MARKVOC
+ MOV &DDP,&MARKDP
+ mNEXT
+
+ FORTHWORD "RST_HERE" ; define dictionary bound for <reset>
+RST_HERE: MOV &LASTVOC,&INIVOC
+ MOV &DDP,&INIDP
+ JMP PWR_HERE ; and init PWR_STATE same as RST_STATE
WIPE_DEFER MOV #PARENWARM,&WARM+2
+ MOV #PARENSLEEP,&SLEEP+2
QAB_DEFER MOV #PARENEMIT,&EMIT+2 ; always restore default console output
MOV #PARENCR,&CR+2 ; and CR to CR EMIT
MOV #PARENKEY,&KEY+2
.IFDEF SD_CARD_LOADER
- MOV #PARENACCEPT,&ACCEPT+2 ; always restore default console input
+ MOV #PARENACCEPT,&ACCEPT+2 ; always restore default console input
+ .ENDIF
+ .IFDEF MSP430ASSEMBLER ; reset all branch labels
+ MOV #0,&CLRBW1
+ MOV #0,&CLRBW2
+ MOV #0,&CLRBW3
+ MOV #0,&CLRFW1
+ MOV #0,&CLRFW2
+ MOV #0,&CLRFW3
.ENDIF
+
RET
- FORTHWORD "WIPE" ; restore the program as it was in FastForth.hex file
-WIPE
+ FORTHWORD "WIPE" ; restore the program as it was in forthMSP430FR.txt file
+WIPE:
; reset JTAG and BSL signatures ; unlock JTAG, SBW and BSL
MOV #SIGNATURES,X
SIGNLOOP MOV #-1,0(X) ; reset signature; WARNING ! DON'T CHANGE THIS IMMEDIATE VALUE !
; reset all FACTORY defered words to allow execution from SD_Card
CALL #WIPE_DEFER
; reinit this factory values :
- MOV #ROMDICT,&DDP
- MOV #lastvoclink,&LASTVOC
+ MOV #ROMDICT,&INIDP
+ MOV #lastvoclink,&INIVOC
; then reinit RST_STATE and PWR_STATE
- JMP RST_HERE
+ JMP RST_STATE
+
+; ------------------------------------------------------------------------------------------
+; forthMSP430FR : CONDITIONNAL COMPILATION
+; ------------------------------------------------------------------------------------------
+ .IFDEF CONDCOMP ; 2- conditionnal compilation part
+ .IFNDEF LOWERCASE
+ .WARNING "uncomment LOWERCASE ADD-ON to pass coretest COMPARE !"
+ .ENDIF ; LOWERCASE
+
+;COMPARE ( c-addr1 u1 c-addr2 u2 -- n )
+;https://forth-standard.org/standard/string/COMPARE
+;Compare the string specified by c-addr1 u1 to the string specified by c-addr2 u2.
+;The strings are compared, beginning at the given addresses, character by character,
+;up to the length of the shorter string or until a difference is found.
+;If the two strings are identical, n is zero.
+;If the two strings are identical up to the length of the shorter string,
+; n is minus-one (-1) if u1 is less than u2 and one (1) otherwise.
+;If the two strings are not identical up to the length of the shorter string,
+; n is minus-one (-1) if the first non-matching character in the string specified by c-addr1 u1
+; has a lesser numeric value than the corresponding character in the string specified by c-addr2 u2 and one (1) otherwise.
+ FORTHWORD "COMPARE"
+COMPARE
+ MOV TOS,S ;1 u2 = S
+ MOV @PSP+,Y ;2 addr2 = Y
+ MOV @PSP+,T ;2 u1 = T
+ MOV @PSP+,X ;2 addr1 = X
+COMPAR1 MOV T,TOS ;1
+ ADD S,TOS ;1
+ JZ COMPEQUAL ;2 end of all successfull comparisons
+ SUB #1,T ;1
+ JN COMPLESS ;2 u1<u2
+ SUB #1,S ;1
+ JN COMPGREATER ;2 u2<u1
+ ADD #1,X ;1
+ CMP.B @Y+,-1(X) ;4 char1-char2
+ JZ COMPAR1 ;2 char1=char2 17~ loop
+ JHS COMPGREATER ;2 char1>char2
+COMPLESS ; char1<char2
+ MOV #-1,TOS ;1
+ MOV @IP+,PC ;4
+COMPGREATER
+ MOV #1,TOS ;1
+COMPEQUAL
+ MOV @IP+,PC ;4 20 words
+
+;[THEN]
+;https://forth-standard.org/standard/tools/BracketTHEN
+ FORTHWORDIMM "[THEN]" ; do nothing
+ mNEXT
+
+ONEMIN
+ SUB #1,TOS
+ mNEXT
+
+;[ELSE]
+;Compilation:
+;Perform the execution semantics given below.
+;Execution:
+;( "<spaces>name ..." -- )
+;Skipping leading spaces, parse and discard space-delimited words from the parse area,
+;including nested occurrences of [IF] ... [THEN] and [IF] ... [ELSE] ... [THEN],
+;until the word [THEN] has been parsed and discarded.
+;If the parse area becomes exhausted, it is refilled as with REFILL.
+ FORTHWORDIMM "[ELSE]"
+BRACKETELSE
+ mDOCOL
+ .word lit,1 ; 1
+BRACKETELSE1 ; BEGIN
+BRACKETELSE2 ; BEGIN
+ .word FBLANK,WORDD,COUNT ; BL WORD COUNT
+ .word DUP,QBRAN,BRACKETELSE10 ; DUP WHILE
+ .word OVER,OVER ; 2DUP
+ .word XSQUOTE ; S" [IF]"
+ .byte 4,"[IF]" ;
+ .word COMPARE ; COMPARE
+ .word QZBRAN,BRACKETELSE3 ; 0= IF
+ .word TWODROP,ONEPLUS ; 2DROP 1+
+ .word BRAN,BRACKETELSE8 ; (ENDIF)
+BRACKETELSE3 ; ELSE
+ .word OVER,OVER ; OVER OVER
+ .word XSQUOTE ; S" [ELSE]"
+ .byte 6,"[ELSE]" ;
+ .word COMPARE ; COMPARE
+ .word QZBRAN,BRACKETELSE5 ; 0= IF
+ .word TWODROP,ONEMIN ; 2DROP 1-
+ .word DUP,QBRAN,BRACKETELSE4 ; DUP IF
+ .word ONEPLUS ; 1+
+BRACKETELSE4 ; THEN
+ .word BRAN,BRACKETELSE7 ; (ENDIF)
+BRACKETELSE5 ; ELSE
+ .word XSQUOTE ; S" [THEN]"
+ .byte 6,"[THEN]" ;
+ .word COMPARE ; COMPARE
+ .word QZBRAN,BRACKETELSE6 ; 0= IF
+ .word ONEMIN ; 1-
+BRACKETELSE6 ; THEN
+BRACKETELSE7 ; THEN
+BRACKETELSE8 ; THEN
+ .word QDUP ; ?DUP
+ .word QZBRAN,BRACKETELSE9 ; 0= IF
+ .word EXIT ; EXIT
+BRACKETELSE9 ; THEN
+ .word BRAN,BRACKETELSE2 ; REPEAT
+BRACKETELSE10 ;
+ .word TWODROP ; 2DROP
+ .word XSQUOTE ;
+ .byte 3,13,107,111 ;
+ .word TYPE,SPACE ; CR ." ko " to show false branch of conditionnal compilation
+ .word TIB,DUP,CPL ; REFILL
+ .word ACCEPT ; -- StringOrg len' (len' <= TIB_LEN)
+ FORTHtoASM ;
+ MOV #0,&TOIN ;
+ MOV TOS,&SOURCE_LEN ; -- StringOrg len'
+ MOV @PSP+,&SOURCE_ADR ; -- len'
+ MOV @PSP+,TOS ; --
+ MOV #BRACKETELSE1,IP ; AGAIN
+ mNEXT ; 78 words
+
+
+;[IF]
+;https://forth-standard.org/standard/tools/BracketIF
+;Compilation:
+;Perform the execution semantics given below.
+;Execution: ;( flag | flag "<spaces>name ..." -- )
+;If flag is true, do nothing. Otherwise, skipping leading spaces,
+; parse and discard space-delimited words from the parse area,
+; including nested occurrences of [IF] ... [THEN] and [IF] ... [ELSE] ... [THEN],
+; until either the word [ELSE] or the word [THEN] has been parsed and discarded.
+;If the parse area becomes exhausted, it is refilled as with REFILL. [IF] is an immediate word.
+;An ambiguous condition exists if [IF] is POSTPONEd,
+; or if the end of the input buffer is reached and cannot be refilled before the terminating [ELSE] or [THEN] is parsed.
+ FORTHWORDIMM "[IF]" ; flag --
+ CMP #0,TOS
+ MOV @PSP+,TOS
+ JZ BRACKETELSE
+ mNEXT
+
+;[UNDEFINED]
+;https://forth-standard.org/standard/tools/BracketUNDEFINED
+;Compilation:
+;Perform the execution semantics given below.
+;Execution: ( "<spaces>name ..." -- flag )
+;Skip leading space delimiters. Parse name delimited by a space.
+;Return a false flag if name is the name of a word that can be found,
+;otherwise return a true flag.
+ FORTHWORDIMM "[UNDEFINED]"
+ mDOCOL
+ .word FBLANK,WORDD,FIND,NIP,ZEROEQUAL,EXIT
+
+;[DEFINED]
+;https://forth-standard.org/standard/tools/BracketDEFINED
+;Compilation:
+;Perform the execution semantics given below.
+;Execution:
+;( "<spaces>name ..." -- flag )
+;Skip leading space delimiters. Parse name delimited by a space.
+;Return a true flag if name is the name of a word that can be found,
+;otherwise return a false flag. [DEFINED] is an immediate word.
+
+ FORTHWORDIMM "[DEFINED]"
+ mDOCOL
+ .word FBLANK,WORDD,FIND,NIP,EXIT
+
+ .ENDIF ; CONDCOMP
+
+; ------------------------------------------------------------------------------
+; forthMSP430FR : WARM
+; ------------------------------------------------------------------------------
+
; define FREQ used in WARM message (6)
- .IF FREQUENCY = 0.5
+ .IF FREQUENCY = 0.25
+FREQ .set " .2MHz"
+ .ELSEIF FREQUENCY = 0.5
FREQ .set " .5MHz"
.ELSEIF FREQUENCY = 1
FREQ .set " 1MHz"
; print start message if ECHO is set,
; then ABORT
FORTHWORD "(WARM)"
-PARENWARM
+PARENWARM:
+; SUB #4,PSP
+; MOV &SYSSNIV,0(PSP)
+; MOV &SYSUNIV,2(PSP)
MOV &SAVE_SYSRSTIV,TOS ; to display it
mDOCOL
.word XSQUOTE ;
.byte 5,13,1Bh,"[7m" ; CR + cmd "reverse video"
.word TYPE ;
.word DOT ; display signed SAVE_SYSRSTIV
+; .word DOT ; display SYSSNIV
+; .word DOT ; display SYSUNIV
.word XSQUOTE
- .byte 39," FastForth V160",FREQ," (C) J.M.Thoorens "
+ .byte 39," FastForth V162",FREQ," (C) J.M.Thoorens "
.word TYPE
.word LIT,FRAM_FULL,HERE,MINUS,UDOT
.word XSQUOTE ;
.byte 11,"bytes free ";
- .word QABORTYESNOECHO ; NOECHO enables any app to execute COLD without terminal connexion !
+ .word QABORTYESNOECHO ; NOECHO state enables any app to execute COLD or WARM without terminal connexion
;Z WARM -- ; deferred word used to init your application
; define this word: : START ...init app here... LIT RECURSE IS WARM (WARM) ;
FORTHWORD "WARM"
-WARM MOV #PARENWARM,PC
+WARM: MOV #PARENWARM,PC
+
+; ------------------------------------------------------------------------------
+; forthMSP430FR : COLD
+; ------------------------------------------------------------------------------
;Z COLD -- performs a software reset
FORTHWORD "COLD"
COLD MOV #0A500h+PMMSWBOR,&PMMCTL0
-; -------------------------------------------------------------------------
-; in addition to <reset>, DEEP_RST restores the program as it was in the FastForth.hex file and the electronic fuse so.
-; -------------------------------------------------------------------------
+;-------------------------------------------------------------------------------
+; in addition to <reset>, DEEP_RST restores the program as it was in the forthMSP430FR.txt file and the electronic fuse so.
+;-------------------------------------------------------------------------------
RESET
-; -------------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; case 1 : Power ON ==> RESET + the volatile program beyond PWR_HERE (not protected by PWR_STATE against POWER OFF) is lost
; SYSRSTIV = 2
; case 3 : TERM_TX wired to GND via 4k7 + <reset> ===> DEEP_RST, works even if the electronic fuse is "blown" !
; case 3.1 : (SYSRSTIV = 0Ah | SYSRSTIV >= 16h) ===> DEEP_RST on failure,
; case 3.2 : writing -1 in SAVE_SYSRSTIV then COLD ===> software DEEP_RST (WARM displays "-1")
-; -------------------------------------------------------------------------
+;-------------------------------------------------------------------------------
-; ------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; RESET : Target Init, limited to FORTH usage : I/O, FRAM, RTC
-; ------------------------------------------------------------------
+; all others I/O are set as input with pullup resistor
+;-------------------------------------------------------------------------------
.include "TargetInit.asm" ; include for each target the init code
MOV &INI_TERM,&TERMVEC
MOV #CPUOFF+GIE,&LPM_MODE
-; -----------------------------------------------------------
-; RESET : INIT FORTH machine
-; -----------------------------------------------------------
+;-------------------------------------------------------------------------------
+; RESET : INIT FORTH machine
+;-------------------------------------------------------------------------------
MOV #RSTACK,SP ; init return stack
MOV #PSTACK,PSP ; init parameter stack
.SWITCH DTC
.CASE 1
- MOV #xdocol,rDOCOL
+ MOV #xdocol,rDOCOL
.CASE 2
MOV #EXIT,rEXIT
.CASE 3 ; inlined DOCOL, do nothing here
MOV #10,&BASE
MOV #-1,&CAPS
-; -----------------------------------------------------------
+;-------------------------------------------------------------------------------
; RESET : test TERM_TXD/Deep_RST before init TERM_UART I/O
-; -----------------------------------------------------------
+;-------------------------------------------------------------------------------
BIC #LOCKLPM5,&PM5CTL0 ; activate all previous I/O settings before DEEP_RST test
MOV &SAVE_SYSRSTIV,Y ;
BIT.B #DEEP_RST,&Deep_RST_IN ; TERM TXD wired to GND via 4k7 resistor ?
ADD #1,Y ; to display SAVE_SYSRSTIV as negative value
MOV Y,&SAVE_SYSRSTIV
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; RESET : INIT TERM_UART
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
TERM_INIT
-
MOV #0081h,&TERMCTLW0 ; Configure TERM_UART UCLK = SMCLK
.include "TERMINALBAUDRATE.asm" ; include code to configure baudrate
BIC #UCSWRST,&TERMCTLW0 ; release from reset...
BIS #UCRXIE,&TERMIE ; ... then enable RX interrupt for wake up on terminal input
-; -----------------------------------------------------------
-; RESET : Select POWER_ON|<reset>|DEEP_RST
-; -----------------------------------------------------------
+;-------------------------------------------------------------------------------
+; RESET : Select POWER_ON|<reset>|DEEP_RST
+;-------------------------------------------------------------------------------
SelectReset MOV #COLD_END,IP ; define return of WIPE,RST_STATE,PWR_STATE
MOV &SAVE_SYSRSTIV,Y;
CMP #0Ah,Y ; reset event = security violation BOR ???? not documented...
- JZ WIPE ; Add WIPE to this reset to do DEEP_RST --------------
+ JZ WIPE ; Add WIPE to this reset to do DEEP_RST --------------
CMP #16h,Y ; reset event > software POR : failure or DEEP_RST request
JHS WIPE ; U>= ; Add WIPE to this reset to do DEEP_RST
CMP #2,Y ; reset event = Brownout ?
JNZ RST_STATE ; else execute RST_STATE
JZ PWR_STATE ; yes execute PWR_STATE
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; RESET : INIT SD_Card optionally
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
COLD_END
.IFNDEF SD_CARD_LOADER ;
.word WARM ; the next step
FORTHtoASM
BIT.B #SD_CD,&SD_CDIN ; SD_memory in SD_Card module ?
JNZ WARM ; no
- .include "forthMSP430FR_SD_INIT.asm";
+ .include "forthMSP430FR_SD_INIT.asm";
JMP WARM
.ENDIF
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; ASSEMBLER OPTION
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
.IFDEF MSP430ASSEMBLER
.include "forthMSP430FR_ASM.asm"
.ENDIF
-; ----------------------------------------------------------------------
-; SD CARD FAT OPTIONS
-; ----------------------------------------------------------------------
- .IFDEF SD_CARD_LOADER
- .include "forthMSP430FR_SD_LowLvl.asm" ; SD primitives
- .include "forthMSP430FR_SD_LOAD.asm" ; SD LOAD fonctions
- .IFDEF SD_CARD_READ_WRITE
- .include "forthMSP430FR_SD_RW.asm" ; SD Read/Write fonctions
- .ENDIF
- .ENDIF ; SD_CARD_LOADER
-
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
; UTILITY WORDS OPTION
-; ----------------------------------------------------------------------
+;-------------------------------------------------------------------------------
.IFDEF UTILITY
.include "ADDON\UTILITY.asm"
.ENDIF ; UTILITY
-;-----------------------------------------------------------------------
-; SD TOOLS
-;-----------------------------------------------------------------------
- .IFDEF SD_TOOLS
-
- .IFNDEF UTILITY
- .include "ADDON\UTILITY.asm"
+ .IFDEF SD_CARD_LOADER
+;-------------------------------------------------------------------------------
+; SD CARD FAT OPTIONS
+;-------------------------------------------------------------------------------
+ .include "forthMSP430FR_SD_LowLvl.asm" ; SD primitives
+ .include "forthMSP430FR_SD_LOAD.asm" ; SD LOAD driver
+ .IFDEF SD_CARD_READ_WRITE
+ .include "forthMSP430FR_SD_RW.asm" ; SD Read/Write driver
.ENDIF
+;-------------------------------------------------------------------------------
+; SD TOOLS
+;-------------------------------------------------------------------------------
+ .IFDEF SD_TOOLS
.include "ADDON\SD_TOOLS.asm"
.ENDIF ; SD_READ_WRITE_TOOLS
+;-------------------------------------------------------------------------------
+ .ENDIF ; SD_CARD_LOADER
-; -----------------------------------------------------------
-; IT'S FINISH : RESOLVE ASSEMBLY PTR
-; -----------------------------------------------------------
-ROMDICT ; init DDP
+;-------------------------------------------------------------------------------
+; IT'S FINISH : RESOLVE ASSEMBLY PTR
+;-------------------------------------------------------------------------------
+ROMDICT ; init DDP with this current address
lastvoclink .equ voclink
lastforthword .equ forthlink
lastasmword .equ asmlink
OSDN Git Service
