|
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: 52224 (0xcc00)
Types: TextFile
Names: »releasel3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »releasel3tx «
(releaselink=algol connect.no
scope login releaselink
lookuplink=assign releaselink
scope login lookuplink
createlink=assign releaselink
scope login createlink
lookupdev=assign releaselink
scope login lookupdev
end)
<* 02.01.79 link programs page...1...*>
begin
message link programs 07.03.79 *** v.60 ;
<*
this program comprises the utility programs releaselink, lookuplink,
createlink and lookupdev.
contents
--------
program descriptions........................................2
common initialization......................................20
main program for releaselink and lookuplink................22
initialization of tables used in createlink and lookupdev..24
main program for createlink and lookupdev..................26
common exit................................................30
procedures:
assignparam...............................................6
devno_to_address..........................................4
error....................................................16
linkup....................................................7
name_to address...........................................4
nextdevname..............................................13
nextfp...................................................19
printalldev..............................................13
printdev.................................................14
printlink................................................11
searchname................................................5
sendrelease..............................................18
setshareandzone..........................................10
skipstatement.............................................5
\f
07.03.79 link programs page...2...
1. releaselink
--------------
the utility program releaselink is used to remove links to devices in
rcnet. the links can be of a temporary as well of a permanent type.
the net supervisor functions release link is used.
e.g.
releaselink 11 13 reader 21 sub013
end links released: 5
note: a left side holding the name of an output file is
allowed for all 4 programs.
2. lookuplink
-------------
the utility program lookuplink prints all parameters describing a
link in rcnet. the link is specified by its logical device
number or the name of the associated external process.
the net supervisor function lookup process (and lookup link) are used
to get the link information.
e.g.
lookuplink 12 printer1 24
lookuplink d.790112.1623
ident kind buf size proc.name jh.lno jh.id jh.nid
type subhostno dh.lno dh.id dh.nid
12 8 1 400 sub028 12 27 0
temp 1031 23 405 0
printer1 114 2 600 printer1 16 27 0
perm 1021 8 405 0
24
free
end links looked up: 3
3. createlink
-------------
the utility program createlink is used for setting up links to peripheral
devices connected to device hosts in rcnet. the link can be of a temporary
as well of a permanent type.
the net supervisor functions release link, lookup process, link up remote
and link up local are used.
e.g.
createlink host.21.1012.0.0 bufsize.900 lp.printer1.temp.name.prba4
end links created: 1
*** if test output is wanted from createlink then assign the variable
'test' on page 4 to true.
the test output is generated in connection with the linkup message on
current output by call of writeall and has the following contents:
- message(1:10)
- output(1:10)
- value of answer result
- answer(1:6)
- input(1:11)
\f
07.03.79 link programs page...3...
4. lookupdev
------------
the utility program lookupdev prints all parameters for a
peripheral device specified by the device host and the
device name.
the net supervisor function lookup is used to get the information.
e.g.
lookupdev host.17.5013 dev.terminal8 dev.terminal12
lookupdev d.790116.0921
device name kind buf size dh.lno dh.id dh.nid
terminal8 8 1 128 7 5013 0
terminal12 8 1 192 16 5013 0
end devices looked up: 2
*>
\f
<* 30.12.82 link programs page...4...*>
boolean test;
integer datasize,zbufsize,maxevent,maxtype,maxparam,maxstate;
test:= false; <* test output indicator, see page 2 point 3. *>
datasize:= 21; <* size of data field in a link message*>
zbufsize:= (datasize-1)//4+1; <* the zone buffer size in reals*>
maxevent:= 5; <* no of events in action-state table*>
maxstate:= 14; <* no of states - - - - *>
maxparam:= 4; <* no of legal parameter types in call*>
maxtype:= 24; <* no of legal device types in call*>
begin <* inner block *>
boolean nodevice,nl,sp,head,leftside,success;
integer separator, item, paramno, int, procadr, nametabfirst,i,
j,action,state,a,paramtype,devicetype,modekind,bufsize,bufno,
nametabtop, linkcount, position, statement, program,event,devno,
hostno, hostid, netid_homereg, refdevno, entry;
real nul,r;
integer array zdescr,zdesinit(1:20), shdescr,shdesinit(1:12),
paramvalue(1:maxparam),paramstd(1:maxtype,1:maxparam),
statetable(1:maxevent,1:maxstate);
array devname,procname,progname,name,stak,navn,refprocname,entryname(1:2);
zone z(zbufsize,1,stderror);
integer procedure name_to_address(name);
array name;
<* convert process name to process descr address *>
begin
zone zz(1,1,stderror);
integer array ia(1:2); integer i;
i:= 1;
open(zz,0,string name(increase(i)),0);
close (zz,true); <*release process*>
name_to_address:= monitor(4,zz,i,ia);
end;
integer procedure devno_to_address(devno);
value devno; integer devno;
<* convert device no to process descr address *>
begin
integer nametabaddr;
integer array corearr(0:1);
<* get address via name table *>
system(5,nametabfirst,corearr);
nametabaddr:= corearr(0) + 2*devno;
system(5,nametabtop,corearr);
if corearr(0) > nametabaddr then
begin
system(5,nametabaddr,corearr);
devno_to_address:= corearr(0)
end
else devno_to_address:= 0;
end;
\f
<* 07.03.79 link programs page...5...*>
procedure skipstatement;
<* reads fp parameters until <sp> or <eop> is met, indicating
end of a statement.
on exit the global paramno is decreased by one. *>
begin
repeat
nextfp;
until separator<>3;
paramno:= paramno-1
end;
integer procedure searchname(name,type);
array name; integer type;
<* search name among the legal text parameters, which may be found
in the beginning of a statement.
the result is delivered as :
type(return value) = 1
text searchname
---- ----------
mode 1 nb illegal!, type is set to 4. at present the
kind 2 basic software dont use modekind spec in lookup
bufsize 3
buffers 4
type = 2
gac 1
bs 2
tw 3
tro 4
tre 5
trn 6
trf 7
tpo 8
tpe 9
tpn 10
tpf 11
lp 12
crb 13
crc 14
crmb 15
crmd 16
crba 17
mto 18
mte 19
nrz 20
nrze 21
pl 22
flx 23
tlx 24
type = 3
dev 1
type = 4
name not found 0
*>
\f
<* 07.03.79 link programs page...6...*>
begin
boolean found; integer i;
i:=0; found:= false;
repeat
i:= i+1;
found:= (name(1) = real(case i of
(<:mode:>,<:kind:>,<:bufsi:> add 122,<:buffe:> add 114,
<:gac:>,<:bs:>,<:tw:>,<:tro:>,<:tre:>,<:trn:>,<:trf:>,
<:tpo:>,<:tpe:>,<:tpn:>,<:tpf:>,<:lp:>,<:crb:>,<:crc:>,
<:crmb:>,<:crmd:>,<:crba:>,<:mto:>,<:mte:>,<:nrz:>,<:nrze:>,
<:pl:>,<:flx:>,<:tlx:>,<:dev:>)))
and name(2) = (if i=3 then real<:e:>
else if i=4 then real<:s:>
else name(2));
until found or i = maxparam + maxtype + 1;
type:=
if -,found then 4 else
if i <= maxparam then 1 else
if i <= maxparam + maxtype then 2
else 3;
if type=1 and i<=2 then type:= 4; <* se notabene above *>
searchname:= case type of(i,i-4,1,0);
end;
procedure assignparam(modekind,bufsize,bufno);
integer modekind,bufsize,bufno;
<* assigns the 3 parameters according to the global devicetype and
the value of paramvalue(i) as follows:
-2 : max value (only bufsize and bufno)
-1 : standard value
>=0 : paramvalue(i)
*>
begin
integer mode,kind;
integer array param(1:maxparam);
for i:=1 step 1 until maxparam do
param(i):= if paramvalue(i) = -1 then paramstd(devicetype,i)
else if paramvalue(i) = -2 then (if i=3 then 30000 else 100)
else paramvalue(i);
param(1):= param(1) extract 8;
modekind:= param(1) shift 12 + param(2);
bufsize:= param(3);
bufno:= param(4)
end;
\f
<* 07.03.79 link programs page...7...*>
procedure linkup(modekind,bufsize,bufno,devno,devname,procname,success);
value modekind,bufsize,bufno,devno;
integer modekind,bufsize,bufno,devno;
boolean success;
array devname,procname;
<* modekind: mode<12 + kind
bufsize : buffer size
bufno : number of buffers
devno : logical device number in jobhost,
equal to -1 if temporary link wanted
devname : internal name in the device host of the device
procname: wanted name of the external process,
equal to nul if omitted in call
success : return - false if an error is detected concerning
<hostdef> or the devicehost.
global quanties:
refdevno : see procedure printdev, par. devno
refprocname: see procedure printdev, par. procname
entryname : wanted name of catalog entry equal to nul
if omitted in call
the procedure performs
- if devno specifies an existing link, the link is released
- send a linkup message to the host process according to the
parameters
- if procname is specified the external process is named with
this name by call of create peripheral process.
*>
begin
integer i,j,res,result,status,procadr;
integer array field iaf;
real array field raf;
zone p(1,1,stderror);
boolean bitsat;
integer array help(1:20);
<* if devno is specified (permanent link), and found in the nametable
then send a release operation to host and wait until the link
actually is removed
*>
success:= true;
if devno >= 0 then
begin
procadr:= devno_to_address(devno);
if procadr > 0 then
begin <* devno exists *>
if sendrelease(procadr) then
goto linkupout <* timeout *>
end
else
begin <* unknown devno *>
error(67);
goto linkupout
end
end;
<* convert refdevno/refprocname to process descr address if
refdevo >= -1 *>
procadr:= if refdevno = -1 then name_to_address(refprocname)
else if refdevno >= 0 then devno_to_address(refdevno)
else -1;
\f
<* 07.03.79 link programs page...8...*>
if procadr = 0 then
begin <* unknown process *>
error(68);
success:= false;
goto linkupout
end;
<* set up the linkup message *>
setshareandzone(1 shift 12 + (if devno=-1 then 6 else 7) shift 1
+ (if refdevno=-2 then 0 else 1), procadr);
<* assign the data fields *>
raf:=0;
if test then writeall(out,shdescr.raf,20,125);
iaf:= 0;
z.iaf(1):= modekind;
z.iaf(2):= 0 shift 12 + bufno; <* timeout field = 0 *>
z.iaf(3):= bufsize;
<* move devname to a integer array *>
i:=1;
open(p,0,string devname(increase(i)),0);
getzone6(p,help);
close(p,true);
for i:=4 step 1 until 7 do
z.iaf(i):= help(i-2);
z.iaf(8):= devno;
z.iaf(9):= 0; <* senderhost = jobhost ved linkup remote *>
if test then writeall(out,z,20,125);
monitor(16,z,1,shdescr); <* send messge *>
res:= monitor(18,z,1,help); <* wait answer *>
if test then write(out,nl,1,<:ares :>,res,nl,1);
if test then writeall(out,help.raf,12,125);
if test then writeall(out,z,22,125);
if res=1 then
begin <* normal answer *>
result:= help(1) extract 12;
if result <> 0 then
begin <* error indicated in function result *>
if result = 1 then
begin <* device troubles (specified in device status) *>
status:= help(1);
bitsat:= false;
i:= 0;
repeat
i:= i+1;
bitsat:= status < 0;
status:= status shift 1;
until bitsat or i=8;
if bitsat then
begin <* error 28-35 *>
error(27+i);
goto linkupout
end
else
begin <* all bits are 0, should not be possible *>
error(36);
goto linkupout
end
end result=1
\f
<* 07.03.79 link programs page...9...*>
else if result = (-1) extract 12 then error(37)
else
begin <* result is >= 2, error 38-45 *>
error(if result <= 8 then result+36 else 45);
if result = 8 then success:= false; <* devicehost unknown *>
goto linkupout
end
end result <> 0
else
begin <* result=0 meaning function executed *>
<* now rename the external process if procname specified
or create a catalog entry holding modekind and external process name
if entryname is specified
*>
if procname(1) <> nul then
begin
devno:= z.iaf(8); <* get logical device no from input data *>
i:=1;
open(p,0,string procname(increase(i)),0);
i:= monitor(54,p,devno,shdescr); <* create peripheral process *>
close(p,true);
if i > 0 then
begin <* error result, error 46-51 *>
error(i+45);
<* release link again *>
sendrelease(z.iaf(11)); <* process descr address *>
goto linkupout
end
end
else if entryname(1) <> nul then
begin
integer array docname(2:5);
i:= 1;
open(p,0,string entryname(increase(i)),0);
shdescr(1):= modekind + 1 shift 23;
procadr:= z.iaf(11); <* proc descr addr of link process *>
system(5,procadr+2,docname);
for i:=2 step 1 until 5 do shdescr(i):= docname(i);
for i:=6 step 1 until 10 do shdescr(i):= 0;
res:= monitor(40,p,i,shdescr); <* create entry *>
close(p,true);
if res > 0 then
begin <* create entry not ok, error 58,59,61,62,63,64,48,
release link again *>
error(if res=3 then 48 else res+57);
sendrelease(procadr);
goto linkupout
end
end entryname(1) <> 0
end result = 0;
linkcount:= linkcount + 1;
end res = 1
else
begin <* error result from wait answer call, error 52-55, 68 *>
error(if refdevno>=-1 and res=3 then 68 else res+50);
success:= false;
goto linkupout
end;
linkupout: ;
end linkup;
\f
<* 07.03.79 link programs page...10...*>
procedure setshareandzone(op,procadr);
value op,procadr; integer op,procadr;
<* the procedure assigns the necessary fields in the share and
the zone descriptor for the zone host according to the parameters
op : operation<12 + function mode<1 + address mode
procadr: process descr address assigned to the ident. field in
the message if address mode = 1.
global variables(assigned in the actions and to be put
into the share descriptor if address mode = 0)
hostno : host number
hostid : devicehostid
netid_homereg: netid < 12 + homereg
*>
begin
integer i;
<* init share and zone descr *>
for i:= 1,2,3,10,11,12 do
shdescr(i):= shdesinit(i);
for i:= 1 step 1 until 20 do
zdescr(i):= zdesinit(i);
shdescr(4):= op;
shdescr(5):= zdescr(19) + 1; <* first(data) *>
shdescr(6):= zdescr(19) + datasize; <* last(data) *>
if op extract 1 = 1 then
shdescr(7):= procadr <* ident.field *>
else
begin <* address mode = 0 *>
shdescr(7):= hostno;
shdescr(8):= hostid;
shdescr(9):= netid_homereg;
end;
setshare6(z,shdescr,1);
zdescr(14):= zdescr(19); <* record base *>
zdescr(15):= zdescr(19) + zdescr(20); <* last byte *>
zdescr(16):= zbufsize*4;
setzone6(z,zdescr);
end;
\f
<* 07.03.79 link programs page...11...*>
procedure printlink(procadr,all);
value procadr; boolean all; integer procadr;
<* the procedure prints all link parameters associated to the link
specified by the external process address procadr.
if all = true the error message 'link unknown' (answer result 3)
is suppressed.
globals:
item: see procedure nextfp
int : device number
name: process name
*>
begin
integer i,res,result,linkdescr,pos;
real p;
integer array help(1:8);
integer array field iaf;
<* call lookup process*>
setshareandzone(1 shift 12 + 2 shift 1 + 1,procadr);
<* no output data *>
monitor(16,z,1,shdescr); <* send message*>
res:= monitor(18,z,1,help); <* wait answer *>
if res>1 then
begin <* dummy answer, error 4-7 *>
if all and res <> 3 or -,all then
error(res+2);
goto linkout
end;
result:= help(1) extract 12;
if result=0 then
begin <* function executed *>
iaf:=0;
i:= 1;
linkdescr:= help(1) shift (-12) extract 3; <* 0,1 or 2 *>
if head then
begin
head:= false;
write(out,nl,1,<:link survey d.:>,
<<dddddd.dddd>,systime(5,0,r) + r/1000000,nl,1,
<:
ident kind buf size proc.name jh.lno jh.id jh.nid
type subhostno dh.lno dh.id dh.nid
:>);
end;
if linkdescr > 2 then
begin <* should not be possible *>
error(70);
goto term
end;
i:=1;
case item of
begin
pos:= write(out,nl,1,<<d>,int);
pos:= write(out,nl,1,string name(increase(i)));
end;
\f
<* 07.03.79 link programs page...12...*>
if linkdescr=0 then
begin <* free subprocess *>
write(out,nl,1,<:free:>,nl,1);
linkcount:= linkcount + 1;
goto linkout
end;
write(out,sp,12-pos,<<dddd>,z.iaf(1),z.iaf(2),sp,2,z.iaf(3),sp,1);
p:= z(2) shift 24;
i:=3;
pos:= write(out,string p,string z(increase(i)));
write(out,sp,14-pos,<<ddddd>,z.iaf(8),sp,2,z.iaf(9),sp,1,
z.iaf(10) extract 12,nl,1,
case linkdescr of(<:temp:>,<:perm:>),sp,22);
<* skip call of lookup link until it is implemented in ncp.
it means that the device name cannot be printed
*>
pos:=0;
goto lus;
<* now call lookup link to get the device host parameters and the
device name *>
setshareandzone(1 shift 12 + 8 shift 1 + 1,procadr);
<* no output data *>
monitor(16,z,1,shdescr); <* send message *>
res:= monitor(18,z,1,help); <* wait answer *>
if res > 1 then
begin <* dummy answer, error 4-7 *>
error(res+2);
goto linkout
end;
p:= z(2) shift 24;
i:= 3;
pos:= write(out,string p,string z(increase(i)));
lus:
write(out,sp,0-pos,<<ddddd>,help(4) extract 12,sp,9,
help(4) shift (-12),sp,2, help(5),sp,1,help(6) extract 12,nl,1);
linkcount:= linkcount + 1;
end <* function result = 0 *>
else <* function result <> 0 , error 17-24, 37 *>
error(if result = -1 then 37 else result+16);
linkout:
;
end printlink;
\f
<* 07.03.79 link programs page...13...*>
procedure printalldev(devno,procname);
value devno; integer devno;
array procname;
<* the procedure prints the parameters associated to all devices
on the specified devicehost.
devno : see procedure printdev
procname : see procedure printdev
note: among the devices connected to the jobhost via the gac
interface in ncp, the procedure only check if fd0, fd1,...
exists.
*>
begin
integer i,j,result,pos,nameix,linknum;
linknum:= 0;
for i:=1 step 1 until 12 do
begin
devname(1):= real (case i of (
<:termi:>,<:print:>,<:cardr:>,<:reade:>,<:punch:>,<:plott:>,
<:mt0:>,<:ct0:>,<:disc0:>,<:fd0:>,<:inhdl:>,<:outhd:>))
add (case i of (110,101,101,114,0,101,0,0,0,0,99,108));
devname(2):= real (case i of
(<:al1:>,<:r:>,<:ader:>,<::>,<::>,<:r:>,
<::>,<::>,<::>,<::>,<:1:>,<:c1:>));
nameix:= case i of(2,2,2,2,1,2,1,1,1,1,2,2);
j:= case i of(1,0,0,0,0,0,0,0,0,0,1,1);
pos:= case i of(4,5,2,6,1,5,4,4,2,4,6,8);
repeat
result:= 0;
printdev(devno,procname,devname,linknum,result);
if result = 0 then
linknum:= linknum + 1;
j:= j+1;
nextdevname(devname(nameix),pos,j);
until result > 0;
if result = 2 then goto finalldev
end i;
finalldev: ;
end printalldev;
procedure nextdevname(name,pos,num);
value pos,num; integer pos,num;
real name;
<* the procedure converts num to decimal and store it in name
starting from position pos. only significant digits are stored.
the leftmost char has pos=6 and the rightmost char pos=1.
it is assumed that the packing of num in name according to pos
is possible.
*>
begin
integer c1,c2,c3,decnum,size;
size:= if num>=100 then 1 else if num>=10 then 2 else 3;
c1:= case size of(num//100 + 48,num//10 + 48,num + 48);
c2:= case size of((num mod 100)//10 + 48,num mod 10 + 48,0);
c3:= case size of((num mod 10) + 48,0,0);
decnum:= case size of(c1 shift 16 add (c2 shift 8) add c3,
c1 shift 8 add c2,c1);
name:= name shift (-pos*8) shift (case size of(24,16,8))
add decnum shift (pos*8 - (case size of(24,16,8)));
end nextdevname;
\f
<* 07.03.79 link programs page...14...*>
procedure printdev(devno,procname,devname,linkno,result);
value devno,linkno; integer devno,linkno,result;
array procname,devname;
<* the procedure prints all parameters associated to the device
specified by devname.
devno : -2 : devicehost specified by hostno, hostid, netid and
homereg (global variables assigned in the actions
and to be put into the share descriptor).
-1 : devicehost specified by procname.
>=0 : devicehost specified by devno, the logical
device number of an external process associated
with a link to the devicehost.
procname : name of an external process associated with a link
to the devicehost.
devname : the name of the device on the devicehost
linkno : -1 : only print linkno if terminal
>=0 : print linkno equal to linkno
result : call : 0 - suppress error message 'device unknown'
1 - normal error printing
return: 0 - device survey printed
1 - device unknown
2 - error in devicehost specification
*>
begin
integer i,res,pos,lno;
integer array field iaf;
real array field raf;
zone p(1,1,stderror);
integer array help(1:20);
<* convert devno/procname to process descr address if devno>=-1 *>
procadr:= if devno = -1 then name_to_address(procname)
else if devno >= 0 then devno_to_address(devno)
else -1;
if procadr = 0 then
begin <* unknown process *>
error(68);
result:= 2;
goto devfinis
end;
<* prepare call of lookup *>
setshareandzone(1 shift 12 + 3 shift 1 + (if devno = -2 then 0
else 1), procadr);
raf:= 0;
iaf:= 0;
<* assign dummy values for modekind, buffers and buffersize in
the data fields *>
z.iaf(1):= -1;
z.iaf(2):= 0;
z.iaf(3):= 0;
\f
<* 30.12.82 link programs page...15...*>
<* move devname to a integer array *>
i:= 1;
open(p,0,string devname(increase(i)),0);
getzone6(p,help);
close(p,true);
for i:= 4 step 1 until 7 do
z.iaf(i):= help(i-2);
monitor(16,z,1,shdescr); <* send message *>
res:= monitor(18,z,1,help); <* wait answer *>
if res > 1 then
begin <* dummy answer, error 52,53/68,54,55 *>
error(if devno>=-1 and res=3 then 68 else res+50);
result:= 2;
goto devfinis
end;
res:= help(1) extract 12;
if res = 0 then
begin <* function executed *>
lno:= linkno;
if linkno = -1 then
begin <* calculate linkno if terminal *>
if devname(1) = real<:termi:> add 110 then
begin
integer tno, digit;
tno:= devname(2) shift (-8) extract 24;
lno:= tno shift (-16) extract 7 - 48;
for i:= 1,2 do
begin
digit:= tno shift (case i of(-8,0)) extract 7 - 48;
if digit <> -48 then
lno:= lno*10 + digit
end;
lno:= lno - 1;
end
end linkno = -1;
if head then
begin
head:= false;
write(out,nl,1,<:device survey d.:>,
<<dddddd.dddd>,systime(5,0,r) + r/1000000,nl,1,
<:
device name kind buf size dh.lno dh.id dh.nid
:>,nl,1);
end;
i:= 1;
pos:= write(out,string devname(increase(i)));
write(out,sp,12-pos,<<dddd>,z.iaf(1),z.iaf(2),sp,2,z.iaf(3),sp,2);
if lno = -1 then write(out,<: -:>)
else write(out,<<dddd>,lno);
write(out,sp,2,<<ddddd>,help(5),sp,1,help(6) extract 12,nl,1);
linkcount:= linkcount+1;
result:= 0;
end <* function result = 0 *>
else <* function result <> 0, error 8-16,37, 44 *>
begin
if result=1 or result=0 and res<>1 then
error(if res = -1 then 37 else if res=8 then 44 else res + 7);
result:= if res=1 then 1 else 2;
end;
devfinis: ;
end printdev;
\f
<* 07.03.79 link programs page...16...*>
procedure error(no);
value no; integer no;
<* write error message defined by no *>
begin integer i;
i:=1;
write(out,<:***:>,string progname(increase(i)),sp,1,<<dd>,statement,sp,2,case no of(
<:call:>, <* 1 rl, ll, cl, ld *>
<:illegal format:>, <* 2 rl, ll, cl, ld *>
<:process unknown:>, <* 3 rl, ll *>
<:process not user of subhost:>, <* 4 ans.res 2 rl.sr, ll *>
<:link unknown:>, <* 5 - - 3 - ll *>
<:line error:>, <* 6 - - 4 - *>
<:p.err 2:>, <* 7 - - 5 - ll *>
<:devicename unknown:>, <* 8 func.res 1,0 rl.sr, ld *>
<:p.err 3:>, <* 9 - - 1,1 - - *>
<:p.err 4:>, <*10 - - 1,2 - - *>
<:p.err 5:>, <*11 - - 1,3 - - *>
<:p.err 6:>, <*12 - - 1,4 - - *>
<:p.err 7:>, <*13 - - 1,5 - - *>
<:p.err 8:>, <*14 - - 1,6 - - *>
<:p.err 9:>, <*15 - - 1,7 - - *>
<:p.err 10:>, <*16 - - 1,n - *>
<:p.err 11:>, <*17 func.res -1, rl.sr / 1,ll*>
<:p.err 12:>, <*18 - - 2, rl.sr, ll *>
<:p.err 13:>, <*19 - - 3 - - *>
<:p.err 14:>, <*20 - - 4 - - *>
<:p.err 15:>, <*21 - - 5 - - *>
<:p.err 16:>, <*22 - - 6 - - *>
<:p.err 17:>, <*23 - - 7 - - *>
<:p.err 18:>, <*24 - - 8 - - *>
<:p.err 19:>, <*25 - - >8 - - *>
<:timeout:>, <*26 wait in cl.sr *>
<:device number unknown:>, <*27 cl.lu *>
<:devicename unknown:>, <*28 func.res 1,0 cl.lu *>
<:device closed:>, <*29 - - 1,1 - *>
<:p.err 20:>, <*30 - - 1,2 - *>
<:p.err 21:>, <*31 - - 1,3 - *>
<:p.err 22:>, <*32 - - 1,4 - *>
<:no driver:>, <*33 - - 1,5 - *>
<:device reserved by another process:>, <*34 - 1,6 - *>
<:reservation rejected:>, <*35 - - 1,7 - *>
<:p.err 23:>, <*36 - - 1,n - *>
<:sender stopped:>, <*37 func.res -1 cl.lu / ll /ld*>
<:device reserved by another host:>,<*38 - 2 cl.lu *>
<:no ressources at jobhost:>, <*39 - 3 - *>
<:no ressources at devicehost:>, <*40 - 4 - *>
<:p.err 24:>, <*41 - 5 - *>
<:high priority request:>, <*42 - 6 - *>
<:permanent link exists:>, <*43 - 7 - *>
<:devicehost unknown:>, <*44 - 8 - ld *>
\f
<* 07.03.79 link programs page...17...*>
<:p.err 26:>, <*45 - >8 = *>
<:renaming not allowed:>, <*46 create p. 1 cl.lu *>
<:p.err 27:>, <*47 - 2 - *>
<:name conflict:>, <*48 - 3 - .ce *>
<:p.err 28:>, <*49 - 4 - *>
<:device reserved by another user:>,<*50 - 5 - *>
<:p.err 29:>, <*51 - 6 - *>
<:process not user of subhost:>, <*52 answ.res 2 cl.lu, ld *>
<:subhost number error:>, <*53 - 3 - - *>
<:line error:>, <*54 - 4 - - *>
<:p.err 30:>, <*55 - 5 - - *>
<:p.err 31:>, <*56 see act. 11 cl *>
<:no device statement:>, <*57 cl, ld *>
<:p.err 32:>, <*58 result 1 cl.le.ce ld rl.re *>
<:catalog error:>, <*59 - 2 - *>
<:unknown hostname:>, <*60 - 3 -(not ce)*>
<:claims exceeded:>, <*61 - 4 - *>
<:create entry not allowed:>, <*62 - 5 - *>
<:p.err 35:>, <*63 - 6 - *>
<:p.err 36:>, <*64 - 7 - *>
<:unknown statement:>, <*65 cl, ld *>
<:no host statement:>, <*66 cl, ld *>
<:device number unknown:>, <*67 cl *>
<:hostref error:>, <*68 ld *>
<:connect outfile impossible:>, <*69 rl, ll, cl, ld *>
<:p.err 37:>, <*70 linkdescr>2, ll *>
<:remove entry not allowed:>), <*71 rl.re *>
nl,1);
errorbits:= 1; <* set ok.no *>
end error;
\f
<* 07.03.79 link programs page...18...*>
boolean procedure sendrelease(procadr);
value procadr; integer procadr;
<* release the link specified by the process descr address procadr
by sending a release message to the host process.
if program=createlink and the answer is ok, the procedure
waits until the link actually is removed (max 10 seconds).
if timeout occurs sendrelease is set to true.
*>
begin
integer i, res,status,tries; boolean bitsat;
sendrelease:= false;
<* send release link operation *>
setshareandzone(2 shift 12 + 0 shift 1 + 1,procadr);
monitor(16,z,1,shdescr); <* send message *>
res:=monitor(18,z,1,shdescr); <* wait answer *>
if program=3 then
begin <* createlink *>
if res=1 then
begin <* normal answer *>
if shdescr(1) extract 12 = 0 then
begin <* function result ok, wait max 10 seconds for link removed *>
zone zur(8,1,stderror); integer array ia(1:12);
tries:= 0;
rep: open(zur,0,<:clock:>,0);
getshare(zur,ia,1);
ia(4):= 0 shift 12 + 0;
ia(5):= 1; <* wait 1 second *>
for i:=6 step 1 until 11 do ia(i):= 0;
setshare(zur,ia,1);
monitor(16,zur,1,ia); <* send message to clock *>
monitor(18,zur,1,ia); <* wait answer from clock *>
<*perform lookup process *>
setshareandzone(1 shift 12 + 2 shift 1 + 1,procadr);
monitor(16,z,1,shdescr); <*send message *>
monitor(18,z,1,shdescr); <*wait answer *>
close(zur,true);
<* get link descriptor, =0 if link removed *>
res:= shdescr(1) shift (-12) extract 3;
tries:= tries + 1;
if res > 0 and tries < 10 then
goto rep;
if res > 0 then
begin
error(26);
sendrelease:= true
end;
end
end res=1;
goto exits
end createlink;
<* releaselink, write possible error messages *>
if res > 1 then
begin <* dummy answer, error no 4-7 *>
error(res+2); <* answer result 2,3,4 and 5 *>
goto exits
end;
<* res is 1, check answer in shdescr(1) *>
res:= shdescr(1) extract 12; <* get function result *>
\f
<* 07.03.79 link programs page...19...*>
if res = 1 then
begin <* device troubles specified in device bits, error no 8-16 *>
status:= shdescr(1); <* status is stored in bit 0-7 *>
bitsat:= false; i:= 0;
repeat
i:= i+1;
bitsat:= status < 0;
status:= status shift 1;
until bitsat or i=8;
if bitsat then
error(i+7)
else error(16); <* should not be possible *>
end res=1
else
if res = (-1) extract 12 then error(17)
else if res>1 then
error(if res<=8 then res+16 else 25)
else
begin <* function result=0 meaning ok *>
linkcount:= linkcount + 1;
end;
exits: ;
end sendrelease;
procedure nextfp;
<*
the procedure reads and lists the next fp-parameter.
global quantities:
separator 1: <s>, 2: =, 3: <point>, 4: <end of param>.
0: <newline>.
item 1: <integer>, 2: <name>.
paramno the number of the preceding parameter, it is in-
creased by one in the procedure.
int will contain an integer parameter.
name will contain a name parameter.
*>
begin
integer i;
paramno:= paramno + 1;
name(1):= name(2):= nul;
i:= system(4, paramno, name);
item:= if i extract 12 = 4 then 1 else 2;
if item = 1 then int:= name(1);
i:= i shift (-12);
separator:= if i = 4 then 1
else
if i = 6 then 2
else
if i = 8 then 3
else
if i = 2 then 0
else
4;
end nextfp;
\f
<* 07.03.79 link programs page...20...*>
<* start program *>
nl:= false add 10;
sp:= false add 32;
head:= nodevice:= true;
nul:= stak(1):= stak(2):= real<::>;
nametabfirst:= 74; <* addr of first word in nametable *>
nametabtop := 76; <* addr of top word in nametable *>
open(z,0,<:host:>,0);
getzone6(z,zdesinit);
getshare6(z,shdesinit,1);
<* get program name
program
1 releaselink
2 lookuplink
3 createlink
4 lookupdev
*>
paramno:= 0;
nextfp;
if separator <> 2 then
begin <* no left side present *>
paramno:= -1;
nextfp;
end;
for i:= 1,2 do progname(i):= name(i);
r:= name(1) shift (-24) shift 24;
program:= if r = real<:rel:> then 1 else
if r = real<:loo:> and name(2) = real<:link:> then 2 else
if r = real<:cre:> then 3 else
4;
<* check if left side present and at least 1 parameter *>
paramno:= linkcount:= position:= statement:= 0;
leftside:= false;
nextfp;
i:= 0;
if separator = 4 then
begin <* no parameters *>
paramno:= -1;
nextfp;
for i:= 1,2 do progname(i):= name(i);
error(1);
goto term
end;
if separator = 2 then
begin <* left side present *>
for i:= 1,2 do progname(i):= name(i);
nextfp;
if separator = 4 then
begin <* no parameters *>
error(1);
goto term
end;
\f
<* 07.03.79 link programs page...21...*>
leftside:= true;
paramno:= -1;
nextfp;
for i:= 1,2 do navn(i):= name(i);
fpproc(29,0,out,stak); <* stack out *>
i:= 1 shift 1 + 1; <* if outfile dont exist, it is created on
disc with a size on 1 segment *>
fpproc(28,i,out,navn); <* connect out *>
if i > 0 then
begin <* connect outfile impossible *>
fpproc(30,0,out,stak);
error(69);
leftside:= false
end;
end;
statement:= 1;
position:= 0;
paramno:= if leftside or i>0 then 1 else 0;
if program = 3 or program = 4 then goto create;
\f
<* 07.03.79 link programs page...22...*>
<* main program for releaselink and lookuplink.
fetch and check the parameters one by one and send a release
or a lookup process operation if an existing external process is specified.
*>
nextparam:
nextfp;
if separator=4 then goto term;
if program = 2 and statement = 1 and name(1) = real<:all:> then
begin <* lookuplink all *>
nextfp;
if separator <> 4 then
begin <* more parameters after 'all' *>
error(2);
goto term
end;
int:= 0;
item:= 1; <* used in printlink *>
repeat
procadr:= devno_to_address(int);
if procadr>0 then printlink(procadr,true);
int:= int + 1;
until procadr = 0;
goto term
end;
<* test next sep is <sp> or <eop> *>
nextfp;
if separator=3 then
begin<* sep is point *>
error(2);
<* skip rest of the statement *>
repeat
nextfp;
until separator <> 3;
paramno:= paramno-1;
end
else
\f
<* 07.03.79 link programs page...23...*>
begin <* next sep is <sp> or <eop> *>
paramno:= paramno-2;
nextfp;
if item = 1 then procadr:= devno_to_address(int)
else
begin <* param is a name of a link process or a entryname *>
zone p(1,1,stderror); integer array tail(1:10);
i:=1;
open(p,0,string name(increase(i)),0);
i:= monitor(42,p,j,tail); <* lookup entry *>
close(p,true);
if i=0 then
begin <* lookup entry ok, check if non-area entry and get docname.
if releaselink then remove entry *>
if tail(1) < 0 then
begin <* non-area entry *>
name(1):= nul add tail(2) shift 24 add tail(3);
name(2):= nul add tail(4) shift 24 add tail(5);
if program = 1 then
begin <* releaselink, remove entry *>
i:= monitor(48,p,j,tail); <* remove entry *>
if i > 0 then
begin <* remove entry not ok, error 58,59,60,62,63,64,71 *>
error(if i=4 then 71 else i+57);
goto nextpar
end
end program = 1
end tail(1) < 0
end i=0;
procadr:= name_to_address(name);
end name param;
if procadr > 0 then
begin
case program of
begin
sendrelease(procadr);
printlink(procadr,false);
end
end
else error(3)
end;
nextpar:
statement:= statement + 1;
goto nextparam;
\f
<* 07.03.79 link programs page...24...*>
create: ;
<* main program for createlink and lookupdev.
the following action-state table is used when proccessing the parameters:
state 1 2 3 4 5 6 7 8 9 10 11 12 13 14
-----
event
1 2,50 3,50 3,50 9,7 9,7 9,7 7,7 14,7 14,7 14,7 21,7 3,50 14,7 14,7
2 2,50 4,3 6,4 8,6 10,6 16,7 11,50 15,6 16,7 19,11 16,7 23,6 16,7 16,7
3 1,2 3,50 3,50 9,7 9,7 9,7 12,8* 14,7 14,7 14,7 21,7 3,50 14,7 14,7
4 2,50 5,6 3,50 3,50 3,50 16,7 11,50 18,6 17,10 20,11 26,14 24,6 25,6 22,6
5 2,50 3,50 3,50 9,7 9,7 9,7 13,50 14,7 14,7 14,7 21,6 3,50 14,7 14,7
* possibly changed to 9 or 13 in the action.
in case of an error the state is changed in the action.
the program is prepared for a parameter <homereg> after the <netid> par.
event no meaning
-------- -------
1 <sp> <integer>
2 . <integer>
3 <sp> <text>
4 . <text>
5 <eop>(end of param)
state no meaning
-------- -------
1 after createlink or lookupdev
2 after host
3 after <hostno>
4 after <hostid>
5 after <netid> *** not used as <homereg> is not accepted ***
6 after last legal parameter in a statement
7 after statement
8 after parameter text (mode/kind/...)
9 after <type> (lp/bs/mt/....)
10 after <devname>
11 after <devno>/temp
12 after hostref
13 after text dev (lookupdev)
14 after name/entry
*>
\f
<* 07.03.79 link programs page...25...*>
<* first init the action-state table *>
a:= 2**12;
for i:=1 step 1 until maxevent do
for j:=1 step 1 until maxstate do
statetable(i,j):=
case i of (
(case j of (2*a+50,3*a+50,3*a+50,9*a+7,9*a+7,9*a+7,7*a+7,14*a+7,
14*a+7,14*a+7,21*a+7,3*a+50,14*a+7,14*a+7)),
(case j of (2*a+50,4*a+3,6*a+4,8*a+6,10*a+6,16*a+7,11*a+50,15*a+6,
16*a+7,19*a+11,16*a+7,23*a+6,16*a+7,16*a+7)),
(case j of (1*a+2,3*a+50,3*a+50,9*a+7,9*a+7,9*a+7,12*a+8,14*a+7,
14*a+7,14*a+7,21*a+7,3*a+50,14*a+7,14*a+7)),
(case j of (2*a+50,5*a+6,3*a+50,3*a+50,3*a+50,16*a+7,11*a+50,18*a+6,
17*a+10,20*a+11,26*a+14,24*a+6,25*a+6,22*a+6)),
(case j of (2*a+50,3*a+50,3*a+50,9*a+7,9*a+7,9*a+7,13*a+50,14*a+7,
14*a+7,14*a+7,21*a+7,3*a+50,14*a+7,14*a+7)));
<* init table with standard device parameters *>
for i:=1 step 1 until maxtype do
for j:=1 step 1 until maxparam do
paramstd(i,j):= <* mode kind bufsize bufnumber *>
case i of (
(case j of ( 0,0,10000,1)), <* gac *>
(case j of ( 0,6,768,1)), <* bs *>
(case j of ( 0,8,86,1)), <* tw *>
(case j of ( 0,10,258,1)), <* tro *>
(case j of ( 2,10,258,1)), <* tre *>
(case j of ( 4,10,258,1)), <* trn *>
(case j of ( 6,10,258,1)), <* trf *>
(case j of ( 0,12,258,1)), <* tpo *>
(case j of ( 2,12,258,1)), <* tpe *>
(case j of ( 4,12,258,1)), <* tpn *>
(case j of ( 6,12,258,1)), <* tpf *>
(case j of ( 0,14,258,1)), <* lp *>
(case j of ( 0,16,258,1)), <* crb *>
(case j of ( 10,16,258,1)), <* crc *>
(case j of ( 64,16,258,1)), <* crmb*>
(case j of ( 74,16,258,1)), <* crmd*>
(case j of ( 256,16,258,1)), <* crba*>
(case j of ( 0,18,3090,2)), <* mto *>
(case j of ( 2,18,3090,2)), <* mte *>
(case j of ( 4,18,3090,2)), <* nrz *>
(case j of ( 6,18,3090,2)), <* nrze*>
(case j of ( 0,20,258,1)), <* pl *>
(case j of ( 0,22,513,2)), <* flx *>
(case j of ( 0,36,258,1))); <* tlx *>
for i:= 1 step 1 until maxparam do
paramvalue(i):= -1; <* indicates parameter standard values *>
state:= 1;
\f
<* 07.03.79 link programs page...26...*>
<* read and check the parameters and execute the corresponding action *>
nextevent:
nextfp;
event:=
if separator = 4 then 5
else
case item of (
(if separator = 1 then 1 else 2),
(if separator = 1 then 3 else 4));
i:= statetable(event,state);
action:= i shift (-12);
state:= i extract 12;
case action of
begin
begin <* action 1, host or hostref read *>
if name(1) = (real<:hostr:> add 101) then
state:= 12 <* lookupdev *>
else
if name(1) <> real<:host:> then
begin
error(66);
state:= 50
end
else refdevno:= -2; <* indicates host read *>
end;
begin <* action 2 *>
error(65);
end;
begin <* action 3 *>
error(2)
end;
begin <* action 4, <hostno> read *>
hostno:= int extract 12;
netid_homereg:= 0;
end;
\f
<* 07.03.79 link programs page...27...*>
begin <* action 5, <hostname> read *>
integer array tail(1:10);
zone p(1,1,stderror);
i:=1;
open(p,0,string name(increase(i)),0);
i:= monitor(42,p,1,tail); <* lookup entry *>
close(p,true);
if i=0 then
begin
hostno:= tail(7) extract 12;
hostid:= tail(8) extract 16;
netid_homereg:= tail(10) extract 8 shift 12 + tail(9) extract 8;
end
else <* error no 58-64 *>
begin
error(57+i);
state:= 50;
end
end;
begin <* action 6, <hostid> read *>
hostid:= int extract 16
end;
begin <* action 7 *>
statement:= statement + 1;
act7:
error(65);
skipstatement;
state:= 7
end;
begin <* action 8, <netid> read *>
netid_homereg:= int extract 8
end;
act9:
begin <* action 9 *>
paramno:= paramno - 1;
end;
begin <* action 10, homereg read *>
netid_homereg:= netid_homereg + int extract 8 shift 12;
end;
begin <* action 11 *>
statement:= statement + 1;
error(56);
end;
\f
<* 07.03.79 link programs page...28...*>
begin <* action 12, text read as first param *>
statement:= statement + 1;
if program=4 and statement=2 and name(1)=real<:all:> then
begin <* lookupdev <hostdef> all *>
nextfp;
if separator <> 4 then
begin <* more parameters after all *>
error(2);
goto term
end;
printalldev(refdevno,refprocname);
goto term
end;
i:= searchname(name,j);
case j of
begin
begin <* param statement *>
paramtype:= i;
state:= 8
end;
begin <* device statement in createlink *>
devicetype:= i;
state:= 9
end;
begin <* device statement in lookupdev *>
state:= 13
end;
begin <* illegal text *>
goto act7
end
end
end;
begin <* action 13 *>
statement:= statement + 1;
if nodevice then error(57)
end;
begin <* action 14 *>
error(2);
goto act9
end;
begin <* action 15, param value read *>
paramvalue(paramtype):= int extract (if paramtype=3 then 16 else 8);
<* cut down to max allowable value *>
end;
act16:
begin <* action 16 *>
error(2);
skipstatement;
state:= 7;
end;
\f
<* 07.03.79 link programs page...29...*>
begin <* action 17, <devname> read *>
for i:=1,2 do devname(i):= name(i);
procname(1):= nul; <* changed if procname is read *>
entryname(1):= nul; <* changed if entry name is read *>
end;
begin <* action 18, std or max read *>
if name(1) = real<:std:> or name(1) = real<:max:> and paramtype>=3 then
paramvalue(paramtype):= if name(1) = real<:std:> then -1 else -2
else
goto act16
end;
begin <* action 19, <devno> read *>
devno:= int;
<* devno is checked and a release link operation is sent in
procedure linkup *>
end;
begin <* action 20, temp read *>
if name(1) <> real<:temp:> then
goto act16;
devno:= -1; <* indicate temp read in call of linkup *>
end;
begin <* action 21, end of device statement without process name spec. *>
assignparam(modekind,bufsize,bufno);
linkup(modekind,bufsize,bufno,devno,devname,procname,success);
if -,success then state:= 50;
nodevice:= false;
goto act9
end;
begin <* action 22, process name or entry name read in a device statement *>
case entry of
begin
for i:= 1,2 do entryname(i):= name(i);
for i:= 1,2 do procname(i):= name(i);
end;
<* check that proc.name or entryname is last parameter in statement *>
nextfp;
paramno:= paramno - 1;
if separator = 3 then goto act16;
assignparam(modekind,bufsize,bufno);
linkup(modekind,bufsize,bufno,devno,devname,procname,success);
if -,success then state:= 50;
nodevice:= false
end;
\f
<* 07.03.79 link programs page...30...*>
begin <* action 23, logical devno read after hostref *>
refdevno:= int
end;
begin <* action 24, procname read after hostref *>
for i:= 1,2 do refprocname(i):= name(i);
refdevno:= -1;
end;
begin <* action 25, device name read in lookupdev *>
for i:= 1,2 do devname(i):= name(i);
<* check that devname is last parameter in statement *>
nextfp;
paramno:= paramno -1;
if separator = 3 then goto act16;
a:=1;
printdev(refdevno,refprocname,devname,-1,a);
if a=2 then state:= 50;
nodevice:= false
end;
begin <* action 26, name/entry read *>
if name(1) = real<:entry:> then
entry:= 1
else if name(1) = real<:name:> then
entry:= 2
else goto act16
end
end case action;
if state <> 50 then goto nextevent;
<* common exit *>
term:
close(z,true);
trapmode:= 1 shift 10; <* suppress normal termination *>
write(out,nl,1,<:end :>,case program of
(<:links released: :>,<:links looked up: :>,<:links created: :>,
<:devices looked up: :>),
<<dd>,linkcount,nl,1);
if leftside then
begin <* terminate use of out *>
outchar(out,25);
close(out,true);
fpproc(30,0,out,stak);
end;
end inner block
end link programs
\f
▶EOF◀