
\ -----------------------------------------------------------------------------
\  Loran-C receiver with precision local clock stabilisation
\    Matthias Koch
\ -----------------------------------------------------------------------------

compiletoflash

  \ ---------------------------------------------------------------------------
  \ Clock Initialisation
  \ ---------------------------------------------------------------------------

$40023800 constant RCC_Base
 
$40023C00 constant Flash_ACR \ Flash Access Control Register
$40004408 constant USART2_BRR

\ f (VCO clock) = f (PLL clock input) * (PLLN/PLLM)
\ f (PLL general clock output) = F (VCO clock) / PLLP
\ f (USB, RNG und andere) = f (VCO clock) / PLLQ

RCC_Base $00 + constant RCC_CR
  1 24 lshift constant PLLON
  1 25 lshift constant PLLRDY

RCC_Base $04 + constant RCC_PLLCRGR
   1 22 lshift constant PLLSRC

RCC_Base $08 + constant RCC_CFGR


: 120MHz-2Msps ( -- )

  \ Set Flash waitstates !
  $103 Flash_ACR !   \ 3 Waitstates for 120 MHz with more than 2.7 V Vcc, Prefetch buffer enabled.

  PLLSRC          \ HSE clock as 8 MHz source

  8  0 lshift or  \ PLLM Division factor for main PLL and audio PLL input clock 
                  \ 8 MHz / 8 =  1 MHz. Divider before VCO. Frequency entering VCO to be between 1 and 2 MHz.

240  6 lshift or  \ PLLN Main PLL multiplication factor for VCO - between 192 and 432 MHz
                  \ 1 MHz * 240 = 240 MHz

  8 24 lshift or  \ PLLQ = 8, 240 MHz / 8 = 30 MHz

  0 16 lshift or  \ PLLP Division factor for main system clock
                  \ 0: /2  1: /4  2: /6  3: /8
                  \ 240 MHz / 2 = 120 MHz 
  RCC_PLLCRGR !

  PLLON RCC_CR bis!
    \ Wait for PLL to lock:
    begin PLLRDY RCC_CR bit@ until

  2                 \ Set PLL as clock source
  %101 10 lshift or \ APB  Low speed prescaler (APB1) - Max 42 MHz ! Here 120/4 MHz = 30 MHz.
  %100 13 lshift or \ APB High speed prescaler (APB2) - Max 84 MHz ! Here 120/2 MHz = 60 MHz.
  RCC_CFGR !

  $104 USART2_BRR ! \ Set Baud rate divider for 115200 Baud at 30 MHz.
;
 

  \ ---------------------------------------------------------------------------
  \ Port Constants
  \ ---------------------------------------------------------------------------

\ Konstanten für die Taktversorgung

\ $40023800 constant RCC_Base
RCC_Base $40 + constant RCC_APB1ENR
RCC_Base $44 + constant RCC_APB2ENR

\ Bits for RCC_APB2ENR:
1  8 lshift constant ADC1EN
1  9 lshift constant ADC2EN
1 10 lshift constant ADC3EN


\ Konstanten für die Leuchtdioden

$40020000 constant PORTA_Base
$40020400 constant PORTB_Base
$40020800 constant PORTC_Base
$40020C00 constant PORTD_Base
$40021000 constant PORTE_Base
$40021400 constant PORTF_Base
$40021800 constant PORTG_Base
$40021C00 constant PORTH_Base
$40022000 constant PORTI_Base

PORTD_BASE $00 + constant PORTD_MODER    \ Reset 0 Port Mode Register - 00=Input  01=Output  10=Alternate  11=Analog
PORTD_BASE $04 + constant PORTD_OTYPER   \ Reset 0 Port Output type register - (0) Push/Pull vs. (1) Open Drain
PORTD_BASE $08 + constant PORTD_OSPEEDR  \ Reset 0 Output Speed Register - 00=2 MHz  01=25 MHz  10=50 MHz  11=100 MHz
PORTD_BASE $0C + constant PORTD_PUPDR    \ Reset 0 Pullup / Pulldown - 00=none  01=Pullup  10=Pulldown
PORTD_BASE $10 + constant PORTD_IDR      \ RO      Input Data Register
PORTD_BASE $14 + constant PORTD_ODR      \ Reset 0 Output Data Register
PORTD_BASE $18 + constant PORTD_BSRR     \ WO      Bit set/reset register   31:16 Reset 15:0 Set
        \ +$1C                                     ... is Lock Register, unused
