\ 2007-01-16 EW adv4_dcf.fs

Variable dcfFlags
$00 Constant dcfError
$01 Constant dcfParity
$02 Constant dcfCommit
$0f Constant dcfDebug
Variable dcfPulse
Variable dcfPause
Variable dcfPos
Variable dcfOffset
Variable dcfPulse1
21 Constant dcfOffset1
create   dcfFields
0  c, \  1  .start
8  c, \  2  
16 c, \  3  leading flags
17 c, \  4  daylight savings time
18 c, \  5  
21 c, \  6  Minute
28 c, \  7  MinuteParity
29 c, \  8  Hour
35 c, \  9  HourParity
36 c, \ 10  Day
42 c, \ 11  DayOfWeek [1: Mo ... 7:So]
45 c, \ 12  Month
50 c, \ 13  Year-2000
58 c, \ 14  Parity
59 c, \ 15  .fin

16 Constant dcfFieldsN
Variable dcfFieldsI
Variable dcfCurr
ram create dcfValues dcfFieldsN allot rom
: dcf.FieldComplete? ( dcfPos -- t/f )
  dcfFieldsI @ dcfFields + c@  1-  = 
;
: dcf.error.set  dcfError dcfFlags bset ;
: dcf.error.clr  dcfError dcfFlags bclr ;
: dcf.error?     dcfError dcfFlags btst ;
: dcf.par.set dcfParity dcfFlags bset ;
: dcf.par.clr dcfParity dcfFlags bclr ;
: dcf.par.tgl dcfParity dcfFlags 2dup
  btst IF bclr ELSE bset ENDIF ;
: dcf.par?    dcfParity dcfFlags btst ;
: dcf.D? dcfDebug dcfFlags btst ;

: bcd>dec ( n.bcd -- n.dec )
  $ff and
  dup 
  4 rshift 10 * \ extract high nibble as 10s
  swap
  $0f and       \ extract low  nibble as 1s
  +             \ add
;
: get.DCF
  0                          \ fake Second
  dcfValues  5  + c@         \ Minute
  dcfValues  7  + c@         \ Hour  
  dcfValues  9  + c@         \ Day   
  dcfValues 11  + c@         \ Month 
  dcfValues 12  + c@ 2000 +  \ Year  
;
: dcf.commit ( -- )
  0 tick !
  0 dcfOffset !
  get.DCF
  year     !
  1- month !
  1- day   !
  hour     !  
  min      !
  sec      ! \ zero
  ."  commited "
;
: dcf.readPin
  \ pin is on "active low" connection
  \ thus invert
  pinDCF portDCF btst invert
;
: dcf.reload
  0 dcfPulse  !
  0 dcfPause  !
  0 dcfPulse1       !
;
: dcf.init
  pinDCF pddrDCF bclr     \ set pinDCF input
  0 dcfPos  !
  1 dcfFieldsI !
  dcf.error.set    \ error unless proven ok.
  dcfDebug dcfFlags bset  \ debug off
  dcfCommit dcfFlags bset \ commit requested
;
: dcf.bit ( pulse pause -- bit/error )
  \ return values:
  \ -3 interval too short
  \ -2 sync detected
  \ -1 error
  \  0 bit value 0
  \  1 bit value 1
  \ limits hardcoded assuming 10 ms per count
  2dup + 97 > IF
    drop
    dup  2 < IF ( ." sync59 " ) -2 ELSE
    dup  6 < IF dcf.error.set   -1 ELSE
    dup 11 < IF ( ." bit:0 "  )  0 ELSE
    dup 16 < IF dcf.error.set   -1 ELSE
    dup 21 < IF ( ." bit:1 "  )  1 ELSE
    dcf.error.set             -1
    ENDIF ENDIF ENDIF ENDIF ENDIF
    swap drop
  ELSE
    2drop -3
  ENDIF
;
: .3r  s>d 3 d.r space ;
: dcf.err.if.par
  dcf.par? IF dcf.error.set ENDIF
  dcf.par.clr
