*DECK NDLP2LF 
USETEXT NDLDATT 
USETEXT NDLFETT 
USETEXT NDLTBLT 
      PROC NDLP2LF; 
      BEGIN 
*IF,DEF,IMS 
# 
**    NDLP2LF - CHECKS LCF STATEMENTS AND CREATES LCF.
* 
*     D.K. ENDO    81/10/12 
* 
*     THIS PROCEDURE TAKES EACH ENTRY IN THE STMT TABLE AND CALLS THE 
*     APPROPRIATE PROC TO CHECK THE ENTRY.
* 
*     PROC NDLP2LF
* 
*     ENTRY        NONE.
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     ALLOCATE TABLE SPACE FOR LCF TABLES.
*     INITIALIZE THE TABLES.
*     REWIND THE STATEMENT TABLE. 
*     FOR EACH ENTRY IN STATEMENT TABLE:  
*       CALL APPROPRIATE PROC TO CHECK ENTRY. 
*     CALL LCF TERMINATION PROC.
* 
# 
*ENDIF
# 
****  PROC NDLP2LF - XREF LIST BEGINS.
# 
      XREF
        BEGIN 
        PROC SSBSBF;         # STORES A BIT FIELD INTO A TABLE         #
        PROC SSTATS;         # ALLOCATES MORE TABLE SPACE              #
        PROC READ;           # FILLS CIO BUFFER                        #
        PROC READW;          # READS GIVEN NUMBER OF CP WORDS          #
        PROC RECALL;         # RETURNS CONTROL WHEN RECALL BIT CLEARED #
        PROC REWIND;         # REWINDS GIVEN FILE                      #
        END 
# 
****
# 
      CONTROL PRESET; 
      CONTROL NOLIST;        # ER2CNDL AND PS2CNDL                     #
*CALL ER2CNDL 
*CALL PS2CNDL 
      CONTROL LIST; 
      DEF MXAT # 60 #;       # SIZE OF ASCII TABLE                     #
      ITEM I;                # SCRATCH ITEM                            #
      ITEM STMT$STAT;        # STATUS RETURNED BY READ                 #
      ITEM USR$M$FLAG B;     # MAXIMUM USER STATEMENTS USED FLAG       #
      ITEM PP$SNODE;         # CURRENT SNODE DEFINED ON OUTCALL STMT   #
      ITEM PP$DNODE;         # CURRENT DNODE DEFINED ON OUTCALL STMT   #
      ITEM PP$PORT;          # CURRENT PORT NUMBER DEFINED ON OUTCALL  #
      ITEM PP$DTEAL;         # CURRENT LENGTH OF DTEA                  #
      ITEM PP$DTEA;          # CURRENT VALUE OF DTEA USED BY PATH PID  #
                             # TABLE                                   #
      ITEM CRNT$PID C(3);    # CURRENT PID NAME USED                   #
      ARRAY ASCII$TABLE [00:MXAT] S(1); # TABLE TO CONVERT DISPLAY CODE#
        BEGIN                           #   TO ASCII                   #
        ITEM A$CHAR U(00,52,08) = [O"72",         # COLON              #
                                   O"101",        # A                  #
                                   O"102",        # B                  #
                                   O"103",        # C                  #
                                   O"104",        # D                  #
                                   O"105",        # E                  #
                                   O"106",        # F                  #
                                   O"107",        # G                  #
                                   O"110",        # H                  #
                                   O"111",        # I                  #
                                   O"112",        # J                  #
                                   O"113",        # K                  #
                                   O"114",        # L                  #
                                   O"115",        # M                  #
                                   O"116",        # N                  #
                                   O"117",        # O                  #
                                   O"120",        # P                  #
                                   O"121",        # Q                  #
                                   O"122",        # R                  #
                                   O"123",        # S                  #
                                   O"124",        # T                  #
                                   O"125",        # U                  #
                                   O"126",        # V                  #
                                   O"127",        # W                  #
                                   O"130",        # X                  #
                                   O"131",        # Y                  #
                                   O"132",        # Z                  #
                                   O"060",        # 0                  #
                                   O"061",        # 1                  #
                                   O"062",        # 2                  #
                                   O"063",        # 3                  #
                                   O"064",        # 4                  #
                                   O"065",        # 5                  #
                                   O"066",        # 6                  #
                                   O"067",        # 7                  #
                                   O"070",        # 8                  #
                                   O"071",        # 9                  #
                                   O"053",        # +                  #
                                   O"055",        # -                  #
                                   O"052",        # *                  #
                                   O"057",        # /                  #
                                   O"050",        # (                  #
                                   O"051",        # )                  #
                                   O"044",        # $                  #
                                   O"075",        # =                  #
                                   O"040",        # BLANK              #
                                   O"054",        # ,                  #
                                   O"056",        # .                  #
                                   O"043",        # POUND              #
                                   O"133",        # [                  #
                                   O"135",        # ]                  #
                                   O"045",        # %                  #
                                   O"042",        # "                  #
                                   O"137",        # _                  #
                                   O"041",        # !                  #
                                   O"046",        # &                  #
                                   O"047",        # '                  #
                                   O"077",        # ?                  #
                                   O"074",        # <                  #
                                   O"076",        # >                  #
                                   O"100"         #                   # 
                                  ];
        END 
      SWITCH LCFJUMP                    ,        # UNKNOWN             #
                                        ,        # NFILE               #
                                        ,        # NPU                 #
                                        ,        # SUPLINK             #
                                        ,        # COUPLER             #
                                        ,        # LOGLINK             #
                                        ,        # GROUP               #
                                        ,        # LINE                #
                                        ,        # ** RESERVED **      #
                                        ,        # TERMINAL            #
                                        ,        # DEVICE              #
                                        ,        # TRUNK               #
                             LFILE$ENTRY,        # LFILE               #
                             USER$ENTRY ,        # USER                #
                             APPL$ENTRY ,        # APPL                #
                             OUTCALL$ENT,        # OUTCALL             #
                             INCALL$ENT ,        # INCALL              #
                                        ,        # END                 #
                                        ,        # TERMDEV             #
                                        ,        # DEFINE              #
                                        ,        # COMMENT             #
                                        ;        # TITLE               #
  
      CONTROL EJECT;
      PROC APPLPR;
      BEGIN 
*IF,DEF,IMS 
# 
**    APPLPR - APPLICATION STATEMENT PROC.
* 
*     D.K. ENDO    81/10/30 
* 
*     THIS PROCEDURE CHECKS THE APPL STATEMENT AND MAKES ENTRIES INTO 
*     THE APPL TABLE. 
* 
*     PROC APPLPR 
* 
*     ENTRY        NONE.
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     INCREMENT APPL TABLE ENTRY SIZE.
*     CLEAR NEXT ENTRY IN APPL TABLE. 
*     IF LABEL IS O.K.
*       SEARCH RESERVED NAME TABLE FOR LABEL
*       IF FOUND, 
*       THEN, 
*         FLAG ERROR. 
*       OTHERWISE,
*         PUT LABEL IN ENTRY. 
*     FOR EACH VALUE-DECLARATION IN ENTRY,
*       IF VALUE IS O.K.
*         SELECT CASE THAT APPLIES: 
*           CASE 1(PRIV): 
*             IF VALUE IS -YES-,
*               SET PRIV FLAG IN ENTRY. 
*           CASE 2(UID):  
*             IF VALUE IS -YES-,
*               SET UID FLAG IN ENTRY.
*           CASE 3(DI): 
*             IF VALUE IS -YES-,
*               SET DI FLAG IN ENTRY. 
*           CASE 4(KDSP): 
*             IF VALUE IS -YES-,
*               SET KDSP FLAG IN ENTRY. 
* 
# 
*ENDIF
# 
****  PROC APPLPR - XREF LIST BEGINS. 
# 
      XREF
        BEGIN 
        PROC NDLCKRG;        # CHECKS RANGE                            #
        PROC NDLEM2;         # MAKES ENTRY IN PASS2 ERROR FILE         #
        END 
# 
****
# 
      ITEM FOUND B;          # FOUND FLAG                              #
      ITEM I;                # SCRATCH ITEM                            #
      DEF MXRA # 9 #; 
      DEF MXCOPY$DEF # 1 #;  # DEFAULT VALUE FOR MXCOPYS               #
      DEF MXBLK # "  " #;    # CHECK FOR APPL NAME LENGTH IF MXCOPYS   #
                             # GREATER THAN 1                          #
      ITEM MXCOPY$USED B;    # MXCOPY SPECIFIED FLAG                   #
      ITEM AT$STAT B;        # STATUS FLAG FOR RANGE CHECKING          #
      ARRAY RSRV$APPLS [1:MXRA] S(1);  # RESERVED APPLICATION TABLE    #
        BEGIN 
        ITEM RA$NAME C(0,0,10) = ["NS", 
                                  "CS", 
                                  "NVF",
                                  "ALL",
                                  "NULL", 
                                  "BYE",
                                  "LOGIN",
                                  "LOGOUT", 
                                  "HELLO",
                                 ]; 
        END 
      SWITCH APPLJMP              ,            , # UNK     , NODE     ,#
                                  ,            , # VARIANT , OPGO     ,#
                                  ,            , #         , LLNAME   ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # HNAME   , LOC      ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  , DI$        , # NCNAME  , DI       ,#
                                  ,            , # N1      , P1       ,#
                                  ,            , # N2      , P2       ,#
                                  ,            , # NOLOAD1 , NOLOAD2  ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # NI      , PORT     ,#
                                  ,            , # LTYPE   , TIPTYPE  ,#
                                  ,            , # AUTO    , SL       ,#
                                  ,            , # LSPEED  , DFL      ,#
                                  ,            , # FRAME   , RTIME    ,#
                                  ,            , # RCOUNT  , NSVC     ,#
                                  ,            , # PSN     , DCE      ,#
                                  ,            , # DTEA    ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # STIP    , TC       ,#
                                  ,            , # RIC     , CSET     ,#
                                  ,            , # TSPEED  , CA       ,#
                                  ,            , # CO      , BCF      ,#
                                  ,            , # MREC    , W        ,#
                                  ,            , # CTYP    , NCIR     ,#
                                  ,            , # NEN     ,          ,#
                                  ,            , #         , DT       ,#
                                  ,            , # SDT     , TA       ,#
                                  ,            , # ABL     , DBZ      ,#
                                  ,            , # UBZ     , DBL      ,#
                                  ,            , # UBL     , XBZ      ,#
                                  ,            , # DO      , STREAM   ,#
                                  ,            , # HN      , AUTOLOG  ,#
                                  ,            , # AUTOCON , PRI      ,#
                                  ,            , # P80     , P81      ,#
                                  ,            , # P82     , P83      ,#
                                  ,            , # P84     , P85      ,#
                                  ,            , # P86     , P87      ,#
                                  ,            , # P88     , P89      ,#
                                  ,            , # AL      , BR       ,#
                                  ,            , # BS      , B1       ,#
                                  ,            , # B2      , CI       ,#
                                  ,            , # CN      , CT       ,#
                                  ,            , # DLC     , DLTO     ,#
                                  ,            , # DLX     , EP       ,#
                                  ,            , # IN      , LI       ,#
                                  ,            , # OP      , PA       ,#
                                  ,            , # PG      , PL       ,#
                                  ,            , # PW      , SE       ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # MFAM    , MUSER    ,#
                                  ,            , # MAPPL   , DFAM     ,#
                                  ,            , # DUSER   ,          ,#
                                  ,            , #         ,          ,#
                                  , RS$        , # PAPPL   ,RS        ,#
                        MXCOPY$   , NETXFR$    , # MXCOPYS ,NETXFR    ,#
                        UID$      , PRIV$      , # UID     ,PRIV      ,#
                        KDSP$     , PRU$       , # KDSP    , PRU      ,#
                                  ,            , # NAME1   , NAME2    ,#
                                  ,            , # SNODE   , DNODE    ,#
                                  ,            , # ACCLEV  ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            ; # FAM     , UNAME     #
      CONTROL EJECT;
#                                                                      #
#                            APPLPR CODE BEGINS HERE                   #
#                                                                      #
      MXCOPY$USED = FALSE;             # MXCOPYS SPECFIED FLAG RESET   #
      ATWC[1] = ATWC[1] + 1;           # INCREMENT TABLE SIZE          #
      IF ATWC[1] GQ AT$LENG-1 
      THEN                   # IF NEED MORE TABLE SPACE                #
        BEGIN                #   ALLOCATE MORE SPACE                   #
        SSTATS(P<APPL$TABLE>,10); 
        END 
      ATWORD[ATWC[1]] = 0;             # CLEAR ENTRY                   #
      IF NOT STLBERR[1]                # IF LABEL IS O.K.              #
      THEN
        BEGIN 
        FOUND = FALSE;                 # CLEAR FOUND FLAG              #
        FOR I=1 STEP 1 UNTIL MXRA 
        DO
          BEGIN 
          IF RA$NAME[I] EQ STLABEL[1] 
          THEN
            BEGIN 
            FOUND = TRUE;    # FLAG ERROR -- NAME CANNOT BE RESRVD WORD#
            ATNAME2[ATWC[1]] = MXBLK;  # BLANK FILL LAST TWO CHARS     #
            NDLEM2(ERR149,STLNUM[0],STLABEL[1]);
            END 
          END 
        IF NOT FOUND                   # IF LABEL NOT RESERVED NAME    #
        THEN
          BEGIN                        # PUT NAME IN ENTRY             #
          ATNAME[ATWC[1]] = STLABEL[1]; 
          END 
        END 
      FOR I=2 STEP 1 UNTIL STWC[0]     # FOR EACH VALUE DECLARATION    #
      DO
        BEGIN 
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN 
          GOTO APPLJMP[STKWID[I]];     # GOTO APPROPRIATE PARAGRAPH    #
PRIV$:  
          IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
          THEN
            BEGIN 
            ATPRIV[ATWC[1]] = TRUE;    # SET PRIV FLAG IN ENTRY        #
            END 
          TEST I; 
UID$: 
          IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
          THEN
            BEGIN 
            ATUID[ATWC[1]] = TRUE;     # SET UID FLAG IN ENTRY         #
            END 
          TEST I; 
  
RS$:      IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
          THEN
            BEGIN 
            ATRS[ATWC[1]] = TRUE;      # SET ATRS FLAG IN ENTRY        #
            END 
          TEST I; 
  
MXCOPY$:  MXCOPY$USED = TRUE;          # SET MXCOPY USED FLAG          #
          NDLCKRG(STKWID[I],STVALNUM[I],AT$STAT);  # CHECK RANGE       #
          IF AT$STAT                   # IF VALUE IS WITHIN RANGE      #
          THEN
            BEGIN 
            ATMAXC[ATWC[1]] = STVALNUM[I];  # ASSIGN VALUE TO ATMAXC   #
                                            # ENTRY                    #
            END 
          TEST I; 
  
DI$:  
          IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
          THEN
            BEGIN 
            ATSTAT[ATWC[1]] = TRUE;    # SET DI FLAG IN ENTRY          #
            END 
          TEST I; 
  
NETXFR$:  
          IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
          THEN
            BEGIN 
            ATXFR[ATWC[1]] = TRUE;     # SET XFR FLAG IN ENTRY         #
            END 
          TEST I; 
PRU$: 
          IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
          THEN
            BEGIN 
            ATPRU[ATWC[1]] = TRUE;     # SET PRU FLAG IN ENTRY         #
            END 
          TEST I; 
KDSP$:  
          IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
          THEN
            BEGIN 
            ATKDSP[ATWC[1]] = TRUE;    # SET KDSP FLAG IN ENTRY        #
            END 
          TEST I; 
          END 
        END 
      IF NOT MXCOPY$USED     # IF MXCOPY NOT SPECIFIED                 #
      THEN
        BEGIN 
        ATMAXC[ATWC[1]] = MXCOPY$DEF;  # ASSIGN DEFAULT VALUE TO ENTRY #
        END 
      IF ATMAXC[ATWC[1]] GR 1      # CHECK APPL NAME IF MXCOPYS GR 1   #
      THEN
        BEGIN 
        IF ATNAME2[ATWC[1]] NQ MXBLK  # NAME GREATER THAN 5 CHARS      #
        THEN
          BEGIN 
          NDLEM2(ERR166,STLNUM[0],STLABEL[1]);
          END 
        END 
      RETURN;                # **** RETURN ****                        #
      END # APPLPR #
      CONTROL EJECT;
      PROC DC$ZFILL(WORD);
      BEGIN                  # REPLACES BLANKS WITH DISPLAY CODE ZEROS #
      ITEM WORD C(10);       # WORD TO BE ZERO FILLED                  #
  
      DEF ZERO # O"33" #;    # DISPLAY CODE ZERO                       #
      ITEM K;                # LOOP COUNTER                            #
#                                                                      #
#                            DC$ZFILL CODE BEGINS HERE                 #
#                                                                      #
      FOR K=0 STEP 1 UNTIL 9
      DO                     # FOR EACH CHARACTER IN WORD              #
        BEGIN 
        IF C<K,1>WORD EQ " "
        THEN                 # IF CHARACTER IS A BLANK                 #
          BEGIN 
          C<K,1>WORD = ZERO; # REPLACE IT WITH DISPLAY CODE ZERO       #
          END 
        END 
      RETURN;                # **** RETURN ****                        #
      END # DC$ZFILL #
      CONTROL EJECT;
      PROC INCALPR; 
      BEGIN 
*IF,DEF,IMS 
# 
**    INCALPR - INCALL STATEMENT PROC 
* 
*     D.K. ENDO    81/10/29 
* 
*     THIS PROCEDURE CHECKS THE INCALL STMTS AND MAKES ENTRIES IN THE 
*     INCALL TABLE. 
* 
*     PROC INCALPR
* 
*     ENTRY        NONE.
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     INCREMENT INCALL TABLE WORD COUNT.
*     CLEAR NEXT ENTRY. 
*     SET ENTRY WORD COUNT FIELD. 
*     FOR EACH VALUE DECLARATION IN ENTRY,
*       SELECT THE CASE THAT APPLIES, 
*         CASE 1(FAM):  
*           IF VALUE IS O.K., 
*             IF VALUE IS NOT ZERO, 
*               PUT VALUE IN ENTRY. 
*         CASE 2(UNAME):  
*           IF VALUE IS O.K.
*             PUT VALUE IN ENTRY. 
*         CASE 3(SNODE,DNODE,DBL,ABL,DBZ):  
*           IF VALUE IS O.K.
*             CHECK IF VALUE IS WITHIN RANGE. 
*             IF VALUE IS WITHIN RANGE, 
*               PUT VALUE IN ENTRY
*         CASE 4(PRI):  
*           IF VALUE IS O.K., 
*             IF VALUE IS -YES-,
*               SET PRI FLAG IN ENTRY.
*     IF FAM,UNAME,SNODE, OR DNODE WAS NOT SPECIFIED, 
*       FLAG ERROR -- REQUIRED PARAMETER MISSING. 
*     IF ABL,DBL,OR DBZ WAS NOT SPECIFIED 
*       PUT DEFAULT VALUE IN ENTRY. 
* 
# 
*ENDIF
# 
****  PROC INCALPR - XREF LIST BEGINS.
# 
      XREF
        BEGIN 
        PROC NDLCKRG;        # CHECKS VALUE TO BE WITHIN RANGE         #
        PROC NDLEM2;         # MAKES ENTRY IN PASS 2 ERROR FILE        #
        PROC NDLZFIL;        # ZERO FILL NAMES                         #
        FUNC XCDD C(10);     # CONVERTS DEC BINARY TO DISPLAY CODE     #
        FUNC XCHD C(10);     # CONVERTS HEX BINARY TO DISPLAY CODE     #
        END 
