- .IFNDEF LOWERCASE
- .WARNING "uncomment LOWERCASE ADD-ON to pass coretest COMPARE !"
- .ENDIF ; LOWERCASE
-
-;COMPARE ( c-addr1 u1 c-addr2 u2 -- n )
-;https://forth-standard.org/standard/string/COMPARE
-;Compare the string specified by c-addr1 u1 to the string specified by c-addr2 u2.
-;The strings are compared, beginning at the given addresses, character by character,
-;up to the length of the shorter string or until a difference is found.
-;If the two strings are identical, n is zero.
-;If the two strings are identical up to the length of the shorter string,
-; n is minus-one (-1) if u1 is less than u2 and one (1) otherwise.
-;If the two strings are not identical up to the length of the shorter string,
-; n is minus-one (-1) if the first non-matching character in the string specified by c-addr1 u1
-; has a lesser numeric value than the corresponding character in the string specified by c-addr2 u2 and one (1) otherwise.
- FORTHWORD "COMPARE"
-COMPARE
- MOV TOS,S ;1 u2 = S
- MOV @PSP+,Y ;2 addr2 = Y
- MOV @PSP+,T ;2 u1 = T
- MOV @PSP+,X ;2 addr1 = X
-COMPAR1 MOV T,TOS ;1 TOS=u1
- ADD S,TOS ;1 TOS=u1+u2
- JZ COMPEQUAL ;2 u1=u2=0: end of all successfull comparisons
+; https://forth-standard.org/standard/tools/BracketTHEN
+; [THEN]
+ FORTHWORDIMM "[THEN]" ; do nothing
+ MOV @IP+,PC
+
+; ; https://forth-standard.org/standard/string/COMPARE
+; ; COMPARE ( c-addr1 u1 c-addr2 u2 -- n )
+; ;Compare the string specified by c-addr1 u1 to the string specified by c-addr2 u2.
+; ;The strings are compared, beginning at the given addresses, character by character,
+; ;up to the length of the shorter string or until a difference is found.
+; ;If the two strings are identical, n is zero.
+; ;If the two strings are identical up to the length of the shorter string,
+; ; n is minus-one (-1) if u1 is less than u2 and one (1) otherwise.
+; ;If the two strings are not identical up to the length of the shorter string,
+; ; n is minus-one (-1) if the first non-matching character in the string specified by c-addr1 u1
+; ; has a lesser numeric value than the corresponding character in the string specified by c-addr2 u2 and one (1) otherwise.
+; FORTHWORD "COMPARE"
+; COMPARE
+; MOV TOS,S ;1 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 COMPEQUAL ;2 u1=u2=0, Z=1, end of all successfull comparisons
+; SUB #1,T ;1
+; JN COMPLESS ;2 u1<u2 if u1 < 0
+; SUB #1,S ;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
+; JC COMPGREATER ;2 char1>char2
+; COMPLESS ; char1<char2
+; MOV #-1,TOS ;1 Z=0
+; MOV @IP+,PC ;4
+; COMPGREATER
+; MOV #1,TOS ;1 Z=0
+; COMPEQUAL
+; MOV @IP+,PC ;4 20 + 5 words def'n
+
+; ; https://forth-standard.org/standard/tools/BracketELSE
+; ; [ELSE] a few (smaller and faster) definition
+; ;Compilation:
+; ;Perform the execution semantics given below.
+; ;Execution:
+; ;( "<spaces>name ..." -- )
+; ;Skipping leading spaces, parse and discard space-delimited words from the parse area,
+; ;including nested occurrences of [IF] ... [THEN] and [IF] ... [ELSE] ... [THEN],
+; ;until the word [THEN] has been parsed and discarded.
+; ;If the parse area becomes exhausted, it is refilled as with REFILL.
+; FORTHWORDIMM "[ELSE]" ; or [IF] if isnogood...
+; BRACKETELSE
+; mDOCOL
+; .word lit,0
+; BRACKETELSE0
+; .word ONEPLUS ;
+; BRACKETELSE1 ;
+; .word FBLANK,WORDD,COUNT ; -- 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
+; BRACKETELSE2 ;
+; .word TWODUP ;
+; .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
+; BRACKETELSE3 ;
+; .word XSQUOTE ;
+; .byte 4,"[IF]" ;
+; .word COMPARE ;
+; .word QTBRAN,BRACKETELSE1 ; if bad comparaison, loop back
+; .word BRAN,BRACKETELSE0 ; else increment loop back
+; BRACKETELSE5 ;
+; .word TWODROP ;
+; ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
+; ; 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 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
+
+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 COMPLESS ;2 u1<u2
+ JN COMPDIF ;2 u1<u2 if u1 < 0
SUB #1,S ;1
- JN COMPGREATER ;2 u1>u2
- ADD #1,X ;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
- JHS COMPGREATER ;2 char1>char2
-COMPLESS ; char1<char2
- MOV #-1,TOS ;1
+COMPDIF MOV @IP,IP ; take branch
+CMPEND MOV @PSP+,TOS
MOV @IP+,PC ;4
-COMPGREATER
- MOV #1,TOS ;1
-COMPEQUAL
- MOV @IP+,PC ;4 20 words
-;[THEN]
-;https://forth-standard.org/standard/tools/BracketTHEN
- FORTHWORDIMM "[THEN]" ; do nothing
- mNEXT
+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 --
+COMPEQU ADD #2,IP ; skip branch
+ JMP CMPEND ; 25 words
-;[ELSE]
+; https://forth-standard.org/standard/tools/BracketELSE
+; [ELSE] a few (smaller and faster) definition
;Compilation:
;Perform the execution semantics given below.
;Execution:
;including nested occurrences of [IF] ... [THEN] and [IF] ... [ELSE] ... [THEN],
;until the word [THEN] has been parsed and discarded.
;If the parse area becomes exhausted, it is refilled as with REFILL.
- FORTHWORDIMM "[ELSE]"
+ FORTHWORDIMM "[ELSE]" ; or [IF] if isnogood...
BRACKETELSE
mDOCOL
- .word lit,1 ; 1
-BRACKETELSE1 ; BEGIN
-BRACKETELSE2 ; BEGIN
- .word FBLANK,WORDD,COUNT ; BL WORD COUNT
- .word DUP,QBRAN,BRACKETELSE10 ; DUP WHILE
- .word OVER,OVER ; 2DUP
- .word XSQUOTE ; S" [IF]"
- .byte 4,"[IF]" ;
- .word COMPARE ; COMPARE
- .word QZBRAN,BRACKETELSE3 ; 0= IF
- .word TWODROP,ONEPLUS ; 2DROP 1+
- .word BRAN,BRACKETELSE8 ; (ENDIF)
-BRACKETELSE3 ; ELSE
- .word OVER,OVER ; OVER OVER
- .word XSQUOTE ; S" [ELSE]"
- .byte 6,"[ELSE]" ;
- .word COMPARE ; COMPARE
- .word QZBRAN,BRACKETELSE5 ; 0= IF
- .word TWODROP,ONEMINUS ; 2DROP 1-
-; .word DUP,QBRAN,BRACKETELSE4 ; DUP IF
- .word DUP,QBRAN,BRACKETELSE7 ;
- .word ONEPLUS ; 1+
-BRACKETELSE4 ; THEN
- .word BRAN,BRACKETELSE7 ; (ENDIF)
-BRACKETELSE5 ; ELSE
- .word XSQUOTE ; S" [THEN]"
- .byte 6,"[THEN]" ;
- .word COMPARE ; COMPARE
- .word QZBRAN,BRACKETELSE6 ; 0= IF
- .word ONEMINUS ; 1-
-BRACKETELSE6 ; THEN
-BRACKETELSE7 ; THEN
-BRACKETELSE8 ; THEN
- .word QDUP ; ?DUP
-; .word QZBRAN,BRACKETELSE9 ; 0= IF
- .word QZBRAN,BRACKETELSE2 ;
- .word EXIT ; EXIT
-;BRACKETELSE9 ; THEN
-; .word BRAN,BRACKETELSE2 ; REPEAT
-BRACKETELSE10 ;
- .word TWODROP ; 2DROP
+ .word lit,0
+BRACKETELSE0
+ .word ONEPLUS ;
+BRACKETELSE1 ;
+ .word FBLANK,WORDD,COUNT ; -- 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 BADCOMPBR,BRACKETELSE2 ; if bad string comparaison, jump for next comparaison
+ .word TOQTB,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 EXIT ; then exit
+BRACKETELSE3 ;
+ .word XSQUOTE ;
+ .byte 4,"[IF]" ;
+ .word BADCOMPBR,BRACKETELSE1 ; if bad string comparaison, loop back
+ .word BRAN,BRACKETELSE0 ; else loop back with count+1
+BRACKETELSE5 ;
+ .word TWODROP ;
+;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
+; 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 REFILL ; REFILL
- .word SETIB ; SET Input Buffer pointers SOURCE_LEN, SOURCE_ORG and clear >IN
- .word BRAN,BRACKETELSE1 ; AGAIN
-
-
-;[IF]
-;https://forth-standard.org/standard/tools/BracketIF
+ .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 44 words without options
+
+; https://forth-standard.org/standard/tools/BracketIF
+; [IF]
;Compilation:
;Perform the execution semantics given below.
;Execution: ;( flag | flag "<spaces>name ..." -- )
CMP #0,TOS
MOV @PSP+,TOS
JZ BRACKETELSE
- mNEXT
+ MOV @IP+,PC
-; FORTHWORDIMM "[IFNOT]" ; flag --
-; XOR #-1,TOS
-; JMP BRACKETIF
+; https://forth-standard.org/standard/core/NIP
+; NIP x1 x2 -- x2 Drop the first item below the top of stack
+ .IFNDEF NIP
+NIP ADD #2,PSP ; 1
+ MOV @IP+,PC ; 4
+ .ENDIF
-;[DEFINED]
-;https://forth-standard.org/standard/tools/BracketDEFINED
+; https://forth-standard.org/standard/tools/BracketDEFINED
+; [DEFINED]
;Compilation:
;Perform the execution semantics given below.
;Execution:
;otherwise return a false flag. [DEFINED] is an immediate word.
FORTHWORDIMM "[DEFINED]"
-BRACKETDEFINED
- mDOCOL
+DEFINED mDOCOL
.word FBLANK,WORDD,FIND,NIP,EXIT
-;[UNDEFINED]
-;https://forth-standard.org/standard/tools/BracketUNDEFINED
+; https://forth-standard.org/standard/tools/BracketUNDEFINED
+; [UNDEFINED]
;Compilation:
;Perform the execution semantics given below.
;Execution: ( "<spaces>name ..." -- flag )
;otherwise return a true flag.
FORTHWORDIMM "[UNDEFINED]"
mDOCOL
- .word BRACKETDEFINED,ZEROEQUAL,EXIT
-
-;; CORE EXT MARKER
-;;https://forth-standard.org/standard/core/MARKER
-;;( "<spaces>name" -- )
-;;Skip leading space delimiters. Parse name delimited by a space. Create a definition for name
-;;with the execution semantics defined below.
-
-;;name Execution: ( -- )
-;;Restore all dictionary allocation and search order pointers to the state they had just prior to the
-;;definition of name. Remove the definition of name and all subsequent definitions. Restoration
-;;of any structures still existing that could refer to deleted definitions or deallocated data space is
-;;not necessarily provided. No other contextual information such as numeric base is affected
-
-MARKER_DOES FORTHtoASM ; execution part
- MOV @RSP+,IP ; -- PFA
- MOV @TOS+,&INIVOC ; set VOC_LINK value for RST_STATE
- MOV @TOS,&INIDP ; set DP value for RST_STATE
- MOV @PSP+,TOS ; --
- JMP RST_STATE ; execute RST_STATE, PWR_STATE then STATE_DOES
-
- FORTHWORD "MARKER" ; definition part
- CALL #HEADER ;4 W = DP+4
- MOV #DODOES,-4(W) ;4 CFA = DODOES
- MOV #MARKER_DOES,-2(W) ;4 PFA = MARKER_DOES
- MOV &LASTVOC,0(W) ;5 [BODY] = VOCLINK to be restored
- SUB #2,Y ;1 Y = LFA
- MOV Y,2(W) ;3 [BODY+2] = LFA = DP to be restored
- ADD #4,&DDP ;3
-
-
- ; the next in forthMSP430FR.asm is GOOD_CSP
+ .word DEFINED
+ .word $+2
+ MOV @RSP+,IP
+ MOV #ZEROEQUAL,PC
OSDN Git Service
