%externalintegerfn x29call


!
      %recordformat %c
TMODEF(%halfinteger FLAGS1, FLAGS2,
{.04}  %byteinteger PROMPTCHAR, ENDCHAR,
{.06}  %bytearray BREAKBIT1(0:3) {%or %halfintegerarray BREAKBIT2(0:1))} ,
{.0A}  %byteinteger PADS, RPTBUF, LINELIMIT, PAGELENG,
{.0E}  %byteintegerARRAY TABVEC(0:7),
{.16}  %byteinteger CR, ESC, DEL, CAN,
{.1A}  %byteinteger FLAGS, INTERNAL STATE, LEADIN1, LEADIN2, XLO, XHI)
{.20}

!>
!<NNF
      %recordformat %c
NNF(%string(6)NAME, %byteinteger KB, TAG, MARKER, %halfinteger INDNO)
!>
!<DIROWNF
!
! Format describing Directors 'own' variables
%constinteger TOPCONENT = 95
      %recordformat %c
CTF(%string(30)FULL, %byteinteger FSYS, NODISCO, INDEX)
!
      %recordformat %c
DIROWNF(%byteintegerarray CPOINT(0:255),
      %record(CTF)%array CONLIST(0 : TOPCONENT),
      %string(63)SEMAHOLDER)
!>
!<PARMF
!
! The standard format for system messages
      %recordformat %c
PARMF(%integer DEST, SRCE,
      (%integer P1, P2, P3, P4, P5, P6 %or %string(23)S))
!>
!<PDF
      %recordformat %c
PDF  (%string(6)NAME, %byteinteger PERM, LINK)
!
%constinteger PDSIZE = 9
!
%ownrecord(PDF)%arrayformat PDSF(1:512)
!>
!<SDF
!     %recordformat SDF(13-bit LINK, 19-bit DA)
%ownintegerarrayformat SDSF(1:8191)
!>
!<UINFF
      %recordformat %c
UINFF (%string(6)USER, %string(31)JOBDOCFILE,
{.28}  %integer MARK, FSYS,
{.30}  PROCNO, ISUFF, REASON, BATCHID, 
{.40}  SESSICLIM, SCIDENSAD, SCIDENS, STARTCNSL,
{.50}  AIOSTAT, SCT DATE, SYNC1 DEST, SYNC2 DEST, 
{.60}  ASYNC DEST, AACCT REC, AIC REVS,
{.6C}  %string(15)JOBNAME,
{.7C}  %string(31)BASEFILE,
{.9C}  %integer PREVIC,
{.A0}  ITADDR0, ITADDR1, ITADDR2, ITADDR3,
{.B0}  ITADDR4, STREAM ID, DIDENT, SCARCITY, 
{.C0}  PREEMPTAT, %string(11)SPOOLRFILE,
{.D0}  %integer FUNDS, SESSLEN, PRIORITY, DECKS,
{.E0}  DRIVES, PART CLOSE,
{.E8}  %record(TMODEF)TMODES,
{108}  %integer PSLOT,
{10C}  %string(63)ITADDR,
{14C}  %integerarray FCLOSING(0:3), %integer CLO FES,
{160}  %integer OUTPUT LIMIT, DAPSECS, %longinteger DAPINSTRS,
{170}  %integer OUT, %string(15)OUTNAME,
{184}  %integer HISEG,
{188}  %string(31)FORK,
{1A8}  %integer INSTREAM, OUTSTREAM,
{1B0}  %integer DIRVSN, DAP NO, SCT BLOCK AD,
       %integer PROTOCOL,
      %integer UEND)
%constrecord(uinff)%name uinf=9<<18


 %result=uinf_protocol
%end


%systemintegermapspec comreg(%integer i)
%externalintegerfnspec dmode(%integer set,adr,cmd)
%systemroutinespec console(%integer ep,%integername i,j)

