FTN4
      PROGRAM TMPG0(5),92080-16452 REV.2026  800512         
C 
C 
C     NAME:   TMPG0 
C     SOURCE: &TMG0A     92080-18452
C     RELOC:  %TMG0A     92080-16452
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     *                                                           * 
C     *     THIS IS THE FIRST SEGMENT OF  TMPGN                   * 
C     *                                                           * 
C     *     THIS SEGMENT IS CALL TO ANALYSE THE ANSWER TO THE     * 
C     *     MENU SCREEN OR AT THE END OF EACH TASK TO REQUEST     * 
C     *     THE NEXT ONE.                                         * 
C     *     THIS SEGMENT TAKES CARE ALSO OF ALL FATAL ERRORS.     * 
C     *                                                           * 
C     ************************************************************* 
C 
C 
C     STOP USED:  4 - 5 - 7 - 10 - 11 - 13 - 14 - 15 - 16 - 17 - 20 
C     ----------
C 
C 
C     IRQFLG(30) = NCRTH COMMON STATUS : 0 IF EMPTY, 1 IF FULL
C                  (NOT USED IN TMPGN)
C 
C 
CCB1
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
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
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 
C 
CCB4
CCB4
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 
C*********************************************************************
CCB4
C 
C 
C 
      DIMENSION NAME(3),IREG(2),IDCB(144),FNAME(3)
      DIMENSION ITMP(3),IRSET(8),IPRES(26)
      DIMENSION ICRTH(5),ISTAT(7) 
C 
C-----ICRTH IS USED AS A TEMPORARY HOLDING AREA FOR NCRTH(13-17). 
C     THIS IS DONE BECAUSE ALTHOUGH EACH INDIVIDUAL ELEMENT OF THE LOG
C     NAMR/LU (NCRTH(13-17)) GETS EDITED SEPERATELY, THE NAMR NEEDS 
C     TO BE MOVED INTO PLACE AS A WHOLE AND NOT BY PIECES. AFTER ALL
C     EDITS ARE COMPLETED, ICRTH(1-5) GOES TO NCRTH(13-17). 
C     ISTAT IS A BUFFER USED BY THE VFLOG CALL TO CHECK THE 
C     STATUS OF DCLOG AND ITS NAMR/LU IF ONE IS AROUND. 
C 
      INTEGER FNAME,OPEN,PURGE,AREG,BREG,FTYPE
      EQUIVALENCE (REG,IREG,AREG),(IREG(2),BREG)
C 
      LOGICAL JPAR,KPAR,ISBTW,OKABT,GETBK,OKABT,CMPB,NAMCK,CMPW 
      LOGICAL READF,WRITF,CREAT,RWNDF,DORMT 
C 
      DATA IRSET/15530B,15555B,15446B,2Hk0,2HB ,15542B,15510B,15512B/ 
      DATA IPRES/15542B,6412B,6412B,15446B,2Ha+,2H47,2HC ,15446B
     .,2HdJ,2HPr,2Hes,2Hs ,15446B,2HdK,2HNE,2HXT,2H S,2HCR,2HEE 
     .,2HN ,15446B,2HdJ,2Hke,74433B,2H&d,2H@ /
      DATA FNAME/2H& ,2H  ,2H  /
      DATA FTYPE/31/
D     DATA LUOXXX/40/ 
      DATA MAXCOP/2/
C 
      KPAR(IP1,IP2,IP3)=JPAR(IRLOC,LENSC0,IDXX,IP1,IP2,IFLG,IP3)
C 
C-----TERMINATE  TMPGN ?
C 
D     WRITE(LUOXXX,9877)ISYTP,ISCRN,IOFST,IEND,IJOB 
D9877 FORMAT(2/" $OPSY="I3",  SCREEN# ="I2",  IOFST="I5",  IEND="I4,
D    .",  IJOB="I4) 
C 
      IF(IEND .EQ. 2)  GOTO 9900
C 
C-----SYSTEM TYPE OK ?  (RTE-IV ONLY) 
C 
      IF(ISYTP.NE.-9)  GOTO 9900
