**********************************************************************
*
*
*                                   R E A L - T I M E    P R O C S
*
*
**********************************************************************
*
*                                   C A L 1              P R O C S
*
**********************************************************************
*
         DISP     X'D00'            5/30/75
         OPEN     USET,ULOC,PLOC,P,X,Y,Z,UK,INOA,MRK,%FIN,S:S,CODE;
                 ,CODES,CNFL,EL,CAL1,FPT0
UK       EQU      'UNRECOGNIZED KEY'
INOA     EQU      'IMPROPER # OF AFS'
MRK      EQU      'MISSING REQUIRED KEYWORD '
CNFL     EQU      'CONFLICTING PARAMETERS'
ULOC     SET      %
         CSECT    0
PLOC     SET      %
         ORG      ULOC
USET     CNAME
         PROC
LF       SET      %
         ORG      AF
         PEND
S:S      FNAME
         PROC
         PEND     AF(AF(1)+2)
CAL1     COM,1,7,4,3,17   AF
FPT0     COM,1,7,7,17   AF(1),AF(2),AF(3),AF(4)
         PAGE
M:INTRTN CNAME    10
         PROC
         BOUND    4
X        SET      0
         DO       NUM(AF)>0
X        SET      SCOR(AF(1),LEAVE,DISARM,ARM)-1
         ERROR,3,X<0   UK
         DO       NUM(AF)>1
X        SET      X|SCOR(AF(2),ENABLE,DISABLE)-1
         ERROR,3,X<0   UK
         ERROR,3,NUM(AF)>2   INOA
         FIN
         FIN
LF(1)    GEN,8,4,3,1,8,8   4,9,0,1,X,NAME
         PEND
         PAGE
M:DISCONNECT CNAME X'22'
M:QFI        CNAME X'24'
M:HOLD       CNAME X'25'
M:INTSTAT    CNAME X'27'
         PROC
         BOUND    4
EL       SET      SCOR(CF(2),E,L)
LF(1)    DO1      EL=0|EL=1
         CAL1     S:S(EL=1,(,4,5,,PLOC),(AFA,4,5,AF(2),AF(1)))
         DO1      EL=0
ULOC     USET     PLOC
         GOTO,EL=1   %FIN
         DO       NAME=X'24'|NAME=X'25'
P        SET      S:KEYS(2,29,ON,PURGE,OFF)
         ERROR,3,(P(1)=0)&(NAME=X'25')   MRK
         ERROR,3,(P(2)>0)&(NAME=X'24') UK
LF(2)    GEN,8,24 NAME,(P(2)&3)*(NAME=X'25')
         ELSE
P        SET      S:KEYS(2,*31,INT)
         ERROR,3,P(3)>NUM(AF)   MRK
LF(2)    FPT0     AFA(P(3),2),NAME,,AF(P(3),2)
         FIN
         DO1      EL=0
PLOC     USET     ULOC
%FIN     PEND
         PAGE
CODES    EQU      1,2,4,5,7
M:INTCON CNAME    X'23',1
M:INHIBIT  CNAME  X'23',2
         PROC
         BOUND    4
EL       SET      SCOR(CF(2),E,L)
LF(1)    DO1      EL=0|EL=1
         CAL1     S:S(EL=1,(,4,5,,PLOC),(AFA,4,5,AF(2),AF(1)))
         GOTO,EL=1   %FIN
         DO       NAME(2)=1
P        SET      S:KEYS(2,*26,INT,TRIGGER,DISABLE,ENABLE,ARM,DISARM)
         ERROR,3,P(3)>NUM(AF)   MRK
Y        SET      1
Z        DO       5
         GOTO,(Y&P(2))>0 CODE
Y        SET      Y**1
         FIN
         ERROR,3  MRK
         GOTO     %FIN
CODE     SET      CODES(Z)
         DO       Z=2
         ERROR,3,P(5)>NUM(AF)&P(6)>NUM(AF)   INOA
CODE     SET      S:S(P(5)<=NUM(AF),CODE,3)
         FIN
         DO1      Z~=2
         ERROR,3,NUM(AF)>2   INOA
         ELSE
