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

⟦5a24b4424⟧ TextFile

    Length: 12288 (0x3000)
    Types: TextFile
    Names: »treadcon«

Derivation

└─⟦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⟧ 

TextFile

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