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