SPL,L,O,M ! NAME: FM.CM ! SOURCE: 92067-18203 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. 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 FM.CM(8) "92067-16185 REV.2026 800311" ! ! MODIFIED: 780413 TO SAVE SECURITY CODE IN TRANSFER ! STACK. (GLM) ! 780414 TO CLEAR .E.R. IF LU PASSED TO OPEN. ! WAS OK. (GLM) ! 780421 SESSION MONITOR CARTRIDGE SEARCH OVERRIDE ! (BL) ! 780531 TO POST ERROR MNEMONIC TO SESSION CONTROL ! BLOCK (BL) ! 800304 TO USE ABSOLUTE VALUE OF REMAINDER IN ! CONV. COMPUTATION (SST #4660) ! 800311 IF OPEN. ERROR AND ABORTING JOB ! (USING RETURN OPTION ON OPEN. CALL), RETURN ! (SST #4770) ! ! LET EXEC BE SUBROUTINE,EXTERNAL LET CLOSE,OPEN BE SUBROUTINE,EXTERNAL LET PTERR BE SUBROUTINE,EXTERNAL !780531 LET .DFER BE SUBROUTINE,EXTERNAL,DIRECT LET FM.ER,OPEN.,CLOS.,\ IER. BE SUBROUTINE LET CLO BE SUBROUTINE,DIRECT LET IFBRK, \CHECK BREAK FLAG LURQ, \LU LOCK-UNLOCK LUTRU \RETURN TRUE SYSTEM LU BE FUNCTION,EXTERNAL LET RQLU BE FUNCTION,DIRECT LET BRKF. BE INTEGER,GLOBAL LET LCKFL,WATMS(8),WATM BE INTEGER INITIALIZE BRKF. TO 0 INITIALIZE LCKFL,WATMS TO 0,"WAITING FOR LU " LET MSS. BE SUBROUTINE LET JER. BE SUBROUTINE,DIRECT LET EC.HO,CONV. BE SUBROUTINE LET ILOG BE FUNCTION,DIRECT LET CAMS.(60) BE INTEGER,GLOBAL !TRANSFER STACK *780413* LET C.BUX BE INTEGER LET C.BUF(40) BE INTEGER,GLOBAL LET TTY.,N.OPL,I.BUF,O.BUF BE INTEGER,EXTERNAL LET .TTY BE FUNCTION,EXTERNAL LET CAM.I BE INTEGER(144),GLOBAL LET CAM.O,ECH.,BUF.(129) BE INTEGER ,GLOBAL LET ECHF.,C.DLM BE INTEGER ,GLOBAL LET .R.E. BE INTEGER ,EXTERNAL LET .E.R. BE INTEGER,GLOBAL !DEFINE THE ERROR WORD LOCATION LET SVCOD BE INTEGER LET P.TR BE INTEGER,GLOBAL LET TMP. BE INTEGER,GLOBAL LET LST(2) BE INTEGER LET SVCO,CREF BE INTEGER LET S,LSSC,SCOD,NFA,ECH,LSDIS BE INTEGER LET FM.AB BE LABEL,EXTERNAL LET XEQT BE CONSTANT (1717K) LET FM(2),MS1,MS2 BE INTEGER INITIALIZE C.BUX TO " :" INITIALIZE FM , MS1,MS2 TO "FMGR 000" LET A BE CONSTANT(0) LET B BE CONSTANT(1) INITIALIZE P.TR TO @CAMS. LET NO.RD,ACTV.,CAD. BE INTEGER,EXTERNAL LET S.CAP, \9P - SESSION CAPABILITY OVRD. \CARTRIDGE SEARCH OVERRIDE BE INTEGER,EXTERNAL ! LET STWD BE CONSTANT (100015K) ! MSS.: SUBROUTINE(ER,NX)GLOBAL LET ER,NX BE INTEGER ! ! MESSAGE FORMAT: ! FMGR XXX ! ! MESSAGE ERROR WORD FORMAT ! THE THOUSANDS DIGIT IS USED AS FOLLOWS: ! IF ONE OR THREE THEN TWO MESSAGES ARE TO BE PRINTED ! ! IF ZERO OR TWO THEN ONLY ONE MESSAGE IS PRINTED ! ! IF ZERO OR ONE THEN SEND THE INPUT DEVICE TO THE LOG UNIT ! IF 2 OR 3 LEAVE THE LOG AND INPUT DEVICES AS IT IS ! IFNOT [NO_ER] THEN BRKF._1 !SAVE ERROR FOR ?? AND ! IF BREAK ERROR SET FLAG S_NO/1000;.R.E._.B. MS1_" " !SET SIGN FOR PLUS IF NO<0 THEN [NO_ -NO;MS1_26400K]!IF NEG SET TO GIVE SIGN S_NO/1000;NO_.B. CONV.(NO,MS2,3) !CONVERT THE NUMBER *780531* FM.ER([IF S>1 THEN 1,ELSE 2],FM,4) IF S.CAP THEN CALL PTERR(FM,PERR) !POST TO SCB *780531* IF S AND 1 THEN [ \DO SECOND NUMBER *780531* S_S-1; \ *780531* MS1 _ 20040K; \ *780531* CONV.(NX,MS2,3); \ *780531* FM.ER([IF S>1 THEN 1,ELSE 2],FM,4)] !780531* RETURN END ! ! COMMAND OUTPUT (ERROR) SUBROUTINE ! FM.ER:SUBROUTINE(SCCOD,BFMS,LN)GLOBAL LET SCCOD,BFMS,LN BE INTEGER ! ! FM.ER PRINTS ONLY IF SCCOD IS GREATER THAN OR EQUAL TO ! THE SVCOD ENTERED AT TURN ON TIME ! ! IN ADDITION, IF THE SCCOD IS GREATER THAN 1, CONTROL IS SWITCHED ! TO THE LOG CHANNEL ! IF SCCOD > 1 THEN GO TO EC !ALWAYS PRINT IF 2 OR MORE IF SCCOD 3 THEN RETURN !IF CODE HIGH ENOUGH RETURN ! IF ACTV. THEN [ \IF IN AN ACTIVE IF SVCOD < 3 THEN [ \JOB, AND SV<3, CAD.,NO.RD _ 6; RETURN]] !ABORT THE JOB. IF ILOG() THEN RETURN !IF ON LOG ALREADY RETURN IF S.CAP THEN OVRD._OVRD. AND 137777K !CLEAR BEFORE GOING TO LOG OPEN.(CAM.I,CAM.O,0.0,410K) !OPEN THE INPUT TO THE LOG DEVICE RETURN END ! ! OPEN.:SUBROUTINE(DCBRF,LURF,PLIS,OPLST) GLOBAL ! ! DCBRF - DCB ARRAY ! LURF - FILE NAME ARRAY OR LU (IF NAME NOT > 20000K) ! PLIS - 2 WORD ARRAY, (1) = SECURITY CODE ! (2) = DISC ID ! OPLST - OPEN OPTION WORD ! (IF SIGN BIT SET AND FILE TYPE 0 WITH EOF OF ! LEADER AND IDCB REFERS TO O.BUF, THEN EOF CALL ! IS MADE) ! (IF BIT 14 SET, ERROR CAUSES RETURN FROM OPEN. ! INSTEAD OF NORMAL IER. EXIT TO COMMAND LOOP) ! LET DCBRF,LURF,PLIS,OPLST BE INTEGER DCB14_[DCB13_[DCB9_[DCB8_[DCB7_[DCB6_[DCB5_[DCB4_[DCB3_\ [DCB2_@DCBRF+2]+1]+1]+1]+1]+1]+1]+1]+4]+1 RTNOP_OPLST OPLST_OPLST AND 137777K .E.R._20 ! SET ERROR CODE FOR ILLEGAL LU IF LURF < 0 THEN [ \IF LU NEGATIVE IF S.CAP THEN OVRD._OVRD. AND 137777K; \IF SESSION,CLEAR OVRD GO TO ABEX] !LU NEGATIVE, SO ABORT IFNOT @DCBRF=@CAM.I THEN GOTO OPN3 ! NOT INPUT UNIT TTY._0 !SET TTY FLAG TO INDICATE NOT TTY $P.TR_$DCB14 !SAVE RECORD COUNT FOR FILE P.TR_P.TR+1! SET THE NEXT ADDRESS CALL .DFER($P.TR,LURF);P.TR_P.TR+3 !STACK THE NAME OPN3: CLO (DCBRF) !CLOSE THE OLD FILE IF LURF>20000K THEN [ \ IF FILE THEN IF S.CAP THEN [IF @DCBRF=@CAM.I THEN \SET FOR PGS SEARCH OVRD._OVRD. OR 40000K]; \ OPEN(DCBRF,.E.R.,LURF,OPLST,PLIS,$(@PLIS+1)); \OPEN THE FILE IF @DCBRF=@CAM.I THEN \RESET OVRD IF CAM.I AND [IFNOT ($DCB7 AND 20K) THEN \IF NOT ON SYSTEM DISC, OVRD._OVRD. AND 137777K]; \CLEAR OVERRIDE FLAG IF .E.R. < 0 THEN[ \IF ERROR OPAB: IF @DCBRF=@CAM.I THEN[ \ON COMMAND DCB THEN BP_1; \ P.TR_P.TR-ILOG()-4; \BACK PTR (10 IF FROM LOG) BP_0; \ $DCB14_$P.TR; \AND RESET THE RECORD COUNT IF SVCOD > 3 THEN[ \TR TO LOG NOT ALLOWED SO MSS.(.E.R.);RETURN] \SEND ERROR AND RETURN ] \ ]; \ ERROR: IF (RTNOP AND 40000K) THEN RETURN;\IF ABORTING, RETURN IER.; \REPORT ERRORS ON OTHERS GO TO OPN2 \SKIP THE ELSE CAUSE ] .E.R. _ -18 !IN CASE OF INVALID LU EXEC(STWD ,LURF,EQT5,NUM,BF) !GET STAT WORD TYPE CODE GO TO OPAB !IF ABORT GO SEND ERROR .E.R._0 !*780414*CLEAR ILLEGAL LU CODE ! ! SET EOF ! EOF_1100K !ASSUME TTY-PRINTER IF [EQT5_EQT5 AND 37400K] > 7000K THEN \IF DRIVER TYPE 17 OR > GO TO EOFCD !USE EOF IF EQT5 = 2400K THEN[ \IF DVR05 AND IF [BF_BF AND 7] = 1 THEN GO TO EOFCD, \SUBCHANNEL 1 OR ELSE[IF BF = 2 THEN[ \2 I.E. CTU EOF EOFCD: EOF_100K;GO TO OPN1]]] IF EQT5=1000K THEN GO TO LEADR !IF PUNCH OR IF (OPLST AND 110K) = 110K THEN[ \OR LEADR SUB FUN SUPPLIED LEADR: EOF_ 1000K] !USE LEADER FUNCTION ! ! OPN1: $DCB2,DCBRF_0 $DCB3_(OPLST AND 3700K) OR LURF $DCB4_EOF OR (LURF AND 77K) $DCB5,$DCB6_100001K $DCB7_100010K $DCB8,$DCB13_0 $DCB14_1 IFNOT 77K AND NUM THEN $DCB6_1 !READ ILLEGAL FROM LU ZERO $DCB9_$XEQT OPN2: IF @DCBRF=@CAM.I THEN[ \IF COMMAND DEVICE $P.TR_ PLIS; P.TR_P.TR+1; \SAVE SECURITY CODE *780413* $P.TR_ -(DCBRF AND 77K);P.TR_P.TR+1] !SAVE THE CR (-LU) IF $DCB2 THEN RETURN !IF NOT TYPE ZERO THEN RETURN IF .TTY($DCB3) OR @DCBRF=@CAM.I \IF INTERACTIVE OR IF THEN GO TO OPN5 !CMND INPUT, SKIP LOCK IF LUTRU($DCB3 AND 77K) = -1 THEN \CHECK IF DEFINED BEFORE LOCK [.E.R._ -18;GO TO ERROR] !790424 IFNOT RQLU() THEN GO TO OPN5 !IF LOCKABLE LOCK AND CONTINUE CALL CONV.($DCB3 AND 77K,WATM,2) !PUT LU IN MESSAGE CALL EXEC(2,CAM.O,WATMS,9) !SEND WAIT MESSAGE OPN6: CALL EXEC(12,0,2,0,-5) !TRY EVERY 5 SECONDS CALL JER. !TEST FOR BREAK IF RQLU() THEN GO TO OPN6 !IF NOT NOW WAIT AGAIN OPN5: IF @DCBRF=@O.BUF THEN[\ IF($DCB4 AND 3700K)=1000K THEN[IF OPLST<0 THEN[\ CALL EXEC(100003K,$DCB4); \END FILE IF REASONABLE GO TO OPN55]]] !CATCH ABORTS OPN55:IF @DCBRF=@CAM.I THEN[\ TTY._.TTY($DCB3);GO TO OPN4] IF @DCBRF=@I.BUF THEN \ IF INPUT ON A ZERO [OPN4: EXEC(100003K,700K+($DCB3 AND 77K));\THEN SET EOT CONDITION RETURN] !EXTRA RETURN FOR ABORT CASE RETURN END ! RQLU: FUNCTION DIRECT RETURN LURQ(100001K,$DCB3,1) END ! ! CLOS.:SUBROUTINE(CLSOP) GLOBAL LET CLSOP BE INTEGER IF @CLSOP THEN[CLO(CLSOP);RETURN]! IF SPECIFIED CLOSE THE FILE CLO(I.BUF)! CLOSE INPUT CLO(O.BUF) ! CLOSE OUTPUT CLO (CAM.I) !CLOSE COMMAND RETURN! RETURN END ! CLO: SUBROUTINE(DCB)DIRECT !CLOSE SUBROUTINE FOR INTERNAL WORK LET DCB BE INTEGER DCBX9_[DCBX3_[DCBX2_@DCB+2]+1]+6 IF $DCBX9 # $XEQT THEN RETURN !IF NOT OPEN FORGET IT IFNOT $DCBX2 THEN[\ !IF THIS IS A TYPE 0 FILE IFNOT @DCB=@CAM.I THEN[\ AND NOT COMMAND INPUT CALL LURQ(40000K,$DCBX3,1) ]] !CLEAR THE LOCK !NOTE-- BIT 14 IS SET(NO-ABORT) GOTO CL1 !THIS LINE IS REQUIRED FOR ! !THE ABORT RETURN CL1: IF DCB AND 177700K THEN CLOSE(DCB) !IF NOT FAKE CLOSE $DCBX9 _0 !ELSE KILL THE OPEN FLAG RETURN END ! ! EC.HO:SUBROUTINE GLOBAL !TO ECHO COMMANDS IFNOT ECHF. THEN RETURN !IF ALREADY DONE THE RETURN IF ILOG() THEN GO TO ECH0 C.BUX_20072K !(BLANK : )ASSUME BATCH IF TTY. THEN C.BUX_ 20040K !(2 BLANKS ) IF BAD ASSUMPTION CHANGE IT CALL EXEC(2,CAM.O,C.BUX,ECH.+1) !ECHO THE COMMAND ECH0: ECHF._0 !SET THE ECHOED FLAG RETURN END ! ! ILOG: FUNCTION DIRECT DCB9_[DCB3_[DCB2_@CAM.I+2]+1]+6 !SET UP DCB ADDRESSES IFNOT ($DCB3 XOR CAM.O) AND 77K THEN[IFNOT $DCB2\ THEN [IF$DCB9=$XEQT OR BP=1 THEN RETURN 6]] RETURN 0 END ! IER.: SUBROUTINE GLOBAL IF .E.R. =>0 THEN RETURN ABEX: DO[MSS.(.E.R.);GO TO FM.AB] END ! ! JER.: SUBROUTINE GLOBAL,DIRECT !SUBROUTINE TO CHECK ERRORS IER. ! AND FOR BREAK CONDITION .E.R._0 !SET ERROR CODE FOR BREAK ERROR IF IFBRK THEN GO TO ABEX!IF BREAK CONDITION ,EXIT RETURN !ELSE RETURN END ! ! CONV.:SUBROUTINE (NOO,BUF,NDIG) GLOBAL LET NOO,BUF,NDIG BE INTEGER ! ROUTINE TO CONVERT NO WITH NDIG DIGITS TO ASC ! A T BUF ! ! BUF WILL CONTAIN THE LOWEST DIGITS BUF-1 THE NEXT ! LOWEST ETC. ! EV,BF_@BUF NUM_NOO FOR I_1 TO NDIG DO THRU COV DO[NUM_NUM/10; \ IF [DI_$B] < 0 THEN DI_ -DI; \ DI_DI+60K] $BF_[IF EV THEN ($BF AND 177400K)+DI,\ ELSE ($BF AND 377K)+(DI-<8)] COV: IF EV THEN EV_0, ELSE\ EV,BF_BF-1 RETURN END ! ! ! ! ! END END$