PORTD_BASE $20 + constant PORTD_AFRL     \ Reset 0 Alternate function  low register
PORTD_BASE $24 + constant PORTD_AFRH     \ Reset 0 Alternate function high register

PORTD_BSRR    constant portd-set
PORTD_BSRR 2+ constant portd-reset

$1000 constant led-green
$2000 constant led-orange
$4000 constant led-red
$8000 constant led-blue



\ Konstanten für den AD-Wandler

$40020800 constant PORTC_Base
PORTC_BASE $00 + constant PORTC_MODER    \ Reset 0 Port Mode Register - 00=Input  01=Output  10=Alternate  11=Analog
\ PC0 is AIN10
\ PC1 is AIN11


$40012000 constant ADC1_Base

ADC1_Base $00 + constant ADC1_SR
ADC1_Base $04 + constant ADC1_CR1
ADC1_Base $08 + constant ADC1_CR2
ADC1_Base $0C + constant ADC1_SMPR1
ADC1_Base $10 + constant ADC1_SMPR2
ADC1_Base $14 + constant ADC1_JOFR1
ADC1_Base $18 + constant ADC1_JOFR2
ADC1_Base $1C + constant ADC1_JOFR3
ADC1_Base $20 + constant ADC1_JOFR4
ADC1_Base $24 + constant ADC1_HTR
ADC1_Base $28 + constant ADC1_LTR
ADC1_Base $2C + constant ADC1_SQR1
ADC1_Base $30 + constant ADC1_SQR2
ADC1_Base $34 + constant ADC1_SQR3
ADC1_Base $38 + constant ADC1_JSQR
ADC1_Base $3C + constant ADC1_JDR1
ADC1_Base $40 + constant ADC1_JDR2
ADC1_Base $44 + constant ADC1_JDR3
ADC1_Base $48 + constant ADC1_JDR4
ADC1_Base $4C + constant ADC1_DR

\ Bits for ADC_SR:
  2 constant EOC
$10 constant OVR

\ Bits for ADC_CR2:
1           constant ADON
2           constant CONT
1 30 lshift constant SWSTART


\ Konstanten für den Timer

$E000E100   constant NVIC_EN0_R      \ IRQ  0 to 31 Set Enable Register
1 28 lshift constant NVIC_EN0_INT28  \ Timer 2 Interrupt (28)

$40000000 constant TIM2-Base

TIM2-Base $00 + constant TIM2_CR1    \ Control register 1
TIM2-Base $04 + constant TIM2_CR2    \ Control register 2
TIM2-Base $08 + constant TIM2_SMCR   \ Slave mode control register
TIM2-Base $0C + constant TIM2_DIER   \ DMA & Interrupt enable register
TIM2-Base $10 + constant TIM2_SR     \ Status register
TIM2-Base $14 + constant TIM2_EGR    \ Event generation register
TIM2-Base $18 + constant TIM2_CCMR1  \ Capture/compare mode register 1
TIM2-Base $1C + constant TIM2_CCMR2  \ Capture/compare mode register 2
TIM2-Base $20 + constant TIM2_CCER   \ Capture/compare enable register
TIM2-Base $24 + constant TIM2_CNT    \ Counter
TIM2-Base $28 + constant TIM2_PSC    \ Prescaler
TIM2-Base $2C + constant TIM2_ARR    \ Auto-reload register
\ $30 Unused
TIM2-Base $34 + constant TIM2_CCR1   \ Capture/compare register 1
TIM2-Base $38 + constant TIM2_CCR2   \ Capture/compare register 2
TIM2-Base $3C + constant TIM2_CCR3   \ Capture/compare register 3
TIM2-Base $40 + constant TIM2_CCR4   \ Capture/compare register 4
\ $44 Unused
TIM2-Base $48 + constant TIM2_DCR    \ DMA control register
TIM2-Base $4C + constant TIM2_DMAR   \ DMA address for full transfer


