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$