dynamic routine spec prompt(string (15) s) dynamic routine spec rdint(integer name i) system string fn spec itos(integer i) system routine spec uctranslate(integer adr, len) routine uctran(string name s) uctranslate(addr(s)+1, length(s)) end {uctran} routine kdate(integer name d, m, y, integer k) ! INPUT PARAMETER K IS DAYS SINCE 1ST JAN 1900 ! RETURNS D, M, Y 2 DIGIT Y ONLY ! %integer W ! K=K+693902 {days since Cleopatras birthday} ! W=4*K-1 ! Y=W//146097 ! K=W-146097*Y ! D=K//4 ! K=(4*D+3)//1461 ! D=4*D+3-1461*K ! D=(D+4)//4 ! M=(5*D-3)//153 ! D=5*D-3-153*M ! D=(D+5)//5 ! Y=K *lss_k; *iad_693902 *imy_4; *isb_1; *imdv_146097 *lss_ tos ; *idv_4; *imy_4; *iad_3 *imdv_1461; *st_(y) *lss_ tos ; *iad_4; *idv_4 *imy_5; *isb_3; *imdv_153 *st_(m); *lss_ tos *iad_5; *idv_5; *st_(d) if m<10 then m=m+3 else start m=m-9 if y=99 then y=0 else y=y+1 finish end {kdate} integer fn day no const long integer jms= x'141DD76000' ! This number is the number of microeconds in a day ! x'141DD76000000' is the number of IBM clock-units in ! a day. A clock unit is the time increment denoted by ! bit 63 of the TOD clock and CPU timer. *rrtc_0 *ush_-1; ! This is a right-shift *shs_1; ! left *ush_1; ! left *idv_jms *stuh_ b *exit_-64 end {dayno} routine ibm clock(longintegername clock) longinteger xxx *rrtc_0; ! 8.1.3.11 *ush_-1; ! This is a right-shift *shs_1; ! left *ush_13; ! left ! ACC now contains a number of IBM clock units *st_xxx clock=xxx end {IBM clock} integer fn kday(integer d, m, y) ! This is the inverse function of KDATE if m>2 then m=m-3 else m=m+9 and y=y-1 result =1461*y//4+(153*m+2)//5+d+58 end {kday} string fn itosp(integer i, pl) string (255) s s=itos(i) s="0".s while length(s)<pl result =s end {itosp} !----------------------------------------------------------------------------- string fn datestring(integer type) ! Type 1 06/06/83 ! Type 2 1st Sep 83 ! Type 3 1st September 1983 ! Type 4 1st Septmeber, 1983 ! Type 5 1 SEP 83 ! Type 6 01 SEP 83 ! Type 7 01SEP83 ! Type 8 WED ! Type 9 Wednesday const string (9) array day(0:6)="Monday","Tuesday","Wednesday","Thursday", "Friday","Saturday","Sunday" const integer sun=6,mon=0,tue=1,wed=2,thu=3,fri=4,sat=5 const string (2) array tags(0:4)="th", "st", "nd", "rd", "th" const string (10) array months(1:12)="January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December" integer k, todayno string (71) ordinal, tag, s record format df(integer y, m, d, dayno, dayname) record (df) today constinteger toptype=9 switch dtype(1:toptype) todayno=dayno kdate(today_d, today_m, today_y, todayno) today_dayname=todayno-7*(todayno//7) today_dayno=todayno k=today_d k=k-(k//10)*10 while not 0<=k<=9 k=4 if k>4 tag=tags(k) ordinal=itos(today_d).tag unless 0<type<=toptype then type=1 ->dtype(type) dtype(1): ! 06/06/83 result =itosp(today_d, 2)."/".itosp(today_m, 2)."/".itosp(today_y, 2) dtype(2): ! 1st Sep 83 s=months(today_m) length(s)=3 result =ordinal." ".s." ".itosp(today_y, 2) dtype(3): ! 1st September 1983 dtype(4): ! 1st September, 1983 s=months(today_m) s=ordinal." ".s s=s."," if type=4 result =s." 19".itosp(today_y, 2) dtype(5): ! 1 SEP 83 dtype(6): ! 01 SEP 83 dtype(7): ! 01SEP83 s=months(today_m) length(s)=3 uctran(s) if type=7 then type=6 else s=" ".s." " result =itosp(today_d, type-4).s.itosp(today_y, 2) dtype(8): ! WED dtype(9): ! Wednesday s=day(today_d) if type=8 then length(s)=3 and uctran(s) result =s end {datestring} external routine testdate(string (255) s) integer type, d, m, y longinteger clock, musecs, day from 1900 ibm clock(clock) musecs=clock>>12 day from 1900=musecs//x'141DD76000' kdate(d, m, y, day from 1900) write(d, 1); write(m, 1); write(y, 1); newline return cycle prompt("Date-type: ") rdint(type) exit if type<=0 printstring(datestring(type)) newline exit if type<=0 repeat end {testdate} end of file