*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:
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