 OPEN PLOC,ULOC,UP,INOA,CAL1,Z,OUTT,FLAG,G,S:S,FLAG%VAR,DMY,;
 FLAG%TXT,FLAG%CK,Q,I,A,%RES,ATF,IF,P,COMMON,CRW,;
 R,BRN,%COUNT,%NOP,HEADES,CORRESS,PARA,DVS,SEQS,TABS,CHG,M,;
 ZAP,#POK,VAR,ITEM,#NOP,VARP,NOVAR,TXT,#T,#PEND,;
 #C1,#C2,#C3,IBPRA,BAV,PC,DV,ZZ,SP,#,CS%,CCS,PT0,PT1,W,X,VKEY,;
 #DEC,TXTV,#S,IVAL,FRM,T,ANOP,COMMENT,H,XM
         OPEN     LISTLOC,INV,F:#KEYS
         DISP     X'C00'
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'
#DEC     EQU      '1','2','3','4','5','6','7','8','9'
CAL1     S:SIN,0  4
ULOC     SET      %
CCS      SET      1
PT0      CSECT
PLOC,CS%(1)  SET %
PT1      CSECT    1
CS%(2)   SET      %
         CSECT    1
LISTLOC  SET      %
         ORG      ULOC
         OPEN     USECT
USECT    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
         WHILE    S:NUMC(S)<NAME
S        SET      S,' '
         FIN
         PEND     S:PT(S)
         CLOSE    S
ANOP     CNAME
         PROC
         PEND
FLAG     FNAME
         PROC
AF(1)    SET      1
         PEND     AF(2)
G        CNAME
         PROC
         BOUND    4
LF       GEN,1,7,4,3,17 AFA(1),CF(2),CF(3),AF(2),AF(1)
         PEND
S:S      FNAME
         PROC
         PEND     AF(AF(1)+2)
FLAG%VAR,FLAG%TXT,FLAG%CK     SET  0
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,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
TXT      FNAME
         PROC
         DO       AF(1)=0
TXTV     SET      S:PT('0')
         ELSE
