forthMSP430FR_CONDCOMP.asm

   1 ; -*- coding: utf-8 -*-
   2 ;
   3             FORTHWORDIMM "[THEN]"   ; do nothing
   4 ; https://forth-standard.org/standard/tools/BracketTHEN
   5 ; [THEN]
   6             MOV @IP+,PC
   7
   8 ; ; https://forth-standard.org/standard/string/COMPARE
   9 ; ; COMPARE ( c-addr1 u1 c-addr2 u2 -- n )
  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 S = u2
  22 ;         MOV @PSP+,Y     ;2 Y = addr2
  23 ;         MOV @PSP+,T     ;2 T = u1
  24 ;         MOV @PSP+,X     ;2 X = addr1
  25 ; COMPLOOP MOV T,TOS       ;1
  26 ;         ADD S,TOS       ;1 TOS = u1+u2
  27 ;         JZ  COMPEQUAL   ;2 u1=u2=0, Z=1,  end of all successfull comparisons
  28 ;         SUB #1,T        ;1
  29 ;         JN COMPLESS     ;2 u1<u2 if u1 < 0
  30 ;         SUB #1,S        ;1
  31 ;         JN COMPGREATER  ;2 u1>u2 if u2 < 0
  32 ;         ADD #1,X        ;1
  33 ;         CMP.B @Y+,-1(X) ;4 char1-char2
  34 ;         JZ COMPLOOP      ;2 char1=char2  17~ loop
  35 ;         JC  COMPGREATER ;2 char1>char2
  36 ; COMPLESS                ;  char1<char2
  37 ;         MOV #-1,TOS     ;1 Z=0
  38 ;         MOV @IP+,PC     ;4
  39 ; COMPGREATER
  40 ;         MOV #1,TOS      ;1 Z=0
  41 ; COMPEQUAL
  42 ;         MOV @IP+,PC     ;4     20 + 5 words def'n
  43
  44 ; ; https://forth-standard.org/standard/tools/BracketELSE
  45 ; ; [ELSE]      a few (smaller and faster) definition
  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]"          ; or [IF] if isnogood...
  55 ; BRACKETELSE
  56 ;         mDOCOL
  57 ;         .word   lit,0                   ; -- cnt=0
  58 ; BRACKETELSE0
  59 ;         .word   ONEPLUS                 ; -- cnt+1
  60 ; BRACKETELSE1                            ;
  61 ;         .word   FBLANK,WORDD,COUNT      ; -- cnt addr u
  62 ;         .word   DUP,QFBRAN,BRACKETELSE5 ;                 u = 0 if end of line --> refill buffer then loop back
  63 ;         .word   TWODUP                  ;
  64 ;         .word   XSQUOTE                 ;
  65 ;         .byte   6,"[THEN]"              ;
  66 ;         .word   COMPARE,ZEROEQUAL       ;
  67 ;         .word   QFBRAN,BRACKETELSE2     ; -- cnt addr u   if bad comparaison, jump for next comparaison
  68 ;         .word   TWODROP,ONEMINUS        ; -- cnt-1        2DROP, decrement count
  69 ;         .word   QDUP,ZEROEQUAL          ;
  70 ;         .word   QFBRAN,BRACKETELSE1     ; -- cnt-1        loop back if count <> 0
  71 ;         .word   EXIT                    ; --              else exit
  72 ; BRACKETELSE2                            ;
  73 ;         .word   TWODUP                  ; -- cnt addr u addr u
  74 ;         .word   XSQUOTE                 ;
  75 ;         .byte   6,"[ELSE]"              ;
  76 ;         .word   COMPARE,ZEROEQUAL       ; -- cnt addr u ff
  77 ;         .word   QFBRAN,BRACKETELSE3     ; -- cnt addr u   if bad comparaison, jump for next comparaison
  78 ;         .word   TWODROP,ONEMINUS        ; -- cnt-1        2DROP, decrement count
  79 ;         .word   QDUP,ZEROEQUAL          ;
  80 ;         .word   QFBRAN,BRACKETELSE0     ; -- cnt-1        if count <> 0 restore old count with loop back increment
  81 ;         .word   EXIT                    ; --              else exit
  82 ; BRACKETELSE3                            ;
  83 ;         .word   XSQUOTE                 ;
  84 ;         .byte   4,"[IF]"                ;
  85 ;         .word   COMPARE,ZEROEQUAL       ;
  86 ;         .word   QFBRAN,BRACKETELSE1     ; -- cnt          if bad comparaison, loop back
  87 ;         .word   BRAN,BRACKETELSE0       ; -- cnt          else increment loop back
  88 ; BRACKETELSE5                            ;
  89 ;         .word   TWODROP                 ; -- cnt
  90 ; ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
  91 ; ; OPTION                                ; plus 5 words option
  92 ; ;vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
  93 ;         .word   XSQUOTE                 ;
  94 ;         .byte   5,13,10,"ko "           ;
  95 ;         .word   TYPE                    ;                 CR+LF ." ko" to show false branch of conditionnal compilation
  96 ; ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
  97 ;         .word   REFILL                  ;                 REFILL Input Buffer with next line
  98 ;         .word   SETIB                   ;                 SET Input Buffer pointers SOURCE_LEN, SOURCE_ORG and clear >IN
  99 ;         .word   BRAN,BRACKETELSE1       ; -- cnt          then loop back   54 words without options
 100
 101 ; BRanch if string BAD COMParaison, [COMPARE,ZEROEQUAL,QFBRAN] replacement
 102 BRBADCOMP                   ;   -- cnt addr1 u1 addr1 u1 addr2 u2
 103             MOV TOS,S       ;1  S = u2
 104             MOV @PSP+,Y     ;2  Y = addr2
 105             MOV @PSP+,T     ;2  T = u1
 106             MOV @PSP+,X     ;2  X = addr1
 107 COMPLOOP    MOV T,TOS       ;1  -- cnt addr1 u1 u1
 108             ADD S,TOS       ;1  -- cnt addr1 u1 u1+u2
 109             JZ  COMPEQU     ;2  u1=u2=0, Z=1,  end of all successfull comparisons
 110             SUB #1,T        ;1
 111             JN COMPDIF      ;2  u1<u2 if u1 < 0
 112             SUB #1,S        ;1
 113             JN COMPDIF      ;2  u1>u2 if u2 < 0
 114             ADD #1,X        ;1
 115             CMP.B @Y+,-1(X) ;4  char1-char2
 116             JZ COMPLOOP     ;2  char1=char2  17~ loop
 117 COMPDIF     MOV @IP,IP      ;1  take branch
 118 CMPEND      MOV @PSP+,TOS   ;
 119             MOV @IP+,PC     ;4
 120
 121 ; BRanch if string GOOD COMParaison, [TWODROP,ONEMINUS,?DUP,ZEROEQUAL,QFBRAN] replacement
 122 BRGOODCMP                   ;    -- cnt addr u
 123             ADD #2,PSP      ;1   -- cnt u
 124             SUB #1,0(PSP)   ;3   -- cnt-1 u
 125             JNZ COMPDIF     ;2   -- cnt-1 u take branch
 126             ADD #2,PSP      ;1   -- u
 127 COMPEQU     ADD #2,IP       ;               skip branch
 128             JMP CMPEND      ; 25 words
 129
 130             FORTHWORDIMM  "[ELSE]"          ; or [IF] if isnogood...
 131 ; https://forth-standard.org/standard/tools/BracketELSE
 132 ; [ELSE]      a few (smaller and faster) definition
 133 ;Compilation:
 134 ;Perform the execution semantics given below.
 135 ;Execution:
 136 ;( "<spaces>name ..." -- )
 137 ;Skipping leading spaces, parse and discard space-delimited words from the parse area,
 138 ;including nested occurrences of [IF] ... [THEN] and [IF] ... [ELSE] ... [THEN],
 139 ;until the word [THEN] has been parsed and discarded.
 140 ;If the parse area becomes exhausted, it is refilled as with REFILL.
 141 BRACKETELSE
 142             mDOCOL
 143             .word   lit,0
 144 BRACKETELSE0
 145             .word   ONEPLUS                 ;
 146 BRACKETELSE1                                ;
 147             .word   FBLANK,WORDD,COUNT      ; -- addr u
 148             .word   DUP,QFBRAN,BRACKETELSE5 ;       u = 0 if end of line --> refill buffer then loop back
 149             .word   TWODUP                  ;
 150             .word   XSQUOTE                 ;
 151             .byte   6,"[THEN]"              ;
 152             .word   BRBADCOMP,BRACKETELSE2  ; if bad string comparaison, jump for next comparaison
 153             .word   BRGOODCMP,BRACKETELSE1  ; 2DROP,  count-1, loop back if count <> 0, else DROP
 154             .word   EXIT                    ; then exit
 155 BRACKETELSE2                                ;
 156             .word   TWODUP                  ;
 157             .word   XSQUOTE                 ;
 158             .byte   6,"[ELSE]"              ;
 159             .word   BRBADCOMP,BRACKETELSE3  ; if bad string comparaison, jump for next comparaison
 160             .word   BRGOODCMP,BRACKETELSE0  ; 2DROP, count-1, loop back with count+1 if count <> 0, else DROP
 161             .word   EXIT                    ; then exit
 162 BRACKETELSE3                                ;
 163             .word   XSQUOTE                 ;
 164             .byte   4,"[IF]"                ;
 165             .word   BRBADCOMP,BRACKETELSE1  ; if bad string comparaison, loop back
 166             .word   BRAN,BRACKETELSE0       ; else loop back with count+1
 167 BRACKETELSE5                                ;
 168             .word   TWODROP                 ;
 169 ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
 170 ; OPTION                                    ; +5 words option
 171 ;vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv;
 172             .word   XSQUOTE                 ;
 173             .byte   5,13,10,"ko "           ;
 174             .word   TYPE                    ; CR+LF ." ko "     to show false branch of conditionnal compilation
 175 ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
 176 BRKTELSEND  .word   REFILL                  ; REFILL Input Buffer with next line
 177             .word   SETIB                   ; SET Input Buffer pointers SOURCE_LEN, SOURCE_ORG and clear >IN
 178             .word   BRAN,BRACKETELSE1       ; then loop back   44 words without options
 179
 180             FORTHWORDIMM "[IF]" ; flag --
 181 ; https://forth-standard.org/standard/tools/BracketIF
 182 ; [IF]
 183 ;Compilation:
 184 ;Perform the execution semantics given below.
 185 ;Execution: ;( flag | flag "<spaces>name ..." -- )
 186 ;If flag is true, do nothing. Otherwise, skipping leading spaces,
 187 ;   parse and discard space-delimited words from the parse area,
 188 ;   including nested occurrences of [IF] ... [THEN] and [IF] ... [ELSE] ... [THEN],
 189 ;   until either the word [ELSE] or the word [THEN] has been parsed and discarded.
 190 ;If the parse area becomes exhausted, it is refilled as with REFILL. [IF] is an immediate word.
 191 ;An ambiguous condition exists if [IF] is POSTPONEd,
 192 ;   or if the end of the input buffer is reached and cannot be refilled before the terminating [ELSE] or [THEN] is parsed.
 193 BRACKETIF   CMP #0,TOS      ; -- f
 194             MOV @PSP+,TOS   ; --
 195             JZ BRACKETELSE  ; false flag output
 196             MOV @IP+,PC     ; true flag output
 197
 198     .IFNDEF NIP
 199 ; https://forth-standard.org/standard/core/NIP
 200 ; NIP      x1 x2 -- x2         Drop the first item below the top of stack
 201 NIP         ADD #2,PSP      ; 1
 202             MOV @IP+,PC     ; 4
 203     .ENDIF
 204
 205
 206             FORTHWORDIMM  "[DEFINED]"
 207 ; https://forth-standard.org/standard/tools/BracketDEFINED
 208 ; [DEFINED]
 209 ;Compilation:
 210 ;Perform the execution semantics given below.
 211 ;Execution:
 212 ;( "<spaces>name ..." -- flag )
 213 ;Skip leading space delimiters. Parse name delimited by a space.
 214 ;Return a true flag if name is the name of a word that can be found,
 215 ;otherwise return a false flag. [DEFINED] is an immediate word.
 216 DEFINED     mDOCOL
 217             .word   FBLANK,WORDD,FIND,NIP,EXIT
 218
 219             FORTHWORDIMM  "[UNDEFINED]"
 220 ; https://forth-standard.org/standard/tools/BracketUNDEFINED
 221 ; [UNDEFINED]
 222 ;Compilation:
 223 ;Perform the execution semantics given below.
 224 ;Execution: ( "<spaces>name ..." -- flag )
 225 ;Skip leading space delimiters. Parse name delimited by a space.
 226 ;Return a false flag if name is the name of a word that can be found,
 227 ;otherwise return a true flag.
 228             mDOCOL
 229             .word   DEFINED,ZEROEQUAL,EXIT
 230
 231
 232 ; https://forth-standard.org/standard/core/MARKER
 233 ; MARKER
 234 ;name Execution: ( -- )
 235 ;Restore all dictionary allocation and search order pointers to the state they had just prior to the
 236 ;definition of name. Remove the definition of name and all subsequent definitions. Restoration
 237 ;of any structures still existing that could refer to deleted definitions or deallocated data space is
 238 ;not necessarily provided. No other contextual information such as numeric base is affected.
 239
 240
 241 ; FastForth provides all that is necessary for a real time application next MARKER definition,
 242 ; by adding a call to a custom subroutine, with the default parameters to be restored saved next MARKER definition.
 243 MARKER_DOES                         ; execution part of MARKER, same effect than RST_STATE, but to restore state before MARKER defn.
 244             .word   $+2             ; -- BODY
 245             MOV @TOS+,&RST_DP       ; -- BODY+2         thus RST_STATE will restore the word-set state before MARKER
 246     .IFDEF VOCABULARY_SET
 247             MOV @TOS+,&RST_VOC      ; -- BODY+4         thus RST_STATE will restore the word-set state before MARKER
 248     .ELSE
 249             ADD #2,TOS              ; -- BODY+4
 250     .ENDIF
 251             CALL @TOS+              ; -- BODY+6         @TOS = RET_ADR|STOP_APP_ADR    (default|custom)
 252             MOV @PSP+,TOS           ; --
 253             MOV @RSP+,IP            ;
 254             JMP RST_STATE           ;               then next
 255
 256             FORTHWORD "MARKER"      ; definition part
 257 ;( "<spaces>name" -- )
 258 ;Skip leading space delimiters. Parse name delimited by a space. Create a definition for name
 259 ;with the execution semantics defined below.
 260
 261             CALL #HEADER            ;4 W = DP+4, Y = NFA,
 262             MOV #1285h,-4(W)        ;4 CFA = CALL R5 = rDODOES
 263             MOV #MARKER_DOES,-2(W)  ;4 PFA = MARKER_DOES
 264             SUB #2,Y                ;1 Y = NFA-2 = LFA
 265             MOV Y,0(W)              ;3 BODY   = DP value before this MARKER definition
 266     .IFDEF VOCABULARY_SET
 267             MOV &LASTVOC,2(W)       ;5 BODY+2 = current VOCLINK
 268     .ENDIF
 269             MOV #RET_ADR,4(W)       ;  BODY+4 = RET addr, to do nothing by default
 270             ADD #6,&DDP             ;4
 271             JMP GOOD_CSP            ;