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 ;X .S      --           print <number> of cells and stack contents if not empty
  22             FORTHWORD ".S"
  23 DOTS        mDOCOL
  24             .word   lit,'<',EMIT
  25             .word   DEPTH,DOT
  26             .word   lit,08h,EMIT        ; backspace
  27             .word   lit,'>',EMIT,SPACE
  28             .word   SPFETCH,lit,PSTACK,ULESS
  29             .word   QBRAN,DOTS2
  30             .word   SPFETCH,lit,PSTACK-2,xdo
  31 DOTS1:      .word   II,FETCH,UDOT
  32             .word   lit,-2
  33             .word   xploop,DOTS1
  34 DOTS2:      .word   EXIT
  35
  36 ;Z  ?       adr --             display the content of adr
  37             FORTHWORD "?"
  38             MOV     @TOS,TOS
  39             MOV     #UDOT,PC
  40
  41 ;X WORDS        --      list all words in all dicts. 53 words
  42     .SWITCH THREADS
  43     .CASE   1
  44
  45             FORTHWORD "WORDS"
  46 WORDS       mDOCOL
  47
  48 ; vvvvvvvv   may be skipped    vvvvvvvv
  49             .word   CR                     ; type # of threads in vocabularies
  50             .word   lit,3,SPACES
  51             .word   XSQUOTE
  52             .byte   23,"monothread vocabularies"
  53             .word   TYPE
  54 ; ^^^^^^^^   may be skipped    ^^^^^^^^
  55
  56             .word   LIT,CONTEXT
  57 WORDS1      .word   DUP,CELLPLUS,SWAP
  58             .word   FETCH,QDUP
  59             .word   QBRAN,WORDS5
  60             .word   CR
  61             .word   lit,3,SPACES
  62 WORDS3      .word   FETCH,QDUP
  63             .word   QBRAN,WORDS4
  64             .word   DUP,DUP,COUNT
  65             .word   lit,07Fh,ANDD,TYPE
  66             .word   CFETCH,lit,0Fh,ANDD
  67             .word   lit,10h,SWAP,MINUS
  68             .word   SPACES,lit,2,MINUS
  69             .word   BRAN,WORDS3
  70 WORDS4      .word   CR
  71             .word   BRAN,WORDS1
  72 WORDS5      .word   DROP
  73             .word   EXIT
  74
  75
  76     .ELSECASE
  77
  78             FORTHWORD "WORDS"
  79 WORDS       mDOCOL
  80
  81 ; vvvvvvvv   may be skipped    vvvvvvvv
  82             .word   FBASE,FETCH
  83             .word   LIT,0Ah,FBASE,STORE
  84             .word   CR                     ; type # of threads in vocabularies
  85             .word   lit,3,SPACES
  86             .word   LIT,THREADS,DOT
  87             .word   XSQUOTE
  88             .byte   20,"threads vocabularies"
  89             .word   TYPE
  90             .word   FBASE,STORE
  91 ; ^^^^^^^^   may be skipped    ^^^^^^^^
  92
  93             .word   LIT,CONTEXT
  94                                             ; BEGIN
  95 WORDS1      .word   DUP,CELLPLUS,SWAP
  96             .word   FETCH,QDUP
  97             .word   QBRAN,WORDS6            ;
  98             .word   CR
  99             .word   lit,3,SPACES
 100
 101             .word   DUP,LIT,PAD             ;
 102             .word   LIT,THREADS,DUP,PLUS
 103             .word   MOVE
 104                                             ; BEGIN
 105 WORDS2      .word   LIT,0,DUP
 106             .word   LIT,THREADS,DUP,PLUS    ; I = ptr = thread*2
 107             .word   LIT,0
 108             .word   xdo                     ; DO
 109 WORDS3      .word   DUP
 110             .word   II,LIT,PAD,PLUS,FETCH   ; old MAX NFA U< NFA ?
 111             .word   ULESS,QBRAN,WORDS4      ; no
 112             .word   DROP,DROP,II            ; yes, replace old MAX of NFA by new MAX of NFA
 113             .word   DUP,LIT,PAD,PLUS,FETCH  ;
 114 WORDS4      .word   LIT,2,xploop,WORDS3     ; 2 +LOOP
 115             .word   QDUP                    ; MAX of NFA = 0 ?
 116             .word   QBRAN,WORDS5            ; WHILE
 117             .word   DUP,LIT,2,MINUS,FETCH   ; replace NFA MAX by its [LFA]
 118             .word   ROT,LIT,PAD,PLUS,STORE
 119             .word   DUP,COUNT               ; display NFA MAX in 10 chars format
 120             .word   lit,07Fh,ANDD,TYPE
 121             .word   CFETCH,lit,0Fh,ANDD
 122             .word   lit,10h,SWAP,MINUS
 123             .word   SPACES
 124             .word   BRAN,WORDS2             ; REPEAT
 125 WORDS5      .word   DROP,DROP
 126             .word   CR
 127             .word   BRAN,WORDS1             ; REPEAT
 128 WORDS6      .word   DROP
 129             .word   EXIT
 130
 131     .ENDCASE
 132
 133
 134     .IFNDEF ANS_CORE_COMPLIANT
 135
 136 ;C MAX    n1 n2 -- n3       signed maximum
 137             FORTHWORD "MAX"
 138 MAX:        CMP     @PSP,TOS    ; n2-n1
 139             JL      SELn1       ; n2<n1
 140 SELn2:      ADD     #2,PSP
 141             mNEXT
 142
 143 ;C MIN    n1 n2 -- n3       signed minimum
 144             FORTHWORD "MIN"
 145 MIN:        CMP     @PSP,TOS    ; n2-n1
 146             JL      SELn2       ; n2<n1
 147 SELn1:      MOV     @PSP+,TOS
 148             mNEXT
 149
 150     .ENDIF
 151
 152 ;X U.R      u n --      display u unsigned in n width
 153             FORTHWORD "U.R"
 154 UDOTR       mDOCOL
 155             .word   TOR,LESSNUM,lit,0,NUM,NUMS,NUMGREATER
 156             .word   RFROM,OVER,MINUS,lit,0,MAX,SPACES,TYPE
 157             .word   EXIT
 158
 159             FORTHWORD "DUMP"
 160 DUMP        PUSH    IP
 161             PUSH    &BASE
 162             MOV     #10h,&BASE
 163             ADD     @PSP,TOS                ; compute end address
 164             AND     #0FFF0h,0(PSP)          ; compute start address
 165             ASMtoFORTH
 166             .word   SWAP,xdo                ; generate line
 167 DUMP1       .word   CR
 168             .word   II,lit,7,UDOTR,SPACE    ; generate address
 169             .word   II,lit,10h,PLUS,II,xdo  ; display 16 bytes
 170 DUMP2       .word   II,CFETCH,lit,3,UDOTR
 171             .word   xloop,DUMP2
 172             .word   SPACE,SPACE
 173             .word   II,lit,10h,PLUS,II,xdo  ; display 16 chars
 174 DUMP3       .word   II,CFETCH
 175             .word   lit,7Eh,MIN,FBLANK,MAX,EMIT
 176             .word   xloop,DUMP3
 177             .word   lit,10h,xploop,DUMP1
 178             .word   RFROM,FBASE,STORE
 179             .word   EXIT
 180