home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / arc-lbr / patchark.ark / PATCHARK.AZM next >
Encoding:
Text File  |  1988-08-16  |  4.1 KB  |  148 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;          PATCHARK.AZM Copyright 1988 by Dale H. Cook        ;
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;                                    ;
  5. ;                       *     *            ;
  6. ;            ^               **   **            ;
  7. ;           ^^^               * * * *   ***   *     *    ;
  8. ;          ^^^^^               *  *  *    *    *     *    ;
  9. ;         ^^^^^^^           *     *    *    *     *    ;
  10. ;   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^       *     *    *    *     *    ;
  11. ;      ^^^^^^^^^^^^^^^^^^^^^^^^^^^       *     *   ***   ***   ***    ;
  12. ;      ^^^^^^^^^^^^^^^^^^^^^                        ;
  13. ;         ^^^^^^^^^^^^^^^           *     *            ;
  14. ;        ^^^^^^^^^^^^^^^^^           **   **            ;
  15. ;       ^^^^^^^^^^^^^^^^^^^           * * * *   *****   *   *    ;
  16. ;      ^^^^^^^^^^ ^^^^^^^^^^           *  *  *     *     **  *    ;
  17. ;     ^^^^^^^     ^^^^^^^       *     *     *     * * *    ;
  18. ;       ^^^^             ^^^^       *     *     *     *  **    ;
  19. ;      ^             ^       *     *     *     *   *  *    ;
  20. ;                                    ;
  21. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22. ;                                    ;
  23. ;             Mill Mountain Software                ;
  24. ;                                    ;
  25. ;   This program  may be freely distributed  provided that it is dis-    ;
  26. ;   tributed in whole  with no alteration or modification  in form or    ;
  27. ;   content,  that all copyright  notices remain intact,  and that no    ;
  28. ;   charge is made  other than a nominal  distribution fee.  All com-    ;
  29. ;   mercial distribution of this program  in part or in whole without    ;
  30. ;   the express written consent of the author is strictly prohibited.    ;
  31. ;                                    ;
  32. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33. ;                                    ;
  34. ;            The author may be contacted at:            ;
  35. ;         CompuServe 71370,2635    GEnie DHCOOK            ;
  36. ;                                    ;
  37. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  38. ;                                    ;
  39. ;   Title: PATCHARK.AZM Version 1.0                    ;
  40. ;                                    ;
  41. ;   Author: Dale H. Cook                        ;
  42. ;                                    ;
  43. ;   Description: Patches Brian Moore's ARK.COM, Version 03 or later to    ;
  44. ;         provide automatic date/time stamping of archives for    ;
  45. ;         '84 (graphics) Kaypro 4 and 10 real-time-clock.    ;
  46. ;                                    ;
  47. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  48. ;                                    ;
  49. ;   Revision History: 16AUG88 - Version 1.0 - first release version    ;
  50. ;                                    ;
  51. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  52.  
  53.     ORG    100H
  54.     JP    GET        ; Set date-and time before running ARK
  55.  
  56. ;
  57. ; ARK EQUATES
  58. ;
  59.  
  60. START:    EQU    285AH        ; ARK035 has jp 285Ah at 100h
  61. ENDARK:    EQU    36D6H        ; First byte after the end of ARK035
  62. DATTIM: EQU    0103H        ; Start of binary date-and-time within ARK
  63.  
  64. ;
  65. ; KAYPRO RTC EQUATES
  66. ;
  67.  
  68. PIOADD    EQU    0FH        ; Pio address
  69. CLKADD    EQU    20H        ; Rtc register select
  70. CLKCTL    EQU    22H        ; Rtc mode control
  71. CLKDAT    EQU    24H        ; Rtc data
  72. STATUS    EQU    14H        ; Rtc status register
  73. MONRTC    EQU    07H        ; Rtc months register
  74. DAYRTC    EQU    06H        ; Rtc days register
  75. HRSRTC    EQU    04H        ; Rtc hours register
  76. MINRTC    EQU    03H        ; Rtc minutes register
  77.  
  78.  
  79.     ORG    ENDARK        ; Locate time/date routine beyond ARK
  80.  
  81. ;
  82. ; FETCH RTC DATA
  83. ;
  84.  
  85. GET:    LD    A,PIOADD    ; Set pio to output
  86.     OUT    CLKCTL,A
  87.     LD    A,STATUS    ; Clear status bit
  88.     OUT    CLKADD,A
  89.     IN    A,CLKDAT
  90.  
  91. GET0:    LD    A,88H        ; Year for Kaypro - change to current year
  92.     CALL    BCDBIN
  93.     LD    (DATTIM),A
  94.  
  95. GET1:    LD    A,MONRTC    ; Get month
  96.     CALL    GETDRI
  97.     CALL    BCDBIN
  98.     LD    (DATTIM+1),A
  99.  
  100.     LD    A,DAYRTC    ; Get day
  101.     CALL    GETDRI
  102.     CALL    BCDBIN
  103.     LD    (DATTIM+2),A
  104.  
  105.     LD    A,HRSRTC    ; Get hour
  106.     CALL    GETDRI
  107.     CALL    BCDBIN
  108.     LD    (DATTIM+3),A
  109.  
  110.     LD    A,MINRTC    ; Get minute
  111.     CALL    GETDRI
  112.     CALL    BCDBIN
  113.     LD    (DATTIM+4),A
  114.  
  115.     LD    A,STATUS    ; Check for rollover
  116.     OUT    CLKADD,A
  117.     IN    A,CLKDAT
  118.     OR    A        ; Status bit = 0?
  119.     JP    Z,START        ; Yes - jump to ARK
  120.     JR    GET1        ; No - try again
  121.     
  122. ;
  123. ; GET DATE/TIME FROM RTC SUBROUTINE
  124. ;
  125. èGETDRI:    OUT    CLKADD,A    ; Output rtc address
  126.     IN    A,CLKDAT    ; Input rtc data
  127.     RET
  128.  
  129. ;
  130. ; CONVERT BCD TO BIN
  131. ;
  132.  
  133. BCDBIN:    LD    H,A        ; Save BCD in H
  134.     AND    0F0H        ; Mask upper nibble
  135.     RRCA            ; Rotate
  136.     LD    L,A        ; L = upper nibble * 8
  137.     RRCA            ; Rotate twice
  138.     RRCA            ; A = upper nibble * 2
  139.     ADD    A,L
  140.     LD    L,A        ; L = upper nibble * 0AH
  141.     LD    A,H        ; Get BCD back
  142.     AND    0FH        ; Mask upper nibble
  143.     ADD    A,L        ; Add to binary upper nibble
  144.     RET
  145.  
  146.  
  147.     END
  148.