C	PROGRAM DOSCAN.FT
C	--------------
C
	SUBROUTINE DOSCAN(KIROW,KICOL,FILE,EXT,IH,ICLASS,NT)
C
C
C
C
C	P.LEMKIN
C	NATIONAL INSTUTUTES OF HEALTH
C	BETHESDA, MD 20014
C
C
C	JAN 24, 1978
C	JAN 15, 1978 /CHANGED BUFFER PACKING FOR EFFICIENCY.
C	JAN 14, 1978 /MODIFIED BMTOMTA.FT TO GET DOSCAN.FT
C
C	PURPOSE
C	--------
C	READ ELECTRON MICROSCOPE SCANNER IN GROUPS OF 256X256
C	IMAGES AND WRITE THESE OUT ON MTA0: TAPE FILE "FILE.EXT"
C	NOTE: FIELD 5 IS USED AS A MAGTAPE BUFFER.
C
C	NOTE: EM SCANNER INTERFACE DEVICE CODES ARE DEFINED IN THE
C	OPDEF SECTION OF THIS SUBROUTINE.
C
C	ARGUMENTS
C	---------
C	KIROW - FIRST ROW TO START THE SCAN
C	KICOL - FIRST COL TO START THE SCAN
C	FILE - FILE NAME FOR HEADER
C	EXT - FILE EXT NAME FOR HEADER
C	IH - 256 WORD FILE HEADER
C	ICLASS - CLASS NUMBER FOR HEADER
C	NT - NUMBER OF TIMES TO AVG HEADER.
C
C	OPDEFS
C	------
S	OPDEF	SWBA 7447
S	OPDEF	SWAB 7431
S	OPDEF	DAD 7443
S	OPDEF	DST 7445
C
C	EAE OPDEFS
C	----------
S	OPDEF CLAMQ 7621
S	OPDEF MQL 7421
S	OPDEF MQA 7501
S	OPDEF DVI 7407
S	OPDEF BSW 7002
C
C	FAST INDIRECT IOTS
C	-----------------
S	OPDEF TADI 1400
S	OPDEF DCAI 3400
C
C
C
C	SPECIAL IOTS ADDED TO PDP8E/ELECTRON MICROSCOPE INTERFACE
C	------------------------------------------------------
S	OPDEF LDSCNX 7200 /LOAD C(AC[1:11])==> SCANNER X COORD. REG
S	OPDEF LDSCNY 7200 /LOAD C(AC[1:11])==> SCANNER Y COORD. REG
S	OPDEF STSCAN 7200 /START SCANNER 
S	SKPDF SCNSKP 7200 /SKIP ON SCANNER DATA READY
S	OPDEF RDATA 7200 /READ SCANNER DATA IN DECIMAL 
C
C
C
	DIMENSION MAGHEADER(256),IDATA(2)
C
	DIMENSION KOUTFILE(4)
	EQUIVALENCE (KOUTFILE(4),KEXT)
C
C	***************** P A R A M E T E R S *********
	GOTO 1
S	DUMMY OS8DATE
S	CPAGE 2
S OS8DATE,	6211
S		7666
S	DUMMY MAGBUFFER
S	CPAGE 2
S MAGBUFFER,	6251 /  CDF 50
S		0
1	CONTINUE
C
C	*************************************************
C
C
C	[1] COPY PARAMETERS
	IROW=KIROW
	ICOL=KICOL
	NTIMES=NT
C
C	COPY KOUTFILE[1:4]<==FILE.EXT
	DO 2 I=1,3
S	TAD I \FILE /GET 2 CHARS
S	DCA \ITWOCHARS
	KOUTFILE(I)=ITWOCHARS
S	INC \FILE#
2	CONTINUE
C	GET EXT
S	TAD I \EXT
S	DCA \KEXT
C
C	GET THE MTA UNIT #
C	DEFINE THE RECORD SIZE AS 3456 BYTES
	MWDCT=2000+1456
C
C	DEFINE THE TAPE AS 9 TRACK 800 BPI BYTE MODE
	KBYTMODE=0
	JUNIT=0
C
C	DO NOT VERIFY !!!
	IVERIFY=0
