Retro1.org codex

User Tools

Site Tools

Trace: • NDLP2LF
cdc:nos2.source:nam5871:ndlp2lf

Table of Contents

NDLP2LF

Table Of Contents

  • [00005] PROC NDLP2LF
  • [00009] CHECKS LCF STATEMENTS AND CREATES LCF.
  • [00038] PROC SSBSBF
  • [00039] PROC SSTATS
  • [00040] PROC READ
  • [00041] PROC READW
  • [00042] PROC RECALL
  • [00043] PROC REWIND
  • [00153] PROC APPLPR
  • [00157] APPLPR - APPLICATION STATEMENT PROC.
  • [00204] PROC NDLCKRG
  • [00205] PROC NDLEM2
  • [00435] PROC DC$ZFILL(WORD)
  • [00456] PROC INCALPR
  • [00460] INCALPR - INCALL STATEMENT PROC
  • [00508] PROC NDLCKRG
  • [00509] PROC NDLEM2
  • [00510] PROC NDLZFIL
  • [00511] FUNC XCDD C(10)
  • [00512] FUNC XCHD C(10)
  • [01127] PROC LCFTERM
  • [01131] LCFTERM - LCF TERMINATION ROUTINE.
  • [01161] PROC SSTATS
  • [01162] PROC NDLEM2
  • [01223] PROC LFILEPR
  • [01227] LFILEPR - LFILE STATEMENT PROC.
  • [01256] FUNC EDATE C(10)
  • [01257] FUNC ETIME C(10)
  • [01258] PROC PDATE
  • [01259] PROC RECALL
  • [01260] PROC REWIND
  • [01261] PROC VERSION
  • [01262] PROC NDLZFIL
  • [01326] PROC OUTCLPR
  • [01330] OUTCLPR - OUTCALL STATEMENT PROC.
  • [01374] PROC NDLCKRG
  • [01375] PROC NDLEM2
  • [01376] FUNC XCDD C(10)
  • [01377] FUNC XCHD C(10)
  • [02541] PROC PIDPR
  • [02598] PROC NDLEM2
  • [02599] PROC SSTETS
  • [02689] PROC USERPR
  • [02693] USERPR - USER STATEMENT PROC
  • [02761] PROC SSTATS
  • [02762] FUNC XCDD C(10)
  • [02763] PROC NDLEM2
  • [02764] PROC NDLZFIL
  • [03037] PROC WR$LCF(TABLE,WSA,LENGTH)
  • [03041] WR$LCF - WRITE TABLE TO LCF.
  • [03077] PROC RECALL
  • [03078] PROC WRITEF
  • [03079] PROC WRITER

Source Code

