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