TXTV     SET      S:PT(#DEC(AF(1)))
         FIN
         PEND     TXTV
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     USECT    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     USECT    ULOC
         PEND
M:CAC    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     USECT    PLOC
         DO1      PF=0|PF=2
LF(2)    GEN,8,1,5,2,16 X'06',1,0,AF&3,0
         DO1      PF=0
PLOC     USECT    ULOC
         PEND
M:TS     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     USECT    PLOC
         DO1      PF=0|PF=2
LF(2)    DATA     X'06400000'
         DO1      PF=0
PLOC     USECT    ULOC
         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     USECT    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     USECT    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     USECT    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,(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     USECT    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     USECT    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     USECT    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,P,ENDL,#NOP,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     USECT    PLOC
         DO       (PF=0)|(PF=2)
V        SET
I        DO       NUM(AF)
P        SET      SCOR(AF(I,1),EVENTS,TIME,ECB,ECBL)
 COMMENT,P=0      'UNRECOGNIZED KEY IN AF(',I,')'
         GOTO,P=0 ENDL
V(P,NUM(V(P))+1)  SET I
ENDL     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
 COMMENT,NUM(V(1))>1 'MULTIPLE SPECIFICATION OF EVENTS - ',;
                     'LAST SPECIFICATION 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
 COMMENT,NUM(V(2))>1 'MULTIPLE SPECIFICATION OF TIME - ',;
                     'LAST SPECIFICATION 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,1   ENDL
#NOP     COMMENT,1 'ECB OR ECBL MUST BE PRESENT'
ENDL     FIN
         DO1      PF=0
PLOC     USECT    ULOC
         PEND
         CLOSE    V,I,P,ENDL,#NOP,J
         OPEN     TXT%STNG,VAL,L,DIV,BYT,TXT
TXT%STNG SET '0','1','2','3','4','5','6','7',;
             '8','9','A','B','C','D','E','F'
COMMENT  CNAME
         PROC
**********************************************************************
**
*  COMMENT MESSAGE PROCEDURE. PERFORMS THE TASK OF OUTPUTTING
*  ASSEMBLY-TIME MESSAGES AND CONVERTING NUMBERS INTO THE TEXT.
*  A NUMBER PRECEDED BY AN ASTERISK IS CONVERTED BASE 16 - ELSE BASE 10.
* FORMAT:
* (LF)   COMMENT,COND  'TEXT...',#,'MORE TEXT...',*#,...
* WHERE
*        COND.    IS A CONDITIONAL FLAG: IF >0 COMMENT IS PRESENT;
*                                        IF <0 COMMENT IS SUPPRESSED
**
**********************************************************************
TXT      SET
I        DO       NUM(AF)
* BRANCH TO NMBR IF A NUMBER , OR CHAR%STRNG IF TEXT
         GOTO,TCOR(AF(I),S:INT,S:C) NMBR,CHAR%STRNG
         ERROR,1,1 'ILLEGAL USE OF COMMENT PROCEDURE ****'
         GOTO,1   PROC%END
* PROCESS NUMERIC INPUT:
NMBR     BOUND    1
DIV      SET      10+(6*AFA(I))     *BASE 10 OR 16
VAL      SET      AF(I)             * GET NUMBER VALUE.
         DO       VAL<0             * IF NUMBER IS NEGATIVE:
TXT(NUM(TXT)+1) SET '-'             * ADD MINUS SIGN
VAL      SET      -VAL              * GET POSITIVE NUMBER
         FIN
         DO1      VAL=0             * IF THE NUMBER IS ZERO:
TXT(NUM(TXT)+1) SET '0'             * ADD ZERO TO TEXT.
         GOTO,VAL=0 FIN
BYT      SET                        * INIT. DIGIT STRING.
         WHILE    VAL>0             * LOOP GETTING LOW DIGIT,
BYT(NUM(BYT)+1) SET VAL-((VAL/DIV)*DIV)
VAL      SET      VAL/DIV
         FIN
L        DO       NUM(BYT)          * ADD TO TXT IN REVERSE ORDER
TXT(NUM(TXT)+1) SET TXT%STNG(BYT(NUM(BYT)-L+1)+1)
         FIN
         GOTO,1   FIN
* PROCESS TEXT STRING ENTRY
CHAR%STRNG BOUND 1
TXT(NUM(TXT)+1) SET AF(I)
FIN      FIN
         ERROR,0,CF(2) S:PT(TXT)
PROC%END PEND
         CLOSE    TXT%STNG,VAL,L,DIV,BYT,TXT
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     USECT    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     USECT    ULOC
         PEND
M:LDTRC  CNAME    FLAG(FLAG%TXT,3)
M:LINK   CNAME    FLAG(FLAG%TXT,2)
         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     USECT    PLOC
         DO       PF=0|PF=2
LF(2)    GEN,8,22,1,1 NAME,,NUM(AF(2))>0,NUM(AF(3))>0
         TEXTC    AF(1)
         DO1      NUM(AF(2))>0
         TEXT     ACN(AF(2))
         DO1      NUM(AF(3))>0
         TEXT     ACN(AF(3))
         FIN
         DO1      PF=0
PLOC     USECT    ULOC
         PEND
M:ABSLOAD CNAME   FLAG(FLAG%TXT,11)
M:DCAL   CNAME    FLAG(FLAG%TXT,5)
M:SBACK  CNAME    FLAG(FLAG%TXT,9)
         PROC
LF(1)    CAL1,5   PLOC
ULOC     USECT    PLOC
LF(2)    GEN,8,6,18 NAME,0,S:S(TCOR(AF(1,2),S:C),AF(1,2),;
                  X'20000'+LBLS(AF(1,2)))
         ERROR,3,NUM(AF)=0  INOA
         DO1      NAME=11
         TEXT     AF(2)
PLOC     USECT    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     USECT    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     USECT    ULOC
         PEND
M:SAVE   CNAME    0
M:RESTORE CNAME   1
         PROC
         ERROR,4,NUM(AF)>1    INOA
LF(1)    CAL1,10  PLOC
ULOC     USECT    PLOC
I        DO       NUM(AF)
         ERROR,4,SCOR(AF(I,1),INT)=0      UP
LF(2)    GEN,8,24 NAME(1),AF(I,2)
         ERROR,4,((AF(I,2)<X'60')=(AF(I,2)>X'5A'))=((AF(I,2)>X'13F');
                  =(AF(I,2)<X'58'))     'ILLEGAL INTERRUPT ADDRESS'
         FIN
PLOC     USECT    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     USECT    PLOC
         DO1      PF=0|PF=2
LF(2)    G,NAME(1) AF(1)
         DO1      PF=0
PLOC     USECT    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     USECT    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     USECT    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     USECT    PLOC
         DO       PF=0|PF=2
LF(2)    G,NAME(1)
P        SET S:KEYS(3,#,DEV,#,3,OUT,*3,IN,LINES,COUNT,SPACE,JDE,;
         COPIES,SEQ,FPC,FORM,FFORM,#,#,#,16,NOVFC,*16,VFC,25,DELETE,;
         AREL,(ASAVE,AINIT),#,#,DIRECT,DRC)
         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       16
 DO1 ((P(2)&X'80000000'**-I)~=0)&(X'80000000'**-I&X'10588000')=0
         GEN,1,31 AFA(P(I+3),2),AF(P(I+3),2)
         DO       ((P(2)&X'80000000'**-I)&X'00180000')~=0
#S       SET      S:UT(AF(P(I+3),2),'    ')
         GEN,8,8,8,8 #S(1),#S(2),#S(3),#S(4)
         FIN
         ERROR,3,((P(2)&X'08000000')~=0)&(I=4)&((AF(P(I+3),2))>32767) ;
         IVAL
         ERROR,3,((P(2)&X'02000000')~=0)&(I=6)&((AF(P(I+3),2))>15) IVAL
         ERROR,3,((P(2)&X'00800000')~=0)&(I=8)&((AF(P(I+3),2))>255) IVAL
         DO       ((P(2)&X'80000000'**-I)&X'00400000')~=0
         DO       AF(P(I+3),2)=0
         GEN,32   0
         ELSE
#S       SET      S:UT(AF(P(I+3),2),'    ')
         GEN,8,8,8,8 #S(1),#S(2),#S(3),#S(4)
         FIN
         FIN
         DO       ((P(2)&X'80000000'**-I)&X'10008000')~=0
         DO       SCOR(AF(P(I+3),1),IN,VFC)~=0
         GEN,32   0
         ELSE
         GEN,32   1
         FIN
         FIN
         FIN
         FIN
         DO1      PF=0
PLOC     USECT    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:RBACK  CNAME    10,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     USECT      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     USECT      ULOC
         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     USECT    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
         G        AF(P(I+2),2)
         DO1      SCOR(AF(P(I+2),1),BUF)
         BAV      AF(P(I+2),2)
         FIN
         FIN
         DO1      PF=0
PLOC     USECT    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)
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,INT,WFPT,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,INT,WFPT,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
         OPEN     V,I,P
M:QUEUE  CNAME
         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,7,,PLOC),(AFA,4,7,AF(2),AF(1)))
         DO1      PF=0
