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$