MSP430-FORTH/CHNGBAUD_pretty.f

   1 \ -*- coding: utf-8 -*-
   2
   3 ; ------------
   4 ; CHNGBAUD.f
   5 ; ------------
   6
   7 \ FastForth kernel options: ASSEMBLER, COND_COMP
   8 \ to see kernel options, download FF_SPECS.f
   9 \
  10 \ TARGET SELECTION : copy your target in (shift+F8) parameter 1:
  11 \ MSP_EXP430FR5739  MSP_EXP430FR5969    MSP_EXP430FR5994    MSP_EXP430FR6989
  12 \ MSP_EXP430FR4133  MSP_EXP430FR2433    MSP_EXP430FR2355    CHIPSTICK_FR2433
  13 \ LP_MSP430FR2476
  14 \
  15 PWR_STATE
  16
  17 [UNDEFINED] EXIT [IF]
  18 \ https://forth-standard.org/standard/core/EXIT
  19 \ EXIT     --      exit a colon definition
  20 CODE EXIT
  21 MOV @RSP+,IP    \ 2 pop previous IP (or next PC) from return stack
  22 MOV @IP+,PC     \ 4 = NEXT
  23 ENDCODE
  24 [THEN]
  25
  26 [UNDEFINED] EXECUTE [IF] \ "
  27 \ https://forth-standard.org/standard/core/EXECUTE
  28 \ EXECUTE   i*x xt -- j*x   execute Forth word at 'xt'
  29 CODE EXECUTE
  30 MOV TOS,W               \ 1 put word address into W
  31 MOV @PSP+,TOS           \ 2 fetch new TOS
  32 MOV W,PC                \ 3 fetch code address into PC
  33 ENDCODE
  34 [THEN]
  35
  36 [UNDEFINED] SWAP [IF]
  37 \ https://forth-standard.org/standard/core/SWAP
  38 \ SWAP     x1 x2 -- x2 x1    swap top two items
  39 CODE SWAP
  40 MOV @PSP,W      \ 2
  41 MOV TOS,0(PSP)  \ 3
  42 MOV W,TOS       \ 1
  43 MOV @IP+,PC     \ 4
  44 ENDCODE
  45 [THEN]
  46
  47 [UNDEFINED] DROP [IF]
  48 \ https://forth-standard.org/standard/core/DROP
  49 \ DROP     x --          drop top of stack
  50 CODE DROP
  51 MOV @PSP+,TOS   \ 2
  52 MOV @IP+,PC     \ 4
  53 ENDCODE
  54 [THEN]
  55
  56 [UNDEFINED] @ [IF]
  57 \ https://forth-standard.org/standard/core/Fetch
  58 \ @     c-addr -- char   fetch char from memory
  59 CODE @
  60 MOV @TOS,TOS
  61 MOV @IP+,PC
  62 ENDCODE
  63 [THEN]
  64
  65 [UNDEFINED] ! [IF]
  66 \ https://forth-standard.org/standard/core/Store
  67 \ !        x a-addr --   store cell in memory
  68 CODE !
  69 MOV @PSP+,0(TOS)    \ 4
  70 MOV @PSP+,TOS       \ 2
  71 MOV @IP+,PC         \ 4
  72 ENDCODE
  73 [THEN]
  74
  75 [UNDEFINED] + [IF]
  76 \ https://forth-standard.org/standard/core/Plus
  77 \ +       n1/u1 n2/u2 -- n3/u3
  78 CODE +
  79 ADD @PSP+,TOS
  80 MOV @IP+,PC
  81 ENDCODE
  82 [THEN]
  83
  84 [UNDEFINED] IF [IF]
  85 \ https://forth-standard.org/standard/core/IF
  86 \ IF       -- IFadr    initialize conditional forward branch
  87 CODE IF       \ immediate
  88 SUB #2,PSP              \
  89 MOV TOS,0(PSP)          \
  90 MOV &DP,TOS             \ -- HERE
  91 ADD #4,&DP            \           compile one word, reserve one word
  92 MOV #QFBRAN,0(TOS)      \ -- HERE   compile QFBRAN
  93 ADD #2,TOS              \ -- HERE+2=IFadr
  94 MOV @IP+,PC
  95 ENDCODE IMMEDIATE
  96 [THEN]
  97
  98 [UNDEFINED] DO [IF]
  99 \ https://forth-standard.org/standard/core/DO
 100 \ DO       -- DOadr   L: -- 0
 101 CODE DO                 \ immediate
 102 SUB #2,PSP              \
 103 MOV TOS,0(PSP)          \
 104 ADD #2,&DP              \   make room to compile xdo
 105 MOV &DP,TOS             \ -- HERE+2
 106 MOV #XDO,-2(TOS)        \   compile xdo
 107 ADD #2,&LEAVEPTR        \ -- HERE+2     LEAVEPTR+2
 108 MOV &LEAVEPTR,W         \
 109 MOV #0,0(W)             \ -- HERE+2     L-- 0
 110 MOV @IP+,PC
 111 ENDCODE IMMEDIATE
 112 [THEN]
 113
 114 [UNDEFINED] LOOP [IF]
 115 \ https://forth-standard.org/standard/core/LOOP
 116 \ LOOP    DOadr --         L-- an an-1 .. a1 0
 117 CODE LOOP               \ immediate
 118     ADD #4,&DP          \ make room to compile two words
 119     MOV &DP,W
 120     MOV #XLOOP,-4(W)    \ xloop --> HERE
 121     MOV TOS,-2(W)       \ DOadr --> HERE+2
 122 BEGIN                   \ resolve all "leave" adr
 123     MOV &LEAVEPTR,TOS   \ -- Adr of top LeaveStack cell
 124     SUB #2,&LEAVEPTR    \ --
 125     MOV @TOS,TOS        \ -- first LeaveStack value
 126     CMP #0,TOS          \ -- = value left by DO ?
 127 0<> WHILE
 128     MOV W,0(TOS)        \ move adr after loop as UNLOOP adr
 129 REPEAT
 130     MOV @PSP+,TOS
 131     MOV @IP+,PC
 132 ENDCODE IMMEDIATE
 133 [THEN]
 134
 135 [UNDEFINED] ESC" [IF]
 136 \ ESC" <escape sequence>" --    type an escape sequence
 137 : ESC" $1B POSTPONE LITERAL POSTPONE EMIT POSTPONE S" POSTPONE TYPE ; IMMEDIATE \ "
 138 [THEN]
 139
 140 \ : OVER= OVER = ;      \ replace 'n1 DUP n2 =' by 'n1 n2 OVER='
 141 CODE OVER=      \ n1 n2 -- n1 flag
 142 SUB @PSP,TOS    \ 2
 143 0<> IF          \ 2
 144     AND #0,TOS  \ 1
 145 ELSE            \ 2
 146     XOR #-1,TOS \ 1 flag Z = 1
 147 THEN
 148 MOV @IP+,PC     \ 4
 149 ENDCODE
 150
 151 \ : OVRSWP<         \ n1 n2 -- n1 flag      flag = -1 if n1 < n2
 152 \   OVER SWAP < ;
 153 CODE OVRSWP<        \ n1 n2 -- n1 flag      flag = -1 if n1 < n2
 154 SUB @PSP,TOS        \ -- n1 n  TOS=n2-n1
 155 S>= IF              \               if n2-n1 >= 0
 156     0<> IF          \               if n2-n1 <> 0
 157         MOV #-1,TOS \ -- n1 -1      flag Z = 0
 158     THEN
 159     MOV @IP+,PC
 160 THEN
 161 AND #0,TOS          \ -- n1 0       flag Z = 1
 162 MOV @IP+,PC
 163 ENDCODE
 164
 165 \ ;THEN                 \ EXIT condition ended by THEN
 166 \   POSTPONE EXIT POSTPONE THEN
 167 \ ; IMMEDIATE
 168 CODE ;THEN              \ IFadr --
 169 ADD #2,&DP              \
 170 MOV &DP,X
 171 MOV #EXIT,-2(X)         \               compile EXIT
 172 MOV X,0(TOS)            \ -- IFadr      compile current DP at IFadr
 173 MOV @PSP+,TOS           \ --
 174 MOV @IP+,PC
 175 ENDCODE IMMEDIATE
 176 [THEN]
 177
 178 \ UM/   udlo|udhi u1 -- q   unsigned 32/16->q16
 179 CODE UM/
 180 CALL #MUSMOD    \ -- r Qlo Qhi
 181 MOV @PSP,TOS    \ -- r Qlo Qlo
 182 ADD #4,PSP      \ -- Qlo
 183 MOV @IP+,PC
 184 ENDCODE
 185
 186 : BAD_MHz           \ abort
 187 $20 EMIT 1 ABORT" only for 1,4,8,16,24 MHz MCLK!"
 188 ;
 189
 190 : OVR_BAUDS         \ abort
 191 $20 EMIT ESC" [7m"  \ set reverse video
 192 FREQ_KHZ @ 0 1000 UM/ ." with MCLK = " .
 193 1 ABORT" MHz? don't dream!"
 194 ;
 195
 196 \ conditionnal EXIT structure
 197 : SELECT_BAUDS      \ -- char frequency TERM_BRW TERM_MCTLW
 198 KEY                 \ -- char
 199
 200 48 OVER=                \ -- char flag     choice 0 = 6MBds ?
 201 IF  ." 6 MBds"
 202     FREQ_KHZ @          \ -- char flag freq
 203     #24000 OVRSWP<      \ MCLK < 24MHz ?
 204     IF OVR_BAUDS ;THEN  \   ==> abort   ( ;THEN does nothing but solve paired IF during compilation)
 205     #24000 OVER=        \ FREQ = 24 MHz ?
 206     IF $4  $0    ;THEN  \ --  char frequency TERM_BRW TERM_MCTLW
 207     BAD_MHz             \   ==> abort for other freq
 208 ;THEN               \ ;THEN does nothing but solve paired IF during compilation
 209
 210 49 OVER=            \ -- char flag     choice 1 = 5MBds ?
 211 IF  ." 5 MBds"
 212     FREQ_KHZ @
 213     #16000 OVRSWP<  \ MCLK < 16MHz ?    ==> abort
 214     IF OVR_BAUDS ;THEN
 215     #16000 OVER=
 216     IF $3  $2100 ;THEN
 217     #24000 OVER=
 218     IF $4  $EE00 ;THEN
 219     BAD_MHz         \ other freq    ==> abort
 220 ;THEN
 221 50 OVER=            \ -- char flag     choice 2 = 4MBds ?
 222 IF  ." 4 MBds"
 223     FREQ_KHZ @
 224     #16000 OVRSWP<  \ MCLK < 16MHz ?    ==> abort
 225     IF OVR_BAUDS ;THEN
 226     #16000 OVER=
 227     IF $4  $0    ;THEN
 228     #24000 OVER=
 229     IF $6  $0    ;THEN
 230     BAD_MHz         \ other freq    ==> abort
 231 ;THEN
 232 51 OVER=            \ -- char flag     choice 3 = 2457600 ?
 233 IF  ." 2457600 Bds"
 234     FREQ_KHZ @
 235     #8000 OVRSWP<   \ MCLK < 8MHz ?    ==> abort
 236     IF OVR_BAUDS ;THEN
 237     #8000 OVER=
 238     IF $3  $4400 ;THEN
 239     #16000 OVER=
 240     IF $6  $AA00 ;THEN
 241     #24000 OVER=
 242     IF $9  $DD00 ;THEN
 243     BAD_MHz
 244 ;THEN
 245 52 OVER=            \ -- char flag     choice 4 = 921600 ?
 246 IF  ." 921600 Bds"
 247     FREQ_KHZ @
 248     #4000 OVRSWP<   \ MCLK < 4MHz ?    ==> abort
 249     IF OVR_BAUDS ;THEN
 250     #4000 OVER=
 251     IF $4  $4900 ;THEN
 252     #8000 OVER=
 253     IF $8  $D600 ;THEN
 254     #16000 OVER=
 255     IF $11 $4A00 ;THEN
 256     #24000 OVER=
 257     IF $1  $00A1 ;THEN
 258     BAD_MHz
 259 ;THEN
 260 53 OVER=            \ -- char flag     choice 5 = 460800 ?
 261 IF  ." 460800 Bds"
 262     FREQ_KHZ @
 263     #4000 OVRSWP<   \ MCLK < 4MHz ?    ==> abort
 264     IF OVR_BAUDS ;THEN
 265     #4000 OVER=
 266     IF $8  $D600 ;THEN
 267     #8000 OVER=
 268     IF $11 $4A00 ;THEN
 269     #16000 OVER=
 270     IF $2  $BB21 ;THEN
 271     #24000 OVER=
 272     IF $6  $0001 ;THEN
 273     BAD_MHz
 274 ;THEN
 275 54 OVER=            \ -- char flag     choice 6 = 230400 ?
 276 IF  ." 230400 Bds"
 277     FREQ_KHZ @
 278     #1000 OVRSWP<   \ MCLK < 1MHz ?    ==> abort
 279     IF OVR_BAUDS ;THEN
 280     #1000 OVER=
 281     IF $4  $4900 ;THEN
 282     #4000 OVER=
 283     IF $11 $4A00 ;THEN
 284     #8000 OVER=
 285     IF $2  $BB21 ;THEN
 286     #16000 OVER=
 287     IF $4  $5551 ;THEN
 288     #24000 OVER=
 289     IF $3  $0241 ;THEN
 290     BAD_MHz
 291 ;THEN
 292 55 OVER=            \ -- char flag     choice 7 = 115200 ?
 293 IF  ." 115200 Bds"
 294     FREQ_KHZ @
 295     #1000 OVER=
 296     IF $8  $D600 ;THEN
 297     #4000 OVER=
 298     IF $2  $BB21 ;THEN
 299     #8000 OVER=
 300     IF $4  $5551 ;THEN
 301     #16000 OVER=
 302     IF $8  $F7A1 ;THEN
 303     #24000 OVER=
 304     IF $0D $4901 ;THEN
 305     BAD_MHz
 306 ;THEN
 307 56 OVER=            \ -- char flag     choice 8 = 38400 Bds?
 308 IF  ." 38400 Bds"
 309     FREQ_KHZ @
 310     #1000 OVER=
 311     IF $1  $00A1 ;THEN
 312     #4000 OVER=
 313     IF $6  $2081 ;THEN
 314     #8000 OVER=
 315     IF $0D $4901 ;THEN
 316     #16000 OVER=
 317     IF $1A $D601 ;THEN
 318     #24000 OVER=
 319     IF $27 $0011 ;THEN
 320     BAD_MHz
 321 ;THEN
 322 57 OVER=            \ -- char flag     choice 9 = 19200 Bds?
 323 IF  ." 19200 Bds"
 324     FREQ_KHZ @
 325     #1000 OVER=
 326     IF $3  $0241 ;THEN
 327     #4000 OVER=
 328     IF $0D $4901 ;THEN
 329     #8000 OVER=
 330     IF $1A $D601 ;THEN
 331     #16000 OVER=
 332     IF $34 $4911 ;THEN
 333     #24000 OVER=
 334     IF $4E $0021 ;THEN
 335     BAD_MHz
 336 ;THEN
 337 65 OVER=            \ -- char flag     choice A = 9600 Bds?
 338 IF  ." 9600 Bds"
 339     FREQ_KHZ @
 340     #1000 OVER=
 341     IF $6  $2081 ;THEN
 342     #4000 OVER=
 343     IF $1A $D601 ;THEN
 344     #8000 OVER=
 345     IF $34 $4911 ;THEN
 346     #16000 OVER=
 347     IF $68 $D621 ;THEN
 348     #24000 OVER=
 349     IF $9C $0041 ;THEN
 350     BAD_MHz
 351 ;THEN               \ -- char           other key
 352     ." abort" CR ABORT
 353 ;
 354
 355 \ CREATE ABUF 10 ALLOT
 356 \
 357 \ : TERM_LINES    \ --
 358 \ ESC" [18t"      \           TERMINAL reports '[8;y;xt' with y lines, x columns
 359 \ ABUF 10         \ -- adr len
 360 \ ACCEPT          \ -- len'
 361 \ drop            \ --
 362 \ ABUF 3 + 2           \ -- ABUF+3, len=2
 363 \ EVALUATE        \ --
 364 \ ;
 365
 366 \ TERM_LINES ABUF !
 367
 368 : CHNGBAUD              \ only for 1, 4, 8, 16, 24 MHz
 369 PWR_STATE               \ to remove this created word (garbage collector)
 370 ECHO
 371 42 0 DO CR LOOP         \ don't erase any line of source, create 42 empty lines
 372 \ TERM_LINES 0 DO CR LOOP \ don't erase any line of source, create y empty lines
 373 ESC" [H"                \ then cursor home
 374 CR
 375 FREQ_KHZ @ 0 1000 UM/
 376 ." target MCLK = " . ." MHz" CR
 377 ." choose your baudrate:" CR
 378 ."  0 --> 6 MBds" CR
 379 ."  1 --> 5 MBds" CR
 380 ."  2 --> 4 MBds" CR      \ linux driver max speed
 381 ."  3 --> 2457600 Bds" CR
 382 ."  4 --> 921600 Bds" CR
 383 ."  5 --> 460800 Bds" CR
 384 ."  6 --> 230400 Bds" CR
 385 ."  7 --> 115200 Bds" CR
 386 ."  8 --> 38400 Bds" CR
 387 ."  9 --> 19200 Bds" CR
 388 ."  A --> 9600 Bds" CR
 389 ." other --> abort" CR
 390 ." your choice: "
 391
 392 SELECT_BAUDS    \ -- char frequency TERM_BRW TERM_MCTLW
 393
 394 TERMMCTLW_RST ! \ set UCAxMCTLW value in FRAM
 395 TERMBRW_RST !   \ set UCAxBRW value in FRAM
 396 DROP DROP       \ clear stack
 397
 398 CR ESC" [7m"    \ escape sequence to set reverse video
 399 ." Change baudrate in Teraterm, save its setup, then reset target."
 400 ;
 401
 402 CHNGBAUD