|
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: 17664 (0x4500)
Types: TextFile
Names: »termspec3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »termspec3tx «
begin
<***********************************************
* *
* utility program termspec *
* ******** *
* for rc8000 terminal specs *
* *
* a/s regnecentralen, c.h.dreyer, mar.84 *
************************************************
call conventions: see procedure syntax.
use: get and/or set terminal specs on the terminal process
_ only for use with basis system version 2, rel 2 or later.
*>
\f
zone z(1,1,stderror);
integer array ia,a,ax(1:20),
_ pdesc(1:30);
boolean set,test,test1;
integer i,fp,no,primout,pda,
_ j,rate,
_ funcmask, ownpda,
_ w,p,b,result,sepleng;
long array par,pname,progname,outfile,chainname(1:2);
integer sp_name, sp_no,
_ pnt_name,pnt_no;
long p1;
integer array ha(1:5);
integer h1,h2,h3,jobhost;
\f
procedure sorry(n); value n;
<*****************>
integer n;
begin
write(out,<:<10>***:>, progname, <: sorry:_:>);
case n of
begin
write(out,<:not found::>,pname);
write(out,<:not terminal:>);
write(out,<:no specs at::>,pname,<:_result:>,i,a(1));
write(out,<:spec not set at::>,pname,<:_result:>,i,ia(1));
write(out,<:function bit 5 required:>);
end;
errorbits:= 3;
goto outofprog;
end procedure soory;
\f
procedure syntax;
<***************>
begin
write(out,<:<10>***:>, progname, <: syntax:_:>);
<*print bad param*>
if system(4,fp,par)=0 then fp:= fp-1; <*it was after last param*>
for fp:= fp, fp+1 while fp>0 do
begin
i:= system(4,fp,par);
if i shift(-12) = 8 then write(out,".",1)
_ else if i shift(-12) = 4 then write(out,"sp",1);
if i extract 12 = 4 then write(out,<<d>,par(1))
_ else if i extract 12 =10 then write(out,par);
if system(4,fp+1,par) shift(-12) <>8 then fp:= -10;
<*i.e. repeat while seperator=point*>
end;
write(out,<:_____correct call syntax is::>,
_ <:<10>termspec <proc>0/1 normal 0/1:>,
_ <:<10>conv.y/n_cont.y/n_echo.y/n_soft.y/n:>,
_ <:_type.<0-9>_att.disa/ena_prom.<char>:>,
_ <:<10>flow.in/out/io/no_stop.1/2_pari.odd/eve/no:>,
_ <:_time.<sec>_char.5/6/7/8_rate.<bps>:>);
errorbits:= 3;
goto outofprog;
end procedure syntax;
\f
procedure takeyes(x,pos); value x,pos;
<************************>
integer x,pos;
begin
if system(4,fp+1,par) <> pnt_name then syntax;
p1:= par(1);
if p1 = long <:y:> or p1 = long <:yes:> then no:= 1
else
if p1 = long <:n:> or p1 = long <:no:> then no:= 0
else syntax;
setbits(x,pos,1); <*set one bit*>
end procedure takeyes;
procedure takeno(n); value n;
<*******************>
integer n;
begin
if system(4,fp+n,par) <> pnt_no then syntax;
no:= par(1);
end procedure takeno;
procedure take_rate(n,pos); value n,pos;
<***************************>
integer n,pos;
begin
takeno(n);
no:= if no=9600 then 0
_ else if no=4800 then 1
_ else if no=2400 then 2
_ else if no=1200 then 3
_ else if no= 600 then 4
_ else if no= 300 then 5
_ else if no= 220 then 6
_ else if no= 200 then 7
_ else if no= 150 then 8
_ else if no= 134 then 9
_ else if no= 110 then 10
_ else if no= 75 then 11
_ else if no= 50 then 12
_ else if no= 40 then 13
_ else -1;
if no<0 then syntax;
setbits(8,pos,4);
end procedure take_rate;
\f
procedure setbits(x,pos,bits); value x,pos,bits;
<****************************>
integer x,pos,bits;
begin
integer mask;
mask:= logor((-1) shift(pos+bits) , (-1) extract pos);
if test then
begin
write(out,<:<10>x,pos,bits,no=:>,x,pos,bits,no,<: a, mask, a after:<10>:>);
bitsout(a(x));
write(out,"nl",1);
bitsout(mask);
end;
a(x):= logand(a(x), mask); <*remove bits in field*>
a(x):= logor(a(x), (no extract bits) shift pos); <*insert bits: value in no *>
if test then
begin
outchar(out,10);
bitsout(a(x));
write(out,<:<10>:>);
end;
end procedure setbits;
procedure testout(at,txt);
<*************************>
integer array at;
string txt;
begin
long lt;
integer q;
lt:= long txt;
write(out,<:<10>:>,string lt);
for q:= 1 step 1 until 8 do
begin
write(out,"nl",1,q,<:=:>,<<ddddd>,at(q) shift(-12),at(q) extract 12);
bitsout(at(q));
end;
write(out,"nl",1);
end procedure testout;
\f
procedure bitsout(b); value b;
<********************>
integer b;
begin
integer q;
for q:= -23 step 1 until 0 do
write(out,"sp", if ((q-1)mod 4) =0 then 1 else 0,
_ if b shift q extract 1 =1 then <:1:> else <:.:>);
end procedure bitsout;
procedure yes(x); value x;
<*****************>
integer x;
begin
write(out, if x extract 1 =1 then <:yes:> else <:no_:>);
end procedure yes;
\f
integer
procedure stack_current_output (file_name);
<*****************************************>
long array file_name ;
begin
integer result ;
result := 2; <*1<1 <=> 1 segment, preferably disc*>
fp_proc (29, 0, out, chain_name); <*stack c o*>
fp_proc (28, result, out, file__name); <*connect *>
if result <> 0 then
fp_proc (30, 0, out, chain_name); <*unstack *>
stack_current_output := result;
end stack_current_output;
procedure unstack_current_output ;
<********************************>
begin
fp_proc (34, 0, out, 25); <*close up*>
fp_proc (79, 0, out, 0); <*terminate*>
fp_proc (30, 0, out, chain_name); <*unstack *>
end unstack_current_output;
\f
<* initializations *>
<*******************>
test:= test1:= false;
trapmode:= 1 shift 10; <*no final end*>
sp_name := 4 shift 12 +10;
sp_no := 4 shift 12 + 4;
pnt_name:= 8 shift 12 +10;
pnt_no := 8 shift 12 + 4;
primout:= system(7,i,pname);
<*get function mask*>
ownpda:= system(6<*own.proc*>,i,par);
system(5<*move*>,ownpda,ia);
funcmask:= ia(15) extract 12;
<*find jobhost no*>
jobhost:= 0;
system(5<*move*>,74,ha);
h1:= ha(1)-2; <*first device in nametab*>
h2:= ha(2); <*first area in nametab*>
for h1:= h1+2 while h1<=h2 and jobhost=0 do
begin <*scan devices, find a subhost*>
system(5<*move*>,h1,ha); <*name table entry*>
h3:= ha(1); <*=pda of device*>
system(5<*move*>,h3,ha); <*proc.descr.*>
if ha(1)=82 then
begin <*kind=subhost*>
system(5<*move*>,h3+50,ha);
jobhost:= ha(1);
end;
end;
\f
<* read possible left hand parameter in call *>
<*********************************************>
trapmode := 1 shift 10; <*no end alarm written*>
system (4, 0, out_file);
sepleng :=
system (4, 1, progname);
if sepleng shift (-12) <> 6 <*=*> then
begin <*noleft side, progname is param after programname*>
for i := 1, 2 do
begin
prog_name (i) := out_file (i);
out__file (i) := long <::> ;
fp := 1 ;
end;
end <*no left side*> else
fp := 2;
if out_file (1) <> long <::> then
begin <*stack current out and connect*>
result := stack_current_output (out_file);
if result <> 0 then
begin
write (out, "nl", 1, <:***:>, progname, "sp", 1, <:connect :>, outfile,
"sp", 1, case result of (
<:no resources:>,
<:malfunction:>,
<:not user, not exist:>,
<:convention error:>,
<:not allowed:>,
<:name format error:> ));
out_file (1) := long <::>;
end;
end <*stack current out and connect*>;
\f
<*read first fp parameter (maybe)*>
<*********************************>
if system(4,fp,par) shift(-12) =4 and system(4,fp+1,par) shift(-12) <> 8 then
begin <*single parameter stated*>
if system(4,fp,par) <> sp_name then syntax;
p1:= par(1);
<*check valid singleword parameters*>
if p1 <> long<:test:>
and p1 <> long<:test1:>
and p1 <> long<:norma:> add 'l' then
begin <*take procname stated*>
system(4,fp,pname);
fp:= fp+1;
end;
end;
\f
<*find process, write first line*>
<********************************>
open(z,0,pname,0);
pda:= monitor(4<*pda*>,z,0,ia);
if pda=0 then sorry(1);
system(5,pda,pdesc); <*process descr*>
write(out,"sp", 18 -
_ write(out,pname, <:::>) );
if pdesc(1)=84 or pdesc(1)=85 or pdesc(1)=64 or pdesc(1)=8 then
begin <*device on temp/perm link*>
write(out, "sp", 18 -
_ write(out,<:jobhost=:>,<<d>,jobhost,
_ <:(:>,pdesc(18) extract 12,<:)_:>) );
write(out, "sp", 17 -
_ write(out,<:devhost=:>,<<d>,pdesc(26),
_ <:(:>,pdesc(18) shift(-12),<:):>) );
write(out,<:hws=:>,<<d>,pdesc(24),
_ <:_kind=:>,pdesc(1),<:(:>,pdesc(19) shift(-12),<:):>);
end
else
begin <*not linked, avoid details*>
write(out,"sp", 18 -
_ write(out,<:jobhost=:>,<<d>,jobhost) );
write(out,<:kind=:>,pdesc(1));
end;
outchar(out,10);
<*get term specs. first check for nonsense*>
<******************************************>
if pda=ownpda or pda=system(8<*parent*>,i,par) then sorry(2);
if pda<>primout then
begin <*avoid unintelligeble messages*>
if pdesc(1)<>84 and pdesc(1)<>85 and pdesc(1)<>64 and pdesc(1)<>8 then sorry(2);
end;
getshare6(z,ia,1);
ia(4):= 134 shift 12; <*new operation first*>
repeat
setshare6(z,ia,1);
monitor(16<*sendmess*>,z,1,ia);
i:= monitor(18<*waitansw*>,z,1,a);
if i=3 and ia(4)=2 shift 12 then
sorry(2); <*old operation tried and still unintelligible*>
if i<>1 and i<>3 or a(1)<>0 then sorry(3); <*otherwise dummy or status*>
if i=3 then
ia(4):= 2 shift 12; <*old operation tried*>
until i=1 and a(1)=0; <*until normal answer and no status*>
for i:= 1 step 1 until 8 do ax(i):= a(i); <*save old specs*>
\f
<*read rest of fp parameters: corrections to specs*>
<**************************************************>
set:= false;
test:= false;
while system(4,fp,par)=sp_name do
begin
set:= true;
p1:= par(1);
if p1 = long<:conv:> then takeyes(2,15)
else
if p1 = long<:cont:> then takeyes(2,13)
else
if p1 = long<:echo:> then takeyes(2,11)
else
if p1 = long<:soft:> then takeyes(2,10)
else
if p1 = long<:type:> then
begin
takeno(1);
if no>9 or no<0 then syntax;
setbits(2,0,4);
end
else
if p1 = long<:prom:> then
begin
takeno(1);
if no>255 or no<0 then syntax;
setbits(4,8,8);
end
else
if p1 = long<:flow:> then
begin
if system(4,fp+1,par) <> pnt_name then syntax;
p1:= par(1);
no:= if p1 = long<:no:> then 0
_ else if p1 = long<:io:> then 1
_ else if p1 = long<:in:> then 2
_ else if p1 = long<:out:> then 3
_ else -1;
if no<0 then syntax;
setbits(8,13,2);
end
\f
else
if p1 = long<:stop:> then
begin
takeno(1);
if no=1 then no:= 0
else
if no=2 then no:= 1
else syntax;
setbits(8,12,1);
end
else
if p1 = long<:pari:> then
begin
if system(4,fp+1,par) <> pnt_name then syntax;
p1:= par(1);
no:= if p1 = long<:odd:> then 0
_ else if p1 = long<:eve:> then 1
_ else if p1 = long<:no:> then 2
_ else -1;
if no<0 then syntax;
setbits(8,10,2);
end
else
if p1 = long<:time:> then
begin
takeno(1);
if no<0 or no>255 then syntax;
setbits(7,8,8);
end
else
if p1 = long<:char:> then
begin
takeno(1);
no:= if no=5 then 0
_ else if no=7 then 1
_ else if no=6 then 2
_ else if no=8 then 3
_ else -1;
if no<0 then syntax;
setbits(8,8,2);
end
\f
else
if p1 = long<:rate:> then
begin
takerate(1,4);
if system(4,fp+2,par) = pnt_no then
begin
takerate(2,0);
fp:= fp+1;
end
else setbits(8,0,4); <*value is already ok, =no*>
end
else
if p1 = long<:test:> then
begin
test:= true;
fp:= fp-1;
end
else
if p1 = long<:test1:> then
begin
test1:= true;
fp:= fp-1;
end
else
if p1 = long<:set:> then
begin
takeno(1); w:= no;
takeno(2); p:= no;
takeno(3); b:= no;
takeno(4);
setbits(w,p,b);
fp:= fp+3;
end
\f
else
if p1 = long<:norma:> add 'l' then
begin <*set normal specs*>
no:= 1; setbits(2,15,1);<*conv.yes*>
no:= 0; setbits(2,13,1);<*cont.no*>
no:= 1; setbits(2,11,1);<*echo.yes*>
no:= 1; setbits(2,10,1);<*soft.yes*>
no:= 1; setbits(2, 0,4);<*type.1*>
no:= 7; setbits(4, 8,8);<*prom.7*>
no:= 0; setbits(8,13,2);<*flow.no*>
no:= 60; setbits(7, 8,8);<*time.60*>
fp:= fp-1;
end
else
if p1 = long<:att:> then
begin
if system(4,fp+1,par) <> pnt_name then syntax;
p1:= par(1);
no:= if p1 = long<:disa:> then 1
_ else if p1 = long<:ena:> then 0
_ else -1;
if no<0 then syntax;
setbits(3,21,1);
end
\f
else
_ syntax;
fp:= fp+2;
end while more fp keywords;
if system(4,fp,par) <>0 then syntax; <*not all params read*>
\f
<*execute functions*>
<*******************>
if test then
begin
testout(ax,<:specs got:>);
testout(a,<:changed specs:>);
end
else
if set then
begin <*set modified termspecs*>
if test1 then testout(ax,<:set: specs got:>);
if test1 then testout( a,<:set: new specs, used in setspec:>);
<*check allowance: function bit 5*>
if pda<>primout and funcmask shift(-6) extract 1 =0 then sorry(5);
getshare6(z,ia,1);
ia(4):= 132 shift 12; <*new operation first*>
repeat
for i:= 2 step 1 until 8 do ia(3+i):= a(i);
setshare6(z,ia,1);
monitor(16<*sendmess*>,z,1,ia);
i:= monitor(18<*waitansw*>,z,1,ia);
if i=3 and ia(4)=4 shift 12 then
sorry(4); <*old operation tried and still not set*>
if i<>1 and i<>3 or ia(1)<>0 then sorry(4); <*otherwise dummy or status*>
if i=3 then
ia(4):= 4 shift 12; <*old operation tried*>
until i=1 and a(1)=0; <*until normal answer and no status*>
<*get final specs*>
getshare6(z,ia,1);
ia(4):= 134 shift 12; <*new operation first*>
repeat
setshare6(z,ia,1);
monitor(16<*sendmess*>,z,1,ia);
monitor(18<*waitansw*>,z,1,a); <*not checked*>
if i=3 and ia(4)=134 shift 12 then
ia(4):= 2 shift 12; <*old operation tried*>
until i=1 or ia(4)=2 shift 12; <*normal answer or old operation tried*>
if test1 then testout( a,<:set: after setspecs:>);
end setspecs wanted;
\f
<*write terminal specs*>
<**********************>
write(out, <:conv.:>); yes(a(2) shift(-15));
write(out,<:_cont.:>); yes(a(2) shift(-13));
write(out,<:_echo.:>); yes(a(2) shift(-11));
write(out,<:_soft.:>); yes(a(2) shift(-10));
write(out,<:_type.:>,<<d>, a(2) extract 4,
_ <:__att.:>, if a(3) shift(-21) extract 1 =1 then <:disa:> else <:ena_:>,
_ <:_prom.:>, a(4) shift(-8) extract 8,
_ <:<10>flow.:>, case (a(8) shift(-13) extract 2 +1) of
_ (<:no_:>,<:io_:>,<:in_:>,<:out:>),
_ <:_stop.:>, case (a(8) shift(-12) extract 1+1) of
_ (<:1__:>,<:2__:>),
_ <:_pari.:>, case (a(8) shift(-10) extract 2 +1) of
_ (<:odd:>,<:eve:>,<:no_:>,<:bad:>) );
write(out,"sp", 9 - write(out,<:_time.:>, <<d>, a(7) shift(-8) extract 8) );
write(out,<:_char.:>, <<d>, case (a(8) shift(-8) extract 2 +1) of
_ (5,7,6,8) );
j:= -1;
write(out,<:_rate:>);
for i:= -4, 0 do
begin <*receive + xmit rates. only receive if equal*>
rate:= a(8) shift i extract 4;
if rate <> j then
_ write(out,<:.:>, <<d>, case (rate+1) of
_ (9600,4800,2400,1200,600,300,220,200,
_ 150, 134, 110, 75, 50, 40, -1, -1));
j:= rate;
end;
outofprog:
outchar(out,10);
if outfile (1) <> long <::> then
unstack_current_output;
end
▶EOF◀