.TITLE	LOGON1 OVERLAY FOR MULTIACCESS
/
/COPYRIGHT (C) 1976
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
/ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
/THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS
/SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO-
/VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON
/EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO
/THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE
/WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM-
/MITMENT BY DIGITAL EQUIPMENT CORPORATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
	.EJECT
/
/ EDIT #10	APRIL 5, 1976		M. HEBENSTREIT
/ EDIT #11	APRIL 14,1976		M. HEBENSTREIT (CTRL T SUPRESSION)
/ EDIT #12	APRE\IL 16,1976		M. HEBENSTREIT (MORE CTRL T)
/ 013	20-APR-76 (RCHM)	BAD NAME PRINTING SOLUTION.	/(013)
/ 014	18-MAY-76 (MJH)		TASK NOT IN ATL ERR MSG		/(014)
/								/(015)
/ 015	30-JUL-76 (EAG)		INSERT FLAG BITS SO THAT BATCH	/(015)
/				WILL IGNORE LOGON DIALOGUE	/(015)
/				MESSAGES.			/(015)
/								/(015)
/
/ THIS FILE IS AN OVERLAY TO THE MULTIACCESS TDV
/ DISPATCHER TASK. THE PURPOSE OF THIS OVERLAY IS TO
/ DETERMINE IF A CONTROL T HAS BEEN STRUCK. IF SO,
/ FIND OUT IF THE USER ON THE TERMINAL ASSOCIATED WITH
/ THE CONTROL T IS LOGGED IN. IF SO, PRINT HIS TASK
/ STATUS. IF NOT, TRY TO LOG HIM IN.  ACTUALLY THE LOGIN
/ PROCESS IS A TWO PASS PROCESS. THIS IS JUST THE 1ST
/ PASS. IN THIS OVERLAY A LUN BLOCK AND UCA ARE SETUP
/ FOR THE USER AND A READ IS ISSUED TO GET DISK UFD ETC.
/ THE OVERLAY LOGON2 HANDLES THE SYNTAX AND ASSIGNMENT
/ FOR THE USER.
/
/
/ ASSEMBLY PARAMETERS:
/
/	MA.NLU=TOTAL NUMBER OF LUNS IN USERS VIRTUAL LUN SPACE
/	MTUNIT=UNITS TO MARK TIME FOR
/	MTNUMU=NUMBER OF UNITS TO MARK TIME FOR
/
	.IFUND	MA.NLU
MA.NLU=31
	.ENDC
	.IFUND	MTUNIT
MTUNIT=2			/SECONDS
	.ENDC
	.IFUND	MTNUMU
MTNUMU=72			/60 DECIMAL SECONDS
	.ENDC
	.TITLE	GLOBALS AND EQUATES
/
/ MACRO TO DEFINE OFFSETS INTO THE USER CONTEXT AREA.
/
	.DEFIN UCAOFF
U.JSW=0				/OFFSET TO JOB STATUS WORD.
U.MAEV=1			/OFFSET TO EVENT VARIABLE
U.MAMTE=2			/OFFSET TO MARK TIME EVENT VARIABLE.
U.OEV=3				/OFFSET TO OVERLAY EVENT VARIABLE.
U.DSK=4				/OFFSET TO DISK NAME
U.DUN=5				/OFFSET TO DISK UNIT NUMBER
U.UFD=6				/OFFSET TO UFD NAME.
U.CTSK=7			/OFFSET TO CURRENT TASK NAME
U.PSC=11			/OFFSET TO PARTITION SELECTION CRITERIA.
U.ULOF=14			/OFFSET TO USER NUMBER AND LUN OFFSET.
U.TTYN=15			/OFFSET TO USER TERMINAL NUMBER.
U.TB=16				/OFFSET TO USER TERMINAL BUFFER.
U.CPB=62			/OFFSET TO MULTI-ACCESS CPB.
U.SSM=74			/SECONDS SINCE MIDNIGHT INTO STATE 11
				/ OR 12 (HUNG ON PARTITION)
U.TW=75				/TOTAL TIME IN SECONDS SPENT IN STATE 11
				/ OR 12.
U.OVID=76			/OVERLAY IDENTIFIER (LAST OVERLAY CALLED)
U.CKS=77			/CHECKSUM OF INPUT BUFFER FOR TIMED READ.
U.LEN=100			/LENGTH OF UCA.
	.DEFIN UCAOFF
	.ENDM
	.ENDM
/
/ EQUATES
/
	UCAOFF
	.EJECT
MA.UCA=221			/ADDRESS OF 1ST UCA
MA.CT=226			/CONTROL T WORD
MA.CY=227			/CONTROL Y WORD
MA.BLU=224			/BASE USER LUN
MA.ELU=225			/END USER LUN
IDX=ISZ				/USED TO INCREMENT
ECLA=641000			/CLA AS AN EAE
SHAL=660000			/AC0 TO LINK
.INH=705522			/INHIBIT INTERRUPTS
.ENB=705521			/ENABLE INTERRUPTS
HOUR=165			/HOUR OF DAY
MINUTE=164			/MINUTE OF HOUR
YEAR=170			/YEAR 
MONTH=166			/MONTH OF YEAR
DAY=167				/DAY OF MONTH
CURTSK=135			/POINTER TO CURRENT TASK ATL NODE
LUTP1=142			/BASE ADDRESS OF LUT
LUTP2=143			/LAST ADDRESS IN LUT
X10=10				/AUTOINCREMENT REG 10
X16=16				/AUTOINCREMENT REG 16
ATL=244				/ATL LIST HEAD
A.FP=0				/OFFSET OF ATL FORWARD POINTER
A.N1=2				/OFFSET OF 1ST 1/2 TASK NAME
A.N2=3				/OFFSET OF 2ND 1/2 TASK NAME
A.TS=7				/OFFSET TO TASK STATUS
A.RA=10				/OFFSET TO RESTART ADDRESS
A.PB=5				/OFFSET TO PARTITION BLOCK ADDRESS
P.N1=2				/OFFSET TO 1ST 1/2 OF PART NAME
P.N2=3				/OFFSET TO 2ND 1/2 OF PART NAME
	.EJECT
