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