⟦f7cea238d⟧

TextFile

;ali time 4 0 
;copyright Anders Lindgård, march 1979;
mode list.yes
lookup netalglist
if ok.yes
mode 15.yes
lookup stdvar
if ok.no
i tstdvar
clear netinit
beskyt std1.netinit.1
netinit=stdvar list.yes key.2
1980-05-08
begin
integer opsense,opstart=8192,optransfer=16394,opstop=24576,opautoload=32768,
        oplock=40960,opunlock=49152,
        opinput=12288,opoutput=20480;
integer netiosw,netprogsw;
boolean neterror=true;
end;
beskyt std.opsense std.opstart std.opstop std.opautoload,
       std.optransfer,
       al3.oplock al3.opunlock,
       std.opinput std.opoutput,
       std.neterror,
       std.netiosw std.netprogsw

clear checkandres
beskyt std.checkandres.4
checkandres=hcalg
external
integer procedure checkandres(name);
string name;
begin
integer res,pda;
array n,nr(1:2);
cleararray(n);
movestring(n,1,name);
res:=reserveproc(n,0);
if res<>0 and neterror then
begin
  write(out,nl,1,star,2,string inc(n));
  pda:=description(n);
  if pda>0 and res=1 then
  begin
    nameload(procidbit(wordload(pda+12))+2,nr);
    write(out,sp,4,<: reserved by :>,string inc(nr));
  end else
  write(out,case res of (<::>,<: not user :>,<: does not exist :>));
end res<>0;
checkandres:=res;
end check and res;
end;

clear netoperat
beskyt std.netoperat.4
netoperat=hcalg
external
integer procedure netoperat(name,op,block);
value op,block; integer op,block;
string name;
if op=0 or op=8192 or op=16394 or op=24576 or op=32768
  or op=40960 or op=49152 then
begin
array n(1:3);
integer array M(1:8);
integer res;
cleararray(n);
movestring(n,1,name);
res:=checkandres(string inc(n));
if res>0 then res:=res+8;
if res=0 then
begin
  M(1):=op; M(2):=block;
  res:=waitanswer(sendmessage(n,M),M);
  netiosw:=M(1);
  netprogsw:=M(3);
  if res<>1 and neterror then write(out,nl,1,star,2,
     <:netoperat :>,string inc(n),
     <: result :>,res,<: wait answer:>) else
  if M(1)<>0 then
  begin
   if neterror then write(out,nl,1,star,2,
      <:netoperat :>,string inc(n),<: status error:>);
   if neterror then writebinary(out,M(1));
  end;
end res ok;
netoperat:=res;
end netoperat else
begin
  netoperat:=0;
  if neterror then write(out,nl,1,star,2,
     <:netoperat :>,name,<: operation error:>,op);
end;
end;

clear netabsio
beskyt std.netabsio.4
netabsio=hcalg
external
integer procedure netabsio(name,op,data,first);
value op,first; integer op,first;
string name;
integer array data;
if op=12288 or op=20480 then
begin
integer res;
integer array M,A(1:8);
array n(1:3);
cleararray(n);
movestring(n,1,name);
res:=checkandres(string inc(n));
if res>0 then res:=res+8
else
begin
  M(1):=op;
  M(2):=firstaddr(data);
  M(3):=M(2)+510;
  M(4):=first;
  for res:=waitanswer(sendmessage(n,M),A) while res=1 and
 A(1)=0 and A(2)=0 do;
  netiosw:=A(1);
  netprogsw:=A(3);
  if res<>1 and neterror then write(out,nl,1,star,2,
    <:netabsio :>,string inc(n),<: result :>,res,<: wait answer:>) else
  if A(1)<>0 then 
  begin
   if neterror then write(out,nl,1,star,2,
      <:netabsio :>,string inc(n),<: status error:>);
   if neterror then writebinary(out,A(1));
  end;
end res ok;
netabsio:=res;
end netabsio else
begin
  netabsio:=0;
  if neterror then write(out,nl,1,star,2,
     <:netabsio :>,name,<: operation error:>);
end;
end

clear netprogload
beskyt std.netprogload.5
netprogload=hcalg
external
integer procedure netprogload(name,bs);
string name,bs;
begin
array n,b(1:3);
integer array M,A(1:8),t(1:10);
integer res,segm,lastsegm;
zone z(128,1,stderror);
integer array field ia;
cleararray(n);
movestring(n,1,name);
res:=checkandres(string inc(n));
if res>0 then res:=res+8
else
begin
  M(1):=opautoload;
  res:=waitanswer(sendmessage(n,M),M);
  netiosw:=M(1);
  netprogsw:=M(3);
  if res<>1 and neterror then write(out,nl,1,star,2,
     <:netprogload :>,string inc(n),
     <: result :>,res,<: wait answer autoload:>) else
  if M(1)<>0 then
  begin
   if neterror then write(out,nl,1,star,2,
      <:netprogload :>,string inc(n),<: status autoload:>);
   if neterror then writebinary(out,M(1));
  end else
  begin
  cleararray(b);
  movestring(b,1,bs);
  res:=lookuptail(b,t);
  if res<>0 then
  begin
    res:=res+16;
    if neterror then write(out,nl,1,star,2,
       <:netprogload :>,string inc(b),<: lookup result :>,res-16);
  end else
  if t(1)<2 or t(10)<512 then
  begin
    res:=17;
    if neterror then write(out,nl,1,star,2,
       <:netprogload :>,string inc(b),<: area size :>,
       t(1),<: load size:>,t(10)-512);
  end else
  begin
    open(z,4,string inc(b),0);
    setposition(z,0,1);
    lastsegm:=(t(10)-1)//512;
    for segm:=1 step 1 until lastsegm do
    begin
     inrec(z,128);
     res:=netabsio(string inc(n),opoutput,z.ia,(segm-1)*768);
   end for segm;
  end check tail;
  end res bs ok;
end res ok;
netprogload:=res;
end netprogram load ;
end;
mode list.no 15.no
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦f7cea238d⟧ TextFile

Derivation

TextFile
