/
/PROGRAM TO SAVE DISC IMAGE ON TAPE AND
/TRANSFER IT BACK TO DISC.
/
/W.S.STEWART, MERCK AND CO.,INC. 12/15/70
/
/
/LINC IOTS
/
	ICON=6141
	IAAC=6171
	IACB=6161
	INTS=6147
/
/PAGE ZERO
/
	*1
/
/LINC CONTROL SUBROUTINE
/
	CONTROL=JMS .
RET,	0		/SUBROUTINE ENTRANCE
	CLA
	TAD I	RET	/GET ARGUMENT
	ICON		/ISSUE COMMAND
	CLA CLL
	ISZ	RET	/INDEX PAST ARGUMENT
	JMP I	RET	/CONTINUE
/
/LITERAL, FLAG AND VARIABLE AREA
/
WORD,	0		/READS OR WRITES TAPE WORD
	*20
SEGNR,	-40		/-20 FOR 32K DISC, -40 FOR 64K DISC
SBLK,	10		/STARTING BLOCK NUMBER
SEG,	0		/CURRENT SEGMENT NUMBER
RWFLG,	0		/READ OR WRITE FLAG - READ=7777
BCNT,	0		/COUNT OF BLOCKS READ OR WRITTEN
CHECK,	0		/CHECKSUM LOCATION
WCNT,	0		/WORD COUNTER
BLKNR,	0		/CURRENT BLOCK NUMBER
INTSAV, 0		/CURRENT LINC INTERRUPT STATUS
C400,	-400		/NUMBER OF WORDS IN BLOCK
C7750,	7750		/CONSTANT
C7751,	7751		/CONSTANT
DR,	DMAR		/DISC READ IOT
DW,	DMAW		/DISC WRITE IOT
MON,	7600		/MONITOR STARTING ADDRESS
MONST,	7576		/MONITOR LOAD ADDRESS
C777,	777		/CONSTANT
C7700,	7700		/CONSTANT
C4000,	4000		/CONSTANT
/
/TAPE WAIT SUBROUTINE
/
	WAIT=JMS .
RET1,	0		/SUBROUTINE ENTRANCE
	CLA
	INTS		/GET INTERRUPT STATUS
	SMA		/TAPE INTERRUPT OCCURRED
	JMP	.-3	/NO
	DCA	INTSAV	/YES, SAVE INTERRUPT STATUS
	CONTROL
	7		/CLEAR LINC INTERRUPTS
	JMP I	RET1	/RETURN
/
/SEARCH TAPE FOR BLOCK SUBROUTINE
/
	SEARCH=JMS .
RET2,	0		/SUBROUTINE ENTRANCE
	CONTROL
	2		/SET SEARCH MODE
LOOP,	WAIT		/FOR NEXT BLOCK NBR
	TAD	INTSAV	/GET INTERRUPT STATUS
	RAR		/PUT MOTION INTO LINK
	CLA
	IAAC		/GET BLOCK NUMBER
	TAD	BLKNR	/COMPARE WITH WANTED BLK NBR
	IAC		/MAKE 2S COMPLEMENT RESULT
	SZA		/IS THIS THE BLOCK
	JMP	CONT	/NO IT IS NOT
	SNL		/ARE WE GOING FORWARD
	JMP TURN	/NO
	CONTROL
	3		/YES, GO TO BLOCK MODE
	TAD	C400	/SET UP WORD COUNT
	DCA	WCNT
	CMA
	DCA	CHECK	/SET UP FOR CHECKSUM
	JMP I	RET2	/EXIT FROM SEARCH
TURN,	WAIT		/FOR NEXT BLOCK
CONT,	SZL		/DO WE CHANGE DIRECTION
	JMP	LOOP	/NO, CONTINUE
	CMA RAL		/YES
	CLA RAR		/THIS WILL DO IT
	ICON		/STOP TAPE MOTION
	IAC
	ICON		/SET MOTION IN NEW DIRECTION
	JMP	LOOP	/CONTINUE
/
/DISC SUBROUTINE
/
	DODISC=JMS .
DISC,	0		/SUBROUTINE ENTRANCE
RETRY,	TAD	C4000
	DCA I	C7750	/NBR OF WORDS TO XFER
	TAD	C777
	DCA I	C7751	/STARTING ADDRESS -1
	TAD	SEG	/GET SEGMENT NBR
	RTL CLL		/PUT IT IN RIGHT PLACE
	RTL
	RAL
	AND	C7700
	DEAL		/LOAD EXTENDED ADDRESS
	TAD	SEG	/COMPUTE WORD ADDRESS
	RTR
	AND	C4000
DINSTR, 0		/BECOMES READ OR WRITE INSTR
	CLA
	DFSC		/WE DONE
	JMP	.-1	/NO
	DFSE		/SEE IF ERRORS
	JMP 	RETRY	/ERRORS, TRY AGAIN
	DCEA		/CLEAR REGISTERS
	DCMA		/AND ALL INTERRUPTS
	JMP I	DISC	/THEN EXIT
/
/INITIALIZE SYSTEM
/
	INITIALIZE=JMS .
INIT,	0		/SUBROUTINE ENTRANCE
	IOF		/INTERRUPTS OFF
	CONTROL		/POWER CLEAR LINC
	11
	CONTROL		/THEN SELECT IT
	10
	DCA	SEG	/SEGMENT ONE IS FIRST
	JMP I	INIT	/CONTINUE
/
/END OF PAGE ZERO
/
	*200
/
/PROGRAM ENTRANCE FOR READ DISC
/
	INITIALIZE
	TAD	DR	/GET DISC READ INSTRUCTION
	DCA	DINSTR	/SET UP SUBROUTINE
