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<SVCOD THEN RETURN                 !IGNOR IF CODE TOO SMALL 
EC:   ECHO                                       !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 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$
                                                                                                                      