C
C
C-----------------------------------------------------------------------------
C
C	PROGRAM:	BLDPUR
C
C	AUTHOR:		Jan H. Belgraver
C
C	DATE:		16-SEP-81
C
C	VERSION:	V1.3	17-JAN-83
C
C	PURPOSE:	Spawns taskbuild command-file, but deletes old
C			task- and map-files first.
C			Tasknames of up to 6 characters in length are appended
C			with BLD to make a standard taskbuil commandfile-name.
C			However, for names over 6 characters in length an 
C			alternative convention is used, i.e. the default 
C			filetype (CMD) is replaced with BLD.
C
C	MODIFIED BY:	Jan H. Belgraver	29-OCT-81	JB01
C			Included call to BELL to have an audible alarm to
C			the user that ...BLD has finished.
C
C			Jan H. Belgraver	17-JAN-83	JB02
C			Replaced calls to WAITFR with STOPFR.
C
C	LUNS:		5	TI:
C
C	EVENT FLAGS:	Local flag #1
C
C	CALLS TO:	EXST,	BELL,	GETMCR,	SPAWN, STOPFR
C	
C	BUILDING:	@BLDPURCBC.CMD:
C			PIP BLDPUR.TSK;*,.MAP;*/DE/NM
C			F4P BLDPUR,BLDPUR/-SP=BLDPUR
C			.IF <EXSTAT> NE 1	.EXIT
C			TKB @BLDPURBLD
C
C			BLDPURBLD.CMD:
C			BLDPUR,BLDPUR/-SP=BLDPUR,BELL
C			/
C			ACTFIL=1
C			TASK=...BLD
C			//
C
C-----------------------------------------------------------------------------
C
C

C
C
	PROGRAM		B L D P U R
C
C
	LOGICAL*1	BUF(80), PIPBUF(28)

	INTEGER		IESB(8)

	REAL		MCR, PIPCMD(7)

	EQUIVALENCE	(PIPBUF(1),PIPCMD(1))

	DATA	MCR	/ 6RMCR... /
	DATA	PIPCMD	/ '.TSK' , ';*/D' , 'E/NM',
     $			  ',.MA' , 'P;*/' , 'DE/N' , 'M   ' /

	CALL	GETMCR	(BUF, IDS)		! Get command-line
12	IF	(IDS) 10, 12, 14
10	STOP	'BLD -- Command line Error'				! JB02

14	IF	(IDS .LT. 7) GOTO 10	! Don't accept less than three
C					  character taskname.
	IBUFL	= IDS 
	INAML	= IDS - 4		! Calc. taskname length

	BUF(1)	= 'P'			! Replace name of this task
	BUF(2)	= 'I'
	BUF(3)	= 'P'

	DO 20	I= 1, 28		! Add PIP cmd-line to taskname
	   BUF(IBUFL+I) = PIPBUF(I)	! to build cmd-line for SPAWN.
20	CONTINUE
	IBUFL	= IBUFL + 28		! IBUFL= total commandline length

	WRITE	(5,21) (BUF(I),I=1,IBUFL)
21	FORMAT	(/1X, 80A1)

	CALL	SPAWN (MCR,,, 1,, IESB,, BUF, IBUFL,,, IDS)	!Send cmd-line
32	IF	(IDS) 30, 32, 34				! to PIP

30	STOP	'BLD -- Spawn Directive Error'

34	CALL	STOPFR (1)						! JB02
	IF	(IESB(1) .GT. 1) STOP	'BLD -- PIP Error'		! JB02
	
	BUF(1)	= 'T'			! Replace PIP with TKB 
	BUF(2)	= 'K'			! for spawning commandline
	BUF(3)	= 'B'			! to taskbuilder.

	DO 40	I= INAML, 1, -1		! Shift-right taskname one location
	   BUF(I+5) = BUF(I+4)
40	CONTINUE
	BUF(5)	= '@'			! Include at-sign to make it indirect
C					  command file for TKB.
	IBUFL	= 5 + INAML		! Update commandline length

	IF	(INAML .GT. 6) GOTO 50	! Alternative buildfile-name convention

	BUF(IBUFL+1)	= 'B'
	BUF(IBUFL+2)	= 'L'
	BUF(IBUFL+3)	= 'D'
	IBUFL	= IBUFL + 3		! IBUFL= total commandline length

	WRITE	(5,21) (BUF(I),I=1,IBUFL)
	CALL	SPAWN (MCR,,, 1,, IESB,, BUF, IBUFL,,, IDS)	! Send cmd-line
42	IF	(IDS) 44, 42, 46				! to TKB

44	STOP	'BLD -- Spawn Directive Error'				! JB02

46	CALL	STOPFR (1)		! Stop BLD until TKB is finished.
	CALL	BELL (1)		! Create audible alarm, 1 beep/sec.
	CALL	EXST(1)			! Successful exit without message.

50	BUF(IBUFL+1)	= '.'		! Replace default filetype
	BUF(IBUFL+2)	= 'B'		! with BLD if taskname length is
	BUF(IBUFL+3)	= 'L'		! larger than 6 characters.
	BUF(IBUFL+4)	= 'D'
	IBUFL	= IBUFL + 4		! IBUFL= total commandline length

	WRITE	(5,21) (BUF(I),I=1,IBUFL)
	CALL	SPAWN (MCR,,, 1,, IESB,, BUF, IBUFL,,, IDS)	! Send cmd-line
52	IF	(IDS) 54, 52, 56				! to TKB

54	STOP	'BLD -- Spawn Directive Error'				! JB02

56	CALL	STOPFR (1)		! Stop BLD until TKB is finished.
	CALL	BELL (1)		! Create audible alarm, 1 beep/sec.
	CALL	EXST(1)			! Successful exit without message.

	END