MSP430-FORTH/UTILITY.f

   1 \ -*- coding: utf-8 -*-
   2
   3 ; ------------------------------------------------------------------------------
   4 ; UTILITY.f
   5 ; ------------------------------------------------------------------------------
   6 \
   7 \ to see kernel options, download FastForthSpecs.f
   8 \ FastForth kernel options: MSP430ASSEMBLER, CONDCOMP
   9 \
  10 \ TARGET SELECTION
  11 \ MSP_EXP430FR5739  MSP_EXP430FR5969    MSP_EXP430FR5994    MSP_EXP430FR6989
  12 \ MSP_EXP430FR4133  MSP_EXP430FR2433    MSP_EXP430FR2355    CHIPSTICK_FR2433
  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, rEXIT,rDOVAR,rDOCON, rDODOES, R3, SR,RSP, PC
  20 \ PUSHM order : R15,R14,R13,R12,R11,R10, R9, R8,  R7  ,  R6  ,  R5  ,   R4   , R3, R2, R1, R0
  21 \
  22 \ example : PUSHM #6,IP pushes IP,S,T,W,X,Y registers to return stack
  23 \
  24 \ POPM  order :  PC,RSP, SR, R3, rDODOES,rDOCON,rDOVAR,rEXIT,  Y,  X,  W,  T,  S, IP,TOS,PSP
  25 \ POPM  order :  R0, R1, R2, R3,   R4   ,  R5  ,  R6  ,  R7 , R8, R9,R10,R11,R12,R13,R14,R15
  26 \
  27 \ example : POPM #6,IP   pop Y,X,W,T,S,IP registers from return stack
  28 \
  29 \
  30 \ FORTH conditionnals:  unary{ 0= 0< 0> }, binary{ = < > U< }
  31 \
  32 \ ASSEMBLER conditionnal usage with IF UNTIL WHILE  S<  S>=  U<   U>=  0=  0<>  0>=
  33 \ ASSEMBLER conditionnal usage with ?JMP ?GOTO      S<  S>=  U<   U>=  0=  0<>  0<
  34
  35
  36 : DEFINED! ECHO 1 ABORT" already loaded!" ;
  37
  38 [DEFINED] {TOOLS} [IF] DEFINED!
  39
  40 [ELSE]
  41
  42 PWR_STATE
  43
  44 MARKER {TOOLS}
  45
  46 [UNDEFINED] ? [IF]    \
  47 \ https://forth-standard.org/standard/tools/q
  48 \ ?         adr --            display the content of adr
  49 CODE ?
  50     MOV @TOS,TOS
  51     MOV #U.,PC  \ goto U.
  52 ENDCODE
  53 [THEN]
  54
  55 [UNDEFINED] .S [IF]    \
  56 \ https://forth-standard.org/standard/tools/DotS
  57 \ .S            --            display <depth> of param Stack and stack contents in hedadecimal if not empty
  58 CODE .S
  59     MOV     TOS,-2(PSP) \ -- TOS ( tos x x )
  60     MOV     PSP,TOS
  61     SUB     #2,TOS      \ to take count that TOS is first cell
  62     MOV     TOS,-6(PSP) \ -- TOS ( tos x  PSP )
  63     MOV     #PSTACK,TOS \ -- P0  ( tos x  PSP )
  64     SUB     #2,TOS      \ to take count that TOS is first cell
  65 BW1 MOV     TOS,-4(PSP) \ -- S0  ( tos S0 SP )
  66     SUB     #6,PSP      \ -- S0 SP S0
  67     SUB     @PSP,TOS    \ -- S0 SP S0-SP
  68     RRA     TOS         \ -- S0 SP #cells
  69 COLON
  70     $3C EMIT            \ char '<'
  71     .                   \ display #cells
  72     $08 EMIT            \ backspace
  73     $3E EMIT SPACE      \ char '>' SPACE
  74     OVER OVER >         \
  75     0= IF
  76         DROP DROP EXIT
  77     THEN                \ display content of stack in hexadecimal
  78     BASE @ >R
  79     $10 BASE !
  80     DO
  81         I @ U.
  82     2 +LOOP
  83     R> BASE !
  84 ;
  85 [THEN]
  86
  87 [UNDEFINED] .RS [IF]    \
  88 \ .RS            --            display <depth> of Return Stack and stack contents if not empty
  89 CODE .RS
  90     MOV     TOS,-2(PSP) \ -- TOS ( tos x x )
  91     MOV     RSP,-6(PSP) \ -- TOS ( tos x  RSP )
  92     MOV     #RSTACK,TOS \ -- R0  ( tos x  RSP )
  93     GOTO    BW1
  94 ENDCODE
  95 [THEN]
  96
  97 [UNDEFINED] AND [IF]
  98
  99 \ https://forth-standard.org/standard/core/AND
 100 \ C AND    x1 x2 -- x3           logical AND
 101 CODE AND
 102 AND @PSP+,TOS
 103 MOV @IP+,PC
 104 ENDCODE
 105
 106 [THEN]
 107
 108 [UNDEFINED] PAD [IF]
 109
 110 \ https://forth-standard.org/standard/core/PAD
 111 \ C PAD    -- addr
 112 PAD_ORG CONSTANT PAD
 113
 114 [THEN]
 115
 116
 117 [UNDEFINED] WORDS [IF]
 118 \ https://forth-standard.org/standard/tools/WORDS
 119 \ list all words of vocabulary first in CONTEXT.
 120 : WORDS                         \ --
 121 CR
 122 CONTEXT @ PAD                   \ -- VOC_BODY PAD                  MOVE all threads of VOC_BODY in PAD
 123 INI_THREAD @ DUP +              \ -- VOC_BODY PAD THREAD*2
 124 MOVE                            \ -- vocabumary entries are copied in PAD
 125 BEGIN                           \ --
 126     0 DUP                       \ -- ptr=0 MAX=0
 127     INI_THREAD @ DUP + 0        \ -- ptr=0 MAX=0 THREADS*2 0
 128         DO                      \ -- ptr MAX            I =  PAD_ptr = thread*2
 129         DUP I PAD + @           \ -- ptr MAX MAX NFAx
 130             U< IF               \ -- ptr MAX            if MAX U< NFAx
 131                 DROP DROP       \ --                    drop ptr and MAX
 132                 I DUP PAD + @   \ -- new_ptr new_MAX
 133             THEN                \
 134         2 +LOOP                 \ -- ptr MAX
 135     ?DUP                        \ -- ptr MAX MAX | -- ptr 0 (all threads in PAD = 0)
 136 WHILE                           \ -- ptr MAX                    replace it by its LFA
 137     DUP                         \ -- ptr MAX MAX
 138     2 - @                       \ -- ptr MAX [LFA]
 139     ROT                         \ -- MAX [LFA] ptr
 140     PAD +                       \ -- MAX [LFA] thread
 141     !                           \ -- MAX                [LFA]=new_NFA updates PAD+ptr
 142     DUP                         \ -- MAX MAX
 143     COUNT $7F AND               \ -- MAX addr count (with suppr. of immediate bit)
 144     TYPE                        \ -- MAX
 145     C@ $0F AND                  \ -- count_of_chars
 146     $10 SWAP - SPACES           \ --                    complete with spaces modulo 16 chars
 147 REPEAT                          \ --
 148 DROP                            \ ptr --
 149 ;                               \ all threads in PAD are filled with 0
 150 [THEN]
 151
 152 [UNDEFINED] MAX [IF]    \ MAX and MIN are defined in {ANS_COMP}
 153     CODE MAX    \    n1 n2 -- n3       signed maximum
 154         CMP @PSP,TOS    \ n2-n1
 155         S< ?GOTO FW1    \ n2<n1
 156     BW1 ADD #2,PSP
 157         MOV @IP+,PC
 158     ENDCODE
 159
 160     CODE MIN    \    n1 n2 -- n3       signed minimum
 161         CMP @PSP,TOS    \ n2-n1
 162         S< ?GOTO BW1    \ n2<n1
 163     FW1 MOV @PSP+,TOS
 164         MOV @IP+,PC
 165     ENDCODE
 166 [THEN]
 167
 168 [UNDEFINED] U.R [IF]
 169 : U.R                       \ u n --           display u unsigned in n width (n >= 2)
 170 >R  <# 0 # #S #>
 171 R> OVER - 0 MAX SPACES TYPE
 172 ;
 173 [THEN]
 174
 175 [UNDEFINED] DUMP [IF]    \
 176 \ https://forth-standard.org/standard/tools/DUMP
 177 CODE DUMP                   \ adr n  --   dump memory
 178 PUSH IP
 179 PUSH &BASE                  \ save current base
 180 MOV #$10,&BASE              \ HEX base
 181 ADD @PSP,TOS                \ -- ORG END
 182 LO2HI
 183   SWAP OVER OVER            \ -- END ORG END ORG
 184   U. U.                     \ -- END ORG        display org end
 185   $FFF0 AND                 \ -- END ORG_modulo_16
 186   DO  CR                    \ generate line
 187     I 4 U.R SPACE           \ generate address
 188       I 8 + I               \ display first 8 bytes
 189       DO I C@ 3 U.R LOOP
 190       SPACE
 191       I $10 + I 8 +         \ display last 8 bytes
 192       DO I C@ 3 U.R LOOP
 193       SPACE SPACE
 194       I $10 + I             \ display 16 chars
 195       DO I C@ $7E MIN BL MAX EMIT LOOP
 196   $10 +LOOP
 197   R> BASE !                 \ restore current base
 198 ;
 199 [THEN]  \ endof [UNDEFINED] DUMP
 200
 201 RST_HERE
 202
 203 [THEN]  \ endof [UNDEFINED] {TOOLS}
 204 ECHO