Google
 

Trailing-Edge - PDP-10 Archives - BB-H138C-BM - 5-sources/format.mac
There are 10 other files named format.mac in the archive. Click here to see a list.
;<5.UTILITIES>FORMAT.MAC.4, 28-Oct-81 15:08:38, EDIT BY GRANT
;Change major version to 5
; UPD ID= 25, SNARK:<5.UTILITIES>FORMAT.MAC.2,  28-Aug-81 13:20:16 by GRANT
;SPR #:20-15823 - NSKDIS BUGHLT while running FORMAT



TITLE	TOPS-20 ON-LINE FORMAT PROGRAM FOR RP04/5'/6'S
SUBTTL	TITLE FILE AND TTY I/O UTILITIES

	MCNVER==5
	DECVER==0
	LIST
	LALL






; COPYRIGHT (C) 1976,1977,1978 BY
; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.


; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
; ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
; COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
; TRANSFERRED.

; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
; AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.

; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


; AUTHOR:	FRANK GATULIS 
; MAINTAINER:	SYSTEMS DIAGNOSTIC ENGINEERING

	PAGE
	LOC	137
	MCNVER_6,,DECVER
	RELOC	0000	
	SEARCH MONSYM


;AC DEFINITIONS

P=17
MBCN=16
DRIVE=15
ERFLG=14
X=13

;ASSEMBLY SWITCHES

RH20==1
RH10==0

PAGE
;OPDEFS

OPDEF	FATAL [JRST	[HALTF
			JRST START]]
OPDEF	GO [PUSHJ P,]
OPDEF	RTN [POPJ P,]
OPDEF	PUT [PUSH P,]
OPDEF	GET [POP P,]
OPDEF	PFORCE [JFCL]
OPDEF	PJRST	[JRST]		;A JRST TO A ROUTINE THAT
				; RETURNS WITH A POPJ


	PAGE

;MACRO DEFINITIONS

DEFINE	S <;*************************************************************>

DEFINE	BOX (TEXTA,TEXTB)<
	LALL
	LIST
	PAGE
S
;* TEXTA
S
COMMENT $
	TEXTB
	$
	XLIST
	XALL
	LIST
	>

	PAGE

;SOME VARIABLES

TXTINH==0		;DUMMY TEXT INHIBIT SWITCH
B:	Z		;FIRST LOC IN PROGRAM
USER:	-1		;THIS IS USER MODE ONLY
CONSW:	0		;THE CONSOLE SWITCHES GO HERE

UUOEXT:	RTN		;UUO EXIT
$SVUUO:	Z		;CURRENT USERS UUO
$SVUPC:	Z		;CURRENT USER PC

$TWCNT:	1		;TTY INPUT CAN'T TIME OUT NOW

;A PRINTABLE CAR RTN LINE FEED STRING

CRLF:	ASCIZ/
/




	PAGE

;OPDEFS FOR THE PROGRAM UUO'S

OPDEF	PNT1	[1B8]	;PRINT 1 OCTAL DIGIT FROM AC0
OPDEF	PNT1F	[1B8]
OPDEF	PNT2	[2B8]	;PRINT 2 OCTAL DIGITS FROM AC0
OPDEF	PNT2F	[2B8]
OPDEF	PNT3	[3B8]	;PRINT 3 OCTAL DIGITS FROM AC0
OPDEF	PNT3F	[3B8]
OPDEF	PNT4	[4B8]	;PRINT 4 OCTAL DIGITS FROM AC0
OPDEF	PNT4F	[4B8]
OPDEF	PNT5	[5B8]	;PRINT 5 OCTAL DIGITS FROM AC0
OPDEF	PNT5F	[5B8]
OPDEF	PNT6	[6B8]	;PRINT 6 OCTAL DIGITS FROM AC0
OPDEF	PNT6F	[6B8]
OPDEF	PNTADR	[7B8]	;PRINT 22 BIT ADDRESS FROM AC0
OPDEF	PNTAL	[10B8]	;PRINT ASCIZ MSG WHOSE ADR IS IN AC0
OPDEF	PNTALF	[10B8]
OPDEF	PCRL	[11B8]	;PRINT A CR LF SEQUENCE
OPDEF	PCRLF	[11B8]
OPDEF	PNTBCD	[12B8]	;PRINT AC0 AS A 9 BIT BCD NUMBER
OPDEF	PNTCHR	[13B8]	;PRINT AC0 AS AN ASCII CHARACTER
OPDEF	PNTSIX	[14B8]	;PRINT AC0 IN SIXBIT
OPDEF	TEXT	[15B8]	;PRINT ASCIZ DATA E-FIELD IS ADDR
OPDEF	TEXTF	[15B8]
OPDEF	PNTHW	[16B8]	;PRINT AC0 AS 2 HALF WORDS (XXXXXX XXXXXX)
OPDEF	PNTHWF	[16B8]
OPDEF	PNTDEC	[17B8]	;PRINT AC0 AS A DECIMAL #
OPDEF	TTIOCT	[20B8]	;INPUT IN OCTAL FROM TTY
OPDEF	TTIDEC	[21B8]	;INPUT IN DECIMAL FROM TTY
OPDEF	TTICNV	[22B8]	;INPUT EITHER OCTAL OR DECIMAL FROM TTY
OPDEF	TTICHR	[23B8]	;INPUT ANY CHARACTER FROM TTY
OPDEF	CLRBFI	[24B8]	;CLEAR TTY INPUT BUFFER
OPDEF	TTSIXB	[25B8]	;INPUT IN SIXBIT FROM THE TTY
OPDEF	TTIYES	[26B8]	;GET YES/NO RESPONSE FROM THE TTY



	PAGE


;DEFINE UUO SERVICE ROUTINES

LUU00==UUOERR
LUU01==UUO01
LUU02==UUO02
LUU03==UUO03
LUU04==UUO04
LUU05==UUO05
LUU06==UUO06
LUU07==UUO07
LUU10==UUO10
LUU11==UUO11
LUU12==UUO12
LUU13==UUO13
LUU14==UUO14
LUU15==UUO15
LUU16==UUO16
LUU17==UUO17
LUU20==UUO20
LUU21==UUO21
LUU22==UUO22
LUU23==UUO23
LUU24==UUO24
LUU25==UUO25
LUU26==UUO26



	PAGE

;DEFAULT SERVICE FOR UNDEFINED UUO'S

IFNDEF	LUU00,<LUU00==UUOERR>
IFNDEF	LUU01,<LUU01==UUOERR>
IFNDEF	LUU02,<LUU02==UUOERR>
IFNDEF	LUU03,<LUU03==UUOERR>
IFNDEF	LUU04,<LUU04==UUOERR>
IFNDEF	LUU05,<LUU05==UUOERR>
IFNDEF	LUU06,<LUU06==UUOERR>
IFNDEF	LUU07,<LUU07==UUOERR>
IFNDEF	LUU10,<LUU10==UUOERR>
IFNDEF	LUU11,<LUU11==UUOERR>
IFNDEF	LUU12,<LUU12==UUOERR>
IFNDEF	LUU13,<LUU13==UUOERR>
IFNDEF	LUU14,<LUU14==UUOERR>
IFNDEF	LUU15,<LUU15==UUOERR>
IFNDEF	LUU16,<LUU16==UUOERR>
IFNDEF	LUU17,<LUU17==UUOERR>
IFNDEF	LUU20,<LUU20==UUOERR>
IFNDEF	LUU21,<LUU21==UUOERR>
IFNDEF	LUU22,<LUU22==UUOERR>
IFNDEF	LUU23,<LUU23==UUOERR>
IFNDEF	LUU24,<LUU24==UUOERR>
IFNDEF	LUU25,<LUU25==UUOERR>
IFNDEF	LUU26,<LUU26==UUOERR>
IFNDEF	LUU27,<LUU27==UUOERR>
IFNDEF	LUU30,<LUU30==UUOERR>
IFNDEF	LUU31,<LUU31==UUOERR>
IFNDEF	LUU32,<LUU32==UUOERR>
IFNDEF	LUU33,<LUU33==UUOERR>
IFNDEF	LUU34,<LUU34==UUOERR>
IFNDEF	LUU35,<LUU35==UUOERR>
IFNDEF	LUU36,<LUU36==UUOERR>
IFNDEF	LUU37,<LUU37==UUOERR>

	PAGE

;UUO DISPATCH TABLE

UUODIS:	LUU00,,LUU01
	LUU02,,LUU03
	LUU04,,LUU05
	LUU06,,LUU07
	LUU10,,LUU11
	LUU12,,LUU13
	LUU14,,LUU15
	LUU16,,LUU17
	LUU20,,LUU21
	LUU22,,LUU23
	LUU24,,LUU25
	LUU26,,LUU27
	LUU30,,LUU31
	LUU32,,LUU33
	LUU34,,LUU35
	LUU36,,LUU37


;CODE TO SET UP LOCATIONS 40 & 41 TO HANDLE USER UUO'S

UUOTAG:	.			;MARK CURRENT LOCATION
	LOC	40		;NOW TO 40 (ABSOLUTE)
	Z			;40 SET TO ZERO
	GO	UUODSP		;TO THE DISPATCHER
	RELOC	UUOTAG		;NOW CORRECTLY RELOCATE


	XLIST
	BOX <PROGRAM UUO DISPATCH ROUTINE>,<
	HANDLES UUO'S 00-37
	AC'S 0-4 ARE SAVED AND RESTORED
	THE UUO DISPATCH TABLE IS AT "UUODIS"
	DURING UUO EXECUTION, THE FOLLOWING LOCATIONS ARE VALID
		(DOLLARS)SVUUO - HOLDS UUO THAT HAS BEEN EXECUTED
		(DOLLARS)SVUPC - HOLS USERS RETURN PC IN MAINLINE >

UUODSP:	PUT	40		;SAVE LOC 40
	PUT	1		;SAVE AC'S
	PUT	2
	PUT	3
	PUT	4
	PUT	$SVUUO		;SAVE USERS UUO
	PUT	$SVUPC		;AND USERS PC
	MOVE	1,-6(P)		;GET UUO
	MOVEM	1,$SVUUO	;SAVE THE RESULTS
	MOVE	1,-7(P)		;GET THE RETURN
	MOVEM	1,$SVUPC	;THE USERS PC

;PROGRAM DISPATCH CODE

	LDB	1,[POINT 9,$SVUUO,8] ;GET OP CODE OF UUO
	IDIVI	1,2		;CALCULATE TABLE OFFSET
	HRRZ	3,UUODIS(1)	;ASSUME WE WANT RIGHT
	SKIPN	2		;DID WE REALLY WANT LEFT ?
	HLRZ	3,UUODIS(1)	;YES. THEN FETCH LEFT
	GO	(3)		;DISPAT CH TO UUO SERVICE ROUTINE

;RESTORE AND EXIT CODE

	MOVE	1,$SVUPC	;GET CURRENT PC
	MOVEM	1,-7(P)		;PUT ON STACK
	MOVE	1,$SVUUO	;GET CURRENT UUO
	MOVEM	1,-6(P)		;PUT ON STACK
	GET	$SVUPC		;RESTORE THE PC
	GET	$SVUUO		;GET USER UUO
	GET	4		;GET ACS
	GET	3
	GET	2
	GET	1
	GET	40		;RESTORE OLD UUO
	RTN			;AND EXIT THE UUO


	PAGE

;UUO SERVICE ROUTINES

;ROUTINE TO SIMULATE PNT1 & PNT1F

UUO01:	PUT	0		;SAVE 0
	MOVSI	3,1		;SET UP THE FORMAT
	ANDI	0,7		;SAVE ONLY 1 DIGIT
	JRST	PCOM		;TO COMMON CODE

;ROUTINE TO SIMULATE PNT2 & PNT2F

UUO02:	PUT	0		;SAVE 0
	MOVSI	3,2		;SET UP THE FORMAT
	ANDI	0,77		;SAVE ONLY 2 DIGITS
	JRST	PCOM		;TO COMMON CODE

;ROUTINE TO SIMULATE PNT3 & PNT3F

UUO03:	PUT	0		;SAVE THE AC
	MOVSI	3,3		;SET UP THE FORMAT
	ANDI	0,777		;SAVE ONLY 3 DIGITS
	JRST	PCOM		;TO COMMON CODE

;ROUTINE TO SIMULATE PNT4 & PNT4F

UUO04:	PUT	0		;SAVE 0
	MOVSI	3,4		;SET UP FORMAT
	ANDI	0,7777		;SAVE ONLY 4 DIGITS
	JRST	PCOM		;TO COMMON CODE

;ROUTINE TO SIMULATE PNT5 & PNT5F

UUO05:	PUT	0		;SAVE 0
	MOVSI	3,5		;SET UP THE FORMAT
	ANDI	0,77777		;SAVE ONLY 5 DIGITS
	JRST	PCOM		;TO COMMON CODE

;ROUTINE TO SIMULATE PNT6 & PNT6F

UUO06:	PUT	0		;SAVE 0
	MOVSI	3,6		;SET UP THE FORMAT
	ANDI	0,777777	;SAVE ONLY 6 DIGITS
	JRST	PCOM		;TO COMMON CODE

	PAGE
;ROUTINE TO SIMULATE PNTADR

UUO07:	PUT	0		;SAVE THE AC
	MOVSI	3,^D8		;SET UP THE FORMAT
	AND	0,[17,,777777]	;SAVE ONLY 22 BITS
	JRST	PCOM		;TO COMMON CODE

;ROUTINE TO SIMULATE PNTHW & PNTHWF

UUO16:	MOVSS	0,0		;SWAP
	PNT6			;PRINT LEFT HALF
	MOVSS	0,0		;SWAP
	PNT6			;PRINT RIGHT HALF
	RTN

;ROUTINE TO SIMULATE PNTDEC

UUO17:	PUT	0		;SAVE AC0
	MOVEI	3,^D10		;SET UP THE RADIX
	JRST	PCOM+1		;TO COMMON CODE

;HERE IS THE COMMON NUMBER OUT CODE

PCOM:	IOR	3,[NO%MAG!NO%LFL!NO%ZRO!^D8] ;SELECT FORMAT OPTIONS
	MOVEI	1,.PRIOU	;OUTPUT DESIGNATOR
	MOVE	2,0		;GET NUMBER TO AC2
	NOUT			;NUMBER OUT JSYS
	 ERCAL	JSYSE3		;ERROR HANDLER

;ROUTINE TO FOLLOW OCTAL NUMBERS WITH A SPACE

	XORI	3,^D10		;CHECK THE RADIX
	TRNN	3,777777	;BASE 10 ?
	JRST	PCOMX		;YES
	HRROI	1,[ASCIZ/ /]
	PSOUT			;WRITE STRING JSYS
	 ERCAL	JSYSE3		;ERROR HANDLER
PCOMX:	GET	0		;RESTORE THE AC
	RTN			;RETURN FROM THE UUO

	PAGE
;ROUTINE TO SIMULATE PNTAL & PNTALF

UUO10:	HRRO	1,0		;GETS AC1 SET UP
	PSOUT			;OUTPUT THE STRING
	 ERCAL	JSYSE1		;CALL ERROR HANDLER
	RTN			;EXIT FORM THE UUO

;ROUTINE TO SIMULATE PCRLF

UUO11:	HRROI	1,[ASCIZ/
/]
	PSOUT			;OUTPUT THE STRING
	 ERCAL	JSYSE1		;JSYS ERROR
	RTN			;EXIT

;ROUTINE TO SIMULATE PNTCHR

UUO13:	PUT	0		;SAVE AC0
	ROT	0,-7		;ROT CHAR TO THE LEFT HALF
	HRROI	1,0		;AC0 HOLDS THE CHAR
	PSOUT			;OUTPUT A STRING
	 ERCAL	JSYSE1		;JSYS ERROR
	GET	0		;RESTORE THE AC
	RTN			;EXIT FROM THE UUO

;ROUTINE TO SIMULATE PNTSIX

.ASCIZ:	BLOCK	2		;CONVERSION  BUFFER

UUO14:	PUT	.ASCIZ		;SAVE ANYTHIN THATS IN PROGRESS
	PUT	.ASCIZ+1

	MOVE	2,[POINT 6,0]	;POINT TO SIXBIT DATA
	MOVE	3,[POINT 7,.ASCIZ] ;POINT TO ASCIZ BUFFER
	MOVEI	4,6		;A CHARACTER COUNTER
	ILDB	1,2		;GET A SIXBIT CHAR
	ADDI	1,40		;CONVERT TO ASCII
	IDPB	1,3		;PUT IN ASCII BUFFER
	SOJG	4,.-3		;LOOP TILL DONE
	SETZM	1		;A NULL CHAR
	IDPB	1,3		;STORE A NULL
	HRROI	1,.ASCIZ	;ADR OF STRING
	PSOUT			;OUTPUT THE STRING
	 ERCAL	JSYSE1		;THE JSYS ERROR HANDLER
	GET	.ASCIZ+1	;RESTORE OLD BUFFER
	GET	.ASCIZ
	RTN			;AND EXIT

	PAGE

;PRINT A 36 BIT QUANTITY AS 9 BCD DIGITS "PNTBCD"

UUO12:	SETZM	4		;A LEADING ZERO FLAG
	MOVEI	3,^D9		;# OF CHARACTERS
	MOVE	2,[POINT 4,0]	;INITIAL BYTE POINTER
BCD1:	ILDB	1,2		;GET A BCD BYTE
	JUMPN	1,BCD2		;NO ZERO. GO PRINT
	JUMPE	4,BCD4		;JUMP IF SKIPPING LEADING ZEROS
BCD2:	SETOM	4		;FLAG FACT THAT WE'RE INTO NUMBER
BCD3:	ADDI	1,60		;CONVERT TO ASCII
	PUT	0		;SAVE 0
	MOVE	0,1		;GET THE CHAR
	PNTCHR			;PRINT IT
	GET	0		;SAVE THE AC
BCD4:	SOJG	3,BCD1		;LOOP UNTIL DONE
	SKIPN	4		;HAVE WE PRINTED ?
	TEXT	[ASCIZ/0/]	;NO. THEN PRINT A ZERO
	TEXT	[ASCIZ/. /]	;A PERIOD THEN A SPACE
	RTN			;AND EXIT

;ROUTINE TO PRINT ASCIZ TEXT

UUO15:	PUT	0		;SAVE THE AC
	CLRBFI			;CLEAR INPUT BUFFER
	HRRZ	0,$SVUUO	;GET MESSAGE ADDRESS
	PNTALF			;PRINT THE LINE
	GET	0		;RESTORE THE AC
	RTN			;AND EXIT

	PAGE

;THE JSYS ERROR HANDLER.....
;REPORT THE ERROR AND THEN RETURN

JSYSE3:	EXCH	1,3		;GET ERROR CODE TO AC1
	SETOM	E3FLG#		;FLAG FACT THAT EXCH TOOK PLACE
JSYSE1:	SETZM	E3FLG		;FLAG NO EXCHANGE OF AC'S 1 & 3
	PUT	1		;SAVE AC'S
	PUT	2
	PUT	3
	MOVEI	1,.PRIOU	;PRIMARY OUTPUT DEVICE
	MOVE	2,[.FHSLF,,-1]	;HANDLE
	SETZM	3		;CLEAR AC3
	ERSTR			;REPORT ERROR STRING
	HALTF			;UNDEFINED ERROR CODE
	HALTF			;STRING PROBLEM
	GET	3		;RESTORE
	GET	2
	GET	1
	SKIPE	E3FLG		;HAD WE EXCHANGED 1 & 3 ??
	EXCH	1,3		;YES. THEN CORRECT THEM
	PCRLF			;ADVANCE TO NEXT LINE
	RTN			;EXIT FROM THE UUO

;ROUTINE TO REPORT ILLEGAL USER UUO

UUOERR:	HRROI	1,[ASCIZ/

ILLEGAL USER UUO EXECUTED .. CANNOT CONTINUE ..

/]
	PSOUT			;OUTPUT THE STRING
	 ERCAL	JSYSE1		;ERROR REPORT FOR JSYS ERROR

	RESET			;A RESET JSYS
	 ERCAL	JSYSE1		;ERRROR REPORT FOR THE JSYS

	FATAL			;FATAL OUT


	PAGE
;ROUTINE TO SIMULATE TTIOCT & TTIDEC & TTICNV
;NUMBERS MAY BE STRUNG TOGETHER, SEPARATED BY COMMAS.
;THE STRING OF NUMBERS MUST BE TERMINATED BY A CR LF SEQUENCE.
;LEADING BLANKS ARE IGNORED.
;DECIMAL  NUMBERS INPUT VIA TTICNV MUST BE TERMINATED WITH A
;DECIMAL POINT. THE POINT IS NOT NECESSARY FOR TTIDEC.
;THE TERMINATOR CHARACTER FOR A NUMBER CAN BE FOUND BY LOOKING
;IN A LOCATION CALLED "(DOLLARS)CHRIN"

UUO20:	MOVEI	1,^D8		;FOR TTIOCT
	SKIPA			;SKIP ENTRY FOR TTIDEC
UUO21:	MOVEI	1,^D10		;FOR TTIDEC
	MOVEM	1,RADIX#	;SAVE RADIX
	SETZM	CNVF#		;CLEAR CONVERTABLE MODE FLAG
	JRST	ENTCOM		;TO COMMON ENTRY CODE
UUO22:	SETOM	CNVF		;FLAG FACT THAT WE'RE IN CONV MODE
	MOVEI	1,^D8		;START BY ASSUMING BASE 8
	MOVEM	1,RADIX		;NOW READY FOR BASE- 8
ENTCOM:	AOS	$SVUPC		;BUMP RETURN
	AOS	$SVUPC		;NOW SET FOR NORMAL RETURN
	MOVE	1,SPTR		;INPUT STRING POINTER
	ILDB	1,1		;GET FIRST BYTE
	SKIPE	1		;IS IT ZERO ?
	JRST	CNUM		;NO. DATA ALREADY IN BUFFER
	SETZM	3		;YES. MUST INPUT A STRING
	HRROI	1,STRING	;POINTER TO STRING BUFFER
	MOVE	2,[RD%BEL!RD%RAI%RD%SUI!^D80]
	RDTTY			;READ STRING JSYS
	 ERCAL	JSYSE1		;ERROR CALL
	MOVEM	1,SIPTR		;SAVE UPDATED STRING POINTER
	MOVE	1,SPTR		;INITIAL STRING POINTER
	MOVEM	1,SOPTR		;SAVE FOR FETCHING NUMBERS


CNUM:	SKIPN	CNVF		;IN CONVERTABLE MODE ?
	JRST	CNUM1		;NO. THEN NO NEED TO FIGURE RADIX

	MOVE	1,SOPTR		;YES. GET POINTER FOR SCAN
	ILDB	0,1		;GET A CHARACTER
	CAIN	0,40		;CHECK FOR LEADING BLANKS
	JRST	.-2		;SKIPS LEADING BLANKS
	SKIPA			;FOUND FIRST NON-BLANK CHAR
NCHR:	ILDB	0,1		;GET A CHARACTER
	CAIL	0,60		;MUST BE BETWEEN 0 AND 9
	CAILE	0,71
	SKIPA			;ITS OUT OF RANGE
	JRST	NCHR		;IN RANGE. KEEP SCANNING
	CAIE	0,"."		;TERMINATOR A DECIMAL POINT ?
	JRST	CNUM1		;NO. THEN WE USE BASE 8
	MOVEI	1,^D10		;YES. SET UP FOR BASE 10
	MOVEM	1,RADIX		;NOW READY
	JRST	CNUM1		;CONTINUE AS USUAL

CNUM1:	MOVE	1,SOPTR		;GET CURRENT OUTPUT POINTER
	MOVE	3,RADIX		;AND PROPER RADIX
	NIN			;NUMBER IN JSYS
	 ERCAL	JSYSE1		;JSYS ERROR
	LDB	0,1		;GET NEXT CHARACTER
	CAIE	3,^D10		;RADIX = 10 ?
	JRST	SVCH		;NO. SKIP DECIMAL POINT TEST
	CAIN	0,"."		;IS IT A DECIMAL POINT ?
	ILDB	0,1		;YES. SKIP OVER AND FETCH NEXT
SVCH:	MOVEM	0,$CHRIN	;SAVE AS TERMINATING CHARACTER

;ANYTHING BUT CR,LF,COMMA CAUSES ERROR RETURN

	CAIN	0,54		;COMMA
	JRST	TE+1		;YES
	CAIN	0,12		;A LINE FEED
	JRST	TE+1		;YES
	CAIE	0,15		;A CAR RTN
TE:	SOS	$SVUPC		;ERROR RETURN BACK UP

;NOW RETURN SET UP ... GET THE NUMBER ...

	MOVE	0,2		;GET CONVERTED NUMBER
	MOVEM	1,SOPTR		;SAVE UPDATED OUTPUT POINTER
	RTN			;AND EXIT THE UUO

	PAGE
;STORAGE FOR STRING INPUT AND ITS POINTERS

$CHRIN:	Z			;THE TERMINATING CHARACTER
SPTR:	POINT 7,STRING		;INITIAL STRING POINTER
SIPTR:	Z			;INPUT POINTER
SOPTR:	Z			;OUTPUT POINTER
STRING:	BLOCK	^D16		;ROOM FOR 16.*5.=80. CHARACTERS

;SIMULATE CLRBFI UUO TO CLEAR INPUT BUFFER

UUO24:	MOVE	1,SPTR		;GET INITIAL STRING POINTER
	MOVEM	1,SIPTR		;INIT INPUT POINTER
	MOVEM	1,SOPTR		;INIT OUTPUT POINTER

	SETZM	STRING		;CLEAR FIRST LOC OF INPUT BUFF
	MOVE	1,[STRING,,STRING+1] ;A BLT POINTER
	BLT	1,STRING+^D15	;CLEAR REST OF INPUT BUFFER

	MOVEI	1,.PRIIN	;PRIMARY INPUT DEVICE
	CFIBF			;CLEAR MONITOR INPUT BUFFER
	 ERCAL	JSYSE1		;JSYS ERROR HANDLER
	RTN			;AND EXIT

;ROUTINE TO SIMULATE TTICHR UUO

UUO23:	CLRBFI			;CLEAR THE INPUT BUFFER
	HRROI	1,STRING	;INPUT POINTER
	MOVE	2,[RD%BEL!RD%RAI!RD%SUI!^D80] ;80-CHAR MAX ALLOWED
	SETZM	3		;CLEAR AC3
	RDTTY			;READ A 1-CHAR STRING
	 ERCAL	JSYSE1		;JSYS ERROR
	LDB	0,[POINT 7,STRING,6] ;GET THE CHARACTER
	SKIPN	0		;0 MEANS CR WAS STRUCK
	MOVEI	0,15		;SO MAKE IT A CR
	AOS	$SVUPC		;BUMP THE RETURN
	RTN			;AND EXIT


	PAGE

;ROUTINE TO SIMULATE TTSIXB

UUO25:	CLRBFI			;CLEAR THE INPUT BUFFER
	HRROI	1,STRING	;STRING POINTER
	MOVE	2,[RD%BEL!RD%RAI!RD%SUI!^D80]
	SETZM	3
	RDTTY			;READ  STRING
	 ERCAL	JSYSE1		;JSYS ERROR

	SETZM	0		;SIXBIT STRING BUILT HERE
	MOVE	2,[POINT 7,STRING] ;POINTER TO ASCII DATA
	MOVE	3,[POINT 6,0]	;POINTER TO SIXBIT DATA
	MOVEI	4,6		;# OF CHARACTERS EXPECTED AS MAX
SL1:	ILDB	1,2		;GET AN ASCII CHAR
	CAIL	1,40		;SEE IF IT'S LEGAL SIXBIT
	CAILE	1,137
	JRST	SLDN		;ILLEGAL. INPUT IS OVER
	SUBI	1,40		;LEGAL. CONVERT TO SIXBIT CODE
	IDPB	1,3		;PUT AWAY AS SIXBIT
	SOJG	4,SL1		;GET NEXT CHAR IF NOT DONE
	ILDB	1,2		;DONE. FETCH THE TERMINATOR
SLDN:	MOVEM	1,$CHRIN	;SAVE TERMINATOR
	CAIN	1,15		;WAS IT A CR ?
	AOS	$SVUPC		;YES. BUMP RETURN FOR NORMAL
	RTN			;EXIT PROPERLY


;ROUTINE TO SIMULATE TTIYES

	PCRLF			;ADVANCE TO NEXT LINE
UUO26:	TEXTF	[ASCIZ/("Y" OR "N" <CR>) - /]
	TTICHR			;GET A CHARACTER
	JFCL			;ERROR RETURN
	CAIN	0,"Y"		;MAKE SURE Y OR N WAS STRUCK
	JRST	.+3		;IT WAS A Y
	CAIE	0,"N"		;WAS IT AN N
	JRST	UUO26-1		;ERROR. ASK AGAIN
	CAIN	0,"Y"		;RESPONSE A YES ?
	AOS	$SVUPC		;YES. BUMP THE RETURN
	RTN			;AND EXIT
	PAGE
	SUBTTL MAINLINE CODE

PDLEN==200			;LENGTH IN OCTAL
PLIST:	BLOCK	PDLEN		;THE STORAGE BLOCK

