ADDON/CONDCOMP.asm

   1
   2
   3     .IFNDEF LOWERCASE
   4     .WARNING "uncomment LOWERCASE ADD-ON to pass coretest COMPARE ADD-ON !"
   5     .ENDIF
   6
   7
   8 ;COMPARE ( c-addr1 u1 c-addr2 u2 -- n )
   9 ;https://forth-standard.org/standard/string/COMPARE
  10 ;Compare the string specified by c-addr1 u1 to the string specified by c-addr2 u2.
  11 ;The strings are compared, beginning at the given addresses, character by character,
  12 ;up to the length of the shorter string or until a difference is found.
  13 ;If the two strings are identical, n is zero.
  14 ;If the two strings are identical up to the length of the shorter string,
  15 ;   n is minus-one (-1) if u1 is less than u2 and one (1) otherwise.
  16 ;If the two strings are not identical up to the length of the shorter string,
  17 ;   n is minus-one (-1) if the first non-matching character in the string specified by c-addr1 u1
  18 ;   has a lesser numeric value than the corresponding character in the string specified by c-addr2 u2 and one (1) otherwise.
  19         FORTHWORD "COMPARE"
  20 COMPARE
  21         MOV TOS,S       ;1 u2 = S
  22         MOV @PSP+,Y     ;2 addr2 = Y
  23         MOV @PSP+,T     ;2 u1 = T
  24         MOV @PSP+,X     ;2 addr1 = X
  25 COMPAR1 MOV T,TOS       ;1
  26         ADD S,TOS       ;1
  27         JZ  COMPEQUAL   ;2 end of all successfull comparisons
  28         SUB #1,T        ;1
  29         JN COMPLESS     ;2 u1<u2
  30         SUB #1,S        ;1
  31         JN COMPGREATER  ;2 u2<u1
  32         ADD #1,X        ;1
  33         CMP.B @Y+,-1(X) ;4 char1-char2
  34         JZ COMPAR1      ;2 char1=char2  17~ loop
  35         JHS COMPGREATER ;2 char1>char2
  36 COMPLESS                ;  char1<char2
  37         MOV #-1,TOS     ;1
  38         MOV @IP+,PC     ;4
  39 COMPGREATER
  40         MOV #1,TOS      ;1
  41 COMPEQUAL
  42         MOV @IP+,PC     ;4     20 words
  43
  44 ;[THEN]
  45 ;https://forth-standard.org/standard/tools/BracketTHEN
  46         FORTHWORDIMM "[THEN]"   ; do nothing
  47         mNEXT
  48
  49 ONEMIN
  50         SUB #1,TOS
  51         mNEXT
  52
  53 ;[ELSE]
  54 ;Compilation:
  55 ;Perform the execution semantics given below.
  56 ;Execution:
  57 ;( "<spaces>name ..." -- )
  58 ;Skipping leading spaces, parse and discard space-delimited words from the parse area,
  59 ;including nested occurrences of [IF] ... [THEN] and [IF] ... [ELSE] ... [THEN],
  60 ;until the word [THEN] has been parsed and discarded.
  61 ;If the parse area becomes exhausted, it is refilled as with REFILL.
  62         FORTHWORDIMM  "[ELSE]"
  63 BRACKETELSE
  64         mDOCOL
  65         .word   lit,1                   ;   1
  66 BRACKETELSE1                            ;   BEGIN
  67 BRACKETELSE2                            ;       BEGIN
  68         .word   FBLANK,WORDD,COUNT      ;           BL WORD COUNT
  69         .word   DUP,QBRAN,BRACKETELSE10 ;       DUP WHILE
  70         .word   OVER,OVER               ;           2DUP
  71         .word   XSQUOTE                 ;           S" [IF]"
  72         .byte   4,"[IF]"                ;
  73         .word   COMPARE                 ;           COMPARE
  74         .word   QZBRAN,BRACKETELSE3     ;           0= IF
  75         .word   TWODROP,ONEPLUS         ;               2DROP 1+
  76         .word   BRAN,BRACKETELSE8       ;           (ENDIF)
  77 BRACKETELSE3                            ;           ELSE
  78         .word   OVER,OVER               ;               OVER OVER
  79         .word   XSQUOTE                 ;               S" [ELSE]"
  80         .byte   6,"[ELSE]"              ;
  81         .word   COMPARE                 ;               COMPARE
  82         .word   QZBRAN,BRACKETELSE5     ;               0= IF
  83         .word   TWODROP,ONEMIN          ;                   2DROP 1-
  84         .word   DUP,QBRAN,BRACKETELSE4  ;                   DUP IF
  85         .word   ONEPLUS                 ;                       1+
  86 BRACKETELSE4                            ;                   THEN
  87         .word   BRAN,BRACKETELSE7       ;               (ENDIF)
  88 BRACKETELSE5                            ;               ELSE
  89         .word   XSQUOTE                 ;                   S" [THEN]"
  90         .byte   6,"[THEN]"              ;
  91         .word   COMPARE                 ;                   COMPARE
  92         .word   QZBRAN,BRACKETELSE6     ;                   0= IF
  93         .word   ONEMIN                  ;                       1-
  94 BRACKETELSE6                            ;                   THEN
  95 BRACKETELSE7                            ;               THEN
  96 BRACKETELSE8                            ;           THEN
  97         .word   QDUP                    ;           ?DUP
  98         .word   QZBRAN,BRACKETELSE9     ;           0= IF
  99         .word   EXIT                    ;               EXIT
 100 BRACKETELSE9                            ;           THEN
 101         .word   BRAN,BRACKETELSE2       ;       REPEAT
 102 BRACKETELSE10                           ;
 103         .word   TWODROP                 ;       2DROP
 104         .word   XSQUOTE                 ;       CR ." ko "     to show false branch of conditionnal compilation
 105         .byte   4,13,107,111,32         ;
 106         .word   TYPE                    ;
 107         .word   FTIB,DUP,lit,TIB_SIZE   ;       REFILL
 108         .word   ACCEPT                  ; -- StringOrg len' (len' <= TIB_SIZE)
 109         FORTHtoASM                      ;
 110         MOV     TOS,&SOURCE_LEN         ; -- StringOrg len'
 111         MOV     @PSP+,&SOURCE_ADR       ; -- len'
 112         MOV     @PSP+,TOS               ;
 113         MOV     #0,&TOIN                ;
 114         MOV     #BRACKETELSE1,IP        ;   AGAIN
 115         mNEXT                           ; 78 words
 116
 117
 118 ;[IF]
 119 ;https://forth-standard.org/standard/tools/BracketIF
 120 ;Compilation:
 121 ;Perform the execution semantics given below.
 122 ;Execution: ;( flag | flag "<spaces>name ..." -- )
 123 ;If flag is true, do nothing. Otherwise, skipping leading spaces,
 124 ;   parse and discard space-delimited words from the parse area,
 125 ;   including nested occurrences of [IF] ... [THEN] and [IF] ... [ELSE] ... [THEN],
 126 ;   until either the word [ELSE] or the word [THEN] has been parsed and discarded.
 127 ;If the parse area becomes exhausted, it is refilled as with REFILL. [IF] is an immediate word.
 128 ;An ambiguous condition exists if [IF] is POSTPONEd,
 129 ;   or if the end of the input buffer is reached and cannot be refilled before the terminating [ELSE] or [THEN] is parsed.
 130         FORTHWORDIMM "[IF]" ; flag --
 131         CMP #0,TOS
 132         MOV @PSP+,TOS
 133         JZ BRACKETELSE
 134         mNEXT
 135
 136 ;[UNDEFINED]
 137 ;https://forth-standard.org/standard/tools/BracketUNDEFINED
 138 ;Compilation:
 139 ;Perform the execution semantics given below.
 140 ;Execution: ( "<spaces>name ..." -- flag )
 141 ;Skip leading space delimiters. Parse name delimited by a space.
 142 ;Return a false flag if name is the name of a word that can be found,
 143 ;otherwise return a true flag.
 144         FORTHWORDIMM  "[UNDEFINED]"
 145         mDOCOL
 146         .word   FBLANK,WORDD,FIND,NIP,ZEROEQUAL,EXIT
 147
 148 ;[DEFINED]
 149 ;https://forth-standard.org/standard/tools/BracketDEFINED
 150 ;Compilation:
 151 ;Perform the execution semantics given below.
 152 ;Execution:
 153 ;( "<spaces>name ..." -- flag )
 154 ;Skip leading space delimiters. Parse name delimited by a space.
 155 ;Return a true flag if name is the name of a word that can be found,
 156 ;otherwise return a false flag. [DEFINED] is an immediate word.
 157
 158         FORTHWORDIMM  "[DEFINED]"
 159         mDOCOL
 160         .word   FBLANK,WORDD,FIND,NIP,EXIT
 161
 162
 163
 164 ;;[THEN]
 165 ;;https://forth-standard.org/standard/tools/BracketTHEN
 166 ;        FORTHWORDIMM ".ENDIF"   ; do nothing
 167 ;        mNEXT
 168 ;
 169 ;ONEMIN
 170 ;        SUB #1,TOS
 171 ;        mNEXT
 172 ;
 173 ;;[ELSE]
 174 ;;Compilation:
 175 ;;Perform the execution semantics given below.
 176 ;;Execution:
 177 ;;( "<spaces>name ..." -- )
 178 ;;Skipping leading spaces, parse and discard space-delimited words from the parse area,
 179 ;;including nested occurrences of [IF] ... [THEN] and [IF] ... [ELSE] ... [THEN],
 180 ;;until the word [THEN] has been parsed and discarded.
 181 ;;If the parse area becomes exhausted, it is refilled as with REFILL.
 182 ;        FORTHWORDIMM  ".ELSE"
 183 ;;BRACKETELSE
 184 ;        mDOCOL
 185 ;BRACKETELSE
 186 ;        .word   lit,1                   ;   1
 187 ;BRACKETELSE1                            ;   BEGIN
 188 ;BRACKETELSE2                            ;       BEGIN
 189 ;        .word   FBLANK,WORDD,COUNT      ;           BL WORD COUNT
 190 ;        .word   DUP,QBRAN,BRACKETELSE10 ;       DUP WHILE
 191 ;        .word   OVER,OVER               ;           2DUP
 192 ;        .word   XSQUOTE                 ;           S" [IF]"
 193 ;        .byte   6,".IFDEF"              ;
 194 ;        .word   COMPARE                 ;           COMPARE
 195 ;        .word   QZBRAN,BRACKETELSE21     ;          0= IF
 196 ;        .word   TWODROP,ONEPLUS         ;               2DROP 1+
 197 ;        .word   BRAN,BRACKETELSE8       ;           (ENDIF)
 198 ;BRACKETELSE21
 199 ;        .word   OVER,OVER               ;           2DUP
 200 ;        .word   XSQUOTE                 ;           S" [IF]"
 201 ;        .byte   7,".IFNDEF"             ;
 202 ;        .word   COMPARE                 ;           COMPARE
 203 ;        .word   QZBRAN,BRACKETELSE3     ;           0= IF
 204 ;        .word   TWODROP,ONEPLUS         ;               2DROP 1+
 205 ;        .word   BRAN,BRACKETELSE8       ;           (ENDIF)
 206 ;BRACKETELSE3                            ;           ELSE
 207 ;        .word   OVER,OVER               ;               OVER OVER
 208 ;        .word   XSQUOTE                 ;               S" [ELSE]"
 209 ;        .byte   5,".ELSE"               ;
 210 ;        .word   COMPARE                 ;               COMPARE
 211 ;        .word   QZBRAN,BRACKETELSE5     ;               0= IF
 212 ;        .word   TWODROP,ONEMIN          ;                   2DROP 1-
 213 ;        .word   DUP,QBRAN,BRACKETELSE4  ;                   DUP IF
 214 ;        .word   ONEPLUS                 ;                       1+
 215 ;BRACKETELSE4                            ;                   THEN
 216 ;        .word   BRAN,BRACKETELSE7       ;               (ENDIF)
 217 ;BRACKETELSE5                            ;               ELSE
 218 ;        .word   XSQUOTE                 ;                   S" [THEN]"
 219 ;        .byte   6,".ENDIF"              ;
 220 ;        .word   COMPARE                 ;                   COMPARE
 221 ;        .word   QZBRAN,BRACKETELSE6     ;                   0= IF
 222 ;        .word   ONEMIN                  ;                       1-
 223 ;BRACKETELSE6                            ;                   THEN
 224 ;BRACKETELSE7                            ;               THEN
 225 ;BRACKETELSE8                            ;           THEN
 226 ;        .word   QDUP                    ;           ?DUP
 227 ;        .word   QZBRAN,BRACKETELSE9     ;           0= IF
 228 ;        .word   EXIT                    ;               EXIT
 229 ;BRACKETELSE9                            ;           THEN
 230 ;        .word   BRAN,BRACKETELSE2       ;       REPEAT
 231 ;BRACKETELSE10                           ;
 232 ;        .word   TWODROP                 ;       2DROP
 233 ;        .word   XSQUOTE                 ;       CR ." ko "     to show false branch of conditionnal compilation
 234 ;        .byte   4,13,"ko "              ;
 235 ;        .word   TYPE                    ;
 236 ;        .word   FTIB,DUP,lit,TIB_SIZE   ;       REFILL
 237 ;        .word   ACCEPT                  ; -- StringOrg len' (len' <= TIB_SIZE)
 238 ;        FORTHtoASM                      ;
 239 ;        MOV     TOS,&SOURCE_LEN         ; -- StringOrg len'
 240 ;        MOV     @PSP+,&SOURCE_ADR       ; -- len'
 241 ;        MOV     @PSP+,TOS               ;
 242 ;        MOV     #0,&TOIN                ;
 243 ;        MOV     #BRACKETELSE1,IP        ;   AGAIN
 244 ;        mNEXT                           ; 78 words
 245 ;
 246 ;
 247 ;        FORTHWORDIMM  ".IFDEF"
 248 ;        mDOCOL
 249 ;        .word   FBLANK,WORDD,FIND,NIP
 250 ;        .WORD   QBRAN,BRACKETELSE
 251 ;        .WORD   EXIT
 252 ;
 253 ;        FORTHWORDIMM  ".IFNDEF"
 254 ;        mDOCOL
 255 ;        .word   FBLANK,WORDD,FIND,NIP
 256 ;        .WORD   QZBRAN,BRACKETELSE
 257 ;        .WORD   EXIT
 258
 259