|
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◀