|
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: 13824 (0x3600)
Types: TextFile
Names: »ga4000tx«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦0f6e8048b⟧ »preditfile«
└─⟦this⟧
\f
comment predit text * page 6 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
comment case 3, ga4000;
_______________________
begin
integer char, i, j, k, s, h, q, u, w, vm, dm, m;
boolean SP, rp, wp, first_begin;
real v;
integer array cp(97:125, 0:2), cpi(1:37, 0:2), cl(0:383),
alfabet(0:255), ttab, htab(1:5, 1:10);
array cps(1:37), val(0:383), rz, wz(1:2);
zone input(25, 1, stop), output(256, 2, stderror);
procedure stop(z, s, b); zone z; integer s, b;
if s extract 1=1 then stderror(z, s, b) else if b=0 then goto exit;
integer procedure inchar;
begin integer i, j;
i:=readchar(input, char);
if i<>9 then inchar:=char else
begin
for i:=readchar(input, j) while i=9 do;
inchar:=char:=j+char
end;
end inchar;
integer procedure readsymbol(v, k); real v; integer k;
begin integer i;
i:=cl(inchar); if i<>8 then
begin k:=i; v:=val(char); readsymbol:=char end
else readsymbol:=compound(v, k);
end readsymbol;
integer procedure compound(v, k); real v; integer k;
begin integer a, n, f, i1, i2, i; own boolean notfirst;
f:=16; a:=val(char) shift (-24) extract 24;
i:=a shift (-16) extract 8;
n:=cp(i, 0); if n=0 then goto F;
i1:=cp(i, 1); i2:=cp(i, 2);
for i:=2 step 1 until n do
begin
for j:=cl(inchar) while j<>8 do;
f:=f-8; a:=a+(char mod 128) shift f
end;
for i:=i1 step 1 until i2 do if a=cpi(i, 0) then
begin
compound:=i; k:=cpi(i, 1); n:=cpi(i, 2)-n; v:=cps(i);
for j:=1 step 1 until n do for a:=cl(inchar) while a<>8 do;
goto E
end;
F:
compound:=0; k:=10; v:=real <:<63>:>;
E:
if i=12 then vm:=vm-2 else if i=3 then
begin if -, notfirst then notfirst:=first_begin:=true; dm:=2 end
end compound;
\f
comment predit text * page 7 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
procedure flexotable(t); integer array t;
begin comment read flexowritercode in tro-mode;
integer i, k, c;
integer procedure ISO(f); value f; integer f;
begin integer i, n; boolean p;
n:=0; p:=true;
for i:=1 step 1 until 7 do
begin
if f mod 2=1 then
begin p:=-, p; n:=n+(case i of (1, 2, 4, 8, 32, 64, 0)) end;
f:=f shift (-1)
end;
ISO:=(if p then n+16 else n)+(f mod 128)*128
end ISO;
for i:=0 step 1 until 255 do t(i):=0;
t(ISO(60)):=1 shift 12 +128; t(ISO(58+128)):=1 shift 12;
k:=48;
for i:=16, 1 step 1 until 9 do
t(ISO(i)):=2 shift 12+increase(k);
t(ISO(32)):=3 shift 12 +45; t(ISO(32+128)):=3 shift 12+43;
t(ISO(59)):=4 shift 12 +46;
t(ISO(27+128)):=5 shift 12 +39;
k:=65;
for i:=49 step 1 until 57, 33 step 1 until 41,
18 step 1 until 25, 48, 43, 13 do
begin
c:=ISO(i); t(c+128):=6 shift 12+k;
t(c):=6 shift 12+k+32; k:=k+1
end;
k:=1;
for i:=0, 128, 129, 144, 134, 136, 135, 137,
130, 27, 131, 187, 133, 17, 132, 145 do
t(ISO(i)):=7 shift 12 +( case increase(k) of
(32, 32, 33, 38, 40, 40, 41, 41, 42, 44, 47, 58, 59, 60, 61, 62));
c:=ISO(64); t(c):=t(c+128):=8 shift 12 +10;
c:=ISO(11); t(c):=t(c+128):=8 shift 12+12;
c:=ISO(44); t(c):=t(c+128):=8 shift 12+12;
c:=ISO(12); t(c):=t(c+128):=8 shift 12+25;
t(ISO( 14)):=9 shift 12+128;
t(ISO(142)):=9 shift 12+256;
intable(t)
end flexotable;
\f
comment predit text * page 8 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
procedure checkw(B); label B;
begin
integer i, j, n; array stv(1:7);
write(output, <:w:>); for i:=1 step 1 until 4 do
begin
u:=readsymbol(v, k);
if u<>(case i of(114, 105, 116, 101)) then goto B;
write(output, string v)
end;
for u:=readsymbol(v, k) while u=32 and k=1 do;
if u<>40 then
begin
if u=116 then begin n:=4; j:=1 end else
if u=105 then begin n:=7; j:=2 end else goto B;
for i:=1 step 1 until n do
begin
for u:=readsymbol(v, k) while u=32 or k=1 do;
stv(n):=v;
if u<> (case j of(
case i of(101, 120, 116, 40),
case i of(110, 116, 101, 103, 101, 114, 40))) then
begin
for i:=1 step 1 until n-1 do write(output, string stv(i));
goto B
end
end
end ;
i:=1; write(output, <:(:>, string wz(increase(i)), <:, :>)
end checkw;
procedure insert(i); value i; integer i;
begin
integer j, k;
case i of
begin
begin comment readproc;
k:= j:= i:=1; write(output,<:
integer char;
integer procedure readinteger;
begin integer i;
read(:>,string rz(increase(i)),<:,i);
repeat<95>char(:>, string rz(increase(j)), <:);
read<95>char(:>, string rz(increase(k)), <:, char);
readinteger:=i
end readinteger;
:>);
k:= j:= i:=1; write(output,<:
real procedure readreal;
begin real r;
read(:>,string rz(increase(i)),<:,r);
repeat<95>char(:>, string rz(increase(j)), <:);
read<95>char(:>, string rz(increase(k)), <:, char);
readreal:=r
end readreal;
:>);
i:= 1; write(output, <:
integer procedure lyn;
begin
read<95>char(:>, string rz(increase(i)), <:, char);
lyn:= char
end lyn; :>);
end case 1;
\f
comment predit text * page 9 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
begin comment writeproc;
i:=1;
write(output,<:
boolean array isovalue(0:131);
boolean procedure initiso(v); boolean array v;
begin integer i,j;
for i:=0 step 1 until 131 do v(i):=false;
for i:=0,66 do v(i):=sp;
for i:=64,130 do v(i):=nl;
for i:=1 step 1 until 9,16 do v(i):=false add (48+i mod 16);
j:=64;
for i:=49 step 1 until 57,33 step 1 until 41,
18 step 1 until 25,48,43,13 do
begin
j:=j+1;
v(i):=false add (j+32);
v(i+66):=false add j
end;
for i:=1 step 1 until 9 do
v(66+i):=false add (case i of(33,42,47,61,59,40,41,40,41));
v(66+16):=false add 38; v(65):=v(131):=false add 12;
j:=1;
for i:=11,12,14,15,17,27,30,32,44,59 do
begin
v(i):=false add (case j of(12,25,95,37,60,44,9,45,42,46));
v(i+66):=false add (case j of(12,25,33,38,62,39,9,43,39,58));
j:=j+1
end;
initiso:=true
end;
procedure writechar(c); value c; integer c;
begin own boolean initialized; own integer outindex;
if -,initialized then initialized:=initiso(isovalue);
if c>64 then c:=65; if c=58 then outindex:=0 else
if c=60 then outindex:=66 else
write(:>,string wz(increase(i)),<:,isovalue(outindex+c),1)
end;
procedure writecr; writechar(64);
:>)
end case 2;
end case i;
first_begin:=false
end insert;
\f
comment predit text * page 10 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
begin comment scan parameterlist;
array a(1:2); integer array t(1:10);
zone z(1, 1, stderror);
integer i, p;
integer procedure alarm; alarm:=system(9, 0, <:<10>***param:>);
rp:=wp:=first_begin:=false;
wz(1):=real<:out:>; rz(1):=real<:in:>; m:=2;
if readparam(a)>=0 then alarm;
i:=1; open(z, 0, string a(increase(i)), 0);
if monitor(42, z, 0, t)<>0 then
begin
t(1):=36;
for i:=2 step 1 until 10 do t(i):=0;
if monitor(40, z, 0, t) <> 0
or monitor(42, z, 0, t) <> 0 then alarm;
end;
close(z, false);
if t(9)<>0 then alarm; p:=t(1);
if p>0 then p:=4 else
begin
p:=(p shift 1)shift(-1);
for i:=1, 2 do a(i):=
0.0 shift 24 add t(2*i) shift 24 add t(2*i+1)
end;
i:=1; open(output, p, string a(increase(i)), 0);
setposition(output, t(7), t(8));
for i:=readparam(a) while i>0 do
begin
if i<>2 then alarm;
for i:=1 step 1 until 5 do
if a(1)=real( case i of
(<:rz:>, <:wz:>, <:rp:>, <:wp:>, <:m:>)) then goto A;
alarm;
A:
if readparam(a)<>4 then alarm;
if i>2 then p:=
if a(1)=real<:yes:> then 1 else
if a(1)=real<:no:> then 2 else alarm;
case i of
begin
begin rz(1):=a(1); rz(2):=a(2) end;
begin wz(1):=a(1); wz(2):=a(2) end;
rp:=p=1; wp:=p=1; m:=p
end
end
end scan parameterlist;
\f
comment predit text * page 11 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
begin comment initialisering af tegntabel;
integer class; real zero;
procedure p(i); value i; integer i;
begin cl(i):=class; val(i):=zero add i shift 40 end;
procedure q(i, s); value i; integer i; string s;
begin cl(i):=class; val(i):=real s end;
zero:=0.0 shift 24;
for i:=0 step 1 until 383 do
begin cl(i):=0; val(i):=zero end;
class:=1; p(32);
class:=2; p(10); p(12);
class:=3;
for i:=39 step 1 until 47, 58 step 1 until 62 do p(i);
class:=4;
q(128+58, <://:>); q(128+60, <:<=:>); q(128+61, <:==:>);
q(128+62, <:>=:>); q(256+38, <:**:>); q(256+61, <:<>:>);
cl(256+60):=5;
class:=7; q(128+44, <:<95>:>);
for i:=65 step 1 until 93 do
begin
for j:=0, 32 do p(i+j);
cl(i+128+32):=8; val(i+32+128):=val(i+32)
end;
cl(66+128):=8; val(66+128):=val(98);
for i:=48 step 1 until 57 do
begin
p(i); cl(128+i):=7;
val(128+i):=zero add (256*95+i) shift 32
end;
cl(119):=6;
class:=10; q(33, <:or:>); q(38, <:and:>);
end initialisering af tegntabel;
\f
comment predit text * page 12 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
comment initialisering af compoundtabeller;
for i:=1 step 1 until 37 do
begin
cpi(i, 0):=(real(case i of(
<:ab:>, <:ar:>, <:be:>, <:bo:>,
<:cas:>, <:cod:>, <:com:>, <:cop:>, <:cor:>,
<:do:>, <:els:>, <:end:>, <:ent:>,
<:fa:>, <:fo:>, <:fi:>, <:got:>,
<:if:>, <:in:>, <:la:>, <:me:>, <:mo:>,
<:of:>, <:ow:>, <:pa:>, <:pr:>, <:re:>, <:ro:>,
<:shi:>, <:swi:>, <:ste:>, <:str:>,
<:th:>, <:tr:>, <:un:>, <:va:>, <:wh:>)))
shift (-24) extract 24;
cpi(i, 1):=10; cpi(i, 2):=case i of (
3, 5, 5, 7,
4, 4, 7, 4, 4,
2, 4, 3, 6,
5, 3, 5, 4,
2, 7, 5, 7, 3,
2, 3, 4, 9, 4, 5,
5, 6, 4, 6,
4, 4, 5, 5, 5, 4);
cps(i):=real ( case i of (
<:abs:>, <:array:>, <:begin:>, <:boolean:>,
<:case:>, <:comment code:>, <:comment:>, <:comment copy:>,
_ <:comment core:>,
<:do:>, <:else:>, <:end:>, <:entier:>,
<:false:>, <:for:>, <:comment finis; :>, <:goto:>,
<:if:>, <:integer:>, <:label:>, <:message:>, <:mod:>,
<:of:>, <:own:>, <:*_page_:>, <:procedure:>, <:real:>, <:round:>,
<:shift:>, <:switch:>, <:step:>, <:string:>,
<:then:>, <:true:>, <:until:>, <:value:>, <:while:>))
end;
for i:=8 do cpi(i, 1):=8; for i:=6 do cpi(i, 1):=9;
for i:=97 step 1 until 125 do
begin
cp(i, 0):=case i-96 of (
2, 2, 3, 2, 3, 2, 3, 0, 2, 0,
0, 2, 2, 0, 2, 2, 0, 2, 3, 2,
2, 2, 2, 0, 0, 0, 0, 0, 0);
cp(i, 1):=case i-96 of (
1, 3, 5, 10, 11, 14, 17, 0, 18, 0,
0, 20, 21, 0, 23, 25, 0, 27, 29, 33,
35, 36, 37, 0, 0, 0, 0, 0, 0);
cp(i, 2):=case i-96 of(
2, 4, 9, 10, 13, 16, 17, 0, 19, 0,
0, 20, 22, 0, 24, 26, 0, 28, 32, 34,
35, 36, 37, 0, 0, 0, 0, 0, 0)
end;
\f
comment predit text * page 13 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
comment initialisering af tilstands/handlingstabeller;
for i:=1 step 1 until 5 do
for j:=1 step 1 until 10 do
begin
ttab(i, j):=case j of (case i of(m, 2, 4, 4, 2),
m, 2, 2, 2, 3, 3, 2, 2, 5);
htab(i, j):=case i of(
case j of (0, 4, 5, 5, 9, 13, 5, 17, 49, 5),
case j of (4, 4, 4, 4, 8, 12, 4, 16, 48, 4),
case j of (0, 4, 4, 4, 8, 4, 4, 18, 50, 6),
case j of (0, 4, 4, 6, 10, 7, 7, 18, 50, 6),
case j of (4, 4, 4, 4, 8, 14, 6, 18, 50, 6))
end;
flexotable(alfabet);
vm:=dm:=0; s:=1; SP:=sp;
open(input, 10, <:reader:>, 1 shift 18);
\f
comment predit text * page 14 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
for u:=readsymbol(v, k) while true do
begin
B:
w:=htab(s, k); s:=ttab(s, k);
h:=w mod 4; w:=w//4; if h<>0 then
begin
case h of
begin
begin write(output, SP, vm); vm:=vm+dm; dm:=0 end;
write(output, SP, 1);
write(output, false add 95, 1)
end
end;
h:=w mod 8; w:=w//8; if h<>0 then
begin
case h of
begin
write(output, string v);
if inchar<>60 then
begin
for i:=60, 60, char, inchar while i<>318, 62 do
write(output, if i=112 then <:z:> else
if i=110 then <:d:> else string val(i))
end else for i:=60, 58, inchar while i<>318, 58, 62 do
write(output, string val(i));
checkw(B);
begin
write(output, string v); j:=if u=8 then 60 else 59;
for i:=readchar(input, q) while q<>j, j do
write(output, false add q, 1);
if j=60 then write(output, <:; :>)
end
end
end;
if w<>0 then
begin
for i:=inchar while i<>229 do
if i=59 then
begin for i:=readchar(input, q) while q<>10 do end
end skip code;
if first_begin then
begin if rp then insert(1); if wp then insert(2); rp:=wp:=false end
end konvertering;
exit:
write(output, <:<10><25>:>); close(input, true); close(output, true)
end case 3, ga4000;
▶EOF◀