ASMB,R,L
*     NAME:   $SPOL 
*     SOURCE: 92002-18001 
*     RELOC:  92002-16001 
*     PGMR:   A.M.G.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  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.       *
*  ***************************************************************
* 
      NAM $SPOL 92002-16001 REV. 1805 771116
      END 
       SPL,L,O
!     NAME:   GASP
!     SOURCE: 92002-18001 
!     RELOC:  92002-16001 
!     PGMR:   A.M.G.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975.  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 GASP(3,80) "92002-16001 760615" 
! 
! 
       LET G1ERP,G1OMS,G1ZAP,G1WFI BE SUBROUTINE
       LET G1IMS BE SUBROUTINE
! 
       LET KCVT BE FUNCTION,EXTERNAL
       LET POST,CREAT,OPEN,CLOSE,POSNT,EXEC BE SUBROUTINE,EXTERNAL
       LET READF,WRITF,PARSE,G1ROT,G1CEX BE SUBROUTINE,EXTERNAL 
       LET G1CIN,RNRQ,REIO BE SUBROUTINE,EXTERNAL 
       LET ST.LU BE SUBROUTINE,DIRECT,EXTERNAL
       LET G1RD,G1WFI,G1OPN BE SUBROUTINE 
       LET ERTS BE SUBROUTINE,DIRECT
! 
       LET G0END,G0NJB,G0NLO,G0SZF,G0NSP BE INTEGER,EXTERNAL
       LET CS43,N.SEQ,G0MXP,G0SLU BE INTEGER,EXTERNAL 
! 
       LET G0EXN,G0JBF,G0SPF BE INTEGER(3),GLOBAL 
       LET PRMPT BE INTEGER(2)
       LET JODCB,SPDCB BE INTEGER(16)  !DO NOT REARRANGE THESE TWO
       LET G0DCB BE INTEGER(144),GLOBAL     !LINES
       LET SIZE,SIZE1 BE INTEGER
       LET ERRS BE INTEGER(3) 
       LET SIGN,ERRNO,SSPOL BE INTEGER
       LET NSPL,IERR,SAVE,SAVE1,SAVE2 BE INTEGER
       LET WRN,IRN,ICNWD,CHARS,FFILE,ADDR BE INTEGER
       LET G0BUF,G0WD1,G0WD2,G0WD3 BE INTEGER,GLOBAL
       LET G0WD4 BE INTEGER(3),GLOBAL 
       LET G0WD7,G0WD8,G0WD9,G0W10,G0W11            \ 
          BE INTEGER,GLOBAL 
       LET G0W12 BE INTEGER(2)
       LET G0W14 BE INTEGER 
       LET G0W15 BE INTEGER,GLOBAL
       LET G0W16(110) BE INTEGER
      LET PBFN2,PBFN1 BE INTEGER
       LET PBUFX,BUFX1,BUFX2,BUFX3,BUFX4 BE INTEGER 
       LET BUFX5 BE INTEGER(9)
       LET BUX14 BE INTEGER 
       LET BUX15 BE INTEGER(17) 
       LET G0PBF BE INTEGER,GLOBAL
       LET G0P1V BE INTEGER,GLOBAL
       LET PARS1 BE INTEGER(3)
       LET G0P2V BE INTEGER,GLOBAL
       LET PARS2 BE INTEGER(26) 
       LET G0NOP BE INTEGER,GLOBAL
       LET G0SDN,G0JDN BE INTEGER,GLOBAL
       LET G0TTY,G0RDS,G0ERH BE INTEGER,GLOBAL
! 
       INITIALIZE PRMPT TO 1,57137K 
       INITIALIZE G0RDS TO 0
       INITIALIZE G0EXN TO "EXTND"
       INITIALIZE G0JBF TO "JOBFIL" 
       INITIALIZE G0SPF TO "SPLCON" 
       INITIALIZE ERRS,SIGN TO 4,"GASP  " 
! 
       LET CNWD BE CONSTANT(400K) 
       LET E BE CONSTANT(42440K)
       LET SEC BE CONSTANT(123456K) 
       LET IOPTN BE CONSTANT(3) 