# 
****
# 
      DEF ABL$DEF # 2 #;     # DEFAULT ABL VALUE                       #
      DEF MXANAME #  7 #;    # MAXIMUM LENGTH OF ANAME :  7 HEX DIGIT  #
      DEF DNODE$DEF # 0 #;   # DEFAULT DNODE VALUE                     #
      DEF SNO$MAX #255#;     #MAXIMUM VALUE OF INCALL SNODE#
      DEF DBL$DEF # 2 #;     # DEFAULT DBL VALUE                       #
      DEF DBZ$DEF # 225 #;   # DEFAULT DBZ VALUE                       #
      DEF DPL$DEF # 7 #;     # DEFAULT DPLR/DPLS VALUE                 #
      DEF FIX$ENT # 8 #;     # SIZE OF FIXED PORTION OF ENTRY          #
      DEF MINFAC # 4 #;      # MINIMUM CHAR COUNT FOR FACILITY CODE    #
      DEF MXFAC # 12 #;      # MAXIMUM CHAR COUNT OF FACILITY CODE     #
      DEF MXFACL # 126 #;    # MAXIMUM OF TOTAL OF FACL-S ALLOWED      #
      DEF MXIB$ENT # 40 #;   # MAXIMUM INCALL BLOCK ENTRY SIZE         #
      DEF UBL$DEF # 2 #;     # DEFAULT UBL VALUE                       #
      DEF UBZ$DEF #  2  #;   # DEFAULT UBZ VALUE                       #
      DEF UBZMUL  # 100 #;   # MULTIPLE THAT UBZ IS ENCODED WITH       #
      DEF W$DEF   # 2 #;     # DEFAULT WR/WS VALUE                     #
      DEF SHOST$DEF # X"303030" #;     # DEFAULT SHOST VALUE           #
      DEF MXDTEA # 15 #;     # MAXIMUM LENGTH OF DTEA                  #
      DEF ZERO # O"33" #;    # DISPLAY CODE ZERO                       #
      ITEM ABL$USED B;       # ABL SPECIFIED FLAG                      #
      ITEM AN$TEMP C(24);    # CHAR TEMP FOR ANAME                     #
      ITEM DNODE$USED B;     # DNODE SPECIFIED FLAG                    #
      ITEM ANAM$USED B;      # ANAME SPECIFIED FLAG                    #
      ITEM CRNT$ENT;         # POINTER TO CURRENT ENTRY                #
      ITEM CTEMP C(10);      # CHARACTER TEMPORARY                     #
      ITEM CTEMP2 C(20);     # CHARACTER TEMPORARY FOR DTEA            #
      ITEM DBL$USED B;       # DBL SPECIFIED FLAG                      #
      ITEM DBZ$USED B;       # DBZ SPECIFIED FLAG                      #
      ITEM DPLS$USED B;      # DPLS SPECIFIED FLAG                     #
      ITEM DPLR$USED B;      # DPLR SPECIFIED FLAG                     #
      ITEM FAC$LENG;         # CURRENT TOTAL LENGTH OF FACILITY CODES  #
      ITEM FAM$USED B;       # FAM SPECIFIED FLAG                      #
      ITEM I;                # SCRATCH ITEM                            #
      ITEM IB$STAT B;        # STATUS RETURNED BY RANGE CHECK PROC     #
      ITEM ITEMP;            # INTEGER TEMPORARY                       #
      ITEM J;                # INTEGER TEMPORARY                       #
      ITEM K;                # INTEGER TEMPORARY                       #
      ITEM NEXT$WORD;        # POINTER TO NEXT WORD IN ENTRY           #
      ITEM SHST$USED B;      # SHOST SPECIFIED FLAG                    #
      ITEM UBL$USED B;       # UBL SPECIFIED FLAG                      #
      ITEM UBZ$USED B;       # UBZ SPECIFIED FLAG                      #
      ITEM UNAM$USED B;      # UNAME SPECIFIED FLAG                    #
      ITEM WS$USED B;        # WS SPECIFIED FLAG                       #
      ITEM WR$USED B;        # WR SPECIFIED FLAG                       #
      ITEM CHARVAL C(10);    #FOR CLARIFIER WORD# 
  
      ARRAY ERROR$WORD [0:0] S(1);     # BUFFER WORD FOR ERROR MESSAGE #
        BEGIN 
        ITEM PARAM C(0,0,4)   = ["    "];   # PARAMETER                #
        ITEM SLASH C(0,24,1)  = ["/"];
        ITEM PVALUE C(0,30,5) = ["     "];  # VALUE                    #
        END 
  
      SWITCH INCLJMP      NEXT$PRM,            , # UNK     , NODE     ,#
                                  ,            , # VARIANT , OPGO     ,#
                                  ,            , #         , LLNAME   ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # HNAME   , LOC      ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # NCNAME  , DI       ,#
                                  ,            , # N1      , P1       ,#
                                  ,            , # N2      , P2       ,#
                                  ,            , # NOLOAD1 , NOLOAD2  ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  , PORT$      , # NI      , PORT     ,#
                                  ,            , # LTYPE   , TIPTYPE  ,#
                                  ,            , # AUTO    , SL       ,#
                                  ,            , # LSPEED  , DFL      ,#
                                  ,            , # FRAME   , RTIME    ,#
                                  ,            , # RCOUNT  , NSVC     ,#
                                  ,            , # PSN     , DCE      ,#
                            DTEA$ ,            , # DTEA    ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # STIP    , TC       ,#
                                  ,            , # RIC     , CSET     ,#
                                  ,            , # TSPEED  , CA       ,#
                                  ,            , # CO      , BCF      ,#
                                  ,            , # MREC    , W        ,#
                                  ,            , # CTYP    , NCIR     ,#
                                  , COLLECT$   , # NEN     , COLLECT  ,#
                                  ,            , # XAUTO   , DT       ,#
                                  ,            , # SDT     , TA       ,#
                      ABL$        , DBZ$       , # ABL     , DBZ      ,#
                      UBZ$        , DBL$       , # UBZ     , DBL      ,#
                      UBL$        ,            , # UBL     , XBZ      ,#
                                  ,            , # DO      , STREAM   ,#
                                  ,            , # HN      , AUTOLOG  ,#
                                  , PRI$       , # AUTOCON , PRI      ,#
                                  ,            , # P80     , P81      ,#
                                  ,            , # P82     , P83      ,#
                                  ,            , # P84     , P85      ,#
                                  ,            , # P86     , P87      ,#
                                  ,            , # P88     , P89      ,#
                                  ,            , # AL      , BR       ,#
                                  ,            , # BS      , B1       ,#
                                  ,            , # B2      , CI       ,#
                                  ,            , # CN      , CT       ,#
                                  ,            , # DLC     , DLTO     ,#
                                  ,            , # DLX     , EP       ,#
                                  ,            , # IN      , LI       ,#
                                  ,            , # OP      , PA       ,#
                                  ,            , # PG      , PL       ,#
                                  ,            , # PW      , SE       ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # MFAM    , MUSER    ,#
                                  ,            , # MAPPL   , DFAM     ,#
                                  ,            , # DUSER   ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # PAPPL   ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # UID     ,PRIV      ,#
                                  ,            , # KDSP    ,          ,#
                                  ,            , # NAME1   , NAME2    ,#
                      SNODE$      ,  DNODE$    , # SNODE   , DNODE    ,#
                                  ,            , # ACCLEV  , DHOST    ,#
                      DPLR$       , DPLS$      , # DPLR     , DPLS    ,#
                                  ,            , # PRID    , UDATA    ,#
                      WR$         , WS$        , # WR      , WS       ,#
                                  ,            , #         ,          ,#
                      FAM$        , UNAME$     , # FAM     , UNAME    ,#
                      FAC$        , FAC$       , # FAC1    , FAC2     ,#
                      FAC$        , FAC$       , # FAC3    , FAC4     ,#
                      FAC$        , FAC$       , # FAC5    , FAC6     ,#
                      FAC$        , FAC$       , # FAC7    , FAC8     ,#
                      FAC$        , FAC$       , # FAC9    , FAC10    ,#
                      FAC$        , FAC$       , # FAC11   , FAC12    ,#
                      FAC$        , FAC$       , # FAC13   , FAC14    ,#
                      FAC$        , FAC$       , # FAC15   , FAC16    ,#
                      FAC$        , FAC$       , # FAC17   , FAC18    ,#
                      FAC$        , FAC$       , # FAC19   , FAC20    ,#
                      FAC$        , FAC$       , # FAC21   , FAC22    ,#
                      FAC$        , FAC$       , # FAC23   , FAC24    ,#
                      FAC$        , FAC$       , # FAC25   , FAC26    ,#
                      FAC$        , FAC$       , # FAC27   , FAC28    ,#
                      FAC$        , FAC$       , # FAC29   , FAC30    ,#
                      FAC$        , ANAME$     , # FAC31   , ANAME    ,#
                      SHOST$      , FASTSEL$   ; # SHOST   , FASTSEL   #
      CONTROL EJECT;
#                                                                      #
#                            INCALPR CODE BEGINS HERE                  #
#                                                                      #
      ABL$USED = FALSE;                # CLEAR PARAM SPECIFIED FLAG    #
      ANAM$USED = FALSE;
      DBL$USED = FALSE; 
      DBZ$USED = FALSE; 
      DPLS$USED = FALSE;
      DPLR$USED = FALSE;
      DNODE$USED = FALSE; 
      FAM$USED = FALSE; 
      SHST$USED = FALSE;
      UBL$USED = FALSE; 
      UBZ$USED = FALSE; 
      UNAM$USED = FALSE;
      WS$USED = FALSE;
      WR$USED = FALSE;
      FAC$LENG = 0; 
      CRNT$ENT = IBRWC[1] + 1;         # POINT TO NEXT ENTRY           #
      IF IBRWC[1]+MXIB$ENT GQ IB$LENG-1 
      THEN                   # IF NEED MORE TABLE SPACE                #
        BEGIN                #   ALLOCATE MORE SPACE                   #
        SSTATS(P<INCALL$TABLE>,MXIB$ENT); 
        END 
      NEXT$WORD = CRNT$ENT + FIX$ENT;  # CALCULATE NEXT AVAILABLE WORD #
      FOR I=CRNT$ENT STEP 1 UNTIL NEXT$WORD-1 
      DO
        BEGIN 
        IBWORD[I] = 0;                 # CLEAR NEXT ENTRY              #
        END 
      IBWC[CRNT$ENT] = FIX$ENT;        # ENTER ENTRY SIZE              #
      FOR I=1 STEP 1 UNTIL STWC[0]     # FOR EACH VALUE DECLARATION    #
      DO
        BEGIN 
        GOTO INCLJMP[STKWID[I]];       # GOTO APPROPRIATE PARAGRAPH    #
ANAME$: 
        ANAM$USED = TRUE;    # SET ANAME SPECIFIED FLAG                #
        IF NOT STVLERR[I] 
        THEN                 # IF VALUE OK                             #
          BEGIN 
          IF STVALLEN[I] LQ MXANAME     # IF LENGTH IS LEGAL           #
          THEN
            BEGIN 
            FOR J=0 STEP 1 UNTIL MXANAME-1
            DO
              BEGIN                        # PACK HEX DIGITS           #
              B<J*8,8>IBRANAME[CRNT$ENT+1] = A$CHAR[C<J,1>STVALNAM[I]]; 
              END 
            END 
          ELSE
            BEGIN 
            CTEMP = " ";
            NDLEM2(ERR100,STLNUM[0],CTEMP);  # VALUE OUT OF RANGE      #
            END 
          END 
        TEST I; 
PRI$: 
        IF NOT STVLERR[I]              # IF PRI VALUE IS O.K.          #
        THEN
          BEGIN 
          IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
          THEN
            BEGIN                      # SET PRI FLAG IN ENTRY         #
            IBPRI[CRNT$ENT + 2] = TRUE; 
            END 
          END 
        TEST I; 
DBL$: 
        DBL$USED = TRUE;               # SET DBL SPECIFIED FLAG        #
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN                        # CHECK IF VALUE WITHIN RANGE   #
          NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); 
          IF IB$STAT                   # IF WITHIN RANGE               #
          THEN
            BEGIN                      # PUT DBL VALUE IN ENTRY        #
            IBDBL[CRNT$ENT + 2] = STVALNUM[I];
            END 
          END 
        TEST I; 
DBZ$: 
        DBZ$USED = TRUE;               # SET DBZ SPECIFIED FLAG        #
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN                        # CHECK IF VALUE WITHIN RANGE   #
          NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); 
          IF IB$STAT                   # IF WITHIN RANGE               #
          THEN
            BEGIN                      # PUT DBZ VALUE IN ENTRY        #
            IBDBZ[CRNT$ENT + 2] = STVALNUM[I];
            END 
          END 
        TEST I; 
UBL$: 
        UBL$USED = TRUE;               # SET UBL SPECIFIED FLAG        #
        IF NOT STVLERR[I] 
        THEN                           # IF VALUE IS O.K.              #
          BEGIN                        # CHECK IF VALUE IS WITHIN RANGE#
          NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); 
          IF IB$STAT                   # IF WITHIN RANGE               #
          THEN
            BEGIN                      # PUT UBL VALUE IN ENTRY        #
            IBUBL[CRNT$ENT + 2] = STVALNUM[I];
            END 
          END 
        TEST I; 
UBZ$: 
        UBZ$USED = TRUE;               # SET UBZ SPECIFIED FLAG        #
        IF NOT STVLERR[I]              # IF VALUE IF O.K.              #
        THEN
          BEGIN                        # CHECK IF VALUE IS WITHIN RANGE#
          NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); 
          IF IB$STAT                   # IF WITHIN RANGE               #
          THEN
            BEGIN            # PUT UBZ VALUE IN ENTRY                  #
            IBUBZ[CRNT$ENT + 2] = STVALNUM[I];
            END 
          END 
        TEST I; 
ABL$: 
        ABL$USED = TRUE;               # SET ABL SPECIFIED FLAG        #
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN                        # CHECK IF VALUE WITHIN RANGE   #
          NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); 
          IF IB$STAT                   # IF WITHIN RANGE               #
          THEN
            BEGIN                      # PUT ABL VALUE IN ENTRY        #
            IBABL[CRNT$ENT + 2] = STVALNUM[I];
            END 
          END 
        TEST I; 
SNODE$: 
        IF NOT STVLERR[I] 
        THEN
          BEGIN                        # CHECK IF VALUE WITHIN RANGE   #
          IB$STAT = TRUE;            # PRESET IB$STAT                #
          IF STVALNUM[I] LS 0 OR STVALNUM[I] GR SNO$MAX 
          THEN
            BEGIN 
            CHARVAL=XCDD(STVALNUM[I]);
            NDLEM2(ERR100,STLNUM[0],CHARVAL); 
            IB$STAT=FALSE;
            END 
          IF IB$STAT
          THEN
            BEGIN                      # PUT SNODE VALUE IN ENTRY      #
            IBSNODE[CRNT$ENT + 3] = STVALNUM[I];
            END 
          END 
        TEST I; 
DNODE$: 
        DNODE$USED = TRUE ; 
        IF NOT STVLERR[I]              # IF DNODE VALUE IS OK         # 
        THEN
          BEGIN 
          NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT);  #  CHECK RANGE     # 
          IF IB$STAT                   #  IF NOT OUT OF RANGE         # 
          THEN
            BEGIN 
            IBDNODE[CRNT$ENT+3] = STVALNUM[I];  #  INSERT VALUE       # 
            END 
          END 
        TEST I; 
  
PORT$:  
        IF NOT STVLERR[I] 
        THEN                 # IF PORT VALUE IS O.K.                   #
          BEGIN 
          IF (STVALNUM[I] LQ X"FE") AND (STVALNUM[I] GR X"00")
          THEN               # IF VALUE IS WITHIN RANGE                #
            BEGIN 
            IBPORT[CRNT$ENT + 2] = STVALNUM[I];  # STORE VALUE IN ENTRY#
            END 
          ELSE               # VALUE IS TOO BIG                        #
            BEGIN            # FLAG ERROR -- VALUE OUT OF RANGE        #
            CTEMP = XCHD(STVALNUM[I]);
            NDLEM2(ERR100,STLNUM[0],CTEMP); 
            END 
          END 
        TEST I; 
WR$:  
        WR$USED = TRUE;                # SET WS SPECIFIED FLAG         #
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN              # CHECK IF VALUE IS WITHIN RANGE          #
          NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); 
          IF IB$STAT                   # IF WITHIN RANGE               #
          THEN
            BEGIN                      # PUT WS VALUE IN ENTRY         #
            IBWR[CRNT$ENT + 3] = STVALNUM[I]; 
            END 
          END 
        TEST I; 
WS$:  
        WS$USED = TRUE;                # SET WS SPECIFIED FLAG         #
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN              # CHECK IF VALUE IS WITHIN RANGE          #
          NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); 
          IF IB$STAT                   # IF WITHIN RANGE               #
          THEN
            BEGIN                      # PUT WS VALUE IN ENTRY         #
            IBWS[CRNT$ENT + 3] = STVALNUM[I]; 
            END 
          END 
        TEST I; 
