DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦656d2e514⟧ TextFile

    Length: 2304 (0x900)
    Types: TextFile
    Names: »wandd«

Derivation

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦this⟧ »wandd« 

TextFile


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