$80 constant ARPE
  1 constant CEN

  1 constant UIE
  1 constant UIF


  \ ---------------------------------------------------------------------------
  \ Initialisations and Hardware Setup
  \ ---------------------------------------------------------------------------

: init-timer ( -- )

  \ Takt aktivieren für Timer 2:
  1  RCC_APB1ENR bis! \ Enable clock for Timer 2
  \ Timer 2 läuft auf APB1 - das sind hier 30 MHz.
  \ Internal Clock CK_INT - was ist das ?
  100 0 do loop \ Etwas warten, bis der Timer wirklich läuft


  \ Timer soll aufwärts zählen, und bei jedem Update-Event einen Interrupt auslösen.
  \ Dabei soll der Überlaufwert gepuffert werden und erst beim nächsten Update aktualisiert werden. ARPE = 1.

  \ In der Interrupt-Routine werden dann abwechselnd zwei (drei) unterschiedliche Zeiten benutzt.

  0 TIM2_CR1 ! \ Timer ausschalten

  NVIC_EN0_INT28 NVIC_EN0_R bis! \ Interrupt einschalten

  UIE TIM2_DIER ! \ Interrupt auf Update-Event setzen

  0 TIM2_CNT ! \ Counter auf 0
  0 TIM2_PSC ! \ Prescaler - jetzt 0, voller Takt ! Huiuiui !

  59 TIM2_ARR ! \ Auto-Reload Register, stellt die Dauer ein, wird im Handler verändert.

  ARPE  TIM2_CR1 !    \ Puffern des Überlaufwertes, Upcounter
  CEN   TIM2_CR1 bis! \ Timer einschalten
;

: init-analog ( -- )  

  ADC1EN RCC_APB2ENR bis! \ Enable clock for ADC1
  %11 1 2* lshift portc_moder bis! \ Switch PC1 to analog mode

     0 ADC1_CR1 !
  ADON ADC1_CR2 ! \ Enable ADC

  1 20 lshift ADC1_SQR1 ! \ One conversion for this sequence
  11 ADC1_SQR3 !           \ Select channel 11, PC1
; 


0 variable ram-exact-crystal-loran-handler
0 variable ram-slow-crystal-loran-handler
0 variable ram-fast-crystal-loran-handler


