CoreForth-0

cortex/boards/nucleo-f303re.ft.md


Host ———————————————————————

::host::

../janus/compiler.ft

Target ——————————————————————-

::target::

$08000000 to trom
$20000000 to tram
        4 to tcell

trom tdp !
tram tvp !

tram $00010000 + t, 0 t,
trom $00000400 + torg

::dtc::  $10  buffer: #docol
::dtc::  $10  buffer: #dodoes
         $1FC buffer: psp
             variable s0
         $1FC buffer: rsp
             variable r0

          $40 buffer: rxb
             variable rx-head
             variable rx-tail

          $40 buffer: txb
             variable tx-head
             variable tx-tail

         $40 constant #init
        $140 constant #vectors

        $380 constant backup-start
        $380 constant backup-cold
        $384 constant backup-latest
        $388 constant backup-dp
        $38C constant backup-vp

   $08020000 constant end-of-flash
        $400 constant #page

../cpus/cortex-m3/armv7-m-primitives.ft

::stc:: include ../cpus/cortex-m3/threading-stc.ft
::dtc:: include ../cpus/cortex-m3/threading-dtc.ft

../common/core.ft

../../common/core.ft

../dictionary/common.ft

../cpus/cortex-m3/nvic.ft

../cpus/stm32f303x/rcc.ft

../cpus/stm32f303x/dma.ft

../cpus/stm32f303x/flash.ft

../cpus/stm32f303x/gpio.ft

../cpus/stm32f303x/usart.ft

../cpus/stm32f303x/spi.ft

: +led          %100000 GPIOA_BSRR ! ;
: -led          %100000 GPIOA_BRR ! ;

: rbuf-ptr@    @ + c@ ;
: rbuf-ptr!    @ + c! ;
: rbuf-ptr++   dup @ 1+ $3F and swap ! ;

: txb-empty?     tx-head @ tx-tail @ xor not ;
: rxb-empty?     rx-head @ rx-tail @ xor not ;

: !txb-empty?    tx-head @ tx-tail @ xor ;
: !rxb-empty?    rx-head @ rx-tail @ xor ;

: usart2-tx-handler
                %10000000 USART2_ISR bit@ !txb-empty? and if
                  txb tx-tail rbuf-ptr@ USART2_TDR !
                  tx-tail rbuf-ptr++
                else
                 %10000000 USART2_CR1 bic!
                then
                ;

: usart2-rx-handler
                %00100000 USART2_ISR bit@ if
                  USART2_RDR @ rxb rx-head rbuf-ptr!
                  rx-head rbuf-ptr++
                then
                ;

i: usart2-handler
                usart2-tx-handler
                usart2-rx-handler
                ;i

: emit          !txb-empty? if begin wfi txb-empty? until then
                txb tx-head rbuf-ptr!
                tx-head rbuf-ptr++
                %10000000 USART2_CR1 bis!
                ;

: dma-key?      $40 DMA1_CNDTR6 @ - rx-tail @ xor ;
: irq-key?      !rxb-empty? ;
: key           rxb-empty? if begin wfi !rxb-empty? until then
                rxb rx-tail rbuf-ptr@
                rx-tail rbuf-ptr++ ;

../../common/output.ft

../../common/input.ft

../dictionary/full.ft

::stc:: include ../common/threading-stc.ft
::dtc:: include ../common/threading-dtc.ft

../../common/exception.ft

../../common/control-flow.ft

../common/compiler.ft

../../common/interpret.ft

../../common/utils.ft

: reset         $05FA0004 $E000ED0C ! ;

: +pll          %1000000000000000000000000 RCC_CR bis! ;
: -pll          %1000000000000000000000000 RCC_CR bic! ;
: pllmul!       #18 lshift RCC_CFGR tuck @ $FFC3FFFF and or swap ! ;
: usart2-src!   #16 lshift RCC_CFGR3 tuck @ $FFFCFFFF and or swap ! ;
: sysclk-src!   RCC_CFGR tuck @ $FFFFFFF0 and or swap ! ;
: rcc.          RCC_CR #13 dumpw ;
: flash-latency!
                FLASH_ACR tuck @ $FFFFFFF0 and or swap ! ;

: 36mhz         1 flash-latency!
                #36 4 / 2 - pllmul!
                +pll
                2 sysclk-src! ;

: 64mhz         2 flash-latency!
                #64 4 / 2 - pllmul!
                +pll
                2 sysclk-src! ;

SPI initialization for Arduino headers (SPI1) PA5 - SCK (AF5) PA6 - MISO (AF5) PA7 - MOSI (AF5) Configure in master mode, MSB first, CPOL=0, CPHA=0, 8-bit

: spi-init     %100000000000 RCC_APB2ENR bis!
               GPIOA_MODER dup @ $FFC0FFFF and $A80000 or swap !    Set pins to alternate function
               GPIOA_AFRL dup @ $FFF000FF and $00555000 or swap !   Set to AF5
               GPIOB_MODER dup @ $FFFF0FFF and $1000 or swap !      Set PB6 as output
               0 SPI1_CR1 !                                         Reset SPI1 configuration
               %1100000100 SPI1_CR1 !                               Set SSM, SSI, SPE, Master mode
               %1000 SPI1_CR2 !                                     RXNE IE = 1 (8-bit)
               ;

