 OPEN PLOC,ULOC,PT0,PT1,CCS,CS%,IBPRA,UP,INOA,PC,IVAL,INV,;
 A,G,H,I,M,P,Q,R,S,T,W,X,Z,CAL1,S:S,BAV,TXT,LNUM,LTEMP,MAX,;
 DMY,CVAR,ATF,IF,COMMON,BRN,%NOP,ZAP,VAR,ITEM,DV,SP,PF,VKEY,;
 XM,#,%DEC,COCOPT,USET
         DISP     X'E00'
IBPRA    EQU      'ILLEGAL BUF/FPARAM/LINE ADDRESS'
UP       EQU      'UNRECOGNIZED KEY'
INOA     EQU      'IMPROPER # OF AFS'
PC       EQU      'PARAMETER CONFLICT'
IVAL     EQU      'VALUE EXCEEDS MAXIMUM'
INV      EQU      'INVALID AF'
CAL1     S:SIN,0  4
ULOC     SET      %
CCS      SET      1
PT0      CSECT
PLOC     SET      %
CS%(1)   SET      %
PT1      CSECT    1
CS%(2)   SET      %
         ORG      ULOC
USET     CNAME
         PROC
LF       SET      %
         ORG      AF
         PEND
         OPEN     S,ACN,S#,LBLS
ACN      FNAME    8
S#       FNAME    4
LBLS     FNAME    2
         PROC
S        SET      AF
         DO1      NAME-S:NUMC(S)
S        SET      S,' '
         PEND     S:PT(S)
         CLOSE    S
G        COM,1,7,4,3,17  AFA(1),CF(2),CF(3),AF(2),AF(1)
S:S      FNAME
         PROC
         PEND     AF(AF(1)+2)
BAV    CNAME                              TEST BUFFER ADDRESS VALIDITY
       PROC
   ERROR,3,(CF(2)|AFA=0)&ABSVAL(WA(AF))<16&TCOR(AF,S:INT,S:AAD)>0;
    &AF~=0 IBPRA
         PEND
         OPEN     SXP,ZONE,DIGIT,S,I
SXP      FNAME                      ANS HASH FUNCTION
         PROC
ZONE     SET      0
DIGIT    SET      0
S        SET      S:UT(AF)
I        DO       6
ZONE     SET      (ZONE**2)|(+S(I)**-4&3)
DIGIT    SET      (DIGIT*10)+(+S(I)&X'F')
         FIN
         PEND     ZONE**20|DIGIT
         CLOSE    ZONE,DIGIT,S,I
%DEC     SET      '0','1','2','3','4','5','6','7','8','9'
TXT      FNAME
         PROC
         PEND     S:PT(%DEC(AF/10+1),%DEC(AF-AF/10*10+1))
LNUM     FNAME
         PROC
