|
|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 2304 (0x900)
Types: TextFile
Names: »wandd«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »wandd«
\f
boolean procedure weekandday(yymmdd, weeknumber, weekday);
integer yymmdd, weeknumber, weekday;
<*
weekandday (return, boolean) true=>legal date, false=>illegal date
yymmdd (call and return, integer)
if call value is 0 then return
value is actual date
weeknumber (return, integer) weeknumber 1 is first week with a thursday
illegal date: weeknumber -1
weekday (return, integer) 1: monday,...,7: sunday, 8: illegal date
*>
begin integer d,m,y,w;
boolean leap;
if yymmdd=0 then yymmdd:=systime(5,0,0.0);
d:=yymmdd mod 100;
m:=(yymmdd//100) mod 100;
y:=1900 + yymmdd//10000;
leap:=y mod 100<>0 and y mod 4=0 or y mod 400=0;
if m<1 or m>12 then goto illegal;
if d>(case m of(31,if leap then 29 else 28,31,30,31,30,31,31,30,31,30,31))
then goto illegal;
w:=(if m>2 then (if leap then 29 else 28) else 0) +
(case m of
(0,
31,
31,
31+31,
31+31+30,
31+31+30+31,
31+31+30+31+30,
31+31+30+31+30+31,
31+31+30+31+30+31+31,
31+31+30+31+30+31+31+30,
31+31+30+31+30+31+31+30+31,
31+31+30+31+30+31+31+30+31+30)) + d - 1;
\f
if m>2 then m:=m-3 else
begin m:=m+9; y:=y-1; end;
d:=(146097*(y//100))//4+(1461*(y mod 100))//4
+(153*m+2)//5+d+1721119;
d:=d mod 7+1;
w:=w+4-d;
weekandday:=true;
weeknumber:=if w<0 then 0 else (w//7+1);
weekday:=d;
if false then
begin
illegal:
weekandday:=false; weeknumber:=-1; weekday:=8
end;
end weekandday;
▶EOF◀