      SUBROUTINE FOPEN
C   
C   
C     THIS SUBROUTINE READS AND OPENS THE DEFINITION PROGRAM
C     INPUT SOURCE AND OUTPUT DEFINITION FILES.
C     ASSEMBLY OPTIONS ARE ALSO READ.
C
C**************************************************************
C
C	MODIFIED BY STEP ENGINEERING FOR OPERATION ON A
C	FUTUREDATA AMDS DEVELOPMENT SYSTEM USING CMDOS.
C
C	MODIFIED:
C
C		MARCH 18, 1981 --  TERRILL  --  ADDED ABILITY
C	TO ENTER THE DRIVE NAME TO THE FILES.
C
C**************************************************************
C
C   
C   
      INTEGER*1 DEFIN
      INTEGER*1 SOURCE
      INTEGER*1 LIST
      INTEGER*1 OBJECT
      INTEGER*1 JCHRB,JCHRJ,JCHRL,JCHRO,JCHRS,JCHRT
      INTEGER*1 JCHRD,JCHRE,JCHRF,JCHRP,JCHRA,JCHRM
      INTEGER*1 JBLNK,JCOMM,JLPAR,JRPAR,JPERD,JEQUL,JCOLN
      INTEGER*1 JCHAR,JNAME(15),INBUF(80),JNUMS(10)
      INTEGER*1 ISNAM(15),ILNAM(15),IONAM(15),IDNAM(15)
      INTEGER*1 KDEV1(5),KDEV2(5),JCHRW
C
C	INTEGER VALUES ADDED FOR DRIVE NUMBER ENTRY. MAR. 18, 1981
C
      INTEGER FROM,ENDING,INDEX,DSKDRV
C
C	BEGINNING OF COMMON AREA
C 
      INTEGER FTYPE,FLEN
      REAL ITABV(384),LC,LODLC,LCMAX
      COMMON ICRD,IPRT,IPCH,MCFLE,IMFLE,IDFLE,MCREC,IMREC,IDREC,IOREC
      COMMON MLAB,MOPC,IBIT,ICCNT,IWORD,IERRL,IERRI,IEND,LEND,IFRMC
      COMMON LSOR,LIF,LSYM,LREF,LDEF,LOCT,LOBJ,LOBJ1,LOBJ2,LINV
      COMMON ILEN,KLEN,LLEN,FLEN,KWORD,IYFLD,IZFLD
      COMMON IDUP,NDUP,NFLAG,IOFLG,LWORD,LINEL,KFILE
      COMMON IFBIT,ZVAL,CVAL,JREAD,IN(80),INB(80),LINE,IPAGE,LISN
      COMMON IALPH(37),IAST,IDOLR,ISHRP,IAMP,ICOLN
      COMMON IBLNK,ICTAB,ISEMI,ICOMM,IPLUS,IMIN,IMULT,IDIV
      COMMON IRPAR,ILPAR,IATT(9),JATT(5),LATT(9),IFPAR(16),NBASE,JBASE
      COMMON ICOL,IFCOL,MCOL,MLCOL,IOLIN,ICNT,LTITL(50),IADDR(4,12)
      COMMON ITYPE,JTYPE,FTYPE,IERR,IERRS,IOPVA,JCOL,IBUG,IOVER
      COMMON IPASS,LC,IOBIN(128),IPDEF,LODLC,LCMAX,LCMIN,LEN
      COMMON ITAB(4,384),ITABS(384),ITABV,NAME(4),INDEX,INDET
      COMMON ISYM,LTAB,IFORM,ITRUN,ILOUT,IXCOL,NUMER,ITRMI,ITRMO
      COMMON IXTAB(768),MXREF,IXT,IXPNT,IXCNT,IXPAG,MCORE(128)
C
C
C	THE NAMED COMMON VARIABLE IFLD(400) IS A DUMMY ENTRY POINT FOR
C	A MUCH LARGER ARRAY -- DEFINED IN INIT.FOR. 
C
      COMMON /OVRLAY/IFLD(400)