/
/ GLOBALS
/
	.GLOBL	TTY.UC		/ADDR OF TABLE OF TTY TO UCA
	.GLOBL	LOGON1		/ENTRY TO THIS OVERLAY
	.GLOBL	T.PEND		/LAST ADDRESS IN LAST UCA
	.GLOBL	MA.LBM		/USER LUN BIT MAP
	.GLOBL	RT.LBM		/REAL TIME LUN BIT MAP
	.GLOBL	TDVTYP		/TYPE SUBROUTINE
	.GLOBL	T.LUNS		/BASE TDV I/O LUN
	.GLOBL	MA.USR		/BIT MAP OF ACTIVE TTYS
	.TITLE	CONTROL T PROCESSOR
/
/ OVERLAY ENTRY POINT AND OVERLAY INITIALIZATION
/
LOGON1	0
	LAC	(LOGON1		/GET THE XR ADJUSTMENT
	AND	(70000
	DAC	MXRADJ		/SAVE INVERSE OF XR ADJUST
	TCA
	DAC	XRADJ		/SAVE THE XR ADJUSTMENT
/
/ DETERMINE TERMINAL ORIGINATING CONTROL T (IF ANY)
/
NEXTCT	LAC*	(MA.CT		/GET CONTROL T WORD FROM SCOM
	SNA			/ANY CONTROL TS?
	JMP*	LOGON1		/NO -- RETURN
	JMS	GETBIT		/YES -- FIND OUT WHICH TERMINAL
	DAC	TERMNL		/SAVE THE TERMINAL NUMBER
/
/ CLEAR BIT IN SCOM FLAG WORD INDICATING CONTROL T
/
	CLL			/CLEAR LINK TO SHOW THAT ONLY ONE
	JMS	MASK		/SHOULD BE SET IN AC ON RETURN
	.INH			/INHIBIT INTERRUPTS WHILE 
	XOR*	(MA.CT		/RESETTING CONTROL T WORD
	.ENB			/ENABLE INTERRUPTS
	DAC*	(MA.CT
/
/ GET THE TDV COMMUNICATION LUN FOR THIS TERMINAL
/
	LAC*	(MA.ELU		/GET LAST USER LUN FOR MULTIACCESS
	IAC			/INCREMENT
	TAD	TERMNL		/ADD TERMINAL
	DAC	LUN		/SAVE THE TDV IO LUN
/
/ DETERMINE IF USER HAS ALREADY LOGGED IN
/
	LAC	TTY.UC		/LOOK AT ENTRY RELATING TERMINAL
	TAD	TERMNL		/TO UCA SO WE CAN DETERMINE IF
	DAC	PTR		/USER IS LOGGED IN
	LAC*	PTR		/IS USER IN SYSTEM?
	SMA	
	JMP	STATUS		/YES -- THEN PRINT HIS STATUS
				/NO -- BEGIN LOGIN
/
	.TITLE	ALLOCATE SYSTEM RESOURCES FOR LOGIN
/
/ FIND A FREE UCA
/
	LAC*	(MA.UCA		/GET BASE OF 1ST UCA
	JMS	SETXR		/PREPARE TO ACCESS IT
	LAC*	T.PEND		/SET UP LR WITH PTR TO
	TAD	XRADJ
	PAL			/END OF LAST UCA
	DZM	CNTR1		/ZERO UCA COUNTER
NXTUCA	LAC	U.JSW,X		/IS THIS UCA BEING USED?
	SNA
	JMP	UCAFND		/NO -- ITS FREE
	IDX	CNTR1		/YES -- BUSY, BUMP UCA COUNT
	AXS	U.LEN		/INCREMENT XR TO NEXT UCA AND
	JMP	NXTUCA		/CHECK NEXT (SKP OF NONE AVAIL)
/
	JMP	ERBUSY		/NO UCAS ARE FREE -- ERROR
/
/ ASSIGN THE USER HIS NUMBER (UCA NUMBER)
/
UCAFND	PXA			/GET THE ADDRESS OF THE FREE UCA
	TAD	MXRADJ
	DAC	UCADDR		/SAVE THE ADDRESS
	LAC	CNTR1		/SHIFT USER NUMBER+UCA NUMBER 
	IAC			/INTO PROPER BITS SO LUN OFFSET
	ALS!SHAL  4		/CAN BE ADDED TO GET WORD FOR
	DAC	USRNUM		/MAPPED REQUEST
/
/ CHECK THE MULTIACCESS USER LUN BIT MAP FOR A FREE LUN BLOCK
/
	LAC*	MA.LBM		/GET USER LUN BIT MAP
	SNA			/ANY LUN BLOCKS FREE?
	JMP	CHRTBM		/NO -- CHECK THE REAL TIME BITMAP
	JMS	GETBIT		/YES -- GET LUN BLOCK NUMBER
	DAC	LBLKN		/SAVE THE LUN BLOCK NUMBER
	STL			/SET LINK TO SHOW AC SHOULD
	JMS	MASK		/HAVE ALL BUT 1 BIT SET ON RETURN
	AND*	MA.LBM		/CLEAR BIT SAYING THIS LUN
	DAC*	MA.LBM		/BLOCK IS AVAILABLE.
	JMP	GOTLUN		/USER NOW HAS BOTH LUNS AND UCA
/
/ CHECK REAL TIME LUN BIT MAP FOR POSSIBLE FREE LUN BLOCK
/
CHRTBM	LAC*	RT.LBM		/GET REAL TIME LUN BIT MAP
	DAC	TEMP		/SAVE TEMPORARILY
CHKBLK	LAC	TEMP		/GET MODIFIED BIT MAP
	SNA			/ANY MORE LUN BLOCKS TO CHECK?
	JMP	ERBUSY		/NO -- ERROR
	JMS	GETBIT		/YES -- GET BIT NUMBER OF A SET BIT
	DAC	LBLKN		/SAVE POTENTIAL LUN BLOCK NUMBER
	STL			/REMOVE BIT FROM TEMP
	JMS	MASK
	AND	TEMP
	DAC	TEMP		/SAVE NEW MODIFIED BIT MAP
/
/ CHECK TO SEE IF LUN BLOCK IS NOW DEASSIGNED
/
TEST	LAC	LBLKN		/GET THE BLOCK NUMBER
	MUL!SHAL		/GET THE LUN OFFSET TO THIS BLOCK
	MA.NLU-1
	LACQ			/GET THE LUN OFFSET
	TAD*	(MA.BLU		/ADD BASE USER LUN
	TAD*	(LUTP1		/ADD START OF LUT TABLE
	AAC	-2		/ADD FUDGE FACTOR 
	DAC*	(X10		/SAVE IN X10 AS A POINTER TO LUT
	LAW	-MA.NLU+1	/GET COUNTER OF LUNS/BLOCK
	DAC	CNTR2
NXTLUN	LAC*	X10		/GET LUT TABLE ENTRY
	SZA			/ASSIGNED TO NONE?
	JMP	CHKBLK		/NO -- LUN BLOCK STILL IS IN USE
	ISZ	CNTR2		/YES -- DONE WITH BLOCK?
	JMP	NXTLUN		/NO -- PROCESS NEXT LUN
	LAC	LBLKN		/YES -- BLOCK IS NO LONGER IN USE!
	STL			/SET BIT TO SAY WE'LL BE ANDING
	JMS	MASK		/CONSTRUCT MASK
	AND*	RT.LBM		/REMOVE BIT
	DAC*	RT.LBM		/SAVE NEW RT BIT MAP
/
	.TITLE	PRIME MULTIACCESS FOR LOGIN DIALOGUE
/
/ INITIALIZE USER'S CONTEXT AREA (UCA)
/
GOTLUN	LAC	UCADDR		/SET TTY NUMBER TO UCA
	DAC*	PTR		/TABLE ENTRY
	LAC	TERMNL		/SAVE TERMINAL NUMBER IN UCA
	DAC	U.TTYN,X
/
	CLL			/SET BIT FOR TTY IN ACTIVE TTY BIT MAP
	JMS	MASK
	XOR*	MA.USR
	DAC*	MA.USR
/
	DZM	U.PSC,X		/SET DEFAULT PARTITION
	LAC	(1400		/SELECTION CRITERIA TO
	DAC	U.PSC+1,X	/+1400
	DZM	U.PSC+2,X
/
				/CONCATENATE LUN OFFSET AND UCA NUMBER
	LAC	LBLKN		/GET LUN BLK NUMBER
	MUL!SHAL		/MULTIPLY BY LUNS/BLK
	MA.NLU-1
	LACQ			/GET OFFSET
	TAD*	(MA.BLU		/ADD BASE USER LUN
	ALS	11		/SHIFT TO MAKE ROOM FOR UCA NUMBER
	TAD	USRNUM		/GET UCA NUMBER IN THERE
	DAC	U.ULOF,X	/SAVE IN UCA
/
	DZM	U.CKS,X		/ZERO BUFFER CHECKSUM
/
	LAC	UCADDR		/ZERO COMMAND BUFFER IN UCA
	AAC	U.TB-1
	DAC*	(X10
	LAW	U.TB-U.CPB
	DAC	CNTR2
	DZM*	X10
	ISZ	CNTR2
	JMP	.-2
/
	.TITLE	BEGIN LOGIN DIALOGUE
/
/ SETUP READ AND MARKTIME CPBS
/
	LAC	UCADDR		/GET ADDRESS OF UCA
	AAC	U.MAEV		/ENTER READ EV INTO READ CPB
	DAC	READ+1
	AAC	U.MAMTE-U.MAEV	/ENTER MARK TIME EV INTO CPB
	DAC	MARK+1
	AAC	U.TB-U.MAMTE	/ENTER MESSAGE BUFFER ADDRESS INTO READ CPB
	DAC	READ+4
/
/ PRINT HELLO
/
	LAC	(MSGCR		/RETURN CARRIAGE
	JMS	TYPE
	LAC	(MSGCR		/PRINT BLANK LINE		(011)
	JMS	TYPE		/				(011)
	LAC	(MSGH1		/PRINT MESSAGE
	JMS	TYPE
/
/ PRINT TIME AND DATE
/
	LAC	(BUFF		/GET BUFFER ADDRESS
	JMS	IPACK		/INIT OUTPUT BUFFER
	LAC*	(MONTH		/GET MONTH
	JMS	NMPK		/PACK DIGITS INTO BUFFER
	JMS	SLASH		/PACK A SLASH
	LAC*	(DAY		/GET DAY
	JMS	NMPK		/PACK DIGITS INTO BUFFER
	JMS	SLASH		/PACK A SLASH
	LAC*	(YEAR		/GET YEAR 1970 STORED AS 70
	.DEC
	TAD	(1900		/MAKE IT INTO REAL YEAR
	.OCT
	JMS	NMPK		/PACK DIGITS INTO BUFFER
	JMS	SPACE		/PACK A SPACE
	JMS	SPACE		/AND ANOTHER
	LAC*	(HOUR		/GET HOUR
	JMS	NMPK		/PACK INTO BUFFER
	LAC	(72		/PACK A COLON
	JMS	PACK
	LAC*	(MINUTE		/GET MINUTE
	JMS	NMPK		/PACK THOSE DIGITS
	LAC	(15		/PACK A CARRIAGE RETURN
	JMS	PACK
	LAC BUFF		/ SET FLAG BIT IN HEADER WORD	/(015)
	RAL!STL			/ SO THAT BATCH WILL IGNORE	/(015)
	RAR			/ THIS MESSAGE.			/(015)
	DAC BUFF						/(015)
	LAC	(BUFF		/TYPE MESSAGE
	JMS	TYPE
/
/ PRINT THE NUMBER OF USERS ALREADY LOGGED IN
/
	LAC	TTY.UC		/GET ADDRESS OF TABLE SHOWING UCA USE
	AAC	-1		/ADJUST FOR AUTOINC USE
	DAC*	(X10		/USE X10 AS A TABLE POINTER
	LAW	-22		/SET UP TABLE ENTRY COUNTER
	DAC	CNTR1
	DZM	CNTR2		/CLEAR USER COUNT
NXTUSR	LAC*	X10		/IS UCA IN USE BY THIS TTY?
	SMA
	IDX	CNTR2		/YES -- BUMP USER COUNT
	ISZ	CNTR1		/NO -- END OF TABLE?
	JMP	NXTUSR		/NO -- CONTINUE
				/YES --
/
	LAC	(BUFF
	JMS	IPACK		/INIT OUTPUT BUFFER
	LAC	CNTR2		/GET NUMBER OF USERS
	AAC	-1		/SUBTRACT 1 FOR THIS USER
	JMS	NMPK		/PACK DIGITS INTO BUFFER
	JMS	SPACE		/PACK A SPACE
	JMS	SPACE		/AND ANOTHER
				/
				/NOW BUFF HAS A HEADER AND UP TO 4 CHARS
				/THIS IS IN ASCII UP TO 2 DIGITS PLUS SPACES
				/THEREFORE IF THE 1ST DATA WORD OF THIS
				/BUFFER IS MOVED TO THE 1ST DATA WORD
				/OF THE MESSAGE 'XX  USERS LOGGED IN'
				/THE XX IN THE MESSAGE WILL BE REPLACED
				/BY THE NUMBER OF USERS AND A FEW SPACES!
/
	LAC	BUFF+2		/MOVE 1ST WORD
	DAC	MSGUSR+2	/(NUMBER OF USERS)
/
	LAC	(MSGUSR		/TYPE THE MESSAGE
	JMS	TYPE
/
	LAC	(MSGDSK		/PRINT DISK UNIT AND UFD PROMPT
	JMS	TYPE
/
/ ISSUE READ AND MARK TIME CALS
/
	CAL	READ
	CAL	MARK
/
/ FINISH PROCESSING INITIAL PART OF LOGIN
/
	LAC	UCADDR		/GET UCA
	JMS	SETXR		/PREPARE TO ACCESS IT
	CLA!IAC			/SET OVERLAY EV AND JOB STATUS
	DAC	U.JSW,X
	DAC	U.OEV,X
	LAC	ONAM		/SET OVERLAY NAME
	DAC	U.OVID,X
	JMP	NEXTCT		/GO CHECK NEXT TERMINAL FOR CONTROL T.
	.TITLE	PRINT JOB STATUS
/
/ DETERMINE USERS JOB STATE
/
STATUS	DAC	UCADDR		/SAVE UCA ADDRESS
	DZM	PARNM1		/ZERO TASKS PARTITION NAME
	DZM	PARNM2
	JMS	SETXR		/PREPARE TO ACCESS IT
	LAC	U.JSW,X		/GET JOB STATUS WORD
	SAD	(3		/WAITING FOR FININS?
	JMP	WFFIN		/YES -- GO TELL USER
	SAD	(7		/NO -- WAITING FOR FININS SO IT CAN ABORT?
	JMP	WFABO		/YES 
	SAD	(11		/NO -- NRM CUSP WAITING FOR PART?
	JMP	WFLIST		/YES
	SAD	(12		/NO -- USER TASK WAITING FOR PART?
	JMP	WFLIST		/YES
	SAD	(4		/NO -- USER TASK IN ATL?
	JMP	ATLPR		/YES 
	SAD	(5		/NO -- NRM CUSP IN ATL?
	JMP	ATLPR		/YES
	SAD	(10		/NO -- EXEC MODE CUSP IN ATL?
	JMP	EATLPR		/YES
	SAD	(1		/NO -- LOGON READ PENDING?
	JMP	NEXTCT		/YES -- IGNORE IT!
	LAC*	T.LUNS		/NO -- GET LUN USED FOR A TDV READ
	TAD	U.TTYN,X	/(ADD BASE USER LUN+1+TERMINAL NUM.)
	DAC	ABORT+2		/PREPARE TO ABORT READ
ABO	CAL	ABORT		/ABORT THE READ
	CAL	WAIT
	LAC	EV		/WAS ABORT DONE?
	SPA
	JMP	ABO		/NO -- RE-ISSUE
	LAC	UCADDR		/GET UCA ADDRESS
	JMS	SETXR		/PREPARE TO ACCESS IT
	LAC	(6		/SET JOB STATE TO 6
	DAC	U.JSW,X
	LAC	(MSGTDV		/PRINT MESSAGE
	JMS	TYPE1
TYPCOM	LAC	UCADDR		/GET UCA
	JMS	SETXR		/PREPARE TO ACCESS
	LAC	ONAM		/PREP TO SET OVERLY NAME
	DAC	U.OVID,X	/SET IT
	CLA!IAC			/SET OVERLAY EVENT VARIABLE
	DAC	U.OEV,X
	JMP	NEXTCT		/GO CHECK FOR ANOTHER CONTROL T.
/
/ JOB STATUS PRINT ROUTINES
/
WFFIN	LAC	(MSGFIN		/PRINT WAITING FOR FININS
	JMP	COMPLT
WFABO	LAC	(MSGABO		/PRINT WAITING TO ABORT
	JMP	COMPLT
WFLIST	LAC	(MSGWFP		/PRINT WAITING FOR PARTITION
	JMP	COMPLT
EATLPR	LAC	U.CTSK,X	/SET EXEC MODE CUSP NAME INTO NAME BUFFER
	SKP			/EXEC MODE TASKS ARE NAMED XXX.NN
				/WHERE XXX IS 1ST 3 CHARS OF TASK NAME
ATLPR	LAC	UTN1		/SET TASK NAME INTO NAME BUFFER
	DAC	NAME1
	LAC	U.TTYN,X	/TASK NAME IS 'USR.NN' WHERE
	LRS!CLQ!SHAL 3		/NN IS OCTAL TTY UNIT
	ALS	3
	LLS	3
	TAD	(566060		/SAVE 2ND HALF OF TASK NAME
	DAC	NAME2		/SAVE TASK NAME
/
/ SCAN THE ATL FOR THIS TASK
/
ATLSCN	LAC*	(CURTSK		/BEGIN SCANNING ATL AT
	JMS	SETXR		/TDV'S ATL NODE
CONT	.INH			/INHIBIT INTERRUPTS
	LAC	A.FP,X		/GET FORWARD POINTER TO NODE
	SAD	(ATL		/END OF ATL?
	JMP	EXATL		/YES -- CAN'T FIND TASK NODE!!?????
	JMS	SETXR		/NO -- ACCESS NODE
	LAC	A.N1,X		/GET NAME FROM ATL AND COMPARE
	SAD	NAME1		/IS THER A MATCH?
	SKP
	JMP	NEXT		/NO
	LAC	A.N2,X
	SAD	NAME2
	SKP
	JMP	NEXT		/NO
	LAC	A.RA,X		/YES -- GET RESTART ADDR
	DAC	RESTAR		/SAVE
	LAC	A.TS,X		/GET TASK STATUS
	DAC	STAT
	.ENB			/ENABLE INTERRUPTS
	LAC	A.PB,X		/GET PART BLOCK NODE ADDRESS
	JMP	PRNTAT		/GO PRINT INFO
/
NEXT	.ENB			/ENABLE INTERRUPTS
	JMP	CONT		/GO PROCESS NEXT NODE
/
EXATL	.ENB			/TELL USER NO ATL ENTRY FOUND?
	LAC	(MSGSER
	JMP	COMPLT		/PROCESS NEXT CONTROL T
/
/ GOT THE STATUS SO PRINT IT
/
PRNTAT	JMS	SETXR		/PREPARE TO ACCESS PBDL NODE
	LAC	P.N1,X		/MOVE PARTITION NAME
	DAC	PARNM1
	LAC	P.N2,X
	DAC	PARNM2
	LAC	STAT		/GET TASK STATUS FROM ATL
	SAD	(1		/IS TASK ON DISK
	JMP	ONDISK		/YES
	SAD	(2		/IS TASK ON DISK BUT WITH PARTITION?
	JMP	ONDISK		/YES
	SPA			/IS TASK LOADING?
	JMP	ONDISK		/YES
	SAD	(3		/NO -- IS TASK WAITING FOR AN EV?
	JMP	WF		/YES
	SAD	(6		/NO -- IS TASK SUSPENDED?
	JMP	SUS		/YES
	LAC	(MSGRUN		/NO -- MUST BE RUNNING
	JMP	COMPLT		/PRINT MESSAGE AND CHECK NEXT CONTROL T
SUS	LAC	(MSGSUS		/TELL USER TASK SUSPENDED
	JMP	COMPLT
ONDISK	LAC	(MSGOND		/TELL USER TASK ON DISK
	JMP	COMPLT
WF	LAC	(MSGWFV		/TASK IS WAITING FOR EV		(012)
	JMS	TNPN		/PACK TASK NAME, PARTITION AND MSG (012)
	LAC	RESTAR		/PACK RESTART ADDR		(012)
	JMS	PONUM		/				(012)
	SKP			/				(012)
/
/ FINISH STATUS PRINTOUT
/
COMPLT	JMS	TNPN		/PRINT TASK NAME PART AND MSG	(012)
	LAC	(15		/PACK A CR			(012)
	JMS	PACK		/				(012)
	LAC	(BUFF		/PREPARE TO PRINT		(012)
	JMS	TYPE1		/GO PRINT MESSAGE		(012)
	JMP	TYPCOM		/TYPEIN IS DONE			(012)
	.TITLE	SUBROUTINES
/
/ SUBROUTINE TNPN -- PACK TASK NAME AND PARTITION NAME AND MESSAGE IN AC ON ENTRY
/
/	ON ENTRY PARNM1 AND PARNM2 HAVE PARTITION NAME
/	AND U.CTSK HAS TASK NAME.
/
/	ALL REGISTERS ARE MODIFIED ON EXIT
/
TNPN	0
	DAC	TNPNMS		/SAVE MSG ADDR			(012)
	LAC	UCADDR		/PREPARE TO ACCESS UCA
	JMS	SETXR
	LAC	(BUFF		/INIT BUFFER
	JMS	IPACK
	LAC	U.CTSK,X
	JMS	CHAR		/PACK THOSE CHARS IN NAME
	LAC	U.CTSK+1,X
	JMS	CHAR
	JMS	SPACE		/PACK SPACES
	JMS	SPACE
	LAC	PARNM1		/PACK PART NAME
	SNA			/IS IT ZERO?
	JMP	TNPN1		/YES -- DON'T PACK IF NULL
	JMS	CHAR
	LAC	PARNM2
	JMS	CHAR
	JMS	SPACE		/PACK SPACES
	JMS	SPACE
TNPN1	LAC	TNPNMS		/GET THE MESSAGE ADDR		(012)
	JMS	IFAC		/INIT UNPACKING ROUTINE		(012)
TNPN2	JMS	FAC		/UNPACK A CHAR IN MESSAGE	(012)
	SAD	(15		/CR?				(012)
	JMP*	TNPN		/YES -- RETURN			(012)
	JMS	PACK		/NO -- PACK CHAR		(012)
	JMP	TNPN2		/GO LOOK FOR NEXT CHAR		(012)
/
TNPNMS	0			/MESSAGE ADDRESS BUFFER		(012)
/
/ SUBROUTINE TYPE -- TYPE THE MESSAGE WHOSE ADDRESS IN AC ON ENTRY
/
/	ALL REGISTERS MODIFIED ON RETURN
/
TYPE	0
	DAC	TYPMES		/SAVE MESSAGE ADDRESS
	JMS*	TDVTYP		/CALL THE READL TYPING ROUTINE
	LAC	TERMNL
	LAC	TYPMES
	LAC	(2		/ONLY IOPS ASCII MESSAGES CAN BE SENT FROM HERE
	JMP*	TYPE		/RETURN
/
TYPMES	0			/ADDR OF MESSAGE TO BE TYPED
/
/ TYPE1 -- SAME AS TYPE BUT BE SURE TO CMA TTY UNIT
/
TYPE1	0
	DAC	TYPMES
	LAC	TERMNL
	CMA
	DAC	TYPE1V
	JMS*	TDVTYP
	LAC	TYPE1V
	LAC	TYPMES
	LAC	(2
	JMP*	TYPE1
/
TYPE1V	0			/CMA OF TTY UNIT
	.EJECT
/
/ SUBROUTINE CHAR -- TRANSLATE AC IN SIXBT TO ASCII IN BUFFER
/
/	ON ENTRY AC MUST HAVE A SIXBT NAME
/
CHAR	0
	LMQ			/LOAD MQ WITH WORD
	JMS	SHIFT		/PACK A CHAR
	JMS	SHIFT		/PACK 2ND CHAR
	JMS	SHIFT		/PACK 3RD CHAR
	JMP*	CHAR		/RETURN
/
/ SUBROUTINE SHIFT -- SHIFT A DIGIT OUT OF MQ AND PACK NUMBER
/
SHIFT	0
	CLA			/REMOVE DEBREE FROM AC
	LLS	6		/SHIFT A DIGIT INTO AC
	SNA			/IS IT NULL?
	JMP*	SHIFT		/YES -- IGNORE
	AAC	-40		/NO -- CONVERT TO ASCII
	SPA
	AAC	100
	AAC	40
	JMS	PACK
	JMP*	SHIFT
	.EJECT
/
/ SUBROUTINE PONUM -- PACK OCTAL NUMBER IN AC
/
PONUM	0
	LMQ			/SAVE NUMBER
	LAW	-6		/SETUP CHAR COUNTER
	DAC	PONCNT
PON1	CLA			/PREPARE TO SHIFT DIGIT
	LLS	3		/SHIFT
	AAC	60		/MAKE IT INTO ASCII
	JMS	PACK		/PACK NUMBER INTO BUFFER	(012)
	ISZ	PONCNT		/DONE?
	JMP	PON1		/NO -- CONTINUE
	JMP*	PONUM		/RETURN
/
PONCNT	0			/OCTAL NUMBER COUNTER
	.EJECT
/
SETXR	0			/STD. SUBROUTINE TO SETUP XR
	TAD	XRADJ
	PAX
	JMP*	SETXR
/
SLASH	0			/ROUTINE TO PACK A SLASH
	LAC	(57
	JMS	PACK
	JMP*	SLASH
/
SPACE	0			/ROUTINE TO PACK A SPACE
	LAC	(40
	JMS	PACK
	JMP*	SPACE
/
	.EJECT
/
/ SUBROUTINE NMPK -- MAKE NUMBER IN AC INTO DECIMAL ASCII
/
/	ON ENTRY AC HAS NUMBER
/	ON EXIT AC AND X16 MODIFIED
/
NMPK	0
	DAC	NMPKV1		/SAVE NUMBER
	LAW	-3		/SETUP DIGIT COUNTER
	DAC	NMPKV2
	DZM	NMPKV3		/ZERO NON-ZERO PRINT FLAG
	LAC	(NMPKT-1	/USER X16 AS DIVISION TABLE PTR
	DAC*	(X16
NMPK1	LAC*	X16		/GET DIVISOR FROM TABLE
	DAC	NMDIV		/SAVE FOR DIVISION
	LAC	NMPKV1		/GET NUMBER
	LMQ!ECLA!SHAL		/ENTER INTO MQ
	DIV			/DIVIDE TO GET DIGIT
NMDIV	XX
	DAC	NMPKV1		/SAVE REMAINDER
	LACQ			/GET QUOTIENT
	SNA			/ZERO?
	JMP	NMPK2		/YES -- SUPPRESS LEADING ZEROES
	AAC	60		/NO -- MAKE ASCII
	JMS	PACK		/PACK
	IDX	NMPKV3		/SET FLAG TO SHOW THAT ZEROS MUST PRINT
NMPK3	ISZ	NMPKV2		/DONE?
	JMP	NMPK1		/NO
	LAC	NMPKV1		/YES -- GET REMAINDER
	AAC	60		/MAKE IT A CHAR
	JMS	PACK		/PACK THE LAST DIGIT
	JMP*	NMPK		/RETURN
/
NMPK2	LAC	NMPKV3		/SHOULD  ZEROS BE SUPPRESSED?
	SNA!CLA
	JMP	NMPK3		/YES -- IGNORE ITS A LEADING ZERO
	AAC	60		/NO -- PRINT THE ZERO
	JMS	PACK
	JMP	NMPK3
/
NMPKV1	0			/NUMBER BEING PACKED INTO BUFFER
NMPKV2	0			/DIGIT COUNTER
NMPKV3	0			/ZERO PRINT FLAG(0 DON'T PRINT;NOT 0 PRINT)
NMPKT=.			/TABLE OF DIVISORS
GRAND=.
	.DEC
	1000
	100
	10
	.OCT
	.EJECT
/
/ SUBROUTINE MASK -- MAKE A MASK IN AC
/
/	ON ENTRY AC HAS BIT NUMBER OF DIFFERENT BIT 
/	ON ENTRY LINK IS SET OR CLEARED TO SHOW IF
/	MOST BITS IN MASK SHOULD BE SET OR CLEARED
/
/	ON RETURN AC= E.G.  776777 OR 001000
/
MASK	0
	TAD	(LRS		/ADD SHIFT COUNT TO LRS
	DAC	.+4		/SAVE IN IMPURE CODE
	LAC	(400000		/GET MASK
	SZL			/SHOULD MOST BITS BE SET?
	CMA			/YES -- SET THEM
	XX			/NO -- SHIFT
	JMP*	MASK		/EXIT WITH MASK IN AC
/
/ SUBROUTINE GETBIT -- FIND OUT WHICH BIT IS SET
/
/	ENTER WITH AC CONTAINING BIT MAP
/	ON EXIT AC CONTAINS BIT NUMBER (0,1,2,3,....)
/
GETBIT	0
	LMQ!ECLA		/STICK BIT MAP INTO MQ
	NORM			/SHIFT
	LACS			/GET STEP COUNT
	XOR	(777700		/MAKE IT NEGATIVE
	AAC	23		/ADD FUDGE FACTOR TO
	JMP*	GETBIT		/GET BIT NUMBER AND RETURN
	.EJECT
/
/ EDIT #1 	APRIL 8, 1974		M. HEBENSTREIT
/
/ THE STANDARD DOS-15 PACKING SUBROUTINES
/ ENTRY TO IPACK WITH AC=BUFFER ADDRESS
/ ENTRY TO PACK WITH AC=CHARACTER
/
/ THIS PAIR OF SUBROUTINES WILL SET UP THE HEADER WORD PAIR AS WELL
/ AS PACK CHARACTERS INTO THE BUFFER.
/
/
SHAL=660000
/
IPACK	0
	DAC	KLBUFH
	TAD	L2
	DAC	KLPUTP
	DZM	KL57
	DZM	CHRCNT
	LAC	(1000
	DAC*	KLBUFH
	JMP*	IPACK
/
PACK	0
	ISZ	CHRCNT
	AND	L177
	DAC	KLCHR2
	CLL
	LAC	KL57
	TAD	(JMP*	KLJ57
	DAC	.+2
	LAC	KLCHR2
	XX
KLJ57	KL571
	KL572
	KL573
	KL574
	KL575
KL571	LAC	(1000						/(013)
	TAD*	KLBUFH
	DAC*	KLBUFH
	LAC KLCHR2	/ FETCH CHARACTER TO BE STORED.		/(013)
	ALS!SHAL	13
KL571A	DZM*	KLPUTP
	JMP	KLND57
KL572	ALS!SHAL	4
	JMP	KLND57
KL573	RTR
	RAR
	AND	L17
	XOR*	KLPUTP
	DAC*	KLPUTP
	ISZ	KLPUTP
	LAC	KLCHR2
	ALS!SHAL	17
	JMP	KL571A
KL574	ALS!SHAL	10
	JMP	KLND57
KL575	RCL
	DZM	KL57
	SKP
KLND57	ISZ	KL57
	XOR*	KLPUTP
	DAC*	KLPUTP
	LAC	KL57
	SNA
	ISZ	KLPUTP
	LAC	KLCHR2
	JMP*	PACK
/
KL57	0
KLPUTP	0
KLBUFH	0
KLCHR2	0
CHRCNT	0
L2	2
L177	177
L17	17
/
	.EJECT
/
/  FETCH A CHARACTER SUBROUTINES FOR TDV
/
/  'IFAC'
/
/  THIS ROUTINE IS CALLED WITH THE MESSAGE ADDRESS IN THE AC
/  TO INITIALIZE THE BUFFER UNPACK
/
/  'FAC'
/
/  THIS ROUTINE IS CALLED TO FETCH EACH CHARACTER
/  CHARACTER IS RETURNED IN THE AC RIGHT JUSTIFIED, LINK=0.
/
/  MODIFIED REGISTERS, AC, LINK.
/
/  ANY CALLS MADE BEYOND THE TERMINATORS <CR> AND <ALT>
/  WILL AGAIN RETURN THE TERMINATOR.
/
IDX=ISZ			/NO ISZ GENERATED SKIPS HERE
/
IFAC	0
	AAC	2	/ADDR OF 1ST WD IN MESSAGE WITH ASCII	(012)
	DAC	FETCHP	/FETCH POINTER, INDIRECT SINCE <32K
	LAC	(FETCH1	/POINTER TO ACTION TO GET FIRST OF 5
	DAC	FETCHX	/DISPATCHER
	JMP*	IFAC
/
FAC	0
	LAC*	FETCHP	/FIRST STEP OF ALL FETCHES
	JMP*	FETCHX	/GO TO APPROPRIATE ACTION
FETCHX	XX
	AND	(177	/STRIP TO 7 BITS
	SAD	(15	/CHECK FOR TERMINATOR
	JMP	FETCHE	/SET UP TO RETURN TERMINATOR FOREVER
	SAD	(175	/ALT IS OTHER TERMINATOR
	JMP	FETCHE
FETCHY	CLL		/LINK CLEAR IN CASE USER SHIFTS
	JMP*	FAC	/RETURN CHAR IN AC
/
FETCHL	JMS	FETCHX	/END OF FIFTH, LEAVE POINTER FOR FIRST
/
FETCH1	SWHA		/CHAR 1, SHIFT DOWN 11 PLACES
	RTR		/CHAR POSITIONED
	JMS	FETCHX	/LEAVE POINTER TO SECOND ACTION
/
FETCH2	RTR		/MOVE SECOND CHAR DOWN 4
	RTR
	JMS	FETCHX	/LEAVING POINTER TO THIRD ACTION
/
FETCH3	RAR		/MOVE TOP HALF DOWN TO TOUCH BOTTOM
	IDX	FETCHP	/MOVE DATA POINTER TO NEXT
	XOR*	FETCHP	/DOUBLE XOR MERGE
	AND	(7	/KEEP ONLY THESE 3 BITS ORIG. AC
	XOR*	FETCHP	/OTHER FIFTEEN BITS FROM FETCHP
	RTL		/CHAR UP TO FINAL PLACE
	RTL
	JMS	FETCHX	/LEAVING POINTER FOR FOURTH
/
FETCH4	RAL
	SWHA
	JMS	FETCHX	/LEAVING FIFTH POINTER
/
FETCH5	RAR
	IDX	FETCHP	/MOVE TO NEXT ASCII PAIR
	JMP	FETCHL	/BACK TO TOP TO KEEP GOING
/
/
FETCHE	DAC	FETCHP	/SAVE TERMINATOR
	LAC	(FETCHZ	/VECTOR TO FETCH TERMINATOR
	DAC	FETCHX
FETCHZ	LAC	FETCHP	/POINTER NO LONGER POINTER, BUT TERMI.
	JMP	FETCHY	/USER EXPECTS LINK CLEARED
/
FETCHP	(764000		/IMMEDIATE <ALT> IF UNINIT'ED
/
	.EJECT
	.TITLE	VARIABLES,MESSAGES, CPBS , ETC.
/
/ VARIABLES
/
XRADJ	0			/XR ADJUSTMENT
MXRADJ	0			/TWOS COMP OF XRADJ
ONAM	.SIXBT	"ON1"		/OVERLAY ID
NAME1	0			/TASK NAME 1ST 1/2
NAME2	0			/TASK NAME 2ND 1/2
UTN1	.SIXBT	"USR"		/1ST 1/2 USER TASK NAME
TEMP	0			/TEMPORARY STORAGE
PARNM1	0			/PART NAME 1ST 1/2
PARNM2	0			/PART NAME 2ND 1/2
TERMNL	0			/TTY UNIT NUMBER
PTR	0			/POINTER TO ENTRY IN TTY.UC
CNTR1	0			/GENERAL PURPOSE COUNTER
CNTR2	0			/GENERAL PURPOSE COUNTER
UCADDR	0			/ADDRESS OF USERS CONTEXT AREA
USRNUM	0			/USER NUMBER
LBLKN	0			/LUN BLOCK NUMBER
RESTAR	0			/TASK RESTART ADDRESS (WAITFR)
STAT	0			/ATL TASK STATUS
EV	0			/GENERAL PURPOSE EV
	.EJECT
/
/ ERROR PROCESSOR
/
ERBUSY	LAC	(MSBUSY		/PRINT ERROR MESSAGE
	JMS	TYPE
	JMP	NEXTCT		/CHECK FOR ANOTHER CONTROL T
				/THIS USER DOES NOT HAVE A UCA
				/SO DON'T TRY TO SET U.OVID ETC.
	.EJECT
/
/ CPBS
/
MARK	13			/MARK TIME
	XX			/EVENT VARIABLE ADDRESS
	MTNUMU			/MARK TIME NUMBER OF UNITS
	MTUNIT			/MARK TIME UNITS
/
READ	2600			/READ
	XX			/EVENT VARIABLE ADDRESS
LUN	XX			/LOGICAL UNIT
	2			/MODE (IOPS ASCII)
	XX			/BUFFER ADDRESS
	U.CPB-U.TB		/MAX BUFFER SIZE
/
ABORT	1700			/ABORT I/O FOR A LUN
	EV			/EVENT VARIABLE
	XX			/LOGICAL UNIT
/
WAIT	20			/WAIT FOR EV
	EV			/EVENT VARIABLE ADDR
	.EJECT
/
/ MESSAGES
/
MSGCR	MSBUSY-MSGCR*400+400002		/ THIS MESSAGE IGNORED	/(015)
	0				/ BY BATCH.		/(015)
	.ASCII " "<15>
MSBUSY	MSGH1-MSBUSY*400+400002		/ THIS MESSAGE IGNORED	/(015)
	0				/ BY BATCH.		/(015)
	.ASCII "MULTIACCESS - TOO MANY JOBS"<15>
MSGH1	MSGUSR-MSGH1*400+400002		/ THIS MESSAGE IGNORED	/(015)
	0				/ BY BATCH.		/(015)
	.ASCII "XVM/RSX V1B000 MULTIACCESS"<15>
MSGUSR	MSGDSK-MSGUSR*400+400002	/ THIS MESSAGE IGNORED	/(015)
	0				/ BY BATCH.		/(015)
	.ASCII "NN  USERS ALREADY LOGGED IN"<15>
MSGDSK	MSGFIN-MSGDSK*400+400002	/ THIS MESSAGE IGNORED	/(015)
	0				/ BY BATCH.		/(015)
	.ASCII "SPECIFY DISK TYPE(RK,RP OR RF),UNIT AND UFD>"<175>
MSGFIN	MSGWFP-MSGFIN/2*1000
	0
	.ASCII "CREATING TASK"<15>
MSGWFP	MSGSER-MSGWFP/2*1000
	0
	.ASCII "WAITING FOR PARTITION"<15>
MSGSER	MSGRUN-MSGSER/2*1000
	0
	.ASCII "TASK NOT IN ATL"<15>				/(014)
MSGRUN	MSGSUS-MSGRUN/2*1000
	0
	.ASCII "EXECUTING"<15>
MSGSUS	MSGOND-MSGSUS/2*1000
	0
	.ASCII "SUSPENDED"<15>
MSGOND	MSGWFV-MSGOND/2*1000
	0
	.ASCII "ON DISK"<15>
MSGWFV	MSGTDV-MSGWFV/2*1000
	0
	.ASCII "WAITING AT "<15>
MSGTDV	MSGABO-MSGTDV/2*1000
	0
	.ASCII "TDV AWAITING COMMAND"<15>
MSGABO	BUFF-MSGABO/2*1000
	0
	.ASCII "ABORTING"<15>
BUFF	.BLOCK	U.CPB-U.TB
	.END