home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / jsage / znode3 / uploads / clock22.lbr / CLOCK22.ZZ0 / CLOCK22.Z80
Encoding:
Text File  |  1993-03-25  |  45.1 KB  |  1,987 lines
  1. ;
  2. ; Program to set the MM58167a chip in the Kenmore Clock, Anapro 
  3. ; Clock for the Heath H89/90 or CDR Super 89 clock. The program
  4. ; reads and writes directly to the MM58167 and automatically 
  5. ; adjusts for leap years and Daylight Savings Time. See the
  6. ; internal HELP for options.
  7. ;
  8. ; CLOCK  ver 1.1  1985--Author unknown
  9. ;
  10. ; CLOCK  ver 2.0 30-Oct-92   Biff Bueffel 
  11. ;
  12. ;    a) Changed DST routine from last Sunday to first Sunday in April
  13. ;    b) Moved year storage to base port + 9, consistent with other
  14. ;        programs for this clock chip
  15. ;    c) Changed time format to be consistent with Ztime
  16. ;    d) Added Military/Civilian time option. Can be configured
  17. ;        for default and then toggle from command line
  18. ;    e) Allow setting of date only(original was time or date/time)
  19. ;    f) Used syslib and zslib routines where possible
  20. ;    g) Base port is stored at beginning of program to allow easy
  21. ;        modification. Whenever a port is read or written the 
  22. ;        base port is loaded and the appropriate offset is
  23. ;        added and the value is placed in register C
  24. ;    h) Silent option added to update clock for DST and leap year
  25. ;        without sending date/time to CRT
  26. ;    i) Command line option will continuously display the date and
  27. ;        time until any key is struck
  28. ;
  29. ;
  30. ;    Thanks to Ludo Van Hemelryck for code suggestions and for
  31. ;        detailed commenting much of the code.
  32. ;
  33. ;    Thanks to Terry Hazen for code suggestions and especially 
  34. ;        for creating the CFG file!
  35. ;
  36. ; CLOCK ver 2.1 16-Nov-92   Biff Bueffel
  37. ;
  38. ;    a) Uses PDAT.REL for routines to print time and date.
  39. ;    b) Added elapsed time option(including hundredths of a
  40. ;        second). Code shamelessly stolen from Terry
  41. ;        Hazen's ELAPSED who borrowed much of it from
  42. ;        Gene Pizzetta. Thanks, Terry for your permission
  43. ;        to use the code.
  44. ;
  45. ; CLOCK ver 2.2 15-Mar-93   Biff Bueffel
  46. ;
  47. ;    Adds ability to place time data on the 25th line of
  48. ;          a H19 terminal. Heath or ANSI(VT-52) modes possible.
  49. ;          May work on other terminals but not tested. Use
  50. ;          CFG file to change strings for 25th line and
  51. ;          saving cursor position. 
  52. ;
  53. ;*********************************************************************
  54. ;
  55. ; Clock base port is 0a0h for CDR Super 89
  56. ;             080h for Anapro clock
  57. ;             0e0h for Kenmore clock
  58. ;
  59. ; TENTHS = base port + 1     Hundreths/Tenths of Seconds
  60. ; SEC     = base port + 2
  61. ; MIN     = base port + 3
  62. ; HRS     = base port + 4
  63. ; DOW     = base port + 5         Day of Week
  64. ; DAY     = base port + 6
  65. ; MON     = base port + 7
  66. ; YEAR     = base port + 9      RAM for 10ths and 100ths of Second
  67. ;
  68. ; FLAGS     = base port + 14     DST and Leap year Flags
  69. ;
  70. ; CLKSTS = base port + 20     Status bit
  71. ; CLKGO     = base port + 21     GO command
  72. ;
  73. ;*************************************************************
  74. ;
  75. ; ZCPR3 utility type.  Configure your assembly/linking alias in one of
  76. ; the following ways to produce the type of file desired.
  77. ;
  78. ; Set ZTYPE to 1 to produce a type 1 utility loading and executing at
  79. ; 100h under any version of ZCPR3:
  80. ;
  81. ;        ZMAC CLOCK;ZML CLOCK
  82. ;    or    Z80ASM CLOCK/M;SLRNKP CLOCK/N,/A:100/J,CLOCK,/E
  83. ;
  84. ;
  85. ; Set ZTYPE to 3 to produce a type 3 utility loading and executing at
  86. ; a specified address such as 8000h under ZCPR33+:
  87. ;
  88. ;        ZMAC CLOCK;ZML CLOCK /A:8000
  89. ;    or    Z80ASM CLOCK/M;SLRNKP CLOCK/N,/A:8000/J,CLOCK,/E
  90. ;
  91. ;
  92. ; Set ZTYPE to 4 to produce a type 4 utility loading under the CCP
  93. ; or protected RSX and executing only under ZCPR34+:
  94. ;
  95. ;        ZMAC CLOCK;ZML CLOCK,T4LDR.HDR/P
  96. ;
  97. ; Rather than re-editing this file each time ZTYPE is changed,
  98. ; ask for the type at assembly time:
  99. ;
  100.     .accept    ' - Configure CLOCK.REL for ZCPR3 Type 1, 3 or 4? ',type
  101.  
  102.       if    (type=4)
  103. ztype    equ    4
  104.  
  105.     public    $memry    ; End of code
  106.  
  107.       else
  108.        if    (type=3)
  109. ztype    equ    3
  110.        else
  111. ztype    equ    1        ; Default is type 1 utility
  112.        endif
  113.       endif
  114. ;
  115. ;*********************************************************************
  116. ;
  117.  
  118.  
  119. vers    equ    22
  120.  
  121.  
  122. lpflg:        equ    00000001b    ;Flag that this is a leap year
  123. yokflg:        equ    00000010b    ;Flag that the year has been fixed
  124. DSTflg:        equ    00000100b    ;Flag enabling Daylight savings time
  125. flgDST:        equ    00001000b    ;Flag daylight savings time in effect
  126. setflg:        equ    01010000b    ;Flag that the clock has been set
  127. okmask:        equ    11110000b    ;Mask for clock ok flag
  128.  
  129. lpbit:        equ    0        
  130. okbit:        equ    1        
  131. DSTbit:        equ    2        
  132. bitDST:        equ    3        
  133.  
  134.  
  135. bdos    equ    5
  136. tbuff    equ    80h
  137.  
  138. cr    equ    0dh    ; carriage return
  139. lf    equ    0ah    ; line feed
  140. bell    equ    07h    ; Bell
  141. bs    equ    08h    ; backspace
  142. esc    equ    1bh    ; escape
  143.  
  144.     .request    pdat
  145.     ext    colon,pdat1,pday1,ptim1,ptim3,space
  146.  
  147.     .request    nztim
  148.     ext    bc2bi,bi2bc
  149.  
  150.     .request    zslib
  151.     ext    isbcdt
  152.  
  153.     .request    vlib
  154.     ext    curon,curoff,z3vinit,at
  155.  
  156.     .request    z3lib
  157.     ext    getmsg
  158.  
  159.     .request    syslib
  160.     ext    caps,condin,cout,crlf,eprint,epstr
  161.     ext    pa2hc,phl4hc
  162.  
  163.     public    envptr
  164.  
  165. ;*********************************************************************
  166.  
  167. entry:     
  168.     if    ztype=3
  169.     jr    start0    ; Executes only under ZCPR33+
  170.     defb    0    ; Filler
  171.      else
  172.     jp    start    ; T4LDR has already tested for Z34
  173.      endif
  174.  
  175. z3env:    defb    'Z3ENV'    ; ZCPR3 indentifier
  176.     defb    ztype    ; Default is type 1 utility
  177. envptr:    defw    0    ; Z3ENV address
  178.  
  179.     iff    ztype=4
  180. load:    defw    entry    ; ENTRY load address for type 3, dummy for type 1
  181.     else
  182. $memry    defw    0    ;   Code size for type 4 filled in by linker here
  183.     endif
  184.  
  185. ;
  186. civflg:    defb    0        ; 0=military time, NZ=civilian time
  187. ;
  188. port:    defb    0a0h        ; 0a0h for CDR Super 89
  189.                 ; 080h for Anapro clock
  190.                 ; 0e0h for Kenmore clock
  191.  
  192. timreg:    defb    18        ; First storage record
  193.  
  194. ; Configures Heath/Zenith H19 terminal(or others?) for 25th line use
  195. ;
  196. line25:    defb    0        ; ffh = put time on 25th line
  197. enable:    defb    esc,'x','1',0,0    ; turn on 25th line
  198.                 ; MUST remain a 5 byte string.
  199.                 ; Unused bytes should be 0
  200.                 ; = esc,'[','1','h' if h19 ansi
  201.     defb    0        ; do not change
  202. ;
  203. disabl:    defb    esc,'y','1',0,0    ; turn off 25th line
  204.                 ; MUST remain a 5 byte string.
  205.                 ; Unused bytes should be 0
  206.                 ; = esc,'[','1','l' if h19 ansi
  207.     defb    0        ; do not change
  208. ;
  209. cursav:    defb    esc,'j',0,0    ; save current cursor position
  210.                 ; MUST remain a 4 byte string.
  211.                 ; Unused bytes should be 0
  212.                 ; = esc,'[','s' if h19 ansi
  213.     defb    0        ; do not change
  214. ;
  215. curret:    defb    esc,'k',0,0    ; return to saved cursor position
  216.                 ; MUST remain a 4 byte string.
  217.                 ; Unused bytes should be 0
  218.                 ; = esc,'[','u' if h19 ansi
  219.     defb    0        ; do not change
  220. ;
  221. cfg:    db    'CLOCK'
  222.     db    vers/10+'0',vers mod 10+'0'
  223.     ds    cfg+8-$,' '    ; Space for 8 bytes
  224.     db    0        ; Termination
  225. ;
  226.  
  227. ; Starting point for type 3
  228. ;
  229.      if    ztype=3
  230. start0:    ld    hl,0        ; Point to warm boot entry
  231.     ld    a,(hl)        ; Get the opcode
  232.     di            ; Protect against interrupts
  233.     ld    (hl),0c9h    ; Replace warm boot with a return
  234.     rst    0        ; 'CALL 0' pushes retadr onto stack
  235. ;
  236. retadr:    ld    (hl),a        ; Restore original opcode at 0
  237.     dec    sp        ; Phony push to set stack pointer to
  238.     dec    sp        ;    to point to the value of retadr
  239.     pop    de        ; DE = real retadr
  240. ;
  241.     ei            ; Enable interrupts
  242.     ld    hl,retadr    ; This is where we should be
  243.     or    a        ; Clear CARRY
  244.     sbc    hl,de        ; Are we actually there?
  245.     jp    z,start        ; Yes, begin real code
  246. ;
  247. ; We're not where we should be, so quit with error message
  248. ;
  249.     ld    hl,nz33msg-retadr ; Offset to message
  250.     add    hl,de
  251.     ex    de,hl        ; Message pointer in DE
  252.     ld    c,9
  253.     jp    bdos        ; Quit via BDOS print string function
  254. ;
  255. nz33msg:db    'Not Z33+$'    ; Abort message if not Z33-compatible
  256.      endif    ; ztype=3
  257.  
  258. ;
  259.  
  260. ;======================================================================
  261. ;
  262. signon:    call    eprint
  263.     defb    CR,LF,'[CLOCK vers '
  264.     defb    vers/10+'0','.',vers mod 10+'0'
  265. ;
  266.     db    ' - Type '
  267.     db    ztype+30h
  268.     db    ' at ',0
  269.     ld    hl,entry    ; Get load address
  270.     call    phl4hc        ; Display it
  271.     call    eprint
  272.     db    'h]'
  273. ;
  274.     defb    CR,LF,LF
  275.     defb    'Clock Help:',CR,LF,LF
  276.     defb    ' CLOCK                    --  Show the date and time',CR,LF
  277.     defb    ' CLOCK 10-SEP-92          --  Set the date',CR,LF
  278.     defb    ' CLOCK 10/SEP/92 13:20    --  Set the date and time',CR,LF
  279.     defb    ' CLOCK 10-SEP-92 13:20 Y  --  Set the date and time '
  280.     defb    'and turn on the DST option',CR,LF
  281.     defb    ' CLOCK 10/SEP/92 13:20 N  --  Set the date and time '
  282.     defb    'and turn off the DST option',CR,LF
  283.     defb    ' CLOCK 13:20    [Y/N-DST] --  Set the hour and minute ',CR,LF
  284.     defb    ' CLOCK 13:20:33 [Y/N-DST] --  Set the time(including '
  285.     defb    'seconds) NOW!',CR,LF
  286.     defb    ' CLOCK C                  --  Continuously display time'
  287.     defb    ' - strike a key to exit',CR,LF
  288.     defb    ' CLOCK M                  --  Toggle Military/Civilian time'
  289.     defb    CR,LF
  290.     defb    ' CLOCK Q                  --  Read and update clock quietly'
  291.     defb    CR,LF,0
  292.     ld    a,(z33flg)
  293.     or    a
  294.     jp    z,sign0
  295.     call    eprint
  296.     defb    ' CLOCK S                  --  Store current time in Z3'
  297.     defb    ' registers',CR,LF
  298.     defb    ' CLOCK E                  --  Display elapsed time since'
  299.     defb    ' option S',CR,LF,0
  300. sign0:    ld    a,(line25)
  301.     or    a
  302.     jr    z,sign1
  303.     call    eprint
  304.     defb    ' CLOCK D                  --  Disable(clear) the 25th line'
  305.     defb    ' on the H19 terminal',CR,LF,0
  306. sign1:    call    eprint
  307.     defb    ' CLOCK ? or /             --  Display the clock registers '
  308.     defb    'and HELP text',CR,LF,LF,0
  309.     ret
  310.  
  311. ;
  312. ;
  313.  
  314. start:    ld    (stack),sp    ; save old stack pointer
  315.     ld    sp,stack    ; set up new one
  316.  
  317. ; Initialize data areas 
  318.  
  319.     xor    a
  320.     ld    (dtonly),a    ; be sure date_only is off
  321.     ld    (cont),a    ; assure continuous time is off
  322.     ld    (z33flg),a    ; No to Z3
  323.  
  324.     ld    ix,(envptr)    ; point to the Z3 ENV
  325.     ld    a,(ix+3)    ; we should find a Z here
  326.     cp    'Z'
  327.     jr    nz,star0    ; not ZCPR3
  328.     ld    a,0ffh        ;
  329.     ld    (z33flg),a    ; save the yes z33
  330.     ld    hl,(envptr)    ; point to Z3 ENV
  331.     call    z3vinit        ; initialize z3 and vlib extended TCAP
  332.  
  333. ;
  334.  
  335. star0:     call    readclk        ; read the clock
  336. ;
  337.      call    z,BCDchk    ; if no error, verify if readings legal
  338. ;
  339.     ld    a,0        ; Clear all flags in flgbyte
  340.     jr    z,star1        ;  if all BCD values within bound
  341. ;
  342.     set    7,a        ; set flgbyte to illegal reading of BCD values
  343.  
  344. star1:    ld    (flgbyte),a    ; save this for later use
  345.  
  346.     ld    a,(tbuff)    ; A = <COMTAIL character count>
  347.     or    a
  348.     jr    nz,star2    ;
  349.     call    PrtDate        ; if none, just print the time/date
  350.     jp    exit        ;  and quit
  351. ;
  352. star2:    ld    (CmTail),A    ; Save COMTAIL character count
  353.     ld    hl,tbuff+1    ; Point to 1st character of COMTAIL
  354.     ld    (CMTptr),hl    ; Store pointer
  355.  
  356.     ld    a,(flgbyte)
  357.     ld    c,a        ; C = <Flag byte>
  358.  
  359.      call    eatspc        ; Jump a 'space' in COMTAIL
  360.                 ;  (If not a ' ' or if an illegal char,
  361.                 ;   return to CCP)
  362. ;
  363.     ld    hl,(CMTptr)    ; HL =.<Command Tail char.>
  364.  
  365.     ld    a,(z33flg)    ; running under ZCPR
  366.     or    a
  367.     jr    z,star3        ; NO!
  368.     ld    a,'S'
  369.     cp    (hl)        ; Store time option?
  370.     jp    z,stortim    
  371.     ld    a,'E'
  372.     cp    (hl)        ; Elapsed time option?
  373.     jp    z,elapse
  374.  
  375. star3:    ld    a,(hl)        ; 
  376.     call    caps        ; Convert any lower case to upper case
  377.     cp    '?'
  378.     jp    z,ClkHlp    ;  if so, print registers plus help message
  379.     cp    '/'        ; Z3 help request
  380.     jp    z,ClkHlp    
  381.  
  382.     cp    'Q'        ; Quiet command?
  383.     jp    z,exit        ; Clock was read on entry so exit silently
  384.     cp    'D'        ; Disable 25th line?
  385.     jr    nz,star4
  386.     ld    a,(line25)    ; be sure 25th line is enabled
  387.     or    a        ;
  388.     jp    z,exit        ; No
  389.     ld    hl,disabl    ; Point to the string
  390.     call    epstr        ; send it
  391.  
  392.     jp    exit
  393.  
  394. star4:    cp    'M'        ; Military/Civilian toggle
  395.     jr    nz,PrCT        ;
  396.     ld    a,(civflg)    ; get the current setting
  397.     or    a        ;
  398.     jr    z,makeCv    ; if 0 then Military go make it Civilian
  399.     xor    a        ;  was Civilian so make Military
  400.     ld    (civflg),a    ; 
  401.     call    PrtDate        ; go print the date/time
  402.     jp    exit        ;
  403. makeCv:    ld    a,0ffh        ;
  404.     ld    (civflg),a    ; make it civilian time
  405.     call    PrtDate        ;  go print the date/time
  406.     jp    exit        ;
  407.  
  408. PrCT:    cp    'C'        ; Continuous time display option
  409.     jr    nz,ParCT1    ; No
  410.     ld    a,0ffh        ;
  411.     ld    (cont),a    ; Store continous flag
  412.  
  413.     call    curoff        ; turn cursor off if Z3 with extended TCAP
  414.  
  415.     ld    a,(line25)    ;
  416.     jr    z,PrCT1        ;
  417.     ld    hl,cursav    ; save current cursor position
  418.     call    epstr        ;
  419.  
  420. PrCT1:    call    PrtDate        
  421. contin:    call    readclk    
  422.     call    PrtDt1    
  423.     call    condin        ; Any key from the keyboard?
  424.     jr    z,contin    ; No then continue updating time
  425.  
  426.     call    curon        
  427.  
  428.     ld    a,(line25)    
  429.     or    a        
  430.     jp    z,exit        
  431.     ld    hl,curret    ; return to saved cursor position 
  432.     call    epstr         
  433.     jp    exit        
  434.  
  435. ;
  436. ParCT1:     call    CTLDig        ; Get a digit from COMTAIL
  437.                 ;  (If not a decimal digit or if an
  438.                 ;   illegal char, return to CCP)
  439. ;
  440.     ld    d,a        ; D = <Digit from COMTAIL (MS)>
  441.      call    CTLCha        ; Get next character from COMTAIL
  442.                 ;  (If illegal, return to CCP)
  443.     bit    6,c        ; Was it a decimal digit?
  444.     jr    nz,ParCT2    ;  if so, process it
  445. ;
  446.     ld    e,d        ;  if not, move MS to LS
  447.     ld    d,0        ;   position and clear MS
  448.     jr    ParCT3        ;   (Single digit Day of Month)
  449. ;
  450. ParCT2:    ld    e,a        ; E = <Digit from COMTAIL (MS)>
  451.      call    CTLCha        ; Get next character from COMTAIL
  452.                 ;  (If illegal, return to CCP)
  453. ;
  454. ParCT3:    bit    3,c        ; Was it a '-' or '/'?
  455.     jr    nz,ParDat    ;  if so, process DE (Day of Month)
  456. ;
  457.     bit    7,c        ; Illegal readings or none?
  458.     jp    nz,ClkHlp    ;  if so, clock broken or not set
  459.                 ;  (Return to CCP)
  460.     bit    2,c        ; Was it a ':'?
  461.     jp    z,SyntErr    ;  if not, syntax error
  462.                 ;  (Return to CCP)
  463.     jp    StoHM        ; Process a ':'
  464. ;
  465. ; Store day of month as a BCD.
  466.  
  467. ParDat:    ld    hl,dayBCD
  468.      call    DIGtoBCD    ; Convert DE into BCD and save at (HL)
  469. ;
  470. ; Identify the Month # (return it in B).
  471.  
  472.      call    cpyCTL        ; Copy alpha chars from COMTAIL
  473.                 ;  to Dbuf (Return on separator)
  474.                 ;  (If illegal char, return to CCP)
  475. ;
  476.     bit    3,c        ; Was it a '-' or '/'?
  477.     jp    z,SyntErr    ;  if not, syntax error
  478.                 ;  (Return to CCP)
  479.     ld    b,1
  480.     ld    de,Dbuf        ; DE =.<Scratchpad base>
  481.     ld    hl,montbl    ; HL =.<1st month table entry>
  482.  
  483. ParDT0:     ld    a,(de)        ; get a letter
  484.     cp    (hl)        ; does it match?
  485.     jr    z,ParDT1    ; yes
  486.     xor    00100000b    ; reverse case of letter in A
  487.     cp    (hl)        ; does it match now?
  488. ;
  489.     jr    nz,ParDT2    ;  if no match
  490. ;
  491. ParDT1:    inc    de        ; Bump pointers
  492.     inc    hl        ;      "
  493.     ld    a,(de)
  494.     or    a        ; End of string?
  495.     jr    z,ParDT3    ;  if so, found match
  496. ;
  497.     jr    ParDT0        ; Check next character...
  498. ;
  499. ParDT2:    inc    b        ; Try next 'montbl' entry
  500.     ld    a,13
  501.     cp    b        ; > 12 ?
  502.     jp    z,SyntErr    ;  if so, syntax error (overflow)
  503.                 ;  (Return to CCP)
  504.     push    bc        ; Save register
  505.  
  506.     ld    bc,20
  507.     xor    a
  508.     cpir            ; HL =.<terminating 0> + 1
  509.  
  510.     pop    bc        ; Restore register
  511.  
  512.     ld    de,Dbuf        ; DE =.<Scratchpad base>
  513.     jr    ParDT0        ; Compare strings...
  514. ;
  515. ParDT3:    ld    d,0        ; Assume single digit month
  516.     ld    a,b        ; A = <Month #> (binary)
  517.     cp    10
  518.     jr    c,StoMo        ;  if A < 10
  519. ;
  520.     ld    d,1        ; Two digit month
  521.     sub    10        ; A = <unit digit>
  522.  
  523. StoMo:    ld    e,a        ; DE = <2-digit month #>
  524. ; Store month as a BCD.
  525.  
  526.     ld    hl,monBCD
  527.      call    DIGtoBCD    ; Convert DE into BCD and save at (HL)
  528. ;
  529.      call    CTLDig        ; Get a digit from COMTAIL
  530.                 ;  (If not a decimal digit or if an
  531.                 ;   illegal char, return to CCP)
  532. ;
  533.     ld    d,a        ; D = <MS year digit>
  534.      call    CTLDig        ; Get a digit from COMTAIL
  535.                 ;  (If not a decimal digit or if an
  536.                 ;   illegal char, return to CCP)
  537. ;
  538.     ld    e,a        ; E = <LS year digit>
  539.  
  540.  
  541. ; Store year as a BCD.
  542.  
  543.     ld    hl,yrBCD
  544.      call    DIGtoBCD    ; Convert DE into BCD and save at (HL)
  545. ;
  546.     ld    a,(monBCD)
  547.     cp    10h        ; 2-digit month?
  548.     jr    c,StorDa    ;  if not
  549. ;
  550.     sub    6        ; Convert 2-digit BCD to binary value
  551.  
  552. StorDa:    ld    hl,lentbl-1    ; HL =.<month length table - 1>
  553.     add    a,l
  554.     ld    l,a
  555.     jr    nc,StorD1    ;  if not crossing page boundary
  556. ;
  557.     inc    h        ; Next page
  558.  
  559. ; HL =.<Month length>
  560. StorD1:    ld    a,(dayBCD)
  561.     cp    (HL)        ; Day of month legal?
  562.     jr    c,CalDOW    ;  accept
  563. ;
  564.     jr    z,CalDOW    ;  accept
  565. ;
  566.     cp    29h        ; Could it be a 29th?
  567.     jp    nz,DtErr    ;  if not, diagnostic and return
  568.                 ;       (to CCP)
  569.  
  570.     ld    hl,yrBCD
  571.     ld    A,(hl)        ; A = <Year (BCD)>
  572.     and    11110000B    ; A = <Year's MS-digit>
  573.     rrca            ; Move to LS-nibble
  574.     rrca
  575.     rrca
  576.     rrca
  577.     inc    a        ; Add 1, in case A = 0, and
  578.     ld    b,a        ;  save in B
  579.  
  580.     ld    a,(hl)        ; A = <Year (BCD)>
  581.     and    00001111B    ; A = <Year's LS-digit>
  582.  
  583. LpYrCk:    add    a,10
  584.     djnz    LpYrCk
  585. ;
  586.     sub    10        ; Adjust for extra 10
  587.                 ; A = <Year (binary)>
  588.     and    00000011B    ; Multiple of 4 ?
  589.     jp    nz,DtErr    ;  if not leap year, display
  590.                 ;   diagnostic and return
  591.                 ;       (to CCP)
  592. CalDOW:    ld    a,c
  593.     ld    (flgbyte),a    ; Save C
  594.  
  595.     ld    a,(monBCD)
  596.      call    bc2bi        ; Convert BCD to binary
  597. ;
  598.     ld    e,a        ;  and save in E
  599.     dec    a
  600.     sla    a        ; A = <Offset in 'DOYtbl'>
  601.  
  602.     ld    hl,DOYtbl    ; HL =.<Day of year (for month) table>
  603.                 ;      (Word format)
  604.     add    a,l
  605.     ld    l,a
  606.     jr    nc,ClDOW0    ;  if not crossing page boundary
  607. ;
  608.     inc    h        ; Next page
  609.  
  610. ; HL =.<Day of year for month (in table)>
  611. ClDOW0:    ld    c,(hl)        ; C = <LS-byte, day of year (for month)>
  612.     inc    hl
  613.     ld    b,(hl)        ; B = <MS-byte, day of year (for month)>
  614.     push    bc        ; Save register
  615.  
  616.     ld    a,(dayBCD)
  617.      call    bc2bi        ; Convert BCD to binary
  618. ;
  619.     ld    c,a        ;  and save in C
  620.     ld    a,(yrBCD)
  621.      call    bc2bi        ; Convert BCD to binary
  622. ;
  623.     ld    d,a        ;  and save in D
  624.     and    00000011B    ; Multiple of 4 ?
  625.     jr    nz,ClDOW1    ;  if not a leap year
  626. ;
  627.     ld    a,e        ; A = month (binary)
  628.     cp    3        ; March to December ?
  629.     jr    nc,ClDOW2    ;  if so, do not decrement
  630. ;
  631. ClDOW1:    dec    c        ; DOM, Jan-Feb, in leap years
  632.  
  633. ClDOW2:    pop    hl        ; HL = <Day of year for month>
  634.     ld    a,l
  635.     add    a,c        ; Add day of month
  636.     ld    l,a
  637.     jr    nc,ClDOW3    ;  if not crossing page boundary
  638. ;
  639.     inc    h        ; Next page
  640.  
  641. ; HL = <Day of year for date>
  642. ClDOW3:    ld    a,d        ; D = <Year (binary)>
  643.     cp    84
  644.     jr    nc,ClDOW4    ;  if '84 or later
  645. ;
  646.     add    a,100        ; If not, add a century
  647.     ld    d,a        ;  and save. (D =< 84)
  648.  
  649. ClDOW4:    ld    a,84        ; A = <Pivot year>
  650.                 ;     (Starting on Sunday)
  651.  
  652. ; Compute number of days between date and pivot year.
  653. ; (Accumulate in HL)
  654.  
  655. ClDOW5:    cp    d
  656.     jr    z,ClDOW7
  657. ;
  658.     ld    bc,365        ; bc = <year lenght>
  659.     ld    e,a        ; Save A
  660.     and    00000011B    ; Multiple of 4 ?
  661.     jr    nz,ClDOW6    ;  if not a leap year
  662. ;
  663.     inc    bc        ; If it is, add a day
  664.  
  665. ClDOW6:    add    hl,bc        ; Accumulate days
  666.     ld    a,e        ; Retrieve year, and
  667.     inc    a        ;  prepare to add next one
  668.     jr    ClDOW5
  669. ;
  670. ClDOW7:    ld    bc,1
  671.     add    hl,bc        ; = <inc  HL>
  672.     ld    bc,7        ; bc = <1 week>
  673.  
  674. ClDOW8:    ld    a,h
  675.     or    a
  676.     jr    nz,ClDOW9
  677. ;
  678.     ld    a,l
  679.     cp    8
  680.     jr    c,StrDOW    ;  if less than 1 week
  681. ;
  682. ClDOW9:    sbc    hl,bc        ; Subtract 1 week
  683.     jr    ClDOW8        ; Loop ...
  684. ;
  685. ; Store day of week (binary = BCD).
  686.  
  687. StrDOW:    ld    hl,dowBCD
  688.     ld    (hl),a        ; Store day of week
  689.  
  690.     ld    a,(CmTail)    ; A = <COMTAIL character count >
  691.     or    a        ;
  692.     jr    nz,ParTim    ; more to come to jump
  693.                 ;
  694.  
  695. ; See if only wants to set the date
  696.  
  697.     ld    a,0ffh        ;
  698.     ld    (dtonly),a    ; we only want to set the date
  699.     jp    SetClk        ; go write it
  700.  
  701.  
  702.  
  703. ParTim:     call    eatspc        ; Jump a 'space' in COMTAIL
  704.                 ;  (If not a ' ' or if an illegal char,
  705.                 ;   return to CCP)
  706. ;
  707.  
  708.     ld    a,(flgbyte)
  709.     ld    c,a        ; C = <flgbyte>
  710.  
  711.      call    CTLDig        ; Get a digit from COMTAIL
  712.                 ;  (If not a decimal digit or if an
  713.                 ;   illegal char, return to CCP)
  714. ;
  715.     ld    d,a
  716.      call    CTLCha        ; Get next character from COMTAIL
  717.                 ;  (If illegal, return to CCP)
  718. ;
  719.     bit    6,c        ; Is it (another) digit?
  720.     jr    nz,PaTm1    ;  if so, process it
  721. ;
  722.     ld    e,d        ;  if not, move MS to LS
  723.     ld    d,0        ;   position and clear MS
  724.     jr    ColChk        ;   (Single digit Hour)
  725. ;
  726. PaTm1:    ld    e,a
  727.      call    CTLCha        ; Get next character from COMTAIL
  728.                 ;  (If illegal, return to CCP)
  729. ;
  730. ColChk:    bit    2,c        ; Is it a ':'?
  731.     jp    z,SyntErr    ;  if not, syntax error
  732.                 ;  (Return to CCP)
  733. ; Store hour as a BCD.
  734.  
  735. StoHM:    ld    hl,hrBCD
  736.      call    DIGtoBCD    ; Convert DE into BCD and save at (HL)
  737. ;
  738.      call    CTLDig        ; Get a digit from COMTAIL
  739.                 ;  (If not a decimal digit or if an
  740.                 ;   illegal char, return to CCP)
  741. ;
  742.     ld    d,a
  743.      call    CTLDig        ; Get a digit from COMTAIL
  744.                 ;  (If not a decimal digit or if an
  745.                 ;   illegal char, return to CCP)
  746. ;
  747.     ld    e,a
  748. ;
  749. ; Store minutes as a BCD.
  750.  
  751.     ld    hl,minBCD
  752.      call    DIGtoBCD    ; Convert DE into BCD and save at (HL)
  753. ;
  754.      call    CTLNxt        ; Get next character from COMTAIL,
  755.                 ;  if some remain
  756.                 ;  (on illegal char., return to CCP)
  757.     jr    nz,StHM1    ;  if COMTAIL empty
  758. ;
  759.     bit    4,c        ; Is it a ' '?
  760.     jr    nz,StHM1    ;  if so, gobble it
  761. ;
  762.     bit    2,c        ; Is it a ':'?
  763.     jp    z,SyntErr    ;  if not, syntax error
  764.                 ;  (Return to CCP)
  765. ;
  766.      call    CTLDig        ; Get a digit from COMTAIL
  767.                 ;  (If not a decimal digit or if an
  768.                 ;   illegal char, return to CCP)
  769. ;
  770.     ld    d,a
  771.      call    CTLDig        ; Get a digit from COMTAIL
  772.                 ;  (If not a decimal digit or if an
  773.                 ;   illegal char, return to CCP)
  774. ;
  775.     ld    e,a
  776.     jr    StrSEC
  777. ;
  778. StHM1:    ld    de,0
  779. ; Store seconds as a BCD.
  780.  
  781. StrSEC:    ld    hl,secBCD
  782.      call    DIGtoBCD    ; Convert DE into BCD and save at (HL)
  783. ;
  784. DSTtog:     call    CTLNxt        ; Get next character from COMTAIL,
  785.                 ;  if some remain
  786.                 ;  (on illegal char., return to CCP)
  787. ;
  788.     jr    nz,CkVals    ;  if COMTAIL empty
  789. ;
  790.     bit    4,c        ; Is it a ' '?
  791.     jr    nz,DSTtog    ;  if so, gobble it...
  792. ;
  793.     bit    5,c        ; Is it an alpha char.?
  794.     jp    z,SyntErr    ;  if not, syntax error
  795.                 ;  (Return to CCP)
  796.     ld    hl,flgBCD
  797.     cp    'Y'
  798.     jr    nz,DSTtg1
  799. ;
  800.     ld    a,(hl)
  801.     OR    00000100B    ; Merge-in DST flag
  802.     ld    (hl),a
  803.     jr    CkVals
  804. ;
  805. DSTtg1:    cp    'N'        ; Only other legal answer?
  806.     jp    nz,SyntErr    ;  if not, syntax error
  807.                 ;  (Return to CCP)
  808.     ld    a,(hl)
  809.     and    11111011B    ; Reset DST flag
  810.     ld    (hl),a
  811.  
  812. CkVals:    ld    a,c
  813.     ld    (flgbyte),a
  814.      call    BCDchk        ; verify if readings legal
  815. ;
  816.     jp    nz,DtErr    ;  if a value out of bound,
  817.                 ;   diagnostic and return
  818.                 ;   (to CCP)
  819. SetClk:     call    writclk        ;
  820. ;
  821.     jr    z,StClk1
  822. ;
  823.      call    eprint        ; Display following string on console
  824. ;
  825.     defb    'Unable to Set the Clock',CR,LF,0
  826.  
  827.     jp    ClkHlp        ; Give help message
  828. ;
  829. StClk1:     call    readclk        ; read the clock
  830. ;
  831.     jp    nz,ClkHlp    ;  if Clock read error
  832.                 ;  (Return to CCP)
  833.     xor    a
  834.     ld    (flgbyte),a
  835.      call    PrtDate        ; Print the time/date
  836. ;
  837.     ld    a,(flgBCD)
  838.     and    00000100B    ; Check DST bit
  839.     jr    z,StClk2    ;  if DST off
  840. ;
  841.      call    eprint        ; Display following string on console
  842. ;
  843.     defb    CR,LF,'Daylight Savings Time '
  844.     defb    'option is enabled.',CR,LF,0
  845.  
  846. ;
  847. StClk2:    ld    a,(secBCD)    ; A = <BCD seconds>
  848.     or    a
  849.     jr    nz,exit        ;  if set to some value, exit
  850.                 ;   if not, hold the clock ...
  851.  
  852.      call    eprint        ; Display following string on console
  853. ;
  854.     defb    CR,LF,'Hit <RETURN> to start clock',0
  855.  
  856. ;
  857. ; Go wait for a <CR>. (Keep zero-ing CLKGO)
  858.  
  859. StClk3:    ld    b,21        ; point to CLKGO
  860.     call    portc        ; 
  861.     out (c),a        ; 0 -> (CLKGO)
  862.      call    condin        ; Check console for input
  863. ;
  864.     jr    z,StClk3    ;  if no input
  865. ;
  866.     cp    CR
  867.     jr    nz,StClk3    ;  if not a <CR>
  868. ;
  869.     ld    b,21        ; point to CLKGO
  870.     call    portc
  871.     out    (c),a        ; Load 0Dh -> (CLKGO)
  872.  
  873. exit:    ld    sp,(stack)    ;
  874.     ret            ; Back to CCP
  875. ;
  876. ClkErr:     call    eprint        ; Display following string on console
  877.     db    CR,LF,'The clock is not operational '
  878.     db    'or it has not been programmed.',CR,LF,bell,0
  879.     jr    exit
  880. ;
  881. ;      Subroutine PrtDate - Display date & time.
  882. ;
  883. PrtDate: ld    a,(flgbyte)
  884.     bit    7,a        ; Illegal readings or none?
  885.     jp    nz,ClkHlp    ;  if so, clock broken or not set
  886.                 ;  (Return to CCP)
  887.  
  888.  
  889. ; Day of week.
  890.  
  891.     ld    a,(line25)    ; H19 and 25th line desired?
  892.     or    a
  893.     jr    z,noline25
  894.     ld    hl,cursav    ; save current cursor position
  895.     call    epstr
  896.     ld    hl,enable    ; turn on 25th line
  897.     call    epstr
  898.     jr    PrtDt1
  899.  
  900. noline25:
  901.     call    eprint        ;
  902.     defb    lf,0        ;
  903.  
  904. PrtDt1:                ; Entry 2nd+ pass of continuous time
  905.  
  906.     ld    a,(line25)    ; H19 with line 25 desired?
  907.     or    a
  908.     jr    z,PrtDta
  909.     call    at        ; get to line 25, column 40
  910.     defb    25,40
  911.     jr    PrtDtb
  912.  
  913. PrtDta:    call    eprint
  914.     defb    cr,' ',0    ;
  915.  
  916. PrtDtb:    ld    de,yrBCD    ; point to the year
  917.     call    pday1        ; print DOW
  918.     call    space
  919.     call    space
  920.     call    pdat1        ; print the date
  921.     inc    de        ; skip dayBCD
  922.     call    space
  923.     call    space
  924. ;
  925.     ld    a,(civflg)    ; Get the Civilian time flag
  926.     or    a        ; Is it Military time?
  927.     jr    z,PrtDt2    ; Yes, not Civilian time!
  928.     call    ptim1        ; print time in 12 hour version
  929.     ld    a,'m'        ; add the m to p or a
  930.     call    cout
  931.     jr    timend        ; 
  932.  
  933. PrtDt2:    call    ptim3        ; print 24 hour format
  934.     call    space
  935. ;
  936. Timend:    ld    a,0        ; default value (must not be xor a!)
  937. cont:    equ    $-1        ;
  938.     or    a        ;
  939.     ret    nz        ; We are in continuous update mode 
  940.     ld    a,(line25)    ; H19 with 25th line wanted?
  941.     or    a
  942.     jr    z,contc        ; No?
  943.     ld    hl,curret    ; return to saved position
  944.     jp    epstr
  945.  
  946. contc:    jp    crlf
  947. ;
  948. ;
  949. ;
  950. ;      Subroutine CTLNxt - Get character from COMTAIL,
  951. ;                  if some remain.
  952. ;
  953. CTLNxt:    ld    a,(CmTail)    ; A = <COMTAIL character count>
  954.     or    a
  955.     jr    nz,CTLCha    ;  if more remain, get next
  956.                 ;   and return via "CTLCha"
  957.                 ;  (If illegal, do not return to Caller)
  958. ;
  959.     dec    a        ; A = 0FFh, Z-flg Reset
  960.     ret
  961. ;
  962. ;
  963. ;      Subroutine CTLCha - Get a COMTAIL character.
  964. ;             = "CTLChr" (but adds 1 Call level)
  965. ;
  966. CTLCha:     call    CTLChr        ; Get a COMTAIL character
  967.                 ;  (If illegal, do not return to Caller)
  968. ;
  969.     cp    a
  970.     ret
  971. ;
  972. ;
  973. ;      Subroutine CTLChr - Get a COMTAIL character.
  974. ;         Inputs:  (CMTptr) =.<Next COMTAIL character>
  975. ;              (CmTail) = <Remaining COMTAIL char. count>
  976. ;         Outputs: A = <Next COMTAIL character>
  977. ;              If COMTAIL character:    Return in C:
  978. ;                   ':'        x0000100B
  979. ;                '-' or '/'    x0001000B
  980. ;                   ' '        x0010000B
  981. ;                'A .... Z'    x0100000B
  982. ;                 or 'a .... z'
  983. ;                '0 .... 9'    x1000000B
  984. ;              (In all cases bit-7 of C is not altered)
  985. ;
  986. ;         Note:    If none of the above (illegal or no character),
  987. ;              CTLChr does not return to caller but exits via
  988. ;              SyntErr.
  989. ;
  990. ;
  991. CTLChr:    ld    a,c
  992.     and    10000000B
  993.     ld    c,a        ; All but MS-bit cleared
  994.  
  995.     ld    a,(CmTail)    ; A = <COMTAIL character count>
  996.     or    a
  997.     jp    z,SyntErr    ;  if none left
  998. ;
  999.     dec    a
  1000.     ld    (CmTail),a    ; Count this one done
  1001.  
  1002.     ld    hl,(CMTptr)    ; HL =.<Command Tail char.>
  1003.     ld    a,(hl)        ; A = <Command Tail char.>
  1004.     inc    hl        ; Bump pointer and
  1005.     ld    (CMTptr),hl    ;  save it
  1006.  
  1007.     set    2,c        ; Assume ':'
  1008.     cp    ':'
  1009.     ret    z        ;  if ':'
  1010. ;
  1011.     res    2,c        ; Not a ':',
  1012.     set    3,c        ;  assume a '-' or '/'
  1013.     cp    '-'
  1014.     ret    z        ;  if '-'
  1015. ;
  1016.     cp    '/'
  1017.     ret    z        ;  if '/'
  1018. ;
  1019.     res    3,c        ; Not a '-' nor '/',
  1020.     set    4,c        ;  assume a ' '
  1021.     cp    ' '
  1022.     ret    z        ;  if ' '
  1023. ;
  1024.     res    4,c        ; Not a ' ',
  1025.     set    6,c        ;  assume a digit
  1026.     cp    '0'
  1027.     jr    c,CTLCh1    ;  if not a decimal digit
  1028. ;
  1029.     cp    ':'
  1030.     ret    c        ;  if a decimal digit
  1031. ;
  1032. CTLCh1:    res    6,c        ; Not a digit,
  1033.     set    5,c        ;  assume an alphabetic char.
  1034.      call    caps        ; Convert A to upper case
  1035. ;
  1036.     cp    'A'
  1037.     jr    c,CTLCh2    ;  if not an alphabetic char.
  1038. ;
  1039.     cp    '['
  1040.     ret    c        ;  if an alphabetic character
  1041. ;
  1042. CTLCh2:    res    5,c        ; Not an alphabetic character
  1043.     jr    SyntErr
  1044. ;
  1045. ;
  1046. ;      Subroutine CTLDig - Get a decimal digit from COMTAIL.
  1047. ;         Outputs A = <digit>, if one found.
  1048. ;             (If COMTAIL char. is no digit, do not return)
  1049. ;
  1050. CTLDig:     call    CTLChr        ; Get a COMTAIL character
  1051.                 ;  (If illegal character, do not
  1052.                 ;   return to Caller)
  1053.     bit    6,c
  1054.     ret    nz        ;  if a decimal digit
  1055. ;
  1056.     jr    SyntErr        ; Do not return to Caller
  1057.  
  1058. ;
  1059. ;      Subroutine eatspc - Accept a 'space' in COMTAIL.
  1060. ;         Outputs - If not a 'space', do not proceed.
  1061. ;
  1062. eatspc:     call    CTLChr        ; Get a COMTAIL character
  1063.                 ;  (If illegal character, do not
  1064.                 ;   return to Caller)
  1065.     bit    4,c
  1066.     ret    nz        ;  if a ' '
  1067. ;
  1068.     jr    SyntErr        ; Do not return to Caller
  1069. ;
  1070. ;
  1071. ;      Subroutine cpyCTL - Copy alpha chars from COMTAIL to buffer.
  1072. ;                  Insert terminating 0 if next character
  1073. ;                  is not alphabetic.
  1074. ;
  1075. cpyCTL:    ld    de,Dbuf        ; DE =.<Scratchpad>
  1076. cpyCT1:     call    CTLCha        ; Get next character from COMTAIL
  1077.                 ;  (If illegal, do not return to Caller)
  1078. ;
  1079.     bit    5,c        ; Alphabetic character?
  1080.     jr    z,cpyCT2    ;  if not
  1081. ;
  1082.     ld    (de),a        ; Insert char. in Scratchpad
  1083.     inc    de        ;  and bump pointer
  1084.     jr    cpyCT1        ; Process next COMTAIL character
  1085. ;
  1086. cpyCT2:    xor    a
  1087.     ld    (de),a        ; Insert terminating 0
  1088.     ret
  1089. ;
  1090.  
  1091. DtErr:     call    eprint        ; Display following string on console
  1092. ;
  1093.     defb    CR,LF,'Incorrect Date or Time entry: ',0
  1094.  
  1095.     jr    FindErr
  1096. ;
  1097. SyntErr: call    eprint        ; Display following string on console
  1098. ;
  1099.     defb    CR,LF,'Date or Time MUST be entered as '
  1100.     defb    'DD-Mon-YY HH:MM only!',CR,LF,0
  1101.  
  1102. ;
  1103. FindErr: ld    hl,(CMTptr)    ; HL =.<Command Tail char.>
  1104.     ld    a,(CmTail)    ; A = <COMTAIL character count>
  1105.     or    a
  1106.     jr    nz,PrtErr    ;  if not the last one
  1107. ;
  1108.     inc    hl
  1109. PrtErr:    xor    a
  1110.     ld    (hl),a        ; Insert terminating 0
  1111.  
  1112.     ld    hl,tbuff+1    ; Point to 1st character of COMTAIL
  1113.      call    epstr        ; Print string HL is pointing at
  1114.  
  1115. ;
  1116. ClkHlp:      call    signon        ; Display signon screen
  1117.  
  1118. ; After printing help then show the clock register values
  1119. ;
  1120.  call    readclk            ; read the clock
  1121.     jp    nz,ClkErr    ;  if Clock read error
  1122.  
  1123.     call    eprint
  1124.     defb    ' Clock registers: ',CR,LF
  1125.     defb    '   ',0
  1126.  
  1127.     ld    a,(port)    ; get the base port
  1128.     ld    c,a        ; C = <Clock base port>
  1129.     ld    b,16        ; 16 registers to print
  1130.  
  1131. PrtReg:    in    a,(c)
  1132.     call    pa2hc        ; print BCD value in A
  1133.     call    space
  1134.     inc    c        ; next port
  1135.     djnz    PrtReg
  1136. ;
  1137.     ld    b,14        ; make it the FLAGS port
  1138.     call    portc        
  1139. ;
  1140. ChkChr:    in    a,(c)        ; Check charateristics and display
  1141.     and    01H    
  1142.     jr    z,ChkCh1
  1143. ;
  1144.      call    eprint        
  1145.      defb    ' NTL',0    ; Need to leap
  1146. ;
  1147. ChkCh1:    in    a,(c)        ;
  1148.     and    yokflg
  1149.     jr    z,ChkCh2
  1150. ;
  1151.      call    eprint        ;
  1152.      defb    ' YOK',0    ; Year ok bit has been updated
  1153. ;
  1154. ChkCh2:    in    a,(c)        ;
  1155.     and    DSTflg
  1156.     jr    z,ChkCh3
  1157. ;
  1158.      call    eprint        ; DST feature enabled
  1159.      defb    ' DST-opt',0
  1160. ;
  1161. ChkCh3:    in    a,(c)        ;
  1162.     and    flgDST
  1163.     jr    z,ChkCh4
  1164. ;
  1165.      call    eprint        ; We are on DST
  1166.      defb    ' DST',0
  1167. ;
  1168. ChkCh4:    call    crlf        ; Print CR,LF
  1169.  
  1170.     jp    exit
  1171. ;
  1172.  
  1173. ;
  1174. ;      Subroutine BCDchk - Verify if BCD readings are legal.
  1175. ;         Outputs If all readings legal, Z-flg Set,
  1176. ;             If not,            Z-flg Reset
  1177. ;
  1178. BCDchk:    ld    de,BCDmax
  1179.     ld    hl,timBCD
  1180.     ld    b,7
  1181.  
  1182. BCDck1:    ld    a,(de)        ; A = <BCD value>
  1183.     cp    (hl)
  1184.     jr    nc,BCDck2    ;  if within bounds
  1185. ;
  1186.     xor    a        ;  if not,
  1187.     dec    a        ;   clear Z-flg
  1188.     ret
  1189. ;
  1190. BCDck2:    inc    de        ; Look at next slot,
  1191.     inc    hl
  1192.     djnz    BCDck1        ;  if more to go...
  1193. ;
  1194.     xor    a        ; Set Z-flg
  1195.     ret
  1196. ;
  1197. ;
  1198. ;      Subroutine DIGtoBCD - Convert 2 digits into Binary Coded
  1199. ;                Decimal and store at (HL).
  1200. ;         Inputs  DE = <Input digits>
  1201. ;             HL =.<BCD storage buffer>
  1202. ;         Outputs BCD byte stored at (HL)
  1203. ;
  1204. DIGtoBCD: ld    a,e
  1205.     and    0FH        ; Extract lower nibble
  1206.     ld    e,a        ; E = <LS-digit>
  1207.     ld    a,d        ; D contains MS-digit
  1208.     and    0FH        ; Extract lower nibble
  1209.  
  1210.     sla    a        ; Shift to upper nibble
  1211.     sla    a
  1212.     sla    a
  1213.     sla    a
  1214.     or    e        ; Merge-in LS-digit
  1215.     ld    (hl),a        ; Store BCD
  1216.     ret
  1217.  
  1218. ;
  1219. ; routine to read the clock
  1220.  
  1221. readclk:ld    b,14
  1222.     call    portc
  1223.     in    a,(c)        ; get flags
  1224.     ld    e,a        ;save them
  1225.     and    okmask        ;mask the check bits        
  1226.     cp    setflg        ;has the clock been set?
  1227.     ret    nz        ; no. Return
  1228.  
  1229.     ld    d,10        ;10 times to try the read
  1230.  
  1231. readtry:ld    b,20        ; point to status port
  1232.     call    portc
  1233.     in    a,(c)        ;reset the counter changed bit
  1234.  
  1235.     ld    b,9        ; year offset
  1236.     call    portc        ; make it so
  1237.     in    a,(c)        ;
  1238.     ld    hl,yrBCD    ; point to the year storage
  1239.     ld    (hl),a        ; save it
  1240.     dec    c        ; decrement the port
  1241.     ld    b,7        ; read 7 registers
  1242.     inc    hl        ; point to month storage
  1243.  
  1244. rdloop:    dec    c        ; decrement the port
  1245.     ini            ; get the value
  1246.     jr    nz,rdloop    ; again if not zero
  1247.  
  1248.     ld    b,20        ; point to the clock status
  1249.     call    portc        ;
  1250.     in    a,(c)        ; counter bit different?
  1251.     or    a        ;
  1252.     jr    z,rdok        ; no.
  1253.  
  1254.     dec    d        ;decrement the attempt count
  1255.     jr    nz,readtry    ; try again if necessary
  1256.  
  1257.     xor    a        ;return error
  1258.     dec    a        ;clear the Z flag
  1259.     ret            ;
  1260.  
  1261. rdok:    ld    hl,monBCD    ; point to the month
  1262.     ld    a,(hl)        ;
  1263.     dec    hl        ;point to the year
  1264.     bit    okbit,e        ; okay?
  1265.     jr    z,fixyr        ; no. check it
  1266.  
  1267. ; The YEAROK bit is set, do we need to clear it?
  1268.  
  1269.     cp    7        ;July or later?
  1270.     jr    c,yearok    ; Nope. So jump.
  1271.     res    okbit,e        ;Make the bit 0
  1272.     jr    yearok        ;
  1273.  
  1274. ; YEAROK bit not set, 'repair' needed?
  1275.  
  1276. fixyr:    cp    7        ;July or later??
  1277.     jr    nc,yearok    ; yes. leave the bit clear
  1278.     ld    a,(hl)        ;get the year back
  1279.     add    a,1        ;increment it
  1280.     daa            ;fixup BCD
  1281.     ld    b,9        ; point to the hour
  1282.     call    portc        ;
  1283.     out    (c),a        ; store the updated year value
  1284.     ld    (hl),a        ;
  1285.     set    okbit,e        ;set the bit
  1286.  
  1287. ; Leap year or before?
  1288.  
  1289. yearok:    ld    a,(hl)        ;get the year
  1290.     and    0f0h        ;get the MSB
  1291.     rrca            ;into
  1292.     rrca            ; the
  1293.     rrca            ;  LSB
  1294.     rrca            ;   
  1295.     inc    a        ;make zero = 1
  1296.     ld    b,a        ;save the MSB
  1297.     ld    a,(hl)        ;get the year back
  1298.     inc    hl        ;HL--> monBCD
  1299.     and    00fh        ;just the LSB
  1300. ckleap:    add    a,10        ;add 10 for each MSB unit
  1301.     djnz    ckleap        ;and loop
  1302.     sub    a,10        ;correct the count
  1303.     and    3h        ;is it a leap year
  1304.     jr    z,isleap    ; yes. handle it
  1305.     cp    3        ;is it a PRE-Leap Year
  1306.     jr    nz,clrleap    ; no. clear the bit
  1307.  
  1308. ; Before a leap year?
  1309.  
  1310.     ld    a,(hl)        ;get the month
  1311.     cp    3        ;after march?
  1312.     jr    nc,setleap    ; yes. set the flag
  1313.  
  1314. ; turn the Leap year bit off
  1315.  
  1316. clrleap: res    lpbit,e        ;clear the bit
  1317.     jr    leapok
  1318.  
  1319. ; Leap year stuff
  1320.  
  1321. isleap:    ld    a,(hl)        ;get the month code
  1322.     inc    hl        ;HL --> dayBCD
  1323.     cp    3        ;is it March yet
  1324.     jr    c,setleap    ; no. just set the bit
  1325.     jr    nz,chkleap    ; (not March) fixup the counters
  1326.     ld    a,(hl)        ;get the date
  1327.     cp    1        ;is it after the first
  1328.     jr    nz,chkleap    ; yes. go fixup the counters
  1329.  
  1330. ; March 1=February 29
  1331.  
  1332.     bit    lpbit,e        ;do we need to lie?
  1333.     jr    z,leapok    ; no. we are done lying
  1334.     ld    a,29h        ;get the 29'th
  1335.     ld    (hl),a        ;store it
  1336.     dec    hl        ;HL --> monBCD
  1337.     ld    a,2        ;get Februrary
  1338.     ld    (hl),a        ;store it
  1339.     jr    leapok        ;keep the bit set
  1340.  
  1341.  
  1342. ; If Leap Year change the date
  1343.  
  1344. chkleap: bit    lpbit,e        ;do we need to leap?
  1345.     jr    z,leapok    ; no. all done here
  1346.     ld    a,(hl)        ;get the date
  1347.     sub    1        ;backup
  1348.     daa            ;fixup for BCD
  1349.     or    a        ;is this day zero
  1350.     jr    nz,monok    ; no. then the month is ok
  1351.     dec    hl        ;HL --> monBCD
  1352.     ld    a,(hl)        ;get the month
  1353.     sub    1        ;count it down
  1354.     daa            ;fixit up
  1355.     ld    (hl),a        ;update our copy
  1356.     ld    b,7        ; point to the month
  1357.     call    portc        ;
  1358.     out    (c),a        ;set the month
  1359.     bit    4,a        ;is the month > 10?
  1360.     jr    z,getday    ; no. go get the days
  1361.     sub    6        ;BCD to Binary
  1362. getday:    ld    hl,daytbl-3    ;point to our table (Jan Feb missing)
  1363.     add    a,l        ;compute the offset
  1364.     ld    l,a        ;
  1365.     jr    nc,gotday    ;
  1366.     inc    h        ;
  1367. gotday:    ld    a,(hl)        ;get the number of days in the month
  1368.     ld    hl,dayBCD    ;HL--> dayBCD
  1369.  
  1370. ; adjust the day
  1371.  
  1372. monok:    ld    (hl),a        ;update our storage
  1373.     ld    b,6        ; point to the day
  1374.     call    portc        ;
  1375.     out    (c),a        ;update the clock
  1376.     jr    clrleap
  1377.  
  1378. setleap: set    lpbit,e        ;set the leap year bit
  1379.  
  1380. ; Leap year stuff done so check out DST
  1381.  
  1382. leapok:    bit    DSTbit,e    ;are we enabled?
  1383.     jp    z,DSTdone    ; no. all done
  1384.  
  1385.     ld    hl,monBCD    ;HL --> Month
  1386.     ld    a,(hl)        ;get the month
  1387.     inc    hl        ;HL --> dayBCD
  1388.     cp    4        ;before April
  1389.     jr    c,notDST    ; yes, not DST then
  1390.     jr    z,DSTapr    ; handle April
  1391.     cp    10h        ;before October?
  1392.     jr    c,isDST        ; yes, still DST
  1393.     jr    z,DSToct    ; go handle October
  1394.     jr    notDST        ;after October no longer DST
  1395.  
  1396. ; April DST stuff
  1397.  
  1398. ; DST starts the first Sunday in April
  1399.  
  1400. DSTapr:    ld    a,(hl)        ;get the day
  1401.     cp    7        ;DST starts April 7 or sooner
  1402.     inc    hl        ;HL --> dowBCD
  1403.     jr    z,ChkSun    ;Today is April 7, is it Sunday?
  1404.     jr    nc,isDST    ;Must be DST as later than April 7
  1405. ; it is April 6 or sooner
  1406.     sub    (hl)        ;Subtract DOW value from Date
  1407.     jp    m,notDST    ;DOW larger than date so Sunday
  1408.                 ;  hasn't happened yet
  1409. ; Today must be 1st Sunday of April or later
  1410.  
  1411. ChkSun:    ld    a,(hl)        ;is Today Sunday?
  1412.     dec    a        ;
  1413.     jr    nz,isDST    ; no. then it's DST now
  1414.  
  1415.     inc    hl        ;HL --> hrBCD
  1416.     ld    a,(hl)        ;after 2 am
  1417.     cp    2        ;
  1418.     jr    c,notDST    ; no. still not DST
  1419.     jr    isDST        ;yes. it's DST now
  1420.  
  1421. ; October DST stuff
  1422.  
  1423. DSToct:    ld    a,(hl)        ;get the day
  1424.     add    a,8        ;compute date of next sunday
  1425.     daa
  1426.     inc    hl        ;HL --> dowBCD
  1427.     sub    (hl)        ;
  1428.     daa
  1429.     cp    32h        ;will it occur in October?
  1430.     jr    c,isDST        ; Yes. it's still DST
  1431.     ld    a,(hl)        ;is Today Sunday?
  1432.     dec    a        ;
  1433.     jr    nz,notDST    ; no. then it's not DST
  1434.  
  1435.     inc    hl        ;HL --> hrBCD
  1436.     ld    a,(hl)        ;after 2 am
  1437.     cp    2        ;
  1438.     jr    c,isDST        ; no. it's still DST
  1439.     cp    3        ;before 3 am
  1440.     jr    c,dstdone    ; yes. don't change it yet
  1441.     jr    notDST        ;yes. it's not DST
  1442.  
  1443. ; DST?
  1444.  
  1445. isdst:    bit    bitDST,e    ;have we already done DST?
  1446.     jr    nz,DSTdone    ; yes. Don't do again.
  1447.  
  1448. ; Add one hour to the time
  1449.  
  1450.     ld    b,1        ; point the the TENTHS
  1451.     call    portc
  1452.     in    a,(c)        ; are we in danger of changing times?
  1453.     cp    99h        ;
  1454.     jp    z,readclk    ; YES. start over
  1455.     ld    b,4        ; point to hours
  1456.     call    portc        ;
  1457.     in    a,(c)        ; we can not do this at 23:00
  1458.     cp    23h        ; as we would have to adjust
  1459.     jr    z,DSTdone    ; the day/month/year also!
  1460.  
  1461.     ld    hl,hrBCD    ;point to the hour
  1462.     ld    a,(hl)        ;get it
  1463.     add    a,1        ;advance one hour
  1464.     jr    DSTfinis    ;finish up
  1465.  
  1466. ; Not DST
  1467.  
  1468. notDST:    bit    bitDST,e    ;have we already cleared DST?
  1469.     jr    z,DSTdone    ; yes. good for us
  1470.  
  1471. ; Should be one hour earlier!
  1472.     ld    b,1        ; point to sec - 1
  1473.     call    portc
  1474.     
  1475.     cp    99h        ;
  1476.     jp    z,readclk    ; yes. Begin again.
  1477.  
  1478.     ld    b,4        ; point to hours
  1479.     call    portc        ;
  1480.     in    a,(c)        ; Can't do at midnight
  1481.     or    a        ; as we'd have to change
  1482.     jr    z,DSTdone    ; the day/month/year also!
  1483.  
  1484.     ld    hl,hrBCD    ;
  1485.     ld    a,(hl)        ;get the hour
  1486.     sub    a,1        ;backup one
  1487.  
  1488. dstfinis: daa            ;convert to BCD
  1489. ;    ld    b,4        ; point to the hour
  1490. ;    call    portc        ;
  1491.     out    (c),a        ; send to the clock
  1492.     ld    (hl),a        ;send to this program also
  1493.     ld    a,e        ;set the DST flag
  1494.     xor    flgDST        ;
  1495.     ld    e,a        ;update our flag
  1496.  
  1497. DSTdone: ld    a,e        ;get our flags
  1498.     ld    (flgBCD),a    ;update the RAM
  1499.     ld    b,14        ; point to FLAGS
  1500.     call    portc        ;
  1501.     out    (c),a        ;and the clock
  1502.     xor    a        ; say we did it
  1503.     ret
  1504.  
  1505. ; routine to write the clock
  1506.  
  1507. writclk: ld    a,(flgBCD)    ;get the flag
  1508.     and    DSTflg        ; only do this bit
  1509.     or    setflg+yokflg    ;plus the other flag bytes
  1510.     ld    e,a        ; save the flags
  1511.  
  1512.     ld    a,(monBCD)    ;get the month
  1513.     cp    7        ;is it after june
  1514.     jr    c,wr01        ; no.
  1515.     res    okbit,e        ;Yes. clear the yearok bit
  1516.  
  1517. wr01:    ld    hl,yrBCD    ;HL --> yrBCD
  1518.     ld    a,(hl)
  1519.     inc    hl        ;HL --> monBCD
  1520.  
  1521. ; See if Leap Year or before a leap year
  1522.  
  1523.     ld    c,a        ;save the year in C
  1524.     and    0f0h        ;get the MSB
  1525.     rrca            ;into
  1526.     rrca            ; the
  1527.     rrca            ;  LSB
  1528.     rrca            ;   
  1529.     inc    a        ;make zero = 1
  1530.     ld    b,a        ;save it away
  1531.     ld    a,c        ;get the year back
  1532.     and    00fh        ;get the LSB
  1533. ck_leap: add    a,10        ;add 10 years
  1534.     djnz    ck_leap        ;loop
  1535.     sub    a,10        ;get the correct value
  1536.     and    3h        ;is this a leap year
  1537.     jr    z,leapyr    ; yes.
  1538.     cp    3        ;is it a preleap
  1539.     jr    nz,cl_leap    ; no. clear the bit
  1540.  
  1541.     ld    a,(hl)        ;get the month
  1542.     cp    3        ;after march?
  1543.     jr    nc,set_leap    ; yes. set the flag
  1544.  
  1545. ; turn the Leap year bit off
  1546.  
  1547. cl_leap: ld    a,e        ;get our flags
  1548.     and    0ffh-lpflg    ;clear the bit
  1549.     jr    do_leap
  1550.  
  1551. ; Make February 29 be March 1
  1552.  
  1553. dofeb29: ld    a,1        ;get the 1'st
  1554.     ld    (hl),a        ;store it
  1555.     dec    hl        ;HL --> monBCD
  1556.     ld    a,3        ;get March
  1557.     ld    (hl),a        ;store it
  1558.     jr    set_leap    ;and set the flag
  1559.  
  1560. ; Leap Year Routines
  1561.  
  1562. leapyr: ld    a,(hl)        ;get the month code
  1563.     inc    hl        ;HL --> dayBCD
  1564.     cp    2        ;is it February?
  1565.     jr    nz,notfeb    ; no.
  1566.     ld    a,(hl)        ;get the day
  1567.     cp    29h        ;is it the 29'th?
  1568.     jr    z,dofeb29    ; yes. fixup our counters
  1569.     dec    hl        ;get the month back
  1570.     ld    a,(hl)        ;
  1571.     inc    hl
  1572.  
  1573. notfeb:    cp    3        ;is it March yet
  1574.     jr    nc,cl_leap    ; yes. clear the bit
  1575.                 ;Otherwise set the bit
  1576.  
  1577. ; Assure leap year bit is on
  1578.  
  1579. set_leap: ld    a,e        ;get our flags
  1580.        or    lpflg        ;set the bit
  1581.  
  1582. do_leap: ld    e,a        ;update our internal copy
  1583.  
  1584. ; Daylight Savings Time Routines
  1585.  
  1586.     and    DSTflg        ;are we enabled?
  1587.     jr    z,wrtclk    ; no. all done
  1588.  
  1589.     ld    hl,monBCD    ;HL --> Month
  1590.     ld    a,(hl)        ;get the month
  1591.     inc    hl        ;HL --> dayBCD
  1592.     cp    4        ;before April
  1593.     jr    c,wrtclk    ; yes, not DST then
  1594.     jr    z,DST_apr    ; handle April
  1595.     cp    10h        ;before October
  1596.     jr    c,is_DST    ; yes. still DST
  1597.     jr    z,DST_oct    ; handle October
  1598.     jr    wrtclk        ;after October no longer DST
  1599.  
  1600. ; April DST routines
  1601.  
  1602. ; DST starts the first Sunday in April
  1603.  
  1604. DST_apr:ld    a,(hl)        ;get the day
  1605.     cp    7        ;DST start April 7 or sooner
  1606.     inc    hl        ;HL --> dowBCD
  1607.     jr    z,Chk_Sun    ;Today is April 7, is it Sunday?
  1608.     jr    nc,is_DST    ;must be DST as later than April 7
  1609.  
  1610. ; it is April 6 or sooner
  1611.  
  1612.     sub    (hl)        ;Subtract DOW value from Date
  1613.     jp    m,wrtclk    ;DOW larger than date so Sunday
  1614.                 ;  hasn't happened yet
  1615. ; Today must be 1st Sunday of April or later
  1616.  
  1617. Chk_Sun:ld    a,(hl)        ;is Today Sunday?
  1618.     dec    a        ;
  1619.     jr    nz,is_DST    ; no. then it's DST now
  1620.  
  1621.     inc    hl        ;HL --> hrBCD
  1622.     ld    a,(hl)        ;after 2 am
  1623.     cp    2        ;
  1624.     jr    c,wrtclk    ; no. still not DST
  1625.     jr    is_DST        ;yes. it's DST now
  1626.  
  1627. ; October DST routines
  1628.  
  1629. DST_oct: ld    a,(hl)        ;get the day
  1630.     add    a,8        ;compute date of next sunday
  1631.     daa
  1632.     inc    hl        ;HL --> dowBCD
  1633.     sub    (hl)        ;
  1634.     daa
  1635.     cp    32h        ;will it occur in October?
  1636.     jr    c,is_DST    ; Yes. it's still DST
  1637.     ld    a,(hl)        ;is Today Sunday?
  1638.     dec    a        ;
  1639.     jr    nz,wrtclk    ; no. then it's not DST
  1640.  
  1641.     inc    hl        ;HL --> hrBCD
  1642.     ld    a,(hl)        ;after 2 am
  1643.     cp    2        ;
  1644.     jr    c,is_DST    ; no. it's still DST
  1645.     jr    wrtclk        ;yes. it's not DST
  1646.  
  1647. ;    Daylight Savings Time
  1648.  
  1649. is_DST: ld    a,e        ;get our flags
  1650.     or    flgDST        ;set the DST flag
  1651.     ld    e,a        ;update flags
  1652.  
  1653.  
  1654. ; Write data to the clock RAM
  1655.  
  1656. wrtclk:    ld    a,(dtonly)    ; get date_only flag
  1657.     or    a        ;
  1658.     jr    nz,wrtck1    ; wants to write date_only
  1659.  
  1660.     ld    b,1        ; point to the TENTHS
  1661.     call    portc        ;
  1662.     ld    hl,secBCD    ;
  1663.     ld    b,6        ; we have six registers to write
  1664.     jr    wrtck2        ; go do the year stuff
  1665.  
  1666. wrtck1:    ld    b,4        ; point to the hours
  1667.     call    portc        ;
  1668.     ld    hl,dowBCD    ;
  1669.     ld    b,3        ; we have three registers to write
  1670.  
  1671.  
  1672. wrtck2:    inc    c        ; increment the port
  1673.     ld    a,(hl)        ; get the value
  1674.     out    (c),a        ; write it
  1675.     dec    hl        ; point to the next item
  1676.     djnz    wrtck2        ; and loop
  1677.  
  1678.     ld    b,9        ; point to the year
  1679.     call    portc
  1680.     ld    a,(hl)        ; get yrBCD
  1681.     out    (c),a        ; send to the clock
  1682.  
  1683.     ld    b,14        ; point to the flags
  1684.     call    portc        ;
  1685.     ld    a,e        ; get the flags
  1686.     out    (c),a        ; update the clock
  1687.     in    a,(c)        ; did clock accept the value?
  1688.     cp    e        ; See if in and out match
  1689.     jr    nz,wrterr    ; Clock is has malfunction or not available
  1690.     xor    a        ; write successful
  1691.     ret            ; and return
  1692.  
  1693. wrterr:    xor    a
  1694.     dec    a        ; report an error
  1695.     ret
  1696. ;
  1697. ; The following code stores the current time in the Z33 registers
  1698. ; when the S option is invoked. Later use of the E option compares
  1699. ; the current time with the saved time and displays the elapsed
  1700. ; time to the hundredths of seconds. Code was removed verbatim
  1701. ; from Terry Hazen's ELAPSED version 10 with only very minor changes
  1702. ; (e.g. jp exit instead of ret!). I appreciate Terry's permission 
  1703. ; to use his code here.
  1704. ;
  1705. elapse:    call    getmsg
  1706.     ld    a,(timreg)
  1707.     add    a,30h
  1708.     ld    e,a
  1709.     ld    d,0
  1710.     add    hl,de
  1711.     call    isbcdt        ; Check validity of memory date and time
  1712.     jp    nz,msgerr
  1713.  
  1714.     inc    hl        ; Point to previous time
  1715.     inc    hl
  1716.     inc    hl
  1717.     inc    hl
  1718.     ld    de,oldbin
  1719.     ld    a,(hl)        ; Old hours
  1720.     call    bc2bi
  1721.     ld    (de),a
  1722.     inc    hl
  1723.     inc    de
  1724.     ld    a,(hl)        ; Old minutes
  1725.     call    bc2bi
  1726.     ld    (de),a
  1727.     inc    hl
  1728.     inc    de
  1729.     ld    a,(hl)        ; Old seconds
  1730.     call    bc2bi
  1731.     ld    (de),a
  1732.     inc    hl
  1733.     inc    de
  1734.     ld    a,(hl)        ; Old tenths
  1735.     call    bc2bi
  1736.     ld    (de),a
  1737.  
  1738.     ld    hl,hrBCD
  1739.     ld    a,(hl)        ; New hours
  1740.     call    bc2bi
  1741.     ld    (hl),a
  1742.     inc    hl
  1743.     ld    a,(hl)        ; New minutes
  1744.     call    bc2bi
  1745.     ld    (hl),a
  1746.     inc    hl
  1747.     ld    a,(hl)        ; New seconds
  1748.     call    bc2bi
  1749.     ld    (hl),a
  1750.     inc    hl
  1751.     ld    a,(hl)        ; New tenths
  1752.     call    bc2bi
  1753.     ld    (hl),a
  1754.  
  1755.     ld    a,(de)        ; DE = address of Julian (old time)
  1756.     ld    b,a
  1757.     ld    a,(hl)        ; HL = address of Tenths (new time)
  1758.     sub    b
  1759.     jr    nc,etime0
  1760.     call    adjtn
  1761.     sub    b
  1762.  
  1763. etime0:    ld    (oldbin+3),a    ; Do seconds
  1764.     dec    hl
  1765.     dec    de
  1766.     ld    a,(de)
  1767.     ld    b,a
  1768.     ld    a,(hl)
  1769.     sub    b
  1770.     jr    nc,etime1
  1771.     call    adjsc
  1772.     sub    b
  1773.  
  1774. etime1:    ld    (oldbin+2),a
  1775.     dec    hl        ; Do minute
  1776.     dec    de
  1777.     ld    a,(de)
  1778.     ld    b,a
  1779.     ld    a,(hl)
  1780.     sub    b
  1781.     jr    nc,etime2
  1782.     call    adjmn
  1783.     sub    b
  1784.  
  1785. etime2:    ld    (oldbin+1),a
  1786.     dec    hl        ; Do hour
  1787.     dec    de
  1788.     ld    a,(de)
  1789.     ld    b,a
  1790.     ld    a,(hl)
  1791.     sub    b
  1792.     jr    nc,etime3
  1793.     call    adjhr
  1794.     sub    b
  1795.  
  1796. etime3:    ld    (oldbin),a
  1797.  
  1798.     ld    a,(line25)    ; 25th line of H19?
  1799.     or    a        
  1800.     jr    z,etime6    
  1801.     ld    hl,cursav    ; save cursor position
  1802.     call    epstr        
  1803.     ld    hl,enable    
  1804.     call    epstr        
  1805.     call    at        
  1806.     defb    25,1        
  1807.  
  1808.     jr    etime7        
  1809.     
  1810. etime6:    call    crlf    
  1811. etime7:    call    eprint
  1812.  
  1813.     db    '   Elapsed time:  ',0
  1814.     ld    hl,oldbin    ; Show elapsed time
  1815.     ld    a,(hl)
  1816.     call    bi2bc
  1817.     call    pa2hc
  1818.     call    colon
  1819.     inc    hl
  1820.     ld    a,(hl)
  1821.     call    bi2bc
  1822.     call    pa2hc
  1823.     call    colon
  1824.     inc    hl
  1825.     ld    a,(hl)
  1826.     call    bi2bc
  1827.     call    pa2hc
  1828.     ld    a,'.'
  1829.     call    cout
  1830.     inc    hl
  1831.     ld    a,(hl)
  1832.     call    bi2bc
  1833.     call    pa2hc
  1834.     ld    a,(line25)    ; H19 with 25th line?
  1835.     or    a
  1836.     jr    z,etimea
  1837.     ld    hl,curret    ; return to save cursor position
  1838.     call    epstr
  1839.     jp    exit
  1840. ;
  1841. etimea:    call    crlf
  1842.     jp    exit
  1843.  
  1844. msgerr:    call    eprint
  1845.     db    '   Use "S" option to store current time first!'
  1846.     db    bell,cr,lf,0
  1847.     jp    exit
  1848.  
  1849. stortim:call    getmsg        ; Get message buffer address
  1850.     ld    a,(timreg)    ; Get first storage register
  1851.     add    a,30h        ; Add offset
  1852.     ld    e,a
  1853.     ld    d,0
  1854.     add    hl,de
  1855.     ex    de,hl        ; Register address in DE
  1856.     ld    hl,yrBCD    ; Point to date and time buffer
  1857.     ld    bc,8        ; Eight bytes to move
  1858.     ldir
  1859.     jp    exit
  1860.  
  1861. adjtn:    dec    hl        ; Point to second
  1862.     ld    a,(hl)
  1863.     or    a        ; Zero?
  1864.     jr    z,adjtn1    ; (yes, adjust it)
  1865.     dec    (hl)        ; No, borrow one
  1866.     inc    hl        ; Point back to tenths
  1867.     ld    a,(hl)
  1868.     add    a,100        ; Add borrow
  1869.     ret
  1870.  
  1871. adjtn1:    dec    hl        ; Point to second
  1872.     call    adjsc        ; Borrow one
  1873.     dec    (hl)
  1874.     inc    hl        ; Point to tenths
  1875.     ld    (hl),99        ; Add borrow-1
  1876.     ret
  1877.  
  1878. adjsc:    dec    hl        ; Point to minute
  1879.     ld    a,(hl)
  1880.     or    a        ; Zero?
  1881.     jr    z,adjsc1    ; (yes, adjust it)
  1882.     dec    (hl)        ; No, borrow one
  1883.     inc    hl        ; Point back to second
  1884.     ld    a,(hl)
  1885.     add    a,60        ; Add borrow
  1886.     ret
  1887.  
  1888. adjsc1:    dec    hl        ; Point to hour
  1889.     call    adjhr        ; Borrow one
  1890.     dec    (hl)
  1891.     inc    hl        ; Point to minute
  1892.     ld    (hl),59        ; Add borrow -1
  1893.     inc    hl        ; Point back to second
  1894.     ld    a,(hl)
  1895.     add    a,60        ; Add borrow
  1896.     ret
  1897.  
  1898. adjmn:    dec    hl        ; Point to hour
  1899.     ld    a,(hl)
  1900.     or    a        ; Zero?
  1901.     call    z,adjhr        ; (yes, adjust it)
  1902.     dec    (hl)
  1903.     inc    hl        ; Point back to minute
  1904.     ld    a,(hl)
  1905.     add    a,60        ; Add borrow -1
  1906.     ret
  1907.  
  1908. adjhr:    ld    a,(hl)        ; Is hour zero?
  1909.     add    a,24        ; Add borrow from day
  1910.     ld    (hl),a
  1911.     ret
  1912.  
  1913.  
  1914. ;
  1915. ; Enter with desired port offset in B, returns with port number in C
  1916. ;
  1917. portc:    push    af        ;
  1918.     ld    a,(port)    ;
  1919.     add    a,b        ;
  1920.     ld    c,a        ;
  1921.     pop    af        ;
  1922.     ret
  1923.  
  1924. montbl:    defb    'Jan',0
  1925.     defb    'Feb',0
  1926.     defb    'Mar',0
  1927.     defb    'Apr',0
  1928.     defb    'May',0
  1929.     defb    'Jun',0
  1930.     defb    'Jul',0
  1931.     defb    'Aug',0
  1932.     defb    'Sep',0
  1933.     defb    'Oct',0
  1934.     defb    'Nov',0
  1935.     defb    'Dec',0
  1936.  
  1937. ; Highest legal BCD values in Clock buffer slots.
  1938. ;
  1939. BCDmax:    defb    99h    ; Year
  1940.     defb    12h    ; Month
  1941.     defb    31h    ; Day of month
  1942.     defb    07h    ; Day of week
  1943.     defb    23h    ; Hours
  1944.     defb    59h    ; Minutes
  1945.     defb    59h    ; Seconds
  1946.  
  1947.  
  1948. ; Length of each month
  1949.  
  1950. lentbl:    defb    31H,28H        ; lentbl includes daytbl below!
  1951.  
  1952. ; BCD table of the days in a month during a leap year (Jan Feb not needed)
  1953.  
  1954. daytbl:    defb    31h,30h,31h,30h,31h,31h,30h,31h,30h,31h
  1955.  
  1956. ; Day of year (for each month's beginning) table.
  1957.  
  1958. DOYtbl:    defw    0,31,59,90,120,151,181
  1959.     defw    212,243,273,304,334
  1960. ;
  1961.  
  1962.     dseg    ;
  1963.  
  1964. timBCD:
  1965. yrBCD:    ds    1        ; Year goes here
  1966. monBCD:    ds    1        ; Month goes here
  1967. dayBCD:    ds    1        ; Day of Month goes here
  1968. dowBCD:    ds    1        ; Day of Week goes here
  1969. hrBCD:    ds    1        ; hours go here
  1970. minBCD:    ds    1        ; minutes go here
  1971. secBCD:    ds    1        ; seconds go here
  1972. tenBCD:    ds    1        ; tenths/hundredths go here
  1973. flgBCD:    ds    1        ; Flags
  1974.  
  1975. oldbin:    ds    4        ; Original binary time buffer
  1976.  
  1977. flgbyte:ds    1        ; Flag byte
  1978. CMTptr:    ds    2        ; COMTAIL pointer buffer
  1979. CmTail:    ds    1        ; COMTAIL character count
  1980. dtonly:    ds    1        ; date_only flag
  1981. z33flg:    ds    1        ; z33 flag
  1982. Dbuf:    defs    60        ; Scratchpad
  1983.     defs    64        ; 64 byte stack
  1984. stack:    defs    2        ; system stack pointer
  1985.  
  1986.     END
  1987.