MSP430_FORTH/UTILITY.f

   1 \ ------------------------------------------------------------------------------
   2 \ UTILITY.f
   3 \ ------------------------------------------------------------------------------
   4
   5 \ TARGET SELECTION
   6 \ MSP_EXP430FR5739  MSP_EXP430FR5969    MSP_EXP430FR5994    MSP_EXP430FR6989
   7 \ MSP_EXP430FR4133  CHIPSTICK_FR2433
   8
   9 \ MY_MSP430FR5738_1 MY_MSP430FR5738     MY_MSP430FR5948     MY_MSP430FR5948_1
  10 \ JMJ_BOX
  11
  12 \ must be preprocessed with yourtarget.pat file because PSTACK,CONTEXT,INI_THREAD
  13
  14 \ REGISTERS USAGE
  15 \ R4 to R7 must be saved before use and restored after
  16 \ scratch registers Y to S are free for use
  17 \ under interrupt, IP is free for use
  18
  19 \ PUSHM order : PSP,TOS, IP,  S,  T,  W,  X,  Y, R7, R6, R5, R4
  20 \ example : PUSHM IP,Y
  21 \
  22 \ POPM  order :  R4, R5, R6, R7,  Y,  X,  W,  T,  S, IP,TOS,PSP
  23 \ example : POPM Y,IP
  24
  25 \ FORTH conditionnals:  unary{ 0= 0< 0> }, binary{ = < > U< }
  26
  27 \ ASSEMBLER conditionnal usage with IF UNTIL WHILE  S<  S>=  U<   U>=  0=  0<>  0>=
  28
  29 \ ASSEMBLER conditionnal usage with ?JMP ?GOTO      S<  S>=  U<   U>=  0=  0<>  <0
  30
  31 PWR_STATE
  32     \
  33 [DEFINED] {UTILITY} [IF] {UTILITY} [THEN]     \ remove {UTILITY} if outside core
  34     \
  35 [DEFINED] ASM [UNDEFINED] {UTILITY} AND [IF]  \ required test and don't replicate {UTILITY} if inside core
  36     \
  37 MARKER {UTILITY}
  38     \
  39 [UNDEFINED] ? [IF]    \
  40 \ https://forth-standard.org/standard/tools/q
  41 \ ?         adr --            display the content of adr
  42 CODE ?
  43     MOV @TOS,TOS
  44     MOV #U.,PC  \ goto U.
  45 ENDCODE
  46 [THEN]
  47     \
  48
  49 [UNDEFINED] .S [IF]    \
  50 \ https://forth-standard.org/standard/tools/DotS
  51 \ .S            --            display <depth> of param Stack and stack contents if not empty
  52 CODE .S
  53     MOV     TOS,-2(PSP) \ -- TOS ( tos x x )
  54     MOV     PSP,TOS
  55     SUB     #2,TOS      \ to take count that TOS is first cell
  56     MOV     TOS,-6(PSP) \ -- TOS ( tos x  PSP )
  57     MOV     #PSTACK,TOS \ -- P0  ( tos x  PSP )
  58     SUB     #2,TOS      \ to take count that TOS is first cell
  59 BW1 MOV     TOS,-4(PSP) \ -- S0  ( tos S0 SP )
  60     SUB     #6,PSP      \ -- S0 SP S0
  61     SUB     @PSP,TOS    \ -- S0 SP S0-SP
  62     RRA     TOS         \ -- S0 SP #cells
  63 COLON
  64     $3C EMIT            \ char '<'
  65     .                   \ display #cells
  66     $08 EMIT            \ backspace
  67     $3E EMIT SPACE      \ char '>' SPACE
  68     OVER OVER >         \
  69     0= IF
  70         DROP DROP EXIT
  71     THEN
  72     DO
  73         I @ U.
  74     2 +LOOP
  75 ;
  76 [THEN]
  77     \
  78
  79 [UNDEFINED] .RS [IF]    \
  80 \ .S            --            display <depth> of Return Stack and stack contents if not empty
  81 CODE .RS
  82     MOV     TOS,-2(PSP) \ -- TOS ( tos x x )
  83     MOV     RSP,-6(PSP) \ -- TOS ( tos x  RSP )
  84     MOV     #RSTACK,TOS \ -- R0  ( tos x  RSP )
  85     GOTO    BW1
  86 ENDCODE
  87 [THEN]
  88     \
  89
  90 [UNDEFINED] WORDS [IF]
  91     \
  92 \ https://forth-standard.org/standard/tools/WORDS
  93 \ list all words of vocabulary first in CONTEXT.
  94 : WORDS                             \ --
  95
  96 \ \ vvvvvvvv   may be skipped    vvvvvvvv
  97 \ BASE @                              \ -- BASE
  98 \ #10 BASE !
  99 \ CR ."    "
 100 \ INI_THREAD @ DUP
 101 \ 1 = IF DROP ." monothread"
 102 \     ELSE . ." threads"
 103 \     THEN ."  vocabularies"
 104 \ BASE !                              \ --
 105 \ \ ^^^^^^^^   may be skipped    ^^^^^^^^
 106
 107 CR ."    "                          \
 108 CONTEXT @                           \ -- VOC_BODY                   MOVE all threads of VOC_BODY in PAD
 109     PAD INI_THREAD @ DUP +          \ -- VOC_BODY PAD THREAD*2
 110     MOVE                            \
 111     BEGIN                           \ --
 112 \        0 DUP                       \ -- ptr=0 MAX=0                select the MAX of NFAs in all vocabulary threads
 113         0.                          \ -- ptr=0 MAX=0
 114         INI_THREAD @ DUP + 0        \ -- ptr=0 MAX=0 THREADS*2 0
 115             DO                      \ -- ptr MAX            I =  PAD_ptr = thread*2
 116             DUP I PAD + @           \ -- ptr MAX MAX NFAx
 117                 U< IF               \ -- ptr MAX            if MAX U< NFAx
 118                     DROP DROP       \ --                    drop ptr and MAX
 119                     I DUP PAD + @   \ -- new_ptr new_MAX
 120                 THEN                \
 121             2 +LOOP                 \ -- ptr MAX
 122         ?DUP                        \ -- ptr MAX MAX | -- ptr 0
 123     WHILE                           \ -- ptr MAX                    replace it by its LFA
 124         DUP                         \ -- ptr MAX MAX
 125         2 - @                       \ -- ptr MAX [LFA]
 126         ROT                         \ -- MAX [LFA] ptr
 127         PAD +                       \ -- MAX [LFA] thread
 128         !                           \ -- MAX                [LFA]=new_NFA --> PAD+ptr   type it in 16 chars format
 129         DUP                         \ -- MAX MAX
 130         COUNT $7F AND               \ -- MAX addr count (with suppr. of immediate bit)
 131         TYPE                        \ -- MAX
 132         C@ $0F AND                  \ -- count_of_chars
 133         $10 SWAP - SPACES           \ --                    complete with spaces to 16 chars
 134     REPEAT                          \ -- ptr
 135     DROP                            \ --
 136 ;
 137 [THEN]
 138     \
 139
 140 [UNDEFINED] MAX [IF]    \ MAX and MIN are defined in {ANS_COMP}
 141     CODE MAX    \    n1 n2 -- n3       signed maximum
 142         CMP @PSP,TOS    \ n2-n1
 143         S< ?GOTO FW1    \ n2<n1
 144     BW1 ADD #2,PSP
 145         MOV @IP+,PC
 146     ENDCODE
 147     \
 148
 149     CODE MIN    \    n1 n2 -- n3       signed minimum
 150         CMP @PSP,TOS    \ n2-n1
 151         S< ?GOTO BW1    \ n2<n1
 152     FW1 MOV @PSP+,TOS
 153         MOV @IP+,PC
 154     ENDCODE
 155 [THEN]
 156     \
 157
 158 [UNDEFINED] U.R [IF]
 159 : U.R                       \ u n --           display u unsigned in n width (n >= 2)
 160 >R  <# 0 # #S #>
 161 R> OVER - 0 MAX SPACES TYPE
 162 ;
 163 [THEN]
 164     \
 165
 166 [UNDEFINED] DUMP [IF]    \
 167 \ https://forth-standard.org/standard/tools/DUMP
 168 CODE DUMP                   \ adr n  --   dump memory
 169 PUSH IP
 170 PUSH &BASE                  \ save current base
 171 MOV #$10,&BASE              \ HEX base
 172 ADD @PSP,TOS                \ -- ORG END
 173 LO2HI
 174   SWAP OVER OVER            \ -- END ORG END ORG
 175   U. U.                     \ -- END ORG        display org end
 176   $FFF0 AND                 \ -- END ORG_modulo_16
 177   DO  CR                    \ generate line
 178     I 7 U.R SPACE           \ generate address
 179       I $10 + I             \ display 16 bytes
 180       DO I C@ 3 U.R LOOP
 181       SPACE SPACE
 182       I $10 + I             \ display 16 chars
 183       DO I C@ $7E MIN BL MAX EMIT LOOP
 184   $10 +LOOP
 185   R> BASE !                 \ restore current base
 186 ;
 187 [THEN]
 188     \
 189
 190 [THEN]
 191     \
 192 ECHO
 193 PWR_HERE