; 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
;===============================================================================
;-----------------------------------------------------------------------------------------------
-; TARGET configuration SWITCHES ; bytes values are for DTC=1, 8MHz 2457600bds XON/XOFF + RTS
+; TARGET configuration SWITCHES ; bytes values are for DTC=1, 8MHz 921600 bds TERMINAL3WIRES, no adds-on
;-----------------------------------------------------------------------------------------------
; 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 ; 4102 - 162 ( 24 + 86 + 52 ) = 3940 bytes
-MSP_EXP430FR5994 ; compile for MSP-EXP430FR5994 launchpad ; 4144 - 186 ( 24 + 86 + 76 ) = 3956 bytes
-;MSP_EXP430FR6989 ; compile for MSP-EXP430FR6989 launchpad ; 4140 - 168 ( 24 + 86 + 58 ) = 3972 bytes
-;MSP_EXP430FR4133 ; compile for MSP-EXP430FR4133 launchpad ; 4174 - 140 ( 24 + 86 + 30 ) = 4034 bytes
-;CHIPSTICK_FR2433 ; compile for the "CHIPSTICK" of M. Ken BOAK ; 4070 - 148 ( 24 + 86 + 38 ) = 3928 bytes
+;MSP_EXP430FR5739 ; compile for MSP-EXP430FR5739 launchpad ; 4210 - 160 ( 24 + 86 + 50 ) = 4050 bytes
+;MSP_EXP430FR5969 ; compile for MSP-EXP430FR5969 launchpad ; 4200 - 162 ( 24 + 86 + 52 ) = 4038 bytes
+MSP_EXP430FR5994 ; compile for MSP-EXP430FR5994 launchpad ; 4242 - 186 ( 24 + 86 + 76 ) = 4056 bytes
+;MSP_EXP430FR6989 ; compile for MSP-EXP430FR6989 launchpad ; 4234 - 168 ( 24 + 86 + 58 ) = 4066 bytes
+;MSP_EXP430FR4133 ; compile for MSP-EXP430FR4133 launchpad ; 4244 - 140 ( 24 + 86 + 30 ) = 4104 bytes
+;MSP_EXP430FR2433 ;; compile for MSP-EXP430FR2433 launchpad ; 4164 - 148 ( 24 + 86 + 38 ) = 4016 bytes
+;CHIPSTICK_FR2433 ; compile for the "CHIPSTICK" of M. Ken BOAK ; 4164 - 148 ( 24 + 86 + 38 ) = 4016 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
-FREQUENCY .equ 16 ; fully tested at 0.25,0.5,1,2,4,8,16 (and 24 for MSP430FR57xx) MHz
+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 921600 ; choose value considering the frequency and the UART2USB bridge, see explanations below.
-TERMINALXONXOFF ; to enable XON/XOFF flow control (PL2303TA/HXD, CP2102)
-TERMINALCTSRTS ; + 18 bytes to enable hardware flow control with RTS (PL2303TA/HXD, FT232RL)
+;HALFDUPLEX ; to use FAST FORTH with input terminal via bluetooth or WIFI (and with teraterm config = local Echo)
- .include "Target.inc" ; to define target config: I/O, memory, SFR, vectors, TERMINAL eUSCI, SD_Card eUSCI, LF_XTAL,
+TERMINALBAUDRATE .equ 921600 ; choose value considering the frequency and the UART2USB bridge, see explanations below.
+TERMINAL3WIRES ; enable 3 wires (GND,TX,RX) with XON/XOFF software flow control (PL2303TA/HXD, CP2102)
+TERMINAL4WIRES ; + 18 bytes enable 4 wires with hardware flow control on RX with RTS (PL2303TA/HXD, FT232RL)
+;TERMINAL5WIRES ; + 6 bytes enable 5 wires with hardware flow control on RX/TX with RTS/CTS (PL2303TA/HXD, FT232RL)
;-------------------------------------------------------------------------------
; 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 write strings in lowercase.
-;BACKSPACE_ERASE ; + 24 bytes : replace BS by ERASE, for visual comfort
+MSP430ASSEMBLER ; + 1884 bytes : adds embedded assembler with TI syntax; without, you can do all but all much more slowly...
+SD_CARD_LOADER ; + 1832 bytes : to LOAD source files from SD_card
+SD_CARD_READ_WRITE ; + 1196 bytes : to read, create, write and del files + source files direct copy from PC to SD_Card
+;BOOTLOADER ; + 52 bytes : adds to <reset> a bootstrap to SD_CARD\BOOT.4TH.
+;QUIETBOOT ; + 2 bytes : to perform bootload without displaying.
+FIXPOINT_INPUT ; + 78 bytes : adds the interpretation of Q15.16 numbers
+VOCABULARY_SET ; + 108 bytes : adds VOCABULARY FORTH ASSEMBLER ALSO PREVIOUS ONLY DEFINITIONS (FORTH83, not ANSI)
+LOWERCASE ; + 30 bytes : enables to write strings in lowercase.
;-------------------------------------------------------------------------------
-; OPTIONAL KERNELL ADD-ON SWITCHES (can be downloaded later) >------------------+
-; Tip: when switched ON below, ADD-ONs become protected against WIPE and Deep Reset... |
+; OPTIONAL KERNEL ADD-ON SWITCHES (can be downloaded later) >------------------+
+; Tip: when added here, 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+
+CONDCOMP ;; + 354 bytes : add cond. comp. : [UNDEFINED] [DEFINED] [IF] [ELSE] [THEN] CONDCOMP.f
+UTILITY ;; + 426/508 bytes : add .S .RS WORDS U.R DUMP ? UTILITY.f
+;FIXPOINT ; + 452 bytes : add Q15.16 words HOLDS F+ F- F/ F* F#S F. S>F 2@ 2CONSTANT FIXPOINT.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) ANS_COMP.f
+;ARITHMETIC ; + 358 bytes : add S>D M* SM/REM FM/MOD * /MOD / MOD */MOD /MOD */
+;DOUBLE ; + 130 bytes : add 2@ 2! 2DUP 2SWAP 2OVER
+;ALIGNMENT ; + 24 bytes : add ALIGN ALIGNED
+;PORTABILITY ; + 46 bytes : add CHARS CHAR+ CELLS CELL+
+ .include "Target.inc" ; to define target config: I/O, memory, SFR, vectors, TERMINAL eUSCI, SD_Card eUSCI, LF_XTAL,
+
;===============================================================================
; XON/XOFF control flow configuration ; up to 322kBd/MHz with ECHO
;===============================================================================
; ...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)
-; + 3000000 (16MHz)
-; + 6000000 (24MHz, MSP430FR57xx)
+; 9600,19200,38400,57600 (250kHz)
+; + 115200,134400 (500kHz)
+; + 201600,230400,268800 (1MHz)
+; + 403200,460800,614400 (2MHz)
+; + 806400,921600,1228800 (4MHz)
+; + 2457600,3000000 (8MHz)
+; + 6000000 (16,24MHz) (shorten the 1m cable or use a Si8622EC-B-IS to regenerate TTL levels)
; UARTtoUSB module with Silabs CP2102 (supply current = 20 mA)
; --------------------------------------------------------------------------------------------
; 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))
+; 9600,19200,38400,57600 (250kHz)
+; + 115200,134400 (500kHz)
+; + 201600,230400,268800 (1MHz)
+; + 403200,460800,614400 (2MHz)
+; + 806400,921600,1228800 (4MHz)
+; + 2457600,3000000 (8MHz)
+; + 6000000 (16,24MHz) (shorten the 1m cable or use a Si8622EC-B-IS to regenerate TTL levels)
; UARTtoUSB module with FTDI FT232RL (FT230X don't work correctly)
;LSTACK = L0 = LEAVEPTR ; ----- RAMSTART
; |
LSTACK_SIZE .equ 16 ; | grows up
- ; |
; V
- ;
; ^
- ; |
PSTACK_SIZE .equ 48 ; | grows down
; |
;PSTACK=S0 ; ----- RAMSTART + $80
- ;
; ^
- ; |
RSTACK_SIZE .equ 48 ; | grows down
; |
;RSTACK=R0 ; ----- RAMSTART + $E0
- ; aligned buffers only required for terminal tasks.
-
; names bytes ; comments
-;PAD ; ----- RAMSTART + $E2
+;PAD ; ----- RAMSTART + $E4
; |
PAD_LEN .equ 84 ; | grows up (ans spec. : PAD >= 84 chars)
- ; |
; v
-;TIB ; ----- RAMSTART + $136
- ; |
-TIB_LEN .equ 82 ; | grows up (ans spec. : TIB >= 80 chars)
+;PAD_END ; ----- RAMSTART + $138
+;TIB-4 ; TIB_I2CADR
+;TIB-2 ; TIB_I2CCNT
+;TIB ; ----- RAMSTART + $13C
; |
+TIB_LEN .equ 84 ; | grows up (ans spec. : TIB >= 80 chars)
; v
+;HOLDS_ORG ; ------RAMSTART + $190
; ^
- ; |
HOLD_SIZE .equ 34 ; | grows down (ans spec. : HOLD_SIZE >= (2*n) + 2 char, with n = 16 bits/cell
; |
-;BASE_HOLD ; ----- RAMSTART + $1AA
+;BASE_HOLD ; ----- RAMSTART + $1B2
;
; variables system ;
;
- ; ----- RAMSTART + $1DC
+ ; ----- RAMSTART + $1E4
;
- ; 32 bytes free
+ ; 24 bytes free
;
-;BUFFER-2 ; ----- RAMSTART + $1FD
-;BUFFER ; ----- RAMSTART + $200
+; variables system END ; ----- RAMSTART + $1FC
+ ; SDBUF_I2CADR
+ ; SDBUF_I2CCNT
+;SD_BUF ; ----- 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_ORG .equ RSTACK+2
-TIB_ORG .equ PAD_ORG+PAD_LEN
-BASE_HOLD .equ TIB_ORG+TIB_LEN+HOLD_SIZE
+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_ORG .equ RSTACK+4
+TIB_ORG .equ PAD_ORG+PAD_LEN+4
+HOLDS_ORG .equ TIB_ORG+TIB_LEN
+BASE_HOLD .equ HOLDS_ORG+HOLD_SIZE
; ----------------------------------
LAST_CFA .word 0
LAST_PSP .word 0
STATE .word 0 ; Interpreter state
-ASM_CURRENT .word 0 ; preserve CURRENT during create assembler words
+SAV_CURRENT .word 0 ; preserve CURRENT during create assembler words
OPCODE .word 0 ; OPCODE adr
ASMTYPE .word 0 ; keep the opcode complement
+SOURCE
SOURCE_LEN .word 0
SOURCE_ADR .word 0 ; len, addr of input stream
-TOIN .word 0
-DDP .word 0
+TOIN .word 0 ; CurrentInputBuffer pointer
+DDP .word 0 ; dictionnary pointer
LASTVOC .word 0 ; keep VOC-LINK
-CURRENT .word 0 ; CURRENT dictionnary ptr
CONTEXT .word 0,0,0,0,0,0,0,0 ; CONTEXT dictionnary space (8 CELLS)
+CURRENT .word 0 ; CURRENT dictionnary ptr
BASE .word 0
+LINE .word 0 ; line in interpretation (initialized by NOECHO)
+
+; ------------------------------------- ; RAMSTART + $1E6
- .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
+ .word 0,0,0 ; user free use
-; ------------------------------
-; RAM SD_CARD BUFFER 2+512 bytes
-; ------------------------------
+; ------------------------------------- ; RAMSTART + $1FC
- .word 0 ; to able init BufferPtr down to -2 (to skip a CR, for example)
-BUFFER
-BUFEND .equ BUFFER + 200h ; 512bytes
+
+; --------------------------------
+; RAM SD_CARD SD_BUF 4 + 512 bytes
+; --------------------------------
+SD_BUF_I2CADR .word 0
+SD_BUF_I2CCNT .word 0
+SD_BUF
+SD_BUFEND .equ SD_BUF + 200h ; 512bytes
;-------------------------------------------------------------------------------
.ENDIF
HECTOBAUDS .word TERMINALBAUDRATE/100 ; user use
-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
+SAVE_SYSRSTIV .word 05 ; value to identify 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 RXON ; user use
.word RXOFF ; user use
; VARIABLES that could be in RAM
; ------------------------------
.IFNDEF RAM_1K ; if RAM = 1K (FR57xx) the variables below stay in FRAM
- .org BUFEND ; else in RAM beyond BUFFER
+ .org SD_BUFEND ; else in RAM beyond SD_BUF
.ENDIF
.IFDEF SD_CARD_LOADER
SectorH .word 0
; ---------------------------------------
-; BUFFER management
+; SD_BUF management
; ---------------------------------------
BufferPtr .word 0
BufferLen .word 0
DIRClusterL .word 0 ; contains the Cluster of current directory ; = 1 as FAT16 root directory
DIRClusterH .word 0 ; contains the Cluster of current directory ; = 1 as FAT16 root directory
EntryOfst .word 0
-pathname .word 0 ; address of pathname string
; ---------------------------------------
; Handle Pointer
; ---------------------------------------
; Load file operation
; ---------------------------------------
-SAVEtsLEN .word 0 ; of previous ACCEPT
-SAVEtsPTR .word 0 ; of previous ACCEPT
- .word 0 ;
- .word 0 ;
- .word 0
+
+pathname .word 0 ; or any string...
+EndOfPath .word 0 ; or of any string...
+
+; ---------------------------------------
+
+ .word 0,0,0,0
; ---------------------------------------
; Handle structure
; =-1 : LOAD"ed file (source file)
; offset values
-HDLW_PrevHDL .equ 0 ; previous handle ; used by LOAD"
+HDLW_PrevHDL .equ 0 ; previous handle
HDLB_Token .equ 2 ; token
HDLB_ClustOfst .equ 3 ; Current sector offset in current cluster (Byte)
HDLL_DIRsect .equ 4 ; Dir SectorL
HDLH_DIRsect .equ 6 ; Dir SectorH
-HDLW_DIRofst .equ 8 ; BUFFER offset of Dir entry
+HDLW_DIRofst .equ 8 ; SD_BUF offset of Dir entry
HDLL_FirstClus .equ 10 ; File First ClusterLo (identify the file)
-HDLH_FirstClus .equ 12 ; File First ClusterHi (byte)
+HDLH_FirstClus .equ 12 ; File First ClusterHi (identify the file)
HDLL_CurClust .equ 14 ; Current ClusterLo
HDLH_CurClust .equ 16 ; Current ClusterHi
HDLL_CurSize .equ 18 ; written size / not yet read size (Long)
HDLH_CurSize .equ 20 ; written size / not yet read size (Long)
-HDLW_BUFofst .equ 22 ; BUFFER offset ; used by LOAD"
+HDLW_BUFofst .equ 22 ; SD_BUF offset ; used by LOAD"
+
+ .IFDEF RAM_1K ; RAM_Size = 1k: due to the lack of RAM PAD is SDIB
- .IFDEF RAM_1K ; RAM_Size = 1k, no SDIB due to the lack of RAM
FirstHandle
-HandleMax .equ 7
+HandleMax .equ 5 ; and not 8 because lack of RAM
HandleLenght .equ 24
HandleEnd .equ FirstHandle+handleMax*HandleLenght
- .org HandleEnd
+ .org HandleEnd
+
+LOADPTR .equ HandleEnd
+LOAD_STACK .equ HandleEnd+2
+LOADSTACK_SIZE .equ HandleMax+1 ; make room for 3 words * handles
+LoadStackEnd .equ LOAD_STACK+LOADSTACK_SIZE*6
+
+ .org LoadStackEnd
+
+SDIB_ORG .equ PAD_ORG
+
+
+ .ELSEIF ; RAM_Size > 1k
- .ELSEIF ; RAM_Size >= 2k
FirstHandle
HandleMax .equ 8
HandleLenght .equ 24
HandleEnd .equ FirstHandle+handleMax*HandleLenght
- .org HandleEnd
-SDIB
-SDIB_LEN .equ 84
+ .org HandleEnd
+
+LOADPTR .equ HandleEnd
+LOAD_STACK .equ HandleEnd+2
+LOADSTACK_SIZE .equ HandleMax+1 ; make room for 3 words * handles
+LoadStackEnd .equ LOAD_STACK+LOADSTACK_SIZE*6 ; 3 words by handle
- .org SDIB+SDIB_LEN
+ .org LoadStackEnd
+
+SDIB_I2CADR .word 0
+SDIB_I2CCNT .word 0
+SDIB_ORG
+SDIB_LEN .equ 84
+
+ .org SDIB_ORG+SDIB_LEN
.ENDIF ; RAM_Size
;-------------------------------------------------------------------------------
; 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.
+; as IP is always 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
+; as ITC competitors.
;-------------------------------------------------------------------------------
RSP .reg R1 ; RSP = Return Stack Pointer (return stack)
;https://forth-standard.org/standard/core/EXIT
;C EXIT -- exit a colon definition; CALL #EXIT performs ASMtoFORTH (10 cycles)
+; JMP #EXIT performs EXIT
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
;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
+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: MOV TOS,-2(PSP) ; 3 -- x1 (x2) x2
+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
;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
;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)
+DEPTH MOV TOS,-2(PSP)
MOV #PSTACK,TOS
SUB PSP,TOS ; PSP-S0--> TOS
SUB #2,PSP ; post decrement stack...
;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 ;2
+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.B @PSP+,0(TOS);4
+CSTORE MOV.B @PSP+,0(TOS);4
ADD #1,PSP ;1
MOV @PSP+,TOS ;2
mNEXT
;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
;https://forth-standard.org/standard/core/Minus
;C - n1/u1 n2/u2 -- n3/u3 n3 = n1-n2
FORTHWORD "-"
-MINUS: SUB @PSP+,TOS ;2 -- n2-n1
-NEGATE: XOR #-1,TOS ;1
-ONEPLUS: ADD #1,TOS ;1 -- n3 = -(n2-n1)
+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
;https://forth-standard.org/standard/core/ABS
;C ABS n1 -- +n2 absolute value
FORTHWORD "ABS"
-ABBS: CMP #0,TOS ; 1
+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
+DABBS AND #-1,TOS ; clear V, set N
JGE DABBSEND ; JMP if positive
-DNEGATE: XOR #-1,0(PSP)
+DNEGATE XOR #-1,0(PSP)
XOR #-1,TOS
ADD #1,0(PSP)
ADDC #0,TOS
;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 ;1 set carry if TOS negative
+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
+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
+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
+LESS MOV @PSP+,W ;2 W=n1
SUB TOS,W ;1 W=n1-n2 flags set
JL TOSTRUE ;2
TOSFALSE MOV #0,TOS ;1
;https://forth-standard.org/standard/core/more
;C > n1 n2 -- flag test n1>n2, signed
FORTHWORD ">"
-GREATER: SUB @PSP+,TOS ;2 TOS=n2-n1
+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
+ULESS MOV @PSP+,W ;2
SUB TOS,W ;1 u1-u2 in W, carry clear if borrow
JNC TOSTRUE ;2
MOV #0,TOS ;1
;-------------------------------------------------------------------------------
;Z branch -- branch always
-BRAN: MOV @IP,IP ; 2
+BRAN MOV @IP,IP ; 2
mNEXT ; 4
;Z ?branch x -- branch if TOS = zero
-QBRAN: CMP #0,TOS ; 1 test TOS value
+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
+QZBRAN SUB #1,TOS ; 1 borrow (clear cy) if TOS was 0
SUBC TOS,TOS ; 1 TOS=-1 if borrow was set
JMP QBRAN1 ; 2
;Z (do) n1|u1 n2|u2 -- R: -- sys1 sys2 run-time code for DO
; n1|u1=limit, n2|u2=index
-xdo: MOV #8000h,X ;2 compute 8000h-limit "fudge factor"
+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.
-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 1 to the loop index. If loop terminates, clean up the
; return stack and skip the branch. Else take the inline branch.
; Note that LOOP terminates when index=8000h.
-xloop: ADD #1,0(RSP) ;4 increment INDEX
+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 ;1 make room in TOS
+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
;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
+; SYSTEM CONSTANTS
;-------------------------------------------------------------------------------
;https://forth-standard.org/standard/core/PAD
PAD mDOCON
.WORD PAD_ORG
-; TIB -- terminal input buffer address
- FORTHWORD "TIB"
-TIB mDOCON
- .WORD TIB_ORG ; constant, may be modified by IS
+; CIB -- Current_Input_Buffer_address
+ FORTHWORD "CIB"
+FCIB mDOCON
+ .WORD TIB_ORG ; constant, modified by open and close (as a VALUE)
-; CPL -- terminal input buffer lenght (CPL = Chars Per Line)
+; CPL -- input_buffer_lenght (CPL = Chars Per Line)
FORTHWORD "CPL"
CPL mDOCON
- .WORD TIB_LEN ; constant, may be modified by IS
+ .WORD TIB_LEN ; constant
+
+;https://forth-standard.org/standard/core/BL
+;C BL -- char an ASCII space
+ FORTHWORD "BL"
+FBLANK mDOCON
+ .word 32
+
+;-------------------------------------------------------------------------------
+; SYSTEM VARIABLES
+;-------------------------------------------------------------------------------
;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
+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
- .word 32
-
-;-------------------------------------------------------------------------------
-; MULTIPLY
-;-------------------------------------------------------------------------------
+; LINE -- a-addr LINE interpretation
+ FORTHWORD "LINE"
+FLINE mDOCON
+ .word LINE ; VARIABLE address in RAM space
;-------------------------------------------------------------------------------
; ANS complement OPTION
.ENDIF ; PORTABILITY
;-------------------------------------------------------------------------------
-; ARITHMETIC OPERATORS OPTION
-;-------------------------------------------------------------------------------
- .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
+;-------------------------------------------------------------------------------
+; ARITHMETIC OPERATORS OPTION
+;-------------------------------------------------------------------------------
+ .IFDEF ARITHMETIC ; included in ANS_COMPLEMENT
+ .include "ADDON\ARITHMETIC.asm"
+ .ENDIF ; ARITHMETIC
+
.ENDIF ; ANS_COMPLEMENT
;-------------------------------------------------------------------------------
;https://forth-standard.org/standard/core/num-start
;C <# -- begin numeric conversion (initialize Hold Pointer)
FORTHWORD "<#"
-LESSNUM: MOV #BASE_HOLD,&HP
+LESSNUM MOV #BASE_HOLD,&HP
mNEXT
-
; unsigned 32-BIT DIVIDEND : 16-BIT DIVISOR --> 32-BIT QUOTIENT, 16-BIT REMAINDER
-; DVDhi|DVDlo : DIVlo --> QUOThi|QUOTlo REMlo
-; then REMlo is converted in ASCII char
; 2 times faster if DVDhi = 0 (it's the general case)
-; reg division NUM
-; -----------------------------
-; S = DVDlo (15-0) = ud1lo
-; TOS = DVDhi (31-16) = ud1hi
+; reg division MU/MOD NUM
+; -----------------------------------------
+; S = DVDlo (15-0) = ud1lo = ud1lo
+; TOS = DVDhi (31-16) = ud1hi = ud1hi
; T = DIVlo = BASE
-; W = REMlo = digit --> char --> -[HP]
-; X = QUOTlo = ud2lo
-; Y = QUOThi = ud2hi
+; W = REMlo = REMlo = digit --> char --> -[HP]
+; X = QUOTlo = ud2lo = ud2lo
+; Y = QUOThi = ud2hi = ud2hi
; rDODOES = count
-;https://forth-standard.org/standard/core/num
-;C # ud1lo ud1hi -- ud2lo ud2hi convert 1 digit of output
- FORTHWORD "#"
-NUM MOV.B &BASE,T ;3 T = DIVlo
-NUM1 CMP #0,TOS ;1 DVDhi <> 0 ?
-NUM2 MOV @PSP,S ;2 S = DVDlo, TOS = DVDhi
- MOV #0,W ;1 W = REMlo = 0
- MOV #32,rDODOES ;2 init loop count
- JNZ MDIV ;2 yes
- RRA rDODOES ;1 no: loop count / 2
+; MU/MOD DVDlo DVDhi DIVlo -- REMlo QUOTlo QUOThi
+; FORTHWORD "MU/MOD"
+ ASMWORD "MU/MOD" ; for ANS_COMP use
+MUSMOD MOV TOS,T ;1 T = DIVlo
+ MOV @PSP,TOS ;2 TOS = DVDhi
+ MOV 2(PSP),S ;3 S = DVDlo
+MUSMOD1 MOV #0,W ;1 W = REMlo = 0
+MUSMOD2 MOV #32,rDODOES ;2 init loop count
+ CMP #0,TOS ;1 DVDhi=0 ?
+ JNZ MDIV1 ;2 no
+ RRA rDODOES ;1 yes: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)
-MDIV ADD S,S ;1 RLA DVDlo
- ADDC TOS,TOS ;1 RLC DVDhi
- ADDC W,W ;1 RLC REMlo
- CMP T,W ;1 REMlo U>= DIVlo ?
- JNC MDIV1 ;2 no : carry is reset
+MDIV1 CMP T,W ;1 REMlo U>= DIVlo ?
+ JNC MDIV2 ;2 no : carry is reset
SUB T,W ;1 yes: REMlo - DIVlo ; carry is set after soustraction!
-MDIV1 ADDC X,X ;1 RLC quotLO
+MDIV2 ADDC X,X ;1 RLC quotLO
ADDC Y,Y ;1 RLC quotHI
SUB #1,rDODOES ;1 Decrement loop counter
- JNZ MDIV ;2 (12+10)/2 = 11 cycles loop
+ JN ENDMDIV ;2
+ ADD S,S ;1 RLA DVDlo
+ ADDC TOS,TOS ;1 RLC DVDhi
+ ADDC W,W ;1 RLC REMlo
+ JNC MDIV1 ;2
+ SUB T,W ;1 REMlo - DIVlo
+ BIS #1,SR ;1 SETC
+ JMP MDIV2 ;2
ENDMDIV MOV #xdodoes,rDODOES;2 restore rDODOES
+ MOV W,2(PSP) ;3 REMlo in 2(PSP)
MOV X,0(PSP) ;3 QUOTlo in 0(PSP)
MOV Y,TOS ;1 QUOThi in TOS
+ RET ;4 35 words, about 252/473 cycles, not FORTH executable !
+
+;https://forth-standard.org/standard/core/num
+;C # ud1lo ud1hi -- ud2lo ud2hi convert 1 digit of output
+ FORTHWORD "#"
+NUM MOV &BASE,T ;3 T = Divisor
+NUM1 MOV @PSP,S ;2 -- DVDlo DVDhi S = DVDlo
+ SUB #2,PSP ;1 -- DVDlo x DVDhi TOS = DVDhi
+ CALL #MUSMOD1 ;4 -- REMlo QUOTlo QUOThi
+ MOV @PSP+,0(PSP);4 -- QUOTlo QUOThi
TODIGIT CMP.B #10,W ;2 W = REMlo
JLO TODIGIT1 ;2 U<
ADD #7,W ;2
HOLDW SUB #1,&HP ;3 store W=char --> -[HP]
MOV &HP,Y ;3
MOV.B W,0(Y) ;3
- mNEXT ;4 41 words, about 214/394 cycles/char
+ mNEXT ;4 26 words
;https://forth-standard.org/standard/core/numS
;C #S udlo:udhi -- udlo:udhi=0 convert remaining digits
FORTHWORD "#S"
-NUMS: mDOCOL
- .word NUM ;
+NUMS mDOCOL
+ .word NUM ; X=QUOTlo
FORTHtoASM ;
SUB #2,IP ;1 restore NUM return
CMP #0,X ;1 test ud2lo first (generally true)
JNZ NUM1 ;2
CMP #0,TOS ;1 then test ud2hi (generally false)
- JNZ NUM2 ;2
+ JNZ NUM1 ;2
MOV @RSP+,IP ;2
- mNEXT ;4 about 215/397 cycles/char
+ mNEXT ;4 10 words, about 241/417 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)
+NUMGREATER MOV &HP,0(PSP)
MOV #BASE_HOLD,TOS
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
+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
+SIGN CMP #0,TOS
MOV @PSP+,TOS
MOV #'-',W
JN HOLDW ; 0<
;https://forth-standard.org/standard/core/Ud
;C U. u -- display u (unsigned)
FORTHWORD "U."
-UDOT: mDOCOL
+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
+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: CMP #0,TOS
+DOT CMP #0,TOS
JGE UDOT
SUB #2,PSP
MOV TOS,0(PSP)
;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
; TERMINAL I/O, input part
; ------------------------------------------------------------------------------
-;Z (KEY?) -- c get character from the terminal
-; FORTHWORD "(KEY?)"
-PARENKEYTST: SUB #2,PSP ; 1 push old TOS..
+;Z (KEY) -- c get character from the terminal
+ FORTHWORD "(KEY)"
+PARENKEY MOV &TERMRXBUF,Y ; empty buffer
+ SUB #2,PSP ; 1 push old TOS..
MOV TOS,0(PSP) ; 4 ..onto stack
CALL #RXON
KEYLOOP BIT #UCRXIFG,&TERMIFG ; loop if bit0 = 0 in interupt flag register
CALL #RXOFF ;
mNEXT
-;F KEY? -- c get character from input device ; deferred word
-; FORTHWORD "KEY?"
-;KEYTST: MOV #PARENKEYTST,PC
-
-
-;Z (KEY) -- c get character from the terminal
- FORTHWORD "(KEY)"
-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 @PC+,PC
+ .word PARENKEY
;-------------------------------------------------------------------------------
; INTERPRETER INPUT, the kernel of kernel !
;-------------------------------------------------------------------------------
.IFDEF SD_CARD_LOADER
- .include "forthMSP430FR_SD_ACCEPT.asm" ; that creates SD_ACCEPT
- .ENDIF ; SD_CARD_LOADER
+ .include "forthMSP430FR_SD_ACCEPT.asm"
+DEFER_ACCEPT
+ .ENDIF
+ .IFDEF DEFER_ACCEPT
;https://forth-standard.org/standard/core/ACCEPT
;C ACCEPT addr addr len -- addr' len' get line at addr to interpret len' chars
FORTHWORD "ACCEPT"
-ACCEPT MOV #PARENACCEPT,PC
+ACCEPT MOV @PC+,PC ;3
+ .word PARENACCEPT
;C (ACCEPT) addr addr len -- addr len' get len' (up to len) chars from terminal (TERATERM.EXE) via USBtoUART bridge
FORTHWORD "(ACCEPT)"
PARENACCEPT
+ .ELSE
+
+;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
+
+ .ENDIF ; DEFER_ACCEPT
+
+ .IFDEF HALFDUPLEX ; to use FAST FORTH with half duplex input terminal (bluetooth or wifi connexion)
+
+ .include "forthMSP430FR_HALFDUPLEX.asm"
+
+ .ELSE ; to use FAST FORTH with full duplex terminal (USBtoUART bridge)
+
; 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,
; --------------------------------------;
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 )
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)
; --------------------------------------;
-
-; ======================================;
-RXON: ;
-; ======================================;
- .IFDEF TERMINALXONXOFF ;
- MOV #17,&TERMTXBUF ;4 move char XON into TX_buf
- .ENDIF ;
- .IFDEF TERMINALCTSRTS ;
- BIC.B #RTS,&HANDSHAKOUT ;4 set RTS low
- .ENDIF ;
- .IFDEF TERMINALXONXOFF ;
- .IF TERMINALBAUDRATE/FREQUENCY <230400
+RXON ;
+; --------------------------------------;
+ .IFDEF TERMINAL3WIRES ;
RXON_LOOP BIT #UCTXIFG,&TERMIFG ;3 wait the sending end of XON, useless at high baudrates
JZ RXON_LOOP ;2
+ MOV #17,&TERMTXBUF ;4 move char XON into TX_buf
.ENDIF ;
+ .IFDEF TERMINAL4WIRES ;
+ BIC.B #RTS,&HANDSHAKOUT ;4 set RTS low
.ENDIF ;
; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
; starts first and 3th stopwatches ;
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"
-; ======================================;
-RXOFF: ; NOP11
-; ======================================;
- .IFDEF TERMINALXONXOFF ;
+; --------------------------------------;
+RXOFF ;
+; --------------------------------------;
+ .IFDEF TERMINAL3WIRES ;
+RXOFF_LOOP BIT #UCTXIFG,&TERMIFG ;3 wait the sending end of XOFF, useless at high baudrates
+ JZ RXOFF_LOOP ;2
MOV #19,&TERMTXBUF ;4 move XOFF char into TX_buf
.ENDIF ;
- .IFDEF TERMINALCTSRTS ;
+ .IFDEF TERMINAL4WIRES ;
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
; --------------------------------------;
; --------------------------------------;
ASMWORD "SLEEP" ; may be redirected
-SLEEP: ;
- MOV #PARENSLEEP,PC ;3
+SLEEP ;
+ MOV @PC+,PC ;3
+ .word PARENSLEEP ;
; --------------------------------------;
; --------------------------------------;
ASMWORD "(SLEEP)" ;
-PARENSLEEP: ;
+PARENSLEEP ;
BIS &LPM_MODE,SR ;3 enter in LPMx sleep mode with GIE=1
; --------------------------------------; default FAST FORTH mode (for its input terminal use) : LPM0.
; **************************************;
-TERMINAL_INT: ; <--- TEMR 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, SR flags are lost (unused by FORTH interpreter)
- .word 173Ah ;6 POPM W=buffer_bound,T=0Dh,S=20h,IP=AYEMIT_RET
+ .word 173Ah ;6 POPM ;W=buffer_bound, T=0Dh,S=20h, IP=AYEMIT_RET
; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
; starts the 2th stopwatch ;
; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
; stops the 3th stopwatch ; 3th bottleneck result : 17~ + LPMx wake_up time ( + 5~ XON loop if F/Bds<230400 )
; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
-AKEYREAD1 ; <--- XON RET address 2 ; first emergency: anticipate XOFF on CR as soon as possible
+AKEYREAD1 CMP.B S,Y ;1 printable char ?
+ JHS ASTORETEST ;2 yes
CMP.B T,Y ;1 char = CR ?
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 ; case of other control chars
+; stops the first stopwatch ;= first bottleneck, best case result: 27~ + LPMx wake_up time..
+; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^; ...or 14~ in case of empty line
+AQBS CMP.B #8,Y ;1 char = BS ?
+ JNE WAITaKEY ;2 case of other control chars
; --------------------------------------;
; start of backspace ; made only by an human
; --------------------------------------;
CMP @PSP,TOS ; Ptr = Org ?
JZ WAITaKEY ; yes: do nothing
SUB #1,TOS ; no : dec Ptr
-; --------------------------------------;
- .IFDEF BACKSPACE_ERASE
- MOV #BS_NEXT,IP ;
- JMP YEMIT ; send BS
-BS_NEXT FORTHtoASM ;
- MOV #32,Y ; send SPACE to rub previous char
- ADD #8,IP ; (BS_NEXT+2) + 8 = FORTHtoASM @ !
- JMP YEMIT ;
- FORTHtoASM ;
- MOV.B #8,Y ;
- MOV #AYEMIT_RET,IP ;
- .ENDIF
-; --------------------------------------;
- JMP YEMIT ; send BS
+ JMP YEMIT1 ; send BS
; --------------------------------------;
; end of backspace ;
; --------------------------------------;
ASTORETEST CMP W,TOS ; 1 Bound is reached ?
- JZ YEMIT ; 2 yes: send echo then loopback
+ JZ YEMIT1 ; 2 yes: send echo then loopback
MOV.B Y,0(TOS) ; 3 no: store char @ Ptr, send echo then loopback
ADD #1,TOS ; 1 increment Ptr
-YEMIT: .word 4882h ; hi7/4~ lo:12/4~ send/send_not echo to terminal
- .word TERMTXBUF ; 3 MOV Y,&TERMTXBUF
+YEMIT1
.IF TERMINALBAUDRATE/FREQUENCY <230400
-YEMIT1 BIT #UCTXIFG,&TERMIFG ; 3 wait the sending end of previous char, useless at high baudrates
+ BIT #UCTXIFG,&TERMIFG ; 3 wait the sending end of previous char (sent before ACCEPT), useless at high baudrates
JZ YEMIT1 ; 2
.ENDIF
+ .IFDEF TERMINAL5WIRES ;
+YEMIT2 BIT.B #CTS,&HANDSHAKIN ; 3
+ JNZ YEMIT2 ; 2
+ .ENDIF
+YEMIT .word 4882h ; hi7/4~ lo:12/4~ send/send_not echo to terminal
+ .word TERMTXBUF ; 3 MOV Y,&TERMTXBUF
mNEXT ; 4
; --------------------------------------;
AYEMIT_RET FORTHtoASM ; 0 YEMII NEXT address; NOP9
SUB #2,IP ; 1 set YEMIT NEXT address to AYEMIT_RET
WAITaKEY BIT #UCRXIFG,&TERMIFG ; 3 new char in TERMRXBUF ?
- JZ WAITaKEY ; 2 no
JNZ AKEYREAD ; 2 yes
+ JZ WAITaKEY ; 2 no
; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
-; stops the 2th stopwatch ; best case result: 31~/28~ (with/without echo) ==> 322/357 kBds/MHz
-; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
+; stops the 2th stopwatch ; best case result: 26~/22~ (with/without echo) ==> 385/455 kBds/MHz
+; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
; --------------------------------------;
ENDACCEPT ; <--- XOFF return address
; --------------------------------------;
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'
+ CMP #0,&LINE ; if LINE <> 0...
+ JZ DROPEXIT ;
+ ADD #1,&LINE ; ...increment LINE
+DROPEXIT 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
-YEMIT2 BIT #UCTXIFG,&TERMIFG ; 3 wait the sending end of previous char (usefull for low baudrates)
- JZ YEMIT2 ; 2
- .ENDIF
- JMP YEMIT ;9 12~
+ JMP YEMIT1 ;9 12~
+
+ .ENDIF ; HALFDUPLEX
;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 15~
+EMIT MOV @PC+,PC ;3 15~
+ .word PARENEMIT
;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>
+ MOV #0,&LINE ;
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
+ MOV #1,&LINE ;
mNEXT
-; (CR) -- send CR to the output terminal (via EMIT)
- FORTHWORD "(CR)"
-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
-
-
;https://forth-standard.org/standard/core/SPACE
;C SPACE -- output a space
FORTHWORD "SPACE"
-SPACE: SUB #2,PSP ;1
+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
mNEXT
+ .IFDEF DEFER_TYPE
+
;https://forth-standard.org/standard/core/TYPE
;C TYPE adr len -- type line to terminal
FORTHWORD "TYPE"
-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 ; 13+6+15+16= 50~ char loop ==> 1.6MBds @ 8MHz
- .word EXIT
+TYPE MOV @PC+,PC
+ .word PARENTYPE
+
+;https://forth-standard.org/standard/core/TYPE
+;C TYPE adr len -- type line to terminal
+ FORTHWORD "(TYPE)"
+PARENTYPE
+
+ .ELSE
+
+;https://forth-standard.org/standard/core/TYPE
+;C TYPE adr len -- type line to terminal
+ FORTHWORD "TYPE"
+TYPE
+
+ .ENDIF ; DEFER_TYPE
+
+ CMP #0,TOS
+ JZ TWODROP ; abort fonction
+ .word 0151Eh ;5 PUSM TOS,IP R-- len,IP
+ MOV #TYPE_NEXT,IP
+TYPELOOP MOV @PSP,Y ;2 -- adr adr ; 30~ char loop
+ MOV.B @Y+,TOS ;2
+ MOV Y,0(PSP) ;3 -- adr+1 char
+ SUB #2,PSP ;1 emit consumes one cell
+ JMP EMIT ;15
+TYPE_NEXT FORTHtoASM
+ SUB #2,IP ;1
+ SUB #1,2(RSP) ;4 len-1
+ JNZ TYPELOOP ;2
+ .word 0171Dh ;5 POPM IP,TOS
+ JMP TWODROP ;2+7
+; (CR) -- send CR+LF to the output terminal (via TYPE)
+ FORTHWORD "(CR)"
+PARENCR mDOCOL
+ .word XSQUOTE
+ .byte 2,13,10
+ .word TYPE,EXIT
+
+;https://forth-standard.org/standard/core/CR
+;C CR -- send CR to the output device
+ FORTHWORD "CR"
+CR MOV @PC+,PC
+ .word PARENCR
; ------------------------------------------------------------------------------
; STRINGS PROCESSING
;Z (S") -- addr u run-time code for S"
; get address and length of string.
-XSQUOTE: SUB #4,PSP ; 1 -- x x TOS ; push old TOS on stack
+XSQUOTE SUB #4,PSP ; 1 -- x x TOS ; push old TOS on stack
MOV TOS,2(PSP) ; 3 -- TOS x x ; and reserve one cell on stack
MOV.B @IP+,TOS ; 2 -- x u ; u = lenght of string
MOV IP,0(PSP) ; 3 -- addr u
.IFDEF LOWERCASE
FORTHWORD "CAPS_ON"
-CAPS_ON: MOV #-1,&CAPS ; state by default
+CAPS_ON MOV #-1,&CAPS ; state by default
mNEXT
FORTHWORD "CAPS_OFF"
-CAPS_OFF: MOV #0,&CAPS
+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
+SQUOTE mDOCOL
.word lit,XSQUOTE,COMMA
SQUOTE1 .word CAPS_OFF
.word lit,'"',WORDD ; -- c-addr (= HERE)
;https://forth-standard.org/standard/core/Sq
;C S" -- compile in-line string
FORTHWORDIMM "S\34" ; immediate
-SQUOTE: mDOCOL
+SQUOTE mDOCOL
.word lit,XSQUOTE,COMMA
SQUOTE1 .word lit,'"',WORDD ; -- c-addr (= HERE)
FORTHtoASM
;https://forth-standard.org/standard/core/Dotq
;C ." -- compile string to print
FORTHWORDIMM ".\34" ; immediate
-DOTQUOTE: mDOCOL
+DOTQUOTE mDOCOL
.word SQUOTE
.word lit,TYPE,COMMA,EXIT
; TOIN is the relative displacement into buffer
; 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
+ ADD W,X ;1 W = buf_org X = buf_org + buf_len = buf_end
ADD @S+,W ;2 W = buf_org + >IN = buf_ptr X = buf_end
MOV @S,Y ;2 -- separator W = buf_ptr X = buf_end Y = HERE, as dst_ptr
SKIPCHARLOO CMP W,X ;1 buf_ptr = buf_end ?
MOV.B Y,0(TOS) ;3
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
; VOCLOOP : 12/18 cycles,
; WORDFOUND to end : 21 cycles.
; 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
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
ADDC #0,X ;1
MOV X,S ;1 S=aligned CFA
MOV @PSP+,TOS
mNEXT
- .IFDEF MPY
+ .IFDEF HRDWMPY
;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
-
FORTHWORD ">NUMBER" ; 23 cycles + 32/34 cycles DEC/HEX char loop
-TONUMBER: MOV @PSP+,S ;2 S = adr
+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
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" ?
+DDIGITQ SUB.B #30h,W ;2 skip all chars < '0'
+ CMP.B #10,W ;2 char was U< "10" ?
JLO DDIGITQNEXT ;2 no
SUB.B #7,W ;2 skip all chars between "9" and "A"
+ CMP.B #10,W ;2
+ JLO TONUMEND ;2
DDIGITQNEXT CMP T,W ;1 digit-base
- JHS TONUMEND ;2 -- ud1lo ud1hi adr count abort
+ JHS TONUMEND ;2 -- ud1lo ud1hi adr count abort if < 0 or >= base
MOV X,&MPY32L ;3 Load 1st operand (ud1lo)
MOV Y,&MPY32H ;3 Load 1st operand (ud1hi)
MOV T,&OP2 ;3 Load 2nd operand with BASE
MOV &RES1,Y ;3 hi result in Y (ud2hi)
ADD W,X ;1 ud2lo + digit
ADDC #0,Y ;1 ud2hi + carry
- ADD #1,S ;1 -- ud1lo ud1hi adr count S=adr+1
+TONUMPLUS ADD #1,S ;1 -- ud1lo ud1hi adr count S=adr+1
SUB #1,TOS ;1 -- ud1lo ud1hi adr count-1
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
+ MOV X,4(PSP) ;3 -- ud2lo ud1hi adr count2
mNEXT ;4 38 words
+; ?NUMBER makes the interface between >NUMBER and INTERPRET; it's a subset of INTERPRET.
; convert a string to a signed number; FORTH 2012 prefixes $, %, # are recognized
-; 32 bits numbers (with decimal point) are recognized
+; 32 bits numbers (with decimal point) and fixed point signed numbers (with a comma) are recognized.
+; prefixes # % $ - are processed before calling >NUMBER
+; not convertible chars '.' (double) and ',' (fixed point) are processed as >NUMBER exits
;Z ?NUMBER c-addr -- n -1 if convert ok ; flag Z=0
;Z c-addr -- c-addr 0 if convert ko ; flag Z=1
-
-; FORTHWORD "?NUMBER"
-QNUMBER: PUSH #0 ;3 -- c-addr
- PUSH IP ;3
- MOV &BASE,T ;3 T=BASE
- PUSH T ;3 R-- sign IP base
-; ----------------------------------;
-; 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
- 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
- CMP.B @S+,W ;2 DP found ?
- 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
+QNUMBER MOV #0,S ;1
+ MOV &BASE,T ;3 T=BASE
+ BIC #UF9,SR ;2 reset flag UF9, before use as decimal point flag
+ .word 152Dh ;5 R-- IP sign base
+ 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 save TOS and make room for >NUMBER
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,W ;2 W=char
- CMP.B #'-',W ;2
- JHS QSIGN ;2 speed up for not prefixed numbers
-QHEXA MOV #16,T ;2 BASE = 16
- SUB.B #'$',W ;2 = 0 ==> "$" : hex number ?
+ MOV TOS,S ;1 S=addrr
+ MOV.B @S+,TOS ;2 -- c-addr x x x cnt TOS=count
+ MOV.B @S,W ;2 W=char
+ SUB.B #',',W ;2
+ JHS QSIGN ;2 for current base, and for ',' or '.' process
+ SUB.B #1,W ;1
+QBINARY MOV #2,T ;3 preset base 2
+ ADD.B #8,W ;1 '%' + 8 = '-' binary number ?
JZ PREFIXED ;2
-QBINARY MOV #2,T ;1 BASE = 2
- SUB.B #1,W ;1 "%" - "$" - 1 = 0 ==> '%' : bin number ?
+QDECIMAL ADD #8,T ;4
+ ADD.B #2,W ;1 '#' + 2 = '%' decimal number ?
JZ PREFIXED ;2
-QDECIMAL ADD #8,T ;1 BASE = 10
- ADD.B #2,W ;1 "#" - "%" + 2 = 0 ==> '#' : decimal number ?
- 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
- CMP.B #'-',W ;2
-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
- JMP TONUMLOOP ;15 + 32/34 cycles DEC/HEX char loop
-; ----------------------------------;
+QHEXA MOV #16,T ;4
+ SUB.B #1,W ;2 '$' - 1 = '#' hex number ?
+ JNZ TONUMLOOP ;2 -- c-addr ud=0 x x other cases will cause error
+PREFIXED ADD #1,S ;1
+ SUB #1,TOS ;1 -- c-addr ud=0 x count S=adr+1 TOS=count-1
+ MOV.B @S,W ;2 X=2th char, W=adr
+ SUB.B #',',W ;2
+QSIGN CMP.B #1,W ;1
+ JNZ TONUMLOOP ;2 for positive number and for , or . process
+ MOV #-1,2(RSP) ;3 R-- IP sign base
+ JMP TONUMPLUS ;2
+; ----------------------------------; 39
+QNUMNEXT FORTHtoASM ; -- c-addr ud2lo-hi addr2 cnt2 R-- IP sign BASE S=addr2
+ CMP #0,TOS ;1 cnt2=0 : conversion is ok ?
+ JZ QNUMNEXT1 ;2 yes
+ BIS #UF9,SR ;2 set double number flag
+
+ .IFDEF FIXPOINT_INPUT
+
+QQNUMDP CMP.B #'.',0(S) ;4 rejected char by >NUMBER = decimal point ?
+ JNZ QQcomma ;2 no
+ SUB #2,IP ;1 yes: set QNUMNEXT address as >NUMBER return
+ JMP TONUMPLUS ;2 loop back to >NUMBER to terminate conversion
+QQcomma CMP.B #',',0(S) ;5 rejected char by >NUMBER is a comma ?
+ JNZ QNUMNEXT1 ;2 no
+S15Q16 MOV TOS,W ;1 -- c-addr ud2lo x x x yes W=cnt2
+ MOV #0,X ;1 -- c-addr ud2lo x 0 x init X = ud2lo' = 0
+S15Q16LOOP MOV X,2(PSP) ;3 -- c-addr ud2lo ud2lo' ud2lo' x 0(PSP) = ud2lo'
+ SUB.B #1,W ;1 decrement cnt2
+ MOV W,X ;1 X = cnt2-1
+ ADD S,X ;1 X = end_of_string-1, first...
+ MOV.B @X,X ;2 X = last char of string, first...
+ SUB #30h,X ;2 char --> digit conversion
+ CMP.B #10,X ;2
+ JLO QS15Q16DIGI ;2
+ SUB.B #7,X ;2
+ CMP.B #10,X ;2
+ JLO S15Q16EOC ;2
+QS15Q16DIGI CMP T,X ;1 R-- IP sign BASE is X a digit ?
+ JHS S15Q16EOC ;2 -- c-addr ud2lo ud2lo' x ud2lo' if no
+ MOV X,0(PSP) ;3 -- c-addr ud2lo ud2lo' digit x
+ MOV T,TOS ;1 -- c-addr ud2lo ud2lo' digit base R-- IP sign base
+ .word 152Ch ;6 PUSH S,T,W: R-- IP sign base addr2 base cnt2
+ CALL #MUSMOD ;4 -- c-addr ud2lo ur uqlo uqhi
+ .word 172Ah ;6 restore W,T,S: R-- IP sign BASE
+ JMP S15Q16LOOP ;2 W=cnt
+S15Q16EOC MOV 4(PSP),2(PSP) ;5 -- c-addr ud2lo ud2hi uqlo x ud2lo from >NUMBER part1 becomes here ud2hi=S15 part2
+ MOV @PSP,4(PSP) ;4 -- c-addr ud2lo ud2hi x x uqlo becomes ud2lo
+ MOV W,TOS ;1 -- c-addr ud2lo ud2hi x cnt2
+ CMP.B #0,TOS ;1 TOS = 0 if end of conversion char = ',' (happy end)
+
+ .ELSE ; no FIXPOINT_INPUT
+
+QQNUMDP CMP.B #'.',0(S) ;4 rejected char by >NUMBER = decimal point ?
+ JNZ QNUMNEXT1 ;2 no
+ SUB #2,IP ;1 yes: set QNUMNEXT address as >NUMBER return
+ JMP TONUMPLUS ;2 loop back to >NUMBER to terminate conversion
-; ----------------------------------;
-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 ?
- .word 0172Ch ;4 -- c-addr ud2lo ud2hi sign POPM S,IP,TOS; TOS = sign flag = {-1;0}
- 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 69
-; ----------------------------------;
-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 !!!
+ .ENDIF
+
+; ----------------------------------;88
+QNUMNEXT1 .word 0172Bh ;4 -- c-addr ud2lo-hi x cnt2 POPM T,S,IP S = sign flag = {-1;0}
+ MOV S,TOS ;1 -- c-addr ud2lo-hi x sign
+ MOV T,&BASE ;3
+ JZ QNUMOK ;2 -- c-addr ud2lo-hi x sign conversion OK
+QNUMKO ADD #6,PSP ;1 -- c-addr sign
+ AND #0,TOS ;1 -- c-addr ff TOS=0 and Z=1 ==> conversion ko
+ mNEXT ;4
+; ----------------------------------;97
+QNUMOK ADD #2,PSP ;1 -- c-addr ud2lo-hi cnt2
+ MOV 2(PSP),4(PSP) ; -- udlo udlo udhi sign
+ MOV @PSP+,0(PSP) ;4 -- udlo udhi sign note : PSP is incremented before write back !!!
XOR #-1,TOS ;1 -- udlo udhi inv(sign)
JNZ QDOUBLE ;2 if jump : TOS=-1 and Z=0 ==> conversion ok
Q2NEGATE XOR #-1,TOS ;1 -- udlo udhi tf
XOR #-1,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
-; ----------------------------------;
+QDOUBLE BIT #UF9,SR ;2 decimal point added ?
+ JNZ QNUMEND ;2 leave double
+ ADD #2,PSP ;1 leave number
+QNUMEND mNEXT ;4 TOS=-1 and Z=0 ==> conversion ok
+; ----------------------------------;119 words
- .ELSE ; no hardware MPY
+ .ELSE ; no hardware HRDWMPY
; 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 ;2 MDlo
- MOV #0,W ;1 MDhi=0
- MOV #0,Y ;1 RES0=0
- MOV #0,T ;1 RES1=0
- MOV #1,X ;1 BIT TEST REGISTER
-UMSTARLOOP BIT X,TOS ;1 TEST ACTUAL BIT MRlo
+UMSTAR MOV @PSP,S ;2 MDlo
+UMSTAR1 MOV #0,T ;1 MDhi=0
+ MOV #0,X ;1 RES0=0
+ MOV #0,Y ;1 RES1=0
+ MOV #1,W ;1 BIT TEST REGISTER
+UMSTARLOOP BIT W,TOS ;1 TEST ACTUAL BIT MRlo
JZ UMSTARNEXT ;2 IF 0: DO NOTHING
- ADD S,Y ;1 IF 1: ADD MDlo TO RES0
- ADDC W,T ;1 ADDC MDhi TO RES1
+ ADD S,X ;1 IF 1: ADD MDlo TO RES0
+ ADDC T,Y ;1 ADDC MDhi TO RES1
UMSTARNEXT ADD S,S ;1 (RLA LSBs) MDlo x 2
- ADDC W,W ;1 (RLC MSBs) MDhi x2
- ADD X,X ;1 (RLA) NEXT BIT TO TEST
+ ADDC T,T ;1 (RLC MSBs) MDhi x 2
+ ADD W,W ;1 (RLA) NEXT BIT TO TEST
JNC UMSTARLOOP ;2 IF BIT IN CARRY: FINISHED 10~ loop
- MOV Y,0(PSP) ;3 low result on stack
- MOV T,TOS ;1 high result in TOS
- mNEXT
+ MOV X,0(PSP) ;3 low result on stack
+ MOV Y,TOS ;1 high result in TOS
+ mNEXT ;4 17 words
;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
FORTHWORD ">NUMBER"
-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" ?
- JLO DDIGITQNEXT ; -- ud1lo ud1hi adr count no
- SUB.B #07h,S ; S=digit
-DDIGITQNEXT CMP &BASE,S ; -- ud1lo ud1hi adr count digit-base
+TONUMBER MOV @PSP,S ; S=adr
+ MOV TOS,T ; T=count
+TONUMLOOP MOV.B @S,X ; -- ud1lo ud1hi x x X=char
+DDIGITQ SUB.B #30h,X ;2 skip all chars < '0'
+ CMP.B #10,X ; char was > "9" ?
+ JLO DDIGITQNEXT ; -- ud1lo ud1hi x x no
+ SUB.B #07,X ;2 skip all chars between "9" and "A"
+ CMP.B #10,X ;2
+ JLO TONUMEND ;2
+DDIGITQNEXT CMP &BASE,X ; -- ud1lo ud1hi x x digit-base
JHS TONUMEND ; U>=
-UDSTAR .word 152Eh ; -- ud1lo ud1hi adr count PUSHM TOS,IP,S (2+1 push,TOS=Eh)
- SUB #2,PSP ; -- ud1lo ud1hi adr x count
- MOV 4(PSP),0(PSP) ; -- ud1lo ud1hi adr ud1hi count
- MOV &BASE,TOS ; -- ud1lo ud1hi adr ud1hi u2=base
+UDSTAR .word 154Dh ; -- ud1lo ud1hi x x R-- IP adr count x digit PSUHM IP,S,T,W,X
+ MOV 2(PSP),S ; -- ud1lo ud1hi x x S=ud1hi
+ MOV &BASE,TOS ; -- ud1lo ud1hi x base
MOV #UMSTARNEXT1,IP ;
-UMSTAR1 JMP UMSTAR ; ud1hi * base ; UMSTAR use S,T,W,X,Y
-UMSTARNEXT1 FORTHtoASM ; -- ud1lo ud1hi adr ud3lo ud3hi
- PUSH @PSP ; r-- count ud3lo
- MOV 6(PSP),0(PSP) ; -- ud1lo ud1hi adr ud1lo ud3hi
- MOV &BASE,TOS ; -- ud1lo ud1hi adr ud1lo u=base
+UMSTARONE JMP UMSTAR1 ; ud1hi * base -- x ud3hi X=ud3lo
+UMSTARNEXT1 FORTHtoASM ; -- ud1lo ud1hi x ud3hi
+ MOV X,2(RSP) ; R-- IP adr count ud3lo digit
+ MOV 4(PSP),S ; -- ud1lo ud1hi x ud3hi S=ud1lo
+ MOV &BASE,TOS ; -- ud1lo ud1hi x base
MOV #UMSTARNEXT2,IP ;
-UMSTAR2 JMP UMSTAR ; ud1lo * base ; UMSTAR use S,T,W,X,Y, and S is free for use
-UMSTARNEXT2 FORTHtoASM ; -- ud1lo ud1hi adr ud2lo ud2hi r-- count IP digit ud3lo
- ADD @RSP+,TOS ; -- ud1lo ud1hi adr ud2lo ud2hi r-- count IP digit add ud3lo to ud2hi
-MPLUS ADD @RSP+,0(PSP) ; -- ud1lo ud1hi adr ud2lo ud2hi Ud2lo + digit
- 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
- SUB #1,TOS ; -- ud2lo ud2hi adr+1 count-1
- JNZ TONUMBER
-TONUMEND mNEXT ; 52 words
+UMSTARTWO JMP UMSTAR1 ; ud1lo * base -- x ud4hi X=ud4lo
+UMSTARNEXT2 FORTHtoASM ; -- ud1lo ud1hi x ud4hi r-- IP adr count ud3lo digit
+ ADD @RSP+,X ; -- ud1lo ud1hi x ud4hi X = ud4lo+digit = ud2lo
+MPLUS ADDC @RSP+,TOS ; -- ud1lo ud1hi x ud2hi TOS = ud4hi+ud3lo+carry = ud2hi
+ MOV X,4(PSP) ; -- ud2lo ud1hi x ud2hi
+ MOV TOS,2(PSP) ; -- ud2lo ud2hi x x R-- IP adr count
+ .word 172Bh ; -- ud2lo ud2hi x x T=count, S=adr POPM T,S,IP
+TONUMPLUS ADD #1,S ;
+ SUB #1,T ;
+ JNZ TONUMLOOP ; -- ud2lo ud2hi x x S=adr+1, T=count-1, X=ud2lo
+TONUMEND MOV S,0(PSP) ; -- ud2lo ud2hi adr2 count2
+ MOV T,TOS ; -- ud2lo ud2hi adr2 count2
+ mNEXT ; 46 words
; convert a string to a signed number
;Z ?NUMBER c-addr -- n -1 if convert ok ; flag Z=0
;Z c-addr -- c-addr 0 if convert ko ; flag Z=1
-; FORTH 2012 prefixes $, %, # are recognized
+; FORTH 2012 prefixes $, %, # are recognised
+; 32 bits numbers (with decimal point) are recognised
+; with FIXPOINT_INPUT switched ON, fixed point signed numbers (with a comma) are recognised.
+; prefixes # % $ - are processed before calling >NUMBER, decimal point and comma are >NUMBER exits
; FORTHWORD "?NUMBER"
-QNUMBER: PUSH #0 ;3 -- c-addr
- PUSH IP ;3
- PUSH &BASE ;3 R-- sign IP base
-; ----------------------------------;
-; decimal point process add-on ;
-; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
+QNUMBER MOV #0,S ;1
+ MOV &BASE,T ;3 T=BASE
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
- MOV TOS,S ;1 S = ptr
- MOV.B #'.',W ;2 W = '.'
-SearchDP CMP S,IP ;1 IP U< S ?
- JLO SearchDPEND ;2
- CMP.B @S+,W ;2 DP found ?
- 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
-; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
+ .word 152Dh ;5 R-- IP sign base
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+,X ;2 X=char
- CMP.B #'-',X ;2
- JHS QSIGN ;2 speed up for not prefixed numbers
-QHEXA SUB.B #'$',X ;2 = 0 ==> "$" : hex number ?
- JNZ QBINARY ;2 -- c-addr ud adr count other cases will cause error
- MOV #16,&BASE ;4
- JMP PREFIXED ;2
-QBINARY SUB.B #1,X ;1 "%" - "$" - 1 = 0 ==> '%' : hex number ?
- JNZ QDECIMAL ;2
- MOV #2,&BASE ;3
- JMP PREFIXED ;2
-QDECIMAL ADD.B #2,X ;1 "#" - "%" + 2 = 0 ==> '#' : decimal number ?
- JNZ TONUMBER ;2 that will perform a conversion error
- MOV #10,&BASE ;4
-PREFIXED MOV W,0(PSP) ;3
- SUB #1,TOS ;1 -- c-addr ud adr+1 count-1
- 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 W,0(PSP) ;3
- SUB #1,TOS ;1 -- c-addr ud adr+1 count-1
- JMP TONUMBER ;2 69
+ MOV #0,2(PSP) ;3 -- c-addr ud=0 x c-addr
+ MOV TOS,S ;1
+ MOV.B @S+,T ;2 -- c-addr ud=0 x x S=adr, T=count
+ MOV.B @S,X ;2 X=char
+ SUB.B #',',X ;2
+ JHS QSIGN ;2 for current base, and for ',' or '.' process
+ SUB.B #1,X ;1
+QBINARY MOV #2,&BASE ;3 preset base 2
+ ADD.B #8,X ;1 '%' + 8 = '-' binary number ?
+ JZ PREFIXED ;2
+QDECIMAL ADD #8,&BASE ;4
+ ADD.B #2,X ;1 '#' + 2 = '%' decimal number ?
+ JZ PREFIXED ;2
+QHEXA MOV #16,&BASE ;4
+ SUB.B #1,X ;2 '$' - 1 = '#' hex number ?
+ JNZ TONUMLOOP ;2 -- c-addr ud=0 x x other cases will cause error
+PREFIXED ADD #1,S ;1
+ SUB #1,T ;1 -- c-addr ud=0 x x S=adr+1 T=count-1
+ MOV.B @S,X ;2 X=2th char, W=adr
+ SUB.B #',',X ;2
+QSIGN CMP.B #1,X ;1
+ JNZ TONUMLOOP ;2 for positive number and for , or . process
+ MOV #-1,2(RSP) ;3 R-- IP sign base
+ JMP TONUMPLUS ;2
+; ----------------------------------;45
+QNUMNEXT FORTHtoASM ; -- c-addr ud2lo-hi addr2 cnt2 R-- IP sign BASE S=addr2,T=cnt2
+ CMP #0,TOS ;1 cnt2=0 ? conversion is ok ?
+ JZ QNUMNEXT1 ;2 yes
+ BIS #UF9,SR ;2 set double number flag
+
+ .IFDEF FIXPOINT_INPUT
+
+QNUMDP CMP.B #'.',0(S) ;4 rejected char by >NUMBER is a decimal point ?
+ JNZ QS15Q16 ;2 no
+QNUMDPFOUND SUB #2,IP ;1 set >NUMBER return address
+ JMP TONUMPLUS ;2 to terminate conversion
+QS15Q16 CMP.B #',',0(S) ;5 rejected char by >NUMBER is a comma ?
+ JNZ QNUMNEXT1 ;2 no
; ----------------------------------;
+S15Q16 MOV T,W ;1 -- c-addr ud2lo x x x W=cnt2
+ MOV &BASE,T ;3 T=current base
+ MOV #0,X ;1 -- c-addr ud2lo x 0 x init ud2lo' = 0
+S15Q16LOOP MOV X,2(PSP) ;3 -- c-addr ud2lo ud2lo' ud2lo' x X = 0(PSP) = ud2lo'
+ SUB.B #1,W ;1 decrement cnt2
+ MOV W,X ;1 X = cnt2-1
+ ADD S,X ;1 X = end_of_string-1, first...
+ MOV.B @X,X ;2 X = last char of string, first...
+ SUB #30h,X ;2 char --> digit conversion
+ CMP.B #10,X ;2
+ JLO QS15Q16DIGI ;2
+ SUB.B #7,X ;2
+ CMP.B #10,X ;2
+ JLO S15Q16EOC ;2
+QS15Q16DIGI CMP T,X ;1 R-- IP sign BASE is X a digit ?
+ JHS S15Q16EOC ;2 -- c-addr ud2lo ud2lo' x ud2lo' if no
+ MOV X,0(PSP) ;3 -- c-addr ud2lo ud2lo' digit x
+ MOV T,TOS ;1 -- c-addr ud2lo ud2lo' digit base R-- IP sign base
+ .word 152Ch ;6 PUSH S,T,W: R-- IP sign base addr2 base cnt2
+ CALL #MUSMOD ;4 -- c-addr ud2lo ur uqlo uqhi
+ .word 172Ah ;6 restore W,T,S: R-- IP sign BASE
+ JMP S15Q16LOOP ;2 W=cnt
+S15Q16EOC MOV 4(PSP),2(PSP) ;5 -- c-addr ud2lo ud2lo uqlo x ud2lo from >NUMBER part1 becomes here ud2hi=S15 part2
+ MOV @PSP,4(PSP) ;4 -- c-addr ud2lo ud2hi x x uqlo becomes ud2lo
+ MOV W,TOS ;1 -- c-addr ud2lo ud2hi x cnt2
+ CMP.B #0,TOS ;1 TOS = 0 if end of conversion char = ',' (happy end)
+
+ .ELSE ; no FIXPOINT_INPUT
+
+QNUMDP CMP.B #'.',0(S) ;4 rejected char by >NUMBER is a decimal point ?
+ JNZ QNUMNEXT1 ;2 no
+QNUMDPFOUND SUB #2,IP ;1 set >NUMBER return address
+ JMP TONUMPLUS ;2 to terminate conversion
-; ----------------------------------;
-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 ?
- .word 0172Ch ;4 -- c-addr ud2lo ud2hi sign POPM S,IP,TOS; TOS = sign flag = {-1;0}
- 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
+ .ENDIF
+
+; ----------------------------------;97
+QNUMNEXT1 .word 0172Bh ;4 -- c-addr ud2lo-hi x cnt2 POPM T,S,IP S = sign flag = {-1;0}
+ MOV S,TOS ;1 -- c-addr ud2lo-hi x sign
+ MOV T,&BASE ;3
+ JZ QNUMOK ;2 -- c-addr ud2lo-hi x sign conversion OK
+QNUMKO ADD #6,PSP ;1 -- c-addr sign
+ AND #0,TOS ;1 -- c-addr ff TOS=0 and Z=1 ==> conversion ko
mNEXT ;4
; ----------------------------------;
-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 !!!
+QNUMOK ADD #2,PSP ;1 -- c-addr ud2lo-hi sign
+ MOV 2(PSP),4(PSP) ; -- udlo udlo udhi sign
+ MOV @PSP+,0(PSP) ;4 -- udlo udhi sign note : PSP is incremented before write back !!!
XOR #-1,TOS ;1 -- udlo udhi inv(sign)
- JNZ QDOUBLE ;2 if jump : TOS=-1 and Z=0 ==> conversion ok
+ 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
-; ----------------------------------;
+ JNZ QNUMEND ;2 leave double
+ ADD #2,PSP ;1 leave number
+QNUMEND mNEXT ;4 TOS=-1 and Z=0 ==> conversion ok
+; ----------------------------------;128 words
- .ENDIF ; MPY
+ .ENDIF ; HRDWMPY
;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
;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)
+; (n|d) -- append double numeric literal if compiling state and if UF9<>0 (not ANS)
FORTHWORDIMM "LITERAL" ; immediate
-LITERAL: CMP #0,&STATE ;3
+LITERAL CMP #0,&STATE ;3
JZ LITERALEND ;2
LITERAL1 MOV &DDP,W ;3
ADD #4,&DDP ;3
;https://forth-standard.org/standard/core/COUNT
;C COUNT c-addr1 -- adr len counted->adr/len
FORTHWORD "COUNT"
-COUNT: SUB #2,PSP ;1
+COUNT SUB #2,PSP ;1
ADD #1,TOS ;1
MOV TOS,0(PSP) ;3
MOV.B -1(TOS),TOS ;3
;C INTERPRET i*x addr u -- j*x interpret given buffer
; This is the common factor of EVALUATE and QUIT.
-; Absent from forth 2012
-; set addr, u as input buffer then parse it word by word
+; 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
+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 ;
FORTHtoASM ;
MOV #INTFINDNEXT,IP ;2 define INTFINDNEXT as FIND return
JNZ FIND ;2 if EOL not reached
- MOV @RSP+,IP ; -- c-addr
MOV @PSP+,TOS ; -- else EOL is reached
+ MOV @RSP+,IP ; --
mNEXT ; return to QUIT on EOL
INTFINDNEXT FORTHtoASM ; -- c-addr fl Z = not found
MOV #INTLOOP,IP ;2 define (EXECUTE | COMMA) return
XOR &STATE,W ;3
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
+ JNZ EXECUTE ;2 c-addr -- if W xor STATE <>0 execute xt then loop back to INTLOOP
-INTQNUMNEXT FORTHtoASM ; -- n|c-addr fl Z = not a number, UF9 = double number request
+INTQNUMNEXT FORTHtoASM ; -- n|c-addr fl Z = not a number, SR(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
NotFoundExe ADD.B #1,0(TOS) ;3 c-addr -- Not a Number : incr string count to add '?'
MOV.B @TOS,Y ;2
ADD TOS,Y ;1
- MOV.B #'?',0(Y) ;5 add '?' to end of word
+ MOV.B #'?',0(Y) ;5 add '?' to end of word string
MOV #FQABORTYES,IP ;2 define COUNT return
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 ;2
+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
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
- MOV #LSTACK,&LEAVEPTR
- MOV #0,&STATE
-
- .IFDEF SD_CARD_LOADER
+ .IFDEF SD_CARD_LOADER
.IFDEF CONDCOMP
.IFDEF BOOTLOADER
+BOOTLOAD
+ .ENDIF
+ .ENDIF
+ .ENDIF
+
+
+ .IFDEF BOOTLOAD ; IF BOOTLOADER
+;c BOOT -- jump to bootstrap then continues with (QUIT)
+ FORTHWORD "BOOT"
+BOOT MOV #RSTACK,RSP
+ MOV #LSTACK,&LEAVEPTR
+ MOV #0,&STATE
; ----------------------------------;
; 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
+ 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!
+ SUB #2,PSP ;
+ MOV TOS,0(PSP) ;
+ MOV &SAVE_SYSRSTIV,TOS ;
+ MOV #0,&SAVE_SYSRSTIV ;
+ ASMtoFORTH ;
+ .IFDEF QUIETBOOT
+ .word NOECHO ; warning ! your BOOT.4TH must to be finished with ECHO command!
+ .ENDIF
.word XSQUOTE ; -- addr u
.byte 15,"LOAD\34 BOOT.4TH\34" ; issues error 2 if no such file...
.word BRAN,QUIT4 ;
; ----------------------------------;
- .ENDIF
- .ENDIF
- .ENDIF
+;https://forth-standard.org/standard/core/QUIT
+;c QUIT -- interpret line by line the input stream, but may be redirected as here:
+ FORTHWORD "QUIT"
+QUIT MOV @PC+,PC
+ .word BOOT
+
+ FORTHWORD "(QUIT)"
+PARENQUIT
+
+ .ELSE ; no BOOTLOADER
+;https://forth-standard.org/standard/core/QUIT
+;c QUIT -- interpret line by line the input stream
+ FORTHWORD "QUIT"
+QUIT
+
+ .ENDIF
+ MOV #RSTACK,RSP
+ MOV #LSTACK,&LEAVEPTR
+ MOV #0,&STATE
QUIT0 MOV #0,&SAVE_SYSRSTIV ;
ASMtoFORTH
QUIT1 .word XSQUOTE
- .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
+ .byte 5,13,10,"ok " ; CR+LF + Forth prompt
+QUIT2 .word TYPE ; display it
+REFILL .word FCIB,DUP,CPL ; -- Org Org size
+ .word ACCEPT ; -- Org len (len <= size)
+QUIT3 .word SPACE
QUIT4 .word INTERPRET
.word DEPTH,ZEROLESS
.word XSQUOTE
.word FSTATE,FETCH
.word QBRAN,QUIT1 ; case of interpretion state
.word XSQUOTE ; case of compilation state
- .byte 3,13,32,32 ; CR + 2 blanks
+ .byte 5,13,10," " ; CR+LF + 3 blanks
.word BRAN,QUIT2
+
+
+
+WIP_DEFER
+ MOV #PARENWARM,&WARM+2 ; reset all FACTORY defered words
+ MOV #PARENSLEEP,&SLEEP+2
+; common part for QABORT and WIPE
+QAB_DEFER MOV #PARENEMIT,&EMIT+2 ;4 always restore default console output
+ MOV #PARENCR,&CR+2 ;4 and CR to CR EMIT
+ MOV #PARENKEY,&KEY+2 ;4
+ .IFDEF SD_CARD_LOADER
+ MOV #PARENACCEPT,&ACCEPT+2 ;4 always restore default console input
+ MOV #TIB_ORG,&FCIB+2 ;4 TIB is the Current Input Buffer
+ .ENDIF
+ .IFDEF MSP430ASSEMBLER ; reset all branch labels
+ MOV #0,&CLRBW1 ;3
+ MOV #0,&CLRBW2 ;3
+ MOV #0,&CLRBW3 ;3
+ MOV #0,&CLRFW1 ;3
+ MOV #0,&CLRFW2 ;3
+ MOV #0,&CLRFW3 ;3
+ .ENDIF
+ MOV #10,&BASE ;4
+ RET
+
;https://forth-standard.org/standard/core/ABORT
;C ABORT i*x -- R: j*x -- clear stack & QUIT
FORTHWORD "ABORT"
-ABORT: MOV #PSTACK,PSP
+ABORT MOV #PSTACK,PSP
JMP QUIT
RefillUSBtime .equ int(frequency*2730) ; 2730*frequency ==> word size max value @ 24 MHz
;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 ; -- c-addr u restore default YEMIT = set ECHO
+QABORTYES ; MOV @PSP+,0(PSP) ; -- c-addr u
+ MOV #4882h,&YEMIT ; restore default YEMIT = set ECHO
.IFDEF SD_CARD_LOADER ; close all handles
MOV &CurrentHdl,T
QABORTCLOSE CMP #0,T
- JZ QABORTYESNOECHO
+ JZ QABORTCLOSEND
MOV.B #0,HDLB_Token(T)
MOV @T,T
JMP QABORTCLOSE
+QABORTCLOSEND
+
.ENDIF
; ----------------------------------;
QABORTYESNOECHO ; <== WARM jumps here, thus, if NOECHO, TERMINAL can be disconnected without freezing the app
; ----------------------------------;
QABORTTERM ; wait the end of source file downloading
; ----------------------------------;
- .IFDEF TERMINALXONXOFF ;
+ .IFDEF TERMINAL3WIRES ;
BIT #UCTXIFG,&TERMIFG ; TX buffer empty ?
JZ QABORTTERM ; no
MOV #17,&TERMTXBUF ; yes move XON char into TX_buf
.ENDIF ;
- .IFDEF TERMINALCTSRTS ;
+ .IFDEF TERMINAL4WIRES ;
BIC.B #RTS,&HANDSHAKOUT ; set /RTS low (connected to /CTS pin of UARTtoUSB bridge)
.ENDIF ;
QABORTLOOP BIC #UCRXIFG,&TERMIFG ; reset TERMIFG(UCRXIFG)
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 ;
+; Display WARM/ABORT message ; no, the input stream is quiet (end of download source file)
; ----------------------------------;
- mDOCOL ; no, the input stream is quiet (end of download source file)
+ mDOCOL ;
.word XSQUOTE ; -- c-addr u c-addr1 u1
.byte 4,27,"[7m" ;
.word TYPE ; -- c-addr u set reverse video
+
+ .word FLINE,FETCH,QDUP; if LINE <> 0
+ .word QBRAN,ERRLINE_END
+ .word XSQUOTE ; displays the line where error occured
+ .byte 5,"line:" ;
+ .word TYPE ;
+ .word lit,1,MINUS,UDOT;
+ .word ECHO ; to clear LINE
+ERRLINE_END ;
.word TYPE ; -- type abort message
.word XSQUOTE ; -- c-addr2 u2
.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
+; ----------------------------------;
+; remove words from PWR_HERE ;
+; ----------------------------------;
+ .word PWR_STATE ;
+; ----------------------------------;
.IFDEF LOWERCASE
.word CAPS_ON ;
.ENDIF
;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
-
;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
; \ -- 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
;-------------------------------------------------------------------------------
;https://forth-standard.org/standard/core/Bracket
;C [ -- enter interpretative state
FORTHWORDIMM "[" ; immediate
-LEFTBRACKET: MOV #0,&STATE
+LEFTBRACKET MOV #0,&STATE
mNEXT
;https://forth-standard.org/standard/core/right-bracket
;C ] -- enter compiling state
FORTHWORD "]"
-RIGHTBRACKET: MOV #-1,&STATE
+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
+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]
+DEFERSTORE MOV @PSP+,2(TOS) ; -- CFA_DEFER xt --> [CFA_DEFER+2]
MOV @PSP+,TOS ; --
mNEXT
; 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
+; KEY, EMIT, CR, ACCEPT and WARM are examples of DEFERred words
; as IS replaces the PFA value of a "PFA word", it may be also used with VARIABLE and CONSTANT words...
FORTHWORDIMM "IS" ; immediate
-IS: mDOCOL
+IS mDOCOL
.word FSTATE,FETCH
.word QBRAN,IS_EXEC
IS_COMPILE .word BRACTICK ; find the word, compile its CFA as literal
;https://forth-standard.org/standard/core/IMMEDIATE
;C IMMEDIATE -- make last definition immediate
FORTHWORD "IMMEDIATE"
-IMMEDIATE: MOV &LAST_NFA,W
+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 ;
+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
+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
+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 :
+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
; HEADER create an header for a new word. Max count of chars = 126
; common code for VARIABLE, CONSTANT, CREATE, DEFER, :, MARKER, CODE, ASM.
; don't link created word in vocabulary.
-HEADER: mDOCOL
+HEADER mDOCOL
.word CELLPLUSALIGN ; ALIGN then make room for LFA
.word FBLANK,WORDD ;
FORTHtoASM ; -- HERE HERE is the NFA of this new word
;https://forth-standard.org/standard/core/VARIABLE
;C VARIABLE <name> -- define a Forth VARIABLE
FORTHWORD "VARIABLE"
-VARIABLE: CALL #HEADER ; W = DDP = CFA + 2 words
+VARIABLE CALL #HEADER ; W = DDP = CFA + 2 words
MOV #DOVAR,-4(W) ; CFA = DOVAR
JMP REVEAL ; PFA = undefined
;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 = CFA + 2 words
+CONSTANT CALL #HEADER ; W = DDP = CFA + 2 words
MOV #DOCON,-4(W) ; CFA = DOCON
MOV TOS,-2(W) ; PFA = n
MOV @PSP+,TOS
;;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.
;
+; FORTHWORD "VALUE" ; is an alias of CONSTANT
+; JMP CONSTANT
+;
;;TO name Run-time: ( x -- )
;;Assign the value x to name.
;
-; FORTHWORD "VALUE"
-; JMP CONSTANT
-;
-; FORTHWORDIMM "TO"
+; FORTHWORDIMM "TO" ; is an alias of IS
; JMP IS
; 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
+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) ; replace old CFA (DOCON) by new CFA (DODOES)
- MOV IP,2(W) ; replace old PFA by the address after DOES> as execution address
+DOES MOV &LAST_CFA,W ; W = CFA of CREATEd word
+ MOV #DODOES,0(W) ; replace CFA (DOCON) by new CFA (DODOES)
+ MOV IP,2(W) ; replace PFA by the address after DOES> as execution address
MOV @RSP+,IP ; exit of the new created word
NEXTADR mNEXT
;until the phrase ' word IS name is executed, causing a new value of xt to be assigned to name.
FORTHWORD "DEFER"
-DEFER: CALL #HEADER
+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
;https://forth-standard.org/standard/core/Colon
;C : <name> -- begin a colon definition
FORTHWORD ":"
- COLON: CALL #HEADER
-
+ COLON: CALL #HEADER
.SWITCH DTC
.CASE 1
MOV #DOCOL1,-4(W) ; compile CALL rDOCOL
;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
+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
- .IFDEF CONDCOMP
-;; CORE EXT MARKER
-;;( "<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: ( -- )
-;;Restore all dictionary allocation and search order pointers to the state they had just prior to the
-;;definition of name. Remove the definition of name and all subsequent definitions. Restoration
-;;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
-
-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
+; ------------------------------------------------------------------------------------------
+; forthMSP430FR : CONDITIONNAL COMPILATION
+; ------------------------------------------------------------------------------------------
+ .IFDEF CONDCOMP ; 2- conditionnal compilation part
- 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
+ .include "forthMSP430FR_CONDCOMP.asm"
.ENDIF ; CONDCOMP
;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
ADD #4,&DDP ; compile one word, reserve one word
;https://forth-standard.org/standard/core/ELSE
;C ELSE IFadr -- ELSEadr resolve forward IF branch, leave ELSEadr on stack
FORTHWORDIMM "ELSE" ; immediate
-ELSS: ADD #4,&DDP ; make room to 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]
;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
+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
;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) ;
ADD #2,&DDP ; make room to compile xdo
MOV &DDP,TOS ; -- HERE+2
;https://forth-standard.org/standard/core/LOOP
;C LOOP DOadr -- L-- an an-1 .. a1 0
FORTHWORDIMM "LOOP" ; immediate
-LOO: MOV #xloop,X
+LOO MOV #xloop,X
ENDLOOP ADD #4,&DDP ; make room to compile two words
MOV &DDP,W
MOV X,-4(W) ; xloop --> HERE
;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
;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 #0,W
- JZ MOVE_X
+ JZ MOVE_X ; already made !
CMP X,Y ; Y-X ; dst - src
JZ MOVE_X ; already made !
JC MOVEUP ; U>= if dst > src
ADD W,X
MOVUP1 SUB #1,X
SUB #1,Y
- MOV.B @X,0(Y) ; if X=src < Y=dst copy W bytes up
+MOVUP2 MOV.B @X,0(Y) ; if X=src < Y=dst copy W bytes up
SUB #1,W
JNZ MOVUP1
MOVE_X mNEXT
.IFDEF VOCABULARY_SET
FORTHWORD "VOCABULARY"
-VOCABULARY: mDOCOL
+VOCABULARY mDOCOL
.word CREATE
.SWITCH THREADS
.CASE 1
.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
.word lastforthword30
.word lastforthword31
- .ELSECASE
+ .ELSECASE ; = CASE 1
.ENDCASE
- .word voclink
-voclink .set $-2
+ .word voclink ; voclink = 0
+voclink .set $-2
;X ALSO -- make room to put a vocabulary as first in context
.IFDEF VOCABULARY_SET
FORTHWORD "ALSO"
.ENDIF ; VOCABULARY_SET
-ALSO: MOV #14,W ; -- move up 7 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 ON/OFF AND RESET
;-------------------------------------------------------------------------------
-STATE_DOES
+STATE_DOES ; execution part of PWR_STATE
.IFDEF VOCABULARY_SET
- .word FORTH,ONLY,DEFINITIONS ; doesn't restore search order pointers
+ .word FORTH,ONLY,DEFINITIONS ; sorry, 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
-
+ ; then restore words link(s) with it value < old DP
.SWITCH THREADS
.CASE 1 ; mono thread vocabularies
MARKALLVOC MOV W,Y ; -- OLD_DP W=VLK Y=VLK
MOV @RSP+,IP ;
mNEXT ;
- 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
+ FORTHWORD "PWR_STATE" ; reinitialize dictionary in state defined by PWR_HERE; executed by power 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 "RST_STATE" ; reinitialize dictionary in same state as after <reset>
-RST_STATE: MOV &INIVOC,&MARKVOC ; INI value saved in FRAM
+ FORTHWORD "RST_STATE" ; reinitialize dictionary in state defined by RST_HERE; executed by <reset>
+RST_STATE MOV &INIVOC,&MARKVOC ; INI value saved in FRAM
MOV &INIDP,&MARKDP ; INI value saved in FRAM
JMP PWR_STATE
-
- FORTHWORD "PWR_HERE" ; define dictionary bound for power OFF/ON
-PWR_HERE: MOV &LASTVOC,&MARKVOC
+ FORTHWORD "PWR_HERE" ; define dictionary bound for power ON
+PWR_HERE MOV &LASTVOC,&MARKVOC
MOV &DDP,&MARKDP
mNEXT
- FORTHWORD "RST_HERE" ; define dictionary bound for <reset>
-RST_HERE: MOV &LASTVOC,&INIVOC
+ 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
- .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
- MOV #10,&BASE
-
- RET
+ JMP PWR_HERE ; ...and for power ON
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 !
- ADD #2,X
- CMP #INTVECT,X
- JNZ SIGNLOOP
-
-; reset all FACTORY defered words to allow execution from SD_Card
- CALL #WIPE_DEFER
-; reinit this factory values :
- MOV #ROMDICT,&INIDP
- MOV #lastvoclink,&INIVOC
-; then reinit RST_STATE and PWR_STATE
- 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
+WIPE MOV #SIGNATURES,X ; reset JTAG and BSL signatures ; unlock JTAG, SBW and BSL
+SIGNLOOP MOV #-1,0(X) ; reset signature; WARNING ! DON'T CHANGE THIS IMMEDIATE VALUE !
+ ADD #2,X
+ CMP #INTVECT,X
+ JNZ SIGNLOOP
+ CALL #WIP_DEFER
+ MOV #ROMDICT,&INIDP ; reinit this factory values :
+ MOV #lastvoclink,&INIVOC
+ JMP RST_STATE ; then reinit RST_STATE and PWR_STATE
; ------------------------------------------------------------------------------
; forthMSP430FR : WARM
; 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"
+ .byte 6,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 V162",FREQ," (C) J.M.Thoorens "
+ .byte 39," FastForth V203",FREQ," (C) J.M.Thoorens "
.word TYPE
.word LIT,FRAM_FULL,HERE,MINUS,UDOT
.word XSQUOTE ;
;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 @PC+,PC ;3
+ .word PARENWARM
; ------------------------------------------------------------------------------
; forthMSP430FR : COLD
; reset all interrupt vectors to RESET vector
MOV #RESET,W ; W = reset vector
MOV #INTVECT,X ; interrupt vectors base address
-RESETINT: MOV W,0(X)
+RESETINT MOV W,0(X)
ADD #2,X
JNZ RESETINT ; endloop when X = 0
MOV &INI_TERM,&TERMVEC
MOV #CPUOFF+GIE,&LPM_MODE
+; init RAM
+ MOV #RAMSTART,X
+INITRAM MOV #0,0(X)
+ ADD #2,X
+ CMP #RAMEND,X
+ JLO INITRAM
;-------------------------------------------------------------------------------
; RESET : INIT FORTH machine
;-------------------------------------------------------------------------------
ADD #1,Y ; to display SAVE_SYSRSTIV as negative value
MOV Y,&SAVE_SYSRSTIV
+TERM_INIT
;-------------------------------------------------------------------------------
; RESET : INIT TERM_UART
;-------------------------------------------------------------------------------
-TERM_INIT
MOV #0081h,&TERMCTLW0 ; Configure TERM_UART UCLK = SMCLK
.include "TERMINALBAUDRATE.asm" ; include code to configure baudrate
.ENDIF
;-------------------------------------------------------------------------------
-; UTILITY WORDS OPTION
-;-------------------------------------------------------------------------------
- .IFDEF UTILITY
- .include "ADDON\UTILITY.asm"
- .ENDIF ; UTILITY
-
- .IFDEF SD_CARD_LOADER
-;-------------------------------------------------------------------------------
; SD CARD FAT OPTIONS
;-------------------------------------------------------------------------------
+ .IFDEF SD_CARD_LOADER
.include "forthMSP430FR_SD_LowLvl.asm" ; SD primitives
.include "forthMSP430FR_SD_LOAD.asm" ; SD LOAD driver
+ ;---------------------------------------------------------------------------
+ ; SD CARD READ WRITE
+ ;---------------------------------------------------------------------------
.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
+
+;-------------------------------------------------------------------------------
+; UTILITY WORDS OPTION
+;-------------------------------------------------------------------------------
+ .IFDEF UTILITY
+ .include "ADDON/UTILITY.asm"
+ .ENDIF ; UTILITY
;-------------------------------------------------------------------------------
-; SD TOOLS
+; FIXED POINT OPERATORS OPTION
;-------------------------------------------------------------------------------
- .IFDEF SD_TOOLS
- .include "ADDON\SD_TOOLS.asm"
- .ENDIF ; SD_READ_WRITE_TOOLS
+ .IFDEF FIXPOINT
+ .include "ADDON/FIXPOINT.asm"
+ .ENDIF ; FIXPOINT
+
;-------------------------------------------------------------------------------
- .ENDIF ; SD_CARD_LOADER
+; UART to I2C bridge OPTION
+;-------------------------------------------------------------------------------
+ .IFDEF UARTtoI2C ; redirects TERMINAL on to I2C address
+ .include "ADDON/UART2MI2C.asm"
+ .ENDIF
;-------------------------------------------------------------------------------
+; ADD HERE YOUR PROGRAM TO BE INTEGRATED IN CORE (protected against WIPE)
+;-------------------------------------------------------------------------------
+
+;-------------------------------------------------------------------------------
; IT'S FINISH : RESOLVE ASSEMBLY PTR
;-------------------------------------------------------------------------------
ROMDICT ; init DDP with this current address
OSDN Git Service
