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<SVCOD THEN RETURN !IGNORE IF CODE TOO SMALL
EC:   EC.HO                  ! IF ERROR TO BE PRINTED ECHO THE COMMAND
      CALL EXEC(2,CAM.O,BFMS,LN)  !PRINT THE ERROR MESSAGE
      IF SCCOD<2   THEN RETURN
      IF SVCOD > 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$
                                                                                                                                