|
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: »linkcentral«, »linkcntr4tx «
└─⟦4ee9f7d29⟧ Bits:30008158 SW8002/2
└─⟦1aff65501⟧
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦1aff65501⟧ »ncp4pack «
└─⟦0af7ac4b3⟧
└─⟦this⟧ »linkcentral«
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »linkcntr4tx «
begin
<*linkcentral*>
integer array zdescr(1:20),shdescr(1:12);
zone z(6,1,stderror),p(1,1,stderror),px(1,1,stderror);
integer bsmkind,bsbufs,bsbufsize,counter,
twmkind,twbufs,twbufsize,
ptrmkind,ptrbufs,ptrbufsize,
ptpmkind,ptpbufs,ptpbufsize,
lptmkind,lptbufs,lptbufsize,
cdrmkind,cdrbufs,cdrbufsize,
mtmkind,mtbufs,mtbufsize,
fdmkind,fdbufs,fdbufsize,
address;
boolean newname;
procedure bs(devno,devname);
integer devno;
string devname;
linkup(bsmkind,bsbufs,bsbufsize,devno,devname);
procedure tw(devno,devname);
integer devno;
string devname;
linkup(twmkind,twbufs,twbufsize,devno,devname);
procedure ptr(devno,devname);
integer devno;
string devname;
linkup(ptrmkind,ptrbufs,ptrbufsize,devno,devname);
procedure ptp(devno,devname);
integer devno;
string devname;
linkup(ptpmkind,ptpbufs,ptpbufsize,devno,devname);
procedure lpt(devno,devname);
integer devno;
string devname;
linkup(lptmkind,lptbufs,lptbufsize,devno,devname);
procedure cdr(devno,devname);
integer devno;
string devname;
linkup(cdrmkind,cdrbufs,cdrbufsize,devno,devname);
procedure mt(devno,devname);
integer devno;
string devname;
linkup(mtmkind,mtbufs,mtbufsize,devno,devname);
procedure fd(devno,devname);
integer devno;
string devname;
linkup(fdmkind,fdbufs,fdbufsize,devno,devname);
procedure host(hostno,hostid,homereg,netid);
integer hostno,hostid,homereg,netid;
begin
shdescr(7):=hostno;
shdescr(8):=hostid;
shdescr(9):=homereg shift 12 + netid;
counter:=counter+1;
end host;
procedure name(devicename);
string devicename;
begin
open(px,0,devicename,0);
counter:=counter+1;
newname:=true;
end name;
procedure sendrelease(address);
integer address;
begin
integer i, j, tries, maxtries; integer array help(1:12), help1(1:20);
maxtries:=50;
tries:=0;
for i:=1 step 1 until 12 do
help(i):=shdescr(i);
getzone6(z,help1);
shdescr(4):=2 shift 12 + 1;
shdescr(7):=address;
setshare6(z,shdescr,1);
monitor(16,z,1,shdescr);
monitor(18,z,1,shdescr);
testready:
for i:=1 step 1 until 12 do
shdescr(i):=help(i);
shdescr(4):=1 shift 12 + 1 shift 2 + 1;
shdescr(5):=zdescr(19) + 1;
shdescr(6):=zdescr(19) + 1 + 20;
shdescr(7):=address;
setshare6(z,shdescr,1);
monitor(16,z,1,shdescr);
tries:=tries+1;
i:=monitor(18,z,1,shdescr);
j:=shdescr(1) shift (-12) extract 3;
if i=1 and (j=1 or j=2) and tries<maxtries then
goto testready;
for i:=1 step 1 until 12 do
shdescr(i):=help(i);
setzone6(z,help1);
setshare6(z,shdescr,1);
end sendrelease;
procedure releaselink(devname);
string devname;
begin
zone zz(1,1,stderror);
integer array ia(1:2);
integer i;
counter:=counter+1;
open(zz,0,devname,0);
address:=monitor(4,zz,i,ia);
if address<>0 then
sendrelease(address);
close(zz,true);
end releaselink;
procedure linkup(mkind,bufno,bufsize,devno,devname);
integer mkind,bufno,bufsize,devno;
string devname;
begin
integer i,j;
integer array field iaf;
integer array name(1:20);
counter:=counter+1;
open(p,0,devname,0);
getzone6(p,name);
close(p,true);
iaf:=0;
shdescr(4):=1 shift 12 + 7 shift 1 +0;
shdescr(5):=zdescr(19)+1;
shdescr(6):=zdescr(19)+1+20;
setshare6(z,shdescr,1);
zdescr(14):=zdescr(19);
zdescr(15):=zdescr(19)+zdescr(20);
zdescr(16):=24;
setzone6(z,zdescr);
begin
integer array start,stop(1:2);
integer pheripherals;
system(5,74,start);
system(5,76,stop);
pheripherals:=(stop(1)-start(1))/2-1;
begin
integer array nametable(0:pheripherals);
integer array field iaf;
iaf := -2;
system(5,start(1),nametable.iaf);
if devno<=pheripherals then
sendrelease(nametable(devno));
end;
end;
z.iaf(1):=mkind;
z.iaf(2):=bufno;
z.iaf(3):=bufsize;
for i:=4 step 1 until 7 do
z.iaf(i):=name(i-2);
z.iaf(8):=devno;
monitor(16,z,1,shdescr);
if monitor(18,z,1,name)=1 then
begin
if newname then
begin
if name(1) extract 12 = 0 then
begin
if monitor(54,px,devno,shdescr)<>0 then
write(out,<:<10>error in call no.:>,<<dddd>,
counter-1,<:<10>***devname:>);
end;
newname:=false;
close(px,true);
end;
if name(1) extract 12 =-1 then
write(out,<:<10>error in call no.:>,<<dddd>,counter,<:<10>***operation rejected:>)
else
if name(1) extract 12<>0 then
write(out,<:<10>error in call no.:>,<<dddd>,counter,
case name(1) extract 12 of
(<:<10>***device trouble :>,
<:<10>***device reserved:>,
<:<10>***no resources:>));
end
else
begin
write(out,<:<10>error in call no.:>,<<dddd>,counter,
<:<10>***unintelligible:>);
close(px,true);
end;
end linkup;
newname:=false;
counter:=0;
bsmkind:=6;
bsbufs:=1;
bsbufsize:=768;
twmkind:=8;
twbufs:=1;
twbufsize:=128;
ptrmkind:=2 shift 12 +10;
ptrbufs:=1;
ptrbufsize:=128;
ptpmkind:=2 shift 12 +12;
ptpbufs:=1;
ptpbufsize:=172;
lptmkind:=14;
lptbufs:=1;
lptbufsize:=172;
cdrmkind:=10 shift 12+16;
cdrbufs:=1;
cdrbufsize:=256;
mtmkind:=18;
mtbufs:=1;
mtbufsize:=4*768+18;
fdmkind:=22;
fdbufs:=1;
fdbufsize:=342*3//2;
open(z,0,<:host:>,0);
getzone6(z,zdescr);
getshare6(z,shdescr,1);
algol copy.1;
end;
▶EOF◀