\ Vampire V4 RTC tool
\ set time and date
\ set also GEMDOS tme and date

variable sortie

16 allot constant BUF
14 allot constant OUT

24 8 * allot constant OBJ
3 28 * allot constant TED

\ true to update ASM part
\ false if it didn't change !

\ 1 >true
1 >false

\ *****************************************
\ export following assembly lines to TEMP.S
\ *****************************************

%h10000 >export "h:\temp.s"

   opt P=68040

; define three strings

TIME: dc.w 143,6
   dcb.b 8,0

DATE: dc.w 143,6
   dcb.b 8,0

TEMP: dc.w 143,8
   dcb.b 10,0

CIAAPRB     = $BFE101
CIAADDRB    = $BFE301

INITPORT MACRO
    move.b #$FF,CIAADDRB        ; all lines in output mode
    move.b #$BF,CIAAPRB         ; seems to be required for Microtext
    ENDM
ALLOCPERCALL MACRO
    ENDM
RELEASEPERCALL MACRO
    ENDM

PREP4MACROS MACRO
    lea CIAAPRB,a0              ; for SCL and SDAin
    lea CIAADDRB,a1             ; for toggling SDA
    ENDM
SCLH MACRO
    bset #0,(a0)
    ENDM
SCLL MACRO
    bclr #0,(a0)
    ENDM
SDAH MACRO
    bclr #1,(a1)                ; bit 1 as an input -> HI
    ENDM
SDAL MACRO
    bclr #1,(a0)
    bset #1,(a1)                ; bit 1 as an output -> LO
    ENDM
SDAtest MACRO
    btst #1,(a0)
    ENDM
IDLEREAD MACRO
    tst.b (a0)
    ENDM

   text


read_data:
   dc.w 437            ; define an assembly routine
   INITPORT
   bsr lire_tout
   bmi .sortie
   lea recevoir(pc),a2
   lea TIME+10(pc),a0
   clr.b (a0)
   move.b (a2)+,d0   ; seconds
   bsr manage_bcd
   move d1,-(a0)
   move.b (a2)+,d0   ; minutes
   bsr manage_bcd
   move d1,-(a0)
   move.b (a2)+,d0   ; hour
   bclr #6,d0         ; 12/24 ?
   beq.s .h24         ; 24h -> no adjust
   bclr #5,d0         ; PM ?
   beq.s .h24         ; no, morning no adjust
   moveq #$12,d1
   abcd.b d1,d0      ; PM !
.h24:
   bsr manage_bcd
   move d1,-(a0)
   lea DATE+4(pc),a0
   move.b (a2)+,d0   ; day of week, ignore
   move.b (a2)+,d0   ; day
   bsr manage_bcd
   move d1,(a0)+
   move.b (a2)+,d0   ; month
   bclr #7,d0         ; remove century
   bsr manage_bcd
   move d1,(a0)+
   move.b (a2)+,d0   ; year
   bsr manage_bcd
   move d1,(a0)+
   clr.b (a0)
   lea TEMP+4(pc),a1
   move.b #'+',(a1)+
   lea 10(a2),a2      ; point to temperature
   move.b (a2)+,d0
   bpl.s .plus
   move.b #'-',-1(a1)
   neg.b d0
.plus:
   ext.w d0
   ext.l d0
   divs #10,d0
   add.l #$00300030,d0
   move.b d0,(a1)+
   swap d0
   move.b d0,(a1)+
   move.b #'.',(a1)+
   move.b (a2),d0      ; quarter of degreees
   and.w #$C000,d0   ; two upper bits
   rol #3,d0
   move.w .quarters(pc,d0.w),(a1)+
   move #'C',(a1)+
   clr.b (a1)
   moveq #0,d3
.sortie:
   move.l d3,-(a6)
   rts
.quarters: dc.b "00255075"

   ; input  D0 = BCD byte
   ; return D1 = ASCII 2 digits
   ;        D2 = binary value
manage_bcd:
   moveq #0,d2
   unpk d0,d1,#$3030
   move.b d0,d2
   lsr #4,d2
   muls #10,d2
   and.b #$0F,d0
   add.b d0,d2
   rts


