C	PROGRAM BCDSPEC.FT AND (BSEARCH.FT)
C	----------------------
C
C
C
C	**SUBROUTINE        M C D S P E C                            *
C
C
C
C	P. LEMKIN AND G. GROSFELD
C	NATIONAL INSTITUTES OF HEALTH
C	BETHESDA, MD 20014
C
C
C	SEPT 2, 1976
C	REV SEPT 1, 1976
C	REV AUG 27, 1976
C	AUG 12, 1976 - ADDED TEST FOR * AND ? IN CD.4.
C	REVISED AND RENAMED AUB 2, 1976 - LEMKIN
C	JULY 16, 1975
C	REVISED JAN 11, 1976
C
C
C	PURPOSE
C	-------
C	DECODE THE COMMAND DECODER LINE REQUESTED IN "SPECIAL MODE"
C	SUCH THAT IF THE FILE IS A NUMBER THEN A CORRESPONDING VALUE
C	IS STORED INTO ICNUM[1:5] FOR THE FIVE INPUT FILES. THE OUTPUT
C	FILE IS STORED IN KOUTFILE[1:4] AND THE FIRST INPUT
C	FILE IN KINFILE[1:4]. THE INPUT AND OUTPUT DEVICES ASSOCIATED 
C	WITH THE FILE NAMES ARE STORED IN KDEVOUT AND KDEVIN RESPECTIVELY.
C	THE SWITCHES ARE STORED IN VARIABLES ISW[1:36].
C
C
C	VARIABLES
C	---------
C	ICNUM[1:5] - CONVERTED NUMBERS FROM EQU. FILE NAMES (DEC. NAMES)
C	KOUTFILE[1:4] - OUTPUT FILE
C	KDEVOUT - OUTPUT DEVICE
C	KINFILE[1:20] - INPUT FILE
C	KDEVIN[5] - INPUT FILE DEVICES 
C	ISW[1:36] - SWITCH ARRAY A,B,C...Z,0,1,2,3,4,5,6,7,8,9.
C	MCD[1:40] - IS A COPY OF THE CD AREA AFTER SPEC. CD IS CALLED
C		  MCD[1]   = OUTPUT DEVICE
C		  MCD[2:5] = OUTPUT FILE NAME AND EXTENSION
C		  MCD[6]   = INPUT SPEC #1 DEVICE
C		  MCD[7:10] = INPUT SPEC #1 FILE NAME AND EXTENSION
C		  MCD[11]   = INPUT SPEC #2 DEVICE
C		  MCD[12:15] = INPUT SPEC #2 FILE NAME AND EXTENSION
C		  MCD[16]   = INPUT SPEC #3 DEVICE
C		  MCD[17:20] = INPUT SPEC #3 FILE NAME AND EXTENSION
C		  MCD[21]   = INPUT SPEC #4 DEVICE
C		  MCD[22:25] = INPUT SPEC #4 FILE NAME AND EXTENSION
C		  MCD[26]   = INPUT SPEC #5 DEVICE
C		  MCD[27:30] = INPUT SPEC #5 FILE NAME AND EXTENSION
C		  MCD[35] = HIGH ORDER 11 BITS OF =N OPTION
C		  MCD[36:38] = SWITCHES /A/B/C.../9
C		  MCD[39] = LOW ORDER 12 BITS OF =N OPTION
C
C
C
C
C
C
S	OPDEF	TADI 1400
S	OPDEF	DCAI 3400
S	OPDEF BSW 7002
C
S	ENTRY BCDSP
S	CPAGE 2
S BCDSP,	BLOCK 2 /ENTRY
C
C	[CD.1] CALL THE COMMAND DECODER
S	CPAGE 3
S	JMS 45 /CDFSKP
S	NOP
S	6212 /CIF 10
S	CPAGE 5
S	JMS 7700 /JMS USR
S	5 /COMMAND DECODER
S	5200 /.* USED TO DENOTE SPECIAL MODE
S	0000 /PRESERVE ALL TENTATIVE FILES
C
C
C
C		[CD.1.1] RESET THE TTY: OUTPUT FLAG FOR LATER FORTRAN
C		I/O SO THAT WE DO NOT HANG THERE...
S		TLS /OUTPUT A NULL...
S FIXUP,	TSF
S		JMP FIXUP
C
C
C	[CD.2] COPY THE CD AREA TO MCD[1:40]
	DO 1700 I=1,40
