;       DEC 99999 BBBBBBBBBBBBBBBBBBBBBB
;
;
;********************************************************************
;*
;*   star03
;*
;*   *DATE command
;*
;*   calls osword &7A (&99) to get local date in ascii
;*   (if available) and prints it with editing (DD/MM/YYYY)
;*
;********************************************************************
;
star03
 LdyIM 12
 LdaIM 0 ; Initialise error flag
 StaAY ARGcon
 LdaIM &99 ; osword call sub-number
 Sta ARGcon
 Jsr date01
;
;   check error return
;
 LdyIM 12 ; offset to error indicator
 LdaAY ARGcon
 CmpIM &F0
 Bne star01
 Jsr stri02
 = "Date not available"
 = 0
 Jmp starda
;
star01
 CmpIM &FF
 Bne stargo
 Jsr stri02
 = "Date reception error"
 = 0
 Jmp starda
stargo
 LdyIM 4 ; offset to ascii result
star02
 LdaAY ARGcon
 Jsr oswrch
 Iny
 LdaAY ARGcon
 Jsr oswrch
 Iny
 CpyIM 12 ; end?
 Beq starda
 CpyIM 9 ; passed DD,MM ?
 Bcs star02
 LdaIM "/"
 Jsr oswrch
 Jmp star02
;
starda
 Jsr osnewl
;
 Sec ; To indicate OSCLI recognised
 Rts
;
;
;
;********************************************************************
;*
;*  osword call  &7A (&99)
;*
;*  date01
;*
;*   grabs Modified Julian Date (MJD) group from the Television
;*   Service Data Packet (TSDP) (TSbuff) and decodes it into
;*   ascii DDMMYYYY using the reference point  31 Dec 1981 = 44969.
;*   time00 is called to see if the date needs correction
;*   by +/- 1 day and to see that the TSDP has arrived correctly
;*
;*   OnAY entry X point to parameter block;
;*         1 byte osword call sub-number
;*         3 bytes packed decimal Julian date  (output)
;*         8 bytes ascii date DDMMYYYY         (output)
;*         1 byte error indicator              (output)
;*                F0    no TSDP
;*                FF    bad TSDP data
;*
;*   OnAX exit, A,Y are preserved
;*
;*   NB Decimal mode arithmetic is used. Therefore, interrs are
;*      disabled for most of the routine
;*
;*   NB Date conversion goes wrong in the year 2100 !!!
;*      This is due to a simplified leap year detector,
;*      i.e. divides by 4, but not by 100 and 400.
;*
;*******************************************************************
;
date01
;
;   call time00 to see if TSDP is present and correct
;   and to get date adjustment
;
 LdaIM &98 ; osword sub-number
 Sta timebl
 Jsr time00
;
 LdyIM 11 ; offset to error/date indicator
 LdaAY timebl
 Bpl datege ; TSDP is present and correct
 Iny ; TSDP is either bad or absent
 StaAY ARGcon
 Jmp dateex ; and exit
;
datege
;
;   get MJD from TSDP
;
 LdxIM 12 ; offset within TSDP
 LdyIM 3 ; offset within parameter block
datemj
 LdaAX TSbuff ; get MJD bytes
 StaAY ARGcon
 Dex
 Dey
 Bne datemj
;
;   process MJD
;
 Php ; save processor status
 Sei ; disable interrs
 Sed ; go into decimal mode arithmetic
;
;   subtract 1 from each MJD digit to get Julian Date
;
 LdyIM 3
datede
 LdaAY ARGcon
 Sec
 SbcIM &11 ; decrement each packed decimal digit by one
 StaAY ARGcon
 StaAY timebl ; save Julian Date for exit
 Dey
 Bne datede
;
 Iny
 AndIM &0F ; zero top MJD digit (unused)
 StaAY ARGcon
;
;   set starting point for years
;
 LdaIM :LSB: 1982
 Sta year ; used to determine leap years
 LdaIM :MSB: 1982
 Sta year+1
 Jsr leapye ; set leap flag to zero
 LdaIM &82
 Sta yeard
 LdaIM &19
 Sta yeard+1
