PROGRAM COMPIL
C
C THIS PROGRAM PARSES A COMMAND LINE AND GENERATES A COMMAND PROCEDURE
C THAT ONLY COMPILES/ASSEMBLES THE PROGRAM THAT NEED TO BE.
C
	IMPLICIT INTEGER (A-Z)
C
C USEFUL PARAMETERS
C
	PARAMETER NOEXT=7		!NUMBER OF EXTENSIONS TO CHECK FOR
	PARAMETER IO=10			!OUTPUT FILE CHANNEL
C
C DEFINE VARIABLE TYPES
C
	BYTE BLINE(512)
	INTEGER*2 ATRBUF(4),ATRBF1(4)
	DIMENSION IATRBF(2),IATRB1(2)
	CHARACTER LINE*512,PARAM*60,TSTFIL*70,EXT(NOEXT)*4,OUTSTR*60
	CHARACTER DEBSWI*5,LSTSWI*4,CMPSWI*7,LSTSTR*60,PRM*60
	CHARACTER*60 FTNFIL(60),MARFIL(60),BLIFIL(60),MACFIL(60)
	EQUIVALENCE (BLINE,LINE)
	EQUIVALENCE (ATRBUF(1),IATRBF(1)),(ATRBF1(1),IATRB1(1))
	COMMON/FLAG/OUTPUT
	DATA ATRCOD/'11'X/,ATRLEN/'8'X/
	DATA EXT/'.FOR','.MAR','.B32','.BLI','.MAC','.P11','.PAL'/
	DATA DEBSWI,LSTSWI,CMPSWI/'DEBUG','LIST','COMPILE'/
C
C START THINGS ROLLING
C
	LINLEN=IGETCMD(BLINE,512)
C	CALL DEFSYM(%REF('CMPNAM'),6,BLINE,LINLEN)
	FTNIND=0
	MARIND=0
	BLIIND=0
	MACIND=0
	START=1
	DEFDBG=0
	DEFLST=0
	RECOMP=0
	OUTPUT=0
	OPEN(UNIT=IO,NAME='COMPIL.FIL',TYPE='NEW',CARRIAGECONTROL='LIST')
10	PARAM(1:60)=' '
	CALL GETPAR(',',LINE,PARAM,START,LINLEN,PRMLEN)
	IF(PRMLEN.EQ.0) GOTO 999
	LOCSPA=LIB$LOCC(' ',PARAM(1:60))
	IF(LOCSPA.GT.PRMLEN) GOTO 15
	IF(PARAM(1:1).NE.'/') THEN
		CLOSE(UNIT=IO,DISPOSE='DELETE')
		STOP 'ILLEGAL COMMAND FORMAT'
		ENDIF
	SSTR=2
	PSTR=1
	LSTR=LOCSPA-2
11	CALL GETPAR('/',PARAM(SSTR:LSTR),PRM,PSTR,LSTR,PLEN)
	IF(PLEN.EQ.0) GOTO 12
	IF(PRM(1:PLEN).EQ.DEBSWI(1:PLEN)) DEFDBG=1
	IF(PRM(1:PLEN).EQ.LSTSWI(1:PLEN)) DEFLST=1
	IF(PRM(1:PLEN).EQ.CMPSWI(1:PLEN)) RECOMP=1
	GOTO 11
12	START=LOCSPA+1
	GOTO 10
15	LOCDOT=LIB$LOCC('.',PARAM(1:PRMLEN))
	LOCSEM=LIB$LOCC(';',PARAM(1:PRMLEN))
	LOCSLA=LIB$LOCC('/',PARAM(1:PRMLEN))
	ENDFIL=PRMLEN
	TSTFIL(1:ENDFIL)=PARAM(1:ENDFIL)
	IF(LOCSLA.NE.0) ENDFIL=LOCSLA-1
	IF(LOCSEM.NE.0.AND.LOCDOT.EQ.0) GOTO 25
	IF(LOCDOT.NE.0) GOTO 30
	DO 20 I=1,NOEXT
	TSTFIL(1:ENDFIL+4)=PARAM(1:ENDFIL)//EXT(I)(1:4)
	STS=GETATR(TSTFIL(1:ENDFIL+4),ENDFIL+4,ATRBUF,ATRCOD,ATRLEN)
	IF((STS.AND.1).EQ.1) GOTO 40