: init ( -- ) 

  \ Switch LED pins to output
  \ Ausgänge aktivieren, damit ich auch etwas sehen kann:
  $55000000 PORTD_MODER ! \ Outputs PD12, PD13, PD14, PD15

  led-blue portd_odr !

  \ Set Clocks
  120mhz-2msps

  \ Copy interrupt handlers into RAM for faster execution without waitstates

  compiletoram align,

  here ram-exact-crystal-loran-handler !
  ['] exact-crystal-loran-handler inline,
  $4770 h, \ bx lr Opcode

  here ram-slow-crystal-loran-handler !
  ['] slow-crystal-loran-handler inline,
  $4770 h, \ bx lr Opcode

  here ram-fast-crystal-loran-handler !
  ['] fast-crystal-loran-handler inline,
  $4770 h, \ bx lr Opcode


  \ Setup timer interrupt hook
  ram-exact-crystal-loran-handler @ irq-tim2 !

  \ Setup special registers for Loran handler
  loran-register-init
  74990 gri!

  \ Initialisation of switch cycles for maximum frequency shift
  1 tack!

  \ Setup analog-digital converter
  init-analog

  \ Ready to fly !
  init-timer

  \ Loran-C receiver is up and running.
  0 portd_odr !
;

  \ ---------------------------------------------------------------------------
  \ On-the-fly reconfiguration
  \ ---------------------------------------------------------------------------

: gricycle ( -- ) 0 TIM2_PSC ! ;  \   1 MHz sampling
: fricycle ( -- ) 1 TIM2_PSC ! ;  \ 500 kHz sampling

: exact-xtal ( -- ) ram-exact-crystal-loran-handler @ irq-tim2 ! 59 TIM2_ARR ! ;
: slow-xtal  ( -- ) ram-slow-crystal-loran-handler  @ irq-tim2 ! ;
: fast-xtal  ( -- ) ram-fast-crystal-loran-handler  @ irq-tim2 ! ;

: t ( u -- ) tack! ; \ For quick clock adjustments

: khz ( f -- ) \ Uses measurement with exact-crystal handler to determine tack value

  1000, f/ 1,0 d-  
  2dup dabs 0,0000003 d< 
  if 2drop ." Crystal almost perfect" exact-xtal
  else

  60,0 f* 1,0 2swap f/ 
  
  nip \ Signed Tack on Stack.

  dup 0< if   ." Crystal too slow, Tack: " slow-xtal abs dup tack! u. 
         else ." Crystal too fast, Tack: " fast-xtal abs dup tack! u.
         then 
  then
  cr
;

  \ ---------------------------------------------------------------------------
  \ Code for signal capture - Routinen für den Empfang
  \ ---------------------------------------------------------------------------

: clearbuffer ( -- ) \ Löscht den Puffer
  gri@ 0 do 0 i sample>address h! loop \ Puffer löschen 
;

0 variable latestgris

: samplegris ( n -- ) \  Liest Signal ein
  led-green portd-set h!
  dup latestgris !
  clearbuffer              \  Puffer löschen
  gri@ * samples!          \  Aufnahme starten mit der gewünschten Zahl von Samples
  begin samples@ 0= until  \  Abwarten, bis alle Samples aufgenommen worden sind
  led-green portd-reset h!
;

: getsample ( sample# -- n ) sample>address h@ sign16 ;

: puffermaximum ( -- n ) \ Sucht nach dem größten Absolutwert im Puffer.
  0 \ Am Anfang ist der maximale Wert 0.
  gri@ 0 do 
           i getsample abs max  \ Ist der aktuelle Absolutwert größer ?
         loop
;

: printbuffer ( -- ) \ Gibt alle Messwerte aus
  dint \ So geht es viel schneller !
  \ Print contents of circular buffer
  cr cr
  gri@ 0 do 
           i u. space
           5000 0 do loop \ Wait a little bit...
           i getsample . cr
           5000 0 do loop \ Wait a little bit for upstream communication buffers
         loop
  eint
;

: offsetmeasurement ( -- ) \ Determine current signal offset

  0 offset!  
  2 samplegris

  0 \ Startwert für den Offset

  gri@ 0 do 
           i getsample   +  \ Alle Samples aufsummieren
         loop

  gri@ 2 *   /    \ Teilen durch die Zahl der Messwerte

  offset!
;

128 variable griscapture
32  variable griscalibration

: coarse ( -- )
  cr \ Try to coarsely determine crystal frequency in -100 ppm to +100 ppm range.
  offsetmeasurement

  101 -100 do
    i . ." ppm "  0 i  0,001 f* 1000,0 d+ ( 2dup f. ) khz
    griscalibration @ samplegris
    puffermaximum ."  Maximum: " . cr
  loop
  cr
;


\ On-the-fly fine frequency calibration and tracking. 
\ This needs a good SNR because it uses maximum signal amplitude as reference point.
\ You have to do coarse calibration before, as this searches for 
\ local intensity maximum in narrow frequency offset range only and it
\ cannot switch from too-fast crystal handler to too-slow crystal handler and vice versa.
\ But as crystals on STM32F407 tend to be "bad enough", it is unlikely to cross the +-0 ppm border.

0  variable calibrationtack
0  variable calibrationamplitude
20 variable calibrationrange

: calfreq ( -- ) \ Taktkalibration anhand des Signals.
  cr             \ Fine tune clock with signal.
  offsetmeasurement
  ." Old Tack: " tack@ $FFFF and u. cr

  0 calibrationamplitude !

  tack@ $FFFF and calibrationrange @ + 1+
  tack@ $FFFF and calibrationrange @ - 
  do
    cr ." Tack: " i .
    i tack! 
    griscalibration @ samplegris
    puffermaximum
    dup ."  Maximum: " .
    dup calibrationamplitude @ >= if calibrationamplitude ! i calibrationtack ! else drop then    
  loop
  cr
  calibrationtack @ tack!
  ." Current Tack: " tack@ $FFFF and u. cr
;


: capture ( -- ) \ Capture Loran-C Signal
  cr
  offsetmeasurement
  offset@ ." # Offset: " . cr
  griscapture @ samplegris
  ." # Absolute Maximum: " puffermaximum . cr
  ." # GRI: " gri@ . cr
;
