*  SYSTEM  DIAG  6/7/73   J.F. MCKONLY
* SYSTEM DIAG CONTAINS THE DIAGNOSTIC PROCEDURES WHICH
* ENABLE THE DIAGNOSTIC PROGRAMMER TO INVOKE MONITOR
*  FUNCTIONS WITHOUT HAND-CODING CALS AND PLISTS. THE SYSTEM
*  CONTAINS THE FOLLOWING PROCS WHICH CORRESPOND TO THE
*  CALS AND FPTS LISTED BELOW:
*
*
*  MON. PROC.          CAL          FPT
*  ----------          ---          ---
*
*  M:MAP              CAL1,6        02
*  M:SIO              CAL1,6        03
*  M:LOCK             CAL1,6        04
*  M:DOPEN            CAL1,6        05
*  M:DCLOSE           CAL1,6        07
*  M:BLIST            CAL1,6        09
*  M:DDCB             ------        --
*  M:DMOD#            CAL1,6        0A
*  M:DMODX            CAL1,6        0A                     26383-F00
*  M:DPART            CAL1,6        0A
*  M:DRET             CAL1,6        0A
*
         OPEN     ULOC,PLOC,USECT,PF,P,XCLIST,XSN,C,Q,I,;
                  R,N,S:S,Y,SER,NDS,INOA,ICF,;
                  ISN,INC,INSN,IDEV
         OPEN     AFM
NDS      EQU      'NO DCB SPECIFIED'
INOA     EQU      'INCORRECT NUMBER OF AFS'
ICF      EQU      'ILLEGAL COMMAND FIELD'
ISN      EQU      'INVALID SERIAL NUMBER'
INC      EQU      'INVALID NUMBER FOR COMMAND LIST'
INSN     EQU      'INVALID NUMBER OF SNS'
IDEV     EQU      'INVALID DEVICE TYPE'
AFM      EQU      'AF MIXTURE ILLEGAL'
S:S      FNAME
         PROC
         PEND     AF(AF(1)+2)
ULOC     SET      %
         CSECT    0
PLOC     SET      %
         ORG      ULOC
USECT    CNAME
         PROC
LF       SET      %
         ORG      AF(1)
         PEND
M:DOPEN  CNAME    6
         PROC
         LOCAL    PEND,CRUNCH,X
         LOCAL    MAXSN
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF~=2
 GEN,1,7,4,3,17   S:S(PF=1,(,4,NAME,,PLOC),(AFA,4,NAME,AF(2),AF(1)))
        GOTO,PF=1 PEND
         DO1      PF=0
ULOC     USECT    PLOC
XSN      SET      0
P        SET      S:KEYS(3,*0,*DEVICE,*STATUS,ABN,20,NOERR,CHAN,;
                  *22,SN,24,PATH)
P(2)     SET      P(2)|(TCOR(AF(P(3),2),S:C)**8)
         DO       P(6)<=NUM(AF)
MAXSN    SET      12
Q        SET      0
I        DO       NUM(AF(P(6)))-1
R        SET      NUM(S:UT(AF(P(6),I+1)))
Q(I)     SET      S:S(R>3,AF(P(6),I+1)**(8*(4-R))|'    ',;
                  AF(P(6),I+1))
         ERROR,3,TCOR(AF(P(6),I+1),S:C)=0  ISN
         FIN
         ERROR,3,((NUM(AF(P(6)))-1)>MAXSN)|;
                  ((NUM(AF(P(6)))-1)<1)  INSN
XSN      SET      NUM(Q)
         FIN
CRUNCH   SET      S:UFV(AF(1))
       ERROR,7,TCOR(CRUNCH,S:EXT,S:RAD,S:ADD)=0 NDS
         BOUND    4
LF(2)    GEN,1,7,7,17  AFA(1),5,0,AF(1)
         DATA,4   P(2)
         GEN,1,14,17   AFA(P(3),2),0,AF(P(3),2)
         GEN,1,14,17  AFA(P(4),2),0,AF(P(4),2)
         DO1      P(5)<=NUM(AF)
         GEN,1,14,17  AFA(P(5),2),0,AF(P(5),2)
         DO       P(6)<=NUM(AF)
         GEN,8,8,8,8  7,1,XSN,XSN
I        DO       XSN
         DATA,4   Q(I)
         FIN
         FIN
         DO1      PF=0
PLOC     USECT    ULOC
PEND     PEND
M:MAP    CNAME    6
         PROC
         LOCAL    PEND
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF~=2
 GEN,1,7,4,3,17   S:S(PF=1,(,4,NAME,,PLOC),(AFA,4,NAME,AF(2),AF(1)))
         GOTO,PF=1 PEND
         ERROR,3,NUM(AF)~=2  INOA
         DO1      PF=0
ULOC     USECT    PLOC
P        SET      S:KEYS(2,*0,*(PTV,VTP),*ADR)
         BOUND    4
LF(2)    GEN,1,7,7,17   AFA(P(4),2),2,0,AF(P(4),2)
         GEN,20,1,11    0,SCOR(PTV,AF(P(3),1)),0
         DO1      PF=0
