forthMSP430FR_CONDCOMP.asm

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