P        SET      S:KEYS(2,30,OFF,ON)
         FIN
         DO1      EL=0
ULOC     USET     PLOC
         DO       NAME(2)=1
LF(2)    FPT0     AFA(P(3),2),NAME(1),,AF(P(3),2)
         GEN,29,3   0,CODE
         ELSE
LF(2)    FPT0     0,NAME(1),0,0
         DATA     P(2)&1
         FIN
         DO1      EL=0
PLOC     USET     ULOC
%FIN     PEND
         PAGE
M:CONNECT   CNAME X'21'
         PROC
         BOUND    4
EL       SET      SCOR(CF(2),E,L)
LF(1)    DO1      EL=0|EL=1
         CAL1     S:S(EL=1,(,4,5,,PLOC),(AFA,4,5,AF(2),AF(1)))
         GOTO,EL=1   %FIN
P        SET      S:KEYS(2,*0,ENTRY,PRIO,INT;
                          ,29,MASTER,CLEAR,DISABLE)
X        SET      P(5)>NUM(AF)|P(3)>NUM(AF)
         ERROR,3,X   MRK
         GOTO,X      %FIN
         DO1      EL=0
ULOC     USET     PLOC
LF(2)    FPT0     AFA(P(5),2),NAME,,AF(P(5),2)
         GEN,32   P(2)&X'C0000007'
         GEN,1,14,17   AFA(P(3),2),,AF(P(3),2)
         DO1      P(4)<=NUM(AF)
         GEN,1,14,17   AFA(P(4),2),,AF(P(4),2)
         DO1      EL=0
PLOC     USET     ULOC
%FIN     PEND
         PAGE
M:CLOCK  CNAME    X'26'
         PROC
         BOUND    4
EL       SET      SCOR(CF(2),E,L)
LF(1)    DO1      EL=0|EL=1
         CAL1     S:S(EL=1,(,4,5,,PLOC),(AFA,4,5,AF(2),AF(1)))
         GOTO,EL=1   %FIN
P        SET      S:KEYS(2,*0,INTERVAL,PRIO,ENTRY;
                          ,29,MASTER,ONESHOT,CANCEL)
X        SET      P(5)>NUM(AF)|((P(2)&1)=0&P(3)>NUM(AF))
Y        SET      ((P(2)&1)=1&P(3)<=NUM(AF))
         ERROR,3,Y   CNFL
         ERROR,3,X   MRK
         GOTO,X|Y %FIN
         DO1      EL=0
ULOC     USET     PLOC
LF(2)    FPT0     AFA(P(5),2),NAME,,AF(P(5),2)
         GEN,32   P(2)&X'C0000007'
         DO1      P(3)<=NUM(AF)
         GEN,1,31 AFA(P(3),2),AF(P(3),2)
         DO1      P(4)<=NUM(AF)
         GEN,1,31 AFA(P(4),2),AF(P(4),2)
         DO1      EL=0
PLOC     USET     ULOC
%FIN     PEND
         PAGE
M:GJOBCON   CNAME X'20'
         PROC
         BOUND    4
EL       SET      SCOR(CF(2),E,L)
LF(1)    DO1      EL=0|EL=1
         CAL1     S:S(EL=1,(,4,5,,PLOC),(AFA,4,5,AF(2),AF(1)))
         GOTO,EL=1   %FIN
P        SET      S:KEYS(2,*0,LMN,ACN,PRIO,INT)
X        SET      P(6)>NUM(AF)|P(3)>NUM(AF)
         ERROR,3,X   MRK
         GOTO,X      %FIN
         DO1      EL=0
ULOC     USET     PLOC
LF(2)    FPT0     AFA(P(6),2),NAME,,AF(P(6),2)
         GEN,32   P(2)&X'E0000000'
X        SET      S:NUMC(AF(P(3),2))
         ERROR,3,X>7   '''LMN'' > 7 CHARS.'
         GOTO,X>7      Y
         TEXTC    AF(P(3),2)
         DO1      X<4
         TEXT     '    '
Y        DO       P(4)<=NUM(AF)
X        SET      S:NUMC(AF(P(4),2))
         ERROR,3,X>8   '''ACN'' > 8 CHARS.'
         GOTO,X>8 P
         TEXT     AF(P(4),2)
         DO1      X<5
         TEXT     '    '
         FIN
         DO1      P(5)<=NUM(AF)
         GEN,1,14,17   AFA(P(5),2),,AF(P(5),2)
