Retro1.org codex

*DECK NDLLIST 
USETEXT NDLDATT 
USETEXT NDLER1T 
USETEXT NDLFETT 
USETEXT NDLNCFT 
USETEXT NDLPS2T 
USETEXT NDLTBLT 
      PROC NDLLIST; 
      BEGIN 
*IF,DEF,IMS 
# 
**    NDLLIST 
* 
*     S.M. ILMBERGER         81/10/29 
* 
*     PRODUCES LISTINGS FOR NDL RUN 
* 
*     PROC NDLLIST
* 
*     ENTRY NONE
* 
*     EXIT  NONE
* 
*     MESSAGES     NONE 
* 
*     METHOD
* 
*     SET UP OUTFET POINTERS
*     SET UP INFO FOR PAGE HEADER 
*     IF RUN IS CREATION RUN
*       IF SOURCE LISTING IS REQUESTED
*         CALL SRCLST 
*       IF ERRORS EXIST 
*         CALL ERRLST 
*       IF DEFINE LISTING IS REQUESTED
*         CALL DEFLST 
*       IF EXPANDED SOURCE LISTING IS REQUESTED 
*         CALL EXSLST 
*       IF SUMMARY LISTING REQUESTED
*         CALL NCFLST AND/OR LCFLST 
*     IF RUN IS SUMMARY RUN 
*       CALL NCFLST AND/OR LCFLST 
*     END 
# 
*ENDIF
 
# 
****  PROC NDL$LST - XREF LIST BEGINS.
# 
      XREF
        BEGIN 
        PROC ABORT;          # ABORTS NDLP                             #
        PROC SSTATS;         # ALLOCATES TABLE SPACE                   #
        FUNC EDATE C(10);    # UNPACKS DATE                            #
        FUNC ETIME C(10);    # UNPACKS TIME                            #
        PROC MESSAGE; 
        PROC PDATE;          # GET PACKED DATE AND TIME                #
        FUNC SSDCAD ;        # CONVERTS ASCII TO DISPLAY CODE          #
        PROC READ;           # READS FET                               #
        PROC READH;          # READS TABLES                            #
        PROC READW;          # READW ERROR FETS                        #
        PROC RECALL;         # RETURNS CONTROL WHEN FUNCTIONS DONE     #
        PROC REWIND;         # REWINDS FILES                           #
        PROC SKIPB;          # SKIP BACKWRDS IN NCF FILE               #
        PROC SKIPEI;         # SKIP TO EOI                             #
        PROC WRITEH;         # WRITES TO TABLES                        #
        PROC WRITER;         # FLUSH BUFFER AND WRITE EOR              #
        FUNC XCDD C(10);     # CONVERTS INT TO DEC DISPLAY CODE        #
        FUNC XCHD C(10);     # CONVERTS HEX TO INT DISPLAY CODE        #
        FUNC XSFW C(10);     # CONVERT ZERO FILLED NAME TO BLANK FILLED#
        END 
# 
****
# 
 
      DEF ENTRY0 # 0 #;        # ENTRY 0 OF TABLE        #
      DEF ENTRY1 # 1 #; 
      DEF ENTRY2 # 2 #; 
      DEF ENTRY3 # 3 #;      # WORD 3 OF TABLE                         #
      DEF ENTRY4 # 4 #;      # WORD 4 OF TABLE                         #
      DEF ERMSG1 # 1 #;      # DEFINE ERROR MESSAGE NUMBERS            #
      DEF ERMSG2 # 2 #; 
      DEF ERMSG3 # 3 #; 
      DEF ERMSG4 # 4 #; 
      DEF ERMSG5 # 5 #; 
      DEF ERMSG6 # 6 #; 
      DEF ERMSG7 # 7 #; 
      DEF ERMSG8 # 8 #; 
      DEF ERMSG9 # 9 #; 
      DEF ERMSG10 # 10 #; 
      DEF ERMSG11 # 11 #; 
      DEF LN1 # 1 #;         # NUMBER OF LINES TO BE PRINTED           #
      DEF LN2 # 2 #;
      DEF LN3 # 3 #;
      DEF LN4 # 4 #;
      DEF LN5 # 5 #;
         DEF LN6 # 6 #; 
      DEF NEWPAGE # 100 #;   # LINE COUNT                              #
      DEF SERMSG # 31 #;     # NUMBER OF WORDS IN ONE SERVICE MESSAGE  #
 
                             # CALL NAMLEV AND ER2CNDL                 #
      CONTROL NOLIST; 
*CALL NAMLEV
 
      CONTROL PRESET; 