! 
GASP:  CALL EXEC(22,2);SAVE1 _ $$1
       IFNOT [G0TTY _ (SAVE1 AND 77K)] THEN G0TTY _ 1 
       G0TTY _ G0TTY + CNWD                 !SAVEG0TTY. 
       IF [X_CS43] THEN GOTO FCHEK
       CALL ST.LU                           !SET UP $LUAV AND CS43. 
       CALL EXEC(9,G0EXN,0)                 !EXTND SETS UP $MPID. 
FCHEK: CALL OPEN(JODCB,IERR,G0JBF,IOPTN,SEC)!TRY TO OPEN JOBFIL.
       CALL ERTS                            !TEST FOR ERRORS
       CALL G1ZAP(SPDCB)
       CALL OPEN(SPDCB,IERR,G0SPF,IOPTN,SEC) !NOW TRY SPLCON
       CALL ERTS                            !TEST FOR ERRORS
       CALL G1OPN(G0DCB,IERR,G0JBF)         !MOVE THE OPEN DATA 
       CALL G1RD(G0BUF,17)                  !READ RECORD 17 
       IF X THEN GOTO RSTRT 
       CALL G1RD(PBUFX,1)                   !REALLOCATE RN S
       RNRQ(20K,PBUFX,SAVE)                 !FOR SPLCON/JOBFIL
       G0BUF _ PBUFX                        !TIME THROUGH AFTER 
       RNRQ(20K,G0W14,SAVE)                 !ALLOCATE HOLD BEM RN.
       CALL G1WFI(PBUFX,1)                  !BOOT-UP. 
       CALL G1WFI(G0BUF,17) 
RSTRT: CALL G1OPN(G0DCB,IERR,G0SPF)         !SET TO ACCESS SPLCON 
       IF X THEN GO TO RSTR2
       CALL G1RD(PBUFX,1) 
       RNRQ(20K,PBUFX,SAVE) 
       CALL G1WFI(PBUFX,1)
RSTR2: CALL G1RD(PBUFX,3) 
       G0SDN_PBUFX;G0JDN_G0W15              !SET THE DOWN FLAGS 
       IF X THEN GO TO GETCD
       BUFX1 _ G0W14
       CALL G1WFI(PBUFX,3)
       CALL G1CEX(-1)                       !TERMINATE
       GO TO GETCD                          !GET COMMAND ON RESTART 
! 
TERM:  CALL CLOSE(JODCB,IERR)                !CLOSE THE FILE AND
       CALL CLOSE(SPDCB)
EX:    CALL EXEC(6)                          !EXIT
! 
GETCD: IFNOT G0RDS THEN [                    \READ NEXT COMMAND AND 
          CALL G1IMS(PRMPT)]                 !PARSE, IF NECESSARY.
       IERR,G0RDS _ 0 
       CALL G1ROT(G0PBF,G0NOP,IERR)          !GO TO PROPER ROUTINE. 
ERCHK: IFNOT IERR THEN GOTO GETCD            !COME BACK.  CHECK FOR 
       CALL G1ERP(IERR)                      !ELSE REPORT THE ERROR 
       GO TO GETCD                           !GO GET THE NEXT COMAND
! 
! 
INIT:  IF SAVE1 < 0 THEN GO TO EX            !IF NO INPUT UNIT, EXIT. 
       G0P1V_60K                            !SET CODE TO GET TO INIT
       CALL G1ROT(G0PBF,G0NOP,IERR)         !CALL INNITILIZE
       CALL G1OMS(G0END)                    !SEND END MESSAGE 
       GO TO EX 
! 
!  THE FOLLOWING ROUTINE ZEROES A 16-WORD BUFFER AREA.
! 
G1ZAP: SUBROUTINE(LOCAT) GLOBAL 
       LET LOCAT BE INTEGER 
       SAVE2 _ @LOCAT - 1 
       REPEAT 16 TIMES DO [                 \ 
          $[SAVE2 _ SAVE2+1] _ 0] 
       RETURN 
       END
! 
!  THE FOLLOWING ROUTINE GETS THE RESPONSE TO QUESTIONS 
!  AT INITIALIZATION. 
! 
G1IMS: SUBROUTINE(MESS) GLOBAL
       LET MESS BE INTEGER
       CALL G1OMS(MESS) 
       CALL REIO(1,G0TTY,G0BUF,-32) 
       CHARS _ $1 
       CALL PARSE(G0BUF,CHARS,G0PBF)
       RETURN 
       END
