|
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 - download
Length: 69120 (0x10e00)
Types: TextFile
Names: »hkovedl «
└─⟦cde9d517b⟧ Bits:30007477 RC8000 Backup tape fra HT's bus-radio system
└─⟦6a563b143⟧
└─ ⟦this⟧ »hkovedl «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─ ⟦this⟧ »hkovedl «
▶14◀P
▶13◀daytext▶0b◀disc`▶04◀▶89◀▶c7◀c
▶13◀dohko▶01◀disc^x▶d9◀▶d0◀s
▶13◀genhtnames▶01◀discy▶8a◀▶7f◀▶e4◀▶e0◀
▶13◀geotext2disc`▶04◀▶8b◀▶04◀▶03◀▶c3◀
▶13◀htsavenames▶03◀discy▶8a◀▶96◀▶04◀2▶9b◀
▶13◀måldummyma▶01◀discZiV▶04◀G▶eb◀
▶13◀nimtx«bs»discc0▶81◀▶04◀▶c3◀▶13◀FOpagetext▶02◀discd▶b3◀▶1e◀▶04◀▶e3◀+FOprinttext▶03◀discd▶ba◀!▶05◀▶11◀▶9b◀
▶13◀slangovers▶01◀discY▶e2◀i▶05◀!▶e0◀
▶13◀søgordtx▶02◀discf▶88◀▶d7◀▶05◀F`
▶13◀tegnsættx▶01◀discd▶8b◀#▶05◀Sæ
▶13◀testtermtx▶02◀discy*0▶05◀r0▶0b◀▶0b◀venttx▶01◀discs▶8f◀O▶0e◀
begin
integer leadingzero,val,class,nr,place,oldclass,lastroma,
day,month,year,j,n,i,t,s,a,r,oO,p,used,c2,c3,c4,c5,c6,c9,c100;
boolean ly,letter,minus,arab,roma; boolean array toobig(1:3);
integer array term(2:4),date(1:3),C,V(1:30),alfa(0:127);
procedure roman(j,nine,four,five,one);
integer j,one; string nine,four,five;
begin integer i;
year:=year mod (10*j);
i:=year//j;
if i>=c4 then
begin
write(out,if i=c9 then nine else
if i=c4 then four else five);
i:=if i=c9 then 0 else i-c5
end;
write(out,false add one,i);
end;
procedure MONTH(month); integer month;
write(out,case month of (
<:January:>,<:February:>,<:March:>,
<:April:>,<:May:>,<:June:>,<:July:>,
<:August:>,<:September:>,<:October:>,
<:November:>,<:December:>) );
procedure alarmexit;
begin
write(out,<:<10>this is not a date, try again<10>:>);
goto TYPEIN
end;
integer procedure weekday(d,m,y);
value d,m,y;integer d,m,y;
begin
if m>c2 then m:=m-c3 else
begin
m:=m+c9;
y:=y-1
end;
d:=(146097*(y//c100))//c4 + (1461*(y mod c100))//c4
+(153*m+c2)//c5 + d + 1721119;
d:=d mod 7 + c2;
weekday:=if d>7 or d<1 then 1 else d
end weekday;
j:=12; c2:=2; c3:=3; c4:=4; c5:=5; c6:=6; c9:=9; c100:=100;
n:=c9 shift j; comment NL;
i:= 8 shift j; comment illegal;
s:= 7 shift j; comment minus, value is 4;
t:=c6 shift j; comment normal terminator, value: sp=1, .=2, /=3;
p:=c5 shift j; comment l, either one or 50;
r:=c4 shift j; comment roman;
oO:=c3 shift j; comment o and O, treated as zero;
a:=c2 shift j; comment arab;
for j:=0 step 1 until 69 do
alfa(j):=case j+1 of (
0, 0, 0, 0, 0, 0, 0, 0, i, 0,
n, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, t+1 , i, i, i, i, i, i, i,
i, i, i, i, i, s+c4, t+c2, t+c3, a+0 , a+1 ,
a+c2, a+c3, a+c4, a+c5, a+c6, a+7 , a+8 , a+c9, i, i,
i, i, i, i, i, i, i,r+c100,r+500 , i);
for j:=70 step 1 until 127 do
alfa(j):= case j-69 of(
i, i, i,r+1 , i, i,r+50 ,r+1000, i, oO,
i, i, i, i, i, i,r+c5 , i,r+10 , i,
i, i, i, i, i, i, i, i, i,r+c100,
r+500, i, i, i, i,r+1 , i, i,p+50 ,r+1000,
i+110, oO, i, i, i, i, i, i,r+c5 , i,
r+10, i, i, i, i, i, i, 0);
intable(alfa);
write(out,<:<10>D A Y in W E E K<10>type day month year:>,
<:<10>Arabic or Roman numerals<10>:>);
TYPEIN:
write(out,<:<10>type date: :>); setposition(out,0,0);
place:=1;
for class:=readchar(in,val) while class<>c9 do
begin
C(place):=class;
V(place):=val;
if place<30 then place:=place+1
end;
if place=30 or place=1 then goto TYPEIN ;
used:=place-1;
if used=c2 and V(1)=110 and C(c2)=c3 then goto EXIT;
date(1):= date(c2):=date(c3):=
lastroma:=leadingzero:=place:=
term(c2):=term(c3):=term(c4):=0;
toobig(1):=toobig(c2):=toobig(c3):=
letter:=minus:=arab:=false;
nr:=1; class:=6;
NEXT:
oldclass:=class;
place:=place+1;
class:=C(place);
val:=V(place);
again:
case class-1 of
begin
comment arab;
begin
if nr>3 then alarmexit;
if-,arab and date(nr)=50 then date(nr):=1 else
if -, arab and oldclass<>c6 then alarmexit;
if date(nr)>800000 then toobig(nr):=true;
date(nr):=date(nr)*10+val;
if nr=c3&date(nr)=0 then leadingzero:=leadingzero+1;
arab:=true
end;
comment o or O;
if roma and oldclass<>c6 then alarmexit else
begin
letter:=true;
class:=c2;
goto again;
end;
comment roma;
if arab and oldclass<>c6 or nr>c3 then alarmexit else
begin
if date(nr)>800000 then toobig(nr):=true;
date(nr):=date(nr)+
(if val>lastroma then val-2*lastroma else val);
arab:=false;
lastroma:=val
end;
comment l;
if arab or oldclass=c6 and nr<c3 then
begin
val:=1;
class:=c2;
letter:=true;
goto again
end
else begin class:=c4; goto again end;
comment terminator;
if oldclass<c6 then
begin
nr:=nr+1; lastroma:=0; arab:=false;
if nr=c4 and val>c2 then alarmexit;
term(nr):=val
end
else
begin
if nr=1 or nr=4 then
begin
if nr=1 and val<>1 then alarmexit;
if nr=c4 then
begin
if (val>c2 or val=c2 and term(nr)=2) then alarmexit;
end
end
else
if val<>1 then
begin
if nr=c2 and term(nr)<>1 or
nr=c3 and term(nr)<>1 and -,minus then alarmexit;
if -,minus or nr=c4 then term(nr):=val
end
end;
comment minus;
begin
if term(c2)=term(c3) and nr=c3
or term(c2)=1 and oldclass<c6 and nr=c2 then minus:=true;
class:=c6;
goto again
end;
comment illegal; alarmexit;
end;
if place<used then goto NEXT;
if term(c2)<>term(c3) and -,(term(c3)=c4 and term(c2) mod c2=1
or term(c3)=1 and term(c2)=c3) then alarmexit;
if nr<c3 and date(1)<10100 or nr=c3 and class>c5
or nr<c3 and -,arab then alarmexit;
if arab then
begin
if date(c2)=0&date(c3)=0 and nr<c3 then
begin
date(c3):=date(1) mod c100;
date(c2):=(date(1)//c100) mod c100;
date( 1):=date(1) // 10000;
end;
if leadingzero>0 then
begin
if date(c3)<10&leadingzero=1 then leadingzero:=0
end;
if date(c3)<c100&leadingzero=0 and -,minus then
date(c3):=date(c3)+1900;
end;
if minus then date(c3):=-date(c3);
day:=date(1); month:=date(c2); year:=date(c3);
ly:=year mod 400=0 or year mod c100<>0 and year mod c4=0;
if day=0 then
begin
write(out,<:no month has 0 days<10>:>);
goto TYPEIN
end;
if year=0 then
begin
write(out,<:I am sure there never was a year 0<10>:>);
goto TYPEIN
end;
if toobig(c3) or abs year>5740 then
begin
write(out,if minus then <:this is too long ago for me<10>:>
else <:our planet is gone by that time<10>:>);
goto TYPEIN
end;
if month<1 or month>12 or toobig(c2) then
begin
write(out,<:no such month<10>:>);
goto TYPEIN
end;
if month=c2 and day=29 and -,ly then
begin
write(out,<<d>,year,<: is not a leap year<10>:>);
goto TYPEIN
end;
nr:=if month=c2 and ly then 29 else if month=c2 then 28 else
if month=c4 or month=c6 or month=c9 or month=11 then 30 else 31;
if day>nr or toobig(1) then
begin
MONTH(month);
if month=c2 then write(out,<<d>,<:, :>,year);
write(out,<: has only:>,nr,<: days<10>:>);
goto TYPEIN
end;
write(out,case weekday(day,month,if year<0 then year+1 else year) of
(<:Sun:>,<:Mon:>,<:Tues:>,<:Wednes:>,
<:Thurs:>,<:Fri:>,<:Satur:>),<:day :>,
<<d>,day,
if day= 1 or day=21 or day=31 then <:st:> else
if day=c2 or day=22 then <:nd:> else
if day=c3 or day=23 then <:rd:> else <:th:>,<: of :>);
MONTH(month);
write(out,<:,:>,<< d>,year,<: - anno :>);
year:=abs year;
write(out,false add 77,year//1000);
roman(c100,<:CM:>,<:CD:>,<:D:>,67);
roman( 10,<:XC:>,<:XL:>,<:L:>,88);
roman( 1,<:IX:>,<:IV:>,<:V:>,73);
if minus then write(out,<: BC:>);
if letter then
write(out,<:<10>you used a letter in the date:>);
write(out,<:<10>:>);
setposition(out,0,0);
goto TYPEIN;
EXIT:
write(out,<:okay<10>:>);
end
▶EOF◀