SPL,L,O,M 
!     NAME:   F.UTM 
!     SOURCE: 92070-18024 
!     RELOC:  92070-16024 
!     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 F.UTM(8) "  92070-1X024  REV.1941  790712" 
! 
!  EXTERNAL SUBROUTINES 
      LET CONV.     BE SUBROUTINE,EXTERNAL
      LET ECHO      BE SUBROUTINE,EXTERNAL
      LET EXEC      BE SUBROUTINE,EXTERNAL
      LET OPEN.     BE SUBROUTINE,EXTERNAL
!  EXTERNAL FUNCTIONS 
      LET IFTTY     BE FUNCTION,EXTERNAL
!  EXTERNAL VARIBLES
      LET .E.R      BE INTEGER,EXTERNAL 
      LET CAM.O     BE INTEGER,EXTERNAL 
      LET G0..      BE INTEGER,EXTERNAL 
      LET I.BUF     BE INTEGER,EXTERNAL 
      LET N.OPL     BE INTEGER,EXTERNAL 
      LET P.6       BE INTEGER,EXTERNAL 
      LET P.7       BE INTEGER,EXTERNAL 
      LET SVCOD     BE INTEGER,EXTERNAL 
      LET TMP.      BE INTEGER,EXTERNAL 
      LET XPAND     BE INTEGER,EXTERNAL 
! 
      LET LLMSG(6)  BE INTEGER
      LET LOMSG(4)  BE INTEGER
      LET SVMSG(5)  BE INTEGER
! 
      INITIALIZE LLMSG TO "  LL=       "
      INITIALIZE LOMSG TO "  LO=   "
      INITIALIZE SVMSG TO "  SV=     "
! 
! 
LL..: SUBROUTINE(N14,LIS14,ER14)GLOBAL           !LIST CHANGE SUBROUTINE
      RC_@LIS14+1                                !SET LIST ADDRESSES
      IFNOT N14  THEN[                           \NO PARAMETERS 
         IF TMP. < 20000K  THEN[                 \IF LIST A LU
            CONV.(TMP.,LLMSG(4),2);              \CONVERT LU AND
            OCNT_ 4],                            \SET MESSAGE SIZE
         ELSE[                                   \
            LLMSG(4)_ TMP.;                      \IF LIST ASCII,
            LLMSG(5)_ $([T_ @TMP.+1]);           \PUT LIST FILE NAME
            LLMSG(6)_ $(T+1);                    \INTO LIST MESSAGE 
            OCNT_ 6];                            \SET OUTPUT LENGTH 
         EXEC(2,CAM.O,LLMSG,OCNT);               \PRINT MESSAGE TO LOG
         RETURN]                                 !RETURN
      OPEN.(I.BUF,$RC,N.OPL,410K)                !ATTEMPT OPEN
      T2_@TMP.                                   !SET LIST DEF ADDRESS
      FOR T_RC TO RC+2 DO[                       \
         $T2_$T;                                 \
         T2 _ T2+1]                              !
      $T2_N.OPL                                  !
      $(T2+1)_ -(I.BUF AND 77K)                  !
      RETURN                                     !
      END 
! 
! 
LO..:SUBROUTINE(N13,LI13,ER13) GLOBAL 
                                                 !NEW LOG UNIT SUBROUTINE 
      IFNOT N13  THEN[                           \NO PARAMETERS 
         CONV.(CAM.O,LOMSG(4),2);                \CONVERT LOG LU
         EXEC (2,CAM.O,LOMSG,4);                 \OUTPUT TO LOG LU
         RETURN]                                 !RETURN
      IF IFTTY([T_$(@LI13+1)]) THEN              \
              CAM.O_T,                           \
              ELSE ER13_56                       !
      RETURN
      END 
! 
SV..: SUBROUTINE(N15,LI15,ER15) GLOBAL
      RC_[T2_[T_@LI15+1]+4]+4 
      IFNOT N15  THEN[                           \NO PARAMETERS 
         T_ SVCOD + 1000*XPAND;                  \CREATE USER'S CODE
         IF T < 1000  THEN[                      \IF RANGE 0 - 4
            CONV.(T,SVMSG(4),1);                 \PUT INTO MESSAGE
            OCNT_ 4],                            \SET OUTPUT COUNT
         ELSE[                                   \IF RANGE 1000 - 1004
            CONV.(T,SVMSG(5),4);                 \THEN CONVERT
            OCNT_ 5];                            \SET OUTPUT COUNT
         EXEC(2,CAM.O,SVMSG,OCNT);               \OUTPUT TO LOG LU
         RETURN]                                 !RETURN
      IF $RC # "IH" THEN [IFNOT P.7 THEN   \ECHO IF CONDITIONS ARE RIGHT
           ECHO]
       IF $T2 THEN[                         \IF A GLOBAL PROVIDED SAVE THE
         IF $T2 > 0 THEN[                   \MAKE SURE IT IS LEGAL
            IF $T2 < 10 THEN[               \1-9 ONLY 
                 T2_@G0..+($T2 -< 2);       \SET BASE ADDRESS 
                 $T2_1;T2_T2+1;             \SET THE TYPE 
                 $T2_P.7;T2_T2+1;           \THE VALUE
                 $[REAL]T2_0.0;             \CLEAN THE OTHER WORDS
                 GO TO SETSV                \AND SKIP ERROR 
             ]   \
         ];      \
         ER15_56;RETURN                     \ILL NUMBER  EXIT 
       ]
SETSV:IF [XPAND_ $T/1000]  THEN P.6_ 0           !SET ERROR EXPANSION FLAG
      T_ .B.                                     !SAVE SEVERITY CODE
      IF T< 0  THEN T_ 0                         !IF SV NEG, SET TO 0 
      IF T> 4  THEN T_ 4                         !IF > 4, SET TO 4
      P.7_ T + 1000*XPAND                        !SET GLOBAL P7 TO SEVERITY 
      SVCOD_ T                                   !SET INTERNAL SEVERITY 
      RETURN
      END 
! 
      END 
      END$
    