RP2040 MSForth Dictionary 0

Where I keep track of my dictionary 0 for Mecrisp-Stellaris Forth on the Feather RP2040.

\ main dictionary for words which have been debugged
compiletoflash
: words4 ( -- ) cr  \ A columnar Word list printer. Width = 20 characters, handles overlength Words neatly 
   0				    \ column counter
   dictionarystart
      begin
	 dup 6 + dup
	 ctype			    \ dup before 6 is for dictionarynext input
	 count nip		    \ get number of characters in the word and drop the address of the word
	     20 swap - dup 0 > if   \ if Word is less than 20 chars
		   spaces swap	    \ pad with spaces to equal 20 chars
		   else drop cr	    \ issue immediate carriage return and drop negative number
		   nip -1	    \ and reset to column -1
		   then		       
		      dup 3 = if 3 - cr \ if at 4th column, zero column counter			   
		      else 1 +
		      then
	 swap		       
	 dictionarynext		    \ 	( a-addr - - a-addr flag )
      until
   2drop
;

: freeram ( -- )
  flashvar-here 4 -
  compiletoram here
  - . ." Bytes "
;

: bp cr . .s cr ;

$40014000 			constant IO_BANK0_GPIO0_STATUS \ GPIO status
$40014004 			constant IO_BANK0_GPIO0_CTRL \ GPIO control including function select and overrides.
$d0000000 			constant SIO_BASE

#5 			    constant SIO 				\ SIO (F5) DS_p258
SIO_BASE $004 + constant GPIO_IN       \ Input value for GPIO
SIO_BASE $010 + constant GPIO_OUT      \ GPIO output value
SIO_BASE $014 + constant GPIO_OUT_SET  \ GPIO output value set
SIO_BASE $018 + constant GPIO_OUT_CLR  \ GPIO output value clear
SIO_BASE $01c + constant GPIO_OUT_XOR  \ GPIO output value XOR
SIO_BASE $020 + constant GPIO_OE       \ GPIO output enable
SIO_BASE $024 + constant GPIO_OE_SET   \ GPIO output enable set
SIO_BASE $028 + constant GPIO_OE_CLR   \ GPIO output enable clear
SIO_BASE $02c + constant GPIO_OE_XOR   \ GPIO output enable XOR

\ Feather RP2040 localization
#13					constant GP13
GP13      			constant LED
#2						constant minGPIO
#29					constant maxGPIO
#0						constant minTest
#3						constant maxTest
#8						constant padsize

: GPIO_ctrl ( GPIO -- ) \ get the address for the specific GPIO ctrl register
	#8 * IO_BANK0_GPIO0_CTRL +
;

\ print values of the GPIO_CTRL registers
: print_CTRL ( n -- ) \ print CTRL values upto GPIO n
	0 CR DO 
	I GPIO_ctrl @
	I . . CR
	LOOP 
;

: one_sec ( -- ) 		\ one sec ( -- )ond delay
	1000 ms
;

: half_sec ( -- )		\ half sec ( -- )ond delay
	500 ms
;

: qtr_sec ( -- )		\ quarter sec ( -- )ond delay
	250 ms
;

: tenth_sec ( -- )		\ tenth sec ( -- )ond delay
	100 ms
;

: GPIO_F5 ( GPIO -- )		\ ensure GPIO is in F5
	dup GPIO_ctrl 
	@ %11111 and
	5 = if drop else ." Not F5! " 5 swap GPIO_ctrl ! then
;

: GPIO_OUT ( GPIO -- )	\ set GPIO to output
	1 swap lshift GPIO_OE !
;

: tog_GPIO ( GPIO -- )	
	1 swap lshift GPIO_OUT_XOR !
;

: set_GPIO ( GPIO -- )	
	1 swap lshift GPIO_OUT_SET !
;

: clr_GPIO ( GPIO -- )	
	1 swap lshift GPIO_OUT_CLR !
;

: blink_GPIO ( GPIO -- ) 
	dup GPIO_F5
	dup GPIO_OUT 
	  begin
	    dup tog_GPIO
	    tenth_sec ( -- )
	  key? until drop
; 

padsize buffer: pad
: print_pad 
	padsize 0 do 
   pad I + c@ hex .
   loop
;

: erase_pad 
	padsize 0 do 
   0 pad I + c! 
   loop 
;

\ Test_GPIO Messages
: enter_GPIO ." Enter GPIO to test or q to quit: (#2-29) " ;
: print_GPIO ." GPIO under test is: " ;
: enter_Tests ." Enter Test to run: (0-3) " ;
: print_Tests ." Tests: 0=> new GPIO 1=> High 2=> Low  3=> Blink once " ;
: print_exit ." Exit " ;
: error_GPIO ." Error: Check GPIO range: " ;
: error_input ." Error: Check input value: " ; 
: error_value_low ." Error: Value too low: " ;
: error_value_high ." Error: Value too high: " ;
: error_number ." Error: Not a number: ";

