home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / BDOS / DOSPLSOR.ARK / TIME.MAC < prev    next >
Text File  |  1986-11-15  |  10KB  |  514 lines
  1. ;
  2. ; syntax:
  3. ;    TIME<cr>        (to report current time)
  4. ;    TIME yy/mm/dd hh:mm    (to set time)
  5. ;    TIME ?            (for help)
  6. ;
  7. ; using ISO std date format and 24 hour (00 <= hh <= 23) time
  8. ;
  9. ver    equ    10
  10. ;
  11. bdos    equ    5
  12. fcb    equ    05ch
  13. defdma    equ    080h
  14. ;
  15. ; DOS+/CPM calls
  16. cout    equ    2
  17. tstr    equ    9
  18. dosver    equ    12
  19. ;
  20. ; Following for DOS+/CPM3 only
  21. setime    equ    104
  22. getime    equ    105
  23. getinfo    equ    210;        Only on DOS+
  24. ;
  25. ; getinfo sub-calls
  26. getbase    equ    0
  27. ;
  28. ; Ascii controls
  29. cr    equ    0dh
  30. lf    equ    0ah
  31. ;
  32. ;    -------------
  33. ;
  34. begin:    lxi    h,0
  35.     shld    tod;        mark no time by default
  36.     dad    sp;        so GO can re-execute correctly
  37.     lxi    sp,stack
  38.     push    h;        save entry sp
  39.     lda    fcb+1
  40.     cpi    '?'
  41.     jz    help;        'TIME ?' entered
  42.     mvi    c,dosver
  43.     call    bdos
  44.     inr    h
  45.     dcr    h
  46.     jnz    badver;        MPM or something
  47.     cpi    24h
  48.     jnc    bgn2;        Dos+ 2.4 up, or CPM 3, ok
  49.     cpi    22h
  50.     jc    badver;        1.4 or CPM2.0/1, no timers
  51.     mvi    c,getinfo
  52.     mvi    e,getbase
  53.     call    bdos;        Check for DOS+ in compatibility mode
  54.     ora    h
  55.     jz    badver;        If base returned, all is well
  56. ;    "    "
  57. ; Running DOS+ or CPM3 if here.  Check parameters
  58. bgn2:    lxi    h,defdma
  59.     mov    a,m
  60.     inx    h
  61.     push    h
  62.     add    l
  63.     mov    l,a
  64.     adc    h
  65.     sub    l
  66.     mov    h,a
  67.     mvi    m,0;        mark line end
  68.     pop    h
  69.     call    skipbk
  70.     jc    show;        no chars, show time
  71. ;    "    "
  72. ; try for valid input time string
  73. set:    call    getn
  74.     jc    badnum;        get year
  75.     cpi    '/'
  76.     jnz    badnum
  77.     inx    h
  78.     push    d;        save year
  79.     call    getn;        get month
  80.     jc    badnum
  81.     sui    '/'
  82.     ora    d
  83.     jnz    badnum;        too large or bad terminator
  84.     ora    e
  85.     jz    badnum
  86.     cpi    13
  87.     jnc    badnum
  88.     push    d;        save month
  89.     inx    h
  90.     call    getn;        get day
  91.     sui    ' '
  92.     ora    d
  93.     jnz    badnum;        too large or bad terminator
  94.     ora    e
  95.     jz    badnum
  96.     cpi    32
  97.     jnc    badnum
  98.     pop    b
  99.     mov    d,c;        d := month
  100.     push    d;        save month/day
  101.     call    skipbk;        past terminating blanks to time
  102.     call    getn
  103.     jc    badnum
  104.     sui    ':'
  105.     ora    d
  106.     jnz    badnum
  107.     push    d;        save hour
  108.     inx    h
  109.     call    getn;        get minute
  110.     jc    badnum
  111.     mov    a,d
  112.     ora    a
  113.     jnz    badnum;        too big
  114.     pop    b
  115.     mov    d,c;        de is hr/min
  116.     xchg;            to hl
  117.     pop    d;        month/day
  118.     pop    b;        year
  119.     push    h;        save hr/min
  120.     lxi    h,-1900
  121.     dad    b
  122.     jnc    set2;        user did not enter the 19
  123.     mov    b,h
  124.     mov    c,l
  125. set2:    mov    a,b
  126.     ora    a
  127.     jnz    badnum;        date too large
  128.     call    cnvt;        to dr format in hl
  129.     shld    tod
  130.     pop    b
  131.     mov    a,b
  132.     cpi    24
  133.     jnc    badnum
  134.     call    binbcd
  135.     sta    tod+2;        hour
  136.     mov    a,c
  137.     cpi    60
  138.     jnc    badnum
  139.     call    binbcd
  140.     sta    tod+3;        minute
  141.     lxi    d,tod
  142.     mvi    c,setime
  143.     call    bdos
  144.     jmp    exit    
  145. ;
  146. ; display current time
  147. show:    mvi    c,getime
  148.     lxi    d,tod
  149.     call    bdos
  150.     sta    tod+4;        save seconds value
  151.     lhld    tod
  152.     lxi    d,notmsg
  153.     mov    a,h
  154.     ora    l
  155.     jz    msgxit;        no time
  156.     call    date
  157.     call    blk
  158.     lhld    tod+2
  159.     call    time
  160.     mvi    a,':'
  161.     call    couta
  162.     lda    tod+4
  163.     call    t2hx
  164.     jmp    exit
  165. ;
  166. ; illegal numeric
  167. badnum:    lxi    d,syntax
  168.     jmp    msgxit
  169. ;
  170. ; Bad DOS version message and exit
  171. badver:    lxi    d,vermsg
  172.     jmp    msgxit
  173. ;
  174. ; help message and exit
  175. help:    lxi    d,hlpmsg
  176. ;    "    "
  177. ; message de^ and exit
  178. msgxit:    mvi    c,tstr
  179.     call    bdos
  180. ;    "    "
  181. exit:    lhld    stack-2;    allows aborts from down in stack
  182.     sphl
  183.     ret
  184. ;
  185. ;    -------------
  186. ;
  187. ; skip blanks, string hl^. Exit with a=hl^ non-blank, cy for eol.
  188. skipbk:    mov    a,m
  189.     cpi    ' '
  190.     rc;            control or 0, end of line
  191.     rnz;            non-blank
  192.     inx    h
  193.     jmp    skipbk
  194. ;
  195. ; check a for numeric char, carry if not
  196. qnum:    cpi    '0'
  197.     rc
  198.     cpi    '9'+1
  199.     cmc
  200.     ret
  201. ;
  202. ; get numeric value from string hl^ to de. Exit hl^ is terminator
  203. ; a,f,b,c,d,e,h,l
  204. getn:    lxi    d,0
  205.     mov    a,m
  206.     call    qnum
  207.     rc;            invalid number
  208. getn1:    ani    0fh
  209.     xchg
  210.     mov    b,h
  211.     mov    c,l
  212.     dad    h;        2*
  213.     dad    h;        4*
  214.     dad    b;        5*
  215.     dad    h;        10*
  216.     call    index;        incorporate digit
  217.     xchg
  218.     inx    h
  219.     mov    a,m
  220.     call    qnum
  221.     jnc    getn1
  222.     cmc
  223.     ret
  224.     
  225. ;
  226. ; show date in hl
  227. ; a,f,b,c,d,e,h,l
  228. date:    mov    a,h
  229.     ora    l
  230.     rz
  231.     call    day;        show day of week
  232.     call    drtodate
  233.     mov    a,c
  234.     call    t2dec
  235.     mov    a,d
  236.     call    date1
  237.     mov    a,e
  238. date1:    push    psw
  239.     mvi    a,'/'
  240.     call    couta
  241.     pop    psw
  242. ;    "    "
  243. ; show a as 2 dig. decimal no.
  244. ; a,f
  245. t2dec:    call    binbcd
  246.     jmp    t2hx
  247. ;
  248. ; show time in hl (BCD)
  249. ; a,f
  250. time:    mov    a,l
  251.     call    t2hx
  252.     mvi    a,':'
  253.     call    couta
  254.     mov    a,h
  255. ;    "    "
  256. t2hx:    push    psw
  257.     rlc
  258.     rlc
  259.     rlc
  260.     rlc
  261.     call    t1hx
  262.     pop    psw
  263. ;    "    "
  264. t1hx:    ani    0fh
  265.     adi    090h
  266.     daa
  267.     aci    040h
  268.     daa
  269.     jmp    couta
  270. ;
  271. ; Convert (a) in binary to BCD. No overflow check. Return z flag.
  272. ; a,f
  273. binbcd:    push    b
  274.     lxi    b,0affh;        b := 10, c := -1
  275. bbcd1:    inr c !    sub b
  276.     jnc    bbcd1;            divide by 10
  277.     add    b;            correct remainder
  278.     mov    b,a
  279.     mov    a,c;            quotient
  280.     add a !    add a !    add a !    add a;    * 16. Cy for o'flow
  281.     add    b;            + remainder. clears cy
  282.     pop    b
  283.     ret
  284. ;
  285. ; show day of week. hl = drdate (days since 77/12/31 = Sat.)
  286. ; a,f,d,e
  287. day:    push    h
  288.     lxi    d,-7
  289.     call    divd
  290.     dad    h
  291.     dad    h
  292.     lxi    d,dtbl
  293.     dad    d
  294.     mvi    d,4
  295. day1:    mov    a,m
  296.     inx    h
  297.     call    couta
  298.     dcr    d
  299.     jnz    day1
  300.     call    blk
  301.     pop    h
  302.     ret
  303. ;
  304. dtbl:    db    'Sat.Sun.Mon.Tue.Wed.Thu.Fri.'
  305. ;
  306. ; PROCEDURE drtodate(thedate : integer; VAR yr, mo, day : integer);
  307. ; (* 1 Jan 1978 corresponds to Digital Research date = 1  *)
  308. ; (* BUG - cannot handle negative values for dates > 2067 *)
  309. ;
  310. ;   VAR
  311. ;     i, y1        : integer;
  312. ;     dayspermonth : ARRAY[1..12] OF 1..31;
  313. ;
  314. ;   BEGIN (* drtodate *)
  315. ;   FOR i := 1 TO 12 DO dayspermonth[i] := 31;
  316. ;   dayspermonth[4] := 30; dayspermonth[6] := 30;
  317. ;   dayspermonth[9] := 30; dayspermonth[11] := 30;
  318. ;   IF thedate > 731 THEN BEGIN (* avoid overflows *)
  319. ;     yr := 1980; thedate := thedate - 731; END
  320. ;   ELSE BEGIN
  321. ;     thedate := thedate + 730; yr := 1976; END;
  322. ;   (* 0..365=y0; 366..730=y1; 731..1095=y2; 1096..1460=y3 *)
  323. ;   i := thedate DIV 1461; thedate := thedate MOD 1461;
  324. ;   y1 := (thedate-1) DIV 365; yr := yr + y1 + 4*i;
  325. ;   IF y1 = 0 THEN (* leap year *) dayspermonth[2] := 29
  326. ;   ELSE BEGIN
  327. ;     thedate := thedate - 1; (* 366 -> 365 -> 1 Jan *)
  328. ;     dayspermonth[2] := 28; END;
  329. ;   day := thedate - 365*y1 + 1; mo := 1;
  330. ;   WHILE day > dayspermonth[mo] DO BEGIN
  331. ;     day := day - dayspermonth[mo];
  332. ;     mo := succ(mo); END;
  333. ;   END; (* drtodate *)
  334. ;
  335. ; Incorporate (a) in year (c), overflows to century (b)
  336. addyr:    add    c
  337.     jnc    addyr1;        <256
  338.     sui    100;        256..276
  339.     jmp    addyr2
  340. addyr1:    dcr    b
  341. addyr2:    inr    b
  342.     sui    100
  343.     jnc    addyr2
  344.     adi    100;        b = century, c = year MOD 100
  345.     mov    c,a
  346.     ret
  347. ;
  348. ; divide hl by -de, rdr to hl, quotient to a
  349. ; a,f,d,e,h,l
  350. divd:    mvi    a,-1
  351. divd1:    inr    a
  352.     dad    d
  353.     jc    divd1
  354.     push    psw
  355.     mov    a,l
  356.     sub    e
  357.     mov    l,a
  358.     mov    a,h
  359.     sbb    d
  360.     mov    h,a
  361.     pop    psw
  362.     ret
  363. ;
  364. ; days per month, except leap year. Leading dummy 0 for month 0
  365. mtbl:    db    0,31,28,31,30,31,30,31,31,30,31,30,31
  366. ;
  367. ; Input  : hl = drdate (days since 78/1/1, 1 = 78/1/1)
  368. ; Output : b, c, d, e = cent, year, month, day (binary)
  369. ; a,f,b,c,d,e,h,l
  370. drtodate:
  371.     lxi    b,256*19 + 76;    731 represents 80/1/1
  372.     push    h
  373.     lxi    d,-731
  374.     dad    d
  375.     pop    h
  376.     jnc    drd1;        before 80/1/1
  377.     dad    d;        on or after 80/1/1
  378.     mvi    c,80;        now 0 represents 80/1/1
  379.     jmp    drd2
  380. drd1:    lxi    d,730
  381.     dad    d;        now 731 represents 78/1/1
  382. drd2:    lxi    d,-1461
  383.     call    divd;        get quad years since base (in c)
  384.     add    a
  385.     add    a;        4 * i.  180 max
  386.     call    addyr;        yr := yr + 4 * i
  387.     mov    a,h
  388.     ora    l
  389.     jz    drd3;        At Jan 1, leap year
  390.     dcx    h;        thedate := thedate - 1
  391.     lxi    d,-365;        so year thresholds come out right
  392.     call    divd;        thedate := thedate MOD 365
  393.     push    psw;        y1 := a := thedate DIV 365
  394.     call    addyr;        yr := yr+y1
  395.     pop    psw;        0 for leapyear
  396.     jnz    drd5;        not a leap year
  397.     inx    h;        thedate := thedate+1 (1..365)
  398. drd3:    mvi    a,29
  399.     sta    mtbl+2
  400. drd5:    xchg
  401.     lxi    h,mtbl
  402.     push    b
  403.     mvi    b,0;        mo := 0
  404. drd6:    inx    h;        WHILE
  405.     inr    b;         day := day-dayspermo[mo := mo+1] >= 0
  406.     mov    a,e;            DO (* again *)
  407.     sub    m
  408.     mov    e,a
  409.     mov    a,d
  410.     sbi    0
  411.     mov    d,a
  412.     jnc    drd6
  413.     mov    a,e;        day := day+dayspermo[mo]
  414.     add    m
  415.     mov    e,a;        range 0..pred(dayspermo[mo])
  416.     adc    d
  417.     sub    e
  418.     mov    d,a
  419.     xchg
  420.     mov    d,b
  421.     pop    b
  422.     mov    e,l
  423.     inr    e;        make result 1 based
  424.     mvi    a,28
  425.     sta    mtbl+2;        restore month table
  426.     ret
  427. ;
  428. ; Input: b, c, d, e = cent, year, month, day (binary)
  429. ; Output: hl = drdate (days since 78/1/1, 1=78/1/1)
  430. ;      hl = 0 for some invalid dates, including 1977.
  431. ; Century = ignored, assumed 1900 base + year.
  432. ; Operates 1978 Jan. 1 to 2155 Dec. 31 inclusive.
  433. ; a,f,b,c,d,e,h,l
  434. cnvt:    lxi    h,0;        default for errors
  435.     mov a,c ! sui 78;    
  436.     rc;            < 1978 illegal, return 0
  437. cnvt2:    adi 2 !    mov b,a;    years since 1976 makes leaps easy
  438.     ani 3 !    mov c,a;    yr := year mod 4
  439.     mov a,b ! sub c
  440.     rrc ! rrc ! mov b,a;    i := year div 4
  441.     mov a,d ! ora a;    month
  442.     rz;            invalid, return 0
  443.     mov a,e ! ora a;    day
  444.     rz;            invalid, return 0
  445.     lxi    h,-730-1461-365;    76/1/1 & pre-corrections
  446.     call    index;        drdate := day + drdate
  447.     push    d
  448.     lxi    d,1461;        4 years of days
  449.     inr    b;        allow for zero input, pre-corrected
  450. cnvt3:    dad d !    dcr b
  451.     jnz    cnvt3;        drdate := day - 730 + (i * 1461) - 365
  452.     pop    d
  453.     mov    a,c;        yr
  454.     ora    a
  455.     mov    a,d;        month
  456.     jnz    cnvt4;        IF (yr = 0) AND (month < 3) THEN
  457.     cpi 3 !    jnc cnvt4;      drdate := drdate-1; (2000 is leapyr)
  458.     dcx    h;        (leap year correction)
  459. cnvt4:    mov    b,c;        yr, 0..3
  460.     lxi    d,365;        1 year of days
  461.     inr    b;        allow for zero, pre-corrected
  462. cnvt5:    dad d !    dcr b
  463.     jnz    cnvt5;        drdate := drdate + 365 * (yr+1)
  464.     mov    b,a;        month
  465.     lxi    d,mtbl
  466. cnvt6:    ldax    d;        for i := 1 to month-1 DO
  467.     call    index;              drdate := drdate + dpermo[i];
  468.     inx d !    dcr b
  469.     jnz    cnvt6
  470.     ret
  471. ;
  472. ; index hl := hl + a (max a = 127)
  473. ; a,f,h,l
  474. index:    add    l
  475.     mov    l,a
  476.     rnc
  477.     inr    h
  478.     ret
  479. ;
  480. ; one blank to console
  481. ; a,f
  482. blk:    mvi    a,' '
  483. ;    "    "
  484. ; console output from (a)
  485. ; a,f
  486. couta:    push    b
  487.     push    d
  488.     push    h
  489.     mov    e,a
  490.     mvi    c,cout
  491.     call    bdos
  492.     pop    h
  493.     pop    d
  494.     pop    b
  495.     ret
  496. ;
  497. syntax:    db    'Bad time specification',cr,lf,cr,lf
  498. hlpmsg:    db    'TIME v. '
  499.     db    ver / 10 + '0', '.', ver MOD 10 + '0'
  500.     db    ' (c) 1986 C.B. Falconer',cr,lf,cr,lf
  501.     db    'Usage:  (ISO standard format)',cr,lf
  502.     db    ' TIME<cr>             (to show current time)',cr,lf
  503.     db    ' TIME yy/mm/dd hh:mm  (to set time)',cr,lf
  504.     db    ' TIME ?               (for help)',cr,lf,cr,lf
  505.     db    'ex: TIME 86/11/15 17:12   (uses 24hr time)$'
  506. vermsg:    db    'Needs DOS+ or CPM3$'
  507. notmsg:    db    'No time set$'
  508. ;
  509. tod:    ds    5;        time string
  510. ;
  511.     ds    64
  512. stack:
  513.     end
  514. =