|
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: 6144 (0x1800)
Types: TextFile
Names: »typeprtxt«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »typeprtxt«
mode list.yes
typeprint=set 42
scope user typeprint
typeprint=algol
begin <* S.E.Harnung. 21 11 80.
Current version: 27 11 81.
Call parameters:
<area> (4.10; run.no)
<area>(.<area>) 1-n (4.10,8.10; run.yes)
<area> <firstpage>.<lastpage> (4.10,4.4,8.4; run.no)
<area> <firstpage>.<lastpage>.run (4.10,4.4,8.4,8.10)
<area> test.<fount> (4.10,8.4) *>
integer chno,segm,lastsegm,i,page,firstpage,lastpage,
j,res,class,char,ch,ch1,cu,file,key;
boolean stop,nextfile,test;
integer array c(1:768),intab(0:150),ia(1:12),tail(1:10);
real array ra(1:2);
zone term(10,1,stderror);
procedure insegm;
begin integer i,j; integer field fi;
if segm<=lastsegm then inrec6(in,512) else error(7);
i:=j:=fi:=0;
for i:=if i=3 then 1 else i+1 while j<768 do
begin j:=j+1;
fi:=fi+(if i=1 then 2 else 0);
c(j):=in.fi shift (case i of (-16,-8,0)) extract 8
end
end insegm;
integer procedure inchar(t); integer t;
begin COUNT: chno:=chno+1;
if chno=769 then
begin segm:=segm+1; insegm; chno:=0; goto COUNT
end;
t:=c(chno); inchar:=intab(t)
end inchar;
procedure error(x); value x; integer x;
begin
i:=1;
write(out,<:<13><10>***typeprint :>,case x of (
<:call:>,<:param:>,<::>,
<:parent :>,<:connect :>,
<:logical error: :>,<:segment error: :>));
if x<4 then goto EXIT;
write(out,string ra(increase(i)));
if x=4 then
begin
write(out,<: not allowed.:>); goto EXIT
end;
write(out,if x<>5 then <:, segment:> else <::>,
if x=5 then res else segm-1);
goto OUT
end error;
for i:=1 step 1 until 29 do intab(i):=4;
intab(27):=1; for i:=9,11,30,31 do intab(i):=2;
for i:=17,18,19,20 do intab(i):=3;
intab(10):=5; intab(8):=6;
for i:=33 step 1 until 126 do intab(i):=8;
for i:=48 step 1 until 57,65,66,68,85 do intab(i):=7;
for i:=128 step 1 until 149 do intab(i):=9;
intab(139):=10; intab(150):=11; intab(0):=intab(127):=12;
intab(32):=13;
file:=firstpage:=1; lastpage:=10000;
nextfile:=false; stop:=true;
if system(4,1,ra)<>4 shift 12+10 then error(1);
test:=ra(1)=real<:test:>; if test then goto SETTW;
i:=system(4,2,ra);
if i=4 shift 12+4 then
begin
firstpage:=ra(1);
if system(4,3,ra)<>8 shift 12+4 then error(1);
lastpage:=ra(1);
if firstpage<1 or firstpage>lastpage then error(2);
if system(4,4,ra)=8 shift 12+10 then
stop:=-,(ra(1)=real<:run:>)
end else
if i=8 shift 12+10 then nextfile:=true;
SETTW: outendcur(0); <* initialize out *>
getshare6(out,ia,1); ia(4):=5 shift 12 add 2; setshare6(out,ia,1);
<*CR not LF*>
if test then
begin
write(out,<:<27><30><17><27><31><13><12><13><10><13><10><13><10>:>);
for i:=3 step 1 until 9 do
write(out,<: :>,false add (48+i),1,<:0<13><10>:>);
write(out,<:100<13><10>110<13><10>120<13>:>,
<:<27><11><3><27><31><25> :>);
for i:=0 step 1 until 9 do write(out,<: :>,false add (48+i),1);
write(out,<:<8><10><27><54>:>); <* BS LF ESC 6 *>
for i:=39 step -1 until 33 do write(out,false add i,1,<: :>);
write(out,false add 32,5);
for i:=4 step 1 until 11 do
begin
write(out,<:<8><10><27>:>,
false add (if i mod 2=0 then 53 else 54),1);
for j:=0 step 1 until 9 do
write(out,false add (10*i+(if i mod 2=0 then j else 9-j)),1,
if j<>9 then <: :> else <::>)
end;
write(out,<:<10><13> <120> <121> <122> <123> <124> <125>:>,
<: <126><13><10><13><10><27><31><13><27><30><9><25>:>);
goto EXIT
end test;
nameload(parent+3,ra);
<*if ra(1)<>real<:p:> then error(4)*>;
open(term,2 shift 12 add 8,ra,0); <*LF not CR*>
<*stackcuri;*> system(4,1,ra);
NEXTFILE: res:=connectcuri(ra);
if res<>0 then error(5); setposition(in,0,0); i:=1;
if reserveproc(ra,key)<>0 then
write(out,<:*** :>,string ra(increase(i)),<: not reserved<13><10>:>);
page:=chno:=0; lookuptail(ra,tail); lastsegm:=tail(1);
for segm:=1 step 1 until lastsegm do
begin insegm;
for chno:=chno+1 while chno<769 do if c(chno)=139 then
begin page:=page+1; if page>=firstpage then goto PRINT
end;
chno:=0
end; error(7);
PRINT: write(out,<:typeprinting begin.<13><12>:>);
ch:=19; cu:=2;
PRSTART: setposition(out,0,0);
for i:=readchar(term,char) while char<>10 and char<>64 do;
if char=64 then goto OUT;
write(out,<:<27><10>:>); cu:=cu+2;
INCHAR: for ch:=ch+1 while true do
begin class:=inchar(char);
case class of
begin
<*1*> begin <*control unit*>
i:=inchar(ch1); ch:=ch-1; cu:=cu+2;
write(out,<:<27>:>,false add ch1,1);
if i=2 then
begin inchar(ch1); outchar(out,ch1); cu:=cu+1
end else
if i<>5 and i<>7 then error(6)
end;
<*2*> error(6); <*HT,VT,RS,US*>
<*3*> begin <*DC1,DC2,DC3,DC4*>
ch:=ch-1;
if stop then
begin
setposition(out,0,0);
for i:=readchar(term,char) while char<>25 do
end
end;
<*4*> error(6); <*control chars, not used*>
<*5*> begin <*LF*>
write(out,<:<13><10>:>); ch:=ch-1; cu:=cu+2
end;
<*6*> begin <*BS*>
ch:=ch-1; cu:=cu+1; outchar(out,8)
end;
<*7*> outchar(out,char); <*digits,A,B,D,U*>
<*8*> outchar(out,char); <*visible chars*>
<*9*> error(6); <*128-138,141-149 not used*>
<*10*> begin <*139,FF*>
page:=page+1; ch:=ch-1; cu:=cu+1;
write(out,<:<13><12>:>);
if page>lastpage then goto CONTINUE;
if stop then goto PRSTART
end;
<*11*> goto CONTINUE; <*150,EM*>
<*12*> ; <*0,127 blind*>
<*13*> begin <*SP*>
ch:=ch-1; cu:=cu+1; outchar(out,32)
end;
end class
end ch;
CONTINUE: releaseproc(ra);
if nextfile then
begin file:=file+1;
if system(4,file,ra)=8 shift 12+10 then goto NEXTFILE
end;
if stop then
begin setposition(out,0,0);
for i:=readchar(term,char) while char<>10 and char<>64 do;
end;
write(out,<:<27><30><9><27><31><13><13>
visible characters::>,<<ddddddd>,ch,
<:<13><10>control characters::>,cu,<:<10>:>);
OUT: close(term,true); unstackcuri;
write(out,<:<10><13>typeprinting end.<10>:>);
EXIT: setposition(out,0,0);
getshare6(out,ia,1); ia(4):=5 shift 12; setshare6(out,ia,1);
outchar(out,10); fpproc(7,0,0,0)
end
▶EOF◀