SPL,L,O,M,C 
!     NAME:   FM.CM 
!     SOURCE: 92064-18164 
!     RELOC:  92064-16055 
!     PGMR:   G.A.A.
!     MOD:    G.L.M.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  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(7) " 92064-16055  REV.1650  761204"
! 
      LET EXEC             BE SUBROUTINE,EXTERNAL 
      LET CLOSE,OPEN,MGLU   BE SUBROUTINE,EXTERNAL
      LET OPEN. BE SUBROUTINE 
      LET CLO BE SUBROUTINE,DIRECT
      LET IFBRK    BE FUNCTION,EXTERNAL 
      LET BUF.(129) BE INTEGER,GLOBAL 
      LET MNAM(3) BE INTEGER
      LET  JER.,CONV.,IER.,MVW BE SUBROUTINE
      LET .E.R BE INTEGER,GLOBAL
      LET ELOG.,AB.FM BE LABEL,EXTERNAL 
      LET XEQT      BE CONSTANT (1717K) 
      LET A        BE CONSTANT(0) 
      LET B        BE CONSTANT(1) 
! 
OPEN.:SUBROUTINE(DCBRF,LURF,PLIS,OPLST) GLOBAL
OPN3: CLO (DCBRF) !CLOSE THE OLD ONE
      IF LURF<20000K THEN [MGLU(LURF,MNAM);FAD_@MNAM],\ IF FILE THEN
                            ELSE FAD_@LURF
      OPEN(DCBRF,.E.R ,$FAD,\ !IF FILE THEN 
             (OPLST AND 37777K),\ 
                 PLIS,$(@PLIS+1));IF .E.R <0 THEN  GO TO ELOG.,\
                    ELSE RETURN 
      END 
! 
! 
! 
CLO:  SUBROUTINE(DCB)GLOBAL,DIRECT !CLOSE SUBROUTINE FOR INTERNAL WORK
      IFNOT (DCB = 177400K) THEN CLOSE(DCB,.E.R ) !IF NOT FAKE CLOSE
      $(@DCB+9)_0   !ELSE KILL THE OPEN FLAG
      RETURN
      END 
! 
CONV.:SUBROUTINE (NOO,BUF,NDIG) GLOBAL
!     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;DI_$B+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 
! 
! 
! 
!    JER. SHOULD ONLY BE CALLED WHEN NO CLEAN UP IS REQUIRED
!       AS IT EXITS TO AB.FM OR ELOG. 
! 
JER.:SUBROUTINE GLOBAL,DIRECT 
      IER.   !GO CHECK FOR FMP ERROR
      .E.R_0
      IF IFBRK THEN GO TO AB.FM 
      RETURN
      END 
! 
MVW:SUBROUTINE(FROM,TT,LENZ) GLOBAL 
! 
      ASSEMBLE " LDA FROM,I"
      ASSEMBLE " LDB TT,I"
      ASSEMBLE " EXT .MVW"
      ASSEMBLE " JSB .MVW"
      ASSEMBLE " DEF LENZ,I"
      ASSEMBLE " NOP        " 
! 
      RETURN
      END 
! 
! 
! 
IER.:SUBROUTINE GLOBAL,DIRECT 
      IF .E.R=>0 THEN RETURN,\
      ELSE GO TO ELOG.
      END 
! 
! 
! 
! 
      END 
      END$
                                                                                                                          