FORTHWORD "{ANS_COMP}"
mNEXT
+;https://forth-standard.org/standard/core/VALUE
+;( x "<spaces>name" -- ) define a Forth VALUE
+;Skip leading space delimiters. Parse name delimited by a space.
+;Create a definition for name with the execution semantics defined below,
+;with an initial value equal to x.
+
+;name Execution: ( -- x )
+;Place x on the stack. The value of x is that given when name was created,
+;until the phrase x TO name is executed, causing a new value of x to be assigned to name.
+
+;TO name Run-time: ( x -- )
+;Assign the value x to name.
+
+ FORTHWORD "VALUE"
+ mDOCOL
+ .word CREATE
+ .word COMMA ; compile x
+ .word DOES
+ FORTHtoASM
+ MOV @RSP+,IP
+ BIT #UF10,SR
+ JZ FETCH
+ BIC #UF10,SR
+ JMP STORE
+
+; https://forth-standard.org/standard/core/TO
+;TO name Run-time: ( x -- )
+;Assign the value x to named VALUE.
+ FORTHWORD "TO"
+ BIS #UF10,SR
+ MOV @IP+,PC
+
;https://forth-standard.org/standard/core/StoD
;C S>D n -- d single -> double prec.
FORTHWORD "S>D"
MOV @PSP+,TOS
mNEXT
+; https://forth-standard.org/standard/double/TwoVALUE
+ FORTHWORD "2VALUE"
+ mDOCOL
+ .word CREATE
+ .word COMMA,COMMA ; compile hi then lo
+ .word DOES
+ FORTHtoASM
+ MOV @RSP+,IP
+ BIT #UF10,SR
+ JZ TWOFETCH
+ BIC #UF10,SR
+ JMP TWOSTORE
+
; https://forth-standard.org/standard/core/TwoDUP
; 2DUP x1 x2 -- x1 x2 x1 x2 dup top 2 cells
FORTHWORD "2DUP"
?GOTO used after a conditionnal (0=,0<>,U>=,U<,0<,S<,S>=) to branch to a label FWx or BWx
GOTO used as unconditionnal branch to a label FWx or BWx
-BW3 BACKWARD branch destination n°3
-BW2 n°2
-BW1 N°1
+BW3 BACKWARD branch destination n°3
+BW2 n°2
+BW1 N°1
-FW3 FORWARD branch destination n°3
-FW2 n°2
-FW1 n°1
+FW3 FORWARD branch destination n°3
+FW2 n°2
+FW1 n°1
?JMP used after a conditionnal (0=,0<>,U>=,U<,0<,S<,S>=) to jump to a predefined word
JMP unconditionnal jump to a predefined word
POPM http://www.ti.com/lit/ug/slau272d/slau272d.pdf#page=204
PUSHM http://www.ti.com/lit/ug/slau272d/slau272d.pdf#page=205
+ASSEMBLER_EXTENDED WORDS set:
+
ADDX http://www.ti.com/lit/ug/slau272d/slau272d.pdf#page=187
ADDCX http://www.ti.com/lit/ug/slau272d/slau272d.pdf#page=188
ANDX http://www.ti.com/lit/ug/slau272d/slau272d.pdf#page=189
MOVA http://www.ti.com/lit/ug/slau272d/slau272d.pdf#page=238
SUBA http://www.ti.com/lit/ug/slau272d/slau272d.pdf#page=241
+RPT
CONDCOMP ADD-ON
---------------
ANS_COMPLEMENT ADD-ON
---------------------
-PAD SOURCE .( ( DECIMAL HEX
+PAD >IN SOURCE .( ( DECIMAL HEX
FILL [CHAR] CHAR +! MIN MAX 2/
2* RSHIFT LSHIFT XOR OR AND INVERT
-2OVER 2SWAP 2DROP 2DUP 2! 2@ S>D
-CELL+ CELLS CHAR+ CHARS ALIGN ALIGNED */
-*/MOD MOD / /MOD * FM/MOD SM/REM
-M* UM* {ANS_COMP}
+2OVER 2SWAP 2DROP 2DUP 2VALUE 2! 2@
+S>D CELL+ CELLS CHAR+ CHARS ALIGN ALIGNED
+*/ */MOD MOD / /MOD * FM/MOD
+SM/REM M* UM* TO VALUE {ANS_COMP}
PAD https://forth-standard.org/standard/core/PAD
>IN https://forth-standard.org/standard/core/toIN
2SWAP https://forth-standard.org/standard/core/TwoSWAP
2DROP https://forth-standard.org/standard/core/TwoDROP
2DUP https://forth-standard.org/standard/core/TwoDUP
+2VALUE https://forth-standard.org/standard/double/TwoVALUE
2! https://forth-standard.org/standard/core/TwoStore
2@ https://forth-standard.org/standard/core/TwoFetch
S>D https://forth-standard.org/standard/core/StoD
SM/REM https://forth-standard.org/standard/core/SMDivREM
M* https://forth-standard.org/standard/core/MTimes
UM* https://forth-standard.org/standard/core/UMTimes
+TO https://forth-standard.org/standard/core/TO
+VALUE https://forth-standard.org/standard/core/VALUE
{ANS_COMP}
+\ -*- coding: utf-8 -*-
; -----------------------------------------------------
-; ANS_COMP.f words complement to pass CORETEST.4th
+; ANS_COMP.f words complement to pass CORETEST.4TH
; -----------------------------------------------------
\
\ to see kernel options, download FastForthSpecs.f
\ ASSEMBLER conditionnal usage with IF UNTIL WHILE S< S>= U< U>= 0= 0<> 0>=
\ ASSEMBLER conditionnal usage with ?JMP ?GOTO S< S>= U< U>= 0= 0<> 0<
-PWR_STATE
-
: DEFINED! ECHO 1 ABORT" already loaded!" ;
[DEFINED] {ANS_COMP} [IF] DEFINED!
[ELSE]
+PWR_STATE
+
MARKER {ANS_COMP}
+\ https://forth-standard.org/standard/core/VALUE
+\ ( x "<spaces>name" -- ) define a Forth VALUE
+\ Skip leading space delimiters. Parse name delimited by a space.
+\ Create a definition for name with the execution semantics defined below,
+\ with an initial value equal to x.
+\
+\ name Execution: ( -- x )
+\ Place x on the stack. The value of x is that given when name was created,
+\ until the phrase x TO name is executed, causing a new value of x to be assigned to name.
+\
+\ TO name Run-time: ( x -- )
+\ Assign the value x to name.
+
+: VALUE
+CREATE ,
+DOES>
+HI2LO
+MOV @RSP+,IP
+BIT #UF10,SR
+0= IF
+ MOV #@,PC
+THEN
+BIC #UF10,SR
+MOV #!,PC
+ENDCODE
+
+\ https://forth-standard.org/standard/core/TO
+\ TO name Run-time: ( x -- )
+\ Assign the value x to named VALUE.
+CODE TO
+BIS #UF10,SR
+MOV @IP+,PC
+ENDCODE
+
[UNDEFINED] AND [IF]
\ https://forth-standard.org/standard/core/AND
\ C AND x1 x2 -- x3 logical AND
[THEN]
\ https://forth-standard.org/standard/core/SMDivREM
-\ SM/REM d1lo d1hi n2 -- r3 q4 symmetric signed div
+\ SM/REM DVDlo DVDhi DIVlo -- r3 q4 symmetric signed div
CODE SM/REM
-MOV TOS,S \ S=divisor
-MOV @PSP,T \ T=dividend_sign==>rem_sign
+MOV TOS,S \ S=DIVlo
+MOV @PSP,T \ T=DVD_sign==>rem_sign
CMP #0,TOS \ n2 >= 0 ?
S< IF \
XOR #-1,TOS
>R M* R> FM/MOD NIP
;
-\ ----------------------------------------------------------------------
-\ DOUBLE OPERATORS
-\ ----------------------------------------------------------------------
-
\ https://forth-standard.org/standard/core/StoD
\ S>D n -- d single -> double prec.
: S>D
DUP 0<
;
+\ ----------------------------------------------------------------------
+\ DOUBLE OPERATORS
+\ ----------------------------------------------------------------------
+
+[UNDEFINED] {DOUBLE} [IF]
+
\ https://forth-standard.org/standard/core/TwoFetch
\ 2@ a-addr -- x1 x2 fetch 2 cells ; the lower address will appear on top of stack
CODE 2@
MOV @IP+,PC
ENDCODE
+\ https://forth-standard.org/standard/double/TwoVALUE
+: 2VALUE
+CREATE
+, , \ compile Shi then Flo
+DOES>
+HI2LO
+MOV @RSP+,IP
+BIT #UF10,SR
+0= ?JMP 2@
+BIC #UF10,SR
+JMP 2!
+ENDCODE
+
\ https://forth-standard.org/standard/core/TwoDUP
\ 2DUP x1 x2 -- x1 x2 x1 x2 dup top 2 cells
CODE 2DUP
MOV @IP+,PC
ENDCODE
+[THEN]
+
\ ----------------------------------------------------------------------
\ ALIGNMENT OPERATORS
\ ----------------------------------------------------------------------
TOIN CONSTANT >IN
[UNDEFINED] PAD [IF]
-
\ https://forth-standard.org/standard/core/PAD
\ PAD -- addr
PAD_ORG CONSTANT PAD
-
[THEN]
RST_HERE
+\ -*- coding: utf-8 -*-
; ------------
; CHNGBAUD.f
+\ -*- coding: utf-8 -*-
; ----------
; CORDIC.f
\ ASSEMBLER conditionnal usage with IF UNTIL WHILE S< S>= U< U>= 0= 0<> 0>=
\ ASSEMBLER conditionnal usage with ?JMP ?GOTO S< S>= U< U>= 0= 0<> 0<
-PWR_STATE
-
: DEFINED! ECHO 1 ABORT" already loaded!" ;
[DEFINED] {CORDIC} [IF] DEFINED!
[ELSE]
+PWR_STATE
+
MARKER {CORDIC}
[UNDEFINED] {FIXPOINT} [IF] \ define words to display angle as Q15.16 number.
+\ -*- coding: utf-8 -*-
; ------------
; DEEP_RST.f
+\ -*- coding: utf-8 -*-
; ------------------
; FF_SPECS.f
: ESC #27 EMIT ;
+[UNDEFINED] PAD [IF]
+\ https://forth-standard.org/standard/core/PAD
+\ PAD -- addr
+PAD_ORG CONSTANT PAD
+[THEN]
+
+[UNDEFINED] AND [IF]
+\ https://forth-standard.org/standard/core/AND
+\ C AND x1 x2 -- x3 logical AND
+CODE AND
+AND @PSP+,TOS
+MOV @IP+,PC
+ENDCODE
+[THEN]
+
+
+[UNDEFINED] WORDS [IF]
+\ https://forth-standard.org/standard/tools/WORDS
+\ list all words of vocabulary first in CONTEXT.
+: WORDS \ --
+CR
+CONTEXT @ PAD \ -- VOC_BODY PAD MOVE all threads of VOC_BODY in PAD
+INI_THREAD @ DUP + \ -- VOC_BODY PAD THREAD*2
+MOVE \ -- vocabumary entries are copied in PAD
+BEGIN \ --
+ 0 DUP \ -- ptr=0 MAX=0
+ INI_THREAD @ DUP + 0 \ -- ptr=0 MAX=0 THREADS*2 0
+ DO \ -- ptr MAX I = PAD_ptr = thread*2
+ DUP I PAD + @ \ -- ptr MAX MAX NFAx
+ U< IF \ -- ptr MAX if MAX U< NFAx
+ DROP DROP \ -- drop ptr and MAX
+ I DUP PAD + @ \ -- new_ptr new_MAX
+ THEN \
+ 2 +LOOP \ -- ptr MAX
+ ?DUP \ -- ptr MAX MAX | -- ptr 0 (all threads in PAD = 0)
+WHILE \ -- ptr MAX replace it by its LFA
+ DUP \ -- ptr MAX MAX
+ 2 - @ \ -- ptr MAX [LFA]
+ ROT \ -- MAX [LFA] ptr
+ PAD + \ -- MAX [LFA] thread
+ ! \ -- MAX [LFA]=new_NFA updates PAD+ptr
+ DUP \ -- MAX MAX
+ COUNT $7F AND \ -- MAX addr count (with suppr. of immediate bit)
+ TYPE \ -- MAX
+ C@ $0F AND \ -- count_of_chars
+ $10 SWAP - SPACES \ -- complete with spaces modulo 16 chars
+REPEAT \ --
+DROP \ ptr --
+; \ all threads in PAD are filled with 0
+[THEN]
+
: ADDONS
ESC ." [7m" \ escape sequence to set reverse video
." KERNEL OPTIONS:" \ in reverse video
[DEFINED] {TOOLS} [IF] CR ." UTILITY" [THEN]
[DEFINED] {FIXPOINT} [IF] CR ." FIXPOINT" [THEN]
[DEFINED] {SD_TOOLS} [IF] CR ." SD_TOOLS" [THEN]
+ CR CR
+ [DEFINED] VOCABULARY [IF]
+ CR ESC ." [7m" \ escape sequence to set reverse video
+ ." ASSEMBLER word set"
+ ESC ." [0m" \ escape sequence to clear reverse video
+ ALSO ASSEMBLER WORDS CR PREVIOUS
+ [THEN]
+ CR ESC ." [7m" \ escape sequence to set reverse video
+ ." FORTH word set"
+ ESC ." [0m" \ escape sequence to clear reverse video
+ WORDS
THEN
;
HERE \ to compute bytes
ECHO
-42 \ number of terminal lines
+41 \ number of terminal lines
0 DO CR LOOP \ don't erase any line of source
ESC ." [1J" \ erase up (42 empty lines)
ESC ." [0m" \ escape sequence to clear reverse video
-CR ADDONS CR
+CR ADDONS
;
-ECHO specs \ here FastForth type a (volatile) message with some informations
+ECHO specs \ here FastForth types a (volatile) message with some informations
+\ -*- coding: utf-8 -*-
; -----------------------------------------------------
; FIXPOINT.f
\ ASSEMBLER conditionnal usage with ?JMP ?GOTO S< S>= U< U>= 0= 0<> 0<
\
-PWR_STATE
-
: DEFINED! ECHO 1 ABORT" already loaded!" ;
[DEFINED] {FIXPOINT} [IF] DEFINED!
[ELSE]
+PWR_STATE
+
MARKER {FIXPOINT}
XOR #-1,X \ 1 INV(DVDhi)
ADD #1,Y \ 1 INV(DVDlo)+1
ADDC #0,X \ 1 INV(DVDhi)+C
-THEN AND #-1,TOS \ 1 DVR < 0 ?
+THEN AND #-1,TOS \ 1 DVRhi < 0 ?
S< IF XOR #-1,rDOVAR \ 1 INV(DVRlo)
XOR #-1,TOS \ 1 INV(DVRhi)
ADD #1,rDOVAR \ 1 INV(DVRlo)+1
; -----------------------------------------------------
-; ANS_COMP.4th words complement to pass CORETEST.4th
+; ANS_COMP.4th words complement to pass CORETEST.4TH
; -----------------------------------------------------
-PWR_STATE
-
: DEFINED! ECHO 1 ABORT" already loaded!" ;
[DEFINED] {ANS_COMP} [IF] DEFINED!
[ELSE]
+PWR_STATE
+
MARKER {ANS_COMP}
+
+: VALUE
+CREATE ,
+DOES>
+HI2LO
+MOV @R1+,R13
+BIT #$400,R2
+0= IF
+ MOV #@,R0
+THEN
+BIC #$400,R2
+MOV #!,R0
+ENDCODE
+
+CODE TO
+BIS #$400,R2
+MOV @R13+,R0
+ENDCODE
+
[UNDEFINED] AND [IF]
CODE AND
AND @R15+,R14
>R M* R> FM/MOD NIP
;
-
: S>D
DUP 0<
;
+
+[UNDEFINED] {DOUBLE} [IF]
+
CODE 2@
SUB #2,R15
MOV 2(R14),0(R15)
MOV @R13+,R0
ENDCODE
+: 2VALUE
+CREATE
+, ,
+DOES>
+HI2LO
+MOV @R1+,R13
+BIT #$400,R2
+0= ?JMP 2@
+BIC #$400,R2
+JMP 2!
+ENDCODE
+
CODE 2DUP
SUB #4,R15
MOV R14,2(R15)
MOV @R13+,R0
ENDCODE
+[THEN]
+
CODE ALIGNED
BIT #1,R14
ADDC #0,R14
$1DC4 CONSTANT >IN
[UNDEFINED] PAD [IF]
-
$1CE4 CONSTANT PAD
-
[THEN]
RST_HERE
; CORDIC.4th
; ----------
-PWR_STATE
-
: DEFINED! ECHO 1 ABORT" already loaded!" ;
[DEFINED] {CORDIC} [IF] DEFINED!
[ELSE]
+PWR_STATE
+
MARKER {CORDIC}
[UNDEFINED] {FIXPOINT} [IF]
ELSE >IN ! DROP [CHAR] * EMIT
THEN ;
-ECHO CR HEX
+ECHO HEX
\ From: John Hayes S1I
\ Subject: core.fr
--- /dev/null
+
+; ------------
+; DEEP_RST.4th
+; ------------
+
+-1 $1808 ! COLD
--- /dev/null
+
+; ------------------
+; FF_SPECS.4th
+; ------------------
+
+; display all FastForth compilation options
+
+
+WIPE
+
+0 CONSTANT CASE IMMEDIATE
+
+: OF
+1+
+>R
+POSTPONE OVER POSTPONE =
+POSTPONE IF
+POSTPONE DROP
+R>
+; IMMEDIATE
+
+: ENDOF
+>R
+POSTPONE ELSE
+R>
+; IMMEDIATE
+
+: ENDCASE
+POSTPONE DROP
+0 DO
+ POSTPONE THEN
+LOOP
+; IMMEDIATE
+
+: BS 8 EMIT ;
+
+: ESC #27 EMIT ;
+
+[UNDEFINED] PAD [IF]
+$1CE4 CONSTANT PAD
+[THEN]
+
+[UNDEFINED] AND [IF]
+CODE AND
+AND @R15+,R14
+MOV @R13+,R0
+ENDCODE
+[THEN]
+
+
+[UNDEFINED] WORDS [IF]
+: WORDS
+CR
+$1DCA @ PAD
+$1800 @ DUP +
+MOVE
+BEGIN
+ 0 DUP
+ $1800 @ DUP + 0
+ DO
+ DUP I PAD + @
+ U< IF
+ DROP DROP
+ I DUP PAD + @
+ THEN
+ 2 +LOOP
+ ?DUP
+WHILE
+ DUP
+ 2 - @
+ ROT
+ PAD +
+ !
+ DUP
+ COUNT $7F AND
+ TYPE
+ C@ $0F AND
+ $10 SWAP - SPACES
+REPEAT
+DROP
+;
+[THEN]
+
+: ADDONS
+ESC ." [7m"
+." KERNEL OPTIONS:"
+ESC ." [0m"
+$1812 @
+
+ DUP 0< IF CR ." LF XTAL" THEN
+DUP + DUP 0< IF CR ." TERMINAL5WIRES" THEN
+DUP + DUP 0< IF CR ." TERMINAL4WIRES" THEN
+DUP + DUP 0< IF CR ." TERMINAL3WIRES" THEN
+DUP + DUP 0< IF CR ." HALFDUPLEX_TERMINAL" THEN
+DUP + DUP 0< IF CR ." PROMPT" THEN
+DUP + DUP 0< IF CR ." BOOTLOADER" THEN
+DUP + DUP 0< IF CR ." SD_CARD_READ_WRITE" THEN
+DUP + DUP 0< IF CR ." SD_CARD_LOADER" THEN
+DUP + DUP 0< IF CR ." FIXPOINT_INPUT" THEN
+DUP + DUP 0< IF CR ." DOUBLE_INPUT" THEN
+DUP + DUP 0< IF CR ." VOCABULARY_SET" THEN
+DUP + DUP 0< IF CR ." NONAME" THEN
+DUP + DUP 0< IF CR ." EXTENDED_ASM" THEN
+DUP + DUP 0< IF CR ." ASSEMBLER" THEN
+DUP + DUP 0< IF CR ." CONDCOMP" THEN
+
+0< IF
+ CR ESC ." [7m"
+ ." OTHER OPTIONS:"
+ ESC ." [0m"
+ [DEFINED] {ANS_COMP} [IF] CR ." ANS_COMPLEMENT" [THEN]
+ [DEFINED] {TOOLS} [IF] CR ." UTILITY" [THEN]
+ [DEFINED] {FIXPOINT} [IF] CR ." FIXPOINT" [THEN]
+ [DEFINED] {SD_TOOLS} [IF] CR ." SD_TOOLS" [THEN]
+ CR CR
+ [DEFINED] VOCABULARY [IF]
+ CR ESC ." [7m"
+ ." ASSEMBLER word set"
+ ESC ." [0m"
+ ALSO ASSEMBLER WORDS CR PREVIOUS
+ [THEN]
+ CR ESC ." [7m"
+ ." FORTH word set"
+ ESC ." [0m"
+ WORDS
+THEN
+;
+
+: specs
+PWR_STATE
+HERE
+ECHO
+
+41
+0 DO CR LOOP
+
+ESC ." [1J"
+ESC ." [H"
+ESC ." [7m"
+
+$1A04 @
+
+CR ." FastForth V" $1810 @ U. ." for MSP430FR"
+CASE
+ $830C OF ." 2355," $8000 ENDOF
+ $8240 OF ." 2433," $C400 ENDOF
+ $81F0 OF ." 4133," $C400 ENDOF
+ $8103 OF ." 5739," $C200 ENDOF
+ $8102 OF ." 5738," $C200 ENDOF
+ $8169 OF ." 5969," $4400 ENDOF
+ $8160 OF ." 5948," $4400 ENDOF
+ $82A1 OF ." 5994," $4000 ENDOF
+ $81A8 OF ." 6989," $4400 ENDOF
+
+ ABORT" xxxx <-- unrecognized device!"
+ENDCASE
+
+SPACE $1806 @ 0 1000 UM/MOD U.
+?DUP IF BS ." ," U.
+THEN ." MHz, "
+
+$1800 @ U. BS ." -Entry Vocabularies, "
+
+- U. ." bytes, "
+
+$FF80 HERE - U. ." bytes free" CR
+
+ESC ." [0m"
+
+CR ADDONS
+;
+
+ECHO specs
; FIXPOINT.4th
; -----------------------------------------------------
-PWR_STATE
-
: DEFINED! ECHO 1 ABORT" already loaded!" ;
[DEFINED] {FIXPOINT} [IF] DEFINED!
[ELSE]
+PWR_STATE
+
MARKER {FIXPOINT}
+
; -----------------------------------
; PROG100k.4th = 110 x RC5toLCD.4th
; -----------------------------------
; SD_TOOLS.4th : BASIC TOOLS for SD Card : DIR FAT SECTOR CLUSTER
; ---------------------------------------------------------------
-PWR_STATE
-
: DEFINED! ECHO 1 ABORT" already loaded!" ;
[DEFINED] {SD_TOOLS} [IF] DEFINED!
[ELSE]
+PWR_STATE
+
MARKER {SD_TOOLS}
[UNDEFINED] MAX [IF]
SUBX_T ; you should see 2 -->
-
; UTILITY.4th
; ------------------------------------------------------------------------------
-PWR_STATE
: DEFINED! ECHO 1 ABORT" already loaded!" ;
[ELSE]
+PWR_STATE
+
MARKER {TOOLS}
[UNDEFINED] ? [IF]
+\ -*- coding: utf-8 -*-
+
; -----------------------------------
; PROG100k.f = 110 x RC5toLCD.f
; -----------------------------------
+\ -*- coding: utf-8 -*-
; -----------------------------------
; RC5TOLCD.f
+\ -*- coding: utf-8 -*-
; --------------------
; RTC.f
+\ -*- coding: utf-8 -*-
; -----------
; SD_TEST.f
+\ -*- coding: utf-8 -*-
; ---------------------------------------------------------------
; SD_TOOLS.f : BASIC TOOLS for SD Card : DIR FAT SECTOR CLUSTER
\ ASSEMBLER conditionnal usage with IF UNTIL WHILE S< S>= U< U>= 0= 0<> 0>=
\ ASSEMBLER conditionnal usage with ?JMP ?GOTO S< S>= U< U>= 0= 0<> 0<
-PWR_STATE
-
: DEFINED! ECHO 1 ABORT" already loaded!" ;
[DEFINED] {SD_TOOLS} [IF] DEFINED!
[ELSE]
+PWR_STATE
+
MARKER {SD_TOOLS}
[UNDEFINED] MAX [IF] \ MAX and MIN are defined in {UTILITY}
+\ -*- coding: utf-8 -*-
; -----------------------------------------------------------------------
; TEST_ASM.f
+\ -*- coding: utf-8 -*-
; -----------------------------------------------------------------------
; TESTXASM.f
+\ -*- coding: utf-8 -*-
; ------------------------------------------------------------------------------
; UTILITY.f
\ ASSEMBLER conditionnal usage with IF UNTIL WHILE S< S>= U< U>= 0= 0<> 0>=
\ ASSEMBLER conditionnal usage with ?JMP ?GOTO S< S>= U< U>= 0= 0<> 0<
-PWR_STATE
: DEFINED! ECHO 1 ABORT" already loaded!" ;
[ELSE]
+PWR_STATE
+
MARKER {TOOLS}
[UNDEFINED] ? [IF] \
@ECHO OFF
::echo %2
-::echo %~d1\config\gema\%~n2.pat
+::echo %~d1\inc\%~n2.pat
IF "%2" == "" (
echo no file to be preprocessed!
:preprocess
::%~d1\prog\gema.exe -nobackup -line -t '\n=\r\n;\r\n=\r\n' -f %~d1\inc\%~n2.pat %1 %~dp1last.4TH
-::%~d1\prog\gema.exe -nobackup -line -t '-\r\n=\r\n' -f %~d1\inc\%~n2.pat %1 %~dp1last.4TH
-%~d1\prog\gema.exe -nobackup -line -t -f %~d1\inc\%~n2.pat %1 %~dp1last.4TH
+%~d1\prog\gema.exe -nobackup -line -t '-\r\n=\r\n' -f %~d1\inc\%~n2.pat %1 %~dp1last.4TH
+::%~d1\prog\gema.exe -nobackup -line -t -f %~d1\inc\%~n2.pat %1 %~dp1last.4TH
@XCOPY /D /Y "%~dp1last.4TH" "%~dp1\%~n2\%~n1.4TH*" > NUL
exit
:: ==============================================================================================
:: source file.f part
:: %~dpn1.f is the symbolic source file.f described as drive\path\name.f
-:: %~d1\config\gema\%~n2.pat is the pattern file for preprocessor gema.exe
-:: %~dpn1.4TH is the source file.4TH to be sent to the target
+:: %~d1\inc\%~n2.pat is the pattern file for preprocessor gema.exe
+:: %~dpn1.4TH is the source file.4TH to be preprocessed then sent to the target
:: %~d1 is the drive of arg %1
:: %~n2 is your selected template by SelectTarget.bat or your scite $(1)
; rDODOES = count
; MU/MOD DVDlo DVDhi DIVlo -- REMlo QUOTlo QUOThi, also used by fixpoint and #
-MUSMOD MOV TOS,T ;1 T = DIV
+MUSMOD MOV TOS,T ;1 T = DIVlo
MOV 2(PSP),S ;3 S = DVDlo
MOV @PSP,TOS ;2 TOS = DVDhi
MUSMOD1 MOV #0,W ;1 W = REMlo = 0
; -----------------------------------------
MDIV1 CMP T,W ;1 REMlo U>= DIV ?
JNC MDIV2 ;2 no : carry is reset
- SUB T,W ;1 yes: REMlo - DIV ; carry is set after soustraction!
+ SUB T,W ;1 yes: REMlo - DIV ; carry is set
MDIV2 ADDC X,X ;1 RLC quotLO
ADDC Y,Y ;1 RLC quotHI
SUB #1,rDODOES ;1 Decrement loop counter
; ?NUMBER makes the interface between INTERPRET and >NUMBER; it's a subset of INTERPRET.
; convert a string to a signed number; FORTH 2012 prefixes $, %, # are recognized
; digits separator '_' is recognized
-; with DOUBLE_INPUT switched ON, 32 bits numbers (with decimal point) are recognised
-; with FIXPOINT_INPUT switched ON, Q15.16 signed numbers are recognised.
+; with DOUBLE_INPUT switched ON, 32 bits numbers (with decimal point) are recognized
+; with FIXPOINT_INPUT switched ON, Q15.16 signed numbers are recognized.
; prefixed chars - # % $ are processed before calling >NUMBER
; other (anywhere) chars . , and _ are processed as >NUMBER exits
;Z ?NUMBER addr -- n|d -1 if convert ok ; flag Z=0, UF9=1 if double
TONUMEXIT FORTHtoASM ; -- addr ud2lo-hi addr2 cnt2 R-- IP sign BASE S=addr2
; ----------------------------------;
JZ QNUMNEXT ;2 if conversion is ok
- SUB #2,IP
+; ----------------------------------;
+ SUB #2,IP ; redefines TONUMEXIT as >NUMBER return
CMP.B #28h,W ; rejected char by >NUMBER is a underscore ?
- JZ TONUMPLUS ; skip it
+ JZ TONUMPLUS ; yes, skip it
+; ----------------------------------;
.IFDEF DOUBLE_NUMBERS ; DOUBLE_NUMBERS = DOUBLE_INPUT | FIXPOINT_INPUT
-; BIT #UF9,SR
-; JNZ QNUMNEXT
BIS #UF9,SR ;2 set double number flag
- .ENDIF
- .IFDEF DOUBLE_INPUT
+ .ENDIF ;
+ .IFDEF DOUBLE_INPUT ;
CMP.B #0F7h,W ;2 rejected char by >NUMBER is a decimal point ?
- JZ TONUMPLUS ;2 skip it
- .ENDIF
+ JZ TONUMPLUS ;2 yes, skip it
+ .ENDIF ;
+; ----------------------------------;
.IFDEF FIXPOINT_INPUT ;
CMP.B #0F5h,W ;2 rejected char by >NUMBER is a comma ?
JNZ QNUMNEXT ;2 no, that will be followed by abort on conversion error
-S15Q16 MOV TOS,W ;1 -- addr ud2lo x x x yes W=cnt2
+; ----------------------------------;
+S15Q16 MOV TOS,W ;1 -- addr ud2lo x x x W=cnt2
MOV #0,X ;1 -- addr ud2lo x 0 x init X = ud2lo' = 0
S15Q16LOOP MOV X,2(PSP) ;3 -- addr ud2lo ud2lo' ud2lo' x 0(PSP) = ud2lo'
SUB.B #1,W ;1 decrement cnt2
MOV @PSP+,0(PSP) ;4 -- udlo udhi sign note : PSP is incremented before write back.
XOR #-1,TOS ;1 -- udlo udhi inv(sign)
JNZ QDOUBLE ;2 if jump : TOS=-1 and Z=0 ==> conversion ok
-Q2NEGATE XOR #-1,TOS ;1 -- udlo udhi tf
+QDNEGATE XOR #-1,TOS ;1 -- udlo udhi tf
XOR #-1,2(PSP) ;3
XOR #-1,0(PSP) ;3 -- (dlo dhi)-1 tf
ADD #1,2(PSP) ;3
; ?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
; digits separator '_' is recognized
-; with DOUBLE_INPUT switched ON, 32 bits numbers (with decimal point) are recognised
-; with FIXPOINT_INPUT switched ON, Q15.16 signed numbers are recognised.
+; with DOUBLE_INPUT switched ON, 32 bits numbers (with decimal point) are recognized
+; with FIXPOINT_INPUT switched ON, Q15.16 signed numbers are recognized.
; prefixes # % $ and - are processed before calling >NUMBER
; not convertible chars '.' , ',' and '_' are processed as >NUMBER exits
;Z ?NUMBER addr -- n|d -1 if convert ok ; flag Z=0, UF9=1 if double
CMP.B #28h,Y ; rejected char by >NUMBER is a underscore ?
JZ TONUMPLUS ; skip it
.IFDEF DOUBLE_NUMBERS ; DOUBLE_NUMBERS = DOUBLE_INPUT | FIXPOINT_INPUT
- BIT #UF9,SR
- JNZ QNUMNEXT
BIS #UF9,SR ;2 set double number flag
.ENDIF
.IFDEF DOUBLE_INPUT
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
+QABUSBLOOPJ MOV #8,X ; 1~ <-------+ windows 10 seems very slow... ==> 2730*37 = 101ms delay
ADD X,X ; 1~ | linux seems very very slow... ==> 2730*69 = 188ms delay
QABUSBLOOPI NOP ; 1~ <---+ |
SUB #1,X ; 1~ | | the loop must be longer than longuest existing silence on terminal
JNZ QABUSBLOOPI ; 2~ 4~ loop ---+ | i.e. when USB driver refill they buffers.
SUB #1,Y ; 1~ |
- JNZ QABUSBLOOPJ ; 2~ 36~/69~ loop --+
+ JNZ QABUSBLOOPJ ; 2~ 37~/69~ loop --+
BIT #UCRXIFG,&TERM_IFG ; 4 new char in TERMRXBUF after delay for refill ?
JNZ QABORTLOOP ; 2 yes, the input stream is still active: loop back
; ----------------------------------;
mDOCOL ;
.word PWR_STATE ; remove all words beyond PWR_HERE, including a definition leading to an error
.word lit,LINE,FETCH ; fetch line number before set ECHO !
- .word ECHO ;
+ .word ECHO ; to see abort message
.word XSQUOTE ; -- c-addr u c-addr1 u1
- .byte 4,27,"[7m" ; type ESC[7m
- .word TYPE ; -- c-addr u set reverse video
+ .byte 4,27,"[7m" ; type ESC[7m (set reverse video)
+ .word TYPE ; -- c-addr u
.word QDUP ;
.word QFBRAN,ERRLINE_END; if LINE = 0
; ----------------------------------;
-; Display error line:xxx ; if LINE <> 0 (if NOECHO)
+; Display error line:xxx ; if LINE <> 0 (if NOECHO state before calling ABORT")
; ----------------------------------;
.word CR ;
.word XSQUOTE ; displays the line where error occured
.word TYPE ;
.word ONEMINUS ;
.word UDOT ;
-ERRLINE_END ;
+ERRLINE_END ; -- c-addr u
; ----------------------------------;
; Display ABORT" message ; <== WARM jumps here
; ----------------------------------;
QABORT_DISPLAY ;
.word TYPE ; -- type abort message
- .word XSQUOTE ; -- c-addr2 u2
+ .word XSQUOTE ; -- c-addr u
.byte 4,27,"[0m" ;
.word TYPE ; -- set normal video
FABORT .word ABORT ; no return; FABORT = BRACTICK-8
;C ' -- xt find word in dictionary and leave on stack its execution address
FORTHWORD "'"
TICK mDOCOL ; separator -- xt
- .word FBLANK,WORDD,FIND ; Z=1 if not found
+ .word FBLANK,WORDD,FIND
.word QFBRAN,NotFound
.word EXIT
-NotFound .word NotFoundExe ; in INTERPRET
+NotFound .word NotFoundExe ; see INTERPRET
;https://forth-standard.org/standard/block/bs
; \ -- backslash
FORTHWORDIMM "IS" ; immediate
IS mDOCOL
- .word FSTATE,FETCH ; STATE @
- .word QFBRAN,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.
+ .word FSTATE,FETCH ; STATE @
+ .word QFBRAN,IS_EXEC ; if = 0
+IS_COMPILE .word BRACTICK ; find the word, compile its CFA as literal
+ .word lit,DEFERSTORE ;
+ .word 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
MOV &DDP,TOS ; -- xt of this NONAME word
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!
+ MOV #PAOUT,Y ;2 MOV @X,-2(Y) also writes to PAIN register = 2th lure for semicolon REVEAL...
+ CALL #HEADEREND ; ...because we don't want write a preamble of this :NONAME definition in dictionnary!
.ENDIF ; NONAME
;-----------------------------------; common part of NONAME and :
MOV #DOCON,-4(W) ; CFA = DOCON
MOV TOS,-2(W) ; PFA = n
MOV @PSP+,TOS
- JMP REVEAL ; to link created VARIABLE in vocabulary
-
-;;https://forth-standard.org/standard/core/VALUE
-;;( x "<spaces>name" -- ) define a Forth VALUE
-;;Skip leading space delimiters. Parse name delimited by a space.
-;;Create a definition for name with the execution semantics defined below,
-;;with an initial value equal to x.
-;
-;;name Execution: ( -- x )
-;;Place x on the stack. The value of x is that given when name was created,
-;;until the phrase x TO name is executed, causing a new value of x to be assigned to name.
-;
-; FORTHWORD "VALUE" ; VALUE is an alias of CONSTANT
-; JMP CONSTANT
-;
-;;TO name Run-time: ( x -- )
-;;Assign the value x to name.
-;
-; FORTHWORDIMM "TO" ; TO is an alias of IS
-; JMP IS
-
-; usage : SDIB_ORG IS CIB ; modify Current_Input_Buffer address to read a SD file sector
-; ...
-; TIB_ORG IS CIB ; restore Terminal_Input_Buffer address as Current_Input_Buffer address
+ JMP REVEAL ; to link created CONSTANT in vocabulary
;https://forth-standard.org/standard/core/CREATE
;C CREATE <name> -- define a CONSTANT with its next address
MOV #10,&BASE ;4
MOV #32,&CAPS ; init CAPS ON
RET
-;---------------------------------------;
+;-----------------------------------;
; --------------------------------------------------------------------------------
; forthMSP430FR : WARM
FORTHWORD "COLD"
COLD BIT #1,&TERM_STATW ;
JNZ COLD ; loop back while TERM_UART is busy
- MOV #0A504h,&PMMCTL0 ; performs BOR (SYSRSTIV = 6) reset @ next address
-; MOV #0A508h,&PMMCTL0 ; performs POR (SYSRSTIV = 20) reset @ next address
+ MOV #0A504h,&PMMCTL0 ; performs BOR (SYSRSTIV = #6) reset @ next address
+; MOV #0A508h,&PMMCTL0 ; performs POR (SYSRSTIV = #20) reset @ next address
;---------------------------------------------------------------------------------
; RESET 1: Initialisation limited to FastForth usage : I/O, RAM, RTC
! forth words filter
+D\.R=D\.R
+
M\*=M\*
+M\+=M\+
+
R\>=R\>!
R\@=R\@!
\>R=\>R!
+
S\>=S\>!
\>S=\>S!
S\<=S\<!
T\{=T\{!
\}T=\}T!
+
U\.R=U\.R!
.include "CHIPSTICK_FR2433.asm"
.ENDIF
-
; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
; add here your target.asm item:
; .IFDEF MY_MSP430FR5738_1
OSDN Git Service