! 
!  WRITE OUT A MESSAGE
! 
G1OMS: SUBROUTINE(STRNG) GLOBAL 
       LET STRNG BE INTEGER 
       SAVE2 _ @STRNG + 1 
       CALL EXEC(2,G0TTY,$SAVE2,STRNG)
       RETURN 
       END
! 
!     READ RECORD NUMR TO RDBF
! 
G1RD: SUBROUTINE(RDBF,NUMR)GLOBAL 
      CALL READF(G0DCB,IERR,RDBF,16,LOC,NUMR) !READ THE RECORD
      IF IERR<0 THEN GO TO ERMS 
      RETURN
      END 
! 
!     ERROR ROUTINE FOR FIRST OPENS 
! 
ERTS: SUBROUTINE DIRECT 
      IFNOT IERR+6 THEN GO TO INIT
      IF IERR<0 THEN[\
ERMS:     CALL G1ERP(IERR);GO TO TERM]
      RETURN
      END 
! 
!     THIS OPEN ROUTINE REALLY JUST MOVES IN A SAVED DCB HEADER 
! 
G1OPN: SUBROUTINE(NWDCB,RREI,NAMF) GLOBAL 
      DPT_@NWDCB
      RREI_2        !ERROR IS ALWAYS TWO
      IF NAMF = "SP" THEN GO TO SPOPN !IF SPOOL GO DO IT
      SPT_@JODCB    !SET SOURCE POINTER 
      GO TO MVOPN   !GO DO THE MOVE 
! 
SPOPN: SPT_@SPDCB                           ! SET UP FOR SPOOL CON
MVOPN: CALL POST(NWDCB,IERR)                !POST ANY DATA
       FOR K_0 TO 15 DO[$(DPT+K)_$(SPT+K)]  !MOVE DCB 
       RETURN 
       END
! 
!  WRITE A RECORD TO A FILE.
! 
G1WFI: SUBROUTINE(RECD,RNUM) GLOBAL,FEXIT 
       LET RECD,RNUM BE INTEGER 
       CALL WRITF(G0DCB,IERR,RECD,16,RNUM)
       IF IERR THEN FRETURN 
       RETURN 
       END
! 
!     PRINT CURRENT ERROR ROUTINE 
! 
G1ERP: SUBROUTINE(BOMNO) GLOBAL 
       SAVE_BOMNO 
       IF BOMNO < 0 THEN [SAVE_ -BOMNO;       \IF NEGATIVE SET SIGN 
          SIGN_ 20055K]                     !TO "-" 
       ERRNO_ KCVT(SAVE)                    !CONVERT TO ASCII 
       CALL G1OMS(ERRS)                     !SEND THE MESSAGE 
       SIGN _ "  "                          !BLANK THE SIGN AGAIN 
       G0ERH _ BOMNO                         !KEEP THE HISTORY
       RETURN                               !EXIT 
       END
! 
! 
       END GASP 
       END$ 
       SPL,L,O
!     NAME:   G1CDJ 
!     SOURCE: 92002-18001 
!     RELOC:  92002-16001 
!     PGMR:   A.M.G.
!     DATE:   741015
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975.  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 G1CDJ(8)
       LET G1SCH,G1RDF BE SUBROUTINE
       LET G1OMS BE SUBROUTINE,EXTERNAL 
       LET G1STM BE SUBROUTINE,EXTERNAL,DIRECT
       LET EXEC,G1OPN,READF BE SUBROUTINE,EXTERNAL
! 
       LET G0W15,G0BUF,G0WD1,G0WD7,G0WD8,G0WD9 BE         \ 
          INTEGER,EXTERNAL
       LET CNTR,BEGIN,TYP,SKEY BE INTEGER 
       LET G0JHD,G0TTY,G0DCB,G0JBF BE INTEGER,EXTERNAL
       LET DOWN(6) BE INTEGER 
       INITIALIZE DOWN TO 5," SHUT DOWN"
       LET SPACE BE REAL
       INITIALIZE SPACE TO 2,"  " 
! 
       LET CNWD BE CONSTANT(1100K)
