DataMuseum.dk

top - metrics - download

    Length: 7680 (0x1e00)
    Types: TextFile
    Names: »tnetprogram«

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦fd91a6c89⟧ »tm68net« 
            └─⟦this⟧ 

TextFile

;ali time 4 0
message tnetprogram
mode list.yes 15.yes
clear netauto

netauto=set 46
permanent netauto.17
netauto=algol
begin
array name(1:3);
cleararray(name);
if readsfp(<:micro:>,name) then
  write(out,netoperat(string inc(name),opautoload,0)) else
  write(out,star,3,<:name missing:>);
end
clear netlock

netlock=set 46
permanent netlock.17
netlock=algol
begin
array name(1:3);
cleararray(name);
if readsfp(<:micro:>,name) then
  write(out,netoperat(string inc(name),oplock,0)) else
  write(out,star,3,<:name missing:>);
end





clear netunlock
netunlock=set 46
permanent netunlock.17
netunlock=algol
begin
array name(1:3);
cleararray(name);
if readsfp(<:micro:>,name) then
  write(out,netoperat(string inc(name),opunlock,0)) else
  write(out,star,3,<:name missing:>);
end





clear netstart
netstart=set 46
permanent netstart.17
netstart=algol
begin
array name(1:3);
cleararray(name);
if readsfp(<:micro:>,name) then
  write(out,netoperat(string inc(name),opstart,0)) else
  write(out,star,3,<:name missing:>);
end





clear netstop
netstop=set 50
permanent netstop.17
netstop=algol
begin
array name(1:3);
cleararray(name);
if readsfp(<:micro:>,name) then
  write(out,netoperat(string inc(name),opstop,0)) else
  write(out,star,3,<:name missing:>);
end





clear netloadp
netloadp=set 60
permanent netloadp.17
netloadp=algol
begin
array name,bs,start(1:3);
cleararray(name);
cleararray(bs);
if readsfp(<:program:>,bs) and readsfp(<:micro:>,name) then
begin
  write(out,netprogload(string inc(name),string inc(bs)));
  if readsfpnext(fpnr,start) and start(1)=real <:start:> then
  write(out,netoperat(string inc(name),opstart,0));
end else
  write(out,star,3,<:micro or program missing:>);
end





clear netdump

clear netdump

clear netdump
netdump=set 56
permanent netdump.17
netdump=algol
begin
integer first,last,segm;
array name,bs(1:3);
zone z(128,1,stderror);
integer array field ia;
ia:=0;
if -,readifp(<:first:>,first) then first:=0;
if -,readifp(<:last:>,last) then last:=16384;
segm:=(last-first+1+1)//768+(if (last-first+1) mod 768<>0 then 1 else 0);
cleararray(name);
cleararray(bs);
if readlsfp(bs) and readsfp(<:micro:>,name) then
begin
  open(z,4,string inc(bs),0);
  for segm:=segm step -1 until 1 do
  begin
     outrec(z,128);
     netabsio(string inc(name),opinput,z.ia,first);
     first:=first+768;
  end;
  close(z,true);
end else
  write(out,star,3,<:micro or left side missing:>);
end





clear netloadmain
netloadmain=set 52
permanent netloadmain.17
netloadmain=algol
begin
integer block,first,last;
integer array field ia;
array name,bs(1:3);
cleararray(name);
cleararray(bs);
if readsfp(<:program:>,bs) then
begin
  close(in,true);
  open(in,4,string inc(bs),0);
  inrec(in,128);
  ia:=0;
  block:=in(1);
  first:=in.ia(3);
  last:=in.ia(4);
  for block:=block step -1 until 1 do
  begin
    inrec(in,128);
    netabsio(<:micnetmain:>,opoutput,in.ia,first);
    first:=first+768;
  end;
  close(in,true);
  netoperat(<:micnetmain:>,opautoload,0);
  netoperat(<:micnetmain:>,opstart,0);
end else
  write(out,star,3,<:program missing:>);
end





