|
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: 24576 (0x6000)
Types: Rc489k_TapeFile, TextFile
Names: »ttemtest «
└─⟦0d4f5e769⟧ Bits:30008171 MIPS/TS RELEASE 7.1
└─⟦this⟧
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦39138f30b⟧
└─⟦this⟧ »ttemtest «
└─⟦aa55fa693⟧ Bits:30007479 SW8110/1 TAS/SOS/PRIMO Rel 2.3
└─⟦this⟧
; tem test and demo programmes
( temproc=edit
adpproc=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'
integer procedure connect (z, a_id, mask, subst);
value mask, subst ;
zone z ;
string a_id ;
integer mask, subst ;
<* return value: if "normal answer" and "status=0" then result is set to "0" else to "-1".
z: must be opened to the process ("tem-pool" or external process)
through which the adp (output) process is accessed.
a_id: application identifier, is the text string that identifies
the application in the "application select menu" presented
to the terminal operator.
mask, subst: must be identical to the "mask" and "subst" parameters
of the "createlink" call to the adp (output) device.
note: if tem is not employed the "mask" and "subst" parameters have
no significance.
*>
begin
integer i, status;
integer array zia (1:20), sia (1:12);
long array arr (1:2);
real array field raf;
zone z_adp (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 (z_adp, 0, string arr (increase(i)),0);
getshare (z_adp, sia, 1);
sia(4):= 4 shift 12 + 4; <* operation:= connect *>
raf:= 10;
movestring (sia.raf, 1, a_id);
sia(11):= (logand (mask, subst))shift 8; <* tem addressing information *>
setshare (z_adp, sia, 1);
monitor (16)send_message:(z_adp, 1, sia);
status:= 1 shift (monitor(18)wait_answer:(z_adp,1,sia));
if status = 2 then status:= status+sia(1);
connect:= if status = 2 then 0 else -1;
close (z_adp, false);
end connect;
integer procedure disconnect (z, mask, subst);
value mask, subst ;
zone z ;
integer mask, subst ;
<* return value: if "normal answer" and "status=0" then result is set to "0" else to "-1".
z: must be opened to the process ("tem-pool" or external process)
through which the adp (output) process is accessed.
mask, subst: must be identical to the "mask" and "subst" parameters
of the "createlink" call to the adp (output) device.
note: if tem is not employed the "mask" and "subst" parameters have
no significance.
*>
begin
integer i, status;
integer array zia (1:20), sia (1:12);
long array arr (1:2);
zone z_adp (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 (z_adp, 0, string arr (increase(i)),0);
getshare (z_adp, sia, 1);
sia(4):= 4 shift 12 + 8; <* operation:= disconnect *>
sia(11):= (logand (mask, subst))shift 8; <* tem addressing information *>
setshare (z_adp, sia, 1);
monitor (16)send_message:(z_adp, 1, sia);
status:= 1 shift (monitor(18)wait_answer:(z_adp,1,sia));
if status = 2 then status:= status+sia(1);
disconnect:= if status = 2 then 0 else -1;
close (z_adp, false);
end disconnect;
integer procedure lookup_device (z, aid, sb, cu, device, mask, subst);
value cu, device, mask, subst ;
zone z ;
integer aid, sb, cu, device, mask, subst ;
<* return value: is taken from the result field of the adp answer ("answer(2)"),
if "normal answer" and "status=0", else result is set to "-1".
z: must be opened to the process ("tem-pool" or external process)
through which the adp (output) process is accessed.
cu, device: device addressing information, please notice that "cu" and
the value of the "cu-byte" byte of the transaktion header
(delivered by waittrans in: "destination shift(-12)extract 12")
not necessarily are identical if TEM is employed. The following
algorithm solves the problem:
"cu := logand (cu-byte, exor (MASK, -1))"
or:
"cu := logand (destination shift(-12)extract 12, exor (MASK, -1))"
where "MASK" must be identical to MASK parameter of the
"createlink" call to the adp (output) device.
aid: attention identifier, is the value of the last received
aid-code from the addressed device.
sb: Status Byte, is the value of the last received
status byte from the addressed device.
mask, subst: must be identical to the "mask" and "subst" parameters
of the "createlink" call to the adp (output) device.
note: if tem is not employed the "mask" and "subst" parameters have
no significance.
*>
begin
integer i, status;
integer array zia (1:20), sia (1:12);
long array arr (1:2);
zone z_adp (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 (z_adp, 0, string arr (increase(i)),0);
getshare (z_adp, sia, 1);
sia(4):= 4 shift 12 + 12; <* operation:= lookup device *>
sia(6):= cu shift 8 + device;
sia(11):= (logand (mask, subst))shift 8; <* tem addressing information *>
setshare (z_adp, sia, 1);
monitor (16)send_message:(z_adp, 1, sia);
status:= 1 shift (monitor(18)wait_answer:(z_adp,1,sia));
if status = 2 then status:= status+sia(1);
if status = 2 then
begin
aid:= sia(4);
sb:= sia(5);
lookup_device:= sia(2);
end
else lookup_device:= -1;
close (z_adp, false);
end lookup device;
integer procedure reserve_device (z, cu, device, mask, subst);
value cu, device, mask, subst ;
zone z ;
integer cu, device, mask, subst ;
<* return value: is taken from the result field of the adp answer ("answer(2)"),
if "normal answer" and "status=0", else result is set to "-1".
z: must be opened to the process ("tem-pool" or external process)
through which the adp (output) process is accessed.
cu, device: device addressing information, please notice that "cu" and
the value of the "cu-byte" byte of the transaktion header
(delivered by waittrans in: "destination shift(-12)extract 12")
not necessarily are identical if TEM is employed. The following
algorithm solves the problem:
"cu := logand (cu-byte, exor (MASK, -1))"
or:
"cu := logand (destination shift(-12)extract 12, exor (MASK, -1))"
where "MASK" must be identical to MASK parameter of the
"createlink" call to the adp (output) device.
mask, subst: must be identical to the "mask" and "subst" parameters
of the "createlink" call to the adp (output) device.
note: if tem is not employed the "mask" and "subst" parameters have
no significance.
*>
begin
integer i, status;
integer array zia (1:20), sia (1:12);
long array arr (1:2);
zone z_adp (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 (z_adp, 0, string arr (increase(i)),0);
getshare (z_adp, sia, 1);
sia(4):= 4 shift 12 + 16; <* operation:= reserve device *>
sia(6):= cu shift 8 + device;
sia(11):= (logand (mask, subst))shift 8; <* tem addressing information *>
setshare (z_adp, sia, 1);
monitor (16)send_message:(z_adp, 1, sia);
status:= 1 shift (monitor(18)wait_answer:(z_adp,1,sia));
if status = 2 then status:= status+sia(1);
reserve_device:= if status = 2 then sia(2) else -1;
close (z_adp, false);
end reserve device;
integer procedure release_device (z, cu, device, mask, subst);
value cu, device, mask, subst ;
zone z ;
integer cu, device, mask, subst ;
<* return value: is taken from the result field of the adp answer ("answer(2)"),
if "normal answer" and "status=0", else result is set to "-1".
z: must be opened to the process ("tem-pool" or external process)
through which the adp (output) process is accessed.
cu, device: device addressing information, please notice that "cu" and
the value of the "cu-byte" byte of the transaktion header
(delivered by waittrans in: "destination shift(-12)extract 12")
not necessarily are identical if TEM is employed. The following
algorithm solves the problem:
"cu := logand (cu-byte, exor (MASK, -1))"
or:
"cu := logand (destination shift(-12)extract 12, exor (MASK, -1))"
where "MASK" must be identical to MASK parameter of the
"createlink" call to the adp (output) device.
mask, subst: must be identical to the "mask" and "subst" parameters
of the "createlink" call to the adp (output) device.
note: if tem is not employed the "mask" and "subst" parameters have
no significance.
*>
begin
integer i, status;
integer array zia (1:20), sia (1:12);
long array arr (1:2);
zone z_adp (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 (z_adp, 0, string arr (increase(i)),0);
getshare (z_adp, sia, 1);
sia(4):= 4 shift 12 + 20; <* operation:= release device *>
sia(6):= cu shift 8 + device;
sia(11):= (logand (mask, subst))shift 8; <* tem addressing information *>
setshare (z_adp, sia, 1);
monitor (16)send_message:(z_adp, 1, sia);
status:= 1 shift (monitor(18)wait_answer:(z_adp,1,sia));
if status = 2 then status:= status+sia(1);
release_device:= if status = 2 then sia(2) else -1;
close (z_adp, false);
end release device;
integer procedure wait_ready (z, cu, device, mask, subst);
value cu, device, mask, subst ;
zone z ;
integer cu, device, mask, subst ;
<* return value: is taken from the result field of the adp answer ("answer(2)"),
if "normal answer" and "status=0", else result is set to "-1".
z: must be opened to the process ("tem-pool" or external process)
through which the adp (output) process is accessed.
cu, device: device addressing information, please notice that "cu" and
the value of the "cu-byte" byte of the transaktion header
(delivered by waittrans in: "destination shift(-12)extract 12")
not necessarily are identical if TEM is employed. The following
algorithm solves the problem:
"cu := logand (cu-byte, exor (MASK, -1))"
or:
"cu := logand (destination shift(-12)extract 12, exor (MASK, -1))"
where "MASK" must be identical to MASK parameter of the
"createlink" call to the adp (output) device.
mask, subst: must be identical to the "mask" and "subst" parameters
of the "createlink" call to the adp (output) device.
note: if tem is not employed the "mask" and "subst" parameters have
no significance.
*>
begin
integer i, status;
integer array zia (1:20), sia (1:12);
long array arr (1:2);
zone z_adp (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 (z_adp, 0, string arr (increase(i)),0);
getshare (z_adp, sia, 1);
sia(4):= 4 shift 12 + 20; <* operation:= wait_ready *>
sia(6):= cu shift 8 + device;
sia(11):= (logand (mask, subst))shift 8; <* tem addressing information *>
setshare (z_adp, sia, 1);
monitor (16)send_message:(z_adp, 1, sia);
status:= 1 shift (monitor(18)wait_answer:(z_adp,1,sia));
if status = 2 then status:= status+sia(1);
wait_ready:= if status = 2 then sia(2) else -1;
close (z_adp, false);
end wait_ready;
',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◀