*CALL ER2CNDL 
      CONTROL LIST; 
 
      ITEM BIT=0;            # BIT OF WORD NODEMAP                     #
      ITEM CPL$ID;           # CURRENT COUPLER NODE ID                 #
      ITEM ENTRY$CNT I;      # NUMBER OF LIN$CON$REC ENTRIES           #
      ITEM FNFV$CNT I;       # NUMB OF FVFN PAIRS IN LIN$CON$REC ENTRY #
      ITEM INCALL$EC I;      # INCALL TABLE ENTRY COUNT                #
      ITEM LCF$STAT I;       # STATUS OF READ FROM LCF                 #
      ITEM LINREC$WC I;      # WORD COUNT OF LINE RECORD               #
      ITEM LINREC$GC I;      # GROUP COUNT OF LINE RECORD              #
      ITEM NCBIT I;          # BIT NUMBER OF NCBWORD TO REFER TO       #
      ITEM NCBWD I;          # WORD NUMBER OF NCB TO REFER TO          #
      ITEM NCF$IDX$EC;       # ENTRY COUNT FOR NCF$INDEX               #
      ITEM NODE$ID;          # CURRENT NPU NODE ID                     #
      ITEM OUTCALL$EC I;     # OUTCALL TABLE ENTRY COUNT               #
      ITEM PORTNUM;          # CURRENT PORT NUMBER                     #
      ITEM TEMPACKED U;      # STORAGE FOR PACKED DATE AND TIME        #
      ITEM TEMPT U;          # STORAGE FOR TIME                        #
      ITEM TEMP1 U;          # TEMP STORAGE FOR INTEGER NUMBER         #
      ITEM TEMP2 C(10);      # TEMP STORAGE FOR CHARACTER ITEM         #
      ITEM TEMPD C(10);      # STORAGE FOR DATE                        #
      ITEM WORD=0;           # WORD OF BITMAP                          #
 
 
      ARRAY ALLNODS [0:0] S(6);        # ALL NODE NUMBERS USED LINE    #
        BEGIN 
        ITEM ALLN          C(00,00,54) =
        ["0        ALL NODE NUMBERS LESS THAN     HAVE BEEN USED"]; 
        ITEM MAXNODE       C(03,36,03); 
        END 
 
      ARRAY APPL$HDR [0:0] S(11); #  HEADER FOR APPL SUMMARY #
        BEGIN 
        ITEM APPL$1        C(00,00,110) = 
          ["0        APPL       NAME      PRIV      UID       STATUS
RS     MXCOPYS      KDSP     NETXFR      PRU"]; 
        END 
 
      ARRAY APPL$LN [0:0] S(11); #  APPL LINE # 
        BEGIN 
        ITEM APPL$FIL      C(00,00,110) = [" "];
        ITEM APPL$NAM      C(02,00,07); 
        ITEM APPL$PRI      C(03,00,03); 
        ITEM APPL$UID      C(04,00,03); 
        ITEM APPL$STA      C(05,12,02); 
        ITEM APPL$RS       C(06,00,03); 
        ITEM APPL$MAXC     C(07,00,02); 
        ITEM APPL$KDP      C(08,00,03); 
        ITEM APPL$XFR      C(09,00,03); 
        ITEM APPL$PRU      C(10,00,03); 
        END 
 
      ARRAY ASCII$TO$DC [0:0] S(13);   # ASCII TO DISPLAY CODE TABLE   #
        BEGIN 
        ITEM DC$CHAR C(00,00,130) = ["
              0123456789       ABCDEFGHIJKLMNOPQRSTUVWXYZ"];
        END 
 
      ARRAY BLNK$LN [0:0] S(1);        # BLANK LINE                    #
        ITEM BLNK          C(00,00,10) = [" "]; 
 
      ARRAY CPL$HDR [0:0] S(6);  #  HEADER FOR COUPLER SUMMARY #
        BEGIN 
        ITEM CPL$1         C(00,00,53) =
          ["0         COUPLER   NAME      NODE      HNAME     LOC"];
        END 
 
      ARRAY CPL$LN [0:0] S(6);   #  COUPLER LINE #
        BEGIN 
        ITEM CPL$FILL      C(00,00,60) = [" "]; 
        ITEM CPL$NAM       C(02,00,07); 
        ITEM CPL$NOD       C(03,06,02); 
        ITEM CPL$HNA       C(04,00,07); 
        ITEM CPL$LOC       C(05,00,07); 
        END 
 
      ARRAY DEF$HDR [0:0] S(4);        # DEFINE LISTING HEADER         #
        ITEM DEF$LN        C(00,00,40) =
          ["0 DEFINE NAME      DEFINE CONTENTS      "]; 
 
      ARRAY DEF$L [0:11] S(1);         # DEFINE LINE                   #
        BEGIN 
        ITEM DEF$LAB       C(00,30,07); 
        ITEM DEF$STR       C(02,00,100);
        ITEM DEF$TOTAL     C(00,00,120) = [" "];
        END 
 
      ARRAY NO$DEF [0:0] S(6);
        ITEM NO$DEF$L      C(00,00,60) =
       ["0                     NO DEFINE COMMANDS ENCOUNTERED        "];
 
      ARRAY DEV$HDR1 [0:0] S(13);  #  HEADER1 FOR DEVICE LINES #
        BEGIN 
        ITEM DEF$1         C(00,00,130) = 
          ["0          DEVICE   NAME     DT/  SDT/  ABL/  DBZ/  UBL/
HN/  AUTOCON/ BR/   AB/  B1/  CI/ CT/  DLC/   EP/  LI/  PG/  PL/ SE/ "] 
        ; 
        END 
 
      ARRAY DEV$HDR2 [0:0] S(14);  #  HEADER2 FOR DEVICE LINES #
        BEGIN 
        ITEM DEV$2         C(00,00,130) = 
         ["                             TA   XBZ/  DBL/  UBZ/  STREAM/ D
O/           PRI/  BS/  B2/  CN/ DLX/ DLTO/  IN/  OP/  PA/  PW/ STAT/"] 
       ;
        END 
 
      ARRAY DEV$HDR3 [0:0] S(13); 
        BEGIN 
        ITEM DEV$3         C(00,00,130) = 
         ["                                  MCI   MLI   RTS   XLY     M
C            FA    ELO  ELX  ELR EBO  EBX    EBR  CP   IC   OC  LK  "]; 
        END 
 
      ARRAY DEV$LN1 [0:0] S(13);  #  DEVICE LINE1 # 
        BEGIN 
        ITEM DEV1$FIL      C(00,06,129) = [" "];
        ITEM DEV$NAM       C(02,00,07); 
        ITEM DEV$DT        C(02,54,04); 
        ITEM DEV$SDT       C(03,24,05); 
        ITEM DEV$ABL       C(04,06,01); 
        ITEM DEV$DBZ       C(04,36,04); 
        ITEM DEV$UBL       C(05,18,02); 
        ITEM DEV$HN        C(06,00,02); 
        ITEM DEV$ACON      C(06,42,03); 
        ITEM DEV$BR        C(07,30,03); 
        ITEM DEV$AB        C(08,00,02); 
        ITEM DEV$B1        C(08,30,02); 
        ITEM DEV$CI        C(09,00,02); 
        ITEM DEV$CT        C(09,30,02); 
        ITEM DEV$DLC       C(10,00,04); 
        ITEM DEV$EP        C(10,36,03); 
        ITEM DEV$LI        C(11,06,02); 
        ITEM DEV$PG        C(11,42,03); 
        ITEM DEV$PL        C(12,06,03); 
        ITEM DEV$SE        C(12,36,03); 
        ITEM DEV1$CRRT     C(00,00,01) = ["0"]; # CARRIAGE CONTROL     #
        END 
 
      ARRAY DEV$LN2 [0:0] S(13);   #  DEVICE LINE2 #
        BEGIN 
        ITEM DEV2$FIL      C(00,00,130) = [" "];
        ITEM DEV$TA        C(03,00,02); 
        ITEM DEV$XBZ       C(03,24,04); 
        ITEM DEV$DBL       C(04,06,01); 
        ITEM DEV$UBZ       C(04,36,04); 
        ITEM DEV$STR       C(05,24,01); 
        ITEM DEV$DO        C(06,06,01); 
        ITEM DEV$PRI       C(07,30,03); 
        ITEM DEV$BS      C(08,00,02); 
        ITEM DEV$B2        C(08,30,02); 
        ITEM DEV$CN        C(09,00,02); 
        ITEM DEV$DLX       C(09,30,02); 
        ITEM DEV$DLTO      C(10,06,03); 
        ITEM DEV$IN        C(10,42,02); 
        ITEM DEV$OP        C(11,06,02); 
        ITEM DEV$PA        C(11,42,01); 
        ITEM DEV$PW        C(12,06,03); 
        ITEM DEV$STAT      C(12,36,02); 
        END 
 
      ARRAY DEV$LN3 [0:0] S(13);
        BEGIN 
        ITEM DEV3$FIL      C(00,00,130) = [" "];
        ITEM DEV$MCI       C(03,24,03); 
        ITEM DEV$MLI       C(04,00,03); 
        ITEM DEV$RTS       C(04,42,03); 
        ITEM DEV$XLY       C(05,18,02); 
        ITEM DEV$MC        C(06,00,02); 
        ITEM DEV$FA        C(07,30,03); 
        ITEM DEV$ELO       C(08,00,02); 
        ITEM DEV$ELX       C(08,30,02); 
        ITEM DEV$ELR       C(09,00,02); 
        ITEM DEV$EBO       C(09,30,02); 
        ITEM DEV$EBX       C(10,06,03); 
        ITEM DEV$EBR       C(10,42,02); 
        ITEM DEV$CP        C(11,06,03); 
        ITEM DEV$IC        C(11,42,03); 
        ITEM DEV$OC        C(12,06,03); 
        ITEM DEV$LK        C(12,36,03); 
        END 
 
      ARRAY ENT1 [0:0] S(1); # NCB TABLE ENTRY                         #
        BEGIN 
        ITEM ENTF          U(00,44,08); # FIRST EIGHT BITS OF ENTRY    #
        ITEM ENTCNT        U(00,52,08); # LAST EIGHT BITS OF ENTRY     #
        ITEM TENTRY        U(00,44,16); # TOTAL ENTRY                  #
        END 
 
      ARRAY EMTAB [1:11] S(5);
        BEGIN 
        ITEM EMPROC        C(01,06,08); 
        ITEM EMESS         C(00,00,40) = [
                   # 1 #     " ABRT FROM         - NO SUCH RECORD TYPE",
                   # 2 #     " ABRT FROM         - READ ERROR         ",
                   # 3 #     " ABRT FROM         - BAD NCF FILE RECORD",
                   # 4 #     " ABRT FROM         - INVALID RECORD TYPE",
                   # 5 #     " ABRT FROM         - FN VAL NOT DEVIC FN",
                   # 6 #     " ABRT FROM         -CAN'T READ LIN RECDS",
                   # 7 #     " ABRT FROM         -CAN'T READ NCF RECDS",
                   # 8 #     " ABRT FROM         - FN VAL NOT LINE FN ",
                   # 9 #     " ERROR IN LCF -- SUMMARY SUPPRESSED.    ",
                   # 10 #    " ABRT FROM         - FN VAL NOT TERM FN ",
                   # 11 #    " ERROR IN NCF -- SUMMARY SUPPRESSED.    ",
                             ]; 
        ITEM EMZBYT        U(04,00,60) = [11(0)]; 
        ITEM EM$ENT     C(00,00,50);   # ERROR MSG TABLE ENTRY         #
        END 
 
      ARRAY ERR$HDR [0:0] S(5); 
        BEGIN 
        ITEM ERR$HDR1      C(00,00,50) =
          ["0 LINE  ERROR  SEVERITY    DETAILS       DIAGNOSIS"]; 
        END 
 
      ARRAY FH$NAM$LST [0:0] S(4);  #  FILE NAME AND TYPE SUMMARY STMT #
        BEGIN 
        ITEM NAM$LIN       C(00,00,37) =
          ["0          FILE NAME                "]; 
        ITEM NAM$TYP       C(00,42,03); 
        ITEM NET$NAME      C(03,00,07); 
        END 
 
      ARRAY FNFV$TAB [0:0] S(1);
        BEGIN 
        ITEM FNFV$ENT      U(00,44,16); 
        ITEM FN$ENT        U(00,44,08); 
        ITEM FV$ENT        U(00,52,08); 
        END 
 
      ARRAY INC$HDR1 [0:0] S(12); # HEADER FOR INCALL SUMMARY # 
        BEGIN 
        ITEM INC$1         C(00,00,120) = 
          ["0        INCALL     FAMILY    USER/     PRI/   DBL   ABL/ 
DBZ/  SNODE/  SHOST/  COLLECT/ PORT/    DPLR/        DTEA  "];
        END 
      ARRAY INC$HDR2 [0:0] S(12); 
        BEGIN 
        ITEM INC$2         C(00,00,120) = 
          ["                              ANAME                  UBL
UBZ   DNODE   WS      FASTSEL  DPLS     WR                 "];
        END 
 
 
      ARRAY INC$HDR3 [0:0] S(3);    # INCALL/OUTCALL FACILITY HEADER   #
        BEGIN 
        ITEM INC$3 C(00,00,30) = ["                    FACILITIES"];
        END 
 
      ARRAY INC$LN [0:0] S(13);  #  INCALL LINE # 
        BEGIN 
        ITEM INC$CRRT      C(00,00,01); 
        ITEM INC$FIL       C(00,00,130) = [" "];
        ITEM INC$FAM       C(02,00,07); 
        ITEM INC$USER      C(03,00,07); 
        ITEM INC$PRI       C(04,00,03); 
        ITEM INC$DBL       C(04,48,01); 
        ITEM INC$ABL       C(05,24,01); 
        ITEM INC$DBZ       C(05,54,04); 
        ITEM INC$SND       C(06,42,03); 
        ITEM INC$SHT       C(07,06,06); 
        ITEM INC$COLLECT   C(08,12,03); 
        ITEM INC$PORT      C(09,12,02); 
        ITEM INC$DPLR      C(09,54,04); 
        ITEM INC$DTEA      C(10,48,15); 
        END 
      ARRAY INC$LN2 [0:0] S(13);
        BEGIN 
        ITEM INC$FIL2     C(00,00,130) = [" "]; 
        ITEM INC$ANAM     C(03,00,14);
        ITEM INC$UBL      C(05,24,01);
        ITEM INC$UBZ      C(05,54,02);
        ITEM INC$DND      C(06,48,02);
        ITEM INC$WS       C(07,36,01);
        ITEM INC$FSEL     C(08,12,03);
        ITEM INC$DPLS     C(09,12,04);
        ITEM INC$WR       C(09,54,03);
        END 
 
      ARRAY LIN$REC$BUF [0:PRULNGTH] S(1);
        ITEM LINEWORD      (00,00,60);
 
      ARRAY LIN$HDR [0:0] S(12); #  HEADER FOR LINE SUMMARY # 
        BEGIN 
        ITEM LIN$1         C(00,00,120) = 
          ["0         LINE      NAME     PORT/ LTYPE  AUTO/ TIPTYPE/ DI 
  LSPEED/  DFL/  FRAME/ RTIME/ RCOUNT/ NSVC/"]; 
        END 
 
      ARRAY LIN$HDR2 [0:0] S(11);      # 2ND HEADER FOR LINE SUMMARY   #
        BEGIN 
        ITEM LIN$2         C(00,00,110) = 
          ["                             LCN          IMDISC  RC
   XAUTO   PSN   NPVC   AL   ARSPEED   DTEA"];
        END 
 
      ARRAY LIN$LN [0:0] S(11); # FORMAT FOR LINE SUMARY LIST # 
        BEGIN 
        ITEM LN$CRRT       C(00,00,01) = ["0"]; 
        ITEM LN$FIL        C(00,06,109) = [" "];
        ITEM LN$NAM        C(02,00,07); 
        ITEM LN$PORT       C(03,00,02); 
        ITEM LN$LTY        C(03,36,02); 
        ITEM LN$AUTO       C(04,12,03); 
        ITEM LN$TIPT       C(04,54,05); 
        ITEM LN$DI         C(05,42,03); 
        ITEM LN$LSPE       C(06,18,05); 
        ITEM LN$DFL        C(07,00,05); 
        ITEM LN$FRAM       C(07,48,03); 
        ITEM LN$RTIME      C(08,24,05); 
        ITEM LN$RCNT       C(09,18,02); 
        ITEM LN$NSVC       C(09,54,03); 
        ITEM LN$DCE        C(10,24,03); 
        END 
 
      ARRAY LIN$LN2 [0:0] S(11);
        BEGIN 
        ITEM LN$FL2        C(00,00,110) = [" "];
        ITEM LN$LCN        C(03,00,03) = ["0"]; 
        ITEM LN$IMD        C(04,12,03) = ["NO"];
        ITEM LN$RC         C(05,12,03); 
        ITEM LN$XAUTO      C(06,30,03); 
        ITEM LN$PSN        C(06,54,07); 
        ITEM LN$NPVC       C(07,42,04); 
        ITEM LN$SL         C(08,36,02); 
        ITEM LN$ARSPEED    C(09,06,03); 
        ITEM LN$DTEA       C(10,00,02); 
        END 
 
      ARRAY LLK$HDR [0:0] S(5);  # HEADER FOR LOGLINK SUMMARY # 
        BEGIN 
        ITEM LLK$1         C(00,00,46) =
          ["0          LOGLINK  NAME      NCNAME    STATUS"]; 
        END 
 
      ARRAY LLK$LN [0:0] S(5);    # LOGLINK LINE #
        BEGIN 
        ITEM LLK$FILL      C(00,00,50) = [" "]; 
        ITEM LLK$NAM       C(02,00,07); 
        ITEM LLK$NCN       C(03,00,07); 
        ITEM LLK$STA       C(04,12,02); 
        END 
 
      ARRAY MAXN$HDR [0:0] S(4);  # MAXIMUM NODE HEADER # 
        BEGIN 
        ITEM MAXN1         C(00,00,32) =
             ["0       MAXIMUM NODE NUMBER USED"];
        END 
 
      ARRAY MAXN$LN [0:0] S(2);   # MAX NODE NUMBER # 
        BEGIN 
        ITEM MAXN$FILL     C(00,00,20) = [" "]; 
        ITEM MAXNOD        C(01,00,03); 
        ITEM MAX$CRRT      C(00,00,01) = ["0"]; # CARRIAGE CONTROL     #
        END 
 
      ARRAY NODE$TAB [0:5] S(1);
        ITEM NODEMAP = [6(0)];
 
      ARRAY NPU$HDR [0:0] S(7);   # HEADER FOR NPU SUMMARY #
        BEGIN 
        ITEM NPU$1         C(00,00,63) =
    ["0       NPU         NAME      NODE      VARIANT   OPGO      DMP"];
        END 
 
      ARRAY NPU$LN [0:0] S(7);  # NPU LINE #
        BEGIN 
        ITEM FIL1          C(00,00,70) = [" "]; 
        ITEM NPU$NAM       C(02,00,07); 
        ITEM NPU$NOD       C(03,00,03); 
        ITEM NPU$VAR       C(04,00,07); 
        ITEM NPU$OP        C(05,00,03); 
        ITEM NPU$DMP       C(06,00,03); 
        END 
 
      ARRAY PG$HDR [0:0] S(13);        # PAGE HEADER FOR NDLP LISTING  #
        BEGIN 
        ITEM PGHDR$FIL C(00,00,130) = [" "];
        ITEM TITLE C(00,06,45); 
        ITEM STAR1 C(04,42,01) = ["*"]; 
        ITEM LST$TYP C(04,54,15); 
        ITEM STAR2 C(06,30,01) = ["*"]; 
        ITEM PROG$T C(07,00,04) = ["NDLP"]; 
        ITEM VER$NUM C(07,30,03); 
        ITEM DASH C(07,54,01) = ["-"];
        ITEM LEV$NUM C(08,06,03); 
        ITEM DAT C(09,00,10);          # DATE                          #
        ITEM TIM C(10,00,10);          # TIME                          #
        ITEM PAG C(11,36,04) = ["PAGE"];
        ITEM PAGE$N C(12,06,05);       # PAGE NUMBER                   #
        ITEM PG$CRRT C(00,00,01) = ["1"];           # CARRIAGE CONTROL #
        END 
 
 
      ARRAY OUT$HDR1 [0:0] S(11); # HEADER FOR OUTCALL SUMMARY         #
        BEGIN 
        ITEM OUTC$1 C(00,00,110) =
          ["0        OUTCALL    NAME1   NAME2/  PRI/ DBL/   ABL/   SNODE
/   PORT   DPLS/   WS           DTEA  PRID       "];
        END 
 
      ARRAY OUT$HDR2 [0:0] S(9);       # HEADER FOR OUTCALL SUMMARY    #
        BEGIN 
        ITEM OUTC$2 C(00,00,90) = 
          ["                             PID    UBL  UBZ    DBZ    DNODE
           ACCLEV    "];
        END 
 
      ARRAY OUT$HDR21 [0:0] S(3);      # HEADER FOR OUTCALL SUMMARY    #
        BEGIN 
        ITEM OUTC$21 C(00,00,30) =
          ["                    UDATA     "]; 
        END 
 
      ARRAY OUT$HDR3 [0:0] S(3);       # HEADER FOR OUTCALL FACILITIES #
        BEGIN 
        ITEM OUTC$3 C(00,00,30) = ["                    FACILITIES "];
        END 
 
      ARRAY OUTC$LN1 [0:0] S(11);  # OUTCALL LINE                      #
        BEGIN 
        ITEM OUTC$CC1 C(00,00,01);
        ITEM OUTC$FL1 C(00,00,110) = [" "]; 
        ITEM OUTC$NM1 C(02,00,07);
        ITEM OUTC$NM2 C(02,54,03);
        ITEM OUTC$PRI C(03,36,03);
        ITEM OUTC$DBL C(04,12,01);
        ITEM OUTC$ABL C(04,54,01);
        ITEM OUTC$SND C(05,36,02);
        ITEM OUTC$PRT C(06,30,02);
        ITEM OUTC$DPS C(07,18,04);
        ITEM OUTC$WS  C(07,54,01);
        ITEM OUTC$DTA C(08,06,16);
        ITEM OUTC$PRD C(09,42,08);
        END 
 
      ARRAY OUTC$LN2 [0:0] S(9);       # OUTCALL LINE TWO              #
        BEGIN 
        ITEM OUTC$FL2 C(00,00,90) = [" "];
        ITEM OUTC$PID C(02,54,03);
        ITEM OUTC$UBL C(03,42,01);
        ITEM OUTC$UBZ C(04,06,02);
        ITEM OUTC$DBZ C(04,42,04);
        ITEM OUTC$DND C(05,36,03);
        ITEM OUTC$ACL C(07,18,02);
        END 
 
      ARRAY OUTC$LN3 [0:0] S(13);      # OUTCALL LINE THREE            #
        BEGIN 
        ITEM OUTC$FL3 C(00,00,130) = [" "]; 
        ITEM OUTC$UDT C(02,00,100); 
        END 
 
      ARRAY OUTPT$BUFFER [0:0] S(14); # OUTPUT WORKING BUFFER          #
        BEGIN 
        ITEM OUTLNUM       C(00,06,05);# LINE NUMBER OF SOURCE         #
        ITEM OUTELINE      C(00,48,03);# SET TO -***- IF ERROR EXISTS  #
        ITEM OUTDLINE      C(01,30,01);# SET TO -D- IF DEFINE EXIST    #
        ITEM OUTBUFF1      C(00,00,135);
        END 
 
      ARRAY SOURCE$HDR [0:0] S(2);
        BEGIN 
        ITEM SRC$LN$HDR C(00,00,20) = ["0 LINE  ERR  DEFINE "]; 
        END 
 
      ARRAY SUP$HDR [0:0] S(3);   # HEADER FOR SUPLINK SUMMARY #
        BEGIN 
        ITEM SUP$1 C(00,00,26) = ["0         SUPLINK   LLNAME"];
        END 
 
      ARRAY SUP$LN [0:0] S(3);   # SUPLINK LINE # 
        BEGIN 
        ITEM SLK$FIL1 C(00,00,30) = [" "];
        ITEM SLK$NAM C(02,00,07); 
        END 
 
      ARRAY TER$HDR1 [0:0] S(11); # HEADER FOR TERMINAL SUMMARY # 
        BEGIN 
        ITEM TER$1 C(00,00,110) = 
          ["0          TERMINAL  STIP/  TC     CSET    TSPEED  CA  RIC
CO   BCF  MREC  W  CTYP  NCIR  NEN  EOF  COLLECT"]; 
        END 
 
      ARRAY TER$HDR2 [0:0] S(3);  # HEADER FOR TERMINAL SUMMARY # 
        BEGIN 
        ITEM TER$2 C(00,00,30) = ["                     PAD      "];
        END 
 
      ARRAY TER$LN1 [0:0] S(11);  # TERMINAL LINE # 
        BEGIN 
        ITEM TER$FIL C(00,00,110) = [" "];
        ITEM TER$STIP C(02,00,05);
        ITEM TER$TC C(02,42,05);
        ITEM TER$CSET C(03,24,07);
        ITEM TER$TSP C(04,24,05); 
        ITEM TER$CA C(05,06,02);
        ITEM TER$RIC C(05,30,03); 
        ITEM TER$CO C(06,00,03);
        ITEM TER$BCF C(06,30,03); 
        ITEM TER$MREC C(07,06,01);
        ITEM TER$W C(07,36,01); 
        ITEM TER$CTYP C(07,54,03);
        ITEM TER$NCIR C(08,30,03);
        ITEM TER$NEN C(09,06,03); 
        ITEM TER$EOF C(09,36,03); 
        ITEM TER$CLCT C(10,00,03);
        END 
 
      ARRAY TER$LN2 [0:0] S(13); # TERMINAL LINE            # 
        BEGIN 
        ITEM TER$FIL2 C(00,00,130) = [" "]; 
        ITEM TER$PAD  C(02,00,110); 
        END 
 
      ARRAY TIMELST [0:0] S(6);   # TIME AND DATE STATEMENT # 
        BEGIN 
        ITEM HD$LINE C(00,00,60) =
       ["-                   VALID     CREATED                       "];
        ITEM HD$TYP C(02,36,03);
        ITEM HD$TIME C(04,06,10); 
        ITEM HD$DATE C(05,06,10); 
        END 
 
      ARRAY TIP$HDR [0:0] S(4);   # HEADER FOR TIPTYPE SUMMARY #
        BEGIN 
        ITEM TIP$1 C(00,00,36)=["0         TIPTYPES USED FOR THIS NPU"];
        END 
 
      ARRAY TIP$LN [0:9] S(1);    # TIPTYPE LINE #
        BEGIN 
        ITEM TIP$FILL C(00,06,99) = [" "];
        ITEM TIPS C(00,00,10);
        ITEM TIPS$CRRT C(00,00,01) = ["0"]; # CARRIAGE CONTROL         #
        END 
 
      ARRAY TIPMP [0:0] S(1); 
        ITEM TIPMAP = [0];
 
      ARRAY TRK$HDR [0:0] S(9);  # HEADER FOR TRUNK SUMMARY # 
        BEGIN 
        ITEM TRK$1 C(00,00,90) =
          ["0        TRUNK      NAME       N1      N2    P1  P2    NOLOA
D1  NOLOAD2  STATUS    FRAME "];
        END 
 
      ARRAY TRK$LN [0:0] S(9);  # TRUNK LINE #
        BEGIN 
        ITEM TRK$FIL C(00,00,90) = [" "]; 
        ITEM TRK$NAM C(02,00,07); 
        ITEM TRK$N1 C(02,54,07);
        ITEM TRK$N2 C(03,48,07);
        ITEM TRK$P1 C(04,42,02);
        ITEM TRK$P2 C(05,06,02);
        ITEM TRK$NOLO1 C(05,48,03); 
        ITEM TRK$NOLO2 C(06,42,03); 
        ITEM TRK$STA C(07,30,04); 
        ITEM TRK$FRAME C(08,18,04);  # FRAME SIZE CODE #
        END 
 
      ARRAY UNODE$LN [0:0] S(11);      # UNUSED NODES                  #
        BEGIN 
        ITEM UNODE$FIL1 C(00,00,110) = [" "]; 
        ITEM NODNUMS C(01,00,98); 
        ITEM UNODE$CRRT C(00,00,01) = ["0"];        # CARRIAGE CONTROL #
        END 
 
      ARRAY USER$HDR [0:0] S(9);   # HEADER FOR USER SUMMARY #
        BEGIN 
        ITEM USER$1 C(00,00,88) = 
          ["0        USER       NAME      FAMILY    F-STATUS  USER
U-STATUS  APPL      A-STATUS"]; 
        END 
 
      ARRAY USER$LN [0:0] S(9);   # USER LINE # 
        BEGIN 
        ITEM USER$FIL C(00,00,90) = [" "];
        ITEM USER$NAM C(02,00,07);
        ITEM USER$FAM C(03,00,07);
        ITEM USER$FST C(04,12,03);
        ITEM USER$USER C(05,00,07); 
        ITEM USER$UST C(06,12,03);
        ITEM USER$APPL C(07,00,07); 
        ITEM USER$AST C(08,12,03);
        END 
 
      ARRAY USEDN$HDR [0:0] S(3);   # UNUSED NODE HEADER #
        BEGIN 
        ITEM USEDNOD C(00,00,27) = ["0       UNUSED NODE NUMBERS"]; 
        END 
      CONTROL EJECT;
      FUNC DC$FRAME (PFRAM) U;
      BEGIN 
# 
*    FUNCTION DC$FRAME
*    ENTRY CONDITION : FRAME SIZE 
*    EXIT CONDITION  : CODE REPRESENTING THE FRAME SIZE 
*                      CODE DELIVERED BY FUNCTION CAN BE 0,1, OR 2. 
# 
      DEF F500 # 500 #; # FRAME SIZE 500# 
      DEF F256 # 256 #; # FRAME SIZE 256# 
      DEF F1050 # 1050 #; # FRAME SIZE 1050#
      DEF FRAME0 # 0 # ; # FRAME SIZE 0 # 
      DEF FRAME1 # 1 # ; # FRAME SIZE 1 # 
      DEF FRAME2 # 2 # ; # FRAME SIZE 2 # 
      ITEM PFRAM ; # FRAME SIZE#
 
      ITEM FCODE ; # FRAME CODE#
      IF PFRAM EQ FRAME0
      THEN
        BEGIN 
        FCODE = F256; 
        END 
      ELSE
        BEGIN 
        IF PFRAM EQ FRAME1
        THEN
          BEGIN 
          FCODE = F500; 
          END 
        ELSE
          BEGIN 
          FCODE = F1050; # FRAME SIZE 1050 #
          END 
        END 
      DC$FRAME = FCODE ; # RETURN RESULT #
    END # END OF DC$FRAME#
      CONTROL EJECT;
      PROC APPLST;
      BEGIN 
*IF,DEF,IMS 
# 
**    APPLST - APPL LISTER
* 
*     S.M. ILMBERGER
* 
*     PRINTS TO OUTPUT FILE INFO FROM APPL TABLE
* 
*     PROC APPLST 
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES     ABORT FROM APPLST  - READ ERROR
* 
*     METHOD
* 
*     IF AT LEAST ONE ENTRY EXISTS IN APPL$TABLE
*       WRITES APPL HEADER OT OUTPUT FILE 
*       FOR EACH ENTRY IN APPL$TABLE
*         FORMAT AND WRITE APPL LINE TO OUTPUT FILE 
*     IF NO ENTRIES IN APPL$TABLE 
*       READ -EOR-
*     END 
# 
*ENDIF
 
      ITEM I;                # LOOP COUNTER                            #
      ITEM CTEMP C(10);      # CHARACTER TEMPORARY                     #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      IF ATWC[ENTRY1] GR 1
      THEN                   # AT LEAST ONE ENTRY EXISTS               #
        BEGIN 
        PGLST(LN2);          # COUNT LINES TO BE PRINTED               #
        WRITEH(OUTFET,APPL$HDR,11);    # WRITE APPL HEADER             #
        READW(LCFFET,APPL$TABLE,ATENTSZ,LCF$STAT);# READ 1ST TAB ENTRY #
        IF LCF$STAT NQ TRNS$OK         # CK STATUS OF READ             #
        THEN
          ERRMSG(ERMSG2,"APPLST");     # PRINT ERROR MESSAGE           #
        FOR I=0 WHILE LCF$STAT EQ TRNS$OK 
        DO
          BEGIN                        #  SET UP APPL LINE FROM INFO   #
          APPL$NAM[0] = ATNAME[I];     # IN APPL$TABL                  #
          IF NOT ATPRIV[I]
          THEN
            APPL$PRI[0] = "NO"; 
          ELSE
            APPL$PRI[0] = "YES";
          IF NOT ATUID[I] 
          THEN
            APPL$UID[0] = "NO"; 
          ELSE
            APPL$UID[0] = "YES";
          IF NOT ATSTAT[I]
          THEN
            APPL$STA[0] = "EN"; 
          ELSE
            APPL$STA[0] = "DI"; 
          IF  NOT ATRS[I]                 # IF RS SET                  #
          THEN
            BEGIN 
            APPL$RS[0] = "NO";            # SET TO NO IF RS NOT SET    #
            END 
          ELSE
            BEGIN 
            APPL$RS[0] = "YES";           # SET TO YES OTHERWISE       #
            END 
          IF NOT ATKDSP[I]
          THEN
            APPL$KDP[0] = "NO"; 
          ELSE
            APPL$KDP[0] = "YES";
          IF NOT ATXFR[I] 
          THEN
            APPL$XFR[0] = "NO"; 
          ELSE
            APPL$XFR[0] = "YES";
          IF NOT ATPRU[I] 
          THEN
            APPL$PRU[0] = "NO"; 
          ELSE
            APPL$PRU[0] = "YES";
          CTEMP = XCDD(ATMAXC[I]);        # CONVERT TO DISPLAY CODE    #
          APPL$MAXC[0] = C<8,2>CTEMP;     # ASSIGN TO MAXC ENTRY       #
          PGLST(LN1); 
          WRITEH(OUTFET,APPL$LN,11);       # WRITE APPLICATION LINE    #
          APPL$FIL[0] = " ";
          READW(LCFFET,APPL$TABLE,ATENTSZ,LCF$STAT);
          END 
 
        END 
 
      ELSE
        BEGIN                # APPL TABLE HAS NO ENTRIES               #
        READW(LCFFET,APPL$TABLE,1,LCF$STAT);             # READ -EOR-  #
        IF LCF$STAT NQ LOC(ATWORD[0])      # MAKE SURE -EOR- WAS READ  #
        THEN       #  EOR NOT READ #
          ERRMSG(ERMSG2,"APPLST");
        END   # ELSE #
 
      RETURN; 
      END  # APPLST PROC #
      CONTROL EJECT;
      PROC CPLLST;
      BEGIN 
*IF,DEF,IMS 
# 
**    CPLLST - COUPLER LISTER.
* 
*     S.M. ILMBERGER         81/10/27 
* 
*     PRINTS COUPLER INFO FROM PLINK$XREF TABLE 
* 
*     PROC CPLLST 
* 
*     ENTRY NONE
* 
*     EXIT  NONE
* 
*     MESSAGES     NONE 
* 
*     METHOD
* 
*     FOR EACH COUPLER ENTRY IN PLINK$XREF TABLE
*       IF THE CURRENT NPU NODE-ID MATCHES ENTRY NODE-ID
*         WRITE COUPLER HEADER TO OUTPUT FILE 
*         FORMAT AND WRITE COUPLER LINE TO OUTPUT FILE
*         CALL LLKLST 
*     END 
# 
*ENDIF
 
      DEF COUPLER # 0 #;     # LINK TYPE IS 0 IF LINK IS COUPLER       #
      DEF PRIM # 0 #;        # PRIMARY COUPLER                         #
 
      ITEM I;                # LOOP COUNTER                            #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      FOR I=ENTRY1 STEP 1 UNTIL (PLWC[ENTRY0]-1)/PLENTSZ
      DO
        BEGIN                # SEARCH PHYSICAL LINK TABLE              #
        IF PLTYPE[I] EQ COUPLER # IF ENTRY IS COUPLER AND NPU NODE     #
          AND PLNID1[I] EQ NODE$ID  # ID MATCHES                       #
        THEN
          BEGIN              # SET UP COUPLER LINE FOR OUTPUT          #
          CPL$NAM[0] = PLNAME[I]; 
          TEMP1 = PLHNID[I]; # CONVERT NODE NUMBER TO DISPLAY CODE     #
          TEMP2 = XCDD(TEMP1);
          CPL$NOD[0] = C<8,2>TEMP2; 
          CPL$HNA[0] = PLHNAME[I];
          IF PLLOC[I] EQ PRIM 
          THEN
            CPL$LOC[0] = "PRIMARY"; 
          ELSE
            CPL$LOC[0] = "SECOND";
          CPL$ID = PLHNID[I]; 
          PGLST(LN3); 
          WRITEH(OUTFET,CPL$HDR,6); 
          WRITEH(OUTFET,CPL$LN,6);
          CPL$FILL[0] = " ";
          WORD = (PLHNID[I] - 1) / 60; # COMPUTE WORD AND              #
          BIT = (PLHNID[I] - 1) - (60 * WORD);# BIT TO REFER TO#
          B<BIT,1>NODEMAP[WORD] = 1;
          LLKLST; 
          END 
 
        END  # I LOOP # 
 
      RETURN; 
      END   # CPLLST PROC # 
      CONTROL EJECT;
      PROC DEFLST;
      BEGIN 
*IF,DEF,IMS 
# 
**    DEFLST - DEFINE LISTER
* 
*     S.M. ILMBERGER         81/10/27 
* 
*     PRINTS DEFINES FROM DEFINE$TABLE
* 
*     PROC DEFLST 
* 
*     ENTRY NONE
* 
*     EXIT  NONE
* 
*     MESSAGES     NONE 
* 
*     METHOD
* 
*     CALLS PGLST TO PRINT PAGE HEADER
*     IF DEFINE$TABLE EMPTY 
*       WRITE NO DEFINES ON OUTPUT FILE 
*     IF DEFINE$TABLE NOT EMPTY 
*       WRITE DEFINE HEADER TO OUTPUT FILE
*       FOR EACH ENTRY IN DEFINE TABLE
*         FORMAT AND WRITE DEFINE LINE TO OUTPUT FILE 
*     END 
# 
*ENDIF
 
      ITEM DONE B;           # TRUE IF ALL DEFINES PROCESSED           #
      ITEM I;                # LOOP COUNTER                            #
      ITEM J;                # LOOP COUNTER                            #
      ITEM K;                # LOOP COUNTER                            #
      ITEM L;                # LOOP COUNTER                            #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      LST$TYP[0] = " DEFINES LIST  "; 
      PGLST(NEWPAGE); 
      IF DTWC[0] LQ 1        # NO DEFINES COMMANDS                     #
      THEN
        BEGIN 
        PGLST(LN2); 
        WRITEH(OUTFET,NO$DEF,6); # PRINT MESSAGE NO DEFINES            #
        END 
 
      ELSE
        BEGIN                # DEFINE COMMANDS EXIST                   #
        PGLST(LN2); 
        WRITEH(OUTFET,DEF$HDR,4);      # PRINT DEFINE LINE             #
        DONE = FALSE; 
        J = 1;
        FOR I=1 WHILE NOT DONE
        DO
          BEGIN              # FORMAT DEFINE LINE                      #
          DEF$LAB[0] = DEFNAME[J];
          IF DEFWCNT[J] LQ 11 
          THEN               # DEFINE STRING LESS THAN 10 WORDS LONG   #
            BEGIN 
            FOR K=0 STEP 1 UNTIL DEFWCNT[J]-1 
            DO
              DEF$STR[K] = DEFSTRNG[J+K+1]; 
            PGLST(LN1); 
            WRITEH(OUTFET,DEF$L,12); # WRITE DEFINE LINE               #
            DEF$TOTAL[0] = " "; 
            END 
 
          ELSE
            BEGIN            # DEFINE CONTENTS WILL NOT FIT ON ONE LINE#
            FOR K=0 STEP 1 UNTIL 9
            DO
              DEF$STR[K] = DEFSTRNG[J+K+1];   # FILL FIRST LINE # 
            PGLST(LN1); 
            WRITEH(OUTFET,DEF$L,12);
            DEF$TOTAL[0] = " "; 
            FOR K=10 STEP 10 UNTIL DEFWCNT[J] 
            DO
              BEGIN 
              DEF$STR[0] = " "; 
              FOR L=0 STEP 1 WHILE L LQ 9 
                AND L+K LQ DEFWCNT[J]-1 
              DO
                DEF$STR[L] = DEFSTRNG[J+K+L+1]; 
              PGLST(LN1); 
              WRITEH(OUTFET,DEF$L,12); # WRITE DEFINE LINE             #
              DEF$TOTAL[0] = " "; 
              END 
 
            END 
 
          J = DEFWCNT[J] + J + 1; 
          IF J GR DTWC[ENTRY0]
          THEN
            DONE = TRUE;
          END  # I LOOP # 
 
        END 
 
      RETURN; 
      END   # DEFLST PROC # 
      CONTROL EJECT;
      PROC DEVLST(TRMWORD); 
      BEGIN 
*IF,DEF,IMS 
# 
**    DEVLST - DEVICE LISTER
* 
*     S.M. ILMBERGER         81/10/27 
* 
*     PRINTS DEVICE INFO FROM LINE$RECORD 
* 
*     PROC DEVLST(TRMWORD)
* 
*     ENTRY        TRMWORD - INDEX OF FIRST WORD OF TERMINAL
*                            ENTRY IN LINE$RECORD 
* 
*     EXIT         NONE 
* 
*     MESSGES 
*     ABORT FROM DEVLST  -FN VAL NOT DEVIC FN 
* 
*     METHOD
* 
*     IF AT LEAST ONE DEVICE ENTRY EXISTS FOR THIS TERMINAL 
*       WRITE DEVICE HEADERS TO OUTPUT FILE 
*     FOR EACH DEVICE ENTRY ON THE TERMINAL 
*       SET DEVICE INFO FROM TERMINAL AND DEVICE ENTRY ITEMS
*       FOR EACH FNFV PAIR IN DEVICE ENTRY
*         SAVE EACH FN-VAL IN CORRESPONDING FV-VAL POSITION OF
*           DEVICE OUTPUT LINE
*       WRITE DEVICE LINES TO OUTPUT FILE 
*     END 
* 
# 
*ENDIF
 
      ITEM TRMWORD I;        #  FIRST WORD OF TERMINAL ENTRY           #
 
      DEF DT$CP # 3 #;       # DEVICE TYPE FOR CP                      #
      DEF DT$CR # 1 #;       # DEVICE TYPE FOR CR                      #
      DEF DT$AP # 6 #;       # DEVICE TYPE FOR AP                      #
      DEF DT$CON # 0 #;      # DEVICE TYPE FOR CON                     #
      DEF DT$LP # 2 #;       # DEVICE TYPE FOR LP                      #
      DEF DT$PL # 4 #;       # DEVICE TYPE FOR PL                      #
      DEF EIGHT # 8 #;       # LENGTH OF DEVICE LIST                   #
      DEF TWELVE # 12 #;     # LENGTH OF NEW DEVICE LIST               #
      DEF FOUR # 4 #;        # NUMBER OF PARITIES                      #
      DEF MAXFNDEV # 148 #;  # MAX DEVICE FN VALUE                     #
      DEF MXEBR # 3 #;       # MAXIMUM NUMBER OF EBR/ELR VALUES - 1    #
      DEF PRU$SIZE # 640 #;  # MULTIPLE TO CONVERT DBZ                 #
      DEF SDT$12 # 12 #;     # BEGINNING USER VALUE OF SDT             #
      DEF SDT$15 # 15 #;     # ENDING USER VALUE OF SDT                #
      DEF SUBT$3780 # 2 #;   # 3780 SUB-TIPTYPE NUMBER                 #
      DEF THREE # 3 #;       # NUMBER OF OUTPUT DEVICES AND            #
                             # SUB-DEVICE TYPES FOR LP DEV-TYPE        #
      DEF TT$BSC # 5 #;      # TIPTYPE NUMBER FOR BSC                  #
      DEF TT$HASP # 3 #;     # TIPTYPE NUMBER FOR HASP                 #
      DEF TT$MODE4 # 2 #;    # TIPTYPE NUMBER FOR MODE4                #
      DEF TT$12 # 12 #;      # TIPTYPE NUMBER FOR TT12                 #
      DEF TT$3270 # 15 #;    # TIPTYPE NUMBER FOR 3270                 #
      DEF TWO # 2 #;         # NUMBER OF ENTRIES IN TABLE              #
 
      ITEM I;                # LOOP COUNTER                            #
      ITEM J;                # LOOP COUNTER                            #
      ITEM LENGTH I;         # LENGTH OF ROOT NAME FOR DEVICE          #
      ITEM TEMPDLC I=0;      # TEMP STORAGE FOR DLC VALUE              #
      ITEM TEMPXBZ I=0;      # TEMP STORAGE FOR XBZ VALUE              #
      ITEM DEVWORD;          # WORD COUNT FOR TABLE                    #
 
      ARRAY TEMP$DBZ [0:0] S(1);
        BEGIN 
        ITEM TEMPDBZ1 I(00,44,08);  # MSB OF DBZ                       #
        ITEM TEMPDBZ2 I(00,52,08);  # LSB OF DBZ                       #
        ITEM TEMPDBZ3 I(00,44,16);  # MSB AND LSB OF DBZ               #
        ITEM TEMPDBZ  I(00,00,60) = [0];
        END 
 
      ARRAY DEV$TYPES [0:TWELVE] S(1);
        ITEM DEV$TYP C(00,00,04)=[" CON"," CR"," LP"," CP"," PL", 
                                  " "," AP"," "," "," "," ",
                                  " ", "DT12"]; 
      ARRAY FV$EBRS [0:MXEBR] S(1); 
        ITEM FV$EBR C(00,00,10) = ["NO","CR","LF","CL"];
 
      ARRAY FV$ELOS [0:TWO] S(1); 
        ITEM FV$ELO C(00,00,10) = [" ","EL","EB"];
 
      ARRAY FV$INS [0:TWO] S(1);
        ITEM FV$IN C(00,00,02) = ["KB","PT","BK"];
 
      ARRAY FV$OPS [0:THREE] S(1);
        ITEM FV$OP C(00,00,02) = ["PR","DI","PT"];
 
      ARRAY FV$PAS [0:FOUR] S(1); 
        ITEM FV$PA C(00,00,01) = ["Z","O","E","N","I"]; 
 
      ARRAY SDT$CRS [0:TWO] S(1); 
        ITEM SDT$CR C(00,00,02) = ["29","26"];
 
      ARRAY SDT$USR [SDT$12:SDT$15] S(1); 
        ITEM SDT$USER C(00,00,05) = ["SDT12","SDT13","SDT14","SDT15"];
 
      ARRAY SDT$LPS [0:THREE] S(1); 
        ITEM SDT$LP C(00,00,02) = ["A6","B6","A9"]; 
 
      ARRAY SDT$PLS [0:TWO] S(1); 
        ITEM SDT$PL C(00,00,04) = ["6BIT","8BIT"];
 
      ARRAY Y$N$S [0:TWO] S(1); 
        ITEM Y$N C(00,00,03) = ["NO","YES"];
 
      SWITCH FN$VAL 
         ERR    ,#  0 # ERR    ,#  1 # ERR    ,#  2 # ERR    ,#  3 #
         ERR    ,#  4 # ERR    ,#  5 # ERR    ,#  6 # ERR    ,#  7 #
         ERR    ,#  8 # ERR    ,#  9 # ERR    ,# 10 # ERR    ,# 11 #
         ERR    ,# 12 # ERR    ,# 13 # ERR    ,# 14 # ERR    ,# 15 #
         ERR    ,# 16 # ERR    ,# 17 # TST    ,# 18 # ERR    ,# 19 #
         HN     ,# 20 # ERR    ,# 21 # AUTOCON,# 22 # PRI    ,# 23 #
         UBL    ,# 24 # UBZ    ,# 25 # ABL    ,# 26 # DBL    ,# 27 #
         DBZ$MSB,# 28 # DBZ$LSB,# 29 # XBZ$MSB,# 30 # XBZ$LSB,# 31 #
         LK     ,# 32 # ERR    ,# 33 # TST    ,# 34 # PW     ,# 35 #
         PL     ,# 36 # PG     ,# 37 # CN     ,# 38 # BS     ,# 39 #
         CT     ,# 40 # AB     ,# 41 # B1     ,# 42 # B2     ,# 43 #
         CI     ,# 44 # LI     ,# 45 # ERR    ,# 46 # ERR    ,# 47 #
         SE     ,# 48 # EP     ,# 49 # PA     ,# 50 # BR     ,# 51 #
         TST    ,# 52 # IN     ,# 53 # OP     ,# 54 # FA     ,# 55 #
         ERR    ,# 56 # DLC$MSB,# 57 # DLC$LSB,# 58 # DLX    ,# 59 #
         DLTO   ,# 60 # ELX    ,# 61 # ELO    ,# 62 # ELR    ,# 63 #
         EBX    ,# 64 # EBO    ,# 65 # EBR    ,# 66 # IC     ,# 67 #
         OC     ,# 68 # XLY    ,# 69 # ERR    ,# 70 # CP     ,# 71 #
         TST    ,# 72 # TST    ,# 73 # TST    ,# 74 # TST    ,# 75 #
         SDT    ,# 76 # TST    ,# 77 # TST    ,# 78 # TST    ,# 79 #
         DO1    ,# 80 # ERR    ,# 81 # ERR    ,# 82 # ERR    ,# 83 #
         ERR    ,# 84 # ERR    ,# 85 # ERR    ,# 86 # ERR    ,# 87 #
         TST    ,# 88 # ERR    ,# 89 # TST    ,# 90 # TST    ,# 91 #
         TST    ,# 92 # TST    ,# 93 # TST    ,# 94 # TST    ,# 95 #
         TST    ,# 96 # TST    ,# 97 # TST    ,# 98 # TST    ,# 99 #
         ERR    ,#100 # ERR    ,#101 # MC     ,#102 # ERR    ,#103 #
         ERR    ,#104 # ERR    ,#105 # ERR    ,#106 # ERR    ,#107 #
         ERR    ,#108 # ERR    ,#109 # ERR    ,#110 # TST    ,#111 #
         ERR    ,#112 # TST    ,#113 # TST    ,#114 # TST    ,#115 #
         TST    ,#116 # TST    ,#117 # TST    ,#118 # TST    ,#119 #
         TST    ,#120 # TST    ,#121 # TST    ,#122 # TST    ,#123 #
         TST    ,#124 # TST    ,#125 # TST    ,#126 # TST    ,#127 #
         TST    ,#128 # TST    ,#129 # TST    ,#130 # TST    ,#131 #
         TST    ,#132 # TST    ,#133 # TST    ,#134 # TST    ,#135 #
         TST    ,#136 # TST    ,#137 # TST    ,#138 # TST    ,#139 #
         TST    ,#140 # TST    ,#141 # TST    ,#142 # TST    ,#143 #
         TST    ,#144 # RTS    ,#145 # TST    ,#146 # MCI    ,#147 #
         MLI    ;#148 # 
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      IF TEWC[TRMWORD] GR 2 
      THEN                   # AT LEAST 1 DEVICE ENTRY EXISTS          #
        BEGIN 
        PGLST(LN3); 
        WRITEH(OUTFET,DEV$HDR1,13); # WRITE DEVICE HEADERS             #
        WRITEH(OUTFET,DEV$HDR2,13); 
        WRITEH(OUTFET,DEV$HDR3,13); 
        END 
 
      FOR DEVWORD=TRMWORD+2 WHILE DEVWORD-TRMWORD+1 LQ TEWC[TRMWORD]
      DO                     # STEP THRU DEVICE ENTRY IN LINE RECORD   #
        BEGIN 
        IF LINREC$GC EQ 0    # NOT A GROUP STATEMENT                   #
        THEN
          BEGIN 
          DEV$NAM[0] = DENAME[DEVWORD+1]; #  SET DEVICE NAME           #
          END 
        ELSE                 # DEVICE IS PART OF GROUP STATEMENT       #
          BEGIN 
          LENGTH = 0; 
          FOR I=0 STEP 1 UNTIL 6       # FIND LENGTH OF ROOT NAME      #
          DO
            BEGIN 
            IF C<I,1>DENAME[DEVWORD+1] NQ " " # NAME IS LEFT JUSTIFIED #
            THEN
              BEGIN 
              LENGTH = LENGTH + 1;
              END 
            END 
          TEMP2 = XCHD(PORTNUM);
          C<0,LENGTH>DEV$NAM[0] = DENAME[DEVWORD+1];
          IF C<8,1>TEMP2 EQ " " 
          THEN
            C<8,1>TEMP2 = "0";
          C<LENGTH,2>DEV$NAM[0] = C<8,2>TEMP2;
          END 
        DEV$DT[0] = DEV$TYP[DEDT[DEVWORD+2]]; # SET DEVICE TYPE        #
        DEV$PRI[0] = "NO";
        DEV$ACON[0] = "NO"; 
        WORD = DEVWORD + 2; 
        BIT = 24; 
        FOR J=1 STEP 1 UNTIL DEFNFV[DEVWORD+1]
        DO
          BEGIN              # GET NEXT FN-FV PAIR FROM DEVICE ENTRY OF#
          IF BIT+16 LQ 60    # LINE RECORD                             #
          THEN               #  WHOLE FNFV PAIR FITS IN THIS WORD      #
            BEGIN 
            FNFV$ENT[0] = B<BIT,16>LRWORD[WORD];
            IF BIT+16 LS 60 
            THEN
              BIT = BIT + 16; 
            ELSE
              BEGIN          # BIT +16 = 60                            #
              BIT = 0;
              WORD = WORD + 1;
              END 
 
            END 
 
          ELSE               # FN-FV PAIR OVERLAPS NEXT WORD           #
            BEGIN            # BIT + 16 GR 60                          #
            B<0,60-BIT>FNFV$ENT[0] = B<BIT,60-BIT>LRWORD[WORD]; 
            B<60-BIT,BIT+16-60>FNFV$ENT[0] =
                B<0,BIT+16-60>LRWORD[WORD+1]; 
            WORD = WORD + 1;
            BIT = BIT + 16 - 60;
            END 
 
          IF FN$ENT[0] GR MAXFNDEV
          THEN               # FN VALUE TO LARGE                       #
            ERRMSG(ERMSG5,"DEVLST");
 
          GOTO FN$VAL[FN$ENT[0]];  # SAVE INFO IN OUTPU DEVICE LINE FOR#
                             # EACH PARAMETER SPECIFIED ON INPUT LINE  #
ERR:  
          ERRMSG(ERMSG5,"DEVLST");
 
TST:  
          TEST J; 
 
DBL:                         # FNFV PAIR IS DBL-SET INFO IN DEVICE LINE#
          TEMP1 = FV$ENT[0];
          TEMP2 = XCDD(TEMP1);         # CONVERT TO DISPLAY            #
          DEV$DBL[0] = C<9,1>TEMP2; 
          TEST J; 
 
PW:                          # SET PAGE WIDTH                          #
          TEMP1 = FV$ENT[0];
          TEMP2 = XCDD(TEMP1);      # CONVERT PW VALUE TO DISPLAY CODE #
          DEV$PW[0] = C<7,3>TEMP2;
          TEST J; 
 
PL: 
          TEMP1 = FV$ENT[0];
          TEMP2 = XCDD(TEMP1);      # CONVERT PL VALUE TO DISPLAY CODE #
          DEV$PL[0] = C<7,3>TEMP2;
          TEST J; 
 
CN: 
          TEMP1 = FV$ENT[0];
          TEMP2 = XCHD(TEMP1);      # CONVERT CN VALUE TO DISPLAY CODE #
          DEV$CN[0] = C<8,2>TEMP2;
          TEST J; 
 
BS: 
          TEMP1 = FV$ENT[0];
          TEMP2 = XCHD(TEMP1);      # CONVERT BS VALUE TO DISPLAY CODE #
          DEV$BS[0] = C<8,2>TEMP2;
          TEST J; 
 
CT: 
          TEMP1 = FV$ENT[0];
          TEMP2 = XCHD(TEMP1);      # CONVERT CT VALUE TO DISPLAY CODE #
          DEV$CT[0] = C<8,2>TEMP2;
          TEST J; 
 
CI: 
          TEMP1 = FV$ENT[0];
          TEMP2 = XCDD(TEMP1);      # CONVERT CI VALUE TO DISPLAY CODE #
          DEV$CI[0] = C<8,2>TEMP2;
          TEST J; 
 
LI: 
          TEMP1 = FV$ENT[0];
          TEMP2 = XCDD(TEMP1);      # CONVERT LI VALUE TO DISPLAY CODE #
          DEV$LI[0] = C<8,2>TEMP2;
          TEST J; 
 
SE:                                 # SET SI VALUE TO YES OR NO        #
          DEV$SE[0] = Y$N[FV$ENT[0]]; 
          TEST J; 
 
CP:                                 # SET CP VALUE TO YES OR NO        #
          DEV$CP[0] = Y$N[FV$ENT[0]]; 
          TEST J; 
 
ELX:  
          TEMP1 = FV$ENT[0];
          TEMP2 = XCHD(TEMP1);      # CONVERT ELX VALUE TO DISPLY CODE #
          DEV$ELX[0] = C<8,2>TEMP2; 
          TEST J; 
 
ELO:  
          DEV$ELO[0] = FV$ELO[FV$ENT[0]]; 
          TEST J; 
 
ELR:  
          DEV$ELR[0] = FV$EBR[FV$ENT[0]]; 
          TEST J; 
 
EBX:  
          TEMP1 = FV$ENT[0];
          TEMP2 = XCHD(TEMP1);      # CONVERT EBX VALUE TO DISPLY CODE #
          DEV$EBX[0] = C<8,2>TEMP2; 
          TEST J; 
 
EBO:  
          DEV$EBO[0] = FV$ELO[FV$ENT[0]]; 
          TEST J; 
 
EBR:  
          DEV$EBR[0] = FV$EBR[FV$ENT[0]]; 
          TEST J; 
 
FA: 
          DEV$FA[0] = Y$N[FV$ENT[0]]; 
          TEST J; 
 
IC: 
          DEV$IC[0] = Y$N[FV$ENT[0]]; 
          TEST J; 
 
OC: 
          DEV$OC[0] = Y$N[FV$ENT[0]]; 
          TEST J; 
 
RTS:      DEV$RTS[0] = Y$N[FV$ENT[0]];
          TEST J; 
MCI:  
          TEMP1 = FV$ENT[0];
          TEMP2 = XCDD(TEMP1);         # CONVERT TO DISPLAY            #
          DEV$MCI[0] = C<7,3>TEMP2; 
          TEST J; 
 
MLI:  
          TEMP1 = FV$ENT[0];
          TEMP2 = XCDD(TEMP1);         # CONVERT TO DISPLAY            #
          DEV$MLI[0] = C<7,3>TEMP2; 
          TEST J; 
 
LK: 
          DEV$LK[0] = Y$N[FV$ENT[0]]; 
          TEST J; 
 
DLC$MSB:                            # SAVE FIRST HALF OF DLC           #
          B<44,8>TEMPDLC = FV$ENT[0]; 
          TEST J; 
 
DLC$LSB:                            # SECOND HALF OF DLC               #
          B<52,8>TEMPDLC = FV$ENT[0]; 
          TEMP2 = XCDD(TEMPDLC);
          DEV$DLC[0] = C<6,4>TEMP2; 
          TEST J; 
 
DLX:  
          TEMP1 = FV$ENT[0];
          TEMP2 = XCHD(TEMP1);
          DEV$DLX[0] = C<8,2>TEMP2; # STORE DLX VALUE IN DEV OUTPUT LIN#
          TEST J; 
 
DLTO: 
          DEV$DLTO[0] = Y$N[FV$ENT[0]]; # SAVE DLTO VAL IN DEV OUTPUT  #
          TEST J; 
 
IN: 
          DEV$IN[0] = FV$IN[FV$ENT[0]]; 
          TEST J; 
 
OP: 
          DEV$OP[0] = FV$OP[FV$ENT[0]]; 
          TEST J; 
 
EP: 
          DEV$EP[0] = Y$N[FV$ENT[0]]; 
          TEST J; 
 
PG: 
          DEV$PG[0] = Y$N[FV$ENT[0]]; 
          TEST J; 
 
PA: 
          DEV$PA[0] = FV$PA[FV$ENT[0]]; 
          TEST J; 
 
AB: 
          TEMP1 = FV$ENT[0];
          TEMP2 = XCHD(TEMP1);
          DEV$AB[0] = C<8,2>TEMP2;
          TEST J; 
 
B1: 
          TEMP1 = FV$ENT[0];
          TEMP2 = XCHD(TEMP1);
          DEV$B1[0] = C<8,2>TEMP2;
          TEST J; 
 
B2: 
          TEMP1 = FV$ENT[0];
          TEMP2 = XCHD(TEMP1);
          DEV$B2[0] = C<8,2>TEMP2;
          TEST J; 
 
HN: 
          TEMP1 = FV$ENT[0];
          TEMP2 = XCDD(TEMP1);
          DEV$HN[0] = C<8,2>TEMP2;
          TEST J; 
 
 
AUTOCON:  
          DEV$ACON[0] = Y$N[FV$ENT[0]]; 
          TEST J; 
 
XBZ$MSB:  
          B<44,8>TEMPXBZ = FV$ENT[0]; 
          TEST J; 
 
XBZ$LSB:  
          B<52,8>TEMPXBZ = FV$ENT[0]; 
          TEMP2 = XCDD(TEMPXBZ);
          DEV$XBZ[0] = C<6,4>TEMP2; 
          TEST J; 
 
SDT:  
          IF FV$ENT[0] GQ SDT$12   # IF USER VALUE IS USED             #
          THEN
            BEGIN 
            DEV$SDT[0] = SDT$USER[FV$ENT[0]];  # SET USER VALUE        #
            END 
          ELSE
            BEGIN 
            IF DEDT[DEVWORD+2] EQ DT$LP  # IF PRINTER DEVICE           #
            THEN
              BEGIN 
              DEV$SDT[0] = SDT$LP[FV$ENT[0]]; 
              END                   # SET PRINTER VALUE                #
            ELSE
              BEGIN 
              IF DEDT[DEVWORD+2] EQ DT$CR  # IF CARD READER DEVICE     #
              THEN
                BEGIN 
                DEV$SDT[0] = SDT$CR[FV$ENT[0]];  # SET CR VALUE        #
                END 
              ELSE
                BEGIN 
                IF DEDT[DEVWORD+2] EQ DT$PL  # IF PLOTTER DEVICE       #
                THEN
                  BEGIN 
                  DEV$SDT[0] = SDT$PL[FV$ENT[0]]; 
                  END 
                END 
              END 
            END 
          TEST J; 
 
 
UBZ:  
          IF C<0,2>LN$TIPT[0] NQ "TT"      # IF NOT USER-DEFN TIPTYP   #
          THEN
            BEGIN 
            TEMP1 = FV$ENT[0];
            IF DEV$DT[0] EQ DEV$TYP[DT$CON] # IF ACTIVE DEVICE TYPE    #
            THEN
              TEMP2 = XCDD(TEMP1*UBZ$CON); # ACTIVE DEVICE MULTIPLIER  #
            ELSE
              TEMP2 = XCDD(TEMP1*PRU$SZ);  # PASSIVE DEVICE MULTIPLIER #
            END 
          ELSE
            BEGIN                          # USER DEFINED TIPTYPE      #
            TEMP2 = XCDD(FV$ENT[0]);
            END 
          DEV$UBZ[0] = C<6,4>TEMP2; 
          TEST J; 
 
DBZ$MSB:  
         IF C<0,2>LN$TIPT[0] EQ "TT" OR 
            C<0,2>DEV$DT[0] EQ "DT" OR
            DEV$DT[0] EQ DEV$TYP[DT$CON] OR 
            DEV$DT[0] EQ DEV$TYP[DT$AP] 
         THEN 
           BEGIN
           TEMPDBZ1[0] = FV$ENT[0]; 
           END
          TEST J; 
 
DBZ$LSB:  
         IF C<0,2>LN$TIPT[0] EQ "TT" OR 
            C<0,2>DEV$DT[0] EQ "DT" OR
            DEV$DT[0] EQ DEV$TYP[DT$CON] OR 
            DEV$DT[0] EQ DEV$TYP[DT$AP] 
         THEN 
           BEGIN
           TEMPDBZ2[0] = FV$ENT[0]; 
           END
         ELSE 
           BEGIN
           TEMPDBZ3[0] = PRU$SIZE*FV$ENT[0];
           END
          TEMP2 = XCDD(TEMPDBZ[0]); 
          DEV$DBZ[0] = C<6,4>TEMP2; 
          TEMPDBZ[0] = 0; 
          TEST J; 
 
ABL:  
          TEMP1 = FV$ENT[0];
          TEMP2 = XCDD(TEMP1);
          DEV$ABL[0] = C<9,1>TEMP2; 
          TEST J; 
 
DO1:  
          TEMP1 = FV$ENT[0];
          TEMP2 = XCDD(TEMP1);
          DEV$DO[0] = C<9,1>TEMP2;
          TEST J; 
 
BR: 
          DEV$BR[0] = Y$N[FV$ENT[0]]; 
          TEST J; 
 
UBL:  
          TEMP1 = FV$ENT[0];
          TEMP2 = XCDD(TEMP1);
          DEV$UBL[0] = C<8,2>TEMP2; 
          TEST J; 
 
PRI:  
          DEV$PRI[0] = Y$N[FV$ENT[0]];
          TEST J; 
 
XLY:  
          TEMP2 = XCHD(FV$ENT[0]);
          DEV$XLY[0] = C<8,2>TEMP2; 
          TEST J; 
 
MC: 
          TEMP2 = XCHD(FV$ENT[0]);
          DEV$MC[0] = C<8,2>TEMP2;
 
          END  # J LOOP # 
 
        IF TETP[TRMWORD+1] EQ TT$MODE4   # IF TIPTYPE = MODE4          #
        OR (TETP[TRMWORD+1] GQ TT$12 AND TETP[TRMWORD+1] LQ TT$3270)
        THEN                             # OR USER TIPTYPES            #
          BEGIN 
          TEMP1 = DEA2[DEVWORD+2];
          TEMP2 = XCHD(TEMP1);
          DEV$TA[0] = C<8,2>TEMP2; #  SET TERMINAL ADDRESS IN DEV OUTPT#
          END                      # LINE                              #
 
        IF TETP[TRMWORD+1] EQ TT$HASP    # IF TIPTYPE = HASP           #
        THEN
          BEGIN 
          TEMP1 = DEA2[DEVWORD+2];
          TEMP2 = XCDD(TEMP1);
          DEV$STR[0] = C<9,1>TEMP2;     # SET STREAM VAL IN DEV OUTPUT #
          END                           # LINE                         #
 
        IF TETP[TRMWORD+1] EQ TT$BSC # IF TIPTYPE IS BSC AND SUBTIP IS #
        THEN                        # 3780 AND DEVICE TYPE IS CP THEN  #
          BEGIN                     # SET TERMINAL ADDRESS             #
          IF TESTIP[TRMWORD+1] EQ SUBT$3780 
            AND DEDT[DEVWORD+2] EQ DT$CP
          THEN
            BEGIN 
            TEMP1 = DEA2[DEVWORD+2];
            TEMP2 = XCDD(TEMP1);
            DEV$TA[0] = C<8,2>TEMP2;
            END 
 
          END 
 
        IF DEST[DEVWORD+2]          # SET DEVICE STATUS                #
        THEN
          DEV$STAT[0] = "DI"; 
        ELSE
          DEV$STAT[0] = "EN"; 
        DEVWORD = DEVWORD + DEWC[DEVWORD];
        PGLST(LN4); 
        WRITEH(OUTFET,DEV$LN1,13);  # WRITE DEVICE LINES TO OUTPUT FILE#
        WRITEH(OUTFET,DEV$LN2,13);
        WRITEH(OUTFET,DEV$LN3,13);
        DEV1$FIL[0] = " ";
        DEV2$FIL[0] = " ";
        DEV3$FIL = " "; 
        END  # DEVWORD LOOP # 
 
      RETURN; 
      END   # DEVLST PROC # 
      CONTROL EJECT;
      PROC ERRLST;
      BEGIN 
*IF,DEF,IMS 
# 
**    ERRLST - ERROR LISTER 
* 
*     S.M. ILMBERGER         81/10/28 
* 
*     PRODUCES ERROR LISTING
* 
*     PROC ERRLST 
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGE      NONE 
* 
*     METHOD
* 
*     SET UP ERROR-2-FET
*     FILL ERR-2-BUFFER 
*     SET UP ERROR-1-FET
*     FILL ERR-1-BUFFER 
*     UNTIL ALL OF ERR-1-BUFFER AND ERR-2-BUFFER ARE DONE 
*       GET THE ERROR WITH THE LOWEST LINE NUMBER FROM
*         ERROR-1-BUFFER OR ERR-2-BUFFER
*         FORMAT ERROR-LINE 
*         WRITE ERROR-LINE TO OUTPUT FILE 
*         READ NEXT ERROR 
*     END 
# 
*ENDIF
 
      DEF NONE # -1 #;       # VALUE OF LINE NUMBER FOR THE CASE WHERE
                               THERE IS NO LINE NUMBER BINDING         #
      DEF NONE$WRD # " NONE" #;  # WORD OUTPUT FOR THE NO LINE NUMBER 
                                 BINDING CASE.                         #
      ITEM E1DONE B;         # SET IF ALL OF ERROR-FILE-1 IS PROCESSED #
      ITEM E2DONE B;         # SET IF ALL OF ERROR-FILE-2 IS PROCESSED #
      ITEM ER1$STAT;         # STATUS OF A READ                        #
      ITEM ER2$STAT;         # STATUS OF A READ                        #
      ITEM I;                # LOOP COUNTER                            #
 
      ARRAY ERR$LINE [0:0] S(11); 
        BEGIN 
        ITEM E$LINE I(00,06,30);
        ITEM E$NUM C(00,54,03);        # ERROR NUMBER                  #
        ITEM E$TYPE C(01,54,01);       # TYPE OF ERROR "F" OR "W"      #
        ITEM E$DETL C(02,30,11);       # ERROR DETAIL WORD             #
        ITEM E$MSG C(03,54,71);        # ERROR MESSAGE                 #
        ITEM E$FIL C(00,00,110) = [" "];
        END 
 
      ARRAY ERR$TAB1 [0:0] S(2);
        BEGIN 
        ITEM E1$CODE I(00,00,12);     # ERROR CODE                    # 
        ITEM E1$LINE I(00,12,18);      # LINE NUMBER                   #
        ITEM E1$CWRD C(01,00,10);      # CLARIFIER WORD                #
        END 
 
      ARRAY ERR$TAB2 [0:0] S(2);
        BEGIN 
        ITEM E2$CODE I(00,00,12);      # ERROR CODE                    #
        ITEM E2$LINE I(00,12,18);      # LINE NUMBER                   #
        ITEM E2$CWRD C(01,00,10);      # CLARIFIER WORD                #
        END 
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      LST$TYP[0] = " ERROR LISTING "; 
      PGLST(NEWPAGE); 
      E2FIRST[0] = LOC(E2WBWORD[0]);
      E2OUT[0] = LOC(E2WBWORD[0]);   # SET UP  PASS 2 ERROR FILE       #
      E2IN[0] = LOC(E2WBWORD[0]); 
      E2LIMIT[0] = LOC(E2WBWORD[0]) + PRULNGTH + 1; 
      REWIND(ERR2FET);
      READ(ERR2FET);
      RECALL(ERR2FET);
 
      E1FIRST[0] = LOC(E1WBWORD[0]); # SET UP PASS 1 ERROR FILE        #
      E1OUT[0] = LOC(E1WBWORD[0]);
      E1IN[0] = LOC(E1WBWORD[0]); 
      E1LIMIT[0] = LOC(E1WBWORD[0]) + PRULNGTH + 1; 
      REWIND(ERR1FET);
      READ(ERR1FET);
      RECALL(ERR1FET);
 
      PGLST(LN3); 
      WRITEH(OUTFET,ERR$HDR,5);      #  WRITE ERROR HEADER             #
      E1DONE = FALSE; 
      E2DONE = FALSE; 
      READW(ERR1FET,ERR$TAB1,2,ER1$STAT);# READ PASS 1 AND 2 ERR FILES #
      READW(ERR2FET,ERR$TAB2,2,ER2$STAT); 
      IF ER1$STAT NQ TRNS$OK OR E1$LINE[0] EQ 0 
      THEN                # CK IF ERROR FILE-1 EMPTY                   #
        E1DONE = TRUE;
      IF ER2$STAT NQ TRNS$OK OR E2$LINE[0] EQ 0 
      THEN                # CK IF ERROR FILE-2 EMPTY                   #
        E2DONE = TRUE;
      FOR I=0 WHILE (NOT (E1DONE) OR NOT (E2DONE))
      DO         # PRINT ERROR INFO UNTIL BOTH ERROR FILE-1 AND ERROR  #
        BEGIN    # FILE-2 ARE DONE                                     #
        IF (NOT E1DONE AND NOT E2DONE)
        THEN     # ERROR FILE 1 AND 2 ARE NOT DONE                     #
          BEGIN 
          IF E1$LINE[0] LQ E2$LINE[0] 
          THEN
            GOTO E$1;    # GET NEXT ERROR FROM ERROR FILE-1            #
          ELSE
            GOTO E$2;    # GET NEXT ERROR FROM ERROR FILE-1            #
          END 
 
        ELSE
          BEGIN 
          IF (E1DONE AND NOT E2DONE)
          THEN           # ERROR FILE 1 IS DONE BUT NOT ERROR FILE 2   #
            GOTO E$2; 
          ELSE
            BEGIN 
            IF (NOT E1DONE AND E2DONE)
            THEN         # ERROR FILE 2 IS DONE BUT NOT ERROR FILE 1   #
              GOTO E$1; 
            END 
 
          END 
 
          TEST I; 
 
E$1:  
            TEMP1 = E1$LINE[0];        # SET UP AND WRITE ERROR MESSAGE#
            TEMP2 = XCDD(TEMP1);       # FROM PASS 1 ERROR FILE        #
            E$LINE[0] = C<5,5>TEMP2;
            TEMP1 = E1$CODE[0]; 
            TEMP2 = XCDD(TEMP1);
            E$NUM[0] = C<7,3>TEMP2; 
            E$DETL[0] = E1$CWRD[0]; 
            E$TYPE[0] = EMTTYPE[E1$CODE[0]];
            E$MSG[0] = EMTMSG[E1$CODE[0]];
            PGLST(LN1); 
            WRITEH(OUTFET,ERR$LINE,11); 
            E$FIL[0] = " "; 
            READW(ERR1FET,ERR$TAB1,2,ER1$STAT); 
            IF ER1$STAT NQ TRNS$OK OR E1$LINE[0] EQ 0 
            THEN
              E1DONE = TRUE;
            TEST I; 
E$2:  
            IF E2$LINE[0] EQ NONE      # IF NO LINE NUMBER BINDING     #
            THEN
              BEGIN 
              E$LINE[0] = NONE$WRD;    # ASSIGN NONE TO LINE NUMBER    #
              END 
            ELSE
              BEGIN 
              TEMP1 = E2$LINE[0];      # SET UP AND WRITE ERROR MESSAGE#
              TEMP2 = XCDD(TEMP1);     # FROM PASS 2 ERROR FILE        #
              E$LINE[0] = C<5,5>TEMP2;
              END 
            TEMP1 = E2$CODE[0]; 
            TEMP2 = XCDD(TEMP1);
            E$NUM[0] = C<7,3>TEMP2; 
            E$DETL[0] = E2$CWRD[0]; 
            E$TYPE[0] = EMT2TYPE[E2$CODE[0]]; 
            E$MSG[0] = EMT2MSG[E2$CODE[0]]; 
            PGLST(LN1); 
            WRITEH(OUTFET,ERR$LINE,11); 
            E$FIL[0] = " "; 
            READW(ERR2FET,ERR$TAB2,2,ER2$STAT); 
            IF ER2$STAT NQ TRNS$OK OR E2$LINE[0] EQ 0 
            THEN
              E2DONE = TRUE;
            TEST I; 
        END  # I LOOP # 
 
      RETURN; 
      END  # ERRLST PROC #
      CONTROL EJECT;
      PROC ERRMSG(ENUM,EPRC); 
      BEGIN 
*IF,DEF,IMS 
# 
**    ERRMSG - PRINT ERROR MESSAGE
* 
*     S.M. ILMBERGER         81/10/29 
* 
*     WRITE DAYFILE ERROR MESSAGE 
* 
*     PROC ERRMSG(ENUM,EPRC)
* 
*     ENTRY        ENUM - SPECIFIES ERROR MESSAGE 
*                  EPRC - PROC NAME ERROR OCCURED IN
* 
*     EXIT         NONE 
* 
*     MESSAGES
*     ABORT FROM XXXXXXX - NO SUCH RECORD TYPE
*     ABORT FROM XXXXXXX - READ ERROR 
*     ABORT FROM XXXXXXX - BAD NCF FILE RECORD
*     ABORT FROM XXXXXXX - INVALID RECORD TYPE
*     ABORT FROM XXXXXXX - FN VAL NOT DEVIC FN
*     ABORT FROM XXXXXXX - CAN'T READ LIN RECDS 
*     ABORT FROM XXXXXXX - CAN'T READ NCF RECDS 
*     ABORT FROM XXXXXXX - FN VAL NOT LINE FN 
*     ABORT FROM XXXXXXX - FN VAL NOT TERM FN 
* 
*     METHOD
* 
*     PUT PROC NAME IN ERROR MESSAGE
*     ISSUE DAYFILE ERROR MESSAGE 
*     ABORT 
*     END 
* 
# 
*ENDIF
 
      ITEM ENUM          I;  # ERROR NUMBER                            #
      ITEM EPRC          C(8); # PROC ERROR OCCURED IN                 #
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      EMPROC[ENUM] = EPRC;
      MESSAGE(EM$ENT[ENUM],0);       # WRITE ERROR MESSAGE IN DAYFILE  #
      ABORT;
      RETURN; 
      END   # ERRMSG PROC # 
      CONTROL EJECT;
      PROC EXSLST;
      BEGIN 
*IF,DEF,IMS 
# 
**    EXSLST - EXPANDED SOURCE LISTER 
* 
*     S.M. ILMBERGER         81/10/28 
* 
*     PRODUCES EXPANDED SOURCE LISTING
* 
*     PROC EXSLST 
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGE      NONE 
* 
*     METHOD
* 
*     SET UP ERROR-2-FET
*     FILL ERROR-2-BUFFER 
*     SET UP SECONDARY-INPUT-FET
*     FILL SEC-INP-BUFFER 
*     SET UP EXPANDED-SECONDARY-INPUT-FET 
*     FILL EXP-SEC-INP-BUFFER 
*     WRITE SOURCE HEADER TO OUTPUT FILE
*     FOR EACH LINE IN SEC-INP-BUFFER 
*       IF SEC-INP-LINE CONTAINS A DEFINE 
*         REPLACE IT WITH EXP-SEC-INP-LINE
*         READ THE NEXT EXP-SEC-INP-LINE
*       IF SEC-INP-LINE NUMBER MATCHES NEXT ERROR-LINE NUMBER 
*         FLAG SEC-INP-LINE WITH ERROR FLAG 
*         READ NEXT ERROR-LINE FROM ERROR-2-FET 
*       WRITE SEC-INP-LINE TO OUTPUT FILE 
*       READ NEXT SEC-INP-LINE
*     END 
* 
# 
*ENDIF
 
      ITEM DEFDONE B;        # SET IF ALL DEFINES PROCESSED            #
      ITEM ESI$STAT I;       # STATUS OF READ ON ESI$BUFFER            #
      ITEM ER2DONE B;        # SET IF ALL PASS 2 ERRORS PROCESSED      #
      ITEM ER$STAT;          # STATUS OF A READ                        #
      ITEM I;                # LOOP COUNTER                            #
      ITEM J;                # LOOP COUNTER                            #
      ITEM LONG$DEF B;       # TRUE IF DEFINE MADE ESIBUFF LONGER      #
                             # THAN 140 CHARACTERS                     #
 
      ARRAY ERR2 [0:0] S(2);
        BEGIN 
        ITEM E2$CD U(00,00,12);# ERROR CODE                            #
        ITEM E2$LN U(00,12,18); # LINE NUMBER                          #
        ITEM E2$CW C(01,00,10);# CLARIFIER WORD                        #
        END 
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      LST$TYP[0] = "EXPANDED SOURCE"; 
      PGLST(NEWPAGE); 
 
      E2FIRST[0] = LOC(E2WBWORD[0]); # SET UP PASS 2 ERROR FILE        #
      E2OUT[0] = LOC(E2WBWORD[0]);
      E2IN[0] = LOC(E2WBWORD[0]); 
      E2LIMIT[0] = LOC(E2WBWORD[0]) + PRULNGTH + 1; 
      REWIND(ERR2FET);
      READ(ERR2FET);                 # FILL CIO BUFFER                 #
      RECALL(ERR2FET);
 
      SECFIRST[0] = LOC(SECWORD[0]); # SET UP SECONDARY INPUT FILE     #
      SECIN[0] = LOC(SECWORD[0]); 
      SECOUT[0] = LOC (SECWORD[0]); 
      SECLIMIT[0] = LOC(SECWORD[0]) + PRULNGTH + 1; 
      REWIND(SECFET); 
      READ(SECFET);                  # FILL CIO BUFFER                 #
      RECALL(SECFET); 
 
      ESIFIRST[0] = LOC(ESIWORD[0]); # SET UP EXPANDED SECONDARY INPUT #
      ESIIN[0] = LOC(ESIWORD[0]);    # FILE                            #
      ESIOUT[0] = LOC(ESIWORD[0]);
      ESILIMIT[0] = LOC(ESIWORD[0]) + PRULNGTH + 1; 
      REWIND(ESIFET); 
      READ(ESIFET);                  # FILL CIO BUFFER                 #
      RECALL(ESIFET); 
 
      PGLST(LN3); 
      WRITEH(OUTFET,SOURCE$HDR,2);
 
      DEFDONE = FALSE;
      ER2DONE = FALSE;
      READW(ERR2FET,ERR2,2,ER$STAT); # READ ERROR 2 FILE               #
      IF ER$STAT NQ TRNS$OK OR E2$LN[0] EQ 0
      THEN
        ER2DONE = FALSE;
      READH(ESIFET,ESI$BUFFER,14,ESI$STAT);# READ EXP-SECND INPUT FILE #
      READH(SECFET,OUTPT$BUFFER,14,STMT$STAT);# READ SECOND INPUT FILE #
      FOR I=0 WHILE STMT$STAT EQ TRNS$OK
      DO
        BEGIN 
        LONG$DEF = FALSE; 
        IF OUTDLINE[0] EQ "D" 
        THEN
          BEGIN 
          OUTBUFF1[0] = ESIBUFF[0]; 
          READH(ESIFET,ESI$BUFFER,14,ESI$STAT); 
          IF ESI$DEF[0] NQ "D"
          THEN
            LONG$DEF = TRUE;
          END 
 
        IF NOT ER2DONE
        THEN
          BEGIN 
          TEMP1 = E2$LN[0]; 
          TEMP2 = XCDD(TEMP1);
          IF C<5,5>TEMP2 EQ OUTLNUM[0]
          THEN
            BEGIN 
            OUTELINE[0] = "***";
            READW(ERR2FET,ERR2,2,ER$STAT);
            IF ER$STAT NQ TRNS$OK OR E2$LN[0] EQ 0
            THEN
              ER2DONE = TRUE; 
            TEMP1 = E2$LN[0]; 
            TEMP2 = XCDD(TEMP1);
            IF OUTLNUM[0] EQ C<5,5>TEMP2   # SEE IF 2 OR MORE ERRORS   #
            THEN             # ON SAME LINE                            #
              BEGIN 
              FOR J=0 WHILE (OUTLNUM[0] EQ C<5,5>TEMP2 AND
                NOT ER2DONE)
              DO
                BEGIN        # SKIP ERRORS WITH DUPLICATE LINE NUMBERS #
                READW(ERR2FET,ERR2,2,ER$STAT);
                IF ER$STAT NQ TRNS$OK OR E2$LN[0] EQ 0
                THEN
                  ER2DONE = TRUE; 
                TEMP1 = E2$LN[0]; 
                TEMP2 = XCDD(TEMP1);
                END 
 
              END 
 
            END 
 
          END 
 
        PGLST(LN1); 
        WRITEH(OUTFET,OUTPT$BUFFER,14); 
        OUTBUFF1[0] = " ";
        IF LONG$DEF          # DEFINE STRING MADE EXPANDED SOURCE      #
                             # LINE LONGER THAN ONE LINE               #
        THEN                 # PRINT REST OF LINE                      #
          BEGIN 
          FOR I=0 WHILE ESI$DEF[0] NQ "D" 
            AND ESI$STAT EQ TRNS$OK 
          DO
            BEGIN 
            PGLST(LN1); 
            OUTBUFF1[0] = ESIBUFF[0]; 
            WRITEH(OUTFET,OUTPT$BUFFER,14); 
            OUTBUFF1[0] = " ";
            READH(ESIFET,ESI$BUFFER,14,ESI$STAT); 
            END 
 
          LONG$DEF = FALSE; 
          END 
 
        READH(SECFET,OUTPT$BUFFER,11,STMT$STAT);
        END   # I LOOP #
 
      RETURN; 
      END  # EXSLST PROC #
      CONTROL EJECT;
      PROC HDRLST;           # PRINT HEADER INFO FOR LCF AND NCF       #
      BEGIN 
*IF,DEF,IMS 
# 
**    HDRLST - HEADER INFO LISTER 
* 
*     S.M. ILMBERGER         81/10/28 
* 
*     PRINT HEADER INFO FOR LCF AND NCF 
* 
*     PROC HDRLST 
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGE      NONE 
* 
*     METHOD
* 
*     EJECT PAGE
*     WRITE PAGE HEADER TO OUTPUT FILE
*     WRITE TIME FILE WAS CREATED TO OUTPUT FILE
*     WRITE FILE NAME TO OUTPUT FILE
*     END 
* 
# 
*ENDIF
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      PGLST(NEWPAGE); 
      PGLST(LN5); 
      WRITEH(OUTFET,TIMELST,6); 
      WRITEH(OUTFET,FH$NAM$LST,4);
      RETURN; 
      END  # HDRLST PROC #
      CONTROL EJECT;
      PROC INLST; 
      BEGIN 
*IF,DEF,IMS 
# 
**    INLST - INCALL INFO LISTER
* 
*     S.M. ILMBERGER         81/10/28 
* 
*     WRITES TO OUTPUT FILE INFO FROM INCALL TABLE
* 
*     PROC INLST
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES
*     ABORT FROM INLST  - READ ERROR
* 
*     METHOD
* 
*     IF AT LEAST ONE ENTRY EXISTS IN INCALL$TABLE
*       WRITE INCALL HEADER TO OUTPUT FILE
*       FOR EACH ENTRY IN INCALL$TABLE
*         FORMAT INCALL LINE
*         WRITE INCALL LINE TO OUTPUT FILE
*     IF NO ENTRIES IN INCALL$TABLE 
*       READ -EOR-
*     END 
* 
# 
*ENDIF
 
      DEF NAME$SIZE # 7 #;     # SIZE FOR FAM AND USER NAME            #
      DEF UBZMUL # 100 #;      # MULTIPLE OF 100 WHICH WITH UBZ WAS    #
                               # ENCODED                               #
      DEF ZERO # O"33" #;      # VALUE OF DISPLAY CODE ZERO            #
      ITEM INDEX ;             # LOOP INDEX                            #
      ITEM I;                  # LOOP COUNTER                          #
      ITEM CTEMP C(10);        # CHARACTER TEMPORARY                   #
      ITEM ITEMP;              # INTEGER TEMPORARY                     #
      ITEM ITEMP2;             # INTEGER TEMPORARY                     #
      ITEM ITEMP3;             # INTEGER TEMPORARY                     #
      ITEM DTEMP;              # INTEGER TEMPORARY                     #
      ARRAY  FACTEMP [0:0] S(1);  # FAC TEMPORARY                      #
        BEGIN 
        ITEM FACT1 U(00,12,08);  # FIRST TWO FAC DIGITS                #
        ITEM FACT2 U(00,20,40);  # LAST 10 FAC DIGITS                  #
        ITEM FACT12 U(00,12,48); # ENTIRE WORD OF FAC                  #
        END 
      ITEM J;                # INTEGER TEMPORARY                       #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      IF IBRWC[ENTRY1] GR 1 
      THEN                   # AT LEAST ONE ENTRY EXISTS IN INCALL$TAB #
        BEGIN 
        PGLST(LN3);          # COUNT LINES TO BE PRINTED               #
        WRITEH(OUTFET,INC$HDR1,13);    # WRITE INCALL HEADER           #
        WRITEH(OUTFET,INC$HDR2,13); 
        READW(LCFFET,INCALL$TABLE,1,LCF$STAT);
                             # READ FIRST WORD OF ENTRY                #
        IF LCF$STAT NQ TRNS$OK
        THEN
          ERRMSG(ERMSG2,"INLST"); 
        FOR I=ENTRY0 WHILE LCF$STAT EQ TRNS$OK
        DO                   # UNTIL -EOR- IS READ                     #
          BEGIN 
          INCALL$EC = IBWC[ENTRY0];    # SAVE ENTRY WORD COUNT         #
          IF IB$LENG LS INCALL$EC-1 
          THEN               # NOT ENOUGH SPACE IN INCALL$TABL         #
            BEGIN            # ALLOCATE MORE SPACE                     #
            SSTATS(P<INCALL$TABLE>,INCALL$EC-1-IB$LENG);
            END 
 
          READW(LCFFET,INCALL$TABLE,INCALL$EC-1,LCF$STAT);
          # READ REST OF INCALL ENTRY  #
          IF LCF$STAT NQ TRNS$OK
          THEN
            ERRMSG(ERMSG2,"INLST"); 
          INC$CRRT[0] = "0";        # SET LINE FOR DOUBLE SPACE        #
          INC$FAM[0] = IBFAM[4];    # SET UP INCALL LINE INFO          #
          INC$USER[0] = IBUSER[5];
          FOR INDEX=0 STEP 1 UNTIL NAME$SIZE-1
          DO
            BEGIN 
            IF C<INDEX,1>INC$FAM[0] EQ 0  # IF ZERO FILLED             #
            THEN
              BEGIN 
              C<INDEX,1>INC$FAM[0] = " ";  # BLANK FILLED              #
              END 
            IF C<INDEX,1>INC$USER[0] EQ 0  # IF ZERO FILLED            #
            THEN
              BEGIN 
              C<INDEX,1>INC$USER[0] = " ";
              END 
            END 
          IF NOT IBPRI[1] 
          THEN
            INC$PRI[0] = "NO";
          ELSE
            INC$PRI[0] = "YES"; 
          TEMP2 = XCDD(IBDBL[1]); 
          INC$DBL[0] = C<9,1>TEMP2; 
          TEMP2 = XCDD(IBABL[1]); 
          INC$ABL[0] = C<9,1>TEMP2; 
          TEMP2 = XCDD(IBDBZ[1]); 
          INC$DBZ[0] = C<6,4>TEMP2; 
          TEMP2 = XCDD(IBSNODE[2]); 
          INC$SND[0] = C<7,3>TEMP2; 
          TEMP2 = XCHD(IBSHOST[3]);  #CONVERT TO DISPLAY CODE          #
          INC$SHT[0] = C<4,6>TEMP2 ; #ASSIGN TO PROPER FIELD           #
          IF IBCOLCT[2]              # IF COLLECT FLAG SET             #
          THEN
            BEGIN 
            INC$COLLECT[0] = "YES"; 
            END 
          ELSE
            BEGIN 
            INC$COLLECT[0] = "NO";
            END 
          TEMP2 = XCHD(IBPORT[1]);
          INC$PORT[0] = C<8,2>TEMP2;
          ITEMP2 = 1; 
          FOR ITEMP = 1 STEP 1 UNTIL IBDPLR[2]
          DO
            BEGIN 
            ITEMP2 = ITEMP2*2;       # GET ACTUAL VALUE OF DPLR        #
            END 
          TEMP2 = XCDD(ITEMP2);      # GET DISPLAY CODE OF DPLR        #
          INC$DPLR[0] = C<6,4>TEMP2;
          IF IBDTEL[2] EQ 0  # IF DTEA IS NOT SPECIFIED                #
          THEN
            BEGIN 
            INC$DTEA[0] =  "**NONE**";
            END 
          ELSE
            BEGIN 
            DTEMP = 15 - IBDTEL[2]; 
            FOR J = 0 STEP 1 UNTIL IBDTEL[2] -1   # CONVERT BCD DIGIT  #
            DO
              BEGIN 
              C<DTEMP +  J,1>INC$DTEA[0] = B<J*4,4>IBDTEA[6] + ZERO;
              END 
            END 
          PGLST(LN2); 
          WRITEH(OUTFET,INC$LN,13);  # WRITE INCALL LINE TO OUTPUT BUF #
          INC$FIL[0] = " "; 
          ITEMP = 0;                   # ITEMP SET TO 0                #
          FOR J=0 STEP 8 UNTIL 48 
 
          DO                           # FOR EACH CHAR OF ANAME VALUE  #
            BEGIN 
            C<9,1>CTEMP = SSDCAD(B<J,8>IBRANAME[0]);
            C<ITEMP,1>INC$ANAM[0] = C<9,1>CTEMP;
                                       # CONVERTS INTO HEX VALUE       #
            ITEMP = ITEMP + 1;
            END 
          TEMP2 = XCDD(IBUBL[1]); 
          INC$UBL[0] = C<9,1>TEMP2; 
          TEMP2 = XCDD(IBUBZ[1]); 
          INC$UBZ[0] = C<8,2>TEMP2; 
          TEMP2 = XCDD(IBDNODE[2]); 
          INC$DND[0] = C<8,2>TEMP2; 
          TEMP2 = XCDD(IBWS[2]);
          INC$WS[0] = C<9,1>TEMP2;
          IF IBFSTSL[2]                # IF FAST SELECT FLAG SET       #
          THEN
            BEGIN 
            INC$FSEL[0] = "YES";
            END 
          ELSE
            BEGIN 
            INC$FSEL[0] = "NO"; 
            END 
          ITEMP2 = 1; 
          FOR ITEMP = 1 STEP 1 UNTIL IBDPLS[2]
          DO
            BEGIN 
            ITEMP2 = ITEMP2*2;       # GET ACTUAL VALUE OF DPLS        #
            END 
          TEMP2 = XCDD(ITEMP2);      # GET DISPLAY CODE OF DPLS        #
          INC$DPLS[0] = C<6,4>TEMP2;
          TEMP2 = XCDD(IBWR[2]);       # CONVERT WR TO DISPLAY CODE    #
          INC$WR[0] = C<7,3>TEMP2;
          PGLST(LN1); 
          WRITEH(OUTFET,INC$LN2,13);    # WRITE LINE TO OUTPUT FILE    #
          INC$FIL2 = " "; 
          PGLST(LN1); 
          WRITEH(OUTFET,INC$HDR3,3);   # WRITE FACILITIES HEADER       #
          IF IBFACNUM[5] EQ 0 
          THEN               # IF NO FACILITY CODES                    #
            BEGIN 
            INC$FIL[0] = "                     ** NONE **"; 
            PGLST(LN1); 
            WRITEH(OUTFET,INC$LN,13); 
            INC$FIL[0] = " "; 
            END 
          FOR TEMP1=7 WHILE TEMP1 LS IBFACNUM[5]+7
          DO                 # FOR EACH FACILITY CODE                  #
            BEGIN 
            FOR ITEMP3=20 STEP 13 WHILE TEMP1 LS IBFACNUM[5]+ 7 AND 
                                        ITEMP3 LS 120 
            DO               # FILL LINE UNTIL FULL                    #
              BEGIN 
              FACT12[0] = B<0,IBFACL[TEMP1]*4>IBFAC[TEMP1]; 
              IF IBFACL[TEMP1] GR 10
              THEN
                BEGIN 
                CTEMP = XCHD(FACT1[0]); 
                C<ITEMP3,2>INC$FIL[0] =  C<08,02>CTEMP; 
                END 
              C<ITEMP3+2,10>INC$FIL[0] = XCHD(FACT2[0]);
              TEMP1 = TEMP1 + 1;
              END 
            PGLST(LN1);      # INCREMENT LINE COUNT                    #
            WRITEH(OUTFET,INC$LN,13);  #  WRITE LINE TO OUTPUT FILE    #
            INC$FIL[0] = " ";          # CLEAR LINE IMAGE BUFFER       #
            END 
          READW(LCFFET,INCALL$TABLE,1,LCF$STAT);
                             # READ FIRST WORD OF NEXT ENTRY           #
          END  # I LOOP # 
 
        END 
 
      ELSE                   # NO ENTRIES EXIST IN INCALL$TABLE        #
        BEGIN 
        READW(LCFFET,INCALL$TABLE,1,LCF$STAT);  # READ -EOR-           #
        IF LCF$STAT NQ LOC(IBWORD[0])              # CK STATUS OF READ #
        THEN
          ERRMSG(ERMSG2,"INLST"); 
        END    # ELSE # 
 
      RETURN; 
      END  # INLST PROC # 
      CONTROL EJECT;
      PROC LCFLST;
      BEGIN 
*IF,DEF,IMS 
# 
**    LCFLST - LCF LISTER 
* 
*     S.M. ILMBERGER         81/10/28 
* 
*     SUPERVISE LCF INFO LISTING
* 
*     PROC LCFLST 
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES
*     ABORT FROM LCFLST  - READ ERROR 
*     ABORT FROM LCFLST  - INVALID RECORD TYPE
*     ERROR IN LCF-SUMMARY LISTING SUPRESSED
* 
*     METHOD
* 
*     SET UP LCF-FET
*     READ PRFX$TABLE INTO BUFFER 
*     IF LCF IS VALID 
*       SET UP HEADER INFO
*       PRINT LCF HEADER LINES
*       FOR EACH RECORD IN LCF FILE 
*         READ RECORD INTO BUFFER 
*         CALL APPROPRIATE PROC TO PROCESS EACH RECORD
*     END 
* 
# 
*ENDIF
 
      DEF NUM$LCF$REC # 4 #; # NUMBER OF LCF RECORDS                   #
      DEF PRF$7700L # 17 #;  # PREFIX TABLE LENGTH                     #
 
      ITEM I;                # LOOP COUNTER                            #
 
      SWITCH BLK$TYP  APPL$R, 
                      USER$R, 
                   OUTCALL$R, 
                    INCALL$R; 
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      LST$TYP[0] = "  LCF SUMMARY  "; 
 
      LCFFIRST[0] = LOC(LCRBUFF[0]);# PT FET AT WORKING STORAGE BUFFER #
      LCFIN[0] = LOC(LCRBUFF[0]); 
      LCFOUT[0] = LOC(LCRBUFF[0]);
      LCFLIMIT[0] = LOC(LCRBUFF[0]) + PRULNGTH + 1; 
 
      REWIND(LCFFET); 
      READ(LCFFET);          # FILL CIO BUFFER WITH FILE HEADER RECORD #
      RECALL(LCFFET); 
      READW(LCFFET,PRFX$TABLE,18,LCF$STAT);    # READ RECORD INTO BUFF #
      NET$NAME[0] = PT$FNAME[0];       # SAVE FILE NAME                #
      SKIPEI(LCFFET);        # POSITION POINTER TO LAST RECORD         #
      SKIPB(LCFFET,2);
      READ(LCFFET);          # FILL CIO BUFFER W/PRFX$TABLE            #
      RECALL(LCFFET); 
 
      READW(LCFFET,PRFX$TABLE,18,LCF$STAT);  # READ PREFIX TABLE       #
      IF B<0,30>VEWORD0[0] NQ "VALID" OR
         LCF$STAT NQ LOC(VEWORD1[0]) + 1
      THEN
        BEGIN 
        MESSAGE(EM$ENT[ERMSG9],0); # NOT VALID LCF FILE                #
        ABRTFLG = TRUE;            # SET ABORT FLAG                    #
        END 
      ELSE
        BEGIN                      # VALID LCF FILE                    #
        C<0,8>HD$TIME[0] = C<0,8>PT$TIME[0]; # SET UP TIME AND DATE TO #
        C<0,8>HD$DATE[0] = C<0,8>PT$DATE[0]; # BE PRINTED              #
        TITLE[0] = PT$TITLE[0];    # SET TITLE AND LCF NAME            #
        HD$TYP[0] = "LCF";
        NAM$TYP[0] = "LCF"; 
        HDRLST;                   # PRINT HEADER INFO                  #
 
        REWIND(LCFFET); 
        READ(LCFFET); 
        RECALL(LCFFET); 
        READW(LCFFET,PRFX$TABLE,18,LCF$STAT); 
 
        FOR I=0 STEP 1 UNTIL NUM$LCF$REC-1
        DO
          BEGIN 
 
          READ(LCFFET);        # FILL CIO BUFFER WITH NEXT RECORD      #
          RECALL(LCFFET); 
 
          GOTO BLK$TYP[I];
 
APPL$R: 
 
          SSTATS(P<APPL$TABLE>,2);
          READW(LCFFET,APPL$TABLE,2,LCF$STAT); # READ APPL$TAB HEADER  #
          IF LCF$STAT NQ TRNS$OK         # CK STATUS OF READ           #
          THEN
            ERRMSG(ERMSG2,"LCFLST"); # PRINT READ ERROR MESSAGE - ABORT#
          IF AT$IDENT[0] NQ "APPL"
          THEN
            ERRMSG(ERMSG4,"LCFLST"); # PRINT INVALID RECORD MSG        #
          APPLST; 
          SSTATS(P<APPL$TABLE>,-1*AT$LENG);      # RELEASE TABLE SPACE #
          TEST I; 
 
USER$R: 
 
          SSTATS(P<USER$TABLE>,UTENTSZ);
          READW(LCFFET,USER$TABLE,2,LCF$STAT); # READ TABLE HEADER #
          IF LCF$STAT NQ TRNS$OK    # CK STATUS OF READ # 
          THEN
            ERRMSG(ERMSG2,"LCFLST");  # PRINT READ-ERROR MSG - ABORT   #
          IF UT$IDENT[0] NQ "USER"
          THEN
            ERRMSG(ERMSG4,"LCFLST");# PRINT INVALID RECORD MESSAGE-ABRT#
          USERLST;
          SSTATS(P<USER$TABLE>,-1*UT$LENG); 
          TEST I; 
 
OUTCALL$R:  
 
          SSTATS(P<OUTCALL$TABL>,2);
          READW(LCFFET,OUTCALL$TABL,2,LCF$STAT); # READ TABLE HEADER #
          IF LCF$STAT NQ TRNS$OK     # CK STATUS OF READ #
          THEN
            ERRMSG(ERMSG2,"LCFLST"); # PRINT READ ERROR MESSAGE - ABORT#
          IF OB$IDENT[0] NQ "OUTCALL" 
          THEN
            ERRMSG(ERMSG4,"LCFLST");# PRINT INVALID RECORD MESSAGE     #
          OUTLST; 
          SSTATS(P<OUTCALL$TABL>,-1*OB$LENG); 
          TEST I; 
 
INCALL$R: 
 
          SSTATS(P<INCALL$TABLE>,2);
          READW(LCFFET,INCALL$TABLE,2,LCF$STAT); # RD INCALL TAB HEADER#
          IF LCF$STAT NQ TRNS$OK
          THEN
            ERRMSG(ERMSG2,"LCFLST"); # PRINT READ ERROR MESSAGE - ABORT#
          IF IB$IDENT[0] NQ "INCALL"
          THEN
            ERRMSG(ERMSG4,"LCFLST"); # PRINT MESSAGE - ABORT           #
          INLST;            # LISTS INCALL STATEMENTS # 
          SSTATS(P<INCALL$TABLE>,-1*IB$LENG); 
            # RELEASE INCALL$TABLE SPACE #
          TEST I; 
          END  # I LOOP # 
 
        END  # VALID LCF #
 
      RETURN; 
      END  # LCFLST PROC #
      CONTROL EJECT;
      PROC LINLST;
      BEGIN 
*IF,DEF,IMS 
# 
**    LINLST - LINE LISTER
* 
*     S.M. ILMBERGER         81/10/28 
* 
*     PRINT LINE INFO 
* 
*     PROC LINLST 
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES
*     ABRT FROM LINLST  - READ ERROR
*     ABRT FROM LINLST  - FN VAL NOT LINE FN
* 
*     METHOD
* 
*     LOCATE LIN$CON$REC TABLE IN NCB 
*     READ HEADER OF LIN$CON$REC TABLE
*     READ ALL FNFV PAIRS INTO LIN$CON$REC TABLE
*     USE PORTNUM FROM LIN$CON$REC AND NPU NODE TO SEARCH LIN$REC$INDX
*       TABLE FOR RELATIVE PRU ADDR OF CORRESPONDING LINE$RECORD
*     READ LINE$RECORD INTO BUFFER
*     IF LINE IS NOT FROM A GROUP STATEMENT 
*       SET LINE NAME FROM LINE$RECORD
*     IF LINE IS FROM GROUP STATEMENT 
*       SET LINE NAME FROM LINE$XREF TABLE
*     SET LINE INFO FROM ITEMS IN LIN$CON$REC TABLE 
*     FOR EACH FNFV PAIR IN LIN$CON$REC TABLE 
*       SET ITEM IN "LINE" OUTPUT LINE
*     WRITE LINE INFO TO OUTPUT FILE
*     END 
* 
# 
*ENDIF
 
      DEF ASCII$C # O"103" #;# VALUE FOR ASCII C CHARACTER             #
      DEF LGUSERFN # 99 #;   # LARGEST USER FN VALUE                   #
      DEF MAXLNCR # 28 #;    # MAX LIN$CON$REC TABLE ENTRY SIZE        #
      DEF MAX$LN$FN # 18 #;  # MAXIMUM FN VALUE FOR LINE               #
      DEF SMUSERFN # 90 #;   # SMALLEST USER FN VALUE                  #
      DEF ZERO # O"33" #;    # VALUE FOR DISPLAY CODE ZERO             #
      DEF HOSTSIZE # 4 #;    # SIZE FOR HOST TABLE ENTRY               #
      DEF HOSTORD # 4 #;     # HOST TABLE ORDINAL                      #
      ITEM DFLTEMP U=0;      # TEMP STORAGE FOR DFL VALUE              #
      ITEM FOUND B; 
      ITEM I;                # LOOP COUNTER                            #
      ITEM J;                # LOOP COUNTER                            #
      ITEM K;                # LOOP COUNTER                            #
      ITEM NCOUNT;           # ENTRY COUNT TO SKIP INTERNAL TABLE      #
      ITEM TABCOUNT;         # TABLE COUNT                             #
      ITEM LCTENTRY;         # LINE XREF ENTRY                         #
      ITEM LINRD$STAT I;     # STATUS OF READ                          #
      ITEM LRIENT;           # LINE REC INDEX ENTRY SIZE               #
      ITEM MATCH B;          # SET IF NODE NUM AND PORT NUM MATCH ITEM #
      ITEM NSVCTEMP U=0;     # TEMP STORAGE FOR NSVC                   #
      ITEM PVCTEMP U=0;      # TEMP STORAGE FOR PVC                    #
 
      ARRAY LTYPNAM [0:12] S(1);
        ITEM LTYPS C(00,00,02) = [" ","S1","S2","S3"," "," ","A1",
                              "A2"," ","A6","H1","S4","H2"];
 
      ARRAY LSPEEDNUM [0:11] S(1);
        ITEM LSPEED1 C(00,00,05) = [" ","110","134","150","300","600",
                                  "1200","2400","4800","9600","19200",
                                   "38400"];
 
      ARRAY PSNNAM [0:10] S(1); 
        ITEM PSNVAL C(00,00,07) = [" ","DATAPAC","TELENET","TRNSPAC", 
                                "TYMNET","CDSN","UNINET","C120   ", 
                                "PSN253","PSN254","PSN255"];
 
      ARRAY TIPNAM [0:15] S(1); 
        ITEM TIPTYP C(00,00,05) = [" ","ASYNC","MODE4","HASP","X25",
                           "BSC"," "," "," "," "," "," ","TT12","TT13", 
                           "TT14","3270"];
 
      SWITCH FNTYP    ERRTYP ,         #  0 # 
                      AL     ,         #  1 # 
                      LSPEED ,         #  2 # 
                      RCOUNT ,         #  3 # 
                      FRAME  ,         #  4 # 
                      PVC$MSB,         #  5 # 
                      PVC$LSB,         #  6 # 
                      DCE    ,         #  7 # 
                      PSN    ,         #  8 # 
                      SVC$MSB,         #  9 # 
                      SVC$LSB,         # 10 # 
                      LCN    ,         # 11 # 
                      RTIME  ,         # 12 # 
                      DFL$MSB,         # 13 # 
                      DFL$LSB,         # 14 # 
                      ERRTYP ,         # 15 # 
                      DTEA   ,         # 16 # 
                      IMDISC ,         # 17 # 
                          RC ;         # 18 # 
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      SSTATS(P<LIN$CON$REC>,MAXLNCR); 
      SSTATS(P<LINE$RECORD>,25);
 
      NCBWD = 3;
      NCBIT = 52; 
      TENTRY[0] = 0;         # CLEAR ENTRY                             #
      FOR I = 1 STEP 1 UNTIL 3
      DO
        BEGIN                # SKIP NCB CHECKSUM AND NPU INFO          #
        SERMSGX;
        NCBW; 
        END 
      FOR TABCOUNT = 1 STEP 1 UNTIL 5 
      DO
        BEGIN 
        NCOUNT = ENTCNT[0];  # GET ENTRY COUNT                         #
        SERMSGX;             # SKIP TABLE ID HEADER                    #
        NCBW; 
        IF NCOUNT NQ 0
        THEN                 # NOT EMPTY TABLE                         #
          BEGIN 
          IF TABCOUNT EQ HOSTORD  # IF HOST TABLE MET                  #
          THEN
            BEGIN 
            NCOUNT = NCOUNT*HOSTSIZE;  # ENTRY SIZE IS 4 WORDS         #
            END 
          FOR I = 1 STEP 1 UNTIL NCOUNT 
          DO
            BEGIN 
            SERMSGX;         # SKIP SERVICE MESSAGE                    #
            NCBW; 
            END 
          END 
        END 
      ENTRY$CNT = ENTCNT[ENTRY0]; # SAVE ENTRY COUNT OF LIN$CON$REC TAB#
      LCWC[ENTRY0] = ENTRY$CNT; 
      FOR K=ENTRY$CNT STEP -1 WHILE K NQ 0
      DO
        BEGIN 
        FOR I=1 STEP 1 UNTIL 3
        DO                   # GET HEADER WORDS OF LIN$CON$REC TABLE   #
          BEGIN 
          SERMSGX;           # CK IF XING A SERVICE MSG BOUNDARY       #
          NCBW;              # GET NEXT 16 BIT NCB WORD                #
          B<44,16>LCWORD[I] = TENTRY[ENTRY0]; 
          END 
 
        FNFV$CNT = LCFNFV[ENTRY3]; # SAVE FNFV COUNT FOR THIS ENTRY    #
        IF FNFV$CNT NQ 0
        THEN                 # AT LEAST ONE FNFV PAIR EXISTS           #
          BEGIN 
          FOR J=1 STEP 1 UNTIL FNFV$CNT 
          DO
            BEGIN 
            SERMSGX;        # CK IF XING A SERVICE MSG BOUNDARY        #
            NCBW;            # GET NEXT 16 BITS FROM NCB               #
            B<44,16>LCWORD[J+3] = TENTRY[0];
            END 
 
          END 
 
        PORTNUM = LCPORT[ENTRY1]; 
        FOUND = FALSE;
        FOR I=ENTRY2 STEP LIENTSZ WHILE NOT FOUND 
          AND I LQ LIWC[ENTRY1] 
        DO
          BEGIN 
          IF LINID[I] EQ NODE$ID
            AND (LIPORT[I] EQ PORTNUM  # SEARCH LINE RECORD INDEX FOR  #
              OR (PORTNUM GQ LIPORT[I] # MATCHING NPU NODE ID AND PORT #
                AND PORTNUM LQ LIPORT[I]+LIGC[I]) ) 
          THEN
            BEGIN 
            FOUND = TRUE; 
            LRIENT = I;      # IF MATCH FOUND SAVE ENTRY NUMBER TO     #
            END             # REFERENCE RELATIVE PRU ADDRESS           #
 
          END 
 
        IF FOUND
        THEN
          BEGIN 
          NCFFIRST[0] = LOC(LINEWORD[0]);# POINT FET AT WORKING STORAGE#
          NCFIN[0] = LOC(LINEWORD[0]);   # BUFFER                      #
          NCFOUT[0] = LOC(LINEWORD[0]); 
          NCFLIMIT[0] = LOC(LINEWORD[0]) + PRULNGTH + 1;
          NCFRR[0] = LIRPA[LRIENT]; 
          READ(NCFFET);                  # FILL CIO BUFFER             #
          RECALL(NCFFET); 
          READW(NCFFET,LINE$RECORD,2,LINRD$STAT); # READ THE LINE REC  #
                             # POINTED TO BY THE RELATIVE PRU ADDRESS  #
          IF LINRD$STAT NQ TRNS$OK
          THEN
            ERRMSG(ERMSG2,"LINLST"); # PRINT READ ERRMSG - ABORT       #
          LINREC$WC = LRWC[ENTRY1];    # SET LINE RECORD WORD COUNT    #
          LINREC$GC = LRGC[ENTRY1];    # SET LINE RECORD GROUP COUNT   #
          IF LINREC$WC GR LR$LENG 
          THEN
            SSTATS(P<LINE$RECORD>,LINREC$WC-LR$LENG); 
          READW(NCFFET,LINE$RECORD,LINREC$WC-1,LINRD$STAT); 
          IF LINRD$STAT NQ TRNS$OK     # CK STATUS OF READ             #
          THEN
            ERRMSG(ERMSG2,"LINLST");  # PRINT READ ERR MSG - ABORT     #
          IF LINREC$GC EQ 0 
          THEN                 # NOT A GROUP STATEMENT                 #
            LN$NAM[0] = LRNAME[ENTRY0]; 
          ELSE                 # GROUP STATEMENT                       #
            BEGIN 
            LCTENTRY = 0; 
            MATCH = FALSE;
            FOR J=ENTRY2 STEP LCTENTSZ WHILE J LQ LCTWC[ENTRY1] 
              AND NOT MATCH            # SEARCH LINE XREF TAB FOR THE  #
            DO                         # NPU NODE ID AND PORT NUMBER   #
              BEGIN                    # THAT MATCH                    #
              IF LCTNID[J] EQ NODE$ID AND 
                LCTPORT[J] EQ PORTNUM 
              THEN
                BEGIN 
                MATCH = TRUE; 
                LCTENTRY = J; 
                END 
 
              END 
 
            IF LCTENTRY NQ 0
            THEN
              LN$NAM[0] = LCTNAME[LCTENTRY]; # SET LINE NAME FROM LINE-#
            END                              # XREF TABLE              #
 
          TEMP1 = LCPORT[ENTRY1]; 
          TEMP2 = XCHD(TEMP1);
          LN$PORT[0] = C<8,2>TEMP2;   # SAVE PORT NUM IN OUTPUT LINE   #
          LN$LTY[0] = LTYPS[LCLTYPE[ENTRY2]]; 
          IF LC$ARSPEED[ENTRY2]       # LC$ARSPEED IS SET              #
          THEN
            BEGIN 
            LN$ARSPEED[0] = "YES";    # SET ARSPEED FLAG TO TRUE       #
            END 
          ELSE
            BEGIN 
            LN$ARSPEED[0] = "NO";     # ELSE SET ARSPEED FLAG TO FALSE #
            END 
 
          IF LCTTYP$A[ENTRY2]         # CK IF AUTO PARAM SET           #
          THEN
            BEGIN 
            IF LC$SRANGE[ENTRY2]      # IF HIGH SPEED LINE             #
            THEN
              BEGIN 
              LN$XAUTO[0] = "YES";    # XAUTO = YES                    #
              LN$AUTO[0] = "NO";      # AUTO = NO                      #
              END 
            ELSE                      # MUST BE AUTO ONLY              #
              BEGIN 
              LN$XAUTO[0] = "NO"; 
              LN$AUTO[0] = "YES";     # AUTO = YES                     #
              END 
            END 
          ELSE                        # NEITHER AUTO NOR XAUTO         #
            BEGIN 
            LN$XAUTO[0] = "NO"; 
            LN$AUTO[0] = "NO";
            END 
          LN$TIPT[0] = TIPTYP[B<1,4>LCTTYP[ENTRY2]]; # SET TIPTYPE     #
          IF LCTTYP$IP[ENTRY2] GQ 12     # SAVE TIPTYPE USED IN TIPMAP #
          THEN
            B<LCTTYP$IP[ENTRY2]-5,1>TIPMAP[0] = 1;
          ELSE
            B<LCTTYP$IP[ENTRY2],1>TIPMAP[0] =  1; 
          IF LCST[ENTRY3] EQ 01  # CHECK LINE STATUS          # 
          THEN               # LINE IS DISABLED                        #
            LN$DI[0] = "YES"; 
          ELSE               # LINE IS ENABLED                         #
            LN$DI[0] = "NO";
          FOR J=ENTRY4 STEP LCTENTSZ UNTIL FNFV$CNT + 3 
          DO
            BEGIN 
            IF LCFN[J] GR MAX$LN$FN # CHECK FOR FN'S LARGER THAN MAX   #
            THEN
              BEGIN 
              IF LCFN[J] LS SMUSERFN OR    # CK FOR USER FN'S AND SKIP #
                LCFN[J] GR LGUSERFN 
              THEN
                ERRMSG(ERMSG8,"LINLST");
              END 
 
            ELSE
              BEGIN 
              GOTO FNTYP[LCFN[J]];
 
ERRTYP: 
            ERRMSG(ERMSG8,"LINLST");
 
AL:                          # SET AL VALUE IN OUTPUT LINE             #
            TEMP1 =   B<5,3>LCFV[J];
            TEMP2 = XCDD(TEMP1);
            LN$SL[0] = C<8,2>TEMP2; 
            TEST J; 
 
LSPEED:                      # SET LSPEED VALUE IN OUTPUT LINE         #
            LN$LSPE[0] = LSPEED1[LCFV[J]];
            TEST J; 
 
RCOUNT:                      # SET RCOUNT VALUE IN OUTPUT LINE         #
            TEMP1 = LCFV[J];
            TEMP2 = XCDD(TEMP1);
            LN$RCNT[0] = C<8,2>TEMP2; 
            TEST J; 
 
FRAME:                       # SET FRAME VALUE IN OUTPUT LINE          #
            TEMP1 = LCFV[J];
            TEMP2 = XCDD(TEMP1);
            LN$FRAM[0] = C<7,3>TEMP2; 
            TEST J; 
 
IMDISC:                      # SET IMMEDIATE DISCONNECT INDICATOR      #
             IF LCFV[J] EQ 1
             THEN 
               BEGIN
               LN$IMD[0] = "YES"; 
               END
             TEST J;
RC:                          # DISPLAY RECONNECT INDICATOR             #
             IF LCFV[J] EQ 1
             THEN 
               BEGIN
               LN$RC[0] = "YES";
               END
             ELSE 
               BEGIN
               LN$RC[0] = "NO"; 
               END
             TEST J;
LCN:                         # SET LOGICAL CHANNEL NUMBER              #
             TEMP2 = XCDD(LCFV[J]); 
             LN$LCN[0] = C<7,3>TEMP2; 
             TEST J;
 
PVC$MSB:                     # SAVE FIRST HALF OF PVC VALUE            #
            B<48,4>PVCTEMP = LCFV[J]; 
            TEST J; 
 
PVC$LSB:                     # SAVE SECOND HALF OF PVC AND SET IN OUTPT#
            B<52,8>PVCTEMP = LCFV[J]; 
            TEMP2 = XCDD(PVCTEMP);
            LN$NPVC[0] = C<6,4>TEMP2; 
            TEST J; 
 
DCE:                         # SET DCE VALUE                           #
            IF LCFV[J] EQ 1 
            THEN
              LN$DCE[0] = "DCE";
            TEST J; 
 
PSN:                         # SET PSN VALUE IN OUTPUT LINE            #
            IF LCFV[J] GR 250 
            THEN
              LN$PSN[0] = PSNVAL[LCFV[J] - 246];
            ELSE
              LN$PSN[0] = PSNVAL[LCFV[J]];
            TEST J; 
 
SVC$MSB:                     # SAVE 1ST HALF OF SVC                    #
            B<48,4>NSVCTEMP = LCFV[J];
            TEST J; 
 
SVC$LSB:                     # SAVE 2ND HALF OF SVC AND SET IN OUTPUT  #
            B<52,8>NSVCTEMP = LCFV[J];
            TEMP2 = XCDD(NSVCTEMP); 
            LN$NSVC[0] = C<7,3>TEMP2; 
            TEST J; 
 
RTIME:                       # SET RTIME VALUE IN OUTPUT LINE          #
            TEMP1 = LCFV[J];
            TEMP2 = XCDD(TEMP1);
            LN$RTIME[0] = C<5,5>TEMP2;
            TEST J; 
 
DFL$MSB:                     # SAVE 1ST HALF OF DFL                    #
            B<44,8>DFLTEMP = LCFV[J]; 
            TEST J; 
 
DFL$LSB:                     # SAVE 2ND HALF OF DFL AND SET DFL VALUE  #
            B<52,8>DFLTEMP = LCFV[J]; 
            TEMP2 = XCDD(DFLTEMP);
            LN$DFL[0] = C<5,5>TEMP2;
            TEST J; 
 
DTEA:                        # SET DTEA VALUE IN OUTPUT LINE           #
            TEMP2 = B<0,4>LCFV[J] + ZERO;   # CONVERT 1ST SEMI-OCTET   #
            C<1,1>TEMP2 = B<4,4>LCFV[J] + ZERO;  # CONVERT 2ND         #
            LN$DTEA[0] = TEMP2; 
 
              END 
            END  # J LOOP # 
 
          PGLST(LN6); 
          WRITEH(OUTFET,LIN$HDR,11); # WRITE LINE HEADER AND LINE      #
          WRITEH(OUTFET,LIN$HDR2,11); 
          WRITEH(OUTFET,LIN$LN,11); 
          WRITEH(OUTFET,LIN$LN2,11);
          TRMLST; 
          LN$FIL[0] = " ";
          LN$FL2[0] = " ";
          LN$IMD[0] = "NO"; 
          LN$LCN[0] = "0";
          END  # FOUND #
 
        END  # K LOOP # 
 
      SSTATS(P<LINE$RECORD>,-1*LR$LENG);
      SSTATS(P<LIN$CON$REC>,-1*LC$LENG);
      RETURN; 
      END  # LINLST PROC #
      CONTROL EJECT;
      PROC LLKLST;
      BEGIN 
*IF,DEF,IMS 
# 
**    LLKLST - LOGICAL LINK LISTER
* 
*     S.M. ILMBERGER         81/10/28 
* 
*     LIST LOGICAL LINK INFO
* 
*     PROC LLKLST 
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES     NONE 
* 
*     METHOD
* 
*     FOR EACH ENTRY IN LOGLINK$XREF TABLE
*       IF THE LINK IS CONNECTED TO THE CURRENT COUPLER 
*         PUT LOGLINK NAME IN LOGLINK LINE
*         IF LOGLINK IS HOST TO NPU 
*           SEARCH NPUXREF TABLE FOR NCNAME VALUE 
*         IF LOGLINK IS HOST TO HOST
*           SEARCH PLINK$XREF FOR NCNAME VALUE
*         SET LOGLINK STATUS
*         WRITE LOGLINK HEADER TO OUTPUT FILE 
*         WRITE LOGLINK LINE TO OUTPUT FILE 
*     END 
* 
# 
*ENDIF
 
      DEF CPL$TYPE # 0 #;    # CODE FOR PLTYPE = COUPLER               #
 
      ITEM FOUNDNCNAME B;    # TRUE IF NCNAME VALUE WAS FOUND          #
      ITEM I;                # LOOP COUNTER                            #
      ITEM J;                # LOOP COUNTER                            #
      ITEM LLKCNT I;         # NUMBER OF LIGLINKS TO THIS COUPLER      #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      LLKCNT = 0; 
      FOR I=ENTRY1 STEP 1 UNTIL (LLWC[ENTRY0]-1)/LLENTSZ
      DO
        BEGIN 
        IF CPL$ID EQ LLHNID1[I] 
        THEN
          BEGIN 
          LLKCNT = LLKCNT + 1;
          LLK$NAM[0] = LLNAME[I]; 
          FOUNDNCNAME = FALSE;
          IF LLHNID2[I] EQ LLNID2[I]
          THEN               # LOGICAL LINK IS HOST TO NPU             #
            BEGIN            # SEARCH NPUXREF TABLE FOR NCNAME VALUE   #
            FOR J=ENTRY1 STEP 1 WHILE J LQ (NPWC[ENTRY0]-1)/NPENTSZ 
              AND NOT FOUNDNCNAME 
            DO
              BEGIN 
              IF NPNID[J] EQ LLHNID2[I] 
              THEN
                BEGIN 
                FOUNDNCNAME = TRUE; 
                LLK$NCN[0] = NPNAME[J];  # SAVE NCNAME                 #
                END 
 
              END   # J LOOP #
 
            END 
 
          ELSE               # LOGICAL LINK IS HOST TO HOST            #
            BEGIN            # SEARCH PLINK XREF TABLE FOR NCNAME VALUE#
            FOR J=ENTRY1 STEP 1 WHILE J LQ (PLWC[ENTRY0]-1)/PLENTSZ 
              AND NOT FOUNDNCNAME 
            DO
              BEGIN 
              IF PLTYPE[J] EQ CPL$TYPE
                AND PLHNID[J] EQ LLHNID2[I] 
              THEN
                BEGIN 
                FOUNDNCNAME = TRUE; 
                LLK$NCN[0] = PLNAME[J]; 
                END 
 
              END  # J LOOP # 
 
            END  # ELSE # 
 
          IF LLST[I]         # SET LOGLINK STATUS                      #
          THEN
            LLK$STA[0] = "DI";
          ELSE
            LLK$STA[0] = "EN";
          IF LLKCNT EQ 1
          THEN               # FIRST LOGLINK ON THIS NPU               #
            BEGIN 
            PGLST(LN3); 
            WRITEH(OUTFET,LLK$HDR,5); # PRINT LOGICAL LINK HEADER      #
            WRITEH(OUTFET,LLK$LN,5);  # PRINT LOGLINK LINE             #
            END 
 
          ELSE
            BEGIN          # NOT FIRST LOGLINK ON THIS NPU             #
            PGLST(LN1); 
            WRITEH(OUTFET,LLK$LN,5);  # PRINT LOGLINK LINE             #
            END 
 
          LLK$FILL[0] = " ";
          END 
 
        END  # I LOOP # 
 
      RETURN; 
      END  # LLKLST PROC #
      CONTROL EJECT;
      PROC NCBW;             # GETS ONE 16 BIT ENTRY FROM THE NCB      #
      BEGIN 
*IF,DEF,IMS 
# 
**    NCBW - NCB WORD 
* 
*     S.M. ILMBERGER         81/10/28 
* 
*     GET, ONE 16 BIT ENTRY FROM NCB
* 
*     PROC NCBW 
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES     NONE 
* 
*     METHOD
* 
*     IF BIT COUNT+16 <= 60 
*       GET NEXT 16 BITS STARTING AT BIT COUNT
*       ADD 16 TO BIT COUNT 
*     IF BIT COUNT+16 > 60
*       GET NEXT BITS STARTING AT BIT COUNT 
*       GET REST OF BITS FROM NEXT WORD 
*       INCREMENT WORD COUNT
*       CHANGE BIT COUNT
*     END 
* 
# 
*ENDIF
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      IF NCBIT + 16 LQ 60 
      THEN                   # NEXT 16 BIT ENTRY IN SAME WORD          #
        BEGIN 
        TENTRY[0] = B<NCBIT,16>NCBWORD[NCBWD];
        IF NCBIT + 16 LS 60 
        THEN                 # INCREMENT BIT COUNT                     #
          NCBIT = NCBIT + 16; 
        ELSE                 # CHANGE BIT COUNT AND WORD COUNT         #
          BEGIN 
          NCBIT = 0;
          NCBWD = NCBWD + 1;
          END 
 
        END 
 
      ELSE
        BEGIN                # NEXT 16 BIT ENTRY OVERLAPS WORD         #
        B<0,60-NCBIT>TENTRY[0] =
          B<NCBIT,60-NCBIT>NCBWORD[NCBWD];
        B<60-NCBIT,NCBIT+16-60>TENTRY[0] =
          B<0,NCBIT+16-60>NCBWORD[NCBWD+1]; 
        NCBWD = NCBWD +1; 
        NCBIT = NCBIT + 16 - 60;
        END 
 
      END      # NCBW PROC #
      CONTROL EJECT;
      PROC NCFLST;
      BEGIN 
*IF,DEF,IMS 
# 
**    NCFLST - NCF LISTER 
* 
*     S.M. ILMBERGER         81/10/28 
* 
*     LIST ALL INFO CONTAINED IN THE NCF
* 
*     PROC NCFLST 
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES
*     ABRT FROM NCFLST  - NO SUCH RECORD TYPE 
*     ABRT FROM NCFLST  - READ ERROR
*     ERROR IN NCFLST-SUMMARY LISTING SUPPRESSED
*     ABRT FROM NCFLST  - BAD NCF FILE RECORD 
* 
*     METHOD
* 
*     SET UP NCF FET
*     FILL CIO BUFFER 
*     READ THE RFX$TABLE INTO BUFFER
*     SET UP HEADER INFO
*     READ NCF$INDEX RECORD 
*     FOR EACH ENTRY IN NCF$INDEX 
*       READ RECORD INTO CORRESPONDING TABLE
*     PRINT NCF HEADER
*     CALL NPULST TO PRINT EACH NPU 
*     CALL NODLST TO PRINT NODE INFO
*     END 
* 
# 
*ENDIF
 
      DEF PRF$7700L # 17 #;  # PREFIX TABLE LENGTH                     #
      DEF PRUPLS1 # O"101" #;# PRU LENGTH IS 65                        #
      DEF SIZERECTYPE # 8 #; # NUMBER OF DEFFERENT KINDS OF RECORDS    #
 
      ITEM I;                # LOOP COUNTER                            #
      ITEM J;                # LOOP COUNTER                            #
      ITEM MATCH B; 
 
      ARRAY NCRWB [0:0] S(65);     # NETWORK CONFIGURATION FILE BUFFER #
        BEGIN 
        ITEM NCRBUFF (00,00,60);
        END 
 
      ARRAY RECNUM [SIZERECTYPE]; 
        BEGIN 
        ITEM TABTYPE U(00,00,12) = [
                                   ,
                             O"7700", 
                             O"1603", 
                             O"1630", 
                             O"2010", 
                             O"1414", 
                             O"1430", 
                             O"0430", 
                             O"1411"];
        END 
 
      SWITCH REC$TYP         ERR$T, 
                             HDR$REC, 
                             NCB$REC, 
                             NPU$XRF, 
                             PL$XREF, 
                             LLK$XREF,
                             LN$XREF, 
                             DEV$XREF,
                             LN$REC$IDX;
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      LST$TYP[0] = "  NCF SUMMARY  "; 
      NCFFIRST[0] = LOC(NCRBUFF[0]);# POINT FET AT WORKING STORAGE BUFF#
      NCFIN[0] = LOC(NCRBUFF[0]); 
      NCFOUT[0] = LOC(NCRBUFF[0]);
      NCFLIMIT[0] = LOC(NCRBUFF[0]) + PRUPLS1;
      SKIPEI(NCFFET); 
      SKIPB(NCFFET,2);
      READ(NCFFET);          # FILL CIO BUFFER                         #
      RECALL(NCFFET); 
      READW(NCFFET,PRFX$TABLE,15,STMT$STAT); # READ PREFIX TABLE       #
      SSTATS(P<NCF$INDEX>,2);                # ALLOCATE SPACE          #
      READW(NCFFET,NCF$INDEX,2,STMT$STAT);   # READ NCF$INDEX          #
      IF STMT$STAT EQ TRNS$OK 
      THEN                   # IF READ WAS O.K.                        #
        BEGIN 
        C<0,8>HD$TIME[0] = C<0,8>PT$TIME[0];# SAVE TIME AND DATE       #
        C<0,8>HD$DATE[0] = C<0,8>PT$DATE[0];
        TITLE[0] = PT$TITLE[0];             # SAVE TITLE               #
        NET$NAME[0] = PT$FNAME[0];          # SAVE NCF NAME            #
        NCF$IDX$EC = (NCFWC[ENTRY0]-1)/NCFENTSZ;
        IF NCF$NAM[ENTRY0] NQ "NCF" 
        THEN                 # IF THIS IS NOT IDENTIFIED AS -NCF-      #
          BEGIN 
          STMT$STAT = TRNS$OK + 1;     # SET ERROR STATUS              #
          END 
        END 
      IF NOT NCFGOOD[ENTRY0] OR 
         STMT$STAT NQ TRNS$OK 
      THEN                   # NCF FILE NOT GOOD                       #
        BEGIN 
        MESSAGE(EM$ENT[ERMSG11],0);    # SEND MESSAGE TO DAYFILE       #
        ABRTFLG = TRUE;                # SET ABORT FLAG                #
        END 
      ELSE
        BEGIN                #  GOOD NCF FILE                          #
        SSTATS(P<NCF$INDEX>,NCFWC[ENTRY0]); 
        READW(NCFFET,NCF$INDEX,NCFWC[ENTRY0]-1,STMT$STAT);
                             # READ REST OF NCF$INDEX                  #
        IF STMT$STAT NQ TRNS$OK 
        THEN                 # CK READ STATUS                          #
          ERRMSG(ERMSG2,"NCFLST");
 
        FOR I=ENTRY0 STEP 1 UNTIL NCF$IDX$EC-1 # FOR EACH ENTRY        #
        DO                   # IN NCF$INDEX READ RECORD INTO TABLE     #
          BEGIN              # I LOOP  #
          MATCH = FALSE;
          FOR J=0 STEP 1 WHILE NOT MATCH
            AND J LQ SIZERECTYPE
          DO
            BEGIN            # J LOOP  #
            IF TABTYPE[J] EQ NCFRT[I] 
            THEN
              MATCH = TRUE; 
            IF MATCH
            THEN
              BEGIN          # MATCH FOUND                             #
              GOTO REC$TYP[J];
 
HDR$REC:  
              TEST I; 
 
NPU$XRF:  
              READREC(P<NPU$XREF>,I); 
              TEST I; 
 
PL$XREF:  
              READREC(P<PLINK$XREF>,I); 
              TEST I; 
 
LLK$XREF: 
              READREC(P<LOGLINK$XREF>,I); 
              TEST I; 
 
LN$XREF:  
              READREC(P<LINE$XREF>,I);
              TEST I; 
 
DEV$XREF: 
              TEST I; 
 
LN$REC$IDX: 
              READREC(P<LIN$REC$INDX>,I); 
              TEST I; 
 
NCB$REC:                          # SKIP NCB RECORDS         #
              TEST I; 
 
ERR$T:  
              ERRMSG(ERMSG3,"NCFLST");
 
              END            # MATCH   #
 
            END   # J LOOP #
 
          ERRMSG(ERMSG1,"NCFLST");
          END  # I LOOP # 
 
        HD$TYP[0] = "NCF";
        NAM$TYP[0] = "NCF"; 
        HDRLST;              # PRINT NAME OF NCF AND TIME CREATED      #
        NPULST;              #  PRINT NPU INFORMATION                  #
        NODLST;              #  PRINT NODE NUMBERS USED                #
        SSTATS(P<NCF$INDEX>,-1*NCF$LENG); # RELEASE ALL TABLE SPACE    #
        SSTATS(P<NCB$BUFFER>,-1*NCB$LENG);
        SSTATS(P<NPU$XREF>,-1*NP$LENG); 
        SSTATS(P<PLINK$XREF>,-1*PL$LENG); 
        SSTATS(P<LOGLINK$XREF>,-1*LL$LENG); 
        SSTATS(P<LINE$XREF>,-1*LCT$LENG); 
        SSTATS(P<LIN$REC$INDX>,-1*LI$LENG); 
        SSTATS(P<SUP$TABLE>,-1*ST$LENG);
        END                  # GOOD NCF FILE                           #
 
      RETURN; 
      END   # NCFLST PROC # 
      CONTROL EJECT;
      PROC NODLST;
      BEGIN 
*IF,DEF,IMS 
# 
**    NODLST - NODE INFO LISTER 
* 
*     S.M. ILMBERGER         81/10/28 
* 
*     LIST ALL THE UNUSED NODE NUMBERS
* 
*     PROC NODLST 
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGE      NONE 
* 
*     METHOD
* 
*     PRINT THE LARGEST NODE NUMBER USED FROM NODMAP
*     PRINTS ALL UNUSED NODE NUMBERS FROM UNSET BITS IN NODMAP
*     END 
* 
# 
*ENDIF
 
      DEF ENDOFLN # 98 #; 
      DEF LGNOD # 255 #;     # LARGEST NODE NUMBER POSSIBLE            #
      DEF SMNOD # 1 #;       # SMALLEST NODE NUMBER POSSIBLE           #
 
      ITEM CHACNT;           # CHARACTER COUNT                         #
      ITEM I;                # LOOP COUNTER                            #
      ITEM MAXNODE1 I;       # MAXIMUN NODE NUMBER                     #
      ITEM UNUSEDNODE B;     # SET IF NOT ALL NODES USED               #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      MAXNOD[0] = 0;
      NODNUMS[0] = " "; 
      MAXNODE1 = 0; 
      FOR I=LGNOD STEP -1 WHILE MAXNODE1 EQ 0 
        AND I GQ SMNOD
      DO
        BEGIN                # FIND LARGEST NODE NUMBER USED           #
        WORD = (I - 1) / 60; # COMPUTE WORD AND                        #
        BIT = (I - 1) - (60 * WORD);   # BIT TO REFER TO               #
        IF B<BIT,1>NODEMAP[WORD] EQ 1 
        THEN                 # FOR EACH NODE NUMBER USED               #
          BEGIN 
          MAXNODE1 = I; 
          TEMP1 = I;
          TEMP2 = XCDD(TEMP1);
          MAXNOD[0] = C<7,3>TEMP2; # PUT NODE NUMBER IN OUTPUT LINE    #
          END 
 
        END 
 
      IF MAXNODE1 GR 0
      THEN                         # AT LEAST 1 NODE NUMBER WAS USED   #
        BEGIN 
        PGLST(LN4); 
        WRITEH(OUTFET,MAXN$HDR,4); # WRITE MAX NODE NUM USED TO OUTPUT #
        WRITEH(OUTFET,MAXN$LN,2); 
        CHACNT = 0; 
        PGLST(LN4); 
        WRITEH(OUTFET,USEDN$HDR,3); 
        UNUSEDNODE = FALSE; 
        FOR I=SMNOD STEP 1 UNTIL MAXNODE1 
        DO
          BEGIN                    # SEARCH FOR UNUSED NODE NUMBERS    #
          WORD = (I - 1) / 60;         # COMPUTE WORD AND              #
          BIT = (I - 1) - (60 * WORD); # BIT TO REFER TO               #
          IF B<BIT,1>NODEMAP[WORD] EQ 0 # FIND UNUSED NODE NUMBERS LESS#
          THEN                         # THEN THE MAX NODE NUMBER      #
            BEGIN 
            UNUSEDNODE = TRUE;
            TEMP1 = I;
            TEMP2 = XCDD(TEMP1);
            C<CHACNT,3>NODNUMS[0] = C<7,3>TEMP2;
            CHACNT = CHACNT + 5;
            IF CHACNT GQ ENDOFLN   # MORE THAN 1 LINE OF UNUSED NODE NO#
            THEN
              BEGIN 
              CHACNT = 0; 
              WRITEH(OUTFET,UNODE$LN,11);# WRITE UNUSED NODE NUMBERS TO#
              NODNUMS[0] = " ";          # OUTPUT FILE                 #
              PGLST(LN1); 
              END 
 
            END 
 
          END 
 
        IF CHACNT NQ 0
        THEN
          BEGIN 
          WRITEH(OUTFET,UNODE$LN,11); 
          UNODE$FIL1[0] = " ";
          END 
 
        IF NOT UNUSEDNODE    # ALL NODE NUMBERS LS THAN THE MAX        #
        THEN                 # NODE WERE USED                          #
          BEGIN 
          MAXNODE[0] = MAXNOD[0]; 
          WRITEH(OUTFET,ALLNODS,6); 
          END 
 
        END 
 
      RETURN; 
      END    # NODELST PROC # 
      CONTROL EJECT;
      PROC NPULST;
      BEGIN 
*IF,DEF,IMS 
# 
**    NPULST - NPU LISTER 
* 
*     S.M. ILMBERGER         81/10/29 
* 
*     LIST NPU INFO 
* 
*     PROC NPULST 
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES     NONE 
* 
*     METHOD
* 
*     FOR EACH ENTRY IN NPU$XREF TABLE
*       FORMAT NPU OUTPUT LINE
*       PRINT NPU HEADER
*       PRINT NPU LINE
*       GET RELATIVE PRU ADDRESS OF NCB THAT MATCHES CURRENT NPU
*       READ IN NCB RECORD
*       CALL SUPLST, TRKLST, CPLLST, LINLST AND TIPLST
*         TO PRINT RESPECTIVE INFO
*     END 
* 
# 
*ENDIF
 
      ITEM FOUND B;          # FOUND RIGHT NCB RECORD                  #
      ITEM I;                # LOOP COUNTER                            #
      ITEM INDX;             # TEMP STORAGE FOR INDEX                  #
      ITEM J;                # LOOP COUNTER                            #
      CONTROL EJECT;
#                                                                      #
#                         CODE BEGINS HERE                             #
#                                                                      #
      FOR I=ENTRY1 STEP 1 UNTIL (NPWC[ENTRY0]-1)/NPENTSZ
      DO                     # FOR EACH ENTRY IN NPU XREF TABLE        #
        BEGIN 
        NPU$NAM[0] = NPNAME[I]; # SET NPU NAME IN NPU OUTPUT LINE      #
        TEMP1 = NPNID[I]; 
        TEMP2 = XCDD(TEMP1);
        NPU$NOD[0] = C<7,3>TEMP2; #  SET NPU NODE ID IN NPU OUTPUT LINE#
        NODE$ID = NPNID[I];     # SAVE NPU NODE ID                     #
        NPU$VAR[0] = NPVARNT[I];  # SET NPU VARIANT IN NPU OUTPUT LINE #
        IF NPOPGO[I]               # SET OPGO FLAG IN NPU OUTPUT LINE  #
        THEN
          NPU$OP[0] = "YES";
        ELSE
          NPU$OP[0] = "NO"; 
        IF NPDMP[I] 
        THEN                       #SET DMP FLAG IN OUTPUT LINE       # 
          NPU$DMP[0] = "YES"; 
        ELSE
          NPU$DMP[0] = "NO";
        PGLST(LN3); 
        WRITEH(OUTFET,NPU$HDR,7); # WRITE NPU HEADER AND NPU OUTPUT   # 
        WRITEH(OUTFET,NPU$LN,7);  # LINE TO OUTPUT FILE               # 
        FIL1[0] = " ";
        FOUND = FALSE;
        FOR J=ENTRY0 STEP 1 WHILE J LQ NCF$IDX$EC-1 
          AND NOT FOUND           # SEARCH NCF$INDEX FOR RELATIVE PRU # 
        DO                        # ADDRESS OF NCB THAT MATCHES THE   # 
          BEGIN                   # CURRENT NPU                       # 
          IF NCFNID[J] EQ NODE$ID 
          THEN
            BEGIN 
            FOUND = TRUE; 
            INDX = J; 
            END 
 
          END  #  J LOOP #
 
        IF FOUND
        THEN
          BEGIN 
          READREC(P<NCB$BUFFER>,INDX); # READ CORRECT NCB RECORD      # 
          SUPLST;                      # CALL SUPLINK LISTING PROC    # 
          TRKLST;                      # CALL TRUNK LISTING PROC      # 
          CPLLST;                      # CALL COUPLER LISTING PROC    # 
          LINLST;                      # CALL LINE LISTING PROC        #
          TIPLST;                      # CALL TIPTYPE LISTING PROC     #
          WORD = (NPNID[I]-1)/60;      # COMPUTE WORD AND              #
          BIT = (NPNID[I]-1) - (60 * WORD);          # BIT TO REFER TO #
          B<BIT,1>NODEMAP[WORD] = 1;
          END  # FOUND #
 
        END  # I LOOP # 
 
      RETURN; 
      END  # NPULST PROC #
      CONTROL EJECT;
      PROC OUTLST;
      BEGIN 
*IF,DEF,IMS 
# 
**    OUTLST - OUTCALL LISTER 
* 
*     S.M. ILMBERGER         81/10/29 
* 
*     LIST OUTCALL INFO 
* 
*     PROC OUTLST 
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES
*     ABRT FROM OUTLST  - READ ERROR
* 
*     METHOD
* 
*     IF AT LEAST ONE ENTRY EXISTS IN OUTCALL$TABLE 
*       WRITE OUTCALL HEADER TO OUTPUT FILE 
*       FOR EACH ENTRY IN OUTCALL$TABLE 
*         FORMAT OUTCALL LINE 
*         WRITE OUTCALL LINE TO OUTPUT FILE 
*     IF NO ENTRIES EXIST IN INCALL$TABLE 
*       READ -EOR-
*     END 
* 
# 
*ENDIF
 
      DEF ZERO # O"33" #;    # DISPLAY CODE VALUE FOR ZERO             #
      DEF UBZMUL # 100 #;    # MULTIPLE OF 100 WITH WHICH UBZ WAS      #
                             # ENCODED                                 #
 
      ITEM I;                # LOOP COUNTER                            #
      ITEM ITEMP;            # INTEGER TEMPORARY                       #
      ITEM ITEMP2;           # INTEGER TEMPORARY                       #
      ITEM ITEMP3;           # INTEGER TEMPORARY                       #
      ITEM CTEMP;            # CHARACTER TEMPORARY                     #
      ITEM DTEMP;            # INTEGER TEMPORARY                       #
      ARRAY  FACTEMP [0:0] S(1);  # FAC TEMPORARY                      #
        BEGIN 
        ITEM FACT1 U(00,12,08);  # FIRST TWO FAC DIGITS                #
        ITEM FACT2 U(00,20,40);  # LAST 10 FAC DIGITS                  #
        ITEM FACT12 U(00,12,48); # ENTIRE WORD OF FAC                  #
        END 
      ITEM J;                # INTEGER TEMPORARY                       #
 
      ARRAY DTEA$TEMP [0:0] S(1);      # DTEA TEMPORARY                #
        BEGIN 
        ITEM DTEA1      U(00,00,52);
        ITEM DTEA2      U(00,52,08);
        ITEM DTEA       I(00,00,60);
        END 
 
      CONTROL EJECT;
      PROC PRHEX(POS);
# 
*     PROCEDURE  PRHEX
*         IT CONVERTS EACH EVERY 4 BIT FROM UDATA FIELD 
*         AND PACKS IT INTO THE OUTPUT LINE FOR UDATA.
* 
*     ENTRY CONDITION : 
*       POS = OFFSET WITHIN THE OUTCALL PACKET. 
*     EXIT CONDITION :  
*       POS UNCHANGED.
* 
* 
# 
 
 
      BEGIN 
      DEF SIXTY # 60 #;                       # CONSTANT 60           # 
      ITEM POS ;                              # OFFSET WITH OUTCALL   # 
      ITEM WORDC ;                            # LOCAL WORD COUNT      # 
      ITEM INDIX, J ;                         # INDEXES               # 
      ITEM BITC ;                             # BIT COUNT             # 
 
      ITEM CTEMP C(10);                       # CHARACTER TEMPORARY   # 
 
      WORDC = POS;                            # SAVE OFFSET           # 
      BITC = 32;                              # SET BIT TO POINT TO   # 
                                              # FIRST BIT OF UDATA    # 
      PGLST(LN1);            # CONDITIONAL NEW PAGE HEADING           # 
      WRITEH(OUTFET,OUTC$21,3); 
      J = 0;                 # INDEX FOR AN OUTPUT LINE OF UDATA      # 
      OUTC$FL3[0] = " ";
 
      FOR INDIX = 0 STEP 1 UNTIL OBUDL[2]-1 
      DO
        BEGIN 
                                              # FOR THE WHOLE LENGTH  # 
                                              # OF UDL                # 
        IF BITC EQ SIXTY                      # IF END OF WORD REACHED# 
        THEN
          BEGIN 
          BITC = 0;                           # BIT COUNT RESET TO 0  # 
          WORDC = WORDC + 1;                  # BUMP WORD COUNT       # 
          END 
        CTEMP = XCHD(B<BITC,4>OBUDATA[WORDC]);
                                              # EXTRACT 4 BITS EACH   # 
                                              # TIME                  # 
        C<J,1>OUTC$UDT[0] = C<9,1>CTEMP;      # PUT INTO UDATA LINE   # 
        BITC = BITC + 4;                      # GET THE NEXT 4 BITS   # 
        J = J + 1;                            # INCR. OUTPUT LINE INDX# 
        IF J GQ 100 
        THEN                 # PRINT LINE OF UDATA IF BUFFER IS FULL  # 
          BEGIN 
          PGLST(LN1);        # NEW PAGE HEADING IF NEEDED             # 
          WRITEH(OUTFET,OUTC$LN3,13); 
          J = 0;             # RESET OUTPUT LINE INDEX FOR UDATA      # 
          OUTC$FL3[0] = " ";    # CLEAR LINE BUFFER                   # 
          END 
        END                                   # END OF DO LOOP        # 
      IF J GR 0 
      THEN
        BEGIN                # LAST LINE OF UDATA                     # 
        PGLST(LN1);          # NEW PAGE HEADING IF NEEDED             # 
        WRITEH(OUTFET,OUTC$LN3,13); 
        END 
      END # END OF PROC PRHEX # 
 
    CONTROL EJECT;
 
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
 
      IF OBRWC[ENTRY1] GR 1 
      THEN                   # AT LEAST 1 ENTRY EXISTS IN OUTCALL$TABL #
        BEGIN 
        PGLST(LN3); 
        WRITEH(OUTFET,OUT$HDR1,11); 
        WRITEH(OUTFET,OUT$HDR2,9);
        READW(LCFFET,OUTCALL$TABL,1,LCF$STAT);
                             # READ FIRST WORD OF OUTCALL$TABLE ENTRY  #
        IF LCF$STAT NQ TRNS$OK
        THEN
            ERRMSG(ERMSG2,"OUTLST");   # PRINT READ ERROR MSG - ABORT  #
        FOR I=ENTRY0 WHILE LCF$STAT EQ TRNS$OK
        DO
          BEGIN 
          OUTCALL$EC = OBWC[ENTRY0];   # SAVE ENTRY WORD COUNT         #
          IF OB$LENG LS OUTCALL$EC-1
          THEN               # NOT ENOUGH SPACE IN OUTCALL$TABL FOR    #
            BEGIN            # ENTRY - ALLOCATE MORE                   #
            SSTATS(P<OUTCALL$TABL>,OUTCALL$EC-1-OB$LENG); 
            END 
 
          READW(LCFFET,OUTCALL$TABL,OUTCALL$EC-1,LCF$STAT); 
                             # READ REST OF ENTRY                      #
          IF LCF$STAT NQ TRNS$OK
          THEN
              ERRMSG(ERMSG2,"OUTLST"); # PRINT ERROR MSG - ABORT       #
          OUTC$CC1[0] = "0";           # SET LINE TO DOUBLE SPACE      #
          OUTC$NM1[0] = OBNAME1[I];  # SET NAME1 IN OUTCALL OUTPUT LINE#
          IF NOT OBPRI[1]            # SET PRIV FLAG IN OUTCALL LINE   #
          THEN
            OUTC$PRI[0] = "NO"; 
          ELSE
            OUTC$PRI[0] = "YES";
          IF OBPID[1]                # IF PID SPECIFIED                #
          THEN
            BEGIN 
            OUTC$PID[0] = OBNAME2[I];  #  UPDATE PID NAME              #
            END 
          ELSE
            BEGIN 
            OUTC$NM2[0] = OBNAME2[I];# SET NAME2 IN OUTCALL OUTPUT LINE#
            END 
          TEMP2 = XCDD(OBDBL[1]); 
          OUTC$DBL[0] = C<9,1>TEMP2; # SET DBL IN OUTCALL OUTPUT LINE  #
          TEMP2 = XCDD(OBABL[1]); 
          OUTC$ABL[0] = C<9,1>TEMP2; # SET ABL IN OUTCALL OUTPUT LINE  #
          TEMP2 = XCDD(OBSNODE[2]); 
          OUTC$SND[0] = C<8,2>TEMP2; # SET SNODE IN OUTCALL OUTPUT LINE#
          TEMP2 = XCDD(OBPORT[1]);
          OUTC$PRT[0] = C<8,2>TEMP2;   # SET PRT IN OUTCALL OUTPUT LINE#
          ITEMP2 = 1; 
          FOR ITEMP = 1 STEP 1 UNTIL OBDPLS[2]
          DO
            BEGIN 
            ITEMP2 = ITEMP2*2;       # GET ACTUAL VALUE OF DPLS        #
            END 
          TEMP2 = XCDD(ITEMP2);      # GET DISPLAY CODE OF DPLS        #
          OUTC$DPS[0] = C<6,4>TEMP2;
          TEMP2 = XCDD(OBWS[2]);
          OUTC$WS[0] = C<9,1>TEMP2; 
          DTEA1[0] = OBDTEA1[3];
          DTEA2[0] = OBDTEA2[4];
          DTEMP = 15 - OBAL1[3];
          FOR J=0 STEP 1 UNTIL OBAL1[3] - 1 
          DO                 #   FOR EACH BCD NUMBER IN DTEA VALUE     #
            BEGIN            # CONVERT NUMBER TO DISPLAY CODE          #
            C<DTEMP + J,1>OUTC$DTA[0] = B<J*4,4>DTEA + ZERO;
            END 
          TEMP1 = 5 + OBFACNUM[2];     # POINT TO PRID /UDATA VALUE    #
          TEMP2 = XCHD(OBPRID[TEMP1]);
          OUTC$PRD[0] = C<2,6>TEMP2;   # SET PRID IN OUTPUT LINE       #
          PGLST(LN2); 
          WRITEH(OUTFET,OUTC$LN1,11);  # WRITE OUTCALL LINE            #
          OUTC$FL1[0] = " ";
          TEMP2 = XCDD(OBUBL[1]); 
          OUTC$UBL[0] = C<9,1>TEMP2;
          TEMP2 = XCDD(OBUBZ[1]); 
          OUTC$UBZ[0] = C<8,2>TEMP2;   # SET UBZ IN OUTCALL OUTPUT LINE#
          TEMP2 = XCDD(OBDBZ[1]); 
          OUTC$DBZ[0] = C<6,4>TEMP2;   # SET DBZ IN OUTCALL OUTPUT LINE#
          TEMP2 = XCDD(OBDNODE[2]);    # SET DNODE IN OUTPUT LINE      #
          OUTC$DND[0] = C<7,3>TEMP2;   # SET DNODE IN OUTPUT LINE      #
          TEMP2 = XCDD(OBACC[2]); 
          OUTC$ACL[0] = C<8,2>TEMP2;
          PGLST(LN1);                  # INCREMENT LINE COUNT          #
          WRITEH(OUTFET,OUTC$LN2,9);   # WRITE LINE TO OUTPUT FILE     #
          IF OBUDL[2] EQ 0             # NONE SPECIFIED FOR USER DATA  #
          THEN
            BEGIN 
            PGLST(LN1);                # CHECK IF NEW PAGE NEEDED      #
            WRITEH(OUTFET,OUTC$21,3); 
            OUTC$FL1[0] = "                     ** NONE **";
            PGLST(LN1); 
            WRITEH(OUTFET,OUTC$LN1,4);
            OUTC$FL1[0] = " ";
            END 
          ELSE
            BEGIN 
            TEMP1 = 5 + OBFACNUM[2];   # POINT TO PRID /UDATA VALUE    #
            PRHEX(TEMP1) ;             # GET HEX DATA FROM UDATA       #
            END 
          OUTC$FL2 = " "; 
          PGLST(LN1); 
          WRITEH(OUTFET,OUT$HDR3,3);   # WRITE FACILITIES HEADER       #
          IF OBFACNUM[2] EQ 0 
          THEN               # IF NO FACILITY CODES                    #
            BEGIN 
            OUTC$FL1[0] = "                     ** NONE **";
            PGLST(LN1); 
            WRITEH(OUTFET,OUTC$LN1,4);
            OUTC$FL1[0] = " ";
            END 
          OUTC$FL3[0] = " ";
          FOR TEMP1=5 WHILE TEMP1 LS OBFACNUM[2]+5
          DO                 # FOR EACH FACILITY CODE                  #
            BEGIN 
            FOR ITEMP3=20 STEP 13 WHILE TEMP1 LS OBFACNUM[2]+5 AND
                                        ITEMP3 LS 120 
            DO               # FILL LINE UNTIL FULL                    #
              BEGIN 
              FACT12[0] =  B<0,OBFACL[TEMP1]*4>OBFAC[TEMP1];
              IF OBFACL[TEMP1] GR 10
              THEN
                BEGIN 
                CTEMP =  XCHD(FACT1[0]);
                C<ITEMP3,2>OUTC$FL3[0] = C<8,2>CTEMP; 
                END 
              C<ITEMP3+2,10>OUTC$FL3[0] = XCHD(FACT2[0]); 
              TEMP1 = TEMP1 + 1;
              END 
            PGLST(LN1);      # INCREMENT LINE COUNT                    #
            WRITEH(OUTFET,OUTC$LN3,13); # WRITE LINE TO OUTPUT FILE    #
            OUTC$FL3[0] = " ";         # CLEAR LINE IMAGE BUFFER       #
            END 
          READW(LCFFET,OUTCALL$TABL,1,LCF$STAT);
                             # READ FIRST WORD OF NEXT ENTRY           #
          END # I LOOP #
 
        END 
 
      ELSE                   # NO ENTRIES IN OUTCALL$TABL              #
        BEGIN 
        READW(LCFFET,OUTCALL$TABL,1,LCF$STAT);    # READ -EOR-         #
        IF LCF$STAT NQ LOC(OBWORD[0])   # CK STATUS OF READ            #
        THEN
          ERRMSG(ERMSG2,"OUTLST");
        END 
 
      RETURN; 
      END  # OUTLST PROC #
      CONTROL EJECT;
      PROC PGLST(NUMLN);     # LISTS THE PAGE HEADER                   #
      BEGIN 
*IF,DEF,IMS 
# 
**    PGLST - PAGE HEADER LISTER
* 
*     S.M. ILMBERGER         81/10/29 
* 
*     PRINTS PAGE HEADER IF NECESSARY 
* 
*     PROC PGLST(NUMLN) 
* 
*     ENTRY        NUMLN - NUMBER OF LINES TO BE PRINTED
* 
*     EXIT         NONE 
* 
*     MESSAGES     NONE 
* 
*     METHOD
* 
*     IF A NEW PAGE IS REQUESTED
*       PAGE EJECT AND PRINT PAGE HEADER
*       CLEAR LINE COUNT
*     ELSE
*       IF NUMLINE+LINCOUNT > LENGTH OF PAGE
*         PAGE EJECT AND PRINT PAGE HEADER
*         CLEAR LINE COUNT
*       ELSE
*         ADD NUMLINES TO LINE-COUNT
*     END 
* 
# 
*ENDIF
 
      ITEM NUMLN I;          # NUMBER OF LINES TO BE PRINTED           #
 
      DEF PGLNGTH # 57 #;    # NUMBER OF LINES ON PAGE                 #
 
      ITEM LNCNT = 0;        # LINE COUNT                              #
      ITEM PGNM = 0;         # INTEGER PAGE NUMBER                     #
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      IF NUMLN EQ NEWPAGE 
      THEN                   # FORCE A NEW PAGE                        #
        BEGIN 
        PGNM = PGNM + 1;
        TEMP2 = XCDD(PGNM); 
        PAGE$N[0] = C<5,5>TEMP2;
        WRITEH(OUTFET,PG$HDR,13); # WRITE PAGE HEADER                  #
        LNCNT = 1;
        END 
 
      ELSE
        BEGIN 
        IF LNCNT+NUMLN GR PGLNGTH 
        THEN                 # NEXT LINE WILL NOT FIT ON PAGE          #
          BEGIN              # PAGE EJECT AND PRINT PAGE HEADER        #
          PGNM = PGNM + 1;
          TEMP2 = XCDD(PGNM); 
          PAGE$N[0] = C<5,5>TEMP2;
          WRITEH(OUTFET,PG$HDR,13); 
          WRITEH(OUTFET,BLNK$LN,1); 
          LNCNT = NUMLN + 2;
          END 
 
        ELSE
          BEGIN              # NEXT LINE WILL FIT ON PAGE              #
          LNCNT = LNCNT + NUMLN;  # INCREMENT LINE COUNT               #
          END 
 
        END 
 
      RETURN; 
      END    # PGLST PROC # 
 
      CONTROL EJECT;
      PROC RDNCB(ASCIILITERAL,NCB$TAB); 
          # READS TABLES FROM NCB                                      #
      BEGIN 
*IF,DEF,IMS 
# 
**    RDNCB - READ NCB
* 
*     S.M. ILMBERGER         81/10/29 
* 
*     LOCATE AND READ SUPERVISORY TABLE FROM NCB
* 
*     PROC RDNCB(ASCIILITERAL,NCB$TAB)
* 
*     ENTRY        ASCIILITERAL - ASCII CHAR TO SEARCH NCB FOR
*                  NCB$TAB - ADDRESS OF TABLE TO PUT SUPERVISORY INFO IN
* 
*     EXIT NONE 
* 
*     MESSAGES     NONE 
* 
*     METHOD
* 
*     SEARCH NCB UNTIL ASCIILITERAL TABLE HEADER IS FOUND 
*     FOR EACH ENTRY IN TABLE 
*       READ ENTRY INTO SUP$TABLE 
*     END 
* 
# 
*ENDIF
 
      ITEM ASCIILITERAL U;
      ITEM NCB$TAB;          # ADDRESS OF TABLE TO READ INTO           #
 
      ITEM I;                # LOOP COUNTER                            #
      ITEM J;                # LOOP COUNTER                            #
 
      ARRAY ENT [0:0] S(1); 
        BEGIN 
        ITEM ENTRYF        U(00,44,08); 
        ITEM ENTCNT        U(00,52,08); 
        ITEM TENTRY        U(00,44,16); 
        END 
 
      BASED ARRAY NCBINFO [0:0] S(1); 
        BEGIN 
        ITEM NCBENT U(00,44,16);
        END 
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      NCBWD = 3;
      NCBIT = 52; 
      TENTRY[0] = 0;
      FOR I=0 WHILE ENTRYF[ENTRY0] NQ ASCIILITERAL
      DO
        BEGIN                # SEARCH NCB UNTIL "S" IS FOUND           #
        SERMSGX;             # CK IF SERVICE MESSAGE BOUNDARY CROSSED  #
        IF NCBIT + 16 LQ 60 
        THEN
          BEGIN 
          TENTRY[ENTRY0] = B<NCBIT,16>NCBWORD[NCBWD]; 
          IF NCBIT + 16 LS 60 
          THEN
            NCBIT = NCBIT + 16; 
          ELSE
            BEGIN            # NCBIT + 16 = 60                         #
            NCBIT = 0;
            NCBWD = NCBWD + 1;
            END 
 
          END 
 
        ELSE
          BEGIN              # NCBIT + 16 GR 60                        #
          B<0,60-NCBIT>TENTRY[ENTRY0] = B<NCBIT,60-NCBIT>NCBWORD[NCBWD];
          B<60-NCBIT,NCBIT+16-60>TENTRY[ENTRY0] = 
              B<0,NCBIT+16-60>NCBWORD[NCBWD+1]; 
          NCBWD = NCBWD + 1;
          NCBIT = NCBIT + 16 - 60;
          END 
 
        END 
 
      IF ENTCNT[ENTRY0]+1 GR ST$LENG
      THEN
        SSTATS(NCB$TAB,ENTCNT[ENTRY0]+1-ST$LENG); 
      P<NCBINFO> = NCB$TAB; 
      NCBENT[0] = TENTRY[ENTRY0]; 
      FOR J=1 STEP 1 UNTIL ENTCNT[ENTRY0] 
      DO                     # READ REST OF SUPERVISORY TABLE          #
        BEGIN 
        SERMSGX;             # CK IF SERVICE MESSAGE BOUNDARY CROSSED  #
        IF NCBIT + 16 LQ 60 
        THEN
          BEGIN 
          NCBENT[J] = B<NCBIT,16>NCBWORD[NCBWD];
          IF NCBIT + 16 LS 60 
          THEN
            NCBIT = NCBIT + 16; 
          ELSE
            BEGIN            # NCBIT + 16 = 60                         #
            NCBIT = 0;
            NCBWD = NCBWD + 1;
            END 
 
          END 
 
        ELSE
          BEGIN              # NCBIT + 16 GR 60                        #
          B<0,60-NCBIT>NCBENT[J] =
              B<NCBIT,60-NCBIT>NCBWORD[NCBWD];
          B<60-NCBIT,NCBIT+16-60>NCBENT[J] =
              B<0,NCBIT+16-60>NCBWORD[NCBWD+1]; 
          NCBWD = NCBWD + 1;
          NCBIT = NCBIT + 16 - 60;
          END 
 
        END 
 
      RETURN; 
      END  # RDNCB PROC # 
      CONTROL EJECT;
      PROC READREC(POINTER,(INDEX));
      BEGIN 
*IF,DEF,IMS 
# 
**    READREC - READ RECOR
* 
*     S.M. ILMBERGER          81/10/29
* 
*     READ MCF FILE RECORDS 
* 
*     PROC READREC(POINTER,(INDEX)) 
* 
*     ENTRY        POINTER - ADDRESS OF TABLE TO READ INTO
*                  INDEX - INDEX OF NCF$INDEX TABLE ENTRY 
* 
*     EXIT         NONE 
* 
*     MESSAGES
*     ABRT FROM READREC - CAN'T READ NCF RECDS
* 
*     METHOD
* 
*     ALLOCATE TABLE SPACE
*     POINT FET AT WORKING STARAGE BUFFER 
*     READ NCFFET RECORD INTO TABLE 
*     END 
* 
# 
*ENDIF
 
      ITEM POINTER U; 
      ITEM INDEX U; 
 
      DEF STAT$EOF # O"33" #;  #  STATUS'S FOR NCFFET READS    #
      DEF STAT$EOI # O"1033" # ;
      DEF STAT$EOR # O"23" #; 
      DEF STAT$FUL # O"3" #;
 
      ITEM SIZE I;
 
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      SIZE = ( (NCFRL[INDEX] + PRULNGTH - 1) / PRULNGTH + 1) * PRULNGTH;
      SSTATS(POINTER,SIZE);   # ALLOCATE TABLE SPACE                   #
      NCFRR[0] = NCFRANINDX[INDEX]; 
      NCFFIRST[0] = POINTER; # POINT FET AT WORKING STORAGE BUFFER     #
      NCFIN[0] = POINTER; 
      NCFOUT[0] = POINTER;
      NCFLIMIT[0] = POINTER + SIZE + 1; 
      READ(NCFFET);          # FILL CIO BUFFER                         #
      RECALL(NCFFET); 
      IF NCFCODE[0] NQ STAT$EOR 
      THEN
        ERRMSG(ERMSG7,"READREC"); 
      RETURN; 
      END   # READREC PROC #
      CONTROL EJECT;
      PROC SERMSGX;       # CHECKS FOR SERVICE MESSAGE CROSSINE IN NCB #
      BEGIN 
*IF,DEF,IMS 
# 
**    SERMSGX - SERVICE MESSAGE CROSSING
* 
*     S.M. ILMBERGER         81/10/29 
* 
*     CHECK IF SERVICE MESSAGE BOUNDARY IS CROSSED
* 
*     PROC SERMSGX
* 
*     ENTRY  NONE 
* 
*     EXIT          NONE
* 
*     MESSAGES     NONE 
* 
*     METHOD
* 
*     IF A SERVICE MESSAGE BOUNDARY IS CROSSED
*       SKIP THE NEXT SERVICE MESSAGE HEADER
*     END 
* 
# 
*ENDIF
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      IF (NCBWD / SERMSG) * SERMSG EQ NCBWD 
        AND NCBIT EQ 52 
      THEN                   # SERVICE MESSAGE IS CROSSED              #
        NCBWD = NCBWD + 3;
      RETURN; 
      END   # SERMSGX PROC   #
      CONTROL EJECT;
      PROC SRCLST;
      # THIS PROC LISTS THE INPUT SOURCE LINES                         #
      BEGIN 
*IF,DEF,IMS 
# 
**    SRCLST - SOURCE LISTER
* 
*     S.M.ILMBERGER81/10/29 
* 
*     PRODUCE SOURCE LISTING
* 
*     PROC SRCLST 
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES     NONE 
* 
*     METHOD
* 
*     SET UP ERROR-2-FET
*     FILL ERROR-2-BUFFER 
*     SET UP SECONDARY-INPUT-FET
*     FILL SEC-INP-BUFFER 
*     WRITE SOURCE HEADER TO OUTPUT FILE
*     IF NO PASS-2 ERRORS EXIST 
*       FOR EACH LINE IN SEC-INP-BUFFER 
*         WRITE SEC-INP-LINE TO OUTPUT-FILE 
*     IF PASS-2 ERRORS EXIST
*       FOR EACH LINE IN SEC-INP-BUFFER 
*         IF PASS-2 ERRORS IXIST FOR LINE NUMBER
*           PLAG ERROR POSITION ON LINE 
*         WRITE SEC-INP-LINE TO OUTPUT FILE 
*     END 
# 
*ENDIF
 
      ITEM ER2$STAT;         # STATUS OF READ                          #
      ITEM ERRDONE B;        # ALL ERRORS PROCESSED WHEN SET           #
      ITEM I;                # LOOP COUNTER                            #
      ITEM J;                # LOOP COUNTER                            #
 
      ARRAY ERR2$LN [0:0] S(2); 
        BEGIN 
        ITEM ERR2$CODE I(00,00,12);            # ERROR CODE # 
        ITEM ERR2$LIN I(00,12,18);            # LINE NUMBER # 
        ITEM ERR2$CLWD C(01,00,10);            # CLARIFIER WORD # 
        ITEM ERR2$WD1 U(00,00,60);
        ITEM ERR2$WD2 U(01,00,60);
        END 
        CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      LST$TYP[0] = "SOURCE LISTING "; 
      PGLST(NEWPAGE); 
 
      E2FIRST[0] = LOC(E2WBWORD[0]);   # POINT FET AT ERROR-1 WORKING  #
      E2OUT[0] = LOC(E2WBWORD[0]);     # STORAGE BUFFER                #
      E2IN[0] = LOC(E2WBWORD[0]); 
      E2LIMIT[0] = LOC(E2WBWORD[0]) + PRULNGTH + 1; 
      REWIND(ERR2FET);
      READ(ERR2FET);                   # FILL CIO BUFFER               #
      RECALL(ERR2FET);
 
      SECFIRST[0] = LOC(SECWORD[0]);   # SET UP SECONDARY INPUT WORKING#
      SECIN[0] = LOC(SECWORD[0]);      # STORAGE BUFFER                #
      SECOUT[0] = LOC(SECWORD[0]);
      SECLIMIT[0] = LOC(SECWORD[0]) + PRULNGTH + 1; 
      REWIND(SECFET); 
      READ(SECFET);                    # FILL CIO BUFFER               #
      RECALL(SECFET); 
 
      PGLST(LN3); 
      WRITEH(OUTFET,SOURCE$HDR,2);
      READW(ERR2FET,ERR2$LN,2,ER2$STAT);
      IF ER2$STAT NQ TRNS$OK # NO PASS2 ERRORS                         #
        OR ERR2$LIN[0] EQ 0 
      THEN                             # NO PASS 2 ERRORS              #
        BEGIN 
        READH(SECFET,OUTPT$BUFFER,11,STMT$STAT);
        FOR I=1 WHILE STMT$STAT EQ TRNS$OK
        DO
          BEGIN              # READ SOURCE LISTING AND WRITE IT TO     #
                             # OUTPUT BUFFER                           #
          PGLST(LN1); 
          WRITEH(OUTFET,OUTPT$BUFFER,11); 
          OUTBUFF1[0] = " ";
          READH(SECFET,OUTPT$BUFFER,11,STMT$STAT);
          END 
 
        END 
 
      ELSE
        BEGIN                          # PASS 2 ERRORS EXIST           #
        ERRDONE = FALSE;
        READH(SECFET,OUTPT$BUFFER,11,STMT$STAT);
        FOR I=0 WHILE STMT$STAT EQ TRNS$OK
        DO
          BEGIN                        # FOR ALL OF SECONDARY INPUT FIL#
          IF NOT ERRDONE
          THEN                         # CK FOR ERRORS                 #
            BEGIN 
            TEMP1 = ERR2$LIN[0];
            TEMP2 = XCDD(TEMP1);
            IF OUTLNUM[0] EQ C<5,5>TEMP2
            THEN
              BEGIN 
              OUTELINE[0] = "***";
              READW(ERR2FET,ERR2$LN,2,ER2$STAT);
              IF ER2$STAT NQ TRNS$OK  OR ERR2$LIN[0] EQ 0 
              THEN
                ERRDONE = TRUE; 
              TEMP1 = ERR2$LIN[0];
              TEMP2 = XCDD(TEMP1);
              IF OUTLNUM[0] EQ C<5,5>TEMP2  # SEE IF 2 OR MORE ERRORS  #
              THEN                          # ON SAME LINE             #
                BEGIN 
                FOR J=0 WHILE (OUTLNUM[0] EQ C<5,5>TEMP2
                  AND ERR2$LIN[0] NQ 0) 
                DO
                  BEGIN # SKIP ERRORS WITH DUPLICATE LINE NUMBERS      #
                  READW(ERR2FET,ERR2$LN,2,ER2$STAT);
                  IF ER2$STAT NQ TRNS$OK OR ERR2$LIN[0] EQ 0
                  THEN
                    ERRDONE = TRUE; 
                  TEMP1 = ERR2$LIN[0];
                  TEMP2 = XCDD(TEMP1);
                  END 
 
                END 
 
              END 
 
            END 
 
          PGLST(LN1); 
          WRITEH(OUTFET,OUTPT$BUFFER,11); # WRITE SECONDARY INPUT LINE #
          OUTBUFF1[0] = " ";              # TO OUTPUT BUFFER           #
          READH(SECFET,OUTPT$BUFFER,11,STMT$STAT);
          END  # I LOOP # 
 
        END  # ELSE # 
 
      RETURN; 
      END  # SRCLST PROC #
      CONTROL EJECT;
      PROC SUPLST;
      BEGIN 
*IF,DEF,IMS 
# 
**    SUPLST - SUPLINK LISTER 
* 
*     S.M. ILMBERGER         81/10/29 
* 
*     LIST SUPLINK INFO 
* 
*     PROC SUPLST 
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES     NONE 
* 
*     METHOD
* 
*     WRITE SUPLINK HEADER TO OUTPUT FILE 
*     READ SUPERVISORY TABLE FROM THE NCB 
*     FOR EACH ENTRY IN SUPERVISORY TABLE 
*       FOR EACH ENTRY IN LOGLINK TABLE 
*         IF ROUTING ORDINAL MATCHES HOST ID AND LLNOD-ID MATCHES 
*           NPU ID
*           FORMAT SUPLINK LINE 
*           WRITE SUPLINK LINE TO OUTPUT FILE 
*     END 
# 
*ENDIF
 
      DEF ASCII$S # O"123" #;# OCTAL VALUE FOR ASCII "S"               #
      DEF SUPTABENTSZ # 1 #; # SUPERVISORY TABLE ENTRY SIZE            #
 
      ITEM FOUND B; 
      ITEM I;                # LOOP COUNTER                            #
      ITEM J;                # LOOP COUNTER                            #
      ITEM SLK$CNT I;        # SUPLINK COUNT                           #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      SLK$CNT = 0;
      PGLST(LN3); 
      WRITEH(OUTFET,SUP$HDR,3); 
      RDNCB(ASCII$S,P<SUP$TABLE>);     # READ SUPLINK TAB FROM NCB     #
      FOR I=ENTRY1 STEP STENTSZ UNTIL ST$ENT[0] 
      DO                     # FOR EACH ENTRY IN SUPERVISORY TABLE     #
        BEGIN 
        FOUND = FALSE;
        FOR J=ENTRY1 STEP 1 WHILE        # SEARCH LOGLIND TAB FOR MATCH#
          (NOT FOUND AND J LQ (LLWC[ENTRY0]-1)/LLENTSZ) 
        DO
          BEGIN 
          IF ST$RO[I] EQ LLHNID1[J]  # IF ROUTING ORDINAL MATCHES HOST #
            AND NODE$ID EQ LLNID2[J]   # ID AND NPU NODE ID MATCHES    #
          THEN
            BEGIN            # MATCH IS FOUND                          #
            FOUND = TRUE; 
            SLK$NAM[0] = LLNAME[J]; # SET SUPLINK NAME IN SUPLINK LINE #
            SLK$CNT = SLK$CNT + 1;
            IF SLK$CNT EQ 1 
            THEN
              BEGIN 
              WRITEH(OUTFET,SUP$LN,3);  # WRITE SUPLINK LINE           #
              END 
 
            ELSE
              BEGIN 
              PGLST(LN1); 
              WRITEH(OUTFET,SUP$LN,3);
              END 
 
            SLK$FIL1[0] = " ";
            END 
 
          END 
 
        END 
 
      RETURN; 
      END  # SUPLST PROC #
      CONTROL EJECT;
      PROC TIPLST;
      BEGIN 
*IF,DEF,IMS 
# 
**    TIPLST - TIPTYPE LISTER 
* 
*     S.M. ILMBERGER         81/10/29 
* 
*     LIST ALL TIPTYPES USED FOR EACH NPU 
* 
*     PROC TIPLST 
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES     NONE 
* 
*     METHOD
* 
*     FOR EACH BIT IN TYPTYPES-USED TABLE 
*       IF BIT IS SET 
*         SAVE CORRESPONDING NAME IN TIP-LINE 
*     IF AT LEAST ONE TIPTYPE WAS USED
*       WRITE TIPTYPE HEADER TO OUTPUT FILE 
*       WRITE TIPTYPE LINE TO OUTPUT FILE 
*     END 
* 
# 
*ENDIF
 
      DEF ENDTIP # 10 #;     # LAST TIP NUMBER                         #
      DEF FSTIP # 0 #;       # FIRST TIP NUMBER                        #
 
      ITEM I;                # LOOP COUNTER                            #
      ITEM J;                # SCRATCH ITEM                            #
 
      ARRAY TIPNMS [0:10] S(1); 
        ITEM TIPNAMES C(00,00,10) = [" ", 
                                     "   ASYNC",
                                     "   MODE4",
                                     "   HASP", 
                                     "   X25",
                                     "   BSC",
                                     "   SYNAUTO",
                                     "   TT12", 
                                     "   TT13", 
                                     "   TT14", 
                                     "   3270"
                                    ];
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      J = 1;                 # INITIALIZE POINTER TO OUTPUT LINE       #
      FOR I=FSTIP STEP 1 UNTIL ENDTIP # SEARCH TIP LIST TABLE          #
      DO                              # IF A BIT IS SET FOR A TIPTYPE  #
        BEGIN                         # SAVE TIPTYPE IN TIPLST LINE    #
        IF B<I,1>TIPMAP[0] EQ 1 
        THEN
          BEGIN 
          TIPS[J] = TIPNAMES[I];
          J = J + 1;         # INCREMENT OUTPUT LINE POINTER           #
          END 
 
        END 
 
      IF J NQ 1              # AT LEAST ONE TIPTYPE WAS USED           #
      THEN
        BEGIN 
        PGLST(LN4); 
        WRITEH(OUTFET,TIP$HDR,4);     # WRITE TIPLIST HEADER           #
        WRITEH(OUTFET,TIP$LN,10);     # WRITE TIPLIST LINE             #
        END 
 
      TIP$FILL[0] = " ";
      TIPMAP[0] = 0;
      RETURN; 
      END  #TIPLST PROC # 
      CONTROL EJECT;
      PROC TRKLST;
      BEGIN 
*IF,DEF,IMS 
# 
**    TRKLST - TRUNK STATEMENT LISTER 
* 
*     S.M. ILMBERGER         81/10/29 
* 
*     LIST TRUNK INFO 
* 
*     PROC TRKLST 
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES     NONE 
* 
*     METHOD
* 
*     FOR EACH TRUNK ENTRY IN PHYSICAL LINE XREF TABLE
*       IF NODE MATCHES CURRENT NPU NODE
*         SEARCH NPU$XREF TABLE FOR N1 AND N2 NAMES 
*         FORMAT REST OF TRUNK LINE 
*         WRITE TRUNK LINE TO OUTPUT FILE 
*     END 
* 
# 
*ENDIF
 
      ITEM FOUNDNPU1 B;      # SET IF N1 NAME FOUND                    #
      ITEM FOUNDNPU2 B;      # SET IF N2 NAME FOUND                    #
      ITEM I;                # LOOP COUNTER                            #
      ITEM J;                # LOOP COUNTER                            #
      ITEM TRKCNT I;         # NUMBER OF TRUNKS                        #
 
      DEF TRK$TYP # 1 #;     # INDICATES PLINK IS TRUNK                #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      TRKCNT = 0; 
      FOR I=ENTRY1 STEP 1 UNTIL (PLWC[ENTRY0]-1)/PLENTSZ
      DO                     # FOR EACH ENTRY IN PHYSICAL LINK TAB     #
        BEGIN 
        IF PLTYPE[I] EQ TRK$TYP AND    # LINK TYPE IS TRUNK AND NODE ID#
          (PLNID1[I] EQ NODE$ID OR PLNID2[I] EQ NODE$ID)   # MATCHES   #
        THEN
          BEGIN 
          TRKCNT = TRKCNT + 1;
          TRK$NAM[0] = PLNAME[I]; # SET TRUNK NAME IN TRUNK OUTPT LINE #
          FOUNDNPU1 = FALSE;
          FOUNDNPU2 = FALSE;
          FOR J=ENTRY1 STEP 1 WHILE J LQ (NPWC[ENTRY0]-1)/NPENTSZ 
            AND ( NOT FOUNDNPU1 OR NOT FOUNDNPU2) 
          DO                 # SEARCH NPUXREF TABLE FOR NPU NAMES TO   #
            BEGIN                      # PRINT IN N1 AND N2 POSITIONS  #
            IF NPNID[J] EQ PLNID1[I]
            THEN
              BEGIN 
              TRK$N1[0] = NPNAME[J];  # SET NAME1 IN TRUNK OUTPUT LINE #
              FOUNDNPU1 = TRUE; 
              END 
 
            IF NPNID[J] EQ PLNID2[I]
            THEN
              BEGIN 
              TRK$N2[0] = NPNAME[J];  # SET NAME2 IN TRUNK OUTPUT LINE #
              FOUNDNPU2 = TRUE; 
              END 
 
            END   # J LOOP #
 
          TEMP1 = PLP1[I];
          TEMP2 = XCDD(DC$FRAME(PLFRAME[I])); # CONVERTS CODE TO CHAR#
          TRK$FRAME[0] = C<6,4>TEMP2;          # ASSIGN FRAME CODE    # 
          TEMP2 = XCHD(TEMP1);
          TRK$P1[0] = C<8,2>TEMP2;    # SET P1 IN TRUNK OUTPUT LINE    #
          TEMP1 = PLP2[I];
          TEMP2 = XCHD(TEMP1);
          TRK$P2[0] = C<8,2>TEMP2;    # SET P2 IN TRUNK OUTPUT LINE    #
          IF PLNLD1[I]                # SET NOLOAD1 FLAG IN TRUNK OUTPT#
          THEN
            TRK$NOLO1[0] = "YES"; 
          ELSE
            TRK$NOLO1[0] = "NO";
          IF PLNLD2[I]                # SET NOLOAD2 FLAG IN TRUNK OUTPT#
          THEN
            TRK$NOLO2[0] = "YES"; 
          ELSE
            TRK$NOLO2[0] = "NO";
          IF PLST[I]                  # SET STATUS FLAG IN TRUNK LINE  #
          THEN
            TRK$STA[0] = "DI";
          ELSE
            TRK$STA[0] = "EN";
          IF TRKCNT EQ 1
          THEN
            BEGIN 
            PGLST(LN3); 
            WRITEH(OUTFET,TRK$HDR,9); # WRITE TRUNK HEADER TO OUTPUT   #
            WRITEH(OUTFET,TRK$LN,9);  # WRITE TRUNK LINE TO OUTPUT FILE#
            END 
 
          ELSE
            BEGIN 
            PGLST(LN1); 
            WRITEH(OUTFET,TRK$LN,9);  # WRITE TRUNK LINE TO OUTPUT FILE#
            END 
 
          TRK$FIL[0] = " "; 
          END 
 
        END  # I LOOP # 
 
      RETURN; 
      END   # TRKLST PROC # 
      CONTROL EJECT;
      PROC TRMLST;
      BEGIN 
*IF,DEF,IMS 
# 
**    TRMLST - TERMINAL LISTER
* 
*     S.M. ILMBERGER         81/10/29 
* 
*     LIST TERMINAL STATEMENT INFO
* 
*     PROC TRMLST 
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSGES 
*     ABRT FROM TRMLST  - FN VAL NOT TERM FN
* 
*     METHOD
* 
*     FOR EACH TERMINAL ENTRY ON CURRENT LINE 
*       FORMAT TERMINAL OUTPUT LINE FROM TERMINAL ITEMS 
*       FOR EACH TERMINAL FNFV PAIR - STORE INFO INTO TERMINAL LINE 
*       WRITE TERMINAL HEADER 
*       WRITE TERMINAL LINE TO OUTPUT FILE
*       CALL DEVLST 
*     END 
* 
# 
*ENDIF
 
      DEF BCE$TIP # 4 #;     # TIPTYPE FOR BCE                         #
      DEF HASP$TIP # 3 #;    # TIPTYPE FOR HASP                        #
      DEF MAX$FN # 148 #;    # MAX POSSIBLE FN VALUE                   #
      DEF MAXCSET # 15 #;    # MAX CODE FOR CSET                       #
      DEF MAXTC # 31 #;      # MAX TERMINAL CLASS CODE                 #
      DEF MAXTSPEED # 11 #;  # MAX CODE FOR TSPEED                     #
      DEF MD4$TIP # 2 #;     # TIPTYPE FOR MODE4                       #
      DEF TT$12 # 12 #;      # TIPTYPE FOR USER TIP TT12               #
      DEF TT$3270 # 15 #;    # TIPTYPE FOR 3270                        #
 
      ITEM I;                # INDEX VARIABLE                          #
      ITEM INDX I;
      ITEM J;                # LOOP COUNTER                            #
      ITEM K;                # LOOP COUNTER                            #
      ITEM CTEMP C(10);      # CHARACTER TEMPORARY                     #
      ITEM FIR$SEMI B;       # FLAG FOR FIRST HALF OF A PAD SEMI-OCTET #
      ITEM PAD$INDX;         # POINTS TO PAD VALUES ON OUTPUT LINE     #
 
      ARRAY CSET$NAMES [0:16] S(1); 
        ITEM CSET C(00,00,07) = [" ","BCD","ASCII","APLTP", 
          "APLBP","EBCD","EBCDAPL","CORRES","CORAPL", 
          "EBCDIC",,,,,,"CSET15"];
 
      ARRAY CTYP$NAMES [0:2] S(1);
        ITEM CTYP$VAL     C(00,00,03) = ["SVC","PVC"];
 
      ARRAY FNFVTABLE [0:0] S(1); 
        BEGIN 
        ITEM FNFV$ENT U(00,44,16);
        ITEM FN$ENT U(00,44,08);
        ITEM FV$ENT U(00,52,08);
        END 
 
      ARRAY STIP1$NAMES [0:6] S(1); 
        ITEM STIP1 C(00,00,05)=[ ,"N2741","M4A","POST","PAD","2780"]; 
 
      ARRAY STIP2$NAMES [0:6] S(1); 
        ITEM STIP2 C(00,00,05) = [ ,"2741","M4C","PRE","USER","3780"];
 
      ARRAY TC$TYPES [0:32] S(1); 
        ITEM TC C(00,00,05) = 
        [ " ","M33","713","721","2741","M40","H2000", 
        "X364","T4014","HASP","200UT","714X","711","714","HPRE","734",
        "2780","3780","3270", , , , , , , , , ,"TC28","TC29","TC30",
        "TC31"];
 
      ARRAY TSPEEEDS [0:11] S(1); 
        ITEM TSPEED C(00,00,05) = [" ","110","134","150","300","600", 
          "1200","2400","4800","9600","19200","38400"]; 
 
      ARRAY YESNOTAB [0:2] S(1);
        ITEM YESNOENT C(00,00,03) = ["NO","YES"]; 
 
      SWITCH TER$FN 
         ERRTER, #  0 # ERRTER, #  1 # ERRTER, #  2 # ERRTER, #  3 #
         ERRTER, #  4 # ERRTER, #  5 # ERRTER, #  6 # ERRTER, #  7 #
         ERRTER, #  8 # ERRTER, #  9 # ERRTER, # 10 # ERRTER, # 11 #
         ERRTER, # 12 # ERRTER, # 13 # ERRTER, # 14 # ERRTER, # 15 #
         ERRTER, # 16 # ERRTER, # 17 # ERRTER, # 18 # ERRTER, # 19 #
         TSTJ  , # 20 # ERRTER, # 21 # TSTJ  , # 22 # TSTJ  , # 23 #
         TSTJ  , # 24 # TSTJ  , # 25 # TSTJ  , # 26 # TSTJ  , # 27 #
         TSTJ  , # 28 # TSTJ  , # 29 # TSTJ  , # 30 # TSTJ  , # 31 #
         TSTJ  , # 32 # ERRTER, # 33 # TSTJ  , # 34 # TSTJ  , # 35 #
         TSTJ  , # 36 # TSTJ  , # 37 # TSTJ  , # 38 # TSTJ  , # 39 #
         TSTJ  , # 40 # TSTJ  , # 41 # TSTJ  , # 42 # TSTJ  , # 43 #
         TSTJ  , # 44 # TSTJ  , # 45 # ERRTER, # 46 # ERRTER, # 47 #
         TSTJ  , # 48 # TSTJ  , # 49 # TSTJ  , # 50 # TSTJ  , # 51 #
         TSTJ  , # 52 # TSTJ  , # 53 # TSTJ  , # 54 # TSTJ  , # 55 #
         ERRTER, # 56 # TSTJ  , # 57 # TSTJ  , # 58 # TSTJ  , # 59 #
         TSTJ  , # 60 # TSTJ  , # 61 # TSTJ  , # 62 # TSTJ  , # 63 #
         TSTJ  , # 64 # TSTJ  , # 65 # TSTJ  , # 66 # TSTJ  , # 67 #
         TSTJ  , # 68 # TSTJ  , # 69 # ERRTER, # 70 # TSTJ  , # 71 #
         W     , # 72 # CTYP  , # 73 # NCIR  , # 74 # NEN   , # 75 #
         TSTJ  , # 76 # RIC   , # 77 # BCF   , # 78 # MREC  , # 79 #
         TSTJ  , # 80 # ERRTER, # 81 # ERRTER, # 82 # ERRTER, # 83 #
         ERRTER, # 84 # ERRTER, # 85 # ERRTER, # 86 # ERRTER, # 87 #
         COLECT, # 88 # ERRTER, # 89 # TSTJ  , # 90 # TSTJ  , # 91 #
         TSTJ  , # 92 # TSTJ  , # 93 # TSTJ  , # 94 # TSTJ  , # 95 #
         TSTJ  , # 96 # TSTJ  , # 97 # TSTJ  , # 98 # TSTJ  , # 99 #
         ERRTER, #100 # ERRTER, #101 # TSTJ  , #102 # ERRTER, #103 #
         ERRTER, #104 # ERRTER, #105 # ERRTER, #106 # ERRTER, #107 #
         ERRTER, #108 # ERRTER, #109 # ERRTER, #110 # EOF,    #111 #
         TSTJ,   #112 # PAD,    #113 # PAD,    #114 # PAD,    #115 #
         PAD,    #116 # PAD,    #117 # PAD,    #118 # PAD,     #119 # 
         PAD,    #120 # PAD,    #121 # PAD,    #122 # PAD,     #123 # 
         PAD,    #124 # PAD,    #125 # PAD,    #126 # PAD,     #127 # 
         PAD,    #128 # PAD,    #129 # PAD,    #130 # PAD,     #131 # 
         PAD,    #132 # PAD,    #133 # PAD,    #134 # PAD,     #135 # 
         PAD,    #136 # PAD,    #137 # PAD,    #138 # PAD,     #139 # 
         PAD,    #140 # PAD,    #141 # PAD,    #142 # PAD,     #143 # 
         PAD,    #144 # TSTJ,   #145 # TSTJ,   #146 # TSTJ,    #147 # 
         TSTJ;   #148 # 
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      I = 1;
      FOR K=1 WHILE I LS LINREC$WC-2
      DO
        BEGIN 
        TER$FIL[0] = " ";    # CLEAR TRM LINE 1                        #
        TER$FIL2[0] = " ";   # CLEAR TRM LINE 2                        #
        TER$PAD = " ";
        FIR$SEMI = TRUE;     # SET FLAGF TO TRUE                       #
        PAD$INDX = 0;        # RESET PRINTABLE PAD CHAR INDEX          #
        IF TESTIP[I+1] EQ 6 
        THEN                 # USER DEFINED TIP                        #
          BEGIN 
          TER$STIP[0] = "USER"; 
          END 
        ELSE
          BEGIN  # REGULAR TIPTYPE #
          IF TESTIP[I+1] EQ 1 
          THEN
            TER$STIP[0] = STIP1[TETP[I+1]]; # SET STIP IN TRM OUTPT LIN#
          ELSE
            BEGIN 
            IF TESTIP[I+1] EQ 2 
            THEN
              TER$STIP[0] = STIP2[TETP[I+1]]; # SET STIP IN TRM LINE   #
            ELSE
              BEGIN 
              IF TESTIP[I+1] EQ 3 
              THEN
                BEGIN 
                TER$STIP[0] = "XAA";      # SET XAA STIP               #
                END 
              END 
            END 
          END 
 
        IF TETC[I+1] LQ MAXTC 
        THEN                 # CK IF VALID TC                          #
          TER$TC[0] = TC[TETC[I+1]];  # SET TERMINAL CLASS IN TRM LINE #
        IF TECD[I+1] LQ MAXCSET 
        THEN          # CK IF VALID CSET         #
          TER$CSET[0] = CSET[TECD[I+1]]; # SET CSET IN TRM OUTPUT LINE #
        IF TETS[I+1] LQ MAXTSPEED 
        THEN
          TER$TSP[0] = TSPEED[TETS[I+1]]; # SET TSPEED IN TERMINAL LINE#
 
        IF (TETP[I+1] EQ HASP$TIP OR    # HASP OR BCE TIP            #
          TETP[I+1] EQ BCE$TIP) AND 
          TEA1[I+1] NQ 0
        THEN
          BEGIN 
          TEMP2 = XCDD(TEA1[I+1]);
          TER$CO[0] = C<7,3>TEMP2;      # SET CO IN TRM OUTPUT LINE  #
          END 
        ELSE IF TETP[I+1] EQ MD4$TIP OR 
                (TETP[I+1] GQ TT$12 AND TETP[I+1] LQ TT$3270) 
        THEN
          BEGIN 
          TEMP2 = XCHD(TEA1[I+1]);
          TER$CA[0] = C<8,2>TEMP2;        # SET CA IN TRM OUTPUT LINE  #
          END 
 
        WORD = I + 4;         # REFERENCE 1ST WORD OF FNFV ENTRIES     #
        BIT = 24; 
        FOR J=1 STEP 1 UNTIL DEFNFV[I+3]
        DO        # GET NEXT NPU WORD - 16 BITS AND STORE IN FNFV TABLE#
          BEGIN 
          IF BIT+16 LQ 60 
          THEN
            BEGIN 
            FNFV$ENT[0] = B<BIT,16>LRWORD[WORD];
            IF BIT + 16 LS 60 
            THEN
              BIT = BIT + 16; 
            ELSE
              BEGIN 
              BIT = 0;
              WORD = WORD + 1;
              END 
 
            END 
 
          ELSE
            BEGIN            # BIT + 16 GR 60                          #
            B<0,60-BIT>FNFV$ENT[0] = B<BIT,60-BIT>LRWORD[WORD]; 
            B<60-BIT,BIT+16-60>FNFV$ENT[0] =
                B<0,BIT+16-60>LRWORD[WORD+1]; 
            WORD = WORD + 1;
            BIT = BIT +16 - 60; 
            END 
 
          IF FN$ENT[0] GR MAX$FN
          THEN               # FN VALUE TO LARGE                       #
            ERRMSG(ERMSG10,"TRMLST"); 
          ELSE
            GOTO TER$FN[FN$ENT[0]]; 
 
ERRTER: 
            ERRMSG(ERMSG10,"TRMLST");  # BAD FN VALUE                  #
 
TSTJ: 
            TEST J;         # FN VALUE NOT FOR TERMINAL STATEMENT      #
RIC:  
            TER$RIC[0] = YESNOENT[FV$ENT[0]]; # SET RIC IN TRM LINE    #
            TEST J; 
 
BCF:                        # SET BCF FLAG IN TERMINAL OUTPUT LINE     #
            TER$BCF[0] = YESNOENT[FV$ENT[0]]; 
            TEST J; 
 
MREC:                       # SET MREC VALUE IN TERMINAL OUTPUT LINE   #
            TEMP1 = FV$ENT[0];
            TEMP2 = XCDD(TEMP1);
            TER$MREC[0] = C<9,1>TEMP2;
            TEST J; 
 
W:                          # SET W VALUE IN TERMINAL OUTPUT LINE      #
            TEMP1 = FV$ENT[0];
            TEMP2 = XCDD(TEMP1);
            TER$W[0] = C<9,1>TEMP2; 
            TEST J; 
 
CTYP:                       # SET CTYPE FLAG IN TERMINAL OUTPUT LINE   #
            TER$CTYP[0] = CTYP$VAL[FV$ENT[0]];
            TEST J; 
 
NCIR:                       # SET NCIR VALUE IN TERMINAL OUTPUT LINE   #
            TEMP1 = FV$ENT[0];
            TEMP2 = XCDD(TEMP1);
            TER$NCIR[0] = C<7,3>TEMP2;
            TEST J; 
 
NEN:                        # SET NEN VLAUE IN TERMINAL OUTPUT LINE    #
            TEMP1 = FV$ENT[0];
            TEMP2 = XCDD(TEMP1);
            TER$NEN[0] = C<7,3>TEMP2; 
            TEST J; 
 
EOF:        TER$EOF[0] = YESNOENT[FV$ENT[0]];    # PUT EOF FLAG ON LIST#
            TEST J; 
PAD:  
            CTEMP = XCHD(FV$ENT[0]);
            C<PAD$INDX,2>TER$PAD = C<8,2>CTEMP; 
            IF FIR$SEMI                 # IF FIRST HALF FOR A SEMIOCTET#
            THEN
              BEGIN 
              PAD$INDX = PAD$INDX + 2;
              FIR$SEMI = FALSE; 
              END 
            ELSE
              BEGIN                     # SECOND HALF OF A SEMIOCTET   #
              PAD$INDX = PAD$INDX + 3;
              FIR$SEMI = TRUE;
              END 
            TEST J; 
 
COLECT:                      # SET COLLECT VALUE IN TRMNL OUTPUT LINE  #
            TER$CLCT[0] = YESNOENT[FV$ENT[0]];
            TEST J; 
          END  # J LOOP # 
 
        PGLST(LN4); 
        WRITEH(OUTFET,TER$HDR1,11);# WRITE TERMINAL HEADER             #
        WRITEH(OUTFET,TER$HDR2,3);
        WRITEH(OUTFET,TER$LN1,11); # WRITE TERMINAL OUTPUT LINE        #
        WRITEH(OUTFET,TER$LN2,13);
        TER$FIL[0] = " "; 
        TER$FIL2[0] = " ";
        INDX = I;            # SET INDX TO 1ST WORD OF TER ENTRY       #
        DEVLST(INDX);        # PROCESS DEVICE STATEMENTS               #
        I = I + TEWC[I];
        END  # I LOOP # 
 
      RETURN; 
      END   # TRMLST PROC # 
      CONTROL EJECT;
      PROC USERLST; 
      BEGIN 
*IF,DEF,IMS 
# 
**    USERLST - USER STATEMENT LISTER 
* 
*     S.M. ILMBERGER 81/10/29 
* 
*     LISTS INFO FROM USER$TABLE
* 
*     PROC USERLST
* 
*     ENTRY        NONE 
* 
*     EXIT         NONE 
* 
*     MESSAGES
*     ABRT FROM USERLST - READ ERROR
* 
*     METHOD
* 
*     IF AT LEAST ONE ENTRY EXISTST ISN USER$TABLE
*       WRITE USER HEADER TO OUTPUT FILE
*       FOR EACH ENTRY IN USER$TABLE
*         FORMAT USER LINE FROM INFO IN USER$TABLE
*         WRITE USER LINE TO OUTPUT FILE
*     IF NO ENTRIES IN USER$TABLE 
*       READ -EOR-
*     END 
* 
# 
*ENDIF
 
      ITEM I;                # LOOP COUNTER                            #
 
      ARRAY MDP [0:4] S(1); 
        ITEM M$D$P C(00,00,03) = [" ","MAN","DEF","PRI"]; 
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
 
      IF UTWC[ENTRY1] GR 1
      THEN                   # AT LEAST ONE ENTRY EXISTS IN USER$TAB   #
        BEGIN 
        PGLST(LN2);          # COUNT LINES TO BE PRINTED               #
        WRITEH(OUTFET,USER$HDR,9);
                             # WRITE USER HEADER                       #
        READW(LCFFET,USER$TABLE,UTENTSZ,LCF$STAT);
        IF LCF$STAT NQ TRNS$OK         # CK STATUS OF READ             #
        THEN
          ERRMSG(ERMSG2,"USERLST");# PRINT READ ERROR MSG - ABORT      #
        FOR I=ENTRY0 WHILE LCF$STAT EQ TRNS$OK
        DO
          BEGIN 
          USER$NAM[0] = UTNAME[I];  # SET USER NAME IN USER OUTPUT LINE#
          IF UTFAM[I+1] NQ 0
          THEN              # SET USER FAMILY NAME IN USER OUTPUT LINE #
            USER$FAM[0] = XSFW(UTFAM[I+1]); 
          ELSE               # NAME FIELD IS ZERO                      #
            BEGIN 
            IF UTCODE[I+1] NQ 0 
            THEN             # IF FAM WAS ORIGINALLY SPECIFIED         #
              BEGIN 
              USER$FAM[0] = "0";       # PUT VALUE OF -0- FOR FAM NAME #
              END 
            END 
          USER$FST[0] = M$D$P[UTCODE[I+1]]; # SET USER FAM FLAG        #
          IF UTUSER[I+2] NQ 0 
          THEN               # PUT USER NAME IN USER LINE              #
            USER$USER[0] = XSFW(UTUSER[I+2]); 
          USER$UST[0] = M$D$P[UTCODE[I+2]]; # SET USER FLAG IN USER LIN#
          IF UTAPPL[I+3] NQ 0 
          THEN
            USER$APPL[0] = UTAPPL[I+3]; # SET APPL NAME IN USER LINE   #
          USER$AST[0] = M$D$P[UTCODE[I+3]]; # SET APPL FLAG IN USER LIN#
          PGLST(LN1); 
          WRITEH(OUTFET,USER$LN,9); # WRITE USER LINE TO OUTPUT FILE #
          USER$FIL[0] = " ";
          READW(LCFFET,USER$TABLE,UTENTSZ,LCF$STAT);
          END  # I LOOP # 
 
        END 
 
      ELSE                   # NO ENTRIES EXIST IN USER$TABLE          #
        BEGIN 
        READW(LCFFET,USER$TABLE,1,LCF$STAT); # READ -EOR-              #
        IF LCF$STAT NQ LOC(UTWORD[0])              # CK STATUS OF READ #
        THEN
          ERRMSG(ERMSG2,"USERLST"); 
        END 
 
      RETURN; 
      END  # USRLST PROC #
      CONTROL EJECT;
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
      # SET UP OUTFILE FET #
      OUTFIRST[0] = LOC(OUTWORD[0]);
      OUTIN[0] = LOC(OUTWORD[0]); 
      OUTOUT[0] = LOC(OUTWORD[0]);
      OUTLIMIT[0] = LOC(OUTWORD[0]) + PRULNGTH + 1; 
      # SET UP PAGE HEADER   #
      LST$TYP[0] = " ";      # CLEAR LISTING TYPE                      #
      VER$NUM[0] = C<9,3>NAMVER[0];    # SET PROGRAM VERSION           #
      LEV$NUM[0] = C<2,3>NAMLV[0];     # SET PROGRAM LEVEL             #
      PDATE(TEMPACKED);      # GET PACKED DATE AND TIME                #
      TEMPT = 0;
      B<42,18>TEMPT = B<42,18>TEMPACKED;
      TIM[0] = ETIME(TEMPT); # UNPACK TIME - STORE IN TABLE            #
      TEMP1 = 0;
      C<7,3>TEMP1 = C<4,3>TEMPACKED;   # SET UP FOR EDATE              #
      TEMPD = EDATE(TEMP1);  # UNPACK DATE                             #
      DAT[0] = TEMPD;        # SET DATE                                #
      PAGE$N[0] = "0";
      IF CRERUN 
      THEN                   # CREATION RUN                            #
        BEGIN 
        TITLE[0] = TITLE$WORD[0]; 
        IF LISTFLG           # IF LISTING IS NOT TO BE SUPPRESSED      #
        THEN
          BEGIN 
          IF LISTN
          THEN               # NORMAL LISTING REQUIRED                 #
            SRCLST; 
          IF ERRCNT GR 0
            OR WARNCNT GR 0 
          THEN               # ERROR LISTING IS NECESSARY              #
            ERRLST; 
          IF LISTD
          THEN               # DEFINE LISTING REQUIRED                 #
            DEFLST; 
          IF LISTS
          THEN               # EXPANDED SOURCE LISTING REQUIRED        #
            EXSLST; 
          IF LISTF AND ERRCNT EQ 0
          THEN               # SUMMARY LISTING REQUIRED                #
            BEGIN 
            IF NCFDIV 
            THEN             # NCF SUMMARY REQUIRED                    #
              NCFLST; 
            IF LCFDIV 
            THEN             # LCF SUMMARY REQUIRED                    #
              LCFLST; 
            END 
          WRITER(OUTFET);    # FLUSH CIO BUFFER FOR OUTPUT FILE        #
          END 
        ELSE                 # LISTING IS TO BE SUPPRESS (L=0)         #
          BEGIN 
          IF ERRCNT GR 0     # IF FATAL ERRORS EXIST                   #
          THEN
            BEGIN 
            ERRLST;          # GENERATE ERROR SUMMARY                  #
            WRITER(OUTFET);  # FLUSH CIO BUFFER FOR OUTPUT FILE        #
            END 
          END 
 
        END 
 
      ELSE
        BEGIN                # SUMMARY RUN                             #
        IF LISTFLG           # IF LISTING IS NOT TO BE SUPPRESSED      #
        THEN
          BEGIN 
          IF LISTNF 
          THEN               # NCF SUMMARY REQUIRED                    #
            BEGIN 
            NCFLFN[0] = NFFILE; 
            NCFLST; 
            END 
 
          IF LISTLF 
          THEN               # LCF SUMMARY REQUIRED                    #
            BEGIN 
            LCFLFN[0] = LFFILE; 
            LCFLST; 
            END 
          WRITER(OUTFET);    # FLUSH CIO BUFFER FOR OUTPUT FILE        #
          END 
 
        END 
 
      RETURN; 
      END 
TERM