LTEMP    SET      -1
         GOTO,(TCOR(S:INT,AF(NUM(AF)))=0)[NUM(AF)=1 #PEND
LTEMP    SET      AF(NUM(AF))
#PEND    PEND     LTEMP
MAX      FNAME
         PROC
         PEND     AF(1)*(AF(1)>AF(2))+AF(2)*(AF(1)<=AF(2))
M:CVM    CNAME    8
         PROC
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17   S:S(PF=1,(,4,NAME,,PLOC),(AFA,4,NAME,AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF=0|PF=2
LF(2)    GEN,1,7,7,17 AFA(1),7,,AF(1)
         GEN,1,14,17 AFA(2),,AF(2)
         FIN
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:CAC    CNAME    1
M:TS     CNAME    4
M:TS2    CNAME    6
M:TS3    CNAME    X'B'
         PROC
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
         GEN,1,7,4,3,17 S:S(PF=1,(,4,8,,PLOC),(AFA,4,8,AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO1      PF=0|PF=2
         GEN,8,4,2,2,16 6,NAME,,AF(1),
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:STA    CNAME    (1,1,23,3),(1,1,19,3),(1,1,18,3),(1,3,16),;
  (2,1,23,3),(2,1,22,3),(2,1,21,3),(2,1,19,3),(2,1,18,3),;
  (2,3,16),(3,1,23,3),(3,1,22,3),(3,1,21,3),(4,X'800000FF'),;
  (5,X'800000FF'),(6,1,23,3),(6,7,16),(7,-1),(8,1,21,3),;
  (10,1,7,3),(10,7)
         PROC
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
         GEN,1,7,4,3,17 S:S(PF=1,(,4,8,,PLOC),(AFA,4,8,AF(2),AF(1)))
         DO       PF=0|PF=2
         DO1      PF=0
ULOC     USET     PLOC
Q        SET      X'06200000',
P        SET      S:KEYS(2,*0,ECHOPLEX,TABSIM,UCSHIFT,BRKCNT,;
                  HANGUP,FDPTAPE,SPACEINSERT,LCSHIFT,PARITYCHECK,;
                  ACS,TABREL,HDPTAPE,BSEDIT,WIDTH,;
                  LENGTH,COUPLE,ALGORITHM,TRANSLATION,DONTSEND,;
                  IGNORE,CRTTYPE)
I        DO       NUM(NAME)
         GOTO,(P(2)&X'100000000'**-I)=0  %FIN
Q(2)     SET      Q(2)|X'100000000'**-NAME(I,1)
         DO       AFA(P(I+2),2)
         ERROR,3,(NAME(I,2)&X'80000000')=0 'INDIRECT AF NOT ALLOWED'
Q(NAME(I,1)+2) SET AF(P(I+2),2)+X'80000000'
         ELSE
M        SET      NAME(I,2)
S        SET      NAME(I,3)
A        SET  M&S:S(NAME(I,4)&SCOR(AF(P(I+2),2),OFF,ON),AF(P(I+2),2),,1)
Q(NAME(I,1)+2) SET Q(NAME(I,1)+2)+A**S+S:S(S>15,,M**(S&X'F'))
         FIN
%FIN     FIN
I        DO       NUM(Q)
         DO1      NUM(Q(I))>0
         DATA     Q(I)
         FIN
         DO1      PF=0
PLOC     USET     ULOC
         FIN
         PEND
M:JOB    CNAME    1
         PROC
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17   S:S(PF=1,(,4,NAME,,PLOC),(AFA,4,NAME,AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF=0|PF=2
P        SET      S:KEYS(3,ABN,BUF,(IN,OUT),LAST,DEL)
LF(2)    GEN,1,7,24   AFA,X'2F',AF(1)
Z        SET      NUM(AF)+1
         DATA     P(2)
         DO       P(3)<Z
         GEN,1,31 AFA(P(3),2),AF(P(3),2)
         BAV      AF(P(3),2)
         FIN
         DO       P(4)<Z
         GEN,1,31   AFA(P(4),2),AF(P(4),2)
         BAV      AF(P(4),2)
         FIN
         GEN,(P(5)<Z)*32  SCOR(AF(P(5),1),IN,OUT)
         DO1      P(6)<Z
         GEN,1,31 AFA(P(6),2),AF(P(6),2)
         DO1      P(7)<Z
         GEN,1,31 AFA(P(7),2),AF(P(7),2)
      DO1    ((P(6)=P(5))&(P(7)=Z))=0
 ERROR,1,(P(6)=P(5))~=(P(7)<Z) PC
         FIN
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:TRAP   CNAME    8
         PROC
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17   S:S(PF=1,(,4,NAME,,PLOC),(AFA,4,NAME,AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF=0|PF=2
Q        SET      0,0,0,0,0,0
I        DO       NUM(AF)
A SET SCOR(AF(I,1),ABORT,TRAP,IGNORE,PERMIT,RESTORE)*(NUM(AF(I))>1)
         GOTO,A>4 #RES
Q(A+1) SET S:S(A,(S:UFV(AF(I))),ATF(AF(I)),ATF(AF(I)),IF(AF(I)),;
            IF(AF(I)))
         ELSE
#RES     ERROR,3,NUM(AF)>1   INOA
Q        SET      AF(I,2),0,0,0,0,1
         FIN
LF(2)    GEN,8,7,17     20,0,Q(1)
         GEN,1,8,8,7,8     Q(6),Q(2),Q(3),Q(5),Q(4)
         FIN
         DO1      PF=0
PLOC     USET     ULOC
         PEND
ATF      FNAME
         PROC
P SET S:KEYS(1,23,ALL,WDOG,NAO,UI,PS,FP,DEC,FX,CAL)
         PEND     P(2)-P(2)**-8
IF       FNAME
         PROC
P  SET  S:KEYS(1,29,BOTH,DEC,FX)
         PEND     P(2)-P(2)**-2
M:XCON   CNAME    X'19'
         PROC
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17   S:S(PF=1,(,4,8,,PLOC),(AFA,4,8,AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO PF=0|PF=2
         ERROR,3,NUM(AF)>2   INOA
         ERROR,3,AFA   'ILLEGAL AFA'
         ERROR,3,(NUM(AF)=2)&(SCOR(AF(2),LAST)=0)   UP
         BAV      AF(1)
LF(2)    GEN,8,1,6,17 NAME,SCOR(AF(2),LAST),,AF(1)
         FIN
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:TRTN   CNAME    9
         PROC
         BOUND    4
         DO       AFA
LF(1)    GEN,1,7,4,3,17 AFA,4,NAME,,AF(1)
         BAV      AF(1)
         ELSE
LF(1)    GEN,8,4,3,9,8 4,NAME,,SCOR(AF(1),XCON),5
         ERROR,3,(NUM(AF)>0)&(SCOR(AF(1),XCON))=0   UP
         ERROR,3,NUM(AF)>1             INOA
         FIN
         PEND
M:PT     CNAME
         PROC
LF(1)    EQU      %
LF(2)    EQU      PT0
LF(3)    EQU      PT1
         ERROR,3,AF~=0&AF~=1        'ILLEGAL AF'
         GOTO,CCS=AF+1|AF<0|AF>1    #PEND
CS%(CCS) SET      PLOC
CCS      SET      AF+1
PLOC     SET      CS%(CCS)
#PEND    PEND
M:EXIT   CNAME    1
M:ERR    CNAME    2
M:XXX    CNAME    3
         PROC
         DO       AFA
LF(1)    GEN,1,7,4,3,17 AFA,4,9,,AF(1)
         BAV      AF(1)
         ELSE
LF(1)    GEN,8,4,4,8,8 4,9,(NUM(AF)>0)&(AF(1)>=0),AF(1),NAME
         ERROR,3,NUM(AF)>1    INOA
 ERROR,3,(AF(1)>255)|(TCOR(AF(1),S:INT))=0   'ILLEGAL SCC VALUE'
         FIN
         PEND
         OPEN     V,I,J
M:CHECKECB CNAME  7
         PROC
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      (PF=0)|(PF=1)
 GEN,1,7,4,3,17 S:S(PF=1,(,4,NAME,,PLOC),(AFA,4,NAME,AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO       (PF=0)|(PF=2)
V        SET
I        DO       NUM(AF)
P        SET      SCOR(AF(I,1),EVENTS,TIME,ECB,ECBL)
         ERROR,3,P=0  S:PT('UNRECOGNIZED KEY IN AF(',TXT(I),')')
         GOTO,P=0 #FIN
V(P,NUM(V(P))+1)  SET I
#FIN     FIN
LF(2)    GEN,8,8,8,8 5,0,NUM(V(3)),NUM(V(4))
         GEN,1,1,30  NUM(V(1))>0,NUM(V(2))>0,0
         GOTO,NUM(V(1))=0 #NOP
 ERROR,3,NUM(V(1))>1 'MULTIPLE ''EVENTS'' SPEC - LAST ONE USED'
 GEN,1,31 AFA((V(1,NUM(V(1)))),2),AF((V(1,NUM(V(1)))),2)
#NOP     GOTO,NUM(V(2))=0           #NOP
 ERROR,3,NUM(V(2))>1 'MULTIPLE ''TIME'' SPEC - LAST ONE USED'
 GEN,1,31 AFA((V(2,NUM(V(2)))),2),AF((V(2,NUM(V(2)))),2)
#NOP     GOTO,(NUM(V(3))=0)&(NUM(V(4))=0) #NOP
J        DO       2
I        DO       NUM(V(J+2))
         GEN,1,31 AFA(V(J+2,I),2),AF(V(J+2,I),2)
         GEN,1,31 AFA(V(J+2,I),3),AF(V(J+2,I),3)
         FIN
         FIN
         GOTO     #FIN
#NOP     ERROR,3  'ECB OR ECBL MUST BE PRESENT'
#FIN     FIN
         DO1      PF=0
PLOC     USET     ULOC
         PEND
         CLOSE    V,I,J
M:STRAP  CNAME     4
M:SUPCLS CNAME    6
M:CLEAR  CNAME     7
M:TERM   CNAME     8
M:EXEC   CNAME    9
         PROC
LF       CAL1,9   NAME
         PEND
M:SEGLD  CNAME    1
M:SMPRT  CNAME    10
         PROC
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    SET      %
         DO       PF=0|PF=1
 GEN,1,7,4,3,17   S:S(PF=1,(,4,8,,PLOC),(AFA,4,8,AF(2),AF(1)))
         ERROR,3,(NAME=10)&(NUM(AF)<2)&(PF=0)   INOA
         FIN
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF=0|PF=2
I        SET      TCOR(S:C,AF)
LF(2) GEN,1,7,24,1,7,24 AFA(2),NAME,AF(2),AFA(1)|AFA(3),S:S(NAME=10,;
  (0,S:S(I,AF(1,1),(PLOC+2))),(AF(1),AF(NUM(AF))))
         DO1      I
         TEXTC    AF
         FIN
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:LDTRC  CNAME    3
M:LINK   CNAME    2
         PROC
         BOUND    4
P        SET      S:KEYS(5,29,ERROR,EXIT,*31,CMD)
A        SET      TCOR(AF(2),S:C)&NUM(AF(2))=1,;
                  TCOR(AF(3),S:C)&NUM(AF(3))=1
PF       SET      SCOR(CF(2),E,L)
         DO       (NAME=3)&(P(2)>0)
P(2)     SET      0
         ERROR,3,1 UP
         FIN
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17   S:S(PF=1,(,4,8,,PLOC),(AFA,4,8,AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF=0|PF=2
LF(2)    GEN,8,19,3,1,1  NAME,,P(2),A
         TEXTC    AF(1)
         DO1      A(1)
         TEXT     ACN(AF(2))
         DO1      A(2)
         TEXT     ACN(AF(3))
         DO1      P(2)&1
         GEN,1,14,17 AFA(P(3),2),,AF(P(3),2)
         FIN
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:TIME   CNAME    8
         PROC
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17   S:S(PF=1,(,4,NAME,,PLOC),(AFA,4,NAME,AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF=0|PF=2
         ERROR,3,NUM(AF)>2 INOA
         DO1      NUM(AF)=2
         ERROR,3,SCOR(AF(2),TUN,TMS)=0 UP
LF(2)    GEN,1,7,1,23 AFA,X'10',SCOR(AF(2),TUN,TMS)>0,AF(1)
         BAV      AF(1)
         FIN
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:ACPL   CNAME    1
M:RCPL   CNAME    0
         PROC
LF(1)    CAL1,8   PLOC
ULOC     USET     PLOC
LF(2)    DATA     X'06200000'
         DATA     X'04000000'
         GEN,9,23 NAME,X'80'
PLOC     USET     ULOC
         PEND
M:COUPLE CNAME    0
M:DECOUPLE CNAME  1
         PROC
LF(1)    CAL1,8   PLOC
ULOC     USET     PLOC
         DO       NAME
LF(2)    DATA     X'1D800000'
         ELSE
         ERROR,3,(NUM(AF)>1|NUM(AF)=0) INOA
         ERROR,3,AF(1)>X'FE' IVAL
LF(2)    GEN,8,24 X'1D',AF(1)&X'FF'
         FIN
PLOC     USET     ULOC
         PEND
M:WAIT   CNAME    X'F',8
M:GVP    CNAME    4,8
M:FVP    CNAME    5,8
M:GP     CNAME    8,8
M:FP     CNAME    9,8
M:GCP    CNAME    X'0C',8
M:FCP    CNAME    X'0D',8
M:GDDL   CNAME    X'1B',8
         PROC
         ERROR,3,(NUM(AF)>1)   INOA
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17 S:S(PF=1,(,4,NAME(2),,PLOC),(AFA,4,NAME(2),AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO1      PF=0|PF=2
LF(2)    G,NAME(1) AF(1)
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:INT    CNAME    X'0E',8
         PROC
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17 S:S(PF=1,(,4,NAME(2),,PLOC),(AFA,4,NAME(2),AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF=0|PF=2
         ERROR,3,NUM(AF)>2  INOA
         ERROR,3,(NUM(AF)=2)&(SCOR(AF(2),CP)=0)  UP
LF(2)    GEN,1,7,1,6,17 AFA(1),NAME(1),SCOR(AF(2),CP),,AF(1)
         FIN
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:LDEV   CNAME    X'1A',8
         PROC
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17 S:S(PF=1,(,4,NAME(2),,PLOC),(AFA,4,NAME(2),AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF=0|PF=2
LF(2)    G,NAME(1)
P SET S:KEYS(3,#,DEV,#,(IN,OUT),LINES,COUNT,SPACE,JDE,COPIES,SEQ,;
      FPC,FORM,FFORM,#,#,#,(VFC,NOVFC),#,#,#,LABEL,23,NOBANNER,;
      25,DELETE,AREL,(ASAVE,AINIT),OUTPUT,28,CONCURR,#,DIRECT,DRC)
         DO       NUM(AF(P(9)))>2
P(2)     SET      P(2)|X'00001000'
P(22)    SET      P(9)
         FIN
         DATA     P(2)|X'80000000'
         GEN,16,16 0,AF(1)
         ERROR,3,NUM(AF)<1|TCOR(AF(1),S:C)=0    'ILLEGAL STREAM-ID'
I        DO       20
         GOTO,NUM(AF(P(I+3)))=0 #F
 GOTO,I #P,#F,#IO,#P,#P,#P,#P,#P,#T,#T,#T,#T,#F,#F,#F,#IO,#F,#F,#P,#P
#P       CLOSE
         G        AF(P(I+3),2+(I=19))
 ERROR,3,S:S(I,0,0,0,0,AF(P(7),2)>255,0,AF(P(9),2)>15,0,;
  AF(P(11),2)>255,0,0,0,0,0,0,0,0,0,0,AF(P(22),3)>15,0)-;
  AFA(P(I+3),2+(I=19))  IVAL
         GOTO     #F
#T       CLOSE
         GEN,32   S:S(TCOR(S:C,AF(P(I+3),2)),0,S#(AF(P(I+3),2)))
         GOTO     #F
#IO      CLOSE
         GEN,32   S:S(SCOR(AF(P(I+3),OUT,NOVFC),0,1,1))
#F       FIN
         FIN
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:REW    CNAME    1,1               .
M:WEOF   CNAME    2,1               .
M:MERC   CNAME    16,2              .
M:DISPLAY CNAME   X'13',8
M:GL     CNAME    11,8              .
M:SLAVE  CNAME    7,5
M:MASTER CNAME    8,5
M:SYS    CNAME    8,6
M:CT     CNAME    6,8
M:PC     CNAME    X'2C',1
M:GETID  CNAME    X'0D',7
         PROC
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17 S:S(PF=1,(,4,NAME(2),,PLOC),(AFA,4,NAME(2),AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF=0|PF=2
         ERROR,3,NUM(AF)>1   INOA
LF(2)    G,NAME(1) AF(1)
        ERROR,3,AFA*NAME(2)>1            'ILLEGAL AFA'
         DO1      NAME(3)
         BAV,1     AF(1)
         FIN
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:CAL    CNAME
         PROC
PF       SET      SCOR(CF(2),E,L)
         BOUND    4
LF(1)    DO1      PF=0|PF=1
         GEN,1,7,4,3,17  S:S(PF=1,(,4,5,,PLOC),(AFA,4,5,AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF=0|PF=2
P        SET      S:KEYS(2,CC,IA,20,FR,FS,FZ,FN,*24,;
                  (SLAVE,MASTER,MP),26,DM,AM,CI,II,EI,INH)
LF(2)    GEN,8,23,1  6,0,SCOR(AF(P(5),1),MP)
         GEN,4,8,3,17,;             CC,(FR,FS,FZ,FN,SLAVE,DM,AM),,IA
             8,24     ;             (CI,II,EI),0
         AF(P(3),2),;               CC
   ((P(2)**-4)&X'F3')[(SCOR(AF(P(5),1),SLAVE)*8)+4,; FR,..FN,SLAVE,DM,AM
         0,AF(P(4),2),;             IA
         ((P(2)**-1)&7)|((P(2)&1)*7),0  CI,II,EI OR INH
         FIN
         DO1      PF=0
PLOC     USET     ULOC
         PEND
COCOPT   CNAME
         PROC
A        SET      S:KEYS(3,*1,TIMEOUT,2,CONDITIONAL,DELETEIN,DELETEOUT,;
                  REREAD,*13,OACS)
         GEN,14,2,1,15 A(2)**-18,AF(A(4),2),,AF(A(3),2)
         PEND
COMMON   CNAME
         PROC
         BOUND    4
PF       SET      SCOR(CF(3),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17 S:S(PF=1,(,4,1,,PLOC),(AFA,4,1,AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF=0|PF=2
LF(2)    GEN,1,7,7,17,32 AFA(1),CF(2),0,AF(1),P(2)
I        DO       NUM(P)-2
         DO       SCOR(AF(P(I+2),1),COC)&(AFA(P(I+2),2)=0)
         COCOPT   AF(P(I+2))
         ELSE
         G        AF(P(I+2),2)
         DO1      SCOR(AF(P(I+2),1),BUF)
         BAV      AF(P(I+2),2)
         FIN
         FIN
         FIN
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:RAMR   CNAME    X'2D'
M:WAMR   CNAME    X'2E'
         PROC
P        SET      S:KEYS(1,*2,BUF,SIZE)
LF       COMMON,NAME,CF(2) AF
         PEND
M:PFIL   CNAME    28
         PROC
P SET             S:KEYS(1,27,(BOF,EOF))
LF       COMMON,NAME,CF(2) AF
         PEND
M:TRUNC  CNAME    18
         PROC
P        SET      0,0
LF       COMMON,NAME,CF(2) AF
         PEND
M:SETDCB CNAME    06
         PROC
P        SET      S:KEYS(1,ERR,ABN,CRPT)
LF       COMMON,NAME,CF(2) AF
         PEND
M:RELREC CNAME    12
         PROC
P  SET            S:KEYS(1,KEY)
LF       COMMON,NAME,CF(2) AF
         PEND
M:DELREC CNAME    13
         PROC
P  SET            S:KEYS(1,KEY)
LF       COMMON,NAME,CF(2) AF
         PEND
M:READ   CNAME    16
         PROC
P        SET      S:KEYS(1,ERR,ABN,BUF,SIZE,(KEY,INDX),BTD,;
            ECB,BLOCK,COC,24,AUTO,;
             26,(REV,FWD),(WAIT,NOWAIT),(ULBL))
LF       COMMON,NAME,CF(2) AF
         PEND
M:WRITE  CNAME    17
         PROC
P        SET      S:KEYS(1,ERR,ABN,BUF,SIZE,(KEY,INDX),BTD,;
                  ECB,BLOCK,COC,25,;
                           ONEWKEY,NEWKEY,(WAIT,NOWAIT))
LF       COMMON,NAME,CF(2) AF
         PEND
M:MOVE   CNAME    14
         PROC
P        SET      S:KEYS(1,ERR,ABN,OUT,BUF,SIZE)
LF       COMMON,NAME,CF(2) AF
         PEND
M:PRECORD CNAME   29
         PROC
P  SET            S:KEYS(1,N,ABN,27,(REV,FWD))
LF       COMMON,NAME,CF(2) AF
         PEND
M:CHECK  CNAME    41
         PROC
P        SET      S:KEYS(1,ERR,ABN,ECB,INDX)
LF       COMMON,NAME,CF(2) AF
         PEND
M:EXU    CNAME    X'28'
         PROC
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17   S:S(PF=1,(,4,5,,PLOC),(AFA,4,5,AF(2),AF(1)))
         ERROR,3,NUM(AF)<1 INOA
         DO1      PF=0
ULOC     USET     PLOC
         DO1      PF=0|PF=2
LF(2)    GEN,1,7,24   AFA,NAME,AF(1)
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:CLOSE  CNAME    21
M:CVOL   CNAME    3
         PROC
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17   S:S(PF=1,(,4,1,,PLOC),(AFA,4,1,AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF=0|PF=2
P        SET      S:KEYS(3,(REL,SAVE,JOB,DISP),LABEL,ERR,ABN,;
                  24,PTV,26,REM,PTL,32,FILE,PASS,READ,WRITE,;
                  EXECUTE,UNDER)
H        SET      S:KEYS(7,*20,#,#,PASS,#,#,#,WRITE,READ,;
                  #,#,#,FILE,*18,EXECUTE,UNDER)
P(2)     SET      P(2)|((H(1)>0)*X'100')  PUT IN V BIT
A        SET      SCOR(AF(P(3),1),REL,SAVE,JOB)
LF(2)    GEN,1,7,7,17,32 AFA,NAME(1),0,AF(1),P(2)
         DO       (P(2)&X'80000000')~=0
         DO       A=0
         G        AF(P(3),2)
         ELSE
         DATA     A
         FIN
         FIN
I        DO       3                 LABEL,ERR,ABN
         GOTO,(P(2)&(X'80000000'**-I))=0  #C1
         GEN,1,14,17  AFA(P(I+3),2),0,AF(P(I+3),2)
#C1      FIN
         GOTO,H(1)=0  #C1
         CVAR     (AF(H(10))),(AF(H(9))),0,0,0,;
             (AF(H(5))),0,0,(AF(H(14))),(AF(H(15))),(AF(H(16)))
#C1      ERROR,7,TCOR(AF(1),S:RAD,S:EXT,S:FR)+AFA=0 'DCB MISSING'
         FIN
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:STIMER CNAME    17
         PROC
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17   S:S(PF=1,(,4,8,,PLOC),(AFA,4,8,AF(2),AF(1)))
         DO       PF=0|PF=2
A        SET     (SCOR(AF(1,1),SEC,MIN,TUN)=0)+1
P        SET      SCOR(AF(A,1),SEC,MIN,TUN)
         ERROR,3,P=0  UP
         FIN
         DO1      PF=0
ULOC     USET     PLOC
         DO1      PF=0|PF=2
LF(2) GEN,1,7,5,2,17,32 AFA(A||3),NAME,0,P-1,AF(A||3),AF(A,2)
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:TTIMER CNAME    18
         PROC
P        SET      S:KEYS(0,22,CANCEL,29,TUN,MIN,SEC)
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17   S:S(PF=1,(,4,8,,PLOC),(AFA,4,8,AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO1      PF=0|PF=2
LF(2)    G,NAME     P(2)/2+2*((P(2)&7)=0)
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:TFILE  CNAME    15
         PROC
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17   S:S(PF=1,(,4,1,,PLOC),(AFA,4,1,AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF=0|PF=2
P        SET      S:KEYS(1,*4,*TFILE,*0,ERR,ABN)
LF(2) GEN,1,7,7,17,32   AFA(1),NAME,0,AF(1),P(2)|X'18000050'
I        DO       NUM(P)-3
         G        AF(P(3+I),2)
         FIN
         GEN,32,1,31   0,AFA(P(3),2),AF(P(3),2)
         FIN
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:PRINT  CNAME    1
M:TYPE   CNAME    2
M:KEYIN  CNAME    4
M:MESSAGE CNAME   0
         PROC
         DO       NAME=1
         DO1      TCOR(M:LL,S:FR)
         REF      M:LL
         ELSE
         DO1      TCOR(M:OC,S:FR)
         REF      M:OC
         FIN
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17   S:S(PF=1,(,4,2,,PLOC),(AFA,4,2,AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF=0|PF=2
         DO       NAME~=4
P        SET      S:KEYS(2,*MESS)
         ELSE
P        SET  S:KEYS(2,*MESS,*REPLY,*SIZE,*ECB,27,OC)
         FIN
LF(2)    GEN,8,24 NAME,0
         DATA     P(2)
         GEN,1,31 AFA(P(3),2),AF(P(3),2)
         BAV      AF(P(3),2)
         DO       NAME=4
         GEN,1,31 AFA(P(4),2),AF(P(4),2)
         BAV      AF(P(4),2)
         GEN,1,31 AFA(P(5),2),AF(P(5),2)
         GEN,1,31 AFA(P(6),2),AF(P(6),2)
         BAV      AF(P(6),2)
         FIN
         FIN
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:SNAP   CNAME    0
M:SNAPC  CNAME    1
M:IF     CNAME    2                 .
M:AND    CNAME    3                 .
M:OR     CNAME    4                 .
M:COUNT  CNAME    5                 .
         PROC
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17   S:S(PF=1,(,4,3,,PLOC),(AFA,4,3,AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF=0|PF=2
I        SET      (NAME<2)&(SCOR(AF(3+NAME),NREGS))
LF(2)    GEN,8,7,17  NAME,I,0
         GOTO,(NAME>1)+(NAME=5)      R,#COUNT
I        SET      AF(1+NAME)
         ERROR,3,TCOR(I,S:C)=0 INV
         DO1      TCOR(M:DO,S:FR)
         REF      M:DO
         GEN,1,31 AFA(2+NAME,1),AF(2+NAME,1)
         GEN,1,31 S:S(NUM(AF(2+NAME))>1,AFA(2+;
 NAME,1),AFA(2+NAME,2)),S:S(NUM(AF(2+NAME))>1,AF(2+NAME,1),AF(2+NAME,2))
         DATA,8   ACN(AF(1+NAME))
         GOTO     #NOP
R        DO       2
BRN      SET      SCOR(AF(2,2+R),LE,GE,EQ,Q,GT,LT,NE)
         GOTO,BRN>0  #OUTT
         FIN
#OUTT    ERROR,3,BRN=0  'UNRECOGNIZED RELATIONAL'
         GEN,1,7,7,17 AFA(2,1),S:S(R=2,50,S:S(AF(2,3)&7,18,114,82,0,50);
                  ),AF(2,2),AF(2,1)
         GEN,1,7,7,17 AFA(2,R+3),S:S(NUM(AF(2))=R+5,50,S:S(AF(2;
                  ,R+5)&7,18,114,82,0,50)),AF(2,R+4),AF(2,R+3)
         GEN,8,4,20 X'68'+BRN/4,BRN&3,0
         DATA     0
         GOTO     #NOP
#COUNT   ERROR,3,NUM(AF)=5  INOA
         DATA     AF(2),AF(3),AF(4),0
#NOP     CLOSE
         GEN,8,24 2,0
         GEN,8,24 X'68',ULOC
         DO1      NAME>0
         GEN,1,31 AFA,AF(1)
         FIN
         DO1      NAME=0
         ERROR,3,NUM(AF)>3          INOA
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:ENQ    CNAME    8,(0,2)
M:DEQ    CNAME    9,(1,3)
         PROC
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF<2
     GEN,1,7,4,3,17 S:S(PF,(,4,2,,PLOC),(AFA,4,2,AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF]=1
P        SET    S:KEYS(5,*30,TEST,NOWAIT,0,ERR,ABN)
P(2) SET P(2)|X'20000000'*((P(2)&3)>0)
R        SET      S:KEYS(7,*30,ERR,ABN)
LF(2)    GEN,8,24 NAME(1),0
         DATA     P(2)
         DO1      R(2)/2
         G        AF(R(3),2)
         DO1      R(2)&1
         G        AF(R(4),2)
         DO       NUM(P)>2
         ERROR,3,NUM(AF(P(3)))]=2  'MISSING ECB ADDRESS'
         G        AF(P(3),2)
         FIN
DMY      SET      %
R        SET      0,0
LF(3)    RES      1
I        DO       2
         DO       AFA(1,I)
         ERROR,3,R(1)=1 'ILLEGAL SNAME AFTER: ALL'
         G        AF(1,I)
         ELSE
R(I)     SET      SCOR(AF(1,I),ALL,NULL,RES)
         ERROR,3,NAME(2,I)<R(I) 'ILLEGAL QNAME/SNAME OPTION'
         DO       (I=2)&(R(1)=1)&(R(2)]=1)
         ERROR,*0  'ELEMENT CHANGED TO: ALL'
R(2)     SET      1
         FIN
         DO       R(I)=0
         TEXTC    AF(1,I)
         ELSE
         GEN,8,24 S:S(R(I),0,X'7F',X'40',X'7E'),0
         FIN
         FIN
         FIN
%NOP     SET      %-DMY-1
         ORG      DMY
         GEN,5,1,1,1,8,16  0,(SCOR(JOB,AF(1))>0),(SCOR(SHARE,AF(1))>0),;
                                   1,1,%NOP
         ORG      DMY+%NOP+1
         FIN
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:DEVICE CNAME  X'28',X'04',X'20',X'2A',X'25',X'0B',X'05',X'0B',X'05',;
 X'24',X'21',X'21',X'22',X'22',X'22',X'22',X'22',X'22',X'23',X'26',;
 X'27',X'2B'
         PROC
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17   S:S(PF=1,(,4,1,,PLOC),(AFA,4,1,AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF=0|PF=2
A SET SCOR(AF(2,1),TAB,PAGE,LINES,NLINES,SPACE,DRC,VFC,NODRC,NOVFC,;
 COUNT,FORM,FNAME,BCD,BIN,FBCD,PACK,UNPACK,SIZE,DATA,HEADER,SEQ,CORRES)
         ERROR,3,A=0     UP
LF(2)    GEN,1,7,7,17  AFA(1),NAME(A),0,AF(1)
         OPEN     CHG,FRM
   GOTO,A+1 PLOC,#TAB,PLOC,#PAR,PLOC,#PAR2,#DV,#DV,#DV,#DV,#PAR,FRM,;
                  FRM,CHG,CHG,CHG,CHG,CHG,CHG,#PAR,#HEAD,#SEQ,#CORR
#HEAD    CLOSE
         GEN      X'C0000000'
         G        AF(2,3)
         BAV      AF(2,3)
#CORR    CLOSE
         G        AF(2,2)
         GOTO     PLOC
#PAR     CLOSE
         GEN      X'80000000'
         G        AF(2,2)
         GOTO     PLOC
#PAR2    CLOSE
         GEN,2,30 2+(NUM(AF(2))>2),0
         G        AF(2,2)
         DO1      NUM(AF(2))>2
         G        AF(2,3)
         GOTO     PLOC
#DV      CLOSE
         GEN       (A<8)**4
         GOTO     PLOC
#SEQ     CLOSE
         GEN,1,31 1*NUM(AF(2))>1,0
         GOTO,NUM(AF(2))=1  PLOC
 TEXT  AF(2,2)
         GOTO     PLOC
#TAB     ERROR,1,NUM(AF)>17  INOA
         GEN,1,31 1,0
         GEN,8    NUM(AF(2))-1
I        DO       NUM(AF(2))-1
         DATA,1   AF(2,I+1)
         FIN
         BOUND    4
         GOTO     PLOC
CHG      SET      S:KEYS(7,SIZE,25,(UNPACK,PACK),FBCD,(BIN,BCD))
         DATA     CHG(2)
         DO1      CHG(2)<0
         GEN,1,31 AFA(CHG(3),2),AF(CHG(3),2)
         GOTO     PLOC
FRM      SET      S:KEYS(7,FORM,FNAME)
         DATA     FRM(2)
         DO       SCOR(AF(FRM(3),1),FORM)
         GEN,1,14,17 AFA(FRM(3),2),0,AF(FRM(3),2)
         BAV      AF(FRM(3),2)
         FIN
         DO       SCOR(AF(FRM(4),1),FNAME)
         DO       AF(FRM(4),2)='NONE'
         GEN,32   0
         ELSE
FRM      SET      S:UT(AF(FRM(4),2),'    ')
         GEN,8,8,8,8 FRM(1),FRM(2),FRM(3),FRM(4)
         FIN
         FIN
         FIN
PLOC     CLOSE    FRM,CHG
         DO1      PF=0
PLOC     USET     ULOC
         PEND
M:OPEN   CNAME
         PROC
         VKEY,1   AF
         BOUND    4
PF       SET      SCOR(CF(2),E,L)
LF(1)    DO1      PF=0|PF=1
 GEN,1,7,4,3,17   S:S(PF=1,(,4,1,,PLOC),(AFA,4,1,AF(2),AF(1)))
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF=0|PF=2
SP       SET      S:KEYS(7,25,NXTA,NOSEP,CYLINDER,ABCERR,TEST)
XM     SET     S:KEYS(7,0,DENS,EBCDIC,ASCII)
XM     SET     XM(1)>0
LF(2)    GEN,1,7,7,17       AFA(1),X'14',(SP(2)+XM)&X'7D',AF(1)
         ZAP,7    AF
         DATA     (H(2)&X'400')+((H(2)&X'3BFF')>0)*8+A(1)+S:S(XM,P(2),0)
     DO1   XM
      DATA     P(2)
I        DO       22
        GOTO,(P(2)&X'100000000'**-I)=0   #ACT
      GOTO,I>20    #NSTP
         GOTO,I<6 #G
         GOTO,(I>10)+(I=14)*(1+Z(6))+(I=17)*3 #G,#DEV,#DEVI,#NEWX
         GOTO,Z(I-5)>0 #S
#G       CLOSE
         G        AF(P(I+2),2)
         DO1      I=3|I=11|I=12
         BAV      AF(P(I+2),2)
#ACT      ELSE
#S       CLOSE
    GOTO,I=8  #SHARE
         G        Z(I-5)
         ELSE
#SHARE   CLOSE
  GEN,16,8,8  0,SCOR(AF(P(10),2),#,EXCL,SHARE),Z(3)
    ELSE
#DEV     CLOSE
 GEN,15,1,16 0,A(2),S:S(TCOR(AF(P(16),2),S:C),(A(3)+A(4)),;
  LBLS(AF(P(16),2)))
         ELSE
#DEVI    CLOSE
         G        AF(P(16),2)
         ELSE
#NEWX    CLOSE
         GEN,16,8,8 0,AF(P(19),2),Z(7)*2+AF(P(19),3)
         ELSE
#NSTP    CLOSE
         GEN,32  I=21&AF(P(23),2)=800|I=22&SCOR(AF(P(24),1),ASCII)=1
         FIN
         DO       (H(2)&X'3BFF')=0    CHECK FOR NO VLP'S
         DO       A(1)>0              CHECK FOR F10-F12 NON-ZERO
LF(3)    EQU      %
         GEN,16,16  1,0             GEN DUMMY VLP
         FIN
         ELSE
LF(3)    EQU      %
 VAR,1 (AF(H(10))),(AF(H(9))),(AF(H(8))),(AF(H(7))),(AF(H(6)));
  ,(AF(H(5))),(AF(H(4))),(AF(H(3))),(AF(H(13+(H(2)&1)))),;
   (AF(H(15))),(AF(H(16)))
         FIN
         FIN
PLOC     CLOSE
         DO1      PF=0
PLOC     USET     ULOC
         PEND
         PAGE
*      THE FOLLOWING LISTS ARE USED IN PROCESSING
*      M:DCB, M:OPEN, AND M:CLOSE
*
* P(3)     ERR                   80000000
* P(4)     ABN                   40000000
* P(5)     BUF                   20000000
* P(6)     RECL/BLKL             10000000
* P(7)     TRIES                 08000000
* P(8)     CONSEC/KEYED/RANDOM/FORMAT(ORG) 04000000
* P(9)     SEQUEN/DIRECT(ACC)    02000000
* P(10)    IN/OUT/INOUT/OUTIN(MODE)        01000000
* P(11)    # (NOT USED)          00800000
* P(12)    REL/SAVE(DISP)        00400000
* P(13)    FPARAM/LINE           00200000
* P(14)    TLABEL/LIST           00100000
* P(15)    KEYM                  00080000
* P(16)    DEVICE                00040000
* P(17)    BTD                   00020000
* P(18)    VOL                   00010000
* P(19)    NEWX                  00008000
* P(20)    SPARE/CONCAT          00004000
* P(21)    # (NOT USED)          00002000
* P(22)    RSTORE/LRECL          00001000
* P(23)    DENS                  00000800
* P(24)    ASCII/EBCDIC          00000400
* P(25)    SHARE/EXCL            00000200
*
*
* H(3)     SYNON                 00000800
* H(4)     NXTF                  00000400
* H(5)     PASS                  00000200
* H(6)     EXPIRE                00000100
* H(7)     OUTSN                 00000080
* H(8)     INSN/SN               00000040
* H(9)     WRITE                 00000020
* H(10)    READ                  00000010
* H(11)    # (NOT USED)          00000008
* H(12)    JRNL                  00000004
* H(13)    LABEL/ANSLBL          00000002
* H(14)    FILE                  00000001
* H(15)    EXECUTE               00002000
* H(16)    UNDER                 00001000
*
*
* R(3)     LINES                 80000000
* R(4)     SPACE                 40000000
* R(5)     DATA                  20000000
* R(6)     COUNT                 10000000
* R(7)     SEQ                   08000000
* R(8)     TAB                   04000000
* R(9)     HEADER                02000000
* R(10)    BIN/BCD/CYLINDER      00000200
* R(11)    # (NOT USED)          00000100
* R(12)    DRC/NODRC             00000080
* R(13)    FBCD                  00000040
* R(14)    ABCERR                00000008
* R(15)    L                     00000004
* R(16)    PACK/UNPACK/NOSEP     00000002
* R(17)    VFC/NOVFC             00000001
M:DCB    CNAME
         PROC
         VKEY,0   AF
 ERROR,3,NUM(LF)=0 'DCB NAME MISSING'
 ERROR,3,NUM(CF)>1 'ILLEGAL FORMAT'
         LOCAL    %KBUF,DMY
         ZAP,6    AF
R SET S:KEYS(6,LINES,SPACE,DATA,COUNT,SEQ,TAB,HEADER,22,;
 (BIN,BCD,CYLINDER),#,(DRC,NODRC),FBCD,28,ABCERR,;
 29,L,(PACK,UNPACK,NOSEP),(VFC,NOVFC))
SP       SET      S:KEYS(4,22,CYLINDER,30,NOSEP)
         ERROR,3,(((H(2)&1)~=1)*SP(1))~=0   PC
         ERROR,3,(R(2)**-1)&H(2)&1~=0   ;
           'PACK SPECIFIED FOR FILE'
         ERROR,3,(R(2)**-9)&H(2)&1~=0   ;
           'BIN SPECIFIED FOR FILE'
ULOC     USET     LF
DV       SET      TCOR(AF(P(16),2),S:C)
         GEN,8,16,4,4,15,S:S(DV,2,1),S:S(DV,1,16);
         ,S:S(DV,14,0) DMY-%,((R(2)|SP(2))&X'2CB'&;
          (X'CB'+(((R(2)**-9)&(H(2)&1))=0)**9));
 ,AF(P(17),2),A(1)+5*(A(1)=5),;
  Z(3),S:S(DV,A(3)**-15&1;
          ,1),S:S(DV,R(2)**-2&1,LBLS(AF(P(16),2)));
          ,S:S(DV,S:S(A(2),0,A(4)),0)                   0,1
         GEN,8,7,17    S:S(P(2)**-27&1,10,AF(P(7),2)),0,AF(P(5),2)     2
         DO1      NUM(AF)+1>P(5)
         BAV,1    AF(P(5),2)
         GEN,15,17 AF(P(6),2),AF(P(3),2)    WORD 3
         GEN,15,17 ,AF(P(4),2)      WORD 4
 GEN,2,3,1,2,16,1,3,4 Z(5),S:S(SCOR(AF(P(22),1),RSTORE),R(2)**-27&1,;
 AF(P(22),2)**-16>0),(NUM(AF(R(7)))=2)|(SCOR(AF(P(24),1),ASCII)),;
     (H(2)**-10)&1,;
   S:S(SCOR(AF(P(22),1),RSTORE),0,(AF(P(22),2)&X'FF0000')**-8),;
        (AF(P(23),2)=800),Z(1),Z(2)
      GEN,15,17,14,1,81 0,S:S((H(2)&X'3BFF')=0,LF+22),0,;
                  SCOR(AF(P(10),2),SHARE)  6,7,8,9
         GEN,15,17       AF(R(3),2),S:S((H(2)&7)=0,%KBUF)             10
         GEN,8,7,17   AF(P(18),2),0,AF(P(13),2)                       11
         DO1      NUM(AF)+1>P(13)
         BAV,1    AF(P(13),2)
  GEN,8,24,32  AF(P(15),2),S:S(A(2),A(4)),0
  GEN,15,17    S:S(SCOR(AF(P(20),1),CONCAT),AF(R(6),2)**7,;
  AF(P(20),2)**7),AF(P(14),2)
         DO1      NUM(AF)+1>P(14)
         BAV,1    AF(P(14),2)
I        DO       NUM(AF(R(8)))
T(I)     SET      S:UFV(AF(R(8),I+1))
         FIN
 GEN,S:S(I=0,(8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8),(96,15,17)) ; 15-18
 S:S(I=0,T,(,S:S(SCOR(AF(P(22),1),LRECL),,AF(P(22),2)),))
         DO       P(2)&1=1
 GEN,8,8,8,8 0,AF(P(19),2),AF(P(19),3)+((P(2)**-15)&Z(7))*2,AF(P(20),2)
         ELSE
         GEN,8,7,17   AF(R(5),2),AF(R(4),2),AF(R(9),3)                19
         FIN
         DO1      NUM(AF)+1>R(9)
         BAV,1    AF(R(9),3)
         GEN,8,7,17 AF(R(9),2),AF(R(4),3),;
 S:S(SCOR(AF(P(22),1),RSTORE,LRECL),SCOR(AF(P(8),1),RANDOM),;
 AF(P(22),2)&X'FFFF',0)
         GEN,32   AF(R(7),2)
         GOTO,(H(2)&X'3BFF')=0  DMY    NO VAR PARMS
  VAR  (AF(H(10))),(AF(H(9))),(AF(H(8))),(AF(H(7))),(AF(H(6)));
  ,(AF(H(5))),(AF(H(4))),(AF(H(3))),(AF(H(13+(H(2)&1)))),;
   (AF(H(15))),(AF(H(16)))
         GOTO,(H(2)&7)=0 DMY
%KBUF    RES      8
DMY     SET      %
         DO1      CS(%)~=CS(ULOC)
         USET     ULOC
         PEND
ZAP      CNAME
         PROC
P SET S:KEYS(CF(2),ERR,ABN,BUF,(RECL,BLKL),TRIES,;
 (CONSEC,KEYED,RANDOM,UNDEF,FORMAT,ORG),(SEQUEN,DIRECT,BLOCK,ACC),;
 (IN,OUT,INOUT,OUTIN,MODE),#,(REL,SAVE,JOB,DISP),;
 (FPARAM,LINE),(TLABEL,LIST),KEYM,DEVICE,BTD,VOL,NEWX,;
  (SPARE,CONCAT),#,(RSTORE,LRECL),(DENS),(ASCII,EBCDIC))
H SET S:KEYS(CF(2),*20,SYNON,NXTF,PASS,EXPIRE,OUTSN,;
  (INSN,SN),WRITE,READ,#,JRNL,(LABEL,ANSLBL),FILE,*18,EXECUTE,UNDER)
Z SET S:S(SCOR(AF(P(8),1),FORMAT),SCOR(AF(P(8),1),CONSEC,KEYED,RANDOM,;
 UNDEF),SCOR(AF(P(8),2),F,D,V,U)),SCOR(AF(P(9),1),;
 SEQUEN,DIRECT,BLOCK),S:S((H(2)&X'800')=0,4,SCOR(AF(P(10),1),IN,OUT,;
  #,INOUT,#,#,#,OUTIN)),0,SCOR(AF(P(12),1),REL,SAVE,JOB),;
         AFA(P(16),2),NUM(AF(P(19)))~=3
         DO1     (P(2)&X'800')>0
  ERROR,3,AF(P(23),2)~=800&AF(P(23),2)~=1600  'ILLEGAL DENSITY'
A        SET      H(2)&7|(P(2)&X'40000')**-15
         ERROR,3,0=S:S(A,1,1,1,0,1,0,0,0,1,1,1) PC
         GOTO,A<8   #AOK
A SET SCOR(AF(P(16),2),TY,PR,PP,CR,CP,LP,DC,9T,7T,MT,DP,CM;
          ,C,OC,LO,LL,DO,PO,BO,LI,SI,BI,SL,SO,CI,CO,AL,EI,EO)
   ERROR,3,A]=0 'DEV. TYPE, OP LABEL NOT IN QUOTES'
 ERROR,3,TCOR(AF(P(16),2),S:C)+A+AFA(P(16),2)=0 'UNDEFINED OP LABEL'
 ERROR,3,((A<8|A>10)*(H(2)&2)|(A~=7&A~=11&A~=12)*(H(2)&1))*A~=0 ;
                  'IMPROPER DEVICE TYPE'
A        SET      ((H(2)&3)+(((H(2)&3)=0)*3)),;
  A>0,(A>0&A<13)**15,S:S((A>0)+(A>12),0,A**8,A-12)
#AOK     CLOSE
A(1)     SET      S:S(SCOR(AF(H(13),1),ANSLBL),A(1),5)
R        SET      S:KEYS(CF(2),ASN)
A(1)     SET      S:S(R(1),A(1),SCOR(AF(R(3),2),FILE,LABEL,;
                  DEVICE,JRNL,ANSLBL))
    GOTO,(P(2)&X'01000000')+(H(2)&X'00000800')~=X'800'  #POK
P(2)     SET      P(2)|X'01000000'           SYNON AND NO IN,OUT,ETC
#POK     PEND
         OPEN     I,J,S
VAR      CNAME    0                 FOR M:OPEN, M:DCB
CVAR     CNAME    1                 FOR M:CLOSE
         PROC
         GOTO,(H(2)&7)=0 #NOP
ITEM     SET      %                 NAME/ACCT#
LTEMP    SET      LNUM(AF(9))
X        SET      S:NUMC(AF(9,2))
X        SET      (X+3+(X>0))/4
 GEN,8,8,8,8 X'01',,X,S:S((X+LTEMP)<0,MAX(LTEMP,X),8)
         DO1      X>0
         TEXTC    AF(9,2)
         ORG      ITEM+1+S:S((X+LTEMP)<0,MAX(LTEMP,X),8)
*        GOTO,(NUM(AF(9,3))=0)*(CF(2)>0) #NOP     FOR NOW ALWAYS GEN 02
         GOTO,NAME  #NOP            NO ACCN FOR M:CLOSE
ITEM     SET      %
         GEN,8,8,8,8 2,,(TCOR(S:C,AF(9,3)))*2,2
         DO       S:NUMC(AF(9,3))>0
         TEXT     ACN(AF(9,3))
         ELSE
         RES      2
         FIN
#NOP     GOTO,(H(2)&X'200')=0 #NOP
ITEM     SET      %
         GEN,8,8,8,8 3,,(NUM(AF(6,2))>0)*2,2
         DO       NUM(AF(6,2))>0
         TEXT     ACN(AF(6,2))
         ELSE
         RES      2
         FIN
#NOP     CLOSE
I        DO       4                 READ,WRITE,INSN,OUTSN
 GOTO,I*((H(2)&8**I)>0)  #5,#6,#7,#8
         ELSE
#5,#6    CLOSE
ITEM     SET      %
LTEMP    SET      LNUM(AF(I))
X        SET      NUM(AF(I))-1-(LTEMP>=0)
 GEN,8,8,8,8 I+4,,X*2,S:S(NUM(AF(I))=1,MAX(LTEMP,X*2),16)
         GOTO,X=0 J
 DATA,8 S:S(SCOR(AF(I,2),NONE,ALL),ACN(AF(I,2)),ACN('NONE'),ACN('ALL'))
J        DO       X-1
         DATA,8   ACN(AF(I,J+2))
         FIN
         ORG      ITEM+1+S:S(NUM(AF(I))=1,MAX(LTEMP,X*2),16)
         ELSE
#7,#8    CLOSE
ITEM     SET      %
LTEMP    SET      LNUM(AF(I))
X        SET      NUM(AF(I))-1-(LTEMP>=0)
 GEN,8,8,8,8 I+4,,X,S:S(NUM(AF(I))=1,MAX(LTEMP,X),3)
J        DO       X
 DATA,4 S:S(S:NUMC(AF(I,J+1))=6,S#(AF(I,J+1)),SXP(AF(I,J+1)))
         FIN
         ORG      ITEM+1+S:S(NUM(AF(I))=1,MAX(LTEMP,X),3)
         FIN
         GOTO,(H(2)&X'100')=0     #NOP
ITEM     SET      %
         GEN,8,8,8,8 4,,2*(NUM(AF(5))>1),2
         DO       S:S(SCOR(AF(5,2),NEVER),AF(5,2)='NEVER',1)
         TEXT     'NEVER'
         ELSE
         DO       NUM(AF(5))=2
A        SET      S:UFV(AF(5,2))
         ERROR,2,A>999 'MAX RETENTION PERIOD=999 DAYS'
 GEN,8,8,8,8,8,8,8,8 ' ',A/100+X'F0',A/10-A/100*10+X'F0',;
 A-A/10*10+X'F0','0','0',' ',' '
         ELSE
         DO       NUM(AF(5))=4
A        SET      0,S:UFV(AF(5,2)),S:UFV(AF(5,3)),S:UFV(AF(5,4))
 GEN,8,8,8,8,8,8,8,8 A(2)/10+X'F0',A(2)-A(2)/10*10+X'F0',A(3)/10+X'F0',;
 A(3)-A(3)/10*10+X'F0','0','0',A(4)/10+X'F0',A(4)-A(4)/10*10+X'F0'
         ELSE
         RES      2
         FIN
         FIN
         FIN
#NOP     GOTO,(H(2)&X'800')=0     #NOP
S        SET      S:NUMC(AF(8,2))
ITEM     SET      %
         GEN,8,8,8,8 X'0B',,(S+3+(S>0))/4,S:S(S>0,8,(S+4)/4)
         DO       S>0
         TEXTC    AF(8,2)
         ELSE
         RES      8
         FIN
#NOP     GOTO,(H(2)&X'2000')=0  #NOP     NO EXEC ACCTS
ITEM     SET      %
LTEMP    SET      LNUM(AF(10))
X        SET      NUM(AF(10))-1-(LTEMP>=0)
 GEN,8,8,8,8 X'14',,X*2,S:S(NUM(AF(10))=1,MAX(LTEMP,X*2),16)
         GOTO,X=0 J
 DATA,8 S:S(SCOR(AF(10,2),NONE,ALL),ACN(AF(10,2)),ACN('NONE'),;
                  ACN('ALL'))
J        DO       X-1
         DATA,8   ACN(AF(10,J+2))
         FIN
         ORG      ITEM+1+S:S(NUM(AF(10))=1,MAX(LTEMP,X*2),16)
#NOP     GOTO,(H(2)&X'1000')=0 #NOP NO UNDER NAMES
ITEM     SET      %
LTEMP    SET      LNUM(AF(11))
X        SET      NUM(AF(11))-1-(LTEMP>=0)
 GEN,8,8,8,8 X'15',,X*3,S:S(NUM(AF(11))=1,MAX(LTEMP,X*3),3)
J        DO       X
I        SET      %
         TEXTC    AF(11,J+1)
         ORG      I+3
         FIN
         ORG      ITEM+1+S:S(NUM(AF(11))=1,MAX(LTEMP,X*3),3)
#NOP     GOTO,H(1)=0  #NOP
%NOP     SET      %
         ORG      ITEM
         RES,1    1
         DATA,1   1                     MARK LAST ITEM
         ORG      %NOP
#NOP     PEND
VKEY     CNAME
         PROC
W        SET      CF(2)
I        DO       NUM(AF)-CF(2)
W        SET      W+1
X SET SCOR(AF(W,1),TEST,NXTA,LINE,ORG,MODE,ACC,DISP,;
 DEVICE,FILE,LABEL,CONSEC,KEYED,RANDOM,IN,SEQUEN,DIRECT,OUT,;
 INOUT,OUTIN,REL,SAVE,JOB,PASS,EXPIRE,READ,WRITE,SN,RECL,;
 TRIES,KEYM,TLABEL,BUF,ERR,ABN,RSTORE,BTD,VOL,NXTF,FPARAM,SYNON,NOSEP,;
 CYLINDER,NEWX,SPARE,INSN,OUTSN,ANSLBL,BLKL,LRECL,CONCAT,ABCERR,JRNL,;
  LIST,ASN,;
 FORMAT,DENS,EBCDIC,ASCII,BLOCK,UNDEF,EXECUTE,UNDER,; REST ARE M:DCB ONLY
 COUNT,DATA,SEQ,LINES,SPACE,TAB,HEADER,VFC,NOVFC,DRC,NODRC,;
 BCD,BIN,FBCD,NOFBCD,PACK,UNPACK,L)
         DO1      ((CF(2)=0)&(X<8))|((CF(2)=1)&((X=0)|(X>62)))
         ERROR,3  S:PT(UP,'  AF(',TXT(W),')')
         FIN
         PEND
M:PURGE  CNAME
         PROC
         LOCAL    UCPURGE,CALN,J
         BOUND    4
P        SET      S:KEYS(6,30,WRITE,READ)
UCPURGE  SET      P(1)=NUM(AF)        =1 IF NO DCB SPECIFIED(M:UC)
CALN     SET      UCPURGE+7
PF       SET      SCOR(CF(2),E,L)
LF(1)    EQU      %
         DO       PF=0|PF=1
         GEN,1,7,4,3,17 S:S(PF=1,(0,4,CALN,0,PLOC),;
                                 (AFA,4,CALN,AF(2),AF(1)))
         FIN
         DO1      PF=0
ULOC     USET     PLOC
         DO       PF=0|PF=2
         DO       UCPURGE
LF(2)    GEN,8,4,20 6,7,P(2)
         ELSE
J        SET      NUM(AF)
         ERROR,3,(J=0)|(J>2)  INOA
LF(2)    G,3      AF(1)
         DO1      (P(2)&2)>0
P(2)     SET      -1
         DATA     P(2)
         FIN
         FIN
         DO1      PF=0
PLOC     USET     ULOC
         PEND
         CLOSE    I,J,S
         CLOSE    SXP,ACN,S#,LBLS
 CLOSE PLOC,ULOC,PT0,PT1,CCS,CS%,IBPRA,UP,INOA,PC,IVAL,INV,;
 A,G,H,I,M,P,Q,R,S,T,W,X,Z,CAL1,S:S,BAV,TXT,LNUM,LTEMP,MAX,;
 DMY,CVAR,ATF,IF,COMMON,BRN,%NOP,ZAP,VAR,ITEM,DV,SP,PF,VKEY,;
 XM,#,%DEC,COCOPT,USET
         END
