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$