! 
! 
! 
G1CDJ: SUBROUTINE(PBUFR,PCNT,ERR) GLOBAL
       LET PBUFR,PCNT,ERR BE INTEGER
       BEGIN _ 19;  TYP _ $(@PBUFR+4) 
       SKEY _ @PBUFR+5
       ICNWD _ CNWD + G0TTY                 !SET UP I/O DEVICE. 
       CALL EXEC(3,ICNWD,-1)
       CALL G1OMS(G0JHD)
       CALL G1OMS(SPACE)
       CALL EXEC(3,ICNWD,1) 
       CALL G1OPN(G0DCB,ERR,G0JBF)
       IF ERR < 0 THEN RETURN 
       CALL G1RDF(17,ERR)?[RETURN]          !GET SPEC RECORD
       ENDR_G0WD1                           !SAVE THE END RECORD
! 
       IFNOT (PCNT-1) THEN GOTO WHOLE 
       FL_0                                 !SET NONE FOUND YET FLAG
SEEK:  G1SCH(SKEY,TYP,BEGIN,ENDR,ERR)    \
          ? [IF FL THEN GO TO RETN;IFNOT ERR THEN ERR_6;RETURN] 
       CALL G1STM                           !PRINT OUT STATUS 
       IF [FL_TYP] = 2 THEN [               \IF NAME KEY, THEN
          BEGIN _ BEGIN + 1;  GOTO SEEK]    !LOOK FOR MORE JOBS 
       GOTO RETN                            !OF SAME NAME.
WHOLE: CALL G1RDF(17,ERR) ? [RETURN]
       CNTR _ G0WD1 
       FOR STRT _ 19 TO CNTR DO [           \ 
          CALL G1RDF(STRT,ERR) ?             \
          [RETURN];  IF G0BUF >= 0 THEN     \ 
          CALL G1STM] 
RETN:  IF ERR THEN RETURN 
       CALL G1RDF(17,ERR)?[RETURN]
       IF G0W15 = "D" THEN CALL G1OMS(DOWN) 
       RETURN 
       END
! 
!  SEARCH THE JOBFIL FOR A JOB (NAME OR NUMBER KEY).
! 
G1SCH: SUBROUTINE(KEY,TYPE,STR,ENDF,ERRS) GLOBAL,FEXIT
       LET KEY,TYPE,STR,ENDF,ERRS BE INTEGER
       FOR STR _ STR TO ENDF DO [           \ 
          CALL G1RDF(STR,ERRS) ? [FRETURN]; \ 
          IF G0BUF >= 0 THEN [               \
             IF TYPE = 1 THEN [             \ 
                IF $KEY = G0WD1 THEN RETURN],  \
             ELSE [IF  $KEY = G0WD7  THEN [IF     \ 
                   $(KEY+1) = G0WD8 THEN [IF \
                      $(KEY+2) = G0WD9 THEN\
                      RETURN]]]]] 
       FRETURN
       END
! 
G1RDF: SUBROUTINE(NUM,ERROR) GLOBAL,FEXIT 
       LET NUM,ERROR BE INTEGER 
       CALL READF(G0DCB,ERROR,G0BUF,16,LEN,NUM) 
       IF ERROR THEN FRETURN
       RETURN 
       END
       END
       END$ 
       SPL,L,O
!     NAME:   G1CCJ 
!     SOURCE: 92002-18001 
!     RELOC:  92002-16001 
!     PGMR:   G.A.A.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975.  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) "92002-16001 760615" 
! 
! 
       LET G1SCH,G1WFI,G1OPN BE SUBROUTINE,EXTERNAL 
       LET EXEC,POST,RNRQ,G1RDF BE SUBROUTINE,EXTERNAL
! 
       LET G0DCB,G0JBF,G0BUF,G0WD1,G0WD2,G0WD7 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 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] 
       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 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 WRT];            \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;  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]
       REC_(REC-1)/16                       !GET FLAG ADDRESS 
       OFF_$1 
       CALL G1RDF(REC,ERR)?[GO TO RETN] 
       $(@G0BUF+OFF)_NP                     !SET THE NEW PRIORTY
       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