;
: dcf.usebit ( b -- )
  CASE
    -2 OF ( sync59, reset Fields Index )
      1 dcfFieldsI !
    ENDOF
    -1 OF dcf.error.set       ( error ) ENDOF
    0 OF  ( bit value 0, do nothing ) ENDOF
    1 OF    ( bit value 1, use it )
      dcf.error? invert IF
	\ position of current bit in dcfCurr
	\ B: minute ones
	\ dcfPos = 21..24, dcfFieldsI = 6
	\ dcfFields[5] = 21
	\ bit pos in dcfCurr = 0..3
	dcfPos @
	dcfFields  dcfFieldsI @ 1-  +  c@
	-    
	dcfCurr bset
	dcf.par.tgl
      ENDIF
    ENDOF
    ( default: ) dcf.error.set
  ENDCASE

  dcfPos @
  CASE
    20 OF    dcf.par.clr ENDOF
    28 OF dcf.err.if.par ENDOF
    35 OF dcf.err.if.par ENDOF
    58 OF dcf.err.if.par ENDOF
  ENDCASE

  \ debug output
  dcf.D? IF
    to-stdout
    space space
    dcfCurr @ dup .3r bcd>dec .3r
    dcf.par? .3r
  ENDIF
  
  dcfPos @ dcf.FieldComplete? IF
    dcfCurr @ bcd>dec
    dcfValues dcfFieldsI @ 1- + c!
    0 dcfCurr !
    \ 1 dcfFieldsI +! \ too simple
    dcfFieldsI @ 1+
    dup dcfFieldsN < invert IF drop 1 ENDIF
    dcfFieldsI !
  ENDIF
;
: dcf.dbg.out ( bit -- )
  dcf.D? IF
    to-stdout cr
    ." ("
    dcfPulse1 @         .3r
    dcfPulse @ dcfPulse1 @ - .3r    
    ." ) "
    dcfPulse @ .3r   \ dcfPulse
    dcfPause @ .3r   \ dcfPause
    dcfPos   @ .3r   \ dcfPos
               .3r   \ bit value
    dcf.error? .3r   \ error flag
    space space
    dcfFieldsI @ .3r \ dcfFieldsI
                     \ dcf.FieldComlete?
    dcfPos @ dcf.FieldComplete? .3r
    dcfOffset @ .3r  \ dcfOffset
  ENDIF
;
: dcfCountPP
  tick @ dcfOffset1 dcfOffset @ + ticks.sec mod =
  IF dcfPulse @ dcfPulse1 ! ENDIF
;
: dcf.inc.offset
  dcfOffset @ 1+ ticks.sec mod  dcfOffset !
;
\ : dcf.dec.offset
\   dcfOffset @ 1- ticks.sec mod  dcfOffset !
\ ;
: dcf.check.offset
  dcfPulse1 @ dcfPulse @ < IF
    ."  dcfOffset++"
    dcf.inc.offset
  ENDIF
;
: dcf.tick
  dcf.readPin

  \ show pin "active" on led2
  dup IF led2_1 ELSE led2_0 ENDIF

  \ count up Pulse/Pause counters
  IF    1 dcfPulse +!
  ELSE  1 dcfPause +!
  ENDIF
  dcfCountPP
  
  \ reload counters if tick == 0
  tick @  dcfOffset @  ticks.sec mod = IF
    dcfPulse @ dcfPause @ dcf.bit

    dup -3 <> IF \ unless interval too short
      
      dup dcf.dbg.out  \ print counters
    
      dup dcf.usebit   \ print dcfCurr bcd
      dup 0 >= IF      \ check offset
	dcf.check.offset
      ENDIF
      dcf.reload       \ clear counters

      -2 = IF \ sync detected
	to-stdout cr 
	dcf.error? invert IF
	  get.DCF
	  show.DT
	  dcfPos @ 59 =
	  dcfCommit dcfFlags btst
	  and IF
	    dcfCommit dcfFlags bclr
	    dcf.commit
	  ENDIF
	ELSE
	  ." dcf error "
	ENDIF
	dcf.error.clr
	0 dcfPos !
	0 dcfCurr !
	1 dcfFieldsI !
      ELSE
	\ 1 dcfPos +!
	\ assert 0 .. 59!
	dcfPos @ 1+ 60 mod dcfPos !
      ENDIF
    ELSE
      drop
    ENDIF
  ENDIF
;