PROC HLRQENQ(ADDR); # TITLE HLRQENQ - HIGH LEVEL REQUEST QUEUE ENQUEUER. # BEGIN # HLRQENQ # # ** HLRQENQ - HIGH LEVEL REQUEST QUEUE ENQUEUER. * * *HLRQENQ* INSERTS AN ENTRY INTO THE HIGH LEVEL REQUEST QUEUE * (HLRQ) BY LINKING THE ENTRY INTO AN *HLRQ* READY CHAIN. *HLRQENQ* * IS CALLED ONLY IF THE *HLRQ* IS NOT FULL. * * PROC HLRQENQ(ADDR) * * EXIT (ADDR) - ADDRESS OF ENTRY ADDED TO QUEUE. * * MESSAGES * EXEC ABNORMAL, HLRQENQ.*. # ITEM ADDR U; # ADDRESS OF *HLRQ* ENTRY # # **** PROC HLRQENQ - XREF LIST BEGIN. # XREF BEGIN PROC ABORT; # ABORT # PROC ADD$LNK; # ADD ENTRY TO END OF CHAIN # PROC DEL$LNK; # DELETE ENTRY FROM CHAIN # PROC MESSAGE; # ISSUE MESSAGE # END # **** # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCHN *CALL COMXHLR *CALL COMXMSC # * CHECK FOR *HLRQ* FULL. # ADDR = CHN$BOC[LCHN"HL$FRSPC"]; IF ADDR EQ 0 # IF NO FREE ENTRIES # THEN BEGIN FE$RTN[0] = "HLRQENQ."; MESSAGE(FEMSG,UDFL1); ABORT; END DEL$LNK(ADDR,LCHN"HL$FRSPC",0); # DELETE ENTRY FROM FREE SPACE CHAIN # P = ADDR; HLR$HPS[0] = PROCST"INITIAL"; ADD$LNK(ADDR,LCHN"HL$READY",0); # ADD ENTRY TO READY CHAIN # ADD$LNK(ADDR,LCHN"HL$ACTV",1); # ADD ENTRY TO ACTIVE CHAIN # RETURN; END # HLRQENQ # TERM PROC HLRQMTR; # TITLE HLRQMTR - HIGH LEVEL REQUEST QUEUE MONITOR. # BEGIN # HLRQMTR # # ** HLRQMTR - HIGH LEVEL REQUEST QUEUE MONITOR. * * THE HIGH LEVEL REQUEST QUEUE MONITOR CONTROLS THE ACTIVATION * OF *HLRQ* PROCESSORS. EACH *HLRQ* ENTRY ON THE READY CHAIN IS * ACTIVATED BY CALLING THE APPROPRIATE PROCESSOR. * * PROC HLRQMTR. * * EXIT IF THE PROCESS STATE FIELD OF AN *HLRQ* ENTRY IS SET * TO "COMPLETE" AFTER ITS PROCESSOR IS CALLED, THE ENTRY * IS CLEARED AND LINKED INTO THE FREE SPACE CHAIN. * OTHERWISE, THE PROCESSOR HAS SET UP SOME CONDITION * THAT WILL EVENTUALLY CAUSE THE *HLRQ* ENTRY TO BE * RELINKED INTO THE *HLRQ* READY CHAIN. * * NOTES *HLRQMTR* IS TO BE CALLED ONLY IF THE *HLRQ* * READY CHAIN IS POPULATED. # # **** PROC HLRQMTR - XREF LIST BEGIN. # XREF BEGIN PROC ADD$LNK; # ADD ENTRY TO END OF CHAIN # PROC DEL$LNK; # DELETE ENTRY FROM CHAIN # PROC DESTAGR; # DESTAGE A FILE # PROC STAGER; # STAGE A FILE # PROC ZFILL; # ZERO FILL BUFFER # END # **** PROC HLRQMTR - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCHN *CALL COMXCTF *CALL COMXHLR *CALL COMXMSC ITEM FLNM C(7); # FILE NAME # ITEM HLRENT U; # *HLRQ* ENTRY ADDRESS # ITEM ACTIVE I; # NUMBER OF TIMES HLRQ LOOPED # ITEM PFMFIRST B; # *UGET/UREPLACE* ACTIVE # SWITCH HLPROC:HLRPN # *HLRQ* PROCESSOR CALLS # HL1:STAGE, # PROCESSOR 1 # HL2:DESTAGE, # PROCESSOR 2 # ENDHLP:ENDPN; # END *HLRQ* PROCESSOR CALLS # CONTROL EJECT; # * TRAVERSE THE *HLRQ* READY CHAIN. # IF CHN$BOC[LCHN"HL$PFMWAIT"] NQ 0 THEN # UGET OR UREPLACE COMPLETED # BEGIN HLRENT = CHN$BOC[LCHN"HL$PFMWAIT"]; DEL$LNK(HLRENT,LCHN"HL$PFMWAIT",0); ADD$LNK(HLRENT,LCHN"HL$READY",0); PFMFIRST = TRUE; END ACTIVE = 0; FASTFOR DUMMY = 0 WHILE CHN$BOC[LCHN"HL$READY"] NQ 0 AND ACTIVE LQ 20 AND NOT GLPFMFL DO BEGIN # TRAVERSE *HLRQ* READY CHAIN # ACTIVE = ACTIVE + 1; IF PFMFIRST THEN BEGIN # TAKE CURRENT *HLRENT* # PFMFIRST = FALSE; END ELSE BEGIN # FIND NEW ADDRESS # HLRENT = CHN$BOC[LCHN"HL$READY"]; END DEL$LNK(HLRENT,LCHN"HL$READY",0); P = HLRENT; IF HLR$HPS[0] EQ PROCST"COMPLETE" THEN BEGIN GOTO ENDHLP; END # * SIMULATED CASE STATEMENT FOR *HLRQ* PROCESSOR CALLS. # GOTO HLPROC[HLR$HPN[0]]; HL1: # STAGE REQUEST # STAGER(HLRENT); GOTO ENDHLP; HL2: # DESTAGE REQUEST # DESTAGR(HLRENT); GOTO ENDHLP; ENDHLP: # * END OF SIMULATED CASE STATEMENT FOR *HLRQ* PROCESSOR CALLS. # P = HLRENT; IF HLR$HPS[0] EQ PROCST"COMPLETE" THEN BEGIN # PROCESS IS COMPLETE # # * CLEAR *HLRQ* ENTRY. # DEL$LNK(HLRENT,LCHN"HL$ACTV",1); FLNM = HLR$FLNM[0]; # PRESERVE FILE NAME # ZFILL(HLRQ,HLRQLEN); HLR$FLNM[0] = FLNM; ADD$LNK(HLRENT,LCHN"HL$FRSPC",0); STG$MSK = 0; IF CHN$BOC[LCHN"HL$DRDRESW"] NQ 0 THEN BEGIN HLRENT = CHN$BOC[LCHN"HL$DRDRESW"]; DEL$LNK(HLRENT,LCHN"HL$DRDRESW",0); ADD$LNK(HLRENT,LCHN"HL$READY",0); END END # PROCESS IS COMPLETE # END # TRAVERSE *HLRQ* READY CHAIN # RETURN; END # HLRQMTR # TERM PROC MSGAFDF(TYPE,FC,CODE,HLRQADR); # TITLE MSGAFDF - ISSUE STATUS MESSAGE TO ACCOUNT AND EXEC DAYFILE. # BEGIN # MSGAFDF # # ** MSGAFDF - ISSUE STATUS MESSAGE TO ACCOUNT AND EXEC-S DAYFILE. * * *MSGAFDF* IS CALLED BY *STAGER*, *DESTAGR*, *HLLOAD*, AND * *HLUNLD* TO ISSUE STATUS MESSAGES NOTING BEGIN OR END * OF A STAGE OR DESTAGE OPERATION, OR INITIATION OF A CARTRIDGE * LOAD/UNLOAD. AN APPROPRIATE MESSAGE IS CONSTRUCTED AND ISSUED * TO EITHER OR BOTH THE ACCOUNT AND JOB DAYFILE DEPENDING ON THE * CONTROLLING BIT MASKS AND THE *TM* RUN-TIME PARAMETER. * * PROC MSGAFDF(TYPE,FC,CODE,HLRQADR) * * ENTRY (TYPE) = MESSAGE TYPE. "I", "B", "E", OR "S". * (FC) = CODE FOR THE FUNCTION BEING PERFORMED. * "LD", "UL", "BS", "ES", "BD", "ED". *D250 * FC = *FC* LD/UL/BS/ES/BD/ED. * (CODE) = COMPLETION STATUS OF A STAGE OR DESTAGE. * (HLRQADR) = ADDRESS OF *HLRQ* ENTRY. * * EXIT THE APPROPRIATE MESSAGE IS ISSUED. * * MESSAGES * T FC MESSAGE DETAIL. * T = *TYPE* = B/E/I. * FC = *FC* = DS/LD/ST/UL. * * MESSAGE DETAIL VARIES BY MESSAGE TYPE... * * SMFC, SM=X, CSN=CCCCCCCC, ID=ZZ. * * CCCCCCCC = CARTRIDGE SERIAL NUMBER. * ZZ = MANUFACTURES'S ID. * * * SMFC, PPPPPPP/UUUUUU/FFFFFFF. * * SMFC, PPPPPPP/UUUUUU/LLLLLL-WW. * * PPPPPPP = PERMANENT FILE NAME. * UUUUUU = USER INDEX (OCTAL). * FFFFFFF = FAMILY NAME. * LLLLLL = FILE LENGTH (DECIMAL). * WW = VALUE OF *CODE* (OCTAL). # # **** PROC MSGAFDF - XREF LIST BEGIN. # ITEM TYPE C(1); # MESSAGE TYPE # ITEM FC C(2); # FUNCTION BEING DONE # ITEM CODE U; # COMPLETION STATUS # ITEM HLRQADR U; # *HLRQ* ENTRY ADDRESS # XREF BEGIN FUNC XCDD C(10); # BINARY TO DISPLAY (DECIMAL) # FUNC XCOD C(10); # BINARY TO DISPLAY (OCTAL) # PROC BZFILL; # BLANK FILL A MESSAGE # PROC MESSAGE; # ISSUE MESSAGE TO O/S # END # **** PROC MSGAFDF - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # *CALL,COMBFAS *CALL,COMBBZF *CALL,COMBLRQ *CALL,COMBTDM *CALL,COMXHLR *CALL,COMXJCA *CALL,COMXMSC DEF SKELCART #"SMFC, SM=X, CSN=CCCCCCCC, ID=ZZ." #; DEF SKELFILE #"SMFC, PPPPPPP/UUUUUU/FFFFFFF." #; DEF SKELTAG #"-WW." #; ITEM DOAF U; # CONTROL ACCOUNT FILE MESSAGE # ITEM DODF U; # CONTROL DAYFILE MESSAGE # ITEM OFFSET U; # BIT POSITION # ARRAY MSGS [0:0] S(4); BEGIN # * BASIC MESSAGE FORMAT. # ITEM MSGS$SKEL C(00,00,38); # TEXT # ITEM MSGS$SMA C(00,00,02); # *SM* # ITEM MSGS$FC C(00,12,02); # *FC* # ITEM MSGS$ZERO U(03,48,12) = [0]; # TERMINATOR # # * DETAIL FOR TYPE = "I". # ITEM MSGS$SM C(00,54,01); # X # ITEM MSGS$CSN C(01,36,08); # CCCCCCCC # ITEM MSGS$ID C(02,54,02); # ZZ # # * DETAIL FOR TYPE = "B" AND PART OF "E". # ITEM MSGS$PFN C(00,36,07); # PPPPPPPP # ITEM MSGS$UI C(01,24,06); # UUUUUU # ITEM MSGS$FAM C(02,06,07); # FFFFFFF # # * REST OF DETAIL FOR "E" TYPE MESSAGES. # ITEM MSGS$LEN C(02,06,06); # LLLLLL # ITEM MSGS$TAG C(02,42,04); # "-WW." # ITEM MSGS$CODE C(02,48,02); # WW # END CONTROL EJECT; IF TYPE EQ "S" THEN BEGIN P = HLRQADR; TYPE = "E"; END ELSE BEGIN P = HLRQADR; P = LOC(HLR$TDAM[0]); P = HLR$LRQADR[0]; END DODF = 0; # DEFAULT IS NOT TO ISSUE MESSAGE # IF TYPE EQ "I" THEN # CARTRIDGE MESSAGE # BEGIN DOAF = B<59,1>MSG$AF$CTL[0]; MSGS$SKEL[0] = SKELCART; MSGS$SM[0] = HLR$SM[0]; IF FC EQ "LD" THEN BEGIN MSGS$CSN[0] = HLR$CSND[0]; MSGS$ID[0] = HLR$CCOD[0]; END ELSE BEGIN MSGS$CSN[0] = LLR$CSND[0]; MSGS$ID[0] = LLR$CCOD[0]; END END ELSE # FILE MESSAGE # BEGIN MSGS$SKEL[0] = SKELFILE; MSGS$PFN[0] = TDAMPFN[0]; CH$10[0] = XCOD(O"1000000" + TDAMUI[0]); MSGS$UI[0] = CH$06[0]; IF TYPE EQ "B" THEN # INSERT FAMILY NAME # BEGIN MSGS$FAM[0] = TDAMFAM[0]; DOAF = B<58,1>MSG$AF$CTL[0]; END ELSE # ADD LENGTH AND TAG # BEGIN CH$10[0] = XCDD(TDAMFLN[0]); MSGS$LEN[0] = CH$06[0]; DOAF = B<57,1>MSG$AF$CTL[0]; MSGS$TAG[0] = SKELTAG; CH$10[0] = XCOD(O"100" + CODE); MSGS$CODE[0] = CH$02[0]; IF FC EQ "BS" OR FC EQ "ES" THEN BEGIN OFFSET = 59; END ELSE BEGIN OFFSET = 29; END DODF = BMSG$DF$CTL[0]; BMSG$ACT[0] = 1; END END MSGS$FC[0] = FC; BZFILL(MSGS,TYPFILL"BFILL",38); IF (DOAF NQ 0) AND RA$TRACE[0] THEN BEGIN MESSAGE(MSGS[0],ACTDF); END IF DODF NQ 0 THEN BEGIN MSGS$SMA[0] = " "; MESSAGE(MSGS[0],UDFL1); END END # MSGAFDF # TERM PROC PFMEC((ERRSTAT),ACTION); # TITLE PFMEC - CONVERT *PFM* ERROR CODES. # BEGIN # PFMEC # # ** PFMEC - CONVERT *PFM* ERROR CODES. * * *PFMEC* CONVERTS AN ERROR CODE RETURNED FROM *PFM* TO AN ERROR * ACTION CODE. THIS ACTION CODE REPRESENTS WHAT TYPE OF ACTION * EXEC SHOULD TAKE WHEN PROCESSING THE ERROR. * * PROC PFMEC((ERRSTAT),ACTION) * * ENTRY (ERRSTAT) - *PFM* ERROR CODE. * * EXIT (ACTION) - ERROR ACTION. * (VALUES DEFINED IN *COMXMSC*) * = ERRST"NOERR". * = ERRST"WAIT". * = ERRST"FATAL". * = ERRST"ABANDON". * = ERRST"SPECIAL". # ITEM ERRSTAT I; # *PFM* ERROR CODE # ITEM ACTION I; # ERROR ACTION # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMXMSC *CALL COMSPFM CONTROL EJECT; IF ERRSTAT EQ PFA OR ERRSTAT EQ FIN OR ERRSTAT EQ INA ## OR ERRSTAT EQ FTF OR ERRSTAT EQ PEA THEN # DELAY CONDITION # BEGIN ACTION = ERRST"WAIT"; RETURN; END IF ERRSTAT EQ FBS OR ERRSTAT EQ FDA ## OR ERRSTAT EQ DTE OR ERRSTAT EQ IOE OR ERRSTAT EQ PRL ## OR ERRSTAT EQ DAF OR ERRSTAT EQ MSE OR ERRSTAT EQ EDA ## OR ERRSTAT EQ EPT OR ERRSTAT EQ EDP ## OR ERRSTAT EQ FLC OR ERRSTAT EQ NEM OR ERRSTAT EQ FSE ## OR ERRSTAT EQ AIO OR ERRSTAT EQ ICU ## OR ERRSTAT EQ FIA OR ERRSTAT EQ PVE OR ERRSTAT EQ FND THEN # ABANDON CONDITION # BEGIN ACTION = ERRST"ABANDON"; RETURN; END IF ERRSTAT EQ SPN OR ERRSTAT EQ TKL THEN # SPECIAL CONDITION # BEGIN ACTION = ERRST"SPECIAL"; RETURN; END ACTION = ERRST"FATAL"; # FATAL CONDITION # RETURN; END # PFMEC # TERM PROC TRACMSG((TDAMADR),(ACTV)); # TITLE TRACMSG - ISSUE TRACE MESSAGE. # BEGIN # TRACMSG # # ** TRACMSG - ISSUE TRACE MESSAGE. * * *TRACMSG* ISSUES MESSAGES TO THE ACCOUNT DAYFILE FOR *STAGER* * AND *DESTAGR* PROVIDING INFORMATION ON THE FILE STAGE AND * DESTAGE REQUESTS BEING PROCESSED. * * PROC TRACMSG((TDAMADR),(ACTV)) * * ENTRY (TRACMSG) - ADDRESS OF *TDAM* REQUEST BLOCK CONTAINING * FILE NAME AND FILE LENGTH. * (ACTV) - 2 CHARACTER ACTIVITY CODE. * * MESSAGES *STD1, FFFFFFF.* * *STD2, FFFFFFF.* * *STD3, FFFFFFF.* * *STD4, FFFFFFF, LLLLLL.* * *STD5, FFFFFFF.* * *STS2, FFFFFFF.* * *STS3, FFFFFFF.* * *STS4, FFFFFFF, LLLLLL.* * *STS5, FFFFFFF.* * *STS6, FFFFFFF.* * * NOTES *ACTV* IS A 2 CHARACTER CODE IDENTIFYING THE ACTIVITY * WHICH OCCURED. THE FIRST CHARACTER IS *S* FOR STAGE * REQUESTS AND *D* FOR DESTAGE REQUESTS. THE SECOND * CHARACTER REPRESENTS THE ACTION AS FOLLOWS: * *1* - FILE ATTACHED FOR DESTAGE (UNDEFINED FOR * STAGE). * *2* - CARTRIDGE LOADED. * *3* - COPY TO BE INITIATED. * *4* - COPY COMPLETE. * *5* - *PFC* HAS BEEN UPDATED. * *6* - COPY FROM FIRST CARTRIDGE COMPLETE FOR A * MULTICARTRIDGE FILE (UNDEFINED FOR DESTAGE). # ITEM TDAMADR U; # ADDRESS OF *TDAM* REQUEST BLOCK # ITEM ACTV C(2); # ACTIVITY RECORDED # # **** PROC TRACMSG - XREF LIST BEGIN. # XREF BEGIN PROC BZFILL; # BLANK OR ZERO FILL ITEM # PROC MSG; # ISSUE MESSAGE # PROC RMVBLNK; # REMOVE EXCESS BLANKS # FUNC XCDD C(10); # CONVERT DECIMAL TO DISPLAY # END # **** PROC TRACMSG - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBBZF *CALL COMBTDM *CALL COMXACM *CALL COMXJCA ITEM FLEN C(10); # DISPLAY CODED FILE LENGTH # ITEM FLNM C(7); # FILE NAME # CONTROL EJECT; IF NOT RA$TRACE[0] THEN # TRACE MODE NOT SELECTED # BEGIN RETURN; END P = TDAMADR; IF ACTV EQ "S4" OR ACTV EQ "D4" THEN # INCLUDE FILE LENGTH IN MESSAGE # BEGIN ACCMMES[0] = ACCMSG4; FLEN = XCDD(TDAMFLN[0]); ACCMFLEN[0] = C<4,6>FLEN; END ELSE BEGIN ACCMMES[0] = ACCMSG3; END FLNM = TDAMPFN[0]; BZFILL(FLNM,TYPFILL"BFILL",7); ACCMPFN[0] = FLNM; ACCMACTV[0] = ACTV; RMVBLNK(ACCMSG[0],40); MSG(ACCMSG[0],ACTDF); RETURN; END # TRACMSG # TERM