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   QZBRAN,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   QBRAN,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,3,SPACES
 107             .word   LIT,CONTEXT,FETCH
 108             .word   PAD,LIT,THREADS,DUP,PLUS
 109             .word   MOVE
 110                                             ; BEGIN
 111 WORDS2      .word   LIT,0,DUP
 112             .word   LIT,THREADS,DUP,PLUS    ;   I = ptr = thread*2
 113             .word   LIT,0
 114             .word   xdo                     ;   DO
 115 WORDS3      .word   DUP
 116             .word   II,PAD,PLUS,FETCH       ;   old MAX NFA U< NFA ?
 117             .word   ULESS,QBRAN,WORDS4      ;   no
 118             .word   DROP,DROP,II            ;   yes, replace old MAX of NFA by new MAX of NFA
 119             .word   DUP,PAD,PLUS,FETCH      ;
 120 WORDS4      .word   LIT,2,xploop,WORDS3     ;   2 +LOOP
 121             .word   QDUP                    ;   MAX of NFA = 0 ?
 122             .word   QBRAN,WORDS5            ; WHILE
 123             .word   DUP,LIT,2,MINUS,FETCH   ;   replace NFA MAX by its [LFA]
 124             .word   ROT,PAD,PLUS,STORE
 125             .word   DUP,COUNT               ;   display NFA MAX in 10 chars format
 126             .word   lit,07Fh,ANDD,TYPE
 127             .word   CFETCH,lit,0Fh,ANDD
 128             .word   lit,10h,SWAP,MINUS
 129             .word   SPACES
 130             .word   BRAN,WORDS2             ; REPEAT
 131 WORDS5      .word   DROP
 132             .word   EXIT
 133
 134     .ENDCASE
 135
 136
 137     .IFNDEF ANS_CORE_COMPLIANT
 138
 139 ;https://forth-standard.org/standard/core/MAX
 140 ;C MAX    n1 n2 -- n3       signed maximum
 141             FORTHWORD "MAX"
 142 MAX:        CMP     @PSP,TOS    ; n2-n1
 143             JL      SELn1       ; n2<n1
 144 SELn2:      ADD     #2,PSP
 145             mNEXT
 146
 147 ;https://forth-standard.org/standard/core/MIN
 148 ;C MIN    n1 n2 -- n3       signed minimum
 149             FORTHWORD "MIN"
 150 MIN:        CMP     @PSP,TOS    ; n2-n1
 151             JL      SELn2       ; n2<n1
 152 SELn1:      MOV     @PSP+,TOS
 153             mNEXT
 154
 155     .ENDIF
 156
 157 ;https://forth-standard.org/standard/core/UDotR
 158 ;X U.R      u n --      display u unsigned in n width
 159             FORTHWORD "U.R"
 160 UDOTR       mDOCOL
 161             .word   TOR,LESSNUM,lit,0,NUM,NUMS,NUMGREATER
 162             .word   RFROM,OVER,MINUS,lit,0,MAX,SPACES,TYPE
 163             .word   EXIT
 164
 165
 166 ;https://forth-standard.org/standard/tools/DUMP
 167             FORTHWORD "DUMP"
 168 DUMP        PUSH    IP
 169             PUSH    &BASE                   ; save current base
 170             MOV     #10h,&BASE              ; HEX base
 171             ADD     @PSP,TOS                ; -- ORG END
 172             ASMtoFORTH
 173             .word   SWAP,OVER,OVER          ; -- END ORG END ORG
 174             .word   UDOT,LIT,1,MINUS,UDOT   ; -- END ORG          display org end-1
 175             .word   LIT,0FFFEh,ANDD,xdo     ; -- END ORG_modulo_2
 176 DUMP1       .word   CR
 177             .word   II,lit,7,UDOTR,SPACE    ; generate address
 178             .word   II,lit,10h,PLUS,II,xdo  ; display 16 bytes
 179 DUMP2       .word   II,CFETCH,lit,3,UDOTR
 180             .word   xloop,DUMP2             ; bytes display loop
 181             .word   SPACE,SPACE
 182             .word   II,lit,10h,PLUS,II,xdo  ; display 16 chars
 183 DUMP3       .word   II,CFETCH
 184             .word   lit,7Eh,MIN,FBLANK,MAX,EMIT
 185             .word   xloop,DUMP3             ; chars display loop
 186             .word   lit,10h,xploop,DUMP1    ; line loop
 187             .word   RFROM,FBASE,STORE       ; restore current base
 188             .word   EXIT
 189