S	TAD (7577
S	TAD \I
S	DCA 7
S	6211 /CDF 7
S	1407 /TADI 7
S	CPAGE 3
S	JMS 45 /CDFSKP
S	NOP
S	DCA \ICD
1700	MCD(I)=ICD
C
C
C	[CD.3] SET OUTPUT FILE NAME
	DO 1703 I=1,4
1703	KOUTFILE(I)=MCD(I+1)
	KDEVOUT=MCD
S	TAD \KDEVOUT
S	AND (0017
S	DCA \KDEVOUT
C
C
C
C
C
C
C
C	[CD.4] SCAN THE 5 INPUT FILES FOR DIGIT NAMES AND PUT
C	INTO ARRAY ICNUM[1:5].
C	ZERO THE INPUT FILE NAMES
C	INIT THE ICNUM PTR
	ICNPTR=1
C
	DO 1807 I=1,20
1807	KINFILE(I)=0
C	ZERO THE ICNUM ARRAY
	DO 1705 N=1,5
	ICNUM(N)=0
C	ALSO ZERO THE INPUT FILE DEVICES
	KDEVIN(N)=0
C	TEST IF FILE NAME IS DIGITS AND THEN CONVERT.
C	COMPUTE THE INDEX OF MCD INPUT FILE FOR N'TH INPUT FILE.
	J=(N-1)*5+7
C	IF FIRST CHARS="*@" THEN DEOCODE AS ASCII NAME
	IY2=MCD(J)
S	TAD \IY2
S	TAD (-5200 /"*@"
S	SNA CLA
S	JMP \1805 /ASCII
C
C	TEST FOR ? IN FIRST CHAR OF WORD
S	TAD \IY2
S	AND (7700
S	TAD (-7700 /"?@"
S	SNA CLA
S	JMP \1805 /ASCII
C
C	IF < 0 THEN 60+DIGIT ==> NUMBER DECODE.
	IF(IY2) 1706,1805,1805
C
C
C		[CD.4.1] IT IS AN ASCII NAME, PUT IT INTO KINFILE ARRAY
1805		DO 1806 I=1,4
C		COMPUTE:	L=(N-1)*4+I
S		CLA CMA
S		TAD \N
S		CLL RAL; CLL RAL
S		TAD \I
S		DCA \L
C
C		ALSO COPY THE DEVICE NUMBER INTO KDEVIN ARRAY
		IY2=MCD(J-1)
S		TAD \IY2
S		AND (0017
S		DCA \IY2
		KDEVIN(N)=IY2
1806		KINFILE(L)=MCD(J+I-1)
		GOTO 1705
C
C
C		[CD.5.2] IT IS DIGITS, CONVERT AND PACK INTO ICNUM ARRAY
1706		DO 1707 I=1,2
		K=MCD(J+I-1)
		DO 1707 K2=1,2
S		TAD \K
S		BSW
S		DCA \K
S		TAD \K
S		AND (0077
S		SNA /TEST IF DONE
S		JMP \1708
S		TAD (-0060
S		DCA \IX2
1707		ICNUM(ICNPTR)=ICNUM(ICNPTR)*10+IX2
C
S\1708,		INC \ICNPTR
1705	CONTINUE
C
C
C	[CD.5] CONVERT THE SWITCHES
	I=0
	DO 1709 N=36,38
	K=MCD(N)
		DO 1709 J=1,12
S		TAD \K
S		RAL
S		DCA \K
S		RAL
S		DCA \KSW /SAVE 0000 OR 0001 EQV OF SWITCH
C
S		INC \I
1709	ISW(I)=KSW
C
C
C
C	[CD.6] RETURN
S	RETRN BCDSP
C
C
C	PROGRAM BSEARCH.FT
C	----------------
C
C
C	####SUBROUTINE BSEARCH
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	NOV 15, 1976
C
C
C
C	INTRODUCTION
C	------------
C
C	BSEARCH SEARCHES THE DISK DIRECTORYS UNTIL IT COMES
C	ACROSS THE CURSYM&".SV". IT THEN COPIES THE
C	FILE TO SYS:JUNK.SV IF IT IS NOT ON SYS: AND THEN
C	RETURNS WITH IP=62 AND CURSYM=  CHAIN FILE NAME.
C	IF IT IS NOT VALID, IT THEN ZEROS IP AND
C	RETURNS.
S	ENTRY BSEAR
S BSEAR,	BLOCK 2
C
C
C	[1] INITIALIZATION
C	IF CURSYM=NULL THEN RETURN FAILURE
S	TAD \CURSYM
S	SNA CLA
S	JMP \999 /FAILED
C
C
C	SETUP DEVICE NAMES POINTER
S	CLA CMA
S	TAD PTBL
S	DCA 11
C
C
C
C	[2] LOOK UP FILE ON DEV SEARCH LIST
	DO 100 I=1,8
S	TAD I 11
S	DCA \DV
S	TAD I 11
S	DCA \DV#
C
S	TAD (2326 /'SV'
S	DCA \EXT
C
C
	IF(IO(DV,CURSYM,EXT,1))100,200,100
100	CONTINUE
C	FELL THROUGH, FILE NOT FOUND
999	IP=0
C
C
C	RETURN
S \998,	RETRN BSEAR /RETURN BECAUSE FAILED.
C
C
C	[3] FOUND FILE, TEST IF SYS:
200	IF(I-1) 999,998,300
C
C
C
C	[4] NOT SYS:, COPY FILE TO SYS:JUNK.SV
300	CURSYM='JUNK'
	IF(IO(1,CURSYM,EXT,3))999,400,999
C
C
C	[5] GET # BLOCKS TO COPY
400	I=IO(I,I,LSNUM,13)
C	FORCE >0 AND ADD 3 TO CARRY TO NEXT BLOCK XFER
	LSNUM=3-LSNUM
C
C
C	[6] XFER DATA
	DO 600 IX1=1,LSNUM,4
	DO 600 IX2=6,7
	IF(IO(4,IBUF1,0,IX2))999,600,999
600	CONTINUE
C
C
C	[7] CLOSE FILE
	IF(IO(0,0,0,5))999,998,999
C
C
C
C
C
C
C	****PARAMETER****
S PTBL,	TBL
S	CPAGE 20
S TBL, 2331 /SY
S	2300 /S@
S	TEXT /DSKBDSKCDSKDDSKEDSKFDSKGDSKH/
C
	END