SPL,L,O,M ! NAME: FM.CM ! SOURCE: 92070-18001 ! RELOC: 92070-16001 ! PGMR: G.A.A. ! ! *************************************************************** ! * (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 FM.CM(8) " 92070-1X001 REV.2001 800103" ! ! EXTERNAL SUBROUTINES LET .DFER BE SUBROUTINE,EXTERNAL,DIRECT LET EXEC BE SUBROUTINE,EXTERNAL LET OPENF BE SUBROUTINE,EXTERNAL ! EXTERNAL FUNCTIONS LET GTOPN BE FUNCTION,EXTERNAL LET IFBRK BE FUNCTION,EXTERNAL LET IFTTY BE FUNCTION,EXTERNAL ! EXTERNAL LABELS LET FM.AB BE LABEL,EXTERNAL ! EXTERNAL VARIBLES LET P.6 BE INTEGER,EXTERNAL LET .E.R BE INTEGER,EXTERNAL LET C.BUX BE INTEGER,EXTERNAL LET CAM.I BE INTEGER,EXTERNAL LET CAM.O BE INTEGER,EXTERNAL LET ECH BE INTEGER,EXTERNAL LET ECHF. BE INTEGER,EXTERNAL LET INT. BE INTEGER,EXTERNAL LET P.TR BE INTEGER,EXTERNAL LET SVCOD BE INTEGER,EXTERNAL ! INTERNAL SUBROUTINES LET CONV. BE SUBROUTINE LET ECHO BE SUBROUTINE LET FM.ER BE SUBROUTINE LET IER. BE SUBROUTINE,DIRECT LET JER. BE SUBROUTINE,DIRECT LET MSS. BE SUBROUTINE LET MVW BE SUBROUTINE LET OPEN. BE SUBROUTINE ! INTERNAL FUNCTIONS LET ILOG BE FUNCTION,DIRECT ! INTERNAL VARIBLES LET FM(2) BE INTEGER LET MS1 BE INTEGER LET MS2 BE INTEGER INITIALIZE FM,MS1,MS2 TO "FMGR 000" LET OPTN BE INTEGER LET SRPMS BE INTEGER LET NO BE INTEGER LET S BE INTEGER LET WATMS(8) BE INTEGER LET WATM BE INTEGER INITIALIZE WATMS TO "WAITING FOR LU " ! ! 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 ! NO _ ER S_NO/1000 !ISOLATE ERROR CODE P.6 _ .B. !SET 6P TO ERROR CODE MS1_" " !SET SIGN FOR PLUS IF NO<0 THEN [ \IF NEGATIVE, NO _ -NO; \CONVERT ERROR TO POSITIVE MS1_ 26400K] !AND USE MINUS SIGN S_NO/1000 NO_ .B. MSS00:CONV.(NO,MS2,3) !CONVERT THE NUMBER FM.ER([IF S>1 THEN 1,ELSE 2],FM,4) IF S AND 1 THEN[ \DO SECOND NUMBER S _ S-1; \ NO_ NX ; \ MS1 _ 20040K; \ GOTO MSS00] ! RETURN END ! ! COMMAND OUTPUT (ERROR) SUBROUTINE ! FM.ER:SUBROUTINE(SCCOD,BFMS,LN)GLOBAL LET BFMS BE INTEGER LET LN BE INTEGER LET SCCOD 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 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 HI ENOUGH, RETURN ! IF ILOG() THEN RETURN !IF ON LOG ALREADY, RETURN OPEN.(CAM.I,CAM.O,0.0,410K) !OPEN INPUT TO LOG RETURN END ! ! OPEN.:SUBROUTINE(ODCB,OLU,PLIST,OPLST) GLOBAL LET ODCB BE INTEGER(144) !USER'S DCB LET OLU BE INTEGER(3) !THE NAME,LU ARRAY LET PLIST BE INTEGER(2) !SECURITY CODE, CRN LET OPLST BE INTEGER !OPEN OPTION ! ! SKPMS _ 1 !SET UP TO PRINT WAIT MES IF NECESSARY OPTN _ OPLST !SET UP IN CASE OF INPUT (NOTE 1) IF @ODCB = @CAM.I THEN[ \OPEN THE INPUT FILE? $P.TR_ ODCB(15); \YES,SAVE CURRENT RECORD COUNT P.TR _ P.TR+1; \POINT TO START OF NEXT BLOCK CALL .DFER($P.TR,OLU); \PUT IN NAME/LU P.TR _ P.TR+3; \POINT TO SECURITY CODE OPTN _ OPTN OR 1] !DON'T ALLOW INPUT TO BE LOCKED OPIN: OPENF(ODCB,.E.R,OLU,OPTN,PLIST(1),PLIST(2))!OPEN NEW FILE/LU IF .E.R < 0 THEN[ \WAS THERE AN ERROR? IF @ODCB = @CAM.I THEN[ \YES, IS THIS INPUT FILE P.TR _ P.TR-4; \BACK UP TO LAST REC COUNT ODCB(15) _ $P.TR; \RESET IN DCB IF SVCOD > 3 THEN[ \TRANSFER TO LOG NOT ALLOWED MSS.(.E.R); \SO REPORT ERROR RETURN]]] !AND RETURN IF .E.R = -36 THEN[ \NO RESOURCE NUMBER OR IF SKPMS THEN[ \ SKPMS _ 0; \ CONV.(ODCB(4) AND 77K,WATM,2); \CONVERT LU EXEC(2,CAM.O,WATMS,9)]; \WRITE WAITING MESSAGE EXEC(12,0,2,0,-5); \TRY IN FIVE SECONDS .E.R _ 0; \CLEAR ERROR CODE JER.; \CHECK BREAK FLAG GOTO OPIN], \GO TRY AGAIN ELSE IER. !REPORT ALL OTHER ERRORS ! IF @ODCB = @CAM.I THEN[ \IS THIS THE INPUT DEVICE? $P.TR _ PLIST(1); \YES, STACK THE SECURITY CODE P.TR _ P.TR+1; \POINT TO CRN/LU $P.TR _ -(ODCB(1) AND 77K); \STORE THE -LU P.TR _ P.TR+1; \NOW POINT TO RECORD COUNT INT._ [IF ODCB(3) THEN 0, ELSE IFTTY(ODCB(4))]]!SET UP INT FLAG RETURN !DONE END ! ! NOTE 1: THE INPUT DEVICE IS NEVER ALLOWED TO BE LOCKED. IF A TR ! OCCURS, THEN A TRANSFER BACK TO THE PREVIOUS DEVICE WOULD HAVE LOST ! THE LOCK IN THE MEAN TIME. ALSO, THE TRANSFER STACK WOULD BE COR- ! RUPTED IF A BREAK OCCURED WHILE WAITING FOR AN ALREADY LOCKED LU. ! TO PREVENT THE LOCK, THE NON-EXCLUSIVE BIT IS ALWAYS OR'ED INTO ! THE USER'S OPTION WORD WHEN THE INPUT IS OPENED. OPEN WILL THERE- ! FORE NEVER REPORT ERROR -36. ! ! ! ! ECHO: SUBROUTINE GLOBAL !TO ECHO COMMANDS IFNOT ECHF. THEN RETURN !IF DONE ALREADY, RETURN IF ILOG() THEN GOTO ECH0 !IF INPUT ON LOG, DON'T ECHO C.BUX_ 20072K !IF XFER FILE, USE " :" IF INT. THEN C.BUX_ 20040K !IF LOG NOT INPUT " " !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 = GTOPN THEN RETURN 1]] ! RETURN 0 END ! ! IER.: SUBROUTINE GLOBAL,DIRECT IF .E.R =>0 THEN RETURN ABEX: MSS.(.E.R) GOTO FM.AB END ! ! JER.: SUBROUTINE GLOBAL,DIRECT !SUBROUTINE TO CHECK ERRORS IER. !AND BREAK CONDITION .E.R _ 0 !SET ERROR CODE FOR BREAK ERROR IF IFBRK THEN GOTO ABEX !IF BREAK CONDITION, EXIT RETURN !ELSE RETURN END ! ! CONV.:SUBROUTINE (NOO,BUF,NDIG) GLOBAL LET NOO,BUF,NDIG BE INTEGER ! ROUTINE TO CONVERT NOO WITH NDIG DIGITS TO ASCII AT 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 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 ! ! MVW: SUBROUTINE(FROM,TT,LENZ) GLOBAL ! ASSEMBLE["EXT .MVW";\ "LDA FROM,I";\ "LDB TT,I ";\ "JSB .MVW ";\ "DEF LENZ,I";\ "NOP "] RETURN END ! ! ! END END$