perm filename MARK.FAI[D,SYS] blob sn#362658 filedate 1978-06-21 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE	MARK
C00006 ENDMK
C⊗;
TITLE	MARK

A←1
B←2
C←3
D←4
E←5

APR←0
TTY←120
DC←204
DTC←210
DTS←214

LOC 140

GO:	CONO APR,200000		;RESET APR
RETRY:	CONO DTC,203410		;UNIT SEL 1, TIME DLY 3, STOP FWD, FCN 4 (WTM)
	CONSZ DTS,2000		;WAIT FOR DELAY TO FINISH
	JRST .-1
	CONSZ DTS,4
	JRST RETRY		;ILLEGAL OP - WRITE PROT OR MULTIPLE SELECT
	CONO DTC,221410		;UNIT SEL 1, TIME DLY 1, START FWD, FCN 4 (WTM)
	CONO DC,3410		;START DC FOR OUTPUT
	MOVEI C,=2700
	MOVE A,[707707,,707707]
	JSP E,WDOUT
	SOJG C,.-1
	MOVEI D,1102
BLKLP:	MOVE A,[070707,,070770]
	JSP E,WDOUT
	MOVE A,[077070,,007000]
	JSP E,WDOUT
	HRLI A,007000
	JSP E,WDOUT
	HRRI A,777000
	JSP E,WDOUT
	MOVEI C,175
	HRLI A,777000
	JSP E,WDOUT
	SOJG C,.-1
	HRRI A,777077
	JSP E,WDOUT
	HRLI A,777077
	JSP E,WDOUT
	HRRI A,707007
	JSP E,WDOUT
	MOVE A,[700707,,070707]
	JSP E,WDOUT
	SOJG D,BLKLP
	MOVE A,[070070,,070070]
	MOVEI C,=2700
	JSP E,WDOUT
	SOJG C,.-1
BACKW:	CONO DTC,202510	;UNIT SEL 1, TIME DLY 2, STOP FWD, FCN 5 (WRITE ENTIRE TAPE)
	CONSZ DTS,2000		;WAIT FOR DELAY IN PROGRESS TO BE OVER
	JRST .-1
	CONSZ DTS,4
	JRST BACKW		;ILLEGAL OP
	CONO DTC,233510	;UNIT SEL 1, TIME DLY 3, START REV, FCN 5(WRITE ENTIRE TAPE)
	CONO DC,3410		;START DC WRITING
	MOVEI C,1101
	MOVEI D,1
RBLKLP:	MOVEI A,0
	CAIN D,1
	MOVE A,C
	CAIE D,2
	CAIN D,203
	MOVE A,[700600,,14300]		;CONO PI,14300
	CAIN D,3
	MOVEI A,77
	CAIN D,204
	JRST RBLKA
RBLKB:	JSP E,WDOUT
	SOJG D,RBLKLP
	MOVEI D,204
	SOJGE C,RBLKLP
	CONSZ DTS,40		;WAIT FOR WRITING TO FINISH
	JRST .-1
	CONO DTC,3000		;DESELECT, TIME DLY 3
	CONSZ DTS,2000		;WAIT FOR DELAY IN PROGRESS TO BE OVER
	JRST .-1
	JRST RETRY

;SEND A WORD TO THE DC FROM A.  CALL WITH JSP E,WDOUT
WDOUT:	CONSZ DTS,6
	JRST LOSE		;TAPE END OR ILLEGAL OP
	CONSO DC,1000		;WAIT FOR DC OUTPUT DONE (DC WANTS A WORD)
	JRST WDOUT
	DATAO DC,A		;FEED THE DC
	JRST (E)

LOSE:	DATAO TTY,DING
	CONO DTC,1000
	JRST 4,GO

RBLKA:	MOVE B,C
	ROT B,-3
	ROTC A,3
	ROT B,-6
	ROTC A,3
	ROT B,-6
	ROTC A,3
	ROT B,-6
	ROTC A,=27
DING:	SETCAI A,7
	JRST RBLKB

END	GO