*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# BNODEMAP[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 CDENAME[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"; CDEV$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] = BLRWORD[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] = BLRWORD[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$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 CINC$FAM[0] EQ 0 # IF ZERO FILLED # THEN BEGIN CINC$FAM[0] = " "; # BLANK FILLED # END IF CINC$USER[0] EQ 0 # IF ZERO FILLED # THEN BEGIN CINC$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 CINC$DTEA[0] = BIBDTEA[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(BIBRANAME[0]); CINC$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]); CINC$FIL[0] = C<08,02>CTEMP; END CINC$FIL[0] = XCHD(FACT2[0]); TEMP1 = TEMP1 + 1; END PGLST(LN1); # INCREMENT LINE COUNT # WRITEH(OUTFET,INC$LN,13); # WRITE LINE TO OUTPUT FILE # INC$FIL[0] = " "; # CLEAR LINE IMAGE BUFFER # END READW(LCFFET,INCALL$TABLE,1,LCF$STAT); # READ FIRST WORD OF NEXT ENTRY # END # I LOOP # END ELSE # NO ENTRIES EXIST IN INCALL$TABLE # BEGIN READW(LCFFET,INCALL$TABLE,1,LCF$STAT); # READ -EOR- # IF LCF$STAT NQ LOC(IBWORD[0]) # CK STATUS OF READ # THEN ERRMSG(ERMSG2,"INLST"); END # ELSE # RETURN; END # INLST PROC # CONTROL EJECT; PROC LCFLST; BEGIN *IF,DEF,IMS # ** LCFLST - LCF LISTER * * S.M. ILMBERGER 81/10/28 * * SUPERVISE LCF INFO LISTING * * PROC LCFLST * * ENTRY NONE * * EXIT NONE * * MESSAGES * ABORT FROM LCFLST - READ ERROR * ABORT FROM LCFLST - INVALID RECORD TYPE * ERROR IN LCF-SUMMARY LISTING SUPRESSED * * METHOD * * SET UP LCF-FET * READ PRFX$TABLE INTO BUFFER * IF LCF IS VALID * SET UP HEADER INFO * PRINT LCF HEADER LINES * FOR EACH RECORD IN LCF FILE * READ RECORD INTO BUFFER * CALL APPROPRIATE PROC TO PROCESS EACH RECORD * END * # *ENDIF DEF NUM$LCF$REC # 4 #; # NUMBER OF LCF RECORDS # DEF PRF$7700L # 17 #; # PREFIX TABLE LENGTH # ITEM I; # LOOP COUNTER # SWITCH BLK$TYP APPL$R, USER$R, OUTCALL$R, INCALL$R; CONTROL EJECT; # # # CODE BEGINS HERE # # # LST$TYP[0] = " LCF SUMMARY "; LCFFIRST[0] = LOC(LCRBUFF[0]);# PT FET AT WORKING STORAGE BUFFER # LCFIN[0] = LOC(LCRBUFF[0]); LCFOUT[0] = LOC(LCRBUFF[0]); LCFLIMIT[0] = LOC(LCRBUFF[0]) + PRULNGTH + 1; REWIND(LCFFET); READ(LCFFET); # FILL CIO BUFFER WITH FILE HEADER RECORD # RECALL(LCFFET); READW(LCFFET,PRFX$TABLE,18,LCF$STAT); # READ RECORD INTO BUFF # NET$NAME[0] = PT$FNAME[0]; # SAVE FILE NAME # SKIPEI(LCFFET); # POSITION POINTER TO LAST RECORD # SKIPB(LCFFET,2); READ(LCFFET); # FILL CIO BUFFER W/PRFX$TABLE # RECALL(LCFFET); READW(LCFFET,PRFX$TABLE,18,LCF$STAT); # READ PREFIX TABLE # IF B<0,30>VEWORD0[0] NQ "VALID" OR LCF$STAT NQ LOC(VEWORD1[0]) + 1 THEN BEGIN MESSAGE(EM$ENT[ERMSG9],0); # NOT VALID LCF FILE # ABRTFLG = TRUE; # SET ABORT FLAG # END ELSE BEGIN # VALID LCF FILE # C<0,8>HD$TIME[0] = C<0,8>PT$TIME[0]; # SET UP TIME AND DATE TO # C<0,8>HD$DATE[0] = C<0,8>PT$DATE[0]; # BE PRINTED # TITLE[0] = PT$TITLE[0]; # SET TITLE AND LCF NAME # HD$TYP[0] = "LCF"; NAM$TYP[0] = "LCF"; HDRLST; # PRINT HEADER INFO # REWIND(LCFFET); READ(LCFFET); RECALL(LCFFET); READW(LCFFET,PRFX$TABLE,18,LCF$STAT); FOR I=0 STEP 1 UNTIL NUM$LCF$REC-1 DO BEGIN READ(LCFFET); # FILL CIO BUFFER WITH NEXT RECORD # RECALL(LCFFET); GOTO BLK$TYP[I]; APPL$R: SSTATS(P,2); READW(LCFFET,APPL$TABLE,2,LCF$STAT); # READ APPL$TAB HEADER # IF LCF$STAT NQ TRNS$OK # CK STATUS OF READ # THEN ERRMSG(ERMSG2,"LCFLST"); # PRINT READ ERROR MESSAGE - ABORT# IF AT$IDENT[0] NQ "APPL" THEN ERRMSG(ERMSG4,"LCFLST"); # PRINT INVALID RECORD MSG # APPLST; SSTATS(P,-1*AT$LENG); # RELEASE TABLE SPACE # TEST I; USER$R: SSTATS(P,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,-1*UT$LENG); TEST I; OUTCALL$R: SSTATS(P,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,-1*OB$LENG); TEST I; INCALL$R: SSTATS(P,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,-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,MAXLNCR); SSTATS(P,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,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 BTIPMAP[0] = 1; ELSE BTIPMAP[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,-1*LR$LENG); SSTATS(P,-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] = BNCBWORD[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] = BNCBWORD[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,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,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,I); TEST I; PL$XREF: READREC(P,I); TEST I; LLK$XREF: READREC(P,I); TEST I; LN$XREF: READREC(P,I); TEST I; DEV$XREF: TEST I; LN$REC$IDX: READREC(P,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,-1*NCF$LENG); # RELEASE ALL TABLE SPACE # SSTATS(P,-1*NCB$LENG); SSTATS(P,-1*NP$LENG); SSTATS(P,-1*PL$LENG); SSTATS(P,-1*LL$LENG); SSTATS(P,-1*LCT$LENG); SSTATS(P,-1*LI$LENG); SSTATS(P,-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 BNODEMAP[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 BNODEMAP[WORD] EQ 0 # FIND UNUSED NODE NUMBERS LESS# THEN # THEN THE MAX NODE NUMBER # BEGIN UNUSEDNODE = TRUE; TEMP1 = I; TEMP2 = XCDD(TEMP1); CNODNUMS[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,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 # BNODEMAP[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(BOBUDATA[WORDC]); # EXTRACT 4 BITS EACH # # TIME # COUTC$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$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 # COUTC$DTA[0] = BDTEA + 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]); COUTC$FL3[0] = C<8,2>CTEMP; END COUTC$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] = BNCBWORD[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] = BNCBWORD[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 = 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] = BNCBWORD[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] = BNCBWORD[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); # 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 BTIPMAP[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] = BLRWORD[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] = BLRWORD[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]); CTER$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