DPLR$:  
        DPLR$USED = TRUE;              # SET DPLR SPECIFIED FLAG       #
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN              # CHECK IF VALUE IS WITHIN RANGE          #
          NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); 
          IF IB$STAT                   # IF WITHIN RANGE               #
          THEN
            BEGIN            # PUT DPLR VALUE IN ENTRY                 #
            ITEMP = 16;      # SET TO MINIMUM DPLR VALUE               #
            FOR J=4 STEP 1 WHILE ITEMP LS STVALNUM[I] 
            DO               # DETERMINE VALUE (POWER OF TWO)          #
              BEGIN 
              ITEMP = ITEMP * 2;       # SET TO NEXT POWER OF TWO      #
              END 
            IBDPLR[CRNT$ENT + 3] = J;  # PUT VALUE IN ENTRY            #
            IF STVALNUM[I] NQ ITEMP 
            THEN                       # VALUE IS NOT POWER OF 2       #
              BEGIN                    # FLAG WARNING                  #
              PARAM[0]  = "DPLR";      # PARAMETER NAME                #
              CTEMP     = XCDD(ITEMP);
              PVALUE[0] = C<5,5>CTEMP; # VALUE                         #
              NDLEM2(ERR137,STLNUM[0],ERROR$WORD);
              END 
            END 
          END 
        TEST I; 
DPLS$:  
        DPLS$USED = TRUE;              # SET DPLS SPECIFIED FLAG       #
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN              # CHECK IF VALUE IS WITHIN RANGE          #
          NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); 
          IF IB$STAT                   # IF WITHIN RANGE               #
          THEN
            BEGIN            # PUT DPLS VALUE IN ENTRY                 #
            ITEMP = 16;      # SET TO MINIMUM DPLS VALUE               #
            FOR J=4 STEP 1 WHILE ITEMP LS STVALNUM[I] 
            DO               # DETERMINE VALUE (POWER OF TWO)          #
              BEGIN 
              ITEMP = ITEMP * 2;       # SET TO NEXT POWER OF TWO      #
              END 
            IBDPLS[CRNT$ENT + 3] = J;  # PUT VALUE IN ENTRY            #
            IF STVALNUM[I] NQ ITEMP 
            THEN                       # VALUE IS NOT POWER OF 2       #
              BEGIN                    # FLAG WARNING                  #
              PARAM[0]  = "DPLS";      # PARAMETER NAME                #
              CTEMP     = XCDD(ITEMP);
              PVALUE[0] = C<5,5>CTEMP; # VALUE                         #
              NDLEM2(ERR137,STLNUM[0],ERROR$WORD);
              END 
            END 
          END 
        TEST I; 
SHOST$: 
        SHST$USED = TRUE;    # SET SHOST SPECIFIED FLAG                #
        IF NOT STVLERR[I] 
        THEN                 # IF VALUE IS O.K.                        #
         BEGIN
         NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT);# CHECK RANGE # 
         IF IB$STAT 
         THEN 
           BEGIN
           IBSHOST[CRNT$ENT + 4] = STVALNUM[I]; 
           END
        END 
        TEST I; 
FAM$: 
        FAM$USED = TRUE;               # SET FAM SPECIFIED FLAG        #
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN 
          IF STVALNAM[I] NQ "0"        # IF VALUE IS NOT ZERO          #
          THEN
            BEGIN                      # PUT FAM NAME IN ENTRY         #
            CTEMP = STVALNAM[I];
            NDLZFIL(CTEMP);            # ZERO FILL CTEMP               #
            IBFAM[CRNT$ENT + 5] = CTEMP;   # ASSIGN ZERO FILED NAME    #
            END 
          ELSE                         # VALUE IS ZERO                 #
            BEGIN                      # PUT ZEROS  IN FAM FIELD       #
            IBFAMU[CRNT$ENT + 5] = 0; 
            END 
          END 
        TEST I; 
UNAME$: 
        UNAM$USED = TRUE;              # SET UNAME SPECIFIED FLAG      #
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN                        # PUT USER NAME IN ENTRY        #
          CTEMP = STVALNAM[I];
          NDLZFIL(CTEMP);              # ZERO FILL NAME                #
          IBUSER[CRNT$ENT + 6] = CTEMP; 
          END 
        TEST I; 
  
DTEA$:  IF NOT STVLERR[I]              # IF VALUE IS VALID             #
        THEN
          BEGIN 
          CTEMP2 = STVALNAM[I];        # GET FIRST 7 CHARACTER         #
          C<7,7>CTEMP2 = STVALNAM[I+1];# GET NEXT 7 CHARACTER          #
          C<14,1>CTEMP2 = STVALNAM[I+2];# GET NEXT 1 CHARACTER         #
          IF STVALLEN[I] LQ MXDTEA     # IF VALUE LENGTH O.K.          #
          THEN
            BEGIN 
            IBDTEL[CRNT$ENT+3] = STVALLEN[I]; 
            IBWORD[CRNT$ENT+7] = 0;     # CLEAR DTEA WORD              #
            FOR J = 0 STEP 1 UNTIL STVALLEN[I] - 1 # ASSIGN DTEA VALUE #
            DO
              BEGIN 
              B<J*4,4>IBWORD[CRNT$ENT + 7] = C<J,1>CTEMP2 - ZERO; 
              END 
            END 
          ELSE
            BEGIN 
            NDLEM2(ERR100,STLNUM[0],CTEMP2); # VALUE OUT OF RANGE      #
            END 
          END 
        I = I + 2;
        TEST I; 
FAC$: 
        IF NOT STVLERR[I] 
        THEN                 # IF VALUE IS O.K.                        #
          BEGIN 
          IF STVALLEN[I] GQ MINFAC AND STVALLEN[I] LQ MXFAC 
          THEN               # IF VALUE IS WITHIN RANGE                #
            BEGIN            #   INCREMENT FAC COUNT                   #
            IBFACNUM[CRNT$ENT + 6] = IBFACNUM[CRNT$ENT + 6] + 1;
            IBWORD[NEXT$WORD] = 0;     # CLEAR NEXT WORD               #
            IBFACL[NEXT$WORD] = STVALLEN[I];   # SAVE LENGTH           #
            ITEMP = STVALLEN[I] * 4;   # CALCULATE MASK                #
            B<0,ITEMP>IBFAC[NEXT$WORD] = B<60-ITEMP,ITEMP>STWORD[I+1 ]; 
            IBWC[CRNT$ENT] = IBWC[CRNT$ENT] + 1; # INCREMENT WORD COUNT#
            FAC$LENG = FAC$LENG + STVALLEN[I];   # INCREMENT FAC LENGTH#
            NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD            #
            IBWORD[NEXT$WORD] = 0;
            END 
          ELSE               # VALUE IS TOO BIG                        #
            BEGIN            # FLAG ERROR -- VALUE OUT OF RANGE        #
            CTEMP = XCHD(STWORD[I+1]);
            NDLEM2(ERR100,STLNUM[0],CTEMP); 
            END 
          END 
        I = I + 1;
        TEST I; 
COLLECT$: 
        IF NOT STVLERR[I]              # IF COLLECT VALUE IS O.K.      #
        THEN
          BEGIN 
          IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
          THEN
            BEGIN                      # SET COLLECT FLAG IN ENTRY     #
            IBCOLCT[CRNT$ENT + 3] = TRUE; 
            END 
          END 
        TEST I; 
FASTSEL$: 
        IF NOT STVLERR[I]              # IF FASTSEL VALUE IS O.K.      #
        THEN
          BEGIN 
          IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
          THEN
            BEGIN                      # SET FASTSEL FLAG IN ENTRY     #
            IBFSTSL[CRNT$ENT + 3] = TRUE; 
            END 
          END 
        TEST I; 
  
NEXT$PRM: END 
      IF NOT FAM$USED                  # IF FAM NOT SPECIFIED          #
      THEN
        BEGIN                # FLAG ERROR -- REQUIRED PARAMETER MISSING#
        NDLEM2(ERR103,STLNUM[0],"FAM"); 
        END 
      IF NOT UNAM$USED                 # IF UNAME NOT SPECIFIED        #
      THEN
        BEGIN                # FLAG ERROR -- REQUIRED PARAMETER MISSING#
        NDLEM2(ERR103,STLNUM[0],"UNAME"); 
        END 
      IF NOT ANAM$USED
      THEN                   # IF ANAME WAS NOT SPECIFIED              #
        BEGIN                # FLAG ERROR -- REQUIRED PARAMETER MISSING#
        NDLEM2(ERR103,STLNUM[0],"ANAME"); 
        END 
      IF NOT SHST$USED
      THEN                   # IF SHOST WAS NOT SPECIFIED              #
        BEGIN 
        IBSHOST[CRNT$ENT + 4] = SHOST$DEF;  # DEFAULT SHOST VALUE      #
        END 
      IF NOT DBL$USED                  # IF DBL NOT SPECIFIED          #
      THEN
        BEGIN                          # PUT DEFAULT DBL VALUE IN ENTRY#
        IBDBL[CRNT$ENT + 2] = DBL$DEF;
        END 
      IF NOT ABL$USED                  # IF ABL NOT SPECIFIED          #
      THEN
        BEGIN                          # PUT DEFAULT ABL VALUE IN ENTRY#
        IBABL[CRNT$ENT + 2] = ABL$DEF;
        END 
      IF NOT DBZ$USED                  # IF DBZ NOT SPECIFIED          #
      THEN
        BEGIN                          # PUT DEFAULT DBZ VALUE IN ENTRY#
        IBDBZ[CRNT$ENT + 2] = DBZ$DEF;
        END 
      IF NOT UBL$USED                  # IF UBL WAS NOT SPECIFIED      #
      THEN
        BEGIN                # PUT DEFAULT VALUE IN ENTRY              #
        IBUBL[CRNT$ENT + 2] = UBL$DEF;
        END 
      IF NOT UBZ$USED                  # IF UBZ WAS NOT SPECIFIED      #
      THEN
        BEGIN                          # PUT DEFAULT VALUE IN ENTRY    #
        IBUBZ[CRNT$ENT + 2] = UBZ$DEF;
        END 
      IF NOT DNODE$USED                # IF DNODE WAS NOT SPECIFIED    #
      THEN
        BEGIN 
        IBDNODE[CRNT$ENT+3] = DNODE$DEF; # PUT DEFAULT VALUE IN ENTRY  #
        END 
      IF NOT DPLR$USED                 # IF DPLR WAS NOT SPECIFIED     #
      THEN
        BEGIN                          # PUT DEFAULT VALUE IN ENTRY    #
        IBDPLR[CRNT$ENT + 3] = DPL$DEF; 
        END 
      IF NOT DPLS$USED                 # IF DPLS WAS NOT SPECIFIED     #
      THEN
        BEGIN                          # PUT DEFAULT VALUE IN ENTRY    #
        IBDPLS[CRNT$ENT + 3] = DPL$DEF; 
        END 
      IF NOT WS$USED                   # IF WS WAS NOT SPECIFIED       #
      THEN
        BEGIN                          # PUT DEFAULT VALUE IN ENTRY    #
        IBWS[CRNT$ENT + 3] = W$DEF; 
        END 
      IF NOT WR$USED                   # IF WR WAS NOT SPECIFIED       #
      THEN
        BEGIN                          # PUT DEFAULT VALUE IN ENTRY    #
        IBWR[CRNT$ENT + 3] = W$DEF; 
        END 
      IF FAC$LENG GR MXFACL 
      THEN                   # IF TOTAL FAC LENGTH IS TOO BIG          #
        BEGIN                # FLAG ERROR -- FAC LENGTH EXCEEDS LIMIT  #
        NDLEM2(ERR153,STLNUM[0]," "); 
        END 
      IBRWC[1] = IBRWC[1] + IBWC[CRNT$ENT]; 
      RETURN;                # **** RETURN ****                        #
      END # INCALPR # 
      CONTROL EJECT;
      PROC LCFTERM; 
      BEGIN 
*IF,DEF,IMS 
# 
**    LCFTERM - LCF TERMINATION ROUTINE.
* 
*     D.K. ENDO    81/10/30 
* 
*     THIS PROCEDURE DOES FINAL PROCESSING FOR LCF CREATION.
* 
*     PROC LCFTERM
* 
*     ENTRY        NONE.
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     WRITE PREFIX,APPL,USER,OUTCALL, AND INCALL TABLE TO LCF.
*     IF NO FATAL ERRORS WERE DETECTED, 
*     THEN, 
*       PUT VALID LCF INDICATOR IN THE VALIDATION RECORD. 
*     OTHERWISE,
*       PUT INVALID LCF INDICATOR IN VALIDATION RECORD. 
*     WRITE VALIDATION RECORD TO LCF. 
*     DE-ALLOCATE TABLE SPACE.
* 
# 
*ENDIF
# 
****  PROC LCFTERM - XREF LIST BEGINS.
# 
      XREF
        BEGIN 
        PROC SSTATS;         # USED TO RELEASE TABLE SPACE             #
        PROC NDLEM2;         # MAKES ENTERIES IN PASS2 ERROR FILE      #
        END 
# 
****
# 
      DEF BAD$MSG # "ERRORS DETECTED IN CREATION OF THIS LCF." #; 
      DEF HDR$SZ # 17 #;     # HEADER RECORD SIZE                      #
      STATUS LF$TBL HDR,     # HEADER RECORD                           #
                    APPL,    # APPL TABLE                              #
                    USER,    # USER TABLE                              #
                    OB,      # OUTCALL BLOCK TABLE                     #
                    IB,      # INCALL BLOCK TABLE                      #
                    PATHPID, # PATHPID TABLE                           #
                    VR;      # VALIDATION RECORD                       #
      ITEM WSA;              # ADDRESS OF TABLE TO BE WRITTEN          #
      CONTROL EJECT;
#                                                                      #
#                            LCFTERM CODE BEGINS HERE                  #
#                                                                      #
      WSA = LOC(PRFX$TABLE);           # WRITE FILE HEADER TO LCF      #
      WR$LCF(LF$TBL"HDR",WSA,HDR$SZ); 
      WSA = LOC(APPL$TABLE);           # WRITE APPL TABLE TO LCF       #
      WR$LCF(LF$TBL"APPL",WSA,ATWC[1]+1); 
      WSA = LOC(USER$TABLE);           # WRITE USER TABLE TO LCF       #
      WR$LCF(LF$TBL"USER",WSA,UTWC[1]+1); 
      WSA = LOC(OUTCALL$TABL);         # WRITE OUTCALL TABLE TO LCF    #
      WR$LCF(LF$TBL"OB",WSA,OBRWC[1] + 1);
      WSA = LOC(INCALL$TABLE);         # WRITE INCALL TABLE TO LCF     #
      WR$LCF(LF$TBL"IB",WSA,IBRWC[1]+1);
      WSA = LOC(PATHPID$TAB);          # WRITE FILE HEADER TO LCF      #
      WR$LCF(LF$TBL"PATHPID",WSA,PIRWC[1]+1); 
  
#                            CREATE VALIDATION RECORD                  #
      IF ERRCNT EQ 0
      THEN                   # IF NO FATAL ERRORS DETECTED             #
        BEGIN 
        VE$ID[0] = "VALIDLF";          # INSERT RECORD NAME            #
        VEWORD1[0] = 1;                # SET FLAG TO GOOD LCF          #
        END 
      ELSE                   # FATAL ERROR(S) DETECTED                 #
        BEGIN 
        VE$ID[0] = "INVLDLF";          # INSERT RECORD NAME            #
        VEWORD1[0] = 0;                # CLEAR LCF GOOD FLAG           #
        PT$TITLE[0] = BAD$MSG;         # INSERT BAD LCF MSG IN PRFX TBL#
        END 
      PT$FNAME[0] = "ENDLCF";          # PUT END FILE INDICATOR INTO   #
                                       #    PREFIX TABLE               #
      WSA = LOC(PRFX$TABLE);           # WRITE VALIDATION RECORD TO LCF#
      WR$LCF(LF$TBL"VR",WSA,HDR$SZ);
#                                                                      #
      NDLEM2(0,0,0);         # CLEAR PASS2 ERROR BUFFER                #
#                                                                      #
      SSTATS(P<APPL$TABLE>,-AT$LENG);   # RELEASE TABLE SPACE          #
      SSTATS(P<USER$TABLE>,-UT$LENG); 
      SSTATS(P<OUTCALL$TABL>,-OB$LENG); 
      SSTATS(P<INCALL$TABLE>,-IB$LENG); 
      SSTATS(P<PATHPID$TAB>,-PP$LENG);
#                                                                      #
      RETURN;                # **** RETURN ****                        #
      END # LCFTERM # 
      CONTROL EJECT;
      PROC LFILEPR; 
      BEGIN 
*IF,DEF,IMS 
# 
**    LFILEPR - LFILE STATEMENT PROC. 
* 
*     D.K. ENDO    81/10/30 
* 
*     THIS PROCEDURE USES THE LFILE STATEMENT TO DEFINE THE FILE NAME 
*     FOR THE LCF AND CREATES THE PREFIX TABLE FOR THE HEADER AND 
*     VALIDATION RECORDS. 
* 
*     PROC LFILEPR
* 
*     ENTRY        NONE.
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     IF LABEL IS O.K.
*       CREATE PREFIX TABLE.
*       CREATE VERSION ENTRY. 
*       INITIALIZE LCF FET. 
*       REWIND LCF FILE.
* 
# 
*ENDIF
# 
****  PROC LFILEPR - XREF LIST BEGINS 
# 
      XREF
        BEGIN 
        FUNC EDATE C(10);    # UNPACKS DATE                            #
        FUNC ETIME C(10);    # UNPACKS TIME                            #
        PROC PDATE;          # RETURNS PACKED DATE AND TIME            #
        PROC RECALL;         # RETURNS CONTROL WHEN RECALL BIT IS SET  #
        PROC REWIND;         # REWINDS A GIVEN FILE                    #
        PROC VERSION;        # RETURNS OPERATING SYSTEM VERSION        #
        PROC NDLZFIL;        # ZERO FILLS A CHARACTER NAME             #
        END 
# 
****
# 
*CALL NAMLEV
      ITEM CTEMP C(10);      # CHARACTER TEMPORARY                     #
      ARRAY PACK$DATE [0:0] S(1);      # TEMPORARY FOR PACKED DATE/TIME#
        BEGIN 
        ITEM PD$DATE U(0,24,18);       # PACKED DATE                   #
        ITEM PD$TIME U(0,42,18);       # PACKED TIME                   #
        ITEM PD$WORD U(0,24,36);       #                               #
        END 
      ARRAY VRSN$PARAMS [0:0] S(1);    # WORD USED TO CONTAIN PARAMS   #
        BEGIN                          #   FOR CALL TO VERSION         #
        ITEM VP$BC U(0,0,12) = [5];    # BYTE COUNT                    #
        ITEM VP$SB U(0,12,12) = [0];   # STARTING BYTE IN SOURCE FIELD #
        ITEM VP$BP U(0,24,12) = [0];   # BYTE POSITION IN REC FIELD    #
        ITEM VP$WSA U(0,42,18);        # ADDR OF RECEIVING FIELD       #
        END 
      CONTROL EJECT;