ULOC     USECT    PLOC
         DO       PF=0|PF=2
V        SET      SCOR(AF(2),UNLOCK,DEFINELIST,PUT,GET,STATS,PURGE,LOCK)
         ERROR,3,V=0|NUM(AF(2))>1  UP
         GOTO,V   V,DEFINELIST,PUT,GET,STATS,PURGE,LOCK
V        SET      1
P  SET  S:KEYS(1,0,(#,UNLOCK),*0,ECB,QPAGES,KEYMAX,QSAT,24,RECOVER,;
                  (NEW,OLD),BACKUP,WAIT)
         GOTO     FIN
DEFINELIST  CLOSE
P  SET  S:KEYS(1,0,(#,DEFINELIST),*0,ECB,*LSIZE,27,WAIT)
         GOTO     FIN
PUT      CLOSE
P  SET  S:KEYS(1,0,(#,PUT),*0,ECB,*LSIZE,26,(HIGH,LOW),WAIT)
         GOTO     FIN
GET      CLOSE
P  SET  S:KEYS(1,0,(#,GET),*0,ECB,INDEX,*BUF,*BSIZE,27,WAIT)
         GOTO     FIN
STATS    CLOSE
P  SET  S:KEYS(1,0,(#,STATS),*0,ECB,LSIZE,BUF,BSIZE,26,COUNT,WAIT)
         GOTO     FIN
PURGE    CLOSE
P  SET  S:KEYS(1,0,(#,PURGE),*0,ECB,27,WAIT)
         GOTO     FIN
LOCK     CLOSE
P  SET  S:KEYS(1,0,(#,LOCK),*0,ECB,23,PAUSE,27,WAIT)
FIN      CLOSE
LF(2)    GEN,1,7,7,17,32 AFA(1),V+5,0,AF(1),P(2)
I        DO       NUM(P)-2
         G        AF(P(I+2),2)
         DO1      SCOR(AF(P(I+2),1),BUF)
         BAV      AF(P(I+2),2)
         FIN
         FIN
         DO1      PF=0
PLOC     USECT    ULOC
         PEND
         CLOSE    V,I,P
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     USECT    PLOC
         DO1      PF=0|PF=2
LF(2)    GEN,1,7,24   AFA,NAME,AF(1)
         DO1      PF=0
PLOC     USECT    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     USECT    PLOC
         DO       PF=0|PF=2
P        SET      S:KEYS(3,(REL,SAVE),LABEL,24,PTV,26,REM,PTL)
A        SET      SCOR(AF(P(3),1),REL,SAVE)
LF(2)    GEN,1,7,7,17,32 AFA,NAME(1),0,AF(1),P(2)
         GOTO,A+1 #C3,#C2,#C2
#C2      BOUND    1
         DATA     A
#C3      BOUND    1
         GOTO,NUM(AF)+1=P(4) #C1
         GEN,1,14,17 AFA(P(4),2),0,AF(P(4),2)
#C1      ERROR,7,TCOR(AF(1),S:RAD,S:EXT,S:FR)+AFA=0 'DCB MISSING'
         FIN
         DO1      PF=0
PLOC     USECT    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     USECT      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     USECT      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     USECT      PLOC
         DO1      PF=0|PF=2
LF(2)    G,NAME     P(2)/2+2*((P(2)&7)=0)
         DO1      PF=0
PLOC     USECT      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     USECT    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     USECT    ULOC
         PEND
         OPEN     P,V,Q,B,D
M:TRIGGER CNAME   0                 .
M:DISABLE CNAME   1                 .
M:ENABLE  CNAME   2                 .
M:DISARM  CNAME   3                 .
M:ARM     CNAME   4                 .
M:CAL    CNAME    6
         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)))
         DO1      PF=0
ULOC     USECT    PLOC
         DO       PF=0|PF=2
P SET S:KEYS(3,START,(DIRECT,RP),*24,(MASTER,AI),25,DM,AM,C,IO,E)
V SET (P(2)||X'80'*(NAME<6))&X'FFFFFFFF'
Q SET ((P(2)&X'40000000'=X'40000000')*(NUM(AF(P(4)))=2)||1)**-30
B SET SCOR(DISABLE,AF(1,3),AF(1,4))
D        SET      S:S(B,NUM(AF(1)),2+2*(NUM(AF(1))=4),3)
LF(2) GEN,8,4,20 NAME,SCOR(AF(1,1),INT),S:S(TCOR(AF(1,2),S:C),AF(1,2),;
                  X'20000'+LBLS(AF(1,2)))
 GEN,32*(NAME>2),V**-31,31*V**-31,32*(V**-30&1),32*(D>2) (V||Q)|V**-30;
 *(NAME<6)&1|(B>0)*2|(D>2)**29,AFA(P(3),2),AF(P(3),2),AF(P(4),2),AF(1,D)
         FIN
         DO1      PF=0
PLOC     USECT    ULOC
         PEND
         CLOSE    P,V,Q,B,D
M:CHKPT   CNAME   FLAG((FLAG%CK,FLAG%TXT),0)
M:RESTART CNAME   FLAG((FLAG%CK,FLAG%TXT),1)
         DO1      FLAG%CK
         REF      M:CK
         PROC
LF(1)    CAL1,4   PLOC
ULOC     USECT    PLOC
P        SET      S:KEYS(3,LOC,31,IN)
LF(2)    G,NAME   AF(P(3),2),P(2)&1
         TEXTC    AF(1)
PLOC     USECT    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     USECT    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     USECT    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     USECT    PLOC
         DO       PF=0|PF=2
LF(2)    GEN,8,24 NAME,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     BOUND    1
         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)>2  INOA
         DO1      PF=0
PLOC     USECT    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     USECT    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)
   GOTO,A+1 PLOC,TABS,PLOC,PARA,PLOC,PARA,DVS,DVS,DVS,DVS,PARA,FRM,;
                  FRM,CHG,CHG,CHG,CHG,CHG,CHG,PARA,HEADES,SEQS,CORRESS
HEADES BOUND 1
         GEN,2,30,1,31        3,0,AFA(2,3),AF(2,3)
         BAV      AF(2,3)
         DATA     AF(2,2)
         GOTO     PLOC
CORRESS   BOUND    1
         GEN,1,14,17   AFA(2,2),0,AF(2,2)
         GOTO     PLOC
PARA     BOUND    1
         DATA     X'80000000'
         GEN,1,14,17 AFA(2,2),0,AF(2,2)
         DO1      SCOR(AF(2,1),FORM)
         BAV      AF(2,2)
         GOTO     PLOC
DVS      BOUND    1
         GEN       (A<8)**4
         GOTO     PLOC
SEQS     BOUND    1
         GEN,1,31 1*NUM(AF(2))>1,0
         GOTO,NUM(AF(2))=1  PLOC
 TEXT  AF(2,2)
         GOTO     PLOC
TABS     ERROR,1,((NUM(AF(2))>17)&1=1)  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     ANOP
         DO1      PF=0
PLOC     USECT    ULOC
         PEND
M:OPEN   CNAME    FLAG(FLAG%VAR,0)
         OPEN     #S,#ACT,#DEV,#DEVI,#SHARE
         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     USECT    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'FF8')+S:S(SCOR(AF(H(13),1),ANSLBL),H(2)&3,5));
         +S:S(XM,P(2),0)
     DO1   XM
      DATA     P(2)
I        DO       22
        GOTO,(P(2)&X'100000000'**-I)=0   #ACT
         GOTO,I>5&I<11|(I=14)*(2+Z(6))|(I=17)*4 #S,#DEV,#DEVI,#NEWX
      GOTO,I>20    #NSTP
         G        AF(P(I+2),2)
         DO1      I=3|I=11|I=12
         BAV      AF(P(I+2),2)
#ACT      ELSE
#S       CLOSE    #S,#ACT
    GOTO,I=8  #SHARE
         G        Z(I-5)
         ELSE
#SHARE  CLOSE  #SHARE
  GEN,16,8,8  0,SCOR(AF(P(10),2),#,EXCL,SHARE),Z(3)
    ELSE
#DEV     CLOSE    #DEV
 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    #DEVI
         G        AF(P(16),2)
         ELSE
#NEWX    CLOSE    #NEWX
         GEN,16,8,8 0,AF(P(19),2),Z(7)*2+AF(P(19),3)
         ELSE
#NSTP   CLOSE       #NSTP
         GEN,32  I=21&AF(P(23),2)=800|I=22&SCOR(AF(P(24),1),ASCII)=1
         FIN
         GOTO,(H(2)&X'BFF')=0 PLOC       NO VAR PARAMS
LF(3)    EQU      %
 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))))
         FIN
PLOC     ANOP
         DO1      PF=0
PLOC     USECT    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     USECT    PLOC
         DO       PF]=1
         DO       NAME(1)=8
P        SET    S:KEYS(1,*2,(TEST,NOWAIT),30,TEST,(NOWAIT,WAIT),ERR,ABN)
I        SET      S:KEYS(5,*0,WAIT,1,(WAIT,TEST))
        ERROR,*0,(NUM(I)=3)&(NUM(AF(I(3)))>1) 'ITEM IGNORED AFTER: WAIT'
I        SET      5
         ELSE
I,P      SET      1
         FIN
R        SET      S:KEYS(I,*0,ERR,ABN)
LF(2)    GEN,8,24 NAME(1),0
         DATA     R(2)[P(2)
I        DO       NUM(R)-2
         ERROR,3,NUM(AF(R(I+2)))]=2 'MISSING ERR/ABN ADDRESS'
         G        AF(R(I+2),2)
         FIN
         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
         DO       NAME(1)=8
         DO       NUM(AF(1))>3
SP       SET F#KEYS((5,(JOB,STEP),(SHARE,EXCL),32,),AF(1,3),AF(1,4))
         ELSE
SP       SET      F#KEYS((5,(JOB,STEP),(SHARE,EXCL),32,),AF(1,3))
         FIN
         ELSE
SP       SET      F#KEYS((5,(JOB,STEP),32,),AF(1,3))
         FIN
         DATA     X'101'**16+SP(2)+#NOP
         ORG      DMY+#NOP+1
         FIN
         DO1      PF=0
PLOC     USECT    ULOC
         PEND
F#KEYS   FNAME
         PROC
         PEND     S:KEYS(1,AF(1))
M:DCB    CNAME    FLAG(FLAG%VAR,0)
         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     USECT      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),S:S(SCOR(AF(H(13),1),ANSLBL),A(1),X'A'),;
  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'BFF')=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),;
  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      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'BFF')=0    DMY       NO VAR PARAMS
  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))))
         GOTO,(H(2)&7)=0 DMY
