C	PROGRAM BMTOMTA.FT
C	--------------
C
	SUBROUTINE BMTOMTA(LMEM,LIBYTE,LKOUTFILE,DEVICE,IHEADER,IKPD)
C
C
C
C
C	P.LEMKIN
C	NATIONAL INSTUTUTES OF HEALTH
C	BETHESDA, MD 20014
C
C
C	MAY 31, 1977
C	MAY 16, 1977
C	MAY 5, 1977
C	APRIL 29, 1977
C
C	PURPOSE
C	--------
C	READ BM (MEM,IBYTE)==>MTA(DEVICE):KOUTFILE[1:4].
C
C	AUXILLARY ROUTINES UNPACK, WTHEADER, WTFILE.
C	FOR MAG10.
C
C	COMPILE AS:
C	-----------
C	.COMP BMTOMTA.RL < BMTOMTA.FT
C
C
C
S	OPDEF	SWBA 7447
S	OPDEF	SWAB 7431
S	OPDEF	DAD 7443
S	OPDEF	DST 7445
S	OPDEF DMAGO 6070
S	SKPDF DMASKP 6071
S	OPDEF DMAWC 6072
S	OPDEF DMACA 6073
S	OPDEF DMACLR 6074
S	OPDEF EXDMA1 6524
S	OPDEF EXDMA2 6525
C
C
C
S	OPDEF DISP1 6435
S	OPDEF DISP2 6436
S	OPDEF CLAMQ 7621
S	OPDEF MQL 7421
S	OPDEF MQA 7501
S	OPDEF BSW 7002
S	OPDEF TADI 1400
S	OPDEF DCAI 3400
C
S	OPDEF	MTRS	6706
C
C
C
C
C
	COMMON IBUF1
	DIMENSION IBUF1(256)
C
	DIMENSION KOUTFILE(4)
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
C
S	DUMMY BMBUFFER
S		CPAGE 2
S BMBUFFER,	6261 /CDF 60
S		0
C
S	DUMMY DV
S	CPAGE 2
S DV,	BLOCK 2
C
1	CONTINUE
C
C	*************************************************
C
C
C	[1] COPY PARAMETERS
	MEM=LMEM
	IBYTE=LIBYTE
	DO 2 I=1,4
	KOUTFILE(I)=LKOUTFILE
S	INC \LKOUTFILE#
2	CONTINUE
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	USE BYTE MODE
	FDEV=DEVICE
S	TAD \FDEV#
S	AND (0001 /0 OR 1
S	DCA \JUNIT
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
	CALL MAGTAP(1,0,7,MTRS,0,JUNIT)
C	IF BOT 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)
	WRITE(3,132)
132	FORMAT(' WRITING INITIAL EOF!')
	CALL MAGTAP(0,0,5,MTRS,KBYTMODE,JUNIT)
	GOTO 133
C
C	NOT BOT , ADV REC
131	CALL MAGTAP(1,0,6,MTRS,KBYTMODE,JUNIT)
C
C
C	[3] WTFILE
133	CALL WTFILE
C
	RETURN
