ADDON/UTILITY.asm

   1 ; -*- coding: utf-8 -*-
   2 ; http://patorjk.com/software/taag/#p=display&f=Banner&t=Fast Forth
   3
   4 ; Fast Forth For Texas Instrument MSP430FRxxxx FRAM devices
   5 ; Copyright (C) <2015>  <J.M. THOORENS>
   6 ;
   7 ; This program is free software: you can redistribute it and/or modify
   8 ; it under the terms of the GNU General Public License as published by
   9 ; the Free Software Foundation, either version 3 of the License, or
  10 ; (at your option) any later version.
  11 ;
  12 ; This program is distributed in the hope that it will be useful,
  13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ; GNU General Public License for more details.
  16 ;
  17 ; You should have received a copy of the GNU General Public License
  18 ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20
  21     FORTHWORD "{TOOLS}"
  22     MOV @IP+,PC
  23
  24     .IFNDEF TOR
  25 ; https://forth-standard.org/standard/core/toR
  26 ; >R    x --   R: -- x   push to return stack
  27             FORTHWORD ">R"
  28 TOR         PUSH TOS
  29             MOV @PSP+,TOS
  30             MOV @IP+,PC
  31     .ENDIF
  32
  33         .IFNDEF ANDD
  34 ;https://forth-standard.org/standard/core/AND
  35 ;C AND    x1 x2 -- x3           logical AND
  36             FORTHWORD "AND"
  37 ANDD        AND     @PSP+,TOS
  38             MOV @IP+,PC
  39         .ENDIF
  40
  41         .IFNDEF CFETCH
  42 ;https://forth-standard.org/standard/core/CFetch
  43 ;C C@     c-addr -- char   fetch char from memory
  44             FORTHWORD "C@"
  45 CFETCH      MOV.B @TOS,TOS      ;2
  46             MOV @IP+,PC               ;4
  47         .ENDIF
  48
  49         .IFNDEF SPACE
  50 ;https://forth-standard.org/standard/core/SPACE
  51 ;C SPACE   --               output a space
  52             FORTHWORD "SPACE"
  53 SPACE       SUB #2,PSP              ;1
  54             MOV TOS,0(PSP)          ;3
  55             MOV #20h,TOS            ;2
  56             MOV #EMIT,PC            ;17~  23~
  57
  58 ;https://forth-standard.org/standard/core/SPACES
  59 ;C SPACES   n --            output n spaces
  60             FORTHWORD "SPACES"
  61 SPACES      CMP #0,TOS
  62             JZ SPACESNEXT2
  63             PUSH IP
  64             MOV #SPACESNEXT,IP
  65             JMP SPACE               ;25~
  66 SPACESNEXT  .word   $+2
  67             SUB #2,IP               ;1
  68             SUB #1,TOS              ;1
  69             JNZ SPACE               ;25~ ==> 27~ by space ==> 2.963 MBds @ 8 MHz
  70             MOV @RSP+,IP            ;
  71 SPACESNEXT2 MOV @PSP+,TOS           ; --         drop n
  72             MOV @IP+,PC                   ;
  73
  74         .ENDIF
  75
  76     .IFNDEF II
  77 ; https://forth-standard.org/standard/core/I
  78 ; I        -- n   R: sys1 sys2 -- sys1 sys2
  79 ;                  get the innermost loop index
  80             FORTHWORD "I"
  81 II          SUB #2,PSP              ;1 make room in TOS
  82             MOV TOS,0(PSP)          ;3
  83             MOV @RSP,TOS            ;2 index = loopctr - fudge
  84             SUB 2(RSP),TOS          ;3
  85             MOV @IP+,PC             ;4 13~
  86     .ENDIF
  87
  88 ;https://forth-standard.org/standard/tools/DotS
  89             FORTHWORD ".S"      ; --            print <depth> of Param Stack and stack contents if not empty
  90 DOTS        MOV     TOS,-2(PSP) ; -- TOS ( tos x x )
  91             MOV     PSP,TOS
  92             SUB     #2,TOS      ; to take count that TOS is first cell
  93             MOV     TOS,-6(PSP) ; -- TOS ( tos x  PSP )
  94             MOV     #PSTACK,TOS ; -- P0  ( tos x  PSP )
  95             SUB     #2,TOS      ; to take count that TOS is first cell
  96 DOTS1       MOV     TOS,-4(PSP) ; -- S0  ( tos S0 SP )
  97             SUB     #6,PSP      ; -- S0 SP S0
  98             SUB     @PSP,TOS    ; -- S0 SP S0-SP
  99             RRA     TOS         ; -- S0 SP #cells
 100             mDOCOL
 101             .word   lit,'<',EMIT
 102             .word   DOT                 ; display #cells
 103             .word   lit,08h,EMIT        ; backspace
 104             .word   lit,'>',EMIT,SPACE
 105             .word   TWODUP,ONEPLUS,ULESS
 106             .word   QFBRAN,STKDISPL1
 107             .word   DROP,DROP,EXIT
 108 STKDISPL1   .word   xdo
 109 STKDISPL2   .word   II,FETCH,UDOT
 110             .word   lit,2,xploop,STKDISPL2
 111             .word   EXIT
 112
 113
 114             FORTHWORD ".RS"     ; --           print <depth> of Return Stack and stack contents if not empty
 115 DOTRS       MOV     TOS,-2(PSP) ; -- TOS ( tos x x )
 116             MOV     RSP,-6(PSP) ; -- TOS ( tos x  RSP )
 117             MOV     #RSTACK,TOS ; -- R0  ( tos x  RSP )
 118             JMP     DOTS1
 119
 120 ;https://forth-standard.org/standard/tools/q
 121 ;Z  ?       adr --             display the content of adr
 122             FORTHWORD "?"
 123 QUESTION    MOV     @TOS,TOS
 124             MOV     #UDOT,PC
 125
 126     .SWITCH THREADS
 127     .CASE   1
 128
 129 ;https://forth-standard.org/standard/tools/WORDS
 130 ;X WORDS        --      list all words in first vocabulary in CONTEXT. 38 words
 131             FORTHWORD "WORDS"
 132 WORDS       mDOCOL
 133             .word   CR
 134             .word   LIT,CONTEXT,FETCH   ; -- VOC_BODY
 135 WORDS1      .word   FETCH               ; -- NFA
 136             .word   QDUP                ; -- 0 | -- NFA NFA
 137             .word   QFBRAN,WORDS2        ; -- NFA
 138             .word   DUP,DUP,COUNT       ; -- NFA NFA addr count
 139             .word   lit,07Fh,ANDD,TYPE  ; -- NFA NFA
 140             .word   CFETCH,lit,0Fh,ANDD
 141             .word   lit,10h,SWAP,MINUS
 142             .word   SPACES
 143             .word   lit,2,MINUS         ; NFA -- LFA
 144             .word   BRAN,WORDS1
 145 WORDS2      .word   EXIT                ; --
 146
 147
 148     .ELSECASE
 149
 150         .IFNDEF PAD
 151 ;https://forth-standard.org/standard/core/PAD
 152 ; PAD           --  pad address
 153             FORTHWORD "PAD"
 154 PAD         CALL rDOCON
 155             .WORD    PAD_ORG
 156         .ENDIF
 157
 158         .IFNDEF ROT
 159 ;https://forth-standard.org/standard/core/ROT
 160 ;C ROT    x1 x2 x3 -- x2 x3 x1
 161             FORTHWORD "ROT"
 162 ROT         MOV @PSP,W          ; 2 fetch x2
 163             MOV TOS,0(PSP)      ; 3 store x3
 164             MOV 2(PSP),TOS      ; 3 fetch x1
 165             MOV W,2(PSP)        ; 3 store x2
 166             MOV @IP+,PC               ; 4
 167         .ENDIF
 168
 169 ;https://forth-standard.org/standard/tools/WORDS
 170 ;X WORDS        --      list all words in first vocabulary in CONTEXT. 38 words
 171             FORTHWORD "WORDS"
 172 WORDS       mDOCOL
 173             .word   CR
 174             .word   LIT,CONTEXT,FETCH
 175             .word   PAD,LIT,THREADS,DUP,PLUS
 176             .word   MOVE
 177                                             ; BEGIN
 178 WORDS2      .word   LIT,0,DUP
 179             .word   LIT,THREADS,DUP,PLUS    ;   I = ptr = thread*2
 180             .word   LIT,0
 181             .word   xdo                     ;   DO
 182 WORDS3      .word   DUP
 183             .word   II,PAD,PLUS,FETCH       ;   old MAX NFA U< NFA ?
 184             .word   ULESS,QFBRAN,WORDS4      ;   no
 185             .word   DROP,DROP,II            ;   yes, replace old MAX of NFA by new MAX of NFA
 186             .word   DUP,PAD,PLUS,FETCH      ;
 187 WORDS4      .word   LIT,2,xploop,WORDS3     ;   2 +LOOP
 188             .word   QDUP                    ;   MAX of NFA = 0 ?
 189             .word   QFBRAN,WORDS5            ; WHILE
 190             .word   DUP,LIT,2,MINUS,FETCH   ;   replace NFA MAX by its [LFA]
 191             .word   ROT,PAD,PLUS,STORE
 192             .word   DUP,COUNT               ;   display NFA MAX in 10 chars format
 193             .word   lit,07Fh,ANDD,TYPE
 194             .word   CFETCH,lit,0Fh,ANDD
 195             .word   lit,10h,SWAP,MINUS
 196             .word   SPACES
 197             .word   BRAN,WORDS2             ; REPEAT
 198 WORDS5      .word   DROP
 199             .word   EXIT
 200
 201     .ENDCASE
 202
 203
 204     .IFNDEF MAX
 205
 206 ;https://forth-standard.org/standard/core/MAX
 207 ;C MAX    n1 n2 -- n3       signed maximum
 208             FORTHWORD "MAX"
 209 MAX         CMP     @PSP,TOS    ; n2-n1
 210             JL      SELn1       ; n2<n1
 211 SELn2       ADD     #2,PSP
 212             MOV @IP+,PC
 213
 214 ;https://forth-standard.org/standard/core/MIN
 215 ;C MIN    n1 n2 -- n3       signed minimum
 216             FORTHWORD "MIN"
 217 MIN         CMP     @PSP,TOS    ; n2-n1
 218             JL      SELn2       ; n2<n1
 219 SELn1       MOV     @PSP+,TOS
 220             MOV @IP+,PC
 221
 222     .ENDIF
 223
 224     .IFNDEF PLUS
 225 ;https://forth-standard.org/standard/core/Plus
 226 ;C +       n1/u1 n2/u2 -- n3/u3     add n1+n2
 227             FORTHWORD "+"
 228 PLUS        ADD @PSP+,TOS
 229             MOV @IP+,PC
 230     .ENDIF
 231
 232         .IFNDEF OVER
 233 ;https://forth-standard.org/standard/core/OVER
 234 ;C OVER    x1 x2 -- x1 x2 x1
 235             FORTHWORD "OVER"
 236 OVER        MOV TOS,-2(PSP)     ; 3 -- x1 (x2) x2
 237             MOV @PSP,TOS        ; 2 -- x1 (x2) x1
 238             SUB #2,PSP          ; 1 -- x1 x2 x1
 239             MOV @IP+,PC               ; 4
 240         .ENDIF
 241
 242     .IFNDEF UDOTR
 243 ;https://forth-standard.org/standard/core/UDotR
 244 ;X U.R      u n --      display u unsigned in n width
 245             FORTHWORD "U.R"
 246 UDOTR       mDOCOL
 247             .word   TOR,LESSNUM,lit,0,NUM,NUMS,NUMGREATER
 248             .word   RFROM,OVER,MINUS,lit,0,MAX,SPACES,TYPE
 249             .word   EXIT
 250     .ENDIF
 251
 252 ;https://forth-standard.org/standard/tools/DUMP
 253             FORTHWORD "DUMP"
 254 DUMP        PUSH    IP
 255             PUSH    &BASE                   ; save current base
 256             MOV     #10h,&BASE              ; HEX base
 257             ADD     @PSP,TOS                ; -- ORG END
 258             ASMtoFORTH
 259             .word   SWAP                    ; -- END ORG
 260             .word   xdo                     ; --
 261 DUMP1       .word   CR
 262             .word   II,lit,4,UDOTR,SPACE    ; generate address
 263
 264             .word   II,lit,8,PLUS,II,xdo    ; display first 8 bytes
 265 DUMP2       .word   II,CFETCH,lit,3,UDOTR
 266             .word   xloop,DUMP2             ; bytes display loop
 267             .word   SPACE
 268             .word   II,lit,10h,PLUS,II,lit,8,PLUS,xdo    ; display last 8 bytes
 269 DUMP3       .word   II,CFETCH,lit,3,UDOTR
 270             .word   xloop,DUMP3             ; bytes display loop
 271             .word   SPACE,SPACE
 272             .word   II,lit,10h,PLUS,II,xdo  ; display 16 chars
 273 DUMP4       .word   II,CFETCH
 274             .word   lit,7Eh,MIN,FBLANK,MAX,EMIT
 275             .word   xloop,DUMP4             ; chars display loop
 276             .word   lit,10h,xploop,DUMP1    ; line loop
 277             .word   RFROM,lit,BASE,STORE       ; restore current base
 278             .word   EXIT
 279