       SPL,L,O
!     NAME:   G1CIN 
!     SOURCE: 92067-18440 
!     RELOC:  92067-16425 
!     PGMR:   A.M.G.
! 
!  ***************************************************************
!  * (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 G1CIN(8) "92067-16425 REV.2013 800102"
! 
       LET G1CDA,                           \DA COMMAND PROCESSOR 
           G1OMS,                           \OUTPUT MESSAGE ROUTINE 
           G1ZAP,                           \ZAP A BUFFER ROUTINE (16 WORDS)
           G1WFI,                           \WRITE A RECORD TO CURRENT FILE 
           G1RD,                            \READ A RECORD FROM FILE
           G1OPN,                           \INTERNAL OPEN FILE ROUTINE 
           G1CQQ,                           \?? COMMAND PROCESSOR 
           G1ERP,                           \ERROR PRINT ROUTINE
           EXEC,                            \WHERE DID THIS COME FROM 
           XLUEX,                           \EXTENDED LU EXEC CALL
           G1IMS,                           \INPUT RESPONCE ROUTINE 
           POST,                            \FMP POST FILE ROUTINE
           CREAT,                           \FMP CREAT FILE ROUTINE 
           OPEN,                            \FMP OPEN  FILE ROUTINE 
           CLOSE,                           \FMP CLOSE FILE ROUTINE 
           RNRQ,                            \SYSTEM RESOURCE NUMBER ROUTINE 
           ISMVE,                           \MOVE FROM SCB SUB. 
           CNUMD                            \SYSTEM NO. TO DEC. ASCII SUB 
                  BE SUBROUTINE,EXTERNAL
! 
       LET .DFER,                           \THREE WORD MOVE ROUTINE
           ST.LU,                           \SET UP $LUAV ECT.
           G1PCR                            \ROUTINE TO SET $SPCR 
                  BE SUBROUTINE,EXTERNAL,DIRECT 
! 
! 
       LET KCVT,                            \CONVERT NO. TO 2-DIG. ASCII
           ICAPS                            \CURRENT USER CAPABILITY FETCH
                BE FUNCTION,EXTERNAL
! 
       LET CRERR                            \INTERNAL ERROR SUB.
                  BE SUBROUTINE 
       LET GERR,                            \GENERATE GASP 2 ERROR
           ERPST                            \POST ERROR IN SCB
                BE SUBROUTINE,DIRECT
! 
       LET G0END,                           \"GASP END" 
           G0NJB,                           \"MAX NUMBER OF JOBS,..." 
           G0NLO,                           \"NUMBER,LOCATION OF SPOOL ...."
           G0SZF,                           \"SIZE OF SPOOL FILES ...." 
           G0NSP,                           \"NUMBER OF SPOOL FILES ...." 
           G0MXP,                           \"MAXIMUM NUMBER ACTIVE ..."
           G0SLU,                           \"ENTER OUTSPOOL DESTI...." 
           G0PCA,                           \"CAPABILITY LEVEL FOR PRIV..." 
\ 
           G0JBF,                           \"JOBFIL" 
           G0SPF,                           \"SPLCON" 
           G0JDC,                           \JOBFIL DCB 
           G0SDC,                           \SPLCON DCB 
           G0DCB,                           \MASTER DCB 
           G0BUF,                           \INTERNAL BUFFER 16 WORDS 
           G0WD1,                           \WORD 1 OF G0BUF
           G0WD2,                           \WORD 2 OF G0BUF
           G0WD3,                           \WORD 3 OF G0BUF
           G0WD4,                           \WORD 4 OF G0BUF
           G0WD7,                           \WORD 7 OF G0BUF
           G0WD8,                           \WORD 8 OF G0BUF
           G0WD9,                           \WORD 9 OF G0BUF
           G0W10,                           \WORD 10 OF G0BUF 
           G0W11,                           \WORD 11 OF G0BUF 
           G0W15,                           \WORD 15 OF G0BUF 
\ 
           G0PBF,                           \PARSE BUFFER 
           G0P1V,                           \PARAMETER 1 VALUE FROM G0PBF 
           G0P2V,                           \PARAMETER 2 VALUE FROM G0PBF 
\ 
           G0SDN,                           \SPOOL SHUT DOWN FLAG 
           G0JDN,                           \JOB SHUT DOWN FLAG 
           G0TTY,                           \TERMINAL LU + 400B 
           G0NPR,                           \NO PRINT FLAG
           N.SEQ                            \NUMBER OF SPOOL EQTS 
                  BE INTEGER,EXTERNAL 
! 
       LET PBUFX,                           \INTERNAL BUFFER
           BUFX1,                           \WORD 1 OF PBUFX
           BUFX2,                           \WORD 2 OF PBUFX
           BUFX3,                           \WORD 3 OF PBUFX
           BUFX4,                           \WORD 4 OF PBUFX
           BUFX5(4),                        \WORD 5 OF PBUFX
           BUFX9,                           \WORD 9 OF PBUFX
           BUX10(4),                        \WORD 10 OF PBUFX 
           BUX14,                           \WORD 14 OF PBUFX 
           BUX15(17)                        \WORD 15 OF PBUFX 
                     BE INTEGER 
! 
       LET NOTIN(16)  BE INTEGER
       INITIALIZE NOTIN TO -29,"SPOOL SYSTEM NOT INITIALIZED!"
       LET DUPNM(8),MESS(4),DINIT(8) BE INTEGER 
       INITIALIZE DUPNM,MESS TO 11,"DUP FILE NAME XXXXXX. " 
       INITIALIZE DINIT TO 7,"DEINITIALIZE?_" 
! 
       LET NOROM(3),DNO(12),MS,MSS(11) BE INTEGER 
       INITIALIZE NOROM,DNO,MS,MSS TO 27,\ DISC FULL MESSAGE
       "DISC XXXXX FULL OR MISSING, XX SPOOL FILES CREATED. " 
! 
       LET SIZE,SIZE1  BE INTEGER   !DO NOT REARRANGE THESE 
       LET SPOL(2),SPLNO,IERR  BE INTEGER   !TWO LINES
       INITIALIZE SPOL TO "SPOL"
       INITIALIZE SPLNO TO 1
       INITIALIZE SIZE1 TO 16 
! 
       LET E BE CONSTANT(42440K)
       LET EXIT BE CONSTANT(42530K) 
       LET SEC BE CONSTANT(123456K) 
       LET IOPTN BE CONSTANT(3) 
! 
G1CIN: SUBROUTINE GLOBAL
       ASSEMBLE["EXT $SMID";"XLA $SMID";"STA SMID";\GET SESSION ID
                "EXT $DSCS";"XLA $DSCS";"STA DSCS"]!GET SESSION IS FLAG 
INOVR: PVCAP _ 0                            !SET CAP INCASE SESSION IS NOT
       IF DSCS < 0 THEN GO TO INIT          !IF NOT SESSON THEN GO INITIALIZE 
       CAP _ ICAPS()                        !GET USERS CAP. 
       CALL ISMVE($($1717K+32),SMID,USID,1) !GET USER ID WORD 
       IF USID = 7777K THEN GO TO INIT0     !ALLOW ONLY SYSTEM MGR. HERE
       CALL G1OMS(NOTIN)                    !ELSE SEND "SPOOL SYS NOT INTI.." 
       GO TO EXSM                           !AND EXIT 
! 
INIT0: CALL G1IMS(G0PCA)                    !GET CAP FOR PRIV COMMANDS
       IF G0P1V > CAP THEN[                 \IF MORE THAN SYS. MGR. 
          CALL GERR;                        \COMPLAIN ABOUT IT
          GO TO INIT0]                      !AND TRY AGAIN
       PVCAP_G0P1V                          !AND SAVE IT FOR LATER
! 
INIT:  CALL ST.LU 
       AB_0                                 !CLEAR DEALLOCATE FLAG
       CLSFL_0                              !CLEAR CLOSE FLAG FOR JOBFIL
       F _ -2                               !SET FLAG FOR NO SHUT DOWN
INIT2: CALL G1IMS(G0NJB)                     !INITIALIZE THE BATCH
       IFNOT [SAVE1 _ G0P1V] > 0 THEN [      \SYSTEM.  GET # OF JOBS. 
INIT1:    CALL GERR;  GOTO INIT2]     ! 
       SIZE _ 3 
       IF G0P1V > 254 THEN GOTO INIT1 
       IF [SAVE _ G0P1V - 6] <= 0 THEN       \FIGURE OUT THE SIZE OF
          GOTO CRJOB                         !JOBFIL, AND CREATE IT.
       IF (SAVE AND 7K) THEN                 \
          SIZE _ SIZE + 1 
       SIZE _ (SAVE >-3) + SIZE 
CRJOB: SPDIS_G0P2V                          !SET THE DISC FOR JOBFIL
       CALL CREAT(G0DCB,IERR,G0JBF,SIZE,2,SEC,SPDIS)
       IF IERR = -32 THEN[                  \IF NOT A SYSTEM DISC COMPLAIN
          CALL G1CQQ(SIZE);                 \AND TRY
          GO TO INIT2]                      !AGAIN
! 
       CALL CRERR(G0JBF)                    !CHECK FOR ERRORS 
       CALL G1ZAP(PBUFX)
       CALL RNRQ(20K,IRN,SAVE)              !ALLOCATE JOBFIL RN.
       PBUFX _ IRN                          !PUT IT IN JOBFIL.
       CALL G1WFI(PBUFX,0) ? [GOTO EXIN]
       PBUFX _ 0                            !INITIALIZE FIRST 2 
       REPEAT 15 TIMES DO [                 \JOBFIL SECTORS.
          CALL G1WFI(PBUFX,0) ?             \ 
             [GOTO EXIN]] 
NSP:   CALL G1IMS(G0NSP)                    !GET # OF SPOOL FILES.
       IF [NSPL,BUFX2 _ G0P1V] > 80 THEN [   \MAKE SURE IT IS NOT 
NSP1:     CALL GERR;  GOTO NSP]      !MORE THAN 80. 
       IFNOT NSPL > 4 THEN GOTO NSP1
SZS:   CALL G1IMS(G0SZF)                    !GET SIZE OF SPOOL FILES. 
       IFNOT G0PBF = 1 THEN GOTO SZS1       !MAKE SURE NUMERIC. 
       IFNOT [SSPOL,BUFX3 _ G0P1V] > 0 THEN [\MAKE SURE IT IS NON-ZERO. 
SZS1:     CALL GERR;  GOTO SZS] 
       BUFX1 _ [SIZE _ SAVE1 + 18]
       PBUFX _ IRN                          !PUT IN RN NUMBER.
       RNRQ(20K,WRN,SAVE)                   !ALLOCATE HOLD BEM RN.
       BUX14 _ WRN
       BUFX9 _ PVCAP                        !SET CAP LEVEL IN RECORD
WRT1:  CALL G1WFI(PBUFX,0) ? [GOTO EXIN]    !WRITE JOBFIL RECORD 17.
NOL:   CALL G1ZAP(PBUFX)
       ADDR _ @PBUFX-1;  FFILE _ 1
       REPEAT 8 TIMES DO [                  \GET # OF SPOOL FILES 
          CALL G1IMS(G0NLO);                \AT EACH LOCATION AND 
          IF G0P1V = E THEN GOTO ADDUP;     \MAKE UP JOBFIL 
          IF G0P1V ="/E" THEN GO TO ADDUP;  \ 
          $[ADDR _ ADDR+1] _ (G0P1V <-8)    \RECORD 18. 
             XOR FFILE;                     \ 
          FFILE _ FFILE + G0P1V;            \ 
          $[ADDR _ ADDR+1] _ G0P2V] 
ADDUP: ADDR _ @PBUFX-2  ;SAVE1 _ 0            !CHECK IF THE # OF FILES
       REPEAT 8 TIMES DO [                  \AT EACH LOCATION AGREES
          SAVE1 _ (($[ADDR _ ADDR+2] -<8)   \WITH THE TOTAL # OF
             AND 377K) + SAVE1]             !FILES. 
       IFNOT SAVE1 = NSPL THEN [            \IF DISAGREE, DO OVER.
          CALL GERR;  GOTO NOL] 
WRT2:  CALL G1WFI(PBUFX,0) ? [GOTO EXIN]    !WRITE JOBFIL RECORD 18.
       CALL G1ZAP(G0BUF)
       G0BUF _ -1 
       FOR SAVE _ 19 TO SIZE DO [           \INITIALIZE REST OF 
          CALL G1WFI(G0BUF,0) ?             \JOBFIL.
             [GOTO EXIN]] 
! 
! 
MNS:   CALL G1IMS(G0MXP)                    !GET SPLCON INFORMATION.
       IFNOT G0PBF = 1 THEN GOTO MNS1 
       IFNOT [BUFX1 _ G0P1V + N.SEQ] >= NSPL\GET MAXIMUM #
          THEN [                            \ 
MNS1:     CALL GERR;  GOTO MNS]      !OF SPOOL FILES. 
       IFNOT [BUFX4 _ G0P1V] > 0            \ 
          THEN GOTO MNS1
       BUFX2 _ 0;  ADDR _ @BUFX5
       REPEAT 11 TIMES DO THRU LUSET
LUN:      CALL G1IMS(G0SLU)                 !GET LOGICAL UNIT 
          IF G0P1V = E THEN GOTO ALLDN      !NUMBERS FOR
          IF G0P1V ="/E" THEN GOTO ALLDN      !NUMBERS FOR
          IF [G0P1V_G0P1V AND 377K] < 3 THEN GO TO LUNER !LU 1,2 ILL
          CALL XLUEX(100015K,G0P1V+100000K,EQT5)     !GET DRIVER TYPE 
          GO TO LUNER                       !BAD LU ERROR 
          IF (EQT5 AND 36000K)=14000K THEN[ \DISC ILLGAL
LUNER:       GERR;GO TO LUN]                !REPORT ERROR AND TRY 
          IFNOT [G0P2V_G0P2V AND 17K] THEN G0P2V_4 !DEFAULT DEPTH 
          $[ADDR _ ADDR+1] _ G0P1V+G0P2V*400K !LEVEL IN HIGH HALF 
LUSET:    BUFX2 _ BUFX2 + 1 
ALLDN: IF (BUFX1 AND 7K) THEN SIZE _ 1,     \ 
          ELSE SIZE _ 0 
       SIZE _ (BUFX1 >-3) + SIZE + BUFX2 + 1
CCR:   CREAT(G0DCB,IERR,G0SPF,SIZE,2,SEC,SPDIS)!CREATE SPLCON.
       CALL CRERR(G0SPF)
       F _ -1                               !SET FLAG FOR SHUT DOWN O.K.
       BUFX3 _ ((BUFX2+1) <-3) + 1
       RNRQ(20K,PBUFX,SAVE)                 !ALLOCATE SPLCON RN.
       ADDR _ @BUFX5
       CALL G1ZAP(G0BUF)
       G1WFI(G0BUF,2) ? [GOTO EXIN]         !WRITE 2ND SPLCON REC.
       G0WD1 _ WRN
       G0WD2 _ PVCAP                        !SET PRIV CAP FOR SPLCON REC 3
       REPEAT 6 TIMES DO [G1WFI(G0BUF,0)    \ 
          ? [GOTO EXIN];                    \ 
             G0WD2,G0WD1 _ 0] 
       REPEAT BUFX2 TIMES DO [              \SET UP LOGICAL UNIT
          G0BUF _ $[ADDR _ ADDR+1];         \SECTORS IN SPLCON. 
          $ADDR_$ADDR AND 377K;             \ISOLATE THE LU 
          G1WFI(G0BUF,0) ? [GOTO EXIN];     \ 
          G0BUF _ 0;                        \ 
          REPEAT 7 TIMES DO [               \ 
             CALL G1WFI(G0BUF,0) ?          \ 
                [GOTO EXIN]]] 
       CALL G1ZAP(G0BUF);  G0BUF _ -1 
       REPEAT BUFX1 TIMES DO [              \ 
          CALL G1WFI(G0BUF,0) ? [GOTO EXIN]]
! 
       CALL G1WFI(PBUFX,1)?[GOTO EXIN]      !WRITE 1ST SPLCON REC.
! 
       AB_1                                 !SET DEALLOCATE FLAG
       CALL OPEN(G0JDC,IERR,G0JBF,3,SEC,SPDIS) !REOPEN JOB FILE 
       CALL CRERR(G0JBF)
       CALL G1OPN(G0DCB,IERR,G0JBF)            !SET UP MASTER DCB FOR JOBFIL
       CALL CRERR(G0JBF)
       AB _ 0                               !CLEAR DEALLOCATE FLAG
       CALL G1PCR (G0DCB)                   !SET UP $SPCR TO JOBFIL CRN 
       CALL G1RD(PBUFX,18)                  !GET BACK RECORD 18 
       ADDR _ @PBUFX-1
       REPEAT 8 TIMES DO THRU LAST          !CREATE ALL THE SPOOL 
          FFILE _ $[ADDR _ ADDR+1] AND 377K !FILES. 
          SAVE1 _ (($ADDR -<8) AND 377K)+FFILE-1
          ICR _ $[ADDR _ ADDR+1]
          FOR FFILE _ FFILE TO SAVE1 DO [   \ 
          IF [SPLNO _ KCVT(FFILE)]          \ 
             < 30000K THEN SPLNO _          \ 
              SPLNO OR 30000K           ;   \ 
             CALL CREAT(G0BUF,IERR,SPOL,    \ 
                SSPOL,3,SEC,ICR);           \ 
             IF IERR = -32 THEN GO TO TRUN;  \
             IF IERR= -33 THEN GO TO TRUN;   \
                    CALL CRERR(SPOL)] 
LAST: 
! 
       CALL CLOSE(G0BUF)
EXINT: CALL CLOSE(G0DCB)                    !CLOSE THE FILE AND 
       RETURN 
! 
! 
TRUN:  CALL G1RD(G0BUF,17)                  !SET UP JOB FILE FOR
       G0WD2_FFILE -1                       !THE ACTUAL NUMBER OF FILES 
       CALL G1WFI(G0BUF,17)                 !WRITE IT OUT 
       CLSFL _ 1                            !SET FLAG TO CLOSE JOBFIL 
       MS_KCVT(FFILE-1)                     !SET UP THE MESSAGE 
       CALL CNUMD(ICR,DNO)
       CALL G1OMS(NOROM)                    !SEND NO ROOM MESSAGE 
       GO TO AGAIN
       END
! 
! 
CRERR: SUBROUTINE(FIN)
       IF IERR > 0 THEN RETURN              !IF NO ERRORS RETURN
       IF IERR = -2 THEN [CALL .DFER(MESS,FIN); \IF DUP NAME
          CALL G1OMS(DUPNM);                \SEND MESSAGE AND GET ANS.
AGAIN:    CALL G1IMS(DINIT);                \SEND MESSAGE AND GET ANS.
          IF G0P1V = "YE" THEN[             \IF DEINITIALIZING THEN 
             CALL OPEN(G0SDC,IERR,G0SPF,3,SEC,SPDIS);\OPEN SPLCON FILE
             CALL G1CDA(F);                 \CALL DE-ALLOCATE ROUTINE 
             GO TO INIT]]                   !GO TO RE-INITIALIZE
       IF CLSFL THEN CALL CLOSE (G0DCB)     !CLOSE JOBFIL IF CLOSE FLAG SET 
EXIN:  CALL G1CQQ(SIZE)                     !SEND ERROR MESSAGE 
       CALL ERPST                           !SET IT UP FOR HELP 
EXSM:  IF AB THEN[                          \IF ABORT FLAG DEALLOCATE 
          CALL G1CDA(-1);                   \AND THEN 
          GO TO INOVR]                      !TRY AGAIN
       CALL G1OMS(G0END)                    !SEND END MESSAGE 
       CALL EXEC(6)                         !TERMINATE
       END
! 
!     ERROR REPORT SUBROUTINE 
! 
GERR:  SUBROUTINE DIRECT
       IERR_2                               !SET THE ERROR CODE 
       CALL G1CQQ(SIZE)                     !PRINT THE MESSAGE
       CALL ERPST                           !SET UP FOR HELP
       RETURN 
       END
! 
!     SET UP TO POST ERROR IN SCB 
! 
ERPST: SUBROUTINE DIRECT
       G0NPR _ "NP" 
       CALL G1ERP(IERR) 
       G0NPR _ 0
       RETURN 
       END
! 
       END
      END$
                                                                                                                                                                      