; -*- coding: utf-8 -*-
-
-; Fast Forth For Texas Instrument MSP430FRxxxx FRAM devices with UART TERMINAL
-; Copyright (C) <2019> <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
-; the Free Software Foundation, either version 3 of the License, or
-; (at your option) any later version.
-;
-; This program is distributed in the hope that it will be useful,
-; but WITHOUT ANY WARRANTY; without even the implied warranty of
-; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-; GNU General Public License for more details.
;
-; You should have received a copy of the GNU General Public License
-; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-; ------------------------------------------------------------------------------
-; forthMSP430FR : CONDITIONNAL COMPILATION
-; ------------------------------------------------------------------------------
-
FORTHWORDIMM "[THEN]" ; do nothing
; https://forth-standard.org/standard/tools/BracketTHEN
; [THEN]
MOV @IP+,PC
- .save
- .listing off
; ; https://forth-standard.org/standard/string/COMPARE
; ; COMPARE ( c-addr1 u1 c-addr2 u2 -- n )
; MOV @PSP+,Y ;2 Y = addr2
; MOV @PSP+,T ;2 T = u1
; MOV @PSP+,X ;2 X = addr1
-; COMPAR1 MOV T,TOS ;1
+; COMPLOOP MOV T,TOS ;1
; ADD S,TOS ;1 TOS = u1+u2
; JZ COMPEQUAL ;2 u1=u2=0, Z=1, end of all successfull comparisons
; SUB #1,T ;1
; JN COMPGREATER ;2 u1>u2 if u2 < 0
; ADD #1,X ;1
; CMP.B @Y+,-1(X) ;4 char1-char2
-; JZ COMPAR1 ;2 char1=char2 17~ loop
+; JZ COMPLOOP ;2 char1=char2 17~ loop
; JC COMPGREATER ;2 char1>char2
; COMPLESS ; char1<char2
; MOV #-1,TOS ;1 Z=0
; FORTHWORDIMM "[ELSE]" ; or [IF] if isnogood...
; BRACKETELSE
; mDOCOL
-; .word lit,0
+; .word lit,0 ; -- cnt=0
; BRACKETELSE0
-; .word ONEPLUS ;
+; .word ONEPLUS ; -- cnt+1
; BRACKETELSE1 ;
-; .word FBLANK,WORDD,COUNT ; -- addr u
-; .word DUP,QFBRAN,BRACKETELSE5 ; u = 0 if end of line --> refill buffer then loop back
+; .word FBLANK,WORDD,COUNT ; -- cnt addr u
+; .word DUP,QFBRAN,BRACKETELSE5 ; u = 0 if end of line --> refill buffer then loop back
; .word TWODUP ;
; .word XSQUOTE ;
; .byte 6,"[THEN]" ;
-; .word COMPARE ;
-; .word QTBRAN,BRACKETELSE2 ; if bad comparaison, jump for next comparaison
-; .word TWODROP,ONEMINUS ; 2DROP, decrement count
-; .word QDUP,QTBRAN,BRACKETELSE1; loop back if count <> 0
-; .word EXIT ; else exit
+; .word COMPARE,ZEROEQUAL ;
+; .word QFBRAN,BRACKETELSE2 ; -- cnt addr u if bad comparaison, jump for next comparaison
+; .word TWODROP,ONEMINUS ; -- cnt-1 2DROP, decrement count
+; .word QDUP,ZEROEQUAL ;
+; .word QFBRAN,BRACKETELSE1 ; -- cnt-1 loop back if count <> 0
+; .word EXIT ; -- else exit
; BRACKETELSE2 ;
-; .word TWODUP ;
+; .word TWODUP ; -- cnt addr u addr u
; .word XSQUOTE ;
; .byte 6,"[ELSE]" ;
-; .word COMPARE ;
-; .word QTBRAN,BRACKETELSE3 ; if bad comparaison, jump for next comparaison
-; .word TWODROP,ONEMINUS ; 2DROP, decrement count
-; .word QDUP,QTBRAN,BRACKETELSE0; if count <> 0 restore old count with loop back increment
-; .word EXIT ; else exit
+; .word COMPARE,ZEROEQUAL ; -- cnt addr u ff
+; .word QFBRAN,BRACKETELSE3 ; -- cnt addr u if bad comparaison, jump for next comparaison
+; .word TWODROP,ONEMINUS ; -- cnt-1 2DROP, decrement count
+; .word QDUP,ZEROEQUAL ;
+; .word QFBRAN,BRACKETELSE0 ; -- cnt-1 if count <> 0 restore old count with loop back increment
+; .word EXIT ; -- else exit
; BRACKETELSE3 ;
; .word XSQUOTE ;
; .byte 4,"[IF]" ;
-; .word COMPARE ;
-; .word QTBRAN,BRACKETELSE1 ; if bad comparaison, loop back
-; .word BRAN,BRACKETELSE0 ; else increment loop back
+; .word COMPARE,ZEROEQUAL ;
+; .word QFBRAN,BRACKETELSE1 ; -- cnt if bad comparaison, loop back
+; .word BRAN,BRACKETELSE0 ; -- cnt else increment loop back
; BRACKETELSE5 ;
-; .word TWODROP ;
+; .word TWODROP ; -- cnt
; ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
; ; OPTION ; plus 5 words option
; ;vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
; .word XSQUOTE ;
; .byte 5,13,10,"ko " ;
-; .word TYPE ; CR+LF ." ko " to show false branch of conditionnal compilation
+; .word TYPE ; CR+LF ." ko" to show false branch of conditionnal compilation
; ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
-; .word REFILL ; REFILL Input Buffer with next line
-; .word SETIB ; SET Input Buffer pointers SOURCE_LEN, SOURCE_ORG and clear >IN
-; .word BRAN,BRACKETELSE1 ; then loop back 54 words without options
+; .word REFILL ; REFILL Input Buffer with next line
+; .word SETIB ; SET Input Buffer pointers SOURCE_LEN, SOURCE_ORG and clear >IN
+; .word BRAN,BRACKETELSE1 ; -- cnt then loop back 54 words without options
- .restore
-BADCOMPBR ; branch if string compare is false; [COMPARE,QTBRAN] replacement
- MOV TOS,S ;1 S = u2
- MOV @PSP+,Y ;2 Y = addr2
- MOV @PSP+,T ;2 T = u1
- MOV @PSP+,X ;2 X = addr1
-COMPAR1 MOV T,TOS ;1
- ADD S,TOS ;1 TOS = u1+u2
- JZ COMPEQU ;2 u1=u2=0, Z=1, end of all successfull comparisons
- SUB #1,T ;1
- JN COMPDIF ;2 u1<u2 if u1 < 0
- SUB #1,S ;1
- JN COMPDIF ;2 u1>u2 if u2 < 0
- ADD #1,X ;1
- CMP.B @Y+,-1(X) ;4 char1-char2
- JZ COMPAR1 ;2 char1=char2 17~ loop
-COMPDIF MOV @IP,IP ; take branch
-CMPEND MOV @PSP+,TOS
+; BRanch if string BAD COMParaison, [COMPARE,ZEROEQUAL,QFBRAN] replacement
+BRBADCOMP ; -- cnt addr1 u1 addr1 u1 addr2 u2
+ MOV TOS,S ;1 S = u2
+ MOV @PSP+,Y ;2 Y = addr2
+ MOV @PSP+,T ;2 T = u1
+ MOV @PSP+,X ;2 X = addr1
+COMPLOOP MOV T,TOS ;1 -- cnt addr1 u1 u1
+ ADD S,TOS ;1 -- cnt addr1 u1 u1+u2
+ JZ COMPEQU ;2 u1=u2=0, Z=1, end of all successfull comparisons
+ SUB #1,T ;1
+ JN COMPDIF ;2 u1<u2 if u1 < 0
+ SUB #1,S ;1
+ JN COMPDIF ;2 u1>u2 if u2 < 0
+ ADD #1,X ;1
+ CMP.B @Y+,-1(X) ;4 char1-char2
+ JZ COMPLOOP ;2 char1=char2 17~ loop
+COMPDIF MOV @IP,IP ;1 take branch
+CMPEND MOV @PSP+,TOS ;
MOV @IP+,PC ;4
-TOQTB ; [TWODROP,ONEMINUS,?DUP,QTBRAN] replacement
- ADD #2,PSP ;1 -- savedTOS TOS
- SUB #1,0(PSP) ;3 -- savedTOS-1 TOS
- JNZ COMPDIF ;2 -- cnt take branch
- ADD #2,PSP ;1 --
+; BRanch if string GOOD COMParaison, [TWODROP,ONEMINUS,?DUP,ZEROEQUAL,QFBRAN] replacement
+BRGOODCMP ; -- cnt addr u
+ ADD #2,PSP ;1 -- cnt u
+ SUB #1,0(PSP) ;3 -- cnt-1 u
+ JNZ COMPDIF ;2 -- cnt-1 u take branch
+ ADD #2,PSP ;1 -- u
COMPEQU ADD #2,IP ; skip branch
JMP CMPEND ; 25 words
.word TWODUP ;
.word XSQUOTE ;
.byte 6,"[THEN]" ;
- .word BADCOMPBR,BRACKETELSE2 ; if bad string comparaison, jump for next comparaison
- .word TOQTB,BRACKETELSE1 ; 2DROP, count-1, loop back if count <> 0, else DROP
+ .word BRBADCOMP,BRACKETELSE2 ; if bad string comparaison, jump for next comparaison
+ .word BRGOODCMP,BRACKETELSE1 ; 2DROP, count-1, loop back if count <> 0, else DROP
.word EXIT ; then exit
BRACKETELSE2 ;
.word TWODUP ;
.word XSQUOTE ;
.byte 6,"[ELSE]" ;
- .word BADCOMPBR,BRACKETELSE3 ; if bad string comparaison, jump for next comparaison
- .word TOQTB,BRACKETELSE0 ; 2DROP, count-1, loop back with count+1 if count <> 0, else DROP
+ .word BRBADCOMP,BRACKETELSE3 ; if bad string comparaison, jump for next comparaison
+ .word BRGOODCMP,BRACKETELSE0 ; 2DROP, count-1, loop back with count+1 if count <> 0, else DROP
.word EXIT ; then exit
BRACKETELSE3 ;
.word XSQUOTE ;
.byte 4,"[IF]" ;
- .word BADCOMPBR,BRACKETELSE1 ; if bad string comparaison, loop back
+ .word BRBADCOMP,BRACKETELSE1 ; if bad string comparaison, loop back
.word BRAN,BRACKETELSE0 ; else loop back with count+1
BRACKETELSE5 ;
.word TWODROP ;
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
-; OPTION ; plus 5 words option
+; OPTION ; +5 words option
;vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
.word XSQUOTE ;
.byte 5,13,10,"ko " ;
.word TYPE ; CR+LF ." ko " to show false branch of conditionnal compilation
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
- .word REFILL ; REFILL Input Buffer with next line
+BRKTELSEND .word REFILL ; REFILL Input Buffer with next line
.word SETIB ; SET Input Buffer pointers SOURCE_LEN, SOURCE_ORG and clear >IN
.word BRAN,BRACKETELSE1 ; then loop back 44 words without options
;If the parse area becomes exhausted, it is refilled as with REFILL. [IF] is an immediate word.
;An ambiguous condition exists if [IF] is POSTPONEd,
; or if the end of the input buffer is reached and cannot be refilled before the terminating [ELSE] or [THEN] is parsed.
-BRACKETIF CMP #0,TOS
- MOV @PSP+,TOS
- JZ BRACKETELSE
- MOV @IP+,PC
+BRACKETIF CMP #0,TOS ; -- f
+ MOV @PSP+,TOS ; --
+ JZ BRACKETELSE ; false flag output
+ MOV @IP+,PC ; true flag output
.IFNDEF NIP
; https://forth-standard.org/standard/core/NIP
;otherwise return a true flag.
mDOCOL
.word DEFINED,ZEROEQUAL,EXIT
-; .word $+2
-; MOV @RSP+,IP
-; MOV #ZEROEQUAL,PC
-; .word FBLANK,WORDD,FIND,NIP,ZEROEQUAL,EXIT
; https://forth-standard.org/standard/core/MARKER
;Restore all dictionary allocation and search order pointers to the state they had just prior to the
;definition of name. Remove the definition of name and all subsequent definitions. Restoration
;of any structures still existing that could refer to deleted definitions or deallocated data space is
-;not necessarily provided. No other contextual information such as numeric base is affected
-MARKER_DOES .word $+2 ; execution part
- MOV @RSP+,IP ; -- PFA
- MOV @TOS+,&INIVOC ; set VOC_LINK value for RST_STATE
- MOV @TOS,&INIDP ; set DP value for RST_STATE
+;not necessarily provided. No other contextual information such as numeric base is affected.
+
+
+; FastForth provides all that is necessary for a real time application next MARKER definition,
+; by adding a call to a custom subroutine, with the default parameters to be restored saved next MARKER definition.
+MARKER_DOES ; execution part of MARKER, same effect than RST_STATE, but to restore state before MARKER defn.
+ .word $+2 ; -- BODY
+ MOV @TOS+,&RST_DP ; -- BODY+2 thus RST_STATE will restore the word-set state before MARKER
+ .IFDEF VOCABULARY_SET
+ MOV @TOS+,&RST_VOC ; -- BODY+4 thus RST_STATE will restore the word-set state before MARKER
+ .ELSE
+ ADD #2,TOS ; -- BODY+4
+ .ENDIF
+ CALL @TOS+ ; -- BODY+6 @TOS = RET_ADR|STOP_APP_ADR (default|custom)
MOV @PSP+,TOS ; --
- JMP RST_STATE ; execute RST_STATE, PWR_STATE then STATE_DOES
+ MOV @RSP+,IP ;
+ JMP RST_STATE ; then next
FORTHWORD "MARKER" ; definition part
;( "<spaces>name" -- )
;Skip leading space delimiters. Parse name delimited by a space. Create a definition for name
;with the execution semantics defined below.
- CALL #HEADER ;4 W = DP+4
- MOV #DODOES,-4(W) ;4 CFA = DODOES
+ CALL #HEADER ;4 W = DP+4, Y = NFA,
+ MOV #1285h,-4(W) ;4 CFA = CALL R5 = rDODOES
MOV #MARKER_DOES,-2(W) ;4 PFA = MARKER_DOES
- MOV &LASTVOC,0(W) ;5 [BODY] = VOCLINK to be restored
- SUB #2,Y ;1 Y = LFA
- MOV Y,2(W) ;3 [BODY+2] = LFA = DP to be restored
- ADD #4,&DDP ;3
+ SUB #2,Y ;1 Y = NFA-2 = LFA
+ MOV Y,0(W) ;3 BODY = DP value before this MARKER definition
+ .IFDEF VOCABULARY_SET
+ MOV &LASTVOC,2(W) ;5 BODY+2 = current VOCLINK
+ .ENDIF
+ MOV #RET_ADR,4(W) ; BODY+4 = RET addr, to do nothing by default
+ ADD #6,&DDP ;4
JMP GOOD_CSP ;
OSDN Git Service