%KBUF    RES      8
DMY     SET      %
         DO1      CS(%)~=CS(ULOC)
         USECT    ULOC
         PEND
ZAP      CNAME
         PROC
P SET S:KEYS(CF(2),ERR,ABN,BUF,(RECL,BLKL),TRIES,;
 (CONSEC,KEYED,RANDOM,FORMAT),(SEQUEN,DIRECT),(IN,OUT,INOUT,OUTIN),;
 #,(REL,SAVE),(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)
Z SET S:S(SCOR(AF(P(8),1),FORMAT),SCOR(AF(P(8),1),CONSEC,KEYED,RANDOM),;
 SCOR(AF(P(8),2),F,D,V,U)),SCOR(AF(P(9),1),;
         SEQUEN,DIRECT),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),;
         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'
   ERROR,3,(SCOR(AF(P(10),2),SHARE,EXCL))*(SCOR(AF(P(10),1),OUT,OUTIN);
           |((H(2)&1)=0))  'INVALID USE OF SHARE/EXCL'
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    #AOK
    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
         PROC
         GOTO,(H(2)&7)=0 #NOP
S        SET      S:NUMC(AF(9,2))
ITEM     SET      %
         GEN,8,8,8,8 1,,(S+3+(S>0))/4,S:S(S>0,8,(S+4)/4)
         DO       S>0
         TEXTC    AF(9,2)
         ELSE
         RES      8
         FIN