START:	RESET			;A GENERAL RESET
	MOVE	P,[-PDLEN,,PLIST-1] ;SET UP POINTER
	TEXT	[ASCIZ?
TOPS-20 ON-LINE FORMATTER FOR DISK PACKS ON RH20'S?]
	TEXTF	[ASCIZ/, VERSION IS /]
	HLRZ	0,137		;GET MCNVER
	LSH	0,-6		;SHIFT INTO POSITION TO PRINT
	GO	POCT		;PRINT IT IN OCTAL
	TEXTF	[ASCIZ/(/]
	HRRZ	0,137		;GET THE DECVER
	GO	POCT		;PRINT IT IN OCTAL
	TEXTF	[ASCIZ/)
/]

;CODE TO MAKE ALL PROGRAM PAGES PRIVATE

	MOVEI	1,B		;POINTER TO FIRST LOCATION
PRVT:	MOVE	0,(1)		;FETCH LOC FROM PAGE
	MOVEM	0,(1)		;RESTORE IT TO MAKE IT PRIVATE
	ADDI	1,1000		;POINT ON TO NEXT PAGE
	CAIGE	1,E+1000	;SEE IF WE WENT PAST END
	JRST	PRVT		;NO. THEN LOOP
	GO	CLRBUF		;YES. CLEAR BUFFER AND CONTINUE

;ENABLE CAPABILITIES AND DIAG JSYS CODE

	GO	ENABLE		;ENABLE USERS CAPABILITIES
	GO	DSETUP		;INIT DIAG CODE

;GET TYPE OF PACK TO BE FORMATTED FROM THE OPERATOR

INE0:	TEXTF	[ASCIZ/
ENTER TYPE OF PACK TO BE USED. (OR HELP)/]
INE1:	TEXTF	[ASCIZ/
PICK ONE: (  HELP  /]
	SETZM	1		;CLEAR AN INDEX REGISTER
IN1N:	MOVE	0,NAMTBL(1)	;GET A SIXBIT NAME
	JUMPE	0,IN1		;GO INPUT IF ALL PRINTED
	PNTSIX			;PRINT OUT THE TYPE
	AOJA	1,IN1N		;GO FETCH THE NEXT VALUE
IN1:	TEXTF	[ASCIZ/) - /]
	TTSIXB			;INPUT IN SIXBIT
	JRST	INE1		;ERROR. RE-PROMPT
	CAME	0,[SIXBIT/HELP/] ;WANT HELP ?
	JRST	NOHLP		;NO
	GO	HELP		;YES. READ HELP FILE
	JRST	INE0		;FULL RE-PROMPT
	PAGE
NOHLP:	MOVE	2,0		;GET THE NAME TO AC2
	MOVEI	1,NAMTBL	;A TABLE POINTER
	GO	TSCAN		;CHECK FOR A VALID NAME
	JRST	INE1		;ERROR. NO ENTRY
	MOVEM	0,NAME		;CORRECT. SAVE THE NAME
	MOVEM	1,INDEX		;AND SAVE THE INDEX
	PCRLF			;SPACE TO NEXT LINE

;GO FIND A USEABLE DRIVE ON THE SYSTEM

	MOVE	1,NAME		;GET THE NAME
	GO	FIND		;FIND DEVICE IF POSSIBLE

;DEVICE FOUND. GET EITHER 16 OR 18 BIT MODE INPUT FROM OPERATOR

ALOW16:	JRST	OPTION		;SKIP THIS FEATURE .. TOPS20 CAN'T
				; SUPPORT 16-BIT MODE AND CAN NOT
				; VERIFY USING DSKOP ......
				; A NOP HERE WILL ALLOW THE PACK TO
				; AT LEAST BE WRITTEN IN 16 BIT MODE

INE2:	TEXTF	[ASCIZ/
ENTER DESIRED FORMAT (16 OR 18 BIT MODE) - /]
	TTSIXB			;INPUT IN SIXBIT
	JRST	INE2		;INPUT ERROR
	MOVE	2,0		;GET INPUT TO AC2
	MOVEI	1,MODTBL	;POINTER TO ACCEPTABLE INPUT TABLE
	GO	TSCAN		;CHECK FOR VALID INPUT
	JRST	INE2		;ERROR
	MOVE	1,MODFLG(1)	;OK. GET THE ASSOCIATED MODE FLAG
	MOVEM	1,MODE16	;AND SAVE IT
	JRST	OPTION		;GO SELECT RUNTIME OPTIONS


;TABLES OF ACCEPTABLE MODE INPUTS AND ASSOCIATED FLAGS

MODTBL:	SIXBIT/18/		;FOR 18 BIT MODE
	SIXBIT/18 BIT/
	SIXBIT/PDP-10/
	SIXBIT/16/		;FOR 16 BIT MODE
	SIXBIT/16 BIT/
	SIXBIT/PDP-11/
	Z

MODFLG:	Z			;FOR 18 BIT MODE
	Z
	Z
	-1			;FOR 16 BIT MODE
	-1
	-1
	Z

	PAGE
;CODE TO SET UP RUNTIME OPTION FLAGS
;FMTFLG IF NON-0 WE WILL FORMAT
;VFYFLG IF NON-0 WE WILL VERIFY

OPTION:	SETZM	FMTFLG#		;INITIALLY SET FLAGS TO 0
	SETZM	VFYFLG#
	TEXTF	[ASCIZ/
- BEWARE - FORMATTING DESTROYS ALL EXISTING PACK DATA/]
	TEXTF	[ASCIZ/
OPTIONS ARE: FORMAT ONLY (F), VERIFY ONLY (V), DO BOTH (B)/]
OPT0:	TEXTF	[ASCIZ/
PICK ONE (F,V,B) - /]
	TTSIXB			;INPUT FROM THE TTY
	JRST	OPT0		;INPUT INVALID
	CAME	0,[SIXBIT/B/]	;BOTH ?
	JRST	FCK		;NOPE
	SETOM	FMTFLG		;YES, SET FLAGS
	SETOM	VFYFLG
	JRST	OPT1		;DO MORE SCREENING
FCK:	CAME	0,[SIXBIT/F/]	;CHECK FOR AN F
	JRST	.VCK		;NOPE
	SETOM	FMTFLG		;YES. SET FLAG
	JRST	OPT1		;DO MORE SCREENING
.VCK:	CAME	0,[SIXBIT/V/]	;CHECK FOR A V
	JRST	OPT0		;INVALID INPUT
	SETOM	VFYFLG		;VERIFY
	JRST	OPT1		;DO SOME FURTHER SCREENING

;DO A CONSISTANCY CHECK ON WHAT WAS ASKED FOR

OPT1:	SKIPN	VFYFLG		;WANT VERIFY ?
	JRST	IP		;IMPLIES FMT ONLY. GO TO IT.
	SKIPN	MODE16		;YES. 16-BIT MODE ?
	JRST	IP		;NO.
	TEXTF	[ASCIZ/
CAN'T VERIFY IN 16-BIT MODE. VERIFY OPTION BEING DE-SELECTED
/]
	SETZM	VFYFLG		;DE-SELECT
	SKIPN	FMTFLG		;FORMAT ALSO SELECTED ?
	JRST	OPTION		;NOTHING SELECTED. GO BACK
	TEXTF	[ASCIZ/FORMAT OPTION STILL IN EFFECT
/]
	JRST	IP		;GO TO IT



	PAGE

;CALL ROUTINE TO SET UP PROG PARAMS FOR THIS TYPE DRIVE
;AND MAKE SURE DRIVE IS READY ... WRL=0 MOL=1 VV=1

IP:	SETZM	DIAGCR		;WE HAVE NO RH IN POSESSION NOW
	GO	IPARAM		;DOES NECESSARY CALCULATIONS

;HERE'S WHERE WE START TO FORMAT

.F:	SKIPN	FMTFLG		;WANT TO FORMAT ?
	JRST	VCK		;NO
	GO	CHKNAM		;ANOTHER USER PROTECT ROUTINE
	JRST	RMV		;HE CHOSE NOT TO CONTINUE
	JFCL			;HE SAYS OK
	GO	TELTIM		;REPORT THE TIME
	TEXTF	[ASCIZ/ STARTING FORMAT OPERATION
/]
	GO	FORMAT		;THIS ROUTINE FORMATS PACK
	GO	TELTIM		;REPORT THE TIME
	TEXTF	[ASCIZ/ FORMAT COMPLETED
/]

;HERE IS THE VERIFY

VCK:	SKIPN	VFYFLG		;WANT TO VERIFY ?
	JRST	RMV		;NO
	SKIPN	MODE16		;16 BIT MODE ?
	JRST	.V		;NO. THEN GO VERIFY
	TEXTF	[ASCIZ/VERIFY BEING SKIPPED.
MONITOR DOES NOT SUPPORT 16-BIT MODE
/]
	JRST	RMV		;GET PACK REMOVED
.V:	GO	TELTIM		;REPORT THE TIME
	TEXTF	[ASCIZ/ STARTING VERIFICATION AND MAPPING
/]
	GO	WRTBAT		;WRITE BAT BLOCKS
	GO	VERIFY		;THIS ROUTINE VERIFIES
	GO	TELTIM		;TELL THE TIME
	TEXTF	[ASCIZ/ VERIFICATION AND MAPPING COMPLETE
/]

;GET THE PACK REMOVED

RMV:	MOVEI	1,[ASCIZ/
REMOVE PACK FROM THE DRIVE/]
	GO	OPRACT		;TELL OPERATOR
	JFCL			;ALL DONE

	PAGE
;SEE IF HE WANTS TO FORMAT MORE PACKS

	TEXTF	[ASCIZ/
FORMAT ANOTHER PACK ? /]
	GO	QSTN		;ASK THE QUESTION
	HALTF			;TIMEOUT
	SKIPA			;ANSWER IS NO
	JRST	INE0		;ANS YES.  ... RESTART HIM
	TEXTF	[ASCIZ/[EXIT]
/]


	FATAL

	XLIST
	BOX <VERIFY -- VERIFY AND MAP THE PACK>,<
	VERIFY MERELY DOES SEQUENTIAL 1 PAGE READS OF THE PACK
	USING DSKOP WITH FULL MONITOR RETRY AND ERROR LOGGING
	ENABLED. ENTRIES WILL GO INTO BAT BLOCKS AS REQUIRED
	AND ERRORS WILL ALSO BE RECORDED IN SYSERR.
	CALL SEQ:
	GO	VERIFY		;CALL
	RTN			;RETURNS HERE >
VERIFY:	GO	FUDGE		;SPECIAL ADJ. FOR RM03 VERIFY
	GO	SINON		;TURN ON SOFTWARE INTERRUPTS
	PUT	0		;SAVE THINGS
	PUT	1
	PUT	2
	PUT	3
	MOVEI	1,^D20		;REPORT AT 20% INTERVALS
	MOVE	2,MAXBLK	;MAX BLOCK #
	GO	IPRPT		;INIT THE PROGRESS REPORT ROUTINE
	SETZM	ERFLG		;CLEAR AN ERROR FLAG
	SETZM	DKOP1#		;HOLDS PART OF AC1 FOR DSKOP JSYS
	DPB	DRIVE,[POINT 3,DKOP1,12] ;PLUG IN THE DRIVE FIELD
	GO	CHSEL		;GET CHAN # TO AC1
	DPB	1,[POINT 3,DKOP1,6] ;PLUG IN THE CHANNEL #
	HRREI	1,-4		;INIT STARTING BLOCK #
	MOVEM	1,SBLK#		;DONE.
	GO	CLRBUF		;CLEAR READ BUFFER THE FIRST TIME
	GO	DEVREQ		;GET DRIVE FROM MONITOR
	MOVSI	1,(1B14)	;DON'T REPORT RAE'S
	GO	LDRG11		;INTO 18 BIT MODE
	JFCL			;CBTO
	GO	DEVREL		;RELEASE DEVICE TO MONITOR

;START INTO THE VERIFY LOOP

VLOOP:	GO	SINTCK		;CHK FOR SOFTWARE INTERRUPT
	GO	PRPT		;SEE IF TIME TO REPORT PROGRESS
	MOVEI	1,4		;DEFAULT XFER 4 BLOCKS IF POSSIBLE
	MOVEM	1,NBLK#		;SAV E THE NUMBER OF BLOCKS
	MOVE	1,SBLK		;GET THE STARTING BLOCK #
	ADDI	1,4		;ONE PAGE ADVANCE
	MOVEM	1,SBLK		;SAVE UPDATED VALUE
	CAMLE	1,MAXBLK	;PAST THE LAST BLOCK YET ?
	JRST	VDONE		;YES. VERIFY IS DONE
	MOVE	1,MAXBLK	;NO. GET MAX BLOCK #
	SUB	1,SBLK		;SEE HOW MANY BLOCKS LEFT
	CAILE	1,3		;SEE HOW MANY LEFT TO END
	JRST	.+3		;AC1 .GT. 3
	AOS	1		;BUMP BY 1
	MOVEM	1,NBLK		;USE ACTUAL # LEFT
	PAGE
;SET UP AND EXECUTE DSKOP

	MOVEI	3,BUFFER	;BUFFER
	MOVE	2,NBLK		;NUMBER OF BLOCKS
	IMULI	2,200		;200 WORDS PER BLOCK
	MOVE	1,SBLK		;GET STARTING BLOCK
	IOR	1,DKOP1		;INCLUDE REST OF AC1 ARG
	TLO	1,200000	;SAYS.. DO PHYSICAL ADDRESSING
	DSKOP			;DO THE ACTUAL JSYS
	 ERCAL	DSKPER		;JSYS ERROR
	SKIPE	1		;WAS THERE A XFER ERROR
	GO	VERPT		;HANDLE ERROR REPORT
	JRST	VLOOP		;AND LOOP SOME MORE

;VERIFICATION COMPLETE

VDONE:	GO	SINOFF		;TURN OFF SOFTWARE INTERRUPTS
	JUMPE	ERFLG,VDN1	;JUMP IF NO XFER ERRORS OCCURED
	TEXTF	[ASCIZ/ **** /]
	MOVE	0,ERFLG		;GET # OF HARD ERRORS
	GO	PSDN		;PRINT #
	TEXTF	[ASCIZ/ HARD ERROR(S) DETECTED DURING VERIFY
/]
VDN1:	GET	3		;RESTORE THINGS
	GET	2
	GET	1
	GET	0
	RTN

DSKPER:	MOVEI	1,400000	;PROCESS HANDLE
	GETER			;GET ERROR
	 ERCAL	[RTN]
	MOVE	1,2		;CODE TO AC1
	TEXTF	[ASCIZ/
ERROR DETECTED DURING DSKOP JSYS
/]
	GO	JSYSE1		;REPORT THE ERROR
	FATAL

VERPT:	PUT	0		;SAVE AC
	AOS	ERFLG		;TALLY THE ERROR
	TEXTF	[ASCIZ/ ** HARD ERROR **   PAGE STARTS AT BLOCK #/]
	MOVE	0,SBLK		;GET STARTING BLOCK
	GO	PSDN		;PRINT IN DECIMAL
	PCRL
	GET	0
	RTN			;RETURN

	XLIST
	BOX <FORMAT -- FORMAT AN ENTIRE PACK>,<
	FORMAT THE PACK 3 SECT AT A TIME USING DIAG AND USRIO JSYS.
	WORST CASE DATA IS USED FOR DATA AREA. SERIAL # OF DRIVE IS
	WRITTEN INTO KEY WORD #2. THE 2 BAT BLOCKS ARE WRITTEN IN THE
	CORRECT FORMAT BUT WITH NO ENTRIES. ERRORS RETRIED 3 TIMES
	AND THEN CONTINUE IF STILL FAILING.
	CALL SEQ:
	GO	FORMAT		;CALL THE ROUTINE
	RTN			;RETURNS HERE >
FORMAT:	GO	SINON		;TURN ON SOFTWARE INTERRUPTS
	PUT	1		;SAVE AC'S
	PUT	2
	PUT	X
	MOVE	X,INDEX		;GET INDEX VALUE
	MOVEI	1,^D20		;PROGRES REPORT AT 20% INTERVALS
	MOVE	2,MAXBLK	;MAX BLOCK #
	GO	IPRPT		;INIT PROGRESS REPORTER
	GO	CLRBUF		;FIRST ZERO WRITE BUFFER
	GO@	WCDTB(X)	;WORST CASE DATA GEN FOR THIS DRIVE
	HRREI	1,-3		;1ST INCREMENT WILL TAKE YOU TO 0
	MOVEM	1,SBLK		;SAVE START BLOCK
	MOVEI	1,3		;# OF BLOCKS DEFAULT
	MOVEM	1,NBLK		;SAVE IT
FLOOP:	GO	SINTCK		;CHECK FOR SOF INT
	GO	PRPT		;SEE IF TIME TO REPORT PROGRESS
	MOVE	1,SBLK		;GET THE STARTING BLOCK
	ADDI	1,3		;UPDATED STARTING BLOCK
	MOVEM	1,SBLK		;SAVE IT
	CAMLE	1,MAXBLK	;PAST THE LAST BLOCK YET ?
	JRST	FDONE		;YES. FORMAT DONE
	MOVE	1,MAXBLK	;GET MAX BLOCK
	SUB	1,SBLK		;CALCULATE REMAINING SPACE
	CAILE	1,2		;SEE IF THERE ARE 3 LEFT
	JRST	.+3		;YES THERE ARE
	AOS	1		;NO. THEN COMPUTE REMAINDER
	MOVEM	1,NBLK		;AND SAVE IT
	MOVE	2,NBLK		;GET # BLOCKS TO AC2
	MOVE	1,SBLK		;START BLOCK TO AC1
	GO@	UPDAT(X)	;TO UPDATE THE HEADERS
	GO	WTFMT		;WRITE FORMAT OPERATION
	JRST	FLOOP		;LOOP UNTIL DONE
FDONE:	GO	SINOFF		;TURN SOFT INT SYS OFF
	GO	WRTBAT		;WRITE BAT BLOCKS
	GET	X		;RESTORE
	GET	2
	GET	1
	RTN			;AND EXIT
	XLIST
	BOX <WRTBAT -- ROUTINE TO WRITE BAT BLOCKS>,<
	THIS ROUTINE WRITES NEW BAT BLOCKS WITH NO ENTRIES.
	CALL SEQ:
	GO	WRTBAT		;CALL IT
	RTN			;IT RETURNS HERE >
WRTBAT:	SKIPE	MODE16		;IN 16 BIT MODE ?
	RTN			;YES.
	PUT	1
	PUT	2
	PUT	X
	MOVE	X,INDEX		;GET CURRENT INDEX
	MOVEI	2,1		;GET # OF BLOCKS
	MOVEM	2,NBLK		;SAVE THE NUMBER
	MOVEI	1,2		;GET STARTING BLOCK
	MOVEM	1,SBLK		;SAVE IT
	GO@	BATDAT(X)	;GENERATE BAT BLOCK DATA
	GO@	UPDAT(X)	;PLUG IN THE HEADER
	GO	WTFMT		;WRITE THE 1ST BAT BLOCK
	MOVEI	1,13		;2ND BAT BLOCK ADDRESS
	MOVEM	1,SBLK		;SAVE AS STARTING BLOCK
	GO@	BATDAT(X)	;GENERATE BAT BLOCK DATA
	GO@	UPDAT(X)	;GENERATE HEADER DATA
	GO	WTFMT		;WRITE OUT THE 2ND BAT BLOCK
	GET	X		;RESTORE
	GET	2
	GET	1
	RTN

	XLIST
	BOX <WTFMT -- WRITE HEADERS AND DATA TO THE DEVICE>,<
	THE I/O IS DONE IN HERE
	CALLING SEQ:
	MOVE	1,ARG1		;THE STARTING BLOCK #
	MOVE	2,ARG2		;THE # OF BLOCKS
	GO	WTFMT		;CALL THE ROUTINE
	RTN			;THE RETURN IS HERE >

WTFMT:	PUT	1		;SAVE THINGS
	PUT	2
	PUT	3
	SETZM	ERCNT#		;CLEAR THE ERROR COUNT
WTFMTL:	SETZM	ERFLG		;CLEAR THE ERROR FLAG
	IMUL	2,BLKSIZ	;(#WORDS)*(#BLOCKS)
	HRLZ	3,2		;3/#WDS,,0
	HRRI	3,BUFFER	;3/#WDS,,CORE ADDR
	SETZM	2		;A MUST FOR PROPER CONVERT
	GO	ADCON		;CONVERT BLOCK TO ADR
	JFCL			;2/CYL,,SURF,SECT
	MOVE	1,CMD		;WRITE HEADER AND DATA COMMAND
DOIT:	GO	DEVREQ		;REQUEST THE DEVICE
	GO	.RHCLR		;INIT THE RH
	GO	CLRATA		;CLR ATA FOR THIS DRIVE
	GO	XFSTRT		;START THE TRANSFER
	GO	IOWAIT		;WAIT TILL IT  FINISHES
	GO	.CONI		;DO A CONI
	TRNE	1,775000	;ANY ERRORS
	JRST	XFE		;YES
XFNE:	GO	DEVREL		;NO. RELEASE THE DEVICE
	SKIPN	ERCNT		;HAVE WE BEEN IN RETRY ?
	JRST	XFX		;NO. THEN WE ARE DONE
	TEXTF	[ASCIZ/
ERROR RECOVERY WAS SUCCESSFUL... CONTINUING.
/]
XFX:	GET	3		;RESTORE THINGS
	GET	2
	GET	1
	RTN			;AND EXIT

;WRITE HEADER AND DATA COMMAND

CMD:	63			;THIS IS IT

	PAGE
;HERE BECAUSE WE HAD AN ERROR DURING THIS TRANSFER

XFE:	SETOM	ERFLG		;SET THE ERROR FLAG
	AOS	ERCNT		;COUNT IT UP
	GO	SNAPS		;SNAPSHOT REGISTERS
	SETZM	1		;CLEAR AC
	GO	GETLOG		;GET LOGOUT AREA
	GO	DRVCLR		;THEN THE DRIVE
	GO	IOWAIT		;UNTIL DRIVE CLEAR FINISHES
	GO	DEVREL		;RELEASE THE DEVICE
	TEXTF	[ASCIZ/
*-*-* TRANSFER ERROR /]
	GO	TELWHO		;IDENTIFY THE DEVICE
	PCRL
	GO	DUMPS		;DUMP REGISTERS
	GO	LOGPNT		;AND CHANNEL LOGOUT AREA
	MOVE	1,ERCNT		;GET ERROR COUNT
	CAMLE	1,RETLIM	;REACHED RETRY LIMIT ?
	JRST	.+4		;YES
	MOVE	1,-2(P)		;SET UP AC'S FOR RETRY
	MOVE	2,-1(P)
	JRST	WTFMTL		;AND TRY AGAIN
	TEXTF	[ASCIZ/
ERROR RECOVERY FAILED... CONTINUING.
/]
	JRST	XFX		;TO EXIT CODE

;# OF RETRIES ALLOWED

RETLIM:	3			;AFTER THIS MANY, CONTINUE



	SUBTTL MASSBUS CONTROLLER UTILITY PKG
	PAGE


;LAST EDIT (#21)	 8 NOV 77
	XLIST
;********************************************************************
;********************************************************************
;********************************************************************
	LIST
S
S
S

COMMENT /
THE CODE IN THIS FILE IS ASSEMBLED BASED ON SEVERAL SWITCHES THAT MAY
APPEAR IN THE PROGRAMS TITLE FILE. THEY ARE:

RH20==1		ASSEMBLE RH20 CODE
RH10==1		ASSEMBLE RH10 CODE

RS04==1		ASSEMBLE CODE FOR THE RS04
RP04==1		ASSEMBLE CODE FOR THE RP04
RP05==1		ASSEMBLE CODE FOR THE RP05
RP06==1		ASSEMBLE CODE FOR THE RP06
DX100==1	ASSEMBLE CODE FOR DX20-V100
DX200==1	ASSEMBLE CODE FOR DX20-V200
RM03==1		ASSEMBLE CODE FOR THE MASSBUS ADAPTER

WHEN SETTING UP THE SWITCHES, DO NOT SELECT MORE THAN
ONE DRIVE TYPE AND CONTROLLER PAIR AT A TIME.

	/
	XLIST

;********************************************************************
;********************************************************************
;********************************************************************
	LIST

	PAGE
	DEFINE	BOX (TEXTA,TEXTB)<
	LALL
	LIST
	PAGE
S
;* TEXTA
S
COMMENT	$
	TEXTB
	$
	XLIST
	XALL
	LIST
	>

	XLIST

	BOX <CONDITIONAL ASSY CONTROL SECTION>,<
THIS CODE DEFINES AND SETS TO ZERO, ALL THE SYMBOLS THAT ARE NESSARY
BUT MAY NOT HAVE BEEN SET UP BY THE USER IN HIS TITLE FILE>

	IFNDEF	RH20,<RH20==0>
	IFNDEF	RH10,<RH10==0>
	IFNDEF	RS04,<RS04==0>
	IFNDEF	RP04,<RP04==0>
	IFNDEF	RP05,<RP05==0>
	IFNDEF	RP06,<RP06==0>
	IFNDEF	RM03,<RM03==0>
	IFNDEF	DX100,<DX100==0>
	IFNDEF	DX200,<DX200==0>
	IFNDEF	SDISK,<SDISK==0>
	IFNDEF	REALTIME,<REALTIME=0>

; HERE IS A FLAG THAT IS ZERO ONLY IF NO DEVICE HAS BEEN SELECTED

	ANYDEV=RS04!RP04!RP05!RP06!RM03!SDISK!DX100!DX200
	DX20=DX100!DX200


S
S
S

	XLIST
	BOX	<NOTES ON I/O ROUTINE DESIGN>,<

1.  ALL CODE IN THIS FILE IS RE-ENTRANT
	WITH THE EXCEPTION OF THE USER MODE STUFF WHICH NEED
	NOT BE SINCE THE PI SYSTEM CANNOT BE USED IN USER MODE

2.  THE ROUTINES EXPECT TO FIND THE DRIVE NUMBER IN AN AC LABLED
	"DRIVE" BITS 33-35 .

3.  THE ROUTINES WILL EXPECT TO FIND THE CONTROLLER DEVICE CODE
	IN AN AC LABLED "MBCN" (MASSBUSS CONTROLLER NUMBER)
	BITS 3-9

4.  NO AC'S ARE MODIFIED UNLESS THEY RETURN DATA.  

5.  THERE IS A GLOBAL SOFTWARE FLAG CALLED "SHMODE" WHICH
	OVERRIDES AND WORKS FUNCTIONALLY IDENTICAL
	TO THE SHORT PRINTOUT SWITCH "TXTINH". THIS
	IS A CONVENIENT WAY FOR THE SOFTWARE TO FORCE
	THE DIAGNOSTIC INTO OCTAL OUTPUT MODE.		

6.   IF IN (EXEC MODE) WITH AN RH20 IT'S NECESSARY FOR THE CHAN ROUTINES
     TO DO A LIMITED AMOUNT OF PAGING. THIS IS ACCOMPLISHED BY SETTING
     UP A LOCATION CALLED "CBASE" TO BE A PAGED ADDRESS OF "0". THE
     THE ROUTINES WILL THEN WORK PROPERLY.

7.	THIS PKG HAS BEEN CONSTRUCTED TO WORK CORRECTLY WITH THE DAS-33
       EXTENDED STATUS FEATURE IF IN EXEC MODE. MONITOR DOES NOT SUPPORT
       THE FEATURE IN USER MODE.

8.     RH10'S WILL DEFAULT TO LOCATION 100 FOR THEIR ICWA. TO CHANGE
       THE DEFAULT ADDRESS, WRITE THE DESIRED ADR INTO LOCATIONS
       ICWA0 THRU ICWA6. THERE IS ONE LOCATION FOR EACH OF THE POSSIBLE
       RH10'S (UP TO 6) >


















	SUBTTL REGISTER LOAD AND READ ROUTINES

	XLIST
	BOX <MASSBUS DEVICE REGISTER LOAD ROUTINES>,<
SPECIFICATION:
 DEVICE REGISTERS ARE LOADED BY SETTING UP AC1
WITH SOME APPROPRIATE ARGUMENT AND THEN CALLING THE CORRECT
ROUTINE WITH A PUSHJ. THE ROUTINES HAVE A NORMAL RETURN AND AN ERROR 
RETURN.
	EG.	MOVE	AC1,FOO	;GET SOME ARGUMENT
		GO	LDRGXX	;XX (REG #) RANGES FROM 00-37 OCTAL
		RTN1		;RAE DETECTED AFTER THE LOAD
		RTN2		;LOAD WAS SUCCESSFUL

AC1:
SPECIFY REGISTER DATA IN BITS 20-35
SPECIFY PARITY MODE BIT 18
	0 MEANS ODD
	1 MEANS EVEN
SPECIFY SOFTWARE OPTION BITS 13-14
	BIT 13=0	CLEAR RAE'S
	BIT 13=1	DON'T CLEAR RAE'S
	BIT 14=0	REPORT RAE'S
	BIT 14=1	DON'T REPORT RAE'S

STATUS:
IF NO ERRORS ARE DETECTED, AC1 IS RETURNED AS IT WAS
SPECIFIED EXCEPT FOR THE REGISTER AND DRIVE FIELDS WHICH WILL HAVE
BEEN SUPPLIED BY THE ROUTINE.
AC1 ON RETURN FROM AN RH10 ERROR HOLDS THE PRESENT VALUE
OF THE DIB.  AC1 ON RETURN FROM AN RH20 ERROR HOLDS THE DATAO ARGUMENT
THAT CAUSED THE RAE. >

LDRG00:	PUT	1		;SAVE AC1
	IOR	1,[0B5!1B6]	;REG # AND LOAD REG BIT
	JRST	LDRGCC		;GO TO COMMON CODE
LDRG01:	PUT	1
	IOR	1,[1B5!1B6]
	JRST	LDRGCC
LDRG02:	PUT	1
	IOR	1,[2B5!1B6]
	JRST	LDRGCC
LDRG03:	PUT	1
	IOR	1,[3B5!1B6]
	JRST	LDRGCC
LDRG04:	PUT	1
	IOR	1,[4B5!1B6]
	JRST	LDRGCC
LDRG05:	PUT	1
	IOR	1,[5B5!1B6]
	JRST	LDRGCC
LDRG06:	PUT	1
	IOR	1,[6B5!1B6]
	JRST	LDRGCC
LDRG07:	PUT	1
	IOR	1,[7B5!1B6]
	JRST	LDRGCC
LDRG10:	PUT	1
	IOR	1,[10B5!1B6]
	JRST	LDRGCC
LDRG11:	PUT	1
	IOR	1,[11B5!1B6]
	JRST	LDRGCC
LDRG12:	PUT	1
	IOR	1,[12B5!1B6]
	JRST	LDRGCC
LDRG13:	PUT	1
	IOR	1,[13B5!1B6]
	JRST	LDRGCC
LDRG14:	PUT	1
	IOR	1,[14B5!1B6]
	JRST	LDRGCC
LDRG15:	PUT	1
	IOR	1,[15B5!1B6]
	JRST	LDRGCC
LDRG16:	PUT	1
	IOR	1,[16B5!1B6]
	JRST	LDRGCC
LDRG17:	PUT	1
	IOR	1,[17B5!1B6]
	JRST	LDRGCC
LDRG20:	PUT	1
	IOR	1,[20B5!1B6]
	JRST	LDRGCC
LDRG21:	PUT	1
	IOR	1,[21B5!1B6]
	JRST	LDRGCC
LDRG22:	PUT	1
	IOR	1,[22B5!1B6]
	JRST	LDRGCC
LDRG23:	PUT	1
	IOR	1,[23B5!1B6]
	JRST	LDRGCC
LDRG24:	PUT	1
	IOR	1,[24B5!1B6]
	JRST	LDRGCC
LDRG25:	PUT	1
	IOR	1,[25B5!1B6]
	JRST	LDRGCC
LDRG26:	PUT	1
	IOR	1,[26B5!1B6]
	JRST	LDRGCC
LDRG27:	PUT	1
	IOR	1,[27B5!1B6]
	JRST	LDRGCC
LDRG30:	PUT	1
	IOR	1,[30B5!1B6]
	JRST	LDRGCC
LDRG31:	PUT	1
	IOR	1,[31B5!1B6]
	JRST	LDRGCC
LDRG32:	PUT	1
	IOR	1,[32B5!1B6]
	JRST	LDRGCC
LDRG33:	PUT	1
	IOR	1,[33B5!1B6]
	JRST	LDRGCC
LDRG34:	PUT	1
	IOR	1,[34B5!1B6]
	JRST	LDRGCC
LDRG35:	PUT	1
	IOR	1,[35B5!1B6]
	JRST	LDRGCC
LDRG36:	PUT	1
	IOR	1,[36B5!1B6]
	JRST	LDRGCC
LDRG37:	PUT	1
	IOR	1,[37B5!1B6]
	JRST	LDRGCC


LDRG:	PUT	1		;SPECIAL FOR DX20
	TLO	1,(1B6)		;SPECIAL FOR THE DX20

LDRGCC:	PUT	0		;SAVE AC0
	PUT	2		;SAVE AC2
	PUT	3		;SAVE THE AC
	XLIST
	IFN	RH20,<
	LIST
	TLO	1,(1B9)		;SET DISABLE RAE STOP BIT
	XLIST
	>
	LIST
	TLZ	1,(1B13!1B14)	;CLEAR SOFTWARE FLAGS
	TSO	1,DRIVE		;INCLUDE THE DRIVE #
	MOVE	3,1		;SAVE THE DATAO ARGUMENT
	MOVE	2,[DATAO 0,1]	;BUILD A DATAO FROM AC1
	IOR	2,MBCN		;INCLUDE THE DEVICE CODE
	XCT	2		;DOES A DATAO RH,1

;CONDITIONAL CODE TO TEST FOR AN RH10/RH20 RAE

	XLIST
	IFN	RH20,<
	LIST
	TLC	2,(1B10!1B11)	;CHANGES DATAO TO A CONI
	XCT	2		;DOES A CONI RH,1
	TRNE	1,1B24		;WAS THERE AN RAE ??
	JRST	LDRGB		;YES.
	XLIST
	>
	IFN	RH10,<
	LIST
	TLZ	2,(1B11)	;CHANGES DATAO RH,1 TO DATAI RH,1
	ADDI	2,2		;NOW WE HAVE DATAI RH,3
	XCT	2		;DO A BLIND DATAI
	MOVSI	(54B5)		;RAE REGISTER NUMBER
	MOVE	1,[DATAO]	;GET A BASIC DATAO INSTRUCTION
	IOR	1,MBCN		;INCLUDE THE DEVICE CODE
	XCT	1		;DO A DATAO RH,0
	TLZ	1,(1B11)	;CHANGE DATAO TO DATAI
	SETA			;RH10 I/O STALL IS NECESSARY
	SETA
	XCT	1		;DOES A DATAI INTO AC0
	MOVEI	1,1		;GET A SINGLE BIT MASK
	LSH	1,(DRIVE)	;POSITION TO CORRECT RAE BIT
	TDNE	0,1		;IS THERE AN RAE ??
	JRST	LDRGB		;YES.
	XLIST
	>
	LIST
	AOS	-4(P)		;NO RAE. BUMP THE RETURN
LDRGC:	GET	3		;CLEAN UP
	GET	2		;RESTORE A COUPLE OF AC'S
	GET	0
	GET	1
	RTN			;AND EXIT

;HERE BECAUSE WE HAD AN RAE DETECTED AFTER A REGISTER LOAD

LDRGB:	MOVE	1,-3(P)		;FETCH ORIGINAL AC1
	TLNE	1,(1B13)	;WANT TO CLEAR THE RAE ??
	JRST	LDRGB1		;NO.

;RH20/RH10 CONDITIONAL CODE TO CLEAR RAE'S

	XLIST
	IFN	RH20,<
	LIST
	GO	.CONI		;DO A CONI
	ANDI	1,1B24!1B27!1B30!7B35 ;RAECLR!MBE!ATTNEN!PICHAN
	GO	.CONO		;DO CORRECT CLEARING CONO
	XLIST
	>
	IFN	RH10,<
	LIST
	MOVE	[54B5!1B6!377] 	;READY TO CLEAR ALL RAE'S
	MOVE	1,[DATAO]	;A BASIC DATAO
	IOR	1,MBCN		;INCLUDE THE DEVICE CODE
	XCT	1		;CLEARS THE RAE
	XLIST
	>
	LIST

;SEE IF WE WANT TO REPORT ERRORS

LDRGB1:	EXCH	3,-3(P)		;PUT ERR ARGUMENT ON STACK
	TLNE	3,(1B14)	;WANT TO REPORT ??
	JRST	LDRGC		;NO
	TEXT	[ASCIZ/
RAE WHILE WRITING A DEVICE REGISTER
RH=/]
	LDB	[POINT 7,MBCN,9] ;GET DEVICE CODE
	LSH	2		;JUSTIFY FOR PRINTING
	GO	POCT		;PRINT IT
	XLIST
	IFN	RH20,<
	LIST
	TEXT	[ASCIZ/  THE DATAO ARGUMENT WAS: /]
	XLIST
	>
	IFN	RH10,<
	LIST
	TEXT	[ASCIZ/  READING THE DIB GIVES: /]
	XLIST
	>
	LIST
	MOVE	-3(P)		;GET IT FROM THE STACK
	PNTHW			;PRINT IT
	PCRL			;PRINT A CRLF
	JRST	LDRGC		;AND GO EXIT

	XLIST
	BOX <MASSBUS DEVICE REGISTER READ ROUTINES>,<
SPECIFICATION:
DEVICE REGISTERS ARE READ INTO AC1 BY SETTING UP SOME ARGUMENT
IN AC1 AND THEN CALLING THE CORRECT ROUTINE WITH A PUSHJ  .
THE ROUTINES HAVE A NORMAL RETURN AND 2 ERROR RETURNS.
	EG.	MOVE	AC1,FOO	;SOME ARGUMENT
		GO	RDRGXX 	;XX(REG #) RANGES FROM 00-37 OCTAL
		RTN1		;RAE DUE TO CTRL BUSS TIMEOUT
		RTN2		;RAE OTHER THAN CTRL BUSS TIMEOUT
		RTN3		;READ WAS SUCCESSFUL

AC1:
SPECIFY PARITY MODE BIT 18
	0 MEANS ODD PARITY
	1 MEANS EVEN PARITY
SPECIFY SOFTWARE OPTION BITS 13-14
	BIT 13=0	CLEAR RAE'S
	BIT 13=1	DON'T CLEAR RAE'S
	BIT 14=0	REPORT RAE'S
	BIT 14=1	DON'T REPORT RAE'S

STATUS:
UPON COMPLETING A REGISTER READ, ALL 36 BITS OF THE DIB REG (RH10) OR
PREP REG (RH20) ARE RETURNED IN AC1. THE ERROR RETURNS ARE TAKEN IF AN RAE IS
DETECTED BY THE CONTROLLER DURING THE READ OPERATION. THE CONDITIONS
THAT CAUSE THE RAE ARE DIFFERENT FOR THE RH10 THAN RH20 AND MAY BE
ANALYZED BASED ON THE STATUS FROM AC1. >

RDRG00:	PUT	1		;SAVE AC1
	IOR	1,[0B5]		;REG # AND LOAD REG BIT
	JRST	RDRGCC		;GO TO COMMON CODE
RDRG01:	PUT	1
	IOR	1,[1B5]
	JRST	RDRGCC
RDRG02:	PUT	1
	IOR	1,[2B5]
	JRST	RDRGCC
RDRG03:	PUT	1
	IOR	1,[3B5]
	JRST	RDRGCC
RDRG04:	PUT	1
	IOR	1,[4B5]
	JRST	RDRGCC
RDRG05:	PUT	1
	IOR	1,[5B5]
	JRST	RDRGCC
RDRG06:	PUT	1
	IOR	1,[6B5]
	JRST	RDRGCC
RDRG07:	PUT	1
	IOR	1,[7B5]
	JRST	RDRGCC
RDRG10:	PUT	1
	IOR	1,[10B5]
	JRST	RDRGCC
RDRG11:	PUT	1
	IOR	1,[11B5]
	JRST	RDRGCC
RDRG12:	PUT	1
	IOR	1,[12B5]
	JRST	RDRGCC
RDRG13:	PUT	1
	IOR	1,[13B5]
	JRST	RDRGCC
RDRG14:	PUT	1
	IOR	1,[14B5]
	JRST	RDRGCC
RDRG15:	PUT	1
	IOR	1,[15B5]
	JRST	RDRGCC
RDRG16:	PUT	1
	IOR	1,[16B5]
	JRST	RDRGCC
RDRG17:	PUT	1
	IOR	1,[17B5]
	JRST	RDRGCC
RDRG20:	PUT	1
	IOR	1,[20B5]
	JRST	RDRGCC
RDRG21:	PUT	1
	IOR	1,[21B5]
	JRST	RDRGCC
RDRG22:	PUT	1
	IOR	1,[22B5]
	JRST	RDRGCC
RDRG23:	PUT	1
	IOR	1,[23B5]
	JRST	RDRGCC
RDRG24:	PUT	1
	IOR	1,[24B5]
	JRST	RDRGCC
RDRG25:	PUT	1
	IOR	1,[25B5]
	JRST	RDRGCC
RDRG26:	PUT	1
	IOR	1,[26B5]
	JRST	RDRGCC
RDRG27:	PUT	1
	IOR	1,[27B5]
	JRST	RDRGCC
RDRG30:	PUT	1
	IOR	1,[30B5]
	JRST	RDRGCC
RDRG31:	PUT	1
	IOR	1,[31B5]
	JRST	RDRGCC
RDRG32:	PUT	1
	IOR	1,[32B5]
	JRST	RDRGCC
RDRG33:	PUT	1
	IOR	1,[33B5]
	JRST	RDRGCC
RDRG34:	PUT	1
	IOR	1,[34B5]
	JRST	RDRGCC
RDRG35:	PUT	1
	IOR	1,[35B5]
	JRST	RDRGCC
RDRG36:	PUT	1
	IOR	1,[36B5]
	JRST	RDRGCC
RDRG37:	PUT	1
	IOR	1,[37B5]
	JRST	RDRGCC


RDRG:	PUT	1		;SPECIAL FOR THE DX20

RDRGCC:	PUT	0		;SAVE THE AC
	PUT	2		;SAVE THE AC
	XLIST
	IFN	RH20,<
	LIST
	TLO	1,(1B9)		;SET THE DISABLE RAE STOP BIT
	XLIST
	>
	LIST
	TLZ	1,(1B13!1B14)	;CLEAR THE SOFTWARE FLAG BITS
	TSO	1,DRIVE		;INCLUDE THE DRIVE NUMBER
	MOVE	2,[DATAO 0,1]	;GET A BASIC DATAO
	IOR	2,MBCN		;INCLUDE THE DEVICE CODE
	XCT	2		;DOES A DATAO RH,1
	TLZ	2,(1B11)	;CHANGE TO DATAI RH,1
	XLIST
	IFN	RH10,<
	LIST
	SETA			;RH10 NEEDS I/O BUSS DELAY
	SETA			;  OF 3 U.S.
	XLIST
	>
	LIST
	XCT	2		;DO A DATAI RH,1
	PUT	1		;SAVE RESULTS ON THE STACK

;CONDITIONAL RH10/RH20 CODE TO TEST FOR AN RAE

	XLIST
	IFN	RH20,<
	LIST
	TLCE	1,(1B10)	;COMPLEMENT AND TEST THE TRA BIT
	AOS	-4(P)		;BUMP RTN IF TRA DID NOT FAIL
	TLNE	1,(1B8!1B10)	;RAE=PE+(TRA FAILURE)
	JRST	RDRGB		;GOT AN RAE
	XLIST
	>
	IFN	RH10,<
	LIST
	TLNN	1,(1B7)		;CBTO ?
	AOS	-4(P)		;NO. BUMP THE RETURN
	TLNE	1,(1B7!1B8!1B9!1B10) ;RAE=CBTO+CBPE+DLT+ILC
	JRST	RDRGB
	XLIST
	>
	LIST
	AOS	-4(P)		;NO RAE. BUMP THE RETURN
RDRGC:	GET	1		;RESTORE THE AC
	EXCH	1,-2(P)		;SOME STACK ADJUSTMENT
	GET	2
	GET	0
	GET	1
	RTN			;AND TAKE THE PROPER RETURN

;HERE BECAUSE WE HAD AN RAE DURING A REGISTER READ OPERATION

RDRGB:	MOVE	1,-3(P)		;FETCH ORIGINAL AC1
	TLNE	1,(1B13)	;WANT TO CLEAR THE RAE ??
	JRST	RDRGB1		;NO. GO REPORT

;RH20/RH10 CONDITIONAL CODE FOR CLEARING RAE'S

	XLIST
	IFN	RH20,<
	LIST
	GO	.CONI		;GET CURRENT CONTROLLER STATUS
	ANDI	1,1B24!1B27!1B30!7B35 ;RAECLR!MBE!ATTNEN!PICHAN
	GO	.CONO		;CLEAR AND RESTORE
	XLIST
	>
	IFN	RH10,<
	LIST
	MOVE	[54B5!1B6!377] 	;READY TO CLEAR ALL RAE'S
	MOVE	1,[DATAO 0,0] ;GET A BASIC DATAO
	IOR	1,MBCN		;INCLUDE THE DEVICE CODE
	XCT	1		;WHICH CLEARS THE RAE REGISTER
	XLIST
	>
	LIST

;SEE IF WE WANT TO REPORT RAE ERRORS

RDRGB1:	MOVE	1,-3(P)		;FETCH ORIGINAL AC1
	TLNE	1,(1B14)	;WANT TO REPORT ??
	JRST	RDRGC		;NO
	TEXT	[ASCIZ/
RAE WHILE READING A DEVICE REGISTER - - DATAI: /]
	MOVE	(P)		;GET THE DATAI WORD
	PNTHW
	PCRL	
	TEXT	[ASCIZ/RH DEVICE CODE WAS /]
	LDB	[POINT 7,MBCN,9] ;GET THE DEVICE CODE
	LSH	2		;JUSTIFY FOR PRINTING
	GO	POCT		;PRINT IT
	PCRL			;A CRLF
	JRST	RDRGC

	XLIST
	IFN	RH10,<
	XLIST
	BOX	<ROUTINES FOR WRITING RH10 INTERNAL REGISTERS>,<
	THERE ARE 4 INTERNAL REGS THAT CAN BE WRITTEN INTO WITH A
	CALL TO THE PROPER SUBROUTINE.

	ENTRY POINTS ARE:
	LDCR		;LOAD THR  CONTROL REG
	LDIAR		;LOAD THE INTERRUPT ADDRESS REG
	LDDBUF		;LOAD THE DATA BUFFER REGISTER
	LDRAE		;LOAD THE RAE REG

	ARGUMENTS ARE PASSED IN AC1. BITS ARE DEFINED EXACTLY
	AS IN THE RH10 SPEC. THE ROUTINES RETURN TO CALL+1 ALWAYS.

	EG.	MOVE	AC1,ARG		;GET THE DATA
		GO	LDRAE		;WANT TO LOAD THE RAE REG
		RETURN			;RETURNS HERE  >


LDCR:	PUT	1		;SAVE THE AC
	IOR	1,[40B5!1B6]	;INCLUDE REG# AND LOAD REG BIT
	TSO	1,DRIVE		;INCLUDE THE DRIVE NUMBER
	JRST	LDIRC		;TO COMMON CODE
LDIAR:	PUT	1
	IOR	1,[44B5!1B6]	
	JRST	LDIRC
LDDBUF:	PUT	1
	IOR	1,[50B5!1B6]
	JRST	LDIRC
LDRAE:	PUT	1
	IOR	1,[54B5!1B6]

LDIRC:	PUT	0		;SAVE THE AC
	MOVE	0,[DATAO 0,1]	;BUILD THE DATAO
	IOR	0,MBCN		;INCLUDE THE DEVICE CODE
	XCT	0		;DOES A DATAO RH,1
	GET	0
	GET	1
	RTN			;AND EXIT

	XLIST
	BOX	<ROUTINES FOR READING RH10 INTERNAL REGISTERS>,<
	THERE ARE 6 INTERNAL RH10 REGISTERS THAT CAN BE READ
	INTO AC1 WITH A CALL TH THE PROPER SUBROUTINE. THE ROUTINES
	RETURN TO CALL+1 ALWAYS.

	THE ENTRY POINTS ARE:
	RDDIB		;READ THE DIB REGISTER
	RDRAE		;READ THE RAE REGISTER
	RDIAR		;READ THE INTERRUPT REGISTER
	RDDBUF		;READ THE DATA BUFFER REGISTER
	RDCR		;READ THE TRANSFER REGISTER
	RDCBUF		;READ THE CHANNEL BUFFER REGISTER
	NOTE: - - THE CHANNEL BUFFER REG IS 36 DATA BITS WIDE
		UNLIKE THE OTHER REGISTERS IN THE RH10. BECAUSE
		OF THIS PROPERTY, THE REGISTER NUMBER IS NOT 
		RETURNED AS PART OF THE DATA.

	EG.	GO	RDIAR		;READ THE CURRENT INTERRUPT ADR
		RETURN			;RETURN HERE  >

RDDIB:	PUT	0		;SAVE 0
	MOVE	0,[DATAI 0,1]	;A BASIC DATAI
	IOR	0,MBCN		;INCLUDE DEVICE CODE
	JRST	RDIRC2		;TO COMMON CODE
RDRAE:	MOVSI	1,(54B5)	
	JRST	RDIRC1
RDIAR:	MOVSI	1,(44B5)
	JRST	RDIRC1
RDDBUF:	MOVSI	1,(50B5)
	JRST	RDIRC1
RDCR:	MOVSI	1,(40B5)
	JRST	RDIRC1
RDCBUF:	MOVSI	1,(74B5)

RDIRC1:	PUT	0		;SAVE 0
	MOVE	0,[DATAO 0,1]	;BUILD THE DATAO
	IOR	0,MBCN		;INCLUDE THE DEVICE CODE
	XCT	0		;DO A DATAO RH,1
	TLZ	0,(1B11)	;CHANGE DATAO TO DATAI
	SETA			;I/O BUSS DELAY
RDIRC2:	XCT	0		;DOES A DATAI RH,1
	GET 	0
	RTN			;AND RETURN
	XLIST
	>

	XLIST
	IFN	RH20,<
	XLIST
	BOX	<ROUTINES FOR WRITING RH20 INTERNAL REGISTERS>,<
	THERE ARE 5 INTERNAL REGISTERS IN THE RH20 THAT ARE
	WRITEABLE WITH A CALL TO THE PROPER SUBROUTINE.

	THE ENTRY POINTS ARE:
	LDSBAR		;LOAD THE SECONDARY BLOCK ADDR REGISTER
	LDSTCR		;LOAD THE SECONDARY TRANSFER CONTROL REGISTER
	LDIVRG		;LOAD THE INTERRUPT VECTOR REGISTER
	LDDCR		;LOAD THE DIAGNOSTIC CONTROL REGISTER
	LDWTRG		;LOAD THE WRITE REGISTER

	ARGUMENTS ARE PASSED IN AC1 AND THE BITS ARE DEFINED EXACTLY
	AS SEEN IN THE RH20 SPEC.THE ROUTINES RETURN TO CALL+1 ALWAYS.

	EG.	MOVE 	AC1,ARG		;SOME ARGUMENT
		GO	LDIVRG		;LOAD THE INTERRUPT VECTOR REG
		RETURN			;RETURN HERE  >
LDSBAR:	PUT	1		;SAVE AC1
	IOR	1,[70B5!1B6]	;INCLUDE REG# AND LOAD REG BIT
	JRST	LIRC		;TO COMMON CODE
LDSTCR:	PUT	1
	IOR	1,[71B5!1B6]
	JRST	LIRC
LDIVRG:	PUT	1
	IOR	1,[74B5!1B6]
	JRST	LIRC
LDDCR:	PUT	1
	IOR	1,[77B5!1B6]
	JRST	LIRC
LDWTRG:	PUT	1
	IOR	1,[76B5!1B6]

LIRC:	PUT	0		;SAVE AC
	TLNN	1,(1B3!1B4)	;SEE IF SBAR OR STCR
	TSO	1,DRIVE		;YES. INCLUDE THE DRIVE NUMBER
	MOVE	0,[DATAO 0,1]	;NO. BUILD APPROPRIATE DATAO
	IOR	0,MBCN		;INCLUDE THE DEVICE CODE
	XCT	0		;DOES A DATAO RH,1
	GET	0
	GET	1
	RTN			;RETURN

	XLIST
	BOX	<ROUTINES FOR READING THE RH20 INTERNAL REGISTERS>,<
	THERE ARE 6 INTERNAL REGISTERS WITHIN THE RH20 THAT CAN BE
	READ BY MEANS OF A CALL TO THE PROPER SUBROUTINE.
	THE REGISTERS ARE READ INTO AC1 ANDTHE ROUTINES RETURN TO
	CALL+1 ALWAYS.

	THE ENTRY POINTS ARE:
	RDSBAR		;READ THE SECONDARY BLOCK ADDR REG
	RDSTCR		;READ THE SECONDARY XFER CTRL REG
	RDPBAR		;READ THE PRIMARY BLOCK ADDR REG
	RDPTCR		;READ THE PRIMARY XFER CTRL REG
	RDIVRG		;READ THE INTERRUPT VECTOR REG
	RDRDRG		;READ THE READ REGISTER

	THE BITS ARE DEFINED EXACTLY AS IN THE RH20 SPEC

	EG.	GO	RDIVRG		;READ CURRENT INTERRUPT ADDRESS
		RETURN			;ADDRESS IS IN AC1  >


RDSBAR:	MOVSI	1,(70B5)	;FETCH THE REGISTER NUMBER
	JRST	RIRC
RDSTCR:	MOVSI	1,(71B5)
	JRST	RIRC
RDPBAR:	MOVSI	1,(72B5)
	JRST	RIRC
RDPTCR:	MOVSI	1,(73B5)
	JRST	RIRC
RDIVRG:	MOVSI	1,(74B5)
	JRST	RIRC
RDRDRG:	MOVSI	1,(75B5)

RIRC:	PUT	0		;SAVE AC0
	MOVE	0,[DATAO 0,1]	;GET A BASIC DATAO
	IOR	0,MBCN		;INCLUDE THE DEVICE CODE
	XCT	0		;DOES A DATAO RH,1
	TLZ	0,(1B11)	;CHANGE TO A DATAI
	XCT	0		;DOES A DATAI RH,1
	GET	0		;RESTORE THE AC
	RTN			;AND EXIT
	XLIST
	>
	XLIST
	BOX <CONTROLLER CONO,CONI,CONSO,CONSZ (I/O) ROUTINES>,<
SPECIFICATIONS:
THESE ROUTINES ARE USED TO PERFORM THE VARIOUS CONDITIONS OPERATIONS
TO MASSBUS CONTROLLERS. AC1 IS USED FOR ARGUMENT PASSING.
.CONI	IS THE ONLY ROUTINE OF THE 4 THAT WILL ALTER AC1.
THE CONO ROUTINE IS DESIGNED TO ALLOW THE USER TO ATTEMPT TO
SET BITS IN THE SAME CALL AS DOING AN RHCLR. THIS ROUTINE WILL
EXECUTE THAT TYPE OF OPERATION CORRECTLY.

	EG.	MOVE	AC1,FOO	;SOME CONDITIONS FOR A CONO
		GO	.CONO	;THE CALL
		RETURN		;CONO HAS BEEN COMPLETED

		GO	.CONI	;WANT TO DO A CONI
		RETURN		;CONI DATA IS IN AC1

		MOVE	AC1,FOO	;A MASK FOR A CONSZ
		GO	.CONSZ	;THE CALL (NO STATUS IS RETURNED)
		RETURN-1	;NOT ALL BITS ZERO
		RETURN-2	;ALL BITS ARE ZERO

		MOVE	AC1,FOO	;A MASK FOR A CONSO
		GO	.CONSO	;THE CALL (NO CONDITIONS ARE RETURNED)
		RETURN-1	;NO BITS ARE ONE
		RETURN-2	;AT LEAST ONE BIT IS A ONE  >


.CONO:	PUT	1		;SAVE AC1
	IOR	1,[CONO]	;INCLUDE THE OPCODE
	IOR	1,MBCN		;INCLUDE THE DEVICE CODE
	TRNN	1,1B25		;IS RHCLR DESIRED ?
	JRST	CNOCMN		;NO
	PUT	1		;YES.  SAVE THE INSTRUCTION
	HLLZ	1,1		;CLEAR ALL RIGHT SIDE BITS
	TRO	1,1B25		;SET THE RHCLR BIT
	XCT	1		;EXECUTE THE CONO
	GET	1
	TRZ	1,1B25		;NOW RESET THE RHCLR BIT
CNOCMN:	XCT	1		;DO THE CONO
	GET	1		;RESTORE THE AC
	RTN			;AND RETURN

.CONI:	MOVE	1,[CONI 0,1]	;GET THE OPCODE
	IOR	1,MBCN		;INCLUDE THE DEVICE CODE
	XCT	1		;DO THE I/O
	RTN			;AND RETURN

.CONSZ:	PUT	1		;SAVE THE AC
	IOR	1,[CONSZ]	;INCLUDE THE OPCODE
	JRST	.CONSO+2		;TO SOME COMMON CODE

.CONSO:	PUT	1		;SAVE THE AC
	IOR	1,[CONSO]	;INCLUDE THE OPCODE
	IOR	1,MBCN		;INCLUDE DEVICE CODE
	XCT	1		;DO THE I/O
	SKIPA			;RTN-1. CONDITIONS NOT SATISFIED
	AOS	-1(P)		;RTN-2. CONDITIONS SATISFIED
	GET	1		;RESTORE THE AC
	RTN			;TAKE THE PROPPER RETURN

	LIST
	SUBTTL DATA CHANNEL SUBROUTINES

	XLIST
	BOX	<ROUTINES TO INTERFACE WITH A CHANNEL>,<
	THERE ARE 5 ROUTINES AVAILABLE FOR INTERFACING WITH
	A DATA CHANNEL WHOSE CHARACTERISTIC DIFFERENCES
	BECOME TRANSPARENT TO THE USER.

	NAME		FUNCTION
	----		--------
	CHINIT		INITIALIZE. RE-SYNC HARDWARE AND SOFTWARE
	GENCCW		GENERATE A LIST OF CCW'S IN CORE
	GETLOG		SNAPSHOT LOGOUT DATA TO A CORE BUFFER AREA
	LOGPNT		PRINT CHANNEL LOGOUT DATA
	CCWPNT		PRINT A CCW LIST FROM MEMORY >

	XLIST
	BOX	<NOTES ON INITIAL CONTROL WORD ADDR.>,<
	WITH EACH CONTROLLER IS AN ASSOCIATED CHANNEL #.
	THE CHANNEL ROUTINES DEFAULT TO THE FOLLOWING (EXEC MODE)
	INITIAL CONTROL WORD ADDRESSES FOR EACH OF THE CHANNELS.

	TYPE	DEV. CODE	CHAN #		ICW-ADR
	----	---------	------		-------
	RH10	270		0		100(ICWA0)
	RH10	274		1		100(ICWA1)
	RH10	360		2		100(ICWA2)
	RH10	364		3		100(ICWA3)
	RH10	370		4		100(ICWA4)
	RH10	374		5		100(ICWA5)

	RH20	540		0		000(ICWA0)
	RH20	544		1		004(ICWA1)
	RH20	550		2		010(ICWA2)
	RH20	554		3		014(ICWA3)
	RH20	560		4		020(ICWA4)
	RH20	564		5		024(ICWA5)
	RH20	570		6		030(ICWA6)
	RH20	574		7		034(ICWA7)

	THE RH20 ZERO FILL WORDS ARE LOCATED AT EPT LOCATIONS
	060 THRU 063  THESE LOCATIONS ARE SET TO ZERO
	BY "CHINIT" IF RUNNING IN EXEC MODE  >

	XLIST
	BOX	<CHANNEL INITIALIZATION ROUTINE>,<
	SPECIFICATION:
	 THIS ROUTINE SYNCHRONIZES THE SOFTWARE AND HARDWARE CHAN LOGIC.

	EG.	MOVE	1,ARG1		;SETUP AC1
		GO	CHINIT		;CALL THE ROUTINE
		RETURN			;ICWA IS IN AC1

	AC1:
	SPECIFY (AC1)R START ADDR OF CHANNEL COMMAND BUFFER
	SPECIFY	(AC1)L SIZE OF THE CHANNEL COMMAND BUFFER
	NOTE - - FOR FIGURING OUT THE SIZE OF THE COMMAND WORD
		BUFFER IT SHOULD BE NOTED THAT THE GENCCW ROUTINE
		WILL TRANSFER A MAXIMUM OF 8192. WORDS PER CCW
		USING AN RH10 WHILE WE CAN TRANSFER ONLY 1920.
		WORDS PER CCW USING AN RH20. >

; 1. SETS UP THE INTIIAL CONTROL WORD WITH THE PROPER JUMP
; 2. SETS UP VARIOUS SOFTWARE PARAMS FOR CHANNEL ROUTINES

CHINIT:	PUT	1		;SAVE AC1
	PUT	2		;SAVE AC2
	HLRZ	2,1		;MAKE AC2/  FINAL ADR,,START ADR
	SUBI	2,1
	ADD	2,1
	HRL	1,2
	PUT	1		;SAVE AC1
	GO	CHSEL		;GET CHAN # TO AC1
	MOVE	2,1		;NOW TO AC2
	GET	1		;RESTORE AC1
	SETOM	CINIT(2)	;SET PROPER INITIALIZE FLAG
	XLIST
	IFN	RH10,<
	LIST
	SETZM	DF22FG(2)	;ASSUME 18 BIT DF10
	PUT	1		;SAVE AC1
	GO	.CONI		;DO A CONI TO SEE IF 22 BIT DF10
	TLNE	1,(1B6)		;IS IT A 22 BIT DF10 ??
	SETOM	DF22FG(2)	;YES. SET THE FLAG
	GET	1		;RESTORE THE AC
	XLIST
	>
	LIST
	MOVEM	1,CADTBL(2)	;SAVE CHARACTERISTICS OF CCW BUFFER
	HRRZM	1,SCLP(2)	;SET UP SOFTWARE CMD LIST POINTER
	MOVE	2,ICWA0(2)	;AC2=ICWA
	ADD	2,CBASE		;CAUSES PAGING TO OCCUR

;CLEAR THE CHAN LOGOUT AREA IF NOT IN USER MODE

	SKIPE	USER		;IN USER MODE ?
	JRST	CHI1		;YES
	PUT	1		;SAVE AC
	XLIST
	IFN	RH10,<
	LIST
	MOVN	1,CHK		;-# OF LOGOUT WORDS PER CHAN
	HRLZ	1,1		;-#WDS,,0
	HRR	1,2		;-#WDS,,ICWA
	XLIST
	>
	IFN	RH20,<
	LIST
;IF RH20 CLEAR ONLY 2ND AND 3RD WORDS OF LOGOUT AREA
	HRLZI	1,-2		;-#WDS,,0
	HRR	1,2		;-#WDS,,ICWA
	ADDI	1,1		;-#WDS,,ICWA+1
	XLIST
	>
	LIST
	SETZM	(1)		;CLEAR A WORD
	AOBJN	1,.-1		;REPEAT TILL ALL CLEARED
	GET	1		;RESTORE THE AC

CHI1:	MOVEM	2,-1(P)		;BECOMES AC1 ON RETURN
	HRRZ	1,1		;AC1=0,,BUFFER ADDR
	IOR	1,JMPWD		;MAKES A JUMP CCW
	SKIPN	USER		;DON'T STOR IF IN USER MODE
	MOVEM	1,(2)		;MAKES ICW A JUMP TO CCW BUFFER
	SKIPN	USER		;SKIP IF IN USER MODE
	SETZM	1(2)		;ZERO THE TERM CONTROL WD
	XLIST
	IFN	REALTIME,<
	LIST
	SKIPN	USER		;SKIP IF IN USER MODE
	JRST	TMPEND		;NO.
	ADD	1,RELOC#	;MAKE A PHYSICAL ADDR
	MOVEM	1,POKEBK+2	;PUT IN POKE ARG BLOCK
	HRRZM	2,POKEBK	;GET ADDR TO POKE
	MOVE	2,POKEBK	;GET ADDR
	PEEK	2,		;READ CURRENT CONTENTS
	MOVEM	2,POKEBK+1	;PUT IN POKE ARGUMENT BLOCK
	MOVE	2,[3,,POKEBK]	;GET POINTER
	POKE.	2,		;POKE MONITOR
	JRST	.-5
	JRST	TMPEND		;DONE
POKEBK:	BLOCK	3		;ARGUMENT BLOCK
TMPEND:	JFCL
	XLIST
	>
	LIST
	XLIST
	IFN	RH20,<
	LIST
	SKIPE	USER		;IN USER MODE
	JRST	CHIX		;YES.
	SETZM	60
	SETZM	61
	SETZM	62
	SETZM	63			;CLEARS THE ZERO FILL WORDS
CHIX:	GET	2
	GET	1
	RTN
	XLIST
	>
	IFN	RH10,<
	LIST
	GET	2
	GET	1
	SKIPN	USER		;USER MODE ?
	RTN			;NO.

;IN USER MODE. GET INITIAL CONTROL WORD ADR WITH A DUMMY
;CHANNEL PGM CALL

	GO	DEV.AD		;GET DEV ADR WORD
	MOVEM	1,INIARG+1	;SAVE IN ONE ARG LIST
	MOVEM	1,IARG+1	;SAVE IN OTHER ARG LIST
	MOVE	1,[-3,,INIARG]	;A POINTER
	XCT	.DIAG		;A CHANNEL PGM IS BORN
	GO	DIAGER		;ERROR
	PUT	1		;SAVE THE ICWA
	MOVE	1,[-2,,IARG]	;A POINTER
	XCT	.DIAG		;ABORT THE DUMMY PGM
	GO	DIAGER		;ERROR
	GET	1		;RECOVERS ICWA
	RTN			;EXIT

;ARGUMENT BLOCKS FOR PREVIOUS 2 DIAG CALLS

INIARG:	4			;SPECIFY CHAN PGM
	Z			;RESERVED FOR DEV ADR
	777760,,CHINIT		;DUMMY CCW THAT WORKS FOR ALL DF'S


IARG:	5			;A RELEASE OF CHANNEL PGM
	Z			;RESERVED FOR DEV ADR

	XLIST
	>
	LIST

	XLIST
	BOX	<CHANNEL COMMAND WORD GENERATOR>,<
	SPECIFICATION:
	 THIS ROUTINE TAKES A PDP-10 WORD COUNT AND A CORE
	ADDRESS AND TRANSLATES IT TO A LIST OF CCW'S IN A
	COMMAND RING BUFFER DEFINED AT INIT TIME. IT RETURNS
	THE STARTING ADDRESS OF THE LIST WITHIN THE RING,AND
	THE # OF CCW'S FOR THIS TRANSFER.

 EG.	MOVE	AC3,ARG3	;A ZERO FILL SPECIFIER
	MOVE	AC2,ARG2	;POS OR NEG WORD COUNT
	MOVE	AC1,ARG1	;AN ADDR UP TO 22 BITS
	GO	GENCCW		;BUILD THE COMMAND LIST
	RETURN			;RETURNS HERE

AC1:
CONTAINS A 22 BIT ADDRESS SPECIFYING WHERE TRANSFER IS TO START.

AC2:
POS OR NEG WORD COUNT FOR # OF WORDS TO GO TO OR FROM THE DEVICE.
A NEG WORD COUNT ON THE RH20 WILL CAUSE THE ROUTINE TO ASSUME THAT
READ REVERSE IS DESIRED AND THE APPROPRIATE COMMAND LIST WILL
BE GENERATED. FOR RH10'S A NEGATIVE WORD COUNT OR POSITIVE 
WORD COUNT ARE HANDLED THE SAME.

AC3:
NOT MEANINGFULL EXCEPT FOR DISKS. OTHER DEVICES SHOULD ZERO AC3.
THIS AC IS IGNORED IF AN RH10 IS USED. IF RUNNING AN RH20,
A POSITIVE, NON-ZERO, WORD COUNT WILL CAUSE THE ROUTINE TO ASSUME THAT
ZERO FILL COMMAND WORDS ARE DESIRED IN THE LIST AND THE APPROPRIATE
ZERO FILL WORD WILL BE GENERATED. IT FURTHERMORE REQUIRES THAT
THE VALUE IN AC3 IS EQUAL TO THE NUMBER OF WORDS  IN ONE SECTOR
OF THE DISK.
ESSENTIALLY THIS WORD SAYS THAT THE SIZE OF THE SIZE OF THE XFER
IS AN EVEN MODULO OF THE VALUE OF AC3. EXTRA WORDS ARE PADDED WITH
ZERO'S, SUPPLIED BY THE CHANNEL.

RETURN:
ON RETURN AC1 WILL CONTAIN THE FOLLOWING:-
	(AC1)L = # OF COMMAND WORDS GENERATED BY THE ROUTINE
	(AC1)R = POINTS TO THE FIRST WORD IN THE LIST. >
	XLIST
	IFN	RH20,<
	PAGE
	LIST


	;FUNCTIONS OF THE AC'S USED IN GENCCW ROUTINE
	;AC	FUNCTION
	;--	--------
	;0	HOLDS REMAINING SIZE IN WORDS
	;1	CCW'S ARE MANUFACTURED IN THIS AC
	;2	HOLDS THE CURRENT CORE ADR AT ANY TIME
	;3	HOLDS THE LOGICAL CHANNEL NUMBER (0-7)
	;4	HOLDS CURRENT SOFTWARE CLP
	;5	HOLDS LAST AVAIL BUFFER ADDR
	;6	HOLDS  START ADR OF CCW LIST,,# OF WDS IN LIST
	;7	HOLDS THE READ REVERSE FLAG
	

GENCCW:	PUT	0		;SAVE AC'S
	PUT	1
	PUT	2
	PUT	3
	PUT	4
	PUT	5
	PUT	6
	PUT	7

; PRE-LOAD AC'S TO PROPER VALUES

	MOVE	0,-5(P)		;GETS THE SIZE
	MOVE	2,-6(P)		;GETS THE CORE ADDRESS
	GO	CHSEL		;GET CHAN # TO AC1
	MOVE	3,1		;NOW TO AC3
	MOVE	4,SCLP(3)	;GETS SOFTWARE CLP
	HLRZ	5,CADTBL(3)	;GETS FINAL BUFFER ADDR
	HRLZ	6,4		;START OF CCW LIST,,# OF WORDS
	SETZ	7,		;ASSUME READ FORWARD

; CHECK SIGN OF SIZE TO SEE IF WE WANT READ REVERSE

	JUMPGE	0,GENL1		;SIZE IS POSITIVE. JUMP.
	SETOM	7		;SIZE NEG. SET REVERSE FLAG
	MOVNS	0,0		;NOW MAKE SIZE A POSITIVE VALUE
	JRST	GENL1		;AND CONTINUE

;START BUILDING A CHANNEL COMMAND LIST

GENL1:	CAMG	0,MAXWD		;SIZE .GT. MAXWD
	JRST	GEN2		;NO
	HRLZ	1,MAXWD		;YES. GET WORD COUNT
	LSH	1,4		;JUSTIFY TO BIT-13
	ADD	1,2		;INCLUDE THE CORE ADDRESS
	SUB	0,MAXWD		;DECREASE SIZE BY MAXWD
	JUMPN	7,.+3		;JUMP IF REVERSE FLAG IS SET
	ADD	2,MAXWD		;ADJUST THE ADDRESS
	JRST	.+3
	SUB	2,MAXWD		;ADJUST ADDR FOR REVERSE
	TLO	1,(1B2)		;SET REVERSE BIT IN THE CCW
	GO	CCWST		;STORE IN THE LIST
	JRST	GENL1
	
;HERE BECAUSE SIZE IS .LE. MAXWD

GEN2:	HRLZ	1,0		;GET REMAINING SIZE
	LSH	1,4		;POSITION TO BIT-13
	ADD	1,2		;INCLUDE THE ADDRESS
	SKIPE	7		;REVERSE ??
	TLO	1,(1B2)		;YES. SET REVERSE BIT
	CAMN	0,MAXWD		;IS SIZE=MAXWD ??
	JRST	GEN3+1		;YES. NO ZERO FILL REQUIRED

;SEE IF ZERO FILL IS REQUIRED

	PUT	1		;SAVE AC1
	SKIPN	-5(P)		;IF AC3 WAS 0 , NO ZERO FILL REQ'D
	JRST	GEN3		;NO ZERO FILL REQUIRED
	IDIV	0,-5(P)		;DIVIDE  REMAINDER/BLOCKSIZE
	SKIPN	1		;IS REMAINDER = 0 ?
	JRST	GEN3		;YES. NO ZERO FILL REQ'D
	EXCH	1,(P)		;EXCHANGE REM & CCW IN PROGRESS
	GO	CCWST		;STORE THE CCW IN THE LIST
	GET	1		;GET THE REMAINDER BACK TO AC1

; HERE TO BUILD A ZERO FILL WORD

	MOVNS	1,1		;ADJUST SIZE
	ADD	1,-5(P)
	LSH	1,^D22		;REMAINDER POSITIONED TO BIT-13
	SKIPE	7		;REVERSE ??
	TLO	1,(1B2)		;YES. SET THE REVERSE BIT 
	JRST	GEN3+1		;TO SKIP THE GET IN THIS PATH

GEN3:	GET	1		;GET THE CCW BACK INTO AC FROM STACK
	TLO	1,(1B1)		;SET THE "LAST WORD" BIT
	GO	CCWST		;STORE IN THE CCW LIST

; TIME TO CLEAN UP AND EXIT

	MOVEM	4,SCLP(3)	;SAVE UPDATED SOFTWARE CLP.
	MOVSM	6,-6(P)		;SO WE CAN PASS BACK TO USER
	GET	7		;RESTORE AC'S
	GET	6
	GET	5
	GET	4
	GET	3
	GET	2
	GET	1
	GET	0
	SKIPE	USER		;USER MODE
	GO	CHPGM		;YES. BUILD A CHAN PGM
	RTN			;AND EXIT

	XLIST
	BOX	<RH20 CCW STORE ROUTINE>,<
	1. PUTS C(AC1) IN CCW BUFFER
	2. DOES BUFFER MANAGEMENT
	3. COUNTS EACH CCW ENTERED

	THE CCW IS RETURNED AN AC1 AS RECEIVED EXCEPT FOR
	THE "OP-DATA" BIT (BIT-0) WHICH IS SET >
CCWST:	PUT	1		;SAVE AC1
	CAME	4,5		;ARE WE AT LAST BUFFER LOCATION ?
	JRST	CCWST1		;NO. GO STORE THE WORD
	MOVE	1,JMPWD		;YES. BUILD A JUMP CCW
	HRR	1,CADTBL(3)	;INCLUDE START ADR OF BUFFER
	MOVEM	1,(4)		;PUT IN THE LAST BUFFER LOC
	AOS	6		;COUNT THE ENTRY
	HRRZ	4,1		;RESET THE CLP TO START OF BUFFER
CCWST1:	GET	1		;RECOVER ORIGINAL CCW
	TLO	1,(1B0)		;SET OP-DATA BIT
	XLIST
	IFN	REALTIME,<
	LIST
	TDNE	1,[17,,777777]	;0 ADR MEANS ZERO FILL
	ADD	1,RELOC		;RELOCATE ADDRESS
	>
	LIST
	MOVEM	1,(4)		;PUT IN THE BUFFER
	ADDI	4,1		;UPDATE COUNTER/POINTER
	ADDI	6,1
	RTN			;AND EXIT
	XLIST
	>
	LIST
	XLIST
	IFN	RH10,<
	PAGE
	LIST


	;FUNCTIONS OF THE AC'S USED IN GENCCW ROUTINE
	;AC	FUNCTION
	;--	--------
	;0	HOLDS REMAINING SIZE IN WORDS
	;1	CCW'S ARE MANUFACTURED IN THIS AC
	;2	HOLDS CURRENT ADDRESS AT ANY TIME
	;3	HOLDS THE LOGICAL CHANNEL NUMBER (0-2)
	;4	HOLDS UPDATED CLP AT ANY TIME
	;5	HOLDS LAST AVAILABLE CCW BUFFER ADDRESS
	;6	HOLDS START ADDR OF CCW LIST,,# OF WDS IN LIST
	;7	HOLDS THE 22-BIT DF10 FLAG
	

GENCCW:	PUT	0		;SAVE AC'S
	PUT	1
	PUT	2
	PUT	3
	PUT	4
	PUT	5
	PUT	6
	PUT	7

; PRESET THE AC 'S TO THEIR APPROPRIATE VALUE

	MOVM	0,-5(P)		;GETS THE ABSOLUTE SIZE
	MOVE	2,-6(P)		;GETS  THE CORE ADDRESS
	GO	CHSEL		;GET CHAN # TO AC1
	MOVE	3,1		;NOW TO AC3
	HRRZ	4,CADTBL(3)	;GET THE BUFFER POINTER
	HLRZ	5,CADTBL(3)	;GET CCW BUFF FINAL ADDR
	HRLZ	6,CADTBL(3)	;6/ CCW START ADR,,0
	MOVE	7,DF22FG(3)	;GETS THE 22-BIT DF10 FLAG

; START BUILDING THE COMMAND LIST

GENL1:	CAMG	0,MAXWD		;SIZE .GT. MAXWD
	JRST	CGEN2		;NO.
	MOVN	1,MAXWD		;YES. GET NEG WORD COUNT
	HRLZ	1,1		;POS -WC TO BIT 17
	SKIPE	7		;22 BIT DF10 ??
	LSH	1,4		;YES. POS -WC TO BIT 13
	ADD	1,2		;NO. INCLUDE CORE ADDR
	SUBI	1,1		;ADR=ADR-1 FOR DF10
	ADD	2,MAXWD		;ADJUST THE ADDRESS
	SUB	0,MAXWD		;ADJUST THE SIZE
	GO	CCWST		;STORE IN THE CCW LIST
	JRST	GENL1		;AND LOOP

; HERE BECAUSE SIZE LESS THAN OR EQUAL TO MAXWD

CGEN2:	MOVN	1,0		;GET THE NEGATIVE SIZE
	HRLZ	1,1		;POS TO BIT 17
	SKIPE	7		;22-BIT DF10 ??
	LSH	1,4		;YES POSITION TO GIT 13
	ADD	1,2		;NO. THEN INCLUDE THE ADDRESS
	SUBI	1,1		;ADR=ADR-1 FOR A DF10
	GO	CCWST		;STORE IT IN THE CCW LIST
	SETZ	1,		;A DF10 HALT WORD
	GO	CCWST		;PUT IT IN THE LIST
	MOVSM	6,-6(P)		;FIX STACK FOR RETURN
	MOVEM	4,SCLP(3)	;SAVE THE UPDATED CLP
	GET	7
	GET	6
	GET	5
	GET	4
	GET	3
	GET	2
	GET	1
	GET	0
	SKIPE	USER		;USER MODE ?
	GO	CHPGM		;YES. BUILD A CHAN PGM
	RTN

	XLIST
	BOX	<RH10/DF10 CCWST ROUTINE>,<
	PUTS THE C(AC1) IN THE CCW LIST AND UPDATES THE
	BUFFER POINTER ALONG WITH COUNTING THE ENTRY. >

CCWST:	CAMLE	4,5		;HAVE WE RUN OUT OF SPACE
	JRST	CCWSTF		;YES. SOFTWARE BUG
	XLIST
	IFN	REALTIME,<
	LIST
	ADD	1,RELOC		;RELOCATE ADDR
	XLIST
	>
	LIST
	MOVEM	1,(4)		;NO. PUT THE WORD IN THE BUFFER
	ADDI	4,1		;UPDATE POINTER/COUNTER
	ADDI	6,1
	RTN

CCWSTF:	TEXT 	[ASCIZ/
PGM BUG: - CCW BUFFER TO SMALL - RAN OUT OF SPACE
/]
	FATAL
	XLIST
	>
	LIST

	XLIST
	BOX <GETLOG - ROUTINE TO SNAPSHOT THE CHANNEL LOGOUT AREA>,<
	THIS ROUTINE TAKES DATA FROM THE CHANNEL LOGOUT AREA
	AND PLACES IT IN A CORE BUFFER SO THAT THE LOGOUT PRINTER
	WILL WORK CORRECTLY IN USER MODE. IT ZEROS THE LOGOUT
	AREA AS IT TRANSFERS ALSO. THIS ROUTINE MUST BE CALLED
	BEFORE CALLING LOGPNT.
	AC1 CONTAINS A POINTER TO A USER AREA WHERE THE LOGOUT DATA SHOULD
	BE PLACED. IF AC1 IS 0 AT CALL TIME, NO DATA IS PUT IN USER AREA.

	CALLING SEQ:
		MOVE	1,ARG		;SET UP POINTER
		GO	GETLOG		;SNAPSHOT
		RETURN			;RETURNS HERE ALWAYS  >

	;FUNCTIONS OF THE AC'S DURING GETLOG
	;AC	FUNCTION
	;--	--------
	;0	HOLDS DATA TO BE TRANSFERRED
	;1	POINTER TO ACTUAL LOGOUT AREA
	;2	COUNTER & POINTER TO BUFFERED LOGOUT AREA
	;3	POINTER TO USER LOGOUT AREA

GETLOG:	SKIPE	USER		;USER MODE
	GO	DIAGGL		;YES. GET LOGOUT DATA
	PUT	0		;SAVE AC'S
	PUT	1
	PUT	2
	PUT	3
	GO	CHSEL		;GET CHAN # TO AC1
	MOVE	2,1		;DUPLICATE AC1 & AC2
	IMUL	2,CHK		;X4 OR X10
	MOVE	1,ICWA0(1)	;ICWA TO AC1
	SETZM	3		;CLEAR AC3
	ADD	3,-2(P)		;SET UP POINTER TO USER AREA
	ADD	1,CBASE		;CREATES A PAGED ADDRESS
	XLIST
	IFE	REALTIME,<
	LIST
	SKIPE	USER		;USER MODE
	MOVEI	1,LOGARG+2	;YES. POINT TO ARGLIST DATA
	XLIST
	>
	LIST
	ADD	2,CHCNT		;CREATES A COUNTER POINTER TO BUFFER
	XLIST
	IFN	RH10,<
	LIST
;CODE TO SEE IF WE NEED TO HANDLE THE DAS

	SKIPE	USER		;IN USER MODE ?
	JRST	GL1		;YES. GO NO FURTHER
	SKIPE	2(1)		;IS THE 3RD LOGOUT WORD A ZERO ?
	HRLI	2,-^D10		;YES. MODIFY THE WORD COUNT
	XLIST
	>
	LIST
GL1:
	XLIST
	IFN	REALTIME,<
	LIST
	SKIPE	USER
	JRST	.+3
	XLIST
	>
	LIST
	SETZM	0		;CLEAR THE DATA WORD
	EXCH	0,(1)		;FETCH WORD AND REPLACE WITH ZERO
	XLIST
	IFN	RH20,<
	LIST
;RH20 - REPLACE 1ST AND LAST WORDS OF LOGOUT AREA
;THEY CONTAIN INITIAL JUMP AND POSSIBLY AN INTERRUPT VECTOR
;1ST WORD HAS BITS 34,35 BOTH CLEAR
;LAST WORD HAS BITS 34,35 BOTH SET
	SKIPE	USER		;USER MODE ?
	JRST	.+6		;YES
	TRNN	1,3		;FIRST WORD ?
	JRST	.+3		;YES. REPLACE IT
	TRC	1,3		;TEST FOR THE LAST WORD
	TRCN	1,3		;LAST WORD ?
	MOVEM	0,(1)		;RESTORE CONTENTS
	JFCL
	XLIST
	>
	IFN	REALTIME,<
	LIST
	SKIPN	USER		;USER MODE
	JRST	.+3		;NO
	MOVEI	(1)		;YES
	PEEK			;DO A PEEK
	XLIST
	>
	LIST
	MOVEM	0,(2)		;STORE IN THE BUFFER AREA
	SKIPE	-2(P)		;DON'T RTN IF AC1 WAS 0 AT CALL
	MOVEM	0,(3)		;PUT IN USER AREA
	AOS	3		;BUMP USER POINTER
	AOS	1		;BUMP THE LOGOUT POINTER
	AOBJN	2,GL1		;BUMP COUNTER, POINTER TO BUFFER
	GET	3		;DONE. RESTORE THE AC'S
	GET	2
	GET	1
	GET	0
	RTN			;AND EXIT


	XLIST
	BOX	<CHANNEL LOGOUT PRINTER>,<
	ROUTINE PRINTS THE STATUS OF THE CHANNEL AT LOGOUT TIME.
	LOGOUT DATA IS PRINTED FROM A BUFFERED AREA, THEREFORE,
	GETLOG SHOULD BE EXECUTED FIRST.

	EG.	GO	LOGPNT		;PRINT
		RETURN			;AND RETURN >

	;FUNCTIONS OF AC'S FOR LOGPNT
	;AC	FUNCTION
	;--	--------
	;0	USED FOR PRINTING
	;1	HOLDS EPT ADR FOR CURRENT WORD
	;2	POINTS TO CURRENT BUFFERED WORD
	;3	HOLDS THE LOGICAL CHANNEL NUMBER
	

LOGPNT:	PUT	0		;SAVE AC'S
	PUT	1
	PUT	2
	PUT	3
	TEXT	[ASCIZ/CHAN-/]
	GO	CHSEL		;GET CHAN # TO AC1
	MOVE	3,1		;NOW TO AC3
	MOVE	0,3		;READY TO PRINT
	PNT1			;PRINT IT
	TEXT	[ASCIZ/LOGOUT DATA
LOC   /]
	SKIPE	SHMODE#		;SHORT PRINTOUT MODE ?
	JRST	.+3		;YES
	MOVE	0,CONSW		;GET THE CONSOLE SWITCHES
	TLNE	TXTINH		;NORMAL OR SHORT PRINTOUT?
	TEXT	[ASCIZ/CONTENTS/] ;SHORT
	PCRL			;NORMAL
	GO	ICWPT		;PRINT INITIAL CW DATA
	XLIST
	IFN	RH20,<
	LIST
	GO	LOSPT		;PRINT SW1 DATA IF AN RH20
	XLIST
	>
	LIST
	GO 	TCWPT		;PRINTS TERM CW STATUS
	PCRL			;A CRLF
	XLIST
	IFN	RH10,<
	LIST
	SKIPN	USER		;IN USER MODE ?
	GO	DASPNT		;NO. PRINT DAS STATUS
	XLIST
	>
	LIST
	SKIPE	SHMODE		;SHORT PRINTOUT MODE ?
	JRST	.+4		;YES
	MOVE	CONSW		;GET CONSOLE SWITCHES
	TLNN	TXTINH		;NORMAL OR SHORT PRINTOUT ?
	PCRL			;NORMAL
	GET	3		;RESTORE THE AC'S
	GET	2
	GET	1
	GET	0
	RTN			;AND EXIT

;PRINTER FOR INITIAL CONTROL WORD & POINTER SETUP ROUTINE

ICWPT:	MOVE	1,3		;AC1 NOW HAS CHAN #
	MOVE	2,3		;DUPLICATE AC'S
	IMUL	2,CHK		;OFFSET INTO BUFFERED AREA
	ADDI	2,LOGBUF	;ADD BASE ADDR OF BUFFER
	MOVE	1,ICWA0(1)	;FETCH THE ICWA AGAIN
	ADD	1,CBASE		;ADD IN THE EPT BASE ADDR
	MOVE	0,1		;NOW HAVE THE ICW POINTER 
	PNT3			;PRINTS THE ICW ADDRESS
	TEXT	[ASCIZ/   /]
	SKIPE	SHMODE		;SHORT PRINTOUT MODE ?
	JRST	ICWPX		;YES
	MOVE	CONSW		;GET THE SWITCHES
	TLNN	TXTINH		;NORMAL OR SHORT PRINTOUT ?
	XLIST
	IFN	RH20,<
	LIST
	TEXT	[ASCIZ/ICW: /] ;NORMAL
	XLIST
	>
	IFN	RH10,<
	LIST
	TEXT	[ASCIZ/INITIAL CONTROL WORD: /]
	XLIST
	>
	LIST
ICWPX:	MOVE	(2)		;FETCH THE INITIAL CW
	PNTHW			;AND PRINT IT
	PCRL	
	RTN			;AND EXIT
	XLIST
	IFN	RH20,<
	LIST

;THE RH20 STATUS WORD-1 PRINTER

LOSPT:	ADDI	1,1		;BUMP THE POINTER CORRECTLY
	ADDI	2,1		;BUMP BUFFER POINTER
	MOVE	0,1		;TO 0 FOR PRINTING
	PNT3			;PRINT SW1 ADDRESS
	TEXT	[ASCIZ/   /]
	SKIPE	SHMODE		;SHORT PRINTOUT MODE ?
	JRST	.+4		;YES
	MOVE	CONSW		;GET CONSOLE SWITCHES
	TLNN	TXTINH		;NORMAL OR SHORT PRINTOUT
	JRST	LOSPT1		;NORMAL
	MOVE	(2)		;FETCH SW1
	PNTHW			;PRINT SW1
	JRST	LOSPT2
LOSPT1:	TEXT	[ASCIZ/SW1: /]
	PUT	2		;SAVE AC'S
	PUT	1
	MOVE	1,(2)		;GET SW1 TO AC1 FOR TYPBIT
	MOVEI	2,LOSTBL	;GET THE BIT TABLE ADDRESS
	GO	TYPBIT		;PRINT THE SIXBIT DATA STUFF
	TEXT	[ASCIZ/CLP POINTS TO: /]
	LDB	[POINT 22,1,35]	;FETCH THE ACTUAL CLP ADDRESS
	GO	POCT		;PRINT IN OCTAL
	GET	1		;RECOVER THE SAVED AC
	GET	2
LOSPT2:	PCRL			;PRINT A CRLF
	RTN			;AND EXIT
	XLIST
	>
	LIST

;PRINT TERMINATION WORD FROM THE LOGOUT AREA

TCWPT:	ADDI	2,1		;BUMP BUFFER POINTER
	ADDI	1,1		;ADJUST THE POINTER 
	MOVE	0,1		;TO 0 FOR PRINTING
	PNT3			;PRINT IT
	TEXT	[ASCIZ/   /]
	SKIPE	SHMODE		;SHORT PRINTOUT MODE ?
	JRST	.+4		;YES
	MOVE	CONSW		;GET THE CONSOLE SWITCHES
	TLNN	TXTINH		;NORMAL OR SHORT PRINTOUT
	JRST	TCWPT1		;NORMAL
	MOVE	(2)		;SHORT. GET THE WORD
	PNTHW			;PRINT IT
TCWPT2:	PCRL			;PRINT A CRLF
	RTN			;AND EXIT
	XLIST
	IFN	RH20,<
	LIST
TCWPT1:	TEXT	[ASCIZ/LAST UPDATED CCW: /]
	MOVE	(2)		;FETCH LAST CCW
	PNTHW			;PRINT IT
	TEXT	[ASCIZ/   +WC=/]
	LDB	[POINT	11,(2),13] ;GETS WORD COUNT
	GO	PSDN		;PRINT IT IN DECIMAL
	TEXT	[ASCIZ/  ADR=/]
	LDB	[POINT	22,(2),35] ;GETS ADDRESS
	GO	POCT		;PRINT IT IN OCTAL
	JRST	TCWPT2
	XLIST
	>
	IFN	RH10,<
	LIST
TCWPT1:	TEXT	[ASCIZ/WRITTEN CONTROL WORD: /]
	MOVE	(2)		;FETCH IT
	PNTHW			;PRINT IT
	TEXT	[ASCIZ/  CWA=/]
	HLR	(2)		;ASSUME 18 BIT DF10
	SKIPE	DF22FG(3)	;SEE IF 18 OR 22 BIT DF10
	LSH	-4		;22 BIT DF10. REPOSITION
	GO	POCT		;PRINT IN OCTAL
	TEXT	[ASCIZ/  DA=/]
	LDB	[POINT	22,(2),35] ;GET 22 BIT ADDRESS
	SKIPN	DF22FG(3)	;SEE IF 18 OR 22 BIT DF10
	HRRZ			;18 BIT DF10
	GO	POCT		;PRINT THE ADDR IN OCTAL
	JRST	TCWPT2
	XLIST
	>
	LIST

	XLIST
	IFN	RH10,<
	LIST

; ROUTINE TO CHECK FOR A DAS-33 AND PRINT ITS
; LOGOUT DATA IN THE PROPER PRINTOUT MODES

DASPNT:	SKIPN	1(2)		;CHECKS INAD+2
	RTN			;ZERO. NOT A DAS-33

	TEXT	[ASCIZ/   DAS-33  EXTENDED STATUS
/]
	PUT	4		;SAVE AC'S
	HRLZI	4,-^D8		;-COUNT,,0


DASPL:	AOS	1		;BUMP THE PHYSICAL ADR POINTER
	AOS	2		;BUMP THE BUFFER POINTER
	HLRZ	0,INADTB(4)	;FETCH SHORT PRINTOUT ROUTIN EADR
	GO	@0		;PRINT IN OCTAL
	MOVE	0,CONSW		;GET CONSOLE SWITCH STATUS
	TLNE	0,TXTINH	;WANT SHORT PRINTOUT ONLY ?
	JRST	DASPL1		;YES
	SKIPE	SHMODE		;SHORT PRINTOUT MODE ?
	JRST	DASPL1		;YES
	HRRZ	0,INADTB(4)	;NO. GET LONG PRINT ROUTINE ADR

	PUT	3		;SAVE SOME AC
	PUT	1
	GO	CHSEL		;GET LOGICAL CHAN NUMBER
	MOVE	3,1		;GET IT TO AC3
	GET	1		;RESTORE AC1
	PUT	4		;SAVE AC4
	GO	@0		;TO PROPER PRINT ROUTINE
	GET	4		;RESTORE THE AC'S
	GET	3

DASPL1:	PCRL
	AOBJN	4,DASPL		;LOOP FOR ALL WORDS
	GET	4
	RTN			;AND EXIT


;TABLE OF PRINT ROUTINE ADDRESSES FOR DAS-33 EXT STATUS
;C(LEFT)= POINTER TO SHORT PRINTOUT ROUTINE
;C(RIGHT)= POINTER TO LONG PRINTOUT ROUTINE

INADTB:	INADS,,INAD2		;ICWA+2
	INADS,,INAD3		;ICWA+3
	INADS,,INAD4		;ICWA+4
	INADS,,INAD5		;ICWA+5
	INADS,,INAD6		;ICWA+6
	INADS,,INAD7		;ICWA+7
	INADS,,INAD8		;ICWA+8
	INADS,,INAD9		;ICWA+9

;PRINT DAS-33 STATUS IN SHORT PRINTOUT MODE

INADS:	PUT	1		;SAVE THE AC
	MOVE	0,1		;GET THE ADDRESS
	PNT3			;PRINT IT
	GO	.TAB		;TAB OVER
	MOVE	0,(2)		;FETCH THE DATA WORD
	PNTHW			;PRINT IT IN OCTAL
	GET	1		;RESTORE THE AC
	RTN
	XLIST
	>
	LIST

	XLIST
	IFN	RH10,<
	LIST

;ROUTINES TO PRINT DAS-33 EXTENDED STATUS IN LONG PRINTOUT MODE
;UPON ENTRY TO EACH, THE AC'S ARE AS FOLLOWS
;	AC0,AC4		FREE FOR USE
;	AC1		PRINTS TO PHYSICAL ADDRESS
;	AC2		PRINTS TO LOGOUT BUFFER AREA
;	AC3		LOGICAL CHANNEL NUMBER

INAD2:	TEXT	[ASCIZ/	INAD+2
	TEN MEMORY REG	= /]
	MOVE	0,(2)		;FETCH DATA
	PNTHW			;PRINT IT
	RTN			;EXIT

INAD3:	TEXT	[ASCIZ/	INAD+3
	MEM CTRL WD ADR	= /]
	GO	PLEFT		;PRINT LEFT IN OCTAL
	TEXT	[ASCIZ/
	MEMORY ADDRESS	= /]
	GO	PRIGHT		;PRINT RIGHT IN OCTAL
	RTN

INAD4:	TEXT	[ASCIZ/	INAD+4
	CH CTRL WD ADR	= /]
	GO	PLEFT		;PRINT LEFT IN OCTAL
	TEXT	[ASCIZ/
	CH DATA ADDRESS	= /]
	GO	PRIGHT		;PRINT RIGHT IN OCTAL
	RTN

INAD5:	TEXT	[ASCIZ/	INAD+5
	CHAN WORD COUNT	= /]
	HLRE	0,(2)		;FETCH LEFT DATA
	SKIPE	DF22FG(3)	;22 BIT DF
	IOR	0,[-1,,740000]	;YES ADJUST COUNT
	GO	PSDN		;PRINT WC IN DECIMAL
	TEXT	[ASCIZ/
	MEM WORD COUNT	= /]
	HRRE	0,(2)		;FETCH THE RIGHT SIDE DATA
	SKIPE	DF22FG(3)	;22 BIT DF
	IOR	0,[-1,,740000]	;YES
	GO	PSDN		;PRINT WC IN DECIMAL
	RTN

INAD6:	TEXT	[ASCIZ/	INAD+6
	CHAN DATA REG	= /]
	MOVE	0,(2)		;FETCH DATA
	PNTHW			;PRINT HALF WORD
	RTN

INAD7:	TEXT	[ASCIZ/	INAD+7
	AUX TRANS REG	= /]
	MOVE	0,(2)		;FETCH DATA
	PNTHW			;PRINT IT
	RTN

INAD8:	TEXT	[ASCIZ/	INAD+8
	TEN RAM ADR REG	= /]
	LDB	0,[POINT 8,(2),8]
	PNT3
	TEXT	[ASCIZ/
	CHAN RAM AD REG	= /]
	LDB	0,[POINT 8,(2),17]
	PNT3
	TEXT	[ASCIZ/
	TRAOV = /]
	LDB	0,[POINT 1,(2),0]
	PNT1
	TEXT	[ASCIZ/CRAOV = /]
	LDB	0,[POINT 1,(2),9]
	PNT1
	TEXT	[ASCIZ/
	AUX CTRL WD REG = /]
	HRRZ	0,(2)
	PNT6
	RTN

INAD9:	TEXT	[ASCIZ/	INAD+9
	CHAN RAM ADDR	= /]
	LDB	0,[POINT 4,(2),17]
	PNT2
	TEXT	[ASCIZ/
	CLS RAM ADDR	= /]
	LDB	0,[POINT 4,(2),23]
	PNT2
	TEXT	[ASCIZ/
	INITIAL CW ADR	= /]
	LDB	0,[POINT 8,(2),34]
	LSH	0,1
	PNT3
	TEXT	[ASCIZ/
	DEVICE RD  = /]
	LDB	0,[POINT 1,(2),24]
	PNT1
	TEXT	[ASCIZ/
	INAD CYCLE = /]
	LDB	0,[POINT 1,(2),26]
	PNT1
	TEXT	[ASCIZ/
	INAD SYNCH = /]
	LDB	0,[POINT 1,(2),35]
	PNT1
	MOVE	0,(2)
	TLNE	0,(1B0)
	TEXT	[ASCIZ/
	00 CHAN ABORT CONDITION/]
	TLNE	0,(1B1)
	TEXT	[ASCIZ/
	01 INAD ERROR/]
	TLNE	0,(1B2)
	TEXT	[ASCIZ/
	02 NXM ERROR/]
	TLNE	0,(1B3)
	TEXT	[ASCIZ/
	03 CONTROL WORD P.E./]
	TLNE	0,(1B4)
	TEXT	[ASCIZ/
	04 MEM DATA P.E./]
	TLNE	0,(1B5)
	TEXT	[ASCIZ/
	05 MEM CTRL HUNG/]
	TLNE	0,(1B6)
	TEXT	[ASCIZ/
	06 NO READ RESTART/]
	TLNE	0,(1B7)
	TEXT	[ASCIZ/
	07 DDS ADR CHK ERROR/]
	TLNE	0,(1B8)
	TEXT	[ASCIZ/
	08 DDS CTRL HUNG/]
	TLNE	0,(1B9)
	TEXT	[ASCIZ/
	09 DDS TO CDR P.E./]
	TLNE	0,(1B10)
	TEXT	[ASCIZ/
	10 DDS TO TMR P.E./]
	TLNE	0,(1B11)
	TEXT	[ASCIZ/
	11 CHAN DATA P.E./]
	TLNE	0,(1B12)
	TEXT	[ASCIZ/
	12 CMD LIST STORAGE ADR ERROR/]
	TLNE	0,(1B13)
	TEXT	[ASCIZ/
	18 MEM WC OVERFLOW/]
	TRNE	0,1B19
	TEXT	[ASCIZ/
	19 CHAN OVERFLOW/]
	RTN

PLEFT:	HLRZ	0,(2)		;FETCH LEFT SIDE DATA
	SKIPE	DF22FG(3)	;22 BIT MODE
	LSH	0,-4		;NO. ADJUST
	PNT6			;PRINT IT
	RTN			;AND EXIT

PRIGHT:	LDB	0,[POINT 22,(2),35]	;FETCH RIGHT
	SKIPN	DF22FG(3)	;22 BIT DF
	ANDI	0,777777	;NO. SAVE ONLY 18 BITS
	GO	POCT		;PRINT IN OCTAL
	RTN

	XLIST
	>
	LIST


	XLIST
	BOX	<CHANNEL COMMAND LIST PRINTER>,<
	RUNS THROUGH CORE PRINTING THE COMMAND LIST FOR A PARTICULAR
	TRANSFER.

	EG.	MOVE	AC1,ARG		;#COMMAND WDS,,ADDR OF FIRST
		GO	CCWPNT		;PRINT
		RETURN			;AND RETURN

	AC1:
	IF AC1 IS 0 WHEN CALLED, RETURN IS IMMEDIATE
	SPECIFY (AC1)R ADDRESS OF FIRST COMMAND WORD
	SPECIFY (AC1)L # OF WORDS IN THE LIST
	(THESE PARAMS WERE RETURNED WHEN GENCCW WAS CALLED)  >

	;FUNCTIONS OF THE AC' IN CCWPT ROUTINE
	;AC	FUNCTION
	;--	--------
	;0	USED FOR PRINTING
	;1	HOLDS THE CURRENT CCW
	;2	A SCRATCH AC
	;3	POINTER TO THE MOST CURRENT CCW
	;4	COUNTER. INITED TO EXPECTED # OF CCW'S +5
	;	IN CASE OF A RUNAWAY CCW LIST.
	

CCWPNT:	JUMPE	1,[RTN]		;EXIT IF AC1 IS ZERO
	PUT	0		;SAVE THE AC'S
	PUT	1
	PUT	2
	PUT	3
	PUT	4
	HRRZ	3,1		;SET UP THE INITIAL POINTER
	HLRZ	4,1		;FETCH THE INITIAL COUNT
	ADDI	4,5		;ADJUST IT BY 5
	TEXT	[ASCIZ/CCW'S   CHAN-/]
	GO	CHSEL		;GET CHAN # TO AC1
	MOVE	0,1		;NOW TO AC0
	PNT1			;PRINT IT
	PCRL			;PRINT A CRLF
	SKIPE	SHMODE		;SHORT PRINTOUT MODE ?
	JRST	.+4		;YES
	MOVE	CONSW		;GET THE CONSOLE SWITCHES
	TLNN	TXTINH		;NORMAL OR SHORT PRINTOUT
	JRST	CCWPT1		;NORMAL
	TEXT	[ASCIZ/ LOC       CCW
 ---       ---
/]
	JRST	CCWPT2
CCWPT1:	TEXT	[ASCIZ/ LOC      +WC       ADR       MISC.
 ---      ---       ---       -----
/]
	JRST	CCWPT2
CCWPT2:	MOVE	1,@3		;FETCH CURRENT CCW FROM LIST
	GO	CCWINT		;GO INTERPRET THE CCW AN PRINT
	XLIST
	IFN	RH20,<
	LIST
	LDB	[POINT 3,1,2]	;FETCH CTRL PART OF THE CCW
	CAIE	2		;IS IT A JUMP CCW ??
	JRST	TLASTW		;NO
	LDB	3,[POINT 22,1,35] ;UPDATE POINTER 
	JRST	CCWPT3		;GO UPDATE THE COUNT
TLASTW:	JUMPE	CCWPT4		;(0-2)=000 MEANS HALT
	LSH	-1
	CAIN	3		;(0-2) 110 OR 111 IS LST XFER CCW
	JRST	CCWPT4
	ADDI	3,1		;BUMP THE POINTER
	JRST	CCWPT3		;GO UPDATE THE COUNT
	XLIST
	>
	IFN	RH10,<
	LIST
	JUMPE	1,CCWPT4	;IS IT A HALT CCW ??
	PUT	1		;SAVE THE AC
	GO	CHSEL		;CHAN # TO AC1
	MOVE	2,1		;NOW TO AC2
	GET	1		;RESTORE THE AC
	HLRZ	0,1		;FETCH THE WORD COUNT FIELD
	SKIPE	DF22FG(2)	;18 OR 22 BIT DF10 ??
	LSH	-4		;22 BIT.  POSITION THE COUNT
	JUMPN	FNDNJ		;TEST FOR A JUMP CCW
	LDB	3,[POINT 22,1,35] ;YES.PICK UP THE ADDRESS
	SKIPN	DF22FG(2)	;18 OR 22 BIT DF10 ??
	HRRZ	3,3		;18 BIT DF10
	JRST	CCWPT3	
FNDNJ:	ADDI	3,1		;BUMP THE POINTER
	JRST	CCWPT3		;GO ADJUST THE COUNT
	XLIST
	>
	LIST
CCWPT3: SOJG	4,CCWPT2	;COUNT TE WORD JUST PROCESSED
	TEXT	[ASCIZ/CCW LIST IS TOO L  O   N    G . . ./]
CCWPT4:	PCRL	
	SKIPE	SHMODE		;SHORT PRINTOUT MODE ?
	JRST	.+4		;YES
	MOVE	CONSW		;GET THE CONSOLE SWITCHES
	TLNN	TXTINH		;NORMAL OR SHORT PRINTOUT ??
	PCRL	
	GET	4		;RESTORE THE AC'S
	GET	3
	GET	2
	GET	1
	GET	0
	RTN			;AND EXIT

;ROUTINE TO INTERPRET THE CHANNEL COMMAND WORD IN AC1

CCWINT:	MOVE	0,3		;GET THE POINTER
	XLIST
	IFN	REALTIME,<
	LIST
	SKIPE	USER
	ADD	0,RELOC		;RELOCATE ADDRESS
	XLIST
	>
	LIST
	PNT6			;PRINT IT
	TEXT	[ASCIZ/  /]
	SKIPE	SHMODE		;SHORT PRINTOUT MODE ?
	JRST	.+4		;YES
	MOVE	CONSW		;GET THE SWITCHES
	TLNN	TXTINH		;MORMAL OR SHORT PRINTOUT ??
	JRST	CCWI1		;NORMAL
	MOVE	0,1		;SHORT. GET THE CCW
	PNTHW			;PRINT IT
CCWIX:	PCRL			;PRINT A CRLF
	RTN			;AND EXIT
	XLIST
	IFN	RH20,<
	LIST
CCWI1:	TLNE	1,(1B0)		;IS IT AN OP-DATA CCW
	JRST	CCWI1A		;YES
	TEXT	[ASCIZ/000000 /]
	PCRL
	JRST	CCWI2
CCWI1A:	LDB	[POINT 11,1,13]	;GET THE WORD COUNT
	PNT6			;PRINT IT IN OCTAL
CCWI2:	TEXT	[ASCIZ/   /]
	LDB	[POINT 22,1,35]	;GET THE ADDRESS PORTION 
	PNTADR			;PRINT IT
	TEXT	[ASCIZ/  /]
	TLNN	1,(1B0)		;IS IT AN OP-DATA CCW
	JRST	CCWI2A		;NO
	MOVEI	2,CCWTBL	;YES. GERT TBL ADDR
	GO	TYPBIT		;TYPE OPTION BITS IN SIXBIT
	JRST	CCWIX		;THEN EXIT
CCWI2A:	LDB	[POINT 3,1,2]	;GET THE CONTROL BITS OF THE CCW
	JUMPE	.+3		;JUMP IF A HALT WORD
	TEXT	[ASCIZ/JUMP-WD/]
	JRST	CCWIX		;EXIT 
	TEXT	[ASCIZ/HALT-WORD/]
	JRST	CCWIX
	XLIST
	>
	IFN	RH10,<
	LIST
CCWI1:	JUMPN	1,CCWI1A	;IS IT A HALT WORD
	MOVEI	6		;YES. DO SOME FORMATTING
	GO	MZERO
	TEXT	[ASCIZ/   /]
	MOVEI	^D8
	GO	MZERO
	TEXT	[ASCIZ/   HALT-WORD/]
	JRST	CCWIX		;TO EXIT CODE
CCWI1A:	PUT	1		;SAVE THE AC
	GO	CHSEL		;CHAN # TO AC1
	MOVE	2,1		;NOW TO AC2
	GET	1		;RESTORE THE AC
	HLRZ	0,1		;GET THE WORD COUNT
	SKIPE	DF22FG(2)	;18 OR 22 BIT DF10
	LSH	-4		;22 BIT DF10
	JUMPN	CCWI2		;IS IT A JUMP WORD ??
	MOVEI	6		;YES. SOME FORMATTING
	GO	MZERO
	TEXT	[ASCIZ/   /]
	LDB	[POINT 22,1,35]	;GET THE 22 BIT ADDRESS
	SKIPN	DF22FG(2)	;18 OR 22 BIT DF10
	HRRZ	0,0		;18 BIT
	PNTADR			;22 BIT. PRINT IT.
	TEXT	[ASCIZ/  JMP-WORD/]
	JRST	CCWIX		;TIME TO EXIT
CCWI2:	HLRE	0,1		;GET THE WORD COUNT
	SKIPN	DF22FG(2)	;18 OR 22 BIT DF10
	JRST	CCWI2A		;18 BIT
	LSH	-4		;22 BIT DF
	HRRE	0,0		;NOW HAVE THE CORRECT WORD COUNT
CCWI2A:	MOVM	0,0		;TAKES THE ABSOLUTE VALUE
	PNT6			;PRINT POS WC IN OCTAL
	TEXT	[ASCIZ/  /]
	LDB	[POINT 22,1,35]	;GET THE ADDRESS
	SKIPN	DF22FG(2)	;18 OR 22 BIT DF10
	HRRZ	0,0		;18 BIT
	ADDI	0,1		;REAL ADDRESS
	PNTADR			;PRINT THE ADDR IN OCTAL
	JRST	CCWIX		;AND EXIT
	XLIST
	>
	LIST

	XLIST
	BOX <CHSEL - - ROUTINE TO GET THE CHAN # FROM MBCN>,<
	THIS ROUTINE BIT DIDDLES THE DEVICE CODE IN MBCN AND 
	TRANSLATES IT TO A LOGICAL CHANNEL NUMBER. THE
	CHANNEL NUMBER IS RETURNED RIGHT JUSTIFIED IN AC1. >

CHSEL:	LDB	1,[POINT 3,MBCN,9] ;GET BASIC 3 BITS
	XLIST
	IFN	RH10,<
	LIST
	TLNN	MBCN,(1B5)	;UPPER OR LOWER GROUP
	SUBI	1,4		;LOWER
	SUBI	1,2		;UPPER
	XLIST
	>
	LIST
	RTN			;AND EXIT CHAN # IN AC1

	XLIST
	IFN	RH10,<
	BOX	<SWEEP - - ROUTINE TO SWEEP CACHE IF KL10-RH10>,<
	THIS ROUTINE IS USED TO SWEEP CACHE WHEN WE HAVE AN RH10
	CONFIGURED TO A KL PROCESSOR. THIS IS NECESSARY SO THAT MEMORY
	DATA WILL BE VALID WHEN THE RH10 STARTS THE TRANSFER.

	CALLING SEQ:
	GO	SWEEP		;CALL THE ROUTINE
	RTN			;RETURNS HERE >

SWEEP:	SKIPE	USER
	RTN
	SKIPL	KLFLG		;SKIP IF WE ARE A KL10
	RTN			;NOT A KL. MAY RETURN
	PUT	0		;SAVE AC0
	700000,,0		;THIS INSTR GETS KL CPU STATUS
	TRNN	0,1B19		;DOES CACHE EXIST ?
	JRST	SWEEP3		;NO. RESTORE AND EXIT
	PUT	1		;SAVE OTHER AC'S
	PUT	2
	PUT	3
	PUT	4
	MOVE	0,[701540,,0]  ;A CACHE SWEEP COMMAND TO AC0
	CONI	APR,4		;GET APR STATUS
	ANDI	4,7		;SAVE LOW ORDER 3 BITS
	TRO	4,40020		;SET UP APR FOR SWEEP INTERUPT
	CONO	APR,(4)		;APR NOW READY
	MOVE	1,[CONSZ LCASWB] ;BUILD AN AC LOOP FOR SWEEP DONE
	MOVE	2,[SOJN 4,1]
	MOVE	3,[JRST SWEEP1]
	MOVEI	4,-1		;A GROSS TIMER
	JRST	0		;JUMP INTO THE AC LOOP

SWEEP1:	JUMPG	4,SWEEP2	;DID WE TIME OUT ?
	TEXTF	[ASCIZ/

CACHE SWEEP FAULT - - TIMED OUT !

/]
	FATAL

SWEEP2:	GET	4		;RESTORE THINGS
	GET	3
	GET	2
	GET	1
SWEEP3:	GET	0
	RTN			;AND RETURN
	XLIST
	>
	LIST

SUBTTL	USER MODE SUPPORT ROUTINES
	XLIST
	BOX	<DSETUP -- SETUP ROUTINE FOR DIAGNOSTIC FUNCTION>,<
	THIS ROUTINE SETS UP A LOCATION CALLED ".DIAG" WITH THE
	APPROPRIATE JSYS OR UUO FOR A DIAGNOSTIC MONITOR CALL.
	TWO MONITOR TYPES ARE PRESENTLY KNOWN 1=TOPS, 4=SNARK.
	THE MONITOR TYPE IS FOUND IN BITS 21-23 OF MONITOR TABLE-11,
	ENTRY-112.  THIS INFORMATION IS RETRIEVED BY EXECUTING A
	GETTAB UUO WHICH NEVER FAILS. ".DIAG" IS SET UP SO THAT
	THE AC FIELD IS 1 (MEANS AC1 IS USED FOR ARGUMENT POINTER)

	CALLING SEQ:
	GO	DSETUP		;CALL THE ROUTINE
	RETURN			;RETURNS + 1 ALWAYS>

.UUO:	047000,,163		;CALLI AC,163 FOR TOPS
.JSYS:	104000,,530		;JSYS AC,530 FOR SNARK
.DIAG:	JRST	NOSET		;A DEFAULT ERROR REPORTER

DSETUP:	SKIPN	USER		;USER MODE?
	RTN			;NO. THEN EXIT
	PUT	0		;SAVE AC0
	MOVE	0,[112,,11]	;ENTRY-112,,TABLE-11
	GETTAB			;A GETTAB UUO
	FATAL			;GETTABS CAN'T FAIL
	LDB	0,[POINT 3,0,23]  ;GET MONITOR TYPE FIELD
	SETZM	SNARKF#		;INIT SNARK FLAG TO 1
	AOS	SNARKF
	CAIN	0,1		;TYPE = 1
	JRST	TPSMON		;YES. TOPS MONITOR
	CAIN	0,4		;TYPE = 4
	JRST	SNKMON		;YES. SNARK MONITOR

;UNRECOGNIZED MONITOR TYPE

	TEXTF	[ASCIZ/
CAN'T RUN UNDER THIS MONITOR. TYPE = /]
	PNT1F
	TEXTF	[ASCIZ/
TYPE COMES FROM BITS 21-23 OF TABLE-11, ENTRY-112. (1&4) ARE ALLOWED.

/]
	FATAL

;SNARK MONITOR FOUND

SNKMON:	MOVE	0,.JSYS		;GET APPROPRIATE JSYS
	JRST	TPSMON + 2	;TO COMMON CODE

;TOPS MONITOR FOUND

TPSMON:	SETZM	SNARKF		;CLEAR SNARK FLAG
	MOVE	0,.UUO		;GET APPROPRIATE UUO
	TLO	0,(1B12)	;1 INTO AC FIELD
	MOVEM	0,.DIAG		;MOVE INTO EXECUTE LOCATION
	SKIPN	SNARKF		;TPOS-20 MONITOR??
	JRST	SMX		;NO
	104000,,310		;SET USER PIV (JSYS 310)
	JRST	NOPRIV		;USER HAS NO PRIV FOR DIAG.
	JRSTF@	.+1		;NOW TURN THE IOT PRIV OFF
	010000,,.		;MODIFIES THE PC WORD
SMX:	GET	0		;RESTORE THE AC
	RTN			;EXIT

NOPRIV:	TEXTF	[ASCIZ/
USER DOES NOT HAVE PROPER PRIV. TO RUN THIS PROGRAM !!
/]
	MOVEI	1,101		;SPECIFT TERMINAL AS DESTINATION
	MOVE	2,[400000,,-1]	;SPECIFY THE HANDLE
	SETZM	3		;MUST BE CLEARED
	104000,,11		;DOES AN ERSTR JSYS
	104000,,170		;ERROR RTN .... HALTF
	104000,,170		;OTHER ERROR RTN .... HALTF
	FATAL			;THEN BACK TO THE MONITOR

;DEFAULT ERROR REPORTER IF WE TRY TO EXECUTE A
;DIAG FUNCTION WITH SETTING UP

NOSET:	TEXTF	[ASCIZ/

ATTEMPT TO EXECUTE A DIAGNOSTIC MONITOR CALL WITHOUT SETTING UP.
PGM BUG - - "DSETUP" MUST BE CALLED FIRST -  -  - - 


/]
	FATAL

	XLIST
	BOX	<USREL - DEVREL - DEVICE  RELEASE ROUTINE>,<
	IN USER MODE THIS ROUTINE ISSUES
	A DIAGNOSTIC MONITOR CALL, FUNCTION - 3, TO RETURN DEVICE
	TO MONITOR RESOURCES. DEVICE IS SPECIFIED BY "DIAGCR"
	AND "DRIVE". "DIAGCR" WAS SET UP BY THE REQUEST ROUTINE.
	UPON RETURN, "DIAGCR" WILL BE SET TO ZERO.


	CALLING SEQ:
	GO	USREL	(OR)	GO	DEVREL
	RETURN			;RETURNS +1 ALWAYS>

USREL:
DEVREL:	SKIPN	DIAGCR#		;YES. ALREADY HAVE DEVICE
	RTN			;NO. THEN EXIT
	PUT	1		;SAVE AC1
	EXCH	MBCN,DIAGCR	;ACTUALLY RELEASE THE DIAGCR ONE
	XLIST
	IFN	RH20,<
	LIST
	MOVEI	1,1B24!1B27!1B31 ;RAECLR+MBE+STOP
	GO	.CONO		;CLEAR CONDITIONS
	MOVEI	1,1B27!1B32	;MBE
	GO	.CONO		;CLEAR CONDITIONS
	XLIST
	>
	IFN	RH10,<
	LIST
	MOVEI	1,1B32		;DONCLR
	GO	.CONO		;CLEAR THE DONE FLOP
	XLIST
	>
	LIST
	SKIPN	USER		;USER MODE
	JRST	RELEX		;NO. THEN WE'RE DONE
	MOVEI	1,1		;A SINGLE BIT
	LSH	1,(DRIVE)	;SHIFI TO PSEUDO POSITION
	GO	LDRG04		;CLEAR ATA'S
	JFCL			;RAE CAN NOT OCCUR
	MOVE	1,REQARG+1	;GET THE DEVICE LAST REQUESTED
	MOVEM	1,RELARG+1	;SAVE IN ARGUMENT LIST
	MOVE	1,[-2,,RELARG]	;POINTER USED
	XCT	.DIAG		;EXECUTE DIAG FUNCTION
	GO	DIAGER		;ERROR
RELEX:	GET	1		;NO ERROR
	EXCH	MBCN,DIAGCR	;NOW RESTORE ORIGINAL RH
	SETZM	DIAGCR		;NOW POSSES NO CONTROLLERS
	SKIPN	SNARKF		;TOPS-20
	RTN			;NO. THEN EXIT.
	JRSTF@	.+1		;YES. TURN OFF USER IOT
	010000,,.+1		;SETS FLAGS
	RTN			;EXIT

;ARGUMENT LIST FOR RELEASE COMMAND

RELARG:	3			;FUNCTION
	Z			;RESERVED FOR DEVICE ADR WORD

	XLIST
	BOX	<USREQ - DEVREQ -- USER MODE REQUEST ROUTINE>,<
	DOES NOTHING IN EXEC MODE. IN USER MODE, THIS ROUTINE
	EXECUTES A DIAGNOSTIC MONITOR CALL OF FUNCTION 2 TO
	REQUEST A CONTROLLER AND ALL DRIVES FROM THE
	MONITOR. THE DEVICE IS SPECIFIED IN "MBCN" AND "DRIVE".
	THE DEVICE WHICH IS REQUESTED GOES TO "DIAGCR" SO THE
	RELEASE ROUTINE KNOWS ABOUT IT.

	NOTE:- THE FUNCTION "MUST" BE 2 AND "NOT" 1. IF YOU USE FUNCTION
	1 AND YOU'VE GOT BROKEN HARDWARE SUCH THAT THE MONITOR CANNOT
	DETECT THE DRIVE, THE DIAG CALL WILL BE REJECTED AND THE ERROR
	CODE FOR "NO SUCH DRIVE" WILL BE RETURNED.

	FAIRNESS:
	A RELEASE IS ISSUED BEFORE EVERY DEVICE REQUEST TO
	GUARANTEE THAT WE TAKE THE DEVICE FOR SHORT PERIODS OF TIME.

	DROP DEAD TIME:
	THE DIAG REQUEST USING FUNCTION-2 IS AN UNTIMED REQUEST.
	THE ARGUMENT BLOCK HAS BEEN SET UP HOWEVER, FOR A 1 MIN.
	DROP DEAD TIME IN CASE THE MONITOR IS EVER CHANGED.

	CALLING SEQUENCE:
	GO	USREQ	(OR)	GO	DEVREQ
	RETURN			;RETURNS + 1 ALWAYS>

USREQ:
DEVREQ:	PUT	1		;SAVE AC1
	SKIPN	USER		;USER MODE
	JRST	REQEX		;NO. THEN EXIT

;FAIRNESS ALGORITHIM

	GO	DEVREL		;YES. - RELEASE DEVICE

;REQUEST CODE

	SKIPN	SNARKF		;TOPS-20 ?
	JRST	.+3		;NO
	104000,,310		;DOES A USRIO JSYS
	JRST	NOPRIV		;ERROR RETURN
	GO	DEV.AD		;BUILD DEVICE ADDRESS WORD
	MOVEM	1,REQARG+1	;PLACE IN ARGUMENT LIST
	MOVE	1,[-2,,REQARG]	;POINTER WORD
	XCT	.DIAG		;A DIAGNOSTIC CALL
	GO	DIAGER		;ERROR
REQEX:	MOVEM	MBCN,DIAGCR	;FLAG DEVICE
	XLIST
	IFN	RH20,<
	LIST
	MOVEI	1,1B27		;MASBUS ENABLE
	GO	.CONO		;DO A CONO
	XLIST
	>
	LIST
	GET	1		;RESTORE THE AC
	RTN			;EXIT


;ARGUMENT LIST FOR REQUEST COMMAND

REQARG:	2			;FUNCTION
	Z			;RESERVED FOR DEVICE ADDRESS
	^D1000*^D60*^D1		;1 MINUTES (IN MILLESECONDS)

	XLIST
	BOX	<DEV.AD -- BUILDS A DEVICE ADDR WORD FOR USER MODE>,<
	THIS ROUTINE BUILDS THE PROPER DEVICE ADDRESS WORD NECESSARY
	FOR THE DIAG MONITOR CALL. THE WORD IS RETURNED
	IN AC1 AND LOOKS LIKE THIS:

	BITS 00-06		RH PHYSICAL DEVICE CODE
	BITS 21-23		LOGICAL RH (0-7)
	BITS 27-29		DRIVE NUMBER (0-7)

	CALLING SEQ:
	GO	DEV.AD		;CALL THE ROUTINE
	RETURN			;ADR WORD IS IN AC1>

DEV.AD:	PUT	0		;SAVE AC0
	MOVE	0,MBCN		;GET DEVICE CODE
	SKIPN	SNARKF		;TOPS-20 MONITOR??
	LSH	0,3		;POSITION ALL THE WAY LEFT
	GO	CHSEL		;GET CHAN # TO AC1
	DPB	1,[POINT 3,0,23]  ;INCLUDE LOGICAL CHAN #
	DPB	DRIVE,[POINT 3,0,29]  ;INCLUDE DRIVE NUMBER
	MOVE	1,0		;NOW GET DEV ADR TO AC1
	GET	0		;RESTORE AC0
	RTN			;AND EXIT

	XLIST

	XLIST
	BOX	<CHPGM -- BUILDS A USER MODE CHANNEL PROGRAM>,<
	THIS ROUTINE IS USED TO BUILD A CHANNEL PROGRAM
	USING A DIAGNOSTIC MONITOR CALL. THIS ROUTINE IS
	SET UP TO OPERATE WITH UP TO 10 CHANNEL COMMAND WORDS
	ALTHOUGH MONITORS CAN HANDLE ONLY ONE.

	THIS ROUTINE EXPECTS AC1 TO BE SET UP IN THE
	FOLLOWING WAY:
	AC1(R) = POINTER TO FIRST WORD
	AC1(L) = # OF WORDS IN THE LIST (10 OR LESS)

	CALLING SEQ:
	MOVE	1,ARG		;# OF WORDS,,POINTER TO FIRST
	GO	CHPGM		;CALL THE ROUTINE
	RETURN			;RETURNS +1 ALWAYS>

CHPGM:	PUT	4		;SAVE AC'S
	PUT	3
	PUT	2
	PUT	0
	PUT	1

;GET THE LOGICAL CHAN # TO AC3

	GO	CHSEL		;CHAN # TO AC1
	MOVE	3,1		;NOW TO AC3

;RANGE CHECK THE WORD COUNT
	HLRZ	0,(P)		;GET COUNT
	CAILE	0,^D10		;LESS THAN OR EQUAL TO 10
	FATAL			;NO. FATAL

;WORD COUNT OK. SET UP POINTER & XFER TO ARGUMENT LIST
	SETZM	2		;CLEAR INDEX
	MOVN	1,0		;-CNT TO AC1
	HRLZ	1,1		;-CNT TO LEFT HALF
	HRR	1,(P)		;POINTER TO RIGHT HALF
CHPGM0:	MOVE	0,(1)		;FETCH A CCW
	XLIST
	IFN	RH10,<
	LIST
	SKIPN	DF22FG(3)	;HAVE TO ADJ IF 22-BIT DF
	JRST	CHPGM1		;NO

	HLRE	4,0
	LSH	4,-4
	HRLM	4,0
	XLIST
	>
	IFN	RH20,<
	LIST
	SKIPE	SNARKF		;TOPS-10 MONITOR??
	JRST	CHPGM1		;NO - MUST BE TOPS-20
	LDB	4,[POINT 11,0,13] ;YES - GET POS. WORD COUNT
	MOVNS	4		;NEGATE FOR TOPS-10
	HRLM	4,0		;STUFF IT BACK IN THE WORD
	XLIST
	>
	LIST
CHPGM1:	MOVEM	0,CHARG+2(2)	;PUT IN ARGUMENT LIST
	AOS	2		;BUMP STORE POINTER
	AOBJN	1,CHPGM0	;LOOP TILL DONE

;SET UP AN EXECUTE DIAG MONITOR CALL

	GO	DEV.AD		;GET DEVICE ADDRESS
	MOVEM	1,CHARG+1	;PUT IN ARGUMENT LIST
	ADDI	2,2		;AC2 NOW HOLDS # OF ARGUMENTS
	MOVN	2,2		;MAKE IT NEGATIVE
	HRLZ	1,2		;-COUNT TO LEFT HAND SIDE AC1
	HRRI	1,CHARG		;POINTER TO ARGLIST
	XCT	.DIAG		;DIAG MONITOR CALL
	GO	DIAGER		;ERROR
	GET	1		;NO ERROR
	GET	0
	GET	2
	GET	3
	GET	4
	RTN

;ARGUMENT LIST FOR CHANNEL PROGRAM COMMAND

CHARG:	4			;FUNCTION CODE
	Z			;RESERVED FOR DEVICE ADDRESS WORD
	BLOCK	^D10		;RESERVED FOR CCW'S

	XLIST
	BOX	<DIAGGL -- GET LOGOUT AREA FROM MONITOR IN USER MODE>,<
	IN USER MODE, THIS ROUTINE EXECUTES A DIAGNOSTIC MONITOR CALL,
	FUNCTION -6, WHICH MOVES LOGOUT DATA TO THE ARGUMENT LIST.
	IN USER MODE, IT IS NOT POSSIBLE TO GET DAS-33 EXT STATUS.

	CALLING SEQ:
	GO	DIAGGL		;CALL ROUTINE
	RETURN			;DATA IS IN THE LIST>

DIAGGL:	PUT	1		;SAVE AC
	GO	DEV.AD		;GET DEVICE ADDRESS WORD
	MOVEM	1,LOGARG+1	;PUT IN ARGUMENT LIST
	MOVE	1,[-6,,LOGARG]	;A POINTER WORD
	XCT	.DIAG		;EXECUTE DIAGNOSTIC FUNCTION
	GO	DIAGER		;ERROR
	GET	1		;NO ERROR
	RTN			;EXIT

;ARGUMENT LIST FOR CHANNEL STATUS SNAPSHOT ROUTINE

LOGARG:	6			;FUNCTION
	Z			;RESERVED FOR DEVICE ADDR WORD
	BLOCK	4		;RESERVED FOR LOGOUT DATA

	XLIST
	BOX	<DIAGER -- REPORT MONITOR CALL ERROR IN USER MODE>,<
	THIS ROUTINE PRINTS AN ERROR MESSAGE STATING WHERE AND WHY
	A DIAGNOSTIC MONITOR CALL HAS FAILED AND THEN FATALS
	OUT FOR LACK OF ANYTHING MORE REASONABLE TO DO.

	CALLING SEQ:
	GO	DIAGER		;CALL THE ROUTINE
				;THERE IS NO RETURN>

DIAGER:	GO DEVREL		;RELEASE THE DEVICE
	JFCL			;A DEBUGGING AIDE LOCATION
	TEXTF	[ASCIZ/

ERROR RETURN FROM DIAGNOSTIC MONITOR CALL AT PC-/]
	HRR	0,(P)		;GET PC
	PNT6F			;PRINT IT
	TEXTF	[ASCIZ/
ERROR CODE=/]
	MOVE	0,1		;GET ERROR CODE
	PNT6F			;PRINT IT
	TEXTF	[ASCIZ/
/]
	SKIPN	SNARKF		;SNARK MONITOR ?
	JRST	TMON		;NO. TOPS.
	MOVE	0,1		;GET ERROR CODE TO AC0
	TRZ	0,377		;SAVE ONLY HIGH ORDER BITS
	CAME	0,[601000]	;IS THE CODE LEGAL
	JRST	SNKER		;NO. ??
	LDB	1,[POINT 8,1,35] ;GET LOW ORDER BITS OF ERROR CODE
	SUBI	1,174		;NORMALIZE
	CAIL	1,0		;RANGE TEST
	CAILE	1,^D8
SNKER:	SETOM	1		;TO -1
	AOS	1		;INCREMENT FOR INDEX INTO TBL
	TEXTF@	SNKTBL(1)	;OK. TO PRINT
	PCRLF
	FATAL


TMON:	TEXTF@	TOPTBL(1)	;PRINT TOPS 10 ERROR CODE
	PCRLF
	FATAL

;DIAG ERR MSGS FROM SNARK

SNKTBL:	[ASCIZ/UNRECOGNIZED ERROR CODE/]
	[ASCIZ/ARGUMENT COUNT FIELD IS NON NEGATIVE/]
	[ASCIZ/DEVICE ASSIGNED TO ANOTHER JOB/]
	[ASCIZ/ARGUMENT COUNT IS TO SMALL/]
	[ASCIZ/ILLEGAL RH TYPE SELECTED/]
	[ASCIZ/DEVICE NOT MOUNTED IN MAINT MODE/]
	[ASCIZ/BAD CCW/]
	[ASCIZ/CCW INDICATES THAT XFER WILL CROSS PAGE BOUNDARY/]
	[ASCIZ/NO SUCH CHANNEL/]
	[ASCIZ/NO SUCH DRIVE/]


;DIAG ERR MSGS FROM TOPS-10

TOPTBL:	[ASCIZ/UNRECOGNIZED ERROR /]
	[ASCIZ/USER DOES NOT HAVE PRIV./]
	[ASCIZ/DIAG ARGUMENT ERROR/]
	[ASCIZ/ILLEGAL CONTROLLER DEVICE CODE/]
	[ASCIZ/ILLEGAL DRIVE NUMBER/]
	[ASCIZ/DEVICE ALREADY ASSIGNED TO THIS JOB/]
	[ASCIZ/DEV NOT MOUNTED IN MAINT MODE/]
	[ASCIZ/DEV ASSIGNED TO ANOTHER JOB/]
	[ASCIZ/NO FREE CORE BLOCK IN MONITOR/]
	[ASCIZ/ISSUED "SETCHN" PGM WITHOUT AN ASSIGNED DEVICE/]
	[ASCIZ/CCW INDICATES XFER WILL CROSS PAGE BOUNDRY/]
	[ASCIZ/ILLEGAL FUNCTION SPECIFIED/]


SUBTTL	STORAGE FOR CHANNEL ROUTINE VAIRIABLES

	XLIST
	BOX	<SOME CHANNEL ROUTINE VARIABLES>,<
	HERE ARE THE CONDITIONAL (RH10/RH20) PARAMETERS
	NECESSARY FOR USE WITH THE DATA CHANNEL ROUTINES. >

; THE # OF WORDS (MAXIMUM) THAT WILL BE SPECIFIED IN A SINGLE
; CHANNEL CONTROL WORD. IF NOT AN EVEN MULTIPLE OF 128. DISK
; OVERRUNS COULD OCCUR.


	XLIST
	IFN	RH20,<
	LIST
MAXWD:	^D1920			;DEFAULT
CBASE:	000000			;A BASE FOR COMPUTING ICWA
				; THE 340000 CAUSES PAGING
JMPWD:	1B1			;A KL10 CHANNEL JUMP WORD
SCLP:	BLOCK	^D8		;8 SOFTWARE CLP'S
CINIT:	BLOCK	^D8		;8 CHANNEL INIT FLAGS
CADTBL:	BLOCK	^D8		;CCW BUFF PARAMS  LAST ADR,,FIRST ADR
LOGBUF:	BLOCK	^D32		;BUFFERED LOGOUT AREA
CHK:	4			;# OF LOGOUT WORDS PER CHANNEL
CHCNT:	-4,,LOGBUF		;USED BY GETLOG


;DEFINING INITIAL CONTROL WD ADDR FOR EACH CHANNEL

ICWA0:	0
ICWA1:	4
ICWA2:	10
ICWA3:	14
ICWA4:	20
ICWA5:	24
ICWA6:	30
ICWA7:	34

	XLIST
	>
	IFN	RH10,<
	LIST
MAXWD:	^D8192			;DEFAULT
CBASE:	000			;A BASE FOR COMPUTING ICWA
JMPWD:	Z			;A DF10 JUMP CCW
SCLP:	BLOCK	6		;6 SOFTWARE CLP'S
CINIT:	BLOCK	6		;6 CHANNEL INIT FLAGS
DF22FG:	BLOCK	6		;6 22-BIT DF10 FLAGS
CADTBL:	BLOCK	6		;CCW BUFF PARAMS LAST ADR,,FIRST ADR
LOGBUF:	BLOCK	^D60		;BUFFERED LOGOUT AREA
CHK:	^D10			;# OF LOGOUT WORDS PER CHANNEL
CHCNT:	-3,,LOGBUF		;USED BY GETLOG

;DEFINING INITAL CONTROL WORD ADDRESSES FOR THE CHANNELS

ICWA0:	100
ICWA1:	100
ICWA2:	100
ICWA3:	100
ICWA4:	100
ICWA5:	100

	XLIST
	>
	LIST

	SUBTTL REGISTER AND CONI PRINT ROUTINES
	XLIST
	BOX <CONI PRINTER AND REGISTER BIT PRINT ROUTINES>,<
	THERE ARE TWO MODES OF PROGRAM PRINTOUT: NORMAL (LONG)
	AND SHORT (TEXT INHIBIT SWITCH IS SET). THE NORMAL MODE
	INTERPRETS THE REGISTER BITS IN ENGLISH (SIXBIT FORMAT)
	WHILE THE SHORT PRINTOUT MODE PRINTS REGISTER AND
	CONI DATA IN HALFWORD OCTAL MODE.

	TO USE THE CONI PRINTER:
		MOVE	AC1,ARG		;FETCH CONI DATA
		GO	CONIPT		;PRINT IT
		RETURN

	TO USE THE REGISTER PRINTER:
		MOVE	AC1,ARG		;36 BIT DATAI WORD
		GO	REGPNT		;PRINT IT
		RETURN

	THE REGISTER PRINTER GETS THE REGISTER NUMBER AND DRIVE
	NUMBER FROM THE LEFT HALF OF THE DATAI WORD. 

	TO USE THE CHANNEL BUFFER PRINTER FOR THE RH10 (REG 74):
		MOVE	AC1,DATA	;36 BIT CHAN BUFF DATA
		RETURN
		GO	CBUFPT		;PRINT IT. >


CONIPT:	PUT	0		;SAVE AC'S
	PUT	2
	TEXT	[ASCIZ/CONI	/]
	LDB	0,[POINT 7,MBCN,9] ;GET THE DEVICE CODE
	LSH	2		;JUSTIFY FOR PRINTING
	GO	POCT		;PRINT IN OCTAL
	TEXT	[ASCIZ/: /]
	SKIPE	SHMODE		;SHORT PRINTOUT MODE ?
	JRST	.+4		;YES
	MOVE	0,CONSW		;GET THE CONSOLE SWITCHES
	TLNN	TXTINH		;LONG OR SHORT PRINTOUT
	JRST	CNIA		;NORMAL
	MOVE	0,1		;SHORT	 PRINTOUT
	PNTHW			;PRINT IN HALFWORD FORMAT
	JRST	CNIB
CNIA:	MOVEI	2,CNITBL	;POINTER TO SIXBIT NAME TABLE
	GO	TYPBIT		;PRINT BIT DATA
	TEXT	[ASCIZ/PIA=/]
	MOVE	0,1
	PNT1			;PRINT THE PI ADDRESS
	PCRL	
CNIB:	PCRL	
	GET	2
	GET	0
	RTN


	;ACCUMULATORS USED BY REGPNT . . 
	;AC	FUNCTION
	;--	--------
	;0	USED FOR PRINTING
	;1	HOLDS 36 BIT DATAI WORD
	;2	HOLDS REGISTER NUMBER
	;3	HOLDS VARIOUS TABLE POINTERS
	;4	SCRATCH AC
	

REGPNT:	PUT	0		;SAVE AC'S
	PUT	1
	PUT	2
	PUT	3
	PUT	4
	LDB	2,[POINT 6,1,5] ;FETCHES REGISTER NUMBER
	GO	RNAM		;PRINT REG NAME AND DEV CODE
	SKIPE	SHMODE		;SHORT PRINTOUT MODE ?
	JRST	.+4		;YES
	MOVE	CONSW		;GET SWITCHES
	TLNN	TXTINH		
	JRST	RPT1		;NORMAL PRINTOUT
	TEXT	[ASCIZ/: /]
	MOVE	0,1		;GET REGISTER DATA
	PNTHW			;HALFWORD FOR SHORT PRINTOUT
	JRST	RPT2
RPT1:	GO	DRPNT		;PRINT DRIVE IF EXTERNAL REG #
	GO	LFTBIT		;PRINT LEFT SIDE BITS
	GO	RITBIT		;PRINT RIGHT SIDE BITS
	GO	BYTES		;PRINT BYTE ORGANIZED DATA
NOBLNK:	JFCL
RPT2:	PCRL			;AND ANOTHER
	GET	4		;CLEAN UP
	GET	3
	GET	2
	GET	1
	GET	0
	RTN

;REGISTER SIXBIT NAME & DEVICE CODE PRINTER

RNAM:	CAILE	2,37		;REGISTER INTERNAL OR EXTERNAL
	JRST	RNAMI		;INTERNAL TO THE RHXX
	MOVEI	3,EXRNAM	;EXTERNAL. GET TBL POINTER
	ADD	3,2		;INDEX INTO THE TABLE
	JRST	RNAMC
RNAMI:	LDB	3,INRNDX	;CREATE INDEX INTO TABLE
	ADDI	3,INRNAM	;ADD TABLE BASE ADDRESS
RNAMC:	MOVE	(3)		;FETCH NAME FROM THE TABLE
	PNTSIX			;PRINT IT
	TEXT	[ASCIZ/	/]	;A TAB
	LDB	[POINT 7,MBCN,9] ;GET DEVICE CODE
	LSH	2		;JUSTIFY FOR PRINTING
	GO	POCT		;PRINT IN OCTAL
	RTN			;AND EXIT

;PRINT DRIVE NUMBER IF EXTERNAL REGISTER

DRPNT:	CAILE	2,37		;INTERNAL OR EXTERNAL REG
	JRST	DRPNT1
	TEXT	[ASCIZ/-/]
	LDB	[POINT 3,1,17]	;GET DRIVE NUMBER
	GO	POCT		;PRINT IT IN OCTAL
DRPNT1:	TEXT	[ASCIZ/: /]
	RTN

;PRINT LEFT SIDE OF EXTERNAL REGISTERS

LFTBIT:	CAILE	2,37		;INTERNAL OR EXTERNAL
	RTN			;INTERNAL REGISTER. EXIT
	PUT	2		;SAVE 	AC2
	MOVEI	2,LFTTBL	;GET TABLE ADDRESS
	GO	TYPBIT		;PRINT SIXBIT DATA
	GET	2		;RESTORE THE AC
	RTN			;AND EXIT

;PRINTS RIGHT SIDE OF EXTERNAL REGISTERS
;PRINTS ALL BIT DATA FOR INTERNAL REGISTERS

RITBIT:	PUT	2		;SAVE AC2
	CAIG	2,37		;INTERNAL OR EXTENAL REG
	JRST	RITA		;EXTERNAL
	LDB	3,INRNDX	;GET CORRECT INDEX
	ADDI	3,INRSER	;GET TABLE BASE
RITC:	HRRZ	2,(3)		;GET BIT TABLE ADDRESS
	GO	TYPBIT		;PRINT TABLE DATA
	GET	2		;RESTORE THE AC
	RTN			;AND EXIT
RITA:	MOVEI	3,EXRSER	;GET TABLE BASE ADDR
	ADD	3,2		;INDEX BY REG NUMBER
	JRST	RITC

;DISPATCHES OFF TO THE PROPER BYTE SERVICE VIA TBL LOOKUP

BYTES:	CAIG	2,37		;INTERNAL OR EXTERNAL REGISTER
	JRST	BYTEA		;EXTERNAL
	LDB	3,INRNDX	;INTERNAL. GET AN INDEX
	ADDI	3,INRSER	;GET TABLE BASE
BYTEC:	HLRZ	3,(3)		;GET DISPATCH ADDRESS
	GO	(3)		;TO THE SERVICE ROUTINE
	RTN			;AND EXIT
BYTEA:	MOVEI	3,EXRSER	;GET TABLE BASE ADDR
	ADD	3,2		;INDEX BY REG #
	JRST	BYTEC

;DEFINING PROPER INDEX FOR SOME OF THE INTERNAL LOOK UPS

	XLIST
	IFN	RH20,<
	LIST
INRNDX:	POINT	3,1,5
	XLIST
	>
	IFN	RH10,<
	LIST
INRNDX:	POINT	3,1,3
	XLIST
	>
	LIST


	SUBTTL	REG-CONI PRINTER LOOKUP TABLES
	XLIST
	BOX	<VARIOUS TABLES NEEDED BY PRINT ROUTINES>,<
	THERE ARE SEVERAL TYPE TABLES HERE AND MOST ARE SELF
	EXPLANITORY. THERE IS ONE TYPE THAT NEEDS CLARIFICATION.
	SOME OF THE SIXBIT TABLES HAVE OCTAL WORDS AS THEIR FIRST
	TWO ENTRIES FOLLOWED BY THE NORMAL LIST OF SIXBIT NAMES.
	THESE TABLES ARE SET UP FOR USE WITH THE "TYPBIT" SUBROUTINE
	AND THE FIRST TWO OCTAL WORDS ARE MASKS FOR "TYPBIT".
	WORD-1: HAS A ONE IN EACH OF THE 36 BIT POSITIONS FOR WHICH
		THERE IS A CORRESPONDING SIXBIT NAME.
	WORD-2: HAS A ONE IN EACH BIT POSITION THAT SHOULD NEVER
		BE NON-ZERO.  >

;TABLE OF SIXBIT NAMES FOR MASBUS CONTROLLER INTERNAL REGISTERS

	XLIST
	IFN  RH20,<
	LIST

;THIS TABLE CAN BE INDEXED INTO BY BITS 3-5 OF THE DATAI WORD

INRNAM:	SIXBIT	/RHSBAR/	;R70
	SIXBIT	/RHSTCR/	;R71
	SIXBIT	/RHPBAR/	;R72
	SIXBIT	/RHPTCR/	;R73
	SIXBIT	/RHIVR/		;R74
	SIXBIT	/RHRDRG/	;R75
	SIXBIT	/RHWTRG/	;R76
	SIXBIT	/RHDIAG/	;R77

	XLIST
	>
	IFN RH10,<
	LIST

;THIS TABLE CAN BE INDEXED INTO BY BITS 1-3 OF THE DATAI WORD

INRNAM:	SIXBIT	/RHCR/		;R40
	SIXBIT	/RHIAR/		;R44
	SIXBIT	/RHDBUF/	;R50
	SIXBIT	/RHRAE/		;R54
	SIXBIT	/RHRG60/	;R60
	SIXBIT	/RHRG64/	;R64
	SIXBIT	/RHRG70/	;R70
	SIXBIT	/RHCBUF/	;R74

	XLIST
	>
	LIST

;TABLE OF INTERNAL REGISTER POINTERS
;POINTER TO BYTE DATA PRINTER,, POINTER TO START OF REG BIT TABLE

	XLIST
	IFN RH20,<
	LIST

;THIS TABLE CAN BE INDEXED INTO BY BITS 3-5 OF THE DATAI WORD

INRSER:	R70SER,,R70TBL
	R71SER,,R71TBL
	R72SER,,R72TBL
	R73SER,,R73TBL
	R74SER,,R74TBL
	R75SER,,R75TBL
	[RTN],,R76TBL
	[RTN],,R77TBL

	XLIST
	>
	IFN  RH10,<
	LIST

;THIS TABLE CAN BE INDEXED INTO BY BITS 1-3 OF THE DATAI WORD

INRSER:	R40SER,,R40TBL
	R44SER,,R44TBL
	R50SER,,R50TBL
	[RTN],,R54TBL
	[RTN],,R60TBL		;NON-IMPLEMENTED REGISTER
	[RTN],,R64TBL		;NON-IMPLEMENTED REGISTER
	[RTN],,R70TBL		;NON-IMPLEMENTED REGISTER
	[RTN],,R74TBL

	XLIST
	>

	IFE	ANYDEV,<
	LIST

; SERVICE FOR 37 MASSBUS REGISTERS WHEN NO DEVICE IS SELECTED


EXRNAM:	SIXBIT	/DRRG00/
	SIXBIT	/DRRG01/
	SIXBIT	/DRRG02/
	SIXBIT	/DRRG03/
	SIXBIT	/DRRG04/
	SIXBIT	/DRRG05/
	SIXBIT	/DRRG06/
	SIXBIT	/DRRG07/
	SIXBIT	/DRRG10/
	SIXBIT	/DRRG11/
	SIXBIT	/DRRG12/
	SIXBIT	/DRRG13/
	SIXBIT	/DRRG14/
	SIXBIT	/DRRG15/
	SIXBIT	/DRRG16/
	SIXBIT	/DRRG17/
	SIXBIT	/DRRG20/
	SIXBIT	/DRRG21/
	SIXBIT	/DRRG22/
	SIXBIT	/DRRG23/
	SIXBIT	/DRRG24/
	SIXBIT	/DRRG25/
	SIXBIT	/DRRG26/
	SIXBIT	/DRRG27/
	SIXBIT	/DRRG30/
	SIXBIT	/DRRG31/
	SIXBIT	/DRRG32/
	SIXBIT	/DRRG33/
	SIXBIT	/DRRG34/
	SIXBIT	/DRRG35/
	SIXBIT	/DRRG36/
	SIXBIT	/DRRG37/


EXRSER:	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL
	[RTN],,RXTBL


RXTBL:	Z			;NO BITS SHOULD BE SET
	177777			;FLAG ERRORS IF THEY ARE

	XLIST
	>
	LIST

	LIST


	PAGE
;CONI - BIT TABLE

	XLIST
	IFN RH20,<
	LIST
CNITBL:	777770			;MASK - 1
	777777B17		;MASK - 2
	SIXBIT	/DPE/
	SIXBIT	/EXCEP/
	SIXBIT	/LNG-WC/
	SIXBIT	/SHT-WC/
	SIXBIT	/CHN-ER/
	SIXBIT	/DRE/
	SIXBIT	/RAE/
	SIXBIT	/CNR/
	SIXBIT	/OVRRUN/
	SIXBIT	/MBCENB/
	SIXBIT	/ATTN/
	SIXBIT	/SCRFUL/
	SIXBIT	/ATN-EN/
	SIXBIT	/PCRFUL/
	SIXBIT	/DONE/
	XLIST
	>
	IFN RH10,<
	LIST

CNITBL:	675607,,776370
	1B2!1B7!17B14!3B27
	SIXBIT	/ARFULL/
	SIXBIT	/CBFULL/
	SIXBIT	/CCINH/
	SIXBIT	/CHNACT/
	SIXBIT	/CHNPLS/
	SIXBIT	/DF22/
	SIXBIT	/CEXC/
	SIXBIT	/ILFC/
	SIXBIT	/SDRAE/
	SIXBIT	/CDPE/
	SIXBIT	/CWPE/
	SIXBIT	/NXM/
	SIXBIT	/DBPE/
	SIXBIT	/EXCEP/
	SIXBIT	/CHANER/
	SIXBIT	/CCWRT/
	SIXBIT	/OVRRUN/
	SIXBIT	/DRE/
	SIXBIT	/ILC/
	SIXBIT	/PSFAIL/
	SIXBIT	/CBOV/
	SIXBIT	/RAE/
	SIXBIT	/ATTN/
	SIXBIT	/BUSY/
	SIXBIT	/DONE/
	XLIST
	>
	LIST

;CONTROLLER INTERNAL REGISTER BIT TABLES

	XLIST
	IFN RH20,<
	LIST

R70TBL:
R72TBL:	Z
	777B14!1B18!1B19

R71TBL:
R73TBL:	2200,,200000
	5570,,400000
	SIXBIT	/RCLP/
	SIXBIT	/STORE/
	SIXBIT	/DTES/

R74TBL:	Z
	7777777B26

R75TBL:	Z
	7777B17

R76TBL:	Z
	7777B17!777777

R77TBL:	1773
	7777B17!776004
	SIXBIT	/D-XFER/
	SIXBIT	/D-CBT/
	SIXBIT	/D-BART/
	SIXBIT	/D-EPT/
	SIXBIT	/D-RWAL/
	SIXBIT	/D-EXEP/
	SIXBIT	/D-EBL/
	SIXBIT	/D-ATA/
	SIXBIT	/D-CLK/

	XLIST
	>
	IFN RH10,<
	LIST

R40TBL:	3B8!1B11!3B19!1B29
	1B6!3B10!7B14!1B20
	SIXBIT	/CBTO/
	SIXBIT	/DBTO/
	SIXBIT	/M-MODE/
	SIXBIT	/GENEDP/
	SIXBIT	/DXES/
	SIXBIT	/WTEVM/

R44TBL:	3B17
	7774B17!777B26
	SIXBIT	/KIINT/
	SIXBIT	/KAINT/

R50TBL:	17B17
	777B14
	SIXBIT	/DB-ODD/
	SIXBIT	/EV-BYT/
	SIXBIT	/OD-BYT/
	SIXBIT	/PARBIT/

R54TBL:	377
	777B17!777400
	SIXBIT	/RAE-7/
	SIXBIT	/RAE-6/
	SIXBIT	/RAE-5/
	SIXBIT	/RAE-4/
	SIXBIT	/RAE-3/
	SIXBIT	/RAE-2/
	SIXBIT	/RAE-1/
	SIXBIT	/RAE-0/

R74TBL:	Z
	Z

R60TBL:
R64TBL:
R70TBL:	Z
	777,,777777
	XLIST
	>
	LIST

;LEFT SIDE BIT TABLE FOR EXTERNAL (DEVICE) REGISTERS

	XLIST
	IFN RH20,<
	LIST

LFTTBL:	1B8!1B9!1B10!1B18!1B19
	6B8!17B14
	SIXBIT	/PAR-ER/
	SIXBIT	/DRAES/
	SIXBIT	/TRA/
	SIXBIT	/GEN-EP/
	SIXBIT	/PAR/

	XLIST
	>
	IFN RH10,<
	LIST

LFTTBL:	7600,,6B20
	170,,0
	SIXBIT	/CTOD/
	SIXBIT	/CBTO/
	SIXBIT	/CBPE/
	SIXBIT	/DTA-LT/
	SIXBIT	/ILC/
	SIXBIT	/GENEVC/
	SIXBIT	/PAR/

	XLIST
	>

	IFN RH20,<
	LIST

;OPTION BITS FOR KL10 OP-DATA CCW'S

CCWTBL:	7B2
	Z
	SIXBIT	/OPDATA/
	SIXBIT	/LSTXFR/
	SIXBIT	/RD-REV/

;BIT PRINTER FOR CHANNEL LOGOUT WORD -#1

LOSTBL:	76B5!76B14
	17B8
	SIXBIT	/LOGOUT/
	SIXBIT	/M-PAR/
	SIXBIT	/SBUSEN/
	SIXBIT	/NWCSZ/
	SIXBIT	/NXM/
	SIXBIT	/LSTXER/
	SIXBIT	/RH-ERR/
	SIXBIT	/LNG-WC/
	SIXBIT	/SHT-WC/
	SIXBIT	/OVRRUN/

	XLIST
	>

	LIST

	XLIST
	SUBTTL 	REGISTER BYTE INFORMATION PRINTERS
	BOX	<REGISTER BYTE PRINT ROUTINES>,<
	THESE ARE THE ROUTINES THAT PRINT THE DATA FROM
	VARIOUS REGISTERS WHEN THE DATA IS ORGANIZED IN
	BYTES. >

	XLIST
	IFN	RH20,<
	LIST

R70SER:
R72SER:	PUT	0
	TEXT	[ASCIZ/ BLOCK ADDRESS FIELD=/]
	LDB	[POINT 16,1,35]
	PNT6
	GET	0
	RTN

R71SER:
R73SER:	PUT	0
	TEXT	[ASCIZ/ DRV=/]
	LDB	[POINT 3,1,17]
	PNT1
	TEXT	[ASCIZ/ +BLK CNT=/]
	LDB	0,[POINT 10,1,29]
	IOR	[-1,,776000]
	MOVNS	0,0			;MAKE POSITIVE
	GO	PSDN			;PRINT IN DECIMAL
	TEXT	[ASCIZ/ FNCTN+GO=/]
	MOVE	0,1
	PNT2				;PRINT LOW ORDER 6 BITS
	TRNE	1,1B32			;READ OR WRITE ??
	JRST	.+3
	TEXT	[ASCIZ/(WRITE)/]
	SKIPA
	TEXT	[ASCIZ/(READ)/]
	GET	0
	RTN

R74SER:	PUT	0
	TEXT	[ASCIZ/INT VECT ADDR=/]
	MOVE	0,1
	PNT3
	GET	0
	RTN

R75SER:	PUT	0
	TEXT	[ASCIZ/READ REG=/]
	MOVE	0,1
	PNT6
	GET	0
	RTN
	XLIST
	>
	IFN	RH10,<
	LIST

R40SER:	PUT	0
	TEXT	[ASCIZ/ DRIVE=/]
	LDB	[POINT 3,1,17]
	PNT1
	TEXT	[ASCIZ/ICWA=/]
	LDB	0,[POINT 8,1,28]
	LSH	0,1
	GO	POCT	
	TEXT	[ASCIZ/ FNCTN+GO=/]
	MOVE	0,1
	PNT2
	TRNE	1,1B32			;READ OR WRITE
	JRST	.+3
	TEXT	[ASCIZ/(WRITE)/]
	SKIPA
	TEXT	[ASCIZ/(READ)/]
	GET	0
	RTN

R44SER:	PUT	0
	TEXT	[ASCIZ/INT VECT ADDR=/]
	MOVE	0,1
	PNT3
	GET	0
	RTN

R50SER:	PUT	0
	TEXT	[ASCIZ/DATA BUFFER=/]
	MOVE	0,1
	PNT6
	GET	0
	RTN

;ASSUMES 36 BIT DATA IN AC1

CBUFPT:	PUT	0		;SAVE THE AC
	TEXT	[ASCIZ/RHCBUF/]
	GO	.TAB
	LDB	[POINT 7,MBCN,9]
	LSH	2
	GO	POCT
	TEXT	[ASCIZ/: /]
	MOVE	0,1
	PNTHW
	PCRL	
	GET	0
	RTN

	XLIST
	>

	SUBTTL	BIT PRINTER ROUTINE  -TYPBIT-
	XLIST
	BOX	<TYPBIT - - TABLE BIT PRINTER>,<
	THIS ROUTINE IS USED TO TRANSLATE ONES IN A 36 BIT
	DATA WORD TO A SERIES OF EQUIV. SIXBIT MESSAGES TAKEN
	FROM A TABLE. THE DESCRIPTION OF THE TABLE LAYOUT IS FOUND 
	AT THE START OF THE TABLE SECTION. THIS ROUTINE MERELY
	TRANSLATES ONE TO SIXBIT MESSAGES AND ALSO TYPES ERROR
	MESSAGES IF IT FINDS ONES IN BIT POSITIONS WHERE THEY ARE 
	NOT EXPECTED.

	EG.	MOVE 	AC1,ARG1	;36 BITS OF DATA
		MOVE	AC2,ARG2	;POINTER TO DESCRIPTOR TABLE
		GO	TYPBIT		;CALL THE ROUTINE
		RETURN			;RETURNS +1 ALWAYS	>


	;FUNCTIONS OF AC'S FOR THIS ROUTINE
	;AC	FUNCTION
	;--	----------
	;0	USED FOR PRINTING
	;1	HOLDS 36 BIT DATA WORD
	;2	HOLDS UPDATED TABLE POINTER
	;3	HOLDS MASK-1 (EXPECTED 1'S)
	;4	HOLDS MASK- 2 (EXPECTED 0'S)
	;5	A SINGLE BIT MASK (SHIFTS TO RIGHT)
	;6	A SCRATCH AC FOR A JFFO
	

TYPBIT:	PUT	0		;SAVE AC0
	SKIPE	SHMODE		;SHORT PRINTOUT MODE ?
	JRST	EXG0		;YES
	MOVE	CONSW		;GET CONSOLE SWITCHES
	TLNE	TXTINH		;SHORT PRINTOUT ONLY ??
	JRST	EXG0		;YES. THEN EXIT
	PUT	1		;NO. SAVE SOME MORE
	PUT	2
	PUT	3
	PUT	4
	PUT	5
	PUT	6

;GET THE AC'S READY TO GO
	ADDI	2,2		;GET POINTER TO FIRST MESSAGE
	MOVE	3,-2(2)		;GETS FIRST MASK WORD
	MOVE	4,-1(2)		;GETS SECOND MASK WORD
	SETZ	5,		;CLEAR THE MASK
	TLO	5,(1B0)		;AND CREATE A SINGLE BIT MASK

TSX1:	TDNN	3,5		;MW-1 A ONE ??
	JRST	TSX2		;NO
	TDNE	1,5		;YES. IS DATA BIT A ONE ??
	GO	TSXM1		;YES. GO PRINT A MESSAGE
	AOS	2		;NO. BUMP THE POINTER
 	JRST	TSX3		;GO AND UPDATE THE MASK
TSX2:	TDNN	1,5		;IS DATA A ONE ??
	JRST	TSX3		;NO.
	TDNE	4,5		;YES. MW-2 A ONE ??
	GO	TSXM2		;YES. GO PRINT ERROR MSG
TSX3:	LSH	5,-1		;SHIFT MASK BIT TO RIGHT
	JUMPN	5,TSX1		;JUMP IF MASK IS NOT YET ZERO
	GET	6		;OTHERWISE RESTORE AC'S
	GET	5
	GET	4
	GET 	3
	GET	2
	GET	1
EXG0:	GET	0
	RTN			;AND RETURN

;HERE ARE THE 2 MESSAGE SUBROUTINES

TSXM1:	MOVE	0,(2)		;GETS MESSAGE
	PNTSIX			;PRINTS IT
	TEXT	[ASCIZ/ /]	;A SPACE
	RTN

TSXM2:	TEXT	[ASCIZ/?BIT-/]
	JFFO	5,.+1		;GET REAL BIT POSITION
	MOVE	0,6		;GET POSITION FOR PRINTING
	GO	PSDN		;PRINT IT
	TEXT	[ASCIZ/? /]
	RTN			;AND EXIT

	SUBTTL	ADDITIONAL PRINT UTILITIES

	XLIST
	BOX	<PSDN - - PRINTS SIGNED DECIMAL NUMBERS>,<
	PSDN PRINTS THE CONTENTS OF AC0 AS A SIGNED DECIMAL 
	NUMBER FOLLOWED BY A PERIOD. LEADING ZEROS ARE
	SURPRESSED.  >

PSDN:	PUT	0
	JUMPL	0,PSDN1
PSDN0:	TDNN	0,[377777,,-1] ;ALL ZEROS
	TLZ	0,400000	;THEN CLEAR SIGN BIT
	PNTDEC			;PRINT THE NUMBER
	TEXT	[ASCIZ/./]	;A DECIMAL POINT
	GET	0
	RTN
PSDN1:	TEXT	[ASCIZ/-/]	;A MINUS SIGN
	MOVN	0,(P)
	JRST	PSDN0


	XLIST
	BOX	<POCT - - OCTAL NUMBER PRINTER>,<
	POCT PRINTS THE CONTENTS OF AC0 AS AN OCTAL NUMBER. 
	LEADING ZEROS ARE SURPRESSED.
	FUNCTIONS OF AC'S FOR THE ROUTINE:
	AC	FUNCTION
	--	--------
	0	HOLDS PRINT CHAR
	1	DIGIT COUNTER
	2	A FLAG
	3	OCTAL DIGIT BYTE POINTER  >

POCT:	PUT	0		;SAVE AC'S
	PUT	1
	PUT	2
	PUT	3
	MOVEI	1,^D12		;# OF OCTAL DIGITS POSSIBLE
	SETZ	2,		;ZERO THE FLAG
	MOVE	3,[POINT 3,-3(P)] ;BYTE POINTER
POCT1:	ILDB	0,3		;GETS NEXT DIGIT
	JUMPN	2,POCT3		;JUMP IF FLAG NON ZERO
	JUMPE	0,POCT2		;JUMP IF DIGIT IS ZERO
	MOVEI	2,1		;SET THE FLAG
	JRST	POCT3		;GO AND CONVERT
POCT2:	CAIE	1,1		;CNT=1 ??
	JRST	POCT4		;NO
POCT3:	ADDI	0,60		;CONVERT TO ASCII
	PNTCHR			;PRINT THE CHARACTER
POCT4:	SOJG	1,POCT1		;LOOP IF COUNT IS NOT YET ZERO
	GET	3
	GET	2
	GET	1
	GET	0
	RTN			;AND EXIT.


XLIST
BOX	<SWCHPT - - PRINTS CURRENT STATE OF SWITCHES>,< >
SWCHPT:	PUT	0
	TEXTF	[ASCIZ/SWITCHES - /]
	MOVE	CONSW
	PNTHWF
	TEXTF	[ASCIZ/
/]
	GET	0
	RTN

	PAGE

SUBTTL ADDITIONAL PROGRAM UTILITY ROUTINES
	XLIST
	BOX <TSCAN - - SCANS TABLE FOR AN ENTRY AND RETURNS INDEX>,<
	THIS ROUTINE IS PASSED SOME DATA AND A POINTER TO A TABLE.
	ITS FUNCTION IS TO SEARCH THE TABLE FOR THE DATA. IF FOUND,
	THE INDEX INTO THE TABLE IS RETURNED IN AC1 AND THE +2 RTN IS
	TAKEN. IF NOT FOUND THE +1 RETURN IS TAKEN AND THE AC'S ARE UNCHANGED
	CALL	SEQ:
	MOVE	AC2,ARG		;DATA YOU ARE LOOKING FOR
	MOVE	AC1,ARG		;POINTER TO TABLE START
	GO	TSCAN		;THE CALL
	RTN-1			;ENTRY NOT FOUND
	RTN-2			;ENTRY FOUND (INDEX IN AC1)
	THE END OF THE TABLE IS MARKED BY A ZERO ENTRY >
TSCAN:	PUT	1		;SAVE THE AC
	SUBI	1,1		;POINT TO TBL ADR-1
TSLOOP:	ADDI	1,1		;BUMP THE POINTER
	SKIPN	(1)		;IS THE ENTRY 0 ?
	JRST	TSX		;YES. NOT FOUND. EXIT.
	CAME	2,(1)		;NO.  ENTRY=DATA ?
	JRST	TSLOOP		;NO
	AOS	-1(P)		;YES. BUMP THE RETURN
	SUB	1,(P)		;AC1 NOW AN INDEX VALUE
	MOVEM	1,(P)		;NEW AC1 VALUE TO THE STACK
TSX:	GET	1		;RESTORE THE AC
	RTN			;AND EXIT


	XLIST
	BOX	<XFSTRT -- ROUTINE TO INITIATE A DATA TRANSFER>,<
	THIS ROUTINE IS USED TO LOAD DCY, DA, AND RH CONTROL
	REGISTERS ALONG WITH INITIALIZING THE CHANNEL AND GENERATING THE
	APPROPRIATE COMMAND LIST IN CORE.
	WHEN THE RETURN IS TAKEN AC1 CONTAINS A (CTR,,PTR)
	TO THE CHANNEL COMMAND LIST JUST TAKEN.

	NOTE: THIS ROUTINE HAS BEEN MODIFIED TO DO ONLY HEADER
	      OPERATIONS IN THIS PGM. TO DO STD READS AND WRITES
	      BLKSIZ WILL HAVE TO BE MODIFIED TO REFLECT THE # OF
	      WORDS PER SECTOR IN THE TRANSFER .........


	CALLING SEQUENCE:
	MOVE	AC1,ARG1	;FUNCTION CODE & MISC. CR BITS
	MOVE	AC2,ARG2	;VALUES FOR DCY,,DA
	MOVE	AC3,ARG2	;VALUES FOR +WC,,CORE ADR
	GO	XFSTRT		;CALL THE ROUTINE
	RTN-1			;RETURN >

XFSTRT:	SETZM	CCWPTR#		;ZERO UNTIL CCW'S GENERATED
	PUT	3		;SAVE AC'S
	PUT	2
	PUT	1
	MOVEM	1,XFST1#	;SAVE ARGS FOR RETRY
	MOVEM	2,XFST2#
	MOVEM	3,XFST3#
	MOVSI	1,(1B14)	;DON'T REPORT RAE'S
	HLR	1,-1(P)		;FETCH DCY DATA FROM STACK
	GO	LDRG12		;LOAD DCY
	JFCL
	MOVSI	1,(1B14)	;DON'T REPORT RAE'S
	HRR	1,-1(P)		;FETCH DA DATA
	GO	LDRG05		;LOAD THE DA REGISTER
	JFCL
	MOVSI	1,(1B14)	;DON'T REPORT RAE'S
	SKIPE	MODE16		;16 BIT MODE ?
	TRO	1,10000		;YES. SET THE BIT
	GO	LDRG11		;LOAD THE OFFSET REGISTER
	JFCL			;HANDSHAKE FAILED
XX1:	MOVE	1,[10,,CBUFF]	;SIZE,,ADR OF CHANNEL BUFFER
	GO	CHINIT		;INIT THE CHANNEL
	MOVEM	1,SVICWA#	;SAVE INITIAL CW ADDR
	HLRZ	2,-2(P)		;FETCH WORD COUNT (SIZE OF XFER)
	HRRZ	1,-2(P)		;FETCH CORE STARTING ADDRESS
	GO	GENCCW		;BUILD A COMMAND LIST IN CORE
	MOVEM	1,CCWPTR	;SAVE POINTER TO THE LIST
	XLIST
	IFN	RH10,<
	LIST
	MOVE	1,SVICWA	;GET ICWA
	LSH	1,6		;POSITION IT
	IOR	1,(P)		;GET CONTROL REG DATA

;CACHE WRITE BACK AND INHIBIT IF A KL IN EXEC MODE

	GO	SWEEP		;SWEEP THE CACHE

	GO	LDCR		;LOAD RH10 CONTROL REGISTER

	XLIST
	>
	IFN	RH20,<
	LIST
	HLRZ	1,-2(P)		;GET THE WORD COUNT
	ADD	1,BLKSIZ	;ADD BLOCK SIZE
	SUBI	1,1		;NOW BLOCK SIZE -1
	IDIV	1,BLKSIZ	;NOW ROUNDED TO CORRECT BLOCK COUNT
	MOVN	1,1		;NOW HAVE 2'S COMP BLOCK COUNT
PBLK1:	ANDI	1,1777		;SAVE ONLY 10 BITS
	LSH	1,6		;POSITION THE BLOCK COUNT
	TLO	1,(1B7!1B10)	;SET STORE AND RCLP BITS
	IOR	1,(P)		;GET CONTROL REG BITS
	GO	LDSTCR		;LOAD STCR (TRANSFER STARTED)
	XLIST
	>
	LIST

	GET	1		;RESTORE AC'S
	GET	2
	GET	3

	MOVE	1,CCWPTR	;PICK UP CCW POINTER
	RTN			;AND EXIT

	XLIST
	BOX	<XFSTOP -- ROUTINE TO TERMINATE A DATA TRANSFER>,<
	THIS ROUTINE WHEN CALLED ISSUES A CONO "STOP" TO SHUT DOWN
	THE CHANNEL AND THEN DOES A CONTROLLER MASTER RESET
	TO FORCE THE TRANSFER TO BE COMPLETELY TERMINATED.

	CALLING SEQUENCE:
	GO	XFSTOP		;CALL THE ROUTINE
	RTN			;RETURNS HERE >

XFSTOP:	PUT	1		;SAVE THE AC
	MOVEI	1,1B31		;STOP TRANSFER BIT
	XLIST
	IFN	RH20,<
	LIST
	TRO	1,1B27		;MASSBUSS ENABLE BIT
	XLIST
	>
	LIST
	GO	.CONO		;TO SHUT DOWN THE CHANNEL
	MOVEI	1,10		;DONE BIT
	GO	.CONSO		;WAIT TILL IT DETS
	JRST	.-2		;LOOP
	GO	MSTCLR		;MASTER RESET
	GET	1		;RESTORE THE AC
	RTN			;AND EXIT
	XLIST
	BOX <DRVCLR -- ISSUE A DRIVE CLEAR>,<
	1. ISSUE A DRIVE CLEAR COMMAND
	2. READ STATUS REGISTER
	3. IF ERROR=1 FATAL OUT
	4. IF ERROR=0 RETURN SUCCESSFULLY
	CALL SEQ:
	GO	DRVCLR		;THE CALL
	RTN			;RETURNS HERE >
DRVCLR:	PUT	1		;SAVE THE AC
	MOVE	1,[1B14!11]	;GET THE COMMAND
	GO	LDRG00		;LOAD CONTROL REGISTER
	GO	CBTOER		;CBTO ERROR
	MOVSI	1,(1B14)	;DON'T REPORT RAE'S
	GO	RDRG01		;READ STATUS REG
	GO	CBTOER		;CBTO ERROR
	GO	CPARER		;PARITY ERROR
	TRNE	1,1B21		;COMPOSITE ERROR=0 ?
	JRST	DCE		;NO. ERROR .....
	GET	1		;NO ERROR. RESTORE AC
	RTN			;AND EXIT

DCE:	GO	SNAPS		;SNAPSHOT DEVICE
	GO	DEVREL		;BACK TO MONITOR
	TEXTF	[ASCIZ/
DRIVE CLEAR FAILED TO CLEAR ERROR CONDITION ?
/]
	GO	DUMPS		;DUMP STATUS
	TEXTF	[ASCIZ/
FATAL ERROR
/]
	RESET
	HALTF			;BACK TO MONITOR LEVEL

	XLIST
	BOX <PAKACK -- ISSUE A PACK ACKNOWLEDGE COMMAND>,<
	1. ISSUE A PACK ACKNOWLEDGE
	2. READ STATUS REGISTER
	3. IF VV=0 FATAL OUT
	4. IF VV=1 RETURN
	CALL SEQ:
	GO	PAKACK		;CALL THE ROUTINE
	RTN			;EXIT>

PAKACK:	PUT	1		;SAVE AC
	MOVE	1,[1B14!23]	;A PACK ACK COMMAND
	GO	LDRG00		;LOAD THE CONTROL REGISTER
	GO	CBTOER		;CBTO ERROR
	MOVSI	1,(1B14)	;DON'T REPORT RAE'S
	GO	RDRG01		;READ THE STATUS REGISTER
	GO	CBTOER		;HANDSHAKE FAILURE
	GO	CPARER		;PARITY ERROR
	TRNN	1,1B29		;IS VV=1 ?
	JRST	VVE		;NO. ERROR ....
	GET	1		;YES. RESTORE AC'S
	RTN			;AND EXIT

VVE:	GO	SNAPS		;SNAPSHOT REGISTERS
	GO	DEVREL		;RELEASE THE DEVICE
	TEXTF	[ASCIZ/
PACK ACKNOWLEDGE CMD FAILED TO SET VOLUME VALID
/]
	GO	DUMPS		;DUMP STATUS
	TEXTF	[ASCIZ/
FATAL ERROR
/]
	RESET
	HALTF

	XLIST
	BOX	<CLRATA -- ROUTINE TO CLEAR ATA >,<
	CALL SEQ
	GO	CLRATA		;CALL SEQ
	RTN			;RETURNS HERE >

CLRATA:	PUT	1		;SAVE AC
	MOVEI	1,1		;GET A MASK
	LSH	1,(DRIVE)	;POSITION IT
	GO	LDRG04		;LOAD PSEUDO ATA REG
	JFCL			;HANDSHAKE FAILURE
	GET	1		;RESTORE AC'S
	RTN			;EXIT

	XLIST
	BOX <ROUTINE TO WAIT FOR ATA>,<
	CALL SEQ:
	GO 	ATAWT		;CALL IT
	RTN+1			;IT RETURNS HERE  >
ATAWT:	PUT	1		;SAVE AC'S
	PUT	2
	MOVEI	2,1		;A SINGLE BIT MASK
	LSH	2,(DRIVE)	;POSITION IT
XDX:	SETZM	1		;CLEAR AC1
	GO	RDRG04		;READ ATA 
	JFCL
	JFCL
	TDNN	1,2		;IS ATA SET ?
	JRST	XDX		;NO YET
	GET	2		;YES. RESTORE
	GET	1		;AND EXIT
	RTN
	XLIST
	BOX	<RHCLR -- ROUTINE TO CLEAR RH INTERRUPT CONDITIONS >,<
	CLEARES: XFERER,RAECLR,DONE
	CALL SEQ
	GO	RHCLR		;CALL THE ROUTINE
	RTN			;EXIT >

.RHCLR:	PUT	1		;SAVE AC1
	GO	.CONI		;DO A CONI
	ANDI	1,4450		;SAVE. RAECLR,MBE,RAEN,DONE,PIA
	IORI	1,1600		;SETS XECLR,MBE,RCLP
	GO	.CONO		;DOES THE CONO
	GET	1		;RESTORE
	RTN			;EXIT

	XLIST
	BOX	<IOWAIT -- WAIT UNTIL IO COMPLETES AND RETURN >,<
	LOOPS WAITING FOR ATTN OR DONE. MONITORS FOR HUNG IO
	WITH A GROSS TIMER. A HUNG DEVICE IS A FATAL ERROR.
	GO	IOWAIT		;CALL THE ROUTINE
	RTN			;RETURNS HERE >
IOWAIT:	PUT	1		;SAVE THINGS
	PUT	2
IOW1:	MOVEI	2,^D16000	;A GROSS TIMER
BZRO:	GO	.CONI		;DO A CONI
	TRNE	1,4210		;RAE+DONE+ATA?
	JRST	IOEX		;I/O IS FINISHED
	LIST
IORL:	SETZM	1		;CLEAR AC1
	GO	RDRG04		;READ ATA REG
	JFCL			;CBTO
	JFCL			;PARITY ERROR
	SOJG	2,BZRO		;BUMP COUNT JUMP IF NOT DONE
HUNG:	JFCL			;HUNG DEVICE
	GO	SNAPS		;SNAPSHOT DEVICE REGISTERS
	SETZM	1		;CLEAR AC1
	GO	GETLOG		;GET LOGOUT AREA
	MOVE	1,CONIIN	;GET CONI DATA
	TRNN	1,20		;PCR FULL ?
	JRST	HFTL		;NO. 
	GO	XFSTOP		;DELETE THE COMMAND
	GO	MSTCLR		;DOES A MASSBUS RESET
HFTL:	GO	DEVREL		;RELEASE THE DEVICE
	TEXTF	[ASCIZ?
**** DEVICE IS HUNG DOING I/O
?]
	GO	TELWHO		;IDENTIFY THE DEVICE
	TEXTF	[ASCIZ/
FATAL ERROR... CAN'T CONTINUE.
/]
	GO	DUMPS		;DUMP REGISTERS
	GO	LOGPNT		;AND LOGOUT AREA
	TEXT	[ASCIZ/
[EXIT]
/]
	RESET			;CLEAR MONITOR THINGS
	FATAL			;BACK TO MONITOR
IOEX:	GET	2		;RESTORE
	GET	1
	RTN			;AND EXIT
SUBTTL USER MODE SUPPORT UTILITIES
	XLIST
	BOX <SETTRP - - PATCHES "UUOTST" INTO SUBR PKG UUO HANDLER>,<
	THIS ROUTINE DOES NOTHING IN EXEC MODE. IN USER MODE IT MODIFIES
	THE SUBROUTINE PKGES UUO HANDLER TO EXECUTE A ROUTINE CALLED
	"UUOTST" EACH TIME THE PGM EXECUTES A UUO AND THEN PASSES
	CONTROL TO THE SUBROUTINE PACKAGE FOR NORMAL UUO PROCESSING.
		EG.	GO	SETTRP		;PATCH IN
			RTN			;RETURNS CONTROL HERE >

SETTRP:	SKIPN	USER		;IN USER MODE ?
	RTN			;NO. RETURN IMMEDIATELY
	PUT	0		;YES. SAVE THE AC
	HRRZ	0,41		;GET PRESENT ADDR OF LOC 41
	CAIN	0,UUOTST	;ALREADY PATCHED IN ?
	JRST	SETEX		;YES
	MOVE	0,41		;NO. GET SUBR PKG INSTRUCTION
	MOVEM	0,SV41#		;SAVE IT TO RTN CTRL LATER
	MOVE	0,[GO UUOTST]	;THE NEW INSTRUCTION (TRAP)
	MOVEM	0,41		;NOW PACHED IN
SETEX:	GET	0		;RESTORE THE AC
	RTN			;AND RETURN

	XLIST
	BOX <UUOTST - - ROUTINE TO RELEASE THE RH BEFORE PRINTING>,<
	THIS ROUTINE IS EXECUTED IN USER MODE ONLY.BEFORE ATTEMPTING
	TO PRINT OR EXECUTE SOME OTHER TIME CONSUMING SUBROUTINE
	PACKAGE UUO, IT IS GOOD FORM TO RETURN THE RH TO THE SYSTEM
	RESOURCES SO THAT BOTH THE MONITOR AND DIAGNOSTIC USE THE
	DEVICE EFFICIENTLY. THIS ROUTINE IS RUN EACH TIME A UUO IS
	EXECUTED IN USER MODE, PROVIDED "SETTRP" WAS PREVIOUSLY
	CALLED. (AFTER PGMINT). >

UUOTST:	SKIPN	DIAGCR		;DO WE HAVE CTRL OF AN RH ?
	PJRST@	SV41		;NO. OFF TO SUBR PKG CODE
	PUT	0		;YES SAVE THE AC
	LDB	0,[POINT 9,40,8] ;GET OP CODE OF THE UUO
	CAILE	0,32		;IS IT A SUBR PKG UUO ?
	GO	DEVREL		;YES. GIVE DEV BACK TO MONITOR
	GET	0		;RESTORE THE AC
	PJRST@	SV41		;GO TO NORMAL SUBROUTINE PROCESS





SUBTTL CONTROLLER INITIALIZATION ROUTINE
	XLIST
	BOX	<MSTCLR - - RH MASTER CLEAR ROUTINE>,<
	THIS ROUTINE DOES THE FOLLOWING:
	1. CLEARS ALL POSSIBLE ERRORS (ISSUES AN RHCLR)
	2. WILL ALLOW ATTN'S TO BE SEEN IN THE CONI IF RH10
	  (ISSUES AN ATTNEN)
	3. CLEARS M-BOX ERRORS (RH20 ONLY) (ISSUES RCLP)
	4. ENABLES RH20 TRANSCEIVERS (ISSUES MBE)

	CALLING SEQ:
		GO	MSTCLR		;CALL THE CLEAR ROUTINE
		RETURN			;RETURNS HERE ALWAYS  >

MSTCLR:	PUT	1		;SAVE THE AC
	XLIST
	IFN	RH10,<
	LIST
	MOVEI	1,1B25!1B30	;RHCLR!ATTNEN
	XLIST
	>
	IFN	RH20,<
	LIST
	MOVEI	1,1B25!1B27!1B28 ;RHCLR!MBE!RCLP
	XLIST
	>
	LIST
	GO	.CONO		;TO THE ACTUAL I/O ROUTINE
	GET	1
	RTN			;AND EXIT

SUBTTL CONTROL BUS TIMEOUT ERROR HANDLER
	XLIST
	BOX <CBTOER - - ROUTINE TO FIELD UNEXPECTED CBTO'S>,<
	THIS ROUTINE IS USED TO FIELD AND REPORT UNEXPECTED CONTROL
	BUS TIMEOUTS WHEN LOADING OR READING DEVICE REGISTERS.A

	CALL SEQ:
		GO	CBTOER		;CALL THE ROUTINE
		RETURN			;RETURNS HERE >

CBTOER:	PUT	0		;SAVE THE AC
	TEXT	[ASCIZ/
UNEXPECTED CBTO AT PC-/]
	HRRZ	0,-1(P)		;GET THE PC
	SUBI	1		;REAL PC
	PNT6			;PRINT IT
	PUT	SHMODE		;SAVE CURRENT PRINT MODE
	SETOM	SHMODE		;FORCE REGPNT TO OCTAL
	GO	REGPNT		;GIVES SOME INDICATION OF FAILURE
	GET	SHMODE		;RESTORE USERS PRINTOUT MODE
	SETOM	ERFLG#		;FLAG ERROR SO SCOPE WILL LOOP
	GO	DEVREQ		;REQUEST THE DEVICE AGAIN
	GET	0		;RESTORE THE AC
	RTN

	XLIST
	BOX <CPARER - - FIELD AND REPORT UNEXPECTED CTRL BUS P.E.'S>,<
	THIS ROUTINE IS USED TO FIELD AND REPORT CONTROL BUS PARITY
	ERRORS.

	CALLING SEQ:
		GO	CPARER		;CALL THE ROUTINE
		RETURN			;RETURNS HERE >
CPARER:	SKIPE	ERFLG		;ANY ERRORS SO FAR ?
	RTN			;YES. PROBABLY FROM CBTOER
				;   AND WERE FALLING THRU THE CODE
				;   SO DON'T REPORT THIS.
	SETOM	ERFLG		;SO SCOPE WILL LOOP
	PUT	0		;SAVE AC0
	TEXT	[ASCIZ/
UNEXPECTED CONTROL BUSS PARITY ERROR AT PC-/]
	HRRZ	0,-1(P)		;GET THE PC
	SUBI	0,1		;ADJUST FOR PROPER PC
	PNT6			;PRINT IT
	PUT	SHMODE		;SAVE THE PRINTOUT MODE
	SETOM	SHMODE		;SET TO OCTAL PRINTOUT MODE
	GO	REGPNT		;PRINT THE DATA
	GET	SHMODE		;RECOVER PRINTOUT MODE
	GO	DEVREQ		;REQUEST THE DEVICE AGAIN
	GET	0		;RESTORE THE AC
	RTN			;AND EXIT

SUBTTL SOME TTY INPUT UTILITY ROUTINES
	XLIST
	BOX <QSTN - - ROUTINE TO INPUT ANSWERS (Y OR N) AND BRANCH>,<
	THIS ROUTINE AUTOMATICALLY OUTPUTS THE "Y OR N" PROMT MSG.
	CALLING SEQUENCE:
		GO	QSTN	;CALL THE ROUTINE
		RTN-1		;TIMEOUT
		RTN-2		;ANSWER WAS A NO
		RTN-3		;ANSWER WAS A YES >

QSTN:	PFORCE			;FORCE THIS TO PRINT
	TTIYES			;INPUT FROM THE TERMINAL
	JRST	QSTNB		;NO OR TIMEOUT HAS OCCURED
	AOS	(P)
QSTNA:	AOS	(P)
	PCRL
	RTN

QSTNB:	SKIPLE	$TWCNT		;WAS THERE A TIMEOUT
	JRST	QSTNA		;NOPE. THE ANSWER WAS A NO
	JRST	QSTNA+1		;THERE WAS A TIMEOUT

	XLIST
	BOX <CHARIN - - ROUTINE TO INPUT A SPECIFIC CHAR FROM THE TTY>,<
	CALLING SEQ:
	MOVEI	0,CHAR		;SPECIFY THE CHARACTER YOU WANT
	GO	CHARIN		;GO AND DO INPUT
	RTN-1			;NO RESPONSE. TIMEOUT
	RTN-2			;WRONG CHARACTER (AC0 HOLDS CHAR)
	RTN-3			;CORRECT CHAR (AC0 HOLDS CHAR) >

CHARIN:	PUT	0		;SAVE DESIRED CHAR ONTHE STACK
	TTICHR			;DO TTY INPUT
	JRST	CHARA		;TIMEOUT
	AOS	-1(P)		;LEGAL. BUMP THE RETURN
	EXCH	0,(P)		;PUT THE CHAR ON THE STACK
	CAMN	0,(P)		;IS THE CHAR AS EXPECTED ?
	AOS	-1(P)		;YES. BUMP THE RETURN
CHARA:	PCRLF			;A FREE CR LF PAIR
	GET 	0		;GET THE CHAR
	RTN			;AND TAKE PROPER RETURN

	XLIST
	BOX <NUMIN - - INPUT AND RANGE TEST A CONVERTABLE NUMBER >,<
	THE LIMITS ARE INCLUSIVE AND ARE SPECIFIED BY AC0 OF THE CALL.
	MULTIPLE RETURNS ARE SUPPLIED FOR BRANCHING.

	CALLING SEQ:
	MOVE	0,[LIM1,,LIM2]	;SPECIFY THE LIMITS
	GO	NUMIN		;CALL THE ROUTINE
	RTN-1			;TIMEOUT. NO RESPONSE (AC0 UNCHANGED)
	RTN-2			;ILLEGAL OR OUT OF RANGE (AC0 UNCHANGED)
	RTN-3			;NORMAL. (36 BIT NUM IN AC0) >

NUMIN:	PUT	0		;SAVE ORIGINAL AC0
	ADD	P,[2,,2]	;GET SOME STACK SPACE

;SET UP 36 BIT LIMITS WITH LOWER OF THE 2 FIRST ON THE STACK

	HRREM	0,-1(P)		;SAVE 36 BIT RIGHT LIMIT
	HLREM	0,(P)		;SAVE 36 BIT LEFT LIMIT
	MOVE	0,-1(P)		;GET THE FIRST LIMIT
	CAML	0,(P)		;SEE IF FIRST IS SMALLER OF THE 2
	EXCH	0,(P)		;NO. EXCHANGE
	MOVEM	0,-1(P)		;LIMITS NOW ORDERED CORRECTLY

;INPUT A CONVERTABLE NUMBER

	TTICNV			;DOES TTY INPUT
	JRST	NUMIE		;ERROR OR TIMEOUT
	AOS	-3(P)		;INPUT OK. BUNMP THE RETURN
	CAML	0,-1(P)		;RANGE TEST THE NUMBER
	CAMLE	0,(P)
	JRST	NUMIEX		;OUT OF RANGE
	EXCH	0,-2(P)		;IN RANGE. PUT ON THE STACK
	AOS	-3(P)		;BUMP THE RETURN
NUMIEX:	SUB	P,[2,,2]	;RELINQUISH STACK SPACE
	GET	0		;RECOVER THE NUMBER
	RTN			;AND TAKE THE PROPER RETURN

NUMIE:	SKIPLE	$TWCNT		;WAS THERE A TIMEOUT ?
	AOS	-3(P)		;NO. BUMP THE RETURN
	JRST	NUMIEX		;TIMEOUT.



SUBTTL GENERAL PRINT UTILITIES

	XLIST
	BOX <OPRACT - - ROUTINE TO HANDLE OPERATOR ACTION MSGES>,<
	THIS ROUTINE HANDLES THE OPERATOR INTERVENTION MESSAGES PASSED
	TO IT DURING THE CALL IN THE FOLLOWING 3 LINE FORMAT

	OPR ACTION REQ'D:  DRIVE-X RH-XXX
	MESSAGE PASSED TO THIS ROUTINE DURING THE CALL
	HIT <CR> WHEN READY

	CALLING SEQ:
	MOVEI	1,[ASCIZ/
MSG......../]
	GO	OPRACT		;CALL THE ROUTINE
	RTN			; HERE WHEN CR IS STRUCK >

OPRACT:	PUT	0		;SAVE THE AC
	TEXTF	[ASCIZ/
OPR ACT'N REQ'D: /]
	GO	TELWHO		;IDENTIFY THE DEVICE
	SKIPE	1
	TEXTF	(1)		;PRINT THE MSG FROM CALL
	TEXTF	[ASCIZ/
HIT <CR> WHEN READY   /]
	MOVEI	0,15		; A CR CODE
	GO	CHARIN		;GET A KEYSTROKE
	JRST	.-3		;TIMEOUT
	JRST	.-4		;ERROR
	GET	0		;RESTORE THE AC
	RTN			;EXIT 

	XLIST
	BOX <TELWHO -- PRINTS CURRENT DRIVE AND CONTROLLER NUMBER>,<
	THIS ROUTINE PRINTS "DRIVE-X RH-XXX" WITHOUT ANY LINE CONTROL,
	THIS ROUTINE IS PRIMARILY USED TO IDENTIFY THE
	DEVICE IN THE OPERATOR INTERVENTION MESSAGES.
	CALLING SEQ:
	GO	TELDEV		;CALL THE ROUTINE
	RTN			;THE RETURN	>

TELWHO:	PUT	0		;SAVE AC0
	TEXTF	[ASCIZ/ DRIVE-/]
	MOVE	0,DRIVE		;GET DRIVE NUMBER
	PNT1F			;PRINT IT
	TEXTF	[ASCIZ/RH-/]
	LDB	0,[POINT 7,MBCN,9]  ;GET DEVICE CODE
	LSH	0,2		;POSITION FOR PRINTING
	PNT3F			;PRINT IT
	PFORCE			;FORCE PRINTOUT
	GET	0		;RESTOR THE AC
	RTN


	XLIST
	BOX <ADCON -- DISK ADDRESS CONVERSION ROUTINE>,<
	TRANSLATES BOTH WAYS BETWEEN DISK ADDRESSES AND LOGICAL
	BLOCK NUMBERS BASED ON STATE OF AC1 WHEN CALLED.
	CALL	SEQ:
	MOVE	1,ARG1		;BLOCK #
	MOVE	2,ARG2		;CYLINDER,,TRK,SECT
	GO	ADCON		;CALL THE ROUTINE
	RTN			;IT RETURNS HERE

	IF AC1 IS 0 WHEN CALLED, THE ROUTINE CONVERTS THE CONTENTS
	OF AC2 (DISK ADR) TO A BLOCK NUMBER AND RETURNS THE 
	RESULTS IN AC1.

	IF AC1 IS NON-0 AT THE CALL, THE ROUTINE CONVERTS THE
	CONTENTS OF AC1 (BLOCK #) TO A DISK ADDRESS AND RETURNS
	THE RESULTS IN AC2 >

ADCON:	PUT	2		;SAVE AC'S
	PUT	1
	JUMPE	1,CTB		;JUMP IF CONVERT TO A BLOCK
	IDIV	1,BLKCYL	;BLOCKS PER CYL
	HRLZM	1,-1(P)		;PUT ON STACK AS CYLINDER #
	MOVE	1,2		;REMAINDER TO AC1
	IDIV	1,BLKTRK	;CALCULATE SURFACE #
	LSH	1,^D8		;POSITION IT
	IOR	1,2		;REMAINDER IS SECTOR #
	HRRM	1,-1(P)		;PUT ON STACK TRK,SEC
	JRST	ADCONX		;TO COMMON EXIT CODE

;CONVERT TO A BLOCK #

CTB:	LDB	1,[POINT 8,-1(P),35] ;SECTOR #
	LDB	2,[POINT 8,-1(P),27] ;TRACK #
	IMUL	2,BLKTRK	;X # OF SECT PER TRK
	ADD	1,2		;A RUNNING SUM IN AC1
	HLRZ	2,-1(P)		;GET CYLINDER #
	IMUL	2,BLKCYL	;X # BLOCKS PER CYL
	ADD	1,2		;UPDATE RUNNING SUM
	MOVEM	1,(P)		;ON STACK AS BLOCK COUNT
ADCONX:	GET	1
	GET	2
	RTN

SUBTTL PARAMETER AND DEVICE INITIALIZATION
	XLIST
	BOX <IPARAM -- INIT PARAMETERS AND DEVICE>,<
	SET UP THE DEVICE TYPE DEPENDANT PARAMETERS SO THEY
	MAY BE USED AS CONSTANTS THROUGHT THE PROGRAM.ALSO
	ISSUE NECESSARY PACK ACKNOWLEDGE COMMAND AND IDENTIFY
	THE DEVICE WE ARE USING BY ITS SERIAL NUMBER.
	CALL SEQ:
	GO	IPARAM		;THE CALL 
	RTN			;THE RETURN >

IPARAM:	PUT	0		;SAVE AC'S
	PUT	1
	PUT	X
	MOVE	X,INDEX		;NOW HAVE PROPER TABLE OFFSETS
	MOVE	1,CYLS(X)	;GET MAX CYL #
	MOVEM	1,MAXCYL	;SAVES MAX CYL #
	MOVE	1,SURS(X)	;GET THE MAX SURF #
	MOVEM	1,MAXSUR	;SAVE MAXIMUM SURFACE NUMBER
	MOVE	1,SEC18(X)	;GET MAX SECT IN 18 BIT MODE 
	SKIPE	MODE16		;DO WE REALLY WANT 16 BIT MODE ?
	MOVE	1,SEC16(X)	;YES. FETCH FROM OTHER TABLE
	MOVEM	1,MAXSEC	;SAVE MAXIMUM SECTOR #
	MOVE	1,MAXSEC	;GET MAX SEC #
	ADDI	1,1		;NOW # OF SECTORS PER TRACK
	MOVEM	1,BLKTRK	;SAVE IT AS SUCH
	MOVE	1,MAXSUR	;GET MAX SUR #
	ADDI	1,1		;NOW # OF SURFACES
	IMUL	1,BLKTRK	;GIVES # SECTORS PER CYL
	MOVEM	1,BLKCYL	;SAVE IT AS SUCH
	MOVE	1,MAXCYL	;GET MAXIMUM CYL #
	ADDI	1,1		;NOW HAVE # OF CYLS
	IMUL	1,BLKTRK	;GIVES # BLOCKS PER SURFACE
	MOVEM	1,BLKSUR	;SAVE IT
	MOVE	1,MAXCYL	;GET MAX CYLINDER #
	ADDI	1,1		;# OF CYLINDERS
	IMUL	1,BLKCYL	;GIVES TOTAL AVAIL BLOCKS
	MOVEM	1,BLKTOT	;SAVE IT AS SUCH
	SUBI	1,1		;GIVES MAX BLOCK #
	MOVEM	1,MAXBLK	;AND SAVE IT
	MOVE	1,WDSPS(X)	;GET WORDS PER SECT DURING FORMAT
	MOVEM	1,BLKSIZ	;SAVE AS BLOCK SIZE
	JRST	DRSTAT		;EVER ONWARD
	PAGE

;GET HOLD OF DEVICE AND SNAPSHOT REGISTERS

DRSTAT:	GO	DEVREQ		;REQUEST THE DEVICE
	GO	.RHCLR		;RH INIT
	GO	DRVCLR		;A DRIVE CLEAR
	GO	SNAPS		;SNAPSHOT REGISTERS
	GO	DEVREL		;DEVICE BACK TO MONITOR
LOOK:	JFCL			;CAN DUMP HERE DURING DEBUG
	LDB	1,[POINT 16,R10D,35] ; GET SERIAL #
	MOVEM	1,SERIAL	;AND SAVE IT

;CHECK THAT MOL=1 AND WRL=0 OPERATOR SHOULD HAVE DONE THIS ALREADY

	MOVE	1,R1D		;GET STATUS REG DATA
	TRC	1,1B23
	TRNN	1,1B23!1B24	;CHECKS STATE OF VV & MOL
	JRST	PAKAK		;OK SO FAR. GO DO PACK ACK
	MOVEI	1,[ASCIZ/
PLACE DRIVE ON LINE AND WRITE ENABLE/]
	GO	OPRACT		;TELL OPERATOR
	JRST	DRSTAT		;HE SAYS HE'S READY. CHECK.

;GET DEVICE FROM MONITOR AND ISSUE A PACK ACKNOWLEDGE

PAKAK:	GO	DEVREQ		;GET THE DEVICE
	GO	.RHCLR		;INIT RH
	GO	DRVCLR		;CLEAR THE DRIVE
	GO	PAKACK		;CALL ROUTINE TO ISSUE THE CMD
	GO	DRVCLR		;INIT DRIVE AGAIN
	GO	DEVREL		;RELEASE THE DEVICE

;REPORT SERIAL # OF DRIVE TO OPERATOR

SRLID:	TEXTF	[ASCIZ/
THE SERIAL # OF THE DRIVE IS - /]
	MOVE	0,SERIAL	;GET THE SERIAL #
	PNTBCD			;PRINT IT IN BCD
	PCRL
	PCRL
	GET	X		;RESTORE AC'S
	GET	1
	GET	0
	RTN			;AND EXIT
	
	XLIST
	BOX <FUDGE -- RM03 "MAXBLK" ADJUSTER>,<
	THIS ROUTINE MODIFIES THE ALREADY CALCULATED MAX BLOCK #
	FOR RM03'S. THIS IS DONE IN VERIFY ONLY SO THAT THE ENTIRE
	PACK WILL BE FORMATTED CORRECTLY BUT ONLY THOSE LOGICAL
	BLOCKS THAT THE MONITOR KNOWS ABOUT WILL BE MAPPED.
	THE MONITOR THROWS AWAY 2 BLOCKS PER CYLINDER. 2*823.=1646.
	CALL SEQ:
	GO	FUDGE		;CALL THE ROUTINE
	RTN			;RETURNS HERE. >

FUDGE:	PUT	1		;SAVE AC1
	MOVE	1,NAME		;SIXBIT NAME OF DEV BEING USED
	CAME	1,[SIXBIT/RM03/] ;RM03 ?
	JRST	.FX		;NO.
	MOVE	1,MAXBLK	;YES. GET MAXIMUM BLOCK #
	SUBI	1,^D1646	;ADJUST IT
	MOVEM	1,MAXBLK	;AND SAVE IT
.FX:	GET	1		;RESTORE THE AC
	RTN			;AND EXIT

SUBTTL SNAPSHOT AND DUMP ROUTINES

	XLIST
	BOX <SNAPSHOT AND DUMP ROUTINES>,<
	READS AND PRINTS RH AND RH STATUS
	CALL SEQ:
	GO	XXXX		;XXXX IS "SNAP" OR "DUMP"
	RTN			;+1 RTN ALWAYS TAKEN>

SNAP:SNAPA:SNAPS:
	PUT	1		;SAVE AC'S
	PUT	2
	HRLZI	2,^D-20		;-CNT,,INDEX=0
SL:	SETZM	1		;CLEAR AC
	TLO	1,(1B14)	;DONT REPORT REGISTER RAE'S
	GO@	RDISP(2)	;READ APPROPRIATE STATUS
	JFCL			;HANDLES MULTIPLE RETURNS
	JFCL
	MOVEM	1,CONIIN(2)	;SAVE RESULTS
	AOBJN	2,SL		;LOOP TILL ALL DONE
	GET	2		;RESTORE AC'S
	GET	1
	RTN			;AND EXIT

DUMP:DUMPS:DUMPA:
	SETOM	SHMODE		;OCTAL PRINT FOR REG DUMP
	PUT	1		;SAVE AC'S
	PUT	2
	HRLZI	2,^D-20		;-CNT,,INDEX=0
	MOVE	1,CONIIN(2)	;GET DATA
	GO	CONIPT		;PRINT CONI DAA
	AOBJN	2,.+1		;ALWAYS CONTINUE
	MOVE	1,CONIIN(2)	;GET DATA
	GO	REGPNT		;REGISTER PRINTER
	AOBJN	2,.-2		;LOOP TILL DONE
	GET	2		;RESTORE AC'S
	GET	1
	SETZM	SHMODE		;LONG PRINT MODE AGAIN
	RTN			;AND EXIT

	PAGE
;STORAGE FOR RH AND DEVICE STATUS

CONIIN:	Z			;FOR CONI DATA
STCRIN:	Z			;FOR RH STCR
PTCRIN:	Z			;FOR RH PTCR
IVRIN:	Z			;FOR RH IVR
R0D:	Z			;NOW FOR THE DRIVE REGISTERS
R1D:	Z
R2D:	Z
R3D:	Z
R4D:	Z
R5D:	Z
R6D:	Z
R7D:	Z
R10D:	Z
R11D:	Z
R12D:	Z
R13D:	Z
R14D:	Z
R15D:	Z
R16D:	Z
R17D:	Z

;DISPATCH POINTERS TO VARIOUS STATUS INPUT ROUTINES

RDISP:	.CONI			;DOES CONI
	RDSTCR			;GET RH STATUS REGISTERS
	RDPTCR
	RDIVRG
	RDRG00			;GET DRIVE REGISTERS
	RDRG01
	RDRG02
	RDRG03
	RDRG04
	RDRG05
	RDRG06
	RDRG07
	RDRG10
	RDRG11
	RDRG12
	RDRG13
	RDRG14
	RDRG15
	RDRG16
	RDRG17




SUBTTL HEADER DATA GENERATION ROUTINES
	XLIST
	BOX <CLRBUF -- ROUTINE TO SET THE BUFFER TO 0>,<
	SETS THE PAGE BUFFER TO ALL ZERO'S
	CALL SEQ:
	GO	CLRBUF		;CALL THE ROUTINE
	RTN			;RTN HERE >

CLRBUF:	PUT	1		;SAVE THE AC
	SETZM	BUFFER		;CLEAR 1ST LOC
	MOVE	1,[BUFFER,,BUFFER+1] ;A BLT WD
	BLT	1,BUFFER+777	;CLEARS THE WHOLE PAGE
	GET	1		;RESTORE THE AC
	RTN			;AND EXIT

	XLIST
	BOX <GENW1 -- GENERATE WORST CASE DATA FOR RP04/5/6'S>,<
	TAILORED TO THIS PGM... GENERATES 3 SECTORS OF WORST
	CASE DATA IN THE BUFFER LEAVING HOLES (ZEROS) IN THE
	HEADER WORDS FOR THE RP04/5/6. DRIVE SERIAL # IS WRITTEN
	INTO KEY WORD #2 RIGHT JUSTIFIED.
	CALL SEQ:
	GO	GENW1		;CALL THE ROUTINE
	RTN			;RTN IS HERE >
GENW1:	PUT	1		;SAVE THE AC
	SETZM	BUFFER		;CLR 1ST LOC
	MOVE	1,SERIAL	;GET THE SERIAL #
	MOVEM	1,BUFFER+1	;PLUG INTO KEY WORD #2

;DO A 16 BIT/18 BIT MODE TEST AND BRANCH ACCORDINGLY

	SKIPE	MODE16		;ARE WE IN 16 BIT MODE ?
	JRST	M16WCD		;YES. GO TO IT
	MOVE	1,[WCDAT,,BUFFER+2] ;BLT PTR FOR WC DATA
	BLT	1,BUFFER+11	;FIRST 8 WD CYCLE IS COMPLETE
	MOVE	1,[BUFFER+2,,BUFFER+12] ;FINISH OUT FIRST SECTOR
	BLT	1,BUFFER+201	;WITH WORST CASE DATA
THREST:	MOVE	1,[BUFFER,,BUFFER+202] ;FOR NEXT 2 SECTORS
	BLT	1,BUFFER+605	;FILLS OUT SECOND AND 3RD SECTORS
	GET	1		;RECOVER THE AC
	RTN			;EXIT

;THE 16 BIT MODE CODE

M16WCD:	MOVE	1,[165555,,133333] ;WORST WORD FOR THIS MODE
	MOVEM	1,BUFFER+2	;SETS UP 1ST DATA WORD
	MOVE	1,[BUFFER+2,,BUFFER+3] ;A BLT POINTER
	BLT	1,BUFFER+201	;DOES THE FIRST SECTOR
	JRST	THREST		;COMMON CODE DOES THE NEXT 2

;HERES THE WORST CASE 18 BIT MODE DATA PATTERN. AN 8 WORD CYCLE.

WCDAT:	726666,,666676
	555555,,555753
	333333,,337266
	666666,,765555
	555557,,533333
	333372,,666666
	667655,,555555
	573333,,333333

	XLIST
	BOX <GENW2 -- GENERATE WORST CASE DATA FOR THE RM03'S>,<
	TAILORED TO THIS PROGRAM... GENERATE 3 SECTORS OF WORST CASE
	DATA IN THE BUFFER WITH THE HEADER WORDS LEFT BLANK.
	CALL 	SEQ:
	GO	GENW2		;CALL THE ROUTINE
	RTN			;RETURNS HERE >

GENW2:	PUT	1		;SAVE THE AC
	SETZM	BUFFER		;CLEAR FIRST LOCATION
	SKIPE	MODE16		;16 BIT MODE ?
	JRST	RM16M		;YES. GO TO IT
	MOVE	1,[WCDAT,,BUFFER+1] ;NO. A POINTER FOR WORST CASE DATA
	BLT	1,BUFFER+10	;1ST 8 WORDS INTO THE DATA BUFFER
	MOVE	1,[BUFFER+1,,BUFFER+11] ;FINISH OUT 1ST SECTOR
	BLT	1,BUFFER+200	;NOW.
RESTRM:	MOVE	1,[BUFFER,,BUFFER+201] ;FOR THE NEXT 2 SECTORS
	BLT	1,BUFFER+602	;FILS OUT 2ND AND 3RD
	GET	1		;RESTORE THE AC
	RTN			;AND EXIT

;THE 16-BIT MODE CODE

RM16M:	MOVE	1,[165555,,133333] ;WORST CASE DATA
	MOVEM	1,BUFFER+1	;TO THE FIRST WORD
	MOVE	1,[BUFFER+1,,BUFFER+2] ;DO FIRST SECTOR
	BLT	1,BUFFER+200	;1ST SECTOR DONE
	JRST	RESTRM		;GO DO 2ND AND THIRD

	XLIST
	BOX <UPDHD1 -- UPDATE HEADERS FOR THE RP04/5/6 & RM03>,<
	MOVES THE PROPER HEADER WORD INTO THE PROPER BUFFER 
	LOCATIONS WITHIN THE WRITE BUFFER
	CALL SEQ:
	MOVE	2,ARG2		;# OF BLOCKS (.LE. 3)
	MOVE	1,ARG1		;STARTING BLOCK #
	GO	UPDHD1		;CALL THE ROUTINE
	RTN			;RETURN IS HERE >

UPDHD1:	PUT	1		;SAVE THE AC'S
	PUT	2
	PUT	3
	PUT	4
	MOVE	3,2		;GET COUNT TO AC3
	MOVEI	4,BUFFER	;A BUFFER POINTER
UPDL1:	SETZM	2		;GETS CONVERSION ALLRIGHT
	GO	ADCON		;CONVRT TO REAL ADDR
	SKIPE	MODE16		;IN 16-BIT MODE ?
	TLO	2,(1B5)		;YES. SET THE FMT BIT
	MOVEM	2,(4)		;PUT IN THE BUFFER
	AOS	1		;BUMP LOGICAL BLOCK #
	ADD	4,BLKSIZ	;UPDATE BUFFER POINTER
	SOJG	3,UPDL1		;LOOP
	GET	4		;DONE. RESTORE THINGS
	GET	3
	GET	2
	GET	1
	RTN			;AND EXIT

SUBTTL ROUTINES TO GENERATE BAT BLOCK DATA
	XLIST
	BOX <RPBAT -- BAT BLOCK ROUTINE FOR RP04/5/6'S>,<
	THIS ROUTINE BUILDS THE DATA IN THE BUFFER FOR EITHER OF
	THE BAT BLOCKS FOR THESE DEVICES
	CALL	SEQ:
	MOVE	1,ARG1		;BAT BLOCK # (#2 OR #13)
	GO	RPBAT		;CALL THE ROUTINE
	RTN			;RETURNS HERE >

RPBAT:	PUT	1		;SAVE THE AC
	GO	CLRBUF		;CLEAR THE BUFFER
	MOVE	1,SERIAL	;GET THE SERIAL #
	MOVEM	1,BUFFER+1	;SAVE IN KEY WORD
	MOVE	1,[SIXBIT/BAT/]	;A BLOCK IDENTIFIER
	MOVEM	1,BUFFER+2	;INTO 1ST DATA WORD
	MOVE	1,[-172,,4]	;A POINTER FOR MONITOR
	MOVEM	1,BUFFER+3	;PUT IN THE BUFFER
	MOVEI	1,606060	;A TERMINATOR WORD
	MOVEM	1,BUFFER+200	;TO 2ND LAST WORD
	GET	1		;RECOVER BLOCK #
	MOVEM	1,BUFFER+201	;TO LAST WORD
	RTN			;AND EXIT

	XLIST
	BOX <RMBAT -- BAT BLOCK ROUTINE FOR THE RM03>,<
	THIS ROUTINE BUILDS BAT BLOCK DATA INTO THE BUFFER FOR
	EITHER OF THE BAT BLOCKS.
	CALL	SEQ:
	MOVE	1,ARG1		;GET BLOCK# (#2 OR #13)
	GO	RMBAT		;CALL THE ROUTINE >

RMBAT:	PUT	1		;SAVE AC
	GO	CLRBUF		;CLEAR THE BUFFER
	MOVE	1,[SIXBIT/BAT/] ;GET THE BLOCK IDENTIFIER
	MOVEM	1,BUFFER+1	;INTO 1ST DATA WORD
	MOVE	1,[-172,,4]	;A POINTER FOR THE MONITOR
	MOVEM	1,BUFFER+2	;INTO 2ND DATA WORD
	MOVEI	1,606060	;A TERMINATOR WORD
	MOVEM	1,BUFFER+177	;TO 2ND LAST WORD
	GET	1		;GET BLOCK #
	MOVEM	1,BUFFER+200	;AND PLUG INTO LAST WORD
	RTN			;AND EXIT

SUBTTL ROUTINE TO OUTPUT TIME
	XLIST
	BOX <TELTIM - - OUTPUT TIME ON TERMINAL>,<
	CALL SEQ:
	GO	TELTIM		;THE CALL
	RTN			;RTN IS HERE >
TELTIM:	PUT	1		;SAVE AC'S
	PUT	2
	PUT	3
	MOVEI	1,.PRIOU	;TERM IS OUTPUT DEV
	SETOM	2		;-1 IS CURRENT TIME
	SETZM	3		;OUTPUT DATE + TIME
	ODTIM			;HERE'S THE JSYS
	 ERCAL	[RTN]		;ERROR NOT SIGNIFICANT
	GET	3		;RESTORE AC'S
	GET	2
	GET	1
	RTN			;AND EXIT

SUBTTL ROUTINES TO HANDLE PROGRAMS PROGRESS REPORT
	XLIST
	BOX <IPRPT -- INIT VARIABLES FOR THE PROGRESS REPORTER>,<
	CALCULATES VARIABLES SO WE CAN REPORT PROG PROGRESS AT
	VARIABLE PERCENTAGES OF COMPLETION BASED ON BLOCKS
	TRANSFERRED.
	CALL	SEQ:
	MOVE	1,ARG1		;% OF PROGRESS TO REPORT
	MOVE	2,ARG2		;MAXIMUM BLOCK #
	GO	IPRPT		;CALL THE ROUTINE
	RTN			;EXIT >

IPRPT:	PUT	1		;SAVE AC
	PUT	2
	CAILE	1,0		;RANGE CHK PERCENTAGE
	CAILE	1,^D100
	MOVEI	1,^D100		;USE 100 IF OUT OF RANGE
	MOVEM	2,BMAX		;SAVE MAX BLOCK
	MOVEM	1,PCNT		;SAVE PERCENTAGE
	MOVEI	1,^D100		;100%
	IDIV	1,PCNT		;CALC # OF INTERVALS
	MOVEM	1,INT		;TOTAL # OF INTERVALS
	MOVEI	1,1		;1
	MOVEM	1,CINT		;INIT CURRENT INTERVAL
	MOVE	1,BMAX		;GET MAX BLOCK #
	ADDI	1,1		;+1
	IDIV	1,INT		;GETS BLOCKS PER INTERVAL
	MOVEM	1,DELTA		;SAVE IT
	MOVEM	1,CKPNT		;AND ESTABLISHES FIRST CKPNT
	GET	2		;RESTORE
	GET	1
	RTN			;EXIT

;VARIABLES

PCNT:	Z			;PERCENTAGE
CINT:	Z			;CURRENT INTERVAL
INT:	Z			;TOTAL # OF INTERVALS
DELTA:	Z			;SIZE OF INTERVAL IN BLOCKS
CKPNT:	Z			;NEXT CHECKPOINT TO REPORT
BMAX:	Z			;COPY OF MAX BLOCK #

	XLIST
	BOX <PRPT -- REPORT PROGRESS IF NECESSARY>,<
	REPORT WHEN PREDETERMINED PERCENTAGE OF PACK HAS BEEN
	FORMATTED OR VERIFIED. (SEE: IPRPT)
	ROUTINE ASSUMES CURRENT BLOCK # IS IN "SBLK"
	CALL	SEQ:
	GO	PRPT		;CALL ROUTINE
	RTN			;RETURNS HERE >

PRPT:	PUT	0		;SAVE AC
	MOVE	0,SBLK		;GET STARTING BLOCK
	CAMG	0,CKPNT		;TIME TO REPORT ?
	JRST	PRPTX		;NO. EXIT

;REPORT THAT WE'VE REACHED A MILSTONE

	GO	CTRLT		;USE SAME PRINTER AS A CTRL-T
	JFCL			;  SOFTWARE INTERRUPT.....

;NOW UPDATE INTERVAL AN NEXT CHECKPOINT CORRECTLY

	MOVE	0,CINT		;GET CURRENT INTERVAL
	CAMG	0,INT		;GREATER THAN TOTAL ?
	AOS	CINT		;NO. INCREMENT IT
	MOVE	0,DELTA		;GET SIZE OF INCREMENT
	ADDM	0,CKPNT		;SET NEXT CHECKPOINT
PRPTX:	GET	0		;RESTORE
	RTN			;EXIT


SUBTTL ROUTINE TO ENABLE PROCESS CAPABILITIES
	XLIST
	BOX <ENABLE -- ENABLE CAPABILITIES OF THIS PROCESS>,<
	FIRST READ CAPABILITIES AND THEN ENABLE THEM. SAME AS
	TYPING "ENA" FROM EXEC LEVEL.
	CALL	SEQ:
	GO	ENABLE		;CALL
	RTN			;RETURNS HERE >

ENABLE:	PUT	1		;SAVE AC'S
	PUT	2
	PUT	3
	MOVEI	1,.FHSLF	;PROCESS HANDLE
	RPCAP			;READ CAPABILITIES
	 ERCAL	[RTN]		;IGNORE ERRORS
	MOVE	3,2		;GET CAPABILITIES TO AC3
	EPCAP			;NOW ENABLE
	 ERCAL	[RTN]		;IGNORE ERRORS
	GET	3		;RESTORE
	GET	2
	GET	1
	RTN			;EXIT

SUBTTL ROUTINE TO PRINT A HELP FILE ON THE TERMINAL
	XLIST
	BOX <HELP -- READ AND OUTPUT FORMAT.HLP ON TTY>,<
	PROGRAM LOOKS SEVERAL PLACES FOR THE HELP FILE:
	A. SYS:FORMAT.HLP
	B. HLP:FORMAT.HLP
	C. FORMAT.HLP (LOGGED IN DIRECTORY)
	CALL SEQ:
	GO	HELP		;CALL THE ROUTINE
	RTN			;RETURNS HERE>
HELP:	PUT	3		;SAVE AC'S
	PUT	2		
	PUT	1
	SETOM	3		;INIT INDEX REG TO -1
HLPLP:	AOS	3		;BUMP INDEX REG
	MOVE	2,HTBL(3)		;GET POINTER FROM THE TABLE
	JUMPE	2,[TEXTF [ASCIZ/
FILE NOT FOUND - FORMAT.HLP
/]
		  JRST	HELPX ] ;ERROR IN GETTING JFN
	MOVSI	1,(GJ%OLD!GJ%FLG!GJ%SHT) ;FLAGS
	SETZM	ERFLG		;CLEAR ERROR FLAG
	GTJFN			;GET A JFN
	 ERCAL	[SETOM	ERFLG
		 RTN ]		;SET ERROR FLAG
	JUMPN	ERFLG,HLPLP	;LOOP IF WE GOT AN ERROR
	HRRM	1,JFN#		;SAVE THE JFN
	MOVE	2,[7B5!OF%RD!OF%THW!OF%PLN] ;FLAGS
	HRRZ	1,JFN		;GET JFN
HOPEN:	OPENF			;OPEN THE FILE
	 ERCAL	FILEER		;ERROR
	JUMPN	ERFLG,HELPX	;ERROR. EXIT
HXFR:	HRRZ	1,JFN		;GET FILE I.D.
	BIN			;READ A BYTE
	ERCAL	[SKIPN	2
		 RTN
		 GO  FILEER
		 RTN ]
	JUMPN	ERFLG,HCLOSE	;IF ERROR, CLOSE FILE
	JUMPE	2,HCLOSE	;0 BYTE MEANS WE'RE DONE
	MOVEI	1,.PRIOU	;TTY FOR OUTPUT
	BOUT			;OUTPUT ON TTY
	 ERCAL	FILEER		;ERROR
	JUMPN	ERFLG,HCLOSE	;IF ERROR, CLOSE THE FILE
	JRST	HXFR		;LOOP TILL DONE
	PAGE

;CLOSE THE FILE

HCLOSE:	HRRZ	1,JFN		;GET THE JFN
	CLOSF			;CLOSE THE FILE
	 ERCAL	FILEER		;ERROR
HELPX:	SETZM	ERFLG		;CLEAR LOCAL ERROR FLAG
	GET	1		;RESTORE
	GET	2
	GET	3
	RTN			;AND EXIT

;TABLE OF POINTERS. WHERE TO LOOK FOR THE HELP FILE

HTBL:	-1,,[ASCIZ/SYS:FORMAT.HLP/]
	-1,,[ASCIZ/HLP:FORMAT.HLP/]
	-1,,[ASCIZ/FORMAT.HLP/]
	Z			;MARKS THE END OF THE TABLE

SUBTTL ROUTINES TO DEAL WITH THE DEVICE AS A STRUCTURE

	XLIST
	BOX <FIND - - FIND DEVICE USING MSTR JSYS>,<
	THIS ROUTINE IS PASSED THE SIXBIT NAME OF THE DEVICE THE
	OPERATOR WANTS TO USE. HAVING THE NAME IT INTERROGATES
	THE SYSTEM RESOURCES FOR AN AVAILABLE DRIVE OF THAT TYPE.
	AFTER FINDING A DRIVE IT ASKS THE OPERATOR TO MOUNT HIS PACK
	AND CYCLE UP THE DRIVE. THIS ROUTINE WILL NOT RETURN IF
	IT DOES NOT FIND A USEABLE DEVICE OF THE DESIRED TYPE BUT
	FATALS BACK TO THE MONITOR. THIS SEEMS REASONABLE SINCE THE
	PROGRAM CAN DO NOTHING MORE ANYHOW.

	IN ORDER FOR THE DEVICE TO BE USEABLE IT MUST BE ....
	 1. A DISK OF THE RIGHT TYPE (RP05 AND RP04'S ARE INTERCHANGABLE)
	 2. THE DEVICE MUST NOT BE PART OF A STRUCTURE.
	 3. THE DEVICE MUST NOT BE IN USE BY AN ON LINE DIAGNOSTIC
	 4. THE UNIT MUST BE OFF-LINE
	 5. THE OPERATOR MUST CONFIRM THE SELECTION ONCE A CANDIDATE IS FOUND.

	CALL SEQ:
	MOVE	1,[SIXBIT/NAME/]
	GO	FIND		;CALL THE ROUTINE
	RTN			;RETURN >

FIND:	PUT	0		;SAVE THE AC'S
	PUT	1
	PUT	2
	PUT	X
	MOVE	2,1		;GET THE NAME TO AC1
	MOVEI	1,NAMTBL	;GET TABLE POINTER
	GO	TSCAN		;LOOK UP THE NAME
	FATAL			;NOT FOUND
	MOVEM	1,INDEX		;SUSPECT THIS WAS ALREADY DONE
	MOVEI	X,ARGBLK	;GET ADDR OF ARG BLOCK FOR INDEX
	SETOM	.MSRCH(X)	;-1 TO CHAN ENTRY OF BLOCK
	SETOM	.MSRCT(X)	;-1 TO CONTROLLER ENTRY OF BLOCK
	SETOM	.MSRUN(X)	;-1 TO UNIT ENTRY OF BLOCK
FINDN:	SETZM	.MSRST(X)	;CLEAR STATUS ENTRY OF BLOCK
	MOVE	2,[ARGBLK+.MSRST,,ARGBLK+.MSRST+1] ;BLT POINTER
	BLT	2,ARGBLK+ARGLN-1 ;CLEAR THE REST OF THE BLOCK
	MOVE	1,[.MSRLN,,.MSRNU] ;TO GET STATUS OF THE NEXT UNIT
	MOVEI	2,ARGBLK	;ADDR OF THE ARGUMENT BLK
MS:	MSTR			;DO THE JSYS
MSR1:	 ERCAL	FINDER		;CALL THE ERROR HANDLER FOR THIS JSYS
MSR2:	CAIN	2,MSTX27	;ERR (IS THE UNIT A DISK ?)
	JRST	FINDN		;UNIT NOT A DISK. TRY FOR ANOTHER
	PAGE
;WE HAVE A DISK. MAKE SURE IT MEETS ALL REQUIREMENTS TO BE USEABLE

	MOVE	1,.MSRST(X)	;GET UNIT STATUS FROM THE ARGUMENT BLK
	TLNE	1,(MS%MNT)	;ALREADY PART OF A STRUCTURE ?
STROK:	JRST	FINDN		;YES. TRY FOR ANOTHER
	TLNE	1,(MS%DIA)	;BEING USED BY AN ON-LINE DIAG ?
DIAOK:	JRST	FINDN		;YES. TRY FOR ANOTHER
	TLNN	1,(MS%OFL)	;IS THE UNIT OFF-LINE
ONOK:	JRST	FINDN		;NO. TRY FOR ANOTHER
	LDB	0,[POINT 9,1,17] ;GET THE MONITOR DRIVE TYPE

;SOME SPECIAL CODE TO TREAT RP04'S AND 5'S INTERCHANGEABLY

	MOVE	1,-2(P)		;GET THE SIXBIT NAME
	CAMN	1,[SIXBIT/RP04/] ;IS IT RP04 ?
	JRST	LK45		;YES GO CKECK FOR CORRECT TYPE
	CAME	1,[SIXBIT/RP05/] ;IS IT RP05 ?
	JRST	OTHR		;SOMTHING BESIDES RP04 OR RP05
LK45:	CAIN	0,.MSRP4	;IS IT AN RP04 ?
	JRST	DIAL		;YES. GO DO DIALOGUE
	CAIE	0,.MSRP5	;IS IT AN RP05 ?
	JRST	FINDN		;NOPE. TRY FOR ANOTHER DRIVE
	JRST	DIAL		;YES. GO DO DIALOGUE

;TEST FOR DRIVES OTHER THAN RP04'S AND 5'S

OTHR:	MOVE	3,INDEX		;GET INDEX VALUE
	CAME	0,MSTYPE(3)	;TABLE LOOKUP AND TEST
	JRST	FINDN		;NO MATCH. TRY NEXT DRIVE

;FOUND A CANDIDATE. SEE IF OPERATOR GIVES THE OK

DIAL:	MOVE	DRIVE,.MSRUN(X)	;GET DRIVE #
	MOVE	MBCN,.MSRCH(X)	;GET CHAN # FROM ARG BLOCK
	ROT	MBCN,^D-10	;START TO CONVRT TO A DEVICE CODE
	ADD	MBCN,[054000,,0] ;CONVERT TO DEVICE CODE
	TEXTF	[ASCIZ/THE FOLLOWING UNIT IS AVAIL. /]
	GO	TELWHO		;IDENTIFY THE DEVICE
	TEXTF	[ASCIZ/
DO YOU WISH TO USE THIS ONE ?/]
	GO	QSTN		;ASK THE QUESTION
	FATAL			;TIMEOUT
	JRST	FINDN		;ANSWER NO. GET ANOTHER
	JFCL			;ANS WAS YES.
	MOVEI	1,[ASCIZ/
CYCLE UP PACK TO BE FORMATTED AND WRITE ENABLE THE DRIVE/]
	GO	OPRACT		;WAIT TILL HE FINISHES
	GET	X		;REXTORE THINGS
	GET	2
	GET	1
	GET	0
	RTN
	XLIST
	BOX <CHKNAM - - ADDITIONAL DATA PROTECTION ROUTINE>,<
	DOES AN MSTR JSYS TO GET STATUS AFTER THE PACK IS ON LINE
	IF THE PACK HAS A VALID NAME IT WILL REQUIRE THE USER TO 
	CONFIRM BEFORE CONTINUING WITH THE FORMAT OPERATION. THIS
	IS HIS LAST CHANCE. IF IT CANT RECOGNIZE THE PACK NAME IT
	WILL PROCEED WITHOUT REQUIRING CONFIRMATION.
	CALL SEQ:
	GO	CHKNAM		;CALL THE ROUTINE
	RTN1			;ABORT OPERATION
	RTN2			;CONTINUE AS ORDERED >
CHKNAM:	PUT	1		;SAVE AC'S
	PUT	2
	SETZM	ARGBLK		;CLEAR 1ST LOCATION
	MOVE	1,[ARGBLK,,ARGBLK+1] ;A BLT POINTER
	BLT	1,ARGBLK+ARGLN-1 ;CLEAR ENTIRE BLOCK
	GO	CLRBUF		;NOW CLEAR DATA BUFFER
	MOVEI	2,ARGBLK	;A POINTER TO THE BLOCK
	LDB	1,[POINT 3,MBCN,9] ;GET THE CHANNEL #
	MOVEM	1,.MSRCH(2)	;PUT IN ARGUMENT BLOCK
	SETOM	.MSRCT(2)	;-1 TO WD-1 OF THE BLOCK
	MOVEM	DRIVE,.MSRUN(2)	;PLUG IN THE DRIVE #
	HRROI	1,BUFFER	;USE DATA BUFFER TO SAVE PACK NAME
	MOVEM	1,.MSRSN(2)	;PUT POINTER IN THE BLOCK
	MOVE	1,[.MSRLN,,.MSRUS] ;BLOCK LENGTH AND FUNCTION
	MSTR			;READ THE STATUS
	 ERCAL	[GO MOUER
		 FATAL]

;GET STATUS FROM THE BLOCK, TEST, ACT ACCORDINGLY

	MOVEI	2,ARGBLK	;POINTER TO THE BLOCK
	MOVE	1,.MSTFL(2)	;GET THE FLAGS
	TLNE	1,(MS%BBB!MS%HBB) ;HOME OR BAT BLOCK BAD ?
	JRST	CXN1		;YES. (AT LEAST ONE)
	TEXTF	[ASCIZ/
PACK NAME IS: /]
	TEXTF	BUFFER		;PRINT NAME OUT OF BUFFER AREA
	TEXTF	[ASCIZ/
ARE YOU SURE YOU WANT IT RE-FORMATTED  ? /]
	GO	QSTN		;ASK THE QUESTION
	FATAL			;TIMEOUT
	SKIPA			;ANSWER NO. TAKE RTN-1
CXN1:	AOS	-2(P)		;BUMP FOR RTN-2
CXN2:	GET	2		;RESTORE
	GET	1
	RTN			;RETURN

	PAGE


;HERE IS THE ARGUMENT BLOCK FOR THE MSTR JSYS

	ARGLN=.MSRLN		;.MSRLN IS LONGEST. WORKS FOR ALL
ARGBLK:	BLOCK	ARGLN		;DEFINE THE BLOCK


;ERROR HANDLER FOR THE GET NEXT UNIT JSYS

FINDER:	MOVEI	1,400000	;SET UP PROCESS HANDLE
	GETER			;GET ERROR CODE
	 ERCAL	[RTN]
	HRRZ	2,2		;ERROR CODE IN AC2 (RIGHT)

	CAIN	2,MSTX27	;IS THE UNIT A DISK ?
	RTN			;NO. THEN GO BACK AND LOOK FURTHER
	CAIN	2,MSTX18	;NO MORE UNITS FOUND ?
	JRST	EXHAU		;EXHAUSTED POSSIBILITIES
	MOVE	1,2		;ERROR CODE TO AC1
	GO	JSYSE1		;HANDLE OTHER JSYS ERROR CONDITIONS
	FATAL			;AND BACK TO THE MONITOR

;FIELD ERRORS FROM THE MOUNT ATTEMPT AND VARIOUS FILE TYPE JSYS'S
FILEER:
MOUER:	SETOM	ERFLG		;FLAG THE FACT
	MOVEI	1,400000	;PROCESS HANDLE
	GETER			;GET THE ERROR
	 ERCAL	[RTN]
	MOVE	1,2		;ERROR CODE TO AC1
	GO	JSYSE1		;GO REPORT
	RTN			;THEN RETURN

;FIELD ERRORS FROM MOUNT COUNT INCREMENT ATTEMPT

MCTER:	GO	MOUER		;USE OTHER ROUTINE
	FATAL			;GIVE UP

EXHAU:	TEXTF	EXHM		;A FATAL MSG AN REASONS
	FATAL
	JRST 	START

	PAGE
;MSG PRINTED WHEN PGM CAN'T LOCATE A USEABLE DRIVE

EXHM:	ASCIZ/
SORRY - THERE ARE NO DRIVES OF THIS TYPE ON THE SYSTEM THAT ARE
AVAILABLE FOR USE IT THIS TIME. THE DRIVE MUST BE OFF-LINE AND NOT
IN USE BY AN ON-LINE DIAGNOSTIC TO BE SELECTED. TRY AGAIN LATER.

/
SUBTTL CODE TO SUPPORT CTRL-C & CTRL-T SOFTWARE INTERRUPTS
	XLIST
	BOX <SINON - TURN ON AND ENABLE FOR SOFTWARE INTERRUPTS.>,<
	CTRL-C AND CTRL-T ARE ENABLED.
	CALL SEQ:
	GO	SINON		;CALL THE ROUTINE
	RTN			;RTN >
SINON:	PUT	1		;SAVE AC'S
	PUT	2
	SETZM	CCFLG#		;CONTROL-C FLAG
	SETZM	CTFLG#		;CONTROL-T FLAG
	CIS			;CLEAR INT SYSTEM
	MOVEI	1,.FHSLF	;PROCESS HANDLE
	MOVE	2,[LEVTAB,,CHNTAB] ;IDENTIFY THE TABLES
	SIR			;MAKE THEM KNOWN TO MONITOR
	 ERCAL	[RTN]
	EIR			;ENABLE INTERRUPT SYSTEM
	 ERCAL	[RTN]
	MOVE	1,[.TICCC,,0]	;CTRL-C TO CHAN-0
	ATI			;LET MONITOR KNOW
	 ERCAL	[RTN]
	MOVE	1,[.TICCT,,1]	;CTRL-T TO CHAN-1
	ATI			;LET MONITOR KNOW
	 ERCAL	[RTN]
	MOVEI	1,.FHSLF	;THIS PROCESS
	MOVSI	2,600000	;IDENTIFIES CHANNELS 0 & 1
	AIC			;ACTIVATE SELECTED CHANNELS
	 ERCAL	[RTN]
	SETOM	SINTON#		;FLAG SAYS WERE NOW ON
	GET	2		;RESTORE
	GET	1
	RTN			;EXIT

	XLIST
	BOX <SINOFF - - DEACTIVATE CTRL-C & CTRL-T INTERRUPTS>,<
	CALL 	SEQ:
	GO	SINTOFF		;CALL IT.
	RTN			;RTN IS HERE >
SINOFF:	PUT	1		;SAVE THINGS
	PUT	2
	MOVEI	1,.FHSLF	;CURRENT PROCESS
	MOVSI	2,600000	;FOR CHANNELS 0 & 1
	DIC			;DISABLE THEM
	 ERCAL	[RTN]
	SETZM	CCFLG		;CLEAR CTRL-C FLAG
	SETZM	CTFLG		;AND CTRL-T FLAG
	SETZM	SINTON		;FLAG NOW SAYS WE'RE OFF
	GET	2		;RESTORE
	GET	1
	RTN			;EXIT

;HERE ARE THE NECESSARY SOFTWARE INTERRUPT TABLES

CHNTAB:	1,,CCSERV		;POINTER TO CTRL-C SERVICE
	1,,CTSERV		;POINTER TO CTRL-T SERVICE
	BLOCK	^D34		;NEXT 34 CHANNELS UNUSED

LEVTAB:	PCL1			;POINTS TO WHERE LEVEL 1 P.C. SAVED
	Z			;LEVELS 2 & 3 ARE NOT USED
	Z

PCL1:	Z			;P.C. STORED HERE

	XLIST
	BOX <CCSERV - CTSERV APPROPRIATE SERVICE ROUTINES>,<
	CALL SEQ:
	THERE IS NONE. WE ARRIVE HERE WITH THE OCCURANCE OF A SOFT-
	WARE INTERRUPT........ >

CCSERV:	SETOM	CCFLG		;SET THE CONTROL-C FLAG
	DEBRK			;DISMISS INTERRUPT

CTSERV:	SETOM	CTFLG		;SET THE CONTROL-T FLAG
	DEBRK			;DISMISS THE INTERRUPT


	XLIST
	BOX <SINTCK - CHECK FOR OCCURANCE OF INTERRUPT>,<
	CHECKS THE 2 INTERRUPT FLAGS AND SERVICES THEM IF NECESSARY
	CALL 	SEQ:
	GO	SINTCK		;CALL THE ROUTINE
	RTN			;RETURNS HERE >
SINTCK:	SKIPE	CCFLG		;CTRL-C FLAG SET ?
	PJRST	CTRLC		;YES. GO SERVICE IT
	SKIPE	CTFLG		;CONTROL-T FLAG SET ?
	PJRST	CTRLT		;YES. SERVICE IT
	RTN			;EXIT

;CTRL-C ORDERLY SHUTDOWN AND CONTINUE CODE

CTRLC:	RESET			;GENERAL CLEAR
	HALTF			;BACK TO MONITOR
	JRST	.+1		;HERE IF USER TYPES CONTINUE
	GO	ENABLE		;ENABLE PRIV ONCE MORE
	SETZM	CCFLG		;CLEAR CTRL-C FLAG
	SKIPE	SINTON		;WERE SOFT INT ON. ?
	GO	SINON		;YES. TURN EM' ON AGAIN
	RTN			;RETURN TO PROGRAM

;CTRL-T REPORT PROGRESS TO APPROX 1% ACCURACY

CTRLT:	SETZM	CTFLG		;CLEAR CTRL-T FLAG
	PUT	0		;SAVE
	PUT	1
	GO	TELTIM		;TELL TIME
	TEXTF	[ASCIZ/  OPERATION /]
	MOVE	0,SBLK		;GET START BLOCK
	IMULI	0,^D100		;*100.
	IDIV	0,MAXBLK	;CALCULATE PERCENTAGE
	SKIPGE	0,0		;IF NEG MAKE = 0
	MOVEI	0,0		;NOW = 0
	CAIGE	0,^D10		;DOUBLE DIGIT VALUE ?
	TEXTF	[ASCIZ/ /]	;NO. PAD IT
	GO	PSDN		;PRINT PERCENTAGE
	TEXTF	[ASCIZ/% COMPLETED. CURRENT BLOCK #/]
	SKIPGE	0,0		;IF NEG. MAKE = 0
	MOVEI	0,0		;NOW = 0
	MOVE	0,SBLK		;GET CURRENT BLOCK
	GO	PSDN		;PRINT AS SIGNED DECIMAL #
	PCRL			;SPACE TO NEXT LINE
	GET	1		;RESTORE
	GET	0
	RTN			;EXIT

	SUBTTL PGM STORAGE FOR TABLES AND KEY VARIABLES
	PAGE

;NAMES OF THE SUPPORTED DEVICES

NAMTBL:	SIXBIT	/RP04/
	SIXBIT	/RP05/
	SIXBIT	/RP06/
	Z			;TERMINATE UNTIL RM03 IS SUPPORTED
	SIXBIT	/RM03/
	Z

;MAXIMUM CYLINDER NUMBERS FOR THE DEVICES

CYLS:	^D410			;RP04
	^D410			;RP05
	^D814			;RP06
	^D822			;RM03
	Z

;MAXIMUM SURFACE NUMBERS FOR THE DEVICES

SURS:	^D18			;RP04
	^D18			;RP05
	^D18			;RP06
	^D4			;RM03
	Z

;MAXIMUM SECTOR NUMBERS FOR THE DEVICES IN 18 BIT MODE

SEC18:	^D19			;RP04
	^D19			;RP05
	^D19			;RP06
	^D29			;RM03
	Z

;MAXIMUM SECTOR NUMBERS FOR THE DEVICES IN 16 BIT MODE

SEC16:	^D21			;RP04
	^D21			;RP05
	^D21			;RP06
	^D31			;RM03
	Z

;WORDS PER SECTOR WRITTEN DURING WRITE HEADER OPERATIONS

WDSPS:	^D130			;RP04
	^D130			;RP05
	^D130			;RP06
	^D129			;RM03
	Z

	PAGE
;TABLE OF POINTERS TO ROUTINES THAT WILL GENERATE 3 SECTORS
;OF WORST CASE DRIVE DATA IN THE WRITE BUFFER

WCDTB:	GENW1			;FOR RP04
	GENW1			;FOR RP05
	GENW1			;FOR RP06
	GENW2			;FOR RM03
	Z

;TABLE OF POINTERS TO ROUTINES THAT WILL PLUG PROPER HEADER
;WORDS INTO THE WRITE BUFFER. FOR UP TO 3 SECTORS WORTH OF
;DATA. SEE THE WRITE UP FOR "UPDHD1" FOR A DESCRIPTION OF
;WHAT IS EXPECTED OF THE ROUTINE.

UPDAT:	UPDHD1			;FOR THE RP04
	UPDHD1			;FOR THE RP05
	UPDHD1			;FOR THE RP06
	UPDHD1			;FOR THE RM03
	Z

;POINTERS TO ROUTINES FOR BUILDING BAT BLOCK DATA IN THE BUFFER

BATDAT:	RPBAT			;FOR RP04
	RPBAT			;FOR RP05
	RPBAT			;FOR RP06
	RMBAT			;FOR RM03
	Z

	PAGE


;THIS TABLE SHOWS MONITOR TRANSLATION OF DRIVE TYPES AS THEY
;ARE RETURNED IN THE ARGUMENT BLOCK OF THE "MSTR" JSYS FOR
;FUNCTIONS ".MSRNU" OR ".MSRUS" . THESE TYPES COME FROM BITS 
;09 THRU 17 OF WORD ".MSRST" OF THE ARG BLOCK

MSTYPE:	.MSRP4			;FOR AN RP04
	.MSRP5			;FOR AN RP05
	.MSRP6			;FOR AN RP06
	11			;(.MSRM3 NOT YET IN MONSYM)
	Z			;THE END OF THE TABLE

;DERIVED VARIABLES (CALCULATED AT START UP TIME)

MAXCYL:	Z			;MAX CYLINDER NUMBER
MAXSUR:	Z			;MAX SURFACE NUMBER
MAXSEC:	Z			;MAX SECTOR NUMBER
MAXBLK:	Z			;MAX BLOCK NUMBER

BLKTOT:	Z			;TOTAL BLOCKS THIS PACK
BLKTRK:	Z			;TOTAL BLOCKS PER TRACK
BLKSUR:	Z			;TOTAL BLOCKS PER SURFACE
BLKCYL:	Z			;TOTAL BLOCKS PER CYLINDER

;NUMBER OF WORDS PER BLOCK DURING WRITE HEADER OPERATION

BLKSIZ:	Z			;DURING FORMAT OPERATION ONLY

;THE 16 BIT MODE FLAG

MODE16:	Z			;0 IMPLIES 18 BIT MODE

;NAME OF DEVICE BEING FORMATTED

NAME:	Z			;IN SIXBIT

;INDEX INTO TABLES (DERIVED FROM TYPE OF DEVICE)

INDEX:	Z			;A SMALL NUMBER

;SERIAL NUMBER OF DRIVE WE'RE FORMATTING ON

SERIAL:	Z			;THIS IS A BCD NUMBER


	PAGE
;HERE IS THE CCW BUFFER AREA

CBUFF:	BLOCK	10			;MORE THAN ENOUGH STORAGE

;SET UP A PATCH AREA

PATCH:	BLOCK	100

;HERE IS THE DATA BUFFER LOCATED TO EVEN PAGE

	LOC	<.+777>&777000
E:
BUFFER:	BLOCK	1000		;A FULL PAGE WORTH
	RELOC	BUFFER+1000

	END	START