      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
C	MODIFIED BY STEP ENGINEERING FOR OPERATION ON A
C	FUTUREDATA AMDS DEVELOPMENT SYSTEM USING CMDOS.
C
C	MODIFIED:
C
C		MARCH 19, 1981 --  TERRILL  --  ADDED ABILITY
C	TO ENTER THE DRIVE NAME TO THE FILES.
C
C**************************************************************
C
C   
C   
      INTEGER SOURCE
      INTEGER LIST
      INTEGER OBJECT
C   
      INTEGER*1 JCHRB,JCHRJ,JCHRL,JCHRO,JCHRS,JCHRT
      INTEGER*1 JCHRD,JCHRE,JCHRF,JCHRP,JCHRW,JCHRA
      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)
      INTEGER*1 KDEV1(5),KDEV2(5)
C
C	INTEGER VALUES ADDED FOR DRIVE NUMBER ENTRY.  MAR. 19,1981
C
      INTEGER FROM,ENDING,INDEX,DSKDRV
C
      INTEGER FTYPE
      REAL ITABV(249)
      COMMON ICRD,IPRT,MCFLE,IDFLE,MCREC,IDREC,IFORM,ITRUN,ILOUT,IXCOL
      COMMON MLAB,MOPC,IBIT,ICCNT,IWORD,IERRL,IERRI,IEND,IFRMC
      COMMON LSOR,LIF,LSYM,LREF,LDEF,LOCT,ITRMI,ITRMO
      COMMON ILEN,KLEN,LLEN,KWORD,IFLD(2400),IYFLD,IZFLD
      COMMON IFBIT,ZVAL,CVAL,JREAD,IN(80),INB(80),LINE,IPAGE,LISN
      COMMON IALPH(37),IAST,IDOLR,ISHRP
      COMMON ICOLN,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
      COMMON ITAB(4,249),ITABS(249),ITABV,NAME(4),INDEX,INDET,ISYM,LTAB
      COMMON IXTAB(256),MXREF,IXT,IXPNT,IXCNT,IXPAG,MCORE(128)
C
      EQUIVALENCE(SOURCE,ISNAM(1)), (LIST,ILNAM(1)),(OBJECT,IONAM(1))
      DATA JCHRB,JCHRJ,JCHRL,JCHRO,JCHRS,JCHRT,JCHRW,JCHRA
     1  /1HB,1HJ,1HL,1HO,1HS,1HT,1HW,1HA/
      DATA JCHRP /1HP/
      DATA JCHRD,JCHRE,JCHRF
     1  /1HD,1HE,1HF/
      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 DEFINITION PROGRAM  VER. 1.1S')
100   WRITE(ITRMO,2000)
2000  FORMAT(' ENTER SOURCE FILE NAME   ')
C     READ SOURCE FILE NAME
      READ (ITRMI,3000) INBUF
3000  FORMAT(80A1)
C     CLEAR FILE NAME BUFFERS
      DO 150 I=1,15
        ISNAM(I) = JBLNK
        ILNAM(I) = JBLNK
        IONAM(I) = JBLNK
150   CONTINUE
C   
C
C	STEP ENGINEERING ADDITION: MAR. 19, 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 195
      JCHAR = INBUF(1)
      DSKDRV = JCHAR - JCHRA + 1
      IF (DSKDRV .LE. 0 .OR. DSKDRV .GT. 2) GO TO 910
      FROM = 3
195   CONTINUE
C
C     MOVE SOURCE FILE TO SOURCE FILE NAME BUFFER
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
C       IF(JCHAR .EQ. JLPAR) GO TO 250
        ISNAM(INDEX) = JCHAR
        ILNAM(INDEX) = JCHAR
        IONAM(INDEX) = JCHAR
        INDEX = INDEX + 1
200   CONTINUE
      GO TO 910
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     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     CHECK FOR CONSOLE INPUT
      DO 270 I=1,5
      IF(ISNAM(I) .NE. KDEV1(I)) GO TO 280
270   CONTINUE
      ICRD = ITRMI
      GO TO 290
C
C	MODIFIED BY STEP ENGINEERING:  MAR. 19, 1981
C
C	USE DSKDRV INSTEAD OF 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
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,11
        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
C     CHECK FOR PRINTER
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. 19, 1981
C
C	USE DSKDRV INSTEAD OF 0.
C
380   CALL OPEN (IPRT,LIST,DSKDRV)
390   IERRZ = 2
C     DETERMINE OBJECT MODULE FILE NAME
      IF(INBUF(ICOL) .NE. JCOMM) GO TO 420
      ICOL = ICOL+1
C
C
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	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
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) = JCHRD
      IONAM(10) = JCHRE
      IONAM(11) = JCHRF
C     OPEN OBJECT MODULE FILE
450   DO 460 I=1,11
        JNAME(I) = IONAM(I)
460   CONTINUE
C
C	MODIFIED BY STEP ENGINEERING:  MAR. 19, 1981
C
C	USE DSKDRV INSTEAD OF 0.
C
      CALL OPEN (IDFLE,OBJECT,DSKDRV)
C   
C     CHECK FOR ASSEMBLY OPTIONS AND SET APPROPRIATE SWITCHES
C
      IFORM = 0
      IFRMC = 12
      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
      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     FILE NOT FOUND
C	--CAN NOT DETERMINE THIS IN MICROSOFT FORTRAN--
C
C920   WRITE(ITRMO,9200) JNAME
C9200  FORMAT(' FILE NOT FOUND - ',15A1)
C      GO TO 960
C
C     FILE ERROR ON ATTEMPT TO OPEN
C	--CAN NOT DETERMINE THIS IN MICROSOFT FORTRAN--
C
C930   WRITE(ITRMO,9300) JNAME
C9300  FORMAT(' FILE OPEN ERROR - ',15A1)
C      GO TO 960
C
C     PARAMETER ERROR
940   WRITE(ITRMO,9400)
9400  FORMAT(' PARAMETER ERROR')
      GO TO 100
C
C	--CAN NOT DETERMINE THIS IN MICROSOFT FORTRAN--
C
C950   WRITE(ITRMO,9500)
C9500  FORMAT(' DEFINITION FILE ALREADY EXISTS')
C
C     CLOSE FILES
960   IF(IERRZ .EQ. 0) GO TO 100
      IF(IERRZ .EQ. 1) GO TO 965
965   CONTINUE
      GO TO 100
990   RETURN
      END
 .EQ. 0) GO TO 100
      IF(IERRZ .EQ. 1) GO TO 965
965   CONTINUE
      GO TO 100
990   RETURN
      END
