	.SYSID <	.TITLE DOSSAV >,<000>
/ 
/ 
/                   FIRST PRINTING, FEBRUARY 1974
/ 
/ THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO 
/ CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
/ AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPON-
/ SIBILITY FOR ANY ERRORS THAT MAY APPEAR IN THIS
/ DOCUMENT.
/ 
/ THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FUR-
/ NISHED TO THE PURCHASER UNDER A LICENSE FOR USE ON
/ A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH
/ INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR 
/ USE IN SUCH SYSTEM, EXCEPT AS MAY OTHERWISE BE PRO-
/ VIDED IN WRITING BY DIGITAL.
/ 
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/ FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIP-
/ MENT THAT IS NOT SUPPLIED BY DIGITAL.
/ 
/ COPYRIGHT (C) 1971,1975, BY DIGITAL EQUIPMENT CORPORATION
/ 
/ 
	.TITLE LEGEND
/
/EDIT #055;	NOV. 20,72
/EDIT #056	AUG. 7, 73
/EDIT #057 11/20/73 S. ROOT PREVENT DISK WRITE ON READ ERROR (RK)!
/EDIT #058 12/11/73 S.ROOT  REWRITE MT DRIVER
/EDIT #059 12/12/73 S.ROOT FINISH #058. ADD CONTINUE
/		/THRU DISK ERROR CAPABILITY ALL DISKS.
/EDIT #060 12/13/73 S. ROOT ANOTHER PATCH TO MT.
/		/GRAB SOME SPACE FROM TTY ROUTINES
/EDIT #061	SCR	1/24/74		EOF TO MT ON SAVE
/EDIT #062	SCR	1/28/74	CHANGE ILLEGAL FUNCTION BIT (R.P.)
/EDIT #063	SCR	1/28/74	062 MISSED
/	064	SK	2-APR-74	REMOVE OFFENDING PDP-9 INST. SWHA AT
/					GETAP
/	065	EK	15-JUL-74	CHANGE SIGNON NUMBER
/	066	SK	16-DEC-74	SPR:15-874 BUG FIX
/	067	JMW	8-JAN-75	CHANGE SIGNON MESSAGE.
/	068	JMW	3-APR-75	CORRECT DISPATCH TO RF ERROR PROCESSOR.
/ 169	02-MAY-75 (RCHM)	CONVERT TO XVM AND STICK IN CODE TO AVOID
/				SAVING THE SPOOLER AREA.
/ 170	06-MAY-75 (RCHM)	FIX OPTION TO SAVE QAREA.
/ 171	06-MAY-75 (RCHM)	FORGOT TO ACCOUNT FOR MISSING BLOCKS ON INPUT.
/ 172	07-MAY-75 (RCHM)	REDO RK-15 DRIVER SO IT WILL WORK IN 24K CASE.
/ 173	07-MAY-75 (RCHM)	REMOVE PARITY QUESTION FOR MAGTAPES.
/ 174	09-MAY-75 (RCHM)	FIX QAREA QUESTION SO THAT IT COMES OUT ONLY IF
/				A QAREA EXISTS.
/ 175	21-SEP-75 (RCHM)	NEED A CLL IN SPOOLER AREA CHECKSUM CALCULATION.
/
/
	.TITLE COMMAND DECODER
	.ABS
IDX=ISZ
CLAC=641000			/(RCHM-169)
SET=ISZ
CLOF=700004
EEM=707702
RFMFD=1777
DPMFD=47040
	.LOC 33600
SATBUF=.
	.LOC 34400		/(RCHM-172) STARTING LOCATION OF TCB FOR RK-15.
				/(RCHM-172) NOTE -- IT WILL BE VIRTUALLY IMPOSSIBLE
				/(RCHM-172) TO GET THE CURRENT DOSSAVE  TO WORK PROPERLY
				/(RCHM-172) WITH A 16K UNICHANNEL IN CASE ONE IS BUILT.
TCB	64*400+1		/(RCHM-172) TCB HEADER WORD 1.
	1*400+202		/(RCHM-172) TCB HEADER WORD 2.
	.REPT 11		/(RCHM-172) RESERVE SPACE FOR REST OF TCB.
	0			/(RCHM-172)
	.LOC 54000		/(RCHM-170) NEW STARTING ADDRESS FOR XVM.