\ test_gpio words

\ state variables
false variable exit_state
: clr_exit false exit_state ! ;
: set_exit true exit_state ! ;
: exit_state? exit_state @ ;
: prt_exit ." Exit_state is " exit_state @ . ;

false variable test0_state
: clr_test0 false test0_state ! ;
: set_test0 true test0_state ! ;
: test0_state? test0_state @ ;
: prt_test ." Test_state is " test0_state @ . ;

false variable GPIO_state
: clr_gpio_st false GPIO_state ! ;
: set_gpio_st true GPIO_state ! ;
: GPIO_state? GPIO_state @ ;
: prt_GPIO ." GPIO_state is " GPIO_state @ . ;

false variable err_state
: clr_err false err_state ! ;
: set_err true err_state ! ;
: err_state? err_state @ ;
: prt_err ." Err_state is " err_state @ . ;

13 variable gpio 

: quit? ( c -- c T | c F ) \ test if char is q to quit
    dup [char] q =
;

: one_digit ( n -- d T | c F ) \ on a single digit, test if a decimal char
   decimal 
   digit
   if true
   else pad c@ false
   then
;

: two_digits ( addr -- dd T | c F ) \ on two digits, test if a decimal
   decimal c@ digit 
   if 10 * pad 1 + c@ digit 
        if + true 
        else drop pad 1 + c@ false 
        then
   else pad c@ false 
   then 
;

: get_2chr ( -- n ) \ get upto 2 char into buffer, pad
	pad 2 accept ; 

: chrtodd ( -- d|dd T | c F)  \ get one or two char and make them decimals
    get_2chr 1 - 0= if pad c@ one_digit else pad two_digits then
;

: minGPIO?
    dup minGPIO <
;

: maxGPIO?
    dup maxGPIO >
;

: in_range?
	minGPIO?
		if  false
		else 
			maxGPIO? 
				if false
				else true
				then
		then
;

: quit_test drop set_exit cr print_exit ;

: get_1 ( -- n ) pad 1 accept ;

: test_1 ( GPIO -- )
	clr_gpio_st	dup GPIO_F5
	dup GPIO_OUT
	set_GPIO
	clr_gpio_st
;

: test_2 ( GPIO -- )
	clr_gpio_st	dup GPIO_F5
	dup GPIO_OUT
	clr_GPIO
	clr_gpio_st
;

: test_3 ( GPIO -- )
	clr_gpio_st	dup GPIO_F5
	dup GPIO_OUT
	dup tog_GPIO
	tenth_sec
	tog_GPIO
	qtr_sec
	clr_gpio_st
;

: tests
	clr_gpio_st	case
		0 of cr set_test0 endof
		1 of gpio @ test_1 clr_test0 clr_gpio_st endof
		2 of gpio @ test_2 clr_test0 clr_gpio_st endof
		3 of gpio @ test_3 clr_test0 clr_gpio_st endof
		dup error_input . clr_test0
	endcase
	clr_gpio_st
;

: minTest?
    dup 0 <
;

: maxTest?
    dup 3 >
;

: valid_range? 
	minTest? 
		if  error_value_low . false 
		else 
			maxTest? 
				if error_value_high . false 
				else true
				then
		then
		
;

: ctotest ( -- ) 
    get_1 drop pad c@ digit
    	if valid_range? 
    	else quit? 
    		if set_test0 quit_test 
    		else drop true
    		then
    	then
    	
;

: get_test
    decimal
    begin 
	    cr enter_Tests ctotest 
	    if tests
	   	else drop true 
	    then
	    test0_state?
    until
;

: init_test 
	erase_pad clr_err clr_gpio_st clr_exit clr_test0 
	cr enter_GPIO
;

: run_tests
	begin
		get_test true
	until
;

: test_gpio
	cr ." Interactive GPIO test, GPIO range is " minGPIO . ." - " maxGPIO . cr 
	begin
		print_Tests
		begin	
			init_test
			chrtodd
			if in_range?
				if cr dup gpio ! print_GPIO . set_test0 set_gpio_st
				else set_err error_GPIO .
				then
			else quit?
				if set_gpio_st quit_test
				else set_err error_input .
				then
			then
			GPIO_state? 
		until
			test0_state?
			if run_tests
			then
		exit_state?
	until
;

: endofDict0 ;
0 save#
compiletoram

Comments powered by Talkyard.