P        SET
         DO1      EL=0
PLOC     USET     ULOC
%FIN     PEND
         PAGE
M:STOPIO CNAME    X'1C'
M:STARTIO   CNAME X'1D'
         PROC
         BOUND    4
EL       SET      SCOR(CF(2),E,L)
LF(1)    DO1      EL=0|EL=1
         CAL1     S:S(EL=1,(,4,5,,PLOC),(AFA,4,5,AF(2),AF(1)))
         GOTO,EL=1   %FIN
P        SET      S:KEYS(2,*15,DEV,DCB,EA)
X        SET      P(3)>NUM(AF)&P(4)>NUM(AF)
Y        SET      P(3)<=NUM(AF)&P(4)<=NUM(AF)
         ERROR,3,X   MRK
         ERROR,3,Y   CNFL
         GOTO,X|Y    %FIN
         DO1      EL=0
ULOC     USET     PLOC
X        SET      S:S(P(3)>NUM(AF),P(3),P(4))
LF(2)    FPT0     AFA(X,2),NAME,,AF(X,2)
         GEN,32   (P(2)+(X'40000000'*(NAME=X'1D')))&X'4000C000'
         DO1      NAME=X'1C'&P(5)<=NUM(AF)
         GEN,1,14,17   AFA(P(5),2),,AF(P(5),2)
         DO1      EL=0
PLOC     USET     ULOC
%FIN     PEND
         PAGE
M:IOEX   CNAME
         PROC
         BOUND    4
EL       SET      SCOR(CF(2),E,L)
LF(1)    DO1      EL=0|EL=1
         CAL1     S:S(EL=1,(,4,5,,PLOC),(AFA,4,5,AF(2),AF(1)))
         GOTO,EL=1   %FIN
P        SET      S:KEYS(2,*0,SIO,EA,TO,PRI,*15,DEV,DCB,29,TIO,HIO,TDV)
X        SET      P(3)>NUM(AF)&(P(2)&7)=0
Y        SET      P(7)>NUM(AF)&P(8)>NUM(AF)
Z        SET      P(7)<=NUM(AF)&P(8)<=NUM(AF)
         ERROR,3,X|Y   MRK
         ERROR,3,Z     CNFL
         GOTO,X|Y|Z    %FIN
         DO1      EL=0
ULOC     USET     PLOC
X        SET      S:S(P(7)>NUM(AF),P(7),P(8))
Y        SET      P(3)<=NUM(AF)
LF(2)    FPT0     AFA(X,2),X'1F'-Y,,AF(X,2)
         DO       Y
Z        SET      SCOR(AF(P(3),3),REL)
         GEN,32   (P(2)&X'F0008000')+Z
         GEN,1,14,17   AFA(P(3),2),,AF(P(3),2)
         DO1      P(4)<=NUM(AF)
         GEN,1,14,17   AFA(P(4),2),,AF(P(4),2)
         DO1      P(5)<=NUM(AF)
         GEN,1,14,17   AFA(P(5),2),,AF(P(5),2)
         DO1      P(6)<=NUM(AF)
         GEN,1,14,17   AFA(P(6),2),,AF(P(6),2)
         ELSE
         GEN,32   P(2)&X'8003'
         FIN
         DO1      EL=0
PLOC     USET     ULOC
%FIN     PEND
         PAGE
M:MAP    CNAME    2
         PROC
         BOUND    4
EL       SET      SCOR(CF(2),E,L)
LF(1)    DO1      EL=0|EL=1
         CAL1     S:S(EL=1,(,4,6,,PLOC),(AFA,4,6,AF(2),AF(1)))
         GOTO,EL=1   %FIN
P        SET      S:KEYS(2,*0,ADR,19,VTP,PTV)
X        SET      P(3)>NUM(AF)|P(1)<2
         ERROR,3,X   MRK
Y        SET      P(1)>2
         ERROR,3,Y   CNFL
         GOTO,X|Y   %FIN
         DO1      EL=0
