*DECK NETREL
*IF,DEF,DEBUG
USETEXT AIPDEF
USETEXT NP$DB
USETEXT NP$MODE
USETEXT NP$NWL
USETEXT NP$ZHDR
*ENDIF
PROC NETREL((LFN),(MSGLTH),(FRWD)); # INITIALIZE OR RELEASE ZZZZZDN #
BEGIN
*CALL NP$CRT
*IF DEF,IMS
#
*1DC NETREL
*
* 1. PROC NAME AUTHOR DATE
* NETREL E. GEE 86/01/20
*
* 2. FUNCTIONAL DESCRIPTION
* ROUTE DEBUG LOG FILE TO INPUT QUEUE AND/OR WRITE JOB RECORD
* TO DEBUG LOG FILE AND/OR UPDATE THE MAXIMUM NUMBER OF WORDS
* OF TEXT THAT IS TO BE WRITTEN TO THE DEBUG LOG FILE.
*
* 3. METHOD USED
* IF LFN IS NONZERO,
* IF ZZZZZDN FILE ALREADY EXISTS,
* CALL NP$WRTR TO WRITE END OF RECORD TO ZZZZZDN FILE.
* IF NO I/O ERROR ON ZZZZZDN FILE,
* SET UP DSP PARAMETER BLOCK.
* CALL NP$ROUT TO ROUTE FILE TO INPUT QUEUE.
* IF DSP ERROR,
* CALL NP$MSG TO ISSUE INFORMATIVE DAYFILE MESSAGE.
* ELSE (I/O ERROR OCCURRED WHEN END OF RECORD WAS WRITTEN),
* CALL NP$MSG TO ISSUE INFORMATIVE DAYFILE MESSAGE.
* IF I/O OR DSP ERROR ON ZZZZZDN FILE,
* CALL NP$RETN TO RETURN FILE.
* INITIALIZE FET.
* IF REWIND OF JOB RECORD FILE IS NEEDED,
* CALL NP$RWD TO REWIND JOB RECORD FILE.
* IF NO I/O ERROR ON JOB RECORD FILE,
* CALL NP$READ TO READ LOGICAL RECORD FROM JOB RECORD FILE.
* IF I/O ERROR ON JOB RECORD FILE,
* CALL NP$MSG TO ISSUE INFORMATIVE DAYFILE MESSAGE.
* ELSE (NO I/O ERROR ON JOB RECORD FILE),
* CALL NP$WRTR TO WRITE JOB REC PLUS EOR TO DEBUG LOG FILE.
* IF APPLICATION HAS NETTED ON,
* CALL NP$RTIM TO GET SYSTEM RTIME.
* CALL NP$CLK TO GET CURRENT CLOCK TIME.
* CALL NP$DATE TO GET CURRENT DATE.
* CREATE HEADER ENTRY FOR DEBUG LOG FILE.
* CALL NP$WRTW TO WRITE HEADER ENTRY TO CIO BUFFER.
* CALL NP$WRTR TO WRITE END OF RECORD TO DEBUG LOG FILE.
* CALL NP$CLK TO GET CURRENT CLOCK TIME.
* CALL NP$WRTO TO WRITE CLOCK TIME TO CIO BUFFER.
* IF I/O ERROR HAS OCCURRED ON ZZZZZDN FILE,
* CALL NP$PIOE TO PROCESS I/O ERROR.
* IF MSGLTH GREATER THAN ZERO, MODIFY TRUNC. 1@TRUNC@410
*
* 4. ENTRY CONDITIONS
* LFN - NAME OF A LOCAL FILE CONTAINING A JOB RECORD
* MSGLTH - MAXIMUM NUMBER OF WORDS PER MESSAGE THAT CAN BE
* WRITTEN TO ZZZZZDN FILE
* FRWD - FLAG FOR REWINDING BEFORE READING
* 0 FOR REWINDING FILE BEFORE READ
* 1 FOR NO REWIND
*
* 5. EXIT CONDITIONS
* DB$TRUNC - EQUAL TO MSGLTH IF MSGLTH IS GREATER THAN ZERO
* ELSE 410
* DB$FET - INITIALIZED,PREVIOUS ZZZZZDN FILE ROUTED TO INPUT
*
* 6. COMDECKS CALLED AND SYMPL TEXTS USED.
* AIPDEF NP$CRT NP$DB NP$MODE
* NP$NWL NP$ZHDR
*
* 7. PROCEDURES/FUNCTIONS CALLED
* NP$CLK CLOCK TIME IN DISPLAY CODE
* NP$DATE DATE IN DISPLAY CODE
* NP$MSG ISSUE DAYFILE MESSAGE
* NP$PIOE PROCESS I/O ERROR ON DEBUG LOG FILE
* NP$READ READS A LOGICAL RECORD
* NP$RETN RETURN FILE
* NP$ROUT ROUTES A FILE TO INPUT
* NP$RTIM REAL TIME SINCE DEADSTART IN SECONDS AND
* MILLISECONDS
* NP$RWD REWIND FILE
* NP$WRTR CLOSES FILE BY WRITING EOR
* NP$WRTW WRITES WORDS TO CIRCULAR IO BUFFER.
*
* 8. DAYFILE/DIAGNOSTIC MESSAGES
* " READ ERROR ON FILE XXXXXXX - AT=YYB."
* " REWIND ERROR ON FILE XXXXXXX - AT=YYB."
* " ROUTE ERROR ON FILE ZZZZZDN - EC=YYB."
* " WRITE ERROR ON FILE ZZZZZDN - AT=YYB."
*
#
*ENDIF
#
FORMAL PARAMETERS
#
ITEM LFN C(10); # NAME OF LOCAL JOB RECORD #
ITEM MSGLTH I; # MAX NO OF WORDS PER MESSAGE #
ITEM FRWD B; # REWIND/NO REWIND OF LFN #
*IF,DEF,DEBUG
#
ROUTINES CALLED
#
XREF
BEGIN
PROC NP$CLK; # CLOCK TIME IN DISPLAY CODE #
PROC NP$DATE; # DATE IN DISPLAY CODE #
PROC NP$MSG; # ISSUE DAYFILE MESSAGE #
PROC NP$PIOE; # PROCESS I/O ERROR ON DISK FILE #
PROC NP$READ; # READS A LOGICAL RECORD #
PROC NP$RETN; # RETURN FILES #
PROC NP$ROUT; # ROUTES A FILE #
PROC NP$RTIM; # REAL TIME SINCE DEADSTART #
PROC NP$RWD; # REWIND FILE #
PROC NP$WRTR; # WRITE END OF RECORD #
PROC NP$WRTW; # WRITE WORDS TO CIO BUFFER #
PROC NP$WRTO; # WRITE ONE WORD #
END
#
DEF-S
#
DEF JOTWRD$ # O"66" #; # WORD POSITION OF JOB ORIGIN TYPE #
DEF SYOT$ # 0 #; # ORIGIN TYPE FOR SYSTEM ORIGIN JOB #
#
LOCAL VARIABLES
#
ITEM AT; # ABNORMAL TERMINATION CODE FROM READ #
ITEM CHARWD C(10);
ITEM DSPEC; # ERROR CODE RETURNED FROM DSP #
ITEM I; # INDUCTION VARIABLE #
ITEM TIMEWD;
ARRAY ERRMSG S(5); # ERROR MESSAGE IF ROUTE FAILS #
BEGIN
ITEM ERRMSGT C(0,0,07); # TYPE OF FUNCTION PERFORMED ON FILE #
ITEM ERRMSG1 C(0,42,3) = [" ER"];
ITEM ERRMSG2 C(1,0,10) = ["ROR ON FIL"];
ITEM ERRMSG3 C(2,0,02) = ["E "];
ITEM ERRMSGF C(2,12,7); # NAME OF FILE WITH ERROR #
ITEM ERRMSG4 C(2,54,6) = [" "];
ITEM ERRMSG5 C(3,0,02) = ["- "];
ITEM ERRMSGC C(3,12,2); # NAME OF FIELD WITH ERROR CODE #
ITEM ERRMSG6 C(3,24,1) = ["="];
ITEM ERRMSGRC U(3,30,12); # ERROR CODE FROM DSP/CIO #
ITEM ERRMSG7 C(3,42,3) = ["B. "];
ITEM ERRMSGE U(4,0,60) = [0];
END
ARRAY PARAM P(7); # PARAMETER BLOCK TO ROUTE LFN TO INPUT #
BEGIN
ITEM PAR$NAME C(0,0,7)=["ZZZZZDN"];# NAME OF FILE BEING ROUTD#
ITEM PAR$EC U(0,42,6); # ERROR CODE RESPONSE #
ITEM PAR$F B(00,48,01); # FORCED ORIGIN FLAG #
ITEM PAR$OT U(00,53,06); # FORCED JOB ORIGIN TYPE #
ITEM PAR$CB B(0,59,1)=[FALSE]; # COMPLETE BIT #
ITEM PAR$DISP C(1,24,2); # DISPOSITION OF FILE #
ITEM PAR$EP B(1,47,1); # ERROR PROCESSING FLAG #
ITEM PAR$DCF B(1,55,1); # DISPOSITION CODE SET FLAG #
ITEM PAR$ID B(1,58,1); # ROUTE TO CENTRAL SITE #
ITEM PAR$WD1 I(1,0,WL)=[0];
ITEM PAR$WD2 I(2,0,WL)=[0];
END
BASED ARRAY JOT [00:00] S(1);
BEGIN # JOB ORIGIN TYPE FIELD #
ITEM JOT$TYPE U(00,24,12);
END
BASED ARRAY LFNNAME;
BEGIN
ITEM LFNAME C(0,0,10); # NAME OF LOCAL FILE #
ITEM LFILE I(0,0,60); # =0 IF NO LOCAL FILE #
END
*ENDIF
#**********************************************************************#
#
NETREL EXECUTION STARTS HERE
#
ENTRY PROC QTREL((LFN),(MSGLTH),(FRWD)); # QTRM ENTRY POINT #
*IF,DEF,DEBUG
DSPEC = 0; # INIT TO NO ERROR IN ROUTE CALL#
P<LFNNAME> = LOC(LFN);
IF LFILE[0] NQ 0
THEN # THERE IS LOCAL FILE TO COPY #
BEGIN
DB$JR = TRUE; # SET JOB RECORD FILE EXIST FLAG#
FOR I = 0 STEP 1 UNTIL 6
DO # CONVERT ZEROS INTO BLANKS #
BEGIN
IF B<I*6,6>LFNAME[0] EQ 0
THEN # BIN ZERO TO CONVERT TO BLANK #
BEGIN
C<I,1>DB$LFN = " "; # REPLACE WITH BLANK #
END
ELSE # LETTER IN NAME #
BEGIN
C<I,1>DB$LFN = C<I,1>LFNAME[0]; # COPY LETTER #
END
END
DB$RWD = NOT FRWD; # SET REWIND JOB RECORD FILE FLG#
IF FET$LFN[0] EQ "ZZZZZDN" # FILE ZZZZZDN ALREADY EXISTS #
THEN # ROUTE ZZZZZDN FILE TO INPUT #
BEGIN
NP$WRTR(DB$FET,1); # WRITE EOR ON FILE ZZZZZDN #
AT = FET$AT[0]; # ABNORMAL TERMINATION CODE #
IF AT EQ 0
THEN # NO RMS I/O ERROR HAS OCCURRED #
BEGIN
P<JOT> = JOTWRD$; # GET JOB ORIGIN TYPE #
IF JOT$TYPE EQ SYOT$
THEN # IF THIS IS A SYSTEM ORIGIN JOB#
BEGIN
PAR$F[0] = TRUE; # SET ROUTE TO SYSTEM ORIGIN #
PAR$OT[0] = SYOT$;
END
ELSE #THIS IS NOT A SYSTEM ORIGIN JOB#
BEGIN
PAR$F[0] = FALSE; # SET ROUTE TO DEFAULT ORIGIN #
END
PAR$CB[0] = FALSE;
PAR$DISP[0] = "IN"; # ROUTE TO INPUT QUEUE #
PAR$EP[0] = TRUE; # ERROR PROCESSING FLAG #
PAR$DCF[0] = TRUE;
PAR$ID[0] = TRUE;
NP$ROUT(PARAM,1); # ROUTE ZZZZZDN FILE #
DSPEC = PAR$EC[0]; # ERROR CODE RESPONSE FROM DSP #
IF DSPEC NQ 0
THEN # ROUTE FAILED DUE TO ERROR #
BEGIN
ERRMSGT[0] = " ROUTE "; # ADD ROUTE TO DAYFILE MESSAGE #
ERRMSGF[0] = "ZZZZZDN"; # NAME OF FILE ROUTED #
ERRMSGC[0] = "EC"; # NAME OF FIELD CONTAINING RC #
ERRMSGRC[0] = ((DSPEC/8)+27)*64 + DSPEC - (DSPEC/8)*8+27;
NP$MSG(ERRMSG,3);
END
# NSUPWRD BASED ARRAY POINTER TO THE USER COMMUNICATION WORD
WAS SET BY NETON. THE ARRAY IS LOCATED IN NP$NWL COMDECK.
ZERO MESSAGE COUNTER FIELD IN NSUP COMMUNICATION WORD.
#
MSGCNT[0] = 0;
#
RESET THRESHOLD VALUE FOR WRITING EOR TO LOGFILE.
#
DB$ERCT = 500;
END
ELSE # WRITE ERROR OCCURRED ON FILE #
BEGIN
ERRMSGT[0] = " WRITE "; # ADD WRITE TO DAYFILE MESSAGE #
ERRMSGF[0] = "ZZZZZDN"; # NAME OF FILE WITH WRITE ERROR #
ERRMSGC[0] = "AT"; # NAME OF FIELD CONTAINING RC #
ERRMSGRC[0] = ((AT/8) + 27)*64 + AT - (AT/8)*8 + 27;
NP$MSG(ERRMSG,3); # ISSUE DAYFILE MESSAGE #
END
IF (DSPEC NQ 0) OR # ROUTE OF FILE ZZZZZDN FAILED #
(AT NQ 0 ) # WRITE TO FILE ZZZZZDN FAILED #
THEN # NEED TO GET RID OF BAD FILE #
BEGIN
NP$RETN(DB$FET); # RETURN TRACE FILE #
END
END
#
INITIALIZE FET
#
FET$LN[0] = 0; # INITIALIZE LEVEL NUMBER FIELD #
FET$AT[0] = 0; # INIT ABNORMAL TERM CODE FIELD #
FET$CODE[0] = 1; # SET COMPLETION BIT #
FET$LEN[0] = 3; # SET FET LENGTH #
TIMEWD = LOC(DB$BUF); # TIMEWD USED AS A TEMPORARY STO#
FET$FIRST[0] = TIMEWD; # INITIALIZE CIRCULAR BUFFER PTR#
FET$IN[0] = TIMEWD;
FET$OUT[0] = TIMEWD;
FET$LIMIT[0] = TIMEWD + 192;
#
COPY JOB RECORD TO ZZZZZDN FILE
#
AT = 0; # INITIALIZE ABNORMAL TERM FLAG #
FET$LFN[0] = LFNAME[0]; # LFN OF JOB RECORD FILE #
IF NOT FRWD
THEN # NEED TO REWIND JOB RECORD FILE#
BEGIN
NP$RWD(DB$FET); # REWIND FILE TO BOI #
ERRMSGT[0] = " REWIND"; # TYPE OF FUNCTION PERFORMED #
AT = FET$AT[0]; # ABNORMAL TERMINATION CODE #
END
IF AT EQ 0
THEN # NO I/O ERROR ON JOB REC FILE #
BEGIN
NP$READ(DB$FET,1); # READ LOGICAL RECORD OF LFN #
IF (FET$AT[0] NQ 0) AND # NO ABNORMAL TERMINATION CODE #
(FET$AT[0] NQ 1) # EOI NOT ENCOUNTERED #
THEN # NO ERROR OCCURRED ON READ #
BEGIN
ERRMSGT[0] = " READ "; # TYPE OF FUNCTION PERFORMED #
AT = FET$AT[0]; # ABNORMAL TERMINATION CODE #
END
END
FET$LFN = "ZZZZZDN"; # RESET FILE NAME IN FET #
FET$AT[0] = 0;
FET$LN[0] = 0; # INITIALIZE LEVEL NUMBER FIELD #
IF AT NQ 0
THEN # ISSUE DAYFILE MSG FOR I/O ERR #
BEGIN
ERRMSGF[0] = DB$LFN; # NAME OF FILE WITH READ ERROR #
ERRMSGC[0] = "AT"; # NAME OF FIELD CONTAINING RC #
ERRMSGRC[0] = ((AT/8)+27)*64 + AT - (AT/8)*8 + 27;
NP$MSG(ERRMSG,3); # ISSUE DAYFILE MESSAGE #
END
ELSE # JOB RECORD WAS NOT READ #
BEGIN
NP$WRTR(DB$FET,1); # WRITE EOR TO FILE ZZZZZDN #
END
IF ACCEPTED # APP HAS NETTED ON #
THEN # CREATE TRACE FILE HEADER REC #
BEGIN
NP$RTIM(TIMEWD); # REAL TIME SINCE DEADSTART #
ZH$TIM[0] = TIMEWD;
NP$CLK(CHARWD); # CLOCK TIME #
ZH$CLK[0] = CHARWD;
NP$DATE(CHARWD); # DATE #
ZH$DATE = CHARWD;
NP$WRTW(DB$FET,ZHDR,4); # COPY HEADER TO ZZZZZDN FILE #
NP$WRTR(DB$FET,1); # WRITE END OF RECORD #
NP$CLK(CHARWD); # CLOCK TIME #
NP$WRTO(DB$FET,CHARWD); # WRITE TIME STAMP #
END # DEBUG LOG FILE HEADER WRITTEN #
IF FET$AT[0] NQ 0
THEN # RMS I/O ERROR HAS OCCURRED #
BEGIN
NP$PIOE(DB$FET); # PROCESS I/O ERROR #
END
END
#
UPDATE DB$TRUNC
#
IF MSGLTH GR 0
THEN
BEGIN
IF MSGLTH GR 410
THEN
MSGLTH = 410;
DB$TRUNC = MSGLTH;
END
*ENDIF
RETURN;
END # NETREL #
TERM