;
;   subtract reference point +/- 1
;
 LdaIM 4
 Sta subtra ; msb is LOWEST in memory to be compatible with MJD
 LdaIM &49
 Sta subtra+1
 LdyIM 11 ; offset to date change indicator
 LdaAY timebl ; has date changed?
 Bne datech
 LdaIM &69
 Sta subtra+2 ; no. subtract 44969
 Jmp datesu
;
datech
 CmpIM 1
 Bne dateba
 LdaIM &68 ; date has gone forward - subtract 1 less
 Sta subtra+2 ; i.e. 44968
 Jmp datesu
;
dateba
 LdaIM &70 ; date has gone back - subtract 1 more
 Sta subtra+2 ; i.e. 44970
;
datesu
 Jsr mpsubt ; subtract (corrected) reference point leaving
; number of days since 1/1/82 in MJD
;
;   find the year by subtracting 365/6 until <= 365/6
;
 LdaIM 0 ; set up subtra for this loop
 Sta subtra
 LdaIM 3
 Sta subtra+1
 LdaIM &65 ; mp routines take care of leap years
 Sta subtra+2
;
dateye
 Jsr mpcomp ; MJD > 365/6 ?
 Bcc datemo ; no. we have found the year
 Jsr mpsubt ; yes. subtract year's worth of days
 Lda yeard
 Clc
 AdcIM 1 ; increment YYYY (Inc doesn't use decimal arith.)
 Sta yeard
 Bcc datebi
 Lda yeard+1
 Clc
 AdcIM 1
 Sta yeard+1
datebi
 Inc year ; increment binary year to check for leaps
 Bne datele
 Inc year+1
datele
 Jsr leapye
 Jmp dateye
;
datemo
;
;   findA2 the month by subtracting length of month 1,etc.
;   until MJD <= length of next month
;
 LdaIM 0
 Sta subtra+1
 LdxIM 0 ; offset to month table (MM-1)
 LdaIM 1 ; first month (packed decimal)
 Sta month ; MM
dml
 CpxIM 1 ; February?
 Beq dateco ; yes. leave leap alone so that it influences sub/cmp
 Asl leap ; no. clear and save leap for straight sub/cmp
dateco
 LdaAX mtable ; get length of month
 Sta subtra+2
 Jsr mpcomp ; MJD > length of month?
 Bcc date00 ; no. we have found the month :AND: the day !!!
 Jsr mpsubt ; yes. subtract this month's worth of days
 CpxIM 1 ; restore leap flag, if necessary
 Beq datene
 Lsr leap
datene
 Inx ; next month
 Lda month
 Clc
 AdcIM 1
 Sta month
 Jmp dml
;
;   convert DD (in MJD) , MM (in month) , YYYY (in yeard) to ascii
;
date00
 Plp ; restore processor status
 LdyIM 3   ; point to tensunits of MJD
 LdaAY ARGcon ; DD
 Iny ; point to ascii destination bytes
 Jsr bcdasc ; convert both digits to ascii and store them
 Lda month
 Iny
 Jsr bcdasc
 Lda yeard+1
 Iny
 Jsr bcdasc
 Lda yeard
 Iny
 Jsr bcdasc
;
;   restore Julian Date for exit
;
 LdyIM 3
datejd
 LdaAY timebl
 StaAY ARGcon
 Dey
 Bne datejd
;
dateex
;
 Rts
;
;
;**************************************************************
;*
;*  leapye
;*
;*    if year is divisible by 4
;*    then leap = 1
;*    else leap = 0
;*
;**************************************************************
;
leapye
 LdaIM 0
 Sta leap
;
 LdaIM 3
 Bit year ; is year a multiple of 4?
 Bne leapex ; no. leave leap clear
 Inc leap ; yes. set leap
leapex
 Rts
;
;
;**************************************************************
;*
;*  mpcomp       multiple precision comparison (3 bytes)
;*
;*   if leap
;*   then compare MJD with subtra + 1
;*   else compare MJD with subtra
;*
;*   on exit,
;*     Carry = 1  iff MJD >  subtra (+1)
;*     Carry = 0  if   MJD <= subtra (+1)
;*
;*     X is preserved
;*
;**************************************************************
;
mpcomp
 Txa
 Pha
 LdxIM 0 ; offset within subtra
 LdyIM 1 ; offset within MJD
;
mpchig
 LdaAY ARGcon ; get MJD byte (highest first)
 CmpAX subtra
 Bcc mpcexi ; MJD < subtra
 Bne mpcexi ; MJD > subtra
 Iny ; these bytes equal. need to compare lower bytes
 Inx
 CpxIM 1
 Beq mpchig
;
;   highest bytes are equal. all eyes on low byte
;
 LdaAY ARGcon
 CmpAX subtra
 Bcc mpcexi ; MJD < subtra
 Bne mpctry
 Clc ; MJD = subtra, so MJD < subtra +1
 Bcc mpcexi ; result (Carry) is the same
;
mpctry
 LdaIM 1 ; mask for bit 0 test
 Bit leap ; see if leap year
 Beq mpcexi ; no correction needed - result stands
 LdaAY ARGcon
 IncAX subtra
 CmpAX subtra
 Bne mpcres ; MJD still > subtra
 Clc ; MJD now = subtra
mpcres
 DecAX subtra ; restore byte
;
mpcexi
 Pla
 Tax
 Rts
;
;
;**************************************************************
;*
;*  mpsubt      multiple precision subtraction (3 bytes)
;*
;*   if leap
;*   then subtract subtra+1 from MJD
;*   else subtract subtra from MJD
;*
;*   on exit, X is preserved
;*
;**************************************************************
;
mpsubt
 Txa
 Pha
 LdxIM 2 ; offset within subtra
 LdyIM 3 ; offset within MJD
;
 LdaIM 1 ; bit 0 mask
 Bit leap ; leap year?
 Beq mpsnol ; no.
 Clc ; yes. subtract an extra 1
 Bcc mpssub
mpsnol
 Sec
;
mpssub
 LdaAY ARGcon ; get MJD byte (lowest first)
 SbcAX subtra
 StaAY ARGcon
 Dex ; next byte
 Dey
 Bne mpssub
;
 Pla
 Tax
 Rts
;
;
;**************************************************************
;*
;*  bcdasc       1 packed decimal byte to two ascii bytes
;*
;*  inputAr in Aesult bytesAY written toIY dbloc)  (dbloc+1
;*
;**************************************************************
;
bcdasc
 Pha
 LsrA      ; convert lefthand digit to binary
 LsrA
 LsrA
 LsrA
 OraIM &30 ; convert binary to ascii character
 StaAY ARGcon
 Iny
 Pla ; restore input byte
 AndIM &0F ; convert righthand digit to binary
 OraIM &30 ; convert binary to ascii character
 StaAY ARGcon
;
 Rts
;
;
mtable ; table giving length of each month (in bcd)
 = &31 ; offset 0 , Jan
 = &28 ; offset 1 , Feb , etc.
 = &31
 = &30
 = &31
 = &30
 = &31
 = &31
 = &30
 = &31
 = &30
 = &31
;
;
;*************** WORKING STORAGE VARIABLES ********************
;
;.leap   = 0 ; leap year flag
;.yeard EQUW 0 ; YYYY (packed decimal)
;.month  = 0 ; MM     "     "
;.year   EQUW 0 ; binary year YYYY for deriving leap
;.subtra EQUW 0 ; operan in mpsubt and mpcomp
;            = 0
;
;.timebl ; param. block for time00 call
;        = 0 ; osword sub-number
;        = "000" ; UTC group (also used as working storage)
;        = 0 ; time offset byte
;        = "000000" ; ascii time
;        = 0 ; error/date change indicator
;
;
;
;
; < 3   ; Get from bottom side from now on
 LNK RLINK