ULOC     USET     PLOC
LF(2)    FPT0     AFA(P(3),2),NAME,,AF(P(3),2)
         GEN,32   P(2)&X'800'
         DO1      EL=0
PLOC     USET     ULOC
%FIN     PEND
         PAGE
M:CDWD   CNAME
         PROC
         BOUND    8
P        SET      S:KEYS(2,0,DC,IZC,CC,ICE,HTE,IUE,SIL,S,;
                          *29,ADR,BC,ORDER)
X        SET      (P(2)&1)<1
         ERROR,3,X   MRK
         GOTO,X      %FIN
LF(1)    GEN,8,5,19  AF(P(5),2),,BA(AF(P(3),2))
LF(2)    GEN,32      (P(2)&X'FF000000')+(AF(P(4),2)&X'FFFF')
%FIN     PEND
         PAGE
**********************************************************************
*
*                            B A L    S E R V I C E      P R O C S
*
**********************************************************************
*
         OPEN     GFPP,GJOB,P,%FIN,GRDG,RUE,X,Y,CHK,EXCP,QUE,COC;
                 ,COCX,SUBR,TSTK
GFPP     SET      1
GJOB     SET      1
GRDG     SET      1
RUE      SET      1
CHK      SET      1
EXCP     SET      1
QUE      SET      1
COC      SET      1
COCX     SET      1
TSTK     SET      1
SAVE     CNAME    9,X'B'
RESTORE  CNAME    8,X'A'
         PROC
         DO       TSTK
         REF      TSTACK
TSTK     SET      0
         FIN
         DO       NUM(AF)=1
         DO       AF(1)=16
LF       LCI      0
         GEN,1,7,4,3,17   0,NAME(2),0,0,TSTACK
         ELSE
LF       GEN,1,7,4,3,17   0,NAME(1),AF(1),0,TSTACK
         FIN
         ELSE
         DO       AF(1)=1
LF       GEN,1,7,4,3,17   0,NAME(1),AF(2),0,TSTACK
         ELSE
LF       LCI      AF(1)
         GEN,1,7,4,3,17   0,NAME(2),AF(2),0,TSTACK
         FIN
         FIN
         PEND
         PAGE
M:GPP    CNAME    1
M:FPP    CNAME    2
         PROC
         DO       GFPP
         REF      T:FPP,T:GPP
GFPP     SET      0
         FIN
         DO       NAME=2
         ERROR,3,NUM(AF)=0   INOA
         GOTO,NUM(AF)=0   %FIN
LF       SAVE     3,2
         GEN,8,4,20          X'22'+(X'10'*AFA),3,AF
         ELSE
LF       SAVE     2
         SAVE     4
         FIN
         BAL,2    S:S(NAME=1,T:FPP,T:GPP)
         DO       NAME=2
         RESTORE  3,2
         ELSE
         RESTORE  4
         RESTORE  2
         FIN
%FIN     PEND
         PAGE
M:GDG    CNAME    1
M:RDG    CNAME    2
         PROC
         DO       GRDG
         REF      GSG,RSG
GRDG     SET      0
         FIN
         DO       NAME=2
         ERROR,3,NUM(AF)=0   INOA
         GOTO,NUM(AF)=0   %FIN
         FIN
LF       SAVE     8,11
         DO       NAME=2
         GEN,8,4,20          X'22'+(X'10'*AFA),8,AF
         FIN
         BAL,11   S:S(NAME=1,RSG,GSG)
         RESTORE  8,11
%FIN     PEND
         PAGE
M:CHKINT CNAME
         PROC
         DO       CHK
         REF      INTSTAT
CHK      SET      0
         FIN
P        SET      S:KEYS(2,*0,INT)
         ERROR,3,P(3)>NUM(AF)   MRK
         GOTO,P(3)>NUM(AF)      %FIN
LF       SAVE     15,9
         GEN,8,4,20       X'22'+(X'10'*AFA(P(3),2)),6,AF(P(3),2)
         BAL,11   INTSTAT
         RESTORE  15,9
%FIN     PEND
         PAGE
