FTN4
      PROGRAM TMPGN(3),92080-16451 REV.2026  800509       
C 
C 
C     NAME: TMPGN 
C     SOURCE: &TMPGN    92080-18451 
C     RELOC:  %TMPGN    92080-16451 
C 
C     PGMR:    DANIEL POT / FRANCOIS GAULLIER   HPG 
C 
C 
C     **************************************************************
C     * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS    *
C     * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C     * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C     * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
C     **************************************************************
C 
C 
C     **************************************************************
C     *                                                            *
C     *          THIS IS THE MAIN PROGRAM OF  TMPGN                *
C     *       (TRANSACTION  MONITOR  PROGRAM  GENERATOR)           *
C     *                                                            *
C     *     THIS PROGRAM HAS 6 SEGMENTS  (TMPG0 - TMPG1 - TMPG2 -  *
C     *                                   TMPG3 - TMPG4 - TMPG5)   *
C     *                                                            *
C     **************************************************************
C 
C 
C 
C     **************************************************************
C     *                                                            *
C     *     RU,TMPGN [,P1 [,P2 [,P3 [,P4 [,P5 ]]]]]                *
C     *                                                            *
C     *        P1   - NOT USED                                     *
C     *        P2   - LISTING LU, DEFAULTED TO CRT                 *
C     *        P3   - LOADER OPTION:                               *
C     *               = 0 --->  LBRP                               *
C     *               = 1 --->  LB                                 *
C     *               = 2 --->  NO LOADING                         *
C     *               = 3 --->  NO CREATION, NO LOADING            *
C     *        P4   - SEARCH %TMSLB/%GPLB4 FLAG:                   *
C     *               = 0 --->  DO NOT SEARCH FOR  %TMSLB/%GPLB4   *
C     *               = 1 --->  SEARCH FOR %TMSLB/%GPLB4           *
C     *        P5   - TMP ID (TMP/TMPD)                            *
C     *               = 0 --->  TMP1   (SYSTEM COMMON)             *
C     *               = 1 --->  TMP2   (CLASS I/O)                 *
C     *                                                            *
C     **************************************************************
C 
CCB1
C*********************************************************************
C 
C-----LABELED COMMON # 1  GENERAL INFORMATION 
C 
      COMMON /TMGC1/LU,LUPRT,LUOUT,ISYTP,IPARAM(5)
C 
C     LU     - USER TERMIAL LU
C     LUPRT  - LISTING LU 
C     LUOUT  - NOT USED 
C     ISYTP  - SYSTEM TYPE (MUST BE .EQ. -9, RTE-IV)
C     IPARAM - TMSGN OPERATING PARAMETERS:
C              ISCRN  - CURRENT SCREEN NO.
                        EQUIVALENCE (ISCRN,IPARAM(1)) 
C              IOFST  - OFFSET INTO BUFFER NCRTH
                        EQUIVALENCE (IOFST,IPARAM(2)) 
C              IEND   - INTERACTIVE OPERATION INDICATOR 
C                       0 - CURRENT PROCESS 
C                       1 - END OF PROCESS
C                       2 - ABORT TMSGN 
C                       3 - PREVIOUS SCREEN 
                        EQUIVALENCE (IEND,IPARAM(3))