#                                                                      #
#                            LFILEPR CODE BEGINS HERE                  #
#                                                                      #
      IF NOT STLBERR[1]      # IF NO LABEL ERROR                       #
      THEN
        BEGIN                # CREATE PREFIX TABLE                     #
        PTWORD0[0] = 0;                # CLEAR FIRST WORD              #
        PT$ID[0] = O"7700";            # SET TABLE I.D.                #
        PTWC[0] = O"0016";             # SET WORD COUNT                #
        PTWORD1[0] = 0;                # CLEAR SECOND WORD             #
        PT$FNAME[0] = STLABEL[1];      # SET FILE NAME                 #
        PDATE(PACK$DATE);              # GET PACKED DATE AND TIME      #
        CTEMP = ETIME(PD$TIME[0]);     # UNPACK THE TIME               #
        PT$TIME[0] = C<1,8>CTEMP;      # PUT TIME IN TABLE             #
        CTEMP = EDATE(PD$DATE[0]);     # UNPACK THE DATE               #
        PT$DATE[0] = C<1,8>CTEMP;      # PUT DATE IN TABLE             #
        VP$WSA[0] = LOC(PT$OPS[0]);    # SET LOCATION FOR OS VERSION   #
        VERSION(VRSN$PARAMS);          # GET OS VERSION                #
        PT$PNAME[0] = "NDLP";          # SET PROGRAM NAME              #
        PT$PVER[0] = C<9,3>NAMVER[0];  # SET PROGRAM VERSION           #
        PT$PLEV[0] = NAMLV[0];         # SET PROGRAM BUILD LEVEL       #
        PT$BLNK1[0] = " ";             # CLEAR FIELDS                  #
        PT$BLNK2[0] = " ";
        PT$TITLE[0] = TITLE$WORD[0];   # SET TITLE IN TABLE            #
#                            CREATE VERSION ENTRY                      #
        VEWORD0[0] = 0;                # CLEAR 1ST WORD                #
        VE$ID[0] = "VERSION";          # ENTER ENTRY I.D.              #
        VEWORD1[0] = 0;                # CLEAR 2ND WORD                #
        VE$PDATE[0] = PD$WORD[0];      # ENTER THE PACKED DATE AND TIME#
#                            INITIALIZE LCF FET AND LCF                #
        CTEMP = STLABEL[1];            # PUT FILE NAME IN TEMPORARY    #
        NDLZFIL(CTEMP);                # ZERO FILL NAME                #
        LCFLFN[0] = CTEMP;             # PUT FILE NAME IN FET          #
        REWIND(LCFFET);                # REWIND THE LCF FILE           #
        RECALL(LCFFET); 
        END 
      ELSE                   # LABEL ERRORS DETECTED                   #
        BEGIN 
        LCFWORD0[0] = 0;     # CLEAR LCF FET                           #
        END 
      RETURN;                # **** RETURN ****                        #
      END # LFILEPR # 
      CONTROL EJECT;
      PROC OUTCLPR; 
      BEGIN 
*IF,DEF,IMS 
# 
**    OUTCLPR - OUTCALL STATEMENT PROC. 
* 
*     D.K. ENDO    81/10/30 
* 
*     THIS PROCEDURE CHECKS THE OUTCALL STMTS AND MAKES ENTRIES INTO
*     THE OUTCALL TABLE 
* 
*     PROC OUTCLPR
* 
*     ENTRY        NONE.
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     INCREMENT OUTCALL TABLE WORD COUNT. 
*     CLEAR NEXT ENTRY. 
*     SET ENTRY WORD COUNT. 
*     FOR EACH VALUE DECLARATION, 
*       SELECT CASE THAT APPLIES, 
*         CASE 1(NAME1,NAME2):  
*           IF VALUE IS O.K., 
*             PUT VALUE IN ENTRY
*         CASE 2(SNODE,DNODE,ACCLEV,DBL,ABL,DBZ): 
*           IF VALUE IS O.K., 
*             CHECK IF VALUE IS WITHIN RANGE. 
*             IF VALUE IS WITHIN RANGE, 
*               ENTER VALUE IN ENTRY
*         CASE 3(PRI):  
*           IF VALUE IS O.K., 
*             IF VALUE IS -YES-,
*               SET PRI FLAG IN ENTRY.
*     IF NAME1, NAME2,SNODE, OR DNODE WAS NOT SPECIFIED,
*       FLAG ERROR -- REQUIRED PARAMETER MISSING. 
*     IF ACCLEV ABL,DBL, OR DBZ WAS NOT SPECIFIED,
*       PUT DEFAULT VALUE IN ENTRY. 
* 
# 
*ENDIF
# 
****  PROC OUTCLPR - XREF LIST BEGINS.
# 
      XREF
        BEGIN 
        PROC NDLCKRG;        # CHECKS IF VALUE IS WITHIN RANGE         #
        PROC NDLEM2;         # MAKES ENTRY IN PASS 2 ERROR FILE        #
        FUNC XCDD C(10);     # CONVERTS DEC BINARY TO DISPLAY CODE     #
        FUNC XCHD C(10);     # CONVERTS HEX BINARY TO DISPLAY CODE     #
        END 
# 
****
# 
      DEF ABL$DEF # 2 #;     # DEFAULT ABL VALUE                       #
      DEF ACCL$DEF # 0 #;    # DEFAULT ACCLEV VALUE                    #
      DEF DNODE$MAX # 255 #; # MAXIMUM VALUE OF DENODE FOR OUTCALL     #
      DEF DBL$DEF # 2 #;     # DEFAULT DBL VALUE                       #
      DEF DBZ$DEF # 225 #;   # DEFAULT DBZ VALUE                       #
      DEF DPL$DEF # 7 #;     # DEFAULT DPL VALUE                       #
      DEF FIX$ENT # 6 #;     # SIZE OF FIXED LENGTH PORTION OF ENTRY   #
      DEF MINFAC # 4 #;      # MINIMUM LENGTH FOR EACH FACILITY CODE   #
      DEF MXFAC # 12 #;      # MAX LENGTH FOR EACH FACILITY CODE       #
      DEF MXUDATA # 248 #;   # MAX LENGTH OF UDATA                     #
      DEF MXFACL # 126 #;    # TOTAL MAX LENGTH FOR ALL FACILITIES     #
      DEF MXDTEA # 15 #;     # MAX LENGTH OF DTEA VALUE                #
      DEF MXOB$ENT # 50 #;   # MAXIMUM OUTCALL BLOCK ENTRY SIZE        #
      DEF MXPRID # 6 #;      # MAX LENGTH OF PRID VALUE                #
      DEF PRID$AOS # X"C0000000" #;    # DEFAULT PRID FOR DOS = AOS/VS #
      DEF PRID$DEF # X"C1000000" #;    # DEFAULT PRID VALUE            #
      DEF PRID$NVE # X"C2000000" #;    # DEFAULT PRID FOR DOS = NOS/VE #
      DEF UDL$DEF # 10 #;    # DEFAULT UDATA LENGTH VALUE              #
      DEF UBL$DEF # 2 #;     # DEFAULT UBL VALUE                       #
      DEF UBZ$DEF #  2  #;   # DEFAULT UBZ VALUE                       #
      DEF UBZMUL # 100 #;    # MULTIPLE WITH WHICH UBZ IS ENCODED      #
      DEF W$DEF # 2 #;       # DEFAULT -W- VALUE                       #
      DEF ZERO # O"33" #;    # DISPLAY CODE ZERO                       #
      DEF SHST$LEN # 24 #;   # LENGTH OF THE SHOST IN BITS             #
      DEF UDL$BIT # 32 #;    # START BIT OF UDL DATA FOR TRANSLATION   #
      DEF WORDSIZE # 60 #;   # WORD SIZE OF 60 BITS                    #
      DEF MXSTRINGW # 14 #;  # MAXIMUM NUMBER OF WORDS FOR DOMAIN/SERV #
      DEF MXOSTYPE # 10 #;   # MAXIMUM NUMBER OF OS TYPES              #
      DEF UNITSEP # X"1F" #; # UPPER CASE UNIT SEPARATOR               #
      ITEM TOTLEN;           # TOTAL LENGTH OF DOMAIN + SERVICE        #
      ITEM ABL$USED B;       # ABL SPECIFIED FLAG                      #
      ITEM ACCL$USED B;      # ACCLEV SPECIFIED FLAG                   #
      ITEM PORT$USED B;      # PORT NUMBER SPECIFIED FLAG              #
      ITEM PRID$USED  B;     # PRID SPECIFIED FLAG                     #
      ITEM SERVICE$USED B;   # SERVICE SPECIFIED FLAG                  #
      ITEM DOMAIN$USED B;    # DOMAIN SPECIFIED FLAG                   #
      ITEM CRNT$OSDID;       # CURRENT OS ORDINAL                      #
      ITEM CRNT$ORNET;       # CURRENT ORIGINATING NETWORK             #
      ITEM CRNT$DENET;       # CURRENT DESTINATION NETWORK             #
      ITEM CRNT$DOSS;        # CURRENT DESTINATION OPERATING SYSTEMS   #
      ITEM CRNT$DHST C(10);  # CURRENT DHOST VALUE                     #
      ITEM CRNT$ENT;         # POINTER TO BEGINNING OF CURRENT ENTRY   #
      ITEM CRNT$PRID;        # CURRENT PRID VALUE                      #
      ITEM UDATA$DEF C(24);  # DEFAULT UDATA SIZE                      #
      ITEM UDATAW ;          # WORD COUNT OF UDATA SPECIFIED           #
      ITEM CRNT$SHST;        # CURRENT VALUE OF SHOST                  #
      ITEM CTEMP C(10);      # CHARACTER TEMPORARY                     #
      ITEM CTEMP2 C(20);     # CHARACTER TEMPORARY                     #
      ITEM DBL$USED B;       # DBL SPECIFIED FLAG                      #
      ITEM DBZ$USED B;       # DBZ SPECIFIED FLAG                      #
      ITEM DHST$LEN;         # DHOST VALUE LENGTH                      #
      ITEM NAME1LEN;         # NAME1 VALUE LENGTH                      #
      ITEM DHST$USED B;      # DHOST SPECIFIED FLAG                    #
      ITEM SHST$USED B;      # SHOST SPECIFIED FLAG                    #
      ITEM DPLS$USED B;      # DPLS SPECIFIED FLAG                     #
      ITEM FAC$LENG;         # CURRENT TOTAL FACILITY CODE LENGTH      #
      ITEM NOMATCH B;        # NO MATCH FLAG                           #
      ITEM I;                # SCRATCH ITEM                            #
      ITEM ITEMP;            # INTEGER TEMPORARY                       #
      ITEM J;                # INTEGER TEMPORARY                       #
      ITEM  K;               # INTEGER TEMPORARY                       #
      ITEM WDC;              # WORD COUNT FOR SERVICE/DOMAIN           #
      ITEM NAM1$USED B;      # NAME1 SPECIFIED FLAG                    #
      ITEM NAM2$USED B;      # NAME2 SPECIFIED FLAG                    #
      ITEM NEXT$WORD;        # POINTER TO NEXT AVAILABLE WORD          #
      ITEM SAVE$WORD;        # COPY OF THE ORIGINAL POINTER TO NEXT    #
                             # AVAILABLE WORD                          #
      ITEM OB$STAT B;        # STATUS RETURNED BY RANGE CHECK PROC     #
      ITEM UBL$USED B;       # UBL SPECIFIED FLAG                      #
      ITEM UBZ$USED B;       # UBZ SPECIFIED FLAG                      #
      ITEM UDATA$USED B;     # UDATA SPECIFIED FLAG                    #
      ITEM WS$USED B;        # -WS- SPECIFIED FLAG                     #
      ITEM SETCHAR  B;       # FLAG FOR PASSING CHARACTER              #
      ITEM PID$USED B;       # -PID- SPECIFIED FLAG                    #
      ITEM CRUBIT;           # BIT POINTER FOR CRNT$UDATA              #
      ARRAY CRNT$UDATA [0:17] S(1); 
        BEGIN 
        ITEM CRNT$UWRD U(00,00,60);  # UDATA VALUE                     #
        END 
      ARRAY SERVICE$WD[ 0 : 14] S(1); 
        BEGIN 
        ITEM SERVICELEN  U(00,00,42);  # LENGTH OF SERVICE IN SEMIOCTET#
        ITEM SERVICELEN1 U(00,42,18);  # EXTENDED LENGTH OF SERVICE    #
        ITEM SERVICEWD    U(00,00,60);  # CONTENT OF SERVICE           #
        END 
      ARRAY ASCIICHAR [0:0] S(1); 
        BEGIN 
        ITEM ASCII$CHAR U(00,00,08);
        ITEM ASCII$CHAR1 U(00,00,04); 
        ITEM ASCII$CHAR2 U(00,04,04); 
        END 
      ARRAY DOMAIN$WD[ 0 : 14] S(1);
        BEGIN 
        ITEM DOMAINLEN  U(00,00,60);   # LENGTH OF DOMAIN  IN SEMIOCTET#
        ITEM DOMAINWD    U(00,00,60);  # CONTENT OF DOMAIN             #
        END 
      ARRAY DTEA$VAL [0:0] S(1);
        BEGIN                # DTEA VALUE                              #
        ITEM DTEA1      U(00,00,52);   # 1ST 13 NUMBERS OF DTEA VALUE  #
        ITEM DTEA2      U(00,52,08);   # 14TH NUMBER OF DTEA VALUE     #
        ITEM DTEA$WORD  I(00,00,60);
        END 
      ARRAY ERROR$WORD [0:0] S(1);     # BUFFER WORD FOR ERROR MESSAGE #
        BEGIN 
        ITEM PARAM C(0,0,4)   = ["    "];   # PARAMETER                #
        ITEM SLASH C(0,24,1)  = ["/"];
        ITEM PVALUE C(0,30,5) = ["     "];  # VALUE                    #
        END 
      STATUS ORNETWORK OUNKNOWN,OCCP,OCDCNET;  # ORIGINAL NETWORK TYPE #
  
      STATUS DESNETWORK DUNKNOWN, DCCP,DCDCNET,DAOSVS,DFOREIGN; 
                                         # DESTINATION NETWORK TYPE    #
      STATUS DOSS DOSUNKNOWN,DONOS,DONOSVE,DOAOSVS,DOFOREIGN; 
                                         # DESTINATION OPERATING SYSTEM#
      ARRAY OSDARRAY [ 0 : MXOSTYPE] S(1);
        BEGIN 
        ITEM OSDMN C(00,00,03) = [ "PPO", 
                                   "PDO", 
                                   "DPO", 
                                   "DDO", 
                                   "PDV", 
                                   "DDV", 
                                   "PAA", 
                                   "DAA", 
                                   "PFF", 
                                   "DFF", 
                                   ]; 
        ITEM OSDMN1 C(00,00,01);
        ITEM OSDMN2 C(00,06,01);
        ITEM OSDMN3 C(00,12,01);
        END 
      ARRAY DNTYPE [ 00:03] S(1); 
        BEGIN 
        ITEM DNNCHAR         C(00,00,01) = ["P","D","A","F"]; 
        ITEM DNNETV          U(00,42,18) = [ DESNETWORK"DCCP",
                                             DESNETWORK"DCDCNET", 
                                             DESNETWORK"DAOSVS",
                                             DESNETWORK"DFOREIGN" 
                                           ]; 
        END 
      ARRAY DNOSTYPE [ 00:03 ] S(1);
        BEGIN 
        ITEM DNOCHAR         C(00,00,01) = [ "O","V","A","F"];
        ITEM DNOOSV          U(00,42,18) = [ DOSS"DONOS", 
                                             DOSS"DONOSVE", 
                                             DOSS"DOAOSVS", 
                                             DOSS"DOFOREIGN"
                                           ]; 
        END 
      SWITCH OUTCJMP  NEXT$PRM    ,            , # UNK     , NODE     ,#
                                  ,            , # VARIANT , OPGO     ,#
                                  ,            , #         , LLNAME   ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # HNAME   , LOC      ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # NCNAME  , DI       ,#
                                  ,            , # N1      , P1       ,#
                                  ,            , # N2      , P2       ,#
                                  ,            , # NOLOAD1 , NOLOAD2  ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  , PORT$      , # NI      , PORT     ,#
                                  ,            , # LTYPE   , TIPTYPE  ,#
                                  ,            , # AUTO    , SL       ,#
                                  ,            , # LSPEED  , DFL      ,#
                                  ,            , # FRAME   , RTIME    ,#
                                  ,            , # RCOUNT  , NSVC     ,#
                                  ,            , # PSN     , DCE      ,#
                      DTEA$       ,            , # DTEA    ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # STIP    , TC       ,#
                                  ,            , # RIC     , CSET     ,#
                                  ,            , # TSPEED  , CA       ,#
                                  ,            , # CO      , BCF      ,#
                                  ,            , # MREC    , W        ,#
                                  ,            , # CTYP    , NCIR     ,#
                                  ,            , # NEN     ,          ,#
                                  ,            , #         , DT       ,#
                                  ,            , # SDT     , TA       ,#
                      ABL$        , DBZ$       , # ABL     , DBZ      ,#
                      UBZ$        , DBL$       , # UBZ     , DBL      ,#
                      UBL$        ,            , # UBL     , XBZ      ,#
                                  ,            , # DO      , STREAM   ,#
                                  ,            , # HN      , AUTOLOG  ,#
                                  , PRI$       , # AUTOCON , PRI      ,#
                                  ,            , # P80     , P81      ,#
                                  ,            , # P82     , P83      ,#
                                  ,            , # P84     , P85      ,#
                                  ,            , # P86     , P87      ,#
                                  ,            , # P88     , P89      ,#
                                  ,            , # AL      , BR       ,#
                                  ,            , # BS      , B1       ,#
                                  ,            , # B2      , CI       ,#
                                  ,            , # CN      , CT       ,#
                                  ,            , # DLC     , DLTO     ,#
                                  ,            , # DLX     , EP       ,#
                                  ,            , # IN      , LI       ,#
                                  ,            , # OP      , PA       ,#
                                  ,            , # PG      , PL       ,#
                                  ,            , # PW      , SE       ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                       NETOSD$    , DOMAIN$    , # NETOSD  , DOMAIN   ,#
                       SERVICE$   ,            , #         ,          ,#
                                  ,            , # MFAM    , MUSER    ,#
                                  ,            , # MAPPL   , DFAM     ,#
                                  ,            , # DUSER   ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # PAPPL   ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # UID     ,PRIV      ,#
                                  ,            , # KDSP    ,          ,#
                       NAME1$     , NAME2$     , # NAME1   , NAME2    ,#
                       SNODE$     , DNODE$     , # SNODE   , DNODE    ,#
                       ACCLEV$    , DHOST$     , # ACCLEV  , DHOST    ,#
                                  , DPLS$      , #         , DPLS     ,#
                       PRID$      , UDATA$     , # PRID    , UDATA    ,#
                                  , WS$        , #         , WS       ,#
                       PID$       ,            , # PID     ,          ,#
                                  ,            , # FAM     , UNAME    ,#
                       FAC$       , FAC$       , # FAC1    , FAC2     ,#
                       FAC$       , FAC$       , # FAC3    , FAC4     ,#
                       FAC$       , FAC$       , # FAC5    , FAC6     ,#
                       FAC$       , FAC$       , # FAC7    , FAC8     ,#
                       FAC$       , FAC$       , # FAC9    , FAC10    ,#
                       FAC$       , FAC$       , # FAC11   , FAC12    ,#
                       FAC$       , FAC$       , # FAC13   , FAC14    ,#
                       FAC$       , FAC$       , # FAC15   , FAC16    ,#
                       FAC$       , FAC$       , # FAC17   , FAC18    ,#
                       FAC$       , FAC$       , # FAC19   , FAC20    ,#
                       FAC$       , FAC$       , # FAC21   , FAC22    ,#
                       FAC$       , FAC$       , # FAC23   , FAC24    ,#
                       FAC$       , FAC$       , # FAC25   , FAC26    ,#
                       FAC$       , FAC$       , # FAC27   , FAC28    ,#
                       FAC$       , FAC$       , # FAC29   , FAC30    ,#
                       FAC$       ,            , # FAC31   , ANAME    ,#
                       SHOST$     ;              # SHOST               #
  
      CONTROL EJECT;