M:RUE    CNAME
         PROC
         DO       RUE
         REF      T:RUE,E:CBK,E:OFF,E:ERR,E:WU,E:UQA
RUE      SET      0
         FIN
P        SET      S:KEYS(2,*0,UN,EV)
         ERROR,3,P(1)~=2   MRK
         GOTO,P(1)~=2      %FIN
LF       SAVE     16
         GEN,8,4,20       X'22'+(X'10'*AFA(P(3),2)),5,AF(P(3),2)
         GEN,8,4,20     X'22'+(X'10'*AFA(P(4),2)),6,AF(P(4),2)
         BAL,11   T:RUE
         RESTORE  16
%FIN     PEND
         PAGE
M:GJOB   CNAME
         PROC
         DO       GJOB
         REF      T:GJOB,SYSACCT,SL:GPRIO
GJOB     SET      0
         FIN
P        SET      S:KEYS(2,*0,LMN,ACN,PRI)
         ERROR,3,P(3)>NUM(AF)   MRK
         GOTO,P(3)>NUM(AF)      %FIN
LF       SAVE     16
         LW,0     AF(P(3),2)
         LW,1     AF(P(3),2)+1
         DO       P(4)<=NUM(AF)
         LW,8     AF(P(4),2)
         LW,9     AF(P(4),2)+1
         ELSE
         LD,8     SYSACCT
         FIN
         DO       P(5)<=NUM(AF)
         GEN,8,4,20     X'22'+(X'10'*AFA(P(5),2)),15,AF(P(5),2)
         ELSE
         LW,15    SL:GPRIO
         FIN
         BAL,10   T:GJOB
         RESTORE  16
%FIN     PEND
         PAGE
M:EXCP   CNAME    1
M:NEWQ   CNAME    2
         PROC
         LOCAL    RET
         DO       EXCP
         REF      NEWQ,NEWQNW,NEWQNWM,Y4,J:JIT,DCT%MASK
EXCP     SET      0
         FIN
P        SET   S:KEYS(2,*0,PRI,EA,*13,DCT,TOI,CPA,*27,SIZ,NRT,DA,BUF,FC)
X        SET      ((P(2)**-16)&7)&(P(2))
         ERROR,3,X   CNFL
         GOTO,X~=0 %FIN
X        SET      ((NAME=1)*(P(2)||X'50000')&X'50000')|;
                  ((NAME=2)*((P(2)||X'13')|((P(2)&X'40000')=0);
                                          &((P(2)&4)=0))&X'13')
X        SET      X~=0
         ERROR,3,X   MRK
         GOTO,X~=0 %FIN
LF       SAVE     16
         DO       NAME=1
         GEN,8,4,20     (X'22'+(X'10'*AFA(P(7),2))),13,AF(P(7),2)
         OR,13    Y4
         GEN,8,4,20     (X'22'+(X'10'*AFA(P(6),2))),14;
                       ,S:S(P(6)<=NUM(AF),1,AF(P(6),2))
         LI,15    0
         ELSE
         GEN,8,4,20     (X'22'+(X'10'*AFA(P(11),2))),13,AF(P(11),2)
         GEN,8,4,20     (X'22'+(X'10'*AFA(P(8),2))),14,AF(P(8),2)
         DO       P(10)<=NUM(AF)
         GEN,8,4,20         X'32',15,AF(P(10),2)
         LH,12    15
         AND,12   DCT%MASK
         ELSE
         LI,15    0
         FIN
         FIN
         GEN,8,4,20     (X'22'+(X'10'*AFA(P(4),2))),0,AF(P(4),2)
         DO1      NUM(AF(P(4)))>2
         LW,1     S:S(AFA(P(4),3),=AF(P(4),3),AF(P(4),3))
         DO1      P(5)<=NUM(AF)
         GEN,8,4,20       X'22'+(X'10'*AFA(P(5),2)),12,AF(P(5),2)
         DO       NAME=2
         GEN,8,4,20     (X'22'+(X'10'*AFA(P(9),2))),2,AF(P(9),2)
         ELSE
         LI,2     0
         FIN
         LI,7     2
         STB,2    12,7
         GEN,8,4,20     (X'22'+(X'10'*AFA(P(3),2))),2;
                       ,S:S(P(3)<=NUM(AF),X'FF',AF(P(3),2))
         LI,7     1
         STB,2    12,7
         GEN,8,4,20     (X'22'+(X'10'*AFA(P(12),2))),2,AF(P(12),2)
         STB,2    12
         DO       NAME=2
