; http://patorjk.com/software/taag/#p=display&f=Banner&t=Fast Forth
; Fast Forth For Texas Instrument MSP430FRxxxx FRAM devices
-; Copyright (C) <2017> <J.M. THOORENS>
+; Copyright (C) <2018> <J.M. THOORENS>
;
; This program is free software: you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; ----------------------------------------------------------------------
; compiled with MACROASSEMBLER AS (http://john.ccac.rwth-aachen.de:8000/as/)
; ----------------------------------------------------------------------
- .cpu MSP430X
- .include "mspregister.mac" ;
-; macexp off ; uncomment to hide macro results
-
-VER .equ "V206"
;-------------------------------------------------------------------------------
; Vingt fois sur le métier remettez votre ouvrage,
;===============================================================================
;===============================================================================
; before assembling or programming you must set TARGET in param1 (SHIFT+F8)
-; according to the TARGET "switched" below
+; according to the selected TARGET below
;===============================================================================
;===============================================================================
+VER .equ "V208" ; FORTH version
+
+ macexp off ; uncomment to hide macro results in forthMSP430FR.lst
+
;-------------------------------------------------------------------------------
-; TARGETS kernel ; sizes are for 8MHz, DTC=2, 3WIRES (XON/XOFF)
+; TARGETS kernel ; sizes are for 8MHz, DTC=1, THREADS=1, 3WIRES (XON/XOFF)
;-------------------------------------------------------------------------------
-; ;INFO + MAIN
-;MSP_EXP430FR5739 ; compile for MSP-EXP430FR5739 launchpad ; 26 + 3974 bytes
-;MSP_EXP430FR5969 ; compile for MSP-EXP430FR5969 launchpad ; 26 + 3962 bytes
-MSP_EXP430FR5994 ;; compile for MSP-EXP430FR5994 launchpad ; 26 + 3980 bytes
-;MSP_EXP430FR6989 ; compile for MSP-EXP430FR6989 launchpad ; 26 + 3990 bytes
-;MSP_EXP430FR4133 ; compile for MSP-EXP430FR4133 launchpad ; 26 + 4024 bytes
-;MSP_EXP430FR2355 ; compile for MSP-EXP430FR2355 launchpad ; 26 + 3956 bytes
-;MSP_EXP430FR2433 ; compile for MSP-EXP430FR2433 launchpad ; 26 + 3942 bytes
-;CHIPSTICK_FR2433 ; compile for the "CHIPSTICK" of M. Ken BOAK ; 26 + 3934 bytes
+;MSP_EXP430FR5739 ; compile for MSP-EXP430FR5739 launchpad ; 24 + 2 + 3876 bytes
+;MSP_EXP430FR5969 ; compile for MSP-EXP430FR5969 launchpad ; 24 + 2 + 3852 bytes
+;MSP_EXP430FR5994 ; compile for MSP-EXP430FR5994 launchpad ; 24 + 2 + 3878 bytes
+;MSP_EXP430FR6989 ; compile for MSP-EXP430FR6989 launchpad ; 24 + 2 + 3888 bytes
+;MSP_EXP430FR4133 ; compile for MSP-EXP430FR4133 launchpad ; 24 + 2 + 3918 bytes
+;MSP_EXP430FR2355 ; compile for MSP-EXP430FR2355 launchpad ; 24 + 2 + 3854 bytes
+;MSP_EXP430FR2433 ; compile for MSP-EXP430FR2433 launchpad ; 24 + 2 + 3840 bytes
+CHIPSTICK_FR2433 ;; compile for the "CHIPSTICK" of M. Ken BOAK ; 24 + 2 + 3840 bytes
-; choose DTC (Direct Threaded Code) model, if you don't know, choose 2
-DTC .equ 2 ; DTC model 1 : DOCOL = CALL rDOCOL 14 cycles 1 word shortest DTC model
+; 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
THREADS .equ 16 ; 1, 2 , 4 , 8 , 16, 32 search entries in dictionnary.
- ; +0, +28, +40, +56, +90, +154 bytes, usefull to speed compilation;
+ ; +0, +42, +54, +70, +104, +168 bytes, usefull to speed up compilation;
; choose 16
-FREQUENCY .equ 16 ; fully tested at 0.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 MHz (+ 24 MHz for MSP430FR57xx,MSP430FR2355)
;-------------------------------------------------------------------------------
; KERNEL ADD-ON SWITCHES
;-------------------------------------------------------------------------------
-MSP430ASSEMBLER ;; + 1814 bytes : adds embedded assembler with TI syntax; without, you can do all but all much more slowly...
-CONDCOMP ;; + 324 bytes : adds conditionnal compilation : MARKER [UNDEFINED] [DEFINED] [IF] [ELSE] [THEN] COMPARE
-FIXPOINT_INPUT ;; + 78 bytes : adds the interpretation input for Q15.16 numbers
-LOWERCASE ;; + 46 bytes : enables to write strings in lowercase.
+CONDCOMP ;; + 320 bytes : adds conditionnal compilation : COMPARE [DEFINED] [UNDEFINED] [IF] [ELSE] [THEN] MARKER
+MSP430ASSEMBLER ;; + 1828/2264 bytes : adds embedded assembler with TI syntax; without, you can do all but all much more slowly...
+NONAME ;; + 54 bytes : adds :NONAME CODENNM (CODENoNaMe)
VOCABULARY_SET ;; + 104 bytes : adds words: VOCABULARY FORTH ASSEMBLER ALSO PREVIOUS ONLY DEFINITIONS (FORTH83)
-SD_CARD_LOADER ;; + 1748 bytes : to LOAD source files from SD_card
-SD_CARD_READ_WRITE ;; + 1192 bytes : to read, create, write and del files + source files direct copy from PC to SD_Card
-NONAME ;; + 64 bytes : adds :NONAME CODENN (CODENoNaMe)
-;BOOTLOADER ; + 72 bytes : adds to <reset> a bootstrap to SD_CARD\BOOT.4TH.
-;QUIETBOOT ; + 2 bytes : to perform bootload without displaying.
-;TOTAL ; + 4 bytes : to save R4 to R7 registers during interrupts.
+DOUBLE_INPUT ;; + 46 bytes : adds the interpretation input for double numbers (dot numbers)
+FIXPOINT_INPUT ;; + 112 bytes : adds the interpretation input for Q15.16 numbers, mandatory for FIXPOINT ADD-ON
+;SD_CARD_LOADER ; + 1748 bytes : to LOAD source files from SD_card
+;SD_CARD_READ_WRITE ; + 1192 bytes : to read, create, write and del files + copy text files from PC to SD_Card
+;BOOTLOADER ; + 72 bytes : includes to <reset> the SD_CARD\BOOT.4TH file as bootloader.
+;QUIETBOOT ; + 2 bytes : to perform bootloader without displaying.
+;TOTAL ; + 4 bytes : to save also R4 to R7 registers during interrupts.
;-------------------------------------------------------------------------------
-; OPTIONAL KERNEL ADD-ON SWITCHES (thatcan be downloaded later) >------------------+
-; Tip: when added here, ADD-ONs become protected against WIPE and Deep Reset... |
-;------------------------------------------------------------------------------- v
-;UARTtoI2C ; to redirect source file to a I2C TERMINAL FastForth device UART2IIC.f
-;FIXPOINT ; + 452 bytes : add Q15.16 words HOLDS F+ F- F/ F* F#S F. S>F 2@ 2CONSTANT FIXPOINT.f
-UTILITY ;; + 426/508 bytes : add .S .RS WORDS U.R DUMP ? UTILITY.f
-SD_TOOLS ;; + 142 bytes for trivial DIR, FAT, CLUSTER and SECTOR view, adds UTILITY SD_TOOLS.f
-;ANS_CORE_COMPLIANT ; + 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+
-
+; OPTIONAL ADD-ON SWITCHES (that can be downloaded later) >-----------------------+
+; when added here, ADD-ONs become protected against WIPE and Deep Reset... |
+;------------------------------------------------------------------------------- v
+;FIXPOINT ; + 422/528 bytes add HOLDS F+ F- F/ F* F#S F. S>F 2@ 2CONSTANT FIXPOINT.f
+UTILITY ;; + 434/524 bytes (1/16threads) : add .S .RS WORDS U.R DUMP ? UTILITY.f
+;SD_TOOLS ; + 142 bytes for trivial DIR, FAT, CLUSTER and SECTOR view, adds UTILITY SD_TOOLS.f
+;ANS_CORE_COMPLEMENT ; + 902 bytes : required to pass coretest.4th ; (includes items below) ANS_COMP.f
;-------------------------------------------------------------------------------
; FAST FORTH TERMINAL configuration
;-------------------------------------------------------------------------------
-
-TERMINALBAUDRATE .equ 5000000 ; choose value considering the frequency and the UART2USB bridge, see explanations below.
- .include "TERMINALBAUDRATE.inc"
-
;HALFDUPLEX ; to use FAST FORTH with half duplex terminal
-
+TERMINALBAUDRATE .equ 115200 ; choose value considering the frequency and the UART2USB bridge, see explanations below.
TERMINAL3WIRES ;; enable 3 wires (GND,TX,RX) with XON/XOFF software flow control (PL2303TA/HXD, CP2102)
-TERMINAL4WIRES ;; + 18 bytes enable 4 wires with hardware flow control on RX with RTS (PL2303TA/HXD, FT232RL)
+TERMINAL4WIRES ;; + 12 bytes enable 4 wires with hardware flow control on RX with RTS (PL2303TA/HXD, FT232RL)
; this RTS pin may be permanently wired on SBWTCK/TEST pin without disturbing SBW 2 wires programming
;TERMINAL5WIRES ; + 6 bytes enable 5 wires with hardware flow control on RX/TX with RTS/CTS (PL2303TA/HXD, FT232RL)...
-; if you uncomment TERMINAL3WIRES, you have a XON/XOFF terminal (software flow control)
-; if you uncomment TERMINAL5WIRES, you have a RTS/CTS terminal (hardware flow control); mandatory option if you also want to perform binary transfers
-; if you uncomment TERMINAL3WIRES + TERMINAL4WIRES, you have a XON/XOFF + RTS terminal; sufficient option to dowload with hardware control flow
-; if you uncomment TERMINAL3WIRES + TERMINAL5WIRES, you have a XON/XOFF + RTS/CTS terminal
+;===============================================================================
+; Software control flow XON/XOFF configuration:
+;===============================================================================
+; Launchpad --- UARTtoUSB device
+; RX <-- TX
+; TX --> RX
+; GND <-> GND
+
+; TERATERM config terminal : NewLine receive : AUTO,
+; NewLine transmit : CR+LF
+; Size : 128 chars x 49 lines (adjust lines to your display)
+
+; TERATERM config serial port : TERMINALBAUDRATE value,
+; 8 bits, no parity, 1 Stop bit,
+; XON/XOFF flow control,
+; delay = 0ms/line, 0ms/char
+; don't forget : save new TERATERM configuration !
; --------------------------------------------------------------------------------------------
; Only two usb2uart bridges correctly handle XON / XOFF: cp2102 and pl2303.
; --------------------------------------------------------------------------------------------
-
-
-
; the best and cheapest: UARTtoUSB cable with Prolific PL2303HXD (or PL2303TA)
-; works wel in 3 WIRES (XON/XOF) and 4WIRES (GND,RX,TX,RTS) config
+; works well in 3 WIRES (XON/XOFF) and 4WIRES (GND,RX,TX,RTS) config
; --------------------------------------------------------------------------------------------
; PL2303TA 4 wires CABLE PL2303HXD 6 wires CABLE
; pads upside: 3V3,txd,rxd,gnd,5V pads upside: gnd, 3V3,txd,rxd,5V
; downside: cts,dcd,dsr,rts,dtr downside: rts,cts
; --------------------------------------------------------------------------------------------
-; WARNING ! if you use PL2303TA/HXD cable as supply, open box before to weld red wire on 3v3 pad !
+; WARNING ! if you use PL2303TA/HXD cable as supply, open the box before to weld red wire on 3v3 pad !
; --------------------------------------------------------------------------------------------
; 9600,19200,38400,57600 (250kHz)
; + 115200,134400 (500kHz)
; + 1843200,2457600 (8MHz,PL2303HXD)
; + 3MBds (16MHz,PL2303TA)
; + 3MBds,4MBds,5MBds (16MHz,PL2303HXD)
-; + 6MBds (MSP430FR57xx family,24MHz)
-
+; + 6MBds (MSP430FR57xx,MSP430FR2355 families,24MHz)
; UARTtoUSB module with Silabs CP2102 (supply current = 20 mA)
; ---------------------------------------------------------------------------------------------------
; + 460800 (2MHz)
; + 921600 (4MHz,8MHz,16MHz,24MHz)
+;===============================================================================
+; Hardware control flow configuration: RTS is wired on UART2USB CTS pin
+;===============================================================================
-; Launchpad --- UARTtoUSB device
+; Launchpad <-> UARTtoUSB
; RX <-- TX
; TX --> RX
+; RTS --> CTS (see launchpad.asm for RTS selected pin)
; GND <-> GND
; TERATERM config terminal : NewLine receive : AUTO,
; TERATERM config serial port : TERMINALBAUDRATE value,
; 8bits, no parity, 1Stopbit,
-; XON/XOFF flow control,
+; Hardware flow control,
; delay = 0ms/line, 0ms/char
; don't forget : save new TERATERM configuration !
-
-;===============================================================================
-; Hardware control flow configuration: RTS is wired on UART2USB CTS pin
-;===============================================================================
-
-; Launchpad <-> UARTtoUSB
-; RX <-- TX
-; TX --> RX
-; RTS --> CTS
-; GND <-> GND
-
-; notice that the control flow seems not necessary for TX (CTS pin)
+; notice that the control flow seems not necessary for TX (CTS <-- RTS)
; UARTtoUSB module with PL2303TA/HXD
; --------------------------------------------------------------------------------------------
-; WARNING ! if you use PL2303HXD cable as supply, open box before to weld red wire on 3v3 pad !
+; WARNING ! if you use PL2303TA/HXD cable as supply, open the box before to weld red wire on 3v3 pad !
; --------------------------------------------------------------------------------------------
; 9600,19200,38400,57600 (250kHz)
; + 115200,134400 (500kHz)
; + 4000000,5000000 (16MHz)
; + 6000000 (24MHz)
-
; UARTtoUSB module with FTDI FT232RL (FT230X don't work correctly)
; ------------------------------------------------------------------------------
; WARNING ! buy a FT232RL module with a switch 5V/3V3 and select 3V3 !
; + 460800 (2MHz)
; + 921600 (4,8,16 MHz)
-; TERATERM config terminal : NewLine receive : AUTO,
-; NewLine transmit : CR+LF
-; Size : 128 chars x 49 lines (adjust lines to your display)
-
-; TERATERM config serial port : TERMINALBAUDRATE value,
-; 8bits, no parity, 1Stopbit,
-; Hardware flow control,
-; delay = 0ms/line, 0ms/char
-
-; don't forget : save new TERATERM configuration !
-
-; ------------------------------------------------------------------------------
-; UARTtoBluetooth 4.2 module (RN4870/RN4871 MIKROE click 2543/2544) at 921600 bds
; ------------------------------------------------------------------------------
; UARTtoBluetooth 2.0 module (RN42 sparkfun bluesmirf) at 921600bds
; ------------------------------------------------------------------------------
; Hardware flow control or software flow control or ...no flow control!
; delay = 0ms/line, 0ms/char
-; in fact, compared to using a UART USB bridge, only the COMx port is to be updated.
; don't forget : save new TERATERM configuration !
+; in fact, compared to using a UART USB bridge, only the COMx port is to be updated.
; ------------------------------------------------------------------------------
- .include "Device.inc" ; to define target config: I/O, memory, SFR, vectors, TERMINAL eUSCI, SD_Card eUSCI, LF_XTAL,
-
- .include "ForthThreads.mac" ; init vocabulary pointers
+ .include "ThingsInFirst.inc" ; to define target config: I/O, memory, SFR, vectors, TERMINAL eUSCI, SD_Card eUSCI, LF_XTAL,
;-------------------------------------------------------------------------------
; DTCforthMSP430FR5xxx RAM memory map:
;-------------------------------------------------------------------------------
+;-------------------------------------
; name words ; comment
-
-;LSTACK = L0 = LEAVEPTR ; ----- RAMSTART
+;-------------------------------------
+;LSTACK = L0 = LEAVEPTR ; ----- RAM_ORG
; |
LSTACK_SIZE .equ 16 ; | grows up
; V
; ^
PSTACK_SIZE .equ 48 ; | grows down
; |
-;PSTACK=S0 ; ----- RAMSTART + $80
+;PSTACK=S0 ; ----- RAM_ORG + $80
; ^
RSTACK_SIZE .equ 48 ; | grows down
; |
-;RSTACK=R0 ; ----- RAMSTART + $E0
+;RSTACK=R0 ; ----- RAM_ORG + $E0
+;-------------------------------------
; names bytes ; comments
-
-;PAD ; ----- RAMSTART + $E4
+;-------------------------------------
+;PAD ; ----- RAM_ORG + $E4
; |
PAD_LEN .equ 84 ; | grows up (ans spec. : PAD >= 84 chars)
; v
-;PAD_END ; ----- RAMSTART + $138
+;PAD_END ; ----- RAM_ORG + $138
;TIB-4 ; TIB_I2CADR
;TIB-2 ; TIB_I2CCNT
-;TIB ; ----- RAMSTART + $13C
+;TIB ; ----- RAM_ORG + $13C
; |
TIB_LEN .equ 84 ; | grows up (ans spec. : TIB >= 80 chars)
; v
-;HOLDS_ORG ; ------RAMSTART + $190
+;HOLDS_ORG ; ------RAM_ORG + $190
; ^
HOLD_SIZE .equ 34 ; | grows down (ans spec. : HOLD_SIZE >= (2*n) + 2 char, with n = 16 bits/cell
; |
-;BASE_HOLD ; ----- RAMSTART + $1B2
+;BASE_HOLD ; ----- RAM_ORG + $1B2
;
; variables system ;
;
- ; ----- RAMSTART + $1E4
+ ; ----- RAM_ORG + $1E4
;
; 24 bytes free
;
-; variables system END ; ----- RAMSTART + $1FC
+; variables system END ; ----- RAM_ORG + $1FC
; SD_BUF_I2CADR
; SD_BUF_I2CCNT
-;SD_BUF ; ----- RAMSTART + $200
+;SD_BUF ; ----- RAM_ORG + $200
;
; 512 bytes buffer
;
- ; ----- RAMSTART + $2FF
-
+ ; ----- RAM_ORG + $2FF
-LSTACK .equ RAMSTART
+LSTACK .equ RAM_ORG
LEAVEPTR .equ LSTACK ; Leave-stack pointer
PSTACK .equ LSTACK+(LSTACK_SIZE*2)+(PSTACK_SIZE*2)
RSTACK .equ PSTACK+(RSTACK_SIZE*2)
BASE_HOLD .equ HOLDS_ORG+HOLD_SIZE
-
; ----------------------------------------------------
-; RAMSTART + $1B2 : RAM VARIABLES
+; RAM_ORG + $1B2 : RAM VARIABLES
; ----------------------------------------------------
-
HP .equ BASE_HOLD ; HOLD ptr
CAPS .equ BASE_HOLD+2
LAST_NFA .equ BASE_HOLD+4 ; NFA, VOC_PFA, CFA, PSP of last created word
CURRENT .equ BASE_HOLD+40 ; CURRENT dictionnary ptr
BASE .equ BASE_HOLD+42
LINE .equ BASE_HOLD+44 ; line in interpretation (initialized by NOECHO)
+
; --------------------------------------------------------------;
-; RAMSTART + $1E0 : free for user after source file compilation ;
+; RAM_ORG + $1E0 : free for user after source file compilation ;
; --------------------------------------------------------------;
SAV_CURRENT .equ BASE_HOLD+46 ; preserve CURRENT during create assembler words
+ASMLABELS
ASMBW1 .equ BASE_HOLD+48
ASMBW2 .equ BASE_HOLD+50
ASMBW3 .equ BASE_HOLD+52
ASMFW1 .equ BASE_HOLD+54
ASMFW2 .equ BASE_HOLD+56
ASMFW3 .equ BASE_HOLD+58
+RPT_WORD .equ BASE_HOLD+60
; ----------------------------------;
-; RAMSTART + $1EE : free for user ;
+; RAM_ORG + $1F0 : free for user ;
; ----------------------------------;
-
; --------------------------------------------------
-; RAMSTART + $1FC : RAM SD_CARD SD_BUF 4 + 512 bytes
+; RAM_ORG + $1FC : RAM SD_CARD SD_BUF 4 + 512 bytes
; --------------------------------------------------
SD_BUF_I2CADR .equ SD_BUF-4
SD_BUF_I2CCNT .equ SD_BUF-2
SD_BUF .equ BASE_HOLD+78
SD_BUFEND .equ SD_BUF + 200h ; 512bytes
-
;-------------------------------------------------------------------------------
-; INFO(DCBA) >= 256 bytes memory map:
+; INFO(DCBA) >= 256 bytes memory map (FRAM) :
;-------------------------------------------------------------------------------
- .org INFOSTART
+ .org INFO_ORG
; --------------------------
; FRAM INFO KERNEL CONSTANTS
; --------------------------
-
INI_THREAD .word THREADS ; used by ADDON_UTILITY.f
TERMBRW_RST .word TERMBRW_INI ; set by TERMINALBAUDRATE.inc
TERMMCTLW_RST .word TERMMCTLW_INI ; set by TERMINALBAUDRATE.inc
FREQ_KHZ .word FREQUENCY*1000 ; user use
.ENDIF
-SAVE_SYSRSTIV .word 05 ; value to identify first start after core recompiling
+SAVE_SYSRSTIV .word 0 ; value to identify first start after core recompiling
LPM_MODE .word CPUOFF+GIE ; LPM0 is the default mode
;LPM_MODE .word CPUOFF+GIE+SCG0 ; LPM1 is the default mode (disable FLL)
INIDP .word ROMDICT ; define RST_STATE
INIVOC .word lastvoclink ; define RST_STATE
-GPFLAGS .word 0 ; always usefull
+FORTHVERSION .word VERSIO ;
+FORTHADDON .word FADDON ;
.word RXON ; user use
.word RXOFF ; user use
+INFO_BASE_END
+
.IFDEF SD_CARD_LOADER
.word ReadSectorWX ; used by ADDON_SD_TOOLS.f
.IFDEF SD_CARD_READ_WRITE
.word WriteSectorWX ; used by ADDON_SD_TOOLS.f
- .ELSEIF
- .word 0
.ENDIF ; SD_CARD_READ_WRITE
- .ELSEIF
- .word 0,0
.ENDIF ; SD_CARD_LOADER
-
-INFO_BASE_END
-
; -------------------------------
; VARIABLES that should be in RAM
; -------------------------------
.IFDEF SD_CARD_LOADER
- .IFDEF RAM_1K ; if RAM = 1K (FR57xx) the variables below are in INFO space (FRAM)
-SD_ORG_DATA .equ INFO_BASE_END+18 ; 8 words free to set some core routines addresses + 1 word guard...
- ; ...while preserving FRAM area SD_LEN_DATA.
+ .IF RAM_LEN < 2048 ; if RAM < 2K (FR57xx) the variables below are in INFO space (FRAM)
+
+SD_ORG .equ INFO_BASE_END+22 ; 8 words free to set some core routines addresses + 1 word guard...
+ ; ...while preserving FRAM area SD_LEN.
.ELSE ; if RAM >= 2k the variables below are in RAM
-SD_ORG_DATA .equ SD_BUFEND+2 ; 1 word guard
+SD_ORG .equ SD_BUFEND+2 ; 1 word guard
.ENDIF
- .org SD_ORG_DATA
+ .org SD_ORG
; ---------------------------------------
; FAT FileSystemInfos
; ---------------------------------------
-FATtype .equ SD_ORG_DATA+0
-BS_FirstSectorL .equ SD_ORG_DATA+2 ; init by SD_Init, used by RW_Sector_CMD
-BS_FirstSectorH .equ SD_ORG_DATA+4 ; init by SD_Init, used by RW_Sector_CMD
-OrgFAT1 .equ SD_ORG_DATA+6 ; init by SD_Init,
-FATSize .equ SD_ORG_DATA+8 ; init by SD_Init,
-OrgFAT2 .equ SD_ORG_DATA+10 ; init by SD_Init,
-OrgRootDIR .equ SD_ORG_DATA+12 ; init by SD_Init, (FAT16 specific)
-OrgClusters .equ SD_ORG_DATA+14 ; init by SD_Init, Sector of Cluster 0
-SecPerClus .equ SD_ORG_DATA+16 ; init by SD_Init, byte size
-
-SD_LOW_LEVEL .equ SD_ORG_DATA+18
+FATtype .equ SD_ORG+0
+BS_FirstSectorL .equ SD_ORG+2 ; init by SD_Init, used by RW_Sector_CMD
+BS_FirstSectorH .equ SD_ORG+4 ; init by SD_Init, used by RW_Sector_CMD
+OrgFAT1 .equ SD_ORG+6 ; init by SD_Init,
+FATSize .equ SD_ORG+8 ; init by SD_Init,
+OrgFAT2 .equ SD_ORG+10 ; init by SD_Init,
+OrgRootDIR .equ SD_ORG+12 ; init by SD_Init, (FAT16 specific)
+OrgClusters .equ SD_ORG+14 ; init by SD_Init, Sector of Cluster 0
+SecPerClus .equ SD_ORG+16 ; init by SD_Init, byte size
+
+SD_LOW_LEVEL .equ SD_ORG+18
; ---------------------------------------
; SD command
; ---------------------------------------
; ---------------------------------------
FirstHandle .equ SD_FAT_LEVEL+22
-
; ---------------------------------------
; Handle structure
; ---------------------------------------
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
+ .IF RAM_LEN < 2048 ; due to the lack of RAM, only 5 handles and PAD replaces SDIB
HandleMax .equ 5 ; and not 8 to respect INFO size (FRAM)
HandleLenght .equ 24
SDIB_I2CCNT .equ PAD_ORG-2
SDIB_ORG .equ PAD_ORG
-SD_END_DATA .equ LoadStackEnd
-SD_LEN_DATA .equ SD_END_DATA-SD_ORG_DATA
+SD_END .equ LoadStackEnd
- .ELSEIF ; RAM_Size > 1k all is in RAM
+ .ELSE ; RAM_Size >= 2k all is in RAM
HandleMax .equ 8
HandleLenght .equ 24
SDIB_ORG .equ LoadStackEnd+4
SDIB_LEN .equ 84 ; = TIB_LEN = PAD_LEN
-SD_END_DATA .equ SDIB_ORG+SDIB_LEN
+SD_END .equ SDIB_ORG+SDIB_LEN
.ENDIF ; RAM_Size
+SD_LEN .equ SD_END-SD_ORG
.ENDIF ; SD_CARD_LOADER
; DTCforthMSP430FR5xxx program (FRAM) memory
;-------------------------------------------------------------------------------
- .org PROGRAMSTART
+ .org MAIN_ORG
;-------------------------------------------------------------------------------
; DEFINING EXECUTIVE WORDS - DTC model
;-------------------------------------------------------------------------------
-
-;-------------------------------------------------------------------------------
; very nice FAST FORTH added feature:
;-------------------------------------------------------------------------------
; as IP is always computed from the PC value, we can place low level to high level
.CASE 1 ; DOCOL = CALL rDOCOL
;-------------------------------------------------------------------------------
-
xdocol MOV @RSP+,W ; 2
PUSH IP ; 3 save old IP on return stack
MOV W,IP ; 1 set new IP to PFA
MOV @TOS+,IP ; 2 IP = CFA of Master word, TOS = BODY address of created word
MOV @IP+,PC ; 4 Execute Master word
+
+;-------------------------------------------------------------------------------
+mSEMI .MACRO
+ MOV @RSP+,IP
+ MOV @IP+,PC
+ .ENDM
+
;-------------------------------------------------------------------------------
; INTERPRETER LOGIC
;-------------------------------------------------------------------------------
FORTHWORD "OVER"
OVER MOV TOS,-2(PSP) ; 3 -- x1 (x2) x2
MOV @PSP,TOS ; 2 -- x1 (x2) x1
- SUB #2,PSP ; 2 -- x1 x2 x1
+ SUB #2,PSP ; 1 -- x1 x2 x1
mNEXT ; 4
;https://forth-standard.org/standard/core/ROT
DEPTH MOV TOS,-2(PSP)
MOV #PSTACK,TOS
SUB PSP,TOS ; PSP-S0--> TOS
- SUB #2,PSP ; post decrement stack...
RRA TOS ; TOS/2 --> TOS
+DECPSP SUB #2,PSP ; post decrement stack...
mNEXT
;-------------------------------------------------------------------------------
FORTHWORD "-"
MINUS SUB @PSP+,TOS ;2 -- n2-n1
NEGATE XOR #-1,TOS ;1
- ADD #1,TOS ;1 -- n3 = -(n2-n1)
+ ADD #1,TOS ;1 -- n3 = -(n2-n1) = n1-n2
mNEXT
;https://forth-standard.org/standard/core/OnePlus
;C DABS d1 -- |d1| absolute value
FORTHWORD "DABS"
DABBS AND #-1,TOS ; clear V, set N
- JGE DABBSEND ; JMP if positive
+ JGE DABBSEND ; if positive
DNEGATE XOR #-1,0(PSP)
XOR #-1,TOS
ADD #1,0(PSP)
;C = x1 x2 -- flag test x1=x2
FORTHWORD "="
EQUAL SUB @PSP+,TOS ;2
- JNZ TOSFALSE ;2 --> +4
+ JZ TOSTRUE ;2
+TOSFALSE MOV #0,TOS ;1
+ mNEXT ;4
+
+;https://forth-standard.org/standard/core/Uless
+;C U< u1 u2 -- flag test u1<u2, unsigned
+ FORTHWORD "U<"
+ULESS MOV @PSP+,W ;2
+ SUB TOS,W ;1 u1-u2 in W, carry clear if borrow
+ JC TOSFALSE ; unsigned
TOSTRUE MOV #-1,TOS ;1
mNEXT ;4
FORTHWORD "<"
LESS MOV @PSP+,W ;2 W=n1
SUB TOS,W ;1 W=n1-n2 flags set
-LESSNEXT JL TOSTRUE ;2
-TOSFALSE MOV #0,TOS ;1
- mNEXT ;4
+ JL TOSTRUE ;2 signed
+ JGE TOSFALSE ;2 --> +5
;https://forth-standard.org/standard/core/more
;C > n1 n2 -- flag test n1>n2, signed
FORTHWORD ">"
GREATER SUB @PSP+,TOS ;2 TOS=n2-n1
- JMP LESSNEXT
-
-;https://forth-standard.org/standard/core/Zeromore
-;C 0> n -- flag true if TOS positive
- FORTHWORD "0>"
-ZEROMORE CMP #1,TOS
- JGE TOSTRUE
- JMP TOSFALSE
-
-;https://forth-standard.org/standard/core/Uless
-;C U< u1 u2 -- flag test u1<u2, unsigned
- FORTHWORD "U<"
-ULESS MOV @PSP+,W ;2
- SUB TOS,W ;1 u1-u2 in W, carry clear if borrow
- JNC TOSTRUE ;2
- JMP TOSFALSE
-
-;-------------------------------------------------------------------------------
-; BRANCH and LOOP OPERATORS
-;-------------------------------------------------------------------------------
-
-;Z branch -- branch always
-BRAN MOV @IP,IP ; 2
- mNEXT ; 4
-
-;Z ?branch x -- branch if TOS = zero
-QBRAN CMP #0,TOS ; 1 test TOS value
-QBRAN1 MOV @PSP+,TOS ; 2 pop new TOS value (doesn't change flags)
- JZ bran ; 2 if TOS was zero, take the branch = 11 cycles
- ADD #2,IP ; 1 else skip the branch destination
- mNEXT ; 4 ==> branch not taken = 10 cycles
-
-;Z 0?branch x -- branch if TOS <> zero
-QZBRAN SUB #1,TOS ; 1 borrow (clear cy) if TOS was 0
- SUBC TOS,TOS ; 1 TOS=-1 if borrow was set
- JMP QBRAN1 ; 2
-
-
-;Z (do) n1|u1 n2|u2 -- R: -- sys1 sys2 run-time code for DO
-; n1|u1=limit, n2|u2=index
-xdo MOV #8000h,X ;2 compute 8000h-limit "fudge factor"
- SUB @PSP+,X ;2
- MOV TOS,Y ;1 loop ctr = index+fudge
- MOV @PSP+,TOS ;2 pop new TOS
- ADD X,Y ;1
- PUSHM #2,X ;4 PUSHM X,Y, i.e. PUSHM LIMIT, INDEX
- mNEXT ;4
-
-;Z (+loop) n -- R: sys1 sys2 -- | sys1 sys2
-; run-time code for +LOOP
-; Add n to the loop index. If loop terminates, clean up the
-; return stack and skip the branch. Else take the inline branch.
-xploop ADD TOS,0(RSP) ;4 increment INDEX by TOS value
- MOV @PSP+,TOS ;2 get new TOS, doesn't change flags
-xloopnext BIT #100h,SR ;2 is overflow bit set?
- JZ bran ;2 no overflow = loop
- ADD #2,IP ;1 overflow = loop done, skip branch ofs
-UNXLOOP ADD #4,RSP ;1 empty RSP
- mNEXT ;4 16~ taken or not taken xloop/loop
-
-
-;Z (loop) R: sys1 sys2 -- | sys1 sys2
-; run-time code for LOOP
-; Add 1 to the loop index. If loop terminates, clean up the
-; return stack and skip the branch. Else take the inline branch.
-; Note that LOOP terminates when index=8000h.
-xloop ADD #1,0(RSP) ;4 increment INDEX
- JMP xloopnext ;2
-
-;https://forth-standard.org/standard/core/UNLOOP
-;C UNLOOP -- R: sys1 sys2 -- drop loop parms
- FORTHWORD "UNLOOP"
-UNLOOP JMP UNXLOOP
-
-;https://forth-standard.org/standard/core/I
-;C I -- n R: sys1 sys2 -- sys1 sys2
-;C get the innermost loop index
- FORTHWORD "I"
-II SUB #2,PSP ;1 make room in TOS
- MOV TOS,0(PSP) ;3
- MOV @RSP,TOS ;2 index = loopctr - fudge
- SUB 2(RSP),TOS ;3
- mNEXT ;4 13~
-
-;https://forth-standard.org/standard/core/J
-;C J -- n R: 4*sys -- 4*sys
-;C get the second loop index
- FORTHWORD "J"
-JJ SUB #2,PSP ; make room in TOS
- MOV TOS,0(PSP)
- MOV 4(RSP),TOS ; index = loopctr - fudge
- SUB 6(RSP),TOS
- mNEXT
+ JL TOSTRUE ;2 signed
+ JGE TOSFALSE ;2 --> +5
;-------------------------------------------------------------------------------
; SYSTEM CONSTANTS
;-------------------------------------------------------------------------------
; ANS complement OPTION
;-------------------------------------------------------------------------------
- .IFDEF ANS_CORE_COMPLIANT
- .include "ADDON\ANS_COMPLEMENT.asm"
- .ELSEIF
-
-;-------------------------------------------------------------------------------
-; ALIGNMENT OPERATORS OPTION
-;-------------------------------------------------------------------------------
- .IFDEF ALIGNMENT ; included in ANS_COMPLEMENT
- .include "ADDON\ALIGNMENT.asm"
- .ENDIF ; ALIGNMENT
-
-;-------------------------------------------------------------------------------
-; PORTABILITY OPERATORS OPTION
-;-------------------------------------------------------------------------------
- .IFDEF PORTABILITY
- .include "ADDON\PORTABILITY.asm"
- .ENDIF ; PORTABILITY
-
-;-------------------------------------------------------------------------------
-; DOUBLE OPERATORS OPTION
-;-------------------------------------------------------------------------------
- .IFDEF DOUBLE ; included in ANS_COMPLEMENT
- .include "ADDON\DOUBLE.asm"
- .ENDIF ; DOUBLE
-
-;-------------------------------------------------------------------------------
-; ARITHMETIC OPERATORS OPTION
-;-------------------------------------------------------------------------------
- .IFDEF ARITHMETIC ; included in ANS_COMPLEMENT
- .include "ADDON\ARITHMETIC.asm"
- .ENDIF ; ARITHMETIC
-
+ .IFDEF ANS_CORE_COMPLEMENT
+ .include "ADDON/ANS_COMPLEMENT.asm"
.ENDIF ; ANS_COMPLEMENT
;-------------------------------------------------------------------------------
mNEXT
;https://forth-standard.org/standard/core/UMDivMOD
-; UM/MOD udlo|udhi u1 -- r q unsigned 32/16->16
+; UM/MOD udlo|udhi u1 -- r q unsigned 32/16->r16 q16
FORTHWORD "UM/MOD"
UMSLASHMOD PUSH #DROP ;3 as return address for MU/MOD
; Y = QUOThi = ud2hi = ud2hi
; rDODOES = count
-; MU/MOD DVDlo DVDhi DIVlo -- REMlo QUOTlo QUOThi, used by fixpoint and #
-MUSMOD MOV TOS,T ;1 T = DIVlo
- MOV @PSP,TOS ;2 TOS = DVDhi
+; MU/MOD DVDlo DVDhi DIVlo -- REMlo QUOTlo QUOThi, also used by fixpoint and #
+MUSMOD MOV TOS,T ;1 T = DIV
MOV 2(PSP),S ;3 S = DVDlo
+ MOV @PSP,TOS ;2 TOS = DVDhi
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)
-MDIV1 CMP T,W ;1 REMlo U>= DIVlo ?
+; -----------------------------------------
+MDIV1 CMP T,W ;1 REMlo U>= DIV ?
JNC MDIV2 ;2 no : carry is reset
- SUB T,W ;1 yes: REMlo - DIVlo ; carry is set after soustraction!
+ SUB T,W ;1 yes: REMlo - DIV ; carry is set after soustraction!
MDIV2 ADDC X,X ;1 RLC quotLO
ADDC Y,Y ;1 RLC quotHI
SUB #1,rDODOES ;1 Decrement loop counter
ADDC TOS,TOS ;1 RLC DVDhi
ADDC W,W ;1 RLC REMlo
JNC MDIV1 ;2
- SUB T,W ;1 REMlo - DIVlo
+ SUB T,W ;1 REMlo - DIV
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 !
+ RET ;4 35 words, about 473 cycles, not FORTH executable !
;https://forth-standard.org/standard/core/num
;C # ud1lo ud1hi -- ud2lo ud2hi convert 1 digit of output
.word NUM ; X=QUOTlo
FORTHtoASM ;
SUB #2,IP ;1 restore NUM return
- CMP #0,X ;1 test ud2lo first (generally true)
+ CMP #0,X ;1 test ud2lo first (generally false)
JNZ NUM1 ;2
- CMP #0,TOS ;1 then test ud2hi (generally false)
+ CMP #0,TOS ;1 then test ud2hi (generally true)
JNZ NUM1 ;2
- MOV @RSP+,IP ;2
- mNEXT ;4 10 words, about 241/417 cycles/char
+ mSEMI ;6 10 words, about 241/417 cycles/char
;https://forth-standard.org/standard/core/num-end
;C #> udlo:udhi -- c-addr u end conversion, get string
JN HOLDW ; 0<
mNEXT
-;https://forth-standard.org/standard/core/Ud
-;C U. u -- display u (unsigned)
- FORTHWORD "U."
-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."
.word LESSNUM,SWAP,OVER,DABBS,NUMS
.word ROT,SIGN,NUMGREATER,TYPE,SPACE,EXIT
+;https://forth-standard.org/standard/core/Ud
+;C U. u -- display u (unsigned)
+ FORTHWORD "U."
+UDOT MOV #0,Y
+UDOT1 SUB #2,PSP
+ MOV TOS,0(PSP)
+ MOV Y,TOS
+ JMP DDOT
+
;https://forth-standard.org/standard/core/d
;C . n -- display n (signed)
FORTHWORD "."
DOT CMP #0,TOS
JGE UDOT
- SUB #2,PSP
- MOV TOS,0(PSP)
- MOV #-1,TOS ; extend sign
- JMP DDOT
+ MOV #-1,Y
+ JMP UDOT1
;-------------------------------------------------------------------------------
; DICTIONARY MANAGEMENT
;-------------------------------------------------------------------------------
;https://forth-standard.org/standard/core/HERE
-;C HERE -- addr returns dictionary ptr
+;C HERE -- addr returns memory ptr
FORTHWORD "HERE"
HERE SUB #2,PSP
MOV TOS,0(PSP)
mNEXT
;https://forth-standard.org/standard/core/ALLOT
-;C ALLOT n -- allocate n bytes in dict
+;C ALLOT n -- allocate n bytes
FORTHWORD "ALLOT"
ALLOT ADD TOS,&DDP
MOV @PSP+,TOS
mNEXT
;https://forth-standard.org/standard/core/CComma
-;C C, char -- append char to dict
+;C C, char -- append char
FORTHWORD "C,"
CCOMMA MOV &DDP,W
MOV.B TOS,0(W)
MOV @PSP+,TOS
mNEXT
+;-------------------------------------------------------------------------------
+; BRANCH and LOOP OPERATORS
+;-------------------------------------------------------------------------------
+
+;Z branch -- branch always
+BRAN MOV @IP,IP ; 2
+ mNEXT ; 4
+
+;Z ?branch x -- branch if TOS = zero
+QBRAN CMP #0,TOS ; 1 test TOS value
+QBRAN1 MOV @PSP+,TOS ; 2 pop new TOS value (doesn't change flags)
+ JZ bran ; 2 if TOS was zero, take the branch = 11 cycles
+ ADD #2,IP ; 1 else skip the branch destination
+ mNEXT ; 4 ==> branch not taken = 10 cycles
+
+;Z 0?branch x -- branch if TOS <> zero
+QZBRAN SUB #1,TOS ; 1 borrow (clear cy) if TOS was 0
+ SUBC TOS,TOS ; 1 TOS=-1 if borrow was set
+ JMP QBRAN1 ; 2
+
+
+;Z (do) n1|u1 n2|u2 -- R: -- sys1 sys2 run-time code for DO
+; n1|u1=limit, n2|u2=index
+xdo MOV #8000h,X ;2 compute 8000h-limit "fudge factor"
+ SUB @PSP+,X ;2
+ MOV TOS,Y ;1 loop ctr = index+fudge
+ MOV @PSP+,TOS ;2 pop new TOS
+ ADD X,Y ;1
+ PUSHM #2,X ;4 PUSHM X,Y, i.e. PUSHM LIMIT, INDEX
+ mNEXT ;4
+
+;Z (+loop) n -- R: sys1 sys2 -- | sys1 sys2
+; run-time code for +LOOP
+; Add n to the loop index. If loop terminates, clean up the
+; return stack and skip the branch. Else take the inline branch.
+xploop ADD TOS,0(RSP) ;4 increment INDEX by TOS value
+ MOV @PSP+,TOS ;2 get new TOS, doesn't change flags
+xloopnext BIT #100h,SR ;2 is overflow bit set?
+ JZ bran ;2 no overflow = loop
+ ADD #2,IP ;1 overflow = loop done, skip branch ofs
+UNXLOOP ADD #4,RSP ;1 empty RSP
+ mNEXT ;4 16~ taken or not taken xloop/loop
+
+
+;Z (loop) R: sys1 sys2 -- | sys1 sys2
+; run-time code for LOOP
+; Add 1 to the loop index. If loop terminates, clean up the
+; return stack and skip the branch. Else take the inline branch.
+; Note that LOOP terminates when index=8000h.
+xloop ADD #1,0(RSP) ;4 increment INDEX
+ JMP xloopnext ;2
+
+;https://forth-standard.org/standard/core/UNLOOP
+;C UNLOOP -- R: sys1 sys2 -- drop loop parms
+ FORTHWORD "UNLOOP"
+UNLOOP JMP UNXLOOP
+
+;https://forth-standard.org/standard/core/I
+;C I -- n R: sys1 sys2 -- sys1 sys2
+;C get the innermost loop index
+ FORTHWORD "I"
+II SUB #2,PSP ;1 make room in TOS
+ MOV TOS,0(PSP) ;3
+ MOV @RSP,TOS ;2 index = loopctr - fudge
+ SUB 2(RSP),TOS ;3
+ mNEXT ;4 13~
+
+;https://forth-standard.org/standard/core/J
+;C J -- n R: 4*sys -- 4*sys
+;C get the second loop index
+ FORTHWORD "J"
+JJ SUB #2,PSP ; make room in TOS
+ MOV TOS,0(PSP)
+ MOV 4(RSP),TOS ; index = loopctr - fudge
+ SUB 6(RSP),TOS
+ mNEXT
+
; ------------------------------------------------------------------------------
; TERMINAL I/O, input part
; ------------------------------------------------------------------------------
-
;https://forth-standard.org/standard/core/KEY
;C KEY -- c wait character from input device ; primary DEFERred word
FORTHWORD "KEY"
-KEY MOV @PC+,PC
- .word BODYKEY
-BODYKEY MOV &TERMRXBUF,Y ; empty buffer
+KEY MOV @PC+,PC ;3 Code Field Address (CFA) of KEY
+PFAKEY .word BODYKEY ; Parameter Field Address (PFA) of KEY, with default value
+BODYKEY MOV &TERM_RXBUF,Y ; empty buffer
SUB #2,PSP ; 1 push old TOS..
- MOV TOS,0(PSP) ; 4 ..onto stack
+ MOV TOS,0(PSP) ; 3 ..onto stack
CALL #RXON
-KEYLOOP BIT #UCRXIFG,&TERMIFG ; loop if bit0 = 0 in interupt flag register
+KEYLOOP BIT #UCRXIFG,&TERM_IFG ; loop if bit0 = 0 in interupt flag register
JZ KEYLOOP ;
- MOV &TERMRXBUF,TOS ;
+ MOV &TERM_RXBUF,TOS ;
CALL #RXOFF ;
mNEXT
.IFDEF SD_CARD_LOADER
.include "forthMSP430FR_SD_ACCEPT.asm"
-DEFER_INPUT ; CIB (Current Input Buffer) and ACCEPT must to be redirected for SD_LOAD usage
.ENDIF
- .IFDEF DEFER_INPUT
-
-; CIB -- addr of Current Input Buffer
- FORTHWORD "CIB"
-FCIB mDOCON
- .WORD TIB_ORG ; constant, may be DEFERred as SDIB_ORG by OPEN.
-
-; : REFILL CIB DUP TIB_LEN ACCEPT ; -- CIB CIB len shared by QUIT and [ELSE]
-REFILL SUB #6,PSP ;2
- MOV TOS,4(PSP) ;3
- MOV #TIB_LEN,TOS ;2
- MOV &FCIB+2,0(PSP) ;5
- MOV @PSP,2(PSP) ;4
- JMP ACCEPT ;2
+ .IFDEF DEFER_ACCEPT
;https://forth-standard.org/standard/core/ACCEPT
;C ACCEPT addr addr len -- addr len' get line at addr to interpret len' chars
FORTHWORD "ACCEPT"
-ACCEPT MOV @PC+,PC ;3
- .word BODYACCEPT
-BODYACCEPT
+ACCEPT MOV @PC+,PC ;3 Code Field Address (CFA) of ACCEPT
+PFAACCEPT .word BODYACCEPT ; Parameter Field Address (PFA) of ACCEPT
+BODYACCEPT ; BODY of ACCEPT = default execution of ACCEPT
.ELSE
-; : REFILL TIB DUP TIB_LEN ACCEPT ; -- TIB TIB len shared by QUIT and [ELSE]
-REFILL SUB #6,PSP ;2
- MOV TOS,4(PSP) ;3
- MOV #TIB_LEN,TOS ;2
- MOV #TIB_ORG,0(PSP) ;4
- MOV @PSP,2(PSP) ;4
- JMP ACCEPT ;2
-
;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_INPUT
+ .ENDIF
.IFDEF HALFDUPLEX ; to use FAST FORTH with half duplex input terminal (bluetooth or wifi connexion)
; 3- the time between sending XON/RTS_low and clearing UCRXIFG on first received char,
; everything must be done to reduce these times, taking into account the necessity of switching to SLEEP (LPMx mode).
; ----------------------------------;
-; (ACCEPT) I prepare TERMINAL_INT ;
+; ACCEPT part I prepare TERMINAL_INT;
; ----------------------------------;
.IFDEF TOTAL
- .word 1537h ;6 push R7,R6,R5,R4
+ PUSHM #4,R7 ;6 push R7,R6,R5,R4
.ENDIF ;
- MOV #ENDACCEPT,S ;2 S = ACCEPT XOFF return
- MOV #AKEYREAD1,T ;2 T = default XON return
- PUSHM #3,IP ;5 PUSHM IP,S,T, as IP ret, XOFF ret, XON ret
+ MOV #ENDACCEPT,S ;2 S = XOFF_ret
+ MOV #AKEYREAD1,T ;2 T = XON_ret
+ PUSHM #3,IP ;5 PUSHM IP,S,T r-- ACCEPT_ret XOFF_ret XON_ret
MOV TOS,W ;1 -- addr len
MOV @PSP,TOS ;2 -- org ptr )
ADD TOS,W ;1 -- org ptr W=Bound )
- MOV #0Dh,T ;2 T = 'CR' to speed up char loop in part II > prepare stack and registers
- MOV #20h,S ;2 S = 'BL' to speed up char loop in part II ) for TERMINAL_INT use
+ MOV #0Dh,T ;2 T = 'CR' to speed up char loop in part II > prepare stack and registers for TERMINAL_INT use
+ MOV #20h,S ;2 S = 'BL' to speed up char loop in part II )
MOV #AYEMIT_RET,IP ;2 IP = return for YEMIT )
- BIT #UCRXIFG,&TERMIFG ;3 RX_Int ?
+ BIT #UCRXIFG,&TERM_IFG ;3 RX_Int ?
JZ ACCEPTNEXT ;2 no : case of quiet input terminal
- MOV &TERMRXBUF,Y ;3 yes: clear RX_Int
+ MOV &TERM_RXBUF,Y ;3 yes: clear RX_Int
CMP #0Ah,Y ;2 received char = LF ? (end of downloading ?)
- JNZ RXON ;2 no : RXON return = AKEYREAD1, to process first char of new line.
-ACCEPTNEXT ADD #2,RSP ;1 yes: remove AKEYREAD1 as XON return,
- MOV #SLEEP,X ;2 and set XON return = SLEEP
- PUSHM #5,IP ;7 PUSHM IP,S,T,W,X before SLEEP (and so WAKE on any interrupts)
+ JNZ RXON ;2 no : send XON then RET to AKEYREAD1 to process first char of new line.
+ACCEPTNEXT ADD #2,RSP ;1 replace XON_ret = AKEYREAD1 by XON_ret = SLEEP
+ MOV #SLEEP,X ;2
+ PUSHM #5,IP ;7 r-- ACCEPT_ret XOFF_ret YEMIT_ret 'BL' 'CR' bound XON_ret
+; ----------------------------------;
+
; ----------------------------------;
RXON ;
; ----------------------------------;
.IFDEF TERMINAL3WIRES ;
-; .IF TERMINALBAUDRATE/FREQUENCY <230400 ; Incompatible with baudrate modification on the fly.
-RXON_LOOP BIT #UCTXIFG,&TERMIFG ;3 wait the sending end of XON, useless at high baudrates
+RXON_LOOP BIT #UCTXIFG,&TERM_IFG ;3 wait the sending of last char, useless at high baudrates
JZ RXON_LOOP ;2
-; .ENDIF
- MOV #17,&TERMTXBUF ;4 move char XON into TX_buf
+ MOV #17,&TERM_TXBUF ;4 move char XON into TX_buf
.ENDIF ;
.IFDEF TERMINAL4WIRES ;
BIC.B #RTS,&HANDSHAKOUT ;4 set RTS low
RET ;4 to BACKGND (End of file download or quiet input) or AKEYREAD1 (get next line of file downloading)
; ----------------------------------; ...or user defined
-
; ----------------------------------;
RXOFF ;
; ----------------------------------;
.IFDEF TERMINAL3WIRES ;
- MOV #19,&TERMTXBUF ;4 move XOFF char into TX_buf
+ MOV #19,&TERM_TXBUF ;4 move XOFF char into TX_buf
.ENDIF ;
.IFDEF TERMINAL4WIRES ;
BIS.B #RTS,&HANDSHAKOUT ;4 set RTS high
RET ;4 to ENDACCEPT, ...or user defined
; ----------------------------------;
-
; ----------------------------------;
- ASMWORD "SLEEP" ; may be redirected
-SLEEP MOV @PC+,PC ;3
- .word BODYSLEEP ;
-BODYSLEEP BIS &LPM_MODE,SR ;3 enter in LPMx sleep mode with GIE=1
+ ASMWORD "SLEEP" ; may be redirected
+SLEEP MOV @PC+,PC ;3 Code Field Address (CFA) of SLEEP
+PFASLEEP .word BODYSLEEP ; Parameter Field Address (PFA) of SLEEP, with default value
+BODYSLEEP
+ BIS &LPM_MODE,SR ;3 enter in LPMx sleep mode with GIE=1
; ----------------------------------; default FAST FORTH mode (for its input terminal use) : LPM0.
;###############################################################################################################
JMP SLEEP ;2 here is the return for any interrupts, else TERMINAL_INT :-)
; ==================================;
-
; **********************************;
TERMINAL_INT ; <--- TEMR RX interrupt vector, delayed by the LPMx wake up time
; **********************************; if wake up time increases, max bauds rate decreases...
-; (ACCEPT) part II under interrupt ; Org Ptr -- len'
+; (ACCEPT) part II under interrupt ; Org Ptr --
; ----------------------------------;
ADD #4,RSP ;1 remove SR and PC from stack, SR flags are lost (unused by FORTH interpreter)
- POPM #4,IP ;6 POPM W=buffer_bound, T=0Dh,S=20h, IP=AYEMIT_RET
+ POPM #4,IP ;6 POPM W=buffer_bound, T=0Dh, S=20h, IP=AYEMIT_RET r-- ACCEPT_ret XOFF_ret
; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
; starts the 2th stopwatch ;
; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
-AKEYREAD MOV.B &TERMRXBUF,Y ;3 read character into Y, UCRXIFG is cleared
+AKEYREAD MOV.B &TERM_RXBUF,Y ;3 read character into Y, UCRXIFG is cleared
; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
; stops the 3th stopwatch ; 3th bottleneck result : 17~ + LPMx wake_up time ( + 5~ XON loop if F/Bds<230400 )
; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
-AKEYREAD1
- CMP.B S,Y ;1 printable char ?
+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
JZ YEMIT1 ; 2 yes: send echo then loopback
MOV.B Y,0(TOS) ; 3 no: store char @ Ptr, send echo then loopback
ADD #1,TOS ; 1 increment Ptr
-YEMIT1
-; .IF TERMINALBAUDRATE/FREQUENCY <230401; Incompatible with baudrate modification on the fly.
- BIT #UCTXIFG,&TERMIFG ; 3 wait the sending end of previous char (sent before ACCEPT), useless at high baudrates
+YEMIT1 ;
+ BIT #UCTXIFG,&TERM_IFG ; 3 wait the sending end of previous char, useless at high baudrates
JZ YEMIT1 ; 2 but there's no point in wanting to save time here:
-; .ENDIF ; it must be understood that the receiver loses time also when receiving the char.
-YEMIT2
+YEMIT2 ;
.IFDEF TERMINAL5WIRES ;
BIT.B #CTS,&HANDSHAKIN ; 3
JNZ YEMIT2 ; 2
- .ENDIF
-YEMIT ; hi7/4~ lo:12/9~ send/send_not echo to terminal
+ .ENDIF ;
+YEMIT ; 7~/4~ send/send_not echo to terminal
.word 4882h ; 4882h = MOV Y,&<next_adr>
- .word TERMTXBUF ; 3
+ .word TERM_TXBUF ; 3
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 ?
+; ----------------------------------; 25~
+AYEMIT_RET FORTHtoASM ; 0 YEMII NEXT address
+ SUB #2,IP ; 1 reset YEMIT NEXT address to AYEMIT_RET
+WAITaKEY BIT #UCRXIFG,&TERM_IFG ; 3 new char in TERMRXBUF ?
JNZ AKEYREAD ; 2 yes
JZ WAITaKEY ; 2 no
; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
-; stops the 2th stopwatch ; best case result: 26~/22~ (with/without echo) ==> 385/455 kBds/MHz
+; stops the 2th stopwatch ; best case result: 31~/28~ (with/without echo) ==> 322/357 kBds/MHz
; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
; ----------------------------------;
-ENDACCEPT ; <--- XOFF return address
+ENDACCEPT ; --- Org Ptr r-- ACCEPT_ret
; ----------------------------------;
- MOV #LPM0+GIE,&LPM_MODE ; reset LPM_MODE to default mode LPM0 for next line of input stream
CMP #0,&LINE ; if LINE <> 0...
JZ ACCEPTEND ;
ADD #1,&LINE ; ...increment LINE
-ACCEPTEND SUB @PSP+,TOS ; Org Ptr -- len'
- MOV @RSP+,IP ; 2 and continue with INTERPRET with GIE=0.
- ; So FORTH machine is protected against any interrupt...
- .IFDEF TOTAL
+ACCEPTEND SUB @PSP+,TOS ; -- len'
+ MOV @RSP+,IP ; 2 return to INTERPRET with GIE=0: FORTH is protected against any interrupt...
+ .IFDEF TOTAL ;
POPM #4,R7 ;6 pop R4,R5,R6,R7
- .ENDIF
+ .ENDIF ;
+; ----------------------------------;
+ MOV #LPM0+GIE,&LPM_MODE ; reset LPM_MODE to default mode LPM0 for next line of input stream
+; ----------------------------------;
mNEXT ; ...until next falling down to LPMx mode of (ACCEPT) part1,
; **********************************; i.e. when the FORTH interpreter has no more to do.
+ .IFDEF DEFER_ACCEPT
+
+; CIB -- addr of Current Input Buffer
+ FORTHWORD "CIB" ; constant, may be redirected as SDIB_ORG by OPEN.
+FCIB mDOCON ; Code Field Address (CFA) of FCIB
+PFACIB .WORD TIB_ORG ; Parameter Field Address (PFA) of FCIB
+
+; : REFILL CIB DUP TIB_LEN ACCEPT ; -- CIB CIB len shared by QUIT and [ELSE]
+REFILL SUB #6,PSP ;2
+ MOV TOS,4(PSP) ;3
+ MOV #TIB_LEN,TOS ;2
+ MOV &PFACIB,0(PSP) ;5
+ MOV @PSP,2(PSP) ;4
+ JMP ACCEPT ;2
+
+ .ELSE
+
+; : REFILL TIB DUP TIB_LEN ACCEPT ; -- TIB TIB len shared by QUIT and [ELSE]
+REFILL SUB #6,PSP ;2
+ MOV TOS,4(PSP) ;3
+ MOV #TIB_LEN,TOS ;2
+ MOV #TIB_ORG,0(PSP) ;4
+ MOV @PSP,2(PSP) ;4
+ JMP ACCEPT ;2
+
+ .ENDIF
+
; ------------------------------------------------------------------------------
; TERMINAL I/O, output part
; ------------------------------------------------------------------------------
;https://forth-standard.org/standard/core/EMIT
;C EMIT c -- output character to the output device ; primary DEFERred word
FORTHWORD "EMIT"
-EMIT MOV @PC+,PC ;3 15~
- .word BODYEMIT
+EMIT MOV @PC+,PC ;3 Code Field Address (CFA) of EMIT
+PFAEMIT .word BODYEMIT ; Parameter Field Address (PFA) of EMIT, with its default value
BODYEMIT MOV TOS,Y ; 1
MOV @PSP+,TOS ; 2
JMP YEMIT1 ;9 12~
.ENDIF ; HALFDUPLEX
-
;Z ECHO -- connect console output (default)
FORTHWORD "ECHO"
ECHO MOV #4882h,&YEMIT ; 4882h = MOV Y,&<next_adr>
FORTHWORD "TYPE"
TYPE CMP #0,TOS
JZ TWODROP ; abort fonction
- .word 0151Eh ;5 PUSM TOS,IP R-- len,IP
+ PUSHM #2,TOS ;5 R-- len,IP
MOV #TYPE_NEXT,IP
TYPELOOP MOV @PSP,Y ;2 -- adr adr ; 30~ char loop
MOV.B @Y+,TOS ;2
;https://forth-standard.org/standard/core/CR
;C CR -- send CR to the output device
FORTHWORD "CR"
-CR MOV @PC+,PC
- .word BODYCR
-BODYCR mDOCOL
+CR MOV @PC+,PC ;3 Code Field Address (CFA) of CR
+PFACR .word BODYCR ; Parameter Field Address (PFA) of CR, with its default value
+BODYCR mDOCOL
.word XSQUOTE
.byte 2,13,10
.word TYPE,EXIT
ADDC #0,IP ; 1 -- addr u IP=addr+u aligned
mNEXT ; 4 16~
- .IFDEF LOWERCASE
-
- FORTHWORD "CAPS_ON"
-CAPS_ON MOV #-1,&CAPS ; state by default
- mNEXT
-
- FORTHWORD "CAPS_OFF"
-CAPS_OFF MOV #0,&CAPS
- mNEXT
-
-;https://forth-standard.org/standard/core/Sq
-;C S" -- compile in-line string
- FORTHWORDIMM "S\34" ; immediate
-SQUOTE mDOCOL
- .word lit,XSQUOTE,COMMA
-SQUOTE1 .word CAPS_OFF
- .word lit,'"',WORDD ; -- c-addr (= HERE)
- .word CAPS_ON
-
- .ELSE
-
;https://forth-standard.org/standard/core/Sq
;C S" -- compile in-line string
FORTHWORDIMM "S\34" ; immediate
-SQUOTE mDOCOL
+SQUOTE MOV #0,&CAPS ; CAPS OFF
+ mDOCOL
.word lit,XSQUOTE,COMMA
-SQUOTE1 .word lit,'"',WORDD ; -- c-addr (= HERE)
-
- .ENDIF ; LOWERCASE
-
+SQUOTE1 .word lit,'"',WORDD ; -- c-addr (= HERE)
FORTHtoASM
MOV @RSP+,IP
+ MOV #32,&CAPS ; CAPS ON
MOV.B @TOS,TOS ; -- u
SUB #1,TOS ; -1 byte
ADD TOS,&DDP
;https://forth-standard.org/standard/core/WORD
;C WORD char -- addr Z=1 if len=0
-; parse a word delimited by char separator
-; "word" is capitalized
-; TOIN is the relative displacement in the ascii string
-; separator filled line = 25 cycles + 7 cycles by char
+; parse a word delimited by char separator, by default "word" is capitalized
FORTHWORD "WORD"
WORDD MOV #SOURCE_LEN,S ;2 -- separator
MOV @S+,X ;2 X = str_len
ADD #1,Y ;1 increment dst just before test loop
CMP.B S,T ;1 char U< 'a' ? ('a'-1 U>= char) this condition is tested at each loop
JC SCANWORDLOO ;2 15~ upper case char loop
- .IFDEF LOWERCASE ;
-QCAPS CMP #0,&CAPS ;3 CAPS is OFF ? (case available only for ABORT" ." .( )
- JZ SCANWORDLOO ;2 yes
- .ENDIF ; LOWERCASE ; here CAPS is ON (other cases)
CMP.B #123,S ;2 char U>= 'z'+1 ?
JC SCANWORDLOO ;2 if yes
- SUB.B #32,S ;2 convert lowercase char to uppercase
- JMP SCANWORDLOO ;2
-
-SCANWORDEND SUB &SOURCE_ADR,W ;3 -- separator W=str_ptr - str_org = new >IN (first char separator next)
+ SUB.B &CAPS,S ;3 convert lowercase char to uppercase if CAPS ON (CAPS=32)
+ JMP SCANWORDLOO ;2 24~ lower case char loop
+SCANWORDEND
+ SUB &SOURCE_ADR,W ;3 -- separator W=str_ptr - str_org = new >IN (first char separator next)
MOV W,&TOIN ;3 update >IN
EOL_END MOV &DDP,TOS ;3 -- c-addr
SUB TOS,Y ;1 Y=Word_Length
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
;C xt 1 if immediate ; flag Z=0
; compare WORD at c-addr (HERE) with each of words in each of listed vocabularies in CONTEXT
; FIND to WORDLOOP : 14/20 cycles,
-; mismatch word loop: 13 cycles on len, +8 cycles on first char,
+; mismatch word loop: 13 cycles on len, +7 cycles on first char,
; +10 cycles char loop,
; VOCLOOP : 12/18 cycles,
; WORDFOUND to end : 21 cycles.
; note: with 16 threads vocabularies, FIND takes about 75% of CORETEST.4th processing time
- FORTHWORD "FIND"
+ FORTHWORD "FIND" ; -- c-addr
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
LENCOMP CMP.B rDOCON,Y ;1 compare lenght
JNZ WORDLOOP ;2 -- ???? NFA 13~ word loop on lenght mismatch
MOV S,W ;1 W=c-addr
-CHARLOOP ADD #1,W ;1
-CHARCOMP CMP.B @X+,0(W) ;4 compare chars
- JNZ WORDLOOP ;2 -- ???? NFA 21~ word loop on first char mismatch
+CHARCOMP CMP.B @X+,1(W) ;4 compare chars
+ JNZ WORDLOOP ;2 -- ???? NFA 20~ word loop on first char mismatch
+ ADD #1,W ;1
SUB.B #1,Y ;1 decr count
- JNZ CHARLOOP ;2 -- ???? NFA 10~ char loop
+ JNZ CHARCOMP ;2 -- ???? NFA 10~ char loop
WORDFOUND BIT #1,X ;1
ADDC #0,X ;1
;https://forth-standard.org/standard/core/toNUMBER
;C convert a string to double number until count2 = 0 or until not convertible char
-;C >NUMBER ud1lo|ud1hi addr1 count1 -- ud2lo|ud2hi addr2 count2
+;C >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
- MOV @PSP+,Y ;2 Y = ud1hi
- MOV @PSP,X ;2 X = ud1lo
- SUB #4,PSP ;1
+TONUMBER MOV @PSP+,S ;2 -- ud1lo ud1hi count1 S = addr1
+ MOV @PSP+,Y ;2 -- ud1lo count1 Y = ud1hi
+ MOV @PSP,X ;2 -- x count1 X = ud1lo
+ SUB #4,PSP ;1 -- x x x x count
MOV &BASE,T ;3
-TONUMLOOP MOV.B @S,W ;2 -- ud1lo ud1hi adr count W=char
-DDIGITQ SUB.B #30h,W ;2 skip all chars < '0'
- CMP.B #10,W ;2 char was U< "10" ?
- JLO DDIGITQNEXT ;2 no
- SUB.B #7,W ;2 skip all chars between "9" and "A"
+TONUMLOOP MOV.B @S,W ;2 -- x x x x count W=char
+DDIGITQ SUB.B #30h,W ;2 skip all chars < '0'
+ CMP.B #10,W ;2 char was U< 10 ?
+ JLO DDIGITQNEXT ;2 no
+ SUB.B #7,W ;2
CMP.B #10,W ;2
- JLO TONUMEND ;2
-DDIGITQNEXT CMP T,W ;1 digit-base
- JHS TONUMEND ;2 -- ud1lo ud1hi adr count abort if < 0 or >= base
- MOV X,&MPY32L ;3 Load 1st operand (ud1lo)
- MOV Y,&MPY32H ;3 Load 1st operand (ud1hi)
- MOV T,&OP2 ;3 Load 2nd operand with BASE
- MOV &RES0,X ;3 lo result in X (ud2lo)
- MOV &RES1,Y ;3 hi result in Y (ud2hi)
- ADD W,X ;1 ud2lo + digit
- ADDC #0,Y ;1 ud2hi + carry
-TONUMPLUS ADD #1,S ;1 -- ud1lo ud1hi adr count S=adr+1
- SUB #1,TOS ;1 -- ud1lo ud1hi adr count-1
- JNZ TONUMLOOP ;2 if count <>0
- 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
-
+ JLO TONUMEND ;2 -- x x x x count skip all chars between "9" and "A"
+DDIGITQNEXT CMP T,W ;1 digit-base
+ JHS TONUMEND ;2 -- x x x x count abort if < 0 or >= base
+ MOV X,&MPY32L ;3 Load 1st operand (ud1lo)
+ MOV Y,&MPY32H ;3 Load 1st operand (ud1hi)
+ MOV T,&OP2 ;3 Load 2nd operand with BASE
+ MOV &RES0,X ;3 lo result in X (ud2lo)
+ MOV &RES1,Y ;3 hi result in Y (ud2hi)
+ ADD W,X ;1 ud2lo + digit
+ ADDC #0,Y ;1 ud2hi + carry
+TONUMPLUS ADD #1,S ;1 S=adr+1
+ SUB #1,TOS ;1 -- x x x x count-1
+ JNZ TONUMLOOP ;2 if count <>0
+TONUMEND MOV S,0(PSP) ;3 -- x x x adr2 count2
+ MOV Y,2(PSP) ;3 -- x x ud2hi addr2 count2
+ MOV X,4(PSP) ;3 -- x ud2lo ud2hi addr2 count2
+ mNEXT ;4 41 words
; ?NUMBER makes the interface between >NUMBER and INTERPRET; it's a subset of INTERPRET.
; convert a string to a signed number; FORTH 2012 prefixes $, %, # are recognized
; 32 bits numbers (with decimal point) and fixed point signed numbers (with a comma) are recognized.
-; prefixes # % $ - are processed before calling >NUMBER
+; prefixes # % $ and - are processed before calling >NUMBER
; not convertible chars '.' (double) and ',' (fixed point) are processed as >NUMBER exits
;Z ?NUMBER c-addr -- n -1 if convert ok ; flag Z=0
;Z c-addr -- c-addr 0 if convert ko ; flag Z=1
-QNUMBER MOV #0,S ;1
+QNUMBER BIC #UF9,SR ;2 reset flag UF9, before use as decimal point flag
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,S ;1 S=sign of result
+ PUSHM #3,IP ;5 R-- IP sign base
+ MOV #QNUMNEXT,IP ;2 set QNUMNEXT as return from >NUMBER
MOV #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 TOS=count
+ MOV.B @S+,TOS ;2 -- c-addr x x x count TOS=count
MOV.B @S,W ;2 W=char
SUB.B #',',W ;2
JHS QSIGN ;2 for current base, and for ',' or '.' process
JZ PREFIXED ;2
QHEXA MOV #16,T ;4
SUB.B #1,W ;2 '$' - 1 = '#' hex number ?
- JNZ TONUMLOOP ;2 -- c-addr ud=0 x x other cases will cause error
+ JNZ TONUMLOOP ;2 -- c-addr x x x count other cases will cause >NUMBER error
PREFIXED ADD #1,S ;1
- SUB #1,TOS ;1 -- c-addr ud=0 x count S=adr+1 TOS=count-1
+ SUB #1,TOS ;1 -- c-addr x x x cnt-1 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
+ JNZ TONUMLOOP ;2 -- c-addr x x x count for positive number and for , or . process
MOV #-1,2(RSP) ;3 R-- IP sign base
JMP TONUMPLUS ;2
-; ----------------------------------; 39
+; ----------------------------------;40
QNUMNEXT FORTHtoASM ; -- c-addr ud2lo-hi addr2 cnt2 R-- IP sign BASE S=addr2
+ .IFDEF DOUBLE_INPUT
CMP #0,TOS ;1 cnt2=0 : conversion is ok ?
JZ QNUMNEXT1 ;2 yes
- BIT #UF9,SR ;2 already flagged double ?
- ; ( test to discard repeated points or repeated commas)
- JNZ QNUMNEXT1 ;2 abort
+ BIT #UF9,SR ;2 already 1 ?
+ JNZ QNUMNEXT1 ;2 yes: abort
BIS #UF9,SR ;2 set double number flag
-
- .IFDEF FIXPOINT_INPUT
-
+ SUB #2,IP ;1 reset QNUMNEXT as return from >NUMBER
QQNUMDP CMP.B #'.',0(S) ;4 rejected char by >NUMBER = decimal point ?
- JNZ QQcomma ;2 no
- SUB #2,IP ;1 yes: reset QNUMNEXT address as >NUMBER return
- JMP TONUMPLUS ;2 loop back to >NUMBER to terminate conversion
+ JZ TONUMPLUS ;2 yes: loop back to >NUMBER to terminate conversion
+ .ENDIF ; DOUBLE_INPUT
+; ----------------------------------;52
+ .IFDEF FIXPOINT_INPUT ;
+ .IFNDEF DOUBLE_INPUT
+ CMP #0,TOS ;1 cnt2=0 : conversion is ok ?
+ JZ QNUMNEXT1 ;2 yes
+ BIT #UF9,SR ;2 already 1 ?
+ JNZ QNUMNEXT1 ;2 yes: abort
+ BIS #UF9,SR ;2 set double number flag
+ .ENDIF
QQcomma CMP.B #',',0(S) ;5 rejected char by >NUMBER is a comma ?
- JNZ QNUMNEXT1 ;2 no
+ JNZ QNUMNEXT1 ;2 no, goto QNUMNEXT1 (abort then)
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'
CMP.B #10,X ;2
JLO QS15Q16DIGI ;2
SUB.B #7,X ;2
- CMP.B #10,X ;2
- JLO S15Q16EOC ;2
+ CMP.B #10,X ;2 to skip all chars between "9" and "A"
+ JLO S15Q16EOC ;2 ens of conversion
QS15Q16DIGI CMP T,X ;1 R-- IP sign BASE is X a digit ?
- JHS S15Q16EOC ;2 -- c-addr ud2lo ud2lo' x ud2lo' if no
+ JHS S15Q16EOC ;2 -- c-addr ud2lo ud2lo' x ud2lo' if no goto QNUMNEXT1 (abort then)
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
+ PUSHM #3,S ;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
+ POPM #3,S ;6 restore W,T,S: R-- IP sign BASE
JMP S15Q16LOOP ;2 W=cnt
-S15Q16EOC MOV 4(PSP),2(PSP) ;5 -- c-addr ud2lo ud2hi uqlo x ud2lo from >NUMBER part1 becomes here ud2hi=S15 part2
- MOV @PSP,4(PSP) ;4 -- c-addr ud2lo ud2hi x x uqlo becomes ud2lo
+S15Q16EOC MOV 4(PSP),2(PSP) ;5 -- c-addr ud2lo ud2hi uqlo x ud2lo from >NUMBER part1 becomes here ud2hi part of Q15.16
+ MOV @PSP,4(PSP) ;4 -- c-addr ud2lo ud2hi x x uqlo becomes ud2lo part of Q15.16
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
-
- .ENDIF
-
-; ----------------------------------;88
+ CMP.B #0,TOS ;1 TOS = 0 if end of conversion (happy end)
+ .ENDIF ; FIXPOINT_INPUT
+; ----------------------------------;54
QNUMNEXT1 POPM #3,IP ;4 -- c-addr ud2lo-hi x cnt2 POPM T,S,IP S = sign flag = {-1;0}
MOV S,TOS ;1 -- c-addr ud2lo-hi x sign
MOV T,&BASE ;3
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
+; ----------------------------------;63
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 !!!
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
+QNUMEND mNEXT ;4 TOS=-1 and Z=0 ==> conversion ok
+; ----------------------------------;85/125 words
- .ELSE ; no hardware HRDWMPY
+ .ELSE ; no hardware MPY
; T.I. SIGNED MULTIPLY SUBROUTINE: U1 x U2 -> Ud
-
;https://forth-standard.org/standard/core/UMTimes
;C UM* u1 u2 -- ud unsigned 16x16->32 mult.
FORTHWORD "UM*"
;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 ; 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: good end
- SUB.B #07,X ;2 skip all chars between "9" and "A"
- CMP.B #10,X ;2 char was < "A" ?
- JLO TONUMEND ;2 yes: bad end
-DDIGITQNEXT CMP &BASE,X ; -- ud1lo ud1hi x x digit-base
- JHS TONUMEND ; U>=
-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 ;
-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 ;
-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
- POPM #3,IP ; -- 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
+TONUMBER MOV @PSP,S ;2 S=adr
+ MOV TOS,T ;1 T=count
+ MOV &BASE,W ;3
+TONUMLOOP MOV.B @S,Y ;2 -- ud1lo ud1hi x x S=adr, T=count, W=BASE, Y=char
+DDIGITQ SUB.B #30h,Y ;2 skip all chars < '0'
+ CMP.B #10,Y ;2 char was > "9" ?
+ JLO DDIGITQNEXT ;2 -- ud1lo ud1hi x x no: good end
+ SUB.B #07,Y ;2 skip all chars between "9" and "A"
+ CMP.B #10,Y ;2 char was < "A" ?
+ JLO TONUMEND ;2 yes: for bad end
+DDIGITQNEXT CMP W,Y ;1 -- ud1lo ud1hi x x digit-base
+ JHS TONUMEND ;2 U>=
+UDSTAR PUSHM #6,IP ;8 -- ud1lo ud1hi x x r-- IP adr count base x digit
+ MOV 2(PSP),S ;3 -- ud1lo ud1hi x x S=ud1hi
+ MOV W,TOS ;1 -- ud1lo ud1hi x base
+ MOV #UMSTARNEXT1,IP ;2
+UMSTARONE JMP UMSTAR1 ;2 ud1hi * base -- x ud3hi X=ud3lo
+UMSTARNEXT1 FORTHtoASM ; -- ud1lo ud1hi x ud3hi
+ MOV X,2(RSP) ;3 r-- IP adr count base ud3lo digit
+ MOV 4(PSP),S ;3 -- ud1lo ud1hi x ud3hi S=ud1lo
+ MOV 4(RSP),TOS ;3 -- ud1lo ud1hi x base
+ MOV #UMSTARNEXT2,IP ;2
+UMSTARTWO JMP UMSTAR1 ;2 -- ud1lo ud1hi x ud4hi X=ud4lo
+UMSTARNEXT2 FORTHtoASM ; -- ud1lo ud1hi x ud4hi
+ ADD @RSP+,X ;2 -- ud1lo ud1hi x ud4hi X=ud4lo+digit=ud2lo r-- IP adr count base ud3lo
+MPLUS ADDC @RSP+,TOS ;2 -- ud1lo ud1hi x ud2hi TOS=ud4hi+ud3lo+carry=ud2hi r-- IP adr count base
+ MOV X,4(PSP) ;3 -- ud2lo ud1hi x ud2hi
+ MOV TOS,2(PSP) ;3 -- ud2lo ud2hi x x r-- IP adr count base
+ POPM #4,IP ;6 -- ud2lo ud2hi x x W=base, T=count, S=adr, IP=prevIP r--
+TONUMPLUS ADD #1,S ;1
+ SUB #1,T ;1
+ JNZ TONUMLOOP ;2 -- ud2lo ud2hi x x S=adr+1, T=count-1, W=base 68 cycles char loop
+TONUMEND MOV S,0(PSP) ;3 -- ud2lo ud2hi adr2 count2
+ MOV T,TOS ;1 -- ud2lo ud2hi adr2 count2
+ mNEXT ;4 50/82 words/cycles, W = BASE
; convert a string to a signed number
;Z ?NUMBER c-addr -- n -1 if convert ok ; flag Z=0
; 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 MOV #0,S ;1
+QNUMBER BIC #UF9,SR ;2 reset flag UF9 used here as decimal point flag
MOV &BASE,T ;3 T=BASE
- BIC #UF9,SR ;2 reset flag UF9 used here as decimal point flag
- .word 152Dh ;5 R-- IP sign base
+ MOV #0,S ;1
+ PUSHM #3,IP ;5 R-- IP sign base
MOV #QNUMNEXT,IP ;2 define >NUMBER return
+ MOV T,W ;1 W=BASE
SUB #8,PSP ;1 -- x x x x c-addr
MOV TOS,6(PSP) ;3 -- c-addr x x x c-addr
MOV #0,4(PSP) ;3
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
+QBINARY MOV #2,W ;1 preset base 2
ADD.B #8,X ;1 '%' + 8 = '-' binary number ?
JZ PREFIXED ;2
-QDECIMAL ADD #8,&BASE ;4
+QDECIMAL ADD #8,W ;1
ADD.B #2,X ;1 '#' + 2 = '%' decimal number ?
JZ PREFIXED ;2
-QHEXA MOV #16,&BASE ;4
+QHEXA MOV #16,W ;1
SUB.B #1,X ;2 '$' - 1 = '#' hex number ?
JNZ TONUMLOOP ;2 -- c-addr ud=0 x x other cases will cause error
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
+QSIGN CMP.B #1,X ;1 char= '-' ?
+ JNZ TONUMLOOP ;2 no (positive number or ',' or '.' )
MOV #-1,2(RSP) ;3 R-- IP sign base
JMP TONUMPLUS ;2
; ----------------------------------;45
QNUMNEXT FORTHtoASM ; -- c-addr ud2lo-hi addr2 cnt2 R-- IP sign BASE S=addr2,T=cnt2
+ .IFDEF DOUBLE_INPUT
CMP #0,TOS ;1 cnt2=0 ? conversion is ok ?
- JZ QNUMNEXT1 ;2 yes
- BIT #UF9,SR ;2 already flagged double ?
- ; ( test to discard repeated points or repeated commas)
+ JZ QNUMNEXT1 ;2 yes (neither comma nor point in string)
+ BIT #UF9,SR ;2 already flagged? (to discard repeated points or repeated commas)
JNZ QNUMNEXT1 ;2 abort
BIS #UF9,SR ;2 set double number flag
-; ----------------------------------;
-
- .IFDEF FIXPOINT_INPUT
-
+ SUB #2,IP ;1 yes set >NUMBER return address
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
+ JZ TONUMPLUS ;2 to terminate conversion
+ .ENDIF ; DOUBLE_INPUT
+; ----------------------------------;52
+ .IFDEF FIXPOINT_INPUT ;
+ .IFNDEF DOUBLE_INPUT
+ CMP #0,TOS ;1 cnt2=0 : conversion is ok ?
+ JZ QNUMNEXT1 ;2 yes
+ BIT #UF9,SR ;2 already 1 ?
+ JNZ QNUMNEXT1 ;2 yes: end of conversion
+ BIS #UF9,SR ;2 set double number flag
+ .ENDIF
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
+S15Q16 MOV #0,X ;1 -- c-addr ud2lo x 0 x init ud2lo' = 0
S15Q16LOOP MOV X,2(PSP) ;3 -- c-addr ud2lo ud2lo' ud2lo' x X = 0(PSP) = ud2lo'
- SUB.B #1,W ;1 decrement cnt2
- MOV W,X ;1 X = cnt2-1
+ SUB.B #1,T ;1 decrement cnt2
+ MOV T,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
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 ?
+QS15Q16DIGI CMP W,X ;1 R-- IP sign BASE, W=BASE, is X a digit ?
JHS S15Q16EOC ;2 -- c-addr ud2lo ud2lo' x ud2lo' if no
MOV X,0(PSP) ;3 -- c-addr ud2lo ud2lo' digit x
- MOV 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
+ MOV W,TOS ;1 -- c-addr ud2lo ud2lo' digit base R-- IP sign base
+ PUSHM #3,S ;5 PUSH S,T,W: R-- IP sign base addr2 cnt2 base
CALL #MUSMOD ;4 -- c-addr ud2lo ur uqlo uqhi
- .word 172Ah ;6 restore W,T,S: R-- IP sign BASE
+ POPM #3,S ;5 restore W,T,S: R-- IP sign BASE
JMP S15Q16LOOP ;2 W=cnt
S15Q16EOC MOV 4(PSP),2(PSP) ;5 -- c-addr ud2lo ud2lo uqlo x ud2lo from >NUMBER part1 becomes here ud2hi=S15 part2
MOV @PSP,4(PSP) ;4 -- c-addr ud2lo ud2hi x x uqlo becomes ud2lo
- MOV W,TOS ;1 -- c-addr ud2lo ud2hi x cnt2
+ MOV T,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
-
- .ENDIF
-
+ .ENDIF
; ----------------------------------;97
QNUMNEXT1 POPM #3,IP ;4 -- c-addr ud2lo-hi x cnt2 POPM T,S,IP S = sign flag = {-1;0}
MOV S,TOS ;1 -- c-addr ud2lo-hi x sign
QNUMEND mNEXT ;4 TOS=-1 and Z=0 ==> conversion ok
; ----------------------------------;128 words
- .ENDIF ; HRDWMPY
+ .ENDIF ; of Hardware/Software MPY
;https://forth-standard.org/standard/core/EXECUTE
;C EXECUTE i*x xt -- j*x execute Forth word at 'xt'
MOV #lit,0(W) ;4
MOV TOS,2(W) ;3
MOV @PSP+,TOS ;2
+ .IFDEF DOUBLE_LITERAL
BIT #UF9,SR ;2
BIC #UF9,SR ;2
- JNZ LITERAL1 ;2
-LITERALEND mNEXT ;4 30~
+ JZ LITERALEND ;2
+ MOV 2(W),X ;3
+ MOV TOS,2(W) ;3
+ MOV X,TOS ;1
+ JMP LITERAL1 ;2
+ .ENDIF
+LITERALEND mNEXT ;4
;https://forth-standard.org/standard/core/COUNT
;C COUNT c-addr1 -- adr len counted->adr/len
mNEXT ;4 15~
; : SETIB SOURCE 2! 0 >IN ! ; ; org len -- set Input Buffer, shared by INTERPRET and [ELSE]
-SETIB MOV #0,&TOIN ;
- MOV TOS,&SOURCE_LEN ; -- org len
+SETIB MOV TOS,&SOURCE_LEN ; -- org len
MOV @PSP+,&SOURCE_ADR ; -- len
MOV @PSP+,TOS ; --
+ MOV #0,&TOIN ;
mNEXT ;
;C INTERPRET i*x addr u -- j*x interpret given buffer
; This is the common factor of EVALUATE and QUIT.
; set addr u as input buffer then parse it word by word
INTERPRET mDOCOL ;
- .word SETIB ; set Input buffer pointers SOURCE_LEN, SOURCE_ORG clear >IN
+ .word SETIB ; set SOURCE_LEN, SOURCE_ORG and clear >IN
INTLOOP .word FBLANK,WORDD ; -- c-addr Z = End Of Line
FORTHtoASM ;
MOV #INTFINDNEXT,IP ;2 define INTFINDNEXT as FIND return
- JNZ FIND ;2 if EOL not reached
- JMP DROPEXIT ; if EOL reached
+ JNZ FIND ;2 Z=0, EOL not reached
+ JMP DROPEXIT ; Z=1, EOL reached
INTFINDNEXT FORTHtoASM ; -- c-addr fl Z = not found
MOV TOS,W ; W = flag =(-1|0|+1) as (normal|not_found|immediate)
MOV @PSP+,TOS ; -- c-addr
MOV #INTQNUMNEXT,IP ;2 define QNUMBER return
- JZ QNUMBER ;2 c-addr -- if not found search a number
+ JZ QNUMBER ;2 c-addr -- Z=1, not found, search a number
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
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 string
+ JNZ LITERAL ;2 n -- Z=0, is a number, execute LITERAL then loop back to INTLOOP
+NotFoundExe ADD.B #1,0(TOS) ;3 c-addr -- Z=1, Not a Number : incr string count to add '?'
+ MOV.B @TOS,Y ;2 Y=count+1
+ ADD TOS,Y ;1 Y=end of string addr
+ MOV.B #'?',0(Y) ;5 add '?' to end of string
MOV #FQABORTYES,IP ;2 define COUNT return
JMP COUNT ;2 -- addr len 36 words
MOV @RSP+,&TOIN ;4
MOV @RSP+,&SOURCE_ADR ;4
MOV @RSP+,&SOURCE_LEN ;4
- MOV @RSP+,IP ;2
- mNEXT
+ mSEMI
+ .IFDEF DEFER_QUIT ; defined in device.inc
-PREQUIT0 MOV #0,&SAVE_SYSRSTIV ;
-PREQUIT1 MOV #RSTACK,RSP
- MOV #LSTACK,&LEAVEPTR
- MOV #0,&STATE
- mNEXT
+QUIT0 MOV #0,&SAVE_SYSRSTIV ; clear SAVE_SYSRSTIV, usefull for next ABORT...
+ MOV #RSTACK,RSP ; ANS mandatory for QUIT
+ MOV #LSTACK,&LEAVEPTR ;
+ MOV #0,&STATE ; ANS mandatory for QUIT
+ mNEXT
- .IFDEF BOOTLOAD ; Boot loader requires Conditional Compilation
-;c BOOT -- jump to bootstrap then continues with (QUIT)
+;c BOOT -- load BOOT.4th file from SD_Card then loop to QUIT1
FORTHWORD "BOOT"
-BOOT ASMtoFORTH ;
- .word PREQUIT1 ; doesn't reset SAVE_SYSRSTIV before testing !
- FORTHtoASM ;
-; ----------------------------------;
-; BOOTSTRAP TEST ;
-; ----------------------------------;
- CMP #0,&SAVE_SYSRSTIV ; if WARM
- JZ QUIT0 ; no boostrap
+ CMP #0,&SAVE_SYSRSTIV ; = 0 if WARM
+ JZ BODYQUIT ; no boostrap if no reset event, default QUIT instead
BIT.B #SD_CD,&SD_CDIN ; SD_memory in SD_Card module ?
- JNZ QUIT0 ; if not, no bootstrap
-; ----------------------------------;
-; BOOTSTRAP ; on SYSRSTIV <> 0
-; ----------------------------------;
+ JNZ BODYQUIT ; if not, no bootstrap, default QUIT instead
SUB #2,PSP ;
MOV TOS,0(PSP) ;
- MOV &SAVE_SYSRSTIV,TOS ;
- MOV #0,&SAVE_SYSRSTIV ;
+ MOV &SAVE_SYSRSTIV,TOS ; -- SAVE_SYSRSTIV TOS = reset event, for tests in BOOT.4TH
ASMtoFORTH ;
- .IFDEF QUIETBOOT
- .word NOECHO ; warning ! your BOOT.4TH must to be finished with ECHO command!
- .ENDIF
+ .IFDEF QUIETBOOT ;
+ .word NOECHO ; warning ! your BOOT.4TH must to be finished with ECHO command!
+ .ENDIF ;
+ .word QUIT0 ;
.word XSQUOTE ; -- addr u
- .byte 15,"LOAD\34 BOOT.4TH\34" ; issues error 2 if no such file...
+ .byte 15,"LOAD\34 BOOT.4TH\34" ; LOAD" BOOT.4TH" issues error 2 if no such file...
.word BRAN,QUIT4 ; to interpret this string
; ----------------------------------;
;https://forth-standard.org/standard/core/QUIT
;c QUIT -- interpret line by line the input stream, primary DEFERred word
+; to enable bootstrap type: ' BOOT IS QUIT
+; to disable bootstrap type: ' QUIT >BODY IS QUIT
+
FORTHWORD "QUIT"
-QUIT MOV @PC+,PC
- .word BODYQUIT ; this word may be replaced by BOOT
-BODYQUIT
+QUIT MOV @PC+,PC ;3 Code Field Address (CFA) of QUIT
+PFAQUIT .word BODYQUIT ; Parameter Field Address (PFA) of QUIT
+BODYQUIT ASMtoFORTH ; BODY of QUIT = default execution of QUIT
+ .word QUIT0 ;
.ELSE ; if no BOOTLOADER, QUIT is not DEFERred
;c QUIT -- interpret line by line the input stream
FORTHWORD "QUIT"
QUIT
+QUIT0 MOV #0,&SAVE_SYSRSTIV ; clear SAVE_SYSRSTIV, usefull for next ABORT...
+ MOV #RSTACK,RSP ; ANS mandatory for QUIT
+ MOV #LSTACK,&LEAVEPTR ;
+ MOV #0,&STATE ; ANS mandatory for QUIT
+ ASMtoFORTH ;
- .ENDIF ; bootloader
+ .ENDIF
-QUIT0 ASMtoFORTH
- .word PREQUIT0
-QUIT1 .word XSQUOTE
+QUIT1 .word XSQUOTE ;
.byte 5,13,10,"ok " ; CR+LF + Forth prompt
QUIT2 .word TYPE ; display it
- .word REFILL
-QUIT3 .word SPACE
-QUIT4 .word INTERPRET
- .word DEPTH,ZEROLESS
- .word XSQUOTE
- .byte 13,"stack empty! "
- .word QABORT
- .word lit,FRAM_FULL,HERE,ULESS
- .word XSQUOTE
- .byte 11,"FRAM full! "
- .word QABORT
- .word FSTATE,FETCH
- .word QBRAN,QUIT1 ; case of interpretion state
- .word XSQUOTE ; case of compilation state
- .byte 5,13,10," " ; CR+LF + 3 blanks
+ .word REFILL ; refill input buffer (one line)
+QUIT3 .word SPACE ;
+QUIT4 .word INTERPRET ; interpret this line
+ .word DEPTH,ZEROLESS ; stack empty test
+ .word XSQUOTE ; ABORT" stack empty! "
+ .byte 13,"stack empty! ";
+ .word QABORT ;
+QUIT5 .word lit,FRAM_FULL,HERE,ULESS ; FRAM full test
+ .word XSQUOTE ; ABORT" FRAM full! "
+ .byte 11,"FRAM full! ";
+ .word QABORT ;
+QUIT6 .word FSTATE,FETCH ; STATE @
+ .word QBRAN,QUIT1 ; 0= case of interpretion state
+ .word XSQUOTE ; 0<> case of compilation state
+ .byte 5,13,10," " ; CR+LF + 3 spaces
.word BRAN,QUIT2
;https://forth-standard.org/standard/core/ABORT
ABORT MOV #PSTACK,PSP
JMP QUIT
-WIP_DEFER ; WIPE resets ALL factory primary DEFERred words
- MOV #BODYWARM,&WARM+2 ; (WARM) is WARM kill user interrupts init
- MOV #BODYSLEEP,&SLEEP+2 ; (SLEEP) is SLEEP kill user background task
-QAB_DEFER ; QABORT resets some primary DEFERred words
- MOV #BODYEMIT,&EMIT+2 ;4 (EMIT) is EMIT default console output
- MOV #BODYCR,&CR+2 ;4 (CR) is CR default CR
- MOV #BODYKEY,&KEY+2 ;4 (KEY) is KEY default KEY
-
- .IFDEF DEFER_INPUT ; true if SD_LOADER
- MOV #BODYACCEPT,&ACCEPT+2 ;4 (ACCEPT) is ACCEPT
- MOV #TIB_ORG,&FCIB+2 ;4 TIB is CIB (Current Input Buffer)
- .ENDIF
- .IFDEF MSP430ASSEMBLER ; reset all 6 branch labels
- MOV #10,Y
- MOV Y,&BASE
-RAZASM MOV #0,ASMFW1(Y)
- SUB #2,Y
- JHS RAZASM
- .ELSE
- MOV #10,&BASE ;4
- .ENDIF
- RET
-
-RefillUSBtime .equ int(frequency*2730) ; 2730*frequency ==> 65520 @ max freq (24MHz)
-
-;Z ?ABORT f c-addr u -- abort & print msg
+; define run-time part of ABORT"
+;Z ?ABORT f c-addr u -- abort & print msg,
; FORTHWORD "?ABORT"
QABORT CMP #0,2(PSP) ; -- f c-addr u flag test
- JNZ QABORTYES
-THREEDROP ADD #4,PSP
- MOV @PSP+,TOS
- mNEXT
-
-QABORTYES MOV #4882h,&YEMIT ; restore default YEMIT = set ECHO
- .IFDEF SD_CARD_LOADER ; close all handles
- MOV &CurrentHdl,T
-QABORTCLOSE CMP #0,T
- JZ QABORTCLOSEND
- MOV.B #0,HDLB_Token(T)
- MOV @T,T
- JMP QABORTCLOSE
-QABORTCLOSEND
- .ENDIF
+ JNZ QABORTYES ;
+THREEDROP ADD #4,PSP ;
+ MOV @PSP+,TOS ;
+ mNEXT ;
+; ----------------------------------; QABORTYES = QABORT + 14
+QABORTYES CALL #QAB_DEFER ; init some variables, see WIPE
; ----------------------------------;
-QABORTYESNOECHO ; <== WARM jumps here, thus, if NOECHO, TERMINAL can be disconnected without freezing the app
+QABORT_SDCARD ; close all handles
; ----------------------------------;
- CALL #QAB_DEFER ; restore default part of primary DEFERred words ....except WARM and SLEEP.
+ .IFDEF SD_CARD_LOADER ;
+ MOV &CurrentHdl,T ;
+QABORTCLOSE CMP #0,T ;
+ JZ QABORTCLOSEND ;
+ MOV.B #0,HDLB_Token(T) ;
+ MOV @T,T ;
+ JMP QABORTCLOSE ;
+QABORTCLOSEND ;
+ .ENDIF ;
; ----------------------------------;
-QABORTTERM ; wait the end of source file downloading
+QABORT_TERM ; wait the end of downloading source file
; ----------------------------------;
- .IFDEF TERMINAL3WIRES ;
- BIT #UCTXIFG,&TERMIFG ; TX buffer empty ?
- JZ QABORTTERM ; no
- MOV #17,&TERMTXBUF ; yes move XON char into TX_buf
- .ENDIF ;
- .IFDEF TERMINAL4WIRES ;
- BIC.B #RTS,&HANDSHAKOUT ; set /RTS low (connected to /CTS pin of UARTtoUSB bridge)
- .ENDIF ;
-QABORTLOOP BIC #UCRXIFG,&TERMIFG ; reset TERMIFG(UCRXIFG)
- MOV #RefillUSBtime,Y ; 2730*36 = 98 ms : PL2303TA seems to be the slower USB device to refill its TX buffer.
-QABUSBLOOPJ MOV #8,X ; 1~ <-------+
+ CALL #RXON ; send XON and/or set RTS low
+QABORTLOOP BIC #UCRXIFG,&TERM_IFG ; clear UCRXIFG
+ MOV #int(frequency*2730),Y ; 2730*frequency ==> 65520 @ 24MHz
+QABUSBLOOPJ MOV #8,X ; 1~ <-------+ windows 10 seems very slow... ==> 2730*36 = 98ms delay
+ ADD X,X ; 1~ | linux seems very very slow... ==> 2730*69 = 188ms delay
QABUSBLOOPI NOP ; 1~ <---+ |
SUB #1,X ; 1~ | |
- JNZ QABUSBLOOPI ; 2~ > 4~ loop -+ |
+ JNZ QABUSBLOOPI ; 2~ 4~ loop ---+ |
SUB #1,Y ; 1~ |
- JNZ QABUSBLOOPJ ; 2~ --> 36~ loop --+
- BIT #UCRXIFG,&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 ; no, the input stream is quiet (end of download source file)
+ JNZ QABUSBLOOPJ ; 2~ 36~/69~ loop --+
+ BIT #UCRXIFG,&TERM_IFG ; 4 new char in TERMRXBUF after refill delay ?
+ JNZ QABORTLOOP ; 2 yes, the input stream is still active: loop back
+; ----------------------------------; no, end of downloading source file
+; Display ABORT" message ; in reverse video mode
; ----------------------------------;
+QABORT_DISPLAY ; <== WARM jumps here
mDOCOL ;
+ .word lit,LINE,FETCH
+ .word ECHO ;
.word XSQUOTE ; -- c-addr u c-addr1 u1
- .byte 4,27,"[7m" ;
+ .byte 4,27,"[7m" ; type ESC[7m
.word TYPE ; -- c-addr u set reverse video
-ERRLINE .word lit,LINE,FETCH,QDUP; if LINE <> 0
- .word QBRAN,ERRLINE_END
- .word XSQUOTE ; displays the line where error occured
+ .word QDUP ; if LINE <> 0
+ .word QBRAN,ERRLINE_END; if LINE = 0
+ERRLINE .word XSQUOTE ; else displays the line where error occured
.byte 5,"line:" ;
.word TYPE ;
- .word ONEMINUS,UDOT ;
- .word ECHO ;
+ .word ONEMINUS ;
+ .word UDOT ;
ERRLINE_END .word TYPE ; -- type abort message
.word XSQUOTE ; -- c-addr2 u2
.byte 4,27,"[0m" ;
.word TYPE ; -- set normal video
; ----------------------------------;
.word PWR_STATE ; remove all words beyond PWR_HERE
- .IFDEF LOWERCASE ;
- .word CAPS_ON ;
- .ENDIF ;
- .word ABORT ; no return
+FABORT .word ABORT ; no return
; ----------------------------------;
;https://forth-standard.org/standard/core/ABORTq
;C ABORT" i*x flag -- i*x R: j*x -- j*x flag=0
;C i*x flag -- R: j*x -- flag<>0
- FORTHWORDIMM "ABORT\34" ; immediate
-ABORTQUOTE mDOCOL
+ FORTHWORDIMM "ABORT\34" ; immediate
+ABORTQUOTE mDOCOL ; ABORT address + 10
.word SQUOTE
.word lit,QABORT,COMMA
.word EXIT
;https://forth-standard.org/standard/block/bs
; \ -- backslash
; everything up to the end of the current line is a comment.
- FORTHWORDIMM "\\" ; immediate
-BACKSLASH MOV &SOURCE_LEN,&TOIN ;
+ FORTHWORDIMM "\\" ; immediate
+BACKSLASH MOV &SOURCE_LEN,&TOIN ;
mNEXT
;-------------------------------------------------------------------------------
.word COMMA,EXIT ; append xt literal
;https://forth-standard.org/standard/core/DEFERStore
-;C DEFER! xt CFA_DEFER -- ; store xt to the address after DODEFER
+;C DEFER! xt CFA_DEFER -- ; store xt into the PFA of DEFERed word
; FORTHWORD "DEFER!"
DEFERSTORE MOV @PSP+,2(TOS) ; -- CFA_DEFER xt --> [CFA_DEFER+2]
MOV @PSP+,TOS ; --
; or in a definition : ... ['] U. IS DISPLAY ...
; KEY, EMIT, CR, ACCEPT and WARM are examples of DEFERred words
-; as IS replaces the PFA value of a "PFA word", it may be also used with VARIABLE and CONSTANT words...
+; as IS replaces the PFA value of a "PFA word", it may be also used as TO for VARIABLE (and CONSTANT!) words...
FORTHWORDIMM "IS" ; immediate
IS mDOCOL
- .word FSTATE,FETCH
- .word QBRAN,IS_EXEC
-IS_COMPILE .word BRACTICK ; find the word, compile its CFA as literal
- .word lit,DEFERSTORE,COMMA ; compile DEFERSTORE
- .word EXIT
-IS_EXEC .word TICK,DEFERSTORE ; find the word, leave its CFA on the stack and execute DEFERSTORE
- .word EXIT
+ .word FSTATE,FETCH ; STATE @
+ .word QBRAN,IS_EXEC ; if = 0
+IS_COMPILE .word BRACTICK ; find the word, compile its CFA as literal
+ .word lit,DEFERSTORE,COMMA; compile DEFERSTORE
+ .word EXIT ;
+IS_EXEC .word TICK,DEFERSTORE ; find the word, leave its CFA on the stack and
+ .word EXIT ; put it into PFA of DEFERed word, then exit.
;https://forth-standard.org/standard/core/IMMEDIATE
;C IMMEDIATE -- make last definition immediate
.word lit,COMMA
POST1 .word COMMA,EXIT
-;;Z ?REVEAL -- if no stack mismatch, link this created word in the CURRENT vocabulary
-; FORTHWORD "REVEAL"
-QREVEAL CMP PSP,&LAST_PSP ; Check SP with its saved value by :
- JZ GOOD_CSP ; if no stack mismatch.
-BAD_CSP mDOCOL
- .word XSQUOTE
- .byte 15,"stack mismatch!"
-FQABORTYES .word QABORTYES
-
;https://forth-standard.org/standard/core/Semi
;C ; -- end a colon definition
FORTHWORDIMM ";" ; immediate
-SEMICOLON CMP #0,&STATE ; in interpret mode semicolon becomes a comment separator
+SEMICOLON CMP #0,&STATE ; if 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
FORTHWORD ":NONAME"
COLONNONAME SUB #2,PSP
MOV TOS,0(PSP)
- MOV &DDP,TOS
- MOV TOS,W
- MOV #PAIN,X ; PAIN is a read only register in all MSP430FRxxxx devices...
- MOV X,Y ; so, MOV Y,0(X) writes to a read only register = lure for semicolon LAST_THREAD REVEAL...
- ADD #2,Y ; so, MOV @X,-2(Y) writes to same register = lure for semicolon LAST_NFA REVEAL...
- CALL #HEADEREND ; ...because we don't want write preamble of word in dictionnary!
+ MOV &DDP,TOS ; -- xt
+ MOV TOS,W ; W=CFA
+ MOV #PAIN,X ;2 MOV Y,0(X) writes to PAIN read only register = first lure for semicolon REVEAL...
+ MOV #PAOUT,Y ;2 MOV @X,-2(Y) writes to PAIN register = 2th lure for semicolon REVEAL...
+ CALL #HEADEREND ; ...because we don't want write a preamble of word in dictionnary!
.ENDIF ; NONAME
+
+;-----------------------------------; common part of NONAME and :
COLONNEXT
.SWITCH DTC
.CASE 1
MOV #-1,&STATE ; enter compiling state
SAVE_PSP MOV PSP,&LAST_PSP ; save PSP for check compiling, used by QREVEAL
PFA_DEFER mNEXT
+;-----------------------------------;
+
;https://forth-standard.org/standard/core/Colon
;C : <name> -- begin a colon definition
COLON PUSH #COLONNEXT ; define COLONNEXT as RET for HEADER
; HEADER create an header for a new word. Max count of chars = 126
-; common code for VARIABLE, CONSTANT, CREATE, DEFER, :, MARKER, CODE, ASM.
-; don't link created word in vocabulary.
+; common code for DEFER, VARIABLE, CONSTANT, CREATE, :, MARKER, CODE, ASM.
+; doesn't link the created word in vocabulary.
HEADER mDOCOL
- .word CELLPLUSALIGN ; ALIGN then make room for LFA
+ .word CELLPLUSALIGN ; align and make room for LFA
.word FBLANK,WORDD ;
FORTHtoASM ; -- HERE HERE is the NFA of this new word
+ MOV @RSP+,IP
MOV TOS,Y ;
MOV.B @TOS+,W ; -- xxx W=Count_of_chars Y=NFA
BIS.B #1,W ; -- xxx W=count is always odd
ADD TOS,X ; -- xxx TOS= Thread X=VOC_PFAx = thread x of VOC_PFA of CURRENT
.ENDCASE
MOV @PSP+,TOS ; --
- MOV @RSP+,IP
- MOV #4030h,0(W) ;4 by default, HEADER create a DEFERred word: CFA = MOV @PC+,PC = BR...
- MOV #PFA_DEFER,2(W) ;4 by default, HEADER create a DEFERred word: PFA = address of NEXT to do nothing.
+ MOV #4030h,0(W) ;4 by default, HEADER create a DEFERred word: CFA = MOV @PC+,PC = BR mNEXT
+ MOV #PFA_DEFER,2(W) ;4 by default, HEADER create a DEFERred word: PFA = address of mNEXT to do nothing.
-HEADEREND MOV Y,&LAST_NFA ; -- NFA --> LAST_NFA used by QREVEAL, IMMEDIATE
+HEADEREND MOV Y,&LAST_NFA ; -- NFA --> LAST_NFA used by QREVEAL, IMMEDIATE, MARKER
MOV X,&LAST_THREAD ; -- VOC_PFAx --> LAST_THREAD used by QREVEAL
MOV W,&LAST_CFA ; -- HERE=CFA --> LAST_CFA used by DOES>, RECURSE
ADD #4,W ; -- by default make room for two words...
MOV W,&DDP ; --
- RET ; 23 words, W is the new DDP value )
+ RET ; 30 words, W is the new DDP value )
; X is LAST_THREAD > used by VARIABLE, CONSTANT, CREATE, DEFER and :
; Y is NFA )
+ .IFDEF CONDCOMP
+; ------------------------------------------------------------------------------
+; forthMSP430FR : CONDITIONNAL COMPILATION
+; ------------------------------------------------------------------------------
+ .include "forthMSP430FR_CONDCOMP.asm"
+
+ ; compile COMPARE [THEN] [ELSE] [IF] [UNDEFINED] [DEFINED] MARKER
+
+; ------------------------------------------------------------------------------
+ .ENDIF
+
+GOOD_CSP MOV &LAST_NFA,Y ; GOOD_CSP is the end of word MARKER
+ MOV &LAST_THREAD,X ;
+REVEAL MOV @X,-2(Y) ; [LAST_THREAD] --> LFA (for NONAME: [LAST_THREAD] --> PAIN)
+ MOV Y,0(X) ; LAST_NFA --> [LAST_THREAD] (for NONAME: LAST_NFA --> PAIN)
+ mNEXT
+
+;;Z ?REVEAL -- if no stack mismatch, link this new word in the CURRENT vocabulary
+; FORTHWORD "REVEAL"
+QREVEAL CMP PSP,&LAST_PSP ; Check SP with its saved value by :
+ JZ GOOD_CSP ; if no stack mismatch.
+BAD_CSP mDOCOL
+ .word XSQUOTE
+ .byte 15,"stack mismatch!"
+FQABORTYES .word QABORTYES
+
;https://forth-standard.org/standard/core/VARIABLE
;C VARIABLE <name> -- define a Forth VARIABLE
FORTHWORD "VARIABLE"
VARIABLE CALL #HEADER ; W = DDP = CFA + 2 words
- MOV #DOVAR,-4(W) ; CFA = DOVAR
- JMP REVEAL ; PFA is undefined
+ MOV #DOVAR,-4(W) ; CFA = DOVAR, PFA is undefined
+ JMP REVEAL ; to link created VARIABLE in vocabulary
;https://forth-standard.org/standard/core/CONSTANT
-;C CONSTANT <name> n -- define a Forth CONSTANT (it's also an alias of VALUE)
+;C CONSTANT <name> n -- define a Forth CONSTANT (and also a Forth VALUE)
FORTHWORD "CONSTANT"
CONSTANT CALL #HEADER ; W = DDP = CFA + 2 words
MOV #DOCON,-4(W) ; CFA = DOCON
MOV TOS,-2(W) ; PFA = n
MOV @PSP+,TOS
- JMP REVEAL
+ JMP REVEAL ; to link created CONSTANT in vocabulary
;;https://forth-standard.org/standard/core/VALUE
;;( x "<spaces>name" -- ) define a Forth VALUE
; ; the execution semantics of name may be extended by using DOES>
FORTHWORD "CREATE"
CREATE CALL #HEADER ; -- W = DDP
- MOV #DOCON,-4(W) ;4 CFA = DOCON
- MOV W,-2(W) ;3 PFA = next address
- JMP REVEAL
+ MOV #DOCON,-4(W) ;4 -4(W) = CFA = DOCON
+ MOV W,-2(W) ;3 -2(W) = PFA = W = next address
+ JMP REVEAL ; to link created word in vocabulary
;https://forth-standard.org/standard/core/DOES
;C DOES> -- set action for the latest CREATEd definition
DOES MOV &LAST_CFA,W ; W = CFA of CREATEd word
MOV #DODOES,0(W) ; replace CFA (DOCON) by new CFA (DODOES)
MOV IP,2(W) ; replace PFA by the address after DOES> as execution address
- MOV @RSP+,IP ; exit of the new created word
- mNEXT
+ mSEMI ; exit of the new created word
;https://forth-standard.org/standard/core/DEFER
;C DEFER "<spaces>name" --
;until the phrase ' word IS name is executed, causing a new value of xt to be assigned to name.
FORTHWORD "DEFER"
-DEFER CALL #HEADER ; that create a secondary DEFERred word (whithout subsequent code)
- JMP REVEAL
+DEFER PUSH #REVEAL ; to link created DEFER word in vocabulary
+ JMP HEADER ; that create a secondary DEFERed word (whithout default code)
;https://forth-standard.org/standard/core/toBODY
-; >BODY -- PFA leave BODY of a CREATEd or a primary DEFERred word
+; >BODY -- addr leave BODY of a CREATEd word or of a primary DEFERred word
FORTHWORD ">BODY"
- ADD #4,TOS
- mNEXT
-
- .IFDEF CONDCOMP
-
-; ------------------------------------------------------------------------------
-; forthMSP430FR : CONDITIONNAL COMPILATION
-; ------------------------------------------------------------------------------
- .include "forthMSP430FR_CONDCOMP.asm"
-
- ; compile the words: COMPARE [THEN] [ELSE] [IF] [UNDEFINED] [DEFINED] MARKER
-
- .ENDIF ; CONDCOMP
-
-GOOD_CSP MOV &LAST_NFA,Y ; GOOD_CSP is the end of word MARKER
- MOV &LAST_THREAD,X ;
-REVEAL MOV @X,-2(Y) ; [LAST_THREAD] --> LFA
- MOV Y,0(X) ; LAST_NFA --> [LAST_THREAD]
+ ADD #4,TOS
mNEXT
; ------------------------------------------------------------------------------
REPEAT mDOCOL
.word AGAIN,THEN,EXIT
-;https://forth-standard.org/standard/core/
-
+;https://forth-standard.org/standard/core/DO
;C DO -- DOadr L: -- 0
FORTHWORDIMM "DO" ; immediate
DO SUB #2,PSP ;
;C LOOP DOadr -- L-- an an-1 .. a1 0
FORTHWORDIMM "LOOP" ; immediate
LOO MOV #xloop,X
-ENDLOOP ADD #4,&DDP ; make room to compile two words
+LOOPNEXT ADD #4,&DDP ; make room to compile two words
MOV &DDP,W
MOV X,-4(W) ; xloop --> HERE
MOV TOS,-2(W) ; DOadr --> HERE+2
SUB #2,&LEAVEPTR ; --
MOV @TOS,TOS ; -- first LeaveStack value
CMP #0,TOS ; -- = value left by DO ?
- JZ ENDLOOPEND
+ JZ LOOPEND
MOV W,0(TOS) ; move adr after loop as UNLOOP adr
JMP LEAVELOOP
-ENDLOOPEND MOV @PSP+,TOS
+LOOPEND MOV @PSP+,TOS
mNEXT
;https://forth-standard.org/standard/core/PlusLOOP
;C +LOOP adrs -- L-- an an-1 .. a1 0
FORTHWORDIMM "+LOOP" ; immediate
PLUSLOOP MOV #xploop,X
- JMP ENDLOOP
+ JMP LOOPNEXT
;https://forth-standard.org/standard/core/LEAVE
;C LEAVE -- L: -- adrs
LEAV MOV &DDP,W ; compile three words
MOV #UNLOOP,0(W) ; [HERE] = UNLOOP
MOV #BRAN,2(W) ; [HERE+2] = BRAN
- ADD #6,&DDP ; [HERE+4] = take word for AfterLOOPadr
+ ADD #6,&DDP ; [HERE+4] = After LOOP adr
ADD #2,&LEAVEPTR
ADD #4,W
MOV &LEAVEPTR,X
JNZ MOVUP1
MOVE_X mNEXT
+
;-------------------------------------------------------------------------------
; WORDS SET for VOCABULARY, not ANS compliant
;-------------------------------------------------------------------------------
-;X VOCABULARY -- create a vocabulary
+;X VOCABULARY -- create a vocabulary, up to 7 vocabularies in CONTEXT
.IFDEF VOCABULARY_SET
VOCABULOOP .word lit,0,COMMA
.word xloop,VOCABULOOP
.ENDCASE
- .word HERE ; link via LASTVOC the future created vocabularies
+ .word HERE ; link via LASTVOC the future created vocabulary
.word LIT,LASTVOC,DUP
.word FETCH,COMMA ; compile [LASTVOC] to HERE+
.word STORE ; store (HERE - CELL) to LASTVOC
.IFDEF VOCABULARY_SET
FORTHWORD "FORTH"
.ENDIF ; VOCABULARY_SET
-FORTH mDODOES ; leave BODYFORTH on the stack and run VOCDOES
- .word VOCDOES
-BODYFORTH .word lastforthword
+FORTH ; leave BODYFORTH on the stack and run VOCDOES
+ mDODOES ; Code Field Address (CFA) of FORTH
+PFAFORTH .word VOCDOES ; Parameter Field Address (PFA) of FORTH
+BODYFORTH ; BODY of FORTH
+ .word lastforthword
.SWITCH THREADS
.CASE 2
.word lastforthword1
MARKVOC .word lastvoclink ; initialised by forthMSP430FR.asm as voclink value
MARKDP .word ROMDICT ; initialised by forthMSP430FR.asm as DP value
- FORTHWORD "RST_STATE" ; executed by <reset>, reinitializes dictionary in state defined by RST_HERE;
-RST_STATE MOV &INIVOC,&MARKVOC ; INI value saved in FRAM
- MOV &INIDP,&MARKDP ; INI value saved in FRAM
+ FORTHWORD "RST_STATE" ; executed by <reset>, reinitializes dictionary in state defined by RST_HERE
+RST_STATE MOV &INIVOC,&MARKVOC ; INIT value above (FRAM value)
+ MOV &INIDP,&MARKDP ; INIT value above (FRAM value)
JMP PWR_STATE
FORTHWORD "PWR_HERE" ; define dictionnary bound for power ON
PWR_HERE MOV &LASTVOC,&MARKVOC
MOV &DDP,&MARKDP
- mNEXT
+NEXT_ADR mNEXT
FORTHWORD "RST_HERE" ; define dictionnary bound for <reset>...
RST_HERE MOV &LASTVOC,&INIVOC
MOV &DDP,&INIDP
- JMP PWR_HERE ; ...and also for power ON...
+ JMP PWR_HERE ; ...and obviously same bound for power ON...
- FORTHWORD "WIPE" ; restore the program as it was in forthMSP430FR.txt file
+ FORTHWORD "WIPE" ; restore the program as it was in forthMSP430FR.txt file
WIPE ; reset JTAG and BSL signatures ; unlock JTAG, SBW and BSL
- MOV #16,X ; max known SIGNATURES length = 10
-SIGNLOOP SUB #2,X
- MOV #-1,SIGNATURES(X) ; reset signature; WARNING ! DON'T CHANGE THIS IMMEDIATE VALUE !
- JNZ SIGNLOOP
- CALL #WIP_DEFER ; set default execute part of all factory primary DEFERred words
- MOV #ROMDICT,&INIDP ; reinit this 2 factory values
- MOV #lastvoclink,&INIVOC
- JMP RST_STATE ; then execute RST_STATE and PWR_STATE
+ MOV #16,X ; max known SIGNATURES length = 16
+SIGNLOO SUB #2,X
+ MOV #-1,SIGNATURES(X) ; reset signature; WARNING ! DON'T CHANGE IMMEDIATE VALUE !
+ JNZ SIGNLOO
+ MOV #BODYSLEEP,&PFASLEEP ;4 MOV #SLEEP,X ADD #4,X MOV X,-2(X), restore default background task
+ MOV #BODYWARM,&PFAWARM ;4 ' WARM >BODY IS WARM, restore default WARM
+ .IFDEF BOOTLOADER ; true if BOOTLOADER
+ MOV #BODYQUIT,&PFAQUIT ;4 ' QUIT >BODY IS QUIT, remove bootstrap
+ .ENDIF
+ MOV #lastvoclink,&INIVOC ; reinit this 2 factory values
+ MOV #ROMDICT,&INIDP
+ PUSH #RST_STATE ; define the next of WIPE
+;-----------------------------------;
+; WIPE, QABORT common subroutine ; <--- ?ABORT calls here
+;-----------------------------------;
+QAB_DEFER
+ MOV #BODYEMIT,&PFAEMIT ;4 ' EMIT >BODY IS EMIT default console output
+ MOV #BODYCR,&PFACR ;4 ' CR >BODY IS CR default CR
+ MOV #BODYKEY,&PFAKEY ;4 ' KEY >BODY IS KEY default KEY
+ .IFDEF DEFER_ACCEPT ; true if SD_LOADER
+ MOV #BODYACCEPT,&PFAACCEPT ;4 ' ACCEPT >BODY IS ACCEPT
+ MOV #TIB_ORG,&PFACIB ;4 TIB_ORG TO CIB (Current Input Buffer)
+ .ENDIF
+;-----------------------------------;
+; WIPE, QABORT, COLD common subrouti; <--- COLD, reset and PUC calls here
+;-----------------------------------;
+RST_INIT
+ MOV #CPUOFF+GIE,&LPM_MODE ; set LPM0
+ .SWITCH DTC
+ .CASE 1
+ MOV #xdocol,rDOCOL
+ .CASE 2
+ MOV #EXIT,rEXIT
+ .ENDCASE
+ MOV #RFROM,rDOVAR
+ MOV #xdocon,rDOCON
+ MOV #xdodoes,rDODOES
+ .IFDEF MSP430ASSEMBLER ; reset all 6 branch labels
+ MOV #10,Y
+ MOV Y,&BASE
+CLRASMLABEL
+ MOV #0,ASMLABELS(Y) ; begins with last label...
+ SUB #2,Y
+ JHS CLRASMLABEL ; out of loop when Y = -2...
+ .ELSE
+ MOV #10,&BASE ;4
+ .ENDIF
+ MOV #32,&CAPS ; init CAPS ON
+ RET
+;---------------------------------------;
-; ------------------------------------------------------------------------------
+; --------------------------------------------------------------------------------
; forthMSP430FR : WARM
-; ------------------------------------------------------------------------------
+; --------------------------------------------------------------------------------
-;Z WARM -- ; deferred word used to init your application
- ; define this word: : START ...init app here... LIT RECURSE IS WARM (WARM) ;
+;Z WARM -- ; deferred word, enabling the initialisation of your application
FORTHWORD "WARM"
-WARM MOV @PC+,PC ;3
- .word BODYWARM
-BODYWARM
-; SUB #4,PSP
-; MOV &SYSSNIV,0(PSP)
-; MOV &SYSUNIV,2(PSP)
- MOV &SAVE_SYSRSTIV,TOS ; to display it
- mDOCOL
- .word XSQUOTE ;
- .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
+WARM MOV @PC+,PC ;3 Code Field Address (CFA) of WARM
+PFAWARM .word BODYWARM ; Parameter Field Address of WARM, may be redirected.
+BODYWARM MOV #WARMTYPE,IP ; define next step for WIPE,RST_STATE,PWR_STATE, etc.
+;=================================================================================
+; WARM 1: activates I/O: inputs and outputs are active only here (hiZ before here)
+;=================================================================================
+ BIC #LOCKLPM5,&PM5CTL0 ; activate all previous I/O settings (before I/O tests below).
+ ; Moved in WARM area to be redirected in your app START routine,
+ ; enabling you full control of the I/O RESET state.
+;=================================================================================
+ MOV &SAVE_SYSRSTIV,TOS ;
+ CMP #0,TOS ; WARM event ?
+ JZ NEXT_ADR ; yes continue with WARMTYPE
+;---------------------------------------------------------------------------------
+; RESET 7: test DEEP RESET before init TERMINAL I/O
+;---------------------------------------------------------------------------------
+RST_EVENT
+ BIT.B #TXD,&TERM_IN ; TERM_TXD wired to GND via 4k7 resistor ?
+ JNZ RST_TERM_IO ; no
+ XOR #-1,TOS ; yes : force DEEP_RST (RESET + WIPE)
+ ADD #1,TOS ; to display SAVE_SYSRSTIV as negative value
+;---------------------------------------------------------------------------------
+; RESET 8: INIT TERMINAL I/O
+;---------------------------------------------------------------------------------
+RST_TERM_IO ;
+ BIS.B #TERM_BUS,&TERM_SEL ; Configure pins TXD & RXD for TERM_UART
+;---------------------------------------------------------------------------------
+; RESET 9: INIT SD_Card
+;---------------------------------------------------------------------------------
+ .IFDEF SD_CARD_LOADER ;
+ BIT.B #SD_CD,&SD_CDIN ; SD_memory in SD_Card module ?
+ JNZ RST_SEL ; no
+ .IF RAM_LEN < 2048 ; case of MSP430FR57xx : SD datas are in FRAM
+ MOV #SD_LEN,X ; not initialised by RESET.
+ClearSDdata SUB #2,X ; 1
+ MOV #0,SD_ORG(X) ; 3
+ JNZ ClearSDdata ; 2
+ .ENDIF
+ .include "forthMSP430FR_SD_INIT.asm"; no use IP,TOS
+ .ENDIF
+;---------------------------------------------------------------------------------
+; RESET 10, RESET events handler: Select POWER_ON|<reset>|DEEP_RST
+;---------------------------------------------------------------------------------
+RST_SEL CMP #0Ah,TOS ; reset event = security violation: access of protected areas.
+ JZ WIPE ; Add WIPE to this reset to do DEEP_RST
+ CMP #16h,TOS ; reset event > software POR : failure or DEEP_RST request
+ JHS WIPE ; U>= ; Add WIPE to this reset to do DEEP_RST
+ CMP #2,TOS ; reset event = BOR ?
+ JZ PWR_STATE ; yes execute PWR_STATE, return to WARMTYPE
+ JNZ RST_STATE ; else execute RST_STATE, return to WARMTYPE
+
+;---------------------------------------------------------------------------------
+; WARM 2: type message on console output
+;---------------------------------------------------------------------------------
+WARMTYPE .word ECHO
+ .word XSQUOTE ;
+ .byte 6,13,1Bh,"[7m#" ; CR + cmd "reverse video" + #
+ .word TYPE ;
+ .word DOT ; display signed SAVE_SYSRSTIV
.word XSQUOTE
.byte 31,"FastForth ",VER," (C)J.M.Thoorens "
.word TYPE
- .word LIT,FRAM_FULL,HERE,MINUS,UDOT
+ .word LIT,SIGNATURES,HERE,MINUS,UDOT
.word XSQUOTE ;
.byte 11,"bytes free ";
- .word QABORTYESNOECHO ; NOECHO state enables any app to execute COLD or WARM without terminal connexion
-
-
-
-;-------------------------------------------------------------------------------
-; RESET : Initialisation limited to FORTH usage : I/O, RAM, RTC
-; all unused I/O are set as input with pullup resistor
-;-------------------------------------------------------------------------------
-
-;Z COLD -- performs a software reset
- FORTHWORD "COLD"
-COLD MOV #0A500h+PMMSWBOR,&PMMCTL0
-
-RESET
- .include "Target.asm" ; include target specific init code
-
-
-; fill all interrupt vectors with RESET
- MOV #VECTLEN,X ; length of vectors area
-RESETINT SUB #2,X
- MOV #RESET,INTVECT(X) ; begin at end of area
- JNZ RESETINT ; endloop when INTVECT(X) = INTVECT
-
-; reset default TERMINAL vector interrupt and LPM0 mode for terminal use
- MOV #TERMINAL_INT,&TERMVEC
- MOV #CPUOFF+GIE,&LPM_MODE
-
-; init RAM
- MOV #RAMLEN,X
-INITRAM SUB #2,X
- MOV #0,RAMSTART(X)
- JNZ INITRAM ; 6~ loop
-
-;-------------------------------------------------------------------------------
-; RESET : INIT FORTH machine
-;-------------------------------------------------------------------------------
- MOV #RSTACK,RSP ; init return stack
- MOV #PSTACK,PSP ; init parameter stack
- .SWITCH DTC
- .CASE 1
- MOV #xdocol,rDOCOL ;
- .CASE 2
- MOV #EXIT,rEXIT
- .CASE 3 ; inlined DOCOL, do nothing here
- .ENDCASE
- MOV #RFROM,rDOVAR
- MOV #xdocon,rDOCON
- MOV #xdodoes,rDODOES
-
- MOV #10,&BASE ; init BASE
- MOV #-1,&CAPS ; init CAPS ON
-
-;-------------------------------------------------------------------------------
-; RESET : test TERM_TXD before init TERM_UART I/O
-;-------------------------------------------------------------------------------
- BIC #LOCKLPM5,&PM5CTL0 ; activate all previous I/O settings before DEEP_RST test
- MOV &SAVE_SYSRSTIV,Y ;3
- BIT.B #TXD,&TERM_IN ; TERM_TXD wired to GND via 4k7 resistor ?
- JNZ TERM_INIT ; no
- XOR #-1,Y ;1 yes : force DEEP_RST (WIPE + COLD)
- ADD #1,Y ;1 to display SAVE_SYSRSTIV as negative value
- MOV Y,&SAVE_SYSRSTIV ;3 save
-
-TERM_INIT
-;-------------------------------------------------------------------------------
-; RESET : INIT TERM_UART
-;-------------------------------------------------------------------------------
- MOV #0081h,&TERMCTLW0 ; Configure TERM_UART UCLK = SMCLK
- MOV &TERMBRW_RST,&TERMBRW ; RST value in FRAM
- MOV &TERMMCTLW_RST,&TERMMCTLW ; RST value in FRAM
- BIS.B #TERM_BUS,&TERM_SEL ; Configure pins TXD & RXD for TERM_UART (PORTx_SEL0 xor PORTx_SEL1)
- ; TERM_DIR is controlled by eUSCI_Ax module
- BIC #UCSWRST,&TERMCTLW0 ; release from reset...
- BIS #UCRXIE,&TERMIE ; ... then enable RX interrupt for wake up on terminal input
-
-;-------------------------------------------------------------------------------
-; RESET : Select POWER_ON|<reset>|DEEP_RST from Y = SAVE_SYSRSTIV
-;-------------------------------------------------------------------------------
-
-SelectReset MOV #COLD_END,IP ; define return of WIPE,RST_STATE,PWR_STATE
- CMP #0Ah,Y ; reset event = security violation BOR ???? not documented...
- JZ WIPE ; Add WIPE to this reset to do DEEP_RST --------------
- CMP #16h,Y ; reset event > software POR : failure or DEEP_RST request
- JHS WIPE ; U>= ; Add WIPE to this reset to do DEEP_RST
- CMP #2,Y ; reset event = Brownout ?
- JNZ RST_STATE ; else execute RST_STATE, return to COLD_END
- JZ PWR_STATE ; yes execute PWR_STATE, return to COLD_END
+ .word QABORT_DISPLAY ;
+
+;Z COLD -- performs a software reset (SYSRSTIV = 6)
+ FORTHWORD "COLD"
+COLD BIT #1,&TERM_STATW ; TERM_UART is busy ?
+ JNZ COLD ; if yes
+ MOV #0A500h+PMMSWBOR,&PMMCTL0 ; performs reset next address
+
+;---------------------------------------------------------------------------------
+; RESET 1: Initialisation limited to FastForth usage : I/O, RAM, RTC
+; all unused I/O are set as input with pullup resistor
+;---------------------------------------------------------------------------------
+RESET .include "TargetInit.asm" ; include target specific FastForth init code
+;---------------------------------------------------------------------------------
+; RESET 2: init RAM
+;---------------------------------------------------------------------------------
+ MOV #RAM_LEN,X
+INITRAMLOOP SUB #2,X
+ MOV #0,RAM_ORG(X)
+ JNZ INITRAMLOOP ; 6~ loop
+;---------------------------------------------------------------------------------
+; RESET 3: set all interrupt vectors
+;---------------------------------------------------------------------------------
+ MOV #VECT_LEN,X ;2 length of vectors area
+VECTORLOOP SUB #2,X ;1
+ MOV #RESET,VECT_ORG(X) ;4 begin at end of area
+ JNZ VECTORLOOP ;2 endloop when VECT_ORG(X) = VECT_ORG
+ MOV #TERMINAL_INT,&TERM_VEC
+;---------------------------------------------------------------------------------
+; RESET 4: INIT TERM_UART UC
+;---------------------------------------------------------------------------------
+ MOV #0081h,&TERM_CTLW0 ; UC SWRST + UCLK = SMCLK
+ MOV &TERMBRW_RST,&TERM_BRW ; RST value in FRAM
+ MOV &TERMMCTLW_RST,&TERM_MCTLW ; RST value in FRAM
+ BIC #UCSWRST,&TERM_CTLW0 ; release from reset...
+ BIS #UCRXIE,&TERM_IE ; ... then enable RX interrupt for wake up on terminal input
+;-------------------------------------------------------------------------------
+; RESET 5: optionnal INIT SD_CARD UC
+;-------------------------------------------------------------------------------
+ .IFDEF SD_CARD_LOADER ;
+ MOV #0A981h,&SD_CTLW0 ; UCxxCTL1 = CKPH, MSB, MST, SPI_3, SMCLK + UCSWRST
+ MOV #FREQUENCY*3,&SD_BRW ; UCxxBRW init SPI CLK = 333 kHz ( < 400 kHz) for SD_Card init
+ BIS.B #SD_CS,&SD_CSDIR ; SD_CS as output high
+ BIS #SD_BUS,&SD_SEL ; Configure pins as SIMO, SOMI & SCK (PxDIR.y are controlled by eUSCI module)
+ BIC #1,&SD_CTLW0 ; release eUSCI from reset
+ .ENDIF
+;---------------------------------------------------------------------------------
+; RESET 6: INIT FORTH machine
+;---------------------------------------------------------------------------------
+ MOV #PSTACK,PSP ; init parameter stack
+ MOV #RSTACK,RSP ; init return stack
+ PUSH #WARM
+ JMP RST_INIT
;-------------------------------------------------------------------------------
-; RESET : INIT SD_Card option
+; ASSEMBLER OPTION
;-------------------------------------------------------------------------------
-COLD_END
- .IFNDEF SD_CARD_LOADER ;
- .word WARM ; the next step
- .ELSE
- FORTHtoASM
- .IFDEF RAM_1K ; case of MSP430FR57xx : SD datas are in FRAM
- MOV #0,&CurrentHDL ; init this FRAM area to pass QABORT
- .ENDIF
- BIT.B #SD_CD,&SD_CDIN ; SD_memory in SD_Card module ?
- JNZ WARM ; no
- .include "forthMSP430FR_SD_INIT.asm";
- JMP WARM
+ .IFDEF MSP430ASSEMBLER
+ .include "forthMSP430FR_ASM.asm"
.ENDIF
;-------------------------------------------------------------------------------
-; ASSEMBLER OPTION
+; FIXED POINT OPERATORS OPTION
;-------------------------------------------------------------------------------
- .IFDEF MSP430ASSEMBLER
- .include "forthMSP430FR_ASM.asm"
+ .IFDEF FIXPOINT
+ .include "ADDON/FIXPOINT.asm"
.ENDIF
;-------------------------------------------------------------------------------
.ENDIF
;-------------------------------------------------------------------------------
-; FIXED POINT OPERATORS OPTION
-;-------------------------------------------------------------------------------
- .IFDEF FIXPOINT
- .include "ADDON/FIXPOINT.asm"
- .ENDIF
+; ADD HERE YOUR CODE TO BE INTEGRATED IN KERNEL (protected against WIPE)
+;vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-;-------------------------------------------------------------------------------
-; 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)
-;vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+; ADD HERE YOUR CODE TO BE INTEGRATED IN KERNEL (protected against WIPE)
+;-------------------------------------------------------------------------------
;-------------------------------------------------------------------------------
; RESOLVE ASSEMBLY PTR
;-------------------------------------------------------------------------------
- .include "ResolveThreads.mac"
-
-
- .org 0FFFEh
- .word reset
-
+ .include "ThingsInLast.inc"
OSDN Git Service
