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