SPL,L,O ! NAME: LU.. ! SOURCE: 92067-18246 ! RELOC: 92067-16185 ! PGMR: A.M.G. ! ! *************************************************************** ! * (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 LU..(8) "92067-16185 REV.1903 790514" ! ! LET .LUAV BE FUNCTION,DIRECT,EXTERNAL ! LET KCVT, \TWO-DIGIT INTEGER TO ASCII RANGE, \FINDSCR # OF SPOOL POOL FILE SELUR, \FORMAT SESSION LU MESSAGE FG.LU, \ROUTINE TO FUDGE SST CAPCK \CAPABILITY CHECK ROUTINE BE FUNCTION,EXTERNAL ! LET EXEC, \SYSTEM EXEC RNRQ, \RN # CONTROL AVAIL, \FINDSAVAILABLE SPOOL FILE. SPOPN, \SPOOLOPEN SUBROUTINE LULU., \SET UP $LUSW OPEN, \FMP OPEN FILE READF, \FMP READ RECORD WRITF, \FMP WRITE RECORD POST, \POST FILE LUTRU, \ROUTINE TO GET TRUE LU XLUEX \LONG LU EXEC CALL BE SUBROUTINE,EXTERNAL ! LET .DFER, \MOVE THREE WORDS SUB JER. \CHECK FOR ERRORS AND BREAK BE SUBROUTINE,DIRECT,EXTERNAL ! LET JRN., \JOBFIL RN # J.REC, \JOBFIL RECD. # OF ACTIVE JOB ACTV., \ACTIVE JOB FLAG G0.., \GLOBALS ENTRY POINT BUF., \FILE I/O BUFFERS CAM.O, \LOG DEVICE LU I.BUF, \DCB AREA CAD., \COMMAND ADDRESS NO.RD, \NO-READ FLAG N.OPL, \SUB-PARAMETER ARRAY OVRD., \CAPABILITY OVERRIDE FLAG S.CAP \SESSION CAPABILITY FLAG BE INTEGER,EXTERNAL ! LET RD,WR BE SUBROUTINE,DIRECT LET IFDSC BE FUNCTION,DIRECT ! LET JOBFL(3) \ASCIISTRING "JOBFIL" BE INTEGER ! LET SPOL. BE REAL ! INITIALIZE JOBFL,SPOL. TO "JOBFIL","SPOL" LET IOPTN BE CONSTANT(3) LET LUMAX BE CONSTANT(1653K) LET NMASK BE CONSTANT(10000K) LET SEC BE CONSTANT(123456K) ! LET SMP BE INTEGER(3) LET DISP,ATTAB BE INTEGER(11) ! INITIALIZE DISP TO 2K,400K,600K,402K,\ \ NO WR BU WN 0K,1K,20K,0,200K,0K,0K ! BU PU ST SA RE SH BLANK INITIALIZE ATTAB TO "NOWRBOWNBUPUSTSARESH " INITIALIZE SMP TO "SMP " ! ! LU..: SUBROUTINE(N,PLIST,ERR) GLOBAL LET N,PLIST,ERR BE INTEGER ! ! THE FOLLOWING STATEMENT GETS AROUND COMPILER BUG. ! $(@DISP+4) _ 100000K ! PRIOR _ [PAR4 _ [LU2 _ [ATT _ [PAR3 \SET UP POINTERS _ [NAMR _ [PAR2 _ [LU1 _ @PLIST \TO PARAMETER + 1] + 3] + 1] + 3] + 1] + 4] \STRING. + 3] + 1 PROG_[PAR5_PRIOR+3]+1 !ADDRESSES OF PROG PRAM. PTS15_[ \ PTS12_[PTS11_[PTS10_[PTS9_[PTS8_[PTS7_[PTS6_[PTS5_[ \SET ADDS PTS4_[PTS3_[PTS2_[PTS1_@BUF.+1]+1]+1]+1]+1]+1]+1]+ \ 1]+1]+1]+1]+1]+3 S0 _ @G0.. - 8 IFNOT PLIST THEN [ \IF NO FIRST PRAM THEN WE FOR J _ 1 TO 255 DO[ \PRINT THE WHOLE LIST CALL LUTRU(J,SYSLU); \TRANSLATE THE LU IF SYSLU >= 0 THEN[ \IF THERE IS ONE THEN LU1 _ SELUR(J,BUF.); \FORMAT THE MESSAGE IF $PTS4 # "IN" THEN \IF IT LOOKS OK CALL EXEC(2,CAM.O,BUF.,LU1)]; \REPORT IT CALL JER.]; \CHECK FOR BREAK RETURN] !DONE WITH REPORT ! IF ($LU1 <= 0 OR $LU1 >255) THEN [ \IF LU1 OUT OF RANGE, ILLAC: ERR _ -20; RETURN] !THEN RETURN ERROR. IF N = 1 THEN[ \IF ONLY ONE PARAMETER CALL EXEC(2,CAM.O,BUF.,SELUR($LU1,BUF.));\FORMAT THE REPORT RETURN] !ALL DONE WITH ONE PRAM. ! IFNOT ACTV. OR S.CAP THEN[ \IF NOT IN SESSION OR JOB QUIT ERR56: ERR _ 56; RETURN] !WITH ERROR (BAD PRAM) ! IF $LU1 = 1 THEN GO TO ER42 !IF LU IS ONE THEN ERROR ! IF J.REC THEN [ \MAKE SURE USER DOES NOT IF $LU1 = 5 THEN GOTO ER42] !CLOBBER THE INSPOOL. ! L2,L3_0 !SET UP THE CAPABILITY FLAGS IF S.CAP THEN[ \IF IN SESSION CHECK THE LEVELS IF (OVRD. AND 40000K) THEN \IF OVERRIDING CAPABILIY GO TO CAPOK; \DON'T WORRY ABOUT IT IF CAPCK("L2",-2) > 0 THEN \SET UP LU LEVEL 2 L2_.B.; \AND IF CAPCK("L3",-2) > 0 THEN \LEVEL 3 L3_.B.] CAPOK: IF L2 THEN[ \IF NOT CAPABLE OF L2 THEN ERROR ILCAP: ERR_46;RETURN] !SO FLUSH HIM OUT ! IFNOT S.CAP THEN[ \IF NOT USEING SESSION SST IF .LUAV($LU1) THEN GO TO ILLAC] !PREVENT USER FROM ! ! DO MOST ERROR CHECKING HERE BEFORE WE FOUL THE TABLE ! IF $LU1 > 63 THEN[ \IF A LARGE LU THEN ERR52: ERR _ 52; RETURN] ! THEN IT'S A NO-NO! ! IF $NAMR # "- " THEN[ \IF NOT CLEARING AN LU THEN IF $PAR2 = 1 THEN[ \IF SECOND LU IS GIVEN IF $NAMR < 0 THEN GO TO ERR52; \IF NEGATIVE, ERROR IF $NAMR > $LUMAX THEN GO TO ERR52;\IF TOO BIG THEN A NO-NO! IF $LU1 # $NAMR THEN[ \AND IT IS DIFFERENT IF IFDSC($LU1) THEN GO TO ER42; \IT MUST NOT BE A DISC IF IFDSC($NAMR+100000K) THEN GO TO ERR52]],\MUST NOT BE DISC ELSE[ \IF SECOND PRAM IS A FILE THEN IFNOT J.REC OR S.CAP THEN GO TO ERR56]] !THEN MUST BE JOB OR SESS. ! ! CLEAR ALL SPOOLS CONNECTED TO THIS LU ! SW_ -1 !SW WILL BE 0 IF THERE WERE NONE CLSPL: CALL LUTRU($LU1,SYSLU) !GET CURRENT MAPPING SW _ SW+1 !STEP THE LOOP COUNT CALL EXEC(100027K,SMP,4,$LU1) !IF SPOOL LU THEN CLOSE IT. GO TO NOSMP !ERROR RETURN FROM SMP CALL NOSMP: CALL LUTRU($LU1,LUSYS) !GET THE MAPPING NOW IF LUSYS # SYSLU THEN GO TO CLSPL !IF SOME EFFECT THEN TRY AGAIN ! LULU.($LU1,"- ") !CLEAR TABLE ENTRY. GO TO SETSW !INDICATE NO ROOM. ! SETSW: IF $NAMR = "- " THEN[ \IF A CLEAR REQUEST IF SW THEN RETURN, \IF SMP ALREADY MADE A CHANGE ELSE GO TO CLRU] !RETURN ELSE GO CLEAR ! IF $PAR2 # 1 THEN GO TO SPLST !IF SPOOL SET UP GO DO IT ! CLRU: IF S.CAP THEN \IF SESSION THEN ERR _FG.LU($LU1,"- ",L3,BUF.) !CLEAR THE LU IF POSSIBLE IF $NAMR = "- " THEN RETURN !IF CLEAR WAS REQUESTED DONE ! ERR_0 !CLEAR ERROR FLAG INCASE SET CALL LUTRU($LU1,SYSLU) !GET CURRENT THE MAPPING IF ANY ! ! SWITCH: IF $NAMR =SYSLU THEN RETURN !IF ALREADY SET JUST RETURN IF S.CAP THEN[ \IF IN SESSION ERR_FG.LU($LU1,$NAMR,L3,BUF.)],\CALL THE SST FIXER ELSE[ \OTHER WISE USE THE BATCH ROUTINES LULU.($LU1,$NAMR); \SET LU SWITCH, GO TO SUSP] !BRANCH ON ERROR RETURN !RETURN IF OK. ! ER42: ERR_42;RETURN !CAN'T SWITCH ERROR ! SPLST: PTR _ @BUF.-1 REPEAT 16 TIMES DO [ \CLEAR THE SETUP $[PTR _ PTR + 1] _ 0] !BUFFER. $(PTS7) _ 11400K !PRESET TYPE TO MT. EXEC(100015K,$LU1,$(PTS7)) !GET LU1 DRIVER TYPE. GO TO NEXT NEXT: $PTS7 _ ($PTS7 AND 37400K) -< 8 !PUT TYPE INTO THE IF [LEN_ $(PTS7) AND 77K] >= 30K \FOR DISK LU'S, AND (LEN <= 34K) THEN GOTO ILLAC !WHICH ARE ILLEGAL. ASSEMBLE["EXT $SPCR";"LDA $SPCR";"STA SPCR"]!GET SPOOL CR I_0 !SET DEFAULT USER OPTION WORD IFNOT J.REC THEN[ \CHECK IF FILE NEEDS TO BE OPENED IF $PAR2 THEN GO TO REGLR] !NOT UNLESS JOB OR SPOOLPOOL OVRD. _ [FNUM _ OVRD.] OR 100000K !SAVE AND SET OVERRIDE OPEN(I.BUF,ERR,JOBFL,IOPTN,SEC,SPCR) !OPEN UP JOBFIL. OVRD. _ FNUM !RESET OVERRIDE FLAG IF ERR < 0 THEN GOTO RELRN !REPORT DISK ERROR. MASK,FNUM _ 0 IFNOT $PAR2 THEN[ \LOCK UP THE FILE ONLY IF POOL IFNOT J.REC THEN[ \ IF NOT JOB THEN CALL RD(1,$PTS15); \ MUST GET THE JOBFIL RN JRN. _ $PTS15]; \ FROM REC. 1 WORD 1. POST(I.BUF); \ RNRQ(1,JRN.,JSTAT)] !OK TO USE JOBFIL? IF J.REC THEN[ \ONLY READ JOB REC IF IN JOB CALL RD(J.REC,$[PTR1_PTR+17])] !IF NAMR IS DEFAULT, IF $PAR2 THEN GO TO REGLR !IF NO POOL FILE NEEDED SKIP CALL RD(18 ,$[PTR32_PTR+33]) !(GET SPOOL LOCATION REC. CALL RD(17 ,$[PTR _PTR+1]) ! AVAIL($(PTR+4),MASK,FNUM) !FIND AN AVAIL. ONE. IFNOT FNUM THEN [ \CHECK FOR ERRORS. NOMOR: ERR _ -23; \REPORT ERROR -  GOTO RELRN] !NO SPOOL POOLS. IF FNUM > $(PTR+2) THEN GOTO NOMOR !CONTINUE CHECKING. $(PTS4) _ KCVT(FNUM) OR NMASK !CONCOCT FILE NAME. $(PTS5) _ SEC !SECURITY CODE. $(PTS6) _ RANGE(FNUM,$PTR32) !CARTRIDGE ID. $[REAL](PTS2) _ SPOL. !SPOOL FILE NAME. $PTS8 _ 412K !SET DEFAULT FLAGS. WRSPHO IFNOT $LU2 THEN $PTS8_12K !DEFAULT TO BOSPHO (ST LATER) IF $PAR5 = 3 THEN GO TO BADPM !PROG NOT ALLOWED IF POOL GOTO SAME REGLR: CALL .DFER($(PTS2),$NAMR) !SPOOL FILE NAME. $(PTS5) _ $(@N.OPL+5) !SECURITY CODE. $(PTS6) _ $(@N.OPL+6) !CARTRIDGE ID. $PTS8 _[IF $LU2 THEN 3K ,ELSE 203K]!SET DEFAULT FLAGS. WR-REHOSA SAME: IFNOT $LU2 THEN I_20K !IF NO OUTSPOOL LU SET TO ST FILE ! ! SPOOL SET UP DEFAULTS ARE: WR = WRITE ONLY ! RE = READ ONLY ! !SPOOL POOL FILE ! USER FILE ! BO = BOTH READ AND WRITE ! !-------------------!--------------! ST = STANDARD FILE ! OUT LU ! WR HO SH SP ! WR HO SH SA ! SH = OUTSPOOL HEADERS ! !-------------------!--------------! SP = SPOOL POOL FILE ! NO OUT LU! BO HO ST SP ! RE HO ST SA ! HO = HOLD TILL CLOSE ! !-------------------!--------------! SA = SAVE (DON'T PURGE) ! IF J.REC THEN $PTS11_J.REC+100000K !JOB #. $PTS1_$LU1 !SET LU DEFAULT FOR SESSION IFNOT $PAR3 THEN GOTO OPSPL REPEAT 3 TIMES DO [ \GET DISPOSITION PTR2 _ @ATTAB - 1; \FLAGS SET UP. PTR3 _ @DISP - 1; \ FOR J _ 1 TO 11 DO [ \PICK UP A MAXIMUM IF $ATT = "SH" THEN I_I AND 177757K;\ SH NEEDS SPECIAL ACTION IF $ATT = $[PTR2_PTR2+1] THEN \OF THREE FILE GOTO HAVIT]; \ATTRIBUTES TO BADPM: ERR _ 56; GOTO RELRN; \DISPOSITION OF THE HAVIT: I _ I OR $(PTR3+J); \FILE. ATT _ ATT + 1] OPSPL: $PTS8 _ $PTS8 XOR I IF [J _ I AND 600K] THEN[ \IF READ OR WRITE DEFALULT IF J = 600K THEN J _ 0; \CHANGED SET REWR TO BO $PTS8 _ ($PTS8 AND 177177K) OR J]!AND SET THE NEW OPTION $(PTS15) _ $LU2 IF $PAR4 THEN [ \CHECK LEGALITY OF IF $PRIOR < 1 OR $PRIOR > 9999 \PRIORITY, IF THEN GOTO BADPM], \SUPPLIED. ELSE[ \PRAM NOT SUPPLIED FIGURE DEFAULT $PRIOR_[IF J.REC THEN $(PTR1+10), \USE SPOOL PRIORITY FROM ELSE 99]] !JOB RECORD ELSE USE 99 $PTS9_$PRIOR !SET SPOOL PRIORITY $(PTS10) _ "W" !SUPPLY INITIAL STATUS. IF $PAR5=3 THEN[ \IF PROGRAM NAME SUPPLIED IFNOT L3 THEN \AND HE HAS THE CAPABILITY CALL .DFER($PTS12,$PROG), \MOVE IN THE NAME ELSE \ELSE GIVE CAP ERROR GO TO ILCAP] IF $PAR2 THEN GO TO SPCAL !IF NOT SPOOL POOL GO DOIT CALL WR !WRITE OUT REC 17 (POOL BITS) POST(I.BUF) !POST AND RELEASE RN RNRQ(4,JRN.,JSTAT) !IN PREPARATION FOR SPCAL: SPOPN(BUF. ,PAR3) !THIS CALL TO SMP. IF PAR3 < 0 THEN [ \CHECK FOR ERROR IFNOT $PAR2 THEN[ \IF NOT POOL JUST EXIT RNRQ(1,JRN.,JSTAT); \LOCK IT UP CALL RD(17,$PTR); \IF ERROR THEN LEN_PTR+4+((FNUM-1) >- 4); \MUST CLEAR BIT IN POOL TBL. $LEN_$LEN AND (NOT MASK); \ CALL WR]; \WRITE THE CORRECTED RECORD ERR _ PAR3; \SET ERROR FOR RETURN GOTO RELRN] !NOW WE HAVE FIXED THE MESS LULU.($LU1,PAR3) !TRY TO SET LU SWITCH. GOTO SUSP !FAILED - LEAVE. IFNOT $PAR2 THEN [ \IF SPOOL SETUP OK IF J.REC THEN[ \AND IF A JOB RNRQ(1,JRN.,JSTAT); \LOCK UP THE FILE CALL RD(J.REC,$PTR1); \SET UP TO SET LEN_PTR1+ 11 + ((FNUM-1) >-4); \THIS OWNERSHIP IN $LEN_$LEN OR MASK; \JOB'S JOBFIL RECORD. CALL WR ]] !WRITE THE RECORD. $S0 _ 1; $(S0+1) _ PAR3 !SET UP GLOBALS 0S $(S0+4) _ 3; $(S0+5) _ $(PTS2) !AND 1S WITH THE LU $[REAL](S0+6) _ $[REAL](PTS3) !AND SPOOL FILE NAME. GOTO RELRN !NOW EXIT GRACEFULLY. ! ! SUSP: ERR _ -24 RELRN: IF JSTAT = 2 THEN [POST(I.BUF); \MAKE SURE FILE IS RNRQ(4,JRN.,JSTAT)] !POSTED AND RN UNLOCKED. RETURN END ! ! RD: SUBROUTINE (R,B) DIRECT CALL READF(I.BUF,ERR,B,16,LEN,R) !ROUTINE TO READ FROM JOB IF ERR < 0 THEN GO TO RELRN !FILE R1_R !SAVE PRAMS FOR WRITE B1_@B RETURN END ! ! WR: SUBROUTINE DIRECT CALL WRITF(I.BUF,ERR,$B1,16,R1) !WRITE THE SAME RECORD BACK OUT IF ERR < 0 THEN GO TO RELRN !EXIT ON ERROR RETURN END IFDSC :FUNCTION(LU) DIRECT CALL XLUEX(100015K,LU,SEQ5) !GET STATUS ON THE LU GO TO IFFLS !IF ERROR TAKE FALSE EXIT ! IF (SEQ5 AND 36000K) = 14000K THEN \IF A DISC RETURN 1 !RETURN TRUE IFFLS: RETURN 0 !ELSE RETURN FALSE END END END$