C	PROGRAM APPLY.FT
C	----------------
C
C	PETER LEMKIN
C	IMAGE PROCESSING UNIT, DCBD
C	NATIONAL CANCER INSTITUTE
C	NATIONAL INSTITUTES OF HEALTH
C	9000 ROCKVILLE PIKE
C	BETHESDA, MD. 20014
C
C	FEB 23, 1977
C	FEB 22, 1977
C
C
C
C	INTRODUCTION
C	------------
C	APPLY.FT IS A CHAINED PROGRAM USED WITH BMON2
C	IT RECEIVES ITS ARGUMENTS FROM THE CD AREA AND THE IBM1,IHGH1
C	IBM2,IHGH2, JBM, JHGH  VARIABLES IN COMMON. COMMON IS RESTORED
C	FIRST BEFORE THE FUNCTION (TO BE INSERTED INTO THE BODY) IS
C	EVALUATED. AFTER THE FUNCTION IS PERFORMED, COMMON
C	IS SAVED AND BMON2 IS CHAINED BACK TO.
C	ANY COMPUTATIONS ARE DONE, THE ARGUMENTS ARE THEN CHECKED
C
C	<Opt.BM0>_APPLY,<.BT template file>,<Opt. BM1,BM2,BM3>,
C		<Opt. n1,n,n3 args>
C	- Apply the Batch .FT template file to the specified argument
C	list to generate a specific instance Batch input file
C	SYS:JUNKTM.BI. This latter file is then submitted to Batch. The
C	APPLY operation copies thetemplate file into JUNKTM.BI. In the
C	process it searches for the patterns "?i" and "%j". The "?i" template
C	corresponds to the pattern for BMi and the "%j" to the pattern for nj.
C	the actual values are then copied into the JUNKTM.BI file
C	instead thus allowing dynamic argument evaluation for
C	complex operations at run time.
C	OPDEFS
C	------
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
C
S	OPDEF	MUY	7405
S	OPDEF	DVI	7407
C
S	OPDEF	DISP2	6436
S	OPDEF	DISP1	6435
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF   KRS	6034
S	OPDEF	BSW	7002
C
C
S	OPDEF	HPL	6360
S	OPDEF	HSL	6361
S	OPDEF	VPL	6362
S	OPDEF	VSL	6363
C	[1] INITIALIZATION
	WRITE(1,995)
995	FORMAT('APPLY 2/22/77 - 4:01PM')
	ET=TIMER(0)
C
C
C
C	[2] PROCESS APPLY
C
C
C	[2.1] LOOKUP THE TEMPLATE FILE
	IF(IO(KDEVIN(2),KINFILE(5),'BT',1))111,120,111
111	WRITE(1,112)(KINFILE(K),K=5,7)
112	FORMAT(' BATCH TEMPLATE FILE ',3A2,'.BT NOT FOUND!')
	GOTO 999
C
C
C	[2.2] ENTER SYS:JUNKTM.BI FILE
120	IF(IO(1,'JUNKTM','BI',3))121,130,121
121	WRITE(1,122)
122	FORMAT(' I/O ERROR!')
	GOTO 998