BEGIN	EBA
	CLOF
	CAF
	IOF
	JMS TYPECR		/OUTPUT CR/LF AND
	LAC (TITLE-1		/THEN TITLE.
	JMS	TYPRET		/TYPE AND CARRIAGE RETURN
START	DZM DIRECT		/GET INPUT INFORMATION.
	CLC
	DAC FIRST
	DZM DSKBLK
	DZM MAGSW
	DZM DISKSW
	DZM CURBLK
	DZM BLKCNT
	LAC PNUMBK		/RESTORE PERMANENT # BLOCKS TO PUT IN 
	DAC NEWBLK		/BUFFER AT ONCE.
	DAC DELBLK
	LAC PBUFSZ
	DAC DTBUFS
	LAC (NOP)			/(RCHM-171)
	DAC QSW				/(RCHM-171) TURN OFF QAREA IGNORE.
	DAC SPOLSW			/(RCHM-171) TURN OFF SPOOL IGNORE.
LM400	LAW -400
	DAC OBUFSZ
	DAC IBUFSZ
	LAC (DEVIN-1		/ASK FOR INPUT DEVICE - 2 CHARS.
	JMS TYPE
	LAW -2
	JMS READTT
	DAC INDEV
	SAD MAGTAP
	JMP MORIN		/NEED MUCH MORE INFO FOR MAGTAPE.
	SAD DECTAP
	JMP TAPIN
	SAD DECDSK
	JMP DSKIN
	SAD DSKPAK
	JMP PAKIN
	SAD DECPAK
	JMP DECIN
	JMS ILLDEV		/NOT A LEGAL DEVICE - COMPLAIN AND
	JMP START		/RESTART.
STOUT	SET DIRECT		/NOW GET OUTPUT INFORMATION.
	LAC (DEVOUT-1
	JMS TYPE		/'OUTPUT DEVICE?'
	LAW -2
	JMS READTT
	DAC OUTDEV
	SAD INDEV		/CAN'T BE THE SAME AS INPUT DEVICE.
	JMP BDDEV		/ANNOUNCE ERROR AND START OVER.
	SAD MAGTAP
	JMP MORIN
	SAD DECTAP
	JMP TAPOUT
	SAD DSKPAK
	JMP PAKOUT
	SAD DECDSK
	JMP DKOUT
	SAD DECPAK
	JMP RKOUT
	JMS ILLDEV		/NOT A LEGAL DEVICE - COMPLAIN AND
	JMP STOUT		/ASK FOR OUTPUT DEVICE AGAIN.
/DECTAPE IN.
TAPIN	LAC DTBUFS		/HAVE ALREADY CALCULATED BUFFER SIZE.
	DAC IBUFSZ
	JMS GETUNT		/GET UNIT NUMBER.
	DAC DTUNIT
	LAC (JMS DTAPIN
SETTIN	DAC IN+1		/(RCHM-171) SET UP INPUT ROUTINE.
	JMP STOUT		/(RCHM-170) GET OUTPUT DEVICE.
/DECPACK IN
DECIN	LAC (RFMFD
	DAC MFDBLK
	JMS GETUNT
	DAC RKUNIT
	LAC (JMS RKDKIN
	JMP SETIN
/DECDISK IN.
DSKIN	LAC (RFMFD
	DAC MFDBLK
	LAC (JMS RFDKIN
	JMP SETIN		/'JMS RFBKIN'
/DISK PACK INPUT.
PAKIN	LAC (DPMFD
	DAC MFDBLK
	JMS GETUNT		/GET UNIT NUMBER.
	DAC DPUNIT
	LAC (JMS DPAKIN
SETIN	DAC IN+1
	JMS QAREA		/(RCHM-170) DIRECT ACCESS INPUT DEVICE. DETERMINE
				/(RCHM-170)  WHETHER OR NOT HE SHOULD SAVE ^Q AREA.
	JMP STOUT
/+
/ ROUTINE TO QUERY THE USER ABOUT SAVING THE CONTROL-Q AREA ON DISK.
/-
QAREA	XX			/(RCHM-170) ENTRY POINT.
	LAC MFDBLK		/(RCHM-174) FETCH MFD BLOCK NUMBER.
	JMS READST		/(RCHM-174) READ MFD BLOCK.
	LAC* (SATBUF+2)		/(RCHM-174) FETCH SYSBLK ADDRESS.
	SAD LM1			/(RCHM-174) IS THERE A SYSBLK?
	JMP* QAREA		/(RCHM-174) NO.
	JMS READST		/(RCHM-170) READ SYSBLK INTO SATBUF.
	LAC* (SATBUF+21)	/(RCHM-170) F3TCH  STARTING BLOCK OF QAREA.
	CMA!IAC			/(RCHM-170) CONVERT TO NEGATIVE NUMBER.
	DAC QBEG		/(RCHM-170) AND SAVE IT FOR LATER.
	LAC* (SATBUF+22)	/(RCHM-170) FETCH LENGTH OF QAREA.
	SNA!CMA!IAC		/(RCHM-170) HAS TO BE NON ZERO TO NOT SAVE IT.
	JMP* QAREA		/(RCHM-170) RETURN TO CALLER.
	DAC QSIZE		/(RCHM-170) SAVE IT FOR LATER.
	LAC (QMES-1)		/(RCHM-174) FETCH MESSAGE ADDRESS.
	JMS TYPG1		/(RCHM-174) ASK USER IF QAREA TO BE SAVED.
	SAD (31)		/(RCHM-174) USER ANSWERED 'Y'?
	JMP* QAREA		/(RCHM-174) YES.
	LAC (SKP)		/(RCHM-170) FLAG QAREA NOT TO BE SAVED.
	DAC QSW			/(RCHM-170) SET SWITCH.
	JMP* QAREA		/(RCHM-170) RETURN TO CALLER.
/DECTAPE OUTPUT.
TAPOUT	LAC INDEV		/MUST ASSURE LEGAL COMBINATION OF DEVICES.
	SAD DECDSK
	SKP
	SAD DSKPAK
	SKP
	SAD DECPAK
	SKP
	JMP BDDEV		/ILLEGAL COMBINATION - RESTART.
	JMS GETUNT		/ASK FOR UNIT NUMBER.
	DAC DTUNIT
	LAC (JMS DTAPOT
	DAC OUT+1		/'JMS DTAPOT'
	LAC DTBUFS
	DAC OBUFSZ
	JMP SAVE
/DECDISK OUTPUT.
DKOUT	LAC (JMS RFDKOT
	DAC OUT+1		/'JMS RFDKOT'
	DAC DISKSW
	JMP RESTOR
/DECPACK OUTPUT
RKOUT	JMS GETUNT	/GET UNIT NBR
	DAC RKUNIT
	LAC (JMS RKDKOT
	JMP RKOUT1		/(RCHM-169) DETERMINE DIRECTION OF TRANSFER.
/DISK PACK OUT.
PAKOUT	JMS GETUNT		/GET UNIT NUMBER
	DAC DPUNIT
	LAC (JMS DPAKOT
RKOUT1	DAC OUT+1		/(RCHM-169) 'JMS DPAKOT' OR 'JMS RKDKOT'
	LAC INDEV
	SAD DECDSK
	JMP SAVE
	JMP RESTOR
/
/SUBROUTINE TO ASK FOR DEVICE UNIT NUMBER.
/AC = UNIT NUMBER IN BITS 0-2 ON EXIT.
/ONLY UNIT NUMBERS 0-7 LEGAL.
/
GETUNT	0
GETUT1	LAC (UNITNO-1
	JMS	TYPG1	/TYPE, AND RETRIEVE 1 CHAR IN AC
	DAC TCOUNT		/MUST CHECK 0-7 LEGALITY.
	LAW -70
	TAD TCOUNT
	SMA
	JMP UNTERR
	LAC TCOUNT
	RTR; RTR
	AND (700000
	JMP* GETUNT
UNTERR	LAC (BADUNT-1
	JMS	TYPRET
	JMP GETUT1
/
/DEVICE IS MAGTAPE.
/
MORIN	JMS GETUNT		/GET UNIT NUMBER.
	DAC MAGCON		/UNIT NUMBER IN BITS 0-2.
RDTRCK	LAC	(20300	/DEFAULT SETTING, NINE TRACK
	DAC	TRACK
	LAC (CHANEL-1		/ASK FOR TRACK - 7 OR 9.
	JMS	TYPG1	/TYPE, AND GET ONE CHARACTER
	SAD (71
	JMP RDPAR		/NO NEED TO ASK DENSITY IF 9 CHANNEL.
	SAD (67
	SKP
	JMP TRKERR		/NEITHER 7 OR 9 - ERROR.
RDDEN	LAC (MDEN-1
	JMS	TYPG1	/TYPE, AND GET BACK CHARACTER IN AC
	SAD (62
	LAW
	SAD (65
	LAW 100
	SAD (70
	LAW 200
	SMA
	JMP DENERR
	AND (1777
	DAC	TRACK	/DENSITY INFO
RDPAR	LAC (40000		/(RCHM-173) ALWAYS USE ODD PARITY.
	XOR	TRACK	/DENSITY,PARTIY,TRACK INFO
	DAC	TRACK	/SAVE IN CASE ANOTHER TAPE LATER
	XOR	MAGCON	/UNIT #
	DAC	MAGCON	/NOW HAVE ALL EXCPT FUNCTION, WHICH
/			/GOES IN DYNAMICALLY
	SET MAGSW
	LAC MWBUFS
	DAC OBUFSZ
	DAC IBUFSZ
	LAC MNUMBK
	DAC DELBLK
	DAC NEWBLK
	LAC DIRECT
	SZA
	JMP MAGOUT
	LAC (JMS MAGIN
	JMP SETTIN		/(RCHM-171) JMS MAGIN.
MAGOUT	LAC (JMS MAGOT
	DAC OUT+1		/'JMS MAGOT'
	LAC INDEV
	SAD DECDSK
	JMP SAVE
	SAD DSKPAK
	JMP SAVE
	SAD DECPAK
	JMP SAVE
BDDEV	JMS ILLDEV
	JMP START
/
TRKERR	LAC (BDTRCK-1		/WRONG NUMBER ENTERED FOR CHANNEL.
	JMS TYPRET		/ONLY 7 OR 9 ACCEPTED.
	JMP RDTRCK		/TRY AGAIN.
/
DENERR	LAC (BADDEN-1		/ILLEGAL DENSITY.
	JMS TYPRET		/ONLY 2,5,8 ALLOWED.
	JMP RDDEN		/TRY AGAIN.
/
PARERR	LAC (BADPAR-1		/ILLEGAL PARITY.
	JMS TYPRET		/ONLY E OR O ALLOWED.
	JMP RDPAR		/TRY AGAIN.
/
ILLDEV	0			/ILLEGAL DEVICE SPECIFIED.
	LAC (BADDEV-1
	JMS TYPRET
	JMP* ILLDEV
	.TITLE RESTORE
/THIS SECTION TAKES INPUT FROM TAPE OR "OTHER TYPE DISK" AND RESTORES
/IT TO EITHER THE DECDISK, DECPACK,  OR THE DISK PACK.
/
RESTOR	JMS REWIND
	LAW 1	/DT, MT SWITCH FOR REWIND SUBROUTINE
GETSAT	JMS READBF		/FILL THE INPUT BUFFER.
	LAC (100		/STARTING ADDR OF BUFFER.
	DAC RPONT1
GTSAT1	JMS SATIN		/PUT SAT IN 'SATBUF'.
	ISZ FIRST
	JMP GOODDV
	LAC* (SATBUF+376	/SYSTEM DEVICE NAME (DP, RK OR DK) IN 
	SAD OUTDEV		/    IN BACKWARD LINK.
	SKP
	JMP DEVERR		/CAN'T PUT DP OR RK SYSTEM ON RF DISK 
				/    OR VICE VERSA.
	LAC* (SATBUF+2		/DATE STORED IN SAT+2.
	JMS DATEOT
GOODDV	LAC* (SATBUF+1
	CMA!IAC			/(RCHM-169)
	DAC SATL
	LAC DISKSW		/RESTORING TO AN RF DISK?
	DZM DISKSW
	SZA!CLA			/SET TO NON-ZERO IF SO.
	JMS INITRF		/GO FIND # PLATTERS, ETC.
LOKSAT	LAC (SATBUF+3
	DAC SATPNT		/DATA STARTS IN WORD 3.
NXTWRD	LAW -22
	DAC BITCNT
	LAC* SATPNT
	IDX SATPNT
NXTBIT	DAC TMPWRD
	SPA
	JMP USEDBK		/THIS BLOCK OCCUPIED - RESTORE IT.
CNTBLK	IDX DSKBLK		/COUNT BLOCK.
	RAL			/SET UP TO LOOK AT NEXT BIT.
	ISZ SATL		/LOOKED AT ENTIRE SAT?
	SKP
	JMP NXTSAT		/YES - SEE IF THERE IS ANOTHER.
	ISZ BITCNT		/LOOKED AT THIS WHOLE WORD?
	JMP NXTBIT		/NO - CURRENTLY LOOKING AT BIT 0.
	JMP NXTWRD		/YES - MUST GET ANOTHER WORD.
NXTSAT	LAC* (SATBUF+377
	SAD LM1
	JMP CLOSE
	LAC BLKCNT		/IS THERE ANOTHER BLOCK IN THE INPUT BUFFER?
	SAD DELBLK
	JMP GETSAT		/NO - GET BLOCK FROM TAPE.
	JMP GTSAT1		/YES - TRANSFER NEXT BLOCK TO 'SATBUF'.
/
SATIN	0
	LAC (SATBUF
	DAC SATPNT
	LAW -400
	DAC TCOUNT
SATIN1	LAC* RPONT1
	DAC* SATPNT
	IDX RPONT1
	IDX SATPNT
	ISZ TCOUNT
	JMP SATIN1
	IDX BLKCNT
	JMP* SATIN
/
DEVERR	LAC (DVERR-1
	JMP	FATAL	/TYPE MESSAGE AND RE-BEGIN
/
/IF RESTORING TO AN RF DISK, MUST FIND OUT HOW MANY PLATTERS ARE AVAILABLE
/ON THE CURRENT SYSTEM.  THEN MUST MAKE SURE THAT THE SOFTWARE SYSTEM BEING
/RESTORED IS NOT LARGER THAN THE MACHINE (FATAL ERROR). IF, HOWEVER, THE SOFTWARE
/SYSTEM IS SMALLER, THE SAT BLOCKS MUST BE ADJUSTED TO REFLECT THE
/ADDITIONAL DISK PLATTER(S). THE ACTUAL ADJUSTMENT IS DONE IN 'CLOSE'.
/
INITRF	DSCF!DSCN
TRYPLT	DLAH
	DSSF
	JMP NXTPLT		/KEEPING LOOKING.
	DSCD
	SNA			/MUST BE AT LEAST ONE PLATTER.
	JMP RFERR		/ERROR- NO PLATTERS.
	DAC PLATER		/NUMBER PLATTERS IN BITS 14-17.
	TAD (LAC NUMBLK-1
	DAC GETSZE
GETSZE	XX
	CMA
	TAD* (SATBUF
	SMA
	JMP RFERR		/SOFTWARE SYSTEM TOO BIG.
	LAC PLATER
	TAD (-5
	SMA!CLA
	JMP CHKSAT		/MORE THAN 4 PLATTERS NEEDS 2 SATS.
CHKSZE	XCT GETSZE
	SAD* (SATBUF
	JMP LOKSAT		/YES. CONTINUE.
	DAC ALTSAT
	JMP LOKSAT
NXTPLT	DSCD
	TAD (1			/TRY FOR ANOTHER PLATTER.
	JMP TRYPLT
/HAVE MORE THAN 4 PLATTERS - MUST HAVE 2 SAT'S.
CHKSAT	LAC* (SATBUF+377			/ALREADY HAVE 2 SAT BLOCKS?
	SAD LM1
	DAC ANOTHR		/NO - SET FLAG TO CREATE ANOTHER.
	JMP CHKSZE
NUMBLK	2000
	4000
	6000
NUMBK2	10000
NUMBK1	12000
	14000
	16000
	20000
/
/ROUTINE TO RESTORE BLOCK TO THE DISK FROM THE INPUT BUFFER.
/
USEDBK	LAC BLKCNT		/BUFFER FULL YET?
	SAD DELBLK		/INPUT BUFFER EMPTY?
	JMS READBF		/YES - REFILL IT.
	JMS WRITDK		/WRITE BLOCK TO DISK.
	LAC RPONT1
	TAD (400
	DAC RPONT1
	IDX BLKCNT
USED10	LAC TMPWRD		/(RCHM-171) FETCH WORD INDICATING NEXT BLOCK.
	JMP CNTBLK
/
/AC = BLOCK # ON ENTRY.
/
READST	0			/PUT SAT INTO 'SATBUF'.
	DAC BLOCK
	LAC (SATBUF
	DAC BUFF
	LAW -400
	DAC BUFSZE
	LAC BLOCK
	JMS IN
	JMP* READST
/
/FILL INPUT BUFFER.
/
READBF	0
	LAC (100
	DAC BUFF
	DAC RPONT1		/RESET BUFFER POINTER.
	LAC IBUFSZ
	DAC BUFSZE
	JMS CHKBLK
	LAC CURBLK
	DAC BLOCK
	JMS IN
	DZM BLKCNT
	JMP* READBF
/
/COME HERE BEFORE DOING ACTUAL INPUT OR OUTPUT OF DECTAPE BUFFER TO MAKE
/SURE THAT THERE IS MORE ROOM ON THE TAPE TO WRITE OR MORE BLOCKS ON THE 
/TAPE TO READ.
/
CHKBLK	0
	ISZ TAPDNE		/-1 IF MUST HAVE NEW TAPE.
	SKP
	JMS GETAPE
	JMP* CHKBLK
/
/COME HERE IMMEDIATELY AFTER READING OR WRITING TO DETERMINE THE BUFFER SIZE FOR THE
/NEXT OPERATION.
/
CHKBK1	0
	LAC COPDNE		/NON-0 IF JUST WROTE LAST BUFFER.
	DZM COPDNE
	SZA
	JMP BEGIN		/DONE.
	LAC NEWBLK		/0 OR MINUS IF JUST USED LAST BUFFER ON THIS TAPE.
	SMA!SZA
	JMP IDXBLK
NEWBUF	CLC
	DAC TAPDNE		/SETUP TO ASK FOR NEW TAPE NEXT TIME.
	LAC DIRECT		/IF INPUTTING FROM DECTAPE, NEED REAL #
	SZA			/OF BLOCKS NOW IN DELBLK.
	JMP FIXIN2
	LAC PNUMBK		/RESET SO GET CORRECT #BLKS ON 1ST BUFFER OF NEW TAPE.
	DAC DELBLK
	JMP* CHKBK1
IDXBLK	DAC CURBLK
	TAD DELBLK
	DAC NEWBLK
	CMA!IAC			/(RCHM-169)
	TAD DTBKCT		/ENOUGH ROOM FOR ANOTHER FULL BUFFER?
	SMA!SZA
	JMP* CHKBK1		/YES.
	DAC NEWBLK		/NO - ADJUST BUFFER SIZE.
	CMA!CLL!IAC		/(RCHM-169)
	JMS R8L
	TAD PBUFSZ		/ADJUST WORD COUNT
	DAC DTBUFS
	LAC DIRECT
	SZA
	JMP FIXIN1
	LAC DELBLK		/AND NUMBER BLOCKS FOR THIS BUFFER.
	TAD NEWBLK
	DAC DELBLK
	SZA
	JMP* CHKBK1
	JMP NEWBUF
/
FIXIN1	LAC DELBLK
	TAD NEWBLK
	DAC DELBK1
	JMP* CHKBK1
/
FIXIN2	LAC DELBK1
	DAC DELBLK
	JMP* CHKBK1
/
/
R8L	0
	RTL; RTL; RTL; RTL
	JMP* R8L
/
/SUBROUTINE TO OUTPUT DATE.
/
DATEOT	0
	DAC DATE		/DATE IN FORM MMDDYY.
	AND (77
	DAC YEAR		/YEAR IN BITS 12-17.
	LAC DATE
	JMS R6R
	DAC DATE
	AND (77
	DAC DAY			/DAY IN BITS 12-17.
	SZA
	TAD (-40
	SMA!CLA
	JMP* DATEOT		/FAIL EXIT
	LAC DATE
	JMS R6R
	AND (77
	DAC DATE		/MONTH IN BITS 12-17.
	SZA
	TAD (-15
	SMA!CLA
	JMP* DATEOT
	DZM PACKCT		/SET UP 'PACK' ROUTINE.
	LAC (DATETT
	DAC PUT
	DZM* PUT
	LAC DAY
	JMS OCTDEC		/CONVERT TO DECIMAL AND OUTPUT.
	LAC DASH
	JMS PACK
	LAC DATE
	TAD (LAC MTABLE-1
	DAC .+1
	XX			/LAC OF PROPER .SIXBT MONTH.
	JMS PACK
	LAC DASH
	JMS PACK
	LAC YEAR
	SZA			/IF 0, OUTPUT 70.
	JMP NOTY70
	LAC (67
	JMS PACK
	LAC (60
	JMS PACK
	JMP PRNTDT
NOTY70	TAD (106
	JMS OCTDEC
PRNTDT	LAC (DATECR-1
	JMS TYPRET
	JMP* DATEOT
/
PACK	0
	DAC PAKTMP
	LAW -2			/SET UP FOR 3 CHARS PER WORD.
	DAC TCOUNT
	LAC PAKTMP
	RAL; RTL; RTL; RTL	/1ST CHAR IN BITS 0-5: PUT INTO BITS 12-17.
PKCHAR	AND (77
	DAC CURCHR
	SNA			/IGNORE 0 CHARACTERS.
	JMP NXTCHR		/IGNORE 0 FIELD.
	LAC PACKCT		/1ST, 2ND OR 3RD CHAR.
	TAD (JMP PKCHR1
	DAC DISPTH
	LAC CURCHR
DISPTH	XX
PKCHR1	JMP CHAR1
PKCHR2	JMP CHAR2
PKCHR3	JMP CHAR3
CHAR1	JMS R6R
	RAR
	AND (770000		/PACK 1ST CHAR INTO BITS 0-5. (770000
PKCH1A	DAC* PUT
	IDX PACKCT
	JMP NXTCHR
CHAR2	RTL; RTL; RTL
	AND (7700		/PACK 2ND CHAR INTO BITS 6-11. (7700
	XOR* PUT
	JMP PKCH1A
CHAR3	XOR* PUT		/3RD CHAR GOES INTO BITS 12-17.
	DAC* PUT
	IDX PUT
	DZM PACKCT
NXTCHR	ISZ TCOUNT		/HAVE ALL INPUT CHARS BEEN DONE?
	JMP .+3			/MAYBE.
	LAC PAKTMP		/3RD CHAR IN BITS 12-17. (NO NEED TO MOVE)
	JMP PKCHAR
	LAC TCOUNT		/MINUS FOR SECOND CHAR; POSITIVE IF DONE.
	SMA
	JMP* PACK
	LAC PAKTMP
	JMS R6R			/2ND CHAR IN BITS 6-11. (PUT INTO BITS 12-17)
	JMP PKCHAR
/
PACKCT	0
PAKTMP	0
PUT	0			/POINTER TO BUFFER.
CURCHR	0		/CHARACTER CURRENTLY BEING PACKED.
/
/SUBROUTINE TO CONVERT OCTAL TO DECIMAL .
/AC=NUMBER TO CONVERTED ON ENTRY.
/
OCTDEC	0
	CMA!IAC			/(RCHM-169)
	DAC DATE1
	DZM TCOUNT
OCTAL2	AAC 12			/(RCHM-169) LOOKING FOR 'TENS'.
	SMA
	JMP GOTTEN		/DONE - HAVE DIGIT.
	IDX TCOUNT
	DAC DATE1
	JMP OCTAL2
GOTTEN	SNA
	DZM DATE1
	LAC DATE1
	SNA
	IDX TCOUNT		/IF 0, NUMBER = 12.
	CMA!IAC			/(RCHM-169)
	DAC DATE1
	LAC TCOUNT
	AAC 60			/(RCHM-169)
	JMS PACK
	LAC DATE1
	AND (17
	AAC 60			/(RCHM-169)
	JMS PACK
	JMP* OCTDEC
MTABLE	.SIXBT 'JAN'
	.SIXBT 'FEB'
	.SIXBT 'MAR'
	.SIXBT 'APR'
	.SIXBT 'MAY'
	.SIXBT 'JUN'
	.SIXBT 'JUL'
	.SIXBT 'AUG'
	.SIXBT 'SEP'
	.SIXBT 'OCT'
	.SIXBT 'NOV'
	.SIXBT 'DEC'
/
DATE	0			/DATE IN FORM MMDDYY.
YEAR	0
DAY	0
DASH	55
DATE1	0
	.TITLE ROUTINE TO DETERMINE SAVABILITY OF BLOCKS.
/+
/ ROUTINE TO SET UP FOR CLEARING OF BITS IN P[HONY SAT TO AVOID READING THEM ON
/ RESTORATION OF THE DOSSAV.
/-
NSR	XX			/(RCHM-171) ENTRY POINT.
	XCT SPOLSW		/(RCHM-171) CHECK FOR SPOOLER AREA?
	JMP NSR005		/(RCHM-171) NO.
	JMS NSRCLR		/(RCHM-171) YES.
	TAD SPOLBEG		/(RCHM-171) ADD BEGINNING EXECUTED BY NSRCLR.
	TAD SPOLSIZ		/(RCHM-171) ADD SIZE EXECUTED BY NSRCLR.
NSR005	XCT QSW			/(RCHM-171) CHECK FOR QAREA?
	JMP* NSR		/(RCHM-171) NO.
	JMS NSRCLR		/(RCHM-171) YES.
	TAD QBEG		/(RCHM-171) AS ABOVE.
	TAD QSIZE		/(RCHM-171) AS ABOVE.
	JMP* NSR		/(RCHM-171) RETURN TO CALLER.
/+
/ ROUTINE TO FIGURE OUT WHETHER OR NOT BITS IN THE SAT SHOULD BE CLEARED
/ IN ORDER TO SAVE THEM FROM THE RESTORE PROCESS.
/
/	JMS NSRCLR		/CALL TO ROUTINE.
/	TAD BEG			/ADD TWO'S COMPLEMENT OF FIRST BLOCK OF AREA TO BE NOT SAVED.
/	TAD SIZE		/ADD TWO'S COMPLEMENT OF SIZE OF AREA TO BE NOT SAVED.
/-
NSRCLR	XX			/(RCHM=-171) ENTRY POINT.
	LAC NSRCLR		/(RCHM-171) FETCH POINTER TO ADD OF AREA BEGINNNING.
	DAC BEG			/(RCHM-171) SAVE FOR LATER.
	IDX NSRCLR		/(RCHM-171) POINT TO ADD OF AREA SIZE.
/+
/ THE FIRST THING TO DO IS TO ELIMINATE ANY CASES WHICH ARE NOT OF INTEREST.
/ SPECIFICALLY, ELEMINATE THE CASES IN WHICH NO BLOCKS IN THIS SAT ARE IN THE AREA
/ TO BE REMOVED FROM THE SAVE.
/-
	LAC DSKBLK		/(RCHM-171) FETCH DISK BLOCK NUMBER OF FIRST BLOCK
				/	      IN CURRENT SAT.
	XCT* BEG		/(RCHM-171) DSKBLK-BEG
	XCT* SIZE		/(RCHM-171) DSKBLK-BEG-SIZE
	SMA			/(RCHM-171) DSKBLK>=BEG+SIZE?
	JMP* NSRCLR		/(RCHM-171) YES.
	LAC DSKBLK		/(RCHM-171)
	TAD* (SATBUF+1)		/(RCHM-171) DSKBLK+NUMBER OF BLOCKS IN SAT (NBS)
	XCT* BEG		/(RCHM-171) DSKBLK+NBS-BEG
	SPA!SNA			/(RCHM-171)SSKBLK+NBS>BEG?
	JMP* NSRCLR		/(RCHM-171) NO, RETURN.
/+
/ WE HAVE NOW IDENTIFIED A CASE OF INTEREST. SOME OR ALL OF THE BLOCKS IN THIS SAT
/ RESIDE WITHIN THE AREA WE WISH TO NOT SAVE. WE NO CALCULATE THE BIT POSITION WITHIN
/ THIS SAT THAT WE MUST START CLEARING WITH.
/-
	LAC DSKBLK		/(RCHM-171) FETCH BLOCK NUMBER OF BEGINNING OF SAT.
	XCT* BEG		/(RCHM-171) DSKBLK-BEG.
	SMA			/(RCHM-171) FIRST BLOCK IN SAT IN AREA TO BE DELETED?
				/	     (DSKBLK<BEG)
	JMP NSR010		/(RCHM-171) NO, CLEAR BEGINNING WITH 1ST WORD OF SAT.
	CMA!IAC			/(RCHM-171) NUMBER OF BITS TO FIRST BIT TO BE CLEARED.
	IDIV			/(RCHM-171) CALCULATE STARTING WORD POSITION.
	22			/(RCHM-171)
	CMA!IAC			/(RCHM-171) REMAINDER IS NUMBER OF BITS TO BE CLEARED.
	DAC LBITS		/(RCHM-171) BEGIN SETTING UP FIRST WORD MASK.
	LACQ			/(RCHM-171) FETCH NUMBER OF WORDS TO SKIP.
	TAD (SATBUF+3)		/(RCHM-171) + RELATIVE ADDRESS OF BEGINNING OF SAT.
	DAC SWORD		/(RCHM-171) SET UP STARTING WORD.
	JMP NSR020		/(RCHM-171) GO FIGURE OUT ENDING POSITION.
NSR010	DZM LBITS		/(RCHM-171) GENERATE A MASK OF ALL 0.
	LAC (SATBUF+3)		/(RCHM-171) ALWAYS START WIL FIRST POSITION OF SAT.
	DAC SWORD		/(RCHM-171) SET UP STARTING CASE.
/+
/ BEGINNING POSITION IS ALL SET UP, NOW WE HAVE TO DO THE SAME THING FOR THE ENDING
/ BIT POSITION.
/-
NSR020	LAC DSKBLK		/(RCHM-171)
	TAD* (SATBUF+1)		/(RCHM-171) DSKBLK+NBS
	XCT* BEG		/(RCHM-171) DSKBLK+NBS-BEG
	XCT* SIZE		/(RCHM-171) DSKBLK+NBS-BEG-SIZE
	SPA!SNA			/(RCHM-171) DSKBLK+NBS>BEG+SIZE?
	JMP NSR030		/(RCHM-171) NO.
	CMA!IAC			/(RCHM-171) NUMBER OF BLOCKS FROM END OF AREA TO END OF SAT.
	TAD* (SATBUF+1)		/(RCHM-171) NUMBER OF BLOCKS RELATIVE TO BEGINNING OF SAT.
	IDIV			/(RCHM-171) CALCULATE NUMBER OF WORDS TO ENDING POSITION.
	22			/(RCHM-171)
	DAC RBITS		/(RCHM-171) NUMBER OF BITS TO BE DELETED FROM LAST WORD.
	LACQ			/(RCHM-171) FETCH RELATIVE ADDRESS OF LAST WORD.
	TAD (SATBUF+3)		/(RCHM-171) CALCULATE REAL ADDRESS OF LAST WORD.
	DAC EWORD		/(RCHM-171) SAVE FOR LATER.
	JMP NSR040		/(RCHM-171) GO CLEAR SAT AREA.
NSR030	LAC (22)		/(RCHM-171) GENERATE A MASK OF ALL 0.
	DAC RBITS		/(RCHM-171) SET UP MASK GENERATOR.
	LAC (SATBUF+375)	/(RCHM-171) FETCH LAST ADDRESS.
	DAC EWORD		/(RCHM-171) AND SET UP LAST WORD POINTER.
/+
/ ALL SET UP IS FINISHED. GENERATE THE BIT MASKS AND LOOP COUNTER AND CLEAR THE SAT.
/-
NSR040	LAC LBITS		/(RCHM-171) FETCH NUMBER OF THIS TO BE SAVED.
	TAD (CLQ!LLS 22)	/(RCHM-171) COMPUT SHIFT TO GENERATE MASK.
	DAC .+2			/(RCHM-171) SET UP FOR USE.
	CMA!CLA			/(RCHM-171) LOAD AC WITH ALL ONES.
	XX			/(RCHM-171) CALCULATE SHIFT.
	DAC LBITS		/(RCHM-171) SAVE FOR LATER.
	LAC RBITS		/(RCHM-171) FETCH NUMBER OF BITS TO DELETE FROM LAST WORD.
	XOR (LRS)		/(RCHM-171) CALCUATE SHIFT TO GENERATE MASK.
	DAC .+2			/(RCHM-171) STORE IN LINE FOR LATER.
	CLA!CMA!CLL		/(RCHM-171) INITIAL MASK OF ALL ONES.
	XX			/(RCHM-171) CALCULATED SHIFT.
	DAC RBITS		/(RCHM-171) SAVE FOR END OF LOOP PROCESSING.
	LAC EWORD		/(RCHM-171) PREPARE LOOP COUNTER.
	CMA			/(RCHM-171) NEED ONE EXTRA COUNT FOR EWORD=SWORD CASE.
	TAD SWORD		/(RCHM-171) LOOP COUNT CALCULATED.
	DAC BEG			/(RCHM-171) BEG NO LONGER NEEDED.
	LAC LBITS		/(RCHM-171) FETCH LEFT SIDE MASK FOR SPECIAL CASE.
	JMP NSR060		/(RCHM-171) ENTER AT BOTTOM OF LOOP.
NSR050	AND* SWORD		/(RCHM-171) REMOVE BITS FROM WORD.
	DAC* SWORD		/(RCHM-171) AND UPDATE PHONY SAT.
	IDX SWORD		/(RCHM-171) MOVE TO NEXT WORD.
	CLA			/(RCHM-171) ALL OTHER MASKS AFTER FIRST ARE 0.
NSR060	ISZ BEG			/(RCHM-171) DONE YET?
	JMP NSR050		/(RCHM-171) NOT YET.
	XOR RBITS		/(RCHM-171) COMBINE CURRENT MASK AND RIGHT MASK FOR SPECIAL CASE.
	AND* SWORD		/(RCHM-171) CLEAR LASW WORD.
	DAC* SWORD		/(RCHM-171) RESTORE LAST WORD.
	JMP* NSRCLR		/(RCHM-171) ALL DONE, EXIT.
/+
/ VARIABLES USED BY NSRCLR.
/-
SIZE=NSRCLR
BEG	0
RBITS	0
LBITS	0
SWORD	0
EWORD	0
	.TITLE SAVE
/
/ROUTINE TO SAVE DISK TO DECTAPE, MAGTAPE OR "OTHER TYPE" DISK.
/
SAVE	DZM DIRECT
	JMS REWIND		/IF MAGTAPE, REWIND TO LOAD POINT.
	LAW 1
	LAC MFDBLK
	JMS READST		/PUT MFD IN 'SATBUF'.
/+
/ NOW SE FIGURE OUT WHETHER OR NOT THERE IS A SPOOLER AREA ON THE DISK.
/-
	LAC* (SATBUF+374	/(RCHM-169) FETCH SPOOLER SIZE.
	LMQ			/(RCHM-169) SAVE SIZE AND CHECKSUM IN MQ.
	AND (177777)		/(RCHM-169) EXTRACT 16 BIT NUMBER OF SPOOL BLOCKS.
	SNA!CMA!IAC		/(RCHM-169) ARE THERE ANY BLOCKS IN SPOOL AREA?
	JMP SAVE0		/(RCHM-169) NO, PROCEED NORMALLY.
	DAC SPOLSIZ		/(RCHM-169) SAVE NUMBER OF BLOCKS IN AREA.
	LAC* (SATBUF+375)	/(RCHM-169) FETCH BEGINNING OF SPOOLER AREA.
	AND (600000)		/(RCHM-169) EXTRACT CHECKSUM BITS.
	CLL!RTR			/(RCHM-169) AND SHIFT TO PROPER POSITION.
	DAC TMPWRD		/(RCHM-169) SAVE TEMPORARILY.
	LACQ			/(RCHM-169) FETCH COUNT WITH CHECKSUM BITS.
	AND (600000)		/(RCHM-169) EXTRACT CHECKSUM BITS.
	XOR TMPWRD		/(RCHM-169) PRODUCE COMPARISON CHECKSUM.
	DAC TMPWRD		/(RCHM-169) AND SAVE IT FOR LATER.
	LACQ			/(RCHM-169) FETCH SPOOL SIZE.
	TAD* (SATBUF+375)	/(RCHM-169) COMPUTE REAL CHECKSUM.
	IAC			/(RCHM-169) + 1 BY DEFINITION.
	CLL			/(RCHM-175) MAKE LEFT SHIFT COME OUT RIGHT.
	ALS 16			/(RCHM-169) MOVE BITS PROPERLY.
	XOR TMPWRD		/(RCHM-169) THIS SHOULD BE ZERO.
	SZA			/(RCHM-169) IS THE CHECKSUM CORRECT?
	JMP SAVE0		/(RCHM-169) NO, NO CHECKSUM TODAY.
	LAC* (SATBUF+375)	/(RCHM-169) FETCH SPOOL AREA BEGINNING.
	AND (177777)		/(RCHM-169) CLEAR TOP TWO BITS.
	CMA!IAC			/(RCHM-169) MAKE IT NEGATIVE.
	DAC SPOLBEG		/(RCHM-169) SAVE FOR COMPARISON LOOP.
	LAC (SKP)		/(RCHM-169) FETCH SWITCH SETTING FOR SPOOL AREA.
	DAC SPOLSW		/(RCHM-169)
SAVE0	LAC (100)		/ SET UP BUFFER POINTER FOR 1ST TIME.
	DAC RPONT1
	LAC* (SATBUF+3		/SAT BLOCK # IN BITS 3-17.
	AND (77777
SAVE1	JMS READST		/NOW PUT SAT IN SATBUF.
	ISZ FIRST		/IF FIRST SAT, SET UP DATE AND DEVICE.
	JMP SKPFIX
	LAC INDEV
	DAC* (SATBUF+376		/STORE DEVICE NAME HERE FOR CHECK ON RESTORE.
	LAC* (147		/DATE IN .SCOM+47.
	DAC* (SATBUF+2		/PUT IT INTO WORD 2.
SKPFIX	LAC* (SATBUF+1		/# BITS TO CONSIDER IN THIS SAT.
	CMA!IAC			/(RCHM-169)
	DAC SATL
	JMS NSR			/(RCHM-171) ERASE ANY BLOCKS NOT TO BE SAVED.
	LAC BLKCNT		/ROOM FOR SAT IN OUTPUT BUFFER?
	SAD DELBLK
	JMS WRITBF		/NO - WRITE OUTPUT BUFFER.
	LAC (SATBUF
	DAC SATPNT		/NOW PUT SAT INTO OUTPUT BUFFER.
	LAW -400
	DAC TCOUNT
ROVER	LAC* SATPNT		/NOW PUT SAT INTO OUTPUT BUFFER.
	DAC* RPONT1
	IDX RPONT1
	IDX SATPNT
	ISZ TCOUNT
	JMP ROVER
	IDX BLKCNT		/COUNT IT.
	LAC (SATBUF+3
	DAC SATPNT		/DATA STARTS IN WORD 3.
OUTER	LAW -22
	DAC BITCNT
	LAC* SATPNT
	IDX SATPNT
INNER	DAC TMPWRD
	SPA
	JMP FULBLK
ROTATE	IDX DSKBLK
	RAL
	ISZ SATL
	SKP
	JMP DNESAT
	ISZ BITCNT
	JMP INNER
	JMP OUTER
DNESAT	LAC* (SATBUF+377
	SAD LM1
	SKP
	JMP SAVE1
	LAC BLKCNT
	SNA
	JMP .+3		/NOTHING IN BUFFER - DONE.
	DAC COPDNE
	JMS WRITBF
	JMS	MTEOF	/PLACE EOF,EOF ON MAGTAPE IF MAGTAPE IS OUTPUT
	JMS REWIND
	CLA
	STL			/DESELECT DT IN CASE OF OUT DEV !!!!
	RAR
	DTXA
	JMP BEGIN
FULBLK	LAC BLKCNT		/ SEE IF ALL DONE WITH THIS BUFFER.
	SAD DELBLK
	JMS WRITBF		/YES - WRITE IT OUT.
	IDX BLKCNT
	JMS READDK
	LAC RPONT1
	TAD (400
	DAC RPONT1
FULBK1	LAC TMPWRD		/(RCHM-171) FETCH MASK INDICATING NEXT BLOCK.
	JMP ROTATE
/
/
/
READDK	0
	LAC RPONT1
	DAC BUFF
	LAW -400
	DAC BUFSZE
	LAC DSKBLK
	DAC BLOCK
	JMS IN
	JMP* READDK
/
/
/
WRITBF	0
	LAC (100
	DAC BUFF
	DAC RPONT1
	LAC OBUFSZ
	DAC BUFSZE
	JMS CHKBLK
	LAC CURBLK
	DAC BLOCK
	JMS OUT
	DZM BLKCNT		/RESET BLOCK COUNT.
	JMP*	WRITBF
/
/
WRITDK	0			/WRITE CURRENT 'USED' BLOCK TO THE DISK.
	LAC RPONT1
	DAC BUFF		/POSITION OF BLOCK IN BUFFER.
	LAW -400
	DAC BUFSZE
	LAC DSKBLK
	DAC BLOCK
	JMS OUT
	JMP* WRITDK
/
/IF MAGTAPE, REWIND.
/
REWIND	0
	LAC MAGSW
	SNA
	JMP DTRWND
	JMS MGDRIV
	NOP		/DUMMY LAC  OF BUFFER ADDRESS
	LAC MREWND		/REWIND FUNCTION.
	JMP* REWIND
/
/DT REWIND
/
DTRWND	XCT* REWIND
	SZA
	JMP NODTRW
	DTRA
	AND (77777
	DTXA		/SAVE UNIT # & STOP TAPE AFTER CLEARING JUNK
	LAC CMD7
	DTXA
NODTRW	JMP* REWIND
/
/
/REQUEST A NEW TAPE.
/
GETAPE	0
	JMS REWIND
	CLA
	LAC PNUMBK		/RESET TO CORRECT # BLOCKS.
	DAC DELBLK
	DAC NEWBLK
	DZM CURBLK		/SET UP TO GET BLOCK 0 FIRST.
	LAC PBUFSZ		/RESET TO CORRECT BUFFER SIZE.
	DAC DTBUFS
	LAC (NEWTAP-1		/ANNOUNCE THAT NEED A NEW TAPE.
GETAP	JMS	TYPWAT	/MESSAGE, CR, GET 1 CHAR IN AC
	CLL!RTR 
	RTR
	AND	(700000
	DAC DTUNIT
	CLC
	DAC NOTBEG
	JMP* GETAPE
/
/ BAD UNIT # TYPED FOR THE '1+X'TH TAPE???
/
DTUBAD	LAC (NOTAPE-1
	JMP GETAP
	.TITLE I/O DISPATCH ROUTINES
/
/
IN	0
	XX
	JMP* IN
/
/
OUT	0
	XX
	JMP* OUT
/
/
/	ROUTINE TO READ MAGTAPE
/
/  MAGTAPE IS READ. ON AN ERROR, THE TAPE IS BACKSPACED
/  THEN READ AGAIN. IF THE COUNT GIVEN IN MTWRCT ISZ'S
/  TO ZERO, IT IS ASSUMED TO BE A FATAL ERROR. CODE
/  ASSUMES MAGTAPE BUFFER STARTS AT 100.
/
MAGIN	0
MAGI00	LAW	-14	/MAGTAPE RETRY COUNT
	DAC	MTWRCT
	JMP	MAGI2	/GO DO READ
MAGI1	JMS	MTBACK	/RETRY SEQUENCE, BACK TO TRY AGAIN
	ISZ	MTETOT	/DEBUGGING, COUNT TOTAL RETRIES
	ISZ	MTWRCT	/TRIED ENUF?
	SKP		/NOPE
	JMP	MTEROT	/TREAT AS FATAL ERROR
MAGI2	LAC	BUFSZE	/CALL MGDRIV, SIZE IN AC
	JMS	MGDRIV
	LAC	(77	/MGDRIV XCT'S TO GET BUFF ADDR.
	LAC	MREAD	/MGDRIV XCT'S TO GET FUNCTION
	SNA!IAC		/SKIP ON ANY PROBLEM
	JMP*	MAGIN	/NONE
	SMA!SZA		/SKIP ON NEW TAPE OR FATAL
	JMP	MAGI1	/RETRY
	SZA		/SKIP ON NEW MAGTAP
	JMP	MTEROT	/FATAL EXIT
	JMS	NEWMAG	/GET NEW MAGTAPE
	JMP	MAGI00	/TRY TO READ FROM IT
/
/
/	ROUTINE TO WRITE ON MAGTAPE
/
/  THE NORMAL SEQUNCE IS WRITE ON MAGAPE, BACKSPACE, READ
/  THE SAME RECORD, AND COMPARE TO ORIGINAL COPY OF RECORD.
/  IF ANYTHING GOES WRONG, BACKSPACE, AND REDO WHOLE
/  SEQUENCE. ON ANY ERROR, THE WRITE IS CARRIED
/  OUT WITH EXTENDED INTERRECORD GAP, TO MOVE TAPE OVER A
/  BAD SPOT.
/  THIS CODE ASSUMES THAT THE ORIGINAL BUFFER IS AT 100, AND
/  THAT THE READ-BACK BUFFER IS AT 15700.
/
/
MAGOT	0
MAGO00	LAW	-14	/MAGTAPE RETRY COUNT
	DAC	MTWRCT
	JMP	MAGO2	/GO TRY TO WRITE
MAGO1	JMS	MTBACK	/BACK UP MAGTAPE TO 'START' OF THIS WRITE
	ISZ	MTETOT	/DEBUGGING, COUNT TOTAL RETRIES
	ISZ	MTWRCT	/TRIES ALLOWED THIS WRITE SEWUENCE
	SKP		/NOT USED UP YET
	JMP	MTEROT	/OH WELL, WE LOSE
	LAC	(10000	/EXTENDED RECORD GAP BIT, MOVE OFF THIS
	DAC	MTXTND	/BAD SPOT, TRY ANOTHER PLACE
MAGO2	LAC	BUFSZE	/BUFFER SIZE
	JMS	MGDRIV	/CALL MGDRIV BUFFER SIZE IN AC
	LAC	(77	/BUFFER ADDR -1
	LAC	MWRITE	/MGDRIV XCT'S THESE TWO INST'S
	SNA!IAC		/SKIP ON ANYTHING WRONG
	JMP	MAGO3	/GO BACK UP TO READ FOR CHECK
	SMA!SZA		/SKIP ON NEW TAPE OR FATAL
	JMP	MAGO1	/GO TRY AGAIN
	SZA		/SKIP ON NEW MAGTAPE
	JMP	MTEROT	/FATAL EXIT
	JMS	NEWMAG	/GET A NEW TAPE
	JMP	MAGO00	/GO TRY WRITE ON NEW TAPE
MAGO3	JMS	MTBACK	/BACK UP FOR READ
	LAC	BUFSZE	/SIZE IN AC
	DAC	LOOPCT	/CONTROL FOR COMPARE LOOP
	JMS	MGDRIV
	LAC	(15677	/BUFFER -1. XCT'ED BY MGDRIV
	LAC	MREAD	/FUCNTION, XCT'ED BY MGDRIV
	SPA		/SKIP ON OK, OR RETRY
	JMP	MTEROT	/FATAL
	SZA		/SKIP ON OK
	JMP	MAGO1	/NOPE, GO RETRY
	LAC	(77	/COMPARE LOOP
	DAC*	(14	/AUTO INCR REG.
	LAC	(15677
	DAC*	(17	/ANOTHER ONE
MAGO4	LAC*	14
	SAD*	17
	SKP		/SAME, KEEP CHECKING
	JMP	MAGO1	/MISSED, RETRY
	ISZ	LOOPCT	/CONTROL
	JMP	MAGO4	/MORE TO CHECK
	JMP*	MAGOT	/WE MADE IT!!
/
MTBACK	0		/CALL TO BACK SPACE MT 1 RECORD
	LAW	-1	/COUNT OF BACKSPACED RECORDS
	JMS	MGDRIV
	LAW	0	/DUMMY OF ADDR
	LAC	MBKSPC	/FUNCTION
	JMP*	MTBACK	/DON'T RECOGNIZE ERRORS (FATALS????)
/
MTEROT	LAC	(MTERRO-1
	JMP	FATAL	/PRINT AND RESTART
/
/
/	ROUTINE NEWMAG SETS UP TO ACCESS A NEW TAPE REEL.
/
NEWMAG	0
	JMS	MTBACK	/MOVE BACK TO LAST GOOD RECORD
	JMS	MTEOF	/PUT ON EOF,EOF
	JMS	REWIND	/REWIND OLD ONE
	LAC	(NEWTAP-1 /TELLL CONSOLE WHAT'S HAPPENEING
NEWMG1	JMS	TYPWAT	/TYPE OUT, CR, GET 1 CHAR
	SAD	(15	/IF USER HITS <CR><CR> GIVE HIM SAME TAPE
	JMP	NEWMG2	/LEAVE MAGCON ALONE
	TAD	(-70	/CHECK  CHAR<CR> FOR LIMITS 0-7
	SMA		/UPPER LIMIT CHECK
	JMP	NEWMG3	/FAILED, TELL USER HEE GOOOOFED
	TAD	(10	/CHECK LOWER LIMIT
	SPA!RTR		/SKIP IF OK,START MOVING # TO TOP 3 BITS
	JMP	NEWMG3	/FAILED, PRINT ERROR MESSAGE
	RTR		/NOW BITS ARE IN PLACE
	AND	(700000	/GET RID OF OTHER BITS
	XOR	TRACK	/TRACK HAS PARITY, DENSITY, TRACK INFO
	DAC	MAGCON	/THIS NOW HAS THOSE + UNIT #
NEWMG2	JMS	REWIND	/INSURE NEW TAPE TO BE AT LOAD POINT
	JMP*	NEWMAG	/ALL SET TO RETRY OPERATION ON NEW TAPE
NEWMG3	LAC	(BADUNT-1 /BAD UNIT NUMBER MESSAGE ADDRESS
	JMP	NEWMG1	/BACK TO TOP AND DO AGAIN
/
LOOPCT	0		/LOOP CONTROL FOR CHECK
/
/  ROUTINE MTEOF PLACES EOF, EOF ON MAGTAPE IF THAT'S THE OUTPUT DEV.
/
MTEOF	0
	LAC	OUTDEV	/FIDN OUT IF MAGTAPE
	SAD	MAGTAP
	SKP		/IT IS, CONTINUE
	JMP*	MTEOF	/IT ISN'T, DO NOTHING
	LAC	MAGCON	/FORCE WRITE IN EVEN PARTIY
	AND	(40000	/PARITY BIT
	XOR	MEOF	/CODE FOR EOF
	DAC	MTEOFT	/SAVE IN TEMPORARY, LATER LAC'ED BY MGDRIV
	JMS	MGDRIV	/CALL DRIVER
	LAW	0	/ADDRESS IGNORED
	LAC	MTEOFT	/EOF, AND BIT TO FORCE EVEN PARITY
	JMS	MGDRIV	/IGNORE ERROR, DO AGAIN
	LAW	0
	LAC	MTEOFT
	JMP*	MTEOF
MTEOFT	0		/TEMPORARY FOR MTEOF
/
/
/BLOCK NUMBER IN AC ON ENTRY.
/
DTAPIN	0
	JMS DTDRIV
	LAC DTRD		/READ.
	JMS CHKBK1		/CHECK FOR TAPE DONE.
	JMP* DTAPIN
/
/
/
DTAPOT	0
	JMS DTDRIV
	LAC DTWD		/WRITE
	JMS CHKBK1
	JMP* DTAPOT
/
/'BLOCK' IN AC ON ENTRY.
/
RFDKOT	0
	JMS RFDRIV
	LAC RFFWR		/WRITE.
	JMP* RFDKOT
/
/
/
RFDKIN	0
	JMS RFDRIV
	LAC RFFR		/READ.
	JMP* RFDKIN
/
/
/
DPAKIN	0
	JMS DPDRIV
	LAC DPFR		/READ.
	JMP* DPAKIN
/
/
/
DPAKOT	0
	JMS DPDRIV
	LAC DPFWR
	JMP* DPAKOT
/
/
/
RKDKIN	0
	JMS RKDRIV
	LAC (FRD		/READ.
	JMP* RKDKIN
/
/
/
RKDKOT	0
	JMS RKDRIV
	LAC (FWR		/WRITE.
	JMP* RKDKOT
/SYSTEM ALL RESTORED. IF RESTORED A SYSTEM SMALLER THAN FITS THIS MACHINE,
/MUST NOW ADJUST SATS.
/
CLOSE	JMS REWIND
	CLA
	STL
	RAR
	DTXA		/DESELECT THE DT IF INPUT DEVICE!!
	LAC ALTSAT		/NON-ZERO IF NEED TO ADJUST BLOCK NUMBER.
	SNA
	JMP BEGIN		/REALLY ALL DONE - GO RESTART.
	LAC (SATBUF
	DAC BUFF
	LAW -400
	DAC BUFSZE
	LAC (RFMFD
	JMS RFDKIN		/GET MFD BLOCK.
	LAC* (SATBUF+3
	AND (77777
	DAC SATBLK
	JMS RFDKIN		/PUT SAT IN SATBUF.
	LAC ANOTHR		/NON-ZERO IF NEED ANOTHER SAT.
	DZM ANOTHR
	SZA
	JMP NEWSAT
	LAC ALTSAT		/CONTAINS CORRECT NUMBER BLOCKS IN SYSTEM.
	DAC* (SATBUF
	LAC* (SATBUF+377
	SAD LM1
	JMP ONESAT
	LAC NUMBK2		/10000
	SKP
ONESAT	LAC ALTSAT
	DAC* (SATBUF+1
SATOUT	LAC SATBLK
	JMS OUT			/REWRITE UPDATED SAT.
	LAC* (SATBUF+377		/ANOTHER SAT BLOCK?
	SAD LM1
	SKP
	JMP CLOSAT		/YES - GET IT AND MODIFY IT.
	DZM ALTSAT
	JMP BEGIN
CLOSAT	DAC SATBLK
	JMS RFDKIN
	LAC ALTSAT
	DAC* (SATBUF
	CLC
	TAD NUMBK1
	CMA
	TAD ALTSAT
	DAC* (SATBUF+1
	JMP SATOUT
NEWSAT	LAC ALTSAT
	DAC* (SATBUF
	LAC NUMBK1
	DAC* (SATBUF+1
	LAC (1775
	DAC* (SATBUF+377			/SET UP FOREWARD LINK.
	LAC* (SATBUF+73
	AND (20		/LOOK AT BIT FOR BLOCK 1775.
	SZA			/IF OCCUPIED, CAN'T SET UP THE SECOND SAT.
	JMP SATERR		/IT IS OCCUPIED - DECLARE AN ERROR.
	LAC* (SATBUF+73			/INDICATE BLOCK 1775 USED.
	AND (777757
	XOR (20
	DAC* (SATBUF+73
	LAC SATBLK
	JMS OUT			/REWRITE UPDATED SAT.
	LAW -400
	DAC TCOUNT		/ZERO OUT BUFFER FOR USE AS SECOND SAT BLOCK.
	LAC (SATBUF
	DAC RPONT1
	DZM* RPONT1
	ISZ TCOUNT
	JMP .-2
	LAC SATBLK		/BACKWARD LINK.
	DAC* (SATBUF+376
	CLC
	DAC* (SATBUF+377
	LAC ALTSAT
	DAC* (SATBUF
	CLC
	TAD NUMBK1
	CMA
	TAD ALTSAT		/SUBTRACT # BLOCKS IN FIRST SAT.
	DAC* (SATBUF+1
	LAC (1775
	JMS OUT			/WRITE BLOCK.
	DZM ALTSAT
	JMP BEGIN
/
R6R	0
	RTR; RTR; RTR
	JMP* R6R
/
SATERR	LAC (SATER-1
	JMP	FATAL	/PRINT, AND BEGIN AGAIN
/
DIRECT	0
MAGTAP	1524
DECTAP	424
DECDSK	413
DSKPAK	420
DECPAK	2213
MFDBLK	0
DISKSW	0			/NON-ZERO IF RESTORING TO RF DISK.
ALTSAT	0			/NON-ZERO IF NEED TO ALTER RESTORED SAT.
ANOTHR	0			/NON-ZERO IF NEED TO CREATE ANOTHER SAT BLOCK.
FIRST	0
SATL	0
SATBLK	0
CURBLK	0
NEWBLK	0
DELBLK	0
DELBK1	0
SATPNT	0
BITCNT	0
TMPWRD	0
DSKBLK	0
BLKCNT	0
BUFPNT	0
TCOUNT	0
RPONT1	0
BLOCK	0
OBUFSZ	0
IBUFSZ	0
MAGCON	0		/MAGTPAE COMMAND REGISTER (MINUS FUNCTION).
MREWND	1000		/BIT 8 OF COMMAND REGISTER (MAGTPAE.
MBKSPC	7000	/BITS 6,7,8. (SPACE REVERSE)
MREAD	2000		/BIT 7.
MWRITE	4000		/BIT 6.
MEOF	5000		/WRITE EOF
MAGSW	0		/NON-ZERO IF DOING MAGTAPE.
BUFF	0		/HOLDS BUFFER ADDRESS FOR DRIVER.
BUFSZE	0		/HOLDS WORD COUNT (MINUS) FOR DRIVER.
INDEV	0
OUTDEV	0
TRACK	0		/DENSITY, PARITY, AND TRACK INFO
TAPDNE	0
COPDNE	0
MTWRCT	0		/MT READ AND WRITE RETRY COUNT
MNUMBK	32	/# OF BLOCKS TO TRANSFER AT ONE TIME FOR MTOUT
PNUMBK	67		/NUMBER OF BLOCKS TO TRANSFER AT ONCE.
DTBKCT	1100			/NUMBER BLOCKS ON A DECTAPE.
PBUFSZ	744400
DTBUFS	744400		/BUFFER SIZE (MINUS) FOR DECTAPE.
MWBUFS	762400	/BUFFER SIZE FOR MT SAVE
MWBUFA	15700	/BUFFER ADDRESS FOR MTOUT WRITE CHECK
SPOLSW	NOP			/(RCHM-169) (SPOL)LER AREA EXISTS (SW)ITCH.
				/(RCHM-169)  NOP => NO SPOOLER AREA.
				/(RCHM-169)  SKP => SPOOLER AREA.
 
SPOLBEG	0			/(RCHM-169) (SPOOL)LER AREA (BEG)IN BLOCK.
				/(RCHM-169)  TWO'S COMPLEMENT OF FIRST BLOCK OF SPOOLER
				/(RCHM-169)  AREA.
 
SPOLSIZ	0			/(RCHM-169) (SPOL)LER AREA (SIZ)E
				/(RCHM-169)  TWO'S COMPLEMENT OF NUMBER OF BLOCKS IN
				/(RCHM-169)  THE SPOOLER AREA.
 
QSW	NOP			/(RCHM-170) SAVE (Q)ARES (SW)ITCH.
				/(RCHM-170) NOP => SAVE QAREA.
				/(RCHM-170) SKP => DELETE QAREA.
 
QBEG	0			/(RCHM-170) (Q)AREA (BEG)INNING BLOCK.
				/(RCHM-170) TWOS COMPLEMENT OF FIRST BLOCK OF QAREA.
 
QSIZE	0			/(RCHM-170) (Q)AREA (SIZE).
				/(RCHM-170) TWOS COMPLEMENT OF QAREA NUMBER OF BLOCKS.
	.TITLE MAGTAPE DRIVER ROUTINE.
/
MTSF=707341		/SKIP ON ERROR OR DONE FLAG.
MTCR=707321		/SKIP ON TAPE CONTROL READY (TCR).
MTTR=707301		/SKIP ON TAPE UNIT READY (TUR).
MTAF=707322		/CLEAR STATUS: COMM,EF,MTF IF TUR; ONLY EF,MTF IF NOT TCR.
MTLC=707326		/LOAD 0-11 OF COMMAND REGISTER FROM AC.
MTRS=707352		/READ STATUS (0-11) INTO AC.
MTGO=707304		/EXECUTE COMMAND IN COMMAND REGISTER.
/
/ CALLING SEQUENCE
/
//	LAC	BUFSZE	/NEGATIVE BUFFER SIZE TO AC
//	JMS	MGDRIV
//	LAC	(BUFF-1	/LAC OF BUFFER ADDR-1
//	LAC	IOFUNC	/LAC OF FUNCTION CODE
/	...		/RETURN
/
/  ON RETURN, AC=0 FOR OK OPERATION
/	      AC>0 FOR A RETRIABLE ERROR
/	      AC=-1 FOR A NEW TAPE NEEDED
/	      AC<-1 FOR A FATAL ERROR,STATUS REG. IN AC
/		EXCEPT FOR ILLEGAL FUNC. WHICH RETURNS 403477
/
/
MGDRIV	0
	DZM	MTLONG	/RESET COUNT OF NOT READY IN CASE NEED
	MTCR		/WAIT FOR CONTROLLER
	JMP	.-1
	DAC*	MAGWC	/WROD COUNT IN AC
	XCT*	MGDRIV	/GET BUFFER-1
	ISZ	MGDRIV
	DAC*	MAGBUF
	XCT*	MGDRIV	/GET FUNCTION
	ISZ	MGDRIV
	XOR	MAGCON	/REST OF COMMAND REGISTER
	XOR	MTXTND	/EXTNEDED RECORD GAP IN ANY
	DZM	MTXTND	/NOT AGAIN
	MTLC		/INTO COMMAND REGISTER
MGDRCT	ISZ	MTLONG	/COUNTDOWN
	JMP	MGDRCH	/NOT YET, CHECK DRIVE AVAILABLE
	MTRS		/OVERFLOW, CHECK IF REWINDING
	RTL		/REWIND BIT IN LINK
	LAC	(NOTAPE-1 /TAPE NOT READY MESSAGE ADDRESS
	SNL		/NO PRINTOUT IF REWINDING
	JMS	TYPWAT	/TYPE MESS, CR, WAIT FOR RESPONSE.
MGDRCH	MTTR		/WAIT FOR UNIT
	JMP	MGDRCT	/ISZ COUNT, DON'T WAIT FOREVER
/			/USER MAY HAVE ASKED IMPOSSIBLE DIRVE
	MTGO		/READY, DO IT!
/
/  HERE COMES #062. AN IMMEDIATE ILLEGAL FUNCTION BIT IS A DISASTER
/  SUCH AS WRITE ON A WRITE LOCKED TAPE; A LATER ILLEGAL
/  FUNCTION IS ACCESSING A TAPE THAT IS IN THE PRCESS OF SLOWING DOWN
/  THIS TO BE IGNORED.  (ROGER PARTRIDGE)
/
	MTRS		/CHECK ILLEGAL FUNCTION
	AND	(40000	/THIS BIT
	TAD	(343477	/MAKE FAKE CODE FOR ILLEGAL FUNC. IF PRESENT
	SPA		/SKIP IF NOT PRESENT
	JMP	MGBLOP	/GOT IT. GO ENTER 2 SECOND DELAY LOOP. NOT
/			/SUPPOSED TO BE NECESSARY, BUT I'M SCARED.
/
	MTSF		/WAIT FOR DONE (NOT=READY) DIDN'T GET ILLEGAL FUNC.
	JMP	.-1
	MTRS		/GET STATUS
MGBLOP	DZM	MTLONG	/SET UP DELAY LOOP IN CASE ERROR
MGLOOP	DAC	MTSTAT	/SAVE STATUS
	ISZ	MTLONG	/COUNT AROUND TO 0 AGAIN
	SMA		/SKIP IF BAD STATUS
	SKP		/SKIP TO ESCAPE LOOP , EITHER IF
/			/STATUS IS GOOD, OR ISZ SKIPS
	JMP	MGLOOP
	AND	(14000	/STOP THIS REEL ON EOF OR EOT (EOF NOT SEEND ON WRITE)
	SZA!CLL!CLA!CMA	/SKIP IF NOT, SET -1 FOR EXIT, 0 LINK FOR CONTINUE
	JMP*	MGDRIV	/END, EXIT WITH -1 IN AC TO SHOW THAT
	LAC	MTSTAT	/FRESH COPY OF STATUS
	AND	(3400	/BAD STATUS BITS, ILL. FUNCT NOT !NOW! AN ERROR
	TAD	(-5	/DIRTY, SETS LINK, IF A BAD STATUS BIT
	LAC	MTSTAT
	SNL		/SKIP ON FATAL ERROR, LEAVING STATUS IN AC
	AND	(20200	/THE RETRY BITS
	JMP*	MGDRIV
/
MAGWC	32
MAGBUF	33
MTSTAT	0			/HOLDS STATUS REGISTER.
MTXTND	0		/HOLDS XTENDED RECORD GAP BIT
MTLONG	0		/2^18 WRAPAROUND COUNT
MTETOT	0		/DEBUGGING, COUNT TOTAL RETRIES
	.TITLE DECTAPE DRIVER ROUTINES.
/
/DTNG=.			/NO GO (STOP)
/DTNM=.			/NORMAL MODE.
/DTMV=.			/MOVE.
/DTCE=.			/CLEAR ERROR FLAGS.
/DTCD=.		/CLEAR DONE FLAG.
/DTFW	000000	/FOREWARD
/DTRV	040000	/REVERSE
/DTGO	020000	/GO
/DTCM	010000	/CONTINUOUS MODE
/DTSE	001000	/SEARCH
DTRD	002000	/READ DATA
DTWD	004000	/WRITE DATA
/DTPE	000200	/PRESERVE ERR FLAG
/DTPD	000100	/PRESERVE DONE FLAG
DTWC	30
DTBUF	31
CMD1	40000		/DTFW!DTRV
CMD2	11000		/DTCM!DTSE
CMD3	37000		/DTGO!DTNG!DTNM!DTCM!DTMV!DTSE!DTRD!DTWD
CMD4	21300		/DTGO!DTNM!DTSE!DTPE!DTPD
CMD5	10000		/DTNM!DTCM
CMD6	20000		/DTGO!DTNG!DTCD!DTCE
CMD7	70000	/DTRV!DTGO!DTCM
/
DTCA=707541	/CLEAR STATUS REGISTER-A
DTRA=707552	/READ STARUS REGISTER-A
DTRB=707572	/READ STATUS REGISTER-B
DTXA=707544	/XOR AC INTO STATUS REG-A
DTLA=707545	/LOAD STATUS REG-A FROM AC
DTDF=707601	/SKIP ON DECTAPE DONE FLAG
DTEF=707561	/SKIP ON DECTAPE ERR FLAG
/
DTDRIV	0
	DAC FDBLK		/BLOCK NUMBER.
	LAW -5
	DAC DTERCT
	XCT* DTDRIV		/GET I/O FUNCTION.
	DAC DTIOF
	IDX DTDRIV		/BUMP TO EXIT.
DTRTRY	DTRA
	AND (700000
	DTXA	/DESELECT THE DT
	LAC DTUNIT
	DTXA	/SELECT THE REQ. DT UNIT!
	DTRA
	AND (77777
	DTXA	/NOW CLEAR JUNK IN COMMAND REG????????
FD1	LAC	FDBLK		/SEARCH FOREWARD.
	JMS	SEARCH
	JMP	RWBLK		/BLOCK FOUND -- GO READ OR WRITE.
	LAC CMD1		/OVERSHOOT - SET BACKWARD.
	DTXA
	DAC OVSNRP
FD2	LAC FDBLK		/MOVE TAPE BACKWARD TWO BLOCKS.
	TAD DIROVS
	JMS	SEARCH
	NOP			/NO CHANCE OF FOUND BLOCK HERE.
	LAC CMD1		/SET FOREWARD AND SEARCH FOR BLOCK.
	DTXA
	DZM OVSNRP		/CLEAR OVERSHOOT FLAG .
	JMP	FD1
/
/ DESIRED BLOCK NUMBER HAS BEEN FOUND, R/W BLOCK.  FLAGS ARE LEFT
/ SET UNTIL FUNCTION IS SWITCHED FROM SEARCH TO READ/WRITE SO THAT A
/ TIMING ERROR WILL OCCURR IF THE SWITCH IS NOT MADE BEFORE THE DATA 
/ AREA HAS REACHED THE R/W HEADS.
/
RWBLK	LAC DTBUFS		/SET WORD COUNT.
	DAC* DTWC
	CLC
	TAD BUFF
	DAC* DTBUF
	DTRA			/INSURE CONTINUOUS MODE
	AND CMD5
	XOR CMD2		/TAKE OUT SEARCH BIT.
	XOR	DTIOF		/CLEAR FLAGS AND SWITCH FROM SEARCH TO READ/WRITE.
	DTXA			/IOT MUST IMMEDIATELY PROCEED JMS.
	JMS WAITDT		/GO WAIT FOR FLAGS.
	JMP	RETRY		/ERROR: -- RETRY
	JMP* DTDRIV		/DONE.
/
/ SEARCH -- SUBROUTINE TO SEARCH IN THE CURRENT DIRECTION FOR THE BLOCK
/           WHOSE BLOCK NUMBER IS IN AC.  RETURN WHEN THE BLOCK HAS BEEN FOUND.
/           THE DT FLAGS ARE CLEARED UPON ENTRY
/
/           IF BLOCK IS FOUND, RETURN AT JMS+1 WHTH FLAGS LEFT SET
/           IF OVERSHOT, RETURN AT JMS+2 WITH GO-BIT & FLAGS CLEARED
/
SEARCH	0
	DAC	RBUF	/SAVE NUMBER OF REQUIRED BLOCK
	DZM* DTWC			/SET WORD COUNT TO AVOID OVERFLOW.
	LAC	(BBUF		/SET CORE ADDRESS TO STORE BLOCK NUMBERS IN 'BBUF'
	DAC* DTBUF
	DTRA		/ALTER NECESSARY BITS OF DT STATUS REGISTER SUCH
			/THAT FUNCTION IS SEARCH, MODE IS NORMAL, THE GO-BIT IS SET,
			/AND THE FLAGS ARE CLEARED (DIRECTION UNCHANGED).
	AND CMD3
	XOR CMD4
	DTXA
	JMS WAITDT		/GO WAIT FOR FLAGS.
SR1	JMP ERRDT			/ERR FLAG.
SR3	LAC	BBUF		/DETERMINE DIFFERENCE BETWEEN DESIRED BLOCK
	AND (RFMFD			/MASK OFF ILLEGAL BLOCK NUMBERS. (1777
	CMA!IAC			/(RCHM-169) AND JUST DETECTED BLOCK NUMBERS.
	TAD	RBUF
	DAC TCOUNT
	SNA!CLL			/DESIRED BLOCK?
	JMP*	SEARCH		/YES -- EXIT SEARCH AT JMS+1 WITH FLAGS SET
	CMA!IAC			/(RCHM-169)
	SPA!CLL			/CALCULATE DIFFERENCE BETWEEN DESIRED BLOCK
	JMP .+3		/(RCHM-169)
	CMA!IAC			/(RCHM-169)
	STL
	DAC* DTWC		/PUT IN TWO'S COMPLEMENT IN BLOCK COUNTER (WORD COUNT).
	/			/ HAS DESIRED BLOCK BEEN OVERSHOT?
	DTRA
	AND CMD1
	SNA
	JMP	SR4
	SNL
	JMP	SROVS		/YES (OVERSHOOT) -- EXIT SEARCH AT JMS+2
	JMP SR5			/NOT OVERSHOOT. CLEAR FLAGS AND TRY AGAIN.
SR4	SZL
	JMP SROVS		/OVERSHOOT - EXIT SEARCH AT JMS+2.
SR5	LAC CMD5		/NOT OVERSHOOT -SET CONTINUOUS MODE SEARCH.
	DTXA
	JMS WAITDT		/GO WAIT FOR FLAGS.
	JMP ERRDT
	JMP SR3
SROVS	LAC CMD6
	DTXA				/EXIT SEARCH ROUTINE AT JMS+2
	ISZ	SEARCH
	JMP*	SEARCH
ERRDT	DTRB			
	AND (270000
	SNA
	JMP	SROVS		/END ZONE -- EXIT AT JMS+2
RETRY	DTRB			/READ THE ERROR STATUS.
	ISZ	DTERCT		/INCREMENT ERROR COUNT.
	SKP!RAL			/PUT SELECT ERROR BIT IN BIT 0.
	JMP DTERR		/FATAL ERROR: CAN'T RECOVER.
	JMP	SEARCH+2	/NO TRY AGAIN AND SEE IF IT CAN BE DONE THIS TIME
/
/SUBROUTINE TO WAIT FOR A FLAG TO COME UP.
/EXIT AT WAITDT+1 IF ERROR;
/EXIT AT WAITDT+2 IF ALL OK.
/
WAITDT	0
	DTDF			/SKIP ON DECTAPE FLAG.
	SKP
	JMP CHKERR		/MUST ALSO CHECK FOR PARITY ERROR.
	DTEF			/SKIP ON ERROR FLAG.
	JMP WAITDT+1
	JMP* WAITDT		/GOT ERROR - EXIT.
CHKERR	DTEF
	JMP OUTOK
	ISZ DTERCT		/PARITY ERROR - TRIED 5 TIMES?
	JMP DTRTRY		/NO - TRY AGAIN.
DTERR	DTXA+10			/CLEAR DECTAPE FLAGS.
	ISZ NOTBEG
	SKP
	JMP DTUBAD
	LAC (FATALA-1		/FATAL DECTAPE ERROR.
	JMP	FATAL		/PRINT AND RE-BEGIN
OUTOK	IDX WAITDT
	JMP* WAITDT
/
	JMP WAITDT+1
/
/DECTAPE UNIT NOT READY.
/
DTNRDY	LAC (NOTAPE-1
	JMS	TYPWAT	/TYPE MESS, CR, GET RESPONSE
	DTRA			/SEE IF SEARCHING.
	AND (1000
	SNA
	JMP DTRTRY		/NOT SEARCHING - GO RETRY.
	LAC OVSNRP		/SEARCHING - MUST WORRY ABOUT DIRECTION.
	SZA
	JMP FD2
	JMP FD1
RBUF	0		/DESIRED BLOCK NUMBER (SEARCH)
NOTBEG	0		/DT BEGINNING OF TAPE SW
DTERCT	-5
DTUNIT	0		/UNIT NUMBER IN BITS 0-2.
DTIOF	0			/READ (2000) OR WRITE (4000).
BBUF	0			/HOLDS BLOCK NUMBER FOUND ON SEARCH.
OVSNRP	0
FDBLK	0			/REQUESTED BLOCK NUMBER.
DIROVS	-2			/OVERSHOOT SPACE COUNT.
	.TITLE RF DISK DRIVER ROUTINES.
/
/
DSSF=707001	/SKIP IF DISK FLAG.
DSCC=707021	/CLR DISK CONTROL, DISABLING 'FREEZE'.
DRAL=707022+10	/CLEAR AC,XOR AP0 INTO AC.
DRAH=707062+10	/CLEAR AC,XOR AP1 INTO AC.
DLAL=707024	/LOAD AC(BITS 0-17) INTO AP0
DLAH=707064	/LOAD AC(BITS 15-17)INTO AP1.
DSCF=707041	/CLEAR FUNCTION REGISTER.
DSFX=707042	/XOR AC(BITS 15-17)INTO FUNCTION REGISTER.
DSCN=707044	/EXECUTE CONDITION IN FR.
DSCD=707242	/CLEAR STATUS REG AND DISK FLAG.
DSRS=707262+10	/CLEAR AC,XOR STATUS INTO AC.
/
/THERE ARE THREE BITS IN THE FUNCTION REGISTER.
/  BITS 15 AND 16 SPECIFY THE FUNCTION THAT
/IS TO BE PERFORMED BY THE CONTROLLER.  THE FUNCTION IS LOADED
/INTO THE FIRST BUFFER, AND AN EXECUTE IOT (DSCN) IS ISSUED TO
/LOAD IT INTO THE SECOND BUFFER FOR EXECUTION.  AT THE END
/OF AN OPERATION, OR IF AN ERROR OCCURS, THE SECOND BUFFER
/IS CLEARED AND EXECUTION STOPS.  THE OPERATION CAN THEN
/BE CONTINUED BY ISSUING A DSCN IOT EXECUTE.  BIT 17, ALSO
/CONTAINED IN THE FUNCTION REGISTER, ENABLES THE PROGRAM
/INTERRUPT AND API LOGIC OF THE CONTROL. (NOT USED BY THIS PROGRAM).
/THE FUNCTION REGISTER BIT CONFIGURATION IS AS FOLLOWS:
/	FUNCTION	BIT 15	BIT 16
/	--------	------	------
/	NO EFFECT	  0	  0
/	READ		  0	  1
/	WRITE		  1	  0
/	WRITE CHECK	  1	  1
/SUBROIUTINE DRIVER STARTS SOME I/O GOING. 
/CALLING SEQUENCE:
/L0C-1	LAC BLOCK
/LOC	JMS DRIVER
/LOC+1	LAC (FUNC	/GET THE FUNCTION
/LOC+2 RETURN CONTROL HERE WHEN DONE.
/
RFDRIV	0
	DAC RFBLOK	/BLOCK # TO TRANSFER.
	XCT* RFDRIV		/GET FUNCTION.
	IDX RFDRIV
	DAC RFIOF
	LAW -12
	DAC RFPARY	/SET PARITY RETRY COUNT.
	.EJECT
/LOGICAL BLOCK  AND PHYSICAL DISK ADDRESS RELATIONSHIP.
/DISK# 	TRACK(0-6)   +   WORD(7-17)   =   BLOCK
/    0	   0		    0		    0
/    0	   0		    400		    1
/    0	   2		    1000	    22
/    .	   .		    .		    .
/    2	   400,000	    0		    5000
/    7	   774,000	   3,400	    17,777
/THE BLOCK NUMBER MUST BE MAPPED INTO THE PLATTER NUMBER
/'PLATER', THE TRACK ADDRESS (BITS 0-6), AND THE WORD
/ADDRESS (BITS 7-17) INTO RFTRCK.
/
	LAC RFBLOK	/DIVIDE BY 2000 TO GET PLATTER NUMBER.
	RTR; RTR; RTR; RTR
	RTR
	AND (7
	DAC PLATER
	LAC RFBLOK	/MULT BY 400 TO GET WORD.
	JMS R8L
	AND LM400
	DAC RFTRCK
RFRTRY	LAC BUFSZE
	DAC* RFWC	/W.C.
	LAC BUFF
	TAD LM1
	DAC* RFBUF
	DSCC		/CLEAR DISK.
	LAC RFTRCK
	DLAL		/TRACK, SECTOR ADDR.
	LAC PLATER	/DISK NUMBER.
	DLAH
	LAC RFIOF		/LOAD FUNCTION REGISTER.
	DSCF!DSCN!DSFX		/CLEAR AND LOAD AND GO.
/
/THE 10-BIT STATUS REGISTER REFLECTS THE STATE
/OF THE DEVICE AFTER IT HAS PERFORMED ITS SPECIFIED
/OPERATION.  ANY TIMING OR PARITY ERRORS THAT HAVE
/OCCURRED DURING THE OPERATION ARE INDICATED HERE.
/
/RF15	DISK STATUS REGISTER.
/		0-ERROR FLAG.*
/		1-DISK HARDWARE ERROR (FREEZE).
/		2-ADDRESS PARITY ERROR (FREEZE).
/		3-MISSED TRANSFER.
/		4-WRITE CHECK ERROR.
/		5-DATA PARITY ERROR.
/		6-WRITE LOCK OUT.
/		7-NON-EXISTANT DISK.
/		8-DCH TIMING ERROR (0 NOT SET).
/		9-PROGRAM ERROR (0 NOT SET).
/		10-TRANSFER COMPLETE.*
/		* CAUSES API OR PI.
/
	DSSF
	JMP .-1			/WAIT FOR DISK FLAG.
	DSRS		/READ DISK STATUS.
	DAC RFSTAT
	SPA!RTL
	JMP RFERRS		/(068:JMW) ERROR FLAG UP.
	DSCD		/CLEAR DISK STATUS.
	LAC RFIOF	/WAS THIS A WRITE?
	SAD RFFWR	/WRITE FUNCTION.
	JMP RFWCHK	/YES- DO A WRITE CHECK.
	JMP* RFDRIV		/DONE - EXIT.
/
/A WRITE HAS JUST COMPLETED. DO A WRITE CHECK .
/
RFWCHK	LAC RFFWC		/SET FUNCTION FOR WRITE CHECK.
	DAC RFIOF
	JMP RFRTRY		/GO DO THE WRITE CHECK.
/
RFERRS	SNL!SMA!RTL
	JMP .+3
RFERR	LAC (RFDKER-1		/FATAL ERROR.
	JMP	FATAL	/PRINT AND RESTART
	SZL!RAL
	JMP RFERR		/MISSED TRANSFER.
	SZL
	JMP RFEWCK		/WRITE CHECK ERROR.
	SPA!RTL
	JMP RFEWK1		/PARITY ERROR.
	SZL
	JMP RFNRDY		/WRITE LOCKOUT.
	JMP RFERR		/ILLEGAL DISK ADDRESS.
/WRITE CHECK ERROR. TRY THE WRITE AGAIN (DO THIS
/12(8) TIMES BEFORE TELLING THE USER).
/
RFEWCK	LAC RFFWR	/REPLACE WRITE CHECK FUNCTION.
	DAC RFIOF
RFEWK1	ISZ RFPARY
	JMP RFRTRY
	LAC	DECDSK	/OUR DEVICE CODE FOR MESSAGE
	JMS	WARN	/TELL USER A BAD BLK, LET HIM CONTINUE
	LAC	RFBLOK	/'WARN' XCT'S THIS
	JMP*	RFDRIV	/TREAT AS COMPLETED OPERATIONA
/
RFNRDY	LAC (RFNTRY-1
	JMS	TYPWAT	/MESSAGE, CR, AND WAIT FOR REPSONSE
	JMP RFRTRY
/
/
PLATER	0
RFTRCK	0
RFIOF	0		/FUNCTION.
RFFR	2		/READ.
RFFWR	4		/WRITE.
RFFWC	6		/WRITE CHECK.
RFPARY	0
RFSTAT	0		/STATUS REGISTER.
RFBLOK	0		/BLOCK NUMBER.
RFWC	36
RFBUF	37
	.TITLE DISK PACK DRIVER ROUTINES.
/
/
/ DISK PACK ADDRESSING
/
/ EACH TRACK IS DIVIDED INTO TEN EQUAL SECTORS.  THESE SECTORS ARE
/ ADDRESSED BY A FOUR BIT SECTOR ADDRESS REGISTER.  THE SECTOR
/ ADDRESSES ARE CODED 00(8) THROUGH 11(8) WHICH LEAVES ILLEGAL CODES
/ OF 12(8) THROUGH 17(8) WHICH MAY APPEAR IN THE SECTOR ADDRESS RE-
/ GISTER.  ILLEGAL CODES RAISE AN ERROR FLAG.  
/
/ A SEPARATE READ/WRITE HEAD IS PROVIDED FOR EACH OF THE TWENTY INNER
/ RECORDING SURFACES.  THESE HEADS ARE MOUNTED PARALLEL AND IN VERTICAL
/ ALIGNMENT TO EACH OTHER, ATTACHED TO A COMMON HEAD TOWER. THE HEAD
/ ARE SELECTED BY A 5-BIT REGISTER CALLED HEAD ADDRESS REGISTER. HEAD
/ ADDRESSES ARE CODED 00(8) THROUGH 23(8).  ILLEGAL CODES 24(8) THROUGH 
/ 37(8), WHEN DETECTED BY THE CONTROLLER, RAISE AN ERROR FLAG WHICH 
/ RESULTS IN THE APPROPRIATE INTERRUPTS.
/
/ THE POSITION OF ALL HEADS, VERTICALLY ALIGNED, WITH RESPECT TO THE
/ VERTICAL AXIS WHICH PASSES THROUGH THE CENTER OF ALL SURFACES, IS
/ CALLED A CYLINDER.  HEAD POSITIONING IS CONTROLLED BY A LINEAR PO-
/ SITIONING MOTOR AND A DETENTING MECHANISM WHICH IS DESIGNED TO STOP
/ THE HEADS IN TWO HUNDRED AND THREE DIFFERENT SUCH CYLINDERS.  THESE
/ CYLINDERS ARE CODED 00(8) THROUGH 312(8) FROM THE OUTER-MOST CYLINDER
/ TO THE INNER-MOST CYLINDER RESPECTIVELY.  CYLINDERS ARE ADDRESSED
/ BY AN 8-BIT REGISTER CALLED CYLINDER ADDRESS REGISTER.  ILLEGAL CODES
/ 313(8) THROUGH 377(8), WHEN DETECTED BY THE CONTROLLER, RAISE AND ERROR
/ FLAG WHICH RESULTS IN THE APPROPRIATE INTERRUPTS.
/
/ THE INTERSECTION OF A CYLINDER HEAD AND SECTOR ADDRESS DEFINES A
/ UNIQUE SECTOR WHICH IS THE SMALLEST ADDRESSABLE UNIT IN THE SYSTEM
/ EACH SECTOR HAS A DATA FIELD OF 256 WORDS.
/
/
/DISK PACK STRUCTURE:
/
/	1 BLOCK= 1 SECTOR
/	10 SECTORS = 1 TRACK(ADDRESSABLE BY 1 HEAD).
/	20 TRACKS = 1 CYLINDER(200(10)) BLOCKS.
/	203(10) CYLINDERS= 1 DISK PACK.
/
/
DPSF=706301	/SKIP ON DISK FLAG
/	 1. THE JOB DONE FLAG IS SET
/	 2. THE ATTENTION FLAG IS SET
/	 3. ERROR FLAG IS SET.
DPLA=706304	/LOAD THE CYLINGER, HEAD, AND SECTOR
/	ADDRESS REGISTERS FROM THE ACCUMULATOR
/	AC BITS 0 THROUGH 7 LOAD THE CYLINDER
/	ADDRESS.  AC BITS 8 THROUGH 12 LOAD
/	THE HEAD ADDRESS.  AC BITS 13 THROUGH
/	17 LOAD THE SECTOR ADDRESS
DPCS=706324	/CLEAR STATUS, THE FOLLOWING BITS ARE CLEARED.
/	1.  FORMAT ERROR
/	2.  WORD ERROR
/	3.  LONGITUDINAL ERROR
/	4.  WRITE CHECK ERROR
/	5.  TIMING ERROR
/	6.  PROGRAMMING ERROR
/	7.  HEADER NOT FOUND
/	8.  END OF PACK
DPSJ=706341	/SKIP ON JOB DONE FLAG.
DPSE=706361	/SKIP ON ERROR FLAG
DPLF=706464	/LOAD STATUS REGISTER A.
/	AC BITS 0-8 ARE LOADED INTO STATUS
/	REGISTER A BITS 0-8.  THE NEW
/	CONTENTS ARE EXECUTED IF GO BIT IS SET
DPLO=706444	/LOAD THE ACCUMULATOR ONES ONTO STATUS
/	REGISTER A BITS 0 THROUGH 8 AND EXECUTE.  AC
/	BITS 0 THROUGH 8 ARE ONES INCLUSIVE ORED WITH
/	STATUS REGISTER A BITS 0 THROUGH 8.  THE NEW
/	CONTENTS OF THE FUNCTION IS THEN EXECUTED IF
/	THE GO BIT IS SET.
DPWC=706364	/LOAD THE WORD COUNT REGISTER FROM AC
DPCA=706344	/LOAD CHANNEL ADDRESS REGISTER FROM AC
DPRSA=706312	/READ THE STATUS REGISTER A INTO AC.
DPRSB=706332	/READ STATUS REGISTER B INTO AC.
DPCF=706404	/CLEAR FUNCTION. THE FUNCTION REGISTER IS SET T
/	IDLE MODE,UNIT ZERO IS SELECTED,ATTENTION ERROR
/	AND DONE INT ENABLES ARE CLEARED. THE WORD COUNT, 
/	CURRENT ADDRESS, BUFFER, SHIFT, LONG.,CLY,HEAD,AND
/	SECTOR ADDRESS ARE CLEARED.
/ THE BLOCK NUMBER IS DIVIDED BY 200(10) TO GET THE
/ CYLINDER ADDRESS.  THE REMAINDER IS DIVIDED BY
/ 10(10) TO GET THE HEAD (TRACK) ADDRESS.  THE RE-
/ MAINDER OF THAT REPRESENTS THE SECTOR ADDRESS.
/
/	BLOCK		CYL	HEAD		SECTOP
/	-----		---	----		------
/	  0		 0	  0		   0
/	  1		 0	  0		   1
/	 11		 0	  0		  11
/	 12		 0	  1		   0
/
DPDRIV	0
	DAC DPBLOK	/ARGUMENT BLOCK#
	XCT* DPDRIV		/GET FUNCTION.
	DAC DPIOF
	IDX DPDRIV		/BUMP TO EXIT.
MIN12	LAW -12		/PARITY AND WRITE-CHECK RETRY COUNT.
	DAC DPPARY
/
/ GET CYLINDER ADDRESS.
/
	LAC DPBLOK
	LMQ
	CLA!CLL
	DIV
	310
	DAC HEDAD
	LACQ
	ALS 12
	DAC CYLAD
/
/ THE CYLINER ADDRESS IS AT 'CYLAD'  THE REMAINDER 
/ FROM THE DIVISION BY 200(10) IS AT 'HEDAD'.
/ GET THE HEAD (TRACK) ADDRESS.
/
	LAC HEDAD
	LMQ
	CLA!CLL
	DIV
	12
	DAC SECTOR
	LACQ
	ALS 5
	DAC HEDAD
/ THE CYLINDER 'CYLAD', HEAD 'HEDAD', AND SECTOR
/ ADDRESS ARE COMBINED AS FOLLOWS:
/	BITS:  0-7 = CYLINDER ADDRESS (8 BITS)
/	BITS:  8-12 = HEAD ADDR
/	BITS:  14-17 = SECTOR ADDRESS
/	** BIT 13 IS NOT USED **
/
	AND (1740	/HEAD ADDR IN AC.
	XOR CYLAD	/CYLINDER ADDRESS.
	XOR SECTOR	/SECTOR ADDRESS.
	DAC PAKAD	/ACTUAL PACK ADDR.
/
DPRTRY	DPCS		/CLEAR STATUS.
	LAC DPUNIT	/DESELECT THE ARGUMENT UNIT NO.
	TAD (400000	/THE WRITE DISABLE CONSOLE (400000
	DPLF		/SWITCH NEEDS THIS TO EFFECT WRITE
	DPRSB		/PROTECT *DELAY*
	DPRSB		/        *DELAY*
	LAC DPUNIT	/BITS 0-2=UNIT#,3-15=IDLE FUN.
	DPLF
	LAC PAKAD
	DPLA		/LOAD CYLINDER, HEAD, AND SECTOR ADDRESSES.
	LAC BUFSZE
	DPWC		/WORD COUNT.
	LAC BUFF
	DPCA		/CHANNEL ADDR FOR SINGLE CYCLE READ.
	DPRSB		/READ STAT B SET FROM 'IDLE'
	RAR
	SZL		/BIT 17 INDICATES UNIT OFF LINE.
	JMP DPNRDY
	DPCS		/CLEAR STATUS.
	LAC DPUNIT
	XOR DPIOF
	DPLF
/
/THE DISK PACK  FLAG IS RAISED BY:
/	1 JOB DONE FLAG.
/	2 ERROR FLAG
/	3 ATTENTION FLAG.
/
DPFLAG	DPSE			/SKIP ON ERROR FLAG.
	SKP
	JMP DPERRS
	DPSJ			/SKIP ON DONE.
	JMP DPFLAG
	LAC DPIOF	/WAS THIS A WRITE?
	SAD DPFWR	/WRITE FUNCTION.
	JMP DPWCHK		/YES - DO A WRITE CHECK.
	JMP* DPDRIV		/NO - ALL DONE SO EXIT.
DPWCHK	LAC DPFWC		/SET FUNCTION FOR WRITE CHECK.
	DAC DPIOF
	JMP DPRTRY		/GO WRITE CHECK.
/
DPERRS	DPRSB		/READ B STATUS REG.
	DAC BSTAT
	DPRSA			/READ STATUS A.
	DAC DPSTAT		/A STATUS.
	AND (340	/BITS 10,11,12=ILLEGAL ADDR.
	SZA		/BIT10=ILL CYL,11=ILL HEAD
	JMP DPERR
	LAC DPSTAT	/BITS 9 AND 14.
	AND (410	/WRITE PROTECT ERROR?
	SZA
	JMP DPNRDY
	LAC DPSTAT	/WAS THE HARD HEADER FND?
	AND (24		/BIT 13 AND 15 OF REG A.
	SZA		/YES IF 0.
	JMP DPERR		/ NO - DISK FAILURE.
	LAC BSTAT	/READ STATUS REG B.
	RCR
	SZL!RAL		/NOT READY?
	JMP DPNRDY
	AND (14		/BITS 14,15m=PARITY ERROR.
	SZA		/14=WORD PARITY.
	JMP DPARIT	/15=LONGITUDINAL PARITY.
	LAC BSTAT
	AND (20
	SZA
	JMP E.CHEK	/WRITE CHECK ERROR.
DPERR	LAC (DPFERR-1		/FATAL DISK ERROR.
FATAL	JMS	TYPRET	/COMMON JOIN FOR TYPE AND BEGIN
	JMP BEGIN
/
/WRITE CHECK ERROR. TRY THE WRITE AGAIN (DO THIS
/12(8) TIMES BEFORE TELLING THE USER).
/
E.CHEK	LAC DPFWR	/REPLACE WRITE CHECK FUNCTION.
	DAC DPIOF
DPARIT	ISZ	DPPARY
	JMP	DPRTRY	/SK:066/SPR-15.874	OLD INST. "JMP RETRY"
	LAC	DSKPAK	/OUR DEVICE CODE FOR MESSAGE
	JMS	WARN	/TELL USER BAD BLK. # IN AC.
	LAC	DPBLOK	/THE BLOCK NUMBER. XCT'ED BY 'WARN'
	JMP*	DPDRIV	/TREAT AS COMPLETED OPERATION
/
DPNRDY	LAC (DPNTRY-1		/'DISK PACK NOT READY'.
	JMS	TYPWAT	/MESSAGE,CR, GET RESPONSE
	JMP DPRTRY		/RETRY FUNCTION.
/
/
DPPARY	0
HEDAD	0
DPSTAT	0		/A STATUS.
BSTAT	0		/B STATUS.
DPIOF	0		/I/O FUNCTION.
CYLAD	0
SECTOR	0
PAKAD	0
DPBLOK	0
DPFWR	21000		/WRITE
DPFWC	71000		/WRITE CHECK.
DPFR	11000		/READ.
DPUNIT	0		/UNIT NUMBER IN BITS 0-2.
	.TITLE DISK CARTRIDGE DRIVER ROUTINES.
/
/
/ DISK CARTRIDGE ADDRESSING
/
/ EACH TRACK IS DIVIDED INTO TWELVE EQUAL SECTORS.  THESE SECTORS ARE
/ ADDRESSED BY A FOUR BIT SECTOR ADDRESS REGISTER.  THE SECTOR
/ ADDRESSES ARE CODED 00(8) THROUGH 14(8) WHICH LEAVES ILLEGAL CODES
/ OF 15(8) THROUGH 17(8) WHICH MAY APPEAR IN THE SECTOR ADDRESS RE-
/ GISTER.  ILLEGAL CODES RAISE AN ERROR FLAG.  
/
/ A SEPARATE READ/WRITE HEAD PROAVES ILLEGAL CODE
/ TO THE INNER-MOST CYLINDER RESPECTIVELY.  CYLINDERS ARE ADDRESSED
/ BY AN 8-BIT REGISTER CALLED CYLINDER ADDRESS REGISTER.  ILLEGAL CODES
/ 313(8) THROUGH 377(8), WHEN DETECTED BY THE CONTROLLER, RAISE AND ERROR
/ FLAG WHICH RESULTS IN THE APPROPRIATE INTERRUPTS.
/
/ THE INTERSECTION OF A CYLINDER HEAD AND SECTOR ADDRESS DEFINES A
/ UNIQUE SECTOR WHICH IS THE SMALLEST ADDRESSABLE UNIT IN THE SYSTEM
/ EACH SECTOR HAS A DATA FIELD OF 256 WORDS.
/
/
/DISK CARTRIDGE STRUCTURE:
/
/	1 BLOCK = 1 SECTOR
/	12 SECTORS = 1 TRACK(ADDRESSABLE BY 1 HEAD).
/	01 TRACK = 1 CYLINDER.
/	203(10) CYLINDERS = 1 DISK CARTRIDGE.
/
/ ALL PARAMETERS ARE TRANSFERRED TO THE PDP-11 THROUGH THE TCB.
/
/ RK IOT'S
/
SIOA=706001		/SKIP ON I/O DATA ACCEPTED
CIOD=706002		/CLEAR I/O DATA FLAG
LIOR=706006		/LOAD I/O DATA REGISTER AND CLEAR DONE FLAG
FRD=4			/READ BITS
FWR=2			/WRITE BITS
FWC=6			/WRITE CHECK BITS
/
	.EJECT
/
RKDRIV	0
	DAC* RKBLOK		/(RCHM-172) ARGUMENT BLOCK#
	XCT* RKDRIV	/GET FUNCTION
	IDX RKDRIV
	DAC RKIOF
	LAW -12
	DAC RKPARY
/
RKRTRY	LAC	RKUNIT	/BUILD TCB FOR CALLING THE PDP-11
	RTL; RTL; CLL
	AND (3
	ALS+10
	XOR	RKIOF
	DAC*	RKUNFN		/(RCHM-172) UNIT NUMBER AND FUNCTION
	LAC	BUFSZE	/WORD COUNT
	DAC*	RKWC		/(RCHM-172) SAVE WORD COUNT IN TCB.
	LAC	BUFF	/STARTING MEMORY ADDRESS
	DAC*	STADD+1		/(RCHM-172) (L.S. 16 BITS)
	DZM*	STADD		/(RCHM-172) (M.S. 2 BITS)
/
/
	DZM* DEV		/(RCHM-172) CLEAR EVENT VARIABLE.
	LAC (TCB		/ASK 11 FOR TRANSFER NOW
	SIOA			/MAKE SURE THE 11 IS READY
	JMP .-1
	LIOR
	LAC* DEV		/(RCHM-172) WAIT FOR IT TO FINISH
	SNA
	JMP .-2
	JMP EVFND
/
/ TCB - TASK CONTROL BLOCK
/    THIS IS THE PDP-15/11 TCB.
/
DEV	TCB+2			/(RCHM-172) DEVICE EVENT VARIABLE
RKBLOK	TCB+3			/(RCHM-172) PHYSICAL BLOCK #
STADD	TCB+4			/(RCHM-172) STARTING MEMORY ADDRESS (M.S. 2 BITS)
	TCB+5			/(RCHM-172)                         (L.S. 16 BITS)
RKWC	TCB+6			/(RCHM-172) NUMBER OF WORDS
RKUNFN	TCB+7			/(RCHM-172) UNIT NUMBER * 400 + FUNCTION
STATUS	TCB+10			/(RCHM-172) RK CONTROL STATUS REGISTER (RKCS)
STATB	TCB+11			/(RCHM-172) RK ERROR REGISTER (RKER)
RKDS	TCB+12			/(RCHM-172) RK DRIVE STATUS REGISTER (RKDS)
/
RKIOF	0
RKPARY	0
RKUNIT	0
	.TITLE RK15 DISK CARTRIDGE INTERRUPT SERVICE
/
/THE DISK CARTRIDGE FLAG IS RAISED BY THE PDP-11 DONE SIGNAL.
/
EVFND	LAC*	STATUS		/(RCHM-172) PICK UP THE STATUS
	RTL		/BIT 2 = ERROR FLAG.
	SPA		/IF POSITIVE NO ERROR ASSUME JOB DONE.
	JMP ERRORS	/ERR. FLAG
	LAC RKIOF		/WAS THIS A WRITE?
	SAD (FWR		/WRITE FUNCTION.
	JMP CHK.WR		/YES. DO WRITE-CHECK
	JMP* RKDRIV
CHK.WR	LAC (FWC		/SET FUNCT. FOR WRITE-CHECK
	DAC RKIOF
	JMP RKRTRY
	.TITLE RK15---DISK ERROR PROCESSOR.
/
/
ERRORS	LAC*	STATB		/(RCHM-172)
	AND (340	/BITS 10,11,12=ILLEGAL ADDR.
	SZA		/BIT11=ILL CYL,10=ILL DISK
	JMP DPERR	/BIT 12 = ILL SECTOR
	LAC* STATB		/(RCHM-172) BIT 14.
	AND (20000	/WRITE PROTECT ERROR?
	SZA
	JMP RKNRDY
	LAC* STATB		/(RCHM-172) CAN WE POSSIBLY GO ON?
	AND (11400	/BITS 5, 8 AND 9 OF RKER.
	SZA
	JMP DPERR	/YES: DISK FAILURE.
	LAC* RKDS		/(RCHM-172)
	AND	(12000
	SZA		/DRIVE UNSAFE?
	JMP DPERR
	LAC* STATB		/(RCHM-172)
	RTR		/WRT CHK BIT TO AC0;READ CHKSM BIT TO LINK
	SNL!SMA		/SKIP IF EITHER BIT FOR RETRY
	JMP	DPERR	/NOT RETRIABLE, GO PRINT A MESSAGE
	.EJECT
/
/WRITE CHECK ERROR OR READ ERROR. RETRY 12(8) TIMES.
/
	LAC (FWR	/REPLACE WRITE CHECK FUNCTION.
	SNL		/NOT FOR A READ ERROR YOU DON'T!!
	DAC RKIOF
	ISZ RKPARY	/IF OVERFLOW, TAKE DATA ANYWAY
	JMP RKRTRY
	LAC	DECPAK	/OUR DEVICE CODE FOR MESSAGE
	JMS	WARN	/TELL USER BAD BLK. # IN AC.
	LAC*	RKBLOK		/(RCHM-172) OUR BLOCK NUMBER FOR AC. XCT'ED BY WARN.
	JMP* RKDRIV		/CONTINUE
/
RKNRDY	LAC (DPNTRY-1	/DISK NOT READY
	JMS	TYPWAT	/MESSAGE,CR,GET RESPONSE
	JMP RKRTRY	/RETRY FUNCTION
/
	.TITLE TTY DRIVER ROUTINES.
/
TCF=700402
TSF=700401
TLS=700406
KSF=700301
KRB=700312
/
/
/
/READTT -- SUBROUTINE TO READ MESSAGES FROM THE CONSOLE TTY.
/  	AC= NEGATIVE NUMBER OF CHARACTERS TO READ ON ENTRY (NO MORE THAN 3).
/       AC= THE RESULTING CHARACTERS (6-BIT, LEFT JUSTIFIED) ON EXIT.
/
READTT	0
	DAC CNTSAV
	DAC CHCNTS		/# CHARS TO READ (3 OR LESS).
	DZM TMPCHR		/CHARS PACKED IN THIS WORD.
READNX	JMS GTCHAR
	DAC CHRSAV
	JMS MRGCHR
	ISZ CHCNTS
	JMP READNX
READSA	JMS GTCHAR
	SAD (15
	SKP
	JMP READSA
	JMS TYPELF
	LAC TMPCHR
	JMP* READTT
/
TMPCHR	0
CHCNTS	0
CHRCNT	0
CNTSAV	0
/
GTCHAR	0
	KSF
	JMP .-1
	KRB
	AND (177
	SAD LCTLU
	JMP DELINE
	SAD LRUBOT
	JMP DECHAR
	JMP* GTCHAR
/
DELINE	LAC (ICTLU-1
	JMS TYPE
	LAC CNTSAV
	JMP READTT+2
/
DECHAR	LAC (IRUBOT-1
	JMS TYPE
	LAW -100
	AND TMPCHR
	CLL!RTR; RTR; RTR
	DAC TMPCHR
	LAC CHCNTS
	TAD LM1			/(RCHM-169)
	DAC CHCNTS
	JMP READNX
/
LCTLU	25
LRUBOT	177
CHRSAV	0
/
MRGCHR	0
	LAC TMPCHR
	CLL!RTL; RTL; RTL
	DAC TMPCHR
	LAC CHRSAV
	AND (77
	XOR TMPCHR
	DAC TMPCHR
	JMP* MRGCHR
/
	.EJECT
/
/ TYPE -- SUBROUTINE TO TYPE MESSAGES ON THE CONSOLE 
/	TELETYPE INTERRUPTS ARE OFF AND ALL WAITS FOR MESSAGES
/	TO BE COMPLETED.
/
/	THREE CHARACTERS ARE STORED PER WORD.
/	AC = ADDRESS-1 OF MESSAGE TO BE TYPED.
/
/
TYPE	0
	DAC*	(15	/USE AUTO-INCR TO GET BUFFER
TYPLP1	LAW	-3	/THREE CHAR'S PER WORD
	DAC	TCOUNT
	LAC*	15	/GET A WORD
	LMQ			/(RCHM-169) SAVE 3 CHARACTERS IN MQ FOR SHIFTING.
TYPLP2	CLAC!LLS 6		/(RCHM-169) FETCH CHARACTER FROM MQ.
	SNA		/QUIT ON A NULL CHAR
	JMP*	TYPE
	XOR (40)		/(RCHM-169) CONVERT TO 7 BIT ASCII.
	TAD (40)		/(RCHM-169)
	TLS		/TYPE IT OUT
	TSF
	JMP	.-1
	ISZ	TCOUNT	/THRID ONE YET
	JMP	TYPLP2	/NO
	JMP	TYPLP1	/YES
TTYTMP	0
/
/	TYPRET ROUTIN RECEIVES IN AC ADDR -1 OF STRING
/
/  ROUTINE MERELY CALLS TYPE TO TYPE OUT STRING, AND THEN
/  ALSO CALLS CARRIAGE RETURN ROUTINE
/
TYPRET	0
	JMS	TYPE
	JMS	TYPECR
	JMP*	TYPRET
/
/	TYPG1 ROUTINE RECEIVES IN AC ADDR-1 OF STRING
/
/  ROUTINE CALLS TYPE TO TYPE IT OUT, AND THEN CALLS
/  READTT TO RECEIVE ONE CHARACTER FROM USER, WHICH
/  IS RETURNED RIGHT JUSTIFIED IN AC
/
TYPG1	0
	JMS	TYPE
	LAW	-1
	JMS	READTT
	JMP*	TYPG1
/
/	TYPWAT ROUTINE IS JUST LIKE TYPG1, XCPT IT ALSO
/  DOES A CR AFTER MESSAGE
/
TYPWAT	0
	JMS	TYPRET
LM1	LAW	-1
	JMS	READTT
	JMP*	TYPWAT
/
TYPECR	0
	LAC (15
	TLS
	TSF
	JMP .-1
	JMS TYPELF
	JMP* TYPECR
/
TYPELF	0
	LAC (12
	TLS
	TSF
	JMP .-1
	JMP* TYPELF
/
/	ROUTINE WARN
/
/  TYPES A MESSAGE FOR A DISK ERROR. BAD BLK # IS IN AC.
/  MACHINE HALTS. USER HITS CONTINE TO KEEP GOING.
/
/  CALLING SEQUENCE:
/
//	LAC	DEVCOD	/DEVICE CODE, 2 SIXBIT CHAR'S, RIGHT
//			/JUSTIFIED, NULL IN TOP CHAR
//	JMS	WARN	/CALL 
//	LAC	XXBLOK	/LOAD BLOCK NUMBER TO AC. (XCT'ED HERE)
//	...		/RETURN, IF USER HITS CONTINUE
/
/
WARN	0
	TAD	(400000	/MAKE LEADING NULL TO SPACE
	DAC	RKCHSE	/PLACE DEVICE CODE IN MESSAGE
	LAC	(RKCHSE-1 /TYPE MESSAGE
	JMS	TYPRET
	XCT*	WARN	/GET BLOCK NUMBER FOR AC
	ISZ	WARN	/BUMP TO EXIT
	HLT		/HALT
	JMP*	WARN	/CONTINUE, IF HE HITS CONTINUE
/
/
/TTY MESSAGES.
/
	.SYSID <TITLE	.SIXBT 'DOSSAV >,<000@'> /(RCHM-174)
QMES	.SIXBT 'SAVE QAREA (Y OR N)? @'
DEVIN	.SIXBT 'INPUT DEVICE? '
DEVOUT	.SIXBT 'OUTPUT DEVICE? '
	0
UNITNO	.SIXBT 'UNIT #? '
BADUNT	.SIXBT 'ILLEGAL UNIT #'
CHANEL	.SIXBT 'TRACK(7 OR 9)? '
	0
MDEN	.SIXBT 'DENSITY (2,5,8)? '
FATALA	.SIXBT 'DECTAPE ERROR'
BDTRCK	.SIXBT 'BAD TRACK'
	0
BADDEN	.SIXBT 'BAD DENSITY'
BADPAR	.SIXBT 'BAD PARITY'
DVERR	.SIXBT 'ATTEMPT TO RESTORE SYSTEM TO WRONG DISK'
	0
SATER	.SIXBT 'BLK 1775 OCCUPIED. NO 2ND SAT CREATED'
BADDEV	.SIXBT 'ILLEGAL DEVICE'
NOTAPE	.SIXBT 'TAPE NOT READY'
MTERRO	.SIXBT 'MAGTAPE ERROR'
NEWTAP	.SIXBT 'TAPE DONE. MOUNT ANOTHER'
	0
RFDKER	.SIXBT 'DISK ERROR'
	0
RFNTRY	.SIXBT 'DISK NOT READY'
DPFERR	.SIXBT 'DISK PACK ERROR'
	0
DPNTRY	.SIXBT 'DISK PACK NOT READY'
RKCHSE	0		/CORRECT DEV CODE PLACED BY 'WARN'
	.SIXBT	' ERR IGN'
ICTLU	.SIXBT	'*'
IRUBOT	.SIXBT	'\'
DATECR	.SIXBT 'DATE CREATED:  '
DATETT	0
	0
	0
	0
	.END BEGIN