#                                                                      #
#                            OUTCLPR CODE BEGINS HERE                  #
#                                                                      #
      ABL$USED = FALSE;                # CLEAR PARAM SPECIFIED FLAGS   #
      PRID$USED = FALSE;
      ACCL$USED = FALSE;
      DBL$USED = FALSE; 
      DBZ$USED = FALSE; 
      DHST$USED = FALSE;
      DPLS$USED = FALSE;
      NAM1$USED = FALSE;
      NAM2$USED = FALSE;
      UBL$USED = FALSE; 
      UBZ$USED = FALSE; 
      UDATA$USED = FALSE; 
      WS$USED = FALSE;
      PID$USED = FALSE; 
      SHST$USED = FALSE;
      PORT$USED = FALSE;
      SERVICE$USED = FALSE; 
      DOMAIN$USED = FALSE;
      TOTLEN = 0; 
      SERVICEWD[0] = 0; 
      DOMAINLEN[0] = 0; 
      CRNT$ORNET = ORNETWORK"OCCP"; 
      CRNT$DENET = DESNETWORK"DCCP";
      CRNT$DOSS = DOSS"DONOS";
      PP$SNODE = 0; 
      PP$DNODE = 0; 
      PP$PORT = 0;
      PP$DTEAL = 0; 
      PP$DTEA = 0;
      CRNT$PID = " ";        # BLANK FILL CURRENT PID VALUE            #
      UDATA$DEF = " ";
      CRNT$PRID = PRID$DEF;  # SET CURRENT PRID VALUE TO DEFAULT       #
      DHST$LEN = 0;          # CLEAR DHOST LENGTH VALUE                #
      FAC$LENG = 0;          # CLEAR CURRENT FAC LENGTH                #
      CRNT$ENT = OBRWC[1] + 1;         # POINT TO NEXT ENTRY           #
      IF OBRWC[1]+MXOB$ENT GQ OB$LENG-1 
      THEN                   # IF NEED MORE TABLE SPACE                #
        BEGIN                #  ALLOCATE MORE SPACE                    #
        SSTATS(P<OUTCALL$TABL>,MXOB$ENT); 
        END 
      NEXT$WORD = CRNT$ENT + FIX$ENT;  # POINT TO NEXT WORD            #
      FOR I=CRNT$ENT STEP 1 UNTIL NEXT$WORD-1 
      DO
        BEGIN 
        OBWORD[I] = 0;                 # CLEAR NEXT ENTRY              #
        END 
      OBWC[CRNT$ENT] = FIX$ENT;        # SET ENTRY WORD COUNT          #
      FOR I=1 STEP 1 UNTIL STWC[0]     # FOR EACH VALUE DECLARATION    #
      DO
        BEGIN 
        GOTO OUTCJMP[STKWID[I]];       # GOTO APPROPRIATE PARAGRAPH    #
NAME1$: 
        NAM1$USED = TRUE;              # SET NAME1 SPECIFIED FLAG      #
        NAME1LEN = STVALLEN[I];        # SAVE LENGTH OF APPLICATIONS   #
        IF NOT STVLERR[I]              # IF THE VALUE IS O.K.          #
        THEN
          BEGIN                        # ENTER NAME1 VALUE IN ENTRY    #
          OBNAME1[CRNT$ENT + 1] = STVALNAM[I];
          END 
        TEST I; 
NAME2$: 
        NAM2$USED = TRUE;              # SET NAME2 SPECIFIED FLAG      #
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN                        # ENTER NAME2 VALUE IN ENTRY    #
          OBNAME2[CRNT$ENT + 1] = STVALNAM[I];
          END 
        TEST I; 
PRI$: 
        IF NOT STVLERR[I]              # IF PRI VALUE IS O.K.          #
        THEN
          BEGIN 
          IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
          THEN
            BEGIN                      # SET PRI FLAG IN ENTRY         #
            OBPRI[CRNT$ENT + 2] = TRUE; 
            END 
          END 
        TEST I; 
DBL$: 
        DBL$USED = TRUE;               # SET DBL SPECIFIED FLAG        #
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN                        # CHECK IF VALUE IS WITHIN RANGE#
          NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); 
          IF OB$STAT                   # IF WITHIN RANGE               #
          THEN
            BEGIN                      # PUT DBL VALUE IN ENTRY        #
            OBDBL[CRNT$ENT + 2] = STVALNUM[I];
            END 
          END 
        TEST I; 
DBZ$: 
        DBZ$USED = TRUE;               # SET DBZ SPECIFIED FLAG        #
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN                        # CHECK IF VALUE WITHIN RANGE   #
          NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); 
          IF OB$STAT                   # IF WITHIN RANGE               #
          THEN
            BEGIN                      # PUT DBZ VALUE IN ENTRY        #
            OBDBZ[CRNT$ENT + 2] = STVALNUM[I];
            END 
          END 
        TEST I; 
UBL$: 
        UBL$USED = TRUE;               # SET UBL SPECIFIED FLAG        #
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN                        # CHECK IF VALUE IS WITHIN RANGE#
          NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); 
          IF OB$STAT                   # IF WITHIN RANGE               #
          THEN
            BEGIN                      # PUT VALUE IN ENTRY            #
            OBUBL[CRNT$ENT + 2] = STVALNUM[I];
            END 
          END 
        TEST I; 
UBZ$: 
        UBZ$USED = TRUE;               # SET UBZ SPECIFIED FLAG        #
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN                        # CHECK IF VALUE IS WITHIN RANGE#
          NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); 
          IF OB$STAT                   # IF WITHIN RANGE               #
          THEN
            BEGIN            # PUT VALUE IN ENTRY                      #
            OBUBZ[CRNT$ENT + 2] = STVALNUM[I];
            END 
          END 
        TEST I; 
ABL$: 
        ABL$USED = TRUE;               # SET ABL SPECIFIED FLAG        #
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN                        # CHECK IF VALUE WITHIN RANGE   #
          NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); 
          IF OB$STAT                   # IF WITHIN RANGE               #
          THEN
            BEGIN                      # PUT ABL VALUE IN ENTRY        #
            OBABL[CRNT$ENT + 2] = STVALNUM[I];
            END 
          END 
        TEST I; 
SNODE$: 
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN                        # CHECK IF VALUE WITHIN RANGE   #
          NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); 
          IF OB$STAT                   # IF WITHIN RANGE               #
          THEN
            BEGIN                      # PUT SNODE VALUE IN ENTRY      #
            OBSNODE[CRNT$ENT + 3] = STVALNUM[I];
            PP$SNODE = STVALNUM[I];    # SAVE SNODE IN PP$SNODE        #
            END 
          END                          # FOR PATH PID TABLE            #
        TEST I; 
PORT$:  
        IF NOT STVLERR[I] 
        THEN                 # IF VALUE IS O.K.                        #
          BEGIN 
          IF STVALNUM[I] LQ X"FE" 
          THEN               # IF VALUE IS WITHIN RANGE                #
            BEGIN 
            OBPORT[CRNT$ENT + 2] = STVALNUM[I];      # ENTRY PORT NUM  #
            PP$PORT = STVALNUM[I]; # PORT NUMBER USED BY PATH PID TABLE#
            END 
          ELSE               # VALUE IS TOO BIG                        #
            BEGIN            # FLAG ERROR -- VALUE OUT OF RANGE        #
            CTEMP = XCHD(STVALNUM[I]);
            NDLEM2(ERR100,STLNUM[0],CTEMP); 
            END 
          END 
        TEST I; 
WS$:  
        WS$USED = TRUE;      # SET -WS- SPECIFIED FLAG                 #
        IF NOT STVLERR[I] 
        THEN                 # IF VALUE IS O.K.                        #
          BEGIN              # CHECK IF VALUE IS WITHIN RANGE          #
          NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); 
          IF OB$STAT
          THEN               # IF VALUE IS WITHIN RANGE                #
            BEGIN 
            OBWS[CRNT$ENT + 3] = STVALNUM[I];     # ENTER -WS- VALUE   #
            END 
          END 
        TEST I; 
DPLS$:  
        DPLS$USED = TRUE;    # SET DPLS SPECIFIED FLAG                 #
        IF NOT STVLERR[I] 
        THEN                 # IF VALUE IS O.K.                        #
          BEGIN              # CHECK IF VALUE IS WITHIN RANGE          #
          NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); 
          IF OB$STAT
          THEN               # IF VALUE IS WITHIN RANGE                #
            BEGIN            # CALCULATE VALUE (POWER OF TWO)          #
            ITEMP = 16;      # SET TO SMALLEST DPL VALUE               #
            FOR J=4 STEP 1 WHILE ITEMP LS STVALNUM[I] 
            DO               # FOR INCREMENT OF EXPONENT               #
              BEGIN 
              ITEMP = ITEMP * 2;       # SET TO NEXT POWER OF TWO      #
              END 
            OBDPLS[CRNT$ENT + 3] = J;  # PUT VALUE IN ENTRY            #
            IF STVALNUM[I] NQ ITEMP 
            THEN                       # VALUE IS NOT POWER OF 2       #
              BEGIN                    # FLAG WARNING                  #
              PARAM[0]  = "DPLS";      # PARAMETER NAME                #
              CTEMP     = XCDD(ITEMP);
              PVALUE[0] = C<5,5>CTEMP; # VALUE                         #
              NDLEM2(ERR137,STLNUM[0],ERROR$WORD);
              END 
            END 
          END 
        TEST I; 
DNODE$: 
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN                        # CHECK IF VALUE WITHIN RANGE   #
          OB$STAT = TRUE; 
          IF (STVALNUM[I] LS 0) OR (STVALNUM[I] GR DNODE$MAX) 
          THEN
            BEGIN 
            OB$STAT = FALSE;
            NDLEM2(ERR100,STLNUM[0],XCDD(STVALNUM[I])); 
            END                      # GENERATE ERROR MESSAGE          #
          IF OB$STAT                 # IF WITHIN RANGE                 #
          THEN
            BEGIN                      # PUT DNODE VALUE IN ENTRY      #
            OBDNODE[CRNT$ENT + 3] = STVALNUM[I];
            PP$DNODE = STVALNUM[I];  # SAVE DNODE IN PP$DNODE FOR      #
            END                      # PATH PID TABLE                  #
          END 
        TEST I; 
PID$: 
        PID$USED = TRUE;               # SET NAME2 SPECIFIED FLAG      #
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN                        # ENTER NAME2 VALUE IN ENTRY    #
          CRNT$PID = STVALNAM[I];      # SAVE VALUE OF CURRENT PID     #
          OBNAME2[CRNT$ENT + 1] = STVALNAM[I];
          OBPID[CRNT$ENT + 2] = TRUE;  # SET PID USED FLAG             #
          END 
        TEST I; 
ACCLEV$:  
        ACCL$USED = TRUE;              # SET ACCLEV SPECIFIED FLAG     #
        IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
        THEN
          BEGIN                        # CHECK IF VALUE WITHIN RANGE   #
          NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); 
          IF OB$STAT                   # IF WITHIN RANGE               #
          THEN
            BEGIN                      # PUT ACCLEV VALUE IN ENTRY     #
            OBACC[CRNT$ENT + 3] = STVALNUM[I];
            END 
          END 
        TEST I; 
SHOST$: 
        SHST$USED = TRUE;          # SET SHOST SPECIFIED FLAG          #
        IF NOT STVLERR[I]          # IF VALUE IS O.K.                  #
        THEN
          BEGIN 
          NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT);  # CHECK RANGE       #
          IF OB$STAT               # IF RANGE IS O.K.                  #
          THEN
            BEGIN 
            CRNT$SHST = STVALNUM[I];  # ASSIGN STVALNUM IS CURRENT     #
                                    # SHOST                            #
            END 
          END 
        TEST I; 
  
DHOST$: 
        DHST$USED = TRUE;    # SET DHOST SPECIFIED FLAG                #
        IF NOT STVLERR[I] 
        THEN                 # IF VALUE IS O.K.                        #
          BEGIN 
          NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); # CHECKS RANGE       #
          IF OB$STAT                              # IF RANGE IS OK     #
          THEN
            BEGIN 
            CTEMP = XCHD(STVALNUM[I]); #CONVERTS TO HEX#
            DC$ZFILL(CTEMP);           #ZERO FILL CTEMP#
            CRNT$DHST = C<8,2>CTEMP;   #MOVE CTEMP TO DHST# 
            DHST$LEN = 2;              #MUST BE 2 CHAR LONG#
            END 
          ELSE
            BEGIN                  #     STICKS IN VALUES OF DHST$LEN  #
            DHST$LEN = 2;          # DHST$LEN LEFT EAULT TO 2          #
            CRNT$DHST = " ";       # BLANK FILLED CRNT$DHST            #
            END 
          END 
        TEST I; 
DTEA$:  
        IF NOT STVLERR[I] 
        THEN                 # IF VALUE IS O.K.                        #
          BEGIN 
          CTEMP2 = STVALNAM[I];        # CONCATINATE NEXT TWO VALUES   #
          C<7,7>CTEMP2 = STVALNAM[I+1];# GET NEXT 7 CHARACTER          #
          C<14,1>CTEMP2 = STVALNAM[I + 2]; # GET NEXT ONE CHAR         #
          IF STVALLEN[I] LQ MXDTEA
          THEN               # IF VALUE IS WITHIN RANGE                #
            BEGIN 
            OBAL1[CRNT$ENT + 4] = STVALLEN[I];
            PP$DTEAL = OBAL1[CRNT$ENT + 4];  # SAVE DTEA LENGTH        #
            ITEMP = CRNT$ENT + 4;      # POINT TO DTEA WORD            #
            DTEA$WORD[0] = 0;          # CLEAR DTEA VALUE TEMPORARY    #
            FOR J=0 STEP 1 UNTIL STVALLEN[I] - 1
            DO               # FOR EACH CHARACTER IN VALUE             #
              BEGIN          #   CONVERT CHARACTER TO 4-BIT BCD        #
              B<J*4,4>DTEA$WORD[0] = C<J,1>CTEMP2 - ZERO; 
              END 
            PP$DTEA = DTEA$WORD[0];  # SAVE DTEA FOR PATH PID ENTRY    #
            OBDTEA1[ITEMP] = DTEA1[0]; # PUT VALUE IN ENTRY            #
            OBDTEA2[ITEMP + 1] = DTEA2[0];
            END 
          ELSE               # VALUE IS TOO BIG                        #
            BEGIN            # FLAG ERROR -- VALUE OUT OF RANGE        #
            NDLEM2(ERR100,STLNUM[0],CTEMP2);
            END 
          END 
        I = I + 2;
        TEST I; 
FAC$: 
        IF NOT STVLERR[I] 
        THEN                 # IF VALUE IS O.K.                        #
          BEGIN 
          IF STVALLEN[I] GQ MINFAC AND STVALLEN[I] LQ MXFAC 
          THEN               # IF VALUE IS WITHIN RANGE                #
            BEGIN            #   INCREMENT FAC COUNT                   #
            OBFACNUM[CRNT$ENT + 3] = OBFACNUM[CRNT$ENT + 3] + 1;
            OBWORD[NEXT$WORD] = 0;     # CLEAR NEXT WORD               #
            OBFACL[NEXT$WORD] = STVALLEN[I];   # SAVE LENGTH           #
            ITEMP = STVALLEN[I] * 4;   # CALCULATE MASK                #
            B<0,ITEMP>OBFAC[NEXT$WORD] = B<60-ITEMP,ITEMP>STWORD[I+1 ]; 
            OBWC[CRNT$ENT] = OBWC[CRNT$ENT] + 1; # INCREMENT WORD COUNT#
            FAC$LENG = FAC$LENG + STVALLEN[I];   # INCREMENT FAC LENGTH#
            NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD            #
            OBWORD[NEXT$WORD] = 0;
            END 
          ELSE               # VALUE IS TOO BIG                        #
            BEGIN            # FLAG ERROR -- VALUE OUT OF RANGE        #
            CTEMP = XCHD(STWORD[I + 1]);
            NDLEM2(ERR100,STLNUM[0],CTEMP); 
            END 
          END 
        I = I + 1;
        TEST I; 
