       SPL,L,O,M,C
!     NAME:   GASP
!     SOURCE: 92067-18028 
!     RELOC:  92067-16028 
!     PGMR:   A.M.G.
!     MOD FOR RTE 4 : C.M.M.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  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(19,80) "92067-16028 REV.1805 780323" 
! 
! 
       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 G0INT BE INTEGER,EXTERNAL
       LET CS43,SP.OK,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. 
       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
       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$ 
                                                                                                                                                                                                                                                          