X        SET      SCOR(CF(2),W,NW)
         DO       X=2
         LI,11    RET
         LW,2     J:JIT
         BEZ      NEWQ
         FIN
         BAL,11   S:S(X,NEWQ,NEWQ,NEWQNWM)
         ELSE
         BAL,11   NEWQNW
         FIN
RET      NOP
         RESTORE  16
%FIN     PEND
         PAGE
M:QUE    CNAME
         PROC
         DO       QUE
         REF      QUEUE,QUEUE1
QUE      SET      0
         FIN
P        SET      S:KEYS(3,*30,EA,FC)
X        SET      P(4)>NUM(AF)
         ERROR,3,X   MRK
Y        SET      TCOR(AF(1),S:RAD,S:EXT,S:FR)+AFA=0
         ERROR,3,Y   'DCB MISSING'
         GOTO,X|Y     %FIN
LF       SAVE     13,8
         GEN,8,4,20     (X'22'+(X'10'*AFA(1))),8,AF(1)
         GEN,8,4,20     (X'22'+(X'10'*AFA(P(4),2))),9,AF(P(4),2)
         STB,9    8
         DO       P(3)<=NUM(AF)
         GEN,8,4,20       X'22'+(X'10'*AFA(P(3),2)),9,AF(P(3),2)
         DO1      NUM(AF(P(3)))>2
         LW,10    S:S(AFA(P(3),3),=AF(P(3),3),AF(P(3),3))
         BAL,11   QUEUE1
         ELSE
         LI,9     0
         BAL,11   QUEUE
         FIN
         RESTORE  13,8
%FIN     PEND
         PAGE
M:COC    CNAME
         PROC
         LOCAL    OK,FOUNDIT,LOOP,XIT,RET
         DO       COC
         REF      COCDSABL,COCSENDX,COCENABL,LNOL,LB:UN,COCTERM;
                 ,COCOTV,CO:INTFL
COC      SET      0
         FIN
P        SET      S:KEYS(2,*0,UN,LN,CHAR)
         ERROR,3,P(1)<2   MRK
         ERROR,3,P(1)>2   CNFL
         GOTO,P(1)<2|P(1)>2   %FIN
LF       SAVE     16
         GEN,8,4,3,17   X'22'+(X'50'*AFA(P(5),2)),5,AF(P(5),3);
                       ,AF(P(5),2)
         WD,0     X'37'
         LH,2     CO:INTFL
         BEZ      OK
         WD,0     X'27'
         RESTORE  16
         LCI      8
         B        XIT
OK       BAL,13   COCDSABL
         DO       P(4)<=NUM(AF)
         GEN,8,4,20       X'22'+(X'10'*AFA(P(4),2)),2,AF(P(4),2)
         ELSE
         GEN,8,4,20       X'22'+(X'10'*AFA(P(3),2)),6,AF(P(3),2)
         BAL,7    SUBR
         BCS,2    XIT
         DO       COCX
         B        FOUNDIT
SUBR     LI,11    LNOL
         LI,2     0
LOOP     CB,6     LB:UN,2
         BE       RET
         AI,2     1
         BDR,11   LOOP
         RESTORE  16
         LCI      2
RET      B        0,7
COCX     SET      0
         FIN
         FIN
FOUNDIT  LB,6     COCTERM,2
         LH,10    COCOTV,6
         BAL,9    COCSENDX
         BAL,13   COCENABL
         RESTORE  16
         LCI      0
XIT      EQU      %
%FIN     PEND
         CLOSE    GFPP,GJOB,P,%FIN,GRDG,RUE,X,Y,CHK,EXCP,QUE,COC;
                 ,COCX,SUBR,TSTK
         CLOSE    USET,ULOC,PLOC,P,X,Y,Z,UK,INOA,MRK,%FIN,S:S,CODE;
                 ,CODES,CNFL,EL,CAL1,FPT0
         END