lire_tout:
   moveq.l #127,d5      ; delay...
   lea envoi(pc),a2
   moveq #envoi_fin-envoi,d1
   bsr SendI2C
   tst d3
   bmi.s oops
   moveq.l #127,d5
   lea recevoir(pc),a2
   moveq #19,d1         ; all 19 registers to retreive !
   bsr ReceiveI2C
   tst d3
oops:
   rts

write_data:
   dc.w 437             ; FORTH assembly routine
   lea reglage+1(pc),a2
   lea .maxtime(pc),a3
   lea TIME+4(pc),a0
   bsr verif6digits
   bne.s .exit            ; 1 si moins de 6 caractres
   move.b d2,(a2)+      ; sec
   move.b d1,(a2)+      ; min
   move.b d0,(a2)+      ; heures
   lea .maxdate(pc),a3
   lea DATE+4(pc),a0
   bsr verif6digits
   bne.s .exit
   addq.l #1,a2         ; saute le jour de la semaine
   move.b d0,(a2)+      ; jour
   move.b d1,(a2)+      ; mois
   move.b d2,(a2)+      ; anne
   moveq.l #127,d5      ; delay...
   lea reglage(pc),a2
   moveq #reglage_fin-reglage,d1
   bsr SendI2C
   lea TIME+4(pc),a0
   bsr binary
   ror #5,d0         ; hh
   lsl #5,d1
   or d1,d0         ; + mm
   lsr #1,d2
   or d2,d0         ; + sec/2
   move d0,-(sp)
   move #45,-(sp)
   trap #1          ; TsetTime
   addq.l #4,sp
   lea DATE+4(pc),a0
   bsr binary
   lsl #5,d1
   or d1,d0         ; mm + dd
   add.b #20,d2     ; yy since 1980
   ror #7,d2
   or d2,d0         ; yy mm dd
   move d0,-(sp)
   move #43,-(sp)
   trap #1          ; TsetDate
   addq.l #4,sp
.exit:
   move.l d3,-(a6)
   rts
.maxtime: dc.b "246060"
.maxdate: dc.b "321344"

; source a0: chaine de 6 chiffres
; output: d0/d1/d2 les trois valeurs en BCD
; d3=0 si OK et 1 si pas assez de chiffres

verif6digits:
   move.l a0,a1
   moveq #0,d0
.lb0:
   move.b (a1)+,d0
   beq.s .lb1
   cmp #'0',d0
   bmi.s .erreur
   cmp #'9'+1,d0
   bmi.s .lb0
   bra.s .erreur
.lb1:
   sub.l a0,a1
   cmp.l #7,a1
   bne.s .erreur
   move (a0)+,d0
   cmp (a3)+,d0
   bpl.s .over
   pack d0,d0,#0
   move (a0)+,d1
   cmp (a3)+,d1
   bpl.s .over
   pack d1,d1,#0
   move (a0)+,d2
   cmp (a3),d2
   bpl.s .over
   pack d2,d2,#0
   moveq #0,d3
   rts
.erreur:
   moveq #1,d3   ; not 6 digits
   rts
.over:
   moveq #2,d3   ; value overflow
   rts

; entre A0 pointe sur 6 chiffres
; sortie d0,d1,d2 en binaire

binary:
   bsr.s .get2
   move.l d3,d0
   bsr.s .get2
   move.l d3,d1
   bsr.s .get2
   move.l d3,d2
   rts
.get2:
   moveq #0,d3
   move.b (a0)+,d3
   sub #$30,d3
   muls #10,d3
   sub.b #'0',d3
   add.b (a0)+,d3
   rts

reglage:
   dc.b 0,00,$13,$15,1,$13,$89,$21,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$00,$00,$00
reglage_fin:

envoi:
   dc.b 0               ; just to set the address to zero
envoi_fin:
   even
recevoir:
   dcb.b 19,0            ; room for 19 registers
   even

SendI2C:

; entry:
; A2 byte buffer to be sent
; d1 = nombre d'octets
; d5 = delai
; renvoie d3=0 pour OK

   bsr prepare
   move.w d1,d6                    ; backup, because D1 will be destroyed
   bclr #0,d0                      ; make the address "write" style
   bsr start_bit