C
C
C
C	[2] WRITE THE FILE TO MTA
C	TEST IF INITIAL EOF EXISTS. IF NOT FORCE IT TO!
C	BACKSPACE RECORD TO SEE IF BOT
	IOPR=7
	CALL MAGTAP(1,0,IOPR,MTRS,0,JUNIT)
C	IF BOT 
C		THEN NOT INITIAL EOF
S	TAD \MTRS
S	AND (1000
S	SNA CLA
S	JMP \131 /NOT BOT, ADV 1 REC
C
C	WAS BOT, WRITE INIT EOF
	WRITE(1,132)
132	FORMAT(' WRITING INITIAL EOF!')
	IOPR=5
	CALL MAGTAP(0,0,IOPR,MTRS,KBYTMODE,JUNIT)
	GOTO 133
C
C	NOT BOT , ADV REC
131	IOPR=6
	CALL MAGTAP(1,0,IOPR,MTRS,KBYTMODE,JUNIT)
C
C
C	[3] WTFILE
133	CALL WTFILE
C
	RETURN
C	*************************************************
C	* SUBROUTINE    U N P A C K H E A D E R
C	*************************************************
C	UNPACK 3/2 IH ==> MAGBUFFER
S	ENTRY UNPAC
S	CPAGE 2
S UNPAC,	BLOCK 2
C
C	[1] 3/2 UNPACK (I.E. 3-BYTES FROM 2-PDP8E WORDS)
C	FOR 3456 BYTES FROM 9 BLOCKS. 3456 BYTES/3=1152.
C
C
C	[1.1] SETUP PTRS COUNTER
C	AUTOINDEX 15= MAGBUFFER
S	CLA CMA
S	DCA 15
C
C
C	[2] LOOP AND CVT
	DO 1888 I=1,128
S	TAD I \IH /1ST WORD, B3[0:3]&B1
S	INC \IH#
S	DCA 25
S	TAD I \IH /2ND WORD, B3[4:7]&B2
S	INC \IH#
S	DCA 26
C
C	[2.1] UNPACK AND STORE
S	CPAGE 34
S	6251 /CDF 50, MAGBUFFER
S	TAD 25
S	AND (0377 /B1
S	DCAI 15
S	TAD 26
S	AND (0377 /B2
S	DCAI 15
S	TAD 25 /GET B3[0:3]
S	RTR; RTR
S	AND (0360 /TO 4:7
S	MQL
S	TAD 26 /GET B3[4:7]
S	RTL; RTL; RAL
S	AND (0017 /TO 8:11
S	MQA
S	DCAI 15 /PUSH B3
S	JMS 45 /CDFSKP
S	NOP
1888	CONTINUE
C
C
C	[3] YES, RETURN
S	CPAGE 3
S	RETRN UNPAC /RETURN
C	*************************************************
C	* SUBROUTINE    W T H E A D E R
C	*************************************************
C	WRITE THE MAGTAPE HEADER CONSISTING OF THE 4 TUPLE:
C	KOUTFILE(1:3) - FILE NAME (6 BYTES)
C	KOUTFILE(4) - FILE EXTENSION (2 BYTES)
C	IBLKCNT - FILE LENGTH IN OS/8 BLOCKS (2 BYTES HI,LOW)
C	IDATE - OS/8 DATE WORD ( 3 BYTES), (YR, MONTH, DAY)
S	ENTRY WTHEA
S	CPAGE 2
S WTHEA,	BLOCK 2
C
C
C	[1] CVT 6 BIT TO 8 BIT
	K=0
	DO 200 I=1,4
	J=KOUTFILE(I)
S	TAD \J
C@S	RTR; RTR; RTR
S	BSW /ALTERNATE MICROCODE
S	AND (0077
S	TAD (-40
S	SPA /IF A:Z THEN < 0 SO ADD 300 INSTEAD OF 200
S	TAD (100 /A:Z
S	TAD (240
S	DCA \J1
S	TAD \J /GET THE 2ND 1/2
S	AND (0077
S	TAD (-40
S	SPA
S	TAD (100
S	TAD (240
S	DCA \J2
S	INC \K
	MAGHEADER(K)=J1
S	INC \K
200	MAGHEADER(K)=J2

C	[2] PUSH THE BLOCK COUNT
S	TAD \IBLKCNT
C@S	RTR; RTR; RTR; RTR
S	BSW RTL /ALTERNATE MICROCODE
S	AND (17 /TOP 4 BITS
S	DCA \J1
S	TAD \IBLKCNT
S	AND (377
S	DCA \J2
S	INC \K
	MAGHEADER(K)=J1
S	INC \K
	MAGHEADER(K)=J2
C
C
C	[3] PUSH THE OS/8 DATE WORD
S	TAD I OS8DATE /GET YEAR
S	AND (7 /YEAR
S	DCA \KYEAR
S	INC \K
	MAGHEADER(K)=KYEAR
C
S	TAD I OS8DATE /GET MONTH
S	CLL RAL; RTL; RTL
S	AND (17 /MONTH
S	DCA \KMONTH
S	INC \K
	MAGHEADER(K)=KMONTH
C
S	TAD I OS8DATE /GET DAY
S	CLL RAR; RTR
S	AND (37 /DAY
S	DCA \KDAY
S	INC \K
	MAGHEADER(K)=KDAY
C
C
C
C
C	[4] WRITE OUT THE RECORD OF 3456 BYTES, FROM MAGHEADER BUFFER
C	BYTE MODE
C
C	INIT PARITY SWITCH
	IPARITY=-50
C
C	TEST FOR > IPARITY TRYS
S \240,	ISZ \IPARITY
S	JMP \245/ OK
C
C	FATAL PARITY ERROR
C	GOTO [WTFILE.2.2.1]
	GOTO 732
C
245	IOPR=4
	CALL MAGTAP(MWDCT,MAGHEADER,IOPR,MTRS,KBYTMODE,JUNIT)
C
C
C	[4.1] TEST FOR EOT AND PARITY ERROR
S	TAD \MTRS /EOT?
S	AND (0040
S	SZA CLA
S	JMP \250 /FATAL EOT
C
S	TAD \MTRS /PARITY?
S	AND (1616
S	SNA CLA
S	JMP \299 /OK
C
C
C	[4.2] BACKSPACE AND TRY AGAIN
	IOPR=7
	CALL MAGTAP(1,0,IOPR,MTRS,KBYTMODE,JUNIT)
	GOTO 240
C
C
C
C
C	[4.3] FATAL EOT FOUND
C	GOTO [WTFILE.3]
250	GOTO 750
C
C	[5] RETURN
S \299,	RETRN WTHEA /RETURN
C
C	*************************************************
C	* SUBROUTINE    W T F I L E
C	*************************************************
C	WRITE THE NEXT MAGTAPE FILE WITH THE NAME 
C	OS8 FILE "EXT:KOUTFILE[1:4]" USING 256X256 SCAN AT
C	(IROW,ICOL).
C
S	ENTRY WTFIL
S	CPAGE 2
S WTFIL,	BLOCK 2
C	[1.1] PRINT THE FILE NAME
C	FIRST PRINT OUT THE FILE.
710	WRITE(I,711)KOUTFILE,ICLASS,IROW,ICOL
711	FORMAT(' W: ',3A2,'.',A2,,' CLASS#: ',I3,
     1', <== ROW,COL(',I4,',',I4,')')
C
C
C	[1.2] NOW SET FILE LENGTH
	IBLKCNT = 173
C
C
C	[1.3] WRITE THE MAGTAPE HEADER
	IRECORD=0
	IPARERR=0
	IPARFIX=0
	CALL WTHEADER
C
C
C	[2] RECORD TRANSFER LOOP.
C	WRITE 1 MAGTAPE RECORD OF 3456 BYTES FROM MAGBUFFER
C	AFTER CONVERTING SCANBUFFER ==> MAGBUFFER.
C
720	IRECORD=IRECORD+1
C
C	RESET PARITY COUNTER SPECIFYING # OF RETRIES
	IPARITY=-50
C
C	DECREMENT NUMBER-OF-BLOCKS-LEFT COUNTER
	IBLKCNT=IBLKCNT-9
C
C
C	[2.1] READ 9 BLOCKS==>SCANBUFFER
	CALL GETSCANBUF
C
C
C	[2.2] WRITE OUT MAGBUFFER.
C	COPY BUFFER POINTER
S \731,	TAD MAGBUFFER
S	DCA AM3
S	TAD MAGBUFFER#
S	DCA AM3#
C
S	CPAGE 16
	IOPR=4
S	CALL 6,MAGTA
S	ARG \MWDCT /WORD COUNT
S AM3,	ARG MAGBUFFER
S	ARG \IOPR
S	ARG \MTRS
S	ARG \KBYTMODE
S	ARG \JUNIT
C
C	TEST FOR EOT
S	TAD \MTRS
S	AND (0040
S	SZA CLA
S	JMP \750 /FATAL ERROR, PRINT MSG AND REWIND - GIVE UP-
C
C
C	IF /V THEN BACKSPACE AND DO READ COMPARE
	IF(IVERIFY)1731,1732,1731
1731	IOPR=7
	CALL MAGTAP(1,0,IOPR,MTRS,KBYTMODE,JUNIT)
C	SETUP READ BUFFER CALL
S	TAD MAGBUFFER
S	DCA AM4
S	TAD MAGBUFFER#
S	DCA AM4#
C
	IOPR=3
S	CPAGE 16
S	CALL 6,MAGTA
S	ARG \MWDCT /WORD COUNT
S AM4,	ARG MAGBUFFER
S	ARG \IOPR /READ COMPARE
S	ARG \MTRS
S	ARG \KBYTMODE
S	ARG \JUNIT
C
S\1732,	TAD \MTRS /TEST FOR PARITY ERROR
S	AND (1636 /RC ERROR TRAP
S	SNA CLA
S	JMP \740 /NO ERRORS
C
C	TEST IF > 50 PARITY RETRIES
S	ISZ \IPARITY
S	SKP
S	JMP \732 /FATAL ERROR
C	NOT > 10 YET, SO BACKUP AND TRY AGAIN.
	IOPR=7
	CALL MAGTAP(1,0,IOPR,MTRS,KBYTMODE,JUNIT)
C	SINCE WE HAD AN ERROR, TRY MOVING AHEAD ON THE TAPE
	GOTO 731
C
C
C	[2.2.1] FATAL PARITY ERROR
732	WRITE(1,733)
733	FORMAT(' WRITE PARITY ERR')
     1,  FILE:',3A2,'.',A2)
	IPARERR=IPARERR+1
C
C
C	[2.3] TEST IF AT END OF FILE THEN DONE, WRITE
C	2 EOFS ON MTA: ELSE GOTO [2].
C	TEST IF RECOVERABLE PARITY ERROR IF (-50 <IPARITY < 0)
C	THEN INCREMENT FIXED ERROR COUNTER
S \740,	TAD \IPARITY
S	SNA CLA
S	JMP \749 /WAS FATAL ERROR, JUST CONTINUE 
C
C	TEST IF MORE THAN 1 READ
S	TAD \IPARITY
S	TAD (D50
S	SZA CLA
S	ISZ \IPARFIX /YES FIXED PARITY
S	CLA
C
C	RESET DRIVE TO WRITE STANDARD GAP
749	KBYTMODE=0
C
C	TEST IF WROTE OUT ALL BLOCKS
	IF(IBLKCNT)741,741,720
C
C
C	[2.4] WRITE MTA: EOFS.
741	IOPR=5
	CALL MAGTAP(0,0,IOPR,MTRS,KBYTMODE,JUNIT)
	CALL MAGTAP(0,0,IOPR,MTRS,KBYTMODE,JUNIT)
C	REVERSE TO FRONT OF 2ND EOF
	IOPR=7
	CALL MAGTAP(1,0,IOPR,MTRS,0,JUNIT)
C
C
C	[2.5] TEST IF ANY PARITY ERRORS THEN PRINT STATISTICS
	IF(IPARERR+IPARFIX) 745,746,745
745	WRITE(1,667)IPARERR,IPARFIX
667	FORMAT(' ',I5,' NON-RECOV.,',I5,' RECOV. PAR. ERRS.')
S \746,	RETRN WTFIL
C
C
C	[3] END OF TAPE ERROR HANDLER
750	WRITE(1,751)
751	FORMAT(' EOT FOUND, REWINDING')
	IOPR=1
	CALL MAGTAP(0,0,IOPR,MTRS,KBYTMODE,JUNIT)
	CALL REENTER
C
C	****************************************************
C	*SUBROUTINE     G E T S C A N B U F
C	****************************************************
C	IF IBLKCNT=173-9
C		THEN MAGBUFFER<==IH[1:256]&8 MAG DATA BLOCKS
C		ELSE MAGBUFFER<==NEXT 9 MAG DATA BLOCKS;
C
S	ENTRY GETSC
S	CPAGE 2
S GETSC,	BLOCK 2
C
C	[GB.0] 
	ICOUNT=0
	IF (IBLKCNT-164)820,801,820
C
C
C	[GB.1]  MAGBUFFER<==IH[1:256]
801	CALL UNPACKHEADER
C
C
C	[G.1.1] SETUP SCANBUFFER FOR READING 8 RATHER THAN 9 BLOCKS
C	START LOADING DATA AFTER THE HEADER ON FIRST WRITE
	ICOUNT=384
C
C
C	[G.1.2] SETUP THE SCANNER ADDRESS
	IX=ICOL
	IY=IROW
	MIXMAX=-(IX+256)
C
C
C	[GB.2] LOOP TO READ SCANNER DATA INTO SCANBUFFER
S\820,	JMS READATA /MAGBUFFER(ICOUNT)<==SCANDATA(IX,IY)
C
C	[G.2.1] INCREMENT (IX,IY) TO NEXT SCANNER POINT
C	IF IX=(ICOL+256)=IXMAX
C		THEN (IX_ICOL, IY_IY+1)
C		ELSE IX_IX+1;
S \834,	TAD \MIXMAX
S	TAD \IX
S	SNA CLA
S	JMP \844 /YES
S	INC \IX /IX<==IX+1
S	CLA
	GOTO 845
844	IX=ICOL
	IY=IY+1
C
C
C	[G.2.2] TEST IF DONE
C	IF (ICOUNT_ICOUNT+1)=3456
C		THEN DONE;
S \845, INC \ICOUNT
S	TAD \MWDCT /(D3456
S	CIA
S	TAD \ICOUNT
S	SZA CLA 
S	JMP \820 /NOT DONE
C
C
C	[G.3] RESET SCAN BUFFER PTR AND COUNTER
829	ICOUNT=0
S	RETRN GETSC
C
C
C	*************************************************
C	*SUBROUTINE   R E A D D A T A
C	*************************************************
C	GET A 8-BIT PIXEL DATUM FROM SCANNER
C	MAGBUFFER[ICOUNT]<==READDATA(IX,IY)
S	CPAGE 3
S RREADDATA,	JMP I READDATA
S READDATA,	0 /ENTRY
C
C	[R.1] LOAD SCANNER COORDINATES
S	TAD \IX
S	LDSCNX
S	TAD \IY
S	LDSCNY

C
C	[R.2] LOAD THE # OF TIMES TO AVG DATA
	KTIMES=-NTIMES
C
C
C	[R.3] START THE SCANNER
S DOSCN,  STSCAN /START SCANNER
S WAITSN,	SCNSKP /SKIP ON READY
S	JMP WAITSN
C
C
C	[R.3.1] READ DECIMAL NUMBER (INTERFACE DOES BCD==>DEC CONV.
C	FOR SPEED!). WE ASSUME (ONLESS OTHERWISE DEVELOPS) THAT
C	THE DATA IS 8-BIT DATA! IF NOT, THEN SCALING IS REQUIRED.
S	RDATA /GET EM SCANNER DATA AND SCALE IF NECESSARY
C
C
C	[R.4] COUNT DOWN KTIMES
S	ISZ \KTIMES
S	JMP DOSCN /NOT DONE
C
C	DIVIDE IDATA BY NTIMES
S	TAD \IDATA
S	SWAB
S	TAD \IDATA#
S	CPAGE 2
S	DVI
S	\NTIMES
S	CLA
S	MQA
S	TAD \ICOUNT
S	DCA 7 /SETUP POINTER
S	CPAGE 2
S	6251 /MAGBUFFER
S	DCAI 7
S	SWBA
C
S	JMP RREADDATA
	END