C              IJOB   - TMS FUNCTION INDICATOR
C                       0 - DEFINE (INT. AND AUX. LU'S, AND T.U.S.) 
C                       1 - SCREEN HAS BEEN PRINTED, PERFORM ANALYSIS 
C                       3 - DEFINE T.U.S. INTO USER PARTITION 
                        EQUIVALENCE (IJOB,IPARAM(4))
C 
C*********************************************************************
CCB1
C 
C 
CCB2
C*********************************************************************
C 
C-----LABELED COMMON # 2  FLAGS 
C 
      COMMON /TMGC2/ITMFL,IRQFLG(30),IMOTR(9),IVASC0(9) 
C 
C     ITMFL  -
C     IRQFLG - LOAD FLAGS 
C     IMOTR  - BUFFER FOR TMS INFORMATION:
C              IMOFNC - TMS OPERATION CODE
C                       1 - CREATE/MODIFY 
C                       2 - MODIFY LU # 
C                       3 - MODIFY MAIN PROG
C                       4 - RELOAD TMS-SUBROUTINES
C                       5 - LOAD AN APPLICATION 
C                       6 - LIST
C                       7 - PURGE APPLICATION 
C                       8 - END TMSGN 
                        EQUIVALENCE (IMOFNC,IMOTR(1)) 
C              IMOLOA - LOAD OPTION (SCREEN 0)
C                       1 - NO LOAD 
C                       2 - BACKGROUND TEMPORARILY
C                       3 - BACKGROUND REPLACEMENT
C                       4 - BACKGROUND ADDITION 
C                       5 - REAL TIME TEMPORARILY 
C                       6 - REAL TIME REPLACEMENT 
C                       7 - REAL TIME ADDITION
                        EQUIVALENCE (IMOTR(2),IMOLOA) 
C              IMOMAP - LOADER MAP OPTION 
                        EQUIVALENCE (IMOTR(3),IMOMAP) 
C              IMOFLG - SEARCH %TMSLB FLAG
                        EQUIVALENCE (IMOTR(4),IMOFLG) 
C              IMONAM - APPLICATION NAME
                        DIMENSION IMONAM(2) 
                        EQUIVALENCE (IMOTR(6),IMONAM(1))
C              IMOSEC - SECURITY CODE 
                        EQUIVALENCE (IMOTR(8),IMOSEC) 
C              IMOCRN - CARTRIDGE NUMBER
                        EQUIVALENCE (IMOTR(9),IMOCRN) 
C     IVASC0 - DISPLAY BUFFER FOR SCREEN INFORMATION
C 
C*********************************************************************
CCB2
C 
C 
CCB3
C*********************************************************************
C 
C-----LABELED COMMON # 3  BUFFER AREA 
C 
      COMMON /TMGC3/IREFC,ILUGH,INTMS,ILPRG,IDECL,ILGMX,NBPRO 
     .             ,NCRTH(2540) 
C 
C     IREFC  -
C     ILUGH  -
C     INTMS  -
C     ILPRG  -
C     IDECL  -
C     ILGMX  -
C     NBPRO  -
C     NCRTH  - OUTPUT FILE BUFFER:
C              NCNOWD - NO. OF WORDS IN FILE
                        EQUIVALENCE (NCNOWD,NCRTH(1)) 
C              NCINLU - BUFFER ADDR OF INTERACTIVE LU TABLE 
                        EQUIVALENCE (NCINLU,NCRTH(2)) 
C              NCAXLU - BUFFER ADDR OF AUX LU TABLE 
                        EQUIVALENCE (NCAXLU,NCRTH(3)) 
C              NCPAR1 - BUFFER ADDR OF FIRST PARTITION
                        EQUIVALENCE (NCPAR1,NCRTH(4)) 
C              NCNAME - APPLICATION NAME (2 WDS)
                        DIMENSION NCNAME(2) 
                        EQUIVALENCE (NCNAME,NCRTH(5)) 
C              NCSCOD - SECURITY CODE 
                        EQUIVALENCE (NCSCOD,NCRTH(7)) 
C              NCCRNO - CARTRIDGE NO. 
                        EQUIVALENCE (NCCRNO,NCRTH(8)) 
C              NCEMAS - EMA SIZE IN KWDS
                        EQUIVALENCE (NCEMAS,NCRTH(9)) 
C              NCMSEG - MSEG SIZE IN KWDS 
                        EQUIVALENCE (NCMSEG,NCRTH(10))
C              NCPARS - PARTITION SIZE IN KWDS
                        EQUIVALENCE (NCPARS,NCRTH(11))
C              NCPARN - PARTITION NO. 
                        EQUIVALENCE (NCPARN,NCRTH(12))
C              NCLOGD - LOGGING DEVICE LU OR FILENAME (5 WDS) 
                        DIMENSION NCLOGD(5) 
                        EQUIVALENCE (NCLOGD(1),NCRTH(13)) 
C              NCTUSP - TUS NAME OF STARTING PROCESS (3 WDS)
                        DIMENSION NCTUSP(3) 
                        EQUIVALENCE (NCTUSP(1),NCRTH(18)) 
C              NCSTCK - STACK LENGTH
                        EQUIVALENCE (NCSTCK,NCRTH(21))
C              NCINIP - TUS NAME OF INITIAL PROCESS (3 WDS) 
                        DIMENSION NCINIP(3) 
                        EQUIVALENCE (NCINIP(1),NCRTH(22)) 
C              NCLUIN - LU FOR INITIAL PROCESS
                        EQUIVALENCE (NCLUIN,NCRTH(25))
C              NCDBNO - NO. OF DATA BASES 
                        EQUIVALENCE (NCDBNO,NCRTH(26))
C 
C NOTE: THE FOLLOWING VARIABLES ARE EQUIVALENCED TO "NCRTH" FOR USE 
C       BY TMSG5. 
C 
C              IEXFL  - 
                        EQUIVALENCE (IEXFL,NCRTH(2101)) 
C              IPTR   - 
                        EQUIVALENCE (IPTR,NCRTH(2102))
C              NBSCR  - 
                        EQUIVALENCE (NBSCR,NCRTH(2103)) 
C              IFSCR  - 
                        EQUIVALENCE (IFSCR,NCRTH(2104)) 
C              ILAST  - 
                        EQUIVALENCE (ILAST,NCRTH(2105)) 
C              IFLG   - 
                        DIMENSION IFLG(29)
                        EQUIVALENCE (IFLG(1),NCRTH(2106)) 
C              IPRVS  - 
                        DIMENSION IPRVS(29) 
                        EQUIVALENCE (IPRVS(1),NCRTH(2135))
C              IBUFR  - DATA BUFFER USED BY SUBROUTINE "TMPRS"
                        DIMENSION IBUFR(62) 
                        EQUIVALENCE (IBUFR(1),NCRTH(2164))
C              ITEMP  - 
                        DIMENSION ITEMP(3)
                        EQUIVALENCE (ITEMP(1),NCRTH(2226))
C              ITOSC  - 
                        EQUIVALENCE (ITOSC,NCRTH(2229)) 
C 
C*********************************************************************
CCB3
C 
CCB4
C 
C*********************************************************************
C 
C-----LABELED COMMON # 4  BUFFER USED IN CREATION PHASE & ERROR FLAG
C                       OR I/O BUFFER USED IN THE INTERACTIVE DEFINITION
C                       PHASE.
C 
      COMMON /TMGC4/IERFL,IERNB,IERTN,IERMS(7),IRLOC(70),ITRSF(20), 
     .              ISWICH(5) 
C 
C NOTE: THE VARIABLES IN THIS COMMON ARE EQUIVALENCED TO "IOBUF"
C       FOR USE BY TMSG4 & TMSG5. 
C 
      DIMENSION IOBUF(100)
      EQUIVALENCE (IOBUF(1),IERFL)
C     IERFL  -
C     IERNB  -
C     IERMS  -
C     IRLOC  -
C     ITRSF  -
C     ISWICH - 5 WORD STORAGE FOR STRAP SETTINGS
C 
C*********************************************************************
CCB4
C 
C 
C     RETREIVE SCHEDULE PROGRAM PARAMETERS
C 
      CALL RMPAR(IPARAM)
C 
C-----IF IPARAM(4)=1, MAKE IT 0, AND IF IT IS 0, MAKE IT 1. 
C     THIS WAS DONE SO THAT THE COMMAND "RU,TMPGN" WILL WORK
C     THE SAME AS THE "RU,TMPGN,0,0,0,0,N" COMING FROM DCMON. 
C     THE FOURTH ZERO USED TO BE A "1" COMING FROM DCMON, AND THIS
C     IN EFFECT TURNS A 0 BACK TO THE 1 FOR LATER USE. (AS OF 2026) 
C 
      IJOBH=0 
      IF(IJOB.EQ.0) IJOBH=1 
      IJOB=IJOBH
C 
C     RETREIVE TERMINAL LU
C 
      LU=LOGLU(I) 
C 
C --- GET THE STRAP SETTINGS SO THEY CAN BE RESET LATER 
C 
      CALL STRAP(LU,ISWICH,0) 
C-----LOCK THE CRT TERMINAL TO PROTECT THE SCREEN 
      CALL LURQ(1,LU,1) 
      LUPRT=LU
      IF(IPARAM(2) .NE. 0)  LUPRT=IPARAM(2) 
C-----SET UP LOADER PARAMETER 
      J=3 
      K=IPARAM(3) 
      IF(K.EQ.1)  J=2 
      IF(K.EQ.2)  J=0 
      IF(K.EQ.3)  J=1 
      IMOTR(2)=J
C-----SET SEARCH %TMSLB FLAG
      IF(IPARAM(4) .EQ. 0)  ITMFL=-1
C-----SET TMP/TMPD FLAG 
      IF(IPARAM(5) .NE. 0)  IMOTR(7)=2HP2 
C-----CALL KEY-MAP SCREEN (SCREEN # 8)
      CALL TMGSC(3,8) 
C 
      END 
      BLOCK DATA TMGLC,92080-16451 REV.2026  800414 
C 
C-----LABELED COMMON # 1  GENERAL INFORMATION 
C 
      COMMON /TMGC1/LU,LUPRT,LUOUT,ISYTP,IPARAM(5)
C 
C-----LABELED COMMON # 2  FLAGS 
C 
      COMMON /TMGC2/ITMFL,IRQFLG(30),IMOTR(9),IVASC0(9) 
C 
C-----LABELED COMMON # 3  BUFFER AREA 
C 
      COMMON /TMGC3/IREFC,ILUGH,INTMS,ILPRG,IDECL,ILGMX,NBPRO 
     .             ,NCRTH(2540) 
C 
C-----LABELED COMMON # 4  BUFFER USED IN CREATION PHASE & ERROR FLAG
C                       OR I/O BUFFER USED IN THE INTERACTIVE DEFINITION
C                       PHASE.
C 
      COMMON /TMGC4/IERFL,IERNB,IERTN,IERMS(7),IRLOC(70),ITRSF(20), 
     .              ISWICH(5) 
C 
C-----INITIALIZE LABELED COMMON:
C 
      DATA ISYTP/0/ 
C 
      DATA ITMFL/0/,IRQFLG/30*0/,IMOTR/0,0,1,0,0,2HTM,2HP1,0,0/ 
     .    ,IVASC0/9*0/
C 
      DATA IREFC/100/,ILUGH/128/,INTMS/62/,ILPRG/118/,IDECL/4098/ 
     .    ,ILGMX/1967/,NBPRO/0/ 
C 
      DATA IERFL/0/,IERNB/0/,IERTN/0/,IERMS/7*2H  / 
     .    ,IRLOC/70*0/,ITRSF/20*2H  / 
C 
      END 
      END$
                                                                                                                                                                                      