       SPL,L,O
!     NAME:   GASP
!     SOURCE: 92067-18426 
!     RELOC:  92067-16425 
!     PGMR:   A.M.G.
!     MOD FOR RTE 4 : C.M.M.
! 
!  ***************************************************************
!  * (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 GASP(3,80) "92067-16425 REV.1903 790628"
! 
! 
       LET G1ERP,                           \ERROR REPORT SUB.
           G1OMS,                           \OUTPUT MESSAGE SUB.
           G1ZAP,                           \ZERO A 16 WORD BUFFER
           G1IMS,                           \INPUT AND PARSE COMMAND/ANS
           G1RD,                            \READ RECORD SUB. 
           G1OPN,                           \RESTORE A DCB SUB. 
           G1WFI,                           \WRITE WRECORD ON CURRENT DCB 
           G1CAP,                           \GET USER & PRIV CAP, USER ACCT#
           G1CHK                            \CHECK USER CAPABILITY
                 BE SUBROUTINE
! 
       LET ERTS                             \ERROR TEST SUB.
                 BE SUBROUTINE,DIRECT 
       LET KCVT,                            \CONVERT 2 DIGIT TO ASCII 
           LOGLU,                           \GET USER TTY FUNCTION
           ICAPS,                           \GET USER CAPABILITY
           LUTRU                            \GET TRUE SYSTEM LU 
                BE FUNCTION,EXTERNAL
       LET .CACT                            \GET USER ACCOUNT # 
               BE FUNCTION,EXTERNAL,DIRECT
       LET POST,                            \FILE POST SUB. 
           CREAT,                           \CREAT FILE SUB.
           OPEN,                            \OPEN FILE SUB. 
           CLOSE,                           \CLOSE FILE SUB.
           POSNT,                           \POSITION FILE SUB. 
           READF,                           \FILE READ ROUTINE
           WRITF,                           \FILE WRITE ROUTINE 
           PARSE,                           \SYSTEM PARSE ROUTINE 
           RNRQ,                            \RESOURCE MANAGEMENT ROUTINE. 
           REIO,                            \SYSTEM I-O ROUTINE.
           PTERR,                           \SESSION POST ERROR ROUTINE 
           RMPAR,                           \GET PARAMETERS 
           EXEC,                            \GUESS WHO. 
\ 
\      FOLLOWING ARE LOCAL TO GASP PROGRAM
\ 
           G1ROT,                           \COMMAND ROUTER (DISPATCHER)
           G1CEX                            \EXIT COMMAND PROCESSOR 
                  BE SUBROUTINE,EXTERNAL
       LET ST.LU,                           \ROUTINE TO SET UP THE LUAV TBL.
           G1PCR                            \TO POST SPOOL CR TO $SPCR
                   BE SUBROUTINE,DIRECT,EXTERNAL
       LET G0INT,                           \" GASP: IRRECOVERABLE INIT..." 
           G0END,                           \"END GASP" 
           OVRD.                            \ 
                      BE INTEGER,EXTERNAL 
! 
       ASSEMBLE ["EXT $SPOK"] 
! 
       LET G0NRD,G0CHR,G0CAP,G0ACT          \STNG LNGTH FLG,#CHARS,CAP,ACCT#
                  BE INTEGER,GLOBAL 
! 
       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,SP.OK 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(2),GLOBAL 
       LET G0WD6,G0WD7,G0WD8,G0WD9,G0W10,G0W11      \ 
          BE INTEGER,GLOBAL 
       LET G0W12 BE INTEGER(2)
       LET G0W14 BE INTEGER,GLOBAL
       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 G0PBX,G0PX1(7) BE INTEGER        !RU,GASP GO HERE
       LET G0PBF BE INTEGER,GLOBAL
       LET G0P1V,G0NPF BE INTEGER,GLOBAL    !COMMAND AND NO PRINT FLAG
       LET PARS1 BE INTEGER(2)
       LET G0P2V BE INTEGER,GLOBAL
       LET G0P14,G0P15,PARS2(16),PARMS,PARS3(7) BE INTEGER
       LET G0NOP BE INTEGER,GLOBAL
       LET G0SDN,G0JDN BE INTEGER,GLOBAL
       LET G0TTY,G0RDS,G0ERH,G0NPR BE INTEGER,GLOBAL
! 
       INITIALIZE PRMPT TO 1,57137K 
       INITIALIZE G0RDS TO 0
       INITIALIZE G0NPF 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
       CALL RMPAR(G0BUF)                    !GET THE PARAMETERS 
       G0CAP _ 0
       IF G0BUF = -63 THEN G0CAP _ 63       !IF CAP PASSED BY ACCTS SET IT
       IF SAVE1 > 20000K THEN SAVE1_0       !IF ASCII THEN NO LU GIVEN
       IFNOT [G0TTY _ (SAVE1 AND 77K)] THEN G0TTY _ LOGLU(G0TTY)
       G0TTY _ G0TTY + CNWD                 !SAVEG0TTY. 
       CALL EXEC(14,1,G0BUF,-32)            !GET THE RUN STRING IF ANY
       G0NRD _ .B.                          !GET THE CHAR COUNT 
       OVRD._OVRD. OR 20000K                !SET TO SEARCH ONLY SYS. DISCS
       ASSEMBLE ["EXT $SPCR";"XLA $SPCR";"STA SPCR"]!GET SPOOL CR 
       IF [X_SPCR] THEN GOTO FCHEK
       CALL ST.LU                           !SET UP $LUAV AND CS43. 
FCHEK: CALL OPEN(JODCB,IERR,G0JBF,IOPTN,SEC,SPCR)!TRY TO OPEN JOBFIL. 
       CALL ERTS                            !TEST FOR ERRORS
       IFNOT X THEN CALL G1PCR(JODCB)       !SET UP $SPCR IF FIRST TIME 
       ASSEMBLE ["XLA $SPCR";"STA SPCR"]    !RELOAD SPOOL CR IN CASE JUST SET 
       CALL G1ZAP(SPDCB)
       CALL OPEN(SPDCB,IERR,G0SPF,IOPTN,SEC,SPCR)!NOW TRY SPLCON
       CALL ERTS                            !TEST FOR ERRORS
       CALL G1OPN(G0DCB,IERR,G0JBF)         !MOVE THE OPEN DATA 
       CALL G1RD(G0PBX,17)                  !READ RECORD 17 
       IF X THEN GOTO RSTRT 
       CALL G1RD(PBUFX,1)                   !REALLOCATE RN S
       RNRQ(20K,PBUFX,SAVE)                 !FOR SPLCON/JOBFIL
       G0PBX _ PBUFX                        !TIME THROUGH AFTER 
       RNRQ(20K,G0P14,SAVE)                 !ALLOCATE HOLD BEM RN.
       CALL G1WFI(PBUFX,1)                  !BOOT-UP. 
       CALL G1WFI(G0PBX,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_G0P15              !SET THE DOPN FLAGS 
       IF X THEN GO TO GETCD
       BUFX1 _ G0P14
       CALL G1WFI(PBUFX,3)
       G0BUF _ "DS"                         !CALL DS TO CLEANUP ON BOOT-UP
       G0WD1 _ "AL" 
       G0NRD,G0CHR _ 4                      !# OF CHARACTERS IN COMMAND 
       G0NPR _ "NP"                         !SET NO PRINT FLAG
       CALL PARSE(G0BUF,G0NRD,G0PBF)        !PARSE THE RUN STRING 
       IERR,G0RDS _ 0 
       CALL G1ROT(G0PBF,G0NOP,IERR)         !CALL DS ROUTINE
       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 
       G0NPR _ G0NPF                         !SET UP PRINT FLAG 
       CALL G1ROT(G0PBF,G0NOP,IERR)          !GO TO PROPER ROUTINE. 
ERCHK: IF IERR THEN CALL G1ERP(IERR)        !REPORT ANY ERRORS
       IF G0NRD < 0  THEN CALL G1CEX        !IF RUN STRNG THEN EXIT 
       G0NPF _ 0                            !CLEAR NO PRINT FLAG
       GO TO GETCD                           !GO GET THE NEXT COMAND
! 
! 
INIT:  IF SAVE1 < 0 THEN GO TO EX            !IF NO INPUT UNIT, EXIT. 
       ASSEMBLE ["XLA $SPOK"; "STA SP.OK"]
       IF SP.OK > 0 THEN[\                   !CHECK WHAT ST.LU RETURNED 
                CALL G1OMS(G0INT);GO TO INIT1] !IF 0 OR NEG SEND ERROR
       G0P1V_60K                            !SET CODE TO GET TO INIT
       CALL G1ROT(G0PBF,G0NOP,IERR)         !CALL INNITILIZE
INIT1: 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
       IF G0NRD > 0  THEN [                 \IF WE HAVE A RUN STRING
         IF @MESS = @PRMPT THEN[            \AND WE NEED A COMMAND
          CALL PARSE(G0BUF,G0NRD,G0PBX);    \THEN PARSE IT
          G0NOP _ PARMS - 2;                \PARAMETERS IN RUN STRING 
          IF G0PBF > 1 THEN[                \IF IT LOOKS REASONABLE 
              G0CHR,G0NRD_ -G0NRD; \FLAG IT AS THE CURRENT
              RETURN]]]                     !COMMAND AND GO DO IT 
       IF G0NRD > 0 THEN G0NRD_0            !CLEAR THE FLAG WORD IF NOT USING 
       SAVE2 _ @MESS + 1                    !POINT TO MESSAGE 
       CALL EXEC (2,G0TTY,$SAVE2,MESS)      !SEND MESSAGE TO CONSOLE
       CALL REIO(1,G0TTY,G0BUF,-32) 
       CHARS _ $1 
       CALL PARSE(G0BUF,CHARS,G0PBF)
       G0CHR _ CHARS
       RETURN 
       END
! 
!  WRITE OUT A MESSAGE
! 
G1OMS: SUBROUTINE(STRNG) GLOBAL 
       LET STRNG BE INTEGER 
       IF G0NPR = "NP" THEN RETURN
       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 
       G0P2V_0
      IFNOT IERR+6 THEN GO TO INIT
       IF IERR= -32 THEN [G0P2V_IERR;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 
       ERR2 _ @ERRS + 1                     !POINT TO ACTUAL MESSAGE
       CALL PTERR($ERR2,IDUM)               !POST THE ERROR TO THE SCB
       SIGN _ "  "                          !BLANK THE SIGN AGAIN 
       G0ERH _ BOMNO                         !KEEP THE HISTORY
       RETURN                               !EXIT 
       END
! 
! 
G1CAP: SUBROUTINE(JERR) GLOBAL,FEXIT
       LET JERR BE INTEGER
       CALL G1OPN(G0DCB,JERR,G0SPF)         !OPEN SPLCON FILE 
       IF JERR THEN FRETURN 
       CALL G1RD(G0BUF,3)                   !READ THIRD REC OF SPLCON 
       PVCAP _ G0WD2                        !PRIVILEGED CAPABILITY
       CAP _ ICAPS                          !USER CAPABILITY
       G0ACT _ .CACT                        !USER ACCT# 
       IF G0ACT <= 0 THEN [G0ACT _ 0;       \IF DETACHED OR NO SESSION
          CAP _ G0CAP]                      !ACCT#=0, SET CAP FOR ACCTS PROG
       RETURN 
       END
! 
! 
G1CHK: SUBROUTINE(KERR) GLOBAL,FEXIT
       LET KERR BE INTEGER
       X _ LOGLU(KERR)                      !GET THE LOGON LU OF USER 
       KERR _ 0 
       IF G0ACT THEN X _ LUTRU(X)           !IF UNDER SESSION, GET TRUE LU
       IF X = 1 THEN RETURN                 !IF SYSTEM CONSOLE THEN OK
       IF CAP < PVCAP THEN [KERR _ 46;      \NOT ENOUGH CAPABILITY
          FRETURN]                          !ERROR RETURN 
       RETURN 
       END
! 
! 
       END GASP 
       END$ 
                                