C SEGSUB.FTN,SEGSRC,CEH-LSS-KJC-PMP, 12/11/80
C Fortran subroutines OPENT$ and IOIT for SEG
C Copyright (c) 1981, Prime Computer, Inc., Natick, MA 01760
C
C      OPENT$ - ROUTINE TO OPEN A FILE FOR READING AND REMEMBER WHAT IT WAS
C
C    CALLING SEQUENCE:  IVARIB=OPENT$(IOCMD,NAME,NAMLNT,IALTRN)
C    WHERE:  IOCMD IS THE COMMAND TO BE USED FOR TSRC$$
C            NAME IS THE USER SUPPLIED NAME - IF ANY
C            NAMLNT - IS ITS LENGTH
C            IALTRN IS AN ALTERNATE RETURN (OPTIONAL)
C
C    UPON RETURN OPENT$ RETURNS:
C          -1 - A NEW, UNINITIALIZED FILE OPEN FOR WRITING OR READ/WRITE
C          0 - THE PREVIOUSLY OPENED FILE
C          1 - A NEW BUT PREVIOUSLY EXISTING SEGMENT DIRECTORY
C
C    INTERNALLY OPENT$ MAINTAINS TW0 FLAGS:
C
C    IFLAG:  =0 - OPENT$ HAS SUPPLIED THE LAST USED NAME
C            =1 - USER HAS SUPPLIED THE LAST USED NAME
C
C    JFLAG:  =0 - OPENT$ DOES NOT KNOW ABOUT ANY FILE
C             1 - OPENT$ HAS A FILE OPEN
C
C     MODIFICATION HISTORY
C
C DATE      PROGRAMMER MODIFICATION
C 07/20/82  D M KOCH   ADDED SPEED-UP MODS.
C 07/15/82  D M KOCH   RETURNED NAME TO USER IF WE GET IT. ADDED MOD HISTORY.
C
       INTEGER FUNCTION OPENT$(IOCMD,NAME,NAMLNT,IALTRN)
       INTEGER NAME(64),ONAME(64),IALTRN,IFLAG,JFLAG,CPV(2),ERRSEV
       INTEGER IERROR,I,IARG,CODE,INFO(8),COUNT
       INTEGER ONALEN
       COMMON/MONAME/ONALEN,ONAME
       COMMON/ERRSEV/ERRSEV
       LOGICAL NAMEQ$,TEMP$S
       INTEGER REALNM
$INSERT SYSCOM>ERRD.INS.FTN
$INSERT SYSCOM>KEYS.INS.FTN
$INSERT AUCOM.INS.FTN
C
$INSERT LODCOM.INS.FTN
       DATA CPV/0,40/,IFLAG/0/,JFLAG/0/