NETOSD$:  
        IF NOT STVLERR[I] 
        THEN                 # IF VALUE IS O.K.                        #
          BEGIN 
          NOMATCH = TRUE;    # SET NOMATCH FLAG                        #
          OSDMN[MXOSTYPE] = C<0,3>STVALNAM[I]; # PRELOAD PARAMETER WORD#
          FOR K = 0 STEP 1 WHILE NOMATCH
          DO
            BEGIN 
            IF OSDMN[K] EQ  C<0,3>STVALNAM[I] 
            THEN
              BEGIN 
              NOMATCH = FALSE;  # EXIT LOOP MATCH FOUND                #
              CRNT$OSDID = K; 
              END 
            END 
          IF CRNT$OSDID EQ MXOSTYPE 
          THEN
            BEGIN 
            NDLEM2(ERR168,STLNUM[0],STVALNAM[I]); 
            END 
          IF OSDMN1[CRNT$OSDID] EQ "P"
          THEN
            BEGIN 
            CRNT$ORNET = ORNETWORK"OCCP";  # CCP IS THE ORGINAL NETWORK#
            END 
          ELSE
            BEGIN 
            CRNT$ORNET = ORNETWORK"OCDCNET"; # MUST BE CDCNET          #
            END 
          FOR K = 0 STEP 1 UNTIL 3
          DO
            BEGIN 
            IF OSDMN2[CRNT$OSDID] EQ DNNCHAR[K] 
            THEN
              BEGIN 
              CRNT$DENET = DNNETV[K]; 
              END 
            END 
          FOR K = 0 STEP 1 UNTIL 3
          DO
            BEGIN 
            IF OSDMN3[CRNT$OSDID] EQ DNOCHAR[K] 
            THEN
              BEGIN 
              CRNT$DOSS = DNOOSV[K];
              END 
            END 
          END 
        TEST I; 
  
SERVICE$: 
        SERVICE$USED = TRUE;  # SET SERVICE USED FLAG                  #
        IF NOT STVLERR[I]    # IF VALUE IS O.K.                        #
        THEN
          BEGIN 
          IF TOTLEN + STVALNUM[I] LQ MXUDATA  # VALUE LENGTH O.K.      #
          THEN
            BEGIN 
            WDC = STVALNUM[I]/10 + 1;  # CALCULATE WORD COUNT          #
            TOTLEN = TOTLEN + STVALNUM[I]; # TOTLEN = DOMAIN + SERVICE #
            SERVICELEN[0] = STVALNUM[I]; # SAVE LENGTH OF SERVICE      #
            FOR K = 1 STEP 1 UNTIL WDC
            DO
              BEGIN 
              SERVICEWD[K] = STWORD[I + K]; # SAVE WORDS               #
              END 
            END 
          ELSE
            BEGIN 
            NDLEM2(ERR100,STLNUM[0],"SERVICE"); 
            END 
          END 
        I = I + MXSTRINGW;
        TEST I; 
DOMAIN$:  
        DOMAIN$USED = TRUE;  # SET DOMAIN  USED FLAG                   #
        IF NOT STVLERR[I]    # IF VALUE IS O.K.                        #
        THEN
          BEGIN 
          IF TOTLEN + STVALNUM[I] LQ MXUDATA  # VALUE LENGTH O.K.      #
          THEN
            BEGIN 
            WDC = STVALNUM[I]/10 + 1;  # CALCULATE WORD COUNT          #
            TOTLEN = TOTLEN + STVALNUM[I]; # TOTLEN = DOMAIN + SERVICE #
            DOMAINLEN[0] = STVALNUM[I];  # SAVE LENGTH OF SERVICE      #
            FOR K = 1 STEP 1 UNTIL WDC
            DO
              BEGIN 
              DOMAINWD[K] = STWORD[I + K]; # SAVE WORDS                #
              END 
            END 
          ELSE
            BEGIN 
            NDLEM2(ERR100,STLNUM[0],"DOMAIN");
            END 
          END 
        I = I + MXSTRINGW;
        TEST I; 
PRID$:  
        PRID$USED = TRUE;    # SET PRID SPECIFIED FLAG                 #
        IF NOT STVLERR[I] 
        THEN                 # IF VALUE IS O.K.                        #
          BEGIN              #   CHECK IF VALUE IS WITHIN RANGE        #
          IF STVALLEN[I] LQ MXPRID
          THEN               # IF VALUE IS IN RANGE                    #
            BEGIN            #   SAVE VALUE LEFT-JUSTIFIED ZERO FILLED #
            CRNT$PRID = STVALNUM[I] * (16**(MXPRID + 2  - STVALLEN[I]));
            END 
          ELSE               # VALUE TOO LARGE                         #
            BEGIN            # FLAG ERROR -- VALUE OUT OF RANGE        #
            CTEMP = XCHD(STVALNUM[I]);
            NDLEM2(ERR100,STLNUM[0],CTEMP); 
            END 
          END 
        TEST I; 
UDATA$: 
        UDATA$USED = TRUE;   # SET UDATA SPECFIED FLAG                 #
        IF NOT STVLERR[I] 
        THEN
          BEGIN 
          IF TOTLEN + STVALNUM[I] LQ MXUDATA
          THEN
            BEGIN                      # STORE LENGTH                  #
            OBUDL[CRNT$ENT + 3] = STVALNUM[I];
                                       # STORE 10-CHAR ENTRIES         #
            IF OBUDL[CRNT$ENT + 3] GR 0  # IF NOT NONE SPECIFIED       #
            THEN
              BEGIN 
              UDATAW = (OBUDL[CRNT$ENT + 3]*4 + 56)/60;  # WORD COUNT  #
              FOR J = 0 STEP 1 WHILE J LQ UDATAW - 1
              DO
                BEGIN 
                CRNT$UWRD[J] =  STWORD[I + J + 1]; #AVAIL SPACE POINTER#
                END 
              END 
            END 
          ELSE
            BEGIN 
            CTEMP = " ";
            NDLEM2(ERR100,STLNUM[0],CTEMP);  # VALUE OUT OF RANGE   # 
            END 
          END 
          I = I + MAXUDATW; 
          TEST I; 
NEXT$PRM: 
        END 
      IF NOT NAM1$USED                 # IF NAME1 NOT SPECIFIED        #
      THEN
        BEGIN                # FLAG ERROR -- REQUIRED PARAMETER MISSING#
        NDLEM2(ERR103,STLNUM[0],"NAME1"); 
        END 
      IF NOT NAM2$USED                 # IF NAME2 NOT SPECIFIED        #
      THEN
        BEGIN 
        IF NOT PID$USED                # IF PID NOT SPECIFIED TOO      #
        THEN
          BEGIN 
          NDLEM2(ERR165,STLNUM[0]," ");  # EITHER NAME2 OR PID REQUIRED#
          END 
        ELSE
          BEGIN 
          PIDPR;                       # CALL THE ROUTINE TO PROCESS   #
          END                          # PID                           #
        END 
      ELSE                             # NAME2 USED                    #
        BEGIN 
        IF PID$USED                    # IF PID SPECIFIED TOO          #
        THEN
          BEGIN 
          NDLEM2(ERR164,STLNUM[0]," ");  # GENERATE ERROR MESSAGE      #
          END 
        END 
      IF NOT ACCL$USED                 # IF ACCLEV NOT SPECIFIED       #
      THEN
        BEGIN                          # PUT ACCLEV DEFAULT IN ENTRY   #
        OBACC[CRNT$ENT + 3] = ACCL$DEF; 
        END 
      IF NOT DBL$USED                  # IF DBL NOT SPECIFIED          #
      THEN
        BEGIN                          # PUT DBL DEFAULT IN ENTRY      #
        OBDBL[CRNT$ENT + 2] = DBL$DEF;
        END 
      IF NOT ABL$USED                  # IF ABL NOT SPECIFIED          #
      THEN
        BEGIN                          # PUT ABL DEFAULT IN ENTRY      #
        OBABL[CRNT$ENT + 2] = ABL$DEF;
        END 
      IF NOT DBZ$USED                  # IF DBZ NOT SPECIFIED          #
      THEN
        BEGIN                          # PUT DBZ DEFAULT IN ENTRY      #
        OBDBZ[CRNT$ENT + 2] = DBZ$DEF;
        END 
      IF NOT UBL$USED                  # IF UBL WAS NOT SPECIFIED      #
      THEN
        BEGIN                # PUT DEFAULT VALUE IN ENTRY              #
        OBUBL[CRNT$ENT + 2] = UBL$DEF;
        END 
      IF NOT UBZ$USED                  # IF UBZ WAS NOT SPECIFIED      #
      THEN
        BEGIN                # PUT DEFAULT VALUE IN ENTRY              #
        OBUBZ[CRNT$ENT + 2] = UBZ$DEF;
        END 
      IF NOT WS$USED
      THEN                   # IF -WS- WAS NOT SPECIFIED               #
        BEGIN 
        OBWS[CRNT$ENT + 3] = W$DEF;    # PUT DEFAULT VALUE IN ENTRY    #
        END 
      IF CRNT$DOSS NQ DOSS"DONOSVE"  # IF DESTINATION OS ISNOT NOSVE   #
         AND
         CRNT$DOSS NQ DOSS"DOFOREIGN" 
      THEN
        BEGIN 
        SERVICE$USED = FALSE;      # IGNORE SERVICE AND DOMAIN         #
        DOMAIN$USED = FALSE;
        END 
      IF NOT DPLS$USED
      THEN                   # IF DPLS WAS NOT SPECIFIED               #
        BEGIN 
        OBDPLS[CRNT$ENT + 3] = DPL$DEF; # PUT DEFAULT VALUE IN ENTRY   #
        END 
     IF NOT SERVICE$USED AND DOMAIN$USED
     THEN                           # IF DOMAIN SPECIFIED THEN SERVICE #
       BEGIN                        # MUST BE SPECIFIED                #
       NDLEM2(ERR170,STLNUM[0]," ");
       END
     IF SERVICE$USED               # IF SERVICE USED                   #
     THEN 
       BEGIN
       IF DHST$USED                # IF DHOST USED                     #
       THEN 
         BEGIN
         NDLEM2(ERR171,STLNUM[0]," ");   # DHOST IS INVALID            #
         END
       END
     IF NOT DHST$USED        # IF DHOST NOT USED                       #
     THEN 
       BEGIN
       IF NOT UDATA$USED     # IF UDATA NOT PRESENT                    #
       THEN 
         BEGIN
         IF CRNT$DOSS EQ DOSS"DONOS"  # ORIGINATING OS IS NOS          #
         THEN 
           BEGIN
           IF CRNT$ORNET EQ ORNETWORK"OCDCNET" OR 
              CRNT$DENET EQ DESNETWORK"DCDCNET" 
           THEN 
             BEGIN
             NDLEM2(ERR169,STLNUM[0]," ");
             END
           END
         END
       END
     IF NOT PRID$USED 
     THEN 
       BEGIN
       IF CRNT$DOSS EQ DOSS"DONOSVE"
       THEN 
         BEGIN
         CRNT$PRID = PRID$NVE;
         END
       ELSE 
         BEGIN
         IF CRNT$DOSS EQ DOSS"DOAOSVS"
         THEN 
           BEGIN
           CRNT$PRID = PRID$AOS;
           END
         END
       END
      IF NOT DHST$USED
      THEN                   # IF DHOST WAS NOT SPECIFIED              #
        BEGIN                # CONVERT DNODE TO DISPLAY CODE           #
        CTEMP = XCHD(OBDNODE[CRNT$ENT + 3]);
        DC$ZFILL(CTEMP);               # DISPLAY CODE ZERO FILL VALUE  #
        CRNT$DHST = C<8,2>CTEMP;       # SAVE DEFAULT DHOST VALUE      #
        DHST$LEN = 2;                  # SAVE LENGTH OF VALUE          #
        END 
      IF FAC$LENG GR MXFACL 
      THEN                   # IF TOTAL FAC LENGTH IS TOO BIG          #
        BEGIN                # FLAG ERROR -- FAC LENGTH EXCEEDS LIMIT  #
        NDLEM2(ERR153,STLNUM[0]," "); 
        END 
