|
|
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: 12288 (0x3000)
Types: TextFile
Names: »treadcon«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦e4d872f9f⟧ »cproc«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦e4d872f9f⟧ »cproc«
└─⟦this⟧
;copyright Anders Lindgård, february 1976;
mode list.yes
readb=algol
procedure for reading a boolean in conversational mode
23 02 76 10 00 00
external
boolean procedure readb(text);
string text;
begin
integer s,x,j;
array TXT(1:1);
boolean equal,tr,fa;
integer array i,o(1:20);
getzone6(in,i);
getzone6(out,o);
equal:=true;
for x:=2,3,4,5 do begin
if i(x)<>o(x) then equal:=false
end;
tr:=fa:=false;
l:write(out,<:<10>:>,text,<: ? :>);
if o(1)<>4 then outendcur(0);
readchar(in,x); repeatchar(in);
if x=25 then alarm(<:***device status in<10>source exhausted:>);
s:= readstring(in,TXT,1); x:= 0;
if s>0 then
begin repeatchar(in); readchar(in,x); end;
if x<>10 then
begin for s:=s while s<>10 do readchar(in,s);
goto l end;
for j:=1,2,3,4 do begin
if TXT(1)=real (case j of (<:yes:>,<:true:>,<:ja:>,<:sand:>))
then tr:=true else
if TXT(1)=real (case j of(<:no:>,<:false:>,<:nej:>,<:falsk:>))
then fa:=true;
end;
if fa==tr then goto l;
readb:=if tr then true else false;
s:= 1;
if -,equal then begin write(out,string TXT(increase(s)));
outendcur(0) end;
end;end;
readl=algol
procedure for reading a long in conversational mode
24 2 76 10 30 00
external
long procedure readl(text);
string text;
begin
integer s,x;
long lo;
boolean equal;
integer array i,o(1:20);
getzone6(in,i);
getzone6(out,o);
equal:=true;
for x:=2,3,4,5 do begin
if i(x)<>o(x) then equal:=false
end;
l:write(out,<:<10>:>,text,<: = :>);
if o(1)<>4 then outendcur(0);
readchar(in,x); repeatchar(in);
if x=25 then alarm(<:***device status in<10>source exhausted:>);
s:=read(in,lo); x:=0;
if s=1 then
begin repeatchar(in); readchar(in,x); end;
if x<>10 then
begin for x:=x while x<>10 do readchar(in,x);
goto l end;
if -,equal then begin write(out,lo); outendcur(0) end;
readl:=lo;
end;end;
readi=algol
procedure for reading of integers in conversational mode
08 2 76 14 00 00
external
integer procedure readi(text);
string text;
begin
integer s,x;
integer int;
boolean equal;
integer array i,o(1:20);
getzone6(in,i);
getzone6(out,o);
equal:=true;
for x:=2,3,4,5 do begin
if i(x)<>o(x) then equal:=false
end;
l:write(out,<:<10>:>,text,<: = :>);
if o(1)<>4 then outendcur(0);
readchar(in,x); repeatchar(in);
if x=25 then alarm(<:***device status in<10>source exhausted:>);
s:=read(in,int); x:=0;
if s=1 then
begin repeatchar(in); readchar(in,x); end;
if x<>10 then
begin for x:=x while x<>10 do readchar(in,x);
goto l end;
if -,equal then begin write(out,int); outendcur(0) end;
readi:=int;
end;end;
readr=algol
procedure for reading a real in conversational mode
09 2 76 10 00 00
external
real procedure readr(text);
string text;
begin
integer s,x,ovfl;
real r;
boolean equal;
integer array i,o(1:20);
getzone6(in,i);
getzone6(out,o);
equal:=true;
for x:=2,3,4,5 do begin
if i(x)<>o(x) then equal:=false
end;
l:write(out,<:<10>:>,text,<: = :>);
if o(1)<>4 then outendcur(0);
readchar(in,x); repeatchar(in);
if x=25 then alarm(<:***device status in<10>source exhausted:>);
ovfl:=overflows; overflows:=0;
s:=read(in,r);
overflows:=ovfl;
if if r<=0 then false else r=maxreal then goto l;
x:=0;
if s=1 then
begin repeatchar(in); readchar(in,x); end;
if x<>10 then
begin for x:=x while x<>10 do readchar(in,x);
goto l end;
if -,equal then begin
real ra;
integer layc,k;
ra:=abs r;
layc:=if ra=0 then 0 else entier (ln(ra)/ln(10));
if layc<0 then layc:=1 else
layc:=layc//3+2;
if layc>6 then layc:=6;
ra:=real (case layc of(<<-f.dd0 000 000 00'-ddd>,
<<-ddd.d00 000 000>,<<-ddd ddd.d00 000>,
<<-ddd ddd ddd.d00>,<<-ddd ddd ddd ddd>,
<<-ddd ddd ddd ddd'+d>));
write(out,string ra,r);
outendcur(0) end;
readr:=r;
end;end;
reads=algol
procedure for reading a string in conversational mode
08 2 76 18 00 00
external
integer procedure reads(text,TXT);
string text;
real array TXT;
begin
integer s,x;
boolean equal;
integer array i,o(1:20);
getzone6(in,i);
getzone6(out,o);
equal:=true;
for x:=2,3,4,5 do begin
if i(x)<>o(x) then equal:=false
end;
l:write(out,<:<10>:>,text,<: = :>);
if o(1)<>4 then outendcur(0);
readchar(in,x); repeatchar(in);
if x=25 then alarm(<:***device status in<10>source exhausted:>);
cleararray(TXT);
reads:=s:= readstring(in,TXT,1); x:= 0;
if s>0 then
begin repeatchar(in); readchar(in,x); end;
if x<>10 then
begin for x:=x while x<>10 do readchar(in,x);
goto l end;
s:= 1;
if -,equal then begin write(out,string TXT(increase(s)));
outendcur(0) end;
end;end;
writeend=algol
external procedure writeend;
begin
outendcur(0);
end;end;
readll=algol
procedure for reading a long in conversational mode
24 2 76 10 30 00
external
long procedure readll(text,ll,ul);
value ll,ul; long ll,ul;
string text;
begin
integer s,x;
long lo;
boolean equal;
integer array i,o(1:20);
getzone6(in,i);
getzone6(out,o);
equal:=true;
for x:=2,3,4,5 do begin
if i(x)<>o(x) then equal:=false
end;
l:write(out,<:<10>:>,text,<: = :>);
if o(1)<>4 then outendcur(0);
readchar(in,x); repeatchar(in);
if x=25 then alarm(<:***device status in<10>source exhausted:>);
s:=read(in,lo); x:=0;
if s=1 then
begin repeatchar(in); readchar(in,x); end;
if x<>10 then
begin for x:=x while x<>10 do readchar(in,x);
goto l end;
if lo<ll or lo>ul then goto l;
if -,equal then begin write(out,lo); outendcur(0) end;
readll:=lo;
end;end;
readil=algol
procedure for readilng of integers in conversational mode
08 2 76 14 00 00
external
integer procedure readil(text,ll,ul);
value ll,ul; integer ll,ul;
string text;
begin
integer s,x;
integer int;
boolean equal;
integer array i,o(1:20);
getzone6(in,i);
getzone6(out,o);
equal:=true;
for x:=2,3,4,5 do begin
if i(x)<>o(x) then equal:=false
end;
l:write(out,<:<10>:>,text,<: = :>);
if o(1)<>4 then outendcur(0);
readchar(in,x); repeatchar(in);
if x=25 then alarm(<:***device status in<10>source exhausted:>);
s:=read(in,int); x:=0;
if s=1 then
begin repeatchar(in); readchar(in,x); end;
if x<>10 then
begin for x:=x while x<>10 do readchar(in,x);
goto l end;
if int<ll or int>ul then goto l;
if -,equal then begin write(out,int); outendcur(0) end;
readil:=int;
end;end;
readrl=algol
procedure for reading a real in conversational mode
09 2 76 10 00 00
external
real procedure readrl(text,ll,ul);
value ll,ul; real ll,ul;
string text;
begin
integer s,x,ovfl;
real r;
boolean equal;
integer array i,o(1:20);
getzone6(in,i);
getzone6(out,o);
equal:=true;
for x:=2,3,4,5 do begin
if i(x)<>o(x) then equal:=false
end;
l:write(out,<:<10>:>,text,<: = :>);
if o(1)<>4 then outendcur(0);
readchar(in,x); repeatchar(in);
if x=25 then alarm(<:***device status in<10>source exhausted:>);
ovfl:=overflows; overflows:=0;
s:=read(in,r);
overflows:=ovfl;
if if r<=0 then false else r=maxreal then goto l;
x:=0;
if s=1 then
begin repeatchar(in); readchar(in,x); end;
if x<>10 then
begin for x:=x while x<>10 do readchar(in,x);
goto l end;
if r<ll or r>ul then goto l;
if -,equal then begin
real ra;
integer layc,k;
ra:=abs r;
layc:=if ra=0 then 0 else entier (ln(ra)/ln(10));
if layc<0 then layc:=1 else
layc:=layc//3+2;
if layc>6 then layc:=6;
ra:=real (case layc of(<<-f.dd0 000 000 00'-ddd>,
<<-ddd.d00 000 000>,<<-ddd ddd.d00 000>,
<<-ddd ddd ddd.d00>,<<-ddd ddd ddd ddd>,
<<-ddd ddd ddd ddd'+d>));
write(out,string ra,r);
outendcur(0) end;
readrl:=r;
end;end;
readra1l=algol
procedure for reading a real in conversational mode
09 2 76 10 00 00
external
procedure readra1l(text,a,lwb,upb,ll,ul);
value lwb,upb,ll,ul;
integer lwb,upb;
real ll,ul;
array a;
string text;
begin
integer s,x,ovfl,index;
real r;
boolean equal;
integer array i,o(1:20);
getzone6(in,i);
getzone6(out,o);
equal:=true;
for x:=2,3,4,5 do begin
if i(x)<>o(x) then equal:=false
end;
index:=lwb;
l:write(out,<:<10>:>,text,<: = :>);
if o(1)<>4 then outendcur(0);
for index:=index step 1 until upb do begin
readchar(in,x); repeatchar(in);
if x=25 then alarm(<:***device status in<10>source exhausted:>);
ovfl:=overflows; overflows:=0;
s:=read(in,r);
overflows:=ovfl;
if if r<=0 then false else r=maxreal then goto l;
x:=0;
if s=1 then
begin repeatchar(in); readchar(in,x); end;
if x<>10 and x<>32 and x<>44 then
begin for x:=x while x<>10 and x<>32 and x<>44 do readchar(in,x);
goto l end;
if r<ll or r>ul then goto l;
if -,equal then begin
real ra;
integer layc,k;
if (index-lwb) mod 4=3 then outendcur(10);
ra:=abs r;
layc:=if ra=0 then 0 else entier (ln(ra)/ln(10));
if layc<0 then layc:=1 else
layc:=layc//3+2;
if layc>6 then layc:=6;
ra:=real (case layc of(<<-f.dd0 000 000 00'-ddd>,
<<-ddd.d00 000 000>,<<-ddd ddd.d00 000>,
<<-ddd ddd ddd.d00>,<<-ddd ddd ddd ddd>,
<<-ddd ddd ddd ddd'+d>));
write(out,string ra,r);
outendcur(0) end;
a(index):=r;
end;
end;end;
readlay=algol
procedure for reading a layout in conversational mode
27 9 78
external
real procedure readlay(text);
string text;
begin
integer s,x,v;
real lay;
boolean equal;
integer array i,o(1:20),A(0:127);
real array LAY(1:12);
A(0):=A(127):=0;
for s:=1 step 1 until 126 do A(s):=7 shift 12 add s;
for s:=10,12,25 do A(s):=8 shift 12 add s;
for s:=32,39,43,45,46,48,60,62,98,100,102,122 do
A(s):=6 shift 12 add s;
intable(A);
tableindex:=0;
getzone6(in,i);
getzone6(out,o);
equal:=true;
for x:=2,3,4,5 do begin
if i(x)<>o(x) then equal:=false
end;
l:write(out,<:<10>:>,text,<: :>);
if o(1)<>4 then outendcur(0);
v:=readchar(in,x); repeatchar(in);
if x=25 then alarm(<:***device status in<10>source exhausted:>);
cleararray(LAY);
s:= readstring(in,LAY,1); x:= 0;
if s>0 then
begin repeatchar(in); readchar(in,x); end;
if x<>10 or v<>6 or -,charlay(LAY,lay) then
begin
for x:=x while x<>10 do readchar(in,x);
goto l end;
readlay:=lay;
intable(0);
s:= 1;
if -,equal then begin write(out,string LAY(increase(s)));
outendcur(0) end;
end;end;
;test readlay
testlay=algol
begin
real lay;
integer l,b,h,d,s;
array A(1:11);
cleararray(A);
lay:=readlay(<:test layout:>);
splitlay(lay,l,b,h,d,s,A);
l:=1;
write(out,<: :>,string A(increase(l)));
end
global readi readr reads readil readrl readb readl readll readra1l readlay
mode list.no
▶EOF◀