Set SPI clock divider 0: fPCLK/2, 1: fPCLK/4, 2: fPCLK/8, 3: fPCLK/16, 4: fPCLK/32, 5: fPCLK/64, 6: fPCLK/128, 7: fPCLK/256

: spi-clk!     ( divider -- )
               %111 and 3 lshift
               SPI1_CR1 dup @ $FFFFFFC7 and rot or swap !
               ;

: setup-dma     %1 RCC_AHBENR bis!
                %10100010 DMA1_CCR6 !
                USART2_RDR DMA1_CPAR6 !
                rxb DMA1_CMAR6 !
                $40 DMA1_CNDTR6 !
                %1 DMA1_CCR6 bis!
                %1000000 USART2_CR3 bis!
                ;

: setup-uart2   %00100000000000000000 RCC_APB1ENR bis!
                3 usart2-src!
                GPIOA_MODER dup @ $FFFFFF0F and $A0 or swap !
                GPIOA_AFRL dup @ $FFFF00FF and $7700 or swap !
                #80000000 #115200 / 5 + #10 / USART2_BRR !
                %10101101 USART2_CR1 !
                0 dup dup dup tx-head ! tx-tail ! rx-head ! rx-tail !
                %1000000 NVIC_SETENA_BASE cell+ bis!
                ;

: setup-hw      %00100000000000000000 RCC_AHBENR bis!
                %00000000000000001000000000 RCC_AHBENR bis! Enable GPIOB clock
                GPIOA_MODER dup @ $FFFFF3FF and $400 or swap !
                setup-uart2
                spi-init
                ;

SPI interface functions

: spi-tx-ready? %10 SPI1_SR bit@ ;
: spi-rx-ready? %1 SPI1_SR bit@ ;

: >spi>        begin spi-tx-ready? until
               SPI1_DR c!
               begin spi-rx-ready? until
               SPI1_DR c@ ;

: >spi         >spi> drop ;
: spi>         $FF >spi> ;

SPI Chip Select functions (using PB6 as default CS)

: -spi         %1000000 GPIOB_BSRR ! ; CS pin high (inactive)
: +spi         %1000000 GPIOB_BRR ! ;  CS pin low (active)

: flash-busy?   1 FLASH_SR bit@ ;
: await-flash-idle
                begin flash-busy? 0= until ;
: unlock-flash  %10000000 FLASH_CR bit@
                if $CDEF89AB $045670123 FLASH_KEYR tuck ! ! then ;
: lock-flash    %10000000 FLASH_CR bis! ;
: flash-mode!   unlock-flash FLASH_CR dup @ $1F invert and rot or swap ! ;
: enable-flash-write
                unlock-flash %00001 flash-mode! ;
: erase-page    unlock-flash %00010 flash-mode!
                FLASH_AR ! %01000000 FLASH_CR bis!
                await-flash-idle lock-flash ;
: erase-range   unlock-flash %00010 flash-mode!
                swap begin 2dup > while
                  dup FLASH_AR ! %01000000 FLASH_CR bis! #page +
                repeat 2drop lock-flash ;
: flash.        FLASH_ACR 8 dumpw ;

../janus/init.ft

: dict-space    backup-dp @ #page + #page 1- invert and ;
: erase-dictspace
                unlock-flash dict-space end-of-flash erase-range lock-flash ;

: save-vars     >r dint
                pad aligned
                0 over #page move
                0 erase-page
                enable-flash-write
                dup 0 #vectors hmove
                backup-start + backup-start #init hmove
                r> init-cold i!
                latest @ init-latest i! dp @ init-dp i! vp @ init-vp i!
                lock-flash eint ;

: restore-vars  dint
                pad aligned
                0 over #page move
                0 erase-page
                enable-flash-write
                dup 0 #vectors hmove
                dup backup-start + backup-start #init hmove
                    backup-start + init-start #init hmove
                lock-flash eint ;

: save          bl word dup c@ 0= if
                  ." missing start word, not saving" drop exit then
                find 0= if ." not found, not saving" drop exit then
                save-vars ;
: restore       restore-vars erase-dictspace ;

: cold          s0 sp! r0 rp! 0 (source-id) ! setup-vars 64mhz setup-hw
                ." CoreForth-0 " .threading ."  ready" cr
::stc::         init-dp @ backup-dp @ = if dict-space org then
                hex abort ;

Host ———————————————————————

::host::

::dtc:: t' #docol $0C + t@ t' ,enter 8 + t!
::dtc:: t' #dodoes $0C + t@ t' ,dodoes 8 + t!

../janus/save-image.ft

t' usart2-handler 1+ trom $000000D8 + t!

::dtc:: s" nucleo-f303re-dtc.hex" save-hex
::stc:: s" nucleo-f303re-stc.hex" save-hex