netlistdev=set 20
permanent netlistdev.17
netlistdev=algol
begin
integer pda,kind,dev,fdev,ldev,res;
boolean first;
array name,resname(1:3);
first:=true;
fdev:=wordload(74);
ldev:=wordload(76)-2;
for dev:=fdev step 2 until ldev do
begin
  pda:=wordload(dev);
  kind:=wordload(pda);
  if kind>=106 and kind<=116 then
  begin
   cleararray(name);
   nameload(pda+2,name);
  res:=wordload(pda+12);
  if res<>0 then nameload(procidbit(res)+2,resname);
  if first then
   begin
     first:=false;
     write(out,nl,4,<:device:>,sp,1,<:kind:>,sp,2,<:name:>);
   end;
   write(out,nl,1,<<ddd>,(dev-fdev)//2,sp,4,kind,sp,3,string inc(name));
   if res<>0 then write(out,sp,4,string inc(resname));
  end;
end;
if first then write(out,nl,2,<:network not included:>) else
              write(out,nl,3);
end





netres=set 25
permanent netres.17
netres=algol
begin
integer address,last,pda,pdares,kind,res;
array name,nameres(1:2);
address:=wordload(74);
last:=wordload(76)-2;
for address:=address step 2 until last do
begin
  pda:=wordload(address);
  kind:=wordload(pda);
  if kind>=106 and kind<=116 and kind<>112 then
  begin
    res:=reserveproc(pda,0);
    redefarray(name,pda+2,4);
    pdares:=procidbit(wordload(pda+12));
    if pdares>0 then redefarray(nameres,pdares+2,4);
    if res<>0 then
    begin
      write(out,nl,1,star,3,string inc(name));
      if pdares<=0 then write(out,<: reservation impossible :>,res)
          else
          write(out,<: reserved by :>,string inc(nameres));
    end;
  end;
end;
end





netrel=set 15
permanent netrel.17
netrel=algol
begin
integer address,last,pda,kind;
address:=wordload(74);
last:=wordload(76)-2;
for address:=address step 2 until last do
begin
  pda:=wordload(address);
  kind:=wordload(pda);
  if kind>=106 and kind<=116 then releaseproc(pda);
end;
end





netdevice=set 35
permanent netdevice.17
netdevice=algol
1979-03-19
begin
boolean endcond;
integer c,char,res,i,dev,recsize,devno;
integer array tail(1:10);
array name,bs(1:3);
integer field devf,recf;
array field nf;
zone z(128,1,stderror);

comment data are normally found in <:netdevdata:>;

packtext(bs,<:netdevinit:>);
recsize:=2+8;
nf:=2;
devf:=2; recf:=4;
if lookuptail(bs,tail)>0 then
begin
  cleararray(tail); tail(1):=10;
  res:=createentry(bs,tail);
  if res>0 then alarm(nl,1,star,3,
    <:netdevice :>,string inc(bs),<: create entry :>,res);
  res:=permentry(bs,1);
  if res>0 then write(out,nl,1,star,2,<:netdevice :>,
    string inc(bs),<: perm entry :>,res);
end;
open(z,4,string inc(bs),0);
endcond:=false;
dev:=0;
outrec6(z,4);
for dev:=dev+1 while -,endcond do
begin
  read(in,devno);
  cleararray(name);
  readstring(in,name,1);
  outrec6(z,recsize);
  z.devf:=devno;
  for i:=1,2 do z.nf(i):=name(i);
  repeatchar(in);
  for c:=readchar(in,char) while char<>25 and c>=7 do;
  repeatchar(in);
  endcond:=char=25 or char=101;
end;
setposition(z,0,0);
swoprec6(z,4);
z.devf:=dev-1;
z.recf:=recsize;
close(z,true);
end;






netname=set 35
permanent netname.17
netname=algol
1979-03-19
begin
integer res,i,dev,recsize,devno;
integer array tail(1:10);
array name,bs(1:3);
integer field devf,recf;
array field nf;
zone z(128,1,stderror);

packtext(bs,<:netdevinit:>);
recsize:=2+8;
nf:=2;
devf:=2; recf:=4;
res:=lookuptail(bs,tail);
if res<>0 then
begin
  if res>0 then alarm(nl,1,star,3,
    <:netname :>,string inc(bs),<: lookup entry :>,res);
  if tail(1)<1 then alarm(out,nl,1,star,3,<:netname :>,
    string inc(bs),<: size of entry :>,tail(1));
end;
open(z,4,string inc(bs),0);
dev:=0;
inrec6(z,4);
dev:=z.devf;
recsize:=z.recf;
cleararray(name);
for dev:=dev step -1 until 1 do
begin
  inrec6(z,recsize);
  devno:=z.devf;
  for i:=1,2 do name(i):=z.nf(i);
  res:=createper(name,devno);
  if res>0 then write(out,nl,1,star,2,
    <:netname :>,devno,sp,2,string inc(name),sp,2,<:create per:>);
end;
close(z,true);
end;
▶EOF◀