%externalroutine xmode(%string(255) prm)
 %byteintegerarrayname resp
 %byteintegerarray parm(0:31)
 %string(31)%name sparm
 %integer i,j,l,err,line width,ip,retcode,pv
 %integerarray pval(1:18)
 %byteintegerarray area(0:127)

 %integerfn ival
   %integer s

   s=0
   %while ip<=parm(0) %and '0'<=parm(ip)<='9' %cycle
      s=s*10+parm(ip)-'0'
      ip=ip+1
   %repeat
   %result=s
 %end

 
 %routine getvalue(%integername iv)

   %if parm(ip)#'=' %start
      printstring("Expected = not found in ".sparm);newline
      retcode=1
      %return
   %finish
   ip=ip+1    {skip =}
   iv = ival
   %if ip<=parm(0) %start
      print string("Invalid character (".tostring(parm(ip)).") in integer");newline
      retcode=2
   %finish
 %end


 {set initial values}
 line width=80
 retcode=0
 pval(i)=-1 %for i=1,1,18
 {check for x29 connection}
 %if x29call=0 %start
      printstring("Not supported for NSI connections");newline
      retcode=1
      comreg(24)=retcode
      %return
 %finish
 {scan all parms}
 i=1;l=length(prm)
 %cycle
   {skip leading blanks and commas}
   %while i<=l %and (substring(prm,i,i)=" " %or substring(prm,i,i)=",") %cycle
      i=i+1
   %repeat
   %exit %if i>l  {exit parms all processed}
   j=1
   {isolate parameter}
   %while i<=l %and ','#charno(prm,i) %and charno(prm,i)#' ' %cycle
      %if j<=31 %start
         err=charno(prm,i)
         %if 'a'<=err<='z' %then err=err-'a'+'A'
         parm(j)=err
         j=j+1
      %finish
      i=i+1
   %repeat
   parm(0)=j-1
   sparm==string(addr(parm(0)))
   {check off parameter values}
   %if sparm="MSG" %or sparm="MESSAGE" %start
      pval(4)=0
      pval(10)=linewidth
      pval(15)=1
      %continue
   %finish
   %if sparm="NATIVE" %start
      pval(4)=1
      pval(10)=0
      pval(15)=0
      %continue
   %finish
   %if sparm="TRANS" %or sparm="TRANSPARENT" %start
      pval(4)=0
      pval(10)=0
      pval(15)=1
      %continue
   %finish
   ip=1
   %if parm(1)='W' %start
      ip=2
      getvalue(line width)
      %continue
   %finish
   %if parm(1)='P' %start
      ip=2
      j=ival
      getvalue(pv)
      %if j<1 %or j>18 %start
         printstring("X3 parameter number must be between 1 and 18 (".sparm.")")
         newline
         retcode=1
      %finishelse pval(j)=pv
      %continue
   %finish
   printstring("Parameter (".sparm.") not recognised"); newline
   retcode=1
 %repeat

 j=3
 area(1)=255
 area(2)=2;  {set parms}
 %for i=1,1,18 %cycle
   %if pval(i)#-1 %start
      area(j)=i;area(j+1)=pval(i)&x'ff'
{*}{write(area(j),4);write(area(j+1),4);newline}
      j=j+2
   %finish
 %repeat
 area(0)=j-1
 %if j=3 %start
      printstring("No parameters changed");newline
 %finishelsestart
   %if retcode=0 %start
      %if pval(4)#-1 %start
         %if pval(4)#0 %then i=2 %else i=1 {2 => binary i.e. native}
         console(18,i,j)
      %finish
      L=3
      %while l<j %cycle
         ip=j-l
         %if ip>28 %then ip=28
         area(l-3)=ip+2
         area(l-2)=255
         area(l-1)=2 {set}
         i=dmode(3,addr(area(l-3)),0)
         %if i#0 %start
            printstring("Failed to change parameters flag=");
            write(i,1);newline
            retcode=i
            %exit
         %finish
{#}      resp==array(addr(area(l)),area)
         l=l+ip
         i=1
         %while i<ip %cycle
            %if resp(i)&x'80' # 0 %start
               printstring("Setting of parameter number ")
               write(resp(i)&x'7f',1)
               printstring(" rejected"); newline
            %finish
            i=i+2
         %repeat
      %repeat
   %finish
 %finish
 comreg(24)=retcode
%end



%externalstring(255)%fn x3parms
 %string(255) ans
 %byteintegerarray area(0:31)
 %string(255)pr
 %integer i,p,j,np
 %byteintegerarrayname resp

 %string(3)%fn tos(%integer n)
   %integer i
   %string(3) s
   s=""
   %if n>=100 %start
      s = tostring('0'+n//100)
      n=n-100*(n//100)
   %finish
   %if n>=10 %start
      s = s.tostring('0'+n//10)
      n=n-10*(n//10)
   %finish
   %result=s.tostring(n+'0')
 %end


 %if x29call=0 %then %result=""
 ans=""
 p=1
 %while p<=18 %cycle
   np=19-p
   %if np>14 %then np=14
   area(0)=2*(np+1)
   area(1)=255
   area(2)=0  {read}
   %for j=1,1,np %cycle
      area(2*j+1)=p
      area(2*j+2)=0
      p=p+1
   %repeat
   i=dmode(3,addr(area(0)),0)
   %if i#0 %start
      %result=""
   %finish
{#}resp==array(addr(area(3)),area)
   %for j=1,1,np %cycle
      %if resp(2*j-2)&x'80'=0 %start
         pr="P".tos(resp(2*j-2))."=".tos(resp(2*j-1)).","
         %if length(pr)+length(ans)<=255 %then ans=ans.pr
      %finish
   %repeat
 %repeat
 %if ans#"" %then ans=substring(ans,1,length(ans)-1)
 %result=ans
%end
%externalroutine testx3(%string(255)t)
printstring(x3parms);newline
%end
%endoffile