ITEM     SET      %
         GEN,8,8,8,8 2,,(NUM(AF(9,3))>0)*2,2
         DO       NUM(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     OPEN     F5,F6,F7,F8
I        DO       4                 READ,WRITE,INSN,OUTSN
 GOTO,I*((H(2)&8**I)>0) F8,F7,F6,F5
         ELSE
F8,F7    CLOSE    F8,F7
ITEM     SET      %
 GEN,8,8,8,8 I+4,,(NUM(AF(I))-1)*2,S:S(NUM(AF(I))=1,(NUM(AF(I))-1)*2,16)
         DO1      NUM(AF(I))>1
  DATA,8 S:S(SCOR(AF(I,2),NONE,ALL),ACN(AF(I,2)),ACN('NONE'),ACN('ALL'))
J        DO       NUM(AF(I))-2
         DATA,8   ACN(AF(I,J+2))
         FIN
         ORG      ITEM+1+S:S(NUM(AF(I))=1,(NUM(AF(I))-1)*2,16)
         ELSE
F6,F5    CLOSE    F6,F5
ITEM     SET      %
 GEN,8,8,8,8 I+4,,S:S(TCOR(AF(I,2),S:C),0,NUM(AF(I))-1),;
 S:S(TCOR(AF(I,2),S:C),S:S(NUM(AF(I))=1,AF(I,2),3),NUM(AF(I))-1)
J        DO       (NUM(AF(I))-1)*TCOR(AF(I,2),S:C)
         DATA     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(TCOR(AF(I,2),S:C),S:S(NUM(AF(I))=1,;
  AF(I,2),3),NUM(AF(I))-1)
         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      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,AF(5,2),AF(5,3),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     SET      %
         ORG      ITEM
         RES,1    1
         DATA,1   1                     MARK LAST ITEM
         ORG      #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,DEVICE,FILE,LABEL,;
 CONSEC,KEYED,RANDOM,IN,;
 SEQUEN,DIRECT,OUT,INOUT,OUTIN,REL,SAVE,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,;
  FORMAT,DENS,EBCDIC,ASCII,; 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<4))|((CF(2)=1)&((X=0)|(X>52)))
         ERROR,3  S:PT(UP,'  AF(',TXT(W/10),TXT(W-W/10*10),')')
         FIN
         PEND
         PAGE
