       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$ 
                          