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$