const  string  (13) vsn="14 MAY 84   1"
record  format  parmf(integer  dest, srce, p1, p2, p3, p4, p5, p6)
external  routine  spec  dout(record  (parmf) name  p)
system  string  fn  spec  htos(integer  i, pl)
system  routine  spec  disconnect(string  (31) file, integer  name  flag)
external  routine  spec  destroy(string  (255) s)
external  integer  fn  spec  exist(string  (255) s)
external  string  fn  spec  uinfs(integer  i)
external  integer  fn  spec  bin(string  (255) s)
external  string  fn  spec  derrs(integer  n)

external  routine  spec  dpon(record  (parmf) name  p)

external  integer  fn  spec  dprg(string  (6) user, string  (15) file, integer  fsys,
    string  (6) label, integer  site)
external  integer  fn  spec  dunprg(string  (6) user, string  (15) file, integer  fsys,
    string  (6) label, integer  site)

routine  uderrs(integer  n)
   printstring("FLAG =")
   printstring(derrs(n))
   newline
end ; ! UDERRS

external  routine  prg(string  (255) s)
string  (63) file, label, ssite, user
integer  site, j
   unless  s->file.(",").label.(",").ssite then  ->bp
   user=uinfs(1)
   disconnect(file, j)
   if  file->user.(".").file start ; finish 
   unless  length(label)=6=length(user) then  ->bp
   site=bin(ssite)
   unless  site=-1 or  (site>=0 and  site&X'3F'=0) then  ->bp
   j=dprg(user, file, -1, label, site)
   uderrs(j)
   return 
bp:
   printstring("PARAM ??  FORM IS:
PRG(FILE,LABEL,SITE)
")
end ; ! PRG
external  routine  unprg(string  (255) s)
string  (63) file, label, ssite, user
integer  site, j
   unless  s->file.(",").label.(",").ssite then  ->bp
   user=uinfs(1)
   unless  file->user.(".").file start ; finish 
   unless  length(label)=6 then  ->bp
   site=bin(ssite)
   unless  site=-1 or  (site>=0 and  site&X'3F'=0) then  ->bp
   j=dunprg(user, file, -1, label, site)
   uderrs(j)
   return 
bp:
   printstring("PARAM ??  FORM IS:
PRG(FILE,LABEL,SITE)
")
end ; ! UNPRG
external  routine  prgdir(string  (255) s)
string  (63) file, label, ssite, user
integer  site, j, vsn
   unless  s->file.(",").label.(",").ssite then  ->bp
   unless  length(file)=3 and  file->("00").file then  ->bp
   unless  "0"<=file<="9" then  ->bp
   unless  length(label)=6 then  ->bp
   unless  length(ssite)=1 then  ->bp
   vsn=bin(ssite)
   unless  0<=vsn<=3 then  ->bp
   j=dprg("ERCC10", "DIR".file."T", -1, label, X'200'+X'40'*vsn)
   uderrs(j)
   return 
bp:
   printstring("PARAM ??  FORM IS:
PRGDIR(00N,LABEL,VSN)
")
end ; ! PRGDIR
routine  toints(string  (6) user, integer  name  l1, l2)
integer  i1, i2, ai1, ai2, au, j
   i1=0; i2=0
   ai1=addr(i1); ai2=addr(i2); au=addr(user)
   cycle  j=0, 1, 3
      byteinteger(ai1+j)=byteinteger(au+j+1)
   repeat 
   cycle  j=0, 1, 1
      byteinteger(ai2+j)=byteinteger(au+j+5)
   repeat 
   l1=i1; l2=i2
end ; ! TOINTS
external  routine  plod(string  (255) s)
string  (31) disc1, disc2, site1, site2, epages, ems
record  (parmf) p
integer  i1, i2, np, j
   unless  s->disc1.(",").site1.(",").disc2.(",").site2.(",").epages and  c 
      length(disc1)=6=length(disc2) start 
      printstring("EXAMPLE:  PLOD(EMAS00,X200,EMAS00,X240,64)
")
      return 
   finish 
   i1=bin(site1)
   i2=bin(site2)
   np=bin(epages)
   ems="SITE1"
   unless  0<=i1<=X'FFFF' then  ->bp
   ems="SITE2"
   unless  0<=i2<=X'FFFF' then  ->bp
   ems="EPAGES"
   unless  0<=np<=X'400' then  ->bp
   p=0
   p_dest=X'00240000'; ! BULK MOVE
   p_p1=X'02020000'!np
   to ints(disc1, p_p2, p_p3)
   p_p3=p_p3!i1
   to ints(disc2, p_p4, p_p5)
   p_p5=p_p5!i2
   p_p6=M'KPRG'
   dout(p)
   uderrs(p_p1)
   return 
bp:
   printstring(ems)
   printstring(" PARAM IN ERROR")
   newline
end ; ! PLOD
end  of  file