! 
!      ABORT SETS THE JOB ACTIVE AND COUNTS ON FMGR TO CLEAN UP 
! 
G1CAB: SUBROUTINE(P1,P2,P3) GLOBAL
       CALL G1CCJ(P1,-1,P3)                 !CALL CHANGE JOB TO DO IT 
       RETURN 
       END
       END
       END$ 
       SPL,L,O
!     NAME:   G1CEX 
!     SOURCE: 92002-18001 
!     RELOC:  92002-16001 
!     PGMR:   G.A.A.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975.  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 G1CEX(8) "92002-16001 760615" 
! 
       LET CLOSE,POST,G1OPN,EXEC,G1OMS BE SUBROUTINE,EXTERNAL 
       LET G1SUB,G0JDN,G0SDN,G0DCB,G0TTY,G0END BE INTEGER,EXTERNAL
! 
G1CEX:  SUBROUTINE(N) GLOBAL
       IF N # -1 THEN CALL G1OMS(G0END) 
       CALL POST(G0DCB)                     !POST DCB IF NEEDED 
       IFNOT G0JDN THEN GO TO EX            !IF BOTH
       IFNOT G0SDN THEN GO TO EX            !JOB AND SPOOL SHUT 
       CALL G1OPN(G0DCB,I,"JO")             !DOWN CLOSE BOTH FILES
       CALL CLOSE(G0DCB)                    !AND
       CALL G1OPN(G0DCB,I,"SP")             !DO NORMAL TERM 
       CALL CLOSE(G0DCB)
       CALL EXEC(6) 
! 
!      SPOOL OR JOB OR BOTH STILL ACTIVE
!      SO SAVE RESOURCES AND TERMINATE
! 
EX:    CALL EXEC(22,2)                      !DON'T SWAP ALL OF MEM
       G1SUB_0                              !CLEAR SEGMENT FLAG 
       CALL EXEC(6,0,1,0) 
       I_$$1                                !GET THE LU 
       IFNOT [G0TTY_(I AND 77K)] THEN G0TTY_1 
       G0TTY_G0TTY+400K                     !SET THE ECHO BIT 
       RETURN 
       END
       END
       END$ 
       SPL,L,O
!     NAME:   G1CKS (G1CRS) 
!     SOURCE: 92002-18001 
!     RELOC:  92002-16001 
!     PGMR:   G.A.A.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975.  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 G1CKS(8) "92002-16001 760627" 
! 
! 
!      THIS ROUTINE KILLS OUT SPOOL FILES WHICH ARE PENDING 
!      ON SOME LU OR IN ONE OF THE HOLD STATES. 
! 
!      IT IS INVOKED WITH THE:
! 
!      KS,PRAM                              COMMAND 
! 
!      WHERE PRAM IS: 
!        NUMERIC MEANING KILL THE SPOOL ACTIVE ON LU PRAM 
!        ASCII MEANING KILL THE SPOOL BY NAME PRAM
! 
       LET G1IMS, \ 
           G1WFI,POST,G1OPN,G1RDF,EXEC,RNRQ BE SUBROUTINE,EXTERNAL
       LET G1KLG                   BE FUNCTION,EXTERNAL,DIRECT
! 
       LET G0DCB,G0SPF,G0BUF,G0WD1,G0WD2,G0WD3,G0WD4,\
           G0W10,G0W15,G0P1V,G0KIL BE INTEGER,EXTERNAL
! 
       LET RD,RECV,WRIF                     BE SUBROUTINE,DIRECT
! 
       LET SMP(3)  BE INTEGER 
       LET JOB(3)  BE INTEGER 
       INITIALIZE SMP TO "SMP   " 
       INITIALIZE JOB TO "JOB   " 
! 
G1CKS: SUBROUTINE(PRAM,N,ER) GLOBAL 
! 
       LU_[PV3_[PV2_[PV_[PF_@PRAM+4]+1]+1]+1]+2 !SET UP PRAM ADDRESSES
       IFNOT $PF THEN [ER_55;RETURN]        !IF NO PRAM SEND ERROR
       CALL G1OPN(G0DCB,ER,G0SPF)            !OPEN THE SPOOL FILE 
       IF ER<0 THEN RETURN                  !IF ERROR EXIT
       ER_0                                 !SET TO ZERO SO NO ERROR IS REPORTED
       IF N= -1 THEN CALL EXEC(9,JOB,-1)    !IF KILL CHECK JOB FIRST
