SPL,L,O ! NAME: G1CDA ! SOURCE: 92067-18441 ! RELOC: 92067-16425 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CDA(8)"92067-16425 REV.2013 800102" ! LET G1OMS, \OUTPUT MESSAGE ROUTINE G1CQQ, \EXPAND AN ERROR CODE G1IMS, \PROMPT AND GET ANSWER G1CSD, \SHUT DOWN ROUTINE G1ZAP, \CLEAR A 16 WORD BUF. G1RD, \READ RECORD FROM CURRENT FILE G1ERP, \ERROR PROCESS ROUTINE ISMVE, \SCB READ ROUTINE \ PURGE, \FMP PURGE FILE ROUTINE OPEN, \FMP OPEN ROUTINE EXEC, \???? RNRQ \ALLOCATE/RELEASE RN NUMBERS BE SUBROUTINE,EXTERNAL ! LET .DFER, \MOVE THREE WORDS ROUTINE G1PCR \ROUTINE TO SET $SPCR BE SUBROUTINE,EXTERNAL,DIRECT ! LET KCVT \CONVERT TO 2 CHAR. ASCII BE FUNCTION,EXTERNAL ! LET FERR \INTERNAL ERROR REPORTER BE SUBROUTINE ! LET G0END, \"END GASP" G0JBF, \"JOBFIL" G0SPF, \"SPLCON" G0DCB, \MASTER DCB G0BUF, \16 WORD BUFFER IN MAIN G0WD2, \WORD 2 OF G0BUF G0W14, \WORD 14 OF G0BUF G0P1V, \VALUE OF 1'ST PRAM IN PARSE BUF G0SDN, \LOCAL SPOOL SHUT DOWN FLAG G0JDN, \LOCAL JOB SHUT DOWN FLAG G0NPR \NO PRINT FLAG BE INTEGER,EXTERNAL ! LET RESON(8),MES(3) BE INTEGER INITIALIZE RESON TO 10,"ERROR ON FILE " ! LET G0N8M BE INTEGER(20) INITIALIZE G0N8M TO 19,"TRY DA AGAIN WHEN ABOVE FILE IS CLOSED" LET CLEAN(8) BE INTEGER INITIALIZE CLEAN TO 7,"SPOOL IS DEAD!" ! LET REALY(9) BE INTEGER INITIALIZE REALY TO 8,"KILL SPOOLING? _" ! LET SIZE,SIZE1 BE INTEGER !DO NOT REARRANGE THESE LET SPOL(2),SPLNO,IER,I BE INTEGER !TWO LINES INITIALIZE SPOL TO "SPOL" INITIALIZE SPLNO,IER TO 1,0 ! LET SEC BE CONSTANT(123456K) !JOBFIL/SPLCON SECURITY CODE LET RLF BE CONSTANT(40040K) !RN RELEASE CODE WORD ! G1CDA: SUBROUTINE(F) GLOBAL ! ! IF F = -1 OR -2 THEN COMING FROM INITIALIZE ! F = -1 IF O.K. TO SHUT DOWN ! F = -2 IF SHUT DOWN NOT O.K. BECAUSE SPLCON DOES NOT EXIST OR NOT OPENED ! ASSEMBLE["EXT $SMID";"XLA $SMID";"STA SMID";\GET SESSION ID "EXT $DSCS";"XLA $DSCS";"STA DSCS"]!GET SESSION IS FLAG IF DSCS < 0 THEN GO TO INIT !IF NOT SESSON THEN GO INITIALIZE CALL ISMVE($($1717K+32),SMID,USID,1) !GET USER ID WORD IF USID = 7777K THEN GO TO INIT !ALLOW ONLY SYSTEM MGR. HERE IER _ 46 !FAILED TEST SET UP ERROR CALL G1CQQ(SIZE) !SEND IT AND G0NPR _ "NP" !SET THE NO PRINT FLAG CALL G1ERP(IER) !POST ERROR IN SCB AND RETURN !BAIL OUT! ! INIT: IF (F = -1 OR F = -2) THEN GO TO SHTDN !IF FROM INIT SKIP QUERY CALL G1IMS(REALY) !MAKE SURE IF G0P1V # "YE" THEN RETURN !IF A MISTAKE THEN RETURN ! ! FIRST CALL SHUT DOWN ! SHTDN: IF F = -2 THEN GO TO DOWN !SPLCON NOT OPENED OR CREATED IF G0JDN THEN[IF G0SDN THEN GO TO DOWN] IER _ 0 CALL G1CSD(SIZE1) ! ! FIRST GET THE NUMBER OF SPOOL POOL FILES TO PURGE ! DOWN: ASSEMBLE["XLA $SPCR";"EXT $SPCR";"STA SPCR"]! GET $SPCR CALL G1PCR(0) !ZAP $SPCR CALL OPEN(G0DCB,IER,G0SPF,0,SEC,SPCR) !TRY TO GET THE SPOOL CONTROL IF IER = -8 THEN [ \IF NOT AVAILABLE THEN CALL FERR(G0SPF); \REPORT IT AS SUCH AND GO TO EXX] !DO A REAL EXIT CALL G1ZAP(G0DCB) !ZAP THE DCB TO HOLD THE OPEN CALL OPEN(G0DCB,IER,G0JBF,0,SEC,SPCR)!OPEN JOB FILE IF IER = -8 THEN[ \IF JOBFIL NOT AVAILABLE CALL FERR(G0JBF); \REPORT THE PROBLEM GO TO EXX] !AND GO EXIT IF IER = 2 THEN GO TO RD17 !IF NO ERROR JUMP IF IER = -6 THEN[SPNO_80;GO TO GOTNO]!IF NO FILE PURGE 80 CALL G1PCR(-SPCR) !RESET $SPCR WE FAILED SOME HOW IF IER = -32 THEN IER _ 54 !CHANGE REPORT IF DISC NOT MOUNTED ! CALL FERR(G0JBF) !REPORT ANY OTHER ERROR GO TO EX !AND GET OUT ! ! RD17: CALL G1RD(G0BUF,17) !GET RECORD 17 CALL G1ZAP(G0DCB) !ZAP DCB TO KEEP FILE OPEN SPNO_G0WD2 AND 177K !SET THE COUNT IF SPNO > 80 THEN SPNO _ 80 !MAX # OF SPOOL FILES RN1_G0BUF !CAPTURE THE RN NUMBERS RN2_G0W14 !CAPTURE THE RN NUMBERS ! GOTNO: FOR I_1 TO SPNO DO THRU X SPLNO_KCVT(I) IF SPLNO < 30000K THEN SPLNO_SPLNO OR 30000K !FIX IF 01-09 CALL PURGE(G0DCB,IER,SPOL,SEC) !PURGE THE FILE IF IER > -1 THEN GO TO X IF IER = -6 THEN GO TO X !IF NO FILE OR NO ERROR CALL FERR(SPOL) !DON'T WORRY, ELSE REPORT GO TO EX !AND STOP X: !END OF LOOP ! CALL RNRQ(RLF,RN1,IS) !RELEASE THE TWO RN'S GO TO NEX1 ! NEX1: CALL RNRQ(RLF,RN2,IS) GO TO NEX2 ! NEX2: CALL PURGE(G0DCB,IER,G0JBF,SEC,SPCR) !PURGE JOB FILE IF IER < 0 THEN CALL FERR(G0JBF) !REPORT ERRORS ! CALL OPEN(G0DCB,IER,G0SPF,0,SEC,SPCR)!NOW GET SPLCON IF IER #2 THEN[ \IF ERROR REPORT IT Z: CALL FERR(G0SPF);GO TO EX] !AND EXIT ! CALL G1RD(G0BUF,1) !GET THE FIRST RECORD CALL G1ZAP(G0DCB) !DON'T LET PURGE CLOSE FILE CALL RNRQ(RLF,G0BUF,IS) !RELEASE THE RN. GO TO NEX3 ! NEX3: CALL PURGE(G0DCB,IER,G0SPF,SEC,SPCR) !PURGE THE FILE IF IER < 0 THEN GO TO Z !IF ERROR REPORT IT CALL G1OMS(CLEAN) !ELSE REPORT DONE EX: IF (F = -1 OR F = -2) THEN [ \IF CALLED FROM INIT. RETURN IF IER # 54 THEN RETURN] !IF DISCS WERE FOUND EX2: CALL G1OMS(G0END) !ELSE EXIT CALL EXEC(6) ! EXX: CALL G1OMS(G0N8M) !SEND THE -8 LINE CALL G1PCR(-SPCR) !RESET THE SPOOL CR # GO TO EX2 !AND EXIT ! END ! ! FERR: SUBROUTINE(N) CALL .DFER(MES,N) !SET UP THE FILE NAME CALL G1OMS(RESON) !SENT IT CALL G1CQQ(SIZE) !CALL ?? TO SEND FULL MESSAGE G0NPR _ "NP" !SET THE NO PRINT FLAG CALL G1ERP(IER) !POST ERROR TO THE SCB RETURN END END END$