PLOC     USECT    ULOC
PEND     PEND
M:DCLOSE CNAME    6
         PROC
         LOCAL    PEND,CRUNCH
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF~=2
 GEN,1,7,4,3,17   S:S(PF=1,(,4,NAME,,PLOC),(AFA,4,NAME,AF(2),AF(1)))
         GOTO,PF=1 PEND
         DO1      PF=0
ULOC     USECT    PLOC
P        SET      S:KEYS(3,20,PART,RETURN,SAME)
         DO1      NUM(AF)=1
P(2)     SET      1**9
CRUNCH   SET      S:UFV(AF(1))
       ERROR,7,TCOR(CRUNCH,S:EXT,S:RAD,S:ADD)=0 NDS
         BOUND    4
LF(2)    GEN,1,7,7,17 AFA(1),7,0,AF(1)
         DATA,4   P(2)
         DO1      PF=0
PLOC     USECT    ULOC
PEND     PEND
M:BLIST  CNAME    6
         PROC
         LOCAL    PEND,CRUNCH
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF~=2
 GEN,1,7,4,3,17   S:S(PF=1,(,4,NAME,,PLOC),(AFA,4,NAME,AF(2),AF(1)))
         GOTO,PF=1 PEND
         DO1      PF=0
ULOC     USECT    PLOC
C        SET      0
Y        SET      0
I        DO       NUM(AF)-1
R        SET      SCOR(AF(I+1,1),ADR,PRI,TIMEOUT,SIO,TIO,TDV,HIO)
         DO       R>0
         DO       R>4
C        SET      1
         ELSE
Y        SET      1
         FIN
         FIN
         FIN
         ERROR,7,(C=1)&(Y=1)=1  AFM
         DO       Y=1
P        SET      S:KEYS(3,*0,*ADR,PRI,TIMEOUT,20,SIO)
         ELSE
Q        SET      S:KEYS(1,22,TIO,TDV,HIO)
         FIN
         DO       C=1
         ERROR,7,(((Q(2)&X'200')~=0)+((Q(2)&X'100')~=0)+;
                  ((Q(2)&X'80')~=0))>1  AFM
         FIN
CRUNCH   SET      S:UFV(AF(1))
       ERROR,7,TCOR(CRUNCH,S:EXT,S:RAD,S:ADD)=0 NDS
         ERROR,3,NUM(AF)<2 INOA
         BOUND    4
LF(2)    GEN,1,7,7,17 AFA(1),9,0,AF(1)
         DO       Y=1
         DATA,4   P(2)
         GEN,1,14,17  AFA(P(3),2),0,AF(P(3),2)
         DO       P(4)<=NUM(AF)
         GEN,1,14,17  AFA(P(4),2),0,AF(P(4),2)
   ERROR,7,AF(P(4),2)<X'F0'|AF(P(4),2)>X'FF' ;
        'PRI VALUE OUT OF RANGE'
         FIN
         DO1      P(5)<=NUM(AF)
         GEN,1,14,17  AFA(P(5),2),0,AF(P(5),2)
         ELSE
Q(2)     SET      Q(2)|(1**10)
         DATA,4   Q(2)
         FIN
         DO1      PF=0
PLOC     USECT    ULOC
PEND     PEND
M:SIO    CNAME    6
         PROC
         LOCAL    PEND,CRUNCH
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF~=2
 GEN,1,7,4,3,17   S:S(PF=1,(,4,NAME,,PLOC),(AFA,4,NAME,AF(2),AF(1)))
         GOTO,PF=1 PEND
         DO1      PF=0
ULOC     USECT    PLOC
CRUNCH   SET      S:UFV(AF(1))
       ERROR,7,TCOR(CRUNCH,S:EXT,S:RAD,S:ADD)=0 NDS
         ERROR,3,NUM(AF)~=1 INOA
         BOUND    4
LF(2)    GEN,1,7,7,17 AFA(1),3,0,AF(1)
         DO1      PF=0
PLOC     USECT    ULOC
PEND     PEND
M:LOCK   CNAME    6
         PROC
         LOCAL    PEND
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF~=2
 GEN,1,7,4,3,17   S:S(PF=1,(,4,NAME,,PLOC),(AFA,4,NAME,AF(2),AF(1)))
         GOTO,PF=1 PEND
         ERROR,3,NUM(AF)~=1 INOA
         DO1      PF=0
ULOC     USECT    PLOC
P        SET      S:KEYS(2,*0,*(YES,NO))
         BOUND    4
LF(2)    GEN,8,24 4,0
         GEN,20,1,11 0,SCOR(YES,AF(P(3),1)),0
         DO1      PF=0
PLOC     USECT    ULOC
PEND     PEND
M:DDCB   CNAME
         PROC
         LOCAL    FINI,MAXCLIST,MAXSN,ZDEV,SER,COML,VLP
         ERROR,3,NUM(AF)<2  INOA
         ERROR,3,NUM(LF)<1  'DCB NAME MISSING'
         ERROR,3,NUM(CF)>1  ICF
         DO       TCOR(LF,S:FR)
