SPL,L,O,M,C ! NAME: FM.CM ! SOURCE: 92064-18052 ! RELOC: 92064-16017 ! 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-16017 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. BE SUBROUTINE LET .E.R BE INTEGER,EXTERNAL 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)DIRECT,GLOBAL !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 ! ! ! IER.:SUBROUTINE GLOBAL IF .E.R=>0 THEN RETURN,\ ELSE GO TO ELOG. END ! ! ! ! END END$