.SendLoop:   ; Send the byte in D0
   bsr NineBitIO
   moveq #0,d3                     ; defaut OK=0
   sub.b d2,d0
   bne HardErr                     ; That's not what we sent!
   tst.w d2
   bmi AckErr                      ; ACK bit "1", that means "NAK"
   subq.w #1,d1
   bmi EndIO                       ; all done
   move.b (a2)+,d0                 ; else get a byte from the buffer
   bra.s .SendLoop
AckErr:
   cmp.w d1,d6                     ; if this was the 1st (=address) byte,
   beq NoReply                     ; this is the classical "bad address" error
   moveq #0,d3                       ; "NAK" might still be "OK",
   tst.w d1                        ; if this were the last byte anyway
   beq EndIO                       ; yes
   moveq #-1,d3                    ; else: error "data rejected"
   bra EndIO

prepare:
   PREP4MACROS
   move #$D0,d0                   ; adress RTC
   bset #15,d0                    ; always enable reading the ACK bit
   rts

start_bit:
   SDAL
   bsr BigDelay
   SCLL
   bsr BigDelay                    ; NineBitIO starts without DELAY
   rts

BigDelay:
   move.l d5,d4
   addq.l #1,d4
   asl.l #1,d4
   beq.s .exit
.wait:
   tst.b (a0)
   subq.l #1,d4
   bne.s .wait
.exit:
   rts

; entry: a2 = buffer to store bytes
; d1 = how many bytes

ReceiveI2C:

   bsr prepare
   bset #0,d0                      ; make the address "read" style

   bsr start_bit
   ; Send the address byte first (is found in D0)
   bsr NineBitIO
   cmp.b d2,d0
   bne HardErr                     ; That's not what we sent!
   tst.w d2
   bmi NoReply                     ; Adress got no reply!
   ; Now we can receive data, but remember:
   ; We must receive 1 byte at least, even if 0 were requested.
.RecvLoop:
    moveq #-1,d0                    ; enable reading 8 bits,
    subq.w #1,d1                    ; count the byte
    ble.s .lb0
    lsr.w #1,d0                     ; always ACK=0, except last byte
.lb0:
    bsr NineBitIO
    tst.w d1                        ; Was this the 1st of 0 bytes?
    bmi.s .lb2                         ; Yes, don't store it, just quit.
    move.b d2,(a2)+                 ; Else store the byte to the buffer.
    tst.w d1
    bne.s .RecvLoop                    ; Any more to receive?
.lb2:
    moveq #0,d3
    bra EndIO                       ; all done

;==========================================================================
; Subroutines for both SendI2C and ReceiveI2C:
;--------------------------------------------------------------------------

    ; these are jumped to (!) at the end of both Send and Receive:
NoReply:
    moveq #-5,d3          ; error: "no reply"
    bra EndIO
HardErr:                            ; encountered a real bad hardware error
    moveq #-2,d3                     ; Suppose "SDA always HI",
    cmp.b #$FF,d2                   ; is that so?
    beq EndIO                       ; yes
    moveq #-3,d3                     ; Well then, "SDA always LO"?
    tst.b d2
    beq EndIO                       ; yes
    moveq #-4,d3                     ; "SDA trashed" in no specific way
EndIO:
    ; stop the bus,
    ; stop condition is CLK=L->H, wait>=4.7s, DATA=L->H, wait>=4.7s
    ; ("protocol violation to HI")
    SDAL                            ; make sure DATA is LO
    bsr BigDelay
    SCLH
    bsr BigDelay
    SDAH
   bsr BigDelay                    ; ensure a minimum "bus free" time
   rts

wait:
   beq.s .exit
.wait0:
   tst.b (a0)
   subq.l #1,d4
   bne.s .wait0
.exit:
   rts