LF       SET      %
         ELSE
ULOC     USECT    LF
         FIN
P        SET      S:KEYS(2,*0,*DEVICE,*CLIST,ABN,SN)
MAXCLIST SET      66
MAXSN    SET      12
XCLIST   SET      AF(P(4),2)
         ERROR,3,XCLIST<2|XCLIST>MAXCLIST   INC
XCLIST   SET      S:S(XCLIST>MAXCLIST,S:S(XCLIST<2,XCLIST,2),MAXCLIST)
         DO       NUM(AF)>=P(6)
Y        SET      TCOR(AF(P(6),2),S:INT,S:C)
         ERROR,3,Y=0  ISN
XSN      SET      1
         GOTO,Y=0 FINI
C        SET      0
         DO       Y=1
XSN      SET      AF(P(6),2)
         ERROR,3,(XSN>MAXSN)|(XSN<1)  INSN
XSN      SET      S:S(XSN>MAXSN,S:S(XSN<1,XSN,1),MAXSN)
         ELSE
Q        SET      0
         ERROR,3,(NUM(AF(P(6)))-1)>MAXSN  INSN
I        DO       NUM(AF(P(6)))-1
R        SET      NUM(S:UT(AF(P(6),I+1)))
Q(I)     SET      S:S(R>3,AF(P(6),I+1)**(8*(4-R))|'    ',;
                  AF(P(6),I+1))
         ERROR,3,TCOR(AF(P(6),I+1),S:C)=0  ISN
         FIN
XSN      SET      NUM(Q)
C        SET      1
         FIN
FINI     FIN
         BOUND    4
         DO       NUM(AF)>=P(6)
         GEN,8,8,8,8 XSN+1+XCLIST+1+22,X'10',X'80',3
         ELSE
         GEN,8,8,8,8 XCLIST+1+22,X'10',X'80',3
         FIN
ZDEV     SET      TCOR(AF(P(3),2),S:INT,S:C)
         ERROR,3,ZDEV=0 IDEV
         DO       ZDEV=1
         GEN,16,1,15  0,1,AF(P(3),2)
         ELSE
         GEN,16,16    1,AF(P(3),2)
         FIN
         DATA,4   0
         GEN,16,16 0,AF(P(5),2)
         GEN,16,16  0,AF(P(5),2)
         GEN,4,28 2,0
         GEN,15,17  0,VLP
         DATA,4   0,0,0
         DATA,4   0,0
         GEN,15,17 0,AF(P(3),2)
         DATA,4   0,0,0,0,0,0,0,0
         GEN,15,17  0,COML
VLP      EQU      %
         DO       NUM(AF)>=P(6)
         GEN,8,8,8,8 7,0,XSN*C,XSN
SER      EQU      %
I        DO       XSN*C
         DATA,4   Q(I)
         ELSE
         RES,4    XSN
         FIN
         FIN
         GEN,8,8,8,8 X'12',1,0,XCLIST
         BOUND    8
COML     EQU      %
         DO       XCLIST
         DATA,4   0
         FIN
         DO1      CS(%)~=CS(ULOC)
         USECT    ULOC
         PEND
M:DMOD#  CNAME    10,2
M:DPART  CNAME    10,0
M:DRET   CNAME    10,1
M:DMODX  CNAME    10,2,1            USE DCTX TO GET INFO   26383-F00
         PROC
PF       SET      SCOR(CF(2),E,L)
LF(1)    SET      %
         SPACE    2
********
  ERROR,3,(PF=0|PF=2)&(NUM(AF)~=1)|(PF=0|PF=2);
         &(NAME(2)=0|NAME(2)=1);
         &(NUM(AF(1))~=2)  INOA
  ERROR,3,(PF=0|PF=2)&(NAME(2)=0|NAME(2)=1);
         &(SCOR(AF(1,1),DEV,CONT)=0)  'UNRECOGNIZED KEY'
********
         SPACE    2
         DO       PF=0|PF=1
  GEN,1,7,4,3,17  S:S(PF=1,(0,4,6,0,PLOC),;
                  (AFA,4,6,AF(2),AF(1)))
         FIN
         DO1      PF=0
ULOC     USECT    PLOC
         DO       PF=0|PF=2
LF(2)  GEN,1,7,24,2,1,1,28 S:S(NAME(2)=2,;                 26383-F00
                  (AFA(1,2),NAME(1),AF(1,2),;              26383-F00
                  NAME(2),SCOR(AF(1,1),CONT),0,0),;        26383-F00
                  (AFA,NAME(1),AF(1),NAME(2),0,NAME(3),0)) 26383-F00
         FIN
         DO1      PF=0
PLOC     USECT    ULOC
         PEND
         CLOSE    ULOC,PLOC,USECT,PF,P,XCLIST,XSN,C,Q,I,;
                  R,N,S:S,Y,SER,NDS,INOA,ICF,;
                  ISN,INC,INSN,IDEV
         CLOSE    AFM
         END

