C-----------------------------------------------------------------------------
C Program:	F O R
C
C Purpose:	Run FORTRAN compiler followed by purge of OBJ and LST-files.
C 
C Author:	Klaas H.N. Bos
C
C Date:		1980
C
C Luns:		5	TI:
C
C Event flags:	Local flag #1
C
C Calls to:	EXIT,	GETMCR,	SPAWN, STOPFR
C
C Building:	@FORBLD.CMD
C
C Modified by:
C	Jan H. Belgraver	10-Apr-90	JB03	V1.3
C	Contents BUF(1) should always become F.
C
C 	Jan H. Belgraver	18-APR-84	JB02	V1.2
C 	F4P references replaced with F77.
C
C	Jan H. Belgraver	17-JAN-83	JB01	V1.1
C 	Replaced all calls to WAITFR with STOPFR.
C-----------------------------------------------------------------------------

C
C
	PROGRAM		F O R
C
C
	LOGICAL*1	BUF(80), SP(4), PIPB(24)

	REAL*4		MCR

	REAL*8		R8(3)

	EQUIVALENCE	(PIPB(1),R8(1))

	DATA	SP	/'/','-','S','P'/
	DATA	MCR	/6RMCR.../
	DATA	R8	/'.OBJ;*/P','U,.LST;*','/PU'/

	CALL	GETMCR	(BUF)
	BUF(1)	= 'F'							! JB03
	BUF(2)	= '7'							! JB02
	BUF(3)	= '7'							! JB02
	I	= 4

	DO	1	K= 5, 80
		IF	(BUF(K).EQ.'.') GOTO 20
		IF	(BUF(K).EQ.'/') GOTO 2
		IF	(BUF(K).LT.32)  GOTO 4
1	CONTINUE

2	I	= 0
	DO	3	L= K, 80
		IF	(BUF(L).LT.32) GOTO 4
		I	= I + 1
		SP(I)	= BUF(L)
3	CONTINUE

4	BUF(K)	= ','
	KNC	= K-1
	NCH	= K-1-4
	J	= 4
	DO	5	L= K+1, K+NCH
		J	= J+1
		BUF(L)	= BUF(J)
5	CONTINUE

	J	= 0
	DO	6	L= K+NCH+1, K+NCH+I
		J	= J+1
		BUF(L)	= SP(J)
6	CONTINUE
	L	= K+NCH+I+1

7	BUF(L)	= '='
	J	= 4
	DO	8	K= L+1, L+NCH
		J	= J+1
		BUF(K)	= BUF(J)
8	CONTINUE

	WRITE	(5,100) (BUF(J),J=1,L+NCH)
100	FORMAT	(1H ,80A1)

	NCH	= L + NCH
	CALL	SPAWN	(MCR,,,1,,,,BUF,NCH,,,IDS)
	CALL	STOPFR	(1)						! JB01

	J	= 0
	DO	9	I= KNC+1, KNC+19
		J	= J+1
		BUF(I)	= PIPB(J)
9	CONTINUE

	BUF(1)	= 'P'
	BUF(2)	= 'I'
	BUF(3)	= 'P'							! JB02
	WRITE	(5,100) (BUF(J),J=1,KNC+19)
	CALL	SPAWN	(MCR,,,1,,,,BUF,KNC+19,,,IDS)
	CALL	STOPFR	(1)						! JB01

	CALL EXIT

20	STOP	'FOR -- " . " in the string is NOT allowed'

	END