! 
       CALL G1RDF(1,ER)?[RETURN]            !READ THE RN RECORD 
       JRN_G0BUF                            !SAVE THE RN
       CALL POST(G0DCB) 
       CALL RNRQ(1,JRN,RNST)                !LOCK THE FILE
       LREC_[FREC_G0WD3]+G0WD1-1            !GET RECORD NUMBERS 
       NLUS_G0WD2                           !AND NUMBER OF LUS
       IF N= -1 THEN GO TO LUCK             !IF RS CALL GO TO CHECK LU
       IF $PF=2 THEN GO TO NAM              !IF NAME, DO NAME SEARCH
       FOR I_1 TO NLUS DO[                  \START LU SCAN
          CALL RD((I*8)+1);                 \READ THE LU BLOCK
          IF (G0BUF AND 77K)=$PV THEN GO TO FLU]!JUMP IF FOUND
! 
!      END OF SCAN AND NOT FOUND
! 
BADPM: ER_56                                !SEND BAD PRAM ERROR
EX:    CALL RNRQ(4,JRN,RNST)                !UNLOCK THE RN AND
       RETURN                               !EXIT 
! 
!      THE LU WAS FOUND 
! 
FLU:   IFNOT G0WD1 THEN [                   \IF NO QUE EXIT 
ER4:   ER_4;GOTO EX]                        !WITH ERROR 4 
       RNUM_G0WD2                           !GET THE FIRST FILE 
       CALL RD(RNUM)                        !READ THE SPOOL CON RECORD
       IF G0W10="A" THEN GO TO KL1          !MAKE SURE IT IS ACTIVE 
       IF G0W10="AH" THEN GO TO KL1         !ELSE 
       GO TO ER4                            !GO SEND ILLEGAL STATUS 
! 
KL1:   FLAG_1                               !SET LEGAL COUNT IF ACTIVE
       IF G0W10="A"  THEN GO TO KL2         !SPOOL FILE MUST BE 
       IF G0W10="AH" THEN GO TO KL2         !IN A DEFINED STATE 
       FLAG_0 
       IF G0W10="W"  THEN GO TO KL2         !IN A DEFINED STATE 
       IF G0W10="H"  THEN GO TO KL2         !IN A DEFINED STATE 
KL0:   CALL G1IMS(G0KIL)                    !ELSE MAKE SURE FIRST 
       IF G0P1V = "YE" THEN GO TO KL4       !IF  YES ANSWER DO IT 
       GO TO EX                             !ELSE RETURN NO ACTION
! 
KL2:   IF G1KLG(RNUM) > FLAG THEN GO TO KL0 !IF STILL WRITING, ASK FIRST
KL4:   CALL RNRQ(4,JRN,RNST)                !UNLOCK THE FILE FOR SMP
       CALL EXEC(23,SMP,13,RNUM,G0WD1,0,G0W10) !CALL SMP TO KILL
KL3:   RETURN                               !AND EXIT 
! 
! 
LUCK:  IFNOT $LU THEN GO TO NAM             !IF NO LU THEN OK 
       RNUM_@G0WD4+2                        !SET UP TO SEARCH THE LU TABLE
       FOR RLHD_1 TO G0WD2 DO[              \SCAN FOR THE LU
          IF $RNUM = ($LU AND 77K) THEN GO TO NAM;\IF THIS IS IT JUMP 
          RNUM_RNUM+1]                      !ELSE STEP TO NEXT ENTRY
       GO TO BADPM                          !NOT FOUND SEND BAD PRAM MESSAGE
! 
! 
NAM:   FOR RNUM_FREC TO LREC DO[            \SCAN THE SPOOL RECS
          CALL RD(RNUM);                    \TO FIND THE NAME 
          IF G0BUF >= 0 THEN [              \IF AN ACTIVE ENTRY 
             IF $PV=G0WD2 THEN[             \CHECK THE NAME 
                IF $PV2=G0WD3 THEN[         \ 
                   IF $PV3=G0WD4 THEN GO TO FNAM]]]]
       GO TO BADPM                          !IF NOT FOUND THEN BAD PRAM 