20	CONTINUE
25	TYPE 1001,TSTFIL(1:ENDFIL)
1001	FORMAT(' FILE NOT FOUND OR ILLEGAL FILE NAME ''',A,'''')
	GOTO 10
30	STS=GETATR(PARAM(1:ENDFIL),ENDFIL,ATRBUF,ATRCOD,ATRLEN)
	IF((STS.AND.1).EQ.1) GOTO 35
	TYPE 1001,PARAM(1:ENDFIL)
	GOTO 10
35	ENDFIL=ENDFIL-4
	TSTFIL(1:ENDFIL+4)=PARAM(1:ENDFIL+4)
40	OUTSLN=ENDFIL+4
	OUTSTR(1:OUTSLN)=TSTFIL(1:OUTSLN)
	IF(RECOMP.NE.0) GOTO 60
	LOCDOT=LIB$LOCC('.',TSTFIL(1:OUTSLN))
	TSTFIL(LOCDOT+1:LOCDOT+3)='OBJ'
	STS=GETATR(TSTFIL(1:LOCDOT+3),LOCDOT+3,ATRBF1,ATRCOD,ATRLEN)
	IF(CMPQUAD(ATRBUF(1),ATRBF1(1),TMP))10,10,60
9876	FORMAT(1X,A,A,2X,A/(4(1X,Z4)/))
60	INDX=1
	LOCDOT=LIB$LOCC('.',OUTSTR(1:OUTSLN))
	DO 70 I=1,NOEXT
	IF(OUTSTR(LOCDOT:OUTSLN).EQ.EXT(I)(1:4)) GOTO 80
70	CONTINUE
80	GOTO (100,110,120,120,130,130,130),I
100	FTNIND=FTNIND+1
	FTNFIL(FTNIND)(1:60)=OUTSTR(1:OUTSLN)
	GOTO 10
110	MARIND=MARIND+1
	MARFIL(MARIND)(1:60)=OUTSTR(1:OUTSLN)
	GOTO 10
120	BLIIND=BLIIND+1
	BLIFIL(BLIIND)(1:60)=OUTSTR(1:OUTSLN)
	GOTO 10
130	MACIND=MACIND+1
	MACFIL(MACIND)(1:60)=OUTSTR(1:OUTSLN)
	GOTO 10
999	LSTLEN=0
	IF(DEFLST.NE.0) THEN
		LSTSTR(1:5)='/LIST'
		LSTLEN=5
		ENDIF
	IF(FTNIND.EQ.0) GOTO 9991
	IF(DEFDBG.NE.0) THEN
		LSTSTR(LSTLEN+1:LSTLEN+6)='/DEBUG'
		LSTLEN=LSTLEN+6
		ENDIF
	LSTLEN=LSTLEN+1
	LSTSTR(LSTLEN:LSTLEN)=' '
	DO 9990 I=1,FTNIND
	LSTCHR=LIB$LOCC(' ',FTNFIL(I)(1:60))-1
	WRITE(IO,8000)(LSTSTR(1:LSTLEN),FTNFIL(I)(1:LSTCHR),KK=1,2)
8000	FORMAT('$WRITE SYS$OUTPUT "Fortrn:	",FTNSWI," ',A,A,'"'/
     1	       '$FORTRAN''FTNSWI''',A,A)
9990	CONTINUE
	OUTPUT=1
	IF(DEFLST.EQ.0) LSTLEN=0
	IF(DEFLST.NE.0) LSTLEN=5
9991	IF(MARIND.EQ.0) GOTO 9993
	IF(DEFDBG.NE.0) THEN
		LSTSTR(LSTLEN+1:LSTLEN+11)='/ENABLE=DBG'
		LSTLEN=LSTLEN+11
		ENDIF
	LSTLEN=LSTLEN+1
	LSTSTR(LSTLEN:LSTLEN)=' '
	DO 9992 I=1,MARIND
	LSTCHR=LIB$LOCC(' ',MARFIL(I)(1:60))-1
	WRITE(IO,8001)(LSTSTR(1:LSTLEN),MARFIL(I)(1:LSTCHR),KK=1,2)
8001	FORMAT('$WRITE SYS$OUTPUT "Macro:	",MARSWI," ',A,A,'"'/
     1	       '$MACRO''MARSWI''',A,A)
9992	CONTINUE
	OUTPUT=1
	IF(DEFLST.EQ.0) LSTLEN=0
	IF(DEFLST.NE.0) LSTLEN=5
9993	IF(BLIIND.EQ.0) GOTO 9995
	IF(DEFDBG.NE.0) THEN
		LSTSTR(LSTLEN+1:LSTLEN+6)='/DEBUG'
		LSTLEN=LSTLEN+6
		ENDIF
	LSTLEN=LSTLEN+1
	LSTSTR(LSTLEN:LSTLEN)=' '
	DO 9994 I=1,BLIIND
	LSTCHR=LIB$LOCC(' ',BLIFIL(I)(1:60))-1
	WRITE(IO,8002)(LSTSTR(1:LSTLEN),BLIFIL(I)(1:LSTCHR),KK=1,2)
8002	FORMAT('$WRITE SYS$OUTPUT "Bliss:	",BLISWI," ',A,A,'"'/
     1	       '$BLISS''BLISWI''',A,A)
9994	CONTINUE
	OUTPUT=1
	IF(DEFLST.EQ.0) LSTLEN=0
	IF(DEFLST.NE.0) LSTLEN=5