*
****************
*
M:GETLINE CNAME   X'00',7
M:RLSLINE CNAME   X'01',7
M:BUFSTAT CNAME   X'02',7
M:PURGE   CNAME   X'03',7
M:MDFLST CNAME    X'04',7
         PROC
         LOCAL    I,J,K,L,ADR,CONT
         BOUND    4
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,NAME(2),0,PLOC),;
                        (AFA,4,NAME(2),AF(2),AF(1)))
         FIN
         DO1      PF=0
ULOC     USECT    PLOC
         DO       PF=0|PF=2
J        SET      NUM(AF)
K        SET      5&NAME(1)
         ERROR,3,(J=0)|((J~=1)&(K=0))|((J>2)&(K~=4)) INOA
LF(2)    G,NAME(1) AF(1)
         DO       NAME(1)=4
P        SET      S:KEYS(3,*1,REPL,*23,HALT,CLS,OPN,PSL,;
                              SEL,POL,INDX,EXCL,INCL)
K        SET      S:S(P(2)&7,0,0,0,3,0,5,6,7),;
                  S:S((P(2)**-3)&7,0,0,0,3,0,5,6,7),;
                  S:S((P(2)**-6)&3,0,0,0,3)
J        DO       3
         ERROR,3,K(J) PC
         FIN
         ERROR,3,((P(2)&X'40000007')~=0)&;
                 ((P(2)&X'00000078')=0)   'POL,PSL OR SEL REQUIRED'
I        SET      1
L        WHILE    I
K        SET      9+L
J        SET      NUM(AF(P(K),1))
         GOTO,(L<3)&(J=0)     CONT
I        SET      0
CONT     SET      %
         FIN
         DO       J=1
ADR      SET      NUM(AF(P(K),2))
         DO1      ADR
P(2)     SET      P(2)|X'80000000'
         FIN
         GEN,32   P(2)
         DO       J=1
J        SET      SCOR(INDX,AF(P(K),1))
         ERROR,3,(J=1)&(ADR=0) 'INDX OPTION REQUIRES ADDRESS'
         DO1      ADR|(J=1)
         GEN,1,31 AFA(P(K),2),AF(P(K),2)
         FIN
         DO       NUM(AF(P(3),1))
         GEN,1,31 AFA(P(3),2),AF(P(3),2)
         GEN,1,31 AFA(P(3),3),AF(P(3),3)
         ERROR,3,(AF(P(3),2)=0)|(AF(P(3),3)=0) 'REPL NEEDS 2 ADDRESSES'
         FIN
K        SET      0
         FIN
         DO       K&(J-1)
         DO       NAME(1)=1
P        SET      SCOR(AF(2,2),SLAVE,MASTER,EITHER)
         ERROR,3,(SCOR(AF(2,1),TYPE)=0)|P=0 UP
         DO1      P=3
P        SET      -1
         ELSE
P        SET      SCOR(AF(2,1),READ,WRITE)
         ERROR,3,P=0|AF(2,2)~=0 UP
         DO1      P=2
P        SET      -1
         FIN
         DATA     P
         ELSE
         DO1      K
         DATA     0
         FIN
         FIN
         DO1      PF=0
PLOC     USECT    ULOC
         PEND
         PAGE