C
      EQUIVALENCE(DEFIN,IDNAM(1))
      EQUIVALENCE(SOURCE,ISNAM(1)), (LIST,ILNAM(1)),(OBJECT,IONAM(1))
      DATA JCHRB,JCHRJ,JCHRL,JCHRO,JCHRS,JCHRT,JCHRW
     1  /1HB,1HJ,1HL,1HO,1HS,1HT,1HW/
      DATA JCHRD,JCHRE,JCHRF
     1  /1HD,1HE,1HF/
      DATA JCHRP,JCHRA,JCHRM /1HP,1HA,1HM/
      DATA JBLNK,JCOMM,JLPAR,JRPAR,JPERD,JEQUL,JCOLN
     1  /1H ,1H,,1H(,1H),1H.,1H=,1H:/
      DATA JNUMS /1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA KDEV1 /1HC,1HO,1HN,1H:,1H /
      DATA KDEV2 /1HL,1HS,1HT,1H:,1H /
C   
C     SET INDICATOR THAT INDICATES WHICH FILES ARE OPEN
      IERRZ = 0
C     PRINT HEADER
      WRITE(ITRMO,1000)
1000  FORMAT(/,' META ASSEMBLER ASSEMBLY PROGRAM  VER. 1.1S')
100   WRITE(ITRMO,1050)
Š1050  FORMAT(' ENTER DEFINITION FILENAME   ')
C     READ DEFINITION FILE NAME
      READ(ITRMI,3000) INBUF
C     CLEAR FILE NAME BUFFERS
      DO 101 I=1,15
        ISNAM(I)=JBLNK
        ILNAM(I)=JBLNK
        IONAM(I)=JBLNK
        IDNAM(I)=JBLNK
101   CONTINUE
C
C	STEP ENGINEERING ADDITION: MAR. 18, 1981
C
C	CHECK FOR THE DRIVE NAME AT BEGINNING OF THE 
C	FILE NAME.
C
      DSKDRV=0
      FROM = 1
      INDEX = 1
C
C	ALL VALUES MUST BE IN THE SAME FORMAT FOR CHECKING
C
      JCHAR = INBUF(2)
      IF (JCHAR .NE. JCOLN)  GO TO 103
      JCHAR = INBUF(1)
      DSKDRV = JCHAR - JCHRA + 1
      IF (DSKDRV .LE. 0 .OR. DSKDRV .GT. 2) GO TO 910
      FROM = 3
103   CONTINUE
C
C     MOVE DEFINITION FILE TO DEFINITION FILE NAME BUFFER
C
C	MODIFIED BY STEP ENGINEERING:  MAR. 3, 1981
C
C	USED INDEX AND FROM AS CALCULATED ABOVE.
C
      ENDING = FROM + 8
      DO 105 ICOL=FROM,ENDING
        JCHAR=INBUF(ICOL)
        IF(JCHAR .EQ. JPERD) GO TO 110
        IDNAM(INDEX)=JCHAR
        INDEX = INDEX + 1
105   CONTINUE
      GO TO 910
C
110   DO 115 I=9,11
        ICOL=ICOL+1
        IDNAM(I)=INBUF(ICOL)
115   CONTINUE
C
      DO 120 I=1,12
        JNAME(I)=IDNAM(I)
120   CONTINUE
C
C	MODIFIED BY STEP ENGINEERING:  MAR. 18, 1981
C
C	USE DSKDRV AS DETERMINED ABOVE RATHER THAN 0.
C
      CALL OPEN (IDFLE,DEFIN,DSKDRV)
C
      WRITE(ITRMO,2000)
2000  FORMAT(' ENTER SOURCE FILE NAME   ')
C     READ SOURCE FILE NAME
      READ (ITRMI,3000) INBUF