9995	IF(MACIND.EQ.0) GOTO 9999
	IF(DEFDBG.NE.0) THEN
		LSTSTR(LSTLEN+1:LSTLEN+6)='/DEBUG'
		LSTLEN=LSTLEN+6
		ENDIF
	LSTLEN=LSTLEN+1
	LSTSTR(LSTLEN:LSTLEN)=' '
	DO 9996 I=1,MACIND
	LSTCHR=LIB$LOCC(' ',MACFIL(I)(1:60))-1
	WRITE(IO,8003)(LSTSTR(1:LSTLEN),MACFIL(I)(1:LSTCHR),KK=1,2)
8003	FORMAT('$WRITE SYS$OUTPUT "Mac/11:	",MACSWI," ',A,A,'"'/
     1	       '$MACRO/RSX11''MACSWI''',A,A)
9996	CONTINUE
	OUTPUT=1
9999	IF(OUTPUT.EQ.0) CLOSE(UNIT=IO,DISPOSE='DELETE')
	IF(OUTPUT.NE.0) CLOSE(UNIT=IO)
	END
	SUBROUTINE GETPAR(DELIM,LINE,PARAM,START,LENGTH,LENPAR)
	IMPLICIT INTEGER (A-Z)
	CHARACTER LINE*(*),PARAM*(*),DELIM*1
	IF(START.LE.LENGTH) GOTO 10
	LENPAR=0
	RETURN
10	LOCOM=LIB$LOCC(DELIM,LINE(START:LENGTH))
	IF(LOCOM.EQ.0) LOCOM=LENGTH-START+2
	END=START+LOCOM-2
	LENPAR=LOCOM-1
	IF(LENPAR.NE.0) PARAM(1:LENPAR)=LINE(START:END)
	START=END+2
	RETURN
	END
	INTEGER FUNCTION GETATR(FILNAM,FILENG,ATRARY,CODE,LENGTH)
	IMPLICIT INTEGER (A-Z)
	PARAMETER IO$_ACCESS='72'X	!ACCESS FILE
	PARAMETER IO$_DEACCESS='34'X	!DEACCESS FILE
	PARAMETER FIB$M_WRITE='501'X	!READ FILE
C
C STORAGE
C
	CHARACTER FILNAM*(*)
	CHARACTER SYSDSK*10,CHRFIB*10
	INTEGER LNGFIB(3),LNGATR(3),ATRARY(1)
	INTEGER*2 WRDFIB(6),WRDATR(6),IOSB(4),FILSEQ
	DOUBLE PRECISION FILEID,DIRID,INDFID,INDDID
	EQUIVALENCE (FILEID,FILSEQ),(CHRFIB,LNGFIB,WRDFIB)
	EQUIVALENCE (WRDFIB(3),FILEID),(LNGATR,WRDATR)
C
C PRESET SOME THINGS
C
	DATA LNGFIB/FIB$M_WRITE,0,0/
	DATA LNGATR/0,0,0/
C
C BEGIN THE FUN
C
	GETATR=1
	WRDATR(1)=LENGTH
	WRDATR(2)=CODE
	STS=SYS$TRNLOG('SYS$DISK',SYSLEN,SYSDSK,TMP,TMP,%VAL(3))
	IF((STS.AND.1).NE.1) CALL CEXIT(STS)
	LOCOLN=LIB$LOCC(':',FILNAM)
	IF(LOCOLN.EQ.0) GOTO 10
	SYSLEN=LOCOLN
	SYSDSK(1:LOCOLN)=FILNAM(1:SYSLEN)
10	STS=SYS$ASSIGN(SYSDSK(1:SYSLEN),CHAN,,)
	IF((STS.AND.1).NE.1) CALL CEXIT(STS)
	STS=OPNFIL(FILNAM,FILENG,FILEID,DIRID)
	IF((STS.AND.1).NE.1) GOTO 20
	LNGATR(2)=%LOC(ATRARY)
	STS=SYS$QIOW(,%VAL(CHAN),%VAL(IO$_ACCESS),IOSB,,,
     1		      CHRFIB(1:10),,,,%REF(LNGATR),)
	IF((IOSB(1).AND.1).NE.1) CALL CEXIT(IOSB(1))
	STS=SYS$DASSGN(%VAL(CHAN))
	IF((STS.AND.1).NE.1) CALL CEXIT(STS)
	RETURN
20	GETATR=STS
	RETURN
	END
	SUBROUTINE CEXIT(STATUS)
	IMPLICIT INTEGER (A-Z)
	INTEGER*2 STATUS
	COMMON/FLAG/OUTPUT
	IF(OUTPUT.EQ.0) CLOSE(UNIT=IO,DISPOSE='DELETE')
	IF(OUTPUT.NE.0) CLOSE(UNIT=IO)
	CALL EXIT(STATUS)
	RETURN
	END