! 
!      NAME FOUND SO CHECK IF KS OR RS COMMAND
! 
FNAM:  IF N# -1 THEN GO TO KL1              !KS SO GO CHECK STATUS
! 
       OLU _ G0W15
       RLHD_G0W10                           !SET CURRENT STATUS 
       IF RLHD = "A" THEN GO TO AH          !IF ACTIVE GO HOLD/ACTIVE 
       IF RLHD = "AH"THEN GO TO W           !IF HOLD/ACTIVE GO RELEASE TO WAIT
       IF RLHD = "W" THEN GO TO H           !IF WAITING GO HOLD 
       IF RLHD = "H" THEN GO TO HH          !IF IN HOLD GO CHANGE LU
! 
       GO TO ER4                            !NOT IN A LEGAL STATUS SO EXIT
! 
!      SPOOL IS ACTIVE SO FIRST PUT A HOLD ON IT
! 
AH:    G0W10_"AH"                           !SET STATUS 
       CALL WRIF                            !WRITE TO THE FILE AND UNLOCK 
       CALL EXEC(23,SMP,14,RNUM,G0W15,0,RLHD)!TELL SMP WHAT TO DO 
! 
!      SET UP TO NOW SET THE FILE ACTIVE
! 
       RLHD_"AH"                            !SET CURRENT STATUS 
       CALL RECV                            !RECOVER THE LOCK AND RECORD
! 
!      FILE IS IN ACTIVE HOLD SO SET THE NEW LU AND 
!      PUT IN WAIT STATUS 
! 
W:     G0W10_"W"                            !SET STATUS 
       LUX_0
       IF $LU THEN[IF $LU#G0W15 THEN LUX_$LU]  !SET LU
       CALL WRIF                            !WRITE OUT AND UNLOCK 
       CALL EXEC(23,SMP,15,RNUM,OLU,LUX,RLHD) !TELL SMP 
       GO TO KL3                            !GO EXIT DONE 
! 
! 
!      FILE IS IN A WAIT QUEUE SO PUT IN HOLD THEN CHANGE LU
!      AND PUT BACK IN WAIT QUEUE FOR THE NEW LU
! 
H:     G0W10_"H"                            !SET NEW STATUS 
       CALL WRIF                            !WRITE IT OUT AND UNLOCK
       CALL EXEC(23,SMP,14,RNUM,G0W15,0,RLHD) !TELL SMP 
! 
!      NOW SET UP FOR THE WAIT QUEUE TRANSITION 
! 
       CALL RECV                            !RESET THE RN LOCK AND READ 
       IF $LU THEN G0W15_$LU
       OLU_G0W15                            !SET LU FOR CALL
       GO TO W                              !GO SET TO WAIT 
! 
! 
!      FILE IS IN HOLD SO JUST CHANGE LU AND EXIT 
! 
HH:    IF $LU THEN G0W15_$LU
       CALL WRIF                            !WRITE IT OUT AND UNLOCK
       RETURN                               !NOW RETURN 
! 
       END
! 
!      SUBROUTINE TO WRITE CURRENT RECORD AND UNLOCK THE DISC 
! 
WRIF:  SUBROUTINE DIRECT
       CALL G1WFI(G0BUF,RNUM)?[GO TO EX]    !WRITE THE RECORD 
       CALL POST(G0DCB)                     !MAKE SURE IT GOES TO THE DISC
       CALL RNRQ(4,JRN,RNST)                !UNLOCK THE RN
       RETURN                               !AND RETURN 
       END
! 
!      SUBROUTINE TO LOCK THE RN AND REREAD THE RECORD
! 
RECV:  SUBROUTINE DIRECT
       CALL RNRQ(1,JRN,RNST)                !LOCK THE RN
       CALL RD(RNUM)                        !READ THE RECORD TO THE BUFFER
       RETURN                               !AND RETURN 
       END
! 
! 
! 
RD:    SUBROUTINE (R) DIRECT
       CALL G1RDF(R,ER)?[GO TO EX]
       RETURN 
       END
! 
!     THE RESTART SUBROUTINE JUST CALLS THE KS ROUTINE WITH N=-1. 
! 
G1CRS: SUBROUTINE(P,PN,EW) GLOBAL 
      CALL G1CKS(P,-1,EW) 
      RETURN
      END 
       END
       END$