C 
C     JOB ? 
C 
      IF(IJOB.EQ.2) GOTO 300
      IF(IJOB.EQ.4) GOTO 270
C 
C-----ANALYSE SFK OR MENU SCREEN (#8 OR #6 OR #7) 
C 
      IDXX=1
      NERR=-IEND
      IF(NERR .EQ. 0)  GOTO 10
C 
5     CALL TMPGE(NERR,IDXX,IASC(IGET(1653B))) 
C 
C-----GET DATA FROM THE 2645/2648 TERMINAL
C 
10    LENSC0=0
      IF(ISCRN .EQ. 6)  LENSC0=27 
      IF(ISCRN .EQ. 7)  LENSC0=22 
      IF(ISCRN .EQ. 8)  LENSC0=2
      IF(LENSC0 .EQ. 0)  STOP 0004
C-----IF GET FAIL, RE-ISSUE THE SCREEN (MENU) 
      IF( GETBK(LU,IRLOC,LENSC0) )  GOTO 198
C 
C     IMOTR(1) = TMPGN FUNCTION 
C     IMOTR(2) = LOAD OPTION
C     IMOTR(3) = PRINT LOAD MAP (0 DO NOT PRINT)
C     IMOTR(4) =
C     IMOTR(5) =
C     IMOTR(6) = APPLICATION NAME 
C     IMOTR(8) = SECURITY CODE  (ALWAYS 0)
C     IMOTR(9) = CARTRIDGE #
C 
C-----ANALYSE USER'S ANSWER 
C 
      IF(ISCRN .EQ. 8)  GOTO 60 
      IEND=0
      IF( ISCRN .EQ. 6 )  GOTO 40 
C 
C-----MODIFICATION OF THE TMP IS PERFORMED, FUNCTION SELECTED ? 
C 
      IMOTR=0 
      IDXX=1
      IF(KPAR(ITMP,1,JVAL)) GOTO 195
      NERR=1
      IF(IFLG.NE.3) GOTO 5
      IF(ITMP .EQ. 2HM ) IMOTR=1
      IF(ITMP .EQ. 2HT ) IMOTR=2
      IF(ITMP .EQ. 2HU ) IMOTR=4
      IF(ITMP .EQ. 2HL ) IMOTR=6
      IF(ITMP .EQ. 2HK ) IMOTR=7
      IF(ITMP .EQ. 2HI ) IMOTR=8
      IF(IMOTR .EQ. 0)  GOTO 5
      IVASC0(3)=ITMP
      IF(IMOTR .EQ. 6) GO TO 278
      GOTO 56 
C 
C-----CREATION OF A NEW TMP IS PERFORMED, 
C     INITIALIZE  NCRTH  IN PACKED FORMAT WITH BLANK OR 0 
C 
40    CONTINUE
C 
C========================================= SPECIAL TMPGN
C 
C     SET UP SYSTEM MODULE:  ZTMP, TSE, STORA, STORB, TSMG
C     INTO 2 USER PARTITION 
C 
C     UPT 1:  ZTMP, TSE, STORA, STORB 
C             NO PARTITION SIZE, NO PARTITION ASSIG.
C 
C     UPT 2:  TSMG
C             PARTITION SIZE, NO PARTITION ASSIG. 
C 
C 
      K=6 
C 
C-----FIXED PART INITIALISATION 
C 
      CALL MOVEW(IMOTR(6),NCRTH(5),4) 
      CALL NUL(NCRTH(9),9)
      CALL MOVEW(14HZTMP    TSE   ,NCRTH(18),7) 
      NCRTH(21)=67
      NCRTH(25)=0 
      CALL NUL(NCRTH(26),74)
      CALL MOVEW(20HTMP REV.2026        ,NCRTH(87),10)
C 
C     INTERACTIVE AND AUXILIARY LU
C     (1 DUMMY INTERACTIVE DEVICE & 3 AUXILIARY DEVICES)
C 
      I=IREFC 
      NCRTH(2)=I
      NCRTH(I)=00 
      NCRTH(I+1)=0
      I=I+2 
      NCRTH(3)=I
      NCRTH(I)=LU 
      NCRTH(I+1)=2645 
      NCRTH(I+2)=2
      NCRTH(I+3)=7905 
      NCRTH(I+4)=3
      NCRTH(I+5)=7905 
      I=I+6 
      NCRTH(4)=I
C 
C-----PROGRAMS
C 
      NCRTH(I+1)=0
      NCRTH(I+2)=0
      CALL MOVEW(24HTSE   STORA STORB IOM70 ,NCRTH(I+3),12) 
      NCRTH(I)=I+15 
      I=NCRTH(I)
      NCRTH(I+1)=0
      NCRTH(I+2)=0
      CALL MOVEW(6HTSMG  ,NCRTH(I+3),3) 
      NCRTH(I)=I+6
      I=NCRTH(I)
      NCRTH(I+1)=0
      NCRTH(I+2)=0
      CALL MOVEW(18HZTMP  OFLPO IOM75 ,NCRTH(I+3),9)
      NCRTH(I)=I+12 
      NCRTH=NCRTH(I)-1
C 
C========================================= END SPECIAL TMPGN
C 
C-----CREATION OF A NEW TMP, GET THE CR#
C 
      IMOTR=1 
      IDXX=1
      IF(KPAR(ITMP,6,IMOTR(9))) GOTO 195
      IF(IFLG .EQ. 0)  GOTO 55
      NERR=5
      IF(IFLG .NE. 3)  GOTO 52
      IF(ISUPB(ITMP,3) .NE. 1)  GOTO 5
      IF(ISBTW(IGETB(ITMP,1),101B,132B))GO TO 5 
      IF(ISBTW(IGETB(ITMP,2),101B,132B).AND.ISBTW(IGETB(ITMP,2),
     .        60B,71B).AND.IGETB(ITMP,2).NE.40B)GO TO 5 
      IMOTR(9)=ITMP 
      GOTO 54 
52    IF(IFLG.NE.1) GOTO 5
      IF(IMOTR(9).LT.0)GO TO 5
      IF(IMOTR(9) .EQ. 100000B)  GOTO 5 
C 
C-----CARTRIDGE MOUNTED ? 
C 
54    NERR=35 
      IF(ICRLU(IMOTR(9)) .LT. 0) GOTO 5 
55    NCRTH(8)=IMOTR(9) 
C 
C-----GET THE LOGGING LU #
C 
56    IDXX=2
      JVAL=0
      IF( KPAR(ITMP,6,JVAL) )  GOTO 195 
      CALL JUSTF(ITMP,1,6,1)
      IFLG1=IFLG
      IF(IFLG.EQ.0) GO TO 58
      NERR=2
      IF(IFLG.NE.1 .AND. IFLG.NE.3) GO TO 5 
      IF(IFLG.EQ.3) GO TO 57
      NERR=44 
      IF(ISBTW(JVAL,1,IGET(1653B)) )  GOTO 5
      NERR=9
      IEQT=IAND(IGET(IGET(1652B)+JVAL-1),77B) 
      IF(IEQT .EQ. 0)  GOTO 5 
      IF(IAND(IGET(IGET(1650B)+((IEQT-1)*15)+4),37400B)/256 
     .   .NE. 23B)  GOTO 5
58    ICRTH(1)=JVAL 
      ICRTH(2)=0
      ICRTH(3)=0
      GO TO 59
57    NERR=45 
      IF(NAMCK(ITMP)) GO TO 5 
      CALL MOVEW(ITMP,ICRTH(1),3) 
C 
C  GET SECURITY CODE
C 
59    IDXX=3
      ICRTH(4)=0
      IF(KPAR(ITMP,6,JVAL)) GO TO 195 
      NERR=46 
      IF(IFLG.NE.0 .AND. IFLG1.NE.3) GO TO 5
      NERR=6
      IF(IFLG.NE.0.AND.IFLG.NE.1.AND.IFLG.NE.3) GO TO 5 
      IF(IFLG.NE.3) GO TO 590 
      IF(ISUPB(ITMP,3).NE.1) GO TO 5
C     THIS WILL ALLOW FOR ONLY 2 CHARACTER ALPHABETIC S. C. 
      IF(ISBTW(ITMP,2HAA,2HZZ))GO TO 5
      ICRTH(4)=ITMP 
      GO TO 594 
590   IF(JVAL.EQ.-32768) GO TO 5
      ICRTH(4)=JVAL 
C 
C  CARTRIDGE REFERENCE NUMBER 
C 
594   IDXX=4
      ICRTH(5)=0
      IF(KPAR(ITMP,6,JVAL)) GO TO 195 
      NERR=46 
      IF(IFLG.NE.0 .AND. IFLG1.NE.3) GO TO 5
      IF(IFLG.EQ.0) GO TO 593 
      IF(IFLG.NE.1) GO TO 591 
      NERR=5
      IF(JVAL.LT.1) GO TO 5 
      GO TO 592 
C  ASCII? 
591   NERR=5
      IF(IFLG.NE.3) GO TO 5 
      CALL JUSTF(ITMP,1,6,1)
      IF(LNCAR(ITMP,1,6).GT.2) GO TO 5
      IF(ISBTW(IGET1(ITMP,1),1HA,1HZ)) GO TO 5
      IHOLD=IGET1(ITMP,2) 
      IF(ISBTW(IHOLD,1HA,1HZ).AND.ISBTW(IHOLD,1H0,1H9).AND. 
     . ISBTW(1,1H ,1H )) GO TO 5
      CALL MOVEW(ITMP,ICRTH(5),1) 
      GO TO 593 
592   ICRTH(5)=JVAL 
C 
C     CARTRIDGE MOUNTED?
C 
593   NERR=35 
      IF (ICRTH(5).EQ.0) GO TO 595
      IF(ICRLU(ICRTH(5)).LT.0) GO TO 5
C 
C-----CHECK FOR VALIDITY OF DCLOG NAMR/LU 
C     IF A LIST OR PURGE IS BEING DONE,SKIP CHECK 
C 
595   IF(IMOTR.EQ.6.) GO TO 200 
      IF(ICRTH(1).EQ.0) GO TO 596 
      IDXX=2
      NERR=47 
      CALL VFLOG(ICRTH,ISTAT) 
      IF(ISTAT(1).EQ.950) GO TO 5 
596   IDXX=1
      NERR=48 
      IF((.NOT.CMPW(ICRTH(1),NCRTH(13),5)).AND. 
     .(IMOTR.NE.1.AND.IMOTR.NE.8.AND.IMOTR.NE.7)) GO TO 5 
      CALL MOVEW(ICRTH(1),NCRTH(13),5)
      GO TO 200 
C 
C-----ANALYSE KEY MAP SCREEN
C     VERIFY THAT THE TMP IS NOT CURRENTTLY RUNNING 
C     TRY TO OPEN THE FILE TO KNOW IF IT IS A CREATE/MODIFY REQUEST 
C 
60    IF(IEND.NE.0 .AND. IEND.NE.-33)  GOTO 9900
      IEND=0
      CALL MOVEW(IMOTR(6),ITMP,2) 
      ITMP(3)=2H
      NERR=4
      IF( .NOT. DORMT(ITMP))  GOTO 97 
      IDXX=1
      IF( KPAR(ITMP,1,JVAL) .AND. IFLG.EQ.9)  GOTO 197
      IF(IFLG .NE. 0)  GOTO 198 
      IMOTR(9)=0
      CALL MOVCA(IMOTR,11,FNAME,2,4)
      IF(OPEN(IDCB,IERR,FNAME,3,IMOTR(8),IMOTR(9)).GE.0) GOTO 65
C-----IF FILE DOESNT EXIT, INIT NCRTH & CREATE TE NEW TMP 
      IF( IERR .NE. -6 )  GOTO 64 
C 
C-----THE FILE DOESNT EXIST, IT IS A CREATION 
C 
      ISCRN=6 
      CALL NUL(IVASC0,2)
      IVASC0(3)=2H
      GOTO 198
C 
C-----THE FILE EXIST, VERIFY IF IT IS A GOOD ONE
C 
64    NERR=6
      IF(IERR.EQ.-7) GOTO 97
      STOP 0005 
C 
65    NERR=38 
      IF(IERR .NE. FTYPE) GOTO 95 
C 
C-----READ FILE INTO NCRTH
C 
      I=1 
80    IF(READF(IDCB,IERR,NCRTH(I),200,LEN)) STOP 0007 
      I=I+LEN 
      IF(LEN .NE. -1)  GOTO 80
C 
C-----CHECK THAT THE FILE IS OK 
C 
      IF(NCRTH .NE. I) GOTO 95
      IF(NCRTH(8) .EQ. 0)  NCRTH(8)=ICRLU(-IAND(IDCB,77B))
      IF(IMOTR(9) .LE. 0)  IMOTR(9)=NCRTH(8)
      IF(NCRTH(8) .NE. IMOTR(9))  GOTO 95 
C 
C-----OK, WRITE IT BACK TO CHECK NOW THE SECURITY CODE
C 
      IF(RWNDF(IDCB,IERR)) STOP 0010
      NERR=6
      I=NCRTH/128 
      LEN=128 
      IF(I.EQ.0) LEN=NCRTH
      IF( .NOT. WRITF(IDCB,IERR,NCRTH,LEN) ) GOTO 85
      IF(IERR.EQ.-7) GOTO 95
      CALL CLOSE(IDCB)
      STOP 0011 
85    CALL CLOSE(IDCB)
C-----INIT FLAG TO NOT PREPARE AND NOT LOAD ANY PROGRAM 
      DO 88 I=1,28
88    IRQFLG(I)=0 
C 
C-----SINCE THE FILE EXIST AND IS CORRECT, IT IS A MODIFY 
C 
      ISCRN=7 
      IVASC0=NCRTH(8) 
      IVASC0(2)=NCRTH(13) 
      IVASC0(3)=2H
C 
C     THE LOGGING NAMR IS BEING PUT INTO IVASC0(4-8) FOR PRINTING 
C      BACK TO THE SCREEN IN A MODIFY MODE. 
C 
      DO 89 IJK=4,8 
89    IVASC0(IJK)=NCRTH(IJK+9)
      GOTO 198
C 
C-----ERROR ON THE FILE ALREADY OPEN, CLOSE IT AND REPORT ERROR 
C 
95    CALL CLOSE(IDCB)
C-----OUTPUT/RE-OUTPUT SCREEN, PRINT THE ERROR MESSAGE AND THEN READ
97    CALL TMGSC(3,ISCRN,0,-NERR) 
C 
C-----SPECIAL CHARACTER FROM THE 2645/2648
C     PREVIOUS SCREEN OR ABORT ?
C 
195   NERR=33 
      IF(IFLG .EQ. 8)  GOTO 97
      NERR=34 
      IF(IFLG .NE. 9)  GOTO 5 
C 
C-----USER WANTS TO ABORT ? 
C 
197   IF(OKABT(LU))  GOTO 9900
C 
C-----IT IS NOT ABORT REQUEST, RE-ISSUE THE SCREEN
C 
198   CALL TMGSC(3,ISCRN) 
C 
C*********************************************************************
C 
C 
C-----PROCESS THE REQUESTED FUNCTION
C 
200   IVASC0=NCRTH(8) 
      IVASC0(2)=NCRTH(13) 
      IVASC0(9)=ISCRN 
C 
C     MOVE IN THE LOGGING NAMR INTO TMGC2 FOR PRINTING TO SCREEN
C 
      DO 201 IJK=4,8
201   IVASC0(IJK)=NCRTH(9+IJK)
C 
C-----SET-UP SEGMENTS' PARAMETERS 
C 
      ISEGNB=5
      IRQ=0 
      IJOB=0
C 
C     *****     LIST ?
C 
      IF(IMOTR .EQ. 6)  GOTO 278
C 
C     *****     PURGE ? 
C 
      IF(IMOTR .NE. 7)  GOTO 210
      IVASC0(2)=0 
      IVASC0(9)=6 
      IEND=3
      GOTO 238
C 
C     *****     MODIFY LU ? 
C 
210   IF(IMOTR .EQ. 2)  GOTO 223
C 
C     *****     MODIFY / CREATE REQUEST ? 
C 
      IF(IMOTR .NE. 1)  GOTO 215
      K=2 
213   DO 218 I=K,28 
218   IRQFLG(I)=1 
      GOTO 223
C 
C     *****     DEFINE USER WRITTEN MODULES ? 
C 
215   IF(IMOTR .NE. 4) GOTO 220 
      IJOB=3
      K=5 
      GOTO 213
C 
C     *****     MODIFY MAIN PROGRAM ? 
C 
220   IF(IMOTR .NE. 3) GOTO 227 
223   IRQFLG=1
      NBPRO=NBUPT(NCRTH)
      CALL DEPAK
C-----EDITING PROCESSING, CALL SEG # 5 OR 4,
C     (LU & PRG.  OR  DATA-BASE & MAIN / RELOAD SOME PARTITION) 
      CALL TMGSC(ISEGNB,0,0,0,IJOB) 
C 
C     *****     MODIFY DATA-BASE DEFINITON ?
C 
227   IF(IMOTR .NE. 8)  GOTO 230
      ISEGNB=4
      IRQFLG(2)=1 
      GOTO 223
C 
C     *****     PREPARE AND LOAD ALL THE APPLICATION ?
C 
230   IF(IMOTR .NE. 5)  STOP 0013 
      DO 232 I=1,28 
232   IRQFLG(I)=1 
C-----CALL PREP. MODULE 
C     (STOP THE APPLT., PREP. FILES AND LOAD AS REQUESTED)
235   IF(IMOTR(2) .EQ. 1)  GOTO 900 
      IRQ=1 
238   CALL TMGSC(2,IRQ,0,IEND,4)
C 
C-----RETURN FROM THE COMPILER, THE LISTING, THE PURGE OR 
C     THE LOAD OPERATION. 
C 
270   IF(IEND .EQ. -1)  GOTO 420
      IF(IEND .EQ. -2)  GOTO 280
      IF(IEND .EQ.  1)  GOTO 900
      IF(IEND .NE.  0)  GOTO 450
C-----PREP. WAS OK, LOAD PROGRAMS.
      IRQ=1 
278   CALL TMGSC(1,IRQ,0,0,4) 
C-----LOAD HAS FAIL, STOP TMPGN OPERATION 
280   CALL MOVEW(16H Loading ERROR  ,IRLOC,8) 
      CALL MOVEW(IERMS(3),IRLOC(9),2) 
      CALL MOVEW(16H, Program       ,IRLOC(11),8) 
      CALL MOVEW(IERMS(5),IRLOC(16),3)
      CALL MOVEW(22H has not been loaded. ,IRLOC(19),11)
      IRLOC(30)=6412B 
      CALL BLANC(IRLOC(31),8) 
      GOTO 440
C 
C-----RETURN FROM THE INTERACTIVE EDITING PROCESSING, 
C     FUNCTION MUST BE 1,2,3,4 OR 8 AND IEND=1 TO BE THE END
C     (REPACK, WRITE THE FILE AND LOAD IF NEEDED) 
C 
300   IF( IEND .NE. 1 )   STOP 0014 
      IF(IMOTR.NE.1 .AND. IMOTR.NE.2 .AND. IMOTR.NE.3 
     .  .AND. IMOTR.NE.4 .AND. IMOTR.NE.8 )  STOP 0015
      CALL REPAK
      CALL MOVCA(NCRTH,9,FNAME,2,4) 
C 
C========================================= SPECIAL TMPGN
C 
C     SETUP PARTITION SIZE FOR ALL SYSTEM MODULE
C 
C     MAIN = CODE SIZE + BUFFER + EMA 
C 
      ICODZ=7 
      CALL MADSP(ITMP)
      N=(NCRTH(4)-NCRTH(2))/2 
C-----EMA SIZE = 2.2 * N + ( N ** 2 ) / 75. 
C     MINIMUM IS 5
      I= 2.2*N+(N*N)/75. + .5 
      IF(I .LT. 5)  I=5 
C-----MSEG SIZE = 3 + EMA / 50
      J=3+I/50+.5 
C-----BUFFER SIZE IN WORDS = ( STACKLEN + 200 ) * N 
      K= (NCRTH(21)+200)*N
C-----CHECK THAT MAXIMUM ADDR SPACE IS OK 
C     CODE SIZE + BUFFER + MSEG + 1  = <  MAX ADDR. SPACE 
      K= ICODZ + 1.5 + K/1024.
      IF(K+J+1 .GT. ITMP(2))  K=ITMP(2)-J-1 
C-----SET EMA SIZE AND MSEG SIZE
      NCRTH(9)=I
      NCRTH(10)=J 
C-----SET PARTITION SIZE = CODE + BUFFER
      NCRTH(11)=K 
C 
C     TMP.B = 5K  +  .350 * NUMBER OF TRANS. SPEC.
C 
      X=5.+.35*25.
      I=NCRTH(NCRTH(4)) 
      NCRTH(I+1)=IFIX(X)+1
C 
C     IMAGE = CODE SIZE + LOCK TABLE + ROOT FILE + IMAGE DCB
C                15 K   + LCKTB SIZE +           9K 
C 
      IF(NCRTH(26) .EQ. 0)  GOTO 340
      J=27
      DO 320 I=1,NCRTH(26)
      NCRTH(J+12)=(15360.+FLOAT(NCRTH(J+14))+9216.)/1024. 
320   J=J+15
C 
C-----REINIT THE CRT AUXILIARY LU TO THE CRT USED BY TMPGN
C 
340   NCRTH(NCRTH(3))=LU
C 
C-----IF TMP # 1, SET SYSTEM COMMON FLAG FOR ALL UPT
C 
      IF( NCRTH(6) .NE. 2HP1 )  GOTO 360
      J=NCRTH(4)
  350 CALL SETBT(NCRTH(J+2),15,1) 
      J=NCRTH(J)
      IF(J .NE. NCRTH+1)  GOTO 350
  360 CONTINUE
C 
C========================================= END SPECIAL TMPGN
C 
      IF(OPEN(IDCB,IERR,FNAME,1,NCRTH(7),NCRTH(8)).EQ.31) GOTO 303
      IF(IERR.NE.-006) STOP 0015
      IF(CREAT(IDCB,IERR,FNAME,2,FTYPE,NCRTH(7),NCRTH(8))) GOTO 400 
303   I=NCRTH/128 
      IF(I.EQ.0) GOTO 309 
      DO 307 K=1,I
      IF(WRITF(IDCB,IERR,NCRTH((128*K)-127),128)) STOP 0016 
307   CONTINUE
309   LEN=(NCRTH)-(128*I) 
      IF(WRITF(IDCB,IERR,NCRTH((128*(I+1))-127),LEN)) STOP 0017 
      IF(WRITF(IDCB,IERR,NCRTH,-1)) STOP 0020 
      CALL CLOSE(IDCB)
C-----RE-INIT  SCREEN DATA & IMOTR  WITH  &XXXX:SC:CR  FROM NCRTH 
      IVASC0(9)=7 
      CALL MOVEW(NCRTH(5),IMOTR(6),4) 
      IF(IMOTR.NE.1 .AND. IMOTR.NE.4)  GOTO 316 
C-----IF THE NUMBER OF PROGRAM HAS DECREASE, CLEAN UP UNUSED MODULE 
      IF(NBPRO .EQ. 0)  GOTO 316
      IF(NBPRO .LE. NBUPT(NCRTH))  GOTO 316 
      CALL MOVEW(IRSET,IRLOC,8) 
      CALL MOVEW(26H Clean up unused modules. ,IRLOC(9),13) 
      CALL EXEC(2,LU,IRLOC,21)
      IRQ=2 
      IEND=4
      GOTO 238
316   NBPRO=NBUPT(NCRTH)
C-----ANY PROGRAM TO PREPARE AND LOAD ? 
      DO 318 I=1,28 
      IF(IRQFLG(I) .NE. 0)  GOTO 235
318   CONTINUE
C-----GO BACK TO SCREEN # 0  (MENU) 
      GOTO 900
C 
C-----NO ROOM ON THE CARTRIDGE !! 
C 
400   CALL MOVEW(FNAME,IRLOC(24),3) 
      CALL MOVEW(IRSET,IRLOC,8) 
      GOTO 430
420   CALL MOVEW(IERMS,IRLOC(20),7) 
      CALL BLANC(IRLOC,7) 
      IRLOC(8)=6412B
      IF(IERNB .EQ. -6)  GOTO 430 
C 
C-----FATAL FMP ERROR DURING CREATION PHASE 
C 
      CALL MOVEW(22H  Illegal file type on,IRLOC(9),11) 
      IF(IERNB .GT. 0)  GOTO 427
      CALL MOVEW(22H FMP ERROR # XXXXXX on,IRLOC(9),11) 
      CALL JASC(IERNB,IRLOC(15),1,7)
427   CALL MOVEW(22H !!                   ,IRLOC(27),11)
      GOTO 438
430   CALL MOVEW(14H NO ROOM on CR,IRLOC(9),7)
      CALL CNUMD(NCRTH(8),IRLOC(16))
      CALL MOVEW(10H ,  file: ,IRLOC(19),5) 
      CALL MOVEW(22H has not been created.,IRLOC(27),11)
438   IRLOC(38)=6412B 
440   IRLOC(39)=6412B 
      CALL MOVEW(30H generation is NOT completed, ,IRLOC(40),15)
      CALL MOVEW(32Hcorrective action MUST be taken.,IRLOC(55),16)
      CALL EXEC(2,LU,IRLOC,70)
      IEND=0
C-----WAIT ACKNOWLEDGMENT FROM THE OPERATOR 
450   CALL EXEC(2,LU,IPRES,26)
      REG= EXEC(1,LU,I,1) 
      IF(IEND .EQ. 4)  GOTO 316 
      ISCRN=IVASC0(9) 
      IF(BREG.EQ.1 .AND. IGET1(I,1).EQ.60440B)  GOTO 197
      GOTO 900
C 
C     END TMPGN 
C 
900   CONTINUE
9900  CALL MOVEW(IRSET,IRLOC,8) 
      CALL MOVEW(14H /TMPGN: $END ,IRLOC(9),7)
      CALL PNAME(IRLOC(10)) 
      IRLOC(12)=IOR(IRLOC(12),72B)
      CALL EXEC(2,LU,IRLOC,8) 
C 
C --- RESET THE STRAP AND LATCH SETTINGS
C 
      CALL RESET(LU,ISWICH,IVAL,0)
C 
C --- UNLOCK THE TERMINAL LU TO ALLOW DCMON IN
C 
      CALL LURQ(100000B,LU,1) 
      GO TO 7373
7373  CONTINUE
C 
C-----TRY TO SCHEDULE 'DCMON',  ATTENTION TO ABORT RETURN 
      CALL EXEC(100000B+23,6HDCMON ,LU,0,0,0,0) 
      GOTO 9920 
9918  GOTO 9950 
C-----DCMON NOT LOADED, PRINT "/TMPGN: $END"
9920  CALL EXEC(2,LU,IRLOC(9),7)
C 
C-----RELEASE TRACKS
C 
9950  CALL EXEC(5,-1) 
C 
C-----TERMINATE PROGRAM 
C 
      CALL EXEC(6)
C     DUMMY CALL TO MAIN !! 
      CALL TMPGN
      END 
      END$
                                