3000  FORMAT(80A1)
C
C	STEP ENGINEERING ADDITION: MAR. 18, 1981
C
C	CHECK FOR THE DRIVE NAME AT BEGINNING OF THE 
C	FILE NAME.
C
      DSKDRV=0
      FROM = 1
      INDEX = 1
      JCHAR = INBUF(2)
      IF (JCHAR .NE. JCOLN)  GO TO 195
      JCHAR = INBUF(1)
      DSKDRV = JCHAR - JCHRA + 1
      IF (DSKDRV .LE. 0 .OR. DSKDRV .GT. 2) GO TO 910
      FROM = 3
195   CONTINUE
C     MOVE SOURCE FILE TO SOURCE FILE NAME BUFFER
C
C	MODIFIED BY STEP ENGINEERING:  MAR. 18,1981
C
C	USE FROM AND INDEX FROM ABOVE.
C
      ENDING = FROM + 8
      DO 200 ICOL=FROM,ENDING 
        JCHAR = INBUF(ICOL)
        IF(JCHAR .EQ. JPERD) GO TO 210
        IF(JCHAR .EQ. JBLNK) GO TO 250
        IF(JCHAR .EQ. JCOMM) GO TO 250
        IF(JCHAR .EQ. JLPAR) GO TO 250
        ISNAM(INDEX) = JCHAR
        ILNAM(INDEX) = JCHAR
        IONAM(INDEX) = JCHAR
        INDEX = INDEX + 1
200   CONTINUE
      GO TO 910
C
210   ICOL=ICOL+1
      DO 220 I=9,12
        JCHAR=INBUF(ICOL)
        IF (JCHAR .EQ. JBLNK) GO TO 250
        IF (JCHAR .EQ. JCOMM) GO TO 250
        IF (JCHAR .EQ. JLPAR) GO TO 250
        ISNAM(I)=JCHAR
        ICOL=ICOL+1
220   CONTINUE
      GO TO 910
C
C     OPEN SOURCE FILE
250   DO 260 I=1,11
        JNAME(I) = ISNAM(I)
Š260   CONTINUE
C     CHECK FOR INVALID FILE NAME CHARACTERS
      DO 265 I=1,11
        JCHAR = ISNAM(I)
        IF (JCHAR .EQ. 32) GO TO 265
        IF (JCHAR .GT. 90) GO TO 910
        IF (JCHAR .LT. 48) GO TO 910
        IF (JCHAR .LE. 57) GO TO 265
        IF (JCHAR .LT. 65) GO TO 910
265   CONTINUE
C
C	MODIFIED BY STEP ENGINEERING:  MAR. 18, 1981
C
C	USE DSKDRV FROM ABOVE RATHER THAN 0
C
280   CALL OPEN (ICRD,SOURCE,DSKDRV)
C
290   IERRZ = 1
C     DETERMINE LIST FILE NAME
      IF(INBUF(ICOL) .NE. JCOMM) GO TO 320
      ICOL = ICOL+1
C
C	STEP ENGINEERING ADDITION: MAR. 18, 1981
C
C	CHECK FOR THE DRIVE NAME AT BEGINNING OF THE 
C	FILE NAME.
C
      DSKDRV=0
      JCHAR = INBUF(ICOL+1)
      IF (JCHAR .NE. JCOLN)  GO TO 295
C
C	DRIVE IS GIVEN AS PREFIX TO FILE NAME.
C
      JCHAR = INBUF(ICOL)
      DSKDRV = JCHAR - JCHRA + 1
      IF (DSKDRV .LE. 0 .OR. DSKDRV .GT. 2) GO TO 910
      ICOL = ICOL + 2
295   CONTINUE
C
C     COPY LIST FILE NAME TO LIST FILE BUFFER
C
      DO 300 I=1,12
      JCHAR = INBUF(ICOL)
      IF(JCHAR .EQ. JPERD) GO TO 310
      IF(JCHAR .EQ. JBLNK) GO TO 310
      IF(JCHAR .EQ. JCOMM) GO TO 310
      IF(JCHAR .EQ. JLPAR) GO TO 310
      ILNAM(I) = JCHAR
      ICOL = ICOL+1
