|
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: 11520 (0x2d00)
Types: TextFile
Names: »ttemtest«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »ttemtest«
; tem test and demo programmes
( temproc=edit
ttemtest1=edit
ttemtest2=edit
ttemtest3=edit
end)
i'
\f
integer procedure createpool(z);
zone z;
begin
integer i;
integer array zia(1:20),sia(1:12);
zone ztem(1,1,stderror);
open(ztem,0,<:tem:>,0);
getzone6(z,zia);
getshare6(ztem,sia,1);
sia(4):=90 shift 12;
for i:=0 step 1 until 3 do sia(8+i):=zia(2+i);
setshare6(ztem,sia,1);
monitor(16,ztem,1,sia);
createpool:=if monitor(18,ztem,1,sia) <> 1 then -1 else sia(1);
close(ztem,true);
end createpool;
integer procedure removepool(z);
zone z;
begin
integer i;
integer array zia(1:20),sia(1:12);
zone ztem(1,1,stderror);
open(ztem,0,<:tem:>,0);
getzone6(z,zia);
getshare6(ztem,sia,1);
sia(4):=92 shift 12;
for i:=0 step 1 until 3 do sia(8+i):=zia(2+i);
setshare6(ztem,sia,1);
monitor(16,ztem,1,sia);
removepool:=if monitor(18,ztem,1,sia) <> 1 then -1 else sia(1);
close(ztem,true);
end removepool;
integer procedure createlink(z,type,id,procref,bufs,timers,
mask,subst);
zone z;
integer type,id,procref,bufs,timers,mask,subst;
begin
integer i;
integer array zia(1:20),sia(1:12);
long array arr(1:2);
zone ztem(1,1,stderror);
getzone(z,zia);
arr(1):=zia(2); arr(1):=arr(1) shift 24 add zia(3);
arr(2):=zia(4); arr(2):=arr(2) shift 24 add zia(5);
i:=1;
open(ztem,0,string arr(increase(i)),0);
getshare6(ztem,sia,1);
sia(4):=100 shift 12 add type;
sia(5):=id;
sia(6):=procref;
sia(7):=bufs shift 12 add timers;
sia(8):= mask shift 12 add subst;
setshare6(ztem,sia,1);
monitor(16,ztem,1,sia);
createlink:=if monitor(18,ztem,1,sia) <> 1 then -1 else sia(1);
close(ztem,true);
end createlink;
integer procedure removelink(z,id,immediate);
zone z;
integer id;
boolean immediate;
begin
integer i;
integer array zia(1:20),sia(1:12);
long array arr(1:2);
zone ztem(1,1,stderror);
getzone6(z,zia);
arr(1):=zia(2); arr(1):=arr(1) shift 24 add zia(3);
arr(2):=zia(4); arr(2):=arr(2) shift 24 add zia(5);
i:=1;
open(ztem,0,string arr(increase(i)),0);
getshare6(ztem,sia,1);
sia(4):=102 shift 12 +(if immediate then 1 else 0);
sia(5):=id;
setshare6(ztem,sia,1);
monitor(16,ztem,1,sia);
removelink:=if monitor(18,ztem,1,sia) <> 1 then -1 else sia(1);
end removelink;
integer procedure terminalid(terminalnumber);
integer terminalnumber;
terminalid:=((terminalnumber//10 + 48) shift 8 add
(terminalnumber mod 10) + 48) shift 8 add 32;
',f
i'
\f
; *** ttemtest ***
;
;
; a testprogram for simpel testing of the tem system
;
; program call:
; temtest term.<terminalname-1>.<terminalname-2>. ... <terminalname-n>
;
; the program acts like this:
;
; create terminal pool
; create links to all terminals specified in program call
; loop
; read an input line from a connected terminal
; (this input line starts with a terminal number)
; increase linecount(terminal number)
; write terminal identification
; write terminal number
; write line count
; write content of input line
; goto loop
begin
zone z(26,1,stderror);
integer i,activeterminals,maxterminals,currterminal,result,terminalref;
real array arr(1:2);
algol copy.1; <* copy tem procedures *>
<* create terminal pool *>
open(z,8,<:tem:>,0);
createpool(z);
maxterminals:=activeterminals:=0;
<* connect all terminals specified in program call *>
begin
integer j;
integer array ia(1:10);
zone dummy(1,1,stderror);
i:=2;
for i:=i while system(4,i,arr) = 8 shift 12 + 10 do
begin
maxterminals:=maxterminals+1;
j:=1;
open(dummy,0,string arr(increase(j)),0);
terminalref:=monitor(4,dummy,0,ia);
result:=createlink(z,
0,terminalid(maxterminals),terminalref,1,0,0,0);
if result <> 0 then
write(out,<:<10>createlink(:>,<<d>,terminalref,<:) = :>,result) else
activeterminals:=activeterminals+1;
i:=i+1;
close(dummy,true);
end;
end;
if activeterminals < 1 then goto stop;
begin
integer i,j;
integer array linebuf(1:100),linecount(1:maxterminals);
for i:=1 step 1 until maxterminals do linecount(i):=0;
<* read a line and display it on corresponding terminal *>
loop:
read(z,currterminal);
i:=1;
for i:=i while readchar(z,linebuf(i)) <> 8 do i:=i+1;
setposition(z,0,0);
linecount(currterminal):=linecount(currterminal)+1;
write(z,<<zd>,currterminal,<: term = :>,<<zd>,currterminal,
<: line = :>,<<ddd>,linecount(currterminal),<:: :>);
for j:=1 step 1 until i do outchar(z,linebuf(j));
if linebuf(1) = 42 then
begin <* a star in first position means logout *>
write(z,<:terminal logged out<10>:>);
setposition(z,0,0);
removelink(z,terminalid(currterminal),false);
activeterminals:=activeterminals-1;
end;
setposition(z,0,0);
if activeterminals > 0 then goto loop;
end;
stop:
removepool(z);
end
',f
i'
\f
; *** tem sense ready test ***
;
;
; a testprogram for simpel testing of the tem system
;
; program call:
; <programname>
;
; the program acts like this:
;
; create terminal pool
; loop
wait attention or input ready
if att then login goto loop
read line from terminal
write terminal number and line number
echo indata
if first char = * then logout
goto loop
begin
integer maxterminals;
algol copy.1; <* copy tem procedures *>
maxterminals:= 10;
begin
boolean array passiveterm(1:maxterminals);
integer array linebuf(1:100),linecount(1:maxterminals);
zone zin(26,1,endofdata),zout(26,1,stderror),
senseready, zhelp(1,1,stderror);
integer i,j,activeterminals,currterminal,result,
terminalref,bufferbase;
boolean poolsensed;
integer array ia(1:20);
procedure endofdata(z,s,b);
zone z;
integer s, b;
begin
if b=0 and s=2 then
goto centralwait;
end;
<* create terminal pool *>
open(zin,8,<:tem:>,2);
open(zout,8,<:tem:>,0);
createpool(zout);
open(zhelp,0,<::>,0);
open(senseready,0,<:tem:>,0);
getshare6(senseready,ia,1);
ia(4):= 0 shift 12 + 2; <* prepare sense ready operation *>
setshare6(senseready,ia,1);
activeterminals:= 0;
bufferbase:= 0;
poolsensed:= false;
for i:= 1 step 1 until maxterminals do passiveterm(i):= true;
centralwait:
if activeterminals>0 and -,poolsensed then
begin
monitor(16) sendmessage:(senseready,1,ia);
poolsensed:= true;
end;
i:= bufferbase;
result:= monitor(24)waitevent:(zhelp,i,ia);
if result=0 then
begin <* (attention) message arrived *>
if ia(1)<>0 then
begin
bufferbase:= i;
goto centralwait;
end;
monitor(26)get event:(zhelp,i,ia);
ia(9):= 1;
monitor(22) send answer:(zhelp,i,ia);
terminalref:= monitor(4) get description:(zhelp,0,ia);
for i:= maxterminals step -1 until 1 do
if passiveterm(i) then currterminal:= i; <* find free terminal no *>
result:=createlink(zout,0,terminalid(currterminal),terminalref,
1,2047,0,0);
if result<>0 then
begin
write(out,<:<10>createlink(:>,<<dd>,terminalref,<:) = :>,
result,<:<10>:>);
setposition(out,0,0);
end
else
begin
write(zout,<<zd>,currterminal,false add 32,1,
<:terminal logged in<10>:>);
setposition(zout,0,0);
activeterminals:= activeterminals+1;
passiveterm(currterminal):= false;
linecount(currterminal):= 0;
end;
goto centralwait;
end
else
begin <* answer ( sense ready ) *>
monitor(18)wait answer:(senseready,1,ia);
poolsensed:= false;
repeat
read(zin,currterminal); <* end of data handled by blockprocedure *>
i:= 1;
for i:= i while readchar(zin,linebuf(i)) <>8 do i:= i+1;
setposition(zin,0,0);
linecount(currterminal):= linecount(currterminal)+1;
write(zout,<<zd>,currterminal,false add 32,1,
<: term = :>,currterminal,
<: line = :>,<<ddd>,linecount(currterminal),<:: :>);
for j:= 1 step 1 until i do outchar(zout,linebuf(j));
if linebuf(1) = 42 then
begin <* a star in first position means logout *>
write(zout,<:terminal logged out<10>:>);
setposition(zout,0,0);
removelink(zout,terminalid(currterminal),false);
activeterminals:= activeterminals-1;
passiveterm(currterminal):= true;
end
else setposition(zout,0,0);
until activeterminals=0;
end
removepool(zout);
close(zin,true); close(zout,true);
end;
end
',f
i'
\f
\f
*********** tem test create pool and create link *************
program call:
<programname> <poolname>(.<type>.<locid>.<process name>.<bufs>.
<timers>.<mask>,<subst>) 0->n
<poolname>,<locid>,<process name>::= <text>
<type>,<bufs>,<timers>,<mask>,<subst>::= <integer>
the program creates a terminal with the name <poolname>. for every
set of link parameters a terminal link is created
begin
algol copy.1; <* copy tem control procedures *>
integer i, j, result,
type, locid, terminalref, bufs,timers, mask, subst;
integer array ia(1:20);
real array arr(1:2);
zone z, dummy(1,1,stderror);
if system(4,1,arr)<>4 shift 12+10 then system(9,1,<:param:>);
i:= 1;
open(z,8,string(arr(increase(i))),0);
result:= createpool(z);
if result<>0 then system(9,result,<:crpool:>);
open(dummy,0,<::>,0);
i:= 0;
repeat <* get dummy message from tem *>
result:= monitor(24) wait event:(dummy,i,ia);
if result=0 then
begin
if ia(1) = -2 shift 12 then
begin
monitor(26) get event:(dummy,i,ia);
i:= 0;
end;
end;
until i=0;
close(dummy,true);
i:= 1;
for i:= i+1 while system(4,i,arr)=8 shift 12+4 do
begin
type:= arr(1);
i:= i+1;
if system(4,i,arr)<>8 shift 12+10 then system(9,i,<:param:>);
locid:= arr(1) shift (-24) extract 24;
i:= i+1;
if system(4,i,arr)<>8 shift 12 +10 then system(9,i,<:param:>);
j:= 1;
open(dummy,0,string(arr(increase(j))),0);
terminalref:= monitor(4,dummy,0,ia);
close(dummy,true);
i:= i+1;
if system(4,i,arr)<>8 shift 12+4 then system(9,i,<:param:>);
bufs:= arr(1);
i:= i+1;
if system(4,i,arr)<> 8 shift 12+4 then system(9,i,<:param:>);
timers:= arr(1);
i:= i+1;
if system(4,i,arr)<> 8 shift 12+4 then system(9,i,<:param:>);
mask:= arr(1);
i:= i+1;
if system(4,i,arr)<>8 shift 12+4 then system(9,i,<:param:>);
subst:= arr(1);
result:= createlink(z,type,locid,terminalref,bufs,timers,mask,subst);
if result<>0 then system(9,result,<:crlink:>);
end;
if system(4,i,arr)<>0 then system(4,i,<:param:>);
close(z,true);
end
',f
▶EOF◀