SPL,L,O ! NAME: G1CCJ ! SOURCE: 92067-18433 ! RELOC: 92067-16425 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. 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 G1CCJ(8) "92067-16425 REV.1903 790621" ! ! LET G1WFI, \GASP WRITE FILE ROUTINE G1OPN, \GASP OPEN FILE ROUTINE EXEC, \WHAT! THIS TURKEY AGAIN?? POST, \FMP FILE POST ROUTINE RNRQ, \SYSTEM RN LOCK ROUTINE G1RDF, \GASP WRITE FILE ROUTINE G1CAP, \GET USER CAP AND ACCT# G1CHK \CHECK USER CAPABILITY BE SUBROUTINE,EXTERNAL ! LET G1CUG \CHECK FOR U.G MATCH ROUTINE BE PSEUDO,EXTERNAL,DIRECT LET G1U.G \PARSE USER.GROUP BE FUNCTION,EXTERNAL,DIRECT ! LET GET.PTR \INTERNAL SUB TO GET JOB PTR BE SUBROUTINE,DIRECT ! ! LET G0BUF, \GASP BUFFER FOR JOB RECORDS G0WD1, \WORD 1 OF ABOVE BUFFER G0WD2, \WORD 2 OF ABOVE BUFFER G0WD7, \WORD 7 OF ABOVE BUFFER G0WD9, \WORD 9 OF ABOVE BUFFER G0DCB, \GASP FILE DCB G0RTN, \RETURN PARAMETER FOR AB G0CAP, \CAPABILITY G0ACT, \USER ACCOUNT # G0JBF \JOBFIL REFERENT FOR G1OPN BE INTEGER,EXTERNAL ! LET FMGR(3),PAR1,PARS2,PAR2,RSTAT BE INTEGER ! LET IOPTN BE CONSTANT(3) LET SEC BE CONSTANT(123456K) ! INITIALIZE RSTAT TO 0 INITIALIZE FMGR TO "FMGR " LET CHHI BE CONSTANT (44400K) ! ! G1CCJ: SUBROUTINE(PBUFR,PCNT,ERR) GLOBAL LET PBUFR,PCNT,ERR BE INTEGER PAR2 _ [PARS2 _ [PAR1 _ @PBUFR + 5] \ + 3] + 1 IFNOT $(@PBUFR+4) = 1 THEN [ \ RET1: ERR _ 3; GOTO RETN] CALL G1CAP(ERR)?[GO TO RETN] !GET CAP AND ACCT# FOR USER CALL G1OPN(G0DCB,ERR,G0JBF) IF ERR < 0 THEN RETURN G1RDF(17,ERR) ? [GOTO RETN] IF [REC_$PAR1+18] > G0WD1 THEN[ \IF BAD JOB NUM EXIT ER3: ERR_3;RETURN] IF $PAR1 <= 0 THEN GO TO ER3 !IF JOB # ILLEGAL SEND ERROR ! JRN _ G0BUF POST(G0DCB) RNRQ(1,JRN,RSTAT) CALL G1RDF(REC,ERR)?[GO TO RETN] IF [NP_G0BUF]<0 THEN [ERR_3;GO TO RETN]!IF NO JOB HERE EXIT IF (G0WD2 = "CS") OR (G0WD2 = "A") THEN [ \ RET2: ERR _ 4; GOTO RETN] ! IF G0WD1 # G0ACT THEN[ \IF NOT CALLERS ACCOUNT CALL G1CHK(ERR)?[GO TO RETN]] !AND NOT CAPABLE, ERROR ! IF PCNT < 0 THEN[ \ABORT REQUEST NP_0; \SET FOR INPUT ABORT IF G0WD2 = "I" THEN GO TO IAB; \IF INPUT OR IF (G0WD2 AND 177400K) = CHHI THEN[ \INPUT A OR H IAB: G0WD2_ "IA";GO TO WRT2]; \SET TO IA G0WD2_ "A";NP_ -G0BUF;GO TO WRT] !ELSE SET TO A ! IFNOT $PARS2 = 1 THEN GOTO CHR IF $PAR2 < 1 THEN GOTO RET1 NP,G0BUF _ $PAR2 AND 377K; GOTO WRT ! ! CHANGE STATUS ! CHR: PAR2_$PAR2 AND 177400K IF PAR2 = 44000K THEN[ \HOLD REQUEST IFNOT [HI_G0WD2 AND 177400K] THEN \IF NO HIGH STATUS HI_G0WD2*400K; \USE THE LOW STATUS G0WD2_HI+"H";NP_0;GO TO WRT] !SET UP AND EXIT IF PAR2 = 51000K THEN[ \RELEASE REQUEST IF G0WD2 AND 177400K THEN \IF A HIGH STATUS G0WD2_G0WD2/400K; \JUST PUT IT LOW ELSE NOP IF G0WD2 # "R" THEN NP_0; \IF NOT READY DON'T Q IT GO TO WRT] ERR_56 !BAD PRAM SO SEND ERROR CJERR: IF ERR THEN GOTO RETN GOTO RET2 WRT: CALL G1WFI(G0BUF,REC) ? [GOTO RETN] ! ! ROUTINE TO REMOVE A JOB FROM THE JOB Q GIVEN THE RECORD # (REC) ! WE ASSUME JOB IS IN THE Q AND IS NOT ACTIVE ! WR,LR_0 !SET INITIAL POINTERS AD_@G0BUF PTR,JOBAT _ REC - 17 !GET THE POINTER IN THE Q CALL GET.PTR !FOR THE JOB TO BE REMOVED SP_PTR !AND SAVE FOR RE LINKING PTR_1 !START WITH THE HEAD UNTIL PTR=JOBAT DO[ \RUN DOWN THE LIST CALL GET.PTR; \TILL WE FIND A POINTER IFNOT PTR THEN GO TO RE.Q] !IF NOT FOUND EXIT LOOP ! ! WE FOUND IT NOW REMOVE IT ! $CAD_$CAD XOR PTR XOR SP !PUT IN NEW POINTER WR,PTR_1 !SET TO GET THE HEAD AGAIN CALL GET.PTR !GET THE HEAD IF (($CAD -< 8) AND 377K) = JOBAT THEN[\IF JOB WAS NEXT $CAD _ (SP -< 8) +PTR; \THEN UPDATE NEXT PTR WR_1] !SET THE MUST WRITE FLAG RE.Q: !END OF D Q ! IFNOT NP THEN GO TO JRQEX !IF NOT TO BE Q'ED SKIP ! ! THE FOLLOWING QUEUES A JOB IN THE JOB Q BY PRIORITY ! ! THIS ROUTINE REQUIRES THE RECORD NUMBER (REC) AND PRIORITY (NP) ! ! JOBS ARE QUEUED IN THE FIRST SEVERAL RECORDS OF JOBFIL. THE ! FORMAT IS AS FOLLOWS: ! ! WORD0 - THE RN # FOR LOCKING THE FILE ! WORD1 - [ NEXT | HEAD ] ! WORD2-127 [PRIORITY | POINTER TO NEXT JOB ] ! ! WHERE: HEAD POINTS AT THE FIRST JOB IN THE Q ! NEXT POINTS AT THE NEXT JOB TO BE RUN. IF NEXT # HEAD THEN ! THE JOBS LINKED BETWEEN HEAD AND NEXT ARE ACTIVE. ! ACTIVE JOBS ARE EITHER RUNNING OR WAITING FOR ! ABORTION. ! PRIORITY IS THE PRIORITY OF THE JOB ! POINTER TO NEXT JOB IS A POINTER (WORD ADDRESS) TO THE NEXT ! ENTRY. IT IS 0 AT THE END OF THE LIST ! ! THE LOCATION IN THE FILE (I.E. WORD#) INDICATES THE JOB RECORD NUMBER ! I.E. REC # = WORD # +17. ! ! LETS BEGIN FIRST PICK UP THE HEAD AND NEXT POINTERS ! PTR_1 !ADDRESS OF HEAD CALL GET.PTR !GET HEAD (IN PTR) NEXT_([HEAD_PTR] XOR $CAD) -< 8 !SAVE HEAD AND NEXT ! ! IF PRORITY IS NEG. THEN WE ARE ABORT LINKING ! IF NP < 0 THEN[ \YES SCAN DOWN TO NEXT UNTIL NEXT = PTR DO CALL GET.PTR; \AND INSERT JUST BEFORE NEXT WR,$CAD _ ($CAD XOR PTR) OR JOBAT;\UP DATE POINTER TO INCLUDE JOB PTR_JOBAT; \NOW ADD THE JOB TO COMPLET LIST CALL GET.PTR; \ WR,$CAD_ 400K+NEXT; \SET PR TO HIGH GO TO JRQEX] !GO WRITE AND EXIT ! ! REINSERT BY PRIORITY ! MUST BE AFTER NEXT BUT IN HEAD LIST SO RUN DOWN HEAD LIST ! UNTIL NEXT = PTR. ! UNTIL NEXT=PTR DO CALL GET.PTR !THERE EASY WASN'T IT? ! ! NOW MUST DO A PRIORITY SEARCH FOR THE INSERT LOCATION ! NEXTQ: IFNOT PTR THEN GO TO QEND !IF END OF LIST PUT IT HERE CALL GET.PTR !ELSE GET THE NEXT ENTRY IF (($CAD -< 8) AND 377K) <= NP THEN GO TO NEXTQ !LOOK AT PRIORITY ! ! EITHER END OF LIST OR PRIORITY FOUND ! PTR_LAST !BACK UP TO THE LAST ENTRY CALL GET.PTR !GET LAST ENTRY IN THE LIST QEND: WR,$CAD_($CAD XOR PTR) XOR JOBAT !REPLACE POINTER WITH NEW JOB SP_PTR !SAVE OLD PTR PTR_JOBAT !FETCH THE NEW JOB ENTRY CALL GET.PTR !AND WR,$CAD_(NP -< 8) OR SP !UP DATE IT'S NP AND POINTER ! ! NOW MUST UP DATE THE NEXT POINTER IF WE HAVE A NEW NEXT ! IF NEXT = SP THEN[ \WELL? PTR_1; \YES A NEW NEXT SO UP DATE IT CALL GET.PTR; \FETCH IT FIRST WR,$CAD_(JOBAT -< 8) + PTR] !UPDATE THE WORD ! ! ALL DONE MAKE SURE AND FLUSH THE FINAL RECORD ! JRQEX: IF WR THEN CALL G1WFI(G0BUF,CR) !FLUSH IT OUT GO TO RETN !SKIP WRITE BACK ! WRT2: CALL G1WFI(G0BUF,REC) RETN: IF RSTAT = 2 THEN [POST(G0DCB); \ RNRQ(4,JRN,RSTAT)] IF PCNT<0 THEN GO TO ABT IF PAR2 = 51000K THEN[\ IF GOING ACTIVE OR ABORT THEN ABT: IFNOT ERR THEN CALL EXEC(10,FMGR,-1)]!CALL FMGR TO FINISH RETURN END ! ! GET.PTR THIS ROUTINE GETS THE JOB Q ENTRY POINTED TO BY PTR ! IT ALSO SETS UP CAD TO POINT AT THE ENTRY AND EXTRACTS A ! NEW PTR. IF WR IS NOT ZERO IT WRITES THE LAST RECORD ! PROVIDED IT IS NOT ALSO THE NEW CURRENT RECORD. ! GET.PTR:SUBROUTINE DIRECT LAST_L !PROPAGATE THE LAST POINTER IFNOT [L_PTR] THEN GO TO RETN !RETURN IF END OF LIST CR_(PTR/16)+1 !CACULATE THE RECORD AND CAD_.B.+AD !BUFFER ADDRESSES IF CR # LR THEN[ \IF NOT THE SAME RECORD IF WR THEN[ \AND RECORD MODIFIED CALL G1WFI(G0BUF,LR)?[GO TO RETN];\THEN WRITE IT OUT WR_0]; \AND CLEAR THE WR FLAG CALL G1RDF([LR_CR],ERR)?[GO TO RETN]] !NOW READ THE NEW ONE PTR_$CAD AND 377K !EXTRACT THE NEW POINTER RETURN !AND RETURN END ! ! ! ABORT SETS THE JOB ACTIVE AND COUNTS ON FMGR TO CLEAN UP ! G1CAB: SUBROUTINE(P1,P2,P3) GLOBAL JONO_[P1F_@P1+4]+1 !SET UP ADDRESS OF JOBNO G0RTN_-1 !SET RETURN PRAM TO FALT RTN_0 !AND INITIALIZE THE REAL COUNT IF [U_G1U.G()] > 0 THEN [ \IF U.G BUT IN ERROR P3 _ 56; \THEN PUT OUT RETURN] !THE LIGHTS IF U < 0 THEN[ \IF NOT GIVEN THEN DO STD. CALL G1CCJ(P1,-1,P3); \AB CALL AND RETURN] !GET OUT ! CALL G1OPN(G0DCB,P3,G0JBF) !OPEN THE JOBFIL IF P3 < 0 THEN RETURN !QUIT IF ERROR ON OPEN ! CALL G1RDF(17,P3)?[RETURN] !GET THE TOTAL NUM OF JOBS ENDJ_G0WD1 !TO ENDJ $P1F _ 1 !SET THE NUM PRESENT FLAG FOR JOBNO _ 19 TO ENDJ DO[ \LOOP TO ABORT CALL G1RDF(JOBNO,P3)?[RETURN]; \READ THE JOB RECORD IF G0BUF > -1 THEN[ \IF A JOB HERE IFNOT [G1CUG() _ G0WD1] THEN[ \AND U.G MATCHES $JONO_JOBNO-18; \SET JOB NO. IN CALL BUF P3_0; \SET ERROR FLAG TO 0 CALL G1CCJ(P1,-1,P3); \CALL CJ TO ABORT THE JOB IF P3 THEN RTN _ RTN + 1 ]]]!IF ERROR STEP NOT DONE COUNT G0RTN_RTN !SET THE NO. NOT DONE AND P3_0 !CLEAR THE ERROR COUNT RETURN !ALL DONE END END END$