forthMSP430FR_CONDCOMP.asm

   1
   2
   3 ;COMPARE ( c-addr1 u1 c-addr2 u2 -- n )
   4 ;https://forth-standard.org/standard/string/COMPARE
   5 ;Compare the string specified by c-addr1 u1 to the string specified by c-addr2 u2.
   6 ;The strings are compared, beginning at the given addresses, character by character,
   7 ;up to the length of the shorter string or until a difference is found.
   8 ;If the two strings are identical, n is zero.
   9 ;If the two strings are identical up to the length of the shorter string,
  10 ;   n is minus-one (-1) if u1 is less than u2 and one (1) otherwise.
  11 ;If the two strings are not identical up to the length of the shorter string,
  12 ;   n is minus-one (-1) if the first non-matching character in the string specified by c-addr1 u1
  13 ;   has a lesser numeric value than the corresponding character in the string specified by c-addr2 u2 and one (1) otherwise.
  14         FORTHWORD "COMPARE"
  15 COMPARE
  16         MOV TOS,S       ;1 S = u2
  17         MOV @PSP+,Y     ;2 Y = addr2
  18         MOV @PSP+,T     ;2 T = u1
  19         MOV @PSP+,X     ;2 X = addr1
  20 COMPAR1 MOV T,TOS       ;1
  21         ADD S,TOS       ;1 TOS = u1+u2
  22         JZ  COMPEQUAL   ;2 u1=u2=0: end of all successfull comparisons
  23         SUB #1,T        ;1
  24         JN COMPLESS     ;2 u1<u2 if u1 < 0
  25         SUB #1,S        ;1
  26         JN COMPGREATER  ;2 u1>u2 if u2 < 0
  27         ADD #1,X        ;1
  28         CMP.B @Y+,-1(X) ;4 char1-char2
  29         JZ COMPAR1      ;2 char1=char2  17~ loop
  30         JHS COMPGREATER ;2 char1>char2
  31 COMPLESS                ;  char1<char2
  32         MOV #-1,TOS     ;1
  33         MOV @IP+,PC     ;4
  34 COMPGREATER
  35         MOV #1,TOS      ;1
  36 COMPEQUAL
  37         MOV @IP+,PC     ;4     20 words
  38
  39 ;[THEN]
  40 ;https://forth-standard.org/standard/tools/BracketTHEN
  41         FORTHWORDIMM "[THEN]"   ; do nothing
  42         mNEXT
  43
  44 ;;[ELSE]
  45 ;;https://forth-standard.org/standard/tools/BracketELSE
  46 ;;Compilation:
  47 ;;Perform the execution semantics given below.
  48 ;;Execution:
  49 ;;( "<spaces>name ..." -- )
  50 ;;Skipping leading spaces, parse and discard space-delimited words from the parse area,
  51 ;;including nested occurrences of [IF] ... [THEN] and [IF] ... [ELSE] ... [THEN],
  52 ;;until the word [THEN] has been parsed and discarded.
  53 ;;If the parse area becomes exhausted, it is refilled as with REFILL.
  54 ;        FORTHWORDIMM  "[ELSE]"
  55 ;BRACKETELSE
  56 ;        mDOCOL
  57 ;        .word   lit,1                   ;   1
  58 ;BRACKETELSE1                            ;   BEGIN
  59 ;BRACKETELSE2                            ;       BEGIN
  60 ;        .word   FBLANK,WORDD,COUNT      ;           BL WORD COUNT
  61 ;        .word   DUP                     ;           DUP
  62 ;        .word   QBRAN,BRACKETELSE10     ;       WHILE
  63 ;        .word   OVER,OVER               ;           2DUP
  64 ;        .word   XSQUOTE                 ;           S" [IF]"
  65 ;        .byte   4,"[IF]"                ;
  66 ;        .word   COMPARE                 ;           COMPARE
  67 ;        .word   QZBRAN,BRACKETELSE3     ;           0= IF
  68 ;        .word   TWODROP,ONEPLUS         ;               2DROP 1+
  69 ;        .word   BRAN,BRACKETELSE8       ;           (ENDIF)
  70 ;BRACKETELSE3                            ;           ELSE
  71 ;        .word   OVER,OVER               ;               2DUP
  72 ;        .word   XSQUOTE                 ;               S" [ELSE]"
  73 ;        .byte   6,"[ELSE]"              ;
  74 ;        .word   COMPARE                 ;               COMPARE
  75 ;        .word   QZBRAN,BRACKETELSE5     ;               0= IF
  76 ;        .word   TWODROP,ONEMINUS        ;                   2DROP 1-
  77 ;        .word   DUP,QBRAN,BRACKETELSE4  ;                  DUP IF
  78 ;        .word   ONEPLUS                 ;                       1+
  79 ;BRACKETELSE4                            ;                   THEN
  80 ;        .word   BRAN,BRACKETELSE7       ;               (ENDIF)
  81 ;BRACKETELSE5                            ;               ELSE
  82 ;        .word   XSQUOTE                 ;                   S" [THEN]"
  83 ;        .byte   6,"[THEN]"              ;
  84 ;        .word   COMPARE                 ;                   COMPARE
  85 ;        .word   QZBRAN,BRACKETELSE6     ;                   0= IF
  86 ;        .word   ONEMINUS                ;                       1-
  87 ;BRACKETELSE6                            ;                   THEN
  88 ;BRACKETELSE7                            ;               THEN
  89 ;BRACKETELSE8                            ;           THEN
  90 ;        .word   QDUP                    ;           ?DUP
  91 ;        .word   QZBRAN,BRACKETELSE9     ;           0= IF
  92 ;        .word   EXIT                    ;               EXIT
  93 ;BRACKETELSE9                            ;           THEN
  94 ;        .word   BRAN,BRACKETELSE2       ;       REPEAT
  95 ;BRACKETELSE10                           ;
  96 ;        .word   TWODROP                 ;       2DROP
  97 ;        .word   XSQUOTE                 ;
  98 ;        .byte   5,13,10,"ko "           ;
  99 ;        .word   TYPE                    ;       CR+LF ." ko "     to show false branch of conditionnal compilation
 100 ;        .word   REFILL                  ;       REFILL
 101 ;        .word   SETIB                   ;               SET Input Buffer pointers SOURCE_LEN, SOURCE_ORG and clear >IN
 102 ;        .word   BRAN,BRACKETELSE1       ;   AGAIN  65 words
 103
 104 ;
 105 ;[ELSE]      a few (smaller and faster) definition
 106 ;https://forth-standard.org/standard/tools/BracketELSE
 107 ;Compilation:
 108 ;Perform the execution semantics given below.
 109 ;Execution:
 110 ;( "<spaces>name ..." -- )
 111 ;Skipping leading spaces, parse and discard space-delimited words from the parse area,
 112 ;including nested occurrences of [IF] ... [THEN] and [IF] ... [ELSE] ... [THEN],
 113 ;until the word [THEN] has been parsed and discarded.
 114 ;If the parse area becomes exhausted, it is refilled as with REFILL.
 115         FORTHWORDIMM  "[ELSE]"          ; or [IF] isnogood...
 116 BRACKETELSE
 117         mDOCOL
 118         .word   lit,0
 119 BRACKETELSE0
 120         .word   ONEPLUS                 ;
 121 BRACKETELSE1                            ;
 122         .word   FBLANK,WORDD,COUNT      ;
 123         .word   DUP,QBRAN,BRACKETELSE5  ; if end of line refill buffer then loop back
 124         .word   OVER,OVER               ; 2DUP
 125         .word   XSQUOTE                 ;
 126         .byte   6,"[THEN]"              ;
 127         .word   COMPARE                 ;
 128         .word   QZBRAN,BRACKETELSE2     ; if bad comparaison, jump for next comparaison
 129         .word   TWODROP,ONEMINUS        ; 2DROP, decrement count
 130         .word   QDUP,QZBRAN,BRACKETELSE1; loop back if count <> 0
 131         .word   EXIT                    ; else exit
 132 BRACKETELSE2                            ;
 133         .word   OVER,OVER               ; 2DUP
 134         .word   XSQUOTE                 ;
 135         .byte   6,"[ELSE]"              ;
 136         .word   COMPARE                 ;
 137         .word   QZBRAN,BRACKETELSE3     ; if bad comparaison, jump for next comparaison
 138         .word   TWODROP,ONEMINUS        ; 2DROP, decrement count
 139         .word   QDUP,QZBRAN,BRACKETELSE0; if count <> 0 restore old count with loop back increment
 140         .word   EXIT                    ; else exit
 141 BRACKETELSE3                            ;
 142         .word   XSQUOTE                 ;
 143         .byte   4,"[IF]"                ;
 144         .word   COMPARE                 ;
 145         .word   QZBRAN,BRACKETELSE1     ; if bad comparaison, loop back
 146         .word   BRAN,BRACKETELSE0       ; else increment loop back
 147 BRACKETELSE5                            ;
 148         .word   TWODROP                 ;
 149         .word   XSQUOTE                 ;
 150         .byte   5,13,10,"ko "           ;
 151         .word   TYPE                    ; CR+LF ." ko "     to show false branch of conditionnal compilation
 152         .word   REFILL                  ; REFILL Input Buffer
 153         .word   SETIB                   ; SET Input Buffer pointers SOURCE_LEN, SOURCE_ORG and clear >IN
 154         .word   BRAN,BRACKETELSE1       ; then loop back   60 words
 155
 156
 157 ;[IF]
 158 ;https://forth-standard.org/standard/tools/BracketIF
 159 ;Compilation:
 160 ;Perform the execution semantics given below.
 161 ;Execution: ;( flag | flag "<spaces>name ..." -- )
 162 ;If flag is true, do nothing. Otherwise, skipping leading spaces,
 163 ;   parse and discard space-delimited words from the parse area,
 164 ;   including nested occurrences of [IF] ... [THEN] and [IF] ... [ELSE] ... [THEN],
 165 ;   until either the word [ELSE] or the word [THEN] has been parsed and discarded.
 166 ;If the parse area becomes exhausted, it is refilled as with REFILL. [IF] is an immediate word.
 167 ;An ambiguous condition exists if [IF] is POSTPONEd,
 168 ;   or if the end of the input buffer is reached and cannot be refilled before the terminating [ELSE] or [THEN] is parsed.
 169         FORTHWORDIMM "[IF]" ; flag --
 170 BRACKETIF
 171         CMP #0,TOS
 172         MOV @PSP+,TOS
 173         JZ BRACKETELSE
 174         mNEXT
 175
 176 ;[DEFINED]
 177 ;https://forth-standard.org/standard/tools/BracketDEFINED
 178 ;Compilation:
 179 ;Perform the execution semantics given below.
 180 ;Execution:
 181 ;( "<spaces>name ..." -- flag )
 182 ;Skip leading space delimiters. Parse name delimited by a space.
 183 ;Return a true flag if name is the name of a word that can be found,
 184 ;otherwise return a false flag. [DEFINED] is an immediate word.
 185
 186         FORTHWORDIMM  "[DEFINED]"
 187         mDOCOL
 188         .word   FBLANK,WORDD,FIND,NIP,EXIT
 189
 190 ;[UNDEFINED]
 191 ;https://forth-standard.org/standard/tools/BracketUNDEFINED
 192 ;Compilation:
 193 ;Perform the execution semantics given below.
 194 ;Execution: ( "<spaces>name ..." -- flag )
 195 ;Skip leading space delimiters. Parse name delimited by a space.
 196 ;Return a false flag if name is the name of a word that can be found,
 197 ;otherwise return a true flag.
 198         FORTHWORDIMM  "[UNDEFINED]"
 199         mDOCOL
 200         .word   FBLANK,WORDD,FIND,NIP,ZEROEQUAL,EXIT
 201
 202 ;; CORE EXT  MARKER
 203 ;;https://forth-standard.org/standard/core/MARKER
 204 ;;( "<spaces>name" -- )
 205 ;;Skip leading space delimiters. Parse name delimited by a space. Create a definition for name
 206 ;;with the execution semantics defined below.
 207
 208 ;;name Execution: ( -- )
 209 ;;Restore all dictionary allocation and search order pointers to the state they had just prior to the
 210 ;;definition of name. Remove the definition of name and all subsequent definitions. Restoration
 211 ;;of any structures still existing that could refer to deleted definitions or deallocated data space is
 212 ;;not necessarily provided. No other contextual information such as numeric base is affected
 213
 214 MARKER_DOES FORTHtoASM                  ; execution part
 215             MOV     @RSP+,IP            ; -- PFA
 216             MOV     @TOS+,&INIVOC       ;       set VOC_LINK value for RST_STATE
 217             MOV     @TOS,&INIDP         ;       set DP value for RST_STATE
 218             MOV     @PSP+,TOS           ; --
 219             JMP     RST_STATE           ;       execute RST_STATE, PWR_STATE then STATE_DOES
 220
 221             FORTHWORD "MARKER"          ; definition part
 222             CALL    #HEADER             ;4 W = DP+4
 223             MOV     #DODOES,-4(W)       ;4 CFA = DODOES
 224             MOV     #MARKER_DOES,-2(W)  ;4 PFA = MARKER_DOES
 225             MOV     &LASTVOC,0(W)       ;5 [BODY] = VOCLINK to be restored
 226             SUB     #2,Y                ;1 Y = LFA
 227             MOV     Y,2(W)              ;3 [BODY+2] = LFA = DP to be restored
 228             ADD     #4,&DDP             ;3
 229
 230
 231                                         ; the next in forthMSP430FR.asm is GOOD_CSP