300   CONTINUE
      GO TO 910
C     PAD NAME WITH BLANKS
310   DO 315 J=I,15
      ILNAM(J) = JBLNK
315   CONTINUE
      IF (JCHAR .NE. JPERD) GO TO 350
      ICOL=ICOL+1
      DO 318 I=9,12
      JCHAR=INBUF(ICOL)
      IF(JCHAR .EQ. JBLNK) GO TO 350
      IF(JCHAR .EQ. JCOMM) GO TO 350
      IF(JCHAR .EQ. JLPAR) GO TO 350
      ILNAM(I)=JCHAR
      ICOL=ICOL+1
318   CONTINUE
      GO TO 910
C     USE LIST FILE DEFAULT NAME, ADD EXTENSION
320   DO 330 I=1,11
      IF(ILNAM(I) .EQ. JPERD) GO TO 340
      IF(ILNAM(I) .EQ. JBLNK) GO TO 340
330   CONTINUE
      GO TO 910
C     ADD OR CHANGE SOURCE FILE EXTENSION FOR LIST FILE
340   ILNAM(9) = JCHRL
      ILNAM(10) = JCHRS
Š      ILNAM(11) = JCHRT
C     OPEN LIST FILE
350   DO 360 I=1,11
        JNAME(I) = ILNAM(I)
360   CONTINUE
C     CHECK FOR CONSOLE OUTPUT DEVICE
      DO 370 I=1,5
        IF(ILNAM(I) .NE. KDEV1(I)) GO TO 375
370   CONTINUE
      IPRT = ITRMO
      GO TO 390
375   DO 378 I=1,5
        IF(ILNAM(I) .NE. KDEV2(I)) GO TO 380
378   CONTINUE
      IPRT=2
      GO TO 390
C
C	MODIFIED BY STEP ENGINEERING:  MAR. 18, 1981
C
C	USE DSKDRV FROM ABOVE RATHER THAN 0
C
380   CALL OPEN (IPRT,LIST,DSKDRV)
C
390   IERRZ = 2
C     DETERMINE OBJECT MODULE FILE NAME
      IF(INBUF(ICOL) .NE. JCOMM) GO TO 420
      ICOL = ICOL+1
C
C	STEP ENGINEERING ADDITION: MAR. 18, 1981
C
C	CHECK FOR THE DRIVE NAME AT BEGINNING OF THE 
C	FILE NAME.
C
      DSKDRV=0
      JCHAR = INBUF(ICOL+1)
      IF (JCHAR .NE. JCOLN)  GO TO 395
C
C	FOUND DRIVE NUMBER PREFIXING FILE NAME.
C
      JCHAR = INBUF(ICOL)
      DSKDRV = JCHAR - JCHRA + 1
      IF (DSKDRV .LE. 0 .OR. DSKDRV .GT. 2) GO TO 910
      ICOL = ICOL + 2
395   CONTINUE
C
C     COPY OBJECT MODULE FILE NAME TO FILE NAME BUFFER
C
      DO 400 I=1,11
        JCHAR = INBUF(ICOL)
        IF(JCHAR .EQ. JPERD) GO TO 410
        IF(JCHAR .EQ. JBLNK) GO TO 410
        IF(JCHAR .EQ. JLPAR) GO TO 410
        IONAM(I) = JCHAR
        ICOL = ICOL+1
400   CONTINUE
      GO TO 910
C     PAD NAME WITH BLANKS
410   DO 415 J=I,11
        IONAM(J) = JBLNK
415   CONTINUE
      IF(JCHAR .NE. JPERD) GO TO 450
      ICOL=ICOL+1
      DO 418 I=9,12
        JCHAR=INBUF(ICOL)
        IF(JCHAR .EQ. JBLNK) GO TO 450
        IF(JCHAR .EQ. JCOMM) GO TO 450
        IF(JCHAR .EQ. JLPAR) GO TO 450
        ILNAM(I)=JCHAR
        ICOL=ICOL+1
