- .IFNDEF LOWERCASE
- .WARNING "uncomment LOWERCASE ADD-ON to pass coretest COMPARE !"
- .ENDIF ; LOWERCASE
-
-;COMPARE ( c-addr1 u1 c-addr2 u2 -- n )
-;https://forth-standard.org/standard/string/COMPARE
-;Compare the string specified by c-addr1 u1 to the string specified by c-addr2 u2.
-;The strings are compared, beginning at the given addresses, character by character,
-;up to the length of the shorter string or until a difference is found.
-;If the two strings are identical, n is zero.
-;If the two strings are identical up to the length of the shorter string,
-; n is minus-one (-1) if u1 is less than u2 and one (1) otherwise.
-;If the two strings are not identical up to the length of the shorter string,
-; n is minus-one (-1) if the first non-matching character in the string specified by c-addr1 u1
-; has a lesser numeric value than the corresponding character in the string specified by c-addr2 u2 and one (1) otherwise.
- FORTHWORD "COMPARE"
-COMPARE
- MOV TOS,S ;1 u2 = S
- MOV @PSP+,Y ;2 addr2 = Y
- MOV @PSP+,T ;2 u1 = T
- MOV @PSP+,X ;2 addr1 = X
-COMPAR1 MOV T,TOS ;1
- ADD S,TOS ;1
- JZ COMPEQUAL ;2 end of all successfull comparisons
- SUB #1,T ;1
- JN COMPLESS ;2 u1<u2
- SUB #1,S ;1
- JN COMPGREATER ;2 u2<u1
- ADD #1,X ;1
- CMP.B @Y+,-1(X) ;4 char1-char2
- JZ COMPAR1 ;2 char1=char2 17~ loop
- JHS COMPGREATER ;2 char1>char2
-COMPLESS ; char1<char2
- MOV #-1,TOS ;1
- MOV @IP+,PC ;4
-COMPGREATER
- MOV #1,TOS ;1
-COMPEQUAL
- MOV @IP+,PC ;4 20 words
-
-;[THEN]
-;https://forth-standard.org/standard/tools/BracketTHEN
- FORTHWORDIMM "[THEN]" ; do nothing
- mNEXT
-
-;[ELSE]
+; ; 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 ; -- cnt=0
+; BRACKETELSE0
+; .word ONEPLUS ; -- cnt+1
+; BRACKETELSE1 ;
+; .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,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 ; -- cnt addr u addr u
+; .word XSQUOTE ;
+; .byte 6,"[ELSE]" ;
+; .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,ZEROEQUAL ;
+; .word QFBRAN,BRACKETELSE1 ; -- cnt if bad comparaison, loop back
+; .word BRAN,BRACKETELSE0 ; -- cnt else increment loop back
+; BRACKETELSE5 ;
+; .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 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
+
+; 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
+
+; 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
+
+ FORTHWORDIMM "[ELSE]" ; or [IF] if isnogood...
+; https://forth-standard.org/standard/tools/BracketELSE
+; [ELSE] a few (smaller and faster) definition