#                            INSERT PRID AND UDATA VALUE INTO ENTRY    #
      OBWC[CRNT$ENT] = OBWC[CRNT$ENT] + 1; # INCREMENT WORD COUNT      #
      OBWORD[NEXT$WORD] = 0;           #  CLEAR NEXT WORD              #
      OBPRID[NEXT$WORD] = CRNT$PRID;   # INSERT PRID VALUE             #
      IF NOT UDATA$USED AND NOT SERVICE$USED AND NOT DOMAIN$USED
      THEN                   # NO UDATA AND NO SERVICE SPECIFIED       #
        BEGIN 
        IF CRNT$DENET EQ  DESNETWORK"DAOSVS"
        THEN                 # CYBER 120 DEFAULTS                      #
          BEGIN 
          OBUDL[CRNT$ENT + 3] = NAME1LEN;   # LENGTH OF NAME1          #
          UDATA$DEF = OBNAME1[CRNT$ENT + 1];
          END                # END OF CYBER 120 DEFAULTS               #
        ELSE
          BEGIN     # REGULAR DEFAULTS                                 #
          OBUDL[CRNT$ENT+3] = (UDL$DEF + DHST$LEN)*2; 
                                      # STORE DEFUALT UDL LENGTH       #
  
          CTEMP = XCDD(OBSNODE[CRNT$ENT+3]);  # CONVERT SNODE VALUE    #
          DC$ZFILL(CTEMP);             # ZERO FILL VALUE               #
          UDATA$DEF =  C<7,3>CTEMP;    # PUT SNODE VALUE IN UDATA      #
          C<3,DHST$LEN>UDATA$DEF =  CRNT$DHST; # PUT DHOST VALUE IN UDA#
          I = 3 + DHST$LEN;    # CALCULATE CURRENT CHARACTER COUNT     #
          C<I,7>UDATA$DEF =  OBNAME1[CRNT$ENT + 1]; # PUT NAME1 IN UDAT#
          END                  # END OF REGULAR DEFAULTS               #
        ITEMP = 32;            # POINT TO BEGINNING OF UDATA FIELD     #
        SAVE$WORD = NEXT$WORD;  # SAVE NEXT$WORD TO POINT TO THE       #
                                # START OF UDATA                       #
        FOR I=0 STEP 1 UNTIL OBUDL[CRNT$ENT + 3] - 1
        DO                     # FOR EACH CHARACTER IN UDATA VALUE     #
          BEGIN 
          IF ITEMP LS 56
          THEN                 # IF STILL ROOM TO PUT A CHARACTER      #
            BEGIN              # CONVERT TO ASCII AND PUT IN ENTRY     #
            B<ITEMP,8>OBUDATA[NEXT$WORD] = A$CHAR[C<I,1>UDATA$DEF]; 
            ITEMP = ITEMP + 8; # POINT TO NEXT POSITION                #
            END 
          ELSE                 # WHOLE CHARATER CAN NOT FIT            #
            BEGIN 
            IF ITEMP EQ 56
            THEN               # IF HALF A CHARACTER CAN FIT           #
              BEGIN            #   PUT FIRST HALF IN CURRENT WORD      #
             B<ITEMP,4>OBUDATA[NEXT$WORD]=B<0,4>A$CHAR[C<I,1>UDATA$DEF];
              NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD          #
              OBWORD[NEXT$WORD] = 0;     # CLEAR NEXT WORD             #
              OBWC[CRNT$ENT]=OBWC[CRNT$ENT] + 1; # INCREMENT WORD COUNT#
              ITEMP = 4;                 # POINT TO NEXT POSITION      #
              B<0,4>OBUDATA[NEXT$WORD] = B<4,4>A$CHAR[C<I,1>UDATA$DEF]; 
              END 
            ELSE               # NO MORE ROOM IN CURRENT WORD          #
              BEGIN 
              NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD          #
              OBWORD[NEXT$WORD] = 0;     # CLEAR NEXT WORD             #
              OBWC[CRNT$ENT] = OBWC[CRNT$ENT]+1; # INCREMENT WORD COUNT#
              ITEMP = 8;                 # POINT TO NEXT POSITION      #
              B<0,8>OBUDATA[NEXT$WORD] = A$CHAR[C<I,1>UDATA$DEF]; 
              END 
            END 
          END                      # END OF FOR LOOP                   #
        IF CRNT$DENET EQ DESNETWORK"DAOSVS" 
        THEN
          BEGIN 
          OBUDL[CRNT$ENT + 3] = OBUDL[CRNT$ENT + 3]*2;
          END 
        IF SHST$USED               #  IF SHOST SPECIFIED               #
        THEN
          BEGIN 
          IF CRNT$DENET NQ DESNETWORK"DAOSVS" 
          THEN                     # FOR NON-CYVBER 120 MACHINES       #
            BEGIN 
            B<UDL$BIT,SHST$LEN>OBUDATA[SAVE$WORD] = CRNT$SHST;
            END 
                                   # OVERWRITE THE EARLIER ASCII TRANS #
          END 
        END                        # END OF NOT UDATA$USED             #
      ELSE
        BEGIN                      # UDATA OR SERVICE OR DOMAIN SPECIFI#
        ITEMP = 32; 
        CRUBIT = 0;                # SET START BIT FOR UDATA           #
        IF SERVICELEN[0] GR 0      # SERVICE SPECIFIED                 #
        THEN
          BEGIN 
          I = 1;
          IF NOT DOMAIN$USED
          THEN
            BEGIN 
            IF UDATA$USED 
            THEN
              BEGIN                # ADD 2 *US*                        #
              SERVICELEN1[0] = 1; 
              END 
            END 
          FOR J = 0 STEP 1 UNTIL SERVICELEN[0] + SERVICELEN1[0] 
          DO
            BEGIN 
            IF J GQ SERVICELEN[0]  # CHECK IF *US* NEEDED              #
            THEN
              BEGIN 
              IF DOMAIN$USED OR UDATA$USED  # IF FOLLOWED BY DOMAIN    #
              THEN
                BEGIN 
                ASCII$CHAR[0] = UNITSEP; # ADD 1 *US* FOR DOMAIN       #
                                     # AND UDATA BOTH USED             #
                                     # ADD 2 *US* FOR DOMAIN NOT USED  #
                                     # AND UDATA USED                  #
                TOTLEN = TOTLEN + 1; # BUMP TOKLEN                     #
                SETCHAR = TRUE;      # SET SETCHAR FLAG                #
                END 
              ELSE
                BEGIN 
                SETCHAR = FALSE;      # NOT TO STORE CHAR IN OBUDATA   #
                END 
              END 
            ELSE
              BEGIN 
              SETCHAR = TRUE; 
              WDC = B<CRUBIT,6>SERVICEWD[I];  # PACK IT IN ASCII       #
              ASCII$CHAR[0] = A$CHAR[WDC];
              END 
            IF SETCHAR          # O.K. TO STORE CHAR IN OBUDATA        #
            THEN
              BEGIN 
              IF ITEMP LS 56
              THEN             # IF STILL ROOM TO PUT A CHARACTER      #
                BEGIN          # CONVERT TO ASCII AND PUT IN ENTRY     #
                B<ITEMP,8>OBUDATA[NEXT$WORD] = ASCII$CHAR[0]; 
                ITEMP = ITEMP + 8; # POINT TO NEXT POSITION            #
                END 
              ELSE             # WHOLE CHARATER CAN NOT FIT            #
                BEGIN 
                IF ITEMP EQ 56
                THEN           # IF HALF A CHARACTER CAN FIT           #
                  BEGIN        #   PUT FIRST HALF IN CURRENT WORD      #
                  B<ITEMP,4>OBUDATA[NEXT$WORD]=ASCII$CHAR1[0];
                  NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD      #
                  OBWORD[NEXT$WORD] = 0;     # CLEAR NEXT WORD         #
                  OBWC[CRNT$ENT]=OBWC[CRNT$ENT] + 1; # INCREMENT WORD C#
                  ITEMP = 4;             # POINT TO NEXT POSITION      #
                  B<0,4>OBUDATA[NEXT$WORD] = ASCII$CHAR2[0];
                  END 
                ELSE           # NO MORE ROOM IN CURRENT WORD          #
                  BEGIN 
                  NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD      #
                  OBWORD[NEXT$WORD] = 0;     # CLEAR NEXT WORD         #
                  OBWC[CRNT$ENT] = OBWC[CRNT$ENT]+1; # INCREMENT WORD C#
                  ITEMP = 8;               # POINT TO NEXT POSITION    #
                  B<0,8>OBUDATA[NEXT$WORD] = ASCII$CHAR[0]; 
                  END 
                END 
              END                 # END OF SETCHAR                     #
            CRUBIT = CRUBIT + 6;  # BUMP BIT INDEX                     #
            IF CRUBIT EQ WORDSIZE  # WORD BOUNDARY REACHED             #
            THEN
              BEGIN 
              CRUBIT = 0;    # CLEAR BIT INDEX                         #
              I = I + 1;     # BUMP WORD INDEX FOR SERVICEWD           #
              END 
            END              # END OF FOR                              #
          END                # END OF SERCIELEN GR 0                   #
        IF DOMAINLEN[0] GR 0 # DOMAIN SPECIFIED                        #
        THEN
          BEGIN 
          I = 1;
          CRUBIT = 0; 
          FOR J = 0 STEP 1 UNTIL DOMAINLEN[0]   # INCLUDES *US*        #
          DO
            BEGIN 
            IF J EQ DOMAINLEN[0]   # US NEEDED?                        #
            THEN
              BEGIN 
              IF UDATA$USED        # IF FOLLOWED BY UDATA              #
              THEN
                BEGIN 
                ASCII$CHAR[0] = UNITSEP;
                TOTLEN = TOTLEN + 1; # BUMP TOKLEN                     #
                SETCHAR = TRUE;      # SET SETCHAR FLAG                #
                END 
              ELSE
                BEGIN 
                SETCHAR = FALSE;
                END 
              END 
            ELSE
              BEGIN 
              WDC = B<CRUBIT,6>DOMAINWD[I];   # PACK IT IN ASCII       #
              ASCII$CHAR[0] = A$CHAR[WDC];
              SETCHAR = TRUE;      # GO AND STORE CHAR IN OBUDATA      #
              END 
            IF SETCHAR          # O.K. TO STORE CHAR IN OBUDATA        #
            THEN
              BEGIN 
              IF ITEMP LS 56
              THEN             # IF STILL ROOM TO PUT A CHARACTER      #
                BEGIN          # CONVERT TO ASCII AND PUT IN ENTRY     #
                B<ITEMP,8>OBUDATA[NEXT$WORD] = ASCII$CHAR[0]; 
                ITEMP = ITEMP + 8; # POINT TO NEXT POSITION            #
                END 
              ELSE             # WHOLE CHARATER CAN NOT FIT            #
                BEGIN 
                IF ITEMP EQ 56
                THEN           # IF HALF A CHARACTER CAN FIT           #
                  BEGIN        #   PUT FIRST HALF IN CURRENT WORD      #
                  B<ITEMP,4>OBUDATA[NEXT$WORD]=ASCII$CHAR1[0];
                  NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD      #
                  OBWORD[NEXT$WORD] = 0;     # CLEAR NEXT WORD         #
                  OBWC[CRNT$ENT]=OBWC[CRNT$ENT] + 1; # INCREMENT WORD C#
                  ITEMP = 4;             # POINT TO NEXT POSITION      #
                  B<0,4>OBUDATA[NEXT$WORD] = ASCII$CHAR2[0];
                  END 
                ELSE           # NO MORE ROOM IN CURRENT WORD          #
                  BEGIN 
                  NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD      #
                  OBWORD[NEXT$WORD] = 0;     # CLEAR NEXT WORD         #
                  OBWC[CRNT$ENT] = OBWC[CRNT$ENT]+1; # INCREMENT WORD C#
                  ITEMP = 8;               # POINT TO NEXT POSITION    #
                  B<0,8>OBUDATA[NEXT$WORD] = ASCII$CHAR[0]; 
                  END 
                END 
              END                 # END OF SETCHAR                     #
            CRUBIT = CRUBIT + 6;  # BUMP BIT INDEX                     #
            IF CRUBIT EQ WORDSIZE  # WORD BOUNDARY REACHED             #
            THEN
              BEGIN 
              CRUBIT = 0;    # CLEAR BIT INDEX                         #
              I = I + 1;     # BUMP WORD INDEX FOR SERVICEWD           #
              END 
            END              # END OF FOR                              #
          END                # END OF DOMAIN GR 0                      #
        IF OBUDL[CRNT$ENT + 3] GR 0  # UDATA SPECIFIED                 #
        THEN
          BEGIN 
          IF ITEMP EQ WORDSIZE   # WORD BOUNDARY REACHED               #
          THEN
            BEGIN 
            ITEMP = 0;
            NEXT$WORD = NEXT$WORD + 1;
            OBWORD[NEXT$WORD] = 0;
            OBWC[CRNT$ENT] = OBWC[CRNT$ENT] + 1;
            END 
          I = 0;
          CRUBIT = 0; 
          FOR J = 0 STEP 1 UNTIL OBUDL[CRNT$ENT + 3] - 1
          DO
            BEGIN 
            B<ITEMP,4>OBUDATA[NEXT$WORD] = B<CRUBIT,4>CRNT$UWRD[I]; 
            ITEMP = ITEMP + 4;     # BUNP ITEMP                        #
            IF ITEMP EQ WORDSIZE   # WORD BOUNDARY REACHED             #
            THEN
              BEGIN 
              IF J NQ OBUDL[CRNT$ENT + 3]  # NOT DONE YET              #
              THEN
                BEGIN 
                ITEMP = 0;
                NEXT$WORD = NEXT$WORD + 1;
                OBWORD[NEXT$WORD] = 0;
                OBWC[CRNT$ENT] = OBWC[CRNT$ENT] + 1;
                END 
              END 
            CRUBIT = CRUBIT + 4;  # BUMP BIT INDEX                     #
            IF CRUBIT EQ WORDSIZE  # WORD BOUNDARY REACHED             #
            THEN
              BEGIN 
              CRUBIT = 0;    # CLEAR BIT INDEX                         #
              I = I + 1;     # BUMP WORD INDEX FOR SERVICEWD           #
              END 
            END              # END OF FOR                              #
          END                # END OF UDL GR 0                         #
        OBUDL[CRNT$ENT + 3] = OBUDL[CRNT$ENT + 3] + TOTLEN*2; 
                             # FINALLY UPDATES OBUDL                   #
        END                  # END OF UDATA/DOMAIN/SERCVICE USED       #
      OBRWC[1] = OBRWC[1] + OBWC[CRNT$ENT];    # INCR TABLE WORD COUNT #
      RETURN;                # **** RETURN ****                        #
      END # OUTCLPR # 
      CONTROL EJECT;
      PROC PIDPR; 
      BEGIN 
*IF,DEF,IMS 
# 
**
*     1. PROC NAME            AUTHOR            DATE
*        PIDPR                Y. C. YIP         06/24/1983
* 
*     2. FUNCTIONAL DESCRIPTION.
* 
*        THIS PROCEDURE PERFORMS ENTERING PATH INFORMATION INTO 
*        THE PATH PID TABLE IN THE FORM OF PID NAME, DNODE, SNODE,
*        PORT NUMBER, DTEA LENGTH AND DTE ADDRESS.
* 
* 
*     3. METHOD USED. 
* 
*        TABLE MANAGER ROUTINE SSTESTS IS CALLED TO EXPAND TABLE
*        SPACE WHEN NEEDED. 
* 
*        FIRST, EMPTY TABLE IS CHECKED BY CHECKING THE WORD COUNT.
*        IF NOT EMPTY TABLE 
*        THEN 
*          SEARCH FOR IDENTICAL PID BY CHECKING PIDNAME IN TABLE
*          AGAINST CRNT$PID.
*          IF IDENTICAL PID FOUND 
*          THEN 
*            CHECK FOR IDENTICAL SET OF SNODE,DNODE, PORT, AND
*            AND DTEA.
* 
*            IF IDENTICL SET FOUND
*            THEN 
*              EXIT 
*            ELSE 
*              MAKE ENTRY OF SNODE,DNODE,PORT, DTEAL AND DTEA.
*          ELSE 
*            MAKE ENTRY WITH NEW PID AND A SET OF SNODE,DNODE,PORT
*            DTEAL, AND DTEA INFORMATION. 
*        ELSE 
*          MAKE THE FIRST PATH PID ENTRY TO THE EMPTY TABLE.
* 
* 
* 
* 
*     3. ENTRY - NONE.
* 
*     4. EXIT  - NONE.
* 
*     5. ROUTINE CALLED - SSTETS. 
* 
# 
*ENDIF
# 
****  PROC PIDPR - XREF LIST BEGINS 
# 
      XREF
        BEGIN 
        PROC NDLEM2;               # PASS2 ERROR MESSAGE GENERATOR     #
        PROC SSTETS;               # TABLE MANAGER ROUTINE TO EXTEND   #
                                   # TABLE ENTRY.                      #
        END 
      DEF ENTY1 # 1 #;             # ONE WORD ENTRY                    #
      DEF ENTY2 # 2 #;             # TWO WORD ENTRY                    #
      DEF ENTY3 # 3 #;             # THREE WORD ENTRY                  #
      ITEM INDEX1;                 # LOOP INDEX ONE                    #
      ITEM INDEX2;                 # LOOP INDEX TWO                    #
      ITEM FOUND B;                # FLAG FOR FINDING A MATCHING PID   #
      ITEM CRNT$PID$ENT;           # POINTER TO THE CURRENT PID ENTRY  #
      ITEM LOOPC;                  # COUNTER FOR NUMBER OF PIDS        #
      ITEM NEW$ENT;                # POINTER TO NERW TABLE ENTRY       #
      CONTROL EJECT;
#                                                                      #
#            CODE OF PIDPR BEGINS HERE                                 #
#                                                                      #
      LOOPC = 1;                   # COUNT OF PIDS SET TO 1            #
      FOUND = FALSE;               # INITIALIZE PID EXIST FLAG TO FALSE#
      IF PICNT[1] EQ 0             # EMPTY TABLE                       #
      THEN                         # NEW ENTRY NEEDED                  #
        BEGIN 
        NEW$ENT = ENTY2;           # POINTER TO TABLE ENTRY            #
        END 
      ELSE
        BEGIN 
        CRNT$PID$ENT = ENTY2;      # POINTER TO CURRENT TABLE ENTRY    #
        FOR INDEX1 = 1 STEP 1 WHILE ( NOT FOUND AND PICNT[1] GQ 
                                      LOOPC)
        DO                         # SCAN UNTIL MATCHING PID FOUND OR  #
          BEGIN                    # TABLE IS EXHAUSTED                #
          IF PINAME[CRNT$PID$ENT] EQ CRNT$PID 
          THEN
            BEGIN 
            FOR INDEX2 = 1 STEP 2 UNTIL (PILLCT[CRNT$PID$ENT]*2)
            DO                     # SCAN LOGICAL LINK RECORD          #
              BEGIN 
              IF PIDN[CRNT$PID$ENT + INDEX2]  EQ PP$DNODE 
                 AND PISN[CRNT$PID$ENT + INDEX2] EQ PP$SNODE
                 AND PIPORT[CRNT$PID$ENT + INDEX2] EQ PP$PORT 
                 AND PIDTEA[CRNT$PID$ENT + INDEX2 + 1] EQ PP$DTEA 
              THEN                 # DUPLIACTE LOGICAL LINK DEFINITION #
                BEGIN 
                FOUND = TRUE;      # SET FOUND FLAG                    #
                END 
              END                  # END OF FOR                        #
            IF NOT FOUND           # NO DUPLICATE LINK FOUND           #
            THEN
              BEGIN 
              FOUND = TRUE;        # CLEAR FLAG                        #
              NEW$ENT = CRNT$PID$ENT +(PILLCT[CRNT$PID$ENT]*2) + 1; 
                                   # NEW ENTRY MADE                    #
              SSTETS(P<PATHPID$TAB>,NEW$ENT,2);        # MAKE EXTRA    #
                                   # ENTRY                             #
              PILLCT[CRNT$PID$ENT] = PILLCT[CRNT$PID$ENT] + 1;
                                   # BUMP LOGICAL LINK COUNT           #
              PIRWC[ENTY1] = PIRWC[ENTY1] + 2;      # BUMP WORD COUNT  #
              PIDN[NEW$ENT] = PP$DNODE;      # UPDATE DNODE FIELD      #
              PISN[NEW$ENT] = PP$SNODE;      # UPDATE SNDOE FIELD      #
              PIPORT[NEW$ENT] = PP$PORT;     # UPDATE PORT  FIELD      #
              PIDTEAL[NEW$ENT] = PP$DTEAL;   # UPDATE DTEA LENGTH      #
              NEW$ENT = NEW$ENT + 1;
              PIDTEA[NEW$ENT] = PP$DTEA;     # UPDATE DTEA FIELD       #
              END 
            END 
          CRNT$PID$ENT = CRNT$PID$ENT +(PILLCT[CRNT$PID$ENT]*2) + 1;
          LOOPC = LOOPC + 1;       # CHECK THE NEXT PID RECORD         #
          END 
        NEW$ENT =  CRNT$PID$ENT;   # MAKE NEW PID RECORD               #
        END 
      IF NOT FOUND                 # IF NO MATCHING PIDNAME FOUND      #
      THEN
        BEGIN                      # NEW PID RECORD NEEDED             #
        SSTETS(P<PATHPID$TAB>,NEW$ENT,ENTY3);      # EXPAND ENTRY      #
        PICNT[ENTY1] = PICNT[ENTY1] + 1;      # BUMP PID COUNT         #
        PIRWC[ENTY1] = PIRWC[ENTY1] + ENTY3;  # BUMP WORD COUNT        #
        PINAME[NEW$ENT] = CRNT$PID;        # UPDATE PID NAME           #
        PILLCT[NEW$ENT] = 1;       # UPDATE LINK COUNT FIELD           #
        NEW$ENT = NEW$ENT + 1;
        PIDN[NEW$ENT] = PP$DNODE;  # UPDATE PIDN FIELD                 #
        PISN[NEW$ENT] = PP$SNODE;  # UPDATE PISN FIELD                 #
        PIPORT[NEW$ENT] = PP$PORT; # UPDATE PIPORT FIELD               #
        PIDTEAL[NEW$ENT] = PP$DTEAL;  #   UPDATE DTEA LENGTH           #
        NEW$ENT = NEW$ENT + 1;
        PIDTEA[NEW$ENT] = PP$DTEA;      # UPDATE DTEA FIELD            #
        END 
      RETURN;                      # RETURN TO CALLER                  #
      END                          # END OF PROC PIDPR                 #
  
  
      CONTROL EJECT;
      PROC USERPR;
      BEGIN 
*IF,DEF,IMS 
# 
**    USERPR - USER STATEMENT PROC
* 
*     D.K. ENDO    81/10/30 
* 
*     THIS PROCEDURE CHECKS THE USER STATEMENTS AND MAKES ENTRIES IN
*     THE USER TABLE. 
* 
*     PROC USERPR 
* 
*     ENTRY        NONE.
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     INCREMENT USER TABLE WORD COUNT.
*     CLEAR NEXT ENTRY IN USER TABLE. 
*     IF LABEL IS O.K., 
*       PUT LABEL IN ENTRY. 
*     FOR EACH VALUE DECLARATION
*       SELECT CASE THAT APPLIES, 
*         CASE 1(MFAM,DFAM,PFAM): 
*           IF VALUE IS NOT -NONE-, 
*             IF A FAMILY HAS NOT BEEN SPECIFIED YET, 
*             THEN, 
*               IF VALUE IS O.K., 
*                 IF VALUE IS NOT ZERO, 
*                   ZERO FILL VALUE.
*                   PUT FAMILY NAME IN ENTRY. 
*                 SET CODE FOR FAMILY.
*             OTHERWISE,
*               FLAG ERROR -- CAN NOT SPECIFY BOTH DFAM,MFAM OR PFAM. 
*         CASE 2(MUSER,DUSER,PUSER):  
*           IF VALUE IS NOT -NONE-, 
*             IF A USER NUMBER HAS NOT BEEN SPECIFIED YET,
*             THEN, 
*               IF VALUE IS O.K., 
*                 IF VALUE IS NOT ZERO, 
*                 THEN, 
*                   ZERO FILL NAME. 
*                   PUT USER NUMBER IN ENTRY. 
*                   SET CODE FOR USER NUMBER. 
*                 OTHERWISE,
*                   FLAG ERROR -- USER CAN NOT BE ZERO. 
*             OTHERWISE,
*               FLAG ERROR -- CAN NOT SPECIFY BOTH MUSER, DUSER OR PUSER
*         CASE 3(MAPPL,PAPPL):  
*           IF VALUE IS NOT -NONE-, 
*             IF AN APPLICATION HAS NOT BEEN SPECIFIED YET, 
*             THEN
*               IF VALUE IS O.K., 
*                 SEARCH TABLE FOR ILLEGAL APPLICATION. 
*                 IF NOT FOUND, 
*                 THEN, 
*                   PUT APPLICATION NAME IN ENTRY 
*                   SET CODE FOR APPLICATION. 
*                 OTHERWISE,
*                   FLAG ERROR -- NAME IS A RESERVE WORD
*             OTHERWISE,
*               FLAG ERROR -- CAN NOT SPECIFY BOTH MAPPL AND PAPPL
* 
# 
*ENDIF
# 
****  PROC USERPR - XREF LIST BEGINS. 
# 
      XREF
        BEGIN 
        PROC SSTATS;         # ALLOCATES MORE TABLE SPACE ON REQUEST   #
        FUNC XCDD C(10);     # CONVERTS INTEGER TO CHARACTER           #
        PROC NDLEM2;         # MAKES ENTRY IN PASS 2 ERROR FILE        #
        PROC NDLZFIL;        # ZERO FILLS A BLANK FILLED NAME          #
        END 