418   CONTINUE
      GO TO 910
C     USE OBJECT FILE DEFAULT NAME, ADD EXTENSION
420   DO 430 I=1,11
        IF(ISNAM(I) .EQ. JPERD) GO TO 440
        IF(ISNAM(I) .EQ. JBLNK) GO TO 440
430   CONTINUE
C     ADD OR CHANGE SOURCE FILE EXTENSION OF OBJECT MODULE FILE
440   IONAM(9) = JCHRA
      IONAM(10) = JCHRS
      IONAM(11) = JCHRM
ŠC     OPEN OBJECT MODULE FILE
450   DO 460 I=1,11
        JNAME(I) = IONAM(I)
460   CONTINUE
C
C	MODIFIED BY STEP ENGINEERING:  MAR. 18, 1981
C
C	USE DSKDRV AS DETERMINED ABOVE INSTEAD OF 0
C
      CALL OPEN (IPCH,OBJECT,DSKDRV)
C   
C     CHECK FOR ASSEMBLY OPTIONS AND SET APPROPRIATE SWITCHES
C   
      IFORM = 0
      ILOUT = 0
      ITRUN = 71
      IF(INBUF(ICOL) .EQ. JBLNK) GO TO 990
      IF(INBUF(ICOL) .NE. JLPAR) GO TO 940
480   ICOL = ICOL+1
      JCHAR = INBUF(ICOL)
C     CHECK FOR ERROR LISTING OPTION
      IF(JCHAR .NE. JCHRE) GO TO 520
      ILOUT = 1
      GO TO 700
C     CHECK FOR FORMS CONTROL OPTION
520   IF(JCHAR .NE. JCHRF) GO TO 530
      IFORM = 1
      IFRMC = 12
      GO TO 700
530   IF(JCHAR .NE. JCHRP) GO TO 540
      IFORM = 1
      IFRMC = IALPH(2)
      GO TO 700
C     CHECK FOR PAGE WIDTH OR LENGTH OPTION
540   IF(JCHAR .EQ. JCHRW) GO TO 550
      IF(JCHAR .NE. JCHRL) GO TO 750
550   ICOL = ICOL+1
      IF(INBUF(ICOL) .NE. JEQUL) GO TO 940
      ICOL = ICOL+1
      JVAL = 0
560   DO 580 I=1,10
        IF(INBUF(ICOL) .EQ. JNUMS(I)) GO TO 600
580   CONTINUE
      GO TO 620
600   JVAL = JVAL*10+I-1
      ICOL = ICOL+1
      GO TO 560
620   IF(JVAL .LT. 10) GO TO 940
      IF(JCHAR .EQ. JCHRL) GO TO 650
C     SET LINE WIDTH
      ITRUN = JVAL
      GO TO 710
C     SET PAGE LENGTH
650   IOLIN = JVAL
      GO TO 710
C     CHECK FOR MORE PARAMETERS
700   ICOL = ICOL+1
710   IF(INBUF(ICOL) .EQ. JCOMM) GO TO 480
750   IF(INBUF(ICOL) .EQ. JRPAR) GO TO 990
      GO TO 940
ŠC   
C     ERRORS
C   
C     ILLEGAL FILE NAME
910   WRITE(ITRMO,9100)
9100  FORMAT(' ILLEGAL FILE NAME')
      GO TO 960
C
C     PARAMETER ERROR
940   WRITE(ITRMO,9400)
9400  FORMAT(' PARAMETER ERROR')
      GO TO 960
C
C     CLOSE FILES
960   CONTINUE
965   CONTINUE
      GO TO 100
990   RETURN
      END
  GO TO 960
C
C     CLOSE FILES
960   CONTINUE
965   CONTINUE
      GO TO 100
990   RETURN
      END