*
********************
*
M:LIST   CNAME
         PROC
         LOCAL    OPNCLS,NEXTX,#KEYWDS,KEYWD,SKIPIT,#SLOTS,BGNRING,;
                  FLINK,DEV,J,K,L,M,N,LL,NN,CONT1,CONT2,CURKEY,;
                  MATCH,PSLHIT,POLX,SELX,PFLG,SFLG,START,END,GENERATE
         BOUND    4
ULOC     USECT    LISTLOC
         ERROR,3,NUM(LF)=0 'REQUIRED LIST LABEL MISSING'
OPNCLS   SET      -1                INITIALIZE OPN/CLS FLAG
BGNRING  SET      0,0                INITIALIZE BEGIN LIST POINTERS
NEXTX    SET      1                 INITIALIZE LIST ELEMENT PNTR
#KEYWDS  SET      NUM(AF)
         ERROR,3,#KEYWDS=0 INOA
LF,START SET      %                 MARK START OF LIST
         ORG      %+2               SKIP OVER HEADER FOR NOW
*
*  BEGIN LEFT TO RIGHT SCAN OF PROCEDURE REFERENCE LINE AND
*  BUILD ELEMENT ENTRIES ONE AT AT TIME AS YOU GO.
*
I        DO       #KEYWDS
KEYWD    SET      SCOR(AF(I,1),POL,SEL,PSL,OPN,CLS)
         ERROR,3,KEYWD=0 UP
         DO1      KEYWD>3           IF >, THEN OPN/CLS HIT
OPNCLS   SET      KEYWD-4           SO SET OPN/CLS FLAG ACCORDINGLY
         GOTO,(KEYWD>3)|(KEYWD=0) SKIPIT  IF TRUE, EXIT & TRY NEXT ONE
#SLOTS   SET      NUM(AF(I))-1      #PARAMETERS W/ THIS KEYWORD
         ERROR,3,#SLOTS=0 INOA
         GOTO,#SLOTS=0              SKIPIT  IF TRUE, EXIT & GO ON
         PAGE
*
*  BEGIN ANALYZING THE ELEMENTS (PARAMETERS) ASSOCIATED WITH
*  THE CURRENT KEYWORD VALUE.
*
J        DO       #SLOTS
NEXTX    SET      NEXTX+1           BUMP CURRENT ELEMENT PNTR
N        SET      NEXTX             MARK CURRENT ELEMENT PNTR
M        SET      I                 MARK CURRENT KEYWORD COUNT
DEV      SET      0                 ASSUME CURRENT PARAMETER=DUM
FLINK    SET      S:S(KEYWD-1,(-1,0),(0,-1),(-1,-1))  SET FOR-
*                                   WARD LINKS ACCORDINGLY
         GOTO,SCOR(AF(I,J+1),DUM) GENERATE
DEV      SET      AF(I,J+1)         O.K., SO IT'S NOT = DUM
NN       SET      1                 INITIALIZE REMAINING ELEMENTS-
*                                   THIS-GROUP POINTER
         DO1      ((KEYWD&1)=1)&(BGNRING(1)=0)
BGNRING(1) SET    N-1               ESTABLISH 1ST POL ENTRY PNTR
         DO1      ((KEYWD&2)=2)&(BGNRING(2)=0)
BGNRING(2) SET    N-1               ESTABLISH 1ST SEL ENTRY PNTR
K        SET      #SLOTS-J          LOOK FOR NEXT NON-DUM THIS GROUP
         WHILE    K
FLINK    SET      S:S(KEYWD-1,(N,0),(0,N),(N,N)) ASSUME = NON-DUM
         GOTO,SCOR(AF(I,J+1+NN),DUM) CONT1
K        SET      0                 NON-DUM HIT; TURN OFF WHILE LOOP
         GOTO,1   CONT2
CONT1    SET      %
NN       SET      NN+1              BUMP REMAINING ELMNTS-THIS-GRP PNTR
N        SET      N+1               BUMP LIST ELEMENT PNTR
CONT2    SET      %
K        SET      K-1               DECREMENT LOOP COUNT
*
         FIN                        *****
*
         GOTO,K=-1          GENERATE
*
*  HAVEN'T FOUND A CANDIDATE YET; EITHER J=#SLOTS OR EVERYTHING
*  AFTER J IN THIS GROUP IS = DUM.
*
CURKEY   SET      KEYWD             MARK CURRENT KEYWORD INDICATOR
PFLG,SFLG SET     1         INITIALIZE LOOK-AHEAD POL-SEL HIT FLAGS
L        SET      #KEYWDS-I         SO LOOK FOR NEXT "LIKE"
         WHILE    L                 KEYWORD OR PSL KEYWORD
M        SET      M+1               BUMP LOOK-AHEAD KEYWORD COUNTER
MATCH    SET      (SCOR(AF(M,1),POL,SEL,PSL)=CURKEY)|(CURKEY=3)
PSLHIT   SET      SCOR(AF(M,1),PSL)      TO CK FOR A PSL ENCOUNTER
         GOTO,(MATCH=0)&(PSLHIT=0) CONT1 MOVE ON TO NEXT KEYWORD
