PROC CALCTS;
# TITLE CALCTS - CALCULATE TABLE SPACE. #
BEGIN # CALCTS #
#
** CALCTS - CALCULATE TABLE SPACE.
*
* THIS PROCEDURE WILL CALCULATE THE NUMBER OF ENTRIES AND THE SPACE
* REQUIRED FOR EACH OF THE VARIABLE TABLES, AND STORE THE RESULTS
* IN THE ARRAY *MAT*.
*
* EXIT TABLE CALCULATIONS COMPLETED.
#
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCMD
*CALL COMBLBL
*CALL COMBLRQ
*CALL COMBMAT
*CALL COMBMCT
*CALL COMBTDM
*CALL COMBUDT
*CALL COMXBST
*CALL COMXCTF
*CALL COMXEXP
*CALL COMXFCQ
*CALL COMXHLR
*CALL,COMXIPR
*CALL COMXINT
*CALL COMXLTC
*CALL COMXMFD
*CALL COMXMSC
ITEM TEMPCOUNT U; # TEMPORARY COUNT FIELD #
CONTROL EJECT;
#
* CALCULATES THE SPACE REQUIRED AND THE NUMBER OF ENTRIES FOR EACH
* OF THE VARIABLE TABLES, AND STORES THE RESULTS IN THE ARRAY
* *MAT*.
#
TEMPCOUNT = Q+2;
MAT$COUNT[MAT$ENTRY"HLRQ"] = TEMPCOUNT;
MAT$SPACE[MAT$ENTRY"HLRQ"] = HLRQLEN * TEMPCOUNT;
MAT$COUNT[MAT$ENTRY"LLRQ"] = TEMPCOUNT;
MAT$SPACE[MAT$ENTRY"LLRQ"] = LLRQENTL * TEMPCOUNT;
MAT$COUNT[MAT$ENTRY"RTRQ"] = Q * RTRQ$SPACE;
MAT$SPACE[MAT$ENTRY"RTRQ"] = (TDAMLEN + 1) * (Q * RTRQ$SPACE);
MAT$COUNT[MAT$ENTRY"FCTQ"] = Q; # SET FCTQ FIELD #
MAT$SPACE[MAT$ENTRY"FCTQ"] = (FCTQHL+FCTENTL) * Q;
BSTL = MAXCTN * 2;
MAT$COUNT[MAT$ENTRY"BST"] = BSTL;
MAT$SPACE[MAT$ENTRY"BST"] = BSTENTL * BSTL;
LTCTCNT = FAMCNT + 3;
MAT$COUNT[MAT$ENTRY"LTCT"] = FAMCNT + 3;
MAT$SPACE[MAT$ENTRY"LTCT"] = LTCL * (FAMCNT + 3);
MAT$COUNT[MAT$ENTRY"MRFT"] = FAMCNT;
MAT$SPACE[MAT$ENTRY"MRFT"] = MRFTLEN * FAMCNT;
MAT$COUNT[MAT$ENTRY"OMT"] = MAXSM;
MAT$SPACE[MAT$ENTRY"OMT"] = OMTENTL * MAXSM;
MAT$COUNT[MAT$ENTRY"OCT"] = 8 * FAMCNT;
MAT$SPACE[MAT$ENTRY"OCT"] = OCTENTL * 8 * FAMCNT;
MAT$COUNT[MAT$ENTRY"PREAMBLE"] = 8 * FAMCNT;
MAT$SPACE[MAT$ENTRY"PREAMBLE"] = PRMTLEN * 8 * FAMCNT * 3;
MAT$COUNT[MAT$ENTRY"SCR$BUF"] = BSTL;
MAT$SPACE[MAT$ENTRY"SCR$BUF"] = SCCBL * BSTL;
MAT$COUNT[MAT$ENTRY"UDT$CONT"] = MAXCTN;
MAT$SPACE[MAT$ENTRY"UDT$CONT"] = UDTCUL + 1; # HEADER INCLUDED #
MAT$COUNT[MAT$ENTRY"UDT$SM"] = MAXSMUNIT;
MAT$SPACE[MAT$ENTRY"UDT$SM"] = UDTSML;
MAT$COUNT[MAT$ENTRY"CAT$FET"] = 1;
MAT$SPACE[MAT$ENTRY"CAT$FET"] = RFETL;
MAT$COUNT[MAT$ENTRY"CAT$BUF"] = 1;
MAT$SPACE[MAT$ENTRY"CAT$BUF"] = FCTBL;
MAT$COUNT[MAT$ENTRY"MAP$FET"] = 1;
MAT$SPACE[MAT$ENTRY"MAP$FET"] = RFETL;
MAT$COUNT[MAT$ENTRY"MAP$BUF"] = 1;
MAT$SPACE[MAT$ENTRY"MAP$BUF"] = MAPBUFL;
MAT$COUNT[MAT$ENTRY"TEMP$FET"] = 1;
MAT$SPACE[MAT$ENTRY"TEMP$FET"] = RFETL * 2;
MAT$COUNT[MAT$ENTRY"TEMP$BUF"] = 1;
MAT$SPACE[MAT$ENTRY"TEMP$BUF"] = TBUFL;
MAT$COUNT[MAT$ENTRY"TEMP$WB"] = 1;
MAT$SPACE[MAT$ENTRY"TEMP$WB"] = WBUFL;
MAT$COUNT[MAT$ENTRY"AST$BUF"] = 1;
MAT$SPACE[MAT$ENTRY"AST$BUF"] = ABUFLEN;
MAT$COUNT[MAT$ENTRY"LABBUF"] = 1;
MAT$SPACE[MAT$ENTRY"LABBUF"] = LABLEN;
MAT$COUNT[MAT$ENTRY"MW$BUFS"] = MAXCTUNIT * CHANPC;
MAT$SPACE[MAT$ENTRY"MW$BUFS"] = MAXCTUNIT * CHANPC *
(MWBUFL + SFMWL + 1);
# READ BUFFER ADDRESS INCLUDED #
MAT$COUNT[MAT$ENTRY"MR$BUFS"] = MAXCTUNIT * CHANPC;
MAT$SPACE[MAT$ENTRY"MR$BUFS"] = MAXCTUNIT*CHANPC*(MRBUFL+SFMRL);
MAT$COUNT[MAT$ENTRY"SBT"] = MAXCTUNIT + (2 * MAXSMUNIT) + 1;
MAT$SPACE[MAT$ENTRY"SBT"] = (MAXCTUNIT+(2*MAXSMUNIT)+1) * MSGLT;
END # CALCTS #
TERM
PROC CRAST((FCTX),(QADDR),(ASTADDR));
# TITLE CRAST - CREATE *AST* ENTRY. #
BEGIN # CRAST #
#
** CRAST - CREATE *AST* ENTRY.
*
* THIS PROCEDURE WILL SCAN THE *FCT* ENTRY AT ORDINAL *FCTX* TO
* CREATE THE CORRESPONDING TRIAL *AST* ENTRY TO BE
* CHECKED WITH THE EXISTING AST IN THE PROCEDURE OPENCAT.
*
* PROC CRAST((FCTX),(QADDR),(ASTADDR))
*
* ENTRY (FCTX) = ORDINAL OF *FCT* ENTRY.
* (QADDR) = ADDRESS OF *FCTQ* ENTRY.
* (ASTADDR) = ADDRESS OF *AST* BUFFER.
*
* EXIT *AST* ENTRY HAS BEEN CONSTRUCTED.
#
ITEM FCTX U; # ORDINAL OF *FCT* ENTRY #
ITEM QADDR U; # ADDRESS OF *FCTQ* ENTRY #
ITEM ASTADDR U; # ADDRESS OF *AST* BUFFER #
DEF SPACES #" "#; # SPACES #
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBMCT
*CALL COMXCTF
*CALL COMXFCQ
*CALL COMXINT
*CALL COMXMSC
ITEM ATBNDRY B; # TRUE IF AT *CDP* OR DONE #
ITEM DONE B; # TRUE IF AFTER LAST AU #
ITEM I U; # INDEX #
ITEM LASTBUSY U; # LAST PROTECTED AU #
ITEM NXTFREE U; # NEXT (EXPECTED) FREE VOLUME #
ITEM PREVVOL U; # AU OF PREVIOUS VOLUME #
ITEM TEMP U; # TEMPORARY #
ITEM THISAU U; # LOOP INDEX #
ITEM TOTAU U; # TOTAL AU AVAILABLE FOR
ALLOCATION #
ITEM VOLLN U; # NUMBER OF (EXPECTED)
CONTINUATION AU #
CONTROL EJECT;
P<FCT> = QADDR + FCTQHL;
IF AST$STAT[FCTX] NQ ASTENSTAT"ASS$CART"
THEN
BEGIN
RETURN;
END
#
* DET OFF CARTRIDGE LINK AND ALLOCATION ALLOWED FLAGS IS AST.
#
AST$NOCLF[FCTX] = FCT$OCLF[FCTX] EQ 7;
AST$AAF[FCTX] = NOT ( FCT$IAF[0] OR FCT$LCF[0] OR ##
FCT$EEF[0] OR FCT$SEF[0] OR ##
FCT$FCF[0]) OR (FCT$ORD[0] NQ FCTX);
#
* THE OBJECTIVES OF THE FOLLOWING ANALYSIS OF THE *FCT* ENTRY
* ARE THREEFOLD:
*
* 1) COUNT THE AU AVAILABLE FOR ALLOCATION.
*
* 2) IDENTIFY THE FREE AU WHICH CAN SAFELY BE ALLOCATED
* FOR STORAGE OF FILE DATA, LEAVING ALONE THOSE AU
* WHICH ARE UNALLOCATED, BUT ARE FLAGGED, FLAWED OR
* INCLUDED WITHIN THE COUNT OF CONTINUATION AU OF
* AN AU OR VOLUME WHICH IS ALLOCATED.
*
* 3) RE-ORGANIZE THESE USABLE AU INTO VOLUMES AND REBUILD
* THE CHAIN OF AVAILABLE VOLUMES FOR USE BY THE ALLOCATOR.
*
* A LOOP EXAMINES EACH AU IN THE *FCT* ENTRY. EACH AU IS
* REJECTED AS BEING AVAILABLE IF IT IS BUSY, FLAWED, OR HAS
* OTHER FLAGS SET. AN AU WHICH IS EXPECTED TO BE A
* CONTINUATION AU FOR A VOLUME AVAILABLE FOR ALLOCATION IS
* ACCEPTED IN THE VOLUME IF IT IS NOT BUSY OR FLAGGED.
* ANY AU WHICH IS NOT BUSY, FLAGGED, OR PART OF A VOLUME IS
* TREATED AS THE START OF A NEW VOLUME, AND PROPERLY LINKED
* INTO THE CHAIN OF FREE VOLUMES.
*
* THE FOLLOWING SEQUENCE OF STEPS IS TAKEN TO ACHIEVE THE ABOVE:
*
* 1) DETERMINE IF THIS AU IS JUST AFTER A BOUNDARY POINT,
* I.E., IT IS JUST AFTER THE LAST AU FOR SHORT OR LONG FILES.
*
* 2) IF A VOLUME OF FREE AU IS BEING ACCUMULATED, REDUCE THE
* VOLUME LENGTH IF IT WOULD OTHERWISE INCLUDE AN AU WHICH
* SHOULD NOT BE PART OF THE VOLUME.
*
* 3) IF THIS AU IS JUST AFTER A BOUNDARY POINT (SEE STEP 1),
* - VERIFY THAT THE FREE VOLUME CHAIN IS TERMINATED WITH A
* LINK=0.
* - SAVE THE COUNT OF FREE AU IN THE *FCT* HEADER.
* - IF AT START OF AU FOR LONG FILES, RESET COUNTERS.
*
* 4) IF THIS AU IS BUSY,
* - SET A VARIABLE SO THAT ANY AU WHICH ARE CLAIMED TO
* BE CONTINUATION AU ARE NOT TREATED AS AVAILABLE FOR
* ALLOCATION REGARDLESS OF THEIR *FCT* ENTRY.
* - LOOP TO EXAMINE THE NEXT AU.
*
* 5) IF THE AU IS PROTECTED (SEE STEP 4) OR FLAGGED, LOOP TO
* EXAMINE THE NEXT AU.
*
* 6) PROCESS THE AU WHICH IS REALLY AVAILABLE FOR ALLOCATION.
* - CLEAR CONTINUATION FLAG..FORCE A HEAD OF VOLUME STATUS.
* - ADJUST IF NECESSARY THE FREE VOLUME LINKAGE TO POINT
* TO THIS AU (VOLUME).
* - SAVE LENGTH FIELD AS THE COUNT OF NUMBER OF EXPECTED
* CONTINUATION AU.
* - SAVE LINK FIELD AS THE NEXT EXPECTED FREE VOLUME.
* - SAVE THE ID OF THIS VOLUME IN CASE ITS LENGTH HAS
* TO BE REDUCED (SEE STEP 2), OR ITS LINK HAS TO BE
* ADJUSTED (SEE ABOVE SUBSTEP).
#
FCT$FLAWS[0] = 0;
PREVVOL = 0;
NXTFREE = FCT$FAUSF[0];
TOTAU = 0;
VOLLN = 0;
LASTBUSY = 0;
DONE = FALSE;
FOR THISAU = 1 STEP 1 WHILE NOT DONE
DO
BEGIN # THISAU LOOP #
#
* STEP 1 - DETERMINE IF AT A BOUNDARY POINT.
#
SETFCTX(THISAU);
DONE = THISAU GR FCT$AVOT[0];
ATBNDRY = (THISAU EQ FCT$CDP[0]) OR DONE;
#
* STEP 2 - IF IN A SEQUENCE OF CONTINUATION AU, VERIFY THAT
* THIS AU CAN BE INCLUDED. IF NOT, CORRECT VOLUME LENGTH.
#
IF VOLLN NQ 0
THEN
BEGIN # STEP 2 #
FCT$CLFG(0,0) = FCT$CLFG(FWD,FPS);
FCT$CAUF(0,0) = 1-FCT$CAUF(0,0);
IF (FCT$FLGS1(0,0) EQ 0) ##
AND NOT ATBNDRY
THEN # AU IS OK AS A CONTINUATION AU #
BEGIN
TOTAU = TOTAU + 1;
FCT$CLFG(FWD,FPS) = 0;
FCT$CAUF(FWD,FPS) = 1;
FCT$LEN(FWD,FPS) = VOLLN - 1;
FCT$LINK(FWD,FPS) = PREVVOL;
VOLLN = VOLLN - 1;
TEST THISAU;
END
ELSE # TERMINATE THIS VOLUME AND ADJUST
ITS LENGTH #
BEGIN
SETFCTX(PREVVOL);
FCT$LEN(FWD,FPS) = FCT$LEN(FWD,FPS) - VOLLN;
VOLLN = 0;
END
END # STEP 2 #
#
* STEP 3 - PROCESS BOUNDARY CONDITION.
#
IF ATBNDRY
THEN
BEGIN # STEP 3 #
SETFCTX(PREVVOL);
IF NXTFREE NQ 0
THEN # SET LINK TO ZERO #
BEGIN
FCT$LINK(FWD,FPS) = 0;
END
IF DONE
THEN # FINISHED AU FOR LONG FILES #
BEGIN
AST$AULF[FCTX] = TOTAU;
IF FCT$FAULF[0] EQ 0
THEN
BEGIN
AST$AULF[FCTX] = 0;
END
TEST THISAU;
END
ELSE # FINISHED AU FOR SHORT FILES #
BEGIN
AST$AUSF[FCTX] = TOTAU;
TOTAU = 0;
PREVVOL = 0;
NXTFREE = FCT$FAULF[0];
END
END # STEP 3 #
#
* STEP 4 - PROCESS AU BUSY.
#
SETFCTX(THISAU);
IF FCT$FBF(FWD,FPS) EQ 1
THEN # AU IS BUSY, PROTECT ALL AU
COVERED BY LENGTH FIELD #
BEGIN
TEMP = THISAU + FCT$LEN(FWD,FPS);
IF TEMP GR LASTBUSY
THEN
BEGIN
LASTBUSY = TEMP;
END
TEST THISAU;
END
#
* STEP 5 - SKIP ANY AU THAT ARE PROTECTED OR FLAGGED.
#
FCT$CAUF(FWD,FPS) = 0; # CLEAR CONTINUATION AU FLAG #
IF FCT$FAUF(FWD,FPS) NQ 0
THEN # COUNT FLAWED AU #
BEGIN
FCT$FLAWS[0] = FCT$FLAWS[0] + 1;
END
IF THISAU LQ LASTBUSY ##
OR (FCT$FLGS1(FWD,FPS) NQ 0)
THEN
BEGIN
TEST THISAU;
END
#
* STEP 6 - ENSURE THE VOLUME HEADED BY THIS AU IS IN THE
* FREE SPACE CHAIN.
* - IF THE NEXT EXPECTED FREE VOLUME (*NXTFREE*)
* IS BEYOND THIS AU, INSERT THIS AU IN THE MIDDLE
* OF THE CHAIN.
* - IF THE NEXT EXPECTED FREE VOLUME IS PRIOR TO THIS
* AU, CORRECT THE LINK FIELD OF THE PREVIOUS VOLUME
* BY LINKING TO THIS AU.
* - USE THE VOLUME LENGTH AND LINK FIELDS AS SPECIFIED
* BY THIS AU-S *FCT* ENTRY. IF THEY ARE NOT CORRECT,
* STEP 2 WILL REDUCE THE LENGTH, AND STEP 3 OR THIS
* STEP WILL CORRECT THE LINK FIELD.
#
IF THISAU NQ NXTFREE
THEN # NEED TO CORRECT LINKAGE #
BEGIN # CORRECT LINKAGE #
IF THISAU LS NXTFREE
THEN # ADD THIS AU (VOLUME) TO CURRENT
CHAIN #
BEGIN
FCT$LINK(FWD,FPS) = NXTFREE;
END
#
* ADJUST LINK FIELD OF PREVIOUS ENTRY TO POINT TO THIS VOLUME.
#
IF PREVVOL EQ 0
THEN # UPDATE FREE SPACE POINTERS #
BEGIN
IF THISAU LS FCT$CDP[0]
THEN # UPDATE SHORT FILE POINTER #
BEGIN
FCT$FAUSF[0] = THISAU;
END
ELSE # UPDATE LONG FILE POINTER #
BEGIN
FCT$FAULF[0] = THISAU;
END
END
ELSE # UPDATE PREVIOUS LINK #
BEGIN
SETFCTX(PREVVOL);
FCT$LINK(FWD,FPS) = THISAU;
END
END # CORRECT LINKAGE #
SETFCTX(THISAU);
TOTAU = TOTAU + 1;
PREVVOL = THISAU;
NXTFREE = FCT$LINK(FWD,FPS);
VOLLN = FCT$LEN(FWD,FPS);
TEST THISAU;
END # THISAU LOOP #
FCT$CLFG(0,0) = 0;
RETURN;
END # CRAST #
TERM
PROC GETRTP;
# TITLE GETRTP - GETS AND PROCESSES RUN TIME PARAMETERS. #
BEGIN # GETRTP #
#
** GETRTP - GETS AND PROCESSES RUN TIME PARAMETERS.
*
* THIS ROUTINE WILL GET AND PROCESS THE TUNING PARAMETER
* AND THE TRACE MODE PARAMETER.
*
* PROC GETRTP
*
* EXIT THE RUN TIME PARAMETERS HAVE BEEN PROCESSED.
*
* MESSAGE 1) EXEC ABORT - SYNTAX ERROR.
*
* 2) *Q* PARAMETER TOO LARGE -
* MAXIMUM ALLOWABLE VALUE SUBSTITUTED.
*
* 3) *Q* PARAMETER TOO SMALL -
* MINIMUM ALLOWABLE VALUE SUBSTITUTED.
#
#
**** PROC GETRTP - XREF LIST BEGIN.
#
XREF
BEGIN
PROC EXTAB; # SETS UP PARAMETER LIST #
PROC MESSAGE; # ISSUES MESSAGE TO DAYFILE #
PROC XARG; # CRACK PARAMETER LIST #
PROC XDXB; # CONVERT DECIMAL TO BINARY #
END
#
**** PROC GETRTP - XREF LIST END.
#
DEF DEC$TYPE #1#; # DECIMAL TYPE CONVERSION #
DEF QAVERAGE #10#; # AVERAGE TUNING PARAMETER VALUE #
DEF QMAXIMUM #50#; # MAXIMUM TUNING PARAMETER VALUE #
DEF QMINIMUM #6#; # MINIMUM TUNING PARAMETER VALUE #
DEF SYNTAXOK #0#; # NO SYNTAX ERRORS #
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMXCTF
*CALL COMXEXP
*CALL COMXINT
*CALL,COMXJCA
ITEM ARGLIST U; # ADDRESS OF ARGUMENT LIST #
ITEM ARG$Q I; # INTEGER TUNING PARAMETER #
ITEM DFLT B; # DEFAULT *Q* FLAG #
ITEM FLAG U; # STATUS FLAG FOR ASARG #
ITEM OPTION U; # OPTION TO SKIP PROGRAM NAME #
#
* MESSAGE BUFFER.
#
ARRAY MSGBUF[0:0] P(5);
BEGIN # ARRAY MSGBUF #
ITEM MSG$LINE C(00,00,40); # MESSAGE LINE #
ITEM MSG$RZRO C(04,00,12); # ZERO BYE TERMINATOR #
END # ARRAY MSGBUF #
CONTROL EJECT;
#
* GET THE RUN TIME PARAMETERS.
#
EXTAB(ARGLIST); # SET UP ARGUMENT LIST #
OPTION = 0; # SKIP OVER PROGRAM NAME #
XARG(ARGLIST,OPTION,FLAG); # GET PARAMETERS #
IF FLAG NQ SYNTAXOK
THEN
BEGIN # IF SYNTAX ERRORS DETECTED BY ASARG #
MSG$LINE[0] = " EXEC ABORT - SYNTAX ERRORS. ";
MESSAGE(MSGBUF[0],UDFL1); # ERROR MESSAGE TO DAYFILE #
FATALERR = TRUE;
RETURN;
END # IF SYNTAX ERRORS DETECTED BY ASARG #
#
* CHANGE DISPLAY CODE *S* PARAMETER TO DECIMAL INTEGER. IF
* *S* PARAMETER IS NOT FOUND ON CONTROL COMMAND, *ARG$S*
* WILL BE SET TO -1.
#
XDXB(ARG$SC[0],DEC$TYPE,ARG$S);
#
* SET THE SMALLEST *HLRQ* COUNT.
#
Q = MAXSMUNIT * 2; # SET MAXIMUN AND DEFAULT *HLRQ* COUNT #
IF MIMHLRQ LS Q
THEN
BEGIN # FORCE THE SMALLEST *HLRQ* COUNT #
Q = MIMHLRQ;
END
#
* SET *RA$TRACE* TO *TRUE* IF *TM* PARAMETER SPECIFIED.
#
RA$TRACE = (ARG$T NQ -1);
RETURN;
END # GETRTP #
TERM
PROC GETUDT;
# TITLE GETUDT - DETERMINES THE PROPERTIES OF THE CONFIGURATION. #
BEGIN # GETUDT #
#
** GETUDT - DETERMINES THE PROPERTIES OF THE CONFIGURATION.
*
* THIS ROUTINE WILL INITIALIZE VARIABLES DEFINING THE
* CONFIGURATION OF THE CONTROLLERS AND STORAGE MODULES.
*
* PROC GETUDT.
*
* ENTRY M860 HARDWARE CONFIGURATION EXISTS.
*
* EXIT CONFIGURATION INFORMATION HAS BEEN PROCESSED.
*
* MESSAGES 1) ATTACH ERROR - BUDT FILE BUSY.
*
* 2) ATTACH ERROR - BUDT FILE NOT FOUND.
*
* 3) BUDT CONTROLLER ENTRY COUNT EXCEEDED.
*
* 4) BUDT CONTROLLER TABLE READ ERROR.
*
* 5) BUDT READ ERROR.
*
* 6) BUDT SM ENTRY COUNT EXCEEDED.
*
* 7) BUDT SM TABLE READ ERROR.
*
* 8) EST ORDINAL XX - NO UDT ENTRY.
*
* 9) EST READ ERROR.
*
* 10) EST/UDT CHANNEL MISMATCH.
*
* 11) MORE CHANNELS THAN MSG FETS.
*
* 12) VERIFY ERROR ON EST ENTRY XX.
*
* NOTES *INITTAB* MUST BE CALLED BEFORE *GETUDT* SO THAT AN
* I/O BUFFER IS AVAILABLE TO READ THE BUDT INTO
* *SSEXEC*.
*
* *KINIT* MUST BE CALLED BEFORE *GETUDT* SO THAT A
* K-DISPLAY MESSAGE CAN BE ISSUED ALLOWING THE OPERATOR
* TO RUN *SSALTER* TO MODIFY THE UDT.
*
* THE *UCP* INTERFACE MUST BE INITIALIZED BEFORE
* *GETUDT* IS CALLED SO THAT *SSALTER* MAY BE RUN.
#
#
**** PROC GETUDT - XREF LIST BEGIN.
#
XREF
BEGIN
PROC ATTACH; # ATTACH FILE #
PROC BZFILL; # BLANK OR ZERO FILLS #
PROC PFD; # PFM ENTRY #
PROC SETPFP; # SETS USER INDEX AND FAMILY #
PROC MESSAGE; # CALLS *MESSAGE* MACRO #
PROC RDEST; # READ EST ENTRIES #
PROC READ; # READS FILE TO I/O BUFFER #
PROC READW; # READS FILE TO WORKING BUFFER #
PROC RETERN; # RETURNS FILE #
PROC RTIME; # GET REAL TIME #
FUNC XCOD C(10); # CONVERT OCTAL TO DISPLAY #
PROC ZSETFET; # SETS UP *FET* #
END
#
**** PROC GETUDT - XREF LIST END.
#
DEF CNTYPE #"SS"#; # CONTROLLER TYPE #
DEF DOWNSTATUS #3#; # CONTROLLER EST *DOWN* STATUS #
DEF ESTCHAN(CUO,UCHO) #B<13+(UCHO*6),5>EST$WORD[0]#;
# EST CHANNEL #
DEF ESTON(UCHO) # B<12+(UCHO*6),1>EST$WORD[0]#;
# EST CHANNEL STATUS #
DEF FILLSIZE #7#; # FILL SIZE FOR *BZFILL* #
DEF FIRSTCHAN #1#; # PRIMARY EST CHANNEL INDEX #
DEF IDLESTATUS #1#; # CONTROLLER EST *IDLE* STATUS #
DEF OFFSTATUS #2#; # CONTROLLER EST *OFF* STATUS #
DEF ONSTATUS #0#; # CONTROLLER EST *ON* STATUS #
DEF READMODE #1#; # READ MODE FOR ATTACH #
DEF UDTEX(CUO,CIFO) #B<CIFO,1>UD$CHEX[CUO]#;
# SET IF CHANNEL EXISTS #
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBCMD
*CALL COMBCPR
*CALL,COMBFET
*CALL COMBKDD
*CALL COMBMAT
*CALL,COMBPFP
*CALL COMBPFS
*CALL COMBUCR
*CALL COMBUDT
*CALL COMSPFM
*CALL COMXBST
*CALL COMXCTF
*CALL COMXINT
*CALL COMXJCA
ITEM BITMAPPOS U; # BIT POSITION IN EST ORD BIT MAP #
ITEM BITMAPWORD U; # EST ORDINAL BIT MAP WORD #
ITEM BUFL U; # I/O BUFFER LENGTH #
ITEM DESIREDORD I; # EST ORD TO CHECK IN BIT MAP #
ITEM ESTNUM U; # COUNT OF EST ENTRIES READ #
ITEM ESTORD C(10); # DISPLAY CODE EST ORDINAL #
ITEM NUM I; # NUMBER OF EST ENTRIES #
ITEM FETL U; # TEMP BUFFER FET LENGTH #
ITEM FOUND B; # SET IF EST/UDT MATCH FOUND #
ITEM I U; # INDEX #
ITEM J U; # INDEX #
ITEM K I; # INDEX #
ITEM LFN C(7); # BUDT LOCAL FILENAME #
ITEM PASSWORD C(7); # BUDT FILE PASSWORD #
ITEM STAT U; # FUNCTION RETURN STATUS #
ITEM TMPCCNT U; # TEMP CHANNEL COUNT #
#
* ARRAY TO MARK SS-TYPE EQUIPMENT.
#
ARRAY EQBITS [0:8] S(9);
BEGIN
ITEM EQUSED U(00,00,60); # BIT MAP WORD #
END
#
* EST BUFFER.
#
ARRAY ESTB [0:0] S(2);
BEGIN # EST #
ITEM EST$WORD U(00,00,60); # EST WORD #
ITEM EST$STAT U(00,10,02); # CONTROLLER STATUS #
ITEM EST$CHBDWN B(00,12,01); # CHANNEL *B* DOWN #
ITEM EST$CHB U(00,13,05); # CHANNEL *B* #
ITEM EST$CHADWN B(00,18,01); # CHANNEL *A* DOWN #
ITEM EST$CHA U(00,19,05); # CHANNEL *A* #
ITEM EST$CHDDWN B(00,24,01); # CHANNEL *D* DOWN #
ITEM EST$CHD U(00,25,05); # CHANNEL *D* #
ITEM EST$CHCDWN B(00,30,01); # CHANNEL *C* DOWN #
ITEM EST$CHC U(00,31,05); # CHANNEL *C* #
ITEM EST$CONT U(00,37,11); # CONTROLLER TYPE #
ITEM EST$CNCT U(00,48,03); # CONNECT CODE #
END # EST #
#
* UDT CHANNEL ARRAY.
#
ARRAY UDTCH [0:MAX$CH] S(1);
BEGIN
ITEM UDTCWORD U(00,00,06); # CHANNEL WORD #
ITEM UDTBSTAT B(00,00,01); # CHANNEL STATUS (BOOLEAN) #
ITEM UDTSTAT U(00,00,01); # CHANNEL STATUS #
ITEM UDTCHAN U(00,01,05); # CHANNEL NUMBER #
END
#
* *MISSING UDT ENTRY* ERROR MESSAGE BUFFER.
#
ARRAY MISMB [0:0] S(4);
BEGIN # MESSAGE BUFFER #
ITEM MIS$1 C(00,00,13) = [" EST ORDINAL "];
ITEM MIS$NUM U(01,18,24); # EST ORDINAL #
ITEM MIS$2 C(01,42,16) = [" - NO UDT ENTRY."];
ITEM MIS$ZRO U(03,18,42) = [0]; # ZERO-BYTE TERMINATOR #
END # MESSAGE BUFFER #
#
* GENERAL ERROR MESSAGE BUFFER.
#
ARRAY MSGMB [0:0] S(5);
BEGIN # MESSAGE BUFFER #
ITEM MSG$LINE C(00,00,40); # MESSAGE LINE #
ITEM MSG$ZRO U(04,00,12) = [0]; # ZERO-BYTE TERMINATOR #
END # MESSAGE BUFFER #
#
* *VERIFY* ERROR MESSAGE BUFFER.
#
ARRAY VERMB [0:0] S(4);
BEGIN # MESSAGE BUFFER #
ITEM VER$1 C(00,00,27) = [" VERIFY ERROR ON EST ENTRY "];
ITEM VER$NUM C(02,42,24); # EST ORDINAL #
ITEM VER$2 C(03,06,06) = ["."];
ITEM VER$ZRO U(03,12,48) = [0]; # ZERO-BYTE TERMINATOR #
END # MESSAGE BUFFER #
CONTROL EJECT;
#
* READ BUDT INTO TEMPORARY BUFFER.
#
LFN = BUDT;
PASSWORD = BUDTPW;
BZFILL(LFN,TYPFILL"ZFILL",FILLSIZE); # CLEAR FILENAME #
BZFILL(PASSWORD,TYPFILL"ZFILL",FILLSIZE); # CLEAR PASSWORD #
PFP$UI = DEF$UI; # SET *SETPFP* PARAMETERS #
PFP$FAM = FAM$NAME[DEFAULTORD];
PFP$FG1 = TRUE;
PFP$FG4 = TRUE;
SETPFP(PFP[0]); # SET USER INDEX AND FAMILY #
#
* TRY ATTACHING BUDT FILE 10 TIMES BEFORE TERMINATING.
#
SLOWFOR I = 0 STEP 1 UNTIL 10
DO
BEGIN
PFD("ATTACH",LFN,0,"PW",PASSWORD,"RC",PFSTAT,"NA",0,"UP",0,0);
IF PFSTAT EQ OK
THEN
BEGIN # BUDT ATTACHED #
GOTO ENDCON;
END
END # ATTACH BUDT LOOP #
ENDCON:
IF PFSTAT NQ OK
THEN # PROCESS ATTACH ERROR #
BEGIN # ABORT #
MSG$LINE[0] = " ATTACH ERROR - BUDT FILE BUSY.";
IF PFP$STAT[0] NQ FBS
THEN # BUDT FILE NOT FOUND #
BEGIN # NOT FOUND #
MSG$LINE[0] = " ATTACH ERROR - BUDT FILE NOT FOUND.";
END # NOT FOUND #
GOTO GETUDT1;
END # ABORT #
BUFL = MAT$SPACE[MAT$ENTRY"TEMP$BUF"];
FETL = MAT$SPACE[MAT$ENTRY"TEMP$FET"];
ZSETFET(TFETADR,LFN,TBUFADR,BUFL,FETL);
READ(TFET,RCL); # READ BUDT WITH AUTO-RECALL #
#
* READ BUDT FROM TEMPORARY BUFFER INTO UDT SPACE.
#
P<UDT$WORD> = UDTCADR;
READW(TFET,UDT$WORD,1,STAT);
IF STAT NQ OK
THEN # READ COMPLETED WITH ERRORS #
BEGIN # ABORT #
MSG$LINE[0] = " BUDT READ ERROR.";
GOTO GETUDT1;
END # ABORT #
IF UDT$LINE$CUN[0] GR MAXCTN
THEN # CONTROLLER TABLE TOO LARGE #
BEGIN # ABORT #
MSG$LINE[0] = " BUDT CONTROLLER ENTRY COUNT EXCEEDED.";
GOTO GETUDT1;
END # ABORT #
IF UDT$LINE$SMN[0] GR MAXSM
THEN # SM TABLE TOO LARGE #
BEGIN # ABORT #
MSG$LINE[0] = " BUDT SM ENTRY COUNT EXCEEDED.";
GOTO GETUDT1;
END # ABORT #
UDT$WORDCNT[0] = MAT$SPACE[MAT$ENTRY"UDT$CONT"]
+ MAT$SPACE[MAT$ENTRY"UDT$SM"];
READW(TFET,UDT$CN,UDTCUL,STAT); # STORE CU TABLE #
IF STAT NQ OK
THEN # READ COMPLETED WITH ERRORS #
BEGIN # ABORT #
MSG$LINE[0] = " BUDT CONTROLLER TABLE READ ERROR.";
GOTO GETUDT1;
END # ABORT #
READW(TFET,UDT$SMA,UDTSML,STAT); # STORE *SM* TABLE #
IF STAT NQ OK
THEN # READ COMPLETED WITH ERRORS #
BEGIN # ABORT #
MSG$LINE[0] = " BUDT SM TABLE READ ERROR.";
GOTO GETUDT1;
END # ABORT #
RETERN(TFET,RCL); # RETURN BUDT WITH AUTO-RECALL #
RETERN(TFET,RCL);
#
* INITIALIZE UDT CONTROLLER AND SM ENTRIES.
#
SLOWFOR I = 1 STEP 1 UNTIL 9
DO # PRESET EST ORDINAL BIT MAP #
BEGIN # PRESET #
EQUSED[I] = 0;
END # PRESET #
MAX$ACHN = 0; # PRESET ACTIVE CHANNEL COUNT #
SLOWFOR I = 1 STEP 1 WHILE UD$EXIST[I] AND I LQ MAXCTN
DO # PRESET CONTROLLER ENTRIES #
BEGIN # PRESET #
NUM = 1;
ESTNUM = UD$ESTO[I];
RDEST(ESTB,NUM,ESTNUM); # READ EST ENTRY #
IF NUM NQ 1
THEN # ABORT ON READ ERROR #
BEGIN
MSG$LINE[0] = "EST READ ERROR.";
GOTO GETUDT1;
END
IF EST$CONT[0] NQ CNTYPE # CONTROLLER TYPE MISMATCH #
OR EST$CNCT[0] NQ UD$CUDA[I] # CONNECT MISMATCH #
THEN # CONTROLLER ENTRY IS INCORRECT #
BEGIN # ABORT #
ESTORD = XCOD(UD$ESTO[I]); # SET EST ORDINAL IN MESSAGE #
VER$NUM[0] = C<6,4>ESTORD;
MESSAGE(VERMB,SYSUDF1);
FATALERR = TRUE;
RETURN;
END # ABORT #
UD$CUON[I] = EST$STAT[0] EQ ONSTATUS # MOVE CU STATUS #
OR EST$STAT[0] EQ IDLESTATUS;
UDTCWORD[0] = UD$CHANA[I]; # COPY UDT CHANNEL INFO #
UDTCWORD[1] = UD$CHANB[I];
UDTCWORD[2] = UD$CHANC[I];
UDTCWORD[3] = UD$CHAND[I];
TMPCCNT = 0; # PRESET TEMP CHANNEL COUNT #
SLOWFOR J = 0 STEP 1 UNTIL MAX$CH
DO # SCAN EST ENTRY FOR CHANNELS #
BEGIN # SCAN EST #
IF J EQ FIRSTCHAN # IN CASE CHANNEL 0 #
OR ESTCHAN(I,J) NQ 0
THEN # EST CHANNEL FOUND #
BEGIN # FOUND #
FOUND = FALSE;
SLOWFOR K = 0 STEP 1 UNTIL MAX$CH
DO # SCAN ARRAY FOR CHANNEL MATCH #
BEGIN # SCAN UDT #
IF UDTEX(I,K) NQ 0 # UDT CHANNEL FOUND #
AND ESTCHAN(I,J) EQ UDTCHAN[K] # CHANNELS MATCH #
THEN # MOVE CHANNEL STATUS TO UDT #
BEGIN # STATUS #
FOUND = TRUE;
MAX$ACHN = MAX$ACHN + UDTSTAT[K]; # COUNT CHANNELS #
TMPCCNT = TMPCCNT + 1;
IF ESTON(J) EQ 1
THEN # CHANNEL OFF IN EST #
BEGIN # OFF #
UDTBSTAT[K] = FALSE; # TURN OFF CHANNEL IN UDT #
END # OFF #
END # STATUS #
END # SCAN UDT #
IF NOT FOUND
THEN # CHANNEL MISMATCH #
BEGIN # ABORT #
GOTO GETUDT2;
END # ABORT #
END # FOUND #
END # SCAN EST #
IF TMPCCNT NQ (UDTEX(I,0) + UDTEX(I,1) +
UDTEX(I,2) + UDTEX(I,3))
THEN # CHANNEL MISMATCH #
BEGIN # ABORT #
GOTO GETUDT2;
END # ABORT #
UD$CHANA$O[I] = UDTBSTAT[0]; # COPY CHANNEL STATUSES TO UDT #
UD$CHANB$O[I] = UDTBSTAT[1];
UD$CHANC$O[I] = UDTBSTAT[2];
UD$CHAND$O[I] = UDTBSTAT[3];
P<UDT$MSG> = LOC(UD$MSG[I]);
MS$MSQN$CN[0] = I; # STORE CONTROLLER ORDINAL #
BITMAPWORD = UD$ESTO[I]/60;
BITMAPPOS = UD$ESTO[I] - (BITMAPWORD * 60);
B<BITMAPPOS,1>EQUSED[BITMAPWORD] = 1; # NOTE ORD PROCESSED #
END # PRESET #
SLOWFOR I= 1 STEP 1 UNTIL MAX$ACHN
DO
BEGIN
BST$AUTH[I] = TRUE;
END
SLOWFOR BITMAPWORD = 0 STEP 1 WHILE NUM EQ 1
DO # FIND UNUSED M860 EST ENTRIES #
BEGIN # FIND #
SLOWFOR BITMAPPOS = 0 STEP 1 UNTIL 59
DO # SCAN EST ORDINAL BIT MAP WORD #
BEGIN # WORD #
DESIREDORD = BITMAPPOS + (BITMAPWORD * 60);
IF DESIREDORD EQ 0
THEN # AVOID READING ENTIRE EST #
BEGIN # SKIP #
TEST BITMAPPOS; # ONLY READ INDIVIDUAL ENTRIES #
END # SKIP #
NUM = 1;
RDEST(ESTB,NUM,DESIREDORD);
IF NUM NQ 1
THEN # EST ORDINAL NON-EXISTENT #
BEGIN # END #
TEST BITMAPWORD; # REACHED END OF EST #
END # END #
IF EST$CONT[0] EQ CNTYPE
AND B<BITMAPPOS,1>EQUSED[BITMAPWORD] EQ 0
THEN # UNPROCESSED ENTRY FOUND #
BEGIN # MESSAGE #
ESTORD = XCOD(DESIREDORD); # SET EST ORDINAL IN MESSAGE #
MIS$NUM[0] = C<6,4>ESTORD;
MESSAGE(MISMB,SYSUDF1);
END # MESSAGE #
END # WORD #
END # FIND #
SLOWFOR I = 1 STEP 1 WHILE SM$EXIST[I] AND I LQ MAXSMUNIT
DO # PRESET SM ENTRIES #
BEGIN # PRESET #
P<UDT$MSG> = LOC(D0$MSG[I]);
MS$MSQN$CN[0] = I; # STORE SM ORDINAL #
MS$MSQN$D0[0] = TRUE; # SET DRD 0 FLAG #
P<UDT$MSG> = LOC(D1$MSG[I]);
MS$MSQN$CN[0] = I; # STORE SM ORDINAL #
MS$MSQN$D1[0] = TRUE; # SET DRD 1 FLAG #
END # PRESET #
#
* INITIALIZE MESSAGE READ AND WRITE BUFFER FETS.
#
P<FETMWB> = MWRBADR + 1; # ALLOW FOR READ BUFFER PTR #
P<FETMRB> = MRDBADR;
SLOWFOR I = 1 STEP 1 WHILE UD$EXIST[I] AND (I LQ MAXCTN)
DO # CHECK UDT CHANNELS #
BEGIN # CHECK #
CHT$WORD[0] = UD$CHANA[I]; # PRESET TEMPORARY CHANNEL ARRAY #
CHT$WORD[1] = UD$CHANB[I];
CHT$WORD[2] = UD$CHANC[I];
CHT$WORD[3] = UD$CHAND[I];
SLOWFOR J = 0 STEP 1 WHILE J LQ MAX$CIF
DO # FIND ON CHANNELS #
BEGIN # FIND #
IF CHT$ON[J]
AND (CHT$CHAN[J] NQ 0 OR J EQ 0)
THEN # INITIALIZE ASSOCIATED MSG FETS #
BEGIN # INITIALIZE #
IF P<FETMWB> GQ (MWRBADR + MAT$SPACE[MAT$ENTRY"MW$BUFS"])
THEN # MORE CHANNELS THAN MSG FETS #
BEGIN # ABORT #
MSG$LINE[0] = " MORE CHANNELS THAN MSG FETS.";
GOTO GETUDT1;
END # ABORT #
P<FETMRA> = P<FETMWB> - 1;
FRA$MRBADR[0] = P<FETMRB>; # MESSAGE READ BUFFER ADDRESS #
FMW$FIRST[0] = P<FETMWB> + SFMWL; # PRESET WRITE BUFFER #
FMW$IN[0] = FMW$FIRST[0];
FMW$OUT[0] = FMW$FIRST[0];
FMW$CHAN[0] = CHT$CHAN[J];
FMW$CHON[0] = TRUE;
FMW$LIMIT[0] = FMW$FIRST[0] + MWBUFL;
FMR$CU[0] = I; # PRESET READ BUFFER #
FMR$FIRST[0] = P<FETMRB> + SFMRL;
FMR$IN[0] = FMR$FIRST[0];
FMR$OUT[0] = FMR$FIRST[0];
FMR$CHAN[0] = CHT$CHAN[J];
FMR$CIF[0] = J;
FMR$LIMIT[0] = FMR$FIRST[0] + MRBUFL;
P<KWORD> = LOC(FMR$KWORDS[0]); # PRESET K-DISPLAY WORDS #
KW$COMP[0] = TRUE;
P<MWBTMP> = LOC(UD$CAMF[I]);
MWB$ADDR[J] = P<FETMWB>; # SET FET ADDRESS IN CU ORDINAL #
P<FETMWB> = P<FETMWB> + SFMWL + MWBUFL + 1; # NEXT FETS #
P<FETMRB> = P<FETMRB> + SFMRL + MRBUFL;
END # INITIALIZE #
END # FIND #
END # CHECK #
RETURN;
GETUDT2:
MSG$LINE[0] = " EST/UDT CHANNEL MISMATCH.";
GETUDT1:
MESSAGE(MSGMB,SYSUDF1); # ABORT PROCESSING #
FATALERR = TRUE;
RETURN;
END # GETUDT #
TERM
PROC INITDAM;
# TITLE INITDAM - INITIALIZE *TDAM* INTERFACE. #
BEGIN # INITDAM #
#
*** INITDAM - INITAILIZE *TDAM* INTERFACE.
*
* THIS ROUTINE WILL INITIALIZE THE *TDAM* INTERFACE
* AND ISSUE AN EVENT TO SWAP IN THE JOBS WAITING FOR *MSAS*.
* PROC INITDAM.
*
* ENTRY *SSEXEC* HAS BEEN INITIALIZED AND READY TO BE
* CALLED BY WAITING JOBS.
*
* EXIT *TDAM* INTERFACE HAS BEEN INITIALIZED AND
* EVENT TO SWAP IN WAITING JOBS HAS BEEN ISSUED.
#
#
**** PROC INITDAM - XREF LIST BEGIN.
#
XREF
BEGIN
PROC EESET; # ENTERS EVENT IN EVENT TABLE #
PROC SYSTEM; # CALLS *SYSTEM* MACRO #
PROC ZFILL; # ZERO FILLS BUFFER #
END
#
**** PROC INITDAM - XREF LIST END.
#
DEF NO$EQUIP #0#; # NO EQUIPMENT VALUE #
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL,COMBCDD
*CALL COMBTDM
*CALL COMBUDT
*CALL COMXCTF
*CALL COMXINT
*CALL,COMXJCA
ITEM I U; # INDEX #
#
* INITIALIZE *TDAM* INTERFACE AND ISSUE EVENT TO SWAP IN JOBS
* WAITING FOR *MSAS*.
#
P<TDAM> = LOC(RA$TDAM);
ZFILL(TDAM,TDAMLEN);
EESET$EQ[0] = NO$EQUIP; # USE NO EQUIPMENT VALUE #
EESET(EVENT); # SET EVENT INTO EVENT TABLE #
#
* PRESET ALL PP CALL BLOCK ENTRIES.
#
SLOWFOR I = 1 STEP 1 UNTIL PPCBTSIZE
DO # SET PARAMETER WORD ADDRESS #
BEGIN # SET ADDRESS #
PPU$1SS[I] = "1SS";
PPU$PADDR[I] = LOC(PPU$WORD1[I]);
PPU$DRCL[I] = LOC(DRVRRECALL);
END # SET ADDRESS #
PPU$FC[1] = IRTDAM;
PPCBENCNT = PPCBENCNT+1; # INCREMENT PPCALL COUNT #
SPC$SPC[0] = "SPC";
SPC$ADDR[0] = LOC(PPTMP);
PPT$WORD0[0] = PPU$WORD0[1];
SLOWFOR I = 0 WHILE PPT$WORD0[0] NQ 0
DO
BEGIN
SYSTEM(SPC,RCL);
END
END # INITDAM #
TERM
PROC INITFAM;
# TITLE INITFAM - INITIALIZES SUBFAMILY PARAMETERS. #
BEGIN # INITFAM #
#
** INITFAM - INITIALIZES SUBFAMILY PARAMETERS.
*
* PROC INITFAM.
#
#
**** PROC INITFAM - XREF LIST BEGIN.
#
XREF
BEGIN
PROC ABORT; # CALLS *ABORT* MACRO #
PROC BZFILL; # BLANK OR ZERO FILLS #
PROC GETFAM; # GETS TABLE OF FAMILIES #
PROC MESSAGE; # CALLS *MESSAGE* MACRO #
PROC PFD; # PERMANENT FILE REQUEST DELAYS #
PROC RETERN; # RETURNS FILE #
PROC RMVBLNK; # REMOVE MULTIPLE BLANKS #
PROC SETPFP; # SETS USER INDEX AND FAMILY #
FUNC XCOD I; # CHANGES INTEGER TO DISPLAY #
PROC XWOD; # CHANGES INTEGER TO OCTAL #
PROC ZSETFET; # SETS UP *FET* #
END
#
**** PROC INITFAM - XREF LIST END.
#
DEF FILLSIZE #7#; # FILL SIZE FOR *BZFILL* #
DEF NUM$MST #4#; # NUMBER OF *MSA-S* #
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBPFP
*CALL COMBPFS
*CALL COMBUDT
*CALL COMXCTF
*CALL COMXINT
*CALL COMXMSC
*CALL COMSPFM
ITEM ATLEASTONE B; # AT LEAST ONE FOUND FLAG #
ITEM BADNUM U; # BAD FILE INDEX #
ITEM BLKFILL S:TYPFILL = S"BFILL"; # BLANK FILL #
ITEM BLKFOUND B; # BLANK FOUND FLAG #
ITEM FOUND B; # ITEM FOUND FLAG #
ITEM I U; # INDEX #
ITEM J U; # INDEX #
ITEM K U; # INDEX #
ITEM MSGTEMP C(8); # ITEM FOR *BZFILL* #
ITEM NUM$FAM U; # NUMBER OF *GETFAM* ENTRIES #
ITEM UI U; # USER INDEX #
#
* ARRAY TO DISPLAY BAD FILE INFORMATION.
#
ARRAY BADFILE[0:MAXSF] P(3);
BEGIN
ITEM BAD$PFN C(00,00,07); # FILE NAME #
ITEM BAD$FAM C(00,42,08); # FAMILY NAME #
ITEM BAD$INDEX C(01,30,06); # USER INDEX #
END
#
* ARRAY TO USER INDEX DISPLAY CODE.
#
ARRAY DIS[0:0] P(2);
BEGIN
ITEM DIS$UI C(01,24,06); # USER INDEX IN DISPLAY CODE #
END
#
* ARRAY TO HOLD *SFMCAT* FILE NAME.
#
ARRAY CAT[0:0];
BEGIN # CAT #
ITEM CAT$PFN C(00,00,07) = ["SFMCAT "]; # FILE NAME #
ITEM CAT$UNID C(00,36,01); # UNIQUE IDENTIFIER #
END # CAT #
#
* MESSAGE BUFFER.
#
ARRAY MSGBUF[0:0] P(5);
BEGIN # ARRAY MSGBUF #
ITEM MSG$LINE C(00,00,40); # MESSAGE LINE #
ITEM MSG$RZRO C(04,00,12); # ZERO BYE TERMINATOR #
END # ARRAY MSGBUF #
ARRAY SC$FET [0:0] P(SFETL);
;
CONTROL EJECT;
#
* FUNCTION 2 - ANALYZE FAMILIES.
*
* FIND NUMBER AND NAMES OF FAMILIES WITH ALL SUBFAMILY CATALOGS.
#
NFAM = 1;
SSID = ATAS;
GETFAM(FAMT,NUM$FAM,LINK[0],DEFAULTORD,SSID);
DEF$FAM = FAM$NAME[DEFAULTORD];
#
* ATTEMPT TO ATTACH EACH *SFMCAT* FILE FOR EACH FAMILY.
* THE FOLLOWING ACTIONS WILL BE TAKEN DEPENDING ON THE NUMBER
* OF FILES ATTACHED
*
* 1) IF NONE, DO NOTHING,
* 2) IF EIGHT, SAVE THE FAMILY NAME,
* 3) IF SOME BUT NOT EIGHT, ISSUE ERROR MESSAGE.
#
SLOWFOR I = 1 STEP 1 UNTIL NUM$FAM
DO
BEGIN # CHECK ALL FAMILIES FOR EIGHT CATALOGS #
ATLEASTONE = FALSE; # AT LEAST ONE FOUND FLAG #
FOUND = TRUE; # CATALOG FOUND FLAG #
BADNUM = 0; # BAD FILE INDEX #
SLOWFOR J = 0 STEP 1 UNTIL MAXSF
DO
BEGIN # CHECK CATALOG FOR EACH SUBFAMILY #
PFP$UI = DEF$UI + J; # SET USER INDEX FOR *SETPFP* #
PFP$FAM = FAM$NAME[I]; # SET FAMILY NAME FOR *SETPFP* #
PFP$FG1 = TRUE; # SET FAMILY BIT FOR *SETPFP* #
PFP$FG4 = TRUE; # SET INDEX BIT FOR *SETPFP* #
SETPFP(PFP); # SET USER INDEX AND FAMILY #
#
* IF UNABLE TO DO A *SETPFP* ON A FAMILY, IGNORE CATALOG VALIDATION
* AND CONTINUE WITH THE NEXT FAMILY.
#
IF PFP$STAT NQ 0
THEN
BEGIN
TEST I; # NEXT FAMILY #
END
CAT$UNID[0] = XCOD(J); # CHANGE INDEX TO DISPLAY CODE #
PFD("ATTACH",CAT$PFN,0,"RC", ##
PFSTAT,"NA",0,"UP",0,0);
IF PFSTAT EQ 0 OR PFSTAT EQ FBS
THEN
BEGIN # IF ATTACH SUCCESSFUL #
ATLEASTONE = TRUE;
END # IF ATTACH SUCCESSFUL #
ELSE
BEGIN # ERROR OTHER THAN FILE BUSY OR UTILITY ACTIVE #
UI = DEF$UI + J;
XWOD(UI,DIS);
BAD$PFN[BADNUM] = CAT$PFN[0]; # SAVE FILE NAME #
MSGTEMP = FAM$NAME[I];
BZFILL(MSGTEMP,BLKFILL,FILLSIZE);
BAD$FAM[BADNUM] = MSGTEMP; # SAVE FAMILY NAME #
BAD$INDEX[BADNUM] = DIS$UI; # SAVE USER INDEX #
BADNUM = BADNUM + 1; # INCREMENT COUNT #
FOUND = FALSE; # CATALOG NOT ATTACHED #
END # ERROR OTHER THAN FILE BUSY OR UTILITY ACTIVE #
ZSETFET(LOC(SC$FET[0]),CAT$PFN,0,0,SFETL);
RETERN(SC$FET[0],RCL);
END # CHECK CATALOG FOR EACH SUBFAMILY #
IF FOUND
THEN
BEGIN # IF EIGHT CATALOGS EXIST #
NAMEFAM[NFAM] = FAM$NAME[I]; # SAVE FAMILY NAME #
NFAM = NFAM + 1; # INCREMENT FAMILY COUNT #
END # IF EIGHT CATALOGS EXIST #
ELSE
BEGIN # CHECK FOR AT LEAST ONE SUCCESSFUL ATTACH #
IF ATLEASTONE
THEN
BEGIN # OUTPUT MESSAGE FOR EACH BAD FILE #
SLOWFOR J = 0 STEP 1 WHILE J LS BADNUM
DO
BEGIN # FOR EACH BAD FILE #
MSG$LINE[0] = " ATTACH ERROR ON SFM SUBFAMILY CATALOG.";
MESSAGE(MSGBUF,UDFL1);
MSGPFN[0] = BAD$PFN[J];
MSGFAM[0] = BAD$FAM[J];
MSGUI[0] = BAD$INDEX[J];
MSG$LINE[0] = MSG$TEXT[0];
RMVBLNK(MSGBUF[0],40);
MESSAGE(MSGBUF,UDFL1);
END # FOR EACH BAD FILE #
END # OUTPUT MESSAGE FOR EACH BAD FILE #
END # CHECK FOR AT LEAST ONE SUCCESSFUL ATTACH #
END # CHECK ALL FAMILIES FOR EIGHT CATALOGS #
NFAM = NFAM - 1; # SET FAMILY COUNT #
#
* SET THE FATAL ERROR FLAG IF THERE ARE NO FAMILIES WITH
* EIGHT *SFM* CATALOGS.
#
IF NFAM EQ 0
THEN
BEGIN # NO FAMILY WITH 8 CATALOGS FOUND #
FATALERR = TRUE;
MSG$LINE[0] = " INITIALIZATION PROBLEMS -";
MESSAGE(MSGBUF[0],UDFL1);
MSG$LINE[0] = " NO FAMILY WITH 8 CATALOGS FOUND.";
MESSAGE(MSGBUF[0],UDFL1);
END # NO FAMILY WITH 8 CATALOGS FOUND #
END # INITFAM #
TERM
PROC INITFLG;
# TITLE INITFLG - INITIALIZES ASSORTED FLAGS AND COUNTERS. #
BEGIN # INITFLG #
#
** INITFLG - INITIALIZES ASSORTED FLAGS AND COUNTERS.
*
* THIS PROCEDURE WILL INITIALIZE ASSORTED FLAGS AND COUNTERS.
*
* PROC INITFLG.
*
* EXIT FLAGS HAVE BEEN INITIALIZED.
#
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCMD
*CALL COMBLBL
*CALL COMBMAT
*CALL COMBUCR
*CALL COMBUDT
*CALL COMXBST
*CALL COMXCTF
*CALL COMXINT
CONTROL EJECT;
#
* INITIALIZE FLAGS.
#
CURESERVED = FALSE; # CONTROLLER RESERVED FLAG #
DRVRRECALL = FALSE; # DRIVER RECALL FLAG #
DRYUP = FALSE; # DRY-UP FLAG #
EXEC = TRUE; # MSAS EXECUTIVE FLAG #
GLBINTLK = FALSE; # GLOBAL CATALOG INTERLOCK FLAG #
GLBSTFL = TRUE; # GLOBAL STAGE FLAG #
GLBDSFL = TRUE; # GLOBAL DESTAGE FLAG #
GLBUCPSW = FALSE; # GLOBAL *UCP* SWAPPED FLAG #
LABELBUSY = FALSE; # LABEL BUFFER BUSY FLAG #
TERMINATE = FALSE; # TERMINATE FLAG #
#
* INITIALIZE COUNTS.
#
SMCNT = NSM; # NUMBER OF *SM-S* #
FAMCNT = NFAM; # NUMBER OF FAMILIES #
PPCBENCNT = 0; # CALL BLOCK ACTIVE ENTRY COUNT #
#
* INITIALIZE THRESHOLDS.
#
#
* INITIALIZE DELAY EXPIRATION TIMES.
#
ITLK$EXPIR = 0; # RECLAIM CATALOG INTERLOCKS #
MINQ$EXPIR = 0; # MINIMUM QUEUE DELAY EXPIRATION #
KDIS$EXPIR = 0; # K-DISPLAY REFRESH #
#
* INITIALIZE ASSORTED POINTERS.
#
SFBLKPTR = LOC(SFPARMBLK);
END # INITFLG #
TERM
PROC INITLZR;
# TITLE INITLZR - SEQUENCES *SSEXEC-S* INITIALIZATION STEPS. #
BEGIN # INITLZR #
#
*** INITLZR - SEQUENCES *SSEXEC-S* INITIALIZATION STEPS.
*
* THIS ROUTINE WILL MAKE CALLS TO SUBROUTINES AND MACROES TO
* PERFORM ALL NON-HARDWARE INITIALIZATION STEPS FOR *SSEXEC*.
*
* PROC INITLZR.
*
* ENTRY CALLED FROM *SSEXEC*.
*
* EXIT PARAMETERS HAVE BEEN PROCESSED AND ALL NON-HARDWARE
* INITIALIZATION STEPS HAVE BEEN EXECUTED OR THE FATAL
* ERROR FLAG HAS BEEN SET.
*
* NOTES THIS INITIALIZATION ROUTINE MAKES PROCEDURE CALLS TO
* DO THE FOLLOWING:
*
* 1) GET THE RUN TIME PARAMETERS,
* 2) INITIALIZE SUBFAMILY PARAMETERS,
* 3) INITIALIZE ASSORTED FLAGS,
* 4) INITIALIZE ASSORTED TABLES,
* 5) INITIALIZE FOR MULTI-MAINFRAMES,
* 6) ADVISE SYSTEM OF KEYBOARD BUFFER,
* 7) REQUEST ACTIVE SUBSYSTEM STATUS,
* 8) INITIALIZE UDT INTERFACE,
* 9) INITIALIZE *TDAM* INTERFACE.
#
#
**** PROC INITLZR - XREF LIST BEGIN.
#
XREF
BEGIN
PROC CALLSS; # ISSUES REQUEST TO SUBSYSTEM #
PROC GETMI; # GETS MACHINE INFORMATION #
PROC GETRTP; # GETS RUN TIME PARAMETERS #
PROC GETSPS; # GET SYSTEM ORIGIN PRIVILEDGES #
PROC GETUDT; # GETS UNIT DEVICE TABLE #
PROC INITDAM; # INITIALIZES *TDAM* INTERFACE #
PROC INITFAM; # INITIALIZE SUBFAMILY PARAMETERS
#
PROC INITFLG; # INITIALIZES FLAGS #
PROC OPENCAT; # OPEN CATALOGS AND MAPS #
PROC INITSRP; # INITIALIZES FOR *MMF* MODE #
PROC INITTAB; # INITIALIZES ASSORTED TABLES #
PROC KINIT; # INITIALIZES *K* DISPLAY #
PROC RTIME; # INTERFACE TO *RTIME* MACRO #
END
#
**** PROC INITLZR - XREF LIST END.
#
DEF NOPARAM #-1#; # NO PARAMETER SPECIFIED #
DEF SECOND #1#; # SWITCH FOR SECOND BUFFER #
DEF SS$SYS #0#; # REQUEST SUBSYSTEM STATUS CODE #
DEF RSLEN #1#; # RETURN USER STATUS #
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCPR
*CALL COMBUCR
*CALL COMXCTF
*CALL COMXEXP
*CALL COMXINT
*CALL,COMXJCA
ITEM FAMSRP C(7); # FAMILY FOR *INITSRP* #
ITEM MFINDEX U; # MACHINE INDEX FOR *INITSRP* #
ITEM PBLOCK U = 0; # PARAMETER BLOCK #
ITEM SS U; # SUBSYSTEM QUEUE PRIORITY #
ARRAY SPSSTAT [0:0] S(RSLEN);
BEGIN
ITEM SPS$STATUS U(00,48,12); # RETURN STATUS #
END
CONTROL EJECT;
#
* READ AND SAVE RTIME.
#
RTIME(RTIMESTAT);
FIRSTRTIME = RTIMSECS[0];
#
* CHECK SYSTEM ORIGIN PRIVILEDGES.
#
GETSPS(SPSSTAT);
IF SPS$STATUS NQ 0
THEN
BEGIN
FATALERR = TRUE;
END
#
* SET UP *RA* POINTER.
#
P<RA$AREA> = 0;
#
* CALL *GETRTP* TO PROCESS RUN TIME PARAMETERS.
#
GETRTP;
IF FATALERR
THEN
BEGIN # IF FATAL ERROR #
RETURN;
END # IF FATAL ERROR #
#
* CALL *INITFAM* TO INITIALIZE SUBFAMILY PARAMETERS.
#
INITFAM;
IF FATALERR
THEN
BEGIN # IF FATAL ERROR #
RETURN;
END # IF FATAL ERROR #
#
* CALL *INITFLG* TO INITIALIZE ASSORTED FLAGS.
#
INITFLG;
#
* CALL *INITTAB* TO INITIALIZE ASSORTED TABLES.
#
INITTAB;
IF FATALERR
THEN
BEGIN
RETURN;
END
#
* CALL *INITSRP* TO INITIALIZE FOR MULTI-MAINFRAMES.
#
GETMI(CMRINFO,EVENT);
EESET$EVT = EESET$ASXE; # MSAS SET UP #
EESET$ASXE = 0;
IF ARG$SC EQ NOPARAM
THEN
BEGIN # *S* NOT SPECIFIED #
FAMSRP = FAM$NAME[LINK$ORD[0]];
MFINDEX = CMR$MFID[0];
END # *S* NOT SPECIFIED #
ELSE
BEGIN # *S* PARAMETER SPECIFIED #
FAMSRP = DEF$FAM;
MFINDEX = ARG$S;
END # *S* PARAMTER SPECIFIED #
INITSRP(CMR$MID[0],MFINDEX,FAMSRP);
#
* CALL *KINIT* TO INITIALIZE *K* DISPLAY.
#
KINIT;
#
* CALL *CALLSS* MACRO TO REQUEST ACTIVE SUBSYSTEM STATUS AND
* INITIALIZE RA.SSC AND *UCPPARMSW* FOR INCOMING *UCP* REQUESTS.
* *UPCPARMSW* INDICATES WHICH BUFFER THE NEXT *UCP* REQUEST
* WILL USE.
#
SS = SS$SYS; # REQUEST ACTIVE STATUS CODE #
CALLSS(SS,PBLOCK,NRCL); # REQUEST ACTIVE STATUS #
RA$SSWWRD[0] = 0;
RA$SSCINLK = FALSE;
RA$SSCPP = TRUE;
RA$SSCXP = 0;
RA$SSCVF = TRUE;
RA$SSCLP = CPRLEN + 2;
RA$SSCAP = LOC(PRAMUCP); # SET *UCP* PARAMETER ADDRESS #
RA$SSPN = "SSEXEC";
RA$SSCODE = SSID;
UCPPARMSW = SECOND; # SET NEXT BUFFER SWITCH #
#
* CALL *GETUDT* TO INITIALIZE UDT INTERFACE.
#
GETUDT;
IF FATALERR
THEN
BEGIN # IF FATAL ERROR #
RETURN;
END # IF FATAL ERROR #
#
* CALL OPENCAT TO INITIALIZE THE OCT AND OMT TABLES AND
* TO FIND ANY DESCREPENCIES IN THE AST.
#
OPENCAT;
#
* INITIALIZE *TDAM* INTERFACE AND ISSUE EVENT TO SWAP IN JOBS
* WAITING FOR *MSAS*.
#
INITDAM;
END # INITLZR #
TERM
PROC INITSRP((MID),(MIDX),(LINKFAM));
# TITLE INITSRP - INITIALIZE SLAVE REQUEST PROCESSOR. #
BEGIN # INITSRP #
#
** INITSRP - INITIALIZE THE SLAVE REQUEST PROCESSOR.
*
* *INITSRP* INITIALIZES THE *SSEXEC* FOR MULTIMAINFRAME
* PROCESSING. IT WILL INITIALIZE THE *MTOS* FILE WHICH IS USED TO
* COMMUNICATE WITH EACH *SLVEXEC*. IT WILL ALSO ATTACH IN
* READ-ALLOW-MODIFY MODE THE *STOM* FILES FROM ALL POSSIBLE SLAVE
* MAINFRAMES SO STAGING REQUESTS FROM *SLVEXEC* PROGRAMS CAN BE
* ACCEPTED AND PROCESSED.
*
* PROC INITSRP((MID),(MIDX),(LINKFAM))
*
* ENTRY (MID) = 2 CHARACTER ID OF THE MASTER MAINFRAME.
* (MIDX) = MACHINE INDEX (1-4) OF THE MASTER MAINFRAME.
* (LINKFAM) = NAME OF THE FAMILY ON WHICH THE
* COMMUNICATION FILES RESIDE, OR ARE TO
* RESIDE.
*
* EXIT THE VARIABLES *STOM$EXPIR* AND *MTOS$EXPIR* (IN
* *COMXCTF*) ARE INITIALIZED TO INDICATE THE TIMES WHEN
* THE *STOM* FILES SHOULD BE MONITORED AND THE *MTOS*
* FILE SHOULD BE UPDATED, RESPECTIVELY. IF THE
* *SSEXEC* IS TO RUN IN SINGLE MAINFRAME MODE, THESE
* TIMES ARE SET TO THE LARGEST POSSIBLE VALUE.
*
* NOTES THE *SSEXEC* WILL RUN IN SINGLE MAINFRAME MODE IF ANY
* OF THE FOLLOWING CONDITIONS ARE MET.
* 1) THE MAINFRAME IS NOT IN MULTIMAINFRAME
* MODE.
* 2) THE *SETPFP* REQUEST FAILS.
* 3) THE *MTOS* FILE EXISTS, BUT CANNOT BE
* ATTACHED IN MODIFY MODE.
* 4) THE *MTOS* FILE DOES NOT EXIST, BUT
* CANNOT BE DEFINED.
* 5) NO VALID SLAVE MAINFRAMES CAN BE
* IDENTIFIED.
*
* ANOTHER MAINFRAME WILL NOT BE RECOGNIZED AS A VALID
* SLAVE MAINFRAME IF ANY OF THE FOLLOWING IS TRUE.
* 1) THE *STOM* FILE CANNOT BE ATTACHED IN
* READ-ALLOW-MODIFY MODE.
*
* 2) THE LENGTH OF THE *STOM* FILE INDICATES
* THAT THE *SLVEXEC* IS WORKING WITH A
* DIFFERENT SET OF INSTALLATION
* PARAMETERS.
*
* MESSAGES
* * EXEC MMF INITIALIZATION OK.*
* AN INFORMATIVE MESSAGE NOTING THAT *SSEXEC*
* IS READY TO RUN IN MULTIMAINFRAME MODE.
*
* * EXEC MMF INITIALIZATION FAILED -*
* * - ALL SLAVES OMITTED.* -OR-
* * - ATTACH MTOS FAILED.* -OR-
* * - DEFINE MTOS FAILED.* -OR-
* * - MTOS FILE BUSY.* -OR-
* * - SETPFP PROBLEM.*
* A MESSAGE INDICATING THAT THE *SSEXEC* PROGRAM
* WILL NOT RUN IN MULTIFRAME MODE FOR THE REASON
* NOTED ON THE SECOND LINE.
*
* * EXEC IN SINGLE MAINFRAME MODE.*
* AN INFORMATIVE MESSAGE INDICATING THAT THE
* *SSEXEC* PROGRAM IS RUNNING IN A SINGLE
* MAINFRAME CONFIGURATION.
*
* * EXEC - SLAVE N XXXX.*
* XXXX = ACTIVE/IDLE.
* AN INFORMATIVE MESSAGE INDICATING THAT *SSEXEC*
* IS READY TO COMMUNICATE WITH THE *SSSLV*
* PROGRAM WHICH IS RUNNING ON MAINFRAME *N*.
*
* * EXEC - SLAVE N OMITTED -*
* * - NO STOM FILE.* -OR-
* * - STOM FILE LENGTH PROBLEM.*
* A MESSAGE INDICATING THAT *SSEXEC* WILL NOT
* COMMUNICATE WITH AN *SSSLV* PROGRAM, IF ANY, ON
* MAINFRAME *N* FOR THE REASON NOTED IN THE
* SECOND LINE.
*
#
ITEM MID C(2); # MACHINE ID OF MASTER MF #
ITEM MIDX U; # INDEX (1-4) OF MASTER MF #
ITEM LINKFAM C(7); # NAME OF LINK FAMILY #
#
**** PROC INITSRP - XREF LIST BEGIN.
#
XREF
BEGIN
PROC MESSAGE; # ISSUES MESSAGE MACRO #
PROC PDATE; # ISSUE PDATE MACRO #
PROC PFD; # PERMANENT FILE REQUEST DELAYS #
PROC READ; # READ FILE #
PROC READW; # READ LINE #
PROC REWIND; # REWIND FILE #
PROC RETERN; # RETURN FILE #
PROC RTIME; # ISSUE RTIME MACRO #
PROC SETPFP; # ISSUE SETPFP MACRO #
PROC WRITER; # WRITE FILE #
FUNC XCOD C(10); # INTEGER TO DISPLAY #
PROC ZFILL; # ZERO FILL AN ARRAY #
PROC ZSETFET; # INITIALIZE *FET* #
END
#
**** PROC INITSRP - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL,COMBFET
*CALL,COMBPFP
*CALL COMBPFS
*CALL,COMXCTF
*CALL COMXINT
*CALL,COMXIPR
*CALL,COMXMMF
*CALL,COMSPFM
ARRAY MMFSTAT [0:0] S(4);
BEGIN
ITEM MMF$TEXT C(00,00,38) # INITIALIZATION STATUS #
=[" EXEC MMF INITIALIZATION STATUS"];
ITEM MMF$STAT C(02,30,09); # OK/FAILED - #
ITEM MMF$END U(03,48,12) =[0]; # END OF LINE #
END
ARRAY RBBUF [0:0] S(RBSIZE);; # SCRATCH BUFFER #
ITEM PFNAME C(7); # PERMANENT FILE NAME #
ITEM RB U; # INDEX TO A REQUEST BLOCK #
ITEM STAT U; # SCRATCH STATUS WORD #
ITEM STATM S:EXECSTAT; # STATUS OF MMF INITIALIZATION #
ITEM STATS S:EXECSTAT; # STATUS OF A SLAVE #
ITEM THISSLV U; # SCRATCH WORD #
CONTROL EJECT;
#
* INITIALIZE VARIOUS ITEMS AND POINTERS.
#
STATM = S"INITPROB";
L$STOM = (NUMRB + 1) * RBSIZE;
L$MTOSH = (MAXSLV + 1) * 3;
L$MTOS = L$MTOSH + NUMRB * NUMSLV;
P<MTOSHEAD> = LOC(MTOS$BUF);
P<MTOSM> = LOC(MTOB$FET);
P<STOMMBUF> = LOC(STOM$BUF);
STOMBUFL = STOM$BFL;
ZSETFET(LOC(MTOSM),MTOSMLFN,LOC(MTOSHEAD),L$MTOS + 1,SFETL);
IF MIDX EQ 0
THEN # SINGLE MAINFRAME MODE #
BEGIN
STATM = S"SMF";
GOTO INITMASTER;
END
#
* ISSUE A *SETPFP* SO THE COMMUNICATION FILES
* CAN BE ATTACHED.
#
PFP$WRD0[0] = 0;
PFP$FAM[0] = LINKFAM;
PFP$FG1[0] = TRUE; # CHANGE FAMILY #
PFP$FG4[0] = TRUE; # CHANGE USER INDEX #
PFP$UI[0] = DEF$UI;
SETPFP(PFP);
IF PFP$STAT[0] NQ 0
THEN
BEGIN
MMFD$PROB[0] = "SETPFP PROBLEM.";
GOTO INITMASTER;
END
#
* ATTACH THE *MTOS* FILE IN MODIFY MODE,
* AND READ IT TO THE *MTOS* BUFFER.
* USE THE *STOM* FILE BUFFER AND *FET* TO READ THE *MTOS* FILE.
#
ZSETFET(LOC(STOMM),MTOSMLFN,LOC(STOMMBUF),STOMBUFL,SFETL);
PFD("ATTACH",MTOSMLFN,MTBSPFN,"PW",MTOSPW,
"M","M", "RC",PFSTAT,"NA",0,"UP",0,0);
IF PFSTAT EQ FBS
THEN # FILE BUSY #
BEGIN
MMFD$PROB[0] = "MTOS FILE BUSY.";
GOTO INITMASTER;
END
IF PFSTAT EQ OK
THEN # READ *MTOS* #
BEGIN
READ(STOMM,RCL);
READW(STOMM,MTOSHEAD,L$MTOS,STAT);
END
IF PFSTAT NQ OK ##
OR MSH$NUMSLV[0] NQ NUMSLV ##
OR MSH$NUMRB[0] NQ NUMRB
THEN # INITIALIZE THE *MTOS* FILE #
BEGIN
PFSTAT = 1;
MSH$NUMSLV[0] = NUMSLV;
MSH$NUMRB[0] = NUMRB;
STAT = 1;
END
#
* INITIALIZE THE MASTER STATUS INFORMATION.
#
MSH$PFNM[0] = MTBSPFN;
MSH$MIDM[0] = MID;
MSH$MIDX[0] = MIDX;
IF PFSTAT NQ OK
THEN
BEGIN # CREATE *MTOS* #
#
* CREATE A NEW *MTOS* PERMANENT FILE WHICH
* HAS THE MASTER HEADER INFORMATION.
* REATTACH THE *MTOS* FILE IN MODIFY MODE
* SO THE *SSSLV* PROGRAMS CAN READ IT.
#
RETERN(STOMM,RCL);
PFD("PURGE",MTBSPFN,"PW",MTOSPW,"RC",PFSTAT,"UP",0,0);
PFD("DEFINE",MTOSMLFN,MTBSPFN,"PW",MTOSPW,"BR","N", "R",
LINK$DT[0],"RC",PFSTAT,"UP",0,0);
IF PFSTAT NQ OK
THEN # CAN NOT DEFINE #
BEGIN
MMFD$PROB[0] = "DEFINE MTOS FAILED.";
GOTO INITMASTER;
END
P<FETSET> = LOC(MTOSM);
FET$IN[0] = FET$FRST[0] + L$MTOS;
WRITER(MTOSM,RCL);
PFD("ATTACH",MTOSMLFN,MTBSPFN,"PW",MTOSPW,"M","M", "RC",PFSTAT
,"NA",0,"UP",0,0);
IF PFSTAT NQ OK
THEN # ABNORMAL ERROR #
BEGIN
MMFD$PROB[0] = "ATTACH MTOS FAILED.";
GOTO INITMASTER;
END
END # CREATE *MTOS* #
STATM = S"ACTIVE";
#
* ATTACH AND READ THE *STOM* COMMUNICATION FILE
* FROM EACH POSSIBLE SLAVE AND INITIALIZE THE
* HEADER AND EACH REPLY BLOCK STATUS FOR EACH SLAVE.
#
SINDX = 1;
P<STOMFILE> = LOC(RBBUF);
FASTFOR DUMMY = 1 STEP 1 UNTIL MAXSLV + 1
DO
BEGIN # INITIALIZE EACH SLAVE #
IF DUMMY EQ MIDX OR ##
SINDX GR NUMSLV
THEN # BYPASS THIS *MF* #
BEGIN
TEST DUMMY;
END
P<MTOSREPBLK> = LOC(MTOSHEAD) + L$MTOSH + (SINDX-1)*NUMRB;
PFNAME = STOMPFN;
CHAR10 = XCOD(DUMMY);
CHAR1 = C<9,1>CHAR10;
B<36,6>PFNAME = CHAR1;
SLVN$INDX[0] = CHAR1;
MSH$PFNS[SINDX] = PFNAME;
#
* ATTACH AND READ THE *STOM* FILE FOR THIS SLAVE
#
PFD("ATTACH",PFNAME,0,"PW",STOMPW,"M","RM","RC",PFSTAT, "NA",0
,"UP",0,0);
IF PFSTAT NQ OK
THEN # REJECT SLAVE #
BEGIN
STATS = S"OMIT";
MMFD$PROB[0] = "NO *STOM* FILE.";
GOTO INITSLAVE;
END
ZSETFET(LOC(STOMM),PFNAME,LOC(STOMMBUF),STOMBUFL,SFETL);
READ(STOMM,NRCL);
READW(STOMM,RBBUF,RBSIZE,STAT);
MMFD$PROB[0] = "STOM FILE LENGTH PROB.";
IF STAT NQ OK
THEN # REJECT SLAVE #
BEGIN
STATS = S"OMIT";
GOTO INITSLAVE;
END
PDATE(PDATESTAT[0]);
RTIME(RTIMESTAT[0]);
#
* INITIALIZE THE *MTOS* FILE HEADER
* TO INDICATE THE SLAVE EXEC STATUS.
#
MSH$SSW[SINDX] = SM$SSW[0];
MSH$MIDS[SINDX] = SM$MIDS[0];
IF SM$IDLE[0]
THEN
BEGIN
STATS = S"IDLE";
SLVN$STAT[0] = "IDLE.";
MSH$TIMOUT[SINDX] = MAXSECS;
END
ELSE
BEGIN
STATS = S"ACTIVE";
SLVN$STAT[0] = "ACTIVE.";
MSH$TIMOUT[SINDX] = RTIMSECS[0] + SLAV$INTV;
END
#
* CHECK THE LENGTH OF THE *STOM* FILE AND
* INITIALIZE THE MASTER REPLY CODE FIELDS.
#
FASTFOR RB = 1 STEP 1 UNTIL NUMRB
DO
BEGIN # CHECK LENGTH OF THE *STOM* FILE #
READW(STOMM,RBBUF,RBSIZE,STAT);
IF STAT NQ OK
THEN
BEGIN
STATS = S"OMIT";
GOTO INITSLAVE;
END
IF MSR$MRC[RB] EQ S"ACCEPTED"
THEN # INITIALIZE REPLY CODE AND STATUS
FIELDS #
BEGIN
MSR$MRC[RB] = S"FINISHED";
MSR$REPLY[RB] = S"ABANDONED";
MSR$PDATE[RB] = PDATEV[0];
END
END # CHECK LENGTH OF THE *STOM* FILE #
INITSLAVE:
MSH$STATS[SINDX] = STATS;
IF STATS EQ S"ACTIVE" OR STATS EQ S"IDLE"
THEN # SLAVE IS DEFINED #
BEGIN
MSH$DEFD[SINDX] = TRUE;
SLAVECTR = SLAVECTR + 1;
MESSAGE(SLVNSTAT,SYSUDF1);
SINDX = SINDX + 1;
END
ELSE # SLAVE IS NOT DEFINED #
BEGIN
MSH$DEFD[SINDX] = FALSE;
SLVN$STAT[0] = "OMITTED - ";
MESSAGE(SLVNSTAT,SYSUDF1);
MESSAGE(MMFDETAIL,SYSUDF1);
END
END # INITIALIZE EACH SLAVE #
INITMASTER:
#
* ESTABLISH THE NEXT TIME TO CALL THE SLAVE
* REQUEST PROCESSOR AND TO FLUSH THE *MTOS* BUFFERS.
* ISSUE A MESSAGE WITH THE FINAL INITIALIZATION STATUS.
#
MTOS$EXPIR = MAXSECS;
STOM$EXPIR = MAXSECS;
IF STATM EQ S"SMF"
THEN
BEGIN
MMF$TEXT[0] = " EXEC IN SINGLE MAINFRAME MODE.";
MESSAGE(MMFSTAT,SYSUDF1);
RETURN;
END
IF STATM EQ S"ACTIVE"
THEN # TEST IF ALL SLAVES OMITTED #
BEGIN # CHECK SLAVE STATUS #
IF SLAVECTR NQ 0
THEN
BEGIN
MTOS$EXPIR = 0;
STOM$EXPIR = 0;
MMF$STAT[0] = "OK.";
MESSAGE(MMFSTAT,SYSUDF1);
RETURN;
END
ELSE
BEGIN
MMFD$PROB[0] = "ALL SLAVES OMITTED.";
END
END # CHECK SLAVE STATUS #
MMF$STAT[0] = "FAILED - ";
MESSAGE(MMFSTAT,SYSUDF1);
MESSAGE(MMFDETAIL,SYSUDF1);
RETERN(MTOSM,RCL);
RETURN;
END # INITSRP #
TERM
PROC INITTAB;
# TITLE INITTAB - INITIALIZES ASSORTED TABLES. #
BEGIN # INITTAB #
#
** INITTAB - INITIALIZES ASSORTED TABLES.
*
* THIS ROUTINE WILL INITIALIZE TABLES USED BY *SSEXEC* AND CREATE
* THE MEMORY ALLOCATION TABLE (*MAT*) WHICH DESCRIBES THE *FWA* OF
* EACH TABLE, THE ENTRY COUNT AND THE SPACE ALLOCATED FOR EACH
* TABLE.
*
* EXIT TABLES DEFINED IN THE *MAT* HAVE BEEN INITIALIZED.
*
* MESSAGES SSEXEC SEEKING FL INCREASE.
* SSEXEC ACTIVE.
* EXEC ABNORMAL - INITTAB.
#
#
**** PROC INITTAB - XREF LIST BEGIN.
#
XREF
BEGIN
PROC ABORT; # CALLS ABORT MACRO #
PROC CALCTS; # CALCULATES TABLE SPACE #
PROC INITTS; # INITIALIZES TABLES #
PROC MEMORY; # CALLS MESSAGE MACRO #
PROC MESSAGE; # CALLS *MESSAGE* MACRO #
PROC MNGMEM; # CHANGES FIELD LENGTH #
PROC MSG; # CALLS *MESSAGE* MACRO #
PROC RECALL; # CALLS RECALL MACRO #
FUNC XCDD C(10); # INTEGER TO DECIMAL DISPLAY #
PROC ZFILL; # ZEROES BUFFER SPACE #
END
#
**** PROC INITTAB - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBMAT
*CALL COMXACM
*CALL COMXCTF
*CALL COMXMSC
*CALL COMXINT
*CALL,COMXJCA
ITEM DC$FL C(10); # CHARACTER FIELD FOR *XCDD* #
ITEM FLCHNG I; # FIELD LENGTH CHANGE AMOUNT #
ITEM I U; # INDEX #
ITEM RCLFLAG B; # *FL* ACCESS DELAY FLAG #
ITEM RESP U; # RESPONSE FROM *MNGMEM* #
ITEM TLAST U; # LAST TABLE WORD #
ITEM TLEN U; # TABLE LENGTH #
ITEM TSTART U; # FIRST TABLE WORD #
#
* ARRAY FOR *ZFILL* PROCEDURE.
#
BASED
ARRAY DUMAR[0:0] P(1);
;
#
* MESSAGE BUFFER.
#
ARRAY MSGBUF[0:0] P(5);
BEGIN # ARRAY MSGBUF #
ITEM MSG$LINE C(00,00,40); # MESSAGE LINE #
ITEM MSG$RZRO C(04,00,12); # ZERO BYE TERMINATOR #
END # ARRAY MSGBUF #
ARRAY STATARY[0:0] P(1); # STATUS FOR MEMORY MACRO #
BEGIN # STATARY #
ITEM STAT U(00,00,30); # STATUS #
ITEM ZEROFL U(00,30,30); # ZERO FILL REST OF WORD #
END # STATARY #
CONTROL EJECT;
#
* CALL *CALCTS* TO CALCULATE THE ENTRY COUNTS AND THE TABLE SPACE
* REQUIRED.
#
CALCTS;
P<RA$AREA> = 0; # POINTER TO *RA* AREA #
#
* CYCLE THROUGH ARRAY *MAT* CALCULATING THE *FWA* OF EACH ENTRY
* BASED ON THE *FWA* AND SPACE REQUIRED OF THE PREVIOUS ENTRY.
#
NEXTADR = RA$HHA; # FOR *MNGMEM* OPERATIONS #
MAT$FWA[0] = RA$HHA; # USE NEXT AVAILABLE FOR FIRST #
SLOWFOR I = 1 STEP 1 ##
WHILE I LS MAT$ENTRY"MAT$LAST"
DO
BEGIN
MAT$FWA[I] = MAT$FWA[I-1] + MAT$SPACE[I-1];
END
#
* GET THE MEMORY REQUIRED FOR THE VARIABLE TABLES.
#
STAT = 0; # REQUEST CURRENT *FL* #
MEMORY("CM",STATARY,RCL,NA);
IF STAT EQ 0
THEN
BEGIN # IF CURRENT *FL* NOT RETURNED #
FE$RTN[0] = "INITTAB."; # SET ROUTINE INTO ERROR MESSAGE #
MESSAGE(FEMSG[0],UDFL1);
ABORT;
END # IF CURRENT *FL* NOT RETURNED #
CUR$FL = STAT; # USED BY *MNGMEM* #
MAX$FL = CUR$FL; # SET MAXIMUM *FL* #
UNU$FL = CUR$FL - NEXTADR;
FLCHNG = MAT$FWA[MAT$ENTRY"MAT$LAST" - 1] + ##
MAT$SPACE[MAT$ENTRY"MAT$LAST" - 1] - NEXTADR;
RCLFLAG = FALSE; # DELAY FLAG #
SLOWFOR I = 0 WHILE RESP EQ 0
DO
BEGIN # LOOP UNTIL *FL* INCREASE SATISFIED #
MNGMEM(FLCHNG,RESP); # REQUEST *FL* INCREASE #
IF RESP EQ 0
THEN
BEGIN # IF ATTEMPT UNSUCCESSFUL #
MSG$LINE[0] = "$SSEXEC SEEKING FL INCREASE.";
MESSAGE(MSGBUF[0],LINE1);
RECALL;
RCLFLAG = TRUE;
END # IF ATTEMPT UNSUCCESSFUL #
END # LOOP UNTIL *FL* INCREASE SATISFIED #
IF RCLFLAG
THEN
BEGIN # IF *FL* ACCESS DELAYED #
MSG$LINE[0] = " FL OBTAINED.";
MESSAGE(MSG$LINE[0],LINE1);
END # IF *FL* ACCESS DELAYED #
MSG(" ",SYSUDF1);
#
* CALL *INITTS* TO PRESET INITIAL VALUES IN THE VARIABLE AND FIXED
* TABLES.
#
TSTART = MAT$FWA[MAT$ENTRY"HLRQ"];
TLAST = MAT$FWA[MAT$ENTRY"MAT$LAST" -1] + ##
MAT$SPACE[MAT$ENTRY"MAT$LAST" -1];
TLEN = TLAST - TSTART;
P<DUMAR> = TSTART;
ZFILL(DUMAR,TLEN);
INITTS;
END # INITTAB #
TERM
PROC INITTS;
# TITLE INITTS - PRESET ASSORTED TABLES. #
BEGIN # INITTS #
#
** INITTS - PRESET ASSORTED TABLES.
*
* THIS PROCEDURE WILL LINK TOGETHER ENTRIES TO FORM FREE SPACE
* CHAINS AND PRESET VALUES IN TABLES USED BY *SSEXEC*.
*
* EXIT TABLE VALUES HAVE BEEN PRESET.
#
#
**** PROC INITTS - XREF LIST BEGIN.
#
XREF
BEGIN
PROC BZFILL; # ZERO FILLS WORD #
PROC MESSAGE; # ISSUE MESSAGE #
FUNC XCOD C(10); # CHANGES INTEGER TO DISPLAY #
PROC ZFILL; # ZERO FILL BUFFER #
END
#
**** PROC INITTS - XREF LIST END.
#
DEF FILLSIZE #7#; # FILL SIZE FOR *BZFILL* #
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBCHN
*CALL COMBCMD
*CALL COMBFET
*CALL,COMBLBL
*CALL COMBLRQ
*CALL COMBMAT
*CALL COMBMCT
*CALL COMBTDM
*CALL COMBUDT
*CALL COMXBST
*CALL COMXCTF
*CALL COMXFCQ
*CALL COMXHLR
*CALL COMXINT
*CALL COMXLTC
*CALL COMXMSC
ITEM FIRST U; # POINTER TO FIRST BUFFER WORD #
ITEM I U; # INDEX #
ITEM J U; # INDEX #
ITEM MSGTEMP C(7); # TEMPORARY CHARACTER ITEM #
ITEM ZEROFILL S:TYPFILL = S"ZFILL"; # ZERO BUFFER FILL #
#
* SMALL BUFFERS AND *FETS*.
#
ARRAY CHARARY[0:0] P(1);
BEGIN
ITEM CHARTEMP C(00,00,10); # CHARACTER BUFFER #
ITEM CHARID C(00,42,03); # CHARACTER *ID* #
END
ARRAY NAMEFILE[0:0] P(1);
BEGIN # NAMFILE #
ITEM NAME$HDR C(00,00,07) = ["FILE"]; # NAME HEADER #
ITEM NAME$UNID C(00,24,03); # UNIQUE ID #
END # NAMFILE #
CONTROL EJECT;
#
* CHAIN ALL *HLRQ* ENTRIES TOGETHER AND PLACE A UNIQUE FILE NAME
* INTO EACH ENTRY. ALSO SET THE *CHN$BOC* AND *CHN$EOC* FIELDS
* IN *COMBCHN* TO POINT TO THE BEGINNING AND END OF THE *HLRQ* FREE
* SPACE CHAIN.
*
* THE UNIQUE FILE NAMES ARE OBTAINED BY PLACING A NUMERIC
* IDENTIFIER AT THE END OF THE WORD "FILE". THE NUMERIC IDENTIFIER
* IS INCREMENTED BY ONE FOR EACH NEW FILE NAME.
#
P<HLRQ> = MAT$FWA[MAT$ENTRY"HLRQ"]; # POINT TO FIRST ENTRY #
CHN$BOC[LCHN"HL$FRSPC"] = P<HLRQ>; # BEGINNING OF CHAIN #
SLOWFOR I = 1 STEP 1 ##
WHILE I LQ MAT$COUNT[MAT$ENTRY"HLRQ"]
DO
BEGIN # FOR ALL *HLRQ* ENTRIES #
CHN$EOC[LCHN"HL$FRSPC"] = P<HLRQ>; # END OF CHAIN POINTER #
J = I + 100;
CHARTEMP[0] = XCOD(J); # CHANGE INDEX TO DISPLAY CODE #
NAME$UNID[0] = CHARID[0];
HLR$FLNM[0] = NAME$HDR[0]; # PLACE FILE NAME INTO ENTRY #
HLR$LNK1[0] = P<HLRQ> + HLRQLEN; # LINK TO NEXT ENTRY #
P<HLRQ> = HLR$LNK1[0]; # POINT TO THE NEXT ENTRY #
END # FOR ALL *HLRQ* ENTRIES #
P<HLRQ> = P<HLRQ> - HLRQLEN; # POINT TO LAST ENTRY OF CHAIN #
HLR$LNK1[0] = 0; # CLEAR LAST POINTER #
#
* CHAIN ALL *LLRQ* ENTRIES TOGETHER INTO A FREE SPACE CHAIN.
#
P<LLRQ> = MAT$FWA[MAT$ENTRY"LLRQ"]; # POINT TO FIRST ENTRY #
CHN$BOC[LCHN"LL$FRSPC"] = P<LLRQ>; # BEGINNING OF CHAIN #
SLOWFOR I = 1 STEP 1 ##
WHILE I LQ MAT$COUNT[MAT$ENTRY"LLRQ"]
DO
BEGIN # FOR ALL *LLRQ* ENTRIES #
CHN$EOC[LCHN"LL$FRSPC"] = P<LLRQ>; # END OF CHAIN POINTER #
LLR$LINK1[0] = P<LLRQ> + LLRQENTL; # LINK TO NEXT ENTRY #
P<LLRQ> = LLR$LINK1[0]; # POINT TO NEXT ENTRY #
END # FOR ALL *LLRQ* ENTRIES #
P<LLRQ> = P<LLRQ> - LLRQENTL; # POINT TO LAST ENTRY OF CHAIN #
LLR$LINK1[0] = 0; # CLEAR LAST POINTER #
#
* CHAIN ALL *RTRQ* ENTRIES TOGETHER INTO A FREE SPACE CHAIN.
#
P<LINKWRD> = MAT$FWA[MAT$ENTRY"RTRQ"]; # POINT TO FIRST ENTRY #
CHN$BOC[LCHN"RTD$FRSPC"] = P<LINKWRD>; # BEGINNING OF CHAIN #
SLOWFOR I = 1 STEP 1 ##
WHILE I LQ MAT$COUNT[MAT$ENTRY"RTRQ"]
DO
BEGIN # FOR ALL *RTRQ* ENTRIES #
CHN$EOC[LCHN"RTD$FRSPC"] = P<LINKWRD>; # END OF CHAIN #
LINK$ADR[0] = P<LINKWRD> + TDAMLEN + 1; # LINK TO NEXT ENTRY #
P<LINKWRD> = LINK$ADR[0]; # POINT TO NEXT ENTRY #
END # FOR ALL *RTRQ* ENTRIES #
P<LINKWRD> = P<LINKWRD> - TDAMLEN - 1; # POINT TO LAST ENTRY #
LINK$ADR[0] = 0; # CLEAR LAST POINTER #
#
* CHAIN ALL *FCTQ* ENTRIES TOGETHER INTO A FREE SPACE CHAIN.
#
P<FCTQ> = MAT$FWA[MAT$ENTRY"FCTQ"]; # POINT TO FIRST ENTRY #
CHN$BOC[LCHN"FCT$FRSPC"] = P<FCTQ>; # BEGINNING OF CHAIN #
SLOWFOR I = 1 STEP 1 ##
WHILE I LQ MAT$COUNT[MAT$ENTRY"FCTQ"]
DO
BEGIN # FOR ALL *FCTQ* ENTRIES #
CHN$EOC[LCHN"FCT$FRSPC"] = P<FCTQ>; # END OF CHAIN POINTER #
FCTQLINK1[0] = P<FCTQ> + FCTQHL + FCTENTL; # LINK TO NEXT #
P<FCTQ> = FCTQLINK1[0]; # POINT TO NEXT ENTRY #
END # FOR ALL *FCTQ* ENTRIES #
P<FCTQ> = P<FCTQ> - FCTQHL - FCTENTL; # POINT TO LAST ENTRY #
FCTQLINK1[0] = 0; # CLEAR LAST POINTER #
#
* SET THE AUTHORIZED FLAG IN THE FIRST *BST* ENTRY.
#
P<BST> = MAT$FWA[MAT$ENTRY"BST"]; # POINT TO FIRST ENTRY #
BST$AUTH[1] = TRUE; # SET AUTHORIZED FLAG #
#
* INITIALIZE THE CATALOG *FET*.
#
P<FETSET> = MAT$FWA[MAT$ENTRY"CAT$FET"]; # POINT TO *FCT* FET #
FIRST = MAT$FWA[MAT$ENTRY"CAT$BUF"]; # FIRST LOCATION POINTER #
FET$IN[0] = FIRST; # IN POINTER #
FET$OUT[0] = FIRST; # OUT POINTER #
FET$LIM[0] = FIRST + SEQBL; # LIMIT #
FCTFADR = MAT$FWA[MAT$ENTRY"CAT$FET"];
P<FCTFET> = FCTFADR;
#
* INITIALIZE THE MAP *FET*.
#
P<FETSET> = MAT$FWA[MAT$ENTRY"MAP$FET"]; # POINT TO *MAP* FET #
FIRST = MAT$FWA[MAT$ENTRY"MAP$BUF"]; # FIRST LOCATION POINTER #
FET$IN[0] = FIRST; # IN POINTER #
FET$OUT[0] = FIRST; # OUT POINTER #
FET$LIM[0] = FIRST + MAPBUFL; # LIMIT #
MAPFADR = MAT$FWA[MAT$ENTRY"MAP$FET"];
P<MAPFET> = MAPFADR;
#
* INITIALIZE THE TEMPORARY *FET*.
#
P<FETSET> = MAT$FWA[MAT$ENTRY"TEMP$FET"];
FIRST = MAT$FWA[MAT$ENTRY"TEMP$BUF"]; # FIRST LOCATION POINTER #
FET$IN[0] = FIRST; # IN POINTER #
FET$OUT[0] = FIRST; # OUT POINTER #
FET$LIM[0] = FIRST + TBUFL; # LIMIT #
TFETADR = MAT$FWA[MAT$ENTRY"TEMP$FET"];
P<TFET> = TFETADR;
#
* INITIALIZE THE POINTERS TO THE BASED ARRAYS.
#
ASTBADR = MAT$FWA[MAT$ENTRY"AST$BUF"];
FCTBADR = MAT$FWA[MAT$ENTRY"CAT$BUF"];
P<FCTBUF> = FCTBADR;
MAPBADR = MAT$FWA[MAT$ENTRY"MAP$BUF"];
P<MAPBUF> = MAPBADR;
TBUFADR = MAT$FWA[MAT$ENTRY"TEMP$BUF"];
P<TBUF> = TBUFADR;
WBUFADR = MAT$FWA[MAT$ENTRY"TEMP$WB"];
P<WBUF> = WBUFADR;
OCTLEN = MAT$COUNT[MAT$ENTRY"OCT"];
OCTADR = MAT$FWA[MAT$ENTRY"OCT"];
P<OCT> = OCTADR;
OMTADR = MAT$FWA[MAT$ENTRY"OMT"];
P<OMT> = OMTADR;
PRMBADR = MAT$FWA[MAT$ENTRY"PREAMBLE"];
LTCTPTR = MAT$FWA[MAT$ENTRY"LTCT"];
P<LTCT> = LTCTPTR;
UDTCADR = MAT$FWA[MAT$ENTRY"UDT$CONT"];
P<UDT$CN> = UDTCADR + 1; # HEADER NOT INCLUDED #
UDTSADR = MAT$FWA[MAT$ENTRY"UDT$SM"];
P<UDT$SMA> = UDTSADR;
P<LABEL$CART> = MAT$FWA[MAT$ENTRY"LABBUF"];
MWRBADR = MAT$FWA[MAT$ENTRY"MW$BUFS"];
MRDBADR = MAT$FWA[MAT$ENTRY"MR$BUFS"];
SBTADR = MAT$FWA[MAT$ENTRY"SBT"];
#
* PUT THE FAMILY NAMES INTO THE *MRFT* TABLE.
#
P<MRFT> = MAT$FWA[MAT$ENTRY"MRFT"]; # POINT TO FIRST ENTRY #
SLOWFOR I = 1 STEP 1 WHILE I LQ FAMCNT
DO
BEGIN # FOR ALL *MRFT* ENTRIES #
MSGTEMP = NAMEFAM[I];
BZFILL(MSGTEMP,ZEROFILL,FILLSIZE);
MRFTFAM[(I-1)] = MSGTEMP; # MOVE FAMILY NAME #
END # FOR ALL *MRFT* ENTRIES #
END # INITTS #
TERM
PROC OPENCAT;
# TITLE OPENCAT - OPENS THE MAP AND CATALOG FILES. #
BEGIN # OPENCAT #
#
** OPENCAT - OPENS MAP AND CATALOG FILES.
*
* THIS ROUTINE CALLS *MOPEN* AND *COPEN* TO OPEN THE *SM* MAPS
* AND THE *SFM* CATALOGS. IT ALSO REBUILDS THE FREE AU
* COUNTS IN THE *AST* TABLES AND UPDATES THE PREAMBLES.
*
* PROC OPENCAT.
*
* ENTRY USES THE LIST OF LOGICAL *SM* NUMBERS, THE LIST
* OF FAMILIES WITH 8 *SFM* CATALOGS, AND THE CATALOGS
* OF THE FAMILIES WITH 8 *SFM* CATALOGS.
*
* EXIT MAP AND CATALOG FILES HAVE BEEN OPENED AND ALL *AST*
* TABLES HAVE BEEN UPDATED.
*
* MESSAGES 1) AST UPDATED.
* PFN=PFN, FAMILY=FAMILY, UI=UI.
* SUBCATALOG SM ID=ID.
*
* 2) ATTACH ERROR ON SFM SMMAP.
* PFN=PFN, FAMILY=FAMILY, UI=UI.
*
* 3) ATTACH ERROR ON SFM SUBFAMILY CATALOG.
* PFN=PFN, FAMILY=FAMILY, UI=UI.
*
* 4) CIO ERROR ON SFM SMMAP.
* PFN=PFN, FAMILY=FAMILY, UI=UI.
*
* 5) CIO ERROR ON SFM SUBFAMILY CATALOG.
* PFN=PFN, FAMILY=FAMILY, UI=UI.
*
* 6) EXEC ABNORMAL, OPENCAT.
*
* 7) INITIALIZATION PROBLEMS -
* NO SMMAP FOUND.
#
#
**** PROC OPENCAT - XREF LIST BEGIN.
#
XREF
BEGIN
PROC ABORT; # CALLS *ABORT* MACRO #
PROC ACQ$FCT; # ACQUIRES AN *FCTQ* ENTRY #
PROC BZFILL; # BLANKS OR ZERO FILLS WORD #
PROC COPEN; # OPENS AN *MSG* CATALOG #
PROC CRAST; # CREATES AN *AST* ENTRY #
PROC CRDAST; # READS THE *AST* TABLE #
PROC MESSAGE; # CALLS *MESSAGE* MACRO #
PROC MOPEN; # OPEN A *SM* MAP #
PROC RMVBLNK; # REMOVE MULTIPLE BLANKS #
PROC RLS$FCT; # RELEASE AN *FCTQ* ENTRY #
PROC SETPFP; # SETS USER INDEX AND FAMILY #
PROC UASTPRM; # UPDATE *AST* AND PREAMBLE #
FUNC XCDD C(3); # INTEGER TO DECIMAL DISPLAY #
FUNC XCOD; # CHANGE OCTAL TO DISPLAY CODE #
PROC XWOD; # CHANGE INTEGER TO OCTAL #
END
#
**** PROC OPENCAT - XREF LIST END.
#
DEF QRADDR #0#; # ADDRESS OF *HLRQ* ENTRY #
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBCMS
*CALL COMBCMD
*CALL COMBMCT
*CALL COMBPFP
*CALL COMBUDT
*CALL COMXCTF
*CALL COMXINT
*CALL COMXMSC
*CALL COMSPFM
ITEM ACCM B; # FILE ACCESS MODE FLAG #
ITEM CER U; # *ACQ$FCT* RETURN CODE #
ITEM CR U; # *CRDAST* RETURN STATUS #
ITEM CSNOTFD B; # *SMMAP* NOT FOUND FLAG #
ITEM FCTX U; # LOOP INDEX - FCT ORDINAL #
ITEM FMX U; # LOOP INDEX - FAMILY #
ITEM FOUND B; # ITEM FOUND FLAG #
ITEM MMM U; # INDEX #
ITEM MOPENCALL B; # *MOPEN* CALL FLAG #
ITEM MSGTEMP C(8); # ITEM FOR *BZFILL* #
ITEM QADDR U; # ADDRESS OF *FCTQ* ENTRY #
ITEM RSTATUS U; # ERROR STATUS FROM *MOPEN* #
ITEM SFX U; # LOOP INDEX - SUBFAMILY #
ITEM SMX U; # LOOP INDEX - STORAGE MODULE #
ITEM STAT U; # RETURN STATUS #
ITEM UI U; # USER INDEX #
#
* ARRAY TO HOLD DATA FROM *XCDD*.
#
ARRAY ARTEMP[0:0] S(1);
BEGIN
ITEM TEMPCHAR C(00,00,10); # TEMPORARY CHARACTER ITEM #
ITEM CHARSUB C(00,00,01); # SUBCATALOG *SM* *ID* #
END
ARRAY BADDR[0:0] P(FCTENTL); # *FCT* BUFFER ADDRESS #
;
ARRAY BADSUB[0:0] P(3);
BEGIN
ITEM BAD$ID C(00,00,20) = [" SUBCATALOG SM ID="]; # ID #
ITEM BAD$SUB C(02,00,01); # BAD *SM* NUMBER #
ITEM BAD$ZRO U(02,18,12) = [0]; # ZERO TERMINATOR #
END
ARRAY CAT[0:0] P(1); # CATALOG FILE NAME #
BEGIN # CAT #
ITEM CAT$PFN C(00,00,07) = ["SFMCAT "]; # SFMCAT #
ITEM CAT$UNID C(00,36,01); # UNIQUE IDENTIFIER #
END # CAT #
ARRAY DIS[0:0] P(2);
BEGIN
ITEM DIS$UI C(01,24,06); # USER INDEX IN DISPLAY CODE #
END
ARRAY MAP[0:0] P(1);
BEGIN # MAP #
ITEM MAP$PFN C(00,00,06) = ["SMMAP "]; # SMMAP #
ITEM MAP$UNID C(00,30,01); # UNIQUE IDENTIFIER #
END # MAP #
#
* MESSAGE BUFFER.
#
ARRAY MSGBUF[0:0] P(5);
BEGIN # ARRAY MSGBUF #
ITEM MSG$LINE C(00,00,40); # MESSAGE LINE #
ITEM MSG$RZRO C(04,00,12); # ZERO BYE TERMINATOR #
END # ARRAY MSGBUF #
ARRAY REAL$AST[1:ASTENTL] S(ASTENTW);; # BUFFER FOR *AST* TABLE
#
SWITCH CERJMP:CMASTAT
CNOERRJ:NOERR, # NO ERRORS #
CINTLKJ:INTLK, # CATALOG/MAP FILE INTERLOCKED #
CFOPENJ:FOPEN, # CATALOG/MAP FILE ALREADY OPEN #
CCIOERRJ:CIOERR, # CIO ERROR #
CATTERRJ:ATTERR, # CATALOG/MAP ATTACH ERROR #
COCTFULLJ:OCTFULL; # OPEN CATALOG TABLE FULL #
SWITCH CGERJMP:CMASTAT
CGNOERRJ:NOERR, # NO ERRORS #
CGINTLKJ:INTLK, # CATALOG/MAP FILE INTERLOCKED #
CGNOTOPENJ:NOTOPEN, # CATALOG/MAP FILE NOT OPEN #
CGNOSUBCATJ:NOSUBCAT, # NO SUCH SUBCATALOG #
CGCIOERRJ:CIOERR, # *CIO* ERROR #
CGORDERRJ:ORDERR; # ORDINAL OUT OF RANGE #
SWITCH CRERJMP:CMASTAT
CRNOERRJ:NOERR, # NO ERRORS #
CRINTLKJ:INTLK, # CATALOG/MAP FILE INTERLOCKED #
CRNOTOPENJ:NOTOPEN, # CATALOG/MAP FILE NOT OPEN #
CRNOSUBCATJ:NOSUBCAT, # NO SUCH SUBCATALOG #
CRCIOERRJ:CIOERR; # *CIO* ERROR #
SWITCH MERJMP:CMASTAT
MNOERRJ:NOERR, # NO ERRORS #
MINTLKJ:INTLK, # CATALOG/MAP FILE INTERLOCKED #
MFOPENJ:FOPEN, # CATALOG/MAP FILE ALREADY OPEN #
MCIOERRJ:CIOERR, # *CIO* ERROR #
MATTERRJ:ATTERR, # CATALOG/MAP ATTACH ERROR #
MOCTFULLJ:OCTFULL; # OPEN CATALOG TABLE FULL #
CONTROL EJECT;
#
* CONSTRUCT THE MAP FILE NAME AND CALL *MOPEN* TO OPEN EACH *SM*
* MAP.
#
MSGTEMP = FAM$NAME[DEFAULTORD];
BZFILL(MSGTEMP,TYPFILL"BFILL",7);
MSGFAM[0] = MSGTEMP; # FAMILY NAME TO MESSAGE #
#
* ISSUE A *SETPFP* SO THE MAP FILE CAN BE ATTACHED.
#
PFP$UI = DEF$UI; # SET USER INDEX FOR *SETPFP* #
PFP$FAM = FAM$NAME[DEFAULTORD]; # SET FAMILY NAME FOR *SETPFP* #
PFP$FG1 = TRUE; # SET FAMILY BIT FOR *SETPFP* #
PFP$FG4 = TRUE; # SET INDEX BIT FOR *SETPFP* #
SETPFP(PFP); # SET USER INDEX AND FAMILY #
XWOD(DEF$UI,DIS); # CHANGE OCTAL TO DISPLAY CODE #
MSGUI[0] = DIS$UI[0]; # SET USER INDEX AND FAMILY #
P<UDT$SMA> = UDTSADR;
SLOWFOR SMX = 1 STEP 1 UNTIL UDT$LINE$SMN[0]
DO
BEGIN # PROCESS FOR EACH LOGICAL *SM* NUMBER #
MMM = SM$ID[1];
MAP$UNID[0] = SM$ID[1];
MSGTEMP = MAP$PFN[0];
BZFILL(MSGTEMP,TYPFILL"BFILL",7);
MSGPFN[0] = MSGTEMP; # PLACE FILE NAME INTO MESSAGE #
BZFILL(MAP,TYPFILL"ZFILL",7); # TYPFILL"ZFILL" FILE NAME #
RSTATUS = 0;
MOPEN(MMM,MAP$PFN[0],"M",RSTATUS);
#
* SIMULATED CASE STATEMENT FOR *MOPEN* PROCESSING.
#
GOTO MERJMP[RSTATUS];
MCIOERRJ:
MSG$LINE[0] = " CIO ERROR ON SFM SMMAP.";
MESSAGE(MSGBUF,UDFL1); # MESSAGE TO DAYFILE #
MSG$LINE[0] = MSG$TEXT[0];
RMVBLNK(MSGBUF[0],40);
MESSAGE(MSGBUF,UDFL1); # MESSAGE TO DAYFILE #
CSNOTFD = TRUE;
GOTO ENDCASE0; # COMMON EXIT #
MATTERRJ:
MSG$LINE[0] = " ATTACH ERROR ON SFM SMMAP.";
MESSAGE(MSGBUF,UDFL1);
MSG$LINE[0] = MSG$TEXT[0];
RMVBLNK(MSGBUF[0],40);
MESSAGE(MSGBUF,UDFL1);
CSNOTFD = TRUE;
GOTO ENDCASE0; # COMMON EXIT #
MNOERRJ:
MINTLKJ:
ENDCASE0:
P<UDT$SMA> = P<UDT$SMA> + SMALT;
#
* END OF CASE STATEMENT FOR *MOPEN* ERROR RESPONSE.
#
END # PROCESS FOR EACH LOGICAL *SM* NUMBER #
P<UDT$SMA> = UDTSADR; # RESET SMA ADDRESS #
IF CSNOTFD
THEN
BEGIN # NO SMMAP FOUND #
FATALERR = TRUE;
MSG$LINE[0] = " INITIALIZATION PROBLEMS -";
MESSAGE(MSGBUF[0],UDFL1);
MSG$LINE[0] = " NO SMMAP FOUND ";
MESSAGE(MSGBUF[0],UDFL1);
END # NO SMMAP FOUND #
CONTROL EJECT;
#
* CONSTRUCT THE *SFM* CATALOG FILE NAME FROM THE FAMILY NAME LIST.
* CALL *COPEN* TO OPEN THE *SFM* CATALOG. SCAN THE *FCT* TO
* RECONSTRUCT THE FREE VOLUME CHAIN AND COUNT THE
* AU AVAIABLE FOR ALLOCATION.
#
SLOWFOR FMX = 1 STEP 1 UNTIL FAMCNT
DO
BEGIN # FOR EACH FAMILY WITH EIGHT SUBFAMILY CATALOGS #
MSGTEMP = NAMEFAM[FMX];
BZFILL(MSGTEMP,TYPFILL"BFILL",7);
MSGFAM[0] = MSGTEMP;
SLOWFOR SFX = 0 STEP 1 UNTIL MAXSF
DO
BEGIN # FOR EACH SUBFAMILY #
UI = DEF$UI + SFX; # CALCULATE USER INDEX #
XWOD(UI,DIS);
MSGUI[0] = DIS$UI[0];
#
* ISSUE A *SETPFP* SO THE SFMCAT FILE CAN BE ATTACHED.
#
PFP$UI = DEF$UI + SFX; # SET USER INDEX FOR *SETPFP* #
PFP$FAM = NAMEFAM[FMX]; # SET FAMILY NAME FOR *SETPFP* #
PFP$FG1 = TRUE; # SET FAMILY BIT FOR *SETPFP* #
PFP$FG4 = TRUE; # SET INDEX BIT FOR *SETPFP* #
SETPFP(PFP); # SET USER INDEX AND FAMILY #
CAT$UNID[0] = XCOD(SFX); # CHANGE INDEX TO DISPLAY CODE #
MSGPFN[0] = CAT$PFN[0]; # PLACE FILE NAME INTO MESSAGE #
ACCM = FALSE; # RANDOM ACCESS MODE #
STAT = 0;
COPEN(NAMEFAM[FMX],SFX,CAT,"M",ACCM,STAT);
#
* SIMULATED CASE STATEMENT FOR *COPEN* ERROR RESPONSE.
#
GOTO CERJMP[STAT];
CCIOERRJ:
CINTLKJ:
TEST SFX; # NEXT CATALOG #
CATTERRJ:
MSG$LINE[0] = "ATTACH ERROR ON SFM SUBFAMILY CATALOG.";
MESSAGE(MSGBUF[0],UDFL1);
MSG$LINE[0] = MSG$TEXT[0];
RMVBLNK(MSGBUF[0],40);
MESSAGE(MSGBUF[0],UDFL1);
TEST SFX; # NEXT CATALOG #
CNOERRJ:
#
* END OF CASE STATEMENT FOR *COPEN* ERROR RESPONSE.
#
#
* THE FIRST WORD OF THE SUBCATALOG PREAMBLES
* ARE SCANNED TO DETERMINE WHICH SUBCATALOGS EXIST.
* FOR EACH EXISTING SUBCATALOG, THE NUMBER OF *FCT* ENTRIES
* TO SCAN IS OBTAINED FROM THE FIRST WORD OF THE SUBCATALOG
* PREAMBLE.
#
SLOWFOR SMX = 1 STEP 1 UNTIL MAXSM
DO
BEGIN # FOR EACH SUBCATALOG #
IF PRM$SCW1[SMX] EQ 0
THEN
BEGIN
TEST SMX;
END
#
* READ THE CATALOG *AST* AND UPDATE IT BASED ON THE
* ANALYSIS OF EACH *FCT* ENTRY IN THE SUBCATALOG.
#
CRDAST(NAMEFAM[FMX],SFX,PRM$SMID[SMX], ##
ASTBADR,QRADDR,CR);
#
* SIMULATED CASE STATEMENT FOR *CRDAST* ERROR PROCESSING.
#
GOTO CRERJMP[CR];
CRINTLKJ:
CRCIOERRJ:
TEST SFX;
CRNOERRJ:
#
* END OF SIMULATED CASE STATEMENT FOR *CRDAST* ERROR PROCESSING.
#
SLOWFOR FCTX = MAXGRT STEP 1 ##
WHILE FCTX LQ (PRM$ENTRC[SMX] + 15) ##
AND PRM$ENTRC[SMX] GR 0
DO
BEGIN # FOR ALL *FCT* ENTRIES FOR THIS SUBCATALOG #
ACQ$FCT(NAMEFAM[FMX],SFX,PRM$SMID[SMX],FCTX, ##
QADDR,QRADDR,CER );
#
* SIMULATED CASE STATEMENT FOR *ACQ$FCT* ERROR PROCESSING.
#
GOTO CGERJMP[CER];
CGCIOERRJ:
CGINTLKJ:
TEST SFX;
CGNOERRJ:
CRAST(FCTX,QADDR,ASTBADR);
UASTPRM(NAMEFAM[FMX],SFX,SMX,QADDR,STAT);
RLS$FCT(QADDR,0,CER);
IF CER NQ CMASTAT"NOERR"
THEN
BEGIN
GOTO RLSERR;
END
END # FOR ALL *FCT* ENTRIES FOR THIS SUBCATALOG #
#
* END OF SIMULATED CASE STATEMENT FOR *ACQ$FCT* PROCESSING.
#
TEMPCHAR[0] = PRM$SMID[SMX];
BAD$SUB[0] = CHARSUB[0];
MSG$LINE[0] = " AST UPDATED.";
MESSAGE(MSGBUF[0],UDFL1);
MSG$LINE[0] = MSG$TEXT[0];
RMVBLNK(MSGBUF[0],40);
MESSAGE(MSGBUF[0],UDFL1);
MESSAGE(BADSUB[0],UDFL1);
END # FOR EACH SUBCATALOG #
END # FOR EACH SUBFAMILY #
END # FOR EACH FAMILY WITH EIGHT SUBFAMILY CATALOGS #
RETURN;
MOCTFULLJ:
MFOPENJ:
COCTFULLJ:
CFOPENJ:
CRNOTOPENJ:
CRNOSUBCATJ:
CGNOTOPENJ:
CGNOSUBCATJ:
CGORDERRJ:
RLSERR:
FE$RTN[0] = "OPENCAT.";
MESSAGE(FEMSG,UDFL1); # EXEC ABNORMAL, OPENCAT #
ABORT;
END # OPENCAT #
TERM
PROC SET0100;
# TITLE SET0100 - PRESETS COMMON AREA(S) USED BY (1,0). #
BEGIN # SET0100 #
#
** SET0100 - PRESETS COMMON AREA USED BY (1,0).
*
* *SET0100* IS A NON-EXECUTABLE ROUTINE WHICH PRESETS
* ANY COMMON AREA(S) USED EXCLUSIVELY BY THE (1,0) OVERLAY.
* THIS IS DONE VIA A *CONTROL PRESET* DIRECTIVE.
*
#
DEF LISTCON #0#;
*CALL COMBFAS
CONTROL PRESET;
*CALL COMXINT
END # SET0100 #
TERM
PROC TERMCAT;
# TITLE TERMCAT - CLOSES THE CATALOGS AND SMMAPS. #
BEGIN # TERMCAT #
#
** *TERMCAT* - CLOSES THE CATALOGS AND SMAMAPS.
*
* THIS PROCEDURE CLOSES THE SFM CATALOGS AND SMAMAPS.
*
* PROC TERMCAT
*
* EXIT EACH SFM CATALOG AND SMMAP IS CLOSED.
#
#
**** PROC TERMCAT - XREF LIST BEGIN.
#
XREF
BEGIN
PROC CCLOSE; # CLOSES THE CATALOGS #
PROC MCLOSE; # CLOSES THE SMAMAPS #
END
#
**** PROC TERMCAT - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCMD
ITEM CSTAT U; # STATUS RETURNED FROM CCLOSE #
ITEM I U; # LOOP COUNTER #
#
* CLOSE THE CATALOGS FOR EACH FAMILY AND SUB-FAMILY
#
FASTFOR I = 1 STEP 1 UNTIL OCTLEN
DO
BEGIN
IF OCT$W1[I] NQ 0
THEN
BEGIN
CCLOSE(OCT$FAM[I],OCT$SUBF[I],0,CSTAT);
END
END
#
* CLOSE ALL THE SMAMAPS
#
FASTFOR I = 1 STEP 1 UNTIL MAXSM
DO
BEGIN
IF OMT$OPEN[I]
THEN
BEGIN
MCLOSE(I,CSTAT);
END
END
END # TERMCAT #
TERM # TERMCAT #
PROC TERMSCP;
# TITLE TERMSCP - RELINQUISHES SCP STATUS. #
BEGIN # TERMSCP #
#
** TERMSCP - RELINQUISHES SCP STATUS.
*
* THIS PROCEDURE ISSUES AN SF.EXIT.
*
* PROC TERMSCP
*
#
#
**** PROC TERMSCP - XREF LIST BEGIN.
#
XREF
BEGIN
PROC SFCALL;
END
#
**** PROC TERMSCP - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBUCR
#
* ISSUE AN SF.EXIT.
#
SFFC = SFEXIT;
SFCALL(SFBLKPTR,RCL);
END # TERMSCP #
TERM
PROC WRAPUP;
# TITLE WRAPUP - WRAP-UP PROCESSING PRIOR TO NORMAL TERMINATION. #
BEGIN # WRAPUP #
#
** WRAPUP - WRAPUP PROCESSING PRIOR TO NORMAL TERMINATION.
*
* THIS PROCEDURE DOES THE WRAP-UP PROCESSING PRIOR TO NORMAL
* TERMINATION.
*
* PROC WRAPUP
*
* MESSAGES CPU SECONDS = XXX.
* CPU PERCENT = XX.X.
* FL CHANGES = XXX.
* MAXIMUM FL = XXX.
* OVERLAY LOADS = XXX.
* FILES STAGED = XXX.
* FILES DESTAGED = XXX.
*
#
XREF
BEGIN
PROC MESSAGE; # INTERFACE TO *MESSAGE* MACRO #
PROC RTIME; # INTERFACE TO *RTIME* MACRO #
PROC TERMCAT; # CLOSES THE CATALOGS AND SMAMAPS
#
PROC TERMSCP; # RELINQUISHES SCP STATUS #
PROC TIME; # INTERFACE TO *TIME* MACRO #
FUNC XCDD C(6); # CONVERT TO DECIMAL DISPLAY #
END
#
**** PROC WRAPUP - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMXMSC
*CALL COMXOVL
ARRAY WRAPMESS [0:0] S(3);
BEGIN
ITEM WRAPFILL1 C(00,00,01) = [" "]; # LEADING BLANK #
ITEM WRAPDESC C(00,06,14); # MSG HEADER #
ITEM WRAPEQ C(01,30,02) = ["= "]; # EQUAL SIGN #
ITEM WRAPQTY C(01,42,06); # QUANTITY #
ITEM WRAPPRD C(02,18,01) = ["."]; # PERIOD #
ITEM WRAPTERM U(02,24,12) = [0]; # MSG TERMINATOR #
END
ARRAY CTIMESTAT [0:0] S(1); # ACCUMULATED JOB TIME #
BEGIN
ITEM CTIMSECS U(00,24,24); # JOB SECONDS #
ITEM CTIMMILS U(00,48,12); # JOB MILLESECONDS #
END
ITEM PERCENT I; # PERCENT OF MACHINE TIME #
ITEM RESULT C(10); # DISPLAY CODE RESULT #
TERMCAT;
TERMSCP;
#
* WRITE SYSTEM DAYFILE MESSAGES.
#
WRAPDESC[0] = "CPU SECONDS";
TIME(CTIMESTAT);
RESULT = XCDD(CTIMSECS[0]);
WRAPQTY[0] = C<4,6>RESULT;
MESSAGE(WRAPMESS,SYSUDF1);
WRAPDESC[0] = "CPU PERCENT";
RTIME(RTIMESTAT);
PERCENT = (CTIMSECS[0] * 10000) / (RTIMSECS[0] - FIRSTRTIME) + 5
;
RESULT = XCDD(PERCENT);
C<0,4>WRAPQTY[0] = C<4,4>RESULT;
C<4,1>WRAPQTY[0] = ".";
C<5,1>WRAPQTY[0] = C<8,1>RESULT;
MESSAGE(WRAPMESS,SYSUDF1);
WRAPDESC[0] = "FL CHANGES";
RESULT = XCDD(NFLCHNG);
WRAPQTY[0] = C<4,6>RESULT;
MESSAGE(WRAPMESS,SYSUDF1);
WRAPDESC[0] = "MAXIMUM FL";
RESULT = XCDD(MAX$FL);
WRAPQTY[0] = C<4,6>RESULT;
MESSAGE(WRAPMESS,SYSUDF1);
WRAPDESC[0] = "OVERLAY LOADS";
RESULT = XCDD(OVLDCNT);
WRAPQTY[0] = C<4,6>RESULT;
MESSAGE(WRAPMESS,SYSUDF1);
WRAPDESC[0] = "FILES STAGED";
RESULT = XCDD(STGCNT);
WRAPQTY[0] = C<4,6>RESULT;
MESSAGE(WRAPMESS,SYSUDF1);
WRAPDESC[0] = "FILES DESTAGED";
RESULT = XCDD(DSTCNT);
WRAPQTY[0] = C<4,6>RESULT;
MESSAGE(WRAPMESS,SYSUDF1);
END # WRAPUP #
TERM