C
C
C	[2.3] COPY FILE TO ^Z
130	CONTINUE
S	CALL 0,INNC
S	DCA \ICHAR
C
C
C	[2.3.1] LOOK FOR ^Z
S	TAD \ICHAR
S	TAD (-232
S	SZA CLA
S	JMP \140 /CONTINUE
C
C	[2.3.1.1] EOF
	IF(IO(1,0,0,5))131,998,131
C
C
C	GO SUBMIT JUNKTM.BI TO BATCH
131	CURSYM='JUNKTM'
	IVAL=15
	CALL BMAX2
C
C
C	[2.3.2] TEST FOR ? PATTERN
S \140,	TAD \ICHAR
S	TAD (-"? /BM TEMPLATE
S	SZA CLA
S	JMP \150 /NO
C
C	[2.3.2.1] YES, READ NEXT CHAR
S	CALL 0,INNC
S	DCA \ICHAR
C
C	IF (0 LEQ ICHAR LEQ 3)
C		THEN SUBSTITUE I'TH BMI
C		ELSE ERROR
S	TAD \ICHAR
S	TAD (-"0
S	SPA CLA
S	JMP \199 /TEMPLATE MATCH ERROR
S	TAD \ICHAR
S	TAD (-"4
S	SMA CLA
S	JMP \199 /TEMPLATE MATCH ERROR
C
C	[2.3.2.2] LOOK UP BMI
	I=I+1
	GOTO(141,142,143,144),I
C
C
C	BM0 IS BMJ
141	MEM=JBM
	IBYTE=JHGH
S	JMS CKOUT
	GOTO 145
C
C
C	BM1 IS BMI1
142	MEM=IBM1
	IBYTE=IHGH1
S	JMS CKIN
	GOTO 145
C
C
C	BM2 IS BMI2
143	MEM=IBM2
	IBYTE=IHGH2
S	JMS CKIN2
	GOTO 145
C
C	BM3 IS 5'TH INPUT FILE NAME WHICH WE NEED TO PARSE
S \144,	JMS CKIN3 /CHECKS AND PARSES!
	MEM=IBM3
	IBYTE=IHGH3
C
C
C	[2.3.2.3] GENERATE OUTSTR("BM"&CVS(MEM)&
C		(IF IBYTE=1 THEN "H" ELSE NULL));
S \145,	TAD ("B
S	CALL 0,OUTC
S	TAD ("M
S	CALL 0,OUTC
C
S	TAD \MEM
S	TAD (260
S	CALL 0,OUTC
C
S	TAD \IBYTE
S	SNA CLA
S	JMP \130 /NO "H", CONTINUE SCAN
S	TAD ("H
S	CALL 0,OUTC
	GOTO 130
C
C
C	[2.3.3] TEST FOR "%"
S \150,	TAD \ICHAR
S	TAD (-"%
S	SZA CLA
S	JMP \160 /NO, GO COPY CHAR
C
C	[2.3.3.1] YES, GET J IN "%J"
S	CALL 0,INNC
S	DCA \ICHAR
C
C	IF (1 LEQ ICHAR LEQ 3)
C		THEN SUBSTITUE CVS(ICNUM(ICHAR LAND '3))
C		ELSE TEMPLATE ERROR;
C
S	TAD \ICHAR
S	TAD (-"1
S	SPA CLA
S	JMP \199 /TEMPLATE # ERROR
S	TAD \ICHAR
S	TAD (-"4
S	SMA CLA
S	JMP \199 /TEMPLATE # ERROR
C
C	[2.3.3.2] LOOKUP CORRESPONDING ICNUM(ICHAR) AND CVS IT.
S	TAD \ICHAR
S	AND (3
S	DCA \IX
C	OUTSTR(CVS(ICNUM(IX));	
	IC=ICNUM(IX)
S	JMS CVID
C
C	[2.3.3.3] OUTSTR IT
	DO 151 I=1,4
	IC=I10(I)
S	TAD \IC
S	TAD (60
S	CALL 0,OUTC
151	CONTINUE
C	CONTINUE THE SCAN
	GOTO 130
C
C
C	[2.3.4] NOT A TEMPLATE CHAR, COPY IT
S \160,	TAD \ICHAR
S	CALL 0,OUTC
C	CHECK IF EXIT
S	CPAGE 3
S	JMS TTYCTL
S	JMP \998 /EXIT
C	CONTINE THE SCAN
	GOTO 130
C
C
C
C
C
C	********ERRORS********
199	WRITE(1,198)ICHAR
198	FORMAT(' TEMPATE # ',I5,' OUT OF RANGE - ABORT!)
	GOTO 998
C
C
C	BM NOT SPECIFIED IN CALL TO APPLY
197	WRITE(1,196)(I-1)
196	FORMAT(' BM',I1,' IS NOT SPECIFIED IN CALL TO APPLY. ABORT!')
	GOTO 998
C
C	[999] RETURN
	GOTO 998
999	WRITE(1,996)
996	FORMAT('BAD BM SPECIFICATION!')
998	ET=TIMER(1)
	CALL CHAIN('BMON2')
C***************************************************
C	*PROCEDURE      C K O U T
C******************************************************
C
C
C	CHECK WHETHER THE OUTPUT BM SPEC IS LEGAL ELSE GOTO 197.
S	CPAGE 3
SRCKOUT,	JMP I CKOUT
S CKOUT,	0 /ENTRY
C
C	[1] TEST IF KOUTFILE="BM"
S	TAD \KOUTFILE
S	CIA
S	TAD BMTEXT
S	SZA CLA
S	JMP \197 /FAILED
C
C	[2] TEST IF (KOUTFILE(2) LAND '7700)=DIGIT
S	TAD \KOUTFILE#
S	BSW
S	AND (0077
S	TAD (-60 /"0"
S	SPA
S	JMP \197 /NO, FAILED
S	TAD (-D8 /"7" TEST
S	SMA CLA
S	JMP \197 /FAILED
S	JMP RCKOUT /OK.
C
C
C***************************************************
C	*PROCEDURE      C K I N
C******************************************************
C
C
C	CHECK WHETHER THE INPUT BM SPEC IS LEGAL ELSE GOTO 197.
S	CPAGE 3
SRCKIN,	JMP I CKIN
S CKIN,	0 /ENTRY
C
C	[1] TEST IF BMI1="BM"
S	TAD \SFILE
S	CIA
S	TAD BMTEXT
S	SZA CLA
S	JMP \197 /FAILED
C
C	[2] TEST IF (BMI1(2) LAND '7700)=DIGIT
S	TAD \SFILE#
S	BSW
S	AND (0077
S	TAD (-60 /"0"
S	SPA
S	JMP \197 /NO, FAILED
S	TAD (-D8 /"7" TEST
S	SMA CLA
S	JMP \197 /FAILED
S	JMP RCKIN /OK.
C
C
C***************************************************
C	*PROCEDURE      C K I N 2
C******************************************************
C
C
C	CHECK WHETHER THE INPUT BM SPEC IS LEGAL ELSE GOTO 197.
S	CPAGE 3
SRCKIN2,	JMP I CKIN2
S CKIN2,	0 /ENTRY
C
C	[1] CHECK FIRST IBM1 SPEC
S	JMS CKIN
C
C
C	[2] TEST IF BMI2="BM"
S	TAD \SEXT
S	CIA
S	TAD BMTEXT
S	SZA CLA
S	JMP \197 /FAILED
C
C	[3] TEST IF (BMI2((6) LAND '7700)=DIGIT
S	TAD \SEXT#
S	BSW
S	AND (0077
S	TAD (-60 /"0"
S	SPA
S	JMP \197 /NO, FAILED
S	TAD (-D8 /"7" TEST
S	SMA CLA
S	JMP \197 /FAILED
S	JMP RCKIN2 /OK.
C
C
C***************************************************
C	*PROCEDURE      C K I N 3
C******************************************************
C
C
C	CHECK WHETHER THE INPUT BM SPEC IS LEGAL ELSE GOTO 197.
S	CPAGE 3
SRCKIN3,	JMP I CKIN3
S CKIN3,	0 /ENTRY
C
C	[1] CHECK FIRST IBM1 SPEC
S	JMS CKIN2
C
C
C	[3] TEST IF BMI3="BM"
	IA=KINFILE(16)
	IB=KINFILE(17)
C
S	TAD \IA
S	CIA
S	TAD BMTEXT
S	SZA CLA
S	JMP \197 /FAILED
C
C	[3] TEST IF (BMI3((6) LAND '7700)=DIGIT
S	TAD \IB
S	BSW
S	AND (0077
S	TAD (-60 /"0"
S	SPA
S	JMP \197 /NO, FAILED
S	TAD (-D8 /"7" TEST
S	SMA CLA
S	JMP \197 /FAILED
C
C
C	GET THE MEMORY NUMBER INTO IBM3
S	TAD \IB
S	BSW
S	AND (7
S	DCA \IBM3
C
C	GET THE "H" SWITCH INTO IHGH3
S	TAD \IB
S	AND (77
S	TAD (-0010 /"@H"
S	SNA CLA
S	CLA IAC
S	DCA \IHGH3
S	JMP RCKIN3 /OK.
C
C
C***************************************************
C	*PROCEDURE      C V I D
C******************************************************
C
C
C	CONVERT IC TO I10[1:4] DECIMAL DIGITS.
S	CPAGE 3
S RCVID,	JMP I CVID
S CVID,	0
C
C
C	ZERO THE HIGH ORDER OF IC
S	DCA \IC#
C
	CALL DPCVRT(IC,FA,-1)
C
C
C	NOW GET DIGITS
	I10=FA/1000.0
	IZ=FA-(FLOAT(I10)*1000.0)
C
	I11=IZ/100
	IZ=IZ-(I11*100)
C
	I12=IZ/10
	I13=IZ-(I12*10)
S	JMP RCVID /OK.
C
C
C	************************************************************
C	SUBROUTINE:	T T Y C T L	(INTERNAL)
C	************************************************************
C
S	CPAGE 3
S RTTYC,	JMP I TTYCTL
S TTYCTL,	0000	/ENTRY
C
S	KSF	/ANYTHING TYPED
S	JMP NORMAL	/NO, RETURN NORMALLY
S	KRB	/GET TYPED CHARACTER
S	AND (0177	/TAKE CARE OF PARITY PROBLEMS
S	TAD (-17	/TEST FOR CTRL/O
S	SNA	/SKIP IF NOT CTRL/O
S	JMP RTTYC	/ABORT CALLING ROUTINE (ERROR RETURN)
S	TAD (-4	/TEST FOR CTRL/S [-17-4=-23(OCTAL)]
S	SZA CLA	/SKIP IF CTRL/S
S	JMP NORMAL	/NOT CTRL/O OR CTRL/S SO RETURN NORMALLY
C
S SLEEP,KSF	/WAIT FOR CTRL/Q
S	JMP SLEEP	/KEEP WAITING
S	KRB	/READ CHARACTER
S	AND (0177
S	TAD (-17	/IS IT A CTRL/O?
S	SNA	/SKIP IF NOT
S	JMP RTTYC	/YES, ABORT
S	TAD (-2	/TEST FOR CTRL/Q (-17-2=-21 OCTAL)
S	SZA CLA	/SKIP IF SO
S	JMP SLEEP	/NOPE, KEEP SLEEPING
C
S NORMAL,INC TTYCTL	/INCREMENT RETURN ADDRESS FOR NORMAL RETURN
S	CLA	/SAFETY VALVE
S	JMP RTTYC	/RETURN
C************** P A R A M E T E R S *************
S BMTEXT,	TEXT /BM/
	END