C
       IALTRN = 0
       TMPLNT =6
       IF(NAME(1).EQ.'* ') GO TO 200
       IF (AUFLAG .EQ. 1) GO TO 40
       IF (IOCMD .EQ. K$CLOS) GO TO 62
       IF(NAME(1).EQ.'  ') GO TO 100
       IF(NAME(1).EQ.'! ') GO TO 110    /*WANTS NEW TREE NAME
       IF(IFLAG.EQ.0) GO TO 50
       IF(.NOT.NAMEQ$(ONAME,CPV(2),NAME,NAMLNT)) GO TO 50
       IF(JFLAG.EQ.0) GO TO 120        /*MAY HAVE BEEN DELETED
       GO TO 45
40     IF (TEMP$S(K$NSGS+K$RDWR+K$GETU,TMPNAM,TMPLNT,SEGDIR))   /* MODIFIED TEMP$A TO OPEN
     X        GO TO 10010                        /* TEMP SEG FILES.
       COUNT =(TMPLNT+1)/2
       DO 42 I=1,COUNT
       NAME(I) = TMPNAM(I)
42     CONTINUE
       NAMLNT=TMPLNT
       CPV(2) = NAMLNT
       IFLAG =0
       OPENT$ =-1
       GO TO 60
45     OPENT$=0
60     CALL SGDR$$(K$SPOS,SEGDIR,0,IERROR,CODE)   /*REWIND SEGDIR
       IF(CODE.NE.0) GO TO 10000
       IF(IOCMD.EQ.K$DELE) GO TO 62
       CALL SRCH$$(K$ISEG+IOCMD+K$GETU,SEGDIR,0,SGUNIT,IERROR,CODE)
       IF(CODE.NE.0) GO TO 10000
       CALL SRCH$$(K$CACC+IOCMD,0,0,SEGDIR,IARG,CODE)  /*APPEASE USERS
       IF(CODE.NE.0) GO TO 10000
       JFLAG=1
61     CALL ATCH$$(K$HOME,0,0,0,0,CODE)
       IF(CODE.NE.0) GO TO 10000
       RETURN
C
62     JFLAG=0
       CODE = REALNM(IOCMD,ONAME,CPV(2),SEGDIR)
       IF(CODE.NE.0) GO TO 10000
       GO TO 61
C
50     IFLAG=(NAMLNT+1)/2 /*USER HAS SUPPLIED NAME
       CPV(2)=NAMLNT              /*AND HIS OWN NAME LENGTH
       ONALEN = NAMLNT         /* FOR MODIFY SUBPROCESSOR (SEE SEGMNT $4000)
       DO 70 I=1,IFLAG         /*TELL ONAME ABOUT IT
       ONAME(I) = NAME(I)
70     CONTINUE
       GO TO 120
C
100    IF(JFLAG.EQ.1) GO TO 45
110    CALL TNOUA('SAVE FILE TREE NAME: ',21)
       IFLAG=0                 /*WE SUPPLIED NAME
       CALL COMANL
       CALL RDTK$$(4,INFO,ONAME,20,CODE)
       CPV(2)=INFO(2)        /* GET THE REAL LENGTH IN CHARS.
       ONALEN=INFO(2)
120    CODE = REALNM(K$READ+K$NSGS+K$GETU,ONAME,CPV(2), SEGDIR) /* GET THE REAL SEG DIR NAME
                                         /* FROM SRSFX$ AND OPEN FILE
       IF (CODE.NE.0) GO TO 500
       OPENT$=1
       GO TO 60
C
200    IF(JFLAG.NE.0) GO TO 45
       CALL TNOUA('FILE NOT OPEN',13)
       CALL TONL
       GO TO 10010
C
500    IF(IOCMD.EQ.K$READ) GO TO 10000
       IF(CODE.NE.E$FNTF) GO TO 10000
       CPV(1) =0
       CALL TSRC$$(K$NSGS+K$GETU+K$WRIT,ONAME,SEGDIR,CPV,IARG,CODE)
       IF (CODE.NE.0) GO TO 10000
       OPENT$=-1
       GO TO 60
C
10000  CALL ERRPR$(K$IRTN,CODE,0,0,'OPENT$',6)
       CALL SS$ERR
       ERRSEV =-1
10010  CALL ATCH$$(K$HOME,0,0,0,0,CODE)
       IFLAG=0
       JFLAG=0
       IALTRN = 1
       OPENT$ = 0
       RETURN
C
       END
C      IOIT - ROUTINE TO READ OR WRITE ALL THE SEGMENTS ASSOCIATED WITH A
C      RUN FILE.
C
C      CALLING SEQUENCE:  CALL IOIT(NUM)
C
C      WHERE: NUM IS 1 FOR READ OR 2 FOR WRITE
C
       SUBROUTINE IOIT(NUM)
C
       INTEGER I,J,K,NUM,ISEGS(2),START,END
       INTEGER IT
C
C      LODCOM.INS.FTN IS LISTED IN OPENT$
       NOLIST
$INSERT LODCOM.INS.FTN
       LIST
$INSERT SYSCOM>KEYS.INS.FTN
C
       CALL INITNE(POINT1,:21,0)       /*POINT AT SEGMENT SYM TABLE
50     IF(NEXT(POINT1).EQ.0) RETURN    /*DONE
       IF(MAP1(P1SUBS+A$SEGM).LT.:4000) GO TO 50 /*SEGMENT TOOLOW
       IF(MAP1(P1SUBS).GT.0) GO TO 50 /*NOTHING THERE
       IF(NUM.EQ.K$WRIT) GO TO 110
C
C      ZERO USED PART OF SEGMNT
C
C       CALL SET0(MAP1(P1SUBS+A$SEGM))  /*NEED THE HELP OF PMA HERE
       GO TO 120
C
C      EXTEND SEGDIR IF NECESSARY
C
110    CALL SGDR$$(K$MSIZ,SEGDIR,(AND(MAP1(P1SUBS),:777)+1)*32+1,IT,I)
C
120    IT=AND(MAP1(P1SUBS),:777)*32   /*POSITION IN BUFCTL ETC.
       ISEGS(1)=MAP1(P1SUBS+A$SEGM)    /*SET UP SEGMENT NUMBER FOR PRWIT
       DO 200 K=1,32             /*NOW LOAD CODE
       I=MOD(IT,16)+1                  /*BIT
       J=RS(IT,4)+1                    /*WORD
       IT=IT+1
       IF(AND(BUFCTL(J),BITMSK(I)).EQ.0) GO TO 130   /*NOTHING TO LOAD
       ISEGS(2)=(K-1)*:4000            /*COMPUTE ADDRESS IN SEGMENT
       CALL SEGPRW(NUM,ISEGS,IT)    /*TRANSFER INFO WITH HELP OF PMA
       GOTO 200
C
C NOTHING TO LOAD.  IF THIS IS A READ OPERATION, ZERO OUT THE
C RANGE OF MEMORY
C
130    IF (NUM .EQ. K$WRIT) GO TO 200
       ISEGS(2) = (K-1) * :4000
       START = ISEGS(2)
       IF (START .GT. MAP1(P1SUBS+A$HIGH)) GO TO 200 /* HIGHER THAN TOP
       END = ISEGS(2) + :3777
       IF (END .LT. MAP1(P1SUBS+A$LOW)) GO TO 200      /* BELOW BOTTOM
C
       IF (START .GE. MAP1(P1SUBS+A$LOW)) GO TO 140   /* ABOVE BOTTOM
       START = MAP1(P1SUBS+A$LOW)                     /* GET LOWEST
140    IF (END .LE. MAP1(P1SUBS+A$HIGH)) GO TO 150    /* BELOW TOP
       END = MAP1(P1SUBS+A$HIGH)
150    START = START - ISEGS(2)
       END = END - ISEGS(2)
       CALL ZFILL$(ISEGS,START,END)
C
200    CONTINUE
       GO TO 50
C
       END