*                                        IF NO LUCK W/THIS ONE
         DO1      PFLG
POLX     SET      N                 MARK LOOK-AHEAD POL ELMNT PNTR
         DO1      SFLG
SELX     SET      N                 MARK LOOK-AHEAD SEL ELMNT PNTR
LL       SET      1                 INITIALIZE REMAINING ELEMENTS-
*                                   THIS-GROUP POINTER
*                                   WE MAY FIND ONLY DUM ENTRIES
K        SET      NUM(AF(M))-1      LOOK FOR NON-DUM IN THIS
         WHILE    K                 LOOK-AHEAD GROUP
         GOTO,SCOR(AF(M,LL+1),DUM) CONT2 CONTINUE SEARCH IF = DUM
K        SET      1                 TURN OFF K WHILE LOOP
         DO       (CURKEY=3)&(PSLHIT=0)
CURKEY   SET      SCOR(AF(M,1),SEL,POL) SET SO NEXT TIME THRU
*                                   WE'RE LOOKING FOR OPPOSITE TYPE
PFLG     SET      PFLG||SCOR(AF(M,1),POL)   SET LOOK-AHEAD POL-SEL
SFLG     SET      SFLG||PFLG                FLAGS ACCORDINGLY
         ELSE
L        SET      0                 TURN OFF L WHILE LOOP AND
FLINK    SET      POLX,SELX         SET UP FORWARD PNTRS
         DO1      (PFLG&SFLG)=1     ONE PNTR=0 IF KEYWD NOT = PSL.
FLINK    SET      S:S(CURKEY-1,(POLX,0),(0,SELX),(POLX,SELX))
*
         FIN                        *****
*
CONT2    SET      %
POLX     SET      POLX+PFLG         BUMP SUB-LOOK-AHEAD POL ELMNT PTR
SELX     SET      SELX+SFLG         BUMP SUB-LOOK-AHEAD SEL ELMNT PTR
K        SET      K-1               DECREMENT K LOOP CONTROL
LL       SET      LL+1              BUMP REMAINING ELMNTS-THIS-GRP PNTR
*
         FIN                        *****
*
*  ALL DUMS IN THIS LOOK-AHEAD GROUP
*
CONT1    SET      %
N        SET      N+NUM(AF(M))-1    BUMP LOOK-AHEAD ELEMENT PNTR
L        SET      L-1               DECREMENT L LOOP CONTROL
*                                   PAST THIS UNSATISFYING GROUP
         FIN                        *****
*
         GOTO,L=-1       GENERATE
*
*  AT THIS POINT THE WHOLE REFERENCE LINE HAS BEEN SCANNED AND
*  WE STILL HAVEN'T FOUND BOTH NECESSARY FORWARD LINKS
*
         DO1      PFLG&SFLG
POLX,SELX SET     0                 REQUIRED IF KEYWD<3
FLINK    SET      S:S(CURKEY-1,(BGNRING(1),SELX),(POLX,BGNRING(2)),;
                               (BGNRING))
GENERATE SET      %
         GEN,8,8,16 FLINK,DEV       GENERATE A LIST ENTRY
*
         FIN                        *****
*
SKIPIT   SET      %
*
         FIN                        *****
*
         ERROR,3,OPNCLS<0 'OPN/CLS OPTION NOT SPECIFIED'
         DO1      OPNCLS<0          DEFAULT TO CLS IN THIS CASE
OPNCLS   SET      1
END      SET      %
         ORG      START             GO BACK AND DO HEADER
         GEN,16,16 OPNCLS,END-(START+2)  FLAGS & LIST LENGTH
         GEN,16,8,8 0,BGNRING       GENERATE START OF RING INDICES
         ORG      END               GO BACK TO BOTTOM OF LIST
LISTLOC  USECT    ULOC
         PEND
         CLOSE    I,J,S
         CLOSE    LISTLOC
         CLOSE    SXP,ACN,S#,LBLS,USECT
 CLOSE PLOC,ULOC,UP,INOA,CAL1,Z,OUTT,FLAG,G,S:S,FLAG%VAR,DMY,;
 FLAG%TXT,FLAG%CK,Q,I,A,%RES,ATF,IF,P,COMMON,CRW,;
 R,BRN,%COUNT,%NOP,HEADES,CORRESS,PARA,DVS,SEQS,TABS,CHG,M,;
 ZAP,#POK,VAR,ITEM,#NOP,VARP,NOVAR,TXT,#T,#PEND,;
 #C1,#C2,#C3,IBPRA,BAV,PC,DV,ZZ,SP,#,PF,CS%,CCS,PT0,PT1,W,X,VKEY,;
 #DEC,TXTV,#S,IVAL,FRM,T,H,XM
         CLOSE    #ZERO,ANOP,COMMENT
         CLOSE    INV,F#KEYS
         END