NineBitIO:
    ; ACK bit (#15): send 9 bits from D0 and monitor SDA line to return
    ; a 9 bit "echo" in D2.
    ; The required minimum timing can be guaranteed from the number of
    ; CIA R/W accesses (i. e. EClock-cycles). CLK=HI: 3 cycles -> 4.2s,
    ; CLK=LO: 4 cycles -> 5.6s.
    rol.w #1,d0                     ; put ACK bit in a more convenient place
    clr.w d2                        ; echo-"byte"
    moveq #8,d3                     ; 9 bit
.BitLoop:
   move.l d5,d4
   lsr.l #1,d4
   bsr wait
   btst d3,d0
   beq.s .lb1
   SDAH                     ; send "1"
   bra.s .lb2
.lb1:
   SDAL                     ; send "0"
.lb2:
   move.l d5,d4
   addq.l #1,d4
   lsr.l #1,d4
   bsr wait
   SCLH                     ; CLK-pulse (>=4.0s) to indicate
   move.l d5,d4
   bsr wait
   SDAtest
   beq.s .lb3                       ; SDA LO?
   bset d3,d2                      ; else set the according "echo-bit"
.lb3:
   SCLL                     ; CLK=LO (>=4.7s) to prepare for
   dbf d3,.BitLoop                 ;  the next bit
   ror.w #1,d0                     ; undo the shifting
   ror.w #1,d2                     ; same for the echo byte
   rts

; *************************************************************
; DATA section contains informations about the routines to link
; to the FORTH.
; here are strings TIME, DATE, TEMP
; and procedures read_data and write_data
; *************************************************************

   data
   dc.b "ADD_DEFS"
   dc.l TIME,DATE,TEMP,read_data,write_data,-1
   dc.b "TIME",0,"DATE",0,"TEMP",0,"read_data",0,"write_data",0

   end

>comp

\ ***********************
\ end of ASSEMBLY section
\ ***********************

\ ***************************
\ assemble TEMP.S to TEMP.PRG
\ ***************************

%h10000 >exec "f:\assemble\asm.ttp"
"h:\temp.s"

\ ********************************************
\ include TEMP.PRG, link routines and relocate
\ ********************************************

0 >include "h:\temp.prg"

>comp

\ *******************************
\ prepares the dialog tree in RAM
\ *******************************

OBJ TED 0 dialogue

0 0 0 0 0 28 11 BOX

0 child<<
   0 0 1 1 27 1 here " 2021 guillaume.tello@orange.fr" dcs
      5 2 %h0100 TEXT
   8 0 1 3 27 1 TIME
      here " Time (hh:mm:ss) : __:__:__" dcs here " 999999" dcs 0 %h0180 FTEXT
   8 0 1 5 27 1 DATE
      here " Date (dd/mm/yy) : __/__/__" dcs here " 999999" dcs 0 %h0180 FTEXT
   0 0 here " Temperature     :" dcs 1 7 17 1 STRING
   0 0 TEMP 19 7 8 1 STRING
   5 0 here " Refresh" dcs 1 9 12 1 BUTTON
   7 0 here " Set" dcs    14 9 13 1 BUTTON
   >>
lastobj

OBJ &wdial_create MAFENETRE

>comp

\ ********************************
\ various alerts in case of errors
\ ********************************

: comm_error
   1
   " [1][ Communication error | with RTC ! ][ Ok ]"
   form_alert
;

: format_error
   1
   " [1][ Please provide exactly | 6 digits for DATE and TIME. ][ Ok ]"
   form_alert
;

: limit_error
   1
   " [1][ Values out of range ! | limits are 23:59:59 | and 31/12/44. ][ Ok ]"
   form_alert
;

\ ***************************************
\ read RTC and if no error, redraw screen
\ ***************************************

: refresh
   read_data
   0< if
      comm_error
   else
      3
      0 0 0 0
      MAFENETRE 4 + get_xywh
      form_dial
   then
;

\ *****************************************
\ write time and date (both RTC and GEMDOS)
\ treat errors on exit
\ *****************************************

: setvalue
   write_data
   case
   0 <of
      comm_error endof
   1 of
      format_error endof
   2 of
      limit_error endof
   drop
   endcase
;

\ ****************************
\ main routine, manages events
\ ****************************

: main
   2 " Vampire RTC" MAFENETRE wdial_open
   0 sortie !
   refresh
   0 v_show_c
   begin
      BUF OUT wdial_evnt
      begin
         BUF OUT wdial_formdo
      while
         drop   \ une seule fentre, pas de test
         case
            -1 of MAFENETRE wdial_close
                 1 sortie ! endof
            6  of refresh
                 6 MAFENETRE wdial_change endof
            7  of setvalue
                 7 MAFENETRE wdial_change endof
            drop
         endcase
      repeat
      sortie @
   until
;

>comp

\ **************
\ execute main !
\ **************

main