# 
****
# 
      DEF MFAM$ID # 136 #;   # MFAM KEYWORD I.D.                       #
      DEF USR$M$ST # 262143 #;         # MAX NUM OF USER STMTS USED # 
      DEF PAPPL$ID # 144 #;  # PAPPL KEYWORD I.D.                      #
      STATUS CODE UNK,       # NOT SPECIFIED                           #
                  MAND,      # MANDITORY                               #
                  DEF,       # DEFAULT                                 #
                  PRIM;      # PRIMARY                                 #
      ITEM APL$FLG B;        # INITIAL APPLICATION SPECIFIED FLAG      #
      ITEM CRNT$ENT;         # POINTS AT CURRENT ENTRY IN USER TABLE   #
      ITEM CTEMP C(10);      # CHARACTER TEMPORARY                     #
      ITEM FAM$FLG B;        # FAMILY SPECIFIED FLAG                   #
      ITEM FOUND B;          # FOUND FLAG                              #
      ITEM I;                # SCRATCH ITEM                            #
      ITEM J;                # SCRATCH ITEM                            #
      ITEM USR$FLG B;        # USER NUMBER SPECIFIED FLAG              #
      ARRAY CODE$TABLE [MFAM$ID:PAPPL$ID] S(1); 
        BEGIN 
        ITEM VAL$CODE (0,0,60) = [CODE"MAND", 
                                  CODE"MAND", 
                                  CODE"MAND", 
                                  CODE"DEF",
                                  CODE"DEF",
                                  CODE"PRIM", 
                                  CODE"PRIM", 
                                  , 
                                  CODE"PRIM"
                                 ]; 
        END 
      DEF MXRWT # 10 #; 
      ARRAY RES$WORD$TAB [1:MXRWT] S(1);
        BEGIN 
        ITEM VALNAM C(0,0,10) = ["NS",
                                 "NVF", 
                                 "ALL", 
                                 "NULL",
                                 "BYE", 
                                 "LOGIN", 
                                 "LOGOUT",
                                 "HELLO", 
                                 "NOP", 
                                 "DOP"
                                ];
        END 
      SWITCH USERJMP              ,            , # UNK     , NODE     ,#
                                  ,            , # VARIANT , OPGO     ,#
                                  ,            , #         , LLNAME   ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # HNAME   , LOC      ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # NCNAME  , DI       ,#
                                  ,            , # N1      , P1       ,#
                                  ,            , # N2      , P2       ,#
                                  ,            , # NOLOAD1 , NOLOAD2  ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # NI      , PORT     ,#
                                  ,            , # LTYPE   , TIPTYPE  ,#
                                  ,            , # AUTO    , SL       ,#
                                  ,            , # LSPEED  , DFL      ,#
                                  ,            , # FRAME   , RTIME    ,#
                                  ,            , # RCOUNT  , NSVC     ,#
                                  ,            , # PSN     , DCE      ,#
                                  ,            , # DTEA    ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # STIP    , TC       ,#
                                  ,            , # RIC     , CSET     ,#
                                  ,            , # TSPEED  , CA       ,#
                                  ,            , # CO      , BCF      ,#
                                  ,            , # MREC    , W        ,#
                                  ,            , # CTYP    , NCIR     ,#
                                  ,            , # NEN     ,          ,#
                                  ,            , #         , DT       ,#
                                  ,            , # SDT     , TA       ,#
                                  ,            , # ABL     , DBZ      ,#
                                  ,            , # UBZ     , DBL      ,#
                                  ,            , # UBL     , XBZ      ,#
                                  ,            , # DO      , STREAM   ,#
                                  ,            , # HN      , AUTOLOG  ,#
                                  ,            , # AUTOCON , PRI      ,#
                                  ,            , # P80     , P81      ,#
                                  ,            , # P82     , P83      ,#
                                  ,            , # P84     , P85      ,#
                                  ,            , # P86     , P87      ,#
                                  ,            , # P88     , P89      ,#
                                  ,            , # AL      , BR       ,#
                                  ,            , # BS      , B1       ,#
                                  ,            , # B2      , CI       ,#
                                  ,            , # CN      , CT       ,#
                                  ,            , # DLC     , DLTO     ,#
                                  ,            , # DLX     , EP       ,#
                                  ,            , # IN      , LI       ,#
                                  ,            , # OP      , PA       ,#
                                  ,            , # PG      , PL       ,#
                                  ,            , # PW      , SE       ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                     FAMILY       , USER$NUM   , # MFAM    , MUSER    ,#
                     APPLICATION  , FAMILY     , # MAPPL   , DFAM     ,#
                     USER$NUM     , FAMILY     , # DUSER   , PFAM     ,#
                     USER$NUM     ,            , # PUSER   ,          ,#
                     APPLICATION  ,            , # PAPPL   ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , # UID     ,PRIV      ,#
                                  ,            , # KDSP    ,          ,#
                                  ,            , # NAME1   , NAME2    ,#
                                  ,            , # SNODE   , DNODE    ,#
                                  ,            , # ACCLEV  ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            , #         ,          ,#
                                  ,            ; # FAM     , UNAME     #
      CONTROL EJECT;
#                                                                      #
#                            USERPR CODE BEGINS HERE                   #
#                                                                      #
      IF USR$M$FLAG          # IF MAXIMUM USR FLAG REACHED             #
      THEN
        BEGIN 
        RETURN;              # SKIP THE ENTRY                          #
        END 
      FAM$FLG = FALSE;       # CLEAR FAMILY SPECIFIED FLAG             #
      USR$FLG = FALSE;       # CLEAR USER NUMBER SPECIFIED FLAG        #
      APL$FLG = FALSE;       # CLEAR INITIAL APPL SPECIFIED FLAG       #
      IF UTWC[1] GQ USR$M$ST
      THEN
        BEGIN                # IF MAXIMUM ENTRY ALREADY REACHED        #
        USR$M$FLAG = TRUE;   # SET WARNING FLAG TO TRUE                #
        NDLEM2(ERR159,STLNUM[0],XCDD(USR$M$ST)); # GENERATE WARNING    #
        RETURN;              # SKIP ENTRY                              #
        END 
      CRNT$ENT = UTWC[1] + 1;          # POINT TO NEXT ENTRY POSITION  #
      UTWC[1] = UTWC[1] + UTENTSZ;     # INCREMENT TABLE WORD COUNT    #
      IF UTWC[1] GQ UT$LENG-1          # IF MORE SPACE IS NEED         #
      THEN
        BEGIN 
        SSTATS(P<USER$TABLE>,UTENTSZ);  # ALLOC ROOM FOR ONE MORE ENTRY#
        END 
      FOR I=CRNT$ENT STEP 1 UNTIL (CRNT$ENT + UTENTSZ) - 1
      DO
        BEGIN 
        UTWORD[I] = 0;       # CLEAR THE CURRENT ENTRY                 #
        END 
      IF NOT STLBERR[1]      # IF NO LABEL ERRORS                      #
      THEN
        BEGIN 
        UTNAME[CRNT$ENT] = STLABEL[1]; # PUT USER NAME IN ENTRY        #
        END 
      FOR I=2 STEP 1 UNTIL STWC[0]     # FOR EACH VALUE DECLARATION    #
      DO
        BEGIN 
        GOTO USERJMP[STKWID[I]];       # GOTO APPROPRIATE PARAGRAPH    #
FAMILY: 
        IF STVALNAM[I] NQ "NONE"       # IF VALUE IS NOT -NONE-        #
        THEN
          BEGIN 
          IF NOT FAM$FLG               # IF FAMILY NOT SPECIFIED       #
          THEN
            BEGIN 
            FAM$FLG = TRUE;            # SET FAMILY SPECIFIED FLAG     #
            IF NOT STVLERR[I]          # IF VALUE IS O.K.              #
            THEN
              BEGIN 
              IF STVALNAM[I] NQ "0"    # IF VALUE IS NOT ZERO          #
              THEN
                BEGIN                  # ENTER FAMILY VALUE            #
                CTEMP = STVALNAM[I];
                NDLZFIL(CTEMP);        # ZERO FILL NAME                #
                UTFAM[CRNT$ENT + 1] = CTEMP;
                END                    # ENTER CODE FOR FAMILY         #
              UTCODE[CRNT$ENT + 1] = VAL$CODE[STKWID[I]]; 
              END 
            END 
          ELSE                         # FAMILY PREVIOUSLY SPECIFIED   #
            BEGIN            # FLAG ERROR -- BOTH MFAM AND DFAM SPEC   #
            NDLEM2(ERR144,STLNUM[0]," "); 
            END 
          END 
        TEST I;              # GET NEXT ENTRY                          #
USER$NUM: 
        IF STVALNAM[I] NQ "NONE"       # IF VALUE IS NOT -NONE-        #
        THEN
          BEGIN 
          IF NOT USR$FLG               # IF USER NUM NOT SPECIFIED     #
          THEN
            BEGIN 
            USR$FLG = TRUE;            # SET USER NUM SPECIFIED FLAG   #
            IF NOT STVLERR[I]          # IF VALUE IS O.K.              #
            THEN
              BEGIN 
              IF STVALNAM[I] NQ "0"    # IF VALUE IS NOT ZERO          #
              THEN
                BEGIN                  # PUT UN AND CODE IN ENTRY      #
                CTEMP = STVALNAM[I];
                NDLZFIL(CTEMP);        # ZERO FILL NAME                #
                UTUSER[CRNT$ENT + 2] = CTEMP; 
                UTCODE[CRNT$ENT + 2] = VAL$CODE[STKWID[I]]; 
                END 
              ELSE                     # VALUE IS ZERO                 #
                BEGIN        # FLAG ERROR -- VALUE CAN NOT BE ZERO     #
                NDLEM2(ERR145,STLNUM[0]," "); 
                END 
              END 
            END 
          ELSE                         # USER NUM ALREADY SPECIFIED    #
            BEGIN            # FLAG ERROR -- CANNOT USE BOTH MUSER AND #
            NDLEM2(ERR146,STLNUM[0]," ");        # DUSER               #
            END 
          END 
        TEST I;              # GOTO NEXT ENTRY                         #
APPLICATION:  
        IF STVALNAM[I] NQ "NONE"       # IF VALUE IS NOT -NONE-        #
        THEN
          BEGIN 
          IF NOT APL$FLG               # IF APPL NOT SPECIFIED         #
          THEN
            BEGIN 
            APL$FLG = TRUE;            # SET APPL SPECIFIED FLAG       #
            IF NOT STVLERR[I]          # IF VALUE IS O.K.              #
            THEN
              BEGIN 
              FOUND = FALSE;           # CLEAR FOUND FLAG              #
              FOR J=1 STEP 1 UNTIL MXRWT
              DO                       # SEARCH RESERVE WORD TABLE FOR #
                BEGIN                  #   VALUE                       #
                IF STVALNAM[I] EQ VALNAM[J] 
                THEN                   # IF VALUE FOUND IN TABLE       #
                  BEGIN 
                  FOUND = TRUE;        # SET FOUND FLAG                #
                  END 
                END 
              IF NOT FOUND             # IF VALUE IS NOT RESERVED WORD #
              THEN
                BEGIN                  # PUT NAME AND CODE IN ENTRY    #
                UTAPPL[CRNT$ENT + 3] = STVALNAM[I]; 
                UTCODE[CRNT$ENT + 3] = VAL$CODE[STKWID[I]]; 
                END 
              ELSE                     # NAME IS A RESERVE WORD        #
                BEGIN        # FLAG ERROR -- CANNOT BE RESERVED APPL   #
                NDLEM2(ERR147,STLNUM[0],STVALNAM[I]); 
                END 
              END 
            END 
          ELSE                         # APPL ALREADY SPECIFIED        #
            BEGIN            # FLAG ERROR -- CANNOT SPEC BOTH MAPPL AND#
            NDLEM2(ERR148,STLNUM[0]," ");        # PAPPL               #
            END 
          END 
        TEST I;              # GOTO NEXT ENTRY                         #
        END 
      RETURN;                # **** RETURN ****                        #
      END # USERPR #
      CONTROL EJECT;
      PROC WR$LCF(TABLE,WSA,LENGTH);
      BEGIN 
*IF,DEF,IMS 
# 
**    WR$LCF - WRITE TABLE TO LCF.
* 
*     D.K. ENDO    81/10/30 
* 
*     THIS PROCEDURE WRITES A GIVEN TABLE TO THE LCF. 
* 
*     PROC WR$LCF(TABLE,WSA,LENGTH) 
* 
*     ENTRY        TABLE = SWITCH I.D. FOR TABLE. 
*                  WSA = FIRST WORD ADDRESS OF TABLE. 
*                  LENGTH = LENGTH OF TABLE.
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     POINT FET TO TABLE
*     SELECT CASE THAT APPLIES: 
*       CASE 1(HEADER RECORD,APPL,USER,OUTCALL,INCALL TABLES):  
*         WRITE TABLE TO LCF. 
*         WRITE EOR TO LCF
*       CASE 2(VERIFICATION RECORD):  
*         WRITE RECORD TO LCF.
*         WRITE EOR TO LCF. 
*         WRITE EOF TO LCF. 
* 
# 
*ENDIF
      ITEM TABLE;            # SWITCH I.D. FOR TABLE                   #
      ITEM WSA;              # FIRST WORD ADDRESS OF TABLE             #
      ITEM LENGTH;           # LENGTH OF TABLE                         #
# 
****  PROC WR$LCF - XREF LIST BEGINS. 
# 
      XREF
        BEGIN 
        PROC RECALL;         # RETURNS CONTROL WHEN RECALL BIT CLEARED #
        PROC WRITEF;         # FLUSH CIO BUFFER AND PUT EOF            #
        PROC WRITER;         # FLUSH CIO BUFFER AND PUT EOR            #
        END 
# 
****
# 
      SWITCH WLCFJMP W$EOR,            # FILE HEADER                   #
                     W$EOR,            # APPL TABLE                    #
                     W$EOR,            # USER TABLE                    #
                     W$EOR,            # OUTCALL TABLE                 #
                     W$EOR,            # INCALL TABLE                  #
                     W$EOR,            # PATH PID TABLEORD             #
                     W$EOF;            # VALIDATION RECORD             #
#                                                                      #
#                            WR$LCF CODE BEGINS HERE                   #
#                                                                      #
      LCFFIRST[0] = WSA;     # POINT FET TO TABLE                      #
      LCFOUT[0] = WSA;
      LCFIN[0] = WSA + LENGTH;
      LCFLIMIT[0] = LCFIN[0] + 1; 
#                                                                      #
      GOTO WLCFJMP[TABLE];
W$EOR:  
      WRITER(LCFFET);        # WRITE TABLE WITH EOR                    #
      RECALL(LCFFET); 
      GOTO LCF$NEXT;
W$EOF:  
      WRITEF(LCFFET);        # WRITE TABLE WITH EOF                    #
      RECALL(LCFFET); 
      GOTO LCF$NEXT;
LCF$NEXT: 
      RETURN;                # **** RETURN ****                        #
      END # WR$LCF #
      CONTROL EJECT;
#                                                                      #
#                            NDLP2LF CODE BEGINS HERE                  #
#                                                                      #
#                            ALLOCATE SPACE FOR LCF CREATION           #
      SSTATS(P<USER$TABLE>,MXUTAB); 
      SSTATS(P<APPL$TABLE>,MXATAB); 
      SSTATS(P<OUTCALL$TABL>,MXOTAB); 
      SSTATS(P<INCALL$TABLE>,MXITAB); 
      SSTATS(P<PATHPID$TAB>,MXPPTAB); 
      UTWORD[0] = 0;         # INITIALIZE USER TABLE                   #
      UT$IDENT[0] = "USER"; 
      USR$M$FLAG = FALSE;    # MAXIMUM USER STATEMENTS FLAG            #
      UTWORD[1] = 0;
      UTWC[1] = 1;
      ATWORD[0] = 0;         # INITIALIZE APPL TABLE                   #
      AT$IDENT[0] = "APPL"; 
      ATWORD[1] = 0;
      ATWC[1] = 1;
      OBWORD[0] = 0;         # INITIALIZE OUTCALL TABLE                #
      OB$IDENT[0] = "OUTCALL";
      OBWORD[1] = 0;
      OBWC[1] = 1;
      IBWORD[0] = 0;         # INITIALIZE INCALL TABLE                 #
      IB$IDENT[0] = "INCALL"; 
      IBWORD[1] = 0;
      IBWC[1] = 1;
      PPWORD[0] = 0;         # INITIALIZE PATHPID TABLE                #
      PP$IDENT[0] = "PATHPID";
      PPWORD[1] = 0;
      PIRWC[1] = 1; 
#                                                                      #
      REWIND(ERR2FET);       # REWIND PASS 2 ERROR FILE                #
      RECALL(ERR2FET);
      REWIND(STFET);         # REWIND STATEMENT TABLE FILE             #
      RECALL(STFET);
      READ(STFET);           # READ STATEMENT TABLE INTO CIO BUFFER    #
      RECALL(STFET);
      READW(STFET,STMT$TABLE,1,STMT$STAT);   # READ HEADER OF 1ST ENTRY#
#                                                                      #
      FOR I=0 WHILE STMT$STAT EQ TRNS$OK
      DO
        BEGIN 
        READW(STFET,STMT$TABLE[1],STWC[0],STMT$STAT); 
        GOTO LCFJUMP[STSTID[0]];
LFILE$ENTRY:  
        LFILEPR;             # CHECK LFILE ENTRY                       #
        GOTO NEXT$STMT; 
USER$ENTRY: 
        USERPR;              # CHECK USER ENTRY                        #
        GOTO NEXT$STMT; 
APPL$ENTRY: 
        APPLPR;              # CHECK APPL ENTRY                        #
        GOTO NEXT$STMT; 
OUTCALL$ENT:  
        OUTCLPR;             # CHECK OUTCALL ENTRY                     #
        GOTO NEXT$STMT; 
INCALL$ENT: 
        INCALPR;             # CHECK INCALL ENTRY                      #
        GOTO NEXT$STMT; 
NEXT$STMT:                   # READ NEXT STATEMENT ENTRY HEADER        #
        READW(STFET,STMT$TABLE,1,STMT$STAT);
        END 
      LCFTERM;               # EXECUTE TERMINATION PROCESSING          #
      RETURN;                # **** RETURN ****                        #
      END # NDLP2LF # 
      TERM