C	*************************************************
C	* SUBROUTINE    U N P A C K
C	*************************************************
C	UNPACK 1/3 BMBUFFER ==> MAGBUFFER
S	ENTRY UNPAC
S	CPAGE 2
S UNPAC,	BLOCK 2
C
C	[1] 1/3 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= MAG, 16 = DSK
S	CLA CMA
S	DCA 15
S	CLA CMA
S	DCA 16
S	TAD (-D1152
S	DCA 7 /COUNTER
C
C
C	[2] LOOP AND CVT
S	CPAGE 5
S UPK2,	6261 /CDF 60 BMBUFFER
S	TADI 16 /1ST WORD, B3[0:3]&B1
S	DCA 20
S	TADI 16 /2ND WORD, B3[4:7]&B2
S	DCA 21
C
C	[2.1] UNPACK AND STORE
S	CPAGE 33
S	6251 /CDF 50, MAGBUFFER
S	TAD 20
S	AND (0377 /B1
S	DCAI 15
S	TAD 21
S	AND (0377 /B2
S	DCAI 15
S	TAD 20 /GET B3[0:3]
S	RTR; RTR
S	AND (0360 /TO 4:7
S	MQL
S	TAD 21 /GET B3[4:7]
S	RTL; RTL; RAL
S	AND (0017 /TO 8:11
S	MQA
S	DCAI 15 /PUSH B3
S	ISZ 7
S	JMP UPK2 /NO
C
C	[3] YES, RETURN
S	CPAGE 3
S	JMS 45
S	CLA
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
S	RTR; RTR; RTR
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
	K=K+1
	IBUF1(K)=J1
	K=K+1
200	IBUF1(K)=J2

C	[2] PUSH THE BLOCK COUNT
S	TAD \IBLKCNT
S	RTR;RTR;RTR;RTR
S	AND (17 /TOP 4 BITS
S	DCA \J1
S	TAD \IBLKCNT
S	AND (377
S	DCA \J2
	K=K+1
	IBUF1(K)=J1
	K=K+1
	IBUF1(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
	K=K+1
	IBUF1(K)=KYEAR
C
S	TAD I OS8DATE /GET MONTH
S	CLL RAL; RTL; RTL
S	AND (17 /MONTH
S	DCA \KMONTH
	K=K+1
	IBUF1(K)=KMONTH
C
S	TAD I OS8DATE /GET DAY
S	CLL RAR; RTR
S	AND (37 /DAY
S	DCA \KDAY
	K=K+1
	IBUF1(K)=KDAY
C
C
C
C
C	[4] WRITE OUT THE RECORD OF 3456 BYTES, FROM IBUF1 BUFFER
C	BYTE MODE
C
	IBYTE=0
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	CALL MAGTAP(MWDCT,IBUF1,4,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
	CALL MAGTAP(1,0,7,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 FROM
C
C
C	OS8 FILE "DEVICE:KOUTFILE[1:4]".
C
S	ENTRY WTFIL
S	CPAGE 2
S WTFIL,	BLOCK 2
C	[1.1] PRINT THE FILE NAME
C	FIRST PRINT OUT THE FILE.
	DO 710 I=1,3,2
C	DEFINE THE H PRINT SYMBOL OF THE BMI1
S	TAD (4040
S	DCA \IHSYM
S	TAD \IBYTE
S	SNA CLA
S	JMP \710 /NOT "H"
S	TAD (1040 /"H "
S	DCA \IHSYM
C
710	WRITE(I,711)KOUTFILE,IKPD,MEM,IHSYM
711	FORMAT(' W: ',3A2,'.',A2,,' CLASS#: ',I3,', <== BM',I1,A1)
C
C
C
C
C	[1.2] NOW SET FILE LENGTH
	IBLKCNT = 173
C
C	[1.3] WRITE THE MAGTAPE HEADER
	IRECORD=0
	IPARERR=0
	IPARFIX=0
	IOPR=4
	CALL WTHEADER
C
C
C	[2] RECORD TRANSFER LOOP.
C	WRITE 1 MAGTAPE RECORD OF 3456 BYTES FROM MAGBUFFER
C	AFTER CONVERTING BMBUFFER ==> MAGBUFFER.
C
720	IRECORD=IRECORD+1
S	TAD \IRECORD
S	DISP1
S	CLA /OUTPUT RECORD NUMBER IN THE RQC DISPLAY REGISTER
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==>BMBUFFER
C
	CALL GETBMBUF
C
C
C	[2.1.1] UNPACK BMBUFFER ==> MAGBUFFER
730	CALL UNPACK
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
S	CALL 6,MAGTA
S	ARG \MWDCT /WORD COUNT
S AM3,	ARG MAGBUFFER
S	ARG \IOPR
S	ARG \MTRS
S	ARG \IBYTE
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	CALL MAGTAP(1,0,7,MTRS,KBYTMODE,JUNIT)
C	SETUP READ BUFFER CALL
S	TAD MAGBUFFER
S	DCA AM4
S	TAD MAGBUFFER#
S	DCA AM4#
C
S	CPAGE 16
S	CALL 6,MAGTA
S	ARG \MWDCT /WORD COUNT
S AM4,	ARG MAGBUFFER
S	ARG (3 /READ COMPARE
S	ARG \MTRS
S	ARG \IBYTE
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.
	CALL MAGTAP(1,0,7,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(3,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	IBYTE=0
C
C	TEST IF WROTE OUT ALL BLOCKS
	IF(IBLKCNT)741,741,720
C
C
C	[2.4] WRITE MTA: EOFS.
741	CALL MAGTAP(0,0,5,MTRS,KBYTMODE,JUNIT)
	CALL MAGTAP(0,0,5,MTRS,KBYTMODE,JUNIT)
C	REVERSE TO FRONT OF 2ND EOF
	CALL MAGTAP(1,0,7,MTRS,0,JUNIT)
C
C
C	[2.5] TEST IF ANY PARITY ERRORS THEN PRINT STATISTICS
	IF(IPARERR+IPARFIX) 745,746,745
745	WRITE(3,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(3,751)
751	FORMAT(' EOT FOUND, REWINDING')
	CALL MAGTAP(0,0,1,MTRS,KBYTMODE,JUNIT)
	CALL CHAIN('BMON2')
C
C	****************************************************
C	*SUBROUTINE     G E T B M B U F
C	****************************************************
C	IF IBLKCNT=173-9
C		THEN BMBUFFER<==IHEADER[1:256]&8 BM BLOCKS
C		ELSE BMBUFFER<==NEXT 9 BM BLOCKS;
C
S	ENTRY GETBM
S	CPAGE 2
S GETBM,	BLOCK 2
C
C	[GB.0] 
	IF (IBLKCNT-164)820,801,820
C
C
C	[GB.1]  BMBUFFER<==IHEADER[1:256]&8 BM BLOCKS
S\801,	TAD BMBUFFER /COPY PTR
S	DCA DV
S	TAD BMBUFFER#
S	DCA DV#
C
	DO 802 I=1,256
	IZ=IHEADER
S	INC \IHEADER#
S	TAD \IZ
S	DCA I DV /BMBUFFER[I]
S	INC DV#
802	CONTINUE
C
C
C	SETUP BMBUFFER FOR READING 8 RATHER THAN 9 BLOCKS
	IFIRST=-384
S	TAD (D256
S	DCA BMBUFFER#
C
C	SETUP THE DMA CONTROL WORD
	IBMCTL=0000
C
C	TEST IF HIGH BYTE
S	TAD \IBYTE
S	SZA CLA
S	TAD (0200 /HIGH 8-BITS
S	TAD (0200 /LOW 8-BITS
S	DCA \IBMCTL
C
C	SETUP THE DATA FIELD FOR BUFFER
S	TAD BMBUFFER /DATA FIELD FOR BUFFER
S	AND (0070
S	TAD \IBMCTL
S	DCA \IBMCTL
C
C
C	SETUP THE BM ADDRESS
S	TAD \MEM /SET BY XMITBM
C	THE BM# IS SPECIFIED IN BITS [5:7] OF THE HIGH ORDER ADDRESS
S	RTL; RTL
S	AND (0160
S	DCA DV# /LOAD HIGH ORDER
S	DCA DV /SET LOW ORDER TO ZERO.
C
C
C	[GB.2] READ BM DATA INTO BMBUFFER
820	CONTINUE
S	DMACLR /CLEAR THE CHANNEL AND ADDRESSES
S	TAD BMBUFFER#
S	DMACA
S	TAD (4400 /'400*9
S	DMAWC
C
C	SETUP THE CURRENT ADDRESS FOR BM DMA
S	TAD DV#
S	EXDMA1 /LOAD HIGH ADDRESS
S	TAD DV
S	EXDMA2 /LOAD LOW ADDRESS
C
C	COMPUTE FUTURE BM DMA ADDRESS (NOTE: 8-BITS=(3/2)12-BITS):
C	DV_DV+(3/2)*256*9 [ I.E. 3456]
S	TAD \IFIRST /-384 IF FIRST WRITE
S	TAD (6600 /384*9=3456=(256*9+128*9)
S	SWAB /MODE B AND MQL
C
S	CPAGE 4
S	DAD
S	DV
C
S	DST
S	DV
C
S	CLAMQ
S	SWBA
C
C	LOAD THE "GET" GO WORD AND GO
C	NOTE: R/W BIT IS 0 FOR READ
S	TAD \IBMCTL /I/O CONTROL WORD
S	DMAGO
S DMAGET,	DMASKP
S	JMP DMAGET /NOT YET
C
C	RESET BM BUFFER PTR
S	DCA BMBUFFER#
C
	IFIRST=0
S	RETRN GETBM
C
C
	END