$title ('CP/M V3.0 Date and Time') tod: do; /* Revised: 14 Sept 81 by Thomas Rolander Modifications: Date: September 2,1982 Programmer: Thomas J. Mason Changes: The 'P' option was changed to the 'C'ontinuous option. Also added is the 'S'et option to let the user set either the time or the date. Date: October 31,1982 Programmer: Bruce K. Skidmore Changes: Added Function 50 call to signal Time Set and Time Get. Date: 17 May 1998 Programmer: John Elliott Changes: Year 2000 fixes (flagged [JCE] below) Patch 17 implemented */ declare PLM label public; mon1: procedure (func,info) external; declare func byte; declare info address; end mon1; mon2: procedure (func,info) byte external; declare func byte; declare info address; end mon2; mon2a: procedure (func,info) address external; declare func byte; declare info address; end mon2a; declare xdos literally 'mon2a'; declare date$flag$offset literally '0ch'; /* [JCE] Date in UK format? */ declare fcb (1) byte external; declare fcb16 (1) byte external; declare tbuff (1) byte external; RETURN$VERSION$FUNC: procedure address; return MON2A(12,0); end RETURN$VERSION$FUNC; read$console: procedure byte; return mon2 (1,0); end read$console; write$console: procedure (char); declare char byte; call mon1 (2,char); end write$console; print$buffer: procedure (buffer$address); declare buffer$address address; call mon1 (9,buffer$address); end print$buffer; READ$CONSOLE$BUFFER: procedure (BUFF$ADR); declare BUFF$ADR address; call MON1(10,BUFF$ADR); end READ$CONSOLE$BUFFER; check$console$status: procedure byte; return mon2 (11,0); end check$console$status; terminate: procedure; call mon1 (0,0); end terminate; crlf: procedure; call write$console (0dh); call write$console (0ah); end crlf; get$date$flag: procedure byte; /* [JCE] Read the date format flag */ declare scbpb structure (offset byte, set byte, value address); scbpb.offset = date$flag$offset; scbpb.set = 0; return (mon2(49,.scbpb) and 1); end get$date$flag; /* [JCE] ends */ /***************************************************** Time & Date ASCII Conversion Code *****************************************************/ declare BUFFER$ADR structure ( MAX$CHARS byte, NUMB$OF$CHARS byte, CONSOLE$BUFFER(23) byte) /* [JCE] size 21 -> 23 throughout */ initial(23,0,0,0,0,0,0,0,0,0,0,0, /* because of printing */ 0,0,0,0,0,0,0,0,0,0,0,0,0); /* four-figure year nos. */ declare tod$adr address; declare tod based tod$adr structure ( opcode byte, date address, hrs byte, min byte, sec byte, ASCII (23) byte ); declare string$adr address; declare string based string$adr (1) byte; declare index byte; declare lit literally 'literally', forever lit 'while 1', word lit 'address'; /* - - - - - - - - - - - - - - - - - - - - - - */ emitchar: procedure(c); declare c byte; string(index := index + 1) = c; end emitchar; /*- - - - - - - - - - - - - - - - - - - - - - -*/ emitn: procedure(a); declare a address; declare c based a byte; do while c <> '$'; string(index := index + 1) = c; a = a + 1; end; end emitn; /*- - - - - - - - - - - - - - - - - - - - - - -*/ emit$bcd: procedure(b); declare b byte; call emitchar('0'+b); end emit$bcd; /*- - - - - - - - - - - - - - - - - - - - - - -*/ emit$bcd$pair: procedure(b); declare b byte; call emit$bcd(shr(b,4)); call emit$bcd(b and 0fh); end emit$bcd$pair; /*- - - - - - - - - - - - - - - - - - - - - - -*/ emit$colon: procedure(b); declare b byte; call emit$bcd$pair(b); call emitchar(':'); end emit$colon; /*- - - - - - - - - - - - - - - - - - - - - - -*/ emit$bin$pair: procedure(b); declare b byte; call emit$bcd(b/10); call emit$bcd(b mod 10); end emit$bin$pair; /*- - - - - - - - - - - - - - - - - - - - - - -*/ emit$slant: procedure(b); declare b byte; call emit$bin$pair(b); call emitchar('/'); end emit$slant; /*- - - - - - - - - - - - - - - - - - - - - - -*/ declare chr byte; /*- - - - - - - - - - - - - - - - - - - - - - -*/ gnc: procedure; /* get next command byte */ if chr = 0 then return; if index = 22 then /* [JCE] 20 -> 22 */ do; chr = 0; return; end; chr = string(index := index + 1); end gnc; /*- - - - - - - - - - - - - - - - - - - - - - -*/ deblank: procedure; do while chr = ' '; call gnc; end; end deblank; numeric: procedure byte; /* test for numeric */ return (chr - '0') < 10; end numeric; scan$numeric: procedure(lb,ub) byte; declare (lb,ub) byte; declare b byte; b = 0; call deblank; if not numeric then go to error; do while numeric; if (b and 1110$0000b) <> 0 then go to error; b = shl(b,3) + shl(b,1); /* b = b * 10 */ if carry then go to error; b = b + (chr - '0'); if carry then go to error; call gnc; end; if (b < lb) or (b > ub) then go to error; return b; end scan$numeric; scan$delimiter: procedure(d,lb,ub) byte; declare (d,lb,ub) byte; call deblank; if chr <> d then go to error; call gnc; return scan$numeric(lb,ub); end scan$delimiter; declare base$year lit '78', /* base year for computations */ base$day lit '0', /* starting day for base$year 0..6 */ month$size (*) byte data /* jan feb mar apr may jun jul aug sep oct nov dec */ ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31), month$days (*) word data /* jan feb mar apr may jun jul aug sep oct nov dec */ ( 000,031,059,090,120,151,181,212,243,273,304,334); leap$days: procedure(y,m) byte; declare (y,m) byte; /* compute days accumulated by leap years */ declare yp byte; yp = shr(y,2); /* yp = y/4 */ if (y and 11b) = 0 and month$days(m) < 59 then /* y not 00, y mod 4 = 0, before march, so not leap yr */ return yp - 1; /* otherwise, yp is the number of accumulated leap days */ return yp; end leap$days; declare word$value word; get$next$digit: procedure byte; /* get next lsd from word$value */ declare lsd byte; lsd = word$value mod 10; word$value = word$value / 10; return lsd; end get$next$digit; bcd: procedure (val) byte; declare val byte; return shl((val/10),4) + val mod 10; end bcd; declare (month, day, year, hrs, min, sec) byte; set$date: procedure; declare (i, leap$flag) byte; /* temporaries */ if get$date$flag = 1 then /* [JCE] UK format */ do; day = scan$numeric(1,31); month = scan$delimiter('/',1,12) - 1; if (leap$flag := month = 1) then i = 29; else i = month$size(month); if day > i then go to error; end; else /* US format */ do; month = scan$numeric(1,12) - 1; /* may be feb 29 */ if (leap$flag := month = 1) then i = 29; else i = month$size(month); day = scan$delimiter('/',1,i); end; /* [JCE] year2000: Was year = scan$delimiter('/',base$year,99); */ year = scan$delimiter('/',0,99); /* [JCE] */ if year < base$year /* [JCE] */ then year = year + 100; /* [JCE] Dates past 2000 */ /* ensure that feb 29 is in a leap year */ if leap$flag and day = 29 and (year and 11b) <> 0 then /* feb 29 of non-leap year */ go to error; /* compute total days */ tod.date = month$days(month) + 365 * (year - base$year) + day - leap$days(base$year,0) + leap$days(year,month); end SET$DATE; SET$TIME: procedure; tod.hrs = bcd (scan$numeric(0,23)); tod.min = bcd (scan$delimiter(':',0,59)); if tod.opcode = 2 then /* date, hours and minutes only */ do; if chr = ':' then i = scan$delimiter (':',0,59); tod.sec = 0; end; /* include seconds */ else tod.sec = bcd (scan$delimiter(':',0,59)); end set$time; bcd$pair: procedure(a,b) byte; declare (a,b) byte; return shl(a,4) or b; end bcd$pair; compute$year: procedure; /* compute year from number of days in word$value */ declare year$length word; year = base$year; do forever; year$length = 365; if (year and 11b) = 0 then /* leap year */ year$length = 366; if word$value <= year$length then return; word$value = word$value - year$length; year = year + 1; end; end compute$year; declare week$day byte, /* day of week 0 ... 6 */ day$list (*) byte data ('Sun$Mon$Tue$Wed$Thu$Fri$Sat$'), leap$bias byte; /* bias for feb 29 */ compute$month: procedure; month = 12; do while month > 0; if (month := month - 1) < 2 then /* jan or feb */ leapbias = 0; if month$days(month) + leap$bias < word$value then return; end; end compute$month; declare date$test byte, /* true if testing date */ test$value word; /* sequential date value under test */ get$date$time: procedure; /* get date and time */ hrs = tod.hrs; min = tod.min; sec = tod.sec; word$value = tod.date; /* word$value contains total number of days */ week$day = (word$value + base$day - 1) mod 7; call compute$year; /* year has been set, word$value is remainder */ leap$bias = 0; if (year and 11b) = 0 and word$value > 59 then /* after feb 29 on leap year */ leap$bias = 1; call compute$month; day = word$value - (month$days(month) + leap$bias); month = month + 1; end get$date$time; emit$date$time: procedure; declare century byte; /* [JCE] century */ century = 19; /* [JCE] start in the 1900s */ call emitn(.day$list(shl(week$day,2))); call emitchar(' '); if get$date$flag = 0 then /* [JCE] US or UK format for dates? */ do; call emit$slant(month); call emit$slant(day); end; else do; call emit$slant(day); call emit$slant(month); end; century = century + (year / 100); /* [JCE] Y2000 fix for output */ year = year mod 100; /* [JCE] */ call emit$bin$pair(century); /* [JCE] end of Y2000 fix for output */ call emit$bin$pair(year); call emitchar(' '); call emit$colon(hrs); call emit$colon(min); call emit$bcd$pair(sec); end emit$date$time; tod$ASCII: procedure (parameter); declare parameter address; declare ret address; ret = 0; tod$adr = parameter; string$adr = .tod.ASCII; if tod.opcode = 0 then do; call get$date$time; index = -1; call emit$date$time; end; else do; if (tod.opcode = 1) or (tod.opcode = 2) then do; chr = string(index:=0); call set$date; call set$time; ret = .string(index); end; else do; go to error; end; end; end tod$ASCII; /******************************************************** ********************************************************/ declare lcltod structure ( opcode byte, date address, hrs byte, min byte, sec byte, ASCII (23) byte ); /* [JCE] 21 -> 23 */ declare datapgadr address; declare datapg based datapgadr address; declare extrnl$todadr address; declare extrnl$tod based extrnl$todadr structure ( date address, hrs byte, min byte, sec byte ); declare i byte; declare ret address; display$tod: procedure; lcltod.opcode = 0; /* read tod */ call mon1(50,.(26,0,0,0,0,0,0,0)); /* BIOS TIME GET SIGNAL */ call move (5,.extrnl$tod.date,.lcltod.date); call tod$ASCII (.lcltod); call write$console (0dh); do i = 0 to 22; /* [JCE] 20 -> 22 */ call write$console (lcltod.ASCII(i)); end; end display$tod; comp: procedure (cnt,parmadr1,parmadr2) byte; declare (i,cnt) byte; declare (parmadr1,parmadr2) address; declare parm1 based parmadr1 (5) byte; declare parm2 based parmadr2 (5) byte; do i = 0 to cnt-1; if parm1(i) <> parm2(i) then return 0; end; return 0ffh; end comp; /************************************** Main Program **************************************/ declare last$dseg$byte byte initial (0); declare CURRENT$VERSION address initial (0); declare CPM30 byte initial (030h); declare MPM byte initial (01h); PLM: do; CURRENT$VERSION = RETURN$VERSION$FUNC; if (low(CURRENT$VERSION) >= CPM30) and (high(CURRENT$VERSION) <> MPM) then do; datapgadr = xdos (49,.(03ah,0)); extrnl$todadr = xdos(49,.(03ah,0)) + 58H; if (FCB(1) = 'C') then do while FCB(1) = 'C'; call mon1(105,.(0,0,0,0)); /* [JCE] this implements Patch 17 */ if comp(5,.extrnl$tod.date,.lcltod.date) = 0 then call display$tod; if check$console$status then do; ret = read$console; fcb(1) = 0; end; end; else if (FCB(1) = ' ') then do; call display$tod; end; else if (FCB(1) = 'S') then do; call crlf; call print$buffer(.('Enter today''s date (','$')); /* [JCE] UK-format */ if get$date$flag then /* [JCE] */ call print$buffer(.('DD/MM/YY): ','$')); /* [JCE] UK format */ else call print$buffer(.('MM/DD/YY): ','$')); /* [JCE] US format */ call move(23,.(000000000000000000000),.buffer$adr.console$buffer); call read$console$buffer(.buffer$adr); if buffer$adr.numb$of$chars > 0 then do; call move(23,.buffer$adr.console$buffer,.lcltod.ASCII); tod$adr = .lcltod; string$adr = .tod.ASCII; chr = string(index := 0); call set$date; call move(2,.lcltod.date,.extrnl$tod.date); end; /* date initialization */ call crlf; call print$buffer(.('Enter the time (HH:MM:SS): ','$')); call move(23,.(000000000000000000000),.buffer$adr.console$buffer); call read$console$buffer(.buffer$adr); if buffer$adr.numb$of$chars > 0 then do; call move(23,.buffer$adr.console$buffer,.lcltod.ASCII); tod$adr = .lcltod; string$adr = .tod.ASCII; chr = string(index := 0); call set$time; call crlf; call print$buffer(.('Press any key to set time ','$')); ret = read$console; call move(3,.lcltod.hrs,.extrnl$tod.hrs); call mon1(50,.(26,0,0ffh,0,0,0,0,0)); /* BIOS TIME SET SIGNAL */ end; call crlf; end; else do; call move (23,.tbuff(1),.lcltod.ASCII); lcltod.opcode = 1; call tod$ASCII (.lcltod); call crlf; call print$buffer (.('Strike key to set time','$')); ret = read$console; call move (5,.lcltod.date,.extrnl$tod.date); call mon1(50,.(26,0,0ffh,0,0,0,0,0)); /* BIOS TIME SET SIGNAL */ call crlf; end; call terminate; end; else do; call CRLF; call PRINT$BUFFER(.('ERROR: Requires CP/M3.','$')); call CRLF; call TERMINATE; end; end; error: do; call crlf; call print$buffer (.('ERROR: Illegal time/date specification.','$')); call terminate; end; end tod;