NDLP2LF.txt 
  1. *DECK NDLP2LF 
  2. USETEXT NDLDATT 
  3. USETEXT NDLFETT 
  4. USETEXT NDLTBLT 
  5.       PROC NDLP2LF; 
  6.       BEGIN 
  7. *IF,DEF,IMS 
  8. # 
  9. **    NDLP2LF - CHECKS LCF STATEMENTS AND CREATES LCF.
  10. * 
  11. *     D.K. ENDO    81/10/12 
  12. * 
  13. *     THIS PROCEDURE TAKES EACH ENTRY IN THE STMT TABLE AND CALLS THE 
  14. *     APPROPRIATE PROC TO CHECK THE ENTRY.
  15. * 
  16. *     PROC NDLP2LF
  17. * 
  18. *     ENTRY        NONE.
  19. * 
  20. *     EXIT         NONE.
  21. * 
  22. *     METHOD
  23. * 
  24. *     ALLOCATE TABLE SPACE FOR LCF TABLES.
  25. *     INITIALIZE THE TABLES.
  26. *     REWIND THE STATEMENT TABLE. 
  27. *     FOR EACH ENTRY IN STATEMENT TABLE:  
  28. *       CALL APPROPRIATE PROC TO CHECK ENTRY. 
  29. *     CALL LCF TERMINATION PROC.
  30. * 
  31. # 
  32. *ENDIF
  33. # 
  34. ****  PROC NDLP2LF - XREF LIST BEGINS.
  35. # 
  36.       XREF
  37.         BEGIN 
  38.         PROC SSBSBF;         # STORES A BIT FIELD INTO A TABLE         #
  39.         PROC SSTATS;         # ALLOCATES MORE TABLE SPACE              #
  40.         PROC READ;           # FILLS CIO BUFFER                        #
  41.         PROC READW;          # READS GIVEN NUMBER OF CP WORDS          #
  42.         PROC RECALL;         # RETURNS CONTROL WHEN RECALL BIT CLEARED #
  43.         PROC REWIND;         # REWINDS GIVEN FILE                      #
  44.         END 
  45. # 
  46. ****
  47. # 
  48.       CONTROL PRESET; 
  49.       CONTROL NOLIST;        # ER2CNDL AND PS2CNDL                     #
  50. *CALL ER2CNDL 
  51. *CALL PS2CNDL 
  52.       CONTROL LIST; 
  53.       DEF MXAT # 60 #;       # SIZE OF ASCII TABLE                     #
  54.       ITEM I;                # SCRATCH ITEM                            #
  55.       ITEM STMT$STAT;        # STATUS RETURNED BY READ                 #
  56.       ITEM USR$M$FLAG B;     # MAXIMUM USER STATEMENTS USED FLAG       #
  57.       ITEM PP$SNODE;         # CURRENT SNODE DEFINED ON OUTCALL STMT   #
  58.       ITEM PP$DNODE;         # CURRENT DNODE DEFINED ON OUTCALL STMT   #
  59.       ITEM PP$PORT;          # CURRENT PORT NUMBER DEFINED ON OUTCALL  #
  60.       ITEM PP$DTEAL;         # CURRENT LENGTH OF DTEA                  #
  61.       ITEM PP$DTEA;          # CURRENT VALUE OF DTEA USED BY PATH PID  #
  62.                              # TABLE                                   #
  63.       ITEM CRNT$PID C(3);    # CURRENT PID NAME USED                   #
  64.       ARRAY ASCII$TABLE [00:MXAT] S(1); # TABLE TO CONVERT DISPLAY CODE#
  65.         BEGIN                           #   TO ASCII                   #
  66.         ITEM A$CHAR U(00,52,08) = [O"72",         # COLON              #
  67.                                    O"101",        # A                  #
  68.                                    O"102",        # B                  #
  69.                                    O"103",        # C                  #
  70.                                    O"104",        # D                  #
  71.                                    O"105",        # E                  #
  72.                                    O"106",        # F                  #
  73.                                    O"107",        # G                  #
  74.                                    O"110",        # H                  #
  75.                                    O"111",        # I                  #
  76.                                    O"112",        # J                  #
  77.                                    O"113",        # K                  #
  78.                                    O"114",        # L                  #
  79.                                    O"115",        # M                  #
  80.                                    O"116",        # N                  #
  81.                                    O"117",        # O                  #
  82.                                    O"120",        # P                  #
  83.                                    O"121",        # Q                  #
  84.                                    O"122",        # R                  #
  85.                                    O"123",        # S                  #
  86.                                    O"124",        # T                  #
  87.                                    O"125",        # U                  #
  88.                                    O"126",        # V                  #
  89.                                    O"127",        # W                  #
  90.                                    O"130",        # X                  #
  91.                                    O"131",        # Y                  #
  92.                                    O"132",        # Z                  #
  93.                                    O"060",        # 0                  #
  94.                                    O"061",        # 1                  #
  95.                                    O"062",        # 2                  #
  96.                                    O"063",        # 3                  #
  97.                                    O"064",        # 4                  #
  98.                                    O"065",        # 5                  #
  99.                                    O"066",        # 6                  #
  100.                                    O"067",        # 7                  #
  101.                                    O"070",        # 8                  #
  102.                                    O"071",        # 9                  #
  103.                                    O"053",        # +                  #
  104.                                    O"055",        # -                  #
  105.                                    O"052",        # *                  #
  106.                                    O"057",        # /                  #
  107.                                    O"050",        # (                  #
  108.                                    O"051",        # )                  #
  109.                                    O"044",        # $                  #
  110.                                    O"075",        # =                  #
  111.                                    O"040",        # BLANK              #
  112.                                    O"054",        # ,                  #
  113.                                    O"056",        # .                  #
  114.                                    O"043",        # POUND              #
  115.                                    O"133",        # [                  #
  116.                                    O"135",        # ]                  #
  117.                                    O"045",        # %                  #
  118.                                    O"042",        # "                  #
  119.                                    O"137",        # _                  #
  120.                                    O"041",        # !                  #
  121.                                    O"046",        # &                  #
  122.                                    O"047",        # '                  #
  123.                                    O"077",        # ?                  #
  124.                                    O"074",        # <                  #
  125.                                    O"076",        # >                  #
  126.                                    O"100"         #                   # 
  127.                                   ];
  128.         END 
  129.       SWITCH LCFJUMP                    ,        # UNKNOWN             #
  130.                                         ,        # NFILE               #
  131.                                         ,        # NPU                 #
  132.                                         ,        # SUPLINK             #
  133.                                         ,        # COUPLER             #
  134.                                         ,        # LOGLINK             #
  135.                                         ,        # GROUP               #
  136.                                         ,        # LINE                #
  137.                                         ,        # ** RESERVED **      #
  138.                                         ,        # TERMINAL            #
  139.                                         ,        # DEVICE              #
  140.                                         ,        # TRUNK               #
  141.                              LFILE$ENTRY,        # LFILE               #
  142.                              USER$ENTRY ,        # USER                #
  143.                              APPL$ENTRY ,        # APPL                #
  144.                              OUTCALL$ENT,        # OUTCALL             #
  145.                              INCALL$ENT ,        # INCALL              #
  146.                                         ,        # END                 #
  147.                                         ,        # TERMDEV             #
  148.                                         ,        # DEFINE              #
  149.                                         ,        # COMMENT             #
  150.                                         ;        # TITLE               #
  151.  
  152.       CONTROL EJECT;
  153.       PROC APPLPR;
  154.       BEGIN 
  155. *IF,DEF,IMS 
  156. # 
  157. **    APPLPR - APPLICATION STATEMENT PROC.
  158. * 
  159. *     D.K. ENDO    81/10/30 
  160. * 
  161. *     THIS PROCEDURE CHECKS THE APPL STATEMENT AND MAKES ENTRIES INTO 
  162. *     THE APPL TABLE. 
  163. * 
  164. *     PROC APPLPR 
  165. * 
  166. *     ENTRY        NONE.
  167. * 
  168. *     EXIT         NONE.
  169. * 
  170. *     METHOD
  171. * 
  172. *     INCREMENT APPL TABLE ENTRY SIZE.
  173. *     CLEAR NEXT ENTRY IN APPL TABLE. 
  174. *     IF LABEL IS O.K.
  175. *       SEARCH RESERVED NAME TABLE FOR LABEL
  176. *       IF FOUND, 
  177. *       THEN, 
  178. *         FLAG ERROR. 
  179. *       OTHERWISE,
  180. *         PUT LABEL IN ENTRY. 
  181. *     FOR EACH VALUE-DECLARATION IN ENTRY,
  182. *       IF VALUE IS O.K.
  183. *         SELECT CASE THAT APPLIES: 
  184. *           CASE 1(PRIV): 
  185. *             IF VALUE IS -YES-,
  186. *               SET PRIV FLAG IN ENTRY. 
  187. *           CASE 2(UID):  
  188. *             IF VALUE IS -YES-,
  189. *               SET UID FLAG IN ENTRY.
  190. *           CASE 3(DI): 
  191. *             IF VALUE IS -YES-,
  192. *               SET DI FLAG IN ENTRY. 
  193. *           CASE 4(KDSP): 
  194. *             IF VALUE IS -YES-,
  195. *               SET KDSP FLAG IN ENTRY. 
  196. * 
  197. # 
  198. *ENDIF
  199. # 
  200. ****  PROC APPLPR - XREF LIST BEGINS. 
  201. # 
  202.       XREF
  203.         BEGIN 
  204.         PROC NDLCKRG;        # CHECKS RANGE                            #
  205.         PROC NDLEM2;         # MAKES ENTRY IN PASS2 ERROR FILE         #
  206.         END 
  207. # 
  208. ****
  209. # 
  210.       ITEM FOUND B;          # FOUND FLAG                              #
  211.       ITEM I;                # SCRATCH ITEM                            #
  212.       DEF MXRA # 9 #; 
  213.       DEF MXCOPY$DEF # 1 #;  # DEFAULT VALUE FOR MXCOPYS               #
  214.       DEF MXBLK # "  " #;    # CHECK FOR APPL NAME LENGTH IF MXCOPYS   #
  215.                              # GREATER THAN 1                          #
  216.       ITEM MXCOPY$USED B;    # MXCOPY SPECIFIED FLAG                   #
  217.       ITEM AT$STAT B;        # STATUS FLAG FOR RANGE CHECKING          #
  218.       ARRAY RSRV$APPLS [1:MXRA] S(1);  # RESERVED APPLICATION TABLE    #
  219.         BEGIN 
  220.         ITEM RA$NAME C(0,0,10) = ["NS", 
  221.                                   "CS", 
  222.                                   "NVF",
  223.                                   "ALL",
  224.                                   "NULL", 
  225.                                   "BYE",
  226.                                   "LOGIN",
  227.                                   "LOGOUT", 
  228.                                   "HELLO",
  229.                                  ]; 
  230.         END 
  231.       SWITCH APPLJMP              ,            , # UNK     , NODE     ,#
  232.                                   ,            , # VARIANT , OPGO     ,#
  233.                                   ,            , #         , LLNAME   ,#
  234.                                   ,            , #         ,          ,#
  235.                                   ,            , #         ,          ,#
  236.                                   ,            , # HNAME   , LOC      ,#
  237.                                   ,            , #         ,          ,#
  238.                                   ,            , #         ,          ,#
  239.                                   ,            , #         ,          ,#
  240.                                   , DI$        , # NCNAME  , DI       ,#
  241.                                   ,            , # N1      , P1       ,#
  242.                                   ,            , # N2      , P2       ,#
  243.                                   ,            , # NOLOAD1 , NOLOAD2  ,#
  244.                                   ,            , #         ,          ,#
  245.                                   ,            , #         ,          ,#
  246.                                   ,            , # NI      , PORT     ,#
  247.                                   ,            , # LTYPE   , TIPTYPE  ,#
  248.                                   ,            , # AUTO    , SL       ,#
  249.                                   ,            , # LSPEED  , DFL      ,#
  250.                                   ,            , # FRAME   , RTIME    ,#
  251.                                   ,            , # RCOUNT  , NSVC     ,#
  252.                                   ,            , # PSN     , DCE      ,#
  253.                                   ,            , # DTEA    ,          ,#
  254.                                   ,            , #         ,          ,#
  255.                                   ,            , #         ,          ,#
  256.                                   ,            , # STIP    , TC       ,#
  257.                                   ,            , # RIC     , CSET     ,#
  258.                                   ,            , # TSPEED  , CA       ,#
  259.                                   ,            , # CO      , BCF      ,#
  260.                                   ,            , # MREC    , W        ,#
  261.                                   ,            , # CTYP    , NCIR     ,#
  262.                                   ,            , # NEN     ,          ,#
  263.                                   ,            , #         , DT       ,#
  264.                                   ,            , # SDT     , TA       ,#
  265.                                   ,            , # ABL     , DBZ      ,#
  266.                                   ,            , # UBZ     , DBL      ,#
  267.                                   ,            , # UBL     , XBZ      ,#
  268.                                   ,            , # DO      , STREAM   ,#
  269.                                   ,            , # HN      , AUTOLOG  ,#
  270.                                   ,            , # AUTOCON , PRI      ,#
  271.                                   ,            , # P80     , P81      ,#
  272.                                   ,            , # P82     , P83      ,#
  273.                                   ,            , # P84     , P85      ,#
  274.                                   ,            , # P86     , P87      ,#
  275.                                   ,            , # P88     , P89      ,#
  276.                                   ,            , # AL      , BR       ,#
  277.                                   ,            , # BS      , B1       ,#
  278.                                   ,            , # B2      , CI       ,#
  279.                                   ,            , # CN      , CT       ,#
  280.                                   ,            , # DLC     , DLTO     ,#
  281.                                   ,            , # DLX     , EP       ,#
  282.                                   ,            , # IN      , LI       ,#
  283.                                   ,            , # OP      , PA       ,#
  284.                                   ,            , # PG      , PL       ,#
  285.                                   ,            , # PW      , SE       ,#
  286.                                   ,            , #         ,          ,#
  287.                                   ,            , #         ,          ,#
  288.                                   ,            , #         ,          ,#
  289.                                   ,            , #         ,          ,#
  290.                                   ,            , #         ,          ,#
  291.                                   ,            , #         ,          ,#
  292.                                   ,            , #         ,          ,#
  293.                                   ,            , #         ,          ,#
  294.                                   ,            , #         ,          ,#
  295.                                   ,            , #         ,          ,#
  296.                                   ,            , #         ,          ,#
  297.                                   ,            , #         ,          ,#
  298.                                   ,            , #         ,          ,#
  299.                                   ,            , # MFAM    , MUSER    ,#
  300.                                   ,            , # MAPPL   , DFAM     ,#
  301.                                   ,            , # DUSER   ,          ,#
  302.                                   ,            , #         ,          ,#
  303.                                   , RS$        , # PAPPL   ,RS        ,#
  304.                         MXCOPY$   , NETXFR$    , # MXCOPYS ,NETXFR    ,#
  305.                         UID$      , PRIV$      , # UID     ,PRIV      ,#
  306.                         KDSP$     , PRU$       , # KDSP    , PRU      ,#
  307.                                   ,            , # NAME1   , NAME2    ,#
  308.                                   ,            , # SNODE   , DNODE    ,#
  309.                                   ,            , # ACCLEV  ,          ,#
  310.                                   ,            , #         ,          ,#
  311.                                   ,            , #         ,          ,#
  312.                                   ,            , #         ,          ,#
  313.                                   ,            , #         ,          ,#
  314.                                   ,            ; # FAM     , UNAME     #
  315.       CONTROL EJECT;
  316. #                                                                      #
  317. #                            APPLPR CODE BEGINS HERE                   #
  318. #                                                                      #
  319.       MXCOPY$USED = FALSE;             # MXCOPYS SPECFIED FLAG RESET   #
  320.       ATWC[1] = ATWC[1] + 1;           # INCREMENT TABLE SIZE          #
  321.       IF ATWC[1] GQ AT$LENG-1 
  322.       THEN                   # IF NEED MORE TABLE SPACE                #
  323.         BEGIN                #   ALLOCATE MORE SPACE                   #
  324.         SSTATS(P<APPL$TABLE>,10); 
  325.         END 
  326.       ATWORD[ATWC[1]] = 0;             # CLEAR ENTRY                   #
  327.       IF NOT STLBERR[1]                # IF LABEL IS O.K.              #
  328.       THEN
  329.         BEGIN 
  330.         FOUND = FALSE;                 # CLEAR FOUND FLAG              #
  331.         FOR I=1 STEP 1 UNTIL MXRA 
  332.         DO
  333.           BEGIN 
  334.           IF RA$NAME[I] EQ STLABEL[1] 
  335.           THEN
  336.             BEGIN 
  337.             FOUND = TRUE;    # FLAG ERROR -- NAME CANNOT BE RESRVD WORD#
  338.             ATNAME2[ATWC[1]] = MXBLK;  # BLANK FILL LAST TWO CHARS     #
  339.             NDLEM2(ERR149,STLNUM[0],STLABEL[1]);
  340.             END 
  341.           END 
  342.         IF NOT FOUND                   # IF LABEL NOT RESERVED NAME    #
  343.         THEN
  344.           BEGIN                        # PUT NAME IN ENTRY             #
  345.           ATNAME[ATWC[1]] = STLABEL[1]; 
  346.           END 
  347.         END 
  348.       FOR I=2 STEP 1 UNTIL STWC[0]     # FOR EACH VALUE DECLARATION    #
  349.       DO
  350.         BEGIN 
  351.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  352.         THEN
  353.           BEGIN 
  354.           GOTO APPLJMP[STKWID[I]];     # GOTO APPROPRIATE PARAGRAPH    #
  355. PRIV$:  
  356.           IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
  357.           THEN
  358.             BEGIN 
  359.             ATPRIV[ATWC[1]] = TRUE;    # SET PRIV FLAG IN ENTRY        #
  360.             END 
  361.           TEST I; 
  362. UID$: 
  363.           IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
  364.           THEN
  365.             BEGIN 
  366.             ATUID[ATWC[1]] = TRUE;     # SET UID FLAG IN ENTRY         #
  367.             END 
  368.           TEST I; 
  369.  
  370. RS$:      IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
  371.           THEN
  372.             BEGIN 
  373.             ATRS[ATWC[1]] = TRUE;      # SET ATRS FLAG IN ENTRY        #
  374.             END 
  375.           TEST I; 
  376.  
  377. MXCOPY$:  MXCOPY$USED = TRUE;          # SET MXCOPY USED FLAG          #
  378.           NDLCKRG(STKWID[I],STVALNUM[I],AT$STAT);  # CHECK RANGE       #
  379.           IF AT$STAT                   # IF VALUE IS WITHIN RANGE      #
  380.           THEN
  381.             BEGIN 
  382.             ATMAXC[ATWC[1]] = STVALNUM[I];  # ASSIGN VALUE TO ATMAXC   #
  383.                                             # ENTRY                    #
  384.             END 
  385.           TEST I; 
  386.  
  387. DI$:  
  388.           IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
  389.           THEN
  390.             BEGIN 
  391.             ATSTAT[ATWC[1]] = TRUE;    # SET DI FLAG IN ENTRY          #
  392.             END 
  393.           TEST I; 
  394.  
  395. NETXFR$:  
  396.           IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
  397.           THEN
  398.             BEGIN 
  399.             ATXFR[ATWC[1]] = TRUE;     # SET XFR FLAG IN ENTRY         #
  400.             END 
  401.           TEST I; 
  402. PRU$: 
  403.           IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
  404.           THEN
  405.             BEGIN 
  406.             ATPRU[ATWC[1]] = TRUE;     # SET PRU FLAG IN ENTRY         #
  407.             END 
  408.           TEST I; 
  409. KDSP$:  
  410.           IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
  411.           THEN
  412.             BEGIN 
  413.             ATKDSP[ATWC[1]] = TRUE;    # SET KDSP FLAG IN ENTRY        #
  414.             END 
  415.           TEST I; 
  416.           END 
  417.         END 
  418.       IF NOT MXCOPY$USED     # IF MXCOPY NOT SPECIFIED                 #
  419.       THEN
  420.         BEGIN 
  421.         ATMAXC[ATWC[1]] = MXCOPY$DEF;  # ASSIGN DEFAULT VALUE TO ENTRY #
  422.         END 
  423.       IF ATMAXC[ATWC[1]] GR 1      # CHECK APPL NAME IF MXCOPYS GR 1   #
  424.       THEN
  425.         BEGIN 
  426.         IF ATNAME2[ATWC[1]] NQ MXBLK  # NAME GREATER THAN 5 CHARS      #
  427.         THEN
  428.           BEGIN 
  429.           NDLEM2(ERR166,STLNUM[0],STLABEL[1]);
  430.           END 
  431.         END 
  432.       RETURN;                # **** RETURN ****                        #
  433.       END # APPLPR #
  434.       CONTROL EJECT;
  435.       PROC DC$ZFILL(WORD);
  436.       BEGIN                  # REPLACES BLANKS WITH DISPLAY CODE ZEROS #
  437.       ITEM WORD C(10);       # WORD TO BE ZERO FILLED                  #
  438.  
  439.       DEF ZERO # O"33" #;    # DISPLAY CODE ZERO                       #
  440.       ITEM K;                # LOOP COUNTER                            #
  441. #                                                                      #
  442. #                            DC$ZFILL CODE BEGINS HERE                 #
  443. #                                                                      #
  444.       FOR K=0 STEP 1 UNTIL 9
  445.       DO                     # FOR EACH CHARACTER IN WORD              #
  446.         BEGIN 
  447.         IF C<K,1>WORD EQ " "
  448.         THEN                 # IF CHARACTER IS A BLANK                 #
  449.           BEGIN 
  450.           C<K,1>WORD = ZERO; # REPLACE IT WITH DISPLAY CODE ZERO       #
  451.           END 
  452.         END 
  453.       RETURN;                # **** RETURN ****                        #
  454.       END # DC$ZFILL #
  455.       CONTROL EJECT;
  456.       PROC INCALPR; 
  457.       BEGIN 
  458. *IF,DEF,IMS 
  459. # 
  460. **    INCALPR - INCALL STATEMENT PROC 
  461. * 
  462. *     D.K. ENDO    81/10/29 
  463. * 
  464. *     THIS PROCEDURE CHECKS THE INCALL STMTS AND MAKES ENTRIES IN THE 
  465. *     INCALL TABLE. 
  466. * 
  467. *     PROC INCALPR
  468. * 
  469. *     ENTRY        NONE.
  470. * 
  471. *     EXIT         NONE.
  472. * 
  473. *     METHOD
  474. * 
  475. *     INCREMENT INCALL TABLE WORD COUNT.
  476. *     CLEAR NEXT ENTRY. 
  477. *     SET ENTRY WORD COUNT FIELD. 
  478. *     FOR EACH VALUE DECLARATION IN ENTRY,
  479. *       SELECT THE CASE THAT APPLIES, 
  480. *         CASE 1(FAM):  
  481. *           IF VALUE IS O.K., 
  482. *             IF VALUE IS NOT ZERO, 
  483. *               PUT VALUE IN ENTRY. 
  484. *         CASE 2(UNAME):  
  485. *           IF VALUE IS O.K.
  486. *             PUT VALUE IN ENTRY. 
  487. *         CASE 3(SNODE,DNODE,DBL,ABL,DBZ):  
  488. *           IF VALUE IS O.K.
  489. *             CHECK IF VALUE IS WITHIN RANGE. 
  490. *             IF VALUE IS WITHIN RANGE, 
  491. *               PUT VALUE IN ENTRY
  492. *         CASE 4(PRI):  
  493. *           IF VALUE IS O.K., 
  494. *             IF VALUE IS -YES-,
  495. *               SET PRI FLAG IN ENTRY.
  496. *     IF FAM,UNAME,SNODE, OR DNODE WAS NOT SPECIFIED, 
  497. *       FLAG ERROR -- REQUIRED PARAMETER MISSING. 
  498. *     IF ABL,DBL,OR DBZ WAS NOT SPECIFIED 
  499. *       PUT DEFAULT VALUE IN ENTRY. 
  500. * 
  501. # 
  502. *ENDIF
  503. # 
  504. ****  PROC INCALPR - XREF LIST BEGINS.
  505. # 
  506.       XREF
  507.         BEGIN 
  508.         PROC NDLCKRG;        # CHECKS VALUE TO BE WITHIN RANGE         #
  509.         PROC NDLEM2;         # MAKES ENTRY IN PASS 2 ERROR FILE        #
  510.         PROC NDLZFIL;        # ZERO FILL NAMES                         #
  511.         FUNC XCDD C(10);     # CONVERTS DEC BINARY TO DISPLAY CODE     #
  512.         FUNC XCHD C(10);     # CONVERTS HEX BINARY TO DISPLAY CODE     #
  513.         END 
  514. # 
  515. ****
  516. # 
  517.       DEF ABL$DEF # 2 #;     # DEFAULT ABL VALUE                       #
  518.       DEF MXANAME #  7 #;    # MAXIMUM LENGTH OF ANAME :  7 HEX DIGIT  #
  519.       DEF DNODE$DEF # 0 #;   # DEFAULT DNODE VALUE                     #
  520.       DEF SNO$MAX #255#;     #MAXIMUM VALUE OF INCALL SNODE#
  521.       DEF DBL$DEF # 2 #;     # DEFAULT DBL VALUE                       #
  522.       DEF DBZ$DEF # 225 #;   # DEFAULT DBZ VALUE                       #
  523.       DEF DPL$DEF # 7 #;     # DEFAULT DPLR/DPLS VALUE                 #
  524.       DEF FIX$ENT # 8 #;     # SIZE OF FIXED PORTION OF ENTRY          #
  525.       DEF MINFAC # 4 #;      # MINIMUM CHAR COUNT FOR FACILITY CODE    #
  526.       DEF MXFAC # 12 #;      # MAXIMUM CHAR COUNT OF FACILITY CODE     #
  527.       DEF MXFACL # 126 #;    # MAXIMUM OF TOTAL OF FACL-S ALLOWED      #
  528.       DEF MXIB$ENT # 40 #;   # MAXIMUM INCALL BLOCK ENTRY SIZE         #
  529.       DEF UBL$DEF # 2 #;     # DEFAULT UBL VALUE                       #
  530.       DEF UBZ$DEF #  2  #;   # DEFAULT UBZ VALUE                       #
  531.       DEF UBZMUL  # 100 #;   # MULTIPLE THAT UBZ IS ENCODED WITH       #
  532.       DEF W$DEF   # 2 #;     # DEFAULT WR/WS VALUE                     #
  533.       DEF SHOST$DEF # X"303030" #;     # DEFAULT SHOST VALUE           #
  534.       DEF MXDTEA # 15 #;     # MAXIMUM LENGTH OF DTEA                  #
  535.       DEF ZERO # O"33" #;    # DISPLAY CODE ZERO                       #
  536.       ITEM ABL$USED B;       # ABL SPECIFIED FLAG                      #
  537.       ITEM AN$TEMP C(24);    # CHAR TEMP FOR ANAME                     #
  538.       ITEM DNODE$USED B;     # DNODE SPECIFIED FLAG                    #
  539.       ITEM ANAM$USED B;      # ANAME SPECIFIED FLAG                    #
  540.       ITEM CRNT$ENT;         # POINTER TO CURRENT ENTRY                #
  541.       ITEM CTEMP C(10);      # CHARACTER TEMPORARY                     #
  542.       ITEM CTEMP2 C(20);     # CHARACTER TEMPORARY FOR DTEA            #
  543.       ITEM DBL$USED B;       # DBL SPECIFIED FLAG                      #
  544.       ITEM DBZ$USED B;       # DBZ SPECIFIED FLAG                      #
  545.       ITEM DPLS$USED B;      # DPLS SPECIFIED FLAG                     #
  546.       ITEM DPLR$USED B;      # DPLR SPECIFIED FLAG                     #
  547.       ITEM FAC$LENG;         # CURRENT TOTAL LENGTH OF FACILITY CODES  #
  548.       ITEM FAM$USED B;       # FAM SPECIFIED FLAG                      #
  549.       ITEM I;                # SCRATCH ITEM                            #
  550.       ITEM IB$STAT B;        # STATUS RETURNED BY RANGE CHECK PROC     #
  551.       ITEM ITEMP;            # INTEGER TEMPORARY                       #
  552.       ITEM J;                # INTEGER TEMPORARY                       #
  553.       ITEM K;                # INTEGER TEMPORARY                       #
  554.       ITEM NEXT$WORD;        # POINTER TO NEXT WORD IN ENTRY           #
  555.       ITEM SHST$USED B;      # SHOST SPECIFIED FLAG                    #
  556.       ITEM UBL$USED B;       # UBL SPECIFIED FLAG                      #
  557.       ITEM UBZ$USED B;       # UBZ SPECIFIED FLAG                      #
  558.       ITEM UNAM$USED B;      # UNAME SPECIFIED FLAG                    #
  559.       ITEM WS$USED B;        # WS SPECIFIED FLAG                       #
  560.       ITEM WR$USED B;        # WR SPECIFIED FLAG                       #
  561.       ITEM CHARVAL C(10);    #FOR CLARIFIER WORD# 
  562.  
  563.       ARRAY ERROR$WORD [0:0] S(1);     # BUFFER WORD FOR ERROR MESSAGE #
  564.         BEGIN 
  565.         ITEM PARAM C(0,0,4)   = ["    "];   # PARAMETER                #
  566.         ITEM SLASH C(0,24,1)  = ["/"];
  567.         ITEM PVALUE C(0,30,5) = ["     "];  # VALUE                    #
  568.         END 
  569.  
  570.       SWITCH INCLJMP      NEXT$PRM,            , # UNK     , NODE     ,#
  571.                                   ,            , # VARIANT , OPGO     ,#
  572.                                   ,            , #         , LLNAME   ,#
  573.                                   ,            , #         ,          ,#
  574.                                   ,            , #         ,          ,#
  575.                                   ,            , # HNAME   , LOC      ,#
  576.                                   ,            , #         ,          ,#
  577.                                   ,            , #         ,          ,#
  578.                                   ,            , #         ,          ,#
  579.                                   ,            , # NCNAME  , DI       ,#
  580.                                   ,            , # N1      , P1       ,#
  581.                                   ,            , # N2      , P2       ,#
  582.                                   ,            , # NOLOAD1 , NOLOAD2  ,#
  583.                                   ,            , #         ,          ,#
  584.                                   ,            , #         ,          ,#
  585.                                   , PORT$      , # NI      , PORT     ,#
  586.                                   ,            , # LTYPE   , TIPTYPE  ,#
  587.                                   ,            , # AUTO    , SL       ,#
  588.                                   ,            , # LSPEED  , DFL      ,#
  589.                                   ,            , # FRAME   , RTIME    ,#
  590.                                   ,            , # RCOUNT  , NSVC     ,#
  591.                                   ,            , # PSN     , DCE      ,#
  592.                             DTEA$ ,            , # DTEA    ,          ,#
  593.                                   ,            , #         ,          ,#
  594.                                   ,            , #         ,          ,#
  595.                                   ,            , # STIP    , TC       ,#
  596.                                   ,            , # RIC     , CSET     ,#
  597.                                   ,            , # TSPEED  , CA       ,#
  598.                                   ,            , # CO      , BCF      ,#
  599.                                   ,            , # MREC    , W        ,#
  600.                                   ,            , # CTYP    , NCIR     ,#
  601.                                   , COLLECT$   , # NEN     , COLLECT  ,#
  602.                                   ,            , # XAUTO   , DT       ,#
  603.                                   ,            , # SDT     , TA       ,#
  604.                       ABL$        , DBZ$       , # ABL     , DBZ      ,#
  605.                       UBZ$        , DBL$       , # UBZ     , DBL      ,#
  606.                       UBL$        ,            , # UBL     , XBZ      ,#
  607.                                   ,            , # DO      , STREAM   ,#
  608.                                   ,            , # HN      , AUTOLOG  ,#
  609.                                   , PRI$       , # AUTOCON , PRI      ,#
  610.                                   ,            , # P80     , P81      ,#
  611.                                   ,            , # P82     , P83      ,#
  612.                                   ,            , # P84     , P85      ,#
  613.                                   ,            , # P86     , P87      ,#
  614.                                   ,            , # P88     , P89      ,#
  615.                                   ,            , # AL      , BR       ,#
  616.                                   ,            , # BS      , B1       ,#
  617.                                   ,            , # B2      , CI       ,#
  618.                                   ,            , # CN      , CT       ,#
  619.                                   ,            , # DLC     , DLTO     ,#
  620.                                   ,            , # DLX     , EP       ,#
  621.                                   ,            , # IN      , LI       ,#
  622.                                   ,            , # OP      , PA       ,#
  623.                                   ,            , # PG      , PL       ,#
  624.                                   ,            , # PW      , SE       ,#
  625.                                   ,            , #         ,          ,#
  626.                                   ,            , #         ,          ,#
  627.                                   ,            , #         ,          ,#
  628.                                   ,            , #         ,          ,#
  629.                                   ,            , #         ,          ,#
  630.                                   ,            , #         ,          ,#
  631.                                   ,            , #         ,          ,#
  632.                                   ,            , #         ,          ,#
  633.                                   ,            , #         ,          ,#
  634.                                   ,            , #         ,          ,#
  635.                                   ,            , #         ,          ,#
  636.                                   ,            , #         ,          ,#
  637.                                   ,            , #         ,          ,#
  638.                                   ,            , # MFAM    , MUSER    ,#
  639.                                   ,            , # MAPPL   , DFAM     ,#
  640.                                   ,            , # DUSER   ,          ,#
  641.                                   ,            , #         ,          ,#
  642.                                   ,            , # PAPPL   ,          ,#
  643.                                   ,            , #         ,          ,#
  644.                                   ,            , # UID     ,PRIV      ,#
  645.                                   ,            , # KDSP    ,          ,#
  646.                                   ,            , # NAME1   , NAME2    ,#
  647.                       SNODE$      ,  DNODE$    , # SNODE   , DNODE    ,#
  648.                                   ,            , # ACCLEV  , DHOST    ,#
  649.                       DPLR$       , DPLS$      , # DPLR     , DPLS    ,#
  650.                                   ,            , # PRID    , UDATA    ,#
  651.                       WR$         , WS$        , # WR      , WS       ,#
  652.                                   ,            , #         ,          ,#
  653.                       FAM$        , UNAME$     , # FAM     , UNAME    ,#
  654.                       FAC$        , FAC$       , # FAC1    , FAC2     ,#
  655.                       FAC$        , FAC$       , # FAC3    , FAC4     ,#
  656.                       FAC$        , FAC$       , # FAC5    , FAC6     ,#
  657.                       FAC$        , FAC$       , # FAC7    , FAC8     ,#
  658.                       FAC$        , FAC$       , # FAC9    , FAC10    ,#
  659.                       FAC$        , FAC$       , # FAC11   , FAC12    ,#
  660.                       FAC$        , FAC$       , # FAC13   , FAC14    ,#
  661.                       FAC$        , FAC$       , # FAC15   , FAC16    ,#
  662.                       FAC$        , FAC$       , # FAC17   , FAC18    ,#
  663.                       FAC$        , FAC$       , # FAC19   , FAC20    ,#
  664.                       FAC$        , FAC$       , # FAC21   , FAC22    ,#
  665.                       FAC$        , FAC$       , # FAC23   , FAC24    ,#
  666.                       FAC$        , FAC$       , # FAC25   , FAC26    ,#
  667.                       FAC$        , FAC$       , # FAC27   , FAC28    ,#
  668.                       FAC$        , FAC$       , # FAC29   , FAC30    ,#
  669.                       FAC$        , ANAME$     , # FAC31   , ANAME    ,#
  670.                       SHOST$      , FASTSEL$   ; # SHOST   , FASTSEL   #
  671.       CONTROL EJECT;
  672. #                                                                      #
  673. #                            INCALPR CODE BEGINS HERE                  #
  674. #                                                                      #
  675.       ABL$USED = FALSE;                # CLEAR PARAM SPECIFIED FLAG    #
  676.       ANAM$USED = FALSE;
  677.       DBL$USED = FALSE; 
  678.       DBZ$USED = FALSE; 
  679.       DPLS$USED = FALSE;
  680.       DPLR$USED = FALSE;
  681.       DNODE$USED = FALSE; 
  682.       FAM$USED = FALSE; 
  683.       SHST$USED = FALSE;
  684.       UBL$USED = FALSE; 
  685.       UBZ$USED = FALSE; 
  686.       UNAM$USED = FALSE;
  687.       WS$USED = FALSE;
  688.       WR$USED = FALSE;
  689.       FAC$LENG = 0; 
  690.       CRNT$ENT = IBRWC[1] + 1;         # POINT TO NEXT ENTRY           #
  691.       IF IBRWC[1]+MXIB$ENT GQ IB$LENG-1 
  692.       THEN                   # IF NEED MORE TABLE SPACE                #
  693.         BEGIN                #   ALLOCATE MORE SPACE                   #
  694.         SSTATS(P<INCALL$TABLE>,MXIB$ENT); 
  695.         END 
  696.       NEXT$WORD = CRNT$ENT + FIX$ENT;  # CALCULATE NEXT AVAILABLE WORD #
  697.       FOR I=CRNT$ENT STEP 1 UNTIL NEXT$WORD-1 
  698.       DO
  699.         BEGIN 
  700.         IBWORD[I] = 0;                 # CLEAR NEXT ENTRY              #
  701.         END 
  702.       IBWC[CRNT$ENT] = FIX$ENT;        # ENTER ENTRY SIZE              #
  703.       FOR I=1 STEP 1 UNTIL STWC[0]     # FOR EACH VALUE DECLARATION    #
  704.       DO
  705.         BEGIN 
  706.         GOTO INCLJMP[STKWID[I]];       # GOTO APPROPRIATE PARAGRAPH    #
  707. ANAME$: 
  708.         ANAM$USED = TRUE;    # SET ANAME SPECIFIED FLAG                #
  709.         IF NOT STVLERR[I] 
  710.         THEN                 # IF VALUE OK                             #
  711.           BEGIN 
  712.           IF STVALLEN[I] LQ MXANAME     # IF LENGTH IS LEGAL           #
  713.           THEN
  714.             BEGIN 
  715.             FOR J=0 STEP 1 UNTIL MXANAME-1
  716.             DO
  717.               BEGIN                        # PACK HEX DIGITS           #
  718.               B<J*8,8>IBRANAME[CRNT$ENT+1] = A$CHAR[C<J,1>STVALNAM[I]]; 
  719.               END 
  720.             END 
  721.           ELSE
  722.             BEGIN 
  723.             CTEMP = " ";
  724.             NDLEM2(ERR100,STLNUM[0],CTEMP);  # VALUE OUT OF RANGE      #
  725.             END 
  726.           END 
  727.         TEST I; 
  728. PRI$: 
  729.         IF NOT STVLERR[I]              # IF PRI VALUE IS O.K.          #
  730.         THEN
  731.           BEGIN 
  732.           IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
  733.           THEN
  734.             BEGIN                      # SET PRI FLAG IN ENTRY         #
  735.             IBPRI[CRNT$ENT + 2] = TRUE; 
  736.             END 
  737.           END 
  738.         TEST I; 
  739. DBL$: 
  740.         DBL$USED = TRUE;               # SET DBL SPECIFIED FLAG        #
  741.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  742.         THEN
  743.           BEGIN                        # CHECK IF VALUE WITHIN RANGE   #
  744.           NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); 
  745.           IF IB$STAT                   # IF WITHIN RANGE               #
  746.           THEN
  747.             BEGIN                      # PUT DBL VALUE IN ENTRY        #
  748.             IBDBL[CRNT$ENT + 2] = STVALNUM[I];
  749.             END 
  750.           END 
  751.         TEST I; 
  752. DBZ$: 
  753.         DBZ$USED = TRUE;               # SET DBZ SPECIFIED FLAG        #
  754.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  755.         THEN
  756.           BEGIN                        # CHECK IF VALUE WITHIN RANGE   #
  757.           NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); 
  758.           IF IB$STAT                   # IF WITHIN RANGE               #
  759.           THEN
  760.             BEGIN                      # PUT DBZ VALUE IN ENTRY        #
  761.             IBDBZ[CRNT$ENT + 2] = STVALNUM[I];
  762.             END 
  763.           END 
  764.         TEST I; 
  765. UBL$: 
  766.         UBL$USED = TRUE;               # SET UBL SPECIFIED FLAG        #
  767.         IF NOT STVLERR[I] 
  768.         THEN                           # IF VALUE IS O.K.              #
  769.           BEGIN                        # CHECK IF VALUE IS WITHIN RANGE#
  770.           NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); 
  771.           IF IB$STAT                   # IF WITHIN RANGE               #
  772.           THEN
  773.             BEGIN                      # PUT UBL VALUE IN ENTRY        #
  774.             IBUBL[CRNT$ENT + 2] = STVALNUM[I];
  775.             END 
  776.           END 
  777.         TEST I; 
  778. UBZ$: 
  779.         UBZ$USED = TRUE;               # SET UBZ SPECIFIED FLAG        #
  780.         IF NOT STVLERR[I]              # IF VALUE IF O.K.              #
  781.         THEN
  782.           BEGIN                        # CHECK IF VALUE IS WITHIN RANGE#
  783.           NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); 
  784.           IF IB$STAT                   # IF WITHIN RANGE               #
  785.           THEN
  786.             BEGIN            # PUT UBZ VALUE IN ENTRY                  #
  787.             IBUBZ[CRNT$ENT + 2] = STVALNUM[I];
  788.             END 
  789.           END 
  790.         TEST I; 
  791. ABL$: 
  792.         ABL$USED = TRUE;               # SET ABL SPECIFIED FLAG        #
  793.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  794.         THEN
  795.           BEGIN                        # CHECK IF VALUE WITHIN RANGE   #
  796.           NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); 
  797.           IF IB$STAT                   # IF WITHIN RANGE               #
  798.           THEN
  799.             BEGIN                      # PUT ABL VALUE IN ENTRY        #
  800.             IBABL[CRNT$ENT + 2] = STVALNUM[I];
  801.             END 
  802.           END 
  803.         TEST I; 
  804. SNODE$: 
  805.         IF NOT STVLERR[I] 
  806.         THEN
  807.           BEGIN                        # CHECK IF VALUE WITHIN RANGE   #
  808.           IB$STAT = TRUE;            # PRESET IB$STAT                #
  809.           IF STVALNUM[I] LS 0 OR STVALNUM[I] GR SNO$MAX 
  810.           THEN
  811.             BEGIN 
  812.             CHARVAL=XCDD(STVALNUM[I]);
  813.             NDLEM2(ERR100,STLNUM[0],CHARVAL); 
  814.             IB$STAT=FALSE;
  815.             END 
  816.           IF IB$STAT
  817.           THEN
  818.             BEGIN                      # PUT SNODE VALUE IN ENTRY      #
  819.             IBSNODE[CRNT$ENT + 3] = STVALNUM[I];
  820.             END 
  821.           END 
  822.         TEST I; 
  823. DNODE$: 
  824.         DNODE$USED = TRUE ; 
  825.         IF NOT STVLERR[I]              # IF DNODE VALUE IS OK         # 
  826.         THEN
  827.           BEGIN 
  828.           NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT);  #  CHECK RANGE     # 
  829.           IF IB$STAT                   #  IF NOT OUT OF RANGE         # 
  830.           THEN
  831.             BEGIN 
  832.             IBDNODE[CRNT$ENT+3] = STVALNUM[I];  #  INSERT VALUE       # 
  833.             END 
  834.           END 
  835.         TEST I; 
  836.  
  837. PORT$:  
  838.         IF NOT STVLERR[I] 
  839.         THEN                 # IF PORT VALUE IS O.K.                   #
  840.           BEGIN 
  841.           IF (STVALNUM[I] LQ X"FE") AND (STVALNUM[I] GR X"00")
  842.           THEN               # IF VALUE IS WITHIN RANGE                #
  843.             BEGIN 
  844.             IBPORT[CRNT$ENT + 2] = STVALNUM[I];  # STORE VALUE IN ENTRY#
  845.             END 
  846.           ELSE               # VALUE IS TOO BIG                        #
  847.             BEGIN            # FLAG ERROR -- VALUE OUT OF RANGE        #
  848.             CTEMP = XCHD(STVALNUM[I]);
  849.             NDLEM2(ERR100,STLNUM[0],CTEMP); 
  850.             END 
  851.           END 
  852.         TEST I; 
  853. WR$:  
  854.         WR$USED = TRUE;                # SET WS SPECIFIED FLAG         #
  855.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  856.         THEN
  857.           BEGIN              # CHECK IF VALUE IS WITHIN RANGE          #
  858.           NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); 
  859.           IF IB$STAT                   # IF WITHIN RANGE               #
  860.           THEN
  861.             BEGIN                      # PUT WS VALUE IN ENTRY         #
  862.             IBWR[CRNT$ENT + 3] = STVALNUM[I]; 
  863.             END 
  864.           END 
  865.         TEST I; 
  866. WS$:  
  867.         WS$USED = TRUE;                # SET WS SPECIFIED FLAG         #
  868.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  869.         THEN
  870.           BEGIN              # CHECK IF VALUE IS WITHIN RANGE          #
  871.           NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); 
  872.           IF IB$STAT                   # IF WITHIN RANGE               #
  873.           THEN
  874.             BEGIN                      # PUT WS VALUE IN ENTRY         #
  875.             IBWS[CRNT$ENT + 3] = STVALNUM[I]; 
  876.             END 
  877.           END 
  878.         TEST I; 
  879. DPLR$:  
  880.         DPLR$USED = TRUE;              # SET DPLR SPECIFIED FLAG       #
  881.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  882.         THEN
  883.           BEGIN              # CHECK IF VALUE IS WITHIN RANGE          #
  884.           NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); 
  885.           IF IB$STAT                   # IF WITHIN RANGE               #
  886.           THEN
  887.             BEGIN            # PUT DPLR VALUE IN ENTRY                 #
  888.             ITEMP = 16;      # SET TO MINIMUM DPLR VALUE               #
  889.             FOR J=4 STEP 1 WHILE ITEMP LS STVALNUM[I] 
  890.             DO               # DETERMINE VALUE (POWER OF TWO)          #
  891.               BEGIN 
  892.               ITEMP = ITEMP * 2;       # SET TO NEXT POWER OF TWO      #
  893.               END 
  894.             IBDPLR[CRNT$ENT + 3] = J;  # PUT VALUE IN ENTRY            #
  895.             IF STVALNUM[I] NQ ITEMP 
  896.             THEN                       # VALUE IS NOT POWER OF 2       #
  897.               BEGIN                    # FLAG WARNING                  #
  898.               PARAM[0]  = "DPLR";      # PARAMETER NAME                #
  899.               CTEMP     = XCDD(ITEMP);
  900.               PVALUE[0] = C<5,5>CTEMP; # VALUE                         #
  901.               NDLEM2(ERR137,STLNUM[0],ERROR$WORD);
  902.               END 
  903.             END 
  904.           END 
  905.         TEST I; 
  906. DPLS$:  
  907.         DPLS$USED = TRUE;              # SET DPLS SPECIFIED FLAG       #
  908.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  909.         THEN
  910.           BEGIN              # CHECK IF VALUE IS WITHIN RANGE          #
  911.           NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT); 
  912.           IF IB$STAT                   # IF WITHIN RANGE               #
  913.           THEN
  914.             BEGIN            # PUT DPLS VALUE IN ENTRY                 #
  915.             ITEMP = 16;      # SET TO MINIMUM DPLS VALUE               #
  916.             FOR J=4 STEP 1 WHILE ITEMP LS STVALNUM[I] 
  917.             DO               # DETERMINE VALUE (POWER OF TWO)          #
  918.               BEGIN 
  919.               ITEMP = ITEMP * 2;       # SET TO NEXT POWER OF TWO      #
  920.               END 
  921.             IBDPLS[CRNT$ENT + 3] = J;  # PUT VALUE IN ENTRY            #
  922.             IF STVALNUM[I] NQ ITEMP 
  923.             THEN                       # VALUE IS NOT POWER OF 2       #
  924.               BEGIN                    # FLAG WARNING                  #
  925.               PARAM[0]  = "DPLS";      # PARAMETER NAME                #
  926.               CTEMP     = XCDD(ITEMP);
  927.               PVALUE[0] = C<5,5>CTEMP; # VALUE                         #
  928.               NDLEM2(ERR137,STLNUM[0],ERROR$WORD);
  929.               END 
  930.             END 
  931.           END 
  932.         TEST I; 
  933. SHOST$: 
  934.         SHST$USED = TRUE;    # SET SHOST SPECIFIED FLAG                #
  935.         IF NOT STVLERR[I] 
  936.         THEN                 # IF VALUE IS O.K.                        #
  937.          BEGIN
  938.          NDLCKRG(STKWID[I],STVALNUM[I],IB$STAT);# CHECK RANGE # 
  939.          IF IB$STAT 
  940.          THEN 
  941.            BEGIN
  942.            IBSHOST[CRNT$ENT + 4] = STVALNUM[I]; 
  943.            END
  944.         END 
  945.         TEST I; 
  946. FAM$: 
  947.         FAM$USED = TRUE;               # SET FAM SPECIFIED FLAG        #
  948.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  949.         THEN
  950.           BEGIN 
  951.           IF STVALNAM[I] NQ "0"        # IF VALUE IS NOT ZERO          #
  952.           THEN
  953.             BEGIN                      # PUT FAM NAME IN ENTRY         #
  954.             CTEMP = STVALNAM[I];
  955.             NDLZFIL(CTEMP);            # ZERO FILL CTEMP               #
  956.             IBFAM[CRNT$ENT + 5] = CTEMP;   # ASSIGN ZERO FILED NAME    #
  957.             END 
  958.           ELSE                         # VALUE IS ZERO                 #
  959.             BEGIN                      # PUT ZEROS  IN FAM FIELD       #
  960.             IBFAMU[CRNT$ENT + 5] = 0; 
  961.             END 
  962.           END 
  963.         TEST I; 
  964. UNAME$: 
  965.         UNAM$USED = TRUE;              # SET UNAME SPECIFIED FLAG      #
  966.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  967.         THEN
  968.           BEGIN                        # PUT USER NAME IN ENTRY        #
  969.           CTEMP = STVALNAM[I];
  970.           NDLZFIL(CTEMP);              # ZERO FILL NAME                #
  971.           IBUSER[CRNT$ENT + 6] = CTEMP; 
  972.           END 
  973.         TEST I; 
  974.  
  975. DTEA$:  IF NOT STVLERR[I]              # IF VALUE IS VALID             #
  976.         THEN
  977.           BEGIN 
  978.           CTEMP2 = STVALNAM[I];        # GET FIRST 7 CHARACTER         #
  979.           C<7,7>CTEMP2 = STVALNAM[I+1];# GET NEXT 7 CHARACTER          #
  980.           C<14,1>CTEMP2 = STVALNAM[I+2];# GET NEXT 1 CHARACTER         #
  981.           IF STVALLEN[I] LQ MXDTEA     # IF VALUE LENGTH O.K.          #
  982.           THEN
  983.             BEGIN 
  984.             IBDTEL[CRNT$ENT+3] = STVALLEN[I]; 
  985.             IBWORD[CRNT$ENT+7] = 0;     # CLEAR DTEA WORD              #
  986.             FOR J = 0 STEP 1 UNTIL STVALLEN[I] - 1 # ASSIGN DTEA VALUE #
  987.             DO
  988.               BEGIN 
  989.               B<J*4,4>IBWORD[CRNT$ENT + 7] = C<J,1>CTEMP2 - ZERO; 
  990.               END 
  991.             END 
  992.           ELSE
  993.             BEGIN 
  994.             NDLEM2(ERR100,STLNUM[0],CTEMP2); # VALUE OUT OF RANGE      #
  995.             END 
  996.           END 
  997.         I = I + 2;
  998.         TEST I; 
  999. FAC$: 
  1000.         IF NOT STVLERR[I] 
  1001.         THEN                 # IF VALUE IS O.K.                        #
  1002.           BEGIN 
  1003.           IF STVALLEN[I] GQ MINFAC AND STVALLEN[I] LQ MXFAC 
  1004.           THEN               # IF VALUE IS WITHIN RANGE                #
  1005.             BEGIN            #   INCREMENT FAC COUNT                   #
  1006.             IBFACNUM[CRNT$ENT + 6] = IBFACNUM[CRNT$ENT + 6] + 1;
  1007.             IBWORD[NEXT$WORD] = 0;     # CLEAR NEXT WORD               #
  1008.             IBFACL[NEXT$WORD] = STVALLEN[I];   # SAVE LENGTH           #
  1009.             ITEMP = STVALLEN[I] * 4;   # CALCULATE MASK                #
  1010.             B<0,ITEMP>IBFAC[NEXT$WORD] = B<60-ITEMP,ITEMP>STWORD[I+1 ]; 
  1011.             IBWC[CRNT$ENT] = IBWC[CRNT$ENT] + 1; # INCREMENT WORD COUNT#
  1012.             FAC$LENG = FAC$LENG + STVALLEN[I];   # INCREMENT FAC LENGTH#
  1013.             NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD            #
  1014.             IBWORD[NEXT$WORD] = 0;
  1015.             END 
  1016.           ELSE               # VALUE IS TOO BIG                        #
  1017.             BEGIN            # FLAG ERROR -- VALUE OUT OF RANGE        #
  1018.             CTEMP = XCHD(STWORD[I+1]);
  1019.             NDLEM2(ERR100,STLNUM[0],CTEMP); 
  1020.             END 
  1021.           END 
  1022.         I = I + 1;
  1023.         TEST I; 
  1024. COLLECT$: 
  1025.         IF NOT STVLERR[I]              # IF COLLECT VALUE IS O.K.      #
  1026.         THEN
  1027.           BEGIN 
  1028.           IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
  1029.           THEN
  1030.             BEGIN                      # SET COLLECT FLAG IN ENTRY     #
  1031.             IBCOLCT[CRNT$ENT + 3] = TRUE; 
  1032.             END 
  1033.           END 
  1034.         TEST I; 
  1035. FASTSEL$: 
  1036.         IF NOT STVLERR[I]              # IF FASTSEL VALUE IS O.K.      #
  1037.         THEN
  1038.           BEGIN 
  1039.           IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
  1040.           THEN
  1041.             BEGIN                      # SET FASTSEL FLAG IN ENTRY     #
  1042.             IBFSTSL[CRNT$ENT + 3] = TRUE; 
  1043.             END 
  1044.           END 
  1045.         TEST I; 
  1046.  
  1047. NEXT$PRM: END 
  1048.       IF NOT FAM$USED                  # IF FAM NOT SPECIFIED          #
  1049.       THEN
  1050.         BEGIN                # FLAG ERROR -- REQUIRED PARAMETER MISSING#
  1051.         NDLEM2(ERR103,STLNUM[0],"FAM"); 
  1052.         END 
  1053.       IF NOT UNAM$USED                 # IF UNAME NOT SPECIFIED        #
  1054.       THEN
  1055.         BEGIN                # FLAG ERROR -- REQUIRED PARAMETER MISSING#
  1056.         NDLEM2(ERR103,STLNUM[0],"UNAME"); 
  1057.         END 
  1058.       IF NOT ANAM$USED
  1059.       THEN                   # IF ANAME WAS NOT SPECIFIED              #
  1060.         BEGIN                # FLAG ERROR -- REQUIRED PARAMETER MISSING#
  1061.         NDLEM2(ERR103,STLNUM[0],"ANAME"); 
  1062.         END 
  1063.       IF NOT SHST$USED
  1064.       THEN                   # IF SHOST WAS NOT SPECIFIED              #
  1065.         BEGIN 
  1066.         IBSHOST[CRNT$ENT + 4] = SHOST$DEF;  # DEFAULT SHOST VALUE      #
  1067.         END 
  1068.       IF NOT DBL$USED                  # IF DBL NOT SPECIFIED          #
  1069.       THEN
  1070.         BEGIN                          # PUT DEFAULT DBL VALUE IN ENTRY#
  1071.         IBDBL[CRNT$ENT + 2] = DBL$DEF;
  1072.         END 
  1073.       IF NOT ABL$USED                  # IF ABL NOT SPECIFIED          #
  1074.       THEN
  1075.         BEGIN                          # PUT DEFAULT ABL VALUE IN ENTRY#
  1076.         IBABL[CRNT$ENT + 2] = ABL$DEF;
  1077.         END 
  1078.       IF NOT DBZ$USED                  # IF DBZ NOT SPECIFIED          #
  1079.       THEN
  1080.         BEGIN                          # PUT DEFAULT DBZ VALUE IN ENTRY#
  1081.         IBDBZ[CRNT$ENT + 2] = DBZ$DEF;
  1082.         END 
  1083.       IF NOT UBL$USED                  # IF UBL WAS NOT SPECIFIED      #
  1084.       THEN
  1085.         BEGIN                # PUT DEFAULT VALUE IN ENTRY              #
  1086.         IBUBL[CRNT$ENT + 2] = UBL$DEF;
  1087.         END 
  1088.       IF NOT UBZ$USED                  # IF UBZ WAS NOT SPECIFIED      #
  1089.       THEN
  1090.         BEGIN                          # PUT DEFAULT VALUE IN ENTRY    #
  1091.         IBUBZ[CRNT$ENT + 2] = UBZ$DEF;
  1092.         END 
  1093.       IF NOT DNODE$USED                # IF DNODE WAS NOT SPECIFIED    #
  1094.       THEN
  1095.         BEGIN 
  1096.         IBDNODE[CRNT$ENT+3] = DNODE$DEF; # PUT DEFAULT VALUE IN ENTRY  #
  1097.         END 
  1098.       IF NOT DPLR$USED                 # IF DPLR WAS NOT SPECIFIED     #
  1099.       THEN
  1100.         BEGIN                          # PUT DEFAULT VALUE IN ENTRY    #
  1101.         IBDPLR[CRNT$ENT + 3] = DPL$DEF; 
  1102.         END 
  1103.       IF NOT DPLS$USED                 # IF DPLS WAS NOT SPECIFIED     #
  1104.       THEN
  1105.         BEGIN                          # PUT DEFAULT VALUE IN ENTRY    #
  1106.         IBDPLS[CRNT$ENT + 3] = DPL$DEF; 
  1107.         END 
  1108.       IF NOT WS$USED                   # IF WS WAS NOT SPECIFIED       #
  1109.       THEN
  1110.         BEGIN                          # PUT DEFAULT VALUE IN ENTRY    #
  1111.         IBWS[CRNT$ENT + 3] = W$DEF; 
  1112.         END 
  1113.       IF NOT WR$USED                   # IF WR WAS NOT SPECIFIED       #
  1114.       THEN
  1115.         BEGIN                          # PUT DEFAULT VALUE IN ENTRY    #
  1116.         IBWR[CRNT$ENT + 3] = W$DEF; 
  1117.         END 
  1118.       IF FAC$LENG GR MXFACL 
  1119.       THEN                   # IF TOTAL FAC LENGTH IS TOO BIG          #
  1120.         BEGIN                # FLAG ERROR -- FAC LENGTH EXCEEDS LIMIT  #
  1121.         NDLEM2(ERR153,STLNUM[0]," "); 
  1122.         END 
  1123.       IBRWC[1] = IBRWC[1] + IBWC[CRNT$ENT]; 
  1124.       RETURN;                # **** RETURN ****                        #
  1125.       END # INCALPR # 
  1126.       CONTROL EJECT;
  1127.       PROC LCFTERM; 
  1128.       BEGIN 
  1129. *IF,DEF,IMS 
  1130. # 
  1131. **    LCFTERM - LCF TERMINATION ROUTINE.
  1132. * 
  1133. *     D.K. ENDO    81/10/30 
  1134. * 
  1135. *     THIS PROCEDURE DOES FINAL PROCESSING FOR LCF CREATION.
  1136. * 
  1137. *     PROC LCFTERM
  1138. * 
  1139. *     ENTRY        NONE.
  1140. * 
  1141. *     EXIT         NONE.
  1142. * 
  1143. *     METHOD
  1144. * 
  1145. *     WRITE PREFIX,APPL,USER,OUTCALL, AND INCALL TABLE TO LCF.
  1146. *     IF NO FATAL ERRORS WERE DETECTED, 
  1147. *     THEN, 
  1148. *       PUT VALID LCF INDICATOR IN THE VALIDATION RECORD. 
  1149. *     OTHERWISE,
  1150. *       PUT INVALID LCF INDICATOR IN VALIDATION RECORD. 
  1151. *     WRITE VALIDATION RECORD TO LCF. 
  1152. *     DE-ALLOCATE TABLE SPACE.
  1153. * 
  1154. # 
  1155. *ENDIF
  1156. # 
  1157. ****  PROC LCFTERM - XREF LIST BEGINS.
  1158. # 
  1159.       XREF
  1160.         BEGIN 
  1161.         PROC SSTATS;         # USED TO RELEASE TABLE SPACE             #
  1162.         PROC NDLEM2;         # MAKES ENTERIES IN PASS2 ERROR FILE      #
  1163.         END 
  1164. # 
  1165. ****
  1166. # 
  1167.       DEF BAD$MSG # "ERRORS DETECTED IN CREATION OF THIS LCF." #; 
  1168.       DEF HDR$SZ # 17 #;     # HEADER RECORD SIZE                      #
  1169.       STATUS LF$TBL HDR,     # HEADER RECORD                           #
  1170.                     APPL,    # APPL TABLE                              #
  1171.                     USER,    # USER TABLE                              #
  1172.                     OB,      # OUTCALL BLOCK TABLE                     #
  1173.                     IB,      # INCALL BLOCK TABLE                      #
  1174.                     PATHPID, # PATHPID TABLE                           #
  1175.                     VR;      # VALIDATION RECORD                       #
  1176.       ITEM WSA;              # ADDRESS OF TABLE TO BE WRITTEN          #
  1177.       CONTROL EJECT;
  1178. #                                                                      #
  1179. #                            LCFTERM CODE BEGINS HERE                  #
  1180. #                                                                      #
  1181.       WSA = LOC(PRFX$TABLE);           # WRITE FILE HEADER TO LCF      #
  1182.       WR$LCF(LF$TBL"HDR",WSA,HDR$SZ); 
  1183.       WSA = LOC(APPL$TABLE);           # WRITE APPL TABLE TO LCF       #
  1184.       WR$LCF(LF$TBL"APPL",WSA,ATWC[1]+1); 
  1185.       WSA = LOC(USER$TABLE);           # WRITE USER TABLE TO LCF       #
  1186.       WR$LCF(LF$TBL"USER",WSA,UTWC[1]+1); 
  1187.       WSA = LOC(OUTCALL$TABL);         # WRITE OUTCALL TABLE TO LCF    #
  1188.       WR$LCF(LF$TBL"OB",WSA,OBRWC[1] + 1);
  1189.       WSA = LOC(INCALL$TABLE);         # WRITE INCALL TABLE TO LCF     #
  1190.       WR$LCF(LF$TBL"IB",WSA,IBRWC[1]+1);
  1191.       WSA = LOC(PATHPID$TAB);          # WRITE FILE HEADER TO LCF      #
  1192.       WR$LCF(LF$TBL"PATHPID",WSA,PIRWC[1]+1); 
  1193.  
  1194. #                            CREATE VALIDATION RECORD                  #
  1195.       IF ERRCNT EQ 0
  1196.       THEN                   # IF NO FATAL ERRORS DETECTED             #
  1197.         BEGIN 
  1198.         VE$ID[0] = "VALIDLF";          # INSERT RECORD NAME            #
  1199.         VEWORD1[0] = 1;                # SET FLAG TO GOOD LCF          #
  1200.         END 
  1201.       ELSE                   # FATAL ERROR(S) DETECTED                 #
  1202.         BEGIN 
  1203.         VE$ID[0] = "INVLDLF";          # INSERT RECORD NAME            #
  1204.         VEWORD1[0] = 0;                # CLEAR LCF GOOD FLAG           #
  1205.         PT$TITLE[0] = BAD$MSG;         # INSERT BAD LCF MSG IN PRFX TBL#
  1206.         END 
  1207.       PT$FNAME[0] = "ENDLCF";          # PUT END FILE INDICATOR INTO   #
  1208.                                        #    PREFIX TABLE               #
  1209.       WSA = LOC(PRFX$TABLE);           # WRITE VALIDATION RECORD TO LCF#
  1210.       WR$LCF(LF$TBL"VR",WSA,HDR$SZ);
  1211. #                                                                      #
  1212.       NDLEM2(0,0,0);         # CLEAR PASS2 ERROR BUFFER                #
  1213. #                                                                      #
  1214.       SSTATS(P<APPL$TABLE>,-AT$LENG);   # RELEASE TABLE SPACE          #
  1215.       SSTATS(P<USER$TABLE>,-UT$LENG); 
  1216.       SSTATS(P<OUTCALL$TABL>,-OB$LENG); 
  1217.       SSTATS(P<INCALL$TABLE>,-IB$LENG); 
  1218.       SSTATS(P<PATHPID$TAB>,-PP$LENG);
  1219. #                                                                      #
  1220.       RETURN;                # **** RETURN ****                        #
  1221.       END # LCFTERM # 
  1222.       CONTROL EJECT;
  1223.       PROC LFILEPR; 
  1224.       BEGIN 
  1225. *IF,DEF,IMS 
  1226. # 
  1227. **    LFILEPR - LFILE STATEMENT PROC. 
  1228. * 
  1229. *     D.K. ENDO    81/10/30 
  1230. * 
  1231. *     THIS PROCEDURE USES THE LFILE STATEMENT TO DEFINE THE FILE NAME 
  1232. *     FOR THE LCF AND CREATES THE PREFIX TABLE FOR THE HEADER AND 
  1233. *     VALIDATION RECORDS. 
  1234. * 
  1235. *     PROC LFILEPR
  1236. * 
  1237. *     ENTRY        NONE.
  1238. * 
  1239. *     EXIT         NONE.
  1240. * 
  1241. *     METHOD
  1242. * 
  1243. *     IF LABEL IS O.K.
  1244. *       CREATE PREFIX TABLE.
  1245. *       CREATE VERSION ENTRY. 
  1246. *       INITIALIZE LCF FET. 
  1247. *       REWIND LCF FILE.
  1248. * 
  1249. # 
  1250. *ENDIF
  1251. # 
  1252. ****  PROC LFILEPR - XREF LIST BEGINS 
  1253. # 
  1254.       XREF
  1255.         BEGIN 
  1256.         FUNC EDATE C(10);    # UNPACKS DATE                            #
  1257.         FUNC ETIME C(10);    # UNPACKS TIME                            #
  1258.         PROC PDATE;          # RETURNS PACKED DATE AND TIME            #
  1259.         PROC RECALL;         # RETURNS CONTROL WHEN RECALL BIT IS SET  #
  1260.         PROC REWIND;         # REWINDS A GIVEN FILE                    #
  1261.         PROC VERSION;        # RETURNS OPERATING SYSTEM VERSION        #
  1262.         PROC NDLZFIL;        # ZERO FILLS A CHARACTER NAME             #
  1263.         END 
  1264. # 
  1265. ****
  1266. # 
  1267. *CALL NAMLEV
  1268.       ITEM CTEMP C(10);      # CHARACTER TEMPORARY                     #
  1269.       ARRAY PACK$DATE [0:0] S(1);      # TEMPORARY FOR PACKED DATE/TIME#
  1270.         BEGIN 
  1271.         ITEM PD$DATE U(0,24,18);       # PACKED DATE                   #
  1272.         ITEM PD$TIME U(0,42,18);       # PACKED TIME                   #
  1273.         ITEM PD$WORD U(0,24,36);       #                               #
  1274.         END 
  1275.       ARRAY VRSN$PARAMS [0:0] S(1);    # WORD USED TO CONTAIN PARAMS   #
  1276.         BEGIN                          #   FOR CALL TO VERSION         #
  1277.         ITEM VP$BC U(0,0,12) = [5];    # BYTE COUNT                    #
  1278.         ITEM VP$SB U(0,12,12) = [0];   # STARTING BYTE IN SOURCE FIELD #
  1279.         ITEM VP$BP U(0,24,12) = [0];   # BYTE POSITION IN REC FIELD    #
  1280.         ITEM VP$WSA U(0,42,18);        # ADDR OF RECEIVING FIELD       #
  1281.         END 
  1282.       CONTROL EJECT;
  1283. #                                                                      #
  1284. #                            LFILEPR CODE BEGINS HERE                  #
  1285. #                                                                      #
  1286.       IF NOT STLBERR[1]      # IF NO LABEL ERROR                       #
  1287.       THEN
  1288.         BEGIN                # CREATE PREFIX TABLE                     #
  1289.         PTWORD0[0] = 0;                # CLEAR FIRST WORD              #
  1290.         PT$ID[0] = O"7700";            # SET TABLE I.D.                #
  1291.         PTWC[0] = O"0016";             # SET WORD COUNT                #
  1292.         PTWORD1[0] = 0;                # CLEAR SECOND WORD             #
  1293.         PT$FNAME[0] = STLABEL[1];      # SET FILE NAME                 #
  1294.         PDATE(PACK$DATE);              # GET PACKED DATE AND TIME      #
  1295.         CTEMP = ETIME(PD$TIME[0]);     # UNPACK THE TIME               #
  1296.         PT$TIME[0] = C<1,8>CTEMP;      # PUT TIME IN TABLE             #
  1297.         CTEMP = EDATE(PD$DATE[0]);     # UNPACK THE DATE               #
  1298.         PT$DATE[0] = C<1,8>CTEMP;      # PUT DATE IN TABLE             #
  1299.         VP$WSA[0] = LOC(PT$OPS[0]);    # SET LOCATION FOR OS VERSION   #
  1300.         VERSION(VRSN$PARAMS);          # GET OS VERSION                #
  1301.         PT$PNAME[0] = "NDLP";          # SET PROGRAM NAME              #
  1302.         PT$PVER[0] = C<9,3>NAMVER[0];  # SET PROGRAM VERSION           #
  1303.         PT$PLEV[0] = NAMLV[0];         # SET PROGRAM BUILD LEVEL       #
  1304.         PT$BLNK1[0] = " ";             # CLEAR FIELDS                  #
  1305.         PT$BLNK2[0] = " ";
  1306.         PT$TITLE[0] = TITLE$WORD[0];   # SET TITLE IN TABLE            #
  1307. #                            CREATE VERSION ENTRY                      #
  1308.         VEWORD0[0] = 0;                # CLEAR 1ST WORD                #
  1309.         VE$ID[0] = "VERSION";          # ENTER ENTRY I.D.              #
  1310.         VEWORD1[0] = 0;                # CLEAR 2ND WORD                #
  1311.         VE$PDATE[0] = PD$WORD[0];      # ENTER THE PACKED DATE AND TIME#
  1312. #                            INITIALIZE LCF FET AND LCF                #
  1313.         CTEMP = STLABEL[1];            # PUT FILE NAME IN TEMPORARY    #
  1314.         NDLZFIL(CTEMP);                # ZERO FILL NAME                #
  1315.         LCFLFN[0] = CTEMP;             # PUT FILE NAME IN FET          #
  1316.         REWIND(LCFFET);                # REWIND THE LCF FILE           #
  1317.         RECALL(LCFFET); 
  1318.         END 
  1319.       ELSE                   # LABEL ERRORS DETECTED                   #
  1320.         BEGIN 
  1321.         LCFWORD0[0] = 0;     # CLEAR LCF FET                           #
  1322.         END 
  1323.       RETURN;                # **** RETURN ****                        #
  1324.       END # LFILEPR # 
  1325.       CONTROL EJECT;
  1326.       PROC OUTCLPR; 
  1327.       BEGIN 
  1328. *IF,DEF,IMS 
  1329. # 
  1330. **    OUTCLPR - OUTCALL STATEMENT PROC. 
  1331. * 
  1332. *     D.K. ENDO    81/10/30 
  1333. * 
  1334. *     THIS PROCEDURE CHECKS THE OUTCALL STMTS AND MAKES ENTRIES INTO
  1335. *     THE OUTCALL TABLE 
  1336. * 
  1337. *     PROC OUTCLPR
  1338. * 
  1339. *     ENTRY        NONE.
  1340. * 
  1341. *     EXIT         NONE.
  1342. * 
  1343. *     METHOD
  1344. * 
  1345. *     INCREMENT OUTCALL TABLE WORD COUNT. 
  1346. *     CLEAR NEXT ENTRY. 
  1347. *     SET ENTRY WORD COUNT. 
  1348. *     FOR EACH VALUE DECLARATION, 
  1349. *       SELECT CASE THAT APPLIES, 
  1350. *         CASE 1(NAME1,NAME2):  
  1351. *           IF VALUE IS O.K., 
  1352. *             PUT VALUE IN ENTRY
  1353. *         CASE 2(SNODE,DNODE,ACCLEV,DBL,ABL,DBZ): 
  1354. *           IF VALUE IS O.K., 
  1355. *             CHECK IF VALUE IS WITHIN RANGE. 
  1356. *             IF VALUE IS WITHIN RANGE, 
  1357. *               ENTER VALUE IN ENTRY
  1358. *         CASE 3(PRI):  
  1359. *           IF VALUE IS O.K., 
  1360. *             IF VALUE IS -YES-,
  1361. *               SET PRI FLAG IN ENTRY.
  1362. *     IF NAME1, NAME2,SNODE, OR DNODE WAS NOT SPECIFIED,
  1363. *       FLAG ERROR -- REQUIRED PARAMETER MISSING. 
  1364. *     IF ACCLEV ABL,DBL, OR DBZ WAS NOT SPECIFIED,
  1365. *       PUT DEFAULT VALUE IN ENTRY. 
  1366. * 
  1367. # 
  1368. *ENDIF
  1369. # 
  1370. ****  PROC OUTCLPR - XREF LIST BEGINS.
  1371. # 
  1372.       XREF
  1373.         BEGIN 
  1374.         PROC NDLCKRG;        # CHECKS IF VALUE IS WITHIN RANGE         #
  1375.         PROC NDLEM2;         # MAKES ENTRY IN PASS 2 ERROR FILE        #
  1376.         FUNC XCDD C(10);     # CONVERTS DEC BINARY TO DISPLAY CODE     #
  1377.         FUNC XCHD C(10);     # CONVERTS HEX BINARY TO DISPLAY CODE     #
  1378.         END 
  1379. # 
  1380. ****
  1381. # 
  1382.       DEF ABL$DEF # 2 #;     # DEFAULT ABL VALUE                       #
  1383.       DEF ACCL$DEF # 0 #;    # DEFAULT ACCLEV VALUE                    #
  1384.       DEF DNODE$MAX # 255 #; # MAXIMUM VALUE OF DENODE FOR OUTCALL     #
  1385.       DEF DBL$DEF # 2 #;     # DEFAULT DBL VALUE                       #
  1386.       DEF DBZ$DEF # 225 #;   # DEFAULT DBZ VALUE                       #
  1387.       DEF DPL$DEF # 7 #;     # DEFAULT DPL VALUE                       #
  1388.       DEF FIX$ENT # 6 #;     # SIZE OF FIXED LENGTH PORTION OF ENTRY   #
  1389.       DEF MINFAC # 4 #;      # MINIMUM LENGTH FOR EACH FACILITY CODE   #
  1390.       DEF MXFAC # 12 #;      # MAX LENGTH FOR EACH FACILITY CODE       #
  1391.       DEF MXUDATA # 248 #;   # MAX LENGTH OF UDATA                     #
  1392.       DEF MXFACL # 126 #;    # TOTAL MAX LENGTH FOR ALL FACILITIES     #
  1393.       DEF MXDTEA # 15 #;     # MAX LENGTH OF DTEA VALUE                #
  1394.       DEF MXOB$ENT # 50 #;   # MAXIMUM OUTCALL BLOCK ENTRY SIZE        #
  1395.       DEF MXPRID # 6 #;      # MAX LENGTH OF PRID VALUE                #
  1396.       DEF PRID$AOS # X"C0000000" #;    # DEFAULT PRID FOR DOS = AOS/VS #
  1397.       DEF PRID$DEF # X"C1000000" #;    # DEFAULT PRID VALUE            #
  1398.       DEF PRID$NVE # X"C2000000" #;    # DEFAULT PRID FOR DOS = NOS/VE #
  1399.       DEF UDL$DEF # 10 #;    # DEFAULT UDATA LENGTH VALUE              #
  1400.       DEF UBL$DEF # 2 #;     # DEFAULT UBL VALUE                       #
  1401.       DEF UBZ$DEF #  2  #;   # DEFAULT UBZ VALUE                       #
  1402.       DEF UBZMUL # 100 #;    # MULTIPLE WITH WHICH UBZ IS ENCODED      #
  1403.       DEF W$DEF # 2 #;       # DEFAULT -W- VALUE                       #
  1404.       DEF ZERO # O"33" #;    # DISPLAY CODE ZERO                       #
  1405.       DEF SHST$LEN # 24 #;   # LENGTH OF THE SHOST IN BITS             #
  1406.       DEF UDL$BIT # 32 #;    # START BIT OF UDL DATA FOR TRANSLATION   #
  1407.       DEF WORDSIZE # 60 #;   # WORD SIZE OF 60 BITS                    #
  1408.       DEF MXSTRINGW # 14 #;  # MAXIMUM NUMBER OF WORDS FOR DOMAIN/SERV #
  1409.       DEF MXOSTYPE # 10 #;   # MAXIMUM NUMBER OF OS TYPES              #
  1410.       DEF UNITSEP # X"1F" #; # UPPER CASE UNIT SEPARATOR               #
  1411.       ITEM TOTLEN;           # TOTAL LENGTH OF DOMAIN + SERVICE        #
  1412.       ITEM ABL$USED B;       # ABL SPECIFIED FLAG                      #
  1413.       ITEM ACCL$USED B;      # ACCLEV SPECIFIED FLAG                   #
  1414.       ITEM PORT$USED B;      # PORT NUMBER SPECIFIED FLAG              #
  1415.       ITEM PRID$USED  B;     # PRID SPECIFIED FLAG                     #
  1416.       ITEM SERVICE$USED B;   # SERVICE SPECIFIED FLAG                  #
  1417.       ITEM DOMAIN$USED B;    # DOMAIN SPECIFIED FLAG                   #
  1418.       ITEM CRNT$OSDID;       # CURRENT OS ORDINAL                      #
  1419.       ITEM CRNT$ORNET;       # CURRENT ORIGINATING NETWORK             #
  1420.       ITEM CRNT$DENET;       # CURRENT DESTINATION NETWORK             #
  1421.       ITEM CRNT$DOSS;        # CURRENT DESTINATION OPERATING SYSTEMS   #
  1422.       ITEM CRNT$DHST C(10);  # CURRENT DHOST VALUE                     #
  1423.       ITEM CRNT$ENT;         # POINTER TO BEGINNING OF CURRENT ENTRY   #
  1424.       ITEM CRNT$PRID;        # CURRENT PRID VALUE                      #
  1425.       ITEM UDATA$DEF C(24);  # DEFAULT UDATA SIZE                      #
  1426.       ITEM UDATAW ;          # WORD COUNT OF UDATA SPECIFIED           #
  1427.       ITEM CRNT$SHST;        # CURRENT VALUE OF SHOST                  #
  1428.       ITEM CTEMP C(10);      # CHARACTER TEMPORARY                     #
  1429.       ITEM CTEMP2 C(20);     # CHARACTER TEMPORARY                     #
  1430.       ITEM DBL$USED B;       # DBL SPECIFIED FLAG                      #
  1431.       ITEM DBZ$USED B;       # DBZ SPECIFIED FLAG                      #
  1432.       ITEM DHST$LEN;         # DHOST VALUE LENGTH                      #
  1433.       ITEM NAME1LEN;         # NAME1 VALUE LENGTH                      #
  1434.       ITEM DHST$USED B;      # DHOST SPECIFIED FLAG                    #
  1435.       ITEM SHST$USED B;      # SHOST SPECIFIED FLAG                    #
  1436.       ITEM DPLS$USED B;      # DPLS SPECIFIED FLAG                     #
  1437.       ITEM FAC$LENG;         # CURRENT TOTAL FACILITY CODE LENGTH      #
  1438.       ITEM NOMATCH B;        # NO MATCH FLAG                           #
  1439.       ITEM I;                # SCRATCH ITEM                            #
  1440.       ITEM ITEMP;            # INTEGER TEMPORARY                       #
  1441.       ITEM J;                # INTEGER TEMPORARY                       #
  1442.       ITEM  K;               # INTEGER TEMPORARY                       #
  1443.       ITEM WDC;              # WORD COUNT FOR SERVICE/DOMAIN           #
  1444.       ITEM NAM1$USED B;      # NAME1 SPECIFIED FLAG                    #
  1445.       ITEM NAM2$USED B;      # NAME2 SPECIFIED FLAG                    #
  1446.       ITEM NEXT$WORD;        # POINTER TO NEXT AVAILABLE WORD          #
  1447.       ITEM SAVE$WORD;        # COPY OF THE ORIGINAL POINTER TO NEXT    #
  1448.                              # AVAILABLE WORD                          #
  1449.       ITEM OB$STAT B;        # STATUS RETURNED BY RANGE CHECK PROC     #
  1450.       ITEM UBL$USED B;       # UBL SPECIFIED FLAG                      #
  1451.       ITEM UBZ$USED B;       # UBZ SPECIFIED FLAG                      #
  1452.       ITEM UDATA$USED B;     # UDATA SPECIFIED FLAG                    #
  1453.       ITEM WS$USED B;        # -WS- SPECIFIED FLAG                     #
  1454.       ITEM SETCHAR  B;       # FLAG FOR PASSING CHARACTER              #
  1455.       ITEM PID$USED B;       # -PID- SPECIFIED FLAG                    #
  1456.       ITEM CRUBIT;           # BIT POINTER FOR CRNT$UDATA              #
  1457.       ARRAY CRNT$UDATA [0:17] S(1); 
  1458.         BEGIN 
  1459.         ITEM CRNT$UWRD U(00,00,60);  # UDATA VALUE                     #
  1460.         END 
  1461.       ARRAY SERVICE$WD[ 0 : 14] S(1); 
  1462.         BEGIN 
  1463.         ITEM SERVICELEN  U(00,00,42);  # LENGTH OF SERVICE IN SEMIOCTET#
  1464.         ITEM SERVICELEN1 U(00,42,18);  # EXTENDED LENGTH OF SERVICE    #
  1465.         ITEM SERVICEWD    U(00,00,60);  # CONTENT OF SERVICE           #
  1466.         END 
  1467.       ARRAY ASCIICHAR [0:0] S(1); 
  1468.         BEGIN 
  1469.         ITEM ASCII$CHAR U(00,00,08);
  1470.         ITEM ASCII$CHAR1 U(00,00,04); 
  1471.         ITEM ASCII$CHAR2 U(00,04,04); 
  1472.         END 
  1473.       ARRAY DOMAIN$WD[ 0 : 14] S(1);
  1474.         BEGIN 
  1475.         ITEM DOMAINLEN  U(00,00,60);   # LENGTH OF DOMAIN  IN SEMIOCTET#
  1476.         ITEM DOMAINWD    U(00,00,60);  # CONTENT OF DOMAIN             #
  1477.         END 
  1478.       ARRAY DTEA$VAL [0:0] S(1);
  1479.         BEGIN                # DTEA VALUE                              #
  1480.         ITEM DTEA1      U(00,00,52);   # 1ST 13 NUMBERS OF DTEA VALUE  #
  1481.         ITEM DTEA2      U(00,52,08);   # 14TH NUMBER OF DTEA VALUE     #
  1482.         ITEM DTEA$WORD  I(00,00,60);
  1483.         END 
  1484.       ARRAY ERROR$WORD [0:0] S(1);     # BUFFER WORD FOR ERROR MESSAGE #
  1485.         BEGIN 
  1486.         ITEM PARAM C(0,0,4)   = ["    "];   # PARAMETER                #
  1487.         ITEM SLASH C(0,24,1)  = ["/"];
  1488.         ITEM PVALUE C(0,30,5) = ["     "];  # VALUE                    #
  1489.         END 
  1490.       STATUS ORNETWORK OUNKNOWN,OCCP,OCDCNET;  # ORIGINAL NETWORK TYPE #
  1491.  
  1492.       STATUS DESNETWORK DUNKNOWN, DCCP,DCDCNET,DAOSVS,DFOREIGN; 
  1493.                                          # DESTINATION NETWORK TYPE    #
  1494.       STATUS DOSS DOSUNKNOWN,DONOS,DONOSVE,DOAOSVS,DOFOREIGN; 
  1495.                                          # DESTINATION OPERATING SYSTEM#
  1496.       ARRAY OSDARRAY [ 0 : MXOSTYPE] S(1);
  1497.         BEGIN 
  1498.         ITEM OSDMN C(00,00,03) = [ "PPO", 
  1499.                                    "PDO", 
  1500.                                    "DPO", 
  1501.                                    "DDO", 
  1502.                                    "PDV", 
  1503.                                    "DDV", 
  1504.                                    "PAA", 
  1505.                                    "DAA", 
  1506.                                    "PFF", 
  1507.                                    "DFF", 
  1508.                                    ]; 
  1509.         ITEM OSDMN1 C(00,00,01);
  1510.         ITEM OSDMN2 C(00,06,01);
  1511.         ITEM OSDMN3 C(00,12,01);
  1512.         END 
  1513.       ARRAY DNTYPE [ 00:03] S(1); 
  1514.         BEGIN 
  1515.         ITEM DNNCHAR         C(00,00,01) = ["P","D","A","F"]; 
  1516.         ITEM DNNETV          U(00,42,18) = [ DESNETWORK"DCCP",
  1517.                                              DESNETWORK"DCDCNET", 
  1518.                                              DESNETWORK"DAOSVS",
  1519.                                              DESNETWORK"DFOREIGN" 
  1520.                                            ]; 
  1521.         END 
  1522.       ARRAY DNOSTYPE [ 00:03 ] S(1);
  1523.         BEGIN 
  1524.         ITEM DNOCHAR         C(00,00,01) = [ "O","V","A","F"];
  1525.         ITEM DNOOSV          U(00,42,18) = [ DOSS"DONOS", 
  1526.                                              DOSS"DONOSVE", 
  1527.                                              DOSS"DOAOSVS", 
  1528.                                              DOSS"DOFOREIGN"
  1529.                                            ]; 
  1530.         END 
  1531.       SWITCH OUTCJMP  NEXT$PRM    ,            , # UNK     , NODE     ,#
  1532.                                   ,            , # VARIANT , OPGO     ,#
  1533.                                   ,            , #         , LLNAME   ,#
  1534.                                   ,            , #         ,          ,#
  1535.                                   ,            , #         ,          ,#
  1536.                                   ,            , # HNAME   , LOC      ,#
  1537.                                   ,            , #         ,          ,#
  1538.                                   ,            , #         ,          ,#
  1539.                                   ,            , #         ,          ,#
  1540.                                   ,            , # NCNAME  , DI       ,#
  1541.                                   ,            , # N1      , P1       ,#
  1542.                                   ,            , # N2      , P2       ,#
  1543.                                   ,            , # NOLOAD1 , NOLOAD2  ,#
  1544.                                   ,            , #         ,          ,#
  1545.                                   ,            , #         ,          ,#
  1546.                                   , PORT$      , # NI      , PORT     ,#
  1547.                                   ,            , # LTYPE   , TIPTYPE  ,#
  1548.                                   ,            , # AUTO    , SL       ,#
  1549.                                   ,            , # LSPEED  , DFL      ,#
  1550.                                   ,            , # FRAME   , RTIME    ,#
  1551.                                   ,            , # RCOUNT  , NSVC     ,#
  1552.                                   ,            , # PSN     , DCE      ,#
  1553.                       DTEA$       ,            , # DTEA    ,          ,#
  1554.                                   ,            , #         ,          ,#
  1555.                                   ,            , #         ,          ,#
  1556.                                   ,            , # STIP    , TC       ,#
  1557.                                   ,            , # RIC     , CSET     ,#
  1558.                                   ,            , # TSPEED  , CA       ,#
  1559.                                   ,            , # CO      , BCF      ,#
  1560.                                   ,            , # MREC    , W        ,#
  1561.                                   ,            , # CTYP    , NCIR     ,#
  1562.                                   ,            , # NEN     ,          ,#
  1563.                                   ,            , #         , DT       ,#
  1564.                                   ,            , # SDT     , TA       ,#
  1565.                       ABL$        , DBZ$       , # ABL     , DBZ      ,#
  1566.                       UBZ$        , DBL$       , # UBZ     , DBL      ,#
  1567.                       UBL$        ,            , # UBL     , XBZ      ,#
  1568.                                   ,            , # DO      , STREAM   ,#
  1569.                                   ,            , # HN      , AUTOLOG  ,#
  1570.                                   , PRI$       , # AUTOCON , PRI      ,#
  1571.                                   ,            , # P80     , P81      ,#
  1572.                                   ,            , # P82     , P83      ,#
  1573.                                   ,            , # P84     , P85      ,#
  1574.                                   ,            , # P86     , P87      ,#
  1575.                                   ,            , # P88     , P89      ,#
  1576.                                   ,            , # AL      , BR       ,#
  1577.                                   ,            , # BS      , B1       ,#
  1578.                                   ,            , # B2      , CI       ,#
  1579.                                   ,            , # CN      , CT       ,#
  1580.                                   ,            , # DLC     , DLTO     ,#
  1581.                                   ,            , # DLX     , EP       ,#
  1582.                                   ,            , # IN      , LI       ,#
  1583.                                   ,            , # OP      , PA       ,#
  1584.                                   ,            , # PG      , PL       ,#
  1585.                                   ,            , # PW      , SE       ,#
  1586.                                   ,            , #         ,          ,#
  1587.                                   ,            , #         ,          ,#
  1588.                                   ,            , #         ,          ,#
  1589.                                   ,            , #         ,          ,#
  1590.                                   ,            , #         ,          ,#
  1591.                                   ,            , #         ,          ,#
  1592.                                   ,            , #         ,          ,#
  1593.                                   ,            , #         ,          ,#
  1594.                                   ,            , #         ,          ,#
  1595.                                   ,            , #         ,          ,#
  1596.                                   ,            , #         ,          ,#
  1597.                        NETOSD$    , DOMAIN$    , # NETOSD  , DOMAIN   ,#
  1598.                        SERVICE$   ,            , #         ,          ,#
  1599.                                   ,            , # MFAM    , MUSER    ,#
  1600.                                   ,            , # MAPPL   , DFAM     ,#
  1601.                                   ,            , # DUSER   ,          ,#
  1602.                                   ,            , #         ,          ,#
  1603.                                   ,            , # PAPPL   ,          ,#
  1604.                                   ,            , #         ,          ,#
  1605.                                   ,            , # UID     ,PRIV      ,#
  1606.                                   ,            , # KDSP    ,          ,#
  1607.                        NAME1$     , NAME2$     , # NAME1   , NAME2    ,#
  1608.                        SNODE$     , DNODE$     , # SNODE   , DNODE    ,#
  1609.                        ACCLEV$    , DHOST$     , # ACCLEV  , DHOST    ,#
  1610.                                   , DPLS$      , #         , DPLS     ,#
  1611.                        PRID$      , UDATA$     , # PRID    , UDATA    ,#
  1612.                                   , WS$        , #         , WS       ,#
  1613.                        PID$       ,            , # PID     ,          ,#
  1614.                                   ,            , # FAM     , UNAME    ,#
  1615.                        FAC$       , FAC$       , # FAC1    , FAC2     ,#
  1616.                        FAC$       , FAC$       , # FAC3    , FAC4     ,#
  1617.                        FAC$       , FAC$       , # FAC5    , FAC6     ,#
  1618.                        FAC$       , FAC$       , # FAC7    , FAC8     ,#
  1619.                        FAC$       , FAC$       , # FAC9    , FAC10    ,#
  1620.                        FAC$       , FAC$       , # FAC11   , FAC12    ,#
  1621.                        FAC$       , FAC$       , # FAC13   , FAC14    ,#
  1622.                        FAC$       , FAC$       , # FAC15   , FAC16    ,#
  1623.                        FAC$       , FAC$       , # FAC17   , FAC18    ,#
  1624.                        FAC$       , FAC$       , # FAC19   , FAC20    ,#
  1625.                        FAC$       , FAC$       , # FAC21   , FAC22    ,#
  1626.                        FAC$       , FAC$       , # FAC23   , FAC24    ,#
  1627.                        FAC$       , FAC$       , # FAC25   , FAC26    ,#
  1628.                        FAC$       , FAC$       , # FAC27   , FAC28    ,#
  1629.                        FAC$       , FAC$       , # FAC29   , FAC30    ,#
  1630.                        FAC$       ,            , # FAC31   , ANAME    ,#
  1631.                        SHOST$     ;              # SHOST               #
  1632.  
  1633.       CONTROL EJECT;
  1634. #                                                                      #
  1635. #                            OUTCLPR CODE BEGINS HERE                  #
  1636. #                                                                      #
  1637.       ABL$USED = FALSE;                # CLEAR PARAM SPECIFIED FLAGS   #
  1638.       PRID$USED = FALSE;
  1639.       ACCL$USED = FALSE;
  1640.       DBL$USED = FALSE; 
  1641.       DBZ$USED = FALSE; 
  1642.       DHST$USED = FALSE;
  1643.       DPLS$USED = FALSE;
  1644.       NAM1$USED = FALSE;
  1645.       NAM2$USED = FALSE;
  1646.       UBL$USED = FALSE; 
  1647.       UBZ$USED = FALSE; 
  1648.       UDATA$USED = FALSE; 
  1649.       WS$USED = FALSE;
  1650.       PID$USED = FALSE; 
  1651.       SHST$USED = FALSE;
  1652.       PORT$USED = FALSE;
  1653.       SERVICE$USED = FALSE; 
  1654.       DOMAIN$USED = FALSE;
  1655.       TOTLEN = 0; 
  1656.       SERVICEWD[0] = 0; 
  1657.       DOMAINLEN[0] = 0; 
  1658.       CRNT$ORNET = ORNETWORK"OCCP"; 
  1659.       CRNT$DENET = DESNETWORK"DCCP";
  1660.       CRNT$DOSS = DOSS"DONOS";
  1661.       PP$SNODE = 0; 
  1662.       PP$DNODE = 0; 
  1663.       PP$PORT = 0;
  1664.       PP$DTEAL = 0; 
  1665.       PP$DTEA = 0;
  1666.       CRNT$PID = " ";        # BLANK FILL CURRENT PID VALUE            #
  1667.       UDATA$DEF = " ";
  1668.       CRNT$PRID = PRID$DEF;  # SET CURRENT PRID VALUE TO DEFAULT       #
  1669.       DHST$LEN = 0;          # CLEAR DHOST LENGTH VALUE                #
  1670.       FAC$LENG = 0;          # CLEAR CURRENT FAC LENGTH                #
  1671.       CRNT$ENT = OBRWC[1] + 1;         # POINT TO NEXT ENTRY           #
  1672.       IF OBRWC[1]+MXOB$ENT GQ OB$LENG-1 
  1673.       THEN                   # IF NEED MORE TABLE SPACE                #
  1674.         BEGIN                #  ALLOCATE MORE SPACE                    #
  1675.         SSTATS(P<OUTCALL$TABL>,MXOB$ENT); 
  1676.         END 
  1677.       NEXT$WORD = CRNT$ENT + FIX$ENT;  # POINT TO NEXT WORD            #
  1678.       FOR I=CRNT$ENT STEP 1 UNTIL NEXT$WORD-1 
  1679.       DO
  1680.         BEGIN 
  1681.         OBWORD[I] = 0;                 # CLEAR NEXT ENTRY              #
  1682.         END 
  1683.       OBWC[CRNT$ENT] = FIX$ENT;        # SET ENTRY WORD COUNT          #
  1684.       FOR I=1 STEP 1 UNTIL STWC[0]     # FOR EACH VALUE DECLARATION    #
  1685.       DO
  1686.         BEGIN 
  1687.         GOTO OUTCJMP[STKWID[I]];       # GOTO APPROPRIATE PARAGRAPH    #
  1688. NAME1$: 
  1689.         NAM1$USED = TRUE;              # SET NAME1 SPECIFIED FLAG      #
  1690.         NAME1LEN = STVALLEN[I];        # SAVE LENGTH OF APPLICATIONS   #
  1691.         IF NOT STVLERR[I]              # IF THE VALUE IS O.K.          #
  1692.         THEN
  1693.           BEGIN                        # ENTER NAME1 VALUE IN ENTRY    #
  1694.           OBNAME1[CRNT$ENT + 1] = STVALNAM[I];
  1695.           END 
  1696.         TEST I; 
  1697. NAME2$: 
  1698.         NAM2$USED = TRUE;              # SET NAME2 SPECIFIED FLAG      #
  1699.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  1700.         THEN
  1701.           BEGIN                        # ENTER NAME2 VALUE IN ENTRY    #
  1702.           OBNAME2[CRNT$ENT + 1] = STVALNAM[I];
  1703.           END 
  1704.         TEST I; 
  1705. PRI$: 
  1706.         IF NOT STVLERR[I]              # IF PRI VALUE IS O.K.          #
  1707.         THEN
  1708.           BEGIN 
  1709.           IF STVALNAM[I] EQ "YES"      # IF VALUE IS -YES-             #
  1710.           THEN
  1711.             BEGIN                      # SET PRI FLAG IN ENTRY         #
  1712.             OBPRI[CRNT$ENT + 2] = TRUE; 
  1713.             END 
  1714.           END 
  1715.         TEST I; 
  1716. DBL$: 
  1717.         DBL$USED = TRUE;               # SET DBL SPECIFIED FLAG        #
  1718.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  1719.         THEN
  1720.           BEGIN                        # CHECK IF VALUE IS WITHIN RANGE#
  1721.           NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); 
  1722.           IF OB$STAT                   # IF WITHIN RANGE               #
  1723.           THEN
  1724.             BEGIN                      # PUT DBL VALUE IN ENTRY        #
  1725.             OBDBL[CRNT$ENT + 2] = STVALNUM[I];
  1726.             END 
  1727.           END 
  1728.         TEST I; 
  1729. DBZ$: 
  1730.         DBZ$USED = TRUE;               # SET DBZ SPECIFIED FLAG        #
  1731.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  1732.         THEN
  1733.           BEGIN                        # CHECK IF VALUE WITHIN RANGE   #
  1734.           NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); 
  1735.           IF OB$STAT                   # IF WITHIN RANGE               #
  1736.           THEN
  1737.             BEGIN                      # PUT DBZ VALUE IN ENTRY        #
  1738.             OBDBZ[CRNT$ENT + 2] = STVALNUM[I];
  1739.             END 
  1740.           END 
  1741.         TEST I; 
  1742. UBL$: 
  1743.         UBL$USED = TRUE;               # SET UBL SPECIFIED FLAG        #
  1744.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  1745.         THEN
  1746.           BEGIN                        # CHECK IF VALUE IS WITHIN RANGE#
  1747.           NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); 
  1748.           IF OB$STAT                   # IF WITHIN RANGE               #
  1749.           THEN
  1750.             BEGIN                      # PUT VALUE IN ENTRY            #
  1751.             OBUBL[CRNT$ENT + 2] = STVALNUM[I];
  1752.             END 
  1753.           END 
  1754.         TEST I; 
  1755. UBZ$: 
  1756.         UBZ$USED = TRUE;               # SET UBZ SPECIFIED FLAG        #
  1757.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  1758.         THEN
  1759.           BEGIN                        # CHECK IF VALUE IS WITHIN RANGE#
  1760.           NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); 
  1761.           IF OB$STAT                   # IF WITHIN RANGE               #
  1762.           THEN
  1763.             BEGIN            # PUT VALUE IN ENTRY                      #
  1764.             OBUBZ[CRNT$ENT + 2] = STVALNUM[I];
  1765.             END 
  1766.           END 
  1767.         TEST I; 
  1768. ABL$: 
  1769.         ABL$USED = TRUE;               # SET ABL SPECIFIED FLAG        #
  1770.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  1771.         THEN
  1772.           BEGIN                        # CHECK IF VALUE WITHIN RANGE   #
  1773.           NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); 
  1774.           IF OB$STAT                   # IF WITHIN RANGE               #
  1775.           THEN
  1776.             BEGIN                      # PUT ABL VALUE IN ENTRY        #
  1777.             OBABL[CRNT$ENT + 2] = STVALNUM[I];
  1778.             END 
  1779.           END 
  1780.         TEST I; 
  1781. SNODE$: 
  1782.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  1783.         THEN
  1784.           BEGIN                        # CHECK IF VALUE WITHIN RANGE   #
  1785.           NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); 
  1786.           IF OB$STAT                   # IF WITHIN RANGE               #
  1787.           THEN
  1788.             BEGIN                      # PUT SNODE VALUE IN ENTRY      #
  1789.             OBSNODE[CRNT$ENT + 3] = STVALNUM[I];
  1790.             PP$SNODE = STVALNUM[I];    # SAVE SNODE IN PP$SNODE        #
  1791.             END 
  1792.           END                          # FOR PATH PID TABLE            #
  1793.         TEST I; 
  1794. PORT$:  
  1795.         IF NOT STVLERR[I] 
  1796.         THEN                 # IF VALUE IS O.K.                        #
  1797.           BEGIN 
  1798.           IF STVALNUM[I] LQ X"FE" 
  1799.           THEN               # IF VALUE IS WITHIN RANGE                #
  1800.             BEGIN 
  1801.             OBPORT[CRNT$ENT + 2] = STVALNUM[I];      # ENTRY PORT NUM  #
  1802.             PP$PORT = STVALNUM[I]; # PORT NUMBER USED BY PATH PID TABLE#
  1803.             END 
  1804.           ELSE               # VALUE IS TOO BIG                        #
  1805.             BEGIN            # FLAG ERROR -- VALUE OUT OF RANGE        #
  1806.             CTEMP = XCHD(STVALNUM[I]);
  1807.             NDLEM2(ERR100,STLNUM[0],CTEMP); 
  1808.             END 
  1809.           END 
  1810.         TEST I; 
  1811. WS$:  
  1812.         WS$USED = TRUE;      # SET -WS- SPECIFIED FLAG                 #
  1813.         IF NOT STVLERR[I] 
  1814.         THEN                 # IF VALUE IS O.K.                        #
  1815.           BEGIN              # CHECK IF VALUE IS WITHIN RANGE          #
  1816.           NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); 
  1817.           IF OB$STAT
  1818.           THEN               # IF VALUE IS WITHIN RANGE                #
  1819.             BEGIN 
  1820.             OBWS[CRNT$ENT + 3] = STVALNUM[I];     # ENTER -WS- VALUE   #
  1821.             END 
  1822.           END 
  1823.         TEST I; 
  1824. DPLS$:  
  1825.         DPLS$USED = TRUE;    # SET DPLS SPECIFIED FLAG                 #
  1826.         IF NOT STVLERR[I] 
  1827.         THEN                 # IF VALUE IS O.K.                        #
  1828.           BEGIN              # CHECK IF VALUE IS WITHIN RANGE          #
  1829.           NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); 
  1830.           IF OB$STAT
  1831.           THEN               # IF VALUE IS WITHIN RANGE                #
  1832.             BEGIN            # CALCULATE VALUE (POWER OF TWO)          #
  1833.             ITEMP = 16;      # SET TO SMALLEST DPL VALUE               #
  1834.             FOR J=4 STEP 1 WHILE ITEMP LS STVALNUM[I] 
  1835.             DO               # FOR INCREMENT OF EXPONENT               #
  1836.               BEGIN 
  1837.               ITEMP = ITEMP * 2;       # SET TO NEXT POWER OF TWO      #
  1838.               END 
  1839.             OBDPLS[CRNT$ENT + 3] = J;  # PUT VALUE IN ENTRY            #
  1840.             IF STVALNUM[I] NQ ITEMP 
  1841.             THEN                       # VALUE IS NOT POWER OF 2       #
  1842.               BEGIN                    # FLAG WARNING                  #
  1843.               PARAM[0]  = "DPLS";      # PARAMETER NAME                #
  1844.               CTEMP     = XCDD(ITEMP);
  1845.               PVALUE[0] = C<5,5>CTEMP; # VALUE                         #
  1846.               NDLEM2(ERR137,STLNUM[0],ERROR$WORD);
  1847.               END 
  1848.             END 
  1849.           END 
  1850.         TEST I; 
  1851. DNODE$: 
  1852.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  1853.         THEN
  1854.           BEGIN                        # CHECK IF VALUE WITHIN RANGE   #
  1855.           OB$STAT = TRUE; 
  1856.           IF (STVALNUM[I] LS 0) OR (STVALNUM[I] GR DNODE$MAX) 
  1857.           THEN
  1858.             BEGIN 
  1859.             OB$STAT = FALSE;
  1860.             NDLEM2(ERR100,STLNUM[0],XCDD(STVALNUM[I])); 
  1861.             END                      # GENERATE ERROR MESSAGE          #
  1862.           IF OB$STAT                 # IF WITHIN RANGE                 #
  1863.           THEN
  1864.             BEGIN                      # PUT DNODE VALUE IN ENTRY      #
  1865.             OBDNODE[CRNT$ENT + 3] = STVALNUM[I];
  1866.             PP$DNODE = STVALNUM[I];  # SAVE DNODE IN PP$DNODE FOR      #
  1867.             END                      # PATH PID TABLE                  #
  1868.           END 
  1869.         TEST I; 
  1870. PID$: 
  1871.         PID$USED = TRUE;               # SET NAME2 SPECIFIED FLAG      #
  1872.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  1873.         THEN
  1874.           BEGIN                        # ENTER NAME2 VALUE IN ENTRY    #
  1875.           CRNT$PID = STVALNAM[I];      # SAVE VALUE OF CURRENT PID     #
  1876.           OBNAME2[CRNT$ENT + 1] = STVALNAM[I];
  1877.           OBPID[CRNT$ENT + 2] = TRUE;  # SET PID USED FLAG             #
  1878.           END 
  1879.         TEST I; 
  1880. ACCLEV$:  
  1881.         ACCL$USED = TRUE;              # SET ACCLEV SPECIFIED FLAG     #
  1882.         IF NOT STVLERR[I]              # IF VALUE IS O.K.              #
  1883.         THEN
  1884.           BEGIN                        # CHECK IF VALUE WITHIN RANGE   #
  1885.           NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); 
  1886.           IF OB$STAT                   # IF WITHIN RANGE               #
  1887.           THEN
  1888.             BEGIN                      # PUT ACCLEV VALUE IN ENTRY     #
  1889.             OBACC[CRNT$ENT + 3] = STVALNUM[I];
  1890.             END 
  1891.           END 
  1892.         TEST I; 
  1893. SHOST$: 
  1894.         SHST$USED = TRUE;          # SET SHOST SPECIFIED FLAG          #
  1895.         IF NOT STVLERR[I]          # IF VALUE IS O.K.                  #
  1896.         THEN
  1897.           BEGIN 
  1898.           NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT);  # CHECK RANGE       #
  1899.           IF OB$STAT               # IF RANGE IS O.K.                  #
  1900.           THEN
  1901.             BEGIN 
  1902.             CRNT$SHST = STVALNUM[I];  # ASSIGN STVALNUM IS CURRENT     #
  1903.                                     # SHOST                            #
  1904.             END 
  1905.           END 
  1906.         TEST I; 
  1907.  
  1908. DHOST$: 
  1909.         DHST$USED = TRUE;    # SET DHOST SPECIFIED FLAG                #
  1910.         IF NOT STVLERR[I] 
  1911.         THEN                 # IF VALUE IS O.K.                        #
  1912.           BEGIN 
  1913.           NDLCKRG(STKWID[I],STVALNUM[I],OB$STAT); # CHECKS RANGE       #
  1914.           IF OB$STAT                              # IF RANGE IS OK     #
  1915.           THEN
  1916.             BEGIN 
  1917.             CTEMP = XCHD(STVALNUM[I]); #CONVERTS TO HEX#
  1918.             DC$ZFILL(CTEMP);           #ZERO FILL CTEMP#
  1919.             CRNT$DHST = C<8,2>CTEMP;   #MOVE CTEMP TO DHST# 
  1920.             DHST$LEN = 2;              #MUST BE 2 CHAR LONG#
  1921.             END 
  1922.           ELSE
  1923.             BEGIN                  #     STICKS IN VALUES OF DHST$LEN  #
  1924.             DHST$LEN = 2;          # DHST$LEN LEFT EAULT TO 2          #
  1925.             CRNT$DHST = " ";       # BLANK FILLED CRNT$DHST            #
  1926.             END 
  1927.           END 
  1928.         TEST I; 
  1929. DTEA$:  
  1930.         IF NOT STVLERR[I] 
  1931.         THEN                 # IF VALUE IS O.K.                        #
  1932.           BEGIN 
  1933.           CTEMP2 = STVALNAM[I];        # CONCATINATE NEXT TWO VALUES   #
  1934.           C<7,7>CTEMP2 = STVALNAM[I+1];# GET NEXT 7 CHARACTER          #
  1935.           C<14,1>CTEMP2 = STVALNAM[I + 2]; # GET NEXT ONE CHAR         #
  1936.           IF STVALLEN[I] LQ MXDTEA
  1937.           THEN               # IF VALUE IS WITHIN RANGE                #
  1938.             BEGIN 
  1939.             OBAL1[CRNT$ENT + 4] = STVALLEN[I];
  1940.             PP$DTEAL = OBAL1[CRNT$ENT + 4];  # SAVE DTEA LENGTH        #
  1941.             ITEMP = CRNT$ENT + 4;      # POINT TO DTEA WORD            #
  1942.             DTEA$WORD[0] = 0;          # CLEAR DTEA VALUE TEMPORARY    #
  1943.             FOR J=0 STEP 1 UNTIL STVALLEN[I] - 1
  1944.             DO               # FOR EACH CHARACTER IN VALUE             #
  1945.               BEGIN          #   CONVERT CHARACTER TO 4-BIT BCD        #
  1946.               B<J*4,4>DTEA$WORD[0] = C<J,1>CTEMP2 - ZERO; 
  1947.               END 
  1948.             PP$DTEA = DTEA$WORD[0];  # SAVE DTEA FOR PATH PID ENTRY    #
  1949.             OBDTEA1[ITEMP] = DTEA1[0]; # PUT VALUE IN ENTRY            #
  1950.             OBDTEA2[ITEMP + 1] = DTEA2[0];
  1951.             END 
  1952.           ELSE               # VALUE IS TOO BIG                        #
  1953.             BEGIN            # FLAG ERROR -- VALUE OUT OF RANGE        #
  1954.             NDLEM2(ERR100,STLNUM[0],CTEMP2);
  1955.             END 
  1956.           END 
  1957.         I = I + 2;
  1958.         TEST I; 
  1959. FAC$: 
  1960.         IF NOT STVLERR[I] 
  1961.         THEN                 # IF VALUE IS O.K.                        #
  1962.           BEGIN 
  1963.           IF STVALLEN[I] GQ MINFAC AND STVALLEN[I] LQ MXFAC 
  1964.           THEN               # IF VALUE IS WITHIN RANGE                #
  1965.             BEGIN            #   INCREMENT FAC COUNT                   #
  1966.             OBFACNUM[CRNT$ENT + 3] = OBFACNUM[CRNT$ENT + 3] + 1;
  1967.             OBWORD[NEXT$WORD] = 0;     # CLEAR NEXT WORD               #
  1968.             OBFACL[NEXT$WORD] = STVALLEN[I];   # SAVE LENGTH           #
  1969.             ITEMP = STVALLEN[I] * 4;   # CALCULATE MASK                #
  1970.             B<0,ITEMP>OBFAC[NEXT$WORD] = B<60-ITEMP,ITEMP>STWORD[I+1 ]; 
  1971.             OBWC[CRNT$ENT] = OBWC[CRNT$ENT] + 1; # INCREMENT WORD COUNT#
  1972.             FAC$LENG = FAC$LENG + STVALLEN[I];   # INCREMENT FAC LENGTH#
  1973.             NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD            #
  1974.             OBWORD[NEXT$WORD] = 0;
  1975.             END 
  1976.           ELSE               # VALUE IS TOO BIG                        #
  1977.             BEGIN            # FLAG ERROR -- VALUE OUT OF RANGE        #
  1978.             CTEMP = XCHD(STWORD[I + 1]);
  1979.             NDLEM2(ERR100,STLNUM[0],CTEMP); 
  1980.             END 
  1981.           END 
  1982.         I = I + 1;
  1983.         TEST I; 
  1984. NETOSD$:  
  1985.         IF NOT STVLERR[I] 
  1986.         THEN                 # IF VALUE IS O.K.                        #
  1987.           BEGIN 
  1988.           NOMATCH = TRUE;    # SET NOMATCH FLAG                        #
  1989.           OSDMN[MXOSTYPE] = C<0,3>STVALNAM[I]; # PRELOAD PARAMETER WORD#
  1990.           FOR K = 0 STEP 1 WHILE NOMATCH
  1991.           DO
  1992.             BEGIN 
  1993.             IF OSDMN[K] EQ  C<0,3>STVALNAM[I] 
  1994.             THEN
  1995.               BEGIN 
  1996.               NOMATCH = FALSE;  # EXIT LOOP MATCH FOUND                #
  1997.               CRNT$OSDID = K; 
  1998.               END 
  1999.             END 
  2000.           IF CRNT$OSDID EQ MXOSTYPE 
  2001.           THEN
  2002.             BEGIN 
  2003.             NDLEM2(ERR168,STLNUM[0],STVALNAM[I]); 
  2004.             END 
  2005.           IF OSDMN1[CRNT$OSDID] EQ "P"
  2006.           THEN
  2007.             BEGIN 
  2008.             CRNT$ORNET = ORNETWORK"OCCP";  # CCP IS THE ORGINAL NETWORK#
  2009.             END 
  2010.           ELSE
  2011.             BEGIN 
  2012.             CRNT$ORNET = ORNETWORK"OCDCNET"; # MUST BE CDCNET          #
  2013.             END 
  2014.           FOR K = 0 STEP 1 UNTIL 3
  2015.           DO
  2016.             BEGIN 
  2017.             IF OSDMN2[CRNT$OSDID] EQ DNNCHAR[K] 
  2018.             THEN
  2019.               BEGIN 
  2020.               CRNT$DENET = DNNETV[K]; 
  2021.               END 
  2022.             END 
  2023.           FOR K = 0 STEP 1 UNTIL 3
  2024.           DO
  2025.             BEGIN 
  2026.             IF OSDMN3[CRNT$OSDID] EQ DNOCHAR[K] 
  2027.             THEN
  2028.               BEGIN 
  2029.               CRNT$DOSS = DNOOSV[K];
  2030.               END 
  2031.             END 
  2032.           END 
  2033.         TEST I; 
  2034.  
  2035. SERVICE$: 
  2036.         SERVICE$USED = TRUE;  # SET SERVICE USED FLAG                  #
  2037.         IF NOT STVLERR[I]    # IF VALUE IS O.K.                        #
  2038.         THEN
  2039.           BEGIN 
  2040.           IF TOTLEN + STVALNUM[I] LQ MXUDATA  # VALUE LENGTH O.K.      #
  2041.           THEN
  2042.             BEGIN 
  2043.             WDC = STVALNUM[I]/10 + 1;  # CALCULATE WORD COUNT          #
  2044.             TOTLEN = TOTLEN + STVALNUM[I]; # TOTLEN = DOMAIN + SERVICE #
  2045.             SERVICELEN[0] = STVALNUM[I]; # SAVE LENGTH OF SERVICE      #
  2046.             FOR K = 1 STEP 1 UNTIL WDC
  2047.             DO
  2048.               BEGIN 
  2049.               SERVICEWD[K] = STWORD[I + K]; # SAVE WORDS               #
  2050.               END 
  2051.             END 
  2052.           ELSE
  2053.             BEGIN 
  2054.             NDLEM2(ERR100,STLNUM[0],"SERVICE"); 
  2055.             END 
  2056.           END 
  2057.         I = I + MXSTRINGW;
  2058.         TEST I; 
  2059. DOMAIN$:  
  2060.         DOMAIN$USED = TRUE;  # SET DOMAIN  USED FLAG                   #
  2061.         IF NOT STVLERR[I]    # IF VALUE IS O.K.                        #
  2062.         THEN
  2063.           BEGIN 
  2064.           IF TOTLEN + STVALNUM[I] LQ MXUDATA  # VALUE LENGTH O.K.      #
  2065.           THEN
  2066.             BEGIN 
  2067.             WDC = STVALNUM[I]/10 + 1;  # CALCULATE WORD COUNT          #
  2068.             TOTLEN = TOTLEN + STVALNUM[I]; # TOTLEN = DOMAIN + SERVICE #
  2069.             DOMAINLEN[0] = STVALNUM[I];  # SAVE LENGTH OF SERVICE      #
  2070.             FOR K = 1 STEP 1 UNTIL WDC
  2071.             DO
  2072.               BEGIN 
  2073.               DOMAINWD[K] = STWORD[I + K]; # SAVE WORDS                #
  2074.               END 
  2075.             END 
  2076.           ELSE
  2077.             BEGIN 
  2078.             NDLEM2(ERR100,STLNUM[0],"DOMAIN");
  2079.             END 
  2080.           END 
  2081.         I = I + MXSTRINGW;
  2082.         TEST I; 
  2083. PRID$:  
  2084.         PRID$USED = TRUE;    # SET PRID SPECIFIED FLAG                 #
  2085.         IF NOT STVLERR[I] 
  2086.         THEN                 # IF VALUE IS O.K.                        #
  2087.           BEGIN              #   CHECK IF VALUE IS WITHIN RANGE        #
  2088.           IF STVALLEN[I] LQ MXPRID
  2089.           THEN               # IF VALUE IS IN RANGE                    #
  2090.             BEGIN            #   SAVE VALUE LEFT-JUSTIFIED ZERO FILLED #
  2091.             CRNT$PRID = STVALNUM[I] * (16**(MXPRID + 2  - STVALLEN[I]));
  2092.             END 
  2093.           ELSE               # VALUE TOO LARGE                         #
  2094.             BEGIN            # FLAG ERROR -- VALUE OUT OF RANGE        #
  2095.             CTEMP = XCHD(STVALNUM[I]);
  2096.             NDLEM2(ERR100,STLNUM[0],CTEMP); 
  2097.             END 
  2098.           END 
  2099.         TEST I; 
  2100. UDATA$: 
  2101.         UDATA$USED = TRUE;   # SET UDATA SPECFIED FLAG                 #
  2102.         IF NOT STVLERR[I] 
  2103.         THEN
  2104.           BEGIN 
  2105.           IF TOTLEN + STVALNUM[I] LQ MXUDATA
  2106.           THEN
  2107.             BEGIN                      # STORE LENGTH                  #
  2108.             OBUDL[CRNT$ENT + 3] = STVALNUM[I];
  2109.                                        # STORE 10-CHAR ENTRIES         #
  2110.             IF OBUDL[CRNT$ENT + 3] GR 0  # IF NOT NONE SPECIFIED       #
  2111.             THEN
  2112.               BEGIN 
  2113.               UDATAW = (OBUDL[CRNT$ENT + 3]*4 + 56)/60;  # WORD COUNT  #
  2114.               FOR J = 0 STEP 1 WHILE J LQ UDATAW - 1
  2115.               DO
  2116.                 BEGIN 
  2117.                 CRNT$UWRD[J] =  STWORD[I + J + 1]; #AVAIL SPACE POINTER#
  2118.                 END 
  2119.               END 
  2120.             END 
  2121.           ELSE
  2122.             BEGIN 
  2123.             CTEMP = " ";
  2124.             NDLEM2(ERR100,STLNUM[0],CTEMP);  # VALUE OUT OF RANGE   # 
  2125.             END 
  2126.           END 
  2127.           I = I + MAXUDATW; 
  2128.           TEST I; 
  2129. NEXT$PRM: 
  2130.         END 
  2131.       IF NOT NAM1$USED                 # IF NAME1 NOT SPECIFIED        #
  2132.       THEN
  2133.         BEGIN                # FLAG ERROR -- REQUIRED PARAMETER MISSING#
  2134.         NDLEM2(ERR103,STLNUM[0],"NAME1"); 
  2135.         END 
  2136.       IF NOT NAM2$USED                 # IF NAME2 NOT SPECIFIED        #
  2137.       THEN
  2138.         BEGIN 
  2139.         IF NOT PID$USED                # IF PID NOT SPECIFIED TOO      #
  2140.         THEN
  2141.           BEGIN 
  2142.           NDLEM2(ERR165,STLNUM[0]," ");  # EITHER NAME2 OR PID REQUIRED#
  2143.           END 
  2144.         ELSE
  2145.           BEGIN 
  2146.           PIDPR;                       # CALL THE ROUTINE TO PROCESS   #
  2147.           END                          # PID                           #
  2148.         END 
  2149.       ELSE                             # NAME2 USED                    #
  2150.         BEGIN 
  2151.         IF PID$USED                    # IF PID SPECIFIED TOO          #
  2152.         THEN
  2153.           BEGIN 
  2154.           NDLEM2(ERR164,STLNUM[0]," ");  # GENERATE ERROR MESSAGE      #
  2155.           END 
  2156.         END 
  2157.       IF NOT ACCL$USED                 # IF ACCLEV NOT SPECIFIED       #
  2158.       THEN
  2159.         BEGIN                          # PUT ACCLEV DEFAULT IN ENTRY   #
  2160.         OBACC[CRNT$ENT + 3] = ACCL$DEF; 
  2161.         END 
  2162.       IF NOT DBL$USED                  # IF DBL NOT SPECIFIED          #
  2163.       THEN
  2164.         BEGIN                          # PUT DBL DEFAULT IN ENTRY      #
  2165.         OBDBL[CRNT$ENT + 2] = DBL$DEF;
  2166.         END 
  2167.       IF NOT ABL$USED                  # IF ABL NOT SPECIFIED          #
  2168.       THEN
  2169.         BEGIN                          # PUT ABL DEFAULT IN ENTRY      #
  2170.         OBABL[CRNT$ENT + 2] = ABL$DEF;
  2171.         END 
  2172.       IF NOT DBZ$USED                  # IF DBZ NOT SPECIFIED          #
  2173.       THEN
  2174.         BEGIN                          # PUT DBZ DEFAULT IN ENTRY      #
  2175.         OBDBZ[CRNT$ENT + 2] = DBZ$DEF;
  2176.         END 
  2177.       IF NOT UBL$USED                  # IF UBL WAS NOT SPECIFIED      #
  2178.       THEN
  2179.         BEGIN                # PUT DEFAULT VALUE IN ENTRY              #
  2180.         OBUBL[CRNT$ENT + 2] = UBL$DEF;
  2181.         END 
  2182.       IF NOT UBZ$USED                  # IF UBZ WAS NOT SPECIFIED      #
  2183.       THEN
  2184.         BEGIN                # PUT DEFAULT VALUE IN ENTRY              #
  2185.         OBUBZ[CRNT$ENT + 2] = UBZ$DEF;
  2186.         END 
  2187.       IF NOT WS$USED
  2188.       THEN                   # IF -WS- WAS NOT SPECIFIED               #
  2189.         BEGIN 
  2190.         OBWS[CRNT$ENT + 3] = W$DEF;    # PUT DEFAULT VALUE IN ENTRY    #
  2191.         END 
  2192.       IF CRNT$DOSS NQ DOSS"DONOSVE"  # IF DESTINATION OS ISNOT NOSVE   #
  2193.          AND
  2194.          CRNT$DOSS NQ DOSS"DOFOREIGN" 
  2195.       THEN
  2196.         BEGIN 
  2197.         SERVICE$USED = FALSE;      # IGNORE SERVICE AND DOMAIN         #
  2198.         DOMAIN$USED = FALSE;
  2199.         END 
  2200.       IF NOT DPLS$USED
  2201.       THEN                   # IF DPLS WAS NOT SPECIFIED               #
  2202.         BEGIN 
  2203.         OBDPLS[CRNT$ENT + 3] = DPL$DEF; # PUT DEFAULT VALUE IN ENTRY   #
  2204.         END 
  2205.      IF NOT SERVICE$USED AND DOMAIN$USED
  2206.      THEN                           # IF DOMAIN SPECIFIED THEN SERVICE #
  2207.        BEGIN                        # MUST BE SPECIFIED                #
  2208.        NDLEM2(ERR170,STLNUM[0]," ");
  2209.        END
  2210.      IF SERVICE$USED               # IF SERVICE USED                   #
  2211.      THEN 
  2212.        BEGIN
  2213.        IF DHST$USED                # IF DHOST USED                     #
  2214.        THEN 
  2215.          BEGIN
  2216.          NDLEM2(ERR171,STLNUM[0]," ");   # DHOST IS INVALID            #
  2217.          END
  2218.        END
  2219.      IF NOT DHST$USED        # IF DHOST NOT USED                       #
  2220.      THEN 
  2221.        BEGIN
  2222.        IF NOT UDATA$USED     # IF UDATA NOT PRESENT                    #
  2223.        THEN 
  2224.          BEGIN
  2225.          IF CRNT$DOSS EQ DOSS"DONOS"  # ORIGINATING OS IS NOS          #
  2226.          THEN 
  2227.            BEGIN
  2228.            IF CRNT$ORNET EQ ORNETWORK"OCDCNET" OR 
  2229.               CRNT$DENET EQ DESNETWORK"DCDCNET" 
  2230.            THEN 
  2231.              BEGIN
  2232.              NDLEM2(ERR169,STLNUM[0]," ");
  2233.              END
  2234.            END
  2235.          END
  2236.        END
  2237.      IF NOT PRID$USED 
  2238.      THEN 
  2239.        BEGIN
  2240.        IF CRNT$DOSS EQ DOSS"DONOSVE"
  2241.        THEN 
  2242.          BEGIN
  2243.          CRNT$PRID = PRID$NVE;
  2244.          END
  2245.        ELSE 
  2246.          BEGIN
  2247.          IF CRNT$DOSS EQ DOSS"DOAOSVS"
  2248.          THEN 
  2249.            BEGIN
  2250.            CRNT$PRID = PRID$AOS;
  2251.            END
  2252.          END
  2253.        END
  2254.       IF NOT DHST$USED
  2255.       THEN                   # IF DHOST WAS NOT SPECIFIED              #
  2256.         BEGIN                # CONVERT DNODE TO DISPLAY CODE           #
  2257.         CTEMP = XCHD(OBDNODE[CRNT$ENT + 3]);
  2258.         DC$ZFILL(CTEMP);               # DISPLAY CODE ZERO FILL VALUE  #
  2259.         CRNT$DHST = C<8,2>CTEMP;       # SAVE DEFAULT DHOST VALUE      #
  2260.         DHST$LEN = 2;                  # SAVE LENGTH OF VALUE          #
  2261.         END 
  2262.       IF FAC$LENG GR MXFACL 
  2263.       THEN                   # IF TOTAL FAC LENGTH IS TOO BIG          #
  2264.         BEGIN                # FLAG ERROR -- FAC LENGTH EXCEEDS LIMIT  #
  2265.         NDLEM2(ERR153,STLNUM[0]," "); 
  2266.         END 
  2267. #                            INSERT PRID AND UDATA VALUE INTO ENTRY    #
  2268.       OBWC[CRNT$ENT] = OBWC[CRNT$ENT] + 1; # INCREMENT WORD COUNT      #
  2269.       OBWORD[NEXT$WORD] = 0;           #  CLEAR NEXT WORD              #
  2270.       OBPRID[NEXT$WORD] = CRNT$PRID;   # INSERT PRID VALUE             #
  2271.       IF NOT UDATA$USED AND NOT SERVICE$USED AND NOT DOMAIN$USED
  2272.       THEN                   # NO UDATA AND NO SERVICE SPECIFIED       #
  2273.         BEGIN 
  2274.         IF CRNT$DENET EQ  DESNETWORK"DAOSVS"
  2275.         THEN                 # CYBER 120 DEFAULTS                      #
  2276.           BEGIN 
  2277.           OBUDL[CRNT$ENT + 3] = NAME1LEN;   # LENGTH OF NAME1          #
  2278.           UDATA$DEF = OBNAME1[CRNT$ENT + 1];
  2279.           END                # END OF CYBER 120 DEFAULTS               #
  2280.         ELSE
  2281.           BEGIN     # REGULAR DEFAULTS                                 #
  2282.           OBUDL[CRNT$ENT+3] = (UDL$DEF + DHST$LEN)*2; 
  2283.                                       # STORE DEFUALT UDL LENGTH       #
  2284.  
  2285.           CTEMP = XCDD(OBSNODE[CRNT$ENT+3]);  # CONVERT SNODE VALUE    #
  2286.           DC$ZFILL(CTEMP);             # ZERO FILL VALUE               #
  2287.           UDATA$DEF =  C<7,3>CTEMP;    # PUT SNODE VALUE IN UDATA      #
  2288.           C<3,DHST$LEN>UDATA$DEF =  CRNT$DHST; # PUT DHOST VALUE IN UDA#
  2289.           I = 3 + DHST$LEN;    # CALCULATE CURRENT CHARACTER COUNT     #
  2290.           C<I,7>UDATA$DEF =  OBNAME1[CRNT$ENT + 1]; # PUT NAME1 IN UDAT#
  2291.           END                  # END OF REGULAR DEFAULTS               #
  2292.         ITEMP = 32;            # POINT TO BEGINNING OF UDATA FIELD     #
  2293.         SAVE$WORD = NEXT$WORD;  # SAVE NEXT$WORD TO POINT TO THE       #
  2294.                                 # START OF UDATA                       #
  2295.         FOR I=0 STEP 1 UNTIL OBUDL[CRNT$ENT + 3] - 1
  2296.         DO                     # FOR EACH CHARACTER IN UDATA VALUE     #
  2297.           BEGIN 
  2298.           IF ITEMP LS 56
  2299.           THEN                 # IF STILL ROOM TO PUT A CHARACTER      #
  2300.             BEGIN              # CONVERT TO ASCII AND PUT IN ENTRY     #
  2301.             B<ITEMP,8>OBUDATA[NEXT$WORD] = A$CHAR[C<I,1>UDATA$DEF]; 
  2302.             ITEMP = ITEMP + 8; # POINT TO NEXT POSITION                #
  2303.             END 
  2304.           ELSE                 # WHOLE CHARATER CAN NOT FIT            #
  2305.             BEGIN 
  2306.             IF ITEMP EQ 56
  2307.             THEN               # IF HALF A CHARACTER CAN FIT           #
  2308.               BEGIN            #   PUT FIRST HALF IN CURRENT WORD      #
  2309.              B<ITEMP,4>OBUDATA[NEXT$WORD]=B<0,4>A$CHAR[C<I,1>UDATA$DEF];
  2310.               NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD          #
  2311.               OBWORD[NEXT$WORD] = 0;     # CLEAR NEXT WORD             #
  2312.               OBWC[CRNT$ENT]=OBWC[CRNT$ENT] + 1; # INCREMENT WORD COUNT#
  2313.               ITEMP = 4;                 # POINT TO NEXT POSITION      #
  2314.               B<0,4>OBUDATA[NEXT$WORD] = B<4,4>A$CHAR[C<I,1>UDATA$DEF]; 
  2315.               END 
  2316.             ELSE               # NO MORE ROOM IN CURRENT WORD          #
  2317.               BEGIN 
  2318.               NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD          #
  2319.               OBWORD[NEXT$WORD] = 0;     # CLEAR NEXT WORD             #
  2320.               OBWC[CRNT$ENT] = OBWC[CRNT$ENT]+1; # INCREMENT WORD COUNT#
  2321.               ITEMP = 8;                 # POINT TO NEXT POSITION      #
  2322.               B<0,8>OBUDATA[NEXT$WORD] = A$CHAR[C<I,1>UDATA$DEF]; 
  2323.               END 
  2324.             END 
  2325.           END                      # END OF FOR LOOP                   #
  2326.         IF CRNT$DENET EQ DESNETWORK"DAOSVS" 
  2327.         THEN
  2328.           BEGIN 
  2329.           OBUDL[CRNT$ENT + 3] = OBUDL[CRNT$ENT + 3]*2;
  2330.           END 
  2331.         IF SHST$USED               #  IF SHOST SPECIFIED               #
  2332.         THEN
  2333.           BEGIN 
  2334.           IF CRNT$DENET NQ DESNETWORK"DAOSVS" 
  2335.           THEN                     # FOR NON-CYVBER 120 MACHINES       #
  2336.             BEGIN 
  2337.             B<UDL$BIT,SHST$LEN>OBUDATA[SAVE$WORD] = CRNT$SHST;
  2338.             END 
  2339.                                    # OVERWRITE THE EARLIER ASCII TRANS #
  2340.           END 
  2341.         END                        # END OF NOT UDATA$USED             #
  2342.       ELSE
  2343.         BEGIN                      # UDATA OR SERVICE OR DOMAIN SPECIFI#
  2344.         ITEMP = 32; 
  2345.         CRUBIT = 0;                # SET START BIT FOR UDATA           #
  2346.         IF SERVICELEN[0] GR 0      # SERVICE SPECIFIED                 #
  2347.         THEN
  2348.           BEGIN 
  2349.           I = 1;
  2350.           IF NOT DOMAIN$USED
  2351.           THEN
  2352.             BEGIN 
  2353.             IF UDATA$USED 
  2354.             THEN
  2355.               BEGIN                # ADD 2 *US*                        #
  2356.               SERVICELEN1[0] = 1; 
  2357.               END 
  2358.             END 
  2359.           FOR J = 0 STEP 1 UNTIL SERVICELEN[0] + SERVICELEN1[0] 
  2360.           DO
  2361.             BEGIN 
  2362.             IF J GQ SERVICELEN[0]  # CHECK IF *US* NEEDED              #
  2363.             THEN
  2364.               BEGIN 
  2365.               IF DOMAIN$USED OR UDATA$USED  # IF FOLLOWED BY DOMAIN    #
  2366.               THEN
  2367.                 BEGIN 
  2368.                 ASCII$CHAR[0] = UNITSEP; # ADD 1 *US* FOR DOMAIN       #
  2369.                                      # AND UDATA BOTH USED             #
  2370.                                      # ADD 2 *US* FOR DOMAIN NOT USED  #
  2371.                                      # AND UDATA USED                  #
  2372.                 TOTLEN = TOTLEN + 1; # BUMP TOKLEN                     #
  2373.                 SETCHAR = TRUE;      # SET SETCHAR FLAG                #
  2374.                 END 
  2375.               ELSE
  2376.                 BEGIN 
  2377.                 SETCHAR = FALSE;      # NOT TO STORE CHAR IN OBUDATA   #
  2378.                 END 
  2379.               END 
  2380.             ELSE
  2381.               BEGIN 
  2382.               SETCHAR = TRUE; 
  2383.               WDC = B<CRUBIT,6>SERVICEWD[I];  # PACK IT IN ASCII       #
  2384.               ASCII$CHAR[0] = A$CHAR[WDC];
  2385.               END 
  2386.             IF SETCHAR          # O.K. TO STORE CHAR IN OBUDATA        #
  2387.             THEN
  2388.               BEGIN 
  2389.               IF ITEMP LS 56
  2390.               THEN             # IF STILL ROOM TO PUT A CHARACTER      #
  2391.                 BEGIN          # CONVERT TO ASCII AND PUT IN ENTRY     #
  2392.                 B<ITEMP,8>OBUDATA[NEXT$WORD] = ASCII$CHAR[0]; 
  2393.                 ITEMP = ITEMP + 8; # POINT TO NEXT POSITION            #
  2394.                 END 
  2395.               ELSE             # WHOLE CHARATER CAN NOT FIT            #
  2396.                 BEGIN 
  2397.                 IF ITEMP EQ 56
  2398.                 THEN           # IF HALF A CHARACTER CAN FIT           #
  2399.                   BEGIN        #   PUT FIRST HALF IN CURRENT WORD      #
  2400.                   B<ITEMP,4>OBUDATA[NEXT$WORD]=ASCII$CHAR1[0];
  2401.                   NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD      #
  2402.                   OBWORD[NEXT$WORD] = 0;     # CLEAR NEXT WORD         #
  2403.                   OBWC[CRNT$ENT]=OBWC[CRNT$ENT] + 1; # INCREMENT WORD C#
  2404.                   ITEMP = 4;             # POINT TO NEXT POSITION      #
  2405.                   B<0,4>OBUDATA[NEXT$WORD] = ASCII$CHAR2[0];
  2406.                   END 
  2407.                 ELSE           # NO MORE ROOM IN CURRENT WORD          #
  2408.                   BEGIN 
  2409.                   NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD      #
  2410.                   OBWORD[NEXT$WORD] = 0;     # CLEAR NEXT WORD         #
  2411.                   OBWC[CRNT$ENT] = OBWC[CRNT$ENT]+1; # INCREMENT WORD C#
  2412.                   ITEMP = 8;               # POINT TO NEXT POSITION    #
  2413.                   B<0,8>OBUDATA[NEXT$WORD] = ASCII$CHAR[0]; 
  2414.                   END 
  2415.                 END 
  2416.               END                 # END OF SETCHAR                     #
  2417.             CRUBIT = CRUBIT + 6;  # BUMP BIT INDEX                     #
  2418.             IF CRUBIT EQ WORDSIZE  # WORD BOUNDARY REACHED             #
  2419.             THEN
  2420.               BEGIN 
  2421.               CRUBIT = 0;    # CLEAR BIT INDEX                         #
  2422.               I = I + 1;     # BUMP WORD INDEX FOR SERVICEWD           #
  2423.               END 
  2424.             END              # END OF FOR                              #
  2425.           END                # END OF SERCIELEN GR 0                   #
  2426.         IF DOMAINLEN[0] GR 0 # DOMAIN SPECIFIED                        #
  2427.         THEN
  2428.           BEGIN 
  2429.           I = 1;
  2430.           CRUBIT = 0; 
  2431.           FOR J = 0 STEP 1 UNTIL DOMAINLEN[0]   # INCLUDES *US*        #
  2432.           DO
  2433.             BEGIN 
  2434.             IF J EQ DOMAINLEN[0]   # US NEEDED?                        #
  2435.             THEN
  2436.               BEGIN 
  2437.               IF UDATA$USED        # IF FOLLOWED BY UDATA              #
  2438.               THEN
  2439.                 BEGIN 
  2440.                 ASCII$CHAR[0] = UNITSEP;
  2441.                 TOTLEN = TOTLEN + 1; # BUMP TOKLEN                     #
  2442.                 SETCHAR = TRUE;      # SET SETCHAR FLAG                #
  2443.                 END 
  2444.               ELSE
  2445.                 BEGIN 
  2446.                 SETCHAR = FALSE;
  2447.                 END 
  2448.               END 
  2449.             ELSE
  2450.               BEGIN 
  2451.               WDC = B<CRUBIT,6>DOMAINWD[I];   # PACK IT IN ASCII       #
  2452.               ASCII$CHAR[0] = A$CHAR[WDC];
  2453.               SETCHAR = TRUE;      # GO AND STORE CHAR IN OBUDATA      #
  2454.               END 
  2455.             IF SETCHAR          # O.K. TO STORE CHAR IN OBUDATA        #
  2456.             THEN
  2457.               BEGIN 
  2458.               IF ITEMP LS 56
  2459.               THEN             # IF STILL ROOM TO PUT A CHARACTER      #
  2460.                 BEGIN          # CONVERT TO ASCII AND PUT IN ENTRY     #
  2461.                 B<ITEMP,8>OBUDATA[NEXT$WORD] = ASCII$CHAR[0]; 
  2462.                 ITEMP = ITEMP + 8; # POINT TO NEXT POSITION            #
  2463.                 END 
  2464.               ELSE             # WHOLE CHARATER CAN NOT FIT            #
  2465.                 BEGIN 
  2466.                 IF ITEMP EQ 56
  2467.                 THEN           # IF HALF A CHARACTER CAN FIT           #
  2468.                   BEGIN        #   PUT FIRST HALF IN CURRENT WORD      #
  2469.                   B<ITEMP,4>OBUDATA[NEXT$WORD]=ASCII$CHAR1[0];
  2470.                   NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD      #
  2471.                   OBWORD[NEXT$WORD] = 0;     # CLEAR NEXT WORD         #
  2472.                   OBWC[CRNT$ENT]=OBWC[CRNT$ENT] + 1; # INCREMENT WORD C#
  2473.                   ITEMP = 4;             # POINT TO NEXT POSITION      #
  2474.                   B<0,4>OBUDATA[NEXT$WORD] = ASCII$CHAR2[0];
  2475.                   END 
  2476.                 ELSE           # NO MORE ROOM IN CURRENT WORD          #
  2477.                   BEGIN 
  2478.                   NEXT$WORD = NEXT$WORD + 1; # POINT TO NEXT WORD      #
  2479.                   OBWORD[NEXT$WORD] = 0;     # CLEAR NEXT WORD         #
  2480.                   OBWC[CRNT$ENT] = OBWC[CRNT$ENT]+1; # INCREMENT WORD C#
  2481.                   ITEMP = 8;               # POINT TO NEXT POSITION    #
  2482.                   B<0,8>OBUDATA[NEXT$WORD] = ASCII$CHAR[0]; 
  2483.                   END 
  2484.                 END 
  2485.               END                 # END OF SETCHAR                     #
  2486.             CRUBIT = CRUBIT + 6;  # BUMP BIT INDEX                     #
  2487.             IF CRUBIT EQ WORDSIZE  # WORD BOUNDARY REACHED             #
  2488.             THEN
  2489.               BEGIN 
  2490.               CRUBIT = 0;    # CLEAR BIT INDEX                         #
  2491.               I = I + 1;     # BUMP WORD INDEX FOR SERVICEWD           #
  2492.               END 
  2493.             END              # END OF FOR                              #
  2494.           END                # END OF DOMAIN GR 0                      #
  2495.         IF OBUDL[CRNT$ENT + 3] GR 0  # UDATA SPECIFIED                 #
  2496.         THEN
  2497.           BEGIN 
  2498.           IF ITEMP EQ WORDSIZE   # WORD BOUNDARY REACHED               #
  2499.           THEN
  2500.             BEGIN 
  2501.             ITEMP = 0;
  2502.             NEXT$WORD = NEXT$WORD + 1;
  2503.             OBWORD[NEXT$WORD] = 0;
  2504.             OBWC[CRNT$ENT] = OBWC[CRNT$ENT] + 1;
  2505.             END 
  2506.           I = 0;
  2507.           CRUBIT = 0; 
  2508.           FOR J = 0 STEP 1 UNTIL OBUDL[CRNT$ENT + 3] - 1
  2509.           DO
  2510.             BEGIN 
  2511.             B<ITEMP,4>OBUDATA[NEXT$WORD] = B<CRUBIT,4>CRNT$UWRD[I]; 
  2512.             ITEMP = ITEMP + 4;     # BUNP ITEMP                        #
  2513.             IF ITEMP EQ WORDSIZE   # WORD BOUNDARY REACHED             #
  2514.             THEN
  2515.               BEGIN 
  2516.               IF J NQ OBUDL[CRNT$ENT + 3]  # NOT DONE YET              #
  2517.               THEN
  2518.                 BEGIN 
  2519.                 ITEMP = 0;
  2520.                 NEXT$WORD = NEXT$WORD + 1;
  2521.                 OBWORD[NEXT$WORD] = 0;
  2522.                 OBWC[CRNT$ENT] = OBWC[CRNT$ENT] + 1;
  2523.                 END 
  2524.               END 
  2525.             CRUBIT = CRUBIT + 4;  # BUMP BIT INDEX                     #
  2526.             IF CRUBIT EQ WORDSIZE  # WORD BOUNDARY REACHED             #
  2527.             THEN
  2528.               BEGIN 
  2529.               CRUBIT = 0;    # CLEAR BIT INDEX                         #
  2530.               I = I + 1;     # BUMP WORD INDEX FOR SERVICEWD           #
  2531.               END 
  2532.             END              # END OF FOR                              #
  2533.           END                # END OF UDL GR 0                         #
  2534.         OBUDL[CRNT$ENT + 3] = OBUDL[CRNT$ENT + 3] + TOTLEN*2; 
  2535.                              # FINALLY UPDATES OBUDL                   #
  2536.         END                  # END OF UDATA/DOMAIN/SERCVICE USED       #
  2537.       OBRWC[1] = OBRWC[1] + OBWC[CRNT$ENT];    # INCR TABLE WORD COUNT #
  2538.       RETURN;                # **** RETURN ****                        #
  2539.       END # OUTCLPR # 
  2540.       CONTROL EJECT;
  2541.       PROC PIDPR; 
  2542.       BEGIN 
  2543. *IF,DEF,IMS 
  2544. # 
  2545. **
  2546. *     1. PROC NAME            AUTHOR            DATE
  2547. *        PIDPR                Y. C. YIP         06/24/1983
  2548. * 
  2549. *     2. FUNCTIONAL DESCRIPTION.
  2550. * 
  2551. *        THIS PROCEDURE PERFORMS ENTERING PATH INFORMATION INTO 
  2552. *        THE PATH PID TABLE IN THE FORM OF PID NAME, DNODE, SNODE,
  2553. *        PORT NUMBER, DTEA LENGTH AND DTE ADDRESS.
  2554. * 
  2555. * 
  2556. *     3. METHOD USED. 
  2557. * 
  2558. *        TABLE MANAGER ROUTINE SSTESTS IS CALLED TO EXPAND TABLE
  2559. *        SPACE WHEN NEEDED. 
  2560. * 
  2561. *        FIRST, EMPTY TABLE IS CHECKED BY CHECKING THE WORD COUNT.
  2562. *        IF NOT EMPTY TABLE 
  2563. *        THEN 
  2564. *          SEARCH FOR IDENTICAL PID BY CHECKING PIDNAME IN TABLE
  2565. *          AGAINST CRNT$PID.
  2566. *          IF IDENTICAL PID FOUND 
  2567. *          THEN 
  2568. *            CHECK FOR IDENTICAL SET OF SNODE,DNODE, PORT, AND
  2569. *            AND DTEA.
  2570. * 
  2571. *            IF IDENTICL SET FOUND
  2572. *            THEN 
  2573. *              EXIT 
  2574. *            ELSE 
  2575. *              MAKE ENTRY OF SNODE,DNODE,PORT, DTEAL AND DTEA.
  2576. *          ELSE 
  2577. *            MAKE ENTRY WITH NEW PID AND A SET OF SNODE,DNODE,PORT
  2578. *            DTEAL, AND DTEA INFORMATION. 
  2579. *        ELSE 
  2580. *          MAKE THE FIRST PATH PID ENTRY TO THE EMPTY TABLE.
  2581. * 
  2582. * 
  2583. * 
  2584. * 
  2585. *     3. ENTRY - NONE.
  2586. * 
  2587. *     4. EXIT  - NONE.
  2588. * 
  2589. *     5. ROUTINE CALLED - SSTETS. 
  2590. * 
  2591. # 
  2592. *ENDIF
  2593. # 
  2594. ****  PROC PIDPR - XREF LIST BEGINS 
  2595. # 
  2596.       XREF
  2597.         BEGIN 
  2598.         PROC NDLEM2;               # PASS2 ERROR MESSAGE GENERATOR     #
  2599.         PROC SSTETS;               # TABLE MANAGER ROUTINE TO EXTEND   #
  2600.                                    # TABLE ENTRY.                      #
  2601.         END 
  2602.       DEF ENTY1 # 1 #;             # ONE WORD ENTRY                    #
  2603.       DEF ENTY2 # 2 #;             # TWO WORD ENTRY                    #
  2604.       DEF ENTY3 # 3 #;             # THREE WORD ENTRY                  #
  2605.       ITEM INDEX1;                 # LOOP INDEX ONE                    #
  2606.       ITEM INDEX2;                 # LOOP INDEX TWO                    #
  2607.       ITEM FOUND B;                # FLAG FOR FINDING A MATCHING PID   #
  2608.       ITEM CRNT$PID$ENT;           # POINTER TO THE CURRENT PID ENTRY  #
  2609.       ITEM LOOPC;                  # COUNTER FOR NUMBER OF PIDS        #
  2610.       ITEM NEW$ENT;                # POINTER TO NERW TABLE ENTRY       #
  2611.       CONTROL EJECT;
  2612. #                                                                      #
  2613. #            CODE OF PIDPR BEGINS HERE                                 #
  2614. #                                                                      #
  2615.       LOOPC = 1;                   # COUNT OF PIDS SET TO 1            #
  2616.       FOUND = FALSE;               # INITIALIZE PID EXIST FLAG TO FALSE#
  2617.       IF PICNT[1] EQ 0             # EMPTY TABLE                       #
  2618.       THEN                         # NEW ENTRY NEEDED                  #
  2619.         BEGIN 
  2620.         NEW$ENT = ENTY2;           # POINTER TO TABLE ENTRY            #
  2621.         END 
  2622.       ELSE
  2623.         BEGIN 
  2624.         CRNT$PID$ENT = ENTY2;      # POINTER TO CURRENT TABLE ENTRY    #
  2625.         FOR INDEX1 = 1 STEP 1 WHILE ( NOT FOUND AND PICNT[1] GQ 
  2626.                                       LOOPC)
  2627.         DO                         # SCAN UNTIL MATCHING PID FOUND OR  #
  2628.           BEGIN                    # TABLE IS EXHAUSTED                #
  2629.           IF PINAME[CRNT$PID$ENT] EQ CRNT$PID 
  2630.           THEN
  2631.             BEGIN 
  2632.             FOR INDEX2 = 1 STEP 2 UNTIL (PILLCT[CRNT$PID$ENT]*2)
  2633.             DO                     # SCAN LOGICAL LINK RECORD          #
  2634.               BEGIN 
  2635.               IF PIDN[CRNT$PID$ENT + INDEX2]  EQ PP$DNODE 
  2636.                  AND PISN[CRNT$PID$ENT + INDEX2] EQ PP$SNODE
  2637.                  AND PIPORT[CRNT$PID$ENT + INDEX2] EQ PP$PORT 
  2638.                  AND PIDTEA[CRNT$PID$ENT + INDEX2 + 1] EQ PP$DTEA 
  2639.               THEN                 # DUPLIACTE LOGICAL LINK DEFINITION #
  2640.                 BEGIN 
  2641.                 FOUND = TRUE;      # SET FOUND FLAG                    #
  2642.                 END 
  2643.               END                  # END OF FOR                        #
  2644.             IF NOT FOUND           # NO DUPLICATE LINK FOUND           #
  2645.             THEN
  2646.               BEGIN 
  2647.               FOUND = TRUE;        # CLEAR FLAG                        #
  2648.               NEW$ENT = CRNT$PID$ENT +(PILLCT[CRNT$PID$ENT]*2) + 1; 
  2649.                                    # NEW ENTRY MADE                    #
  2650.               SSTETS(P<PATHPID$TAB>,NEW$ENT,2);        # MAKE EXTRA    #
  2651.                                    # ENTRY                             #
  2652.               PILLCT[CRNT$PID$ENT] = PILLCT[CRNT$PID$ENT] + 1;
  2653.                                    # BUMP LOGICAL LINK COUNT           #
  2654.               PIRWC[ENTY1] = PIRWC[ENTY1] + 2;      # BUMP WORD COUNT  #
  2655.               PIDN[NEW$ENT] = PP$DNODE;      # UPDATE DNODE FIELD      #
  2656.               PISN[NEW$ENT] = PP$SNODE;      # UPDATE SNDOE FIELD      #
  2657.               PIPORT[NEW$ENT] = PP$PORT;     # UPDATE PORT  FIELD      #
  2658.               PIDTEAL[NEW$ENT] = PP$DTEAL;   # UPDATE DTEA LENGTH      #
  2659.               NEW$ENT = NEW$ENT + 1;
  2660.               PIDTEA[NEW$ENT] = PP$DTEA;     # UPDATE DTEA FIELD       #
  2661.               END 
  2662.             END 
  2663.           CRNT$PID$ENT = CRNT$PID$ENT +(PILLCT[CRNT$PID$ENT]*2) + 1;
  2664.           LOOPC = LOOPC + 1;       # CHECK THE NEXT PID RECORD         #
  2665.           END 
  2666.         NEW$ENT =  CRNT$PID$ENT;   # MAKE NEW PID RECORD               #
  2667.         END 
  2668.       IF NOT FOUND                 # IF NO MATCHING PIDNAME FOUND      #
  2669.       THEN
  2670.         BEGIN                      # NEW PID RECORD NEEDED             #
  2671.         SSTETS(P<PATHPID$TAB>,NEW$ENT,ENTY3);      # EXPAND ENTRY      #
  2672.         PICNT[ENTY1] = PICNT[ENTY1] + 1;      # BUMP PID COUNT         #
  2673.         PIRWC[ENTY1] = PIRWC[ENTY1] + ENTY3;  # BUMP WORD COUNT        #
  2674.         PINAME[NEW$ENT] = CRNT$PID;        # UPDATE PID NAME           #
  2675.         PILLCT[NEW$ENT] = 1;       # UPDATE LINK COUNT FIELD           #
  2676.         NEW$ENT = NEW$ENT + 1;
  2677.         PIDN[NEW$ENT] = PP$DNODE;  # UPDATE PIDN FIELD                 #
  2678.         PISN[NEW$ENT] = PP$SNODE;  # UPDATE PISN FIELD                 #
  2679.         PIPORT[NEW$ENT] = PP$PORT; # UPDATE PIPORT FIELD               #
  2680.         PIDTEAL[NEW$ENT] = PP$DTEAL;  #   UPDATE DTEA LENGTH           #
  2681.         NEW$ENT = NEW$ENT + 1;
  2682.         PIDTEA[NEW$ENT] = PP$DTEA;      # UPDATE DTEA FIELD            #
  2683.         END 
  2684.       RETURN;                      # RETURN TO CALLER                  #
  2685.       END                          # END OF PROC PIDPR                 #
  2686.  
  2687.  
  2688.       CONTROL EJECT;
  2689.       PROC USERPR;
  2690.       BEGIN 
  2691. *IF,DEF,IMS 
  2692. # 
  2693. **    USERPR - USER STATEMENT PROC
  2694. * 
  2695. *     D.K. ENDO    81/10/30 
  2696. * 
  2697. *     THIS PROCEDURE CHECKS THE USER STATEMENTS AND MAKES ENTRIES IN
  2698. *     THE USER TABLE. 
  2699. * 
  2700. *     PROC USERPR 
  2701. * 
  2702. *     ENTRY        NONE.
  2703. * 
  2704. *     EXIT         NONE.
  2705. * 
  2706. *     METHOD
  2707. * 
  2708. *     INCREMENT USER TABLE WORD COUNT.
  2709. *     CLEAR NEXT ENTRY IN USER TABLE. 
  2710. *     IF LABEL IS O.K., 
  2711. *       PUT LABEL IN ENTRY. 
  2712. *     FOR EACH VALUE DECLARATION
  2713. *       SELECT CASE THAT APPLIES, 
  2714. *         CASE 1(MFAM,DFAM,PFAM): 
  2715. *           IF VALUE IS NOT -NONE-, 
  2716. *             IF A FAMILY HAS NOT BEEN SPECIFIED YET, 
  2717. *             THEN, 
  2718. *               IF VALUE IS O.K., 
  2719. *                 IF VALUE IS NOT ZERO, 
  2720. *                   ZERO FILL VALUE.
  2721. *                   PUT FAMILY NAME IN ENTRY. 
  2722. *                 SET CODE FOR FAMILY.
  2723. *             OTHERWISE,
  2724. *               FLAG ERROR -- CAN NOT SPECIFY BOTH DFAM,MFAM OR PFAM. 
  2725. *         CASE 2(MUSER,DUSER,PUSER):  
  2726. *           IF VALUE IS NOT -NONE-, 
  2727. *             IF A USER NUMBER HAS NOT BEEN SPECIFIED YET,
  2728. *             THEN, 
  2729. *               IF VALUE IS O.K., 
  2730. *                 IF VALUE IS NOT ZERO, 
  2731. *                 THEN, 
  2732. *                   ZERO FILL NAME. 
  2733. *                   PUT USER NUMBER IN ENTRY. 
  2734. *                   SET CODE FOR USER NUMBER. 
  2735. *                 OTHERWISE,
  2736. *                   FLAG ERROR -- USER CAN NOT BE ZERO. 
  2737. *             OTHERWISE,
  2738. *               FLAG ERROR -- CAN NOT SPECIFY BOTH MUSER, DUSER OR PUSER
  2739. *         CASE 3(MAPPL,PAPPL):  
  2740. *           IF VALUE IS NOT -NONE-, 
  2741. *             IF AN APPLICATION HAS NOT BEEN SPECIFIED YET, 
  2742. *             THEN
  2743. *               IF VALUE IS O.K., 
  2744. *                 SEARCH TABLE FOR ILLEGAL APPLICATION. 
  2745. *                 IF NOT FOUND, 
  2746. *                 THEN, 
  2747. *                   PUT APPLICATION NAME IN ENTRY 
  2748. *                   SET CODE FOR APPLICATION. 
  2749. *                 OTHERWISE,
  2750. *                   FLAG ERROR -- NAME IS A RESERVE WORD
  2751. *             OTHERWISE,
  2752. *               FLAG ERROR -- CAN NOT SPECIFY BOTH MAPPL AND PAPPL
  2753. * 
  2754. # 
  2755. *ENDIF
  2756. # 
  2757. ****  PROC USERPR - XREF LIST BEGINS. 
  2758. # 
  2759.       XREF
  2760.         BEGIN 
  2761.         PROC SSTATS;         # ALLOCATES MORE TABLE SPACE ON REQUEST   #
  2762.         FUNC XCDD C(10);     # CONVERTS INTEGER TO CHARACTER           #
  2763.         PROC NDLEM2;         # MAKES ENTRY IN PASS 2 ERROR FILE        #
  2764.         PROC NDLZFIL;        # ZERO FILLS A BLANK FILLED NAME          #
  2765.         END 
  2766. # 
  2767. ****
  2768. # 
  2769.       DEF MFAM$ID # 136 #;   # MFAM KEYWORD I.D.                       #
  2770.       DEF USR$M$ST # 262143 #;         # MAX NUM OF USER STMTS USED # 
  2771.       DEF PAPPL$ID # 144 #;  # PAPPL KEYWORD I.D.                      #
  2772.       STATUS CODE UNK,       # NOT SPECIFIED                           #
  2773.                   MAND,      # MANDITORY                               #
  2774.                   DEF,       # DEFAULT                                 #
  2775.                   PRIM;      # PRIMARY                                 #
  2776.       ITEM APL$FLG B;        # INITIAL APPLICATION SPECIFIED FLAG      #
  2777.       ITEM CRNT$ENT;         # POINTS AT CURRENT ENTRY IN USER TABLE   #
  2778.       ITEM CTEMP C(10);      # CHARACTER TEMPORARY                     #
  2779.       ITEM FAM$FLG B;        # FAMILY SPECIFIED FLAG                   #
  2780.       ITEM FOUND B;          # FOUND FLAG                              #
  2781.       ITEM I;                # SCRATCH ITEM                            #
  2782.       ITEM J;                # SCRATCH ITEM                            #
  2783.       ITEM USR$FLG B;        # USER NUMBER SPECIFIED FLAG              #
  2784.       ARRAY CODE$TABLE [MFAM$ID:PAPPL$ID] S(1); 
  2785.         BEGIN 
  2786.         ITEM VAL$CODE (0,0,60) = [CODE"MAND", 
  2787.                                   CODE"MAND", 
  2788.                                   CODE"MAND", 
  2789.                                   CODE"DEF",
  2790.                                   CODE"DEF",
  2791.                                   CODE"PRIM", 
  2792.                                   CODE"PRIM", 
  2793.                                   , 
  2794.                                   CODE"PRIM"
  2795.                                  ]; 
  2796.         END 
  2797.       DEF MXRWT # 10 #; 
  2798.       ARRAY RES$WORD$TAB [1:MXRWT] S(1);
  2799.         BEGIN 
  2800.         ITEM VALNAM C(0,0,10) = ["NS",
  2801.                                  "NVF", 
  2802.                                  "ALL", 
  2803.                                  "NULL",
  2804.                                  "BYE", 
  2805.                                  "LOGIN", 
  2806.                                  "LOGOUT",
  2807.                                  "HELLO", 
  2808.                                  "NOP", 
  2809.                                  "DOP"
  2810.                                 ];
  2811.         END 
  2812.       SWITCH USERJMP              ,            , # UNK     , NODE     ,#
  2813.                                   ,            , # VARIANT , OPGO     ,#
  2814.                                   ,            , #         , LLNAME   ,#
  2815.                                   ,            , #         ,          ,#
  2816.                                   ,            , #         ,          ,#
  2817.                                   ,            , # HNAME   , LOC      ,#
  2818.                                   ,            , #         ,          ,#
  2819.                                   ,            , #         ,          ,#
  2820.                                   ,            , #         ,          ,#
  2821.                                   ,            , # NCNAME  , DI       ,#
  2822.                                   ,            , # N1      , P1       ,#
  2823.                                   ,            , # N2      , P2       ,#
  2824.                                   ,            , # NOLOAD1 , NOLOAD2  ,#
  2825.                                   ,            , #         ,          ,#
  2826.                                   ,            , #         ,          ,#
  2827.                                   ,            , # NI      , PORT     ,#
  2828.                                   ,            , # LTYPE   , TIPTYPE  ,#
  2829.                                   ,            , # AUTO    , SL       ,#
  2830.                                   ,            , # LSPEED  , DFL      ,#
  2831.                                   ,            , # FRAME   , RTIME    ,#
  2832.                                   ,            , # RCOUNT  , NSVC     ,#
  2833.                                   ,            , # PSN     , DCE      ,#
  2834.                                   ,            , # DTEA    ,          ,#
  2835.                                   ,            , #         ,          ,#
  2836.                                   ,            , #         ,          ,#
  2837.                                   ,            , # STIP    , TC       ,#
  2838.                                   ,            , # RIC     , CSET     ,#
  2839.                                   ,            , # TSPEED  , CA       ,#
  2840.                                   ,            , # CO      , BCF      ,#
  2841.                                   ,            , # MREC    , W        ,#
  2842.                                   ,            , # CTYP    , NCIR     ,#
  2843.                                   ,            , # NEN     ,          ,#
  2844.                                   ,            , #         , DT       ,#
  2845.                                   ,            , # SDT     , TA       ,#
  2846.                                   ,            , # ABL     , DBZ      ,#
  2847.                                   ,            , # UBZ     , DBL      ,#
  2848.                                   ,            , # UBL     , XBZ      ,#
  2849.                                   ,            , # DO      , STREAM   ,#
  2850.                                   ,            , # HN      , AUTOLOG  ,#
  2851.                                   ,            , # AUTOCON , PRI      ,#
  2852.                                   ,            , # P80     , P81      ,#
  2853.                                   ,            , # P82     , P83      ,#
  2854.                                   ,            , # P84     , P85      ,#
  2855.                                   ,            , # P86     , P87      ,#
  2856.                                   ,            , # P88     , P89      ,#
  2857.                                   ,            , # AL      , BR       ,#
  2858.                                   ,            , # BS      , B1       ,#
  2859.                                   ,            , # B2      , CI       ,#
  2860.                                   ,            , # CN      , CT       ,#
  2861.                                   ,            , # DLC     , DLTO     ,#
  2862.                                   ,            , # DLX     , EP       ,#
  2863.                                   ,            , # IN      , LI       ,#
  2864.                                   ,            , # OP      , PA       ,#
  2865.                                   ,            , # PG      , PL       ,#
  2866.                                   ,            , # PW      , SE       ,#
  2867.                                   ,            , #         ,          ,#
  2868.                                   ,            , #         ,          ,#
  2869.                                   ,            , #         ,          ,#
  2870.                                   ,            , #         ,          ,#
  2871.                                   ,            , #         ,          ,#
  2872.                                   ,            , #         ,          ,#
  2873.                                   ,            , #         ,          ,#
  2874.                                   ,            , #         ,          ,#
  2875.                                   ,            , #         ,          ,#
  2876.                                   ,            , #         ,          ,#
  2877.                                   ,            , #         ,          ,#
  2878.                                   ,            , #         ,          ,#
  2879.                                   ,            , #         ,          ,#
  2880.                      FAMILY       , USER$NUM   , # MFAM    , MUSER    ,#
  2881.                      APPLICATION  , FAMILY     , # MAPPL   , DFAM     ,#
  2882.                      USER$NUM     , FAMILY     , # DUSER   , PFAM     ,#
  2883.                      USER$NUM     ,            , # PUSER   ,          ,#
  2884.                      APPLICATION  ,            , # PAPPL   ,          ,#
  2885.                                   ,            , #         ,          ,#
  2886.                                   ,            , # UID     ,PRIV      ,#
  2887.                                   ,            , # KDSP    ,          ,#
  2888.                                   ,            , # NAME1   , NAME2    ,#
  2889.                                   ,            , # SNODE   , DNODE    ,#
  2890.                                   ,            , # ACCLEV  ,          ,#
  2891.                                   ,            , #         ,          ,#
  2892.                                   ,            , #         ,          ,#
  2893.                                   ,            , #         ,          ,#
  2894.                                   ,            , #         ,          ,#
  2895.                                   ,            ; # FAM     , UNAME     #
  2896.       CONTROL EJECT;
  2897. #                                                                      #
  2898. #                            USERPR CODE BEGINS HERE                   #
  2899. #                                                                      #
  2900.       IF USR$M$FLAG          # IF MAXIMUM USR FLAG REACHED             #
  2901.       THEN
  2902.         BEGIN 
  2903.         RETURN;              # SKIP THE ENTRY                          #
  2904.         END 
  2905.       FAM$FLG = FALSE;       # CLEAR FAMILY SPECIFIED FLAG             #
  2906.       USR$FLG = FALSE;       # CLEAR USER NUMBER SPECIFIED FLAG        #
  2907.       APL$FLG = FALSE;       # CLEAR INITIAL APPL SPECIFIED FLAG       #
  2908.       IF UTWC[1] GQ USR$M$ST
  2909.       THEN
  2910.         BEGIN                # IF MAXIMUM ENTRY ALREADY REACHED        #
  2911.         USR$M$FLAG = TRUE;   # SET WARNING FLAG TO TRUE                #
  2912.         NDLEM2(ERR159,STLNUM[0],XCDD(USR$M$ST)); # GENERATE WARNING    #
  2913.         RETURN;              # SKIP ENTRY                              #
  2914.         END 
  2915.       CRNT$ENT = UTWC[1] + 1;          # POINT TO NEXT ENTRY POSITION  #
  2916.       UTWC[1] = UTWC[1] + UTENTSZ;     # INCREMENT TABLE WORD COUNT    #
  2917.       IF UTWC[1] GQ UT$LENG-1          # IF MORE SPACE IS NEED         #
  2918.       THEN
  2919.         BEGIN 
  2920.         SSTATS(P<USER$TABLE>,UTENTSZ);  # ALLOC ROOM FOR ONE MORE ENTRY#
  2921.         END 
  2922.       FOR I=CRNT$ENT STEP 1 UNTIL (CRNT$ENT + UTENTSZ) - 1
  2923.       DO
  2924.         BEGIN 
  2925.         UTWORD[I] = 0;       # CLEAR THE CURRENT ENTRY                 #
  2926.         END 
  2927.       IF NOT STLBERR[1]      # IF NO LABEL ERRORS                      #
  2928.       THEN
  2929.         BEGIN 
  2930.         UTNAME[CRNT$ENT] = STLABEL[1]; # PUT USER NAME IN ENTRY        #
  2931.         END 
  2932.       FOR I=2 STEP 1 UNTIL STWC[0]     # FOR EACH VALUE DECLARATION    #
  2933.       DO
  2934.         BEGIN 
  2935.         GOTO USERJMP[STKWID[I]];       # GOTO APPROPRIATE PARAGRAPH    #
  2936. FAMILY: 
  2937.         IF STVALNAM[I] NQ "NONE"       # IF VALUE IS NOT -NONE-        #
  2938.         THEN
  2939.           BEGIN 
  2940.           IF NOT FAM$FLG               # IF FAMILY NOT SPECIFIED       #
  2941.           THEN
  2942.             BEGIN 
  2943.             FAM$FLG = TRUE;            # SET FAMILY SPECIFIED FLAG     #
  2944.             IF NOT STVLERR[I]          # IF VALUE IS O.K.              #
  2945.             THEN
  2946.               BEGIN 
  2947.               IF STVALNAM[I] NQ "0"    # IF VALUE IS NOT ZERO          #
  2948.               THEN
  2949.                 BEGIN                  # ENTER FAMILY VALUE            #
  2950.                 CTEMP = STVALNAM[I];
  2951.                 NDLZFIL(CTEMP);        # ZERO FILL NAME                #
  2952.                 UTFAM[CRNT$ENT + 1] = CTEMP;
  2953.                 END                    # ENTER CODE FOR FAMILY         #
  2954.               UTCODE[CRNT$ENT + 1] = VAL$CODE[STKWID[I]]; 
  2955.               END 
  2956.             END 
  2957.           ELSE                         # FAMILY PREVIOUSLY SPECIFIED   #
  2958.             BEGIN            # FLAG ERROR -- BOTH MFAM AND DFAM SPEC   #
  2959.             NDLEM2(ERR144,STLNUM[0]," "); 
  2960.             END 
  2961.           END 
  2962.         TEST I;              # GET NEXT ENTRY                          #
  2963. USER$NUM: 
  2964.         IF STVALNAM[I] NQ "NONE"       # IF VALUE IS NOT -NONE-        #
  2965.         THEN
  2966.           BEGIN 
  2967.           IF NOT USR$FLG               # IF USER NUM NOT SPECIFIED     #
  2968.           THEN
  2969.             BEGIN 
  2970.             USR$FLG = TRUE;            # SET USER NUM SPECIFIED FLAG   #
  2971.             IF NOT STVLERR[I]          # IF VALUE IS O.K.              #
  2972.             THEN
  2973.               BEGIN 
  2974.               IF STVALNAM[I] NQ "0"    # IF VALUE IS NOT ZERO          #
  2975.               THEN
  2976.                 BEGIN                  # PUT UN AND CODE IN ENTRY      #
  2977.                 CTEMP = STVALNAM[I];
  2978.                 NDLZFIL(CTEMP);        # ZERO FILL NAME                #
  2979.                 UTUSER[CRNT$ENT + 2] = CTEMP; 
  2980.                 UTCODE[CRNT$ENT + 2] = VAL$CODE[STKWID[I]]; 
  2981.                 END 
  2982.               ELSE                     # VALUE IS ZERO                 #
  2983.                 BEGIN        # FLAG ERROR -- VALUE CAN NOT BE ZERO     #
  2984.                 NDLEM2(ERR145,STLNUM[0]," "); 
  2985.                 END 
  2986.               END 
  2987.             END 
  2988.           ELSE                         # USER NUM ALREADY SPECIFIED    #
  2989.             BEGIN            # FLAG ERROR -- CANNOT USE BOTH MUSER AND #
  2990.             NDLEM2(ERR146,STLNUM[0]," ");        # DUSER               #
  2991.             END 
  2992.           END 
  2993.         TEST I;              # GOTO NEXT ENTRY                         #
  2994. APPLICATION:  
  2995.         IF STVALNAM[I] NQ "NONE"       # IF VALUE IS NOT -NONE-        #
  2996.         THEN
  2997.           BEGIN 
  2998.           IF NOT APL$FLG               # IF APPL NOT SPECIFIED         #
  2999.           THEN
  3000.             BEGIN 
  3001.             APL$FLG = TRUE;            # SET APPL SPECIFIED FLAG       #
  3002.             IF NOT STVLERR[I]          # IF VALUE IS O.K.              #
  3003.             THEN
  3004.               BEGIN 
  3005.               FOUND = FALSE;           # CLEAR FOUND FLAG              #
  3006.               FOR J=1 STEP 1 UNTIL MXRWT
  3007.               DO                       # SEARCH RESERVE WORD TABLE FOR #
  3008.                 BEGIN                  #   VALUE                       #
  3009.                 IF STVALNAM[I] EQ VALNAM[J] 
  3010.                 THEN                   # IF VALUE FOUND IN TABLE       #
  3011.                   BEGIN 
  3012.                   FOUND = TRUE;        # SET FOUND FLAG                #
  3013.                   END 
  3014.                 END 
  3015.               IF NOT FOUND             # IF VALUE IS NOT RESERVED WORD #
  3016.               THEN
  3017.                 BEGIN                  # PUT NAME AND CODE IN ENTRY    #
  3018.                 UTAPPL[CRNT$ENT + 3] = STVALNAM[I]; 
  3019.                 UTCODE[CRNT$ENT + 3] = VAL$CODE[STKWID[I]]; 
  3020.                 END 
  3021.               ELSE                     # NAME IS A RESERVE WORD        #
  3022.                 BEGIN        # FLAG ERROR -- CANNOT BE RESERVED APPL   #
  3023.                 NDLEM2(ERR147,STLNUM[0],STVALNAM[I]); 
  3024.                 END 
  3025.               END 
  3026.             END 
  3027.           ELSE                         # APPL ALREADY SPECIFIED        #
  3028.             BEGIN            # FLAG ERROR -- CANNOT SPEC BOTH MAPPL AND#
  3029.             NDLEM2(ERR148,STLNUM[0]," ");        # PAPPL               #
  3030.             END 
  3031.           END 
  3032.         TEST I;              # GOTO NEXT ENTRY                         #
  3033.         END 
  3034.       RETURN;                # **** RETURN ****                        #
  3035.       END # USERPR #
  3036.       CONTROL EJECT;
  3037.       PROC WR$LCF(TABLE,WSA,LENGTH);
  3038.       BEGIN 
  3039. *IF,DEF,IMS 
  3040. # 
  3041. **    WR$LCF - WRITE TABLE TO LCF.
  3042. * 
  3043. *     D.K. ENDO    81/10/30 
  3044. * 
  3045. *     THIS PROCEDURE WRITES A GIVEN TABLE TO THE LCF. 
  3046. * 
  3047. *     PROC WR$LCF(TABLE,WSA,LENGTH) 
  3048. * 
  3049. *     ENTRY        TABLE = SWITCH I.D. FOR TABLE. 
  3050. *                  WSA = FIRST WORD ADDRESS OF TABLE. 
  3051. *                  LENGTH = LENGTH OF TABLE.
  3052. * 
  3053. *     EXIT         NONE.
  3054. * 
  3055. *     METHOD
  3056. * 
  3057. *     POINT FET TO TABLE
  3058. *     SELECT CASE THAT APPLIES: 
  3059. *       CASE 1(HEADER RECORD,APPL,USER,OUTCALL,INCALL TABLES):  
  3060. *         WRITE TABLE TO LCF. 
  3061. *         WRITE EOR TO LCF
  3062. *       CASE 2(VERIFICATION RECORD):  
  3063. *         WRITE RECORD TO LCF.
  3064. *         WRITE EOR TO LCF. 
  3065. *         WRITE EOF TO LCF. 
  3066. * 
  3067. # 
  3068. *ENDIF
  3069.       ITEM TABLE;            # SWITCH I.D. FOR TABLE                   #
  3070.       ITEM WSA;              # FIRST WORD ADDRESS OF TABLE             #
  3071.       ITEM LENGTH;           # LENGTH OF TABLE                         #
  3072. # 
  3073. ****  PROC WR$LCF - XREF LIST BEGINS. 
  3074. # 
  3075.       XREF
  3076.         BEGIN 
  3077.         PROC RECALL;         # RETURNS CONTROL WHEN RECALL BIT CLEARED #
  3078.         PROC WRITEF;         # FLUSH CIO BUFFER AND PUT EOF            #
  3079.         PROC WRITER;         # FLUSH CIO BUFFER AND PUT EOR            #
  3080.         END 
  3081. # 
  3082. ****
  3083. # 
  3084.       SWITCH WLCFJMP W$EOR,            # FILE HEADER                   #
  3085.                      W$EOR,            # APPL TABLE                    #
  3086.                      W$EOR,            # USER TABLE                    #
  3087.                      W$EOR,            # OUTCALL TABLE                 #
  3088.                      W$EOR,            # INCALL TABLE                  #
  3089.                      W$EOR,            # PATH PID TABLEORD             #
  3090.                      W$EOF;            # VALIDATION RECORD             #
  3091. #                                                                      #
  3092. #                            WR$LCF CODE BEGINS HERE                   #
  3093. #                                                                      #
  3094.       LCFFIRST[0] = WSA;     # POINT FET TO TABLE                      #
  3095.       LCFOUT[0] = WSA;
  3096.       LCFIN[0] = WSA + LENGTH;
  3097.       LCFLIMIT[0] = LCFIN[0] + 1; 
  3098. #                                                                      #
  3099.       GOTO WLCFJMP[TABLE];
  3100. W$EOR:  
  3101.       WRITER(LCFFET);        # WRITE TABLE WITH EOR                    #
  3102.       RECALL(LCFFET); 
  3103.       GOTO LCF$NEXT;
  3104. W$EOF:  
  3105.       WRITEF(LCFFET);        # WRITE TABLE WITH EOF                    #
  3106.       RECALL(LCFFET); 
  3107.       GOTO LCF$NEXT;
  3108. LCF$NEXT: 
  3109.       RETURN;                # **** RETURN ****                        #
  3110.       END # WR$LCF #
  3111.       CONTROL EJECT;
  3112. #                                                                      #
  3113. #                            NDLP2LF CODE BEGINS HERE                  #
  3114. #                                                                      #
  3115. #                            ALLOCATE SPACE FOR LCF CREATION           #
  3116.       SSTATS(P<USER$TABLE>,MXUTAB); 
  3117.       SSTATS(P<APPL$TABLE>,MXATAB); 
  3118.       SSTATS(P<OUTCALL$TABL>,MXOTAB); 
  3119.       SSTATS(P<INCALL$TABLE>,MXITAB); 
  3120.       SSTATS(P<PATHPID$TAB>,MXPPTAB); 
  3121.       UTWORD[0] = 0;         # INITIALIZE USER TABLE                   #
  3122.       UT$IDENT[0] = "USER"; 
  3123.       USR$M$FLAG = FALSE;    # MAXIMUM USER STATEMENTS FLAG            #
  3124.       UTWORD[1] = 0;
  3125.       UTWC[1] = 1;
  3126.       ATWORD[0] = 0;         # INITIALIZE APPL TABLE                   #
  3127.       AT$IDENT[0] = "APPL"; 
  3128.       ATWORD[1] = 0;
  3129.       ATWC[1] = 1;
  3130.       OBWORD[0] = 0;         # INITIALIZE OUTCALL TABLE                #
  3131.       OB$IDENT[0] = "OUTCALL";
  3132.       OBWORD[1] = 0;
  3133.       OBWC[1] = 1;
  3134.       IBWORD[0] = 0;         # INITIALIZE INCALL TABLE                 #
  3135.       IB$IDENT[0] = "INCALL"; 
  3136.       IBWORD[1] = 0;
  3137.       IBWC[1] = 1;
  3138.       PPWORD[0] = 0;         # INITIALIZE PATHPID TABLE                #
  3139.       PP$IDENT[0] = "PATHPID";
  3140.       PPWORD[1] = 0;
  3141.       PIRWC[1] = 1; 
  3142. #                                                                      #
  3143.       REWIND(ERR2FET);       # REWIND PASS 2 ERROR FILE                #
  3144.       RECALL(ERR2FET);
  3145.       REWIND(STFET);         # REWIND STATEMENT TABLE FILE             #
  3146.       RECALL(STFET);
  3147.       READ(STFET);           # READ STATEMENT TABLE INTO CIO BUFFER    #
  3148.       RECALL(STFET);
  3149.       READW(STFET,STMT$TABLE,1,STMT$STAT);   # READ HEADER OF 1ST ENTRY#
  3150. #                                                                      #
  3151.       FOR I=0 WHILE STMT$STAT EQ TRNS$OK
  3152.       DO
  3153.         BEGIN 
  3154.         READW(STFET,STMT$TABLE[1],STWC[0],STMT$STAT); 
  3155.         GOTO LCFJUMP[STSTID[0]];
  3156. LFILE$ENTRY:  
  3157.         LFILEPR;             # CHECK LFILE ENTRY                       #
  3158.         GOTO NEXT$STMT; 
  3159. USER$ENTRY: 
  3160.         USERPR;              # CHECK USER ENTRY                        #
  3161.         GOTO NEXT$STMT; 
  3162. APPL$ENTRY: 
  3163.         APPLPR;              # CHECK APPL ENTRY                        #
  3164.         GOTO NEXT$STMT; 
  3165. OUTCALL$ENT:  
  3166.         OUTCLPR;             # CHECK OUTCALL ENTRY                     #
  3167.         GOTO NEXT$STMT; 
  3168. INCALL$ENT: 
  3169.         INCALPR;             # CHECK INCALL ENTRY                      #
  3170.         GOTO NEXT$STMT; 
  3171. NEXT$STMT:                   # READ NEXT STATEMENT ENTRY HEADER        #
  3172.         READW(STFET,STMT$TABLE,1,STMT$STAT);
  3173.         END 
  3174.       LCFTERM;               # EXECUTE TERMINATION PROCESSING          #
  3175.       RETURN;                # **** RETURN ****                        #
  3176.       END # NDLP2LF # 
  3177.       TERM
cdc/nos2.source/nam5871/ndlp2lf.txt · Last modified: 2023/08/05 17:22 by Site Administrator