MORE,	DCA	RWFLG	/SET TO WRITE TAPE
	DODISC		/READ A SEGMENT FROM DISC
	DOTAPE		/WRITE IT ON TAPE
	ISZ	SEG	/INCREMENT SEGMENT
	TAD	SEG	/GET SEGMENT NUMBER
	TAD	SEGNR	/SUBTRACT MAX SEG NBR
	SZA CLA		/WE DONE
	JMP	MORE	/NO, CONTINUE
	JMP I	MON	/YES, RETURN TO MONITOR
/
/PROGRAM ENTRANCE FOR WRITE DISC
/
	*220
	INITIALIZE
	TAD	DW	/SET UP TO WRITE DISC
	DCA	DINSTR
AGIN,	CMA		/7777 TO AC
	DCA	RWFLG	/SET UP TO READ TAPE
	DOTAPE		/READ IN TAPE
	DODISC		/WRITE IT ON DISC
	ISZ	SEG	/INCREMENT SEGMENT
	TAD	SEG	/GET SEGMENT NBR
	TAD	SEGNR	/COMPARE WITH MAX SEG NBR
	SZA CLA		/WE DONE
	JMP	AGIN	/NO, CONTINUE
/
/CALL DISC MONITOR
/
CALMON,	TAD	MONST
	DCA I	C7750	/LOAD 7750
	TAD	MONST
	DCA I	C7751	/LOAD 7751
	DMAR		/READ DISC
	DFSC		/WE DONE
	JMP	.-1	/NO
	DFSE		/WE HAVE ERRORS
	JMP	CALMON	/YES, TRY AGAIN
	JMP I	MON	/NO, START MONITOR
/
/TAPE OPERATION
/
	DOTAPE=JMS .
TAPE,	0		/SUBROUTINE ENTRANCE
REWRIT,	SETUP		/FOR TAPE OPERATION
	ISZ	RWFLG	/IS READ FLAG SET
	JMP	WRITE	/NO, DO A WRITE
/
/READ TAPE OPERATION
/
READ,	SEARCH		/FIND TAPE BLOCK
	WAIT		/FOR CHECK MARK
GETWD,	WAIT		/FOR FIRST WORD
	TAD	RWFLG	/GET READ-WRITE FLAG
	SPA CLA		/WE CHECKING
	JMP	NOSTOR	/YES
	IAAC		/GET IT
	DCA I 	WORD	/DEPOSIT WORD
NOSTOR,	IAAC		/GET WORD AGAIN
	TAD	CHECK
	DCA	CHECK	/BUILD CHECKSUM
	ISZ	WCNT	/THAT ALL THE WORDS
	JMP	GETWD	/NO, GET ANOTHER
	WAIT		/FOR CHECKSUM WORD
	CONTROL
	6		/CLEAR BLOCK MODE
	IAAC		/GET CHECKSUM WORD
	TAD	CHECK	/ADD IT IN
	CMA
	SZA CLA		/IS CHECKSUM RESULT ZERO
	JMP	CKFAIL	/NO, TRY AGAIN
	ISZ	BLKNR	/INCREMENT BLOCK NBR
	NOP		/IF WE READ END OF TAPE
	ISZ	BCNT	/THAT ALL TO READ
	JMP	READ	/NO, READ ANOTHER
	CONTROL
	4		/OFF SEARCH
	ICON		/STOP TAPE
	JMP I	TAPE	/RETURN
CKFAIL,	ISZ	RWFLG	/WERE WE CHECKING
	JMP	READ	/NO
	JMP	REWRIT	/YES, WRITE AREA AGAIN
/
/WRITE TAPE OPERATION
/
WRITE,	SEARCH		/FIND BLOCK
	CONTROL
	5		/TURN ON TAPE WRITERS
PUTWD,	TAD I	WORD	/GET WORD
	IACB		/PUT IN B REGISTER
	TAD	CHECK	/FORM CHECKSUM
	DCA	CHECK
	WAIT		/FOR LAST WORD TO BE WRITTEN
	ISZ	WCNT	/THAT LAST WORD
	JMP	PUTWD	/NO, PUT ANOTHER
	TAD	CHECK	/YES, GET CHECKSUM
	CMA		/MAKE ONES COMPLEMENT
	IACB		/PUT IN B REGISTER
	WAIT		/FOR CHECKSUM
	WAIT		/FOR ONE MORE WORD
	CONTROL
	6		/OFF WRITE AND BLOCK
	ISZ	BLKNR	/INCREMENT BLOCK NBR
	NOP		/FOR LAST BLOCK
	ISZ	BCNT	/THAT LAST BLOCK
	JMP	WRITE	/NO, WRITE ANOTHER
	CMA		/7777 TO AC
	DCA	RWFLG	/SET READ/WRITE FLAG FOR CHECK
	SETUP		/FOR NEW OPERATION
	JMP	READ	/AND CHECK WHAT WE WROTE
/
/SETUP FOR TAPE OPERATION
/
	SETUP=JMS .
RET3,	0		/SUBROUTINE ENTRANCE
	TAD	SEG	/GET SEGMENT NBR
	RTL CLL
	RAL
	TAD	SBLK	/STARTING TAPE BLOCK
	DCA	BLKNR	/BECOMES CURRENT BLOCK NBR
	TAD	C777
	DCA	WORD	/SET WORD POINTER
	ICON		/CLEAR MOTION FLIP FLOPS
	CONTROL
	1		/SET DRIVE GOING BACKWARDS
	TAD	(-10
	DCA	BCNT	/SET BLOCK COUNT
	JMP I	RET3	/CONTINUE
/
/END OF PAGE ONE
/
/END OF PROGRAM
$