Google
 

Trailing-Edge - PDP-10 Archives - cuspjul86upd_bb-jf24a-bb - 10,7/galaxy/quasar/qsradm.mac
There are 45 other files named qsradm.mac in the archive. Click here to see a list.
	TITLE	QSRADM  --  System Administrative and Operator Functions

;
;
;        COPYRIGHT (c) 1975,1976,1977,1978,1979,1980,1981,1982,
;			 1983,1984,1985,1986
;                    DIGITAL EQUIPMENT CORPORATION
;			 ALL RIGHTS RESERVED.
;
;     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.

	SEARCH	QSRMAC,GLXMAC		;PARAMETER FILE

	PROLOGUE(QSRADM)		;GENERATE NECESSARY SYMBOLS

	SEARCH	ORNMAC			;NEED ORION INTERFACE

	QSRVRS==:QSRVRS			;REFERENCE QUASAR'S VERSION
	%%.QSR==:%%.QSR			;AND QSRMAC'S

	SUBTTL	Module Storage and Constants


;Dummy STARTUP message for VARIOUS PROCESSORS

COMSTA:: $BUILD	.ARGLN+OBJ.SZ
	 $SET(.MSTYP,MS.CNT,.ARGLN+OBJ.SZ)
	 $SET(.MSTYP,MS.TYP,.OMSTA)
	 $SET(.MSCOD,,-1)
	 $SET(.OARGC,,1)
	 $SET(.OHDRS+ARG.HD,AR.LEN,OBJ.SZ+1)
	 $SET(.OHDRS+ARG.HD,AR.TYP,.OROBJ)
	 $SET(.OHDRS+ARG.DA+OBJ.TY,,0)
	 $SET(.OHDRS+ARG.DA+OBJ.ND,,0)
	$EOB
	SUBTTL	OBJECT TABLE AND MISC STORAGE

;Table of OBJECT types

DEFINE X(OBJ,QUE,PARM),<
	EXP	.OT'OBJ
>  ;END DEFINE X

OBJTAB:	MAPOBJ				;GENERATE THE TABLE

	NOBJS==.-OBJTAB			;NUMBER OF OBJECTS

BLKADR:	BLOCK	1			;IPCF MSG BLOCK ADDRESS.

ILLMSG:	$ACK	(<ORION error>,<Illegally formatted message>,,.MSCOD(M))
	$RETF

BADMSG:	$ACK	(Orion Message Error,Invalid Object Block Specified,,.MSCOD(M))
	$RETF

DEVUNK:	$ACK	(Device Unknown,,0(P1),.MSCOD(M))
	$RETT	

DASMSG:	$ACK	(<Cannot set unit type>,<Device started>,OBJTYP(P1),.MSCOD(M))
	$RETF

NOOMSG:	$ACK	(<Not an output object>,,OBJTYP(P1),,.MSCOD(M))
	$RETF

TMPMSG:	BLOCK	MOD.SZ+3		;SPACE FOR TEMP OPR MSG

	DEFINE	X(A,B,C),<
	XXXX==0
	IRP C,<
		IFE <C>,<STOPI>
		IFN <C>,<XXXX==XXXX+1>
	>
	IFE <XXXX>,<EXP 0>
	IFG <XXXX>,<XWD XXXX,[EXP C]>
	>

	;DEFINE THE OBJECT STATUS CODE LIMITS AND DEVICE TYPES

	; 0 = DEVICE STATUS GOOD FOR ALL DEVICES
	; COUNT,,ADDRESS = # OF DEVICE TYPES LOCATED AT ADDRESS
	;    THESE ARE THE ONLY DEVICES FOR WHICH THE STATUS CODE IS VALID

OBJCDS:	STATUS			;LETERRIP

;  Display table to give meaningful node definition messages

DEFTAB:	ASCIZ/Red/
	ASCIZ/D/
	SUBTTL	Initialization Entry

;CALLED DURING QUASAR INITIALIZATION TO INITIALIZE THE ADMINISTRATIVE
;	DATABASE.

A$INIT::PUSHJ	P,I%NOW			;GET NOW!!
	MOVEM	S1,G$ITEM+$$STAR	;SAVE IT
INIT.1:	MOVX	S1,SP.OPR		;GET ORION'S PID INDEX
	PUSHJ	P,C%RPRM		;GET ORION'S PID
	JUMPF	[MOVEI S1,1		;NOT THERE YET,,THEN
		 PUSHJ P,I%SLP		;   SLEEP 1 SECOND AND
		 JRST  INIT.1  ]	;     TRY AGAIN
	MOVEM	S1,G$OPR##		;SAVE IT FOR FUTURE REFERENCE
	MOVE	S1,G$LNAM##		;GET THE HOST NODE ID.
	MOVEM	S1,COMSTA+.OHDRS+ARG.DA+OBJ.ND ;SAVE IT IN THE MESSAGE 
	MOVX	S1,.OTEVT		;GET THE EVENT OBJECT TYPE
	STORE	S1,COMSTA+.OHDRS+ARG.DA+OBJ.TY ;SAVE IT
	MOVEI	M,COMSTA		;GET START MESSAGE ADDRESS
	PUSHJ	P,A$OSTA		;STARTUP THE EVENT PROCESSOR
	MOVEI	S1,.OTBIN		;GET THE CORRECT OBJECT TYPE
	STORE	S1,COMSTA+.OHDRS+ARG.DA+OBJ.TY ;SAVE IT IN THE MESSAGE
	MOVEI	M,COMSTA		;STARTUP MESSAGE FOR BIN QUEUE
	PUSHJ	P,A$OSTA		;SETUP THE OBJECT BLOCK
	MOVX	S1,.OTDBM		;GET THE DBMS OBJECT TYPE
	STORE	S1,COMSTA+.OHDRS+ARG.DA+OBJ.TY ;SAVE FOR DBMS STARTUP
	MOVEI	M,COMSTA		;GET START MESSAGE ADDRESS
	PUSHJ	P,A$OSTA		;STARTUP THE DBMS PROCESSOR
	$RETT				;AND RETURN
	SUBTTL	Administrative Message Handlers

;THE MESSAGE HANDLERS ARE TOP LEVEL ROUTINES WHICH PROCESS THE
;	VARIOUS MESSAGES THAT ARE SENT TO QUASAR.  THEY ARE
;	CALLED DIRECTLY OUT OF THE MAIN PROCESSING LOOP WITH
;	ACCUMULATOR "M" POINTING TO THE FIRST WORD OF THE MESSAGE.
;	THE MESSAGE HANDLERS HAVE FULL USE OF ALL ACCUMULATORS
;	EXCEPTING "M" AND THE "P" REGS.

	INTERN	A$HELLO		;FUNCTION 1  --  HELLO
	INTERN	A$COUNT		;FUNCTION 20 --  COUNT
	SUBTTL	HELLO  --  Function 1

;THE HELLO MESSAGE IS SENT TO QUASAR BY ONE OF THE KNOWN SYSTEM
;	COMPONENTS UNDER TWO CIRCUMSTANCES, THE FIRST BEING PROGRAM
;	STARTUP, THE SECOND, PROGRAM SHUTDOWN.

A$HELL::DOSCHD				;FORCE A SCHEDULING PASS
	PUSHJ	P,.SAVE1		;SAVE P1
	LOAD	S1,.MSTYP(M),MS.CNT	;GET THE MESSAGE SIZE
	CAIGE	S1,HEL.OB		;AT LEAST BIG ENOUGH?
	PJRST	E$MTS##			;NO, INDICATE MESSAGE TOO SHORT
	PUSHJ	P,A$WHEEL		;SEE IF CALLER IS AN OPERATOR
	JUMPF	E$IPE##			;ISN'T, CANNOT BECOME A KNOWN COMPONENT
	LOAD	S1,HEL.FL(M),HEFVER	;GET PROGRAMS VERSION OF QSRMAC
	CAXE	S1,%%.QSR		;BETTER BE THE SAME AS MINE
	PJRST	E$WVN##			;ISN'T, GIVE WRONG VERSION ERROR
	LOAD	S1,HEL.FL(M),HEFBYE	;SAYING GOODBYE?
	JUMPN	S1,HELL.1		;YUP, BYE!!
	LOAD	S1,HEL.NO(M),HENNOT	;GET THE NUMBER OF OBJECT TYPES
	JUMPE	S1,E$MTS##		;AND GIVE AN ERROR IF ZERO
TOPS20<	MOVE	S2,HEL.OB(M)		;GET THE FIRST OBJECT TYPE
	CAIN	S2,.OTMNT		;IS IT FOR TAPE/DISK MOUNTS ???
	PUSHJ	P,I$MINI## >		;YES,,GO CLEAN UP THE MOUNT QUEUE
	MOVE	S1,G$SND##		;GET PID OF CURRENT SENDER
	PUSHJ	P,GETPSB		;FIND HIS PSB
	MOVE	P1,S1			;STORE ADDRESS OF PSB IN P1
	SKIPE	PSBPID(P1)		;IS IT A NEW ONE?
	JRST	HELL.2			;NO, MUST BE RESTARTING
	MOVE	S1,G$SND##		;GET SENDER'S PID
	MOVEM	S1,PSBPID(P1)		;AND STORE IT IN THE PSB
	LOAD	S1,HEL.NM(M)		;GET PROGRAM NAME
	STORE	S1,PSBNAM(P1)		;STORE IN THE PSB
	LOAD	S1,HEL.NO(M),HENMAX	;GET MAXIMUM NUMBER OF JOBS
	STORE	S1,PSBLIM(P1),PSLMAX	;AND STORE IT
	LOAD	S1,HEL.NO(M),HENNOT	;LOAD NUMBER OF OBJECT TYPES
	STORE	S1,PSBFLG(P1),PSFNOT	;AND STORE IT
	MOVE	S2,M			;GET THE MSG ADDRESS IN S2

HELL.0:	LOAD	TF,HEL.OB(S2),HELATR	;GET THE OBJECT ATTRIBUTES
	JUMPN	TF,.+3			;IF SET,,SKIP THIS
	MOVX	TF,%GENRC		;NO,,GET 'GENERIC' ATTRIBUTES
	STORE	TF,HEL.OB(S2),HELATR	;AND SET THEM FOR THIS OBJECT
	AOS	S2			;BUMP TO NEXT OBJECT
	SOJG	S1,HELL.0		;CONTINUE FOR ALL OBJECTS

	LOAD	S1,HEL.NO(M),HENNOT	;LOAD NUMBER OF OBJECT TYPES
	MOVSI	S2,HEL.OB(M)		;GET SOURCE FOR A BLT
	HRRI	S2,PSBOBJ(P1)		;AND THE DESTINATION
	ADDI	S1,PSBOBJ-1(P1)		;GET THE END ADDRESS
	BLT	S2,0(S1)		;AND BLT THE OBJECT TYPES

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	$LOG(<Process ^W/PSBNAM(P1)/ signon to QUASAR>,<Process PID is ^O/PSBPID(P1)/, Process Object Type is ^O/PSBOBJ(P1),HELOBJ/(^1/PSBOBJ(P1),HELOBJ/)>,,<$WTFLG(WT.SJI)>)
	MOVE	S1,PSBOBJ(P1)		;GET THE OBJECT TYPE
	CAMN	S1,[%GENRC,,.OTBAT]	;IS THIS THE BATCH PROCESSOR??
	PUSHJ	P,D$PMDR##		;GO PROCESS ALLOCATIONS

	MOVE	S1,P1			;GET PSB ADDRESS
	PUSHJ	P,HELL.3		;SEND ODB MESSAGE IF NEEDED

	;Each time we get a HELLO message, poll the processors and see
	;   if any have died

	$SAVE	<G$ACK##,G$MCOD##,G$ERR##,G$SND##> ;SAVE LOTS OF VARIABLES
	SETZM	G$ACK##			;ZAP THE ACK FLAG
	SETZM	G$ERR##			;ZAP THE ERROR CODE
	SETZM	G$MCOD##		;ZAP THE ACK CODE
	PUSH	P,P1			;SAVE PSB
	LOAD	P1,HDRPSB##+.QHLNK,QH.PTF ;GET THE FIRST PROCESSOR BLOCK
HELL.A:	JUMPE	P1,HELL.B		;NONE,,THATS WIERD !!!
	MOVE	S1,PSBPID(P1)		;GET ITS PID
	MOVEM	S1,G$SND##		;MAKE BELIEVE HE SENT US A MSG
	LOAD	P1,.QELNK(P1),QE.PTN	;GET NEXT PSB,,THIS ONE MAY GO AWAY
	PUSHJ	P,G$MSND##		;SEND A NULL ACK
	JRST	HELL.A			;AND GO SEND ANOTHER
HELL.B:	POP	P,P1			;GET PSB BACK
	MOVE	S1,P1			;COPY
	PUSHJ	P,HELSTA		;START OBJECTS IF NECESSARY
	$RETT				;AND RETURN

	;HERE WHEN WE RECEIVE A GOOD-BYE MESSAGE

HELL.1:	MOVE	S1,G$SND##		;GET SENDERS PID
	PUSHJ	P,A$FPSB		;FIND THE PSB
	JUMPE	S1,E$NKC##		;LOSE
	PJRST	KILPSB			;ELSE, KILL THE PSB

	;HERE WHEN WE RECEIVE A HELLO FROM A KNOWN PROGRAM.  WE ASSUME THE
	;	PROGRAM ABENDED AND HAS BEEN RESTARTED, SO WE FORCE A
	;	GOODBYE FOLLOWED BY A NEW HELLO.

HELL.2:	PUSHJ	P,KILPSB		;BYE....
	JRST	A$HELLO			;HI.....

;HERE TO SEND AN ODB MESSAGE(S) TO PROCESSOR IF NEEDED.
;S1/PSB ADDRESS

HELL.3:	PUSHJ	P,.SAVET		;SAVE T1 - T4
	MOVE	T1,S1			;SAVE PSB ADDRESS
	LOAD	T2,PSBFLG(T1),PSFNOT	;GET NUMBER OF OBJECTS SUPPORTED
	JUMPE	T2,.RETF		;IF NONE, RETURN FALSE
	MOVNS	T2			;MAKE AOBJN POINTER
	HRLZS	T2
	HRRI	T2,PSBOBJ(T1)
HELL.4:	LOAD	S1,(T2),HELOBJ		;GET OBJECT TYPE
	LOAD	T4,HDRODB##+.QHLNK,QH.PTF ;GET THE FIRST ODB BLOCK
HELL.5:	JUMPE	T4,HELL.8		;IF NONE, LOOP
	CAMN	S1,ODB.OT(T4)		;OBJECT TYPES MATCH?
	JRST	HELL.7			;YES, GO SEND ODB MESSAGE
HELL.6:	LOAD	T4,.QELNK(T4),QE.PTN	;NO, GET POINTER TO NEXT ODB
	JRST	HELL.5			;LOOP
HELL.7:	MOVE	S2,PSBPID(T1)		;GET PROCESSOR PID FROM PSB
	PUSH	P,S1			;SAVE OBJECT TYPE
	MOVE	S1,T4			;GET ODB ADDRESS
	PUSHJ	P,SNDODB		;GET SEND ODB MESSAGE
	POP	P,S1			;GET OBJECT TYPE BACK
	JRST	HELL.6			;LOOP FOR NEXT ODB
HELL.8:	AOBJN	T2,HELL.4		;LOOP FOR ALL OBJECTS SUPPORTED
	POPJ	P,
; Here to restart any objects not owned by a spooler
; Call:	MOVE	S1, PSB address
;	PUSHJ	P,HELSTA

HELSTA:	$SAVE	<M>			;SAVE M
	PUSHJ	P,.SAVE3		;SAVE	 SOME ACS
	MOVE	P1,S1			;COPY PSB ADDRESS
	LOAD	P2,PSBFLG(P1),PSFNOT	;GET THE OBJECT COUNT
	MOVNS	P2			;NEGATE
	MOVSS	P2			;PUT IN LH
	HRRI	P2,PSBOBJ(P1)		;MAKE AN AOBJN POINTER
	LOAD	P3,HDROBJ##+.QHLNK,QH.PTF ;POINT TO THE FIRST OBJ

HELS.1:	JUMPE	P3,.RETT		;RETURN IF NO MORE OBJECTS
	SKIPE	OBJPID(P3)		;OBJECT OWNED?
	JRST	HELS.2			;YES--TRY ANOTHER
	MOVE	S1,P2			;GET POINTER TO OBJECTS
	HRRZ	S2,(S1)			;GET AN OBJECT TYPE
	CAME	S2,OBJTYP(P3)		;SAME?
	AOBJN	S1,.-1			;CHECK MORE
	JUMPGE	S1,HELS.2		;JUMP IF NO MORE OBJECTS
	MOVX	S1,OBSSTA!OBSSUP!OBSDAA	;STARTED+SETUP+DEVICE ATTRIBUTES
	ANDCAM	S1,OBJSCH(P3)		;CLEAR FOR RESTART
	MOVEI	M,COMSTA		;POINT TO INTERNAL START MESSAGE
	SETOM	.MSCOD(M)		;ACK ALL OPERATORS
	MOVE	S1,OBJTYP(P3)		;OBJECT TYPE
	MOVEM	S1,.OHDRS+ARG.DA+OBJ.TY(M)
	MOVE	S1,OBJNOD(P3)		;NODE NAME/NUMBER
	MOVEM	S1,.OHDRS+ARG.DA+OBJ.ND(M)
	MOVE	S1,OBJUNI(P3)		;UNIT NUMBER
	MOVEM	S1,.OHDRS+ARG.DA+OBJ.UN(M)
	LOAD	S1,OBJDAT(P3),RO.ATR	;GET ATTRIBUTES
	PUSH	P,S1			;SAVE
	MOVEI	S1,%GENRC		;TO ALLOW STARTUP
	CAIE	S2,.OTNQC		;DON'T SCREW UP NQC
	STORE	S1,OBJDAT(P3),RO.ATR	;SO THAT WE MAY DETERMINE ATTRIBUTES
	MOVEI	S1,.OHDRS+ARG.DA(M)	;PONT TO THE OBJECT BLOCK
	PUSHJ	P,A$ISTA		;START THE OBJECT
	POP	P,S1			;GET ORIGINAL ATTRIBUTES BACK
	STORE	S1,OBJDAT(P3),RO.ATR	;RESTORE

HELS.2:	LOAD	P3,.QELNK(P3),QE.PTN	;POINT TO NEXT OBJECT
	JRST	HELS.1			;AND LOOP
	SUBTTL	COUNT  --  Function 20

;COUNT MESSAGE IS SENT TO QUASAR BY A USER TO REQUEST A COUNT-ANSWER
;	CONTAINING ALL OF QUASAR'S INTERESTING COUNTERS.

A$COUNT:
	MOVE	S1,G$NOW##		;GET NOW
	$SITEM	S1,NOW			;SAVE IT

	$COUNT	(MCAN)			;NUMBER OF COUNTANSWER MESSAGES
	$CALL	M%GPAG			;GET A PAGE
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE IT IN THE SAB
	MOVE	S2,[CAN.SZ,,.QOCAN]	;GET LEN,,FUNCTION
	MOVEM	S2,.MSTYP(S1)		;STORE IT IN THE MESSAGE
	MOVSI	S2,G$ITEM##		;GET START ADDRESS
	HRRI	S2,CAN.BL(S1)		;GET DEST ADDRESS
	BLT	S2,CAN.SZ-1(S1)		;BLT THE MESSAGE
	MOVEI	S1,PAGSIZ		;PUT IN PAGE LENGTH
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE IT IN THE SAB
	MOVE	S1,G$SND##		;GET PID OF SENDER
	MOVEM	S1,G$SAB##+SAB.PD	;SAVE IT IN THE SAB
	PJRST	C$SEND##		;SEND IT
	SUBTTL	Auto-file request -- Function 67


; Here to request auto-file processing from ORION.
; Call:	MOVE	S1, FD address
;	PUSHJ	P,A$AUTO

A$AUTO::$SAVE	<M>			;SAVE M
	PUSH	P,S1			;SAVE FD ADDRESS
	$CALL	M%GPAG			;GET A PAGE
	MOVE	M,S1			;COPY ADDRESS
	MOVEI	S1,.QOATO		;FUNCTION CODE
	STORE	S1,.MSTYP(M),MS.TYP	;SAVE
	MOVEI	S1,.OHDRS+FDXSIZ	;LENGTH
	STORE	S1,.MSTYP(M),MS.CNT	;SAVE
	MOVEI	S1,1			;ARGUMENT COUNT
	MOVEM	S1,.OARGC(M)		;SAVE
	GETLIM	S1,.QELIM(AP),SWIT	;GET THE ACK CODE
	MOVEM	S1,.OFLAGS(M)		;AND STORE IT
	POP	P,S1			;GET FD ADDRESS BACK
	HRLZS	S1			;PUT IN LH
	HRRI	S1,.OHDRS(M)		;WHERE TO PUT FD
	MOVEI	S2,.OHDRS+FDXSIZ(M)	;COMPUTE END OF BLT
	BLT	S1,-1(S2)		;COPY FD

	MOVEM	M,G$SAB##+SAB.MS	;SAVE MESSAGE ADDRESS IN THE SAB
	LOAD	S1,.MSTYP(M),MS.CNT	;GET LENGTH OF MESSAGE
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE IT IN THE SAB
	MOVE	S1,G$OPR##		;GET ORION'S PID
	MOVEM	S1,G$SAB##+SAB.PD	;SAVE IT IN THE SAB
	PJRST	C$SEND##		;SEND THE MESSAGE
	SUBTTL	Operator Messages

;The following messages are received from ORION:

	INTERN	A$OSTA			;STARTUP AN OBJECT
	INTERN	A$OSHT			;SHUTDOWN AN OBJECT
	INTERN	A$OSET			;SET PARAMETERS FOR AN OBJECT
	INTERN	A$OPAU			;PAUSE AN OBJECT
	INTERN	A$OCON			;CONTINUE AN OBJECT
	INTERN	A$OSHC			;SHOW CONTROL FILE (EXAMINE)
	INTERN	A$OREQ			;REQUEUE A JOB
	INTERN	A$OCAN			;CANCEL A JOB
	INTERN	A$OFWS			;FORWARD SPACE 
	INTERN	A$OBKS			;BACK SPACE
	INTERN	A$OALI			;ALIGN FORMS ON PRINTER
	INTERN	A$OSUP			;SUPPRESS CARRIAGE CONTROL
	INTERN	A$OSND			;SEND MESSAGE TO LOG FILE
	INTERN	A$OREL			;RELEASE MESSAGE.
	INTERN	A$OHLD			;HOLD MESSAGE
	INTERN	A$ORTE			;ROUTE MESSAGE.
	INTERN	A$ODEL			;DELETE QUEUES MSG
	INTERN	A$MODIFY		;MODIFY QUEUE ENTRY MESSAGE
	INTERN	A$DEFINE		;DEFINE NODE COMMAND PROCESSOR
	INTERN	A$DN60			;DN60 OPERATOR MSG PROCESSOR
	INTERN	A$STND			;START NODE PROCESSOR
	INTERN	A$ISTA			;INTERNAL STARTUP OF AN OBJECT
SUBTTL	A$AGE  --  Routine to compare two times in internal format


; Compute age in seconds based on the universal date/time format
; Call:	S1 and S2 contain the UDTs to compare
;	PUSHJ	P,A$AGE
;
; On return S1:= age in seconds. AC usage: S1 and S2
;
A$AGE::	PUSH	P,T1			;SAVE T1
	CAMGE	S1,S2			;ORDERING CHECK
	EXCH	S1,S2			;WANT THE LARGEST IN S1
	ADDI	S1,1			;ROUND UP
	SUB	S1,S2			;SUBTRACT THEM
	HLRZ	T1,S1			;GET DIFFERENCE IN DAYS
	IMULI	T1,^D24*^D60*^D60	;CONVERT TO SECONDS
	HRRZS	S1			;ISOLATE FRACTIONAL PORTION OF DAY
	MULI	S1,^D24*^D60*^D60	;CONVERT TO SECONDS
	ASHC	S1,21			;POSITION RESULT
	ADD	S1,T1			;ADD IN DIFFERENCE IN DAYS
	POP	P,T1			;RESTORE T1
	POPJ	P,			;RETURN
SUBTTL	A$AFT  --  Routine to modify an internal time


; Compute C(G$NOW) + a specified interval
; Call:	S1/	interval in minutes
;	PUSHJ	P,A$AFT
;
; On return, S1:= new time. AC usage: S1 and S2.
;
A$AFT::	ZERO	S2			;ZERO FOR A SHIFT
	ASHC	S1,-^D17		;GENERATE DOUBLE CONSTANT
					; = ARG*2^18
	DIVI	S1,^D1440		;DIVIDE BY MIN/DAY
	ADD	S1,G$NOW##		;ADD IN NOWTIM
	$RETT				;AND RETURN
SUBTTL	I$WHEEL  --  Determine whether sender of current message is privileged


; Determine whether the send of the current IPCF message has lots of privs
; Call:	No arguments
;	PUSHJ	P,A$WHEEL
; TRUE return:	caller is a wheel (or operator)
; FALSE return:	caller has no special privs
;
A$WHEEL::
	MOVE	S1,G$PRVS##		;GET PRIVS WORD
	SKIPN	DEBUGW			;IF DEBUGGING, ALWAYS SUCCEED
	TXNE	S1,MD.PWH!MD.POP	;WHEEL OR OPERATOR?
	$RETT				;YES, RETURN TRUE
	$RETF				;NOW RETURN FALSE
	SUBTTL	A$OSTA / A$ISTA  --  Startup an object

;  The A$OSTA entry to this routine is the normal entry for a normal startup
;  command.  It can include a range for the object.

;  The A$ISTA entry to this routine is to startup an object as part of
;  start node processing.  S1 must contain a pointer to an object block.
;  A range is not allowed.  In addition, use of this entry point causes
;  the check for starting individual objects on an IBM node to be skipped.

A$OSTA:	$SAVE	P1
	MOVEI	S1,.OROBJ		;GET THE OBJECT BLOCK TYPE
	PUSHJ	P,A$FNDB		;FIND THE OBJECT BLOCK IN THE MESSAGE
	JUMPF	A$STND			;NO,,MIGHT BE START NODE SO CHECK IT OUT
	PUSHJ	P,ORANGE		;CHECK FOR A RANGE
	MOVE	P1,S1			;Save S1 for a min.
	MOVE	S1,OBJ.ND(S1)		;Get the node name
	PUSHJ	P,N$NODE##		;Get the node entry

;  Since we are not part of a start node, want to check if this is the
;  start of an IBM object, since that is illegal in this case.

	LOAD	S1,NETSTS(S2),NETIBM	;Get IBM status
	SKIPE	S1			;Is it IBM object?
	JRST	OSTA.5			;Yes, error, go tell the operator
	SKIPA	S1,P1			;Get object block back

A$ISTA:	$SAVE	P1
	PUSHJ	P,GETOBJ		;GET THE OBJECT
	JUMPF	.RETT			;NO GOOD,,RETURN.
	MOVE	P1,S1			;SAVE THE OBJECT ADDRESS
	MOVX	S1,OBSSTA		;GET STARTED BIT...
	TDNE	S1,OBJSCH(P1)		;ARE WE ALREADY STARTED ?
	JRST	OSTA.3			;YES,,LET'EM KNOW ...
	IORM	S1,OBJSCH(P1)		;NO,,SET IT
	$ACK	(Startup Scheduled,,OBJTYP(P1),.MSCOD(M))
	MOVE	S1,P1			;GET THE OBJECT ADDRESS BACK
	PUSHJ	P,A$OBST		;SETUP THE OBJECT STATUS.
	DOSCHD				;FORCE A SCHEDULING PASS
	MOVE	S1,OBJTYP(P1)		;GET THE OBJECT TYPE
	MOVX	S2,OBSSUP!OBSFRR!OBSINV	;SETUP + FREE RUNNING + INVISIVBLE
	CAIN	S1,.OTEVT		;EVENT OBJECT?
	IORM	S2,OBJSCH(P1)		;YES--LITE LOTS OF BITS

	;Check to see if object has a Physical Device Name

OSTA.1:	MOVX	S1,.CMDEV		;WANT A DEVICE BLOCK
	PUSHJ	P,A$FNDB		;SEE IF THERE IS ONE
	JUMPF	OSTA.2			;NO
	HRLI	S1,(POINT 7,0)		;BYTE POINTER TO THE ASCIZ STRING
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	MOVEM	S2,OBJPRM+.OOTAP(P1)	;SAVE THE DEVICE NAME FOR LATER
	MOVX	S1,OBSSPL		;GET SPOOL TO TAPE FUNCTION
	IORM	S1,OBJSCH(P1)		;LITE IT IN THE SCHEDULING VECTOR

OSTA.2:	MOVE	S1,P1			;COPY OBJECT BLOCK
	PUSHJ	P,S$FPSB##		;FIND THE PROCESSOR STATUS BLOCK
	JUMPF	.RETT			;DONE IF NO PROCESSOR
	PUSHJ	P,S$SETU##		;SEND SETUP MESSAGE TO PROCESSOR
	$RETT				;AND RETURN

OSTA.3:	MOVX	S1,OBSSEJ		;GET 'SHUTDOWN AT EOJ'
	TDNN	S1,OBJSCH(P1)		;WAS SHUTDOWN PENDING ???
	JRST	OSTA.4			;NO,,SAY ALREADY STARTED
	ANDCAM	S1,OBJSCH(P1)		;CLEAR PENDING SHUTDOWN
	$ACK	(Pending shutdown cancelled,,OBJTYP(P1),.MSCOD(M))
	$RETT				;RETURN

OSTA.4:	$ACK	(Already Started,,OBJTYP(P1),.MSCOD(M))
	$RETT

OSTA.5:	$ACK	(<Illegal to start a specific object for IBM node ^N/OBJ.ND(P1)/>,<Use START NODE command>,,.MSCOD(M))
	$RETT

	SUBTTL	A$STND - START NODE MESSAGE PROCESSOR

A$STND:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	$SAVE	<M>			;SAVE THE ORIGIONAL MESSAGE ADDRESS
	MOVX	S1,.ORNOD		;GET NODE BLOCK TYPE
	PUSHJ	P,A$FNDB		;FIND IT IN THE MESSAGE
	JUMPF	BADMSG			;NOT THERE,,THATS AN ERROR
	MOVE	S1,0(S1)		;GET THE NODE NAME
	MOVE	S2,.MSCOD(M)		;GET THE ACK CODE
	MOVEI	M,COMSTA		;POINT TO THE COMMON START MESSAGE
	MOVEM	S1,.OHDRS+ARG.DA+OBJ.ND(M) ;SAVE IN OUR OBJECT BLOCK
	MOVEM	S2,.MSCOD(M)		;SAVE THE ACK CODE IN THE MESSAGE
	SETZM	.OHDRS+ARG.DA+OBJ.UN(M) ;WANT UNIT 0
	PUSHJ	P,N$PORT##		;LOOK FOR OTHER DEVICES STARTED ON
	JUMPT	STAERR			;   THE SAME PORT/LINE (IBM ONLY)

;  S2 now contains the pointer to the node entry, check out the IBM status.

	MOVE	P1,S2			;SAVE NET QUEUE ADDRESS
	LOAD	S1,NETSTS(P1),NETIBM	;GET IBM STATUS
	LOAD	S2,NETSTS(P1),NT.MOD	;GET THE MODE
	JUMPE	S1,STND.2		;JUMP IF NOT IBM
	CAXN	S2,DF.EMU		;IN EMULATION MODE ???
	JRST	STND.1			;YES,,START A BATCH STREAM
	CAXE	S2,DF.PRO		;Is it prototype mode?
	JRST	STAE.2			;No, can't start an actual termination
	PUSH	P,S1			;Save S1 for a min.
	MOVX	S1,.OTRDR		;GET CARD READER OBJECT TYPE
	PUSHJ	P,STND.X		;START A CDR
	POP	P,S1			;GET BACK IBMNESS
	JUMPN	S1,.RETT		;DONE IF IBM
	MOVX	S1,.OTLPT		;GET LINE PRINTER OBJECT TYPE
	PUSHJ	P,STND.X		;START A LPT
	SETOM	.MSCOD(M)		;CLEAR COMMON ACK CODE
	$RETT				;AND RETURN

STND.1:	MOVX	S1,.OTBAT		;GET BATCH STREAM OBJECT TYPE
	PUSHJ	P,STND.X		;START A BATCH STREAM
	SETOM	.MSCOD(M)		;CLEAR COMMON ACK CODE
	$RETT				;AND RETURN

; HERE TO START ALL DEVICES ON A REMOTE STATION
STND.2:	SKIPE	S1,NETCOL(P1)		;GET SYSTEM DEPENDANT IDENTIFIER
	MOVEM	S1,.OHDRS+ARG.DA+OBJ.ND(M) ;UPDATE INCASE OTHER NOTATION USED
	PUSH	P,[EXP 0]		;INIT COUNTER
	MOVEI	P2,NETOBJ(P1)		;POINT TO DEVICE WORDS
	HRLI	P2,-NETOBL		;MAKE AN AOBJN POINTER
STND.3:	HLRZ	S1,(P2)			;GET A DEVICE COUNT
	JUMPE	S1,STND.5		;CONTINUE IF NONE
	PUSH	P,S1			;SAVE COUNT
	SETOM	.OHDRS+ARG.DA+OBJ.UN(M) ;INIT UNIT NUMBER
STND.4:	AOS	.OHDRS+ARG.DA+OBJ.UN(M) ;ADVANCE UNIT NUMBER
	HRRZ	S1,(P2)			;GET AN OBJECT TYPE
	PUSHJ	P,STND.X		;START DEVIVE
	AOS	-1(P)			;COUNT THE DEVICE STARTED
	SOSLE	(P)			;COUNT DOWN
	JRST	STND.4			;LOOP
	POP	P,(P)			;TRIM STACK
STND.5:	AOBJN	P2,STND.3		;LOOP FOR ALL DEVICES
	POP	P,S1			;GET DEVICE STARTED COUNTER BACK
	JUMPN	S1,STND.6		;CONTINUE IF DEVICES STARTED
	MOVE	S1,NETCOL(P1)		;GET NODE NAME/NUMBER
	PUSHJ	P,N$NODE##		;SEE IF ONLINE
	SKIPN	S1,NETCOL(P1)		;GET NODE NAME/NUMBER BACK
	MOVE	S1,NETLOC(P1)		;MUST BE NON-ZERO
	MOVEI	S2,[ASCIZ /has no devices/]
	SKIPT				;SKIP IF ONLINE
	MOVEI	S2,[ASCIZ /is offline/]
	$ACK	(<No devices started>,<Node ^N/S1/ ^T/(S2)/>,,.MSCOD(M))
STND.6:	SETZM	.OHDRS+ARG.DA+OBJ.UN(M) ;RESET UNIT NUMBER FOR NEXT CALLER
	SETOM	.MSCOD(M)		;CLEAR COMMON ACK CODE
	$RETT				;AND RETURN


; START A DEVICE
; CALL:	MOVE	S1, OBJECT TYPE
;	PUSHJ	P,STND.X
STND.X:	MOVEM	S1,.OHDRS+ARG.DA+OBJ.TY(M) ;SAVE AS THE OBJECT TYPE
	MOVEI	S1,.OHDRS+ARG.DA(M)	;Get the start of the object block
	PUSHJ	P,A$ISTA		;START A BATCH STREAM FOR THE NODE
	$RETT				;AND RETURN

STAERR:	PUSHJ	P,DN60ID		;GENERATE DN60 IDENTIFIER
	$ACK	(<Illegal start command>,<^T/(S2)/ already started>,,.MSCOD(M))
	$RETT				;RETURN

STAE.2:	MOVE	S1,.OHDRS+ARG.DA+OBJ.ND(M) ;Get the node name back
	$ACK	(<Illegal to start termination node ^N/S1/>,<Only defined prototype nodes may be started>,,.MSCOD(M))
	$RETT
DN60ID:	PUSHJ	P,.SAVET		;SAVE SOME ACS
	LOAD	T4,NETPTL(S1),NT.PRT	;GET THE PORT DATA
	HRLZS	T4			;CAL11. STYLE
	LOAD	T1,T4,C1.1CN		;CPU NUMBER
	LOAD	T2,T4,C1.1TY		;PORT TYPE
	MOVE	T2,PORTAB(T2)		;CONVERT TO TEXT
	LOAD	T3,T4,C1.1PN		;PORT NUMBER
	LOAD	T4,NETPTL(S1),NT.LIN	;LINE NUMBER
	MOVE	S2,NETCOL(S1)		;GET NODE NUMBER
	$TEXT	(<-1,,DN60TX>,<^I/DN60IT/^0>)
	MOVEI	S2,DN60TX		;POINT TO TEXT
	POPJ	P,			;RETURN


DN60IT:	ITEXT	(<Station ^N/S2/ CPU^D/T1/ ^T/(T2)/ port ^O/T3/ line ^O/T4/>)

DN60TX:	BLOCK	25

PORTAB:	[ASCIZ	/DL10/]
	[ASCIZ	/DTE/]
	[ASCIZ	/KMC/]
	[ASCIZ	/DMR/]
	SUBTTL	A$OSHT  --  Shutdown an object

A$OSHT:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2 FOR A MINUTE
	MOVX	S1,.OROBJ		;GET THE OBJECT BLOCK TYPE
	PUSHJ	P,A$FNDB		;FIND THE OBJECT BLOCK IN THE MESSAGE
	JUMPF	SHUTNODE		;NO OBJECT BLK,,TRY SHUTDOWN NODE
	PUSHJ	P,ORANGE		;BREAK UP A RANGE
	MOVE	P1,S1			;SAVE THE OBJECT BLOCK ADDRESS

;  Need to make certain it is not a shutdown for an IBM node device

	MOVE	S1,OBJ.ND(S1)		;Get the node name
	PUSHJ	P,N$GNOD##		;Get the node entry
	JUMPF	BADMSG			;It must be there!
	LOAD	S1,NETSTS(S2),NETIBM	;Get the IBM status
	SKIPE	S1			;Is it IBM object?
	JRST	A$SH.3			;Yes, not allowed

	MOVE	S1,P1			;Get back the object block address
	PUSHJ	P,A$FOBJ		;FIND IT IN OUR DATA BASE
	JUMPF	DEVUNK			;NOT THERE,,ACK THE OPR AND RETURN
	MOVE	P1,S1			;SAVE THE OBJECT QUEUE ENTRY ADDRESS
	LOAD	S1,OBJSCH(P1)		;GET OBJ SCHEDULING BITS
	TXNN	S1,OBSSUP		;IS IT SETUP ???
	JRST	A$SH.0			;NO,,JUST SHUT IT DOWN.
	TXO	S1,OBSSEJ		;LITE SHUTDOWN AT END OF JOB BIT
	TXNE	S1,OBSBUS		;IS IT BUSY ??? IF SO,SEND THE ACK.
	$ACK	(Shutdown at EOJ Scheduled,,OBJTYP(P1),.MSCOD(M))
	MOVE	S2,OBJTYP(P1)		;GET OBJECT TYPE
	TXNE	S1,OBSFRR		;IS THIS A FREE RUNNING DEVICE ??
	CAIN	S2,.OTFAL		;YES, BUT IS IT FAL?
	TRNA				;NOT FREE RUNNING OR FREE RUNNING AND FAL
	TXZ	S1,OBSBUS		;YES,,CLEAR THE BUSY BIT
	MOVEM	S1,OBJSCH(P1)		;SAVE THE SCHEDULING BITS
	DOSCHD				;FORCE A SCHEDULING PASS
	$RETT				;AND RETURN

A$SH.0:	MOVE	S1,P1			;GET THE OBJECT ADDRESS
	PUSHJ	P,S$SHUT##		;SHUT IT DOWN
	$RETT				;AND RETURN

A$SH.3:	$ACK	(<Illegal to shutdown a specific object for IBM node ^N/OBJ.ND(P1)/>,<Use SHUTDOWN NODE command>,,.MSCOD(M))
	$RETT				;Tell the operator and quit
	SUBTTL	SHUTNODE - ROUTINE TO SHUTDOWN AN ENTIRE NODE


SHUTNO:	MOVX	S1,.ORNOD		;GET THE NODE BLOCK TYPE
	PUSHJ	P,A$FNDB		;GO FIND IT IN THE MESSAGE
	JUMPF	BADMSG			;NOT THERE,,THATS ALL SHE WROTE !!
	MOVE	S1,0(S1)		;GET THE NODE NAME/NUMBER
SHUT.1:	PUSHJ	P,N$GNOD##		;FIND IT IN OUR DATA BASE
	DMOVE	P1,S1			;COPY NODE NAME & ADDRESS
	JUMPF	SHUT.8			;If not found, just return an error

;  Check to see if we are shutting down an online proto.  If so, mark the
;  proto node and then go for the devices on the actual node

	LOAD	S1,NETSTS(P2),NT.MOD	;Get the mode
	JUMPE	S1,SHUT.2		;CONTINUE IF NON-DN60 NODE
	CAME	P1,NETLOC(P2)		;Skip this if proto is same as actual
	CAIE	S1,DF.PRO		;Is it proto mode?
	JRST	SHUT.3			;No, continue on
	LOAD	S1,NETSTS(P2),NETPRO	;Get proto online flag
	SKIPN	S1			;Is it online prototype?
	JRST	SHUT.3			;No, just shutdown the proto
	MOVX	S1,NETSHT		;Get the network shutdown bit
	IORM	S1,NETSTS(P2)		;Set it in the proto node
	MOVE	S1,NETLOC(P2)		;Get the actual node name
	JRST	SHUT.1			;Go shut the actual node

SHUT.2:	SKIPN	P1,NETCOL(P2)		;GET SYSTEM DEPENDENT IDENTIFIER
	MOVE	P1,NETLOC(P2)		;ELSE USE ALTERNATE

SHUT.3:	SETZM	.OARGC(M)		;INDICATE NO OBJECT SHUTDOWN YET !!!
	MOVX	S1,NETSHT		;GET THE NETWORK SHUTDOWN BIT
	IORM	S1,NETSTS(P2)		;LITE IT FOR THIS NODE
	MOVEI	H,HDROBJ##		;GET THE OBJECT HEADER ADDRESS
	LOAD	P2,.QHLNK(H),QH.PTF 	;GET THE FIRST OBJECT

SHUT.4:	JUMPE	P2,SHUT.7		;NO MORE,,WE ARE DONE
	MOVE	S1,OBJSCH(P2)		;GET THE SCHEDULING BITS
	TXNN	S1,OBSINV		;IS IT INVISIBLE ???
	CAME	P1,OBJNOD(P2)		;ARE WE SHUTING DOWN THIS OBJECT ???
	JRST	SHUT.5			;INVISIBLE OR WRONG NODE,,TRY NEXT
	TXNN	S1,OBSSUP		;IS THE OBJECT SETUP ???
	JRST	SHUT.6			;NO,,JUST SHUT IT DOWN
	TXO	S1,OBSSEJ		;LITE SHUT DOWN AT EOJ BIT
	TXNE	S1,OBSBUS		;IS THE OBJECT BUSY ???
	$ACK	(<Shutdown at EOJ Scheduled>,,OBJTYP(P2),.MSCOD(M));YES !!
	MOVE	S2,OBJTYP(P2)		;GET OBJECT TYPE
	TXNE	S1,OBSFRR		;IS THIS A FREE RUNNING DEVICE ??
	CAIN	S2,.OTFAL		;YES, BUT IS IT FAL?
	TRNA				;NOT FREE RUNNING OR FREE RUNNING AND FAL
	TXZ	S1,OBSBUS		;YES,,CLEAR THE BUSY BIT
	STORE	S1,OBJSCH(P2)		;RESTORE THE SCHEDULING BITS
	DOSCHD				;FORCE A SCHEDULING PASS
	AOS	.OARGC(M)		;BUMP SHUTDOWN COUNT BY 1

SHUT.5:	LOAD	P2,.QELNK(P2),QE.PTN	;GET THE NEXT OBJECT ADDRESS
	JRST	SHUT.4			;AND CONTINUE

SHUT.6:	MOVE	S1,P2			;GET THE OBJECT ADDRESS
	LOAD	P2,.QELNK(P2),QE.PTN	;GET NEXT OBJ ADDR,,THIS ONE IS LEAVING
	PUSHJ	P,S$SHUT##		;SHUT THE OBJECT DOWN
	AOS	.OARGC(M)		;BUMP SHUTDOWN COUNT BY 1
	JRST	SHUT.4			;AND CONTINUE

SHUT.7:	SKIPN	.OARGC(M)		;DID WE SHUTDOWN ANY OBJECTS ???
SHUT.8:	$ACK	(<No devices started on node ^N/P1/>,,,.MSCOD(M)) ;NO !!
	$RETT				;RETURN

	SUBTTL	A$OSET  --  Set parameters for an object

A$OSET:	PUSHJ	P,.SAVE3		;SAVE P1 & P2 FOR A MINUTE
	MOVEI	S1,.OROBJ		;GET THE OBJECT BLOCK TYPE
	PUSHJ	P,A$FNDB		;FIND THE OBJECT BLOCK IN THE MESSAGE
	JUMPF	NETSET			;NOT THERE,,TRY NETWORK SET
	MOVE	P1,S1			;SAVE THE OBJ BLK ADDRESS FOR A MINUTE

OSET.0:	PUSHJ	P,A$GBLK		;GET FIRST/NEXT MESSAGE BLOCK
	JUMPF	BADMSG			;NO MORE,,RETURN THROUGH 'BADMSG'
	MOVSI	S1,-NSETS		;GET NEGATIVE # OS SET COMMANDS.
OSET.1:	HLRZ	S2,SETTBL(S1)		;PICK UP A SET COMMAND TYPE.
	CAMN	S2,T1			;DO WE MATCH ???
	JRST	OSET.2			;YES,,GO PROCESS IT
	AOBJN	S1,OSET.1		;BUMP TO NEXT TBL ENTRY AND CONTINUE.
	JRST	OSET.0			;NO MATCH,,TRY NEXT

OSET.2:	HRRZ	P2,SETTBL(S1)		;GET THE PROCESSING ROUTINE ADDRESS
	MOVE	P3,T3			;SAVE THE 'SET' DATA ADDRESS
	MOVE	S1,P1			;GET THE OBJ BLK ADDRESS
	PUSHJ	P,ORANGE		;BREAK UP THE RANGE
	MOVE	P1,S1			;SAVE THE OBJ BLK ADDRESS
	PUSHJ	P,GETOBJ		;FIND/CREATE THE OBJ BLK.
	JUMPF	.RETT			;NO GOOD,,RETURN
	MOVE	P1,S1			;SAVE THE OBJECT QUEUE ADDRESS

	PJRST	0(P2)			;GO PROCESS IT (ADDRESS FROM OSET.2)


SETPGL:	MOVEI	S1,.OOLIM		;GET PAGE LIMIT OFFSET.
	PJRST	SETMMX			;GO SET MIN/MAX.

SETFRM:	LOAD	S1,0(P3)		;GET FORMS TYPE.
	STORE	S1,OBJPRM+.OOFRM(P1)	;AND SAVE IT IN QUEUE.
	MOVX	S1,OBSFRM		;GET 'SET FORMS TYPE' STATUS
	MOVE	S2,OBJTYP(P1)		;GET THE OBJECT TYPE
	CAXN	S2,.OTLPT		;PRINTER 'SET' ???
	IORM	S1,OBJSCH(P1)		;YES,,SET FORMS CHANGE STATUS
	JRST	SETMSG			;GO SAY ITS OK...

SETMEM:	MOVEI	S1,.OBCOR		;GET CORE LIMIT OFFSET.
	PJRST	SETMMX			;GO SET MIN/MAX.

SETTIM:	MOVEI	S1,.OBTIM		;GET TIME LIMIT OFFSET.
	PJRST	SETMMX			;GO SET MIN/MAX.

SETPRI:	MOVEI	S1,.OOPRI		;GET PRIORTY LIMIT OFFSET.
	PJRST	SETMMX			;GO SET MIN/MAX.

SETOIA:	SKIPA	S1,[.OPINY]		;GET OPR INTERVN ALLOWED CODE
SETNOI:	MOVE	S1,[.OPINN]		;GET NO OPR INTERVN ALLOWED CODE
	STORE	S1,OBJPRM+.OBFLG(P1),.OPRIN ;SAVE IT
	JRST	SETMSG			;SEND AN ACK AND RETURN

SETLEA:	LOAD	S1,0(P3)		;GET THE ACTION CODE
	STORE	S1,OBJPRM+.OOFLG(P1),.OFLEA ;SAVE IT IN THE OBJECT BLOCK
	JRST	SETMSG			;SEND THE ACK

SETLP2:	MOVE	S1,(P3)			;GET THE ACTION CODE
	STORE	S1,OBJPRM+.OOFLG(P1),OF.LP2 ;SAVE IN THE OBJECT BLOCK
	JRST	SETMSG			;SEND THE ACK

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

SETMMX:	ADDI	S1,OBJPRM(P1)		;CALC QUEUE PARAMETER ADDRESS.
	LOAD	S2,0(P3)		;PICK UP MIN VALUE.
	STORE	S2,0(S1),OBPMIN		;SAVE THE MIN VALUE.
	LOAD	S2,1(P3)		;PICK UP MAX VALUE.
	STORE	S2,0(S1),OBPMAX		;SAVE THE MAX VALUE.
SETMSG:	$ACK	(Set Accepted,,OBJTYP(P1),.MSCOD(M))
	MOVE	S1,P1			;GET OBJECT ADDRESS IN S1
	PUSHJ	P,A$OBST		;UPDATE THE OBJECT STATUS
	DOSCHD				;FORCE A SCHEDULING PASS
	$RETT				;RETURN.

SETUTY:	PUSHJ	P,UTYCHK		;CHECK FOR ALREADY SETUP, OUTPUT
	$RETIF				;GIVE UP IF ERROR ALREADY ACKED
	MOVE	S1,(P3)			;GET UNIT TYPE
	MOVEM	S1,OBJPRM+.OOUNT(P1)	;SAVE SIXBIT QUANTITY
	PJRST	SETMSG			;GO ACK

SETNTY:	MOVE	S1,(P3)			;GET NETWORK-TYPE
	CAIE	S1,ST.ANF		;ANF-10?
	CAIN	S1,ST.DCN		;DECNET?
	TRNA				;YES, TO ONE OF THEM
	JRST	SETA.2			;NO, TO BOTH
	MOVEM	S1,OBJPRM+.OBNTY(P1)	;NO, STORE IN OBJECT BLOCK
	PJRST	SETMSG			;ACK OPR AND RETURN

SETATR:	LOAD	S1,OBJDAT(P1),RO.ATR	;GET ATTRIBUTES
	CAMN	S1,0(P3)		;NEED TO BE CHANGED?
	PJRST	SETMSG			;NO,,JUST RETURN
	LOAD	S1,OBJSCH(P1)		;GET SCHEDULER FLAGS
	TXNE	S1,OBSSUP!OBSSIP	;ERROR IF SETUP STARTED
	JRST	SETA.1
	MOVE	S1,0(P3)		;GET THE NEW ATTRIBUTES
	STORE	S1,OBJDAT(P1),RO.ATR	;STORE THEM
	PJRST	SETMSG			;RETURN

SETA.1:	$ACK	(Attribute may not be changed,,OBJTYP(P1),.MSCOD(M))
	$RETF

SETA.2:	$ACK	(Invalid attribute specified,,OBJTYP(P1),.MSCOD(M))
	$RETF

SETTBL:	.STPGL,,SETPGL			;PAGE LIMIT
	.STFRM,,SETFRM			;FORMS TYPE
	.STMEM,,SETMEM			;CORE LIMIT
	.STTIM,,SETTIM			;TIME LIMIT
	.STPRI,,SETPRI			;PRIORTY LIMIT
	.STOIA,,SETOIA			;OPR INTERVENTION ACTION
	.STNOI,,SETNOI			;NO OPR INTERVENTION ACTION.
	.STLEA,,SETLEA			;LIMIT EXCEEDED ACTION
	.STATR,,SETATR			;SET ATTIBUTES
	.STNTY,,SETNTY			;FAL-STREAM NETWORK-TYPE (ATTRIBUTE)
	.STMTA,,SETMTA			;SET MAGTAPE SPOOLING PARAMETERS
	.STUTY,,SETUTY			;SET PRINTER UNIT-TYPE
	.STLP2,,SETLP2			;SET LP20 SIMULATION

		NSETS==.-SETTBL


;CHECK FOR ALREADY SETUP AND OUTPUT OBJECT
UTYCHK:	MOVX	S1,OBSSTA!OBSSUP!OBSSIP	;VARIOUS SETUP BITS
	TDNE	S1,OBJSCH(P1)		;ALREADY SETUP?
	PJRST	DASMSG			;DEVICE ALREADY STARTED
	MOVE	S1,OBJTYP(P1)		;GET THE OBJECT TYPE
	PUSHJ	P,A$OB2Q		;CONVERT TO QUEUE HEADER
	JUMPF	BADMSG			;BAD ORION MESSAGE
	LOAD	S1,.QHTYP(S1),QH.TYP	;GET QUEUE TYPE
	CAIE	S1,.QHTOU		;OUTPUT?
	JRST	BADMSG			;ORION BUILT A BAD MESSAGE
	$RETT				;RETURN GOODNESS
;SET MAGTAPE SPOOLING PARAMETERS
SETMTA:	PUSHJ	P,UTYCHK		;ALREADY SETUP, OUTPUT?
	$RETIF				;ERROR ACK SENT
	MOVE	S1,OBJPRM+.OOUNT(P1)	;GET CURRENT (MAYBE ZERO) UNIT TYPE
	MOVEM	S1,OLDUTY		;SAVE INCASE OF ERROR
	MOVE	S1,OBJPRM+.OOMTA(P1)	;GET CURRENT MTA PARAMETERS
	MOVEM	S1,OLDMTA		;SAVE INCASE OF ERROR
	MOVSI	S1,OBJPRM+.OOVSN(P1)	;POINT TO CURRENT VSN
	HRRI	S1,OLDVSN		;MAKE A BLT POINTER
	BLT	S1,OLDVSN+VSNLEN-1	;COPY AWAY INCASE OF ERROR
	SKIPN	S1,OBJPRM+.OOUNT(P1)	;GET UNIT TYPE
	MOVE	S1,MTAUTT		;DEFAULT
	MOVSI	S2,-MTAUTL		;AOBJN POINTER
	CAME	S1,MTAUTT(S2)		;VALID UNIT TYPE?
	AOBJN	S2,.-1			;LOOP THROUGH TABLE
	JUMPGE	S2,SETMT5		;NO
	MOVEM	S1,OBJPRM+.OOUNT(P1)	;POSSIBLY UPDATE IT
SETMT1:	PUSHJ	P,A$GBLK		;GET FIRST/NEXT BLOCK
	JUMPF	SETMT4			;BAD MESSAGE
	MOVSI	S1,-MTALEN		;AOBJN POINTER
SETMT2:	HLRZ	S2,MTATAB(S1)		;GET SWITCH BLOCK TYPE
	CAIN	T1,(S2)			;MATCH?
	JRST	SETMT3			;YES
	AOBJN	S1,SETMT2		;LOOP THROUGH TABLE
	JRST	SETMT4			;BAD MESSAGE
SETMT3:	HRRZ	S2,MTATAB(S1)		;GET DISPATCH ADDRESS
	PUSHJ	P,(S2)			;PROCESS SWITCH
	JUMPF	SETMT6			;CHECK FOR ERROR
	ADDI	T3,-ARG.DA(T2)		;OFFSET TO NEXT POSSIBLE BLOCK
	SKIPE	(T3)			;END?
	JRST	SETMT1			;LOOP BACK FOR ANOTHER
	PUSHJ	P,MDACHK		;DO MDA RESOURCE CHECKING
	JUMPT	SETMSG			;GO ACK IF OK
	JRST	SETMT6			;ELSE RESET THINGS
SETMT4:	SKIPA	S1,[[ITEXT (<Unknown magtape parameter ^O/T1/>)]]
SETMT5:	MOVEI	S1,[ITEXT (<Unit type is not MAGTAP>)]
	$ACK	(<ORION message error>,<^I/(S1)/>,OBJTYP(P1),.MSCOD(M))
SETMT6:	MOVE	S1,OLDUTY		;GET PREVIOUS UNIT TYPE
	MOVEM	S1,OBJPRM+.OOUNT(P1)	;REPLACE
	MOVE	S1,OLDMTA		;GET PREVIOUS PARAMETERS
	MOVEM	S1,OBJPRM+.OOMTA(P1)	;REPLACE
	MOVSI	S1,OLDVSN		;POINT TO PREVIOUS VSN
	HRRI	S1,OBJPRM+.OOVSN(P1)	;AND TO STORAGE
	BLT	S1,OBJPRM+.OOVSN+VSNLEN-1(P1) ;REPLACE
	$RETF


MTATAB:	.SWMDN,,MTAMDN			;/DENSITY
	.SWMDI,,MTAMDI			;/DIRECTORY-FILE
	.SWMLT,,MTAMLT			;/LABEL-TYPE
	.SWMRL,,MTAMRL			;/MULTI-REEL
	.SWMPR,,MTAMPR			;/PARITY
	.SWMTK,,MTAMTK			;/TRACKS
	.SWMVS,,MTAMVS			;/VOLUME-SET
MTALEN==.-MTATAB			;LENGTH OF TABLE


MTAUTT:	SIXBIT	/MAGTAP/		;DEFAULT UNIT TYPE (MUST BE FIRST)
MTAUTL==.-MTAUTT			;LENGTH OF TABLE

OLDUTY:	BLOCK	1			;OLD UNIT TYPE
OLDMTA:	BLOCK	1			;OLD MAGTAPE PARAMETERS
OLDVSN:	BLOCK	VSNLEN			;OLD VOLUME-SET NAME
;DENSITY
MTAMDN:	MOVE	S1,(T3)			;GET DENSITY ACTION
	STORE	S1,OBJPRM+.OOMTA(P1),OB.MDN ;SET DENSITY
	$RETT				;RETURN

;DIRECTORY-FILE
MTAMDI:	MOVE	S1,(T3)			;GET YES/NO ACTION
	STORE	S1,OBJPRM+.OOMTA(P1),OB.MDI ;SET MAGTAPE DIRECTORY
	$RETT				;RETURN

;LABEL TYPE
MTAMLT:	MOVX	S1,OB.MLV!OB.MLT	;AND LABEL TYPE AND VALID BITS
	ANDCAM	S1,OBJPRM+.OOMTA(P1)	;INITIALLY CLEAR THEM
	MOVE	S1,(T3)			;GET LABEL TYPE ACTION
	CAIN	S1,-1			;DEFAULT?
	$RETT				;YES--USE SPOOLER DEFAULT
	STORE	S1,OBJPRM+.OOMTA(P1),OB.MLT ;SET LABEL TYPE
	MOVX	S1,OB.MLV		;ONE MORE BIT
	IORM	S1,OBJPRM+.OOMTA(P1)	;INDICATE LABEL TYPE IS VALID
	$RETT				;RETURN

;MULTI-REEL
MTAMRL:	MOVE	S1,(T3)			;GET YES/NO ACTION
	STORE	S1,OBJPRM+.OOMTA(P1),OB.MRL ;SET MULTI-REEL VOLUME-SET
	$RETT				;RETURN

;PARITY
MTAMPR:	MOVE	S1,(T3)			;GET ODD/EVEN/DEFAULT ACTION
	STORE	S1,OBJPRM+.OOMTA(P1),OB.MPR ;SET PARITY
	$RETT				;RETURN

;TRACKS
MTAMTK:	MOVE	S1,(T3)			;GET 7/9/DEFAULT ACTION
	STORE	S1,OBJPRM+.OOMTA(P1),OB.MTK ;SET TRACK TYPE
	$RETT				;RETURN

;VOLUME-SET NAME
MTAMVS:	MOVSI	S1,OBJPRM+.OOVSN(P1)	;VOLUME-SET DESTINATION
	HRRI	S1,OBJPRM+.OOVSN+1(P1)	;MAKE A BLT POINTER
	SETZM	OBJPRM+.OOVSN(P1)	;CLEAR FIRST WORD
	BLT	S1,OBJPRM+.OOVSN+VSNLEN-1(P1); CLEAR STORAGE
	MOVSI	S1,(T3)			;POINT TO VOLUME-SET NAME
	HRRI	S1,OBJPRM+.OOVSN(P1)	;MAKE A BLT POINTER
	LOAD	S2,-ARG.DA(T3),AR.LEN	;GET LENGTH OF VSN STRING
	CAILE	S2,VSNLEN		;REASONABLE?
	MOVEI	S2,VSNLEN		;TRUNCATE
	ADDI	S2,OBJPRM+.OOVSN(P1)	;COMPUTE END OF BLT
	BLT	S1,-1(S2)		;COPY VSN
	$RETT				;RETURN


;HERE FOR MDA RESOURCE CHECK WITH DENSITY IN S1 AND TRACKS IN S2
MDACHK:	SKIPN	G$MDA##			;MDA SUPPORT?
	$RETT				;NO
	LOAD	S1,OBJPRM+.OOMTA(P1),OB.MDN ;GET DENSITY
	CAIN	S1,.TFD00		;DEFAULT DENSITY?
	JRST	MDACH1			;YES
	MOVNI	S2,-1(S1)		;NEGATE DENSITY INDEX FOR LSH
	MOVX	S1,UC.200		;STARTING DENSITY BIT
	LSH	S1,(S2)			;SELECT PROPER BIT
	JRST	MDACH2			;ONWARD
MDACH1:	MOVE	S1,[UC.200+UC.556+UC.800+UC.1600+UC.6250]
MDACH2:	LOAD	S2,OBJPRM+.OOMTA(P1),OB.MTK ;GET TRACKS
	JUMPN	S2,MDACH3		;PROCEED IF TRACK TYPE KNOWN
	PUSH	P,S1			;SAVE DENSITY BIT(S)
	MOVEI	S2,%TRK9		;FIRST TRY 9-TRACK
	PUSHJ	P,D$TRSN##		;...
	POP	P,S1			;GET DENSITY BIT(S) BACK
	JUMPT	.RETT			;RETURN IF RESOURCE FOUND
	MOVEI	S2,%TRK7		;NOW TRY 7-TRACK
MDACH3:	PUSHJ	P,D$TRSN##		;FIND A MATCHING RESOURCE
	JUMPT	.RETT			;RETURN IF A RESOURCE EXISTS
	$ACK	(<No units with desired density and tracks>,,OBJTYP(P1),.MSCOD(M))
	$RETF				;RETURN

	SUBTTL	A$ETSR - ENABLE TIMESHARING

TOPS10	<

A$ETSR::PUSHJ	P,A$WHEEL		;MAKE SURE SENDER IS PRIV'ED
	JUMPF	E$IPE##			;NO PRIVS
	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	SETZB	P1,P2			;CLEAR JOB AND REQUEST-ID
	SKIPGE	S1,G$KSYS##		;KSYS TIMED OUT?
	JRST	ETSR.3			;YES
	JUMPE	S1,ETSR.4		;ERROR IF NOT PENDING
	MOVEI	H,HDREVT##		;POINT TO EVENT QUEUE HEADER
	LOAD	AP,.QHLNK(H),QH.PTF	;POINT TO THE FIRST ENTRY

ETSR.1:	JUMPE	AP,ETSR.3		;RETURN IF NO MORE ENTRIES
	GETLIM	S1,.QELIM(AP),TYPE	;GET EVENT CODE
	CAIE	S1,.EVKSY		;KSYS?
	TDZA	S1,S1			;NO
	GETLIM	S1,.QELIM(AP),ACTV	;GET ACTIVE BIT
	JUMPN	S1,ETSR.2		;ONLY VALID IF ACTIVE
	LOAD	AP,.QELNK(AP),QE.PTN	;GET POINTER TO NEXT ENTRY
	JRST	ETSR.1			;AND LOOP

ETSR.2:	MOVE	P1,.QEJOB(AP)		;SAVE JOB NAME
	MOVE	P2,.QERID(AP)		;AND REQUEST-ID
	PUSHJ	P,Q$KPRO##		;KILL OFF THIS REQUEST

ETSR.3:	MOVE	S1,[.STKSY,,0]		;FUNCTION,,CLEAR TIMER
	SKIPN	DEBUGW			;DEBUGGING?
	SETUUO	S1,			;SET KSYS
	  JFCL				;SHOULDN'T FAIL
	MOVEI	S2,ETSR.K		;POINT TO KILL TEXT
	SKIPN	P2			;HAVE A REQUEST-ID?
	MOVEI	S2,ETSR.N		;NO--POINT TO NULL TEXT
	MOVEI	S1,ETSR.A		;POINT TO NORMAL ACK TEXT
	JRST	ETSR.5			;FINISH UP

ETSR.4:	MOVEI	S1,ETSR.E		;POINT TO ERROR ACK TEXT
	MOVEI	S2,ETSR.N		;POINT TO NULL TEXT

ETSR.5:	$ACK	(<^T/(S1)/>,<^I/(S2)/>,,.MSCOD(M))
	POPJ	P,			;RETURN

ETSR.A:	ASCIZ	/Timesharing enabled/
ETSR.E:	ASCIZ	/No KSYS pending/
ETSR.N:	ITEXT	(<>)
ETSR.K:	ITEXT	(<Event ^W/P1/ request #^D/P2/ cancelled>)
> ;END TOPS-10 CONDITIONAL
	SUBTTL	NETSET - 'SET NODE' PROCESSING ROUTINE

NETSET:

IFN FTDN60,<
	MOVX	S1,.ORNOD		;GET THE NODE BLOCK TYPE
	PUSHJ	P,A$FNDB		;SEE IF ITS THERE
	JUMPF	BADMSG			;THAT WAS HIS LAST CHANCE
	MOVE	S1,0(S1)		;GET THE NODE NAME/NUMBER
	SETO	S2,			;Say we want online check
	$CALL	N$CKND##		;Check out the node
	JUMPF	NETS.3			;Failed, either online or
					;  objects started
	JUMPE	S2,NETS.2		;Not found, not defined
	MOVE	P1,S2			;SAVE THE DATA BASE ENTRY ADDRESS
	LOAD	S2,NETSTS(P1),NT.MOD	;GET THE IBM REMOTE STATUS BITS
	JUMPE	S2,NETS.2		;NOT IBM,,CAN'T DO THIS !!!

	CAIN	S2,DF.TRM		;Is it an actual termination node?
	JRST	NETS.4			;Yes, can't do set

NETS.1:	PUSHJ	P,A$GBLK		;GO GET A BLOCK
	CAIN	T1,.ORNOD		;IS THIS THE NODE BLOCK (ALREADY DONE) ?
	JRST	NETS.1			;YES,,TRY THE NEXT ONE
	MOVE	T3,0(T3)		;GET THE ARGUMENT DATA
	CAIN	T1,.STCSD		;IS IT THE  CLEAR TO SEND DELAY VALUE
	STORE	T3,NETCSD(P1)		;YES,,SAVE IT
	CAIN	T1,.STDTR		;IS IT THE DATA TERMINAL READY VALUE ???
	STORE	T3,NETSTS(P1),NT.DTR	;YES,,SAVE IT
	CAIN	T1,.STRPM		;IS IT THE RECORDS PER MESSAGE VALUE ???
	STORE	T3,NETRPM(P1)		;YES,,SAVE IT
	CAIN	T1,.STSWL		;IS IT THE SILO WARNING LEVEL VALUE ???
	STORE	T3,NETSWL(P1)		;YES,,SAVE IT
	CAIN	T1,.STTOU		;IS IT THE TIMEOUT CATAGORY ???
	STORE	T3,NETSTS(P1),NT.TOU	;YES,,SAVE IT
	CAIN	T1,.STTRA		;IS IT THE TRANSPARENCY VALUE ???
	STORE	T3,NETSTS(P1),NT.TRA	;YES,,SAVE IT
	CAIN	T1,.STBPM		;IS IT BYTES PER MESSAGE ???
	STORE	T3,NETBPM(P1)		;YES,,SAVE IT
	MOVX	S1,NETSGN		;GET NODE SIGNON REQUIRED BIT
	CAIN	T1,.STSON		;IS SIGNON REQUIRED ???
	IORM	S1,NETSTS(P1)		;YES,,LIGHT THE BIT
	CAIN	T1,.STNSN		;IS SIGNON OPTIONAL ???
	ANDCAM	S1,NETSTS(P1)		;YES,,CLEAR THE BIT

	$ACK	(<Set for Node ^T/NETASC(P1)/ Accepted>,,,.MSCOD(M))
	$RETT				;RETURN

NETS.2:	$ACK(<Set for Node ^N/S1/ Ignored>,<It is Not Defined as an IBM Remote>,,.MSCOD(M))
	$RETT

NETS.3:	$ACK	(<Set for Node ^T/NETASC(S2)/ Ignored>,<^I/0(S1)/>,,.MSCOD(M))
	$RETT

NETS.4:	$ACK	(<Set for Node ^T/NETASC(P1)/ Ignored>,<It is a termination but not a prototype node>,,.MSCOD(M))
	$RETT
>
IFE FTDN60,<JRST NODN60 >		;JUST ACK AND RETURN

	SUBTTL	A$MODIFY - ROUTINE TO SET THE JOBS PRIORTY

A$MODIFY: $SAVE	<M,P1>			;SAVE 'M' & P1 FOR A SECOND
	MOVEI	S1,TMPMSG+MOD.RQ	;GET THE RDB BLOCK ADDRESS
	PUSHJ	P,GENRDB		;GO GENERATE THE RDB
	MOVX	S1,.MOPRI		;GET THE PRIORITY BLOCK TYPE
	PUSHJ	P,A$FNDB		;GO FIND THE PRIORITY BLOCK
	JUMPF	BADMSG			;IF NOT FOUND,,THATS AN ERROR
	MOVE	S1,0(S1)		;GET THE NEW PRIORITY
	MOVEI	M,TMPMSG		;POINT 'M' AT THE NEW MSG
	MOVEM	S1,MOD.SZ+2(M)		;SAVE THE NEW PRIORITY
	MOVE	S1,[MOD.SZ+3,,.QOMOD]	;GET THE MSG LENGTH AND TYPE
	MOVEM	S1,.MSTYP(M)		;SAVE IT
	SETOM	MOD.SZ+1(M)		;NO/AFTER PARAMETER
	MOVEI	S1,3			;GET THE MAJOR BLOCK LENGTH
	MOVEM	S1,MOD.SZ(M)		;AND SAVE IT
	SETZM	G$ACK##			;WE DONT WANT AN ACK.
	SETOM	G$QOPR##		;THIS IS AN OPERATOR REQUEST

	PUSHJ	P,Q$MODIFY##		;GO MODIFY THE JOB PRIORTY

	SETZM	G$QOPR##		;RESET THE OPERATOR INDICATOR
	SETZM	G$RMTE##		;ZERO THE NODE WE USED (SET BY GENRDB)
	SKIPG	S1			;MORE THEN 0 JOBS ???
	$ACK	(<No ^T/(S2)/s modified>,,,.MSCOD(M))
	CAIN	S1,1			;JUST 1 JOB ???
	$ACK	(<1 ^T/(S2)/ modified>,,,.MSCOD(M))
	CAILE	S1,1			;MORE THEN 1 JOB ???
	$ACK	(<^D/S1/ ^T/(S2)/s modified>,,,.MSCOD(M))
	$RETT				;AND RETURN

SUBTTL A$QUEU - ENABLE/DISABLE SPECIFIC QUEUES

A$QUEU::PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	MOVE	P1,S2			;GET THE CODE (.OMDIS/.OMENA)
	MOVEI	S1,.EDQUE		;GET THE MESSAGE TYPE
	PUSHJ	P,A$FNDB		;FIND THE BLOCK
	JUMPF	ILLMSG			;CAN'T FIND IT
	MOVE	S1,(S1)			;GET THE OBJECT TYPE
	CAMN	S1,[EXP -1]		;ALL QUEUES?
	SKIPA	S1,[-NQUEUE##,,TBLHDR##];AOBJN POINTER TO QUEUE HEADERS
	PUSHJ	P,A$OB2Q		;CONVERT TO QUEUE HEADER
	JUMPF	ILLMSG			;UNKNOWN QUEUE
	PUSH	P,H			;SAVE H
	MOVE	H,S1			;COPY QUEUE HEADER ADDRESS
	MOVX	S1,QH.DIS		;GET DISABLED BIT
	CAIE	P1,.OMENA		;WHICH ONE?
	SKIPA	P2,[IORM   S1,.QHTYP(H)] ;DISABLE
	SKIPA	P2,[ANDCAM S1,.QHTYP(H)] ;ENABLE
	SKIPA	P1,[[ASCIZ /disabled/]]	;DISABLE
	MOVEI	P1,[ASCIZ /enabled/]	;ENABLE

QUEU.1:	LOAD	S2,.QHTYP(H),QH.TYP	;GET QUEUE TYPE
	CAIE	S2,.QHTOU		;OUTPUT?
	CAIN	S2,.QHTIP		;INPUT?
	XCT	P2			;TOGGLE BIT
	JUMPG	H,QUEU.2		;DONE IF ONLY A SINGLE QUEUE
	ADDI	H,QHSIZE-1		;ACCOUNT FOR MULTI-WORD ENTRIES
	AOBJN	H,QUEU.1		;LOOP THROUGH ALL THE HEADERS
	MOVEI	S1,[ASCIZ .All input/output.]
	MOVEI	S2,[ASCIZ /queues are/]
	JRST	QUEU.3			;GO ACK

QUEU.2:	MOVE	S1,.QHLQN(H)		;GET QUEUE LISTING NAME
	MOVEI	S2,[ASCIZ /queue is/]	;ASSUME A SINGLE QUEUE

QUEU.3:	POP	P,H			;RESTORE H
	$ACK	(<^T/(S1)/ ^T/(S2)/ ^T/(P1)/>,,,.MSCOD(M))
	$RETT				;RETURN
	SUBTTL	A$OREQ - Operator REQUEUE Request

A$OREQ:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVX	S1,.OROBJ		;GET OBJECT BLOCK TYPE CODE
	PUSHJ	P,A$FNDB		;GO FIND IT IN THE MESSAGE
	JUMPF	BADMSG			;NOT THERE,,RETURN WITH AN ERROR
	PUSHJ	P,ORANGE		;CHECK FOR A RANGE
	MOVE	P1,S1			;SAVE THE OBJECT BLOCK ADDRESS
	MOVE	S2,OBJ.UN(P1)		;GET THE UNIT NUMBER
	MOVEM	S2,.OHDRS+ARG.DA+OBJ.UN(M)  ;SAVE IT IN THE MESSAGE

	PUSHJ	P,A$FOBJ		;FIND THE OBJ ENTRY
	JUMPF	DEVUNK			;NOT THERE,,ACK THE OPR AND RETURN
	MOVE	P1,S1			;SAVE THE OBJECT QUEUE ENTRY ADDRESS
	MOVE	S1,OBJSCH(P1)		;GET THE SCHEDULING BITS
	TXNN	S1,OBSBUS		;IS THE OBJECT BUSY ???
	JRST	A$RQ.2			;NO,,LET'EM KNOW AND RETURN.
	SETZM	OBJRID(P1)		;Prevent further NEXT processing
	TXNE	S1,OBSFRR		;IS THIS A FREE RUNNING DEVICE ???
	JRST	OREQ.3			;YES,,JUST SEND THE MESSAGE

	LOAD	S1,OBJITN(P1)		;GET THE ITN
	PUSHJ	P,Q$SUSE##		;FIND IT IN THE USE QUEUE
	SKIPT				;SKIP IF WE WON
	$STOP(RJM,Requeue job missing)
	MOVE	AP,S1			;SAVE THE QE ADDRESS

OREQ.1:	PUSHJ	P,A$GBLK		;GET FIRST/NEXT MESSAGE BLOCK
	JUMPF	OREQ.3			;NO MORE,,SEND THE MSG.
	CAIE	T1,.ORREQ		;IS THIS THE REQUEST ID BLOCK
	JRST	OREQ.1			;NO,,TRY THE NEXT ONE
	LOAD	S1,.QERID(AP)		;GET THE REQUEST ID
	CAME	S1,0(T3)		;DO WE MATCH ???
	JRST	A$RQ.3			;NO,,TOUGH BREAKEEEE
	JRST	OREQ.1			;YES,,CONTINUE

OREQ.3:	MOVE	S1,P1			;LOAD S1 WITH OBJECT BLOCK ADDR.
	PJRST	SNDOAC			;GO SEND THE MSG.

A$RQ.2:	$ACK	(Not Active,,OBJTYP(P1),.MSCOD(M))
	$RETT

A$RQ.3:	$ACK	(Request Id Invalid,,OBJTYP(P1),.MSCOD(M))
	$RETT

	SUBTTL 	COMMMM - OPERATOR REQUEST COMMON PROCESSING ROUTINE.

A$COMM:	PUSHJ	P,.SAVE1		;SAVE P1 AND P2 FOR A MINUTE
	MOVX	S1,.OROBJ		;GET THE OBJECT BLOCK TYPE CODE
	PUSHJ	P,A$FNDB		;FIND THE OBJECT BLOCK IN THE MESSAGE
	JUMPF	BADMSG			;NOT THERE,,TOO BAD !!!
	PUSHJ	P,ORANGE		;DETERMINE OBJECT RANGE.
	MOVE	P1,S1			;SAVE THE OBJECT BLOCK ADDRESS
	MOVE	S2,OBJ.UN(P1)		;GET THE UNIT NUMBER
	MOVEM	S2,.OHDRS+ARG.DA+OBJ.UN(M)  ;SAVE IT IN THE MESSAGE
	
	PUSHJ	P,A$FOBJ		;FIND THE OBJECT BLOCK.
	JUMPF	DEVUNK			;NOT THERE,,ACK THE OPR AND RETURN
	MOVE	P1,S1			;SAVE THE OBJECT QUEUE ENTRY ADDRESS
	MOVX	S1,OBSSTP		;GET THE 'STOPPED' STATUS BIT
	LOAD	S2,.MSTYP(M),MS.TYP	;GET THE MESSAGE TYPE
	CAXN	S2,.OMCON		;IS THE MESSAGE 'CONTINUE' ???
	ANDCAM	S1,OBJSCH(P1)		;YES,,TURN OFF THE 'STOP' BIT
	MOVX	S1,OBSBUS!OBSFCH	;[1163] PICK UP BUSY BIT AND FORMS CHANGE BIT
	TDNN	S1,OBJSCH(P1)		;IS THE DEVICE BUSY ???.
	JRST	COMM.2			;IF NOT,, RETURN.

	MOVE	S1,P1			;GET THE OBJECT ADDRESS
	PUSHJ	P,SNDOAC		;GO SEND THE MSG.
	MOVE	S1,P1			;GET THE OBJECT ADDRESS
	PUSHJ	P,A$OBST		;UPDATE THE OBJECT STATUS
	$RETT				;RETURN...

COMM.2:	LOAD	S2,.MSTYP(M),MS.TYP	;GET THE MESSAGE TYPE
	CAXE	S2,.OMCON		;IS THE MESSAGE 'CONTINUE' ???
	JRST	COMM.4			;NO,,JUST ACK AND LEAVE
	$ACK	(Continued,,OBJTYP(P1),.MSCOD(M)) ;TELL THE OPERATOR
	MOVE	S1,P1			;GET THE OBJECT ADDRESS
	PUSHJ	P,A$OBST		;UPDATE THE OBJECT STATUS
	DOSCHD				;FORCE A SCHEDULING PASS
	$RETT				;AND RETURN

COMM.4:	$ACK	(Not Active,,OBJTYP(P1),.MSCOD(M))
	$RETT
	SUBTTL	OPERATOR COMMAND PROCESSING ROUTINES.


A$OCON:	PJRST	A$COMM			;PROCESS THE CONTINUE COMMAND.

A$OALI:	PJRST	A$COMM			;PROCESS THE ALIGN COMMAND.

A$OCAN:	PJRST	A$OREQ			;PROCESS THE CANCEL COMMAND.

A$OFWS:	PJRST	A$COMM			;PROCESS THE FORWARD SPACE COMMAND.

A$OBKS:	PJRST	A$COMM			;PROCESS THE BACK SPACE COMMAND.

A$OSUP:	PJRST	A$COMM			;PROCESS THE SUPPRESS COMMAND.

A$OSND:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVX	S1,.OROBJ		;GET THE OBJECT BLOCK TYPE
	PUSHJ	P,A$FNDB		;FIND THE OBJECT BLOCK IN THE MESSAGE
	JUMPF	BADMSG			;NOT THERE,,THATS AN ERROR
	MOVE	P1,S1			;SAVE THE ADDRESS FOR A MINUTE
	PUSHJ	P,A$FOBJ		;FIND THE OBJECT IN OUR OBJECT QUEUE
	JUMPF	DEVUNK			;NOT THERE,,ACK THE OPR AND RETURN
	MOVE	P1,S1			;SAVE THE OBJECT ADDRESS
	MOVE	S1,OBJNOD(P1)		;GET THE NODE FOR THIS OBJECT
	PUSHJ	P,N$NODE##		;FIND IT IN OUT DATA BASE
	MOVE	S1,P1			;RESTORE THE OBJECT ADDRESS TO S1
	LOAD	S2,NETSTS(S2)		;GET THE NODE STATUS BITS IN S2
	TXNN	S2,NETIBM		;IS THIS NODE SOME FLAVOR OF DN60 ???
	JRST	A$COMM			;NO,,ALL THIS FOR NOTHING !!!
	LOAD	S2,S2,NT.MOD		;GET THIS NODES MODE OF OPERATION
	CAXE	S2,DF.EMU		;IS IT EMULATION ???
	JRST	A$COMM			;NO,,WELL WE STILL LOSE !!!
	LOAD	S2,OBJSCH(S1)		;SO FAR, SO GOOD - GET SCHEDULING BITS
	TXNE	S2,OBSSUP		;OBJECT MUST BE SETUP.IF SO HE WINS
	JRST	SNDOAC			;ALL THIS FOR DN60! ITS NOT WORTH IT !!
	$ACK	(<Not Active>,,OBJTYP(S1),.MSCOD(M))
	$RETT				;JUST RETURN

A$OSHC:	PJRST	A$COMM			;PROCESS THE SHOW CONTROL FILE COMMAND.

	SUBTTL	A$OPAU - STOP OPERATOR MESSAGE PROCESSOR

A$OPAU:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A SECOND
	MOVX	S1,.OROBJ		;GET THE OBJECT BLOCK TYPE CODE
	PUSHJ	P,A$FNDB		;FIND THE OBJECT BLOCK IN THE MESSAGE
	JUMPF	BADMSG			;NOT THERE,,TOO BAD !!!
	PUSHJ	P,ORANGE		;DETERMINE OBJECT RANGE.
	MOVE	P1,S1			;SAVE THE OBJECT BLOCK ADDRESS
	MOVE	S2,OBJ.UN(P1)		;GET THE UNIT NUMBER
	MOVEM	S2,.OHDRS+ARG.DA+OBJ.UN(M)  ;SAVE IT IN THE MESSAGE
	
	PUSHJ	P,A$FOBJ		;FIND THE OBJECT BLOCK.
	JUMPF	DEVUNK			;NOT THERE,,ACK THE OPR AND RETURN
	MOVE	P1,S1			;SAVE THE OBJECT QUEUE ENTRY ADDRESS
	MOVE	S1,.OFLAGS(M)		;GET THE MESSAGE FLAG BITS
	TXNE	S1,ST.ACR+ST.AER	;IS THIS AN 'IMMEDIATE' STOP ???
	JRST	OPAU.1			;NO,,SKIP THIS
	LOAD	S1,OBJSCH(P1),OBSBUS	;IS THE DEVICE ACTIVE ???
	JUMPE	S1,OPAU.2		;NO,,JUST ACK AND RETURN
	MOVE	S1,P1			;GET THE OBJECT ADDRESS IN S1
	PUSHJ	P,SNDOAC		;SEND THE REQUEST OFF
	JRST	OPAU.3			;[1202] GO SET 'STOPPED' AND UPDATE

OPAU.1:	MOVX	S2,OBSSER		;GET THE 'STOP AFTER EVERY REQUEST' BIT
	TXNE	S1,ST.AER		;DOES HE WANT EACH REQUEST STOPPED ???
	IORM	S2,OBJSCH(P1)		;YES,,SET THE STATUS BIT
	MOVEI	S2,[ASCIZ/Stop is Pending/]	;GET THE ACK TEXT
	MOVX	S1,OBSBUS		;GET THE ACTIVE STATUS
	TDNN	S1,OBJSCH(P1)		;ARE WE ACTIVE NOW ???
OPAU.2:	MOVEI	S2,[ASCIZ/Stopped/]	;NO,,JUST SAY STOPPED
	$ACK	(^T/0(S2)/,,OBJTYP(P1),.MSCOD(M))  ;ACK THE OPR
OPAU.3:	MOVX	S1,OBSSTP		;GET THE 'STOPPED' STATUS BIT
	IORM	S1,OBJSCH(P1)		;AND SET IT
	MOVE	S1,P1			;GET THE OBJECT ADDRESS IN S1
	PUSHJ	P,A$OBST		;UPDATE THE STATUS
	$RETT				;RETURN

	SUBTTL	A$OREL, A$OHLD - RELEASE/HOLD OPERATOR MESSAGES.

A$OREL:	TXOA	S1,HB.FRL		;INDICATE RELEASE ENTRY POINT.
A$OHLD:	SETZ	S1,			;INDICATE HOLD ENTRY POINT.
	$SAVE	<M,P1>			;SAVE 'M' AND P1 FOR A SECOND
	MOVE	P1,S1			;SAVE THE ENTRY TYPE
	MOVEI	S1,TMPMSG+HBO.RQ	;GET THE RDB BLOCK ADDRESS
	PUSHJ	P,GENRDB		;GO CREATE THE MESSAGE RDB
	MOVEI	M,TMPMSG		;GET THE MSG ADDRESS IN 'M'
	MOVEM	P1,HBO.FL(M)		;SAVE THE TYPE FLAGS
	MOVE	S1,[HBO.SZ,,.QOHBO]	;GET THE MSG LENGTH,,TYPE
	MOVEM	S1,.MSTYP(M)		;SAVE IT
	SETZM	G$ACK##			;INDICATE NO ACK.
	SETOM	G$QOPR##		;SHOW THAT MSG IS FROM THE OPERATOR.

	PUSHJ	P,Q$HOLD##		;PERFORM HOLD/RELEASE

	SETZM	G$QOPR##		;TURN OFF THE QUEUE SEARCH FLAG.
	SETZM	G$RMTE##		;ZERO THE NODE WE USED (SET BY GENRDB)
	MOVEI	TF,[ASCIZ/held/]	;ASSUME HOLD MESSAGE.
	SKIPE	P1			;CHECK FLAGS,,IF 0 WE WERE RIGHT
	MOVEI	TF,[ASCIZ/released/]	;ELSE MAKE IT RELEASE.
	SKIPG	S1			;MORE THEN 0 JOBS ???
	$ACK	(<No ^T/(S2)/s ^T/@TF/>,,,.MSCOD(M))
	CAIN	S1,1			;IS THERE ONLY 1 JOB ???
	$ACK	(<1 ^T/(S2)/ ^T/@TF/>,,,.MSCOD(M))
	CAILE	S1,1			;MORE THEN 1 JOB ???
	$ACK	(<^D/S1/ ^T/(S2)/s ^T/@TF/>,,,.MSCOD(M))
	SKIPE	P1			;IS THIS A RELEASE MSG ???
	DOSCHD				;YES,,FORCE A SCHEDULING PASS
	$RETT				;AND RETURN.


	SUBTTL	A$ODEL - ROUTINE TO REMOVE JOBS FROM THE SYSTEM QUEUES

	;CALL:	M/ The Operator CANCEL msg address
	;
	;RET:	True Always

A$ODEL:	$SAVE	<M>			;SAVE THE INCOMMING MSG ADDRESS
	MOVEI	S1,TMPMSG+KIL.RQ	;GET THE RDB BLOCK ADDRESS
	PUSHJ	P,GENRDB		;GO CREATE THE RDB FOR THE MSG
	MOVEI	M,TMPMSG		;GET THE MSG ADDRESS IN 'M'
	MOVE	S1,[KIL.SZ,,.QOKIL]	;GET THE MSG LENGTH,,TYPE
	MOVEM	S1,.MSTYP(M)		;SAVE IT
	SETZM	G$ACK##			;NO ACK (PERIOD)
	SETOM	G$QOPR##		;THIS IS AN OPERATOR REQUEST

	PUSHJ	P,Q$KILL##		;GO DO IT !!!

	SETZM	G$QOPR##		;CLEAR OPR FLAG
	SETZM	G$RMTE##		;ZERO THE NODE WE USED (SET BY GENRDB)
	SKIPG	S1			;NO JOBS KILLED !!!
	$ACK	(<No ^T/(S2)/s canceled>,,,.MSCOD(M))
	CAIN	S1,1			;1 JOB KILLED !!!
	$ACK	(<1 ^T/(S2)/ canceled>,,,.MSCOD(M))
	CAILE	S1,1			;MORE THE 1 JOB !!!
	$ACK	(<^D/S1/ ^T/(S2)/s canceled>,,,.MSCOD(M))
	$RETT				;RETURN,,WE'RE DONE
	SUBTTL	A$ORTE - ROUTINE TO PROCESS OPERATOR ROUTE COMMAND.


A$ORTE:	PUSHJ	P,A$WHEEL		;IS THIS GUY A WHEEL ???
	JUMPF	E$IPE##			;NO,,A FRAUD !!
	MOVX	S1,.ORRTN		;GET THE ROUTE BLOCK TYPE
	PUSHJ	P,A$FNDB		;FIND THE BLOCK IN THE MESSAGE
	JUMPF	BADMSG			;NOT THERE,,RETURN AN ERROR
	PUSHJ	P,.SAVE1		;SAVE P1 FOR A SECOND
	MOVE	P1,S1			;SAVE THE DATA ADDRESS
	MOVSI	S1,RTELEN+.OHDRS	;GET THE MSG LENGTH
	MOVEM	S1,.MSTYP(M)		;SAVE IT IN THE MESSAGE
	MOVEI	S1,2			;GET 2 BLOCKS
	MOVEM	S1,.OARGC(M)		;SAVE IT IN THE MESSAGE
	MOVEI	S2,.OHDRS(M)		;POINT TO THE FIRST BLOCK
	MOVE	S1,[4,,.RTEFM]		;GET THE FIRST BLOCK HEADER
	MOVEM	S1,ARG.HD(S2)		;SAVE IT
	SETOM	ARG.DA+OBJ.TY(S2)	;ALL DEVICES
	SETOM	ARG.DA+OBJ.UN(S2)	;ALL UNITS
	LOAD	S1,.SNODE-1(P1)		;GET THE SOURCE NODE NAME/NUMBER
	MOVEM	S1,ARG.DA+OBJ.ND(S2)	;SAVE IT
	MOVEI	S2,OBJ.SZ+1(S2)		;POINT TO THE NEXT BLOCK
	MOVE	S1,[4,,.RTETO]		;GET THE SECOND BLOCK HEADER
	MOVEM	S1,ARG.HD(S2)		;SAVE IT
	SETOM	ARG.DA+OBJ.TY(S2)	;ALL DEVICES
	SETOM	ARG.DA+OBJ.UN(S2)	;ALL UNITS
	LOAD	S1,.DNODE-1(P1)		;GET THE DESTINATION NODE NBR.
	MOVEM	S1,ARG.DA+OBJ.ND(S2)	;SAVE IT
	PJRST	N$NRTE##		;GO PERFORM THE ROUTING & RETURN
	SUBTTL	A$DEFINE - Routine to process the 'DEFINE' network command

	;Call:	M/ The message address

	;Ret:	TRUE always

;  The purpose of this routine is to add a prototype node to the node data base.
;  The current characteristics are:
;	1.  If the node already exists, verify its current state.  If it already
;		has objects started, is online, or has devices started on the
;		same port/line, thats an error.
;	2.  If 1 passed, add the node to the node database.
;	3.  If the node is termination, and signon is required, find the signon
;		file and validate all of the actual nodes as specified in
;		step 1.  Also add the node to the data base as an IBM term.
;		node (unless it has objects started on it, in which case
;		the operator is notified of the error.)
;	4.  Notify the operator of the completion of the definition.

A$DEFINE:
IFN FTDN60!FTDQS,<
	$SAVE	<P1,P2,P3,P4>		;Save P1,P2,P3,P4 for a minute
					;P1 is used for node name
					;P2 is used for node entry address
					;P3 is used for block header
					;P4 is used for display
	MOVX	S1,.ORNOD		;GET THE NODE NAME BLOCK TYPE
	PUSHJ	P,A$FNDB		;GO FIND IT
	JUMPF	BADMSG			;NOT THERE,,ORION BUG !!!

	MOVE	S1,0(S1)		;GET THE NODE NAME
	SETO	S2,			;Say we want online check
	MOVE	P1,S1			;Save the node name
	$CALL	N$CKND##		;Check out the node
	JUMPF	DEFBD1			;Failed, either online or
					;  objects started
	MOVE	P2,S2			;Remember the results of N$CKND
	SETZ	P4,			;Say this is a definition
	SKIPN	P2			;Is it?
	AOJ	P4,			;No, say redefinition

;  Find the DEFINE Msg Block

	MOVX	S1,.DFBLK		;GET THE DEFINE BLOCK TYPE
	PUSHJ	P,A$FNDB		;GO FIND IT
	JUMPF	BADMSG			;NOT THERE,,ORION ERROR
	MOVEI	P3,-1(S1)		;MAKE SURE WE ARE POINTING AT BLK HEADER
IFN FTDQS,<
	LOAD	S1,DEF.TY(P3),DF.TPP	;GET TYPE
	CAXN	S1,DF.SRV		;SERVER?
	JRST	DEFSRV			;YES
>; END IFN FTDQS
IFN FTDN60,<
	MOVE	S1,P1			;Get back the node name
	MOVE	S2,DEF.MD(P3)		;GET THE NODE MODE
	CAXE	S2,DF.TRM		;Is it termination?
	JRST	DEFI.1			;No, skip this
	LOAD	S2,DEF.TY(P3),DF.FLG	;Get the signon flag
	CAIN	S2,DF.NSN		;Is no signon required?
	JRST	DEFI.1			;No signon required, skip this

;  Check out the prototype termination signon file

	MOVE	S2,P2			;Give what we know of node address
	PUSHJ	P,N$SACT##		;Go check out signon file and nodes
	JUMPF	DEFBD1			;Failed, tell the operator about it
	MOVE	P2,S2			;Remember the entry

;  Add the node to the data base if needed

DEFI.1:	JUMPN	P2,DEFI.2		;Skip this if node already defined
	PUSHJ	P,N$NNET##		;Add the node
	MOVE	P2,S2			;Remember the entry

DEFI.2:	MOVE	S2,DEF.MD(P3)		;Get the node mode
	CAXN	S2,DF.TRM		;Is it termination
	MOVX	S2,DF.PRO		;Yes, make it a prototype
	STORE	S2,NETSTS(P2),NT.MOD	;SAVE IT IN OUR DATA BASE
	LOAD	S2,DEF.TY(P3),DF.TPP	;Get the type of node
	STORE	S2,NETSTS(P2),NT.TYP	;SAVE IT IN OUR DATA BASE
	MOVE	S2,DEF.PT(P3)		;GET THE PORT NUMBER
	STORE	S2,NETPTL(P2),NT.PRT	;SAVE THE PORT NUMBER
	MOVE	S2,DEF.LN(P3)		;GET THE LINE NUMBER
	STORE	S2,NETPTL(P2),NT.LIN	;SAVE THE LINE NUMBER

;  Setting defaults

;  BPM--If 3780 then 512 else 400

	MOVEI	S1,^D400		;Get most likely
	LOAD	S2,NETSTS(P2),NT.TYP	;GET THE REMOTE TYPE
	CAXN	S2,DF.378		;IS IT 3780 ???
	MOVEI	S1,^D512		;Yes, set it different
	STORE	S1,NETBPM(P2),FWMASK	;And set it

;  CSD--Is always set to 3

	MOVEI	S1,3			;Get the normal value
	STORE	S1,NETCSD(P2),FWMASK	;And set it

;  RPM--If 2780 then 7 else 0

	SETZ	S1,			;Get most likely
	CAXN	S2,DF.278		;Is it 2780 ???
	MOVEI	S1,7			;Yes, set it different
	STORE	S1,NETRPM(P2),FWMASK	;And set it

;  Timeout cat.--If proto termination, then primary else secondary

	MOVEI	S1,ST.SEC		;Must start somewhere
	LOAD	S2,NETSTS(P2),NT.MOD	;GET THE REMOTE MODE
	CAXN	S2,DF.PRO		;IS IT PROTO TERMINATION MODE ???
	MOVEI	S1,ST.PRI		;Yes, say primary
	STORE	S1,NETSTS(P2),NT.TOU	;And set it

;  Transparancy--Always off

	MOVEI	S1,ST.OFF		;Set it off
	STORE	S1,NETSTS(P2),NT.TRA	;And set it

;  Set port/line handle

	MOVE	S1,G$NOW##		     ;GET THE UDT FOR PORT/LINE HANDLE
	MOVEM	S1,NETIDN(P2)		     ;SAVE IT IN THE DATA BASE

;  Say we are IBM node

	MOVEI	S1,1			     ;GET A 1
	STORE	S1,NETSTS(P2),NETIBM	     ;LITE THE IBM NODE BIT

;  Set the signon according to the define

	LOAD	S2,DEF.TY(P3),DF.FLG	     ;Get the signon flag
	CAIN	S2,DF.NSN		     ;Is signon required?
	SETZ	S1,			     ;Want to clear the bit
	STORE	S1,NETSTS(P2),NETSGN	     ;SET 'SIGNON REQUIRED' BIT
>; END IFN FTDN60

DEFGOD:	$ACK	(< ^T/DEFTAB(P4)/efine for node ^T/NETASC(P2)/ accepted >,,,.MSCOD(M))
	$RETT				;AND RETURN

IFN FTDQS,<
DEFSRV:	MOVE	S1,P1			;GET BACK THE NODE NAME
	PUSHJ	P,N$NNET##		;ADD THE NODE
	MOVE	P2,S2			;REMEMBER THE ENTRY
	MOVEI	S1,1			;GET A 1
	STORE	S1,NETSTS(P2),NETSRV	;LITE THE SERVER NODE BIT
	MOVE	S1,[1,,.OTLPT]		;ONE LPT
	MOVEM	S1,NETLPT(S2)		;SAVE
	JRST	DEFGOD			;GO ACK THEM
>; END IFN FTDQS

DEFBD1:	$ACK(< Define for node ^N/P1/ ignored >,<^I/0(S1)/>,,.MSCOD(M))
	$RETT
>; END IFN FTDN60!FTDQS
IFE FTDN60!FTDQS,<
NODN60:	$ACK	(< DN60 remotes are not supported >,,,.MSCOD(M))
	$RETT
>
	SUBTTL	A$DN60 - ROUTINE TO SEND A OPERATOR RESPONSE TO LPTSPL

	;CALL:	M/ The Operator response message address
	;
	;RET:	True Always

A$DN60:
IFN FTDN60,<
	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVX	S1,.OTLPT		;GET PRINTER OBJECT TYPE
	MOVEM	S1,G$MSG##+OBJ.TY	;SAVE IT IN OBJECT BLOCK
	SETZM	G$MSG##+OBJ.UN		;WANT UNIT 0
	MOVE	S1,.MSCOD(M)		;GET THE NODE NAME
	MOVEM	S1,G$MSG##+OBJ.ND	;SAVE IT IN OBJECT BLOCK
	MOVEI	S1,G$MSG##		;POINT TO OUR OBJECT BLOCK
	PUSHJ	P,A$FOBJ		;FIND IT IN THE OBJECT QUEUE
	JUMPF	DN60.1			;NOT THERE,,TELL OPERATOR AND RETURN
	MOVE	P1,S1			;SAVE THE OBJECT ADDRESS
	LOAD	S1,OBJSCH(P1)		;GET THE OBJECT SCHEDULING BITS
	TXNN	S1,OBSSUP+OBSSIP	;OBJ MUST BE SETUP OR SETUP-IN-PROGRESS
	JRST	DN60.1			;NO,,TELL OPERATOR AND RETURN
	LOAD	S1,OBJNOD(P1)		;GET THIS OBJECTS NODE NAME
	PUSHJ	P,N$NODE##		;FIND IT IN OUR DATA BASE
	LOAD	S1,NETSTS(S2),NETIBM	;GET THE DN60 FLAG BIT
	JUMPE	S1,DN60.1		;NOT DN60,,TELL OPR AND RETURN
	MOVE	S1,P1			;GET THE OBJECT ADDRESS
	PJRST	SNDOAC			;AND SEND THE MESSAGE OFF TO LPTSPL

DN60.1:	$WTO(<No Operator Console for IBM Remote ^N/.MSCOD(M)/>,,,<$WTFLG(WT.SJI)>)
	MOVEI	S1,G$MSG##		;[1206] GET MESSAGE BUFFER ADDR
	PJRST	SNDOPR			;RETURN THE MSG TO ORION AND RETURN
>
IFE FTDN60,<JRST NODN60 >		;SHOULD NOT HAPPEN

	SUBTTL	A$DQNM - Define a Queue Name

A$DQNM::$SAVE	<AP,H,E,P1,P2>		;SAVE THE AC'S
	MOVX	S1,.DFQNM		;GET THE BLOCK TYPE
	PUSHJ	P,A$FNDB		;FIND IT IN THE MESSAGE
	JUMPF	BADMSG			;SHOULD BE THERE

	MOVEI	P1,-1(S1)		;POINT AT THE BLOCK HEADER
	MOVEI	S1,DFQ.QN(P1)		;POINT AT THE QUEUE NAME
	HRLI	S1,(POINT 8)		;WE STORE THE NAME IN 8-BIT ASCII
	PUSHJ	P,ASCUPR		;MAKE SURE IT'S UPPER CASE
	MOVEI	H,HDRQNM##		;POINT AT THE QUEUE HEADER
	SETZB	P2,E			;ASSUME A REDEFINITION
	LOAD	AP,.QHLNK(H),QH.PTF	;GET POINTER TO FIRST ENTRY IN QUEUE
DQNM.1:	JUMPE	AP,DQNM.3		;IF NOTHING THERE, GO CREATE AN ENTRY
	MOVEI	S1,DFQ.QN(P1)		;TEST STRING
	MOVEI	S2,QNM.QN(AP)		;BASE STRING
	HRLI	S1,(POINT 8)		;BOTH 8-BIT ASCII STRINGS
	HRLI	S2,(POINT 8)
	PUSHJ	P,S%SCMP		;COMPARE THE STRINGS
	SKIPF				;DID IT MATCH?
	JUMPE	S1,DQNM.4		;YES, IF EXACT MATCH, TAKE IT
	JUMPG	E,DQNM.2		;CONTINUE IF POSITION FOUND
	TXNN	S1,SC%GTR		;NEW NAME GREATER THAN OLD?
	MOVE	E,AP			;REMEMBER POSITION IN QUEUE
DQNM.2:	LOAD	AP,.QELNK(AP),QE.PTN	;GET POINTER TO NEXT ENTRY
	JRST	DQNM.1			;CHECK FOR THAT

DQNM.3:	SKIPN	DFQ.OT(P1)		;CREATING AND DELETING?
	JRST	DQNM.6			;TELL FOOL TO GET STUFFED
	PUSHJ	P,M$GFRE##		;GET A FREE CELL
	SKIPGE	E			;KNOW WHERE TO PUT NEW ENTRY?
	LOAD	E,.QHLNK(H),QH.PTF	;STICK AT FRONT OF QUEUE
	PUSHJ	P,M$LINK##		;LINK IT IN
	MOVEI	P2,1			;THIS IS A DEFINITION
DQNM.4:	MOVSI	S1,DFQ.QN(P1)		;SOURCE
	HRRI	S1,QNM.QN(AP)		;DESTINATION
	BLT	S1,QNM.QN+QNMLEN-1(AP)	;GET IT ALL
	MOVE	S1,DFQ.TY(P1)		;GET THE QUEUE TYPE
	CAXE	S1,.KYLCL		;LOCAL QUEUE?
	TDZA	S1,S1			;NO, GET A ZERO
	MOVX	S1,QN.LCL		;YES, GET THE FLAG
	MOVEM	S1,QNM.FL(AP)		;STUFF FLAGS
	MOVE	S1,DFQ.ND(P1)		;GET THE NODE NAME
	MOVEM	S1,QNM.RO+.ROBND(AP)	;STUFF IT
	MOVE	S1,DFQ.OT(P1)		;GET THE OBJECT TYPE
	MOVEM	S1,QNM.RO+.ROBTY(AP)	;STUFF IT
	MOVE	S1,DFQ.UN(P1)		;GET THE UNIT NUMBER
	MOVEI	S2,%PHYCL		;ASSUME PHYSICAL
	CAME	S1,[EXP -1]		;ANY UNIT?
	SKIPE	DFQ.UT(P1)		;OR A UNIT TYPE?
	MOVEI	S2,%GENRC		;CALL IT GENERIC
	STORE	S1,QNM.RO+.ROBAT(AP),RO.UNI ;STUFF IT
	STORE	S2,QNM.RO+.ROBAT(AP),RO.ATR ;STUFF IT
	MOVE	S1,DFQ.UT(P1)		;GET THE UNIT TYPE
	MOVEM	S1,QNM.RO+.ROBUT(AP)	;STUFF IT
	MOVE	S1,QNM.RO+.ROBND(AP)	;NODE
	SETZ	S2,			;NO NUMBER
	PUSHJ	P,N$NNET##		;ADD REMOTE NODE
	MOVX	S1,NETNQC		;MAGICAL BIT
	IORM	S1,NETSTS(S2)		;MAKE UNREAL NODE
	SKIPN	QNM.RO+.ROBTY(AP)	;OBJECT TYPE?
	JRST	DQNM.5			;DELETING QUEUE NAME
	$ACK	(<^T/DEFTAB(P2)/efine for network queue ^Q/QUEQUE/ accepted>,,,.MSCOD(M))
	$RETT				;ALL SET

DQNM.5:	$ACK	(<Network queue ^Q/QUEQUE/ deleted>,,,.MSCOD(M))
	PUSHJ	P,M$RFRE##		;DEALLOCATE, RETURN CORE
	$RETT				;RETURN

DQNM.6:	$ACK	(<Network queue ^Q/QUEMSG/ does not exist>,,,.MSCOD(M))
	$RETT				;RETURN

QUEQUE:	POINT	8,QNM.QN(AP)		;POINTER TO NAME IN QUEUE
QUEMSG:	POINT	8,DFQ.QN(P1)		;POINTER TO NAME IN MSG
;ROUTINE TO CONVERT A STRING TO UPPER-CASE ASCII.  CALL WITH THE
;BYTE POINTER TO THE STRING IN S1.

ASCUPR:	ILDB	S2,S1			;GET A BYTE
	JUMPE	S2,.RETT		;DONE WHEN A NULL IS ENCOUNTERED
	CAIL	S2,"a"			;LOWER CASE ASCII?
	CAILE	S2,"z"			;...
	JRST	ASCUPR			;NOPE, NO SWEAT
	SUBI	S2,"a"-"A"		;CONVERT TO UPPER CASE
	DPB	S2,S1			;STORE IT BACK
	JRST	ASCUPR			;LOOP
	SUBTTL	A$NEXT - NEXT COMMAND PROCESSOR

A$NEXT:: MOVX	S1,.OROBJ		;[NXT] GET THE OBJECT BLOCK TYPE
	PUSHJ	P,A$FNDB		;[NXT] FIND THE OBJECT BLOCK IN THE MSG
	JUMPF	BADMSG			;[NXT] NOT THERE,,TOO BAD !!!
	$SAVE	<P1,AP>			;[NXT] SAVE P1 AND AP
	MOVE	P1,S1			;[NXT] SAVE THE OBJECT BLOCK ADDRESS
	PUSHJ	P,GETOBJ		;[1167] [NXT] FIND OR CREATE OBJ ENTRY 
	JUMPF	DEVUNK			;[NXT] NOT THERE,,ACK THE OPR AND RETURN
	MOVE	P1,S1			;[NXT] SAVE THE OBJECT ADDRESS
	MOVX	S1,.ORREQ		;[NXT] GET THE REQUEST ID BLOCK
	PUSHJ	P,A$FNDB		;[NXT] LOCATE IT IN THE MESSAGE
	JUMPF	BADMSG			;[NXT] NOT THERE,,THAS AN ERROR
	MOVE	S1,0(S1)		;[NXT] GET THE REQUEST ID
	MOVE	AP,S1			;[NXT] SAVE IT HERE FOR A SECOND
	PUSHJ	P,A$FREQ		;[NXT] LOCATE THE REQUEST
	JUMPF	NEXT.2			;[NXT] NOT THERE,,OH WELL...
	MOVE	AP,S1			;[NXT] SAVE THE QE ADDRESS
	MOVE	S1,.QEROB+.ROBTY(AP)	;[NXT] GET THE REQUEST DEVICE TYPE
	CAME	S1,OBJTYP(P1)		;[NXT] THESE MUST MATCH !!!
	JRST	NEXT.3			;[NXT] NO,,THATS AN ERROR
	PUSHJ	P,Q$CDEP##		;[NXT] MAKE SURE NO DEPENDIENCIES
	JUMPF	NEXT.4			;[NXT] OH WELL,,WE TRIED !!!
	MOVE	S1,.QERID(AP)		;[NXT] GET THE REQUEST ID BACK
	MOVEM	S1,OBJRID(P1)		;[NXT] SAVE IT FOR THE SCHEDULER
	DOSCHD				;[NXT] FORCE A SCHEDULING PASS
	$ACK	(<NEXT request #^D/S1/ scheduled>,,OBJTYP(P1),.MSCOD(M))
	$RETT				;[NXT] RETURN

NEXT.2:	$ACK	(<NEXT request #^D/AP/ does not exist>,,,.MSCOD(M))
	$RETT				;[NXT] RETURN

NEXT.3:	$ACK	(<Illegal device specified for NEXT request #^D/.QERID(AP)/>,,,.MSCOD(M))
	$RETT				;[NXT] RETURN

NEXT.4:	$ACK	(<NEXT request #^D/.QERID(AP)/ is not schedulable>,,,.MSCOD(M))
	$RETT				;[NXT] RETURN

	SUBTTL	A$OODB - Process a Object Type Data Message

	;Call:	M/Addr of message from ORION

A$OODB::LOAD	S1,.MSTYP(M),MS.CNT	;GET MESSAGE SIZE
	CAILE	S1,.OHDRS		;IF TOO SMALL
	CAILE	S1,PAGSIZ		;OR TOO BIG
	JRST	BADMSG			;FORGET IT
	ADD	S1,M			;POINT TO END OF MESSAGE
	PUSHJ	P,.SAVE4		;SAVE PRESERVED ACS
	SETZB	P3,AP			;P3 WILL GET OBJECT TYPE
					;AP WILL GET SIZE OF DATA FOR ODB
	MOVE	P2,S1			;SAVE END OF MESSAGE ADDR
	MOVE	P1,.OARGC(M)		;GET NUMBER OF ARG BLOCKS
	CAIE	P1,2			;NEED 2, 1 FOR OBJ TYP, 1 FOR DATA
	JRST	BADMSG			;NOT ENOUGH
	$CALL	M%GPAG			;GET A SCRATCH PAGE
	JUMPF	BADMSG			;IF NO MEMORY, FORGET IT
	MOVEI	S2,.OHDRS(M)		;POINT TO FIRST BLOCK
	$SAVE	<H,AP>			;SAVE THESE TOO
	SETZ	H,			;ODB ARG COUNTER
	
;Loop thru message copying arg blocks to go into variable length ODB.
;S1 = address where to put data in scratch page, S2 = pointer into message

OODB.1:	LOAD	TF,ARG.HD(S2),AR.TYP	;GET ARG BLOCK TYPE
	CAIE	TF,.ORTYP		;OBJECT BLOCK TYPE?
	JRST	OODB.2			;NO, GO COPY ARG BLOCK

;Process Object type arg block - save object type in P3

	JUMPN	P3,ODBERR		;ERROR IF OBJECT TYPE ALREADY FOUND
	MOVE	TF,ARG.DA(S2)		;GET OBJECT TYPE
	CAILE	TF,0			;WITHIN RANGE?
	CAILE	TF,.OTMAX
	JRST	ODBERR			;NO, GO FREE MEMORY AND RETURN
	MOVE	P3,TF			;SAVE OBJECT TYPE
	LOAD	P4,ARG.HD(S2),AR.LEN	;GET LENGTH OF .ORTYP BLOCK
	JRST	OODB.3			;GO LOOK FOR NEXT ARG BLOCK

;Process any other arg block - copy to scratch page

OODB.2:	LOAD	TF,ARG.HD(S2),AR.LEN	;GET ARGUMENT LENGTH
	MOVE	P4,TF			;SAVE IT
	ADD	TF,S2			;COMPUTE END OF BLOCK
	CAILE	TF,(P2)			;WITHIN MESSAGE STILL?
	JRST	ODBERR			;NO, QUIT NOW
	HRL	TF,S2			;GET SOURCE ADDRESS FOR BLT
	HRR	TF,S1			;GET DESTINATION ADDRESS FOR BLT
	ADD	S1,P4			;GET ENDING ADDRESS + 1 (NEXT FREE)
	BLT	TF,-1(S1)		;COPY ARG BLOCK
	ADD	AP,P4			;COUNT UP WORDS NEEDED IN ODB
	AOS	H			;COUNT NUMBER OF ARGS COPIED
OODB.3:	ADD	S2,P4			;POINT TO NEXT ARG BLOCK
	SOJG	P1,OODB.1		;LOOP FOR ALL ARG BLOCKS

;Here when ready to copy scratch page data and object type into ODB.

	JUMPE	P3,ODBERR		;CAN'T DO ANYTHING WITHOUT OBJ TYPE
	MOVE	P1,S1			;GET SCRATCH PAGE ADDR IN P1
	TRZ	P1,777			;POINT TO START OF PAGE
	MOVE	P2,AP			;SAVE DATA SIZE
	MOVE	P4,H			;SAVE COUNT OF ARGS COPIED
	MOVEI	H,HDRODB##		;GET QUEUE HEADER ADDR, AP IS ALL SET
	PUSHJ	P,M$GFRE##		;GET ENTRY, SIZE IS ODBSIZ + (AP)
	MOVEM	P3,ODB.OT(AP)		;STORE OBJECT TYPE IN ODB
	MOVEM	P4,ODB.AC(AP)		;STORE ARG COUNT
	HRL	S1,P1			;GET SOURCE ADDRESS FOR BLT
	HRRI	S1,ODB.DA(AP)		;GET DESTINATION ADDRESS FOR BLT
	ADDI	P2,ODB.DA-1(AP)		;COMPUTE ENDING ADDRESS FOR BLT
	BLT	S1,(P2)			;COPY DATA FROM SCRATCH PAGE TO ODB
	MOVE	S1,P3			;GET OBJECT TYPE IN S1
	LOAD	S2,ODB.DA+ARG.HD(AP),AR.TYP ;GET ARG TYPE
	PUSHJ	P,FNDOAR		;SEE IF ODB EXISTS WITH SAME ARG TYPE
	JUMPF	OODB.4			;IF ODB DOESN'T EXIST, SKIP OVER
	PUSH	P,AP			;SAVE AP
	MOVE	AP,S1			;GET ODB ADDRESS
	PUSHJ	P,M$RFRE##		;DELINK AND RETURN MEMORY
	POP	P,AP			;GET POINTER TO NEW ODB BACK
OODB.4:	PUSHJ	P,M$ELNK##		;LINK ODB INTO QUEUE
	MOVE	S1,P1			;GET SCRATCH PAGE ADDRESS
	$CALL	M%RPAG			;GIVE IT BACK TO GLXMEM
	MOVE	S1,P3			;GET THE OBJECT TYPE
	PUSHJ	P,OBJNAM		;GET THE NAME STRING ASSOCIATED
	PUSH	P,S1			;SAVE STRING ADDRESS
	LOAD	S1,ODB.DA+ARG.HD(AP),AR.TYP ;GET ARG TYPE
	PUSHJ	P,ARGNAM		;GET ARG NAME STRING ADDRESS
	POP	P,S2			;GET OBJECT NAME STRING ADDR BACK
	$ACK	(<^T/(S1)/ defined for all ^T/(S2)/s>,,,.MSCOD(M))

;Look in PSB queue for processors that handle object type in P3.

	$CALL	M%GPAG			;GET A PAGE FOR PID STACK
	PUSH	P,S1			;SAVE PAGE ADDRESS
	ADD	S1,[-100,,-1]		;SHOULD BE BIG ENOUGH STACK
	PUSH	S1,[-1]			;END OF STACK MARKER
	MOVE	S2,P3			;GET OBJECT TYPE
	PUSHJ	P,STKPSB		;GET PIDS ON STACK FROM PSB QUEUE

;Send ODB messages to processors whose PIDs are on stack pointed to by S1.

	MOVE	P1,S1			;GET STACK POINTER IN SAFE AC
OODB.5:	POP	P1,S2			;GET POTENTIAL PID
	CAMN	S2,[-1]			;END OF STACK MARKER?
	JRST	OODB.6			;YES, GO CLEAN UP
	MOVE	S1,AP			;GET ODB POINTER
	PUSHJ	P,SNDODB		;GO SEND MESSAGE TO PROCESSOR
	JRST	OODB.5			;LOOP FOR NEXT PSB

OODB.6:	POP	P,S1			;GET STACK PAGE ADDRESS BACK
	$CALL	M%RPAG			;LET IT GO
	$RETT				;RETURN

ODBERR:	TRZ	S1,777			;GET PAGE ADDRESS AGAIN
	$CALL	M%RPAG			;RETURN IT
	JRST	BADMSG			;COMPLAIN

	SUBTTL	OBJNAM - Find Object Name

	;Call:	S1/ object type (.OTxxx)
	;
	;Ret:	S1/ address of ASCIZ object name

OBJNAM::CAILE	S1,0			;IN RANGE?
	CAILE	S1,.OTMAX
	$RETF				;NO
	PUSHJ	P,.SAVE1		;SAVE P1
	MOVSI	P1,-.OTMAX		;MAKE AOBJN POINTER
	HRRI	P1,ONMTAB		;GET OBJECT NAME TABLE
OBJN.1:	MOVE	S2,(P1)			;GET TABLE ENTRY
	CAIE	S1,(S2)			;OBJECT TYPES MATCH?
	AOBJN	P1,OBJN.1		;NO, GOT TO BE THERE
	HLRZ	S1,S2			;YES, GET ADDRESS OF ASCIZ STRING
	$RETT				;RETURN

DEFINE	X (TYP,TXT) <
	XWD	[ASCIZ\'TXT\],TYP
>

ONMTAB::	OBJCTS			;GENERATE TABLE (OBJCTS IN GLXMAC)

;ARGNAM - Find argument name string for ODB message ACKs.
;
;Call:	S1/ arg type  (.ORxxx) (must be in ARGTAB below.)
;Ret:	TRUE S1/ string address or address of "Unknown"

ARGNAM:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVEI	P1,ARGTAB		;GET TABLE ADDRESS
ARGN.1:	SKIPN	S2,(P1)			;ANYTHING THERE
	JRST	ARGN.2			;NO, NO MATCH FOUND
	CAIE	S1,(S2)			;ARG TYPES MATCH?
	AOJA	P1,ARGN.1		;NO, LOOP
	HLRZ	S1,S2			;YES, GET ARG NAME STRING ADDRESS
	$RETT
ARGN.2:	MOVEI	S1,[ASCIZ\Unknown argument\] ;GET 'DUNNO' STRING
	$RETT

ARGTAB:	[ASCIZ\Default network PPN\],,.ORDPP
	[ASCIZ\Rejection list\],,.ORREJ
	0
SUBTTL	FNDODB & FNDOAR	& SNDODB

;FNDODB - Look for ODB for a specified object type
;
;Call:	S1/ object type
;Ret:   TRUE S1/ entry addr
;	FALSE means none found
;
;NXTODB - Get next ODB in queue	for a specified object type
;
;Call:	S1/Address of current ODB
;	S2/Object type
;Ret:	TRUE S1/Address of next ODB with specified object type
;	FALSE no more

FNDODB:	$SAVE	<H>			;SAVE H
	MOVEI	H,HDRODB##		;GET QUEUE HEADER FOR ODB
	MOVE	S2,S1			;GET OBJECT TYPE IN S2
	LOAD	S1,.QHLNK(H),QH.PTF	;GET 1ST ENTRY ADDRESS
FNDO.1:	JUMPE	S1,.RETF		;IF EMPTY, NOT THERE
	CAMN	S2,ODB.OT(S1)		;OBJECT TYPES MATCH?
	$RETT				;YES, RETURN TRUE
NXTODB:	LOAD	S1,.QELNK(S1),QE.PTN	;GET POINTER TO NEXT ODB
	JRST	FNDO.1			;LOOP

;FNDOAR - Find ODB for a specified object type and arg type
;
;Call:	S1/ abject type
;	S2/ arg type
;Ret:	TRUE S1/ODB address
;	FALSE None found

FNDOAR:	$SAVE	<T1,T2>			;SAVE T1 & T2
	DMOVE	T1,S1			;SAVE OBJECT AND ARG TYPES
	PUSHJ	P,FNDODB		;GET 1ST ODB FOR OBJECT TYPE
	$RETIF				;RETURN IF NONE FOUND
FNDA.1:	LOAD	TF,ODB.DA+ARG.HD(S1),AR.TYP ;FOUND ODB, GET ARG TYPE
	CAIN	TF,(T2)			;ONE WE WANT?
	$RETT				;RETURN WITH S1 POINTING TO ODB
	MOVE	S2,T1			;GET OBJECT TYPE IN S2, S1 IS SETUP
	PUSHJ	P,NXTODB		;LOOK FOR NEXT ODB FOR OBJECT TYPE
	JUMPT	FNDA.1			;CHECK ARG TYPES IF ODB FOUND
	$RETF				;RETURN FALSE IF NONE FOUND

;SNDODB - Send ODB message to processor
;
;Call:	S1/ ODB address
;	S2/ processor PID
;Ret:	TRUE always

SNDODB:	$SAVE	<P1>			;SAVE P1
	MOVE	P1,S1			;COPY ODB ADDRESS
	MOVEM	S2,G$SAB##+SAB.PD	;PUT PID IN SAB
	$CALL	M%GPAG			;GET A PAGE OF FOR MESSAGE
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE ADDRESS ON SAB
	LOAD	S2,.QEVSZ(P1),QE.VSZ	;GET SIZE OF DATA BLOCK IN ODB
	ADDI	S2,.OHDRS+ARG.SZ	;ADD IN HEADER PLUS 1 ARG BLOCK
	STORE	S2,.MSTYP(S1),MS.CNT	;SAVE IN MESSAGE
	MOVEM	S2,G$SAB##+SAB.LN	;IN SAB TOO
	MOVX	S2,.QOODB		;GET MESSAGE TYPE
	STORE	S2,.MSTYP(S1),MS.TYP	;SAVE IN MESSAGE
	MOVE	S2,ODB.AC(P1)		;GET ARG COUNT IN DATA
	MOVEI	S2,1(S2)		;ADD ONE FOR ARG BLOCK TO BUILD
	MOVEM	S2,.OARGC(S1)		;PUT IN MESSAGE HEADER
	SETZM	.MSFLG(S1)		;NO FLAGS
	SETZM	.OFLAG(S1)
	MOVE	S2,.MSCOD(M)		;GET AN OPR'S ACK CODE
	MOVEM	S2,.MSCOD(S1)		;LET SPOOLER TALK TO SOMEONE
	MOVE	S2,[2,,.ORTYP]		;OBJECT TYPE ARG BLOCK HEADER WORD
	MOVEM	S2,.OHDRS+ARG.HD(S1)	;STORE ARE 1ST ARG BLOCK HEADER
	MOVE	S2,ODB.OT(P1)		;GET OBJECT TYPE
	MOVEM	S2,.OHDRS+ARG.DA(S1)	;PUT OBJECT TYPE IN ARG BLOCK
	HRLI	TF,ODB.DA(P1)		;GET START OF DATA TO COPY
	HRRI	TF,.OHDRS+ARG.SZ(S1)	;GET WHERE TO COPY IT
	LOAD	S2,.MSTYP(S1),MS.CNT	;GET MESSAGE LENGTH
	ADD	S2,S1			;POINT TO END+1
	BLT	TF,-1(S2)		;COPY TO END OF MESSAGE
	SETZM	G$SAB##+SAB.SI		;NO SPECIAL PID INDEX
	MOVE	P1,S1			;SAVE PAGE ADDRESS
	PUSHJ	P,C$SEND##		;SEND IT OFF
	MOVE	S1,P1			;GET IT BACK
	$CALL	M%RPAG			;GIVE PAGE BACK
	$RETT
SUBTTL	STKPSB - Stack PIDs of Processors for an Object

;STKPSB - Routine to stack the PIDs of processors that can handle
;	a specfied object type.
;
;Call:	S1/ stack pointer to PID stack
;	S2/ object type
;
;Ret:	TRUE always

STKPSB:	$SAVE	<P1,P2,P3>		;SAVE SOME ACS
	LOAD	P1,HDRPSB##+.QHLNK,QH.PTF ;GET 1ST PSB ADDRESS
STKP.1:	JUMPE	P1,.RETT		;RETURN WHEN NO MORE
	LOAD	P2,PSBFLG(P1),PSFNOT	;GET NUMBER OF OBJECTS PROCESSOR HANDLES
	JUMPE	P2,STKP.3		;PARANOIA CHECK
	MOVNS	P2
	HRLZS	P2
	HRRI	P2,PSBOBJ(P1)		;BUILD AOBJN POINTER
STKP.2:	LOAD	P3,(P2),HELOBJ		;GET OBJECT TYPE
	CAIN	S2,(P3)			;OBJECT TYPES MATCH?
	PUSH	S1,PSBPID(P1)		;YES, PUT PID ON STACK
	AOBJN	P2,STKP.2		;LOOP FOR ALL OBJECTS SUPPORTED
STKP.3:	LOAD	P1,.QELNK(P1),QE.PTN	;GET POINTER TO NEXT PSB
	JRST	STKP.1			;CONTINUE
	SUBTTL	SNDOAC  --  Send  an Operator Action Message

	;CALL:  S1/ADDR OF OBJECT BLOCK
	;        M/ADDR OF MSG TO BE SENT

SNDOPR:	TDZA	S2,S2			;INDICATE SEND ORION ENTRY POINT
SNDOAC:	SETOM	S2			;INDICATE SEND PROCESSOR ENTRY POINT
	$SAVE	<AP,T2,T3>		;SAVE AP, T2 AND T3
	DMOVE	T2,S1			;SAVE OBJ BLK ADDR AND ENTRY POINT FLAG
	PUSHJ	P,M%ACQP		;GET A PAGE.
	PG2ADR	S1			;CONVERT TO AN ADDRESS.
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE IT IN THE SAB
	LOAD	T1,.MSTYP(M),MS.CNT	;GET THE MSG LENGTH.
	ADD	T1,S1			;CALC BLT END ADDRESS.
	HRL	S1,M			;GEN BLT AC.
	BLT	S1,-1(T1)		;COPY MSG OVER.
	MOVX	S1,PAGSIZ		;GET THE PAGE LENGTH
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE IT IN THE SAB
	MOVE	S1,OBJPID(T2)		;GET THE PID
	SKIPN	T3			;IS THIS A SEND TO OPR
	MOVE	S1,G$OPR##		;YES,,GET ORIONS PID
	MOVEM	S1,G$SAB##+SAB.PD	;SAVE IT IN THE SAB
	PJRST	C$SEND##		;SEND THE MESSAGE

	SUBTTL	Global Routines

;THE FOLLOW ARE ADDITIONAL GLOBAL ROUTINES FOUND IN THIS MODULE
;	OTHER THAN THE TOP-LEVEL MESSAGE HANDLERS.

	INTERN	A$KLPD			;KILL OFF A PSB GIVEN ITS PID
	INTERN	A$FPSB			;FIND A PSB GIVEN A PID
	INTERN	A$GPSB			;FIND A GENERIC PSB IN THE PSB CHAIN
	INTERN	A$LPSB			; "   "   "   "     "   "  "   "   "
	INTERN	A$FQNM			;FIND A QUEUE NAME ENTRY
	INTERN	A$FOBJ			;FIND AN OBJECT
	INTERN	A$CPOB			;COPY OVER AN OBJECT BLOCK
	INTERN	A$FREQ			;FIND A REQUEST VIA REQUEST ID
	INTERN	A$OB2Q			;CONVERT OBJECT TYPE TO QUE HEADER
	INTERN	A$OBST			;UPDATE OBJECT STATUS
	INTERN	A$GBLK			;BREAK DOWN BLOCK TYPE IPCF MESSAGES

	SUBTTL	A$KLPD  --  Routine to kill a PSB given its PID

;A$KLPD IS CALLED TO "KILL" A PSB ENTRY.  A$KLPD IS CALLED
;	WITH THE PID OF THE PSB TO BE KILLED (E.G. WHEN A SEND TO
;	A KNOWN COMPONENT FAILS WITH "UNKNOWN PID").
;
;CALL WITH ARGUMENT IN S1

A$KLPD:	$SAVE	AP			;SAVE CALLERS REGISTERS
	$SAVE	H			;  ""
	PUSHJ	P,A$FPSB		;FIND THE PSB GIVEN THE PID
	JUMPE	S1,.RETT		;RETURN IF NOT THERE
	PJRST	KILPSB			;KILL THE PSB ENTRY AND RETURN
	SUBTTL	A$FPSB  --  Subroutine to find a PSB

;A$FPSB IS CALLED WITH A PID IN S1. IT SCANS THE PSB LIST
;	LOOKING FOR A MATCH.  IF ONE IS FOUND, THE ADDRESS
;	OF THE PSB IS RETURNED IN S1, ELSE S1 IS RETURNED
;	CONTAINING 0.

A$FPSB:	MOVEI	H,HDRPSB##		;ADDRESS OF PSB QUEUE HEADER
	MOVE	S2,S1			;COPY ARGUMENT TO S2
	LOAD	S1,.QHLNK(H),QH.PTF	;GET ADDRESS OF FIRST

FPSB.1:	JUMPE	S1,.RETF		;RETURN IF LAST ONE (OR NONE)
	CAMN	S2,PSBPID(S1)		;MATCH?
	$RETT				;YES, RETURN WITH ADDRESS IN S1
	LOAD	S1,.QELNK(S1),QE.PTN	;GET POINTER TO NEXT
	JRST	FPSB.1			;AND LOOP
	SUBTTL	A$GPSB - ROUTINE TO FIND A PSB IN THE PSB CHAIN
	;	A$LPSB -  "  "    "  "   "  "  "   "   "    "

	;CALL:	S1/ The Object Type
	;	S2/ The Attributes
	;
	;RET:	S1/ The PSB Address

A$LPSB:	TDZA	TF,TF			;FLAG 'LPSB' ENTRY POINT
A$GPSB:	SETOM	TF			;FLAG 'GPSB' ENTRY POINT
	PUSHJ	P,.SAVE3		;SAVE P1 - P3
	DMOVE	P1,S1			;SAVE THE OBJECT TYPE AND ATTRIBUTES
	MOVE	P3,TF			;SAVE THE ENTRY POINT INDICATOR
	LOAD	S1,HDRPSB##+.QHLNK,QH.PTF ;GET THE FIRST ENTRY
	SKIPA				;SKIP OVER THE LOAD NEXT PSB
GPSB.1:	LOAD	S1,.QELNK(S1),QE.PTN	;GET THE NEXT PSB IN THE CHAIN
	JUMPE	S1,.RETF		;NOT FOUND,,RETURN
	LOAD	S2,PSBFLG(S1),PSFNOT	;GET THE OBJECT COUNT
	MOVNS	S2			;NEGATE IT
	MOVSS	S2			;MOVE RIGHT TO LEFT
	HRRI	S2,PSBOBJ(S1)		;CREATE OBJECT SEARCH AC
	LOAD	TF,0(S2),HELOBJ		;GET THE OBJECT TYPE
	CAME	TF,P1			;DO WE MATCH ???
GPSB.2:	AOBJN	S2,.-2			;NO,,TRY NEXT
	JUMPGE	S2,GPSB.1		;NO MATCH,,TRY NEXT PSB
	LOAD	TF,0(S2),HELATR		;GET THE OBJECT ATTRIBUTES
	CAME	TF,P2			;DO THEY MATCH ???
	JRST	GPSB.2			;NO,,TRY NEXT OBJECT
	JUMPE	P3,.RETT		;NO SETUP CHECK,,RETURN
	LOAD	TF,PSBLIM(S1),PSLCUR	;GET THE CURRENT SETUP COUNT
	LOAD	S2,PSBLIM(S1),PSLMAX	;GET THE MAX SETUP COUNT
	CAML	TF,S2			;ALL USED UP ???
	JRST	GPSB.1			;YES,,TRY NEXT PSB
	$RETT				;NO,,RETURN THIS PSB
SUBTTL	A$APSB - Adjust PSB Object/Attribute parameters


; Call:	MOVE	S1, [attrributes,,object-type]
;	MOVE	S2, PSB address
;	PUSHJ	P,A$APSB

A$APSB::PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	DMOVE	P1,S1			;COPY ARGUMENTS
	LOAD	S1,PSBFLG(P2),PSFNOT	;GET THE OBJECT COUNT
	MOVNS	S1			;NEGATE
	MOVSS	S1			;PUT IN LH
	HRRI	S1,PSBOBJ(P3)		;MAKE AN AOBJN POINTER
	CAME	P1,(S1)			;MATCH?
	AOBJN	S1,.-1			;NO--TRY THE NEXT
	JUMPL	S1,.RETT		;RETURN IF FOUND
	LOAD	S2,PSBFLG(P2),PSFNOT	;GET OBJECT COUNT AGAIN
	ADDI	S2,1			;GOING TO ADD ANOTHER OBJECT/ATTRIB
	CAIL	S2,OBPRSZ		;TOO MANY?
	JRST	APSB.1			;YES
	STORE	S2,PSBFLG(P2),PSFNOT	;UPDATE COUNT
	MOVEM	P1,(S1)			;SAVE NEW OBJECT/ATTRIBUTE COMBINATION
	$RETT				;AND RETURN

APSB.1:	$WTO	(<Object/Attribute count exceeded>,<^I/APSB.2/>,OBJTYP(P1))
	$RETF				;RETURN

APSB.2:	ITEXT	(<Program: ^W6L /PSBNAM(P1)/  PID: ^12R0/PSBPID(P1)/>)
	SUBTTL	A$FRMC - Send a forms change request

	;CALL:	S1/ The object block address

A$FRMC:: PUSHJ	P,.SAVE1		;Save p1
	MOVE	P1,S1			;Save the object address
	SKIPN	S1,OBJPID(P1)		;Get the processors pid
	$RETT				;None,,return
	MOVEM	S1,G$SAB##+SAB.PD	;Save it
	MOVX	S1,.OHDRS+OBJ.SZ+1	;Get the message length
	MOVEM	S1,G$SAB##+SAB.LN	;Save it
	STORE	S1,G$MSG##+.MSTYP,MS.CNT ;Here also
	MOVX	S1,.QOFCH		;Get the message type
	STORE	S1,G$MSG##+.MSTYP,MS.TYP ;Save it
	SETZM	G$MSG##+.MSCOD		;No ack code
	SETZM	G$MSG##+.MSFLG		;No flags yet
	MOVEI	S1,1			;Get 1 block count
	MOVEM	S1,G$MSG##+.OARGC	;Save it
	MOVE	S1,OBJPRM+.OOFRM(P1)	;Get the forms type
	MOVEM	S1,G$MSG##+.OFLAG	;Save it
	MOVE	S1,[OBJ.SZ,,.OROBJ]	;Get the object block header
	MOVEM	S1,G$MSG##+.OHDRS+ARG.HD ;Save it
	MOVEI	S1,G$MSG##+.OHDRS+ARG.DA ;Get object block data address
	HRLI	S1,OBJTYP(P1)		;Get source obj blk address
	BLT	S1,G$MSG##+.OHDRS+ARG.DA+OBJ.SZ-1 ;Copy the obj blk over
	MOVEI	S1,G$MSG##		;Get the message address
	MOVEM	S1,G$SAB##+SAB.MS	;Save it
	SETZM	G$SAB##+SAB.SI		;No special pid index
	PUSHJ	P,C$SEND##		;Send the message off
	JUMPF	.RETT			;Failed,,return
	MOVX	S1,OBSFCH		;[1163] Get the 'forms change' bit
	IORM	S1,OBJSCH(P1)		;lite it
	MOVX	S1,OBSFRM		;Get forms change flag
	ANDCAM	S1,OBJSCH(P1)		;Clear them
	MOVE	S1,P1			;Get the object address
	PUSHJ	P,A$OBST		;Update the status
	$RETT				;Return
	SUBTTL	A$FOBJ  --  Find an entry in the object queue

	;CALL:	S1/ An Object Block Address
	;
	;RET:	S1/ The address that object queue entry or false

A$FOBJ:	PUSHJ	P,.SAVET		;SAVE THE 'T' ACS
	MOVE	T1,OBJ.TY(S1)		;GET THE MODEL OBJECT TYPE
	MOVE	T2,OBJ.UN(S1)		;GET THE MODEL OBJECT UNIT
	MOVE	T3,OBJ.ND(S1)		;GET THE MODEL OBJECT NODE
	LOAD	T4,HDROBJ##+.QHLNK,QH.PTF ;GET THE FIRST OBJECT ENTRY
	SKIPA				;SKIP THE FIRST TIME THROUGH

FOBJ.1:	LOAD	T4,.QELNK(T4),QE.PTN	;GET THE NEXT OBJECT ENTRY ADDRESS
	JUMPE	T4,.RETF		;IF NO ENTRIES OR END, RETURN
	CAMN	T1,OBJTYP(T4)		;DO OBJECT TYPES MATCH ???
	CAME	T2,OBJUNI(T4)		;DO OBJECT UNITS MATCH ???
	JRST	FOBJ.1			;NO TO EITHER,,TRY NEXT OBJECT
	MOVE	S1,T3			;GET THE MODEL OBJECT NODE NAME/NUMBER
	MOVE	S2,OBJNOD(T4)		;GET THE SOURCE OBJECT NODE NAME/NUMBER
	PUSHJ	P,N$MTCH##		;DO THEY MATCH ???
	JUMPF	FOBJ.1			;NO,,TRY NEXT OBJECT IN THE QUEUE
	MOVE	S1,T4			;GET THE OBJECT QUEUE ENTRY ADDRESS
	$RETT				;AND RETURN
	SUBTTL	A$FQNM  --  Find a queue name entry


	;CALL:	S1/ Pointer to a queue name
	;
	;RET:	S1/ The entry address if found, false otherwise

A$FQNM:	$SAVE	<AP,P1>			;GRAB A FEW FREE AC'S
	HRLI	S1,(POINT 8)		;SET BYTE POINTER FOR 8-BIT ASCII
	MOVE	P1,S1			;COPY THE NAME POINTER
	LOAD	AP,HDRQNM##+.QHLNK,QH.PTF ;GET POINTER TO FIRST QUE NAME ENTRY
FQNM.1:	JUMPE	AP,.RETF		;RETURN FALSE IF END OF NAMES
	MOVE	S1,P1			;GET POINTER TO BASE STRING
	MOVEI	S2,QNM.QN(AP)		;GET ADDRESS OF TEST STRING
	HRLI	S2,(POINT 8)		;IT'S 8-BIT ASCII
	PUSHJ	P,S%SCMP		;COMPARE THE STRINGS
	JUMPN	S1,FQNM.2		;ONLY ACCEPT EXACT MATCH
	MOVE	S1,AP			;COPY THE ENTRY ADDRESS
	$RETT				;TRUE RETURN

FQNM.2:	LOAD	AP,.QELNK(AP),QE.PTN	;GET POINTER TO NEXT ENTRY
	JRST	FQNM.1			;LOOP
	SUBTTL	A$CPOB  --  Copy an object block

;A$CPOB IS CALLED TO COPY AN OBJECT BLOCK OVER TO A NEW BLOCK
;
;CALL:	S1/ ADDRESS OF SOURCE OBJECT BLOCK
;	S2/ ADDRESS OF DESTINATION OBJECT BLOCK

A$CPOB:	PUSHJ	P,.SAVE1		;SAVE P1
	HRLZ	P1,S1			;GET THE SOURCE OBJECT BLOCK ADDRESS
	HRR	P1,S2			;GET THE DESTINATION OBJECT BLOCK ADD.
	BLT	P1,OBJ.SZ-1(S2)		;MOVE THE OBJECT BLOCK
	$RETT				;AND RETURN

	SUBTTL	A$FREQ - ROUTINE TO FIND A REQUEST IN ANY QUEUE VIA REQUEST ID

	;CALL:	S1/ The Request ID
	;
	;RET:	S1/ The .QE Address if Found, False Otherwise

A$FREQ:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	MOVE	P1,S1			;SAVE THE REQUEST ID
	HRLZI	P2,-NOBJS		;CREATE AOBJN SEARCH AC

FREQ.1:	MOVE	S1,PROQUE(P2)		;GET A PROCESSING QUEUE HDR ADDRESS
	LOAD	S1,.QHLNK(S1),QH.PTF	;GET THE FIRST QUEUE ENTRY
FREQ.2:	JUMPE	S1,FREQ.3		;NO MORE,,TRY NEXT QUEUE
	CAMN	P1,.QERID(S1)		;IS THIS THE REQUEST WE WANT ???
	$RETT				;YES,,RETURN
	LOAD	S1,.QELNK(S1),QE.PTN	;GET THE NEXT QUEUE ENTRY
	JUMPN	S1,FREQ.2		;AND GO CHECK IT OUT

FREQ.3:	AOBJN	P2,FREQ.1		;NOT IN THIS QUEUE,,TRY NEXT
	$RETF				;REQUEST IS NOT IN THE SYSTEM !!!


	SUBTTL	A$OB2Q  --  Convert object type to queue header

;A$OB2Q IS CALLED TO CONVERT AN OBJECT TYPE INTO THE ADDRESS OF THE
;	QUEUE HEADER FOR THAT OBJECT.
;
;CALL:	S1/  OBJECT TYPE
;
;T RET:	S1/  ADDRESS OF QUEUE HEADER (HDRXXX)
;
;F RET:	NO SUCH OBJECT

A$OB2Q:	PUSHJ	P,.SAVE1		;SAVE P1
	HRLZI	P1,-NOBJS		;MAKE AOBJN POINTER TO TABLE
	MOVE	S2,S1			;PUT OBJECT TYPE INTO S2

OB2Q.1:	CAMN	S2,OBJTAB(P1)		;IS THIS OBJECT A MATCH?
	JRST	OB2Q.2			;WIN!!!!
	AOBJN	P1,OB2Q.1		;LOOP
	$RETF				;NOT FOUND, RETURN FAILURE

OB2Q.2:	LOAD	S1,PROQUE(P1)		;GET THE QUEUE HEADER ADDRESS
	$RETT				;AND RETURN


;NOW GENERATE THE TABLE OF QUEUE HEADER ADDRESSES PARALLEL TO OBJTAB

DEFINE	X(OBJ,QUE,PARM),<
	EXP	HDR'QUE'##
>  ;END DEFINE X

PROQUE:	MAPOBJ
	SUBTTL	A$OBST  --  Update Object Status

;A$OBST should be called whenever the status of an object changes so that
;	the operator status changes.
;
;Call:	S1/  address of OBJ entry
;
;T Ret:	always

A$OBST:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	P1,S1			;GET THE OBJECT ADDRESS
	MOVX	S1,%IDLE		;DEFAULT TO 'IDLE'
	MOVE	S2,OBJSCH(P1)		;GET THE SCHEDULING BITS
	TXNE	S2,OBSIGN		;ARE WE IGNORING THE OBJECT ???
	MOVX	S1,%NAVAL		;YES,,GET 'NOT AVAILABLE' CODE
	TXNN	S2,OBSHUT		;IS IT IN 'INTERNAL SHUTDOWN' STATE ???
	TXNE	S2,OBSFRR		;OR IS IT A FREE RUNNING DEVICE ???
	MOVX	S1,%IDLE		;YES,,ITS IDLE !!!!
	TXNN	S2,OBSSTA		;IS THE OBJECT STARTED ???
	MOVX	S1,%NSTRT		;NO,,GET THE 'NOT STARTED' CODE
	TXNE	S2,OBSBUS		;IS THE OBJECT BUSY ???
	MOVX	S1,%ACTIV		;YES,,GET THE 'ACTIVE' CODE
	TXNE	S2,OBSSTP		;IS THE DEVICE STOPPED ???
	MOVX	S1,%STOPD		;YES,,GET THE 'STOPPED' CODE
	TXC	S2,OBSBUS+OBSSTP	;ARE WE ACTIVE & STOPPED ???
	TXNN	S2,OBSBUS+OBSSTP	;LETS CHECK !!!
	MOVX	S1,%STPPN		;YES,,THEN STOPPED PENDING
	TXNE	S2,OBSSEJ		;IS IT SHUT DOWN AT END OF JOB ???
	MOVX	S1,%SHUTD		;YES,,GET 'SHUTTING DOWN' CODE
	TXNE	S2,OBSFCH		;[1166] CHANGING FORMS?
	MOVX	S1,%FRMCH		;[1163] YES,,GET 'CHANGING FORMS' STATUS
	MOVEM	S1,OBJSTS(P1)		;SAVE THE DEVICE STATUS
	$RETT				;AND RETURN

	SUBTTL	A$STATUS - UPDATE THE DEVICE STATUS

	;CALL:	M/STATUS UPDATE MESSAGE ADDRESS
	;
	;RET:	TRUE ALWAYS
	;
	;ERRORS: E$SNY FOR ANY VALIDATION ERRORS

A$STATUS::
	PUSHJ	P,.SAVE2		;SAVE P1 & P2
	LOAD	P2,.MSTYP(M),MS.CNT	;GET MESSAGE SIZE
	CAIGE	P2,STU.SZ		;AT LEAST MINIMUM LENGTH?
	PJRST	E$MTS##			;NO
	PUSHJ	P,A$WHEEL		;MAKE SURE MSG HAS PRIVS
	JUMPF	E$SNY##			;NO,,TOUGH BREAKEEE
	MOVEI	S1,STU.RB(M)		;GET THE OBJECT BLOCK ADDRESS
	PUSHJ	P,A$FOBJ		;GO FIND THE OBJECT
	JUMPF	E$SNY##			;NOT THERE,,THATS NO GOOD !!
	MOVE	P1,S1			;PUT THE OBJ ADDRESS INTO P1
	MOVE	S1,OBJPID(P1)		;GET THE CONTROLLING PID
	CAME	S1,G$SND##		;IS IT THE SAME GUY ???
	JRST	E$SNY##			;NO,,BETTER LUCK NEXT TIME !!
	MOVE	S1,STU.CD(M)		;GET THE DEVICE STATUS CODE
	JUMPLE	S1,E$SNY##		;MUST BE GREATER THEN 0
	CAILE	S1,%STMAX		;MUST ALSO BE LESS THEN MAX STATUS CODE
	JRST	E$SNY##			;ELSE HE LOSES !!
	HRRZ	S2,OBJCDS(S1)		;PICK UP THE OBJ TYPE LIST ADDRESS
	JUMPE	S2,STAT.2		;IF 0,,THEN THIS CODE IS GOOD FOR ALL
	HLRZ	T1,OBJCDS(S1)		;GET THE # OF DEVICES SPECIFIED
	MOVE	T2,STU.RB+OBJ.TY(M)	;GET THE MESSAGE OBJECT TYPE
STAT.1:	CAMN	T2,0(S2)		;DOES MSG DEVICE MATCH DEVICE LIST ??
	JRST	STAT.2			;YES,,THEN HE WINS AT LAST !!
	AOS	S2			;BUMP TO NEXT ENTRY IN DEVICE LIST
	SOJG	T1,STAT.1		;KEEP TRYING WHILE WE CAN
	JRST	E$SNY##			;NOT A VALID DEVICE,,BUMP HIM !!

STAT.2:	EXCH	P1,S1			;SWAP OBJ ADDRESS AND OBJ STATUS CODE
	CAIN	P1,%RESET		;IS IT 'RESET' ???
	PJRST	[DOSCHD			;FORCE A SCHEDULING PASS
		 MOVX   S2,OBSSTP!OBSFCH;[1163] YES,,GET 'STOPPED' AND 'CHANGING FORMS' STATUS
		 ANDCAM S2,OBJSCH(S1)	;CLEAR THEM
		 PJRST  A$OBST ]	;GO UPDATE THE STATUS
	STORE	P1,OBJSTS(S1)		;NO,,SAVE THE NEW DEVICE STATUS
	CAIG	P2,STU.SZ		;DOES MESSAGE INCLUDE OPTIONAL DATA?
	$RETT				;NO, ALL DONE
	MOVE	S2,OBJSCH(S1)		;GET SCHEDULING BITS
	CAIN	P1,%IDLE		;IDLE?
	TXZA	S2,OBSBUS		;YES, CLEAR BUSY
	TXO	S2,OBSBUS		;NO, SET BUSY
	MOVEM	S2,OBJSCH(S1)		;PUT BITS BACK
	HRLI	S2,STU.PR(M)		;COPY PARM WORDS
	HRRI	S2,OBJPRM(S1)		;FROM MESSAGE TO OBJ BLOCK
	BLT	S2,OBJPRM+OBPRSZ-1(S1)
	HRLI	S2,STU.ST(M)		;COPY STATUS STRING FROM MESSAGE
	HRRI	S2,OBJST1(S1)		;TO OBJ BLOCK
	BLT	S2,OBJST1+STSSIZ-1(S1)
	$RETT				;RETURN
	SUBTTL	A$GBLK - ROUTINE TO BREAK DOWN IPCF MESSAGES

	;CALL:	M/ THE MESSAGE ADDRESS
	;
	;RET:	T1/ THE BLOCK TYPE
	;	T2/ THE BLOCK LENGTH
	;	T3/ THE BLOCK DATA ADDRESS
	;	FALSE IF NO MORE BLOCKS


A$GBLK:	SKIPE	S1,G$BLKA##		;GET THE BLOCK ADDRESS IF THERE IS ONE
	JRST	.+4			;NOT FIRST TIME THROUGH,,SO SKIP INITLZN
	MOVE	S1,.OARGC(M)		;GET THE MESSAGE BLOCK COUNT
	MOVEM	S1,BLKCNT		;AND SAVE IT
	MOVEI	S1,.OHDRS+ARG.HD(M)	;IF NOT,,GET THE FIRST ONE
	SOSGE	BLKCNT			;CHECK THE BLOCK COUNT
	$RETF				;NO MORE,,JUST RETURN
	LOAD	TF,.MSTYP(M),MS.CNT	;GET THE MSG LENGTH
	ADD	TF,M			;GET END ADDRESS
	CAMLE	S1,TF			;VALIDATE THE ENTRY ADDRESS
	$RETF				;NO GOOD...
	LOAD	T1,ARG.HD(S1),AR.TYP	;GET THE BLOCK TYPE
	LOAD	T2,ARG.HD(S1),AR.LEN	;GET THE BLOCK LENGTH
	JUMPE	T2,.RETF		;VALIDATE THE ENTRY LENGTH
	MOVEI	T3,ARG.DA(S1)		;POINT TO THE ACTUAL DATA
	ADD	S1,T2			;POINT TO THE NEXT BLOCK
	MOVEM	S1,G$BLKA##		;SAVE IT FOR THE NEXT TIME AROUND
	$RETT				;AND RETURN

BLKCNT:	BLOCK	1			;MESSAGE BLOCK COUNT

	SUBTTL	Utility Routines


;	GETPSB	--		FIND OR CREATE A PSB GIVEN A PID
;	KILPSB	--		KILL A SPECIFIED PSB
;	GETOBJ  --		FIND OR CREATE AN OBJ ENTRY
;	ORANGE  --		HANDLE A RANGE OF OBJECTS
	SUBTTL	GETPSB  --  Routine to get a PSB

;GETPSB IS CALLED WITH A PID IN S1.  IT CALLS A$FPSB TO SEE IF
;	THE PID IS ALREADY KNOWN, AND IF SO IT RETURNS ITS ADDRESS
;	IN S1.  IF NOT, A NEW PSB IS GOTTEN AND ZEROED AND ITS
;	ADDRESS IS RETURNED IN S1.
;
GETPSB:	PUSHJ	P,A$FPSB		;FIND KNOWN PID
	JUMPN	S1,.RETT		;FOUND IT

GETP.1:	MOVEI	H,HDRPSB		;LOAD ADR OF PSB HEADER
	PUSHJ	P,M$GFRE##		;GET A FREE CELL
	PUSHJ	P,M$ELNK##		;LINK IN THE PSB
	MOVE	S1,AP			;RETURN ANSWER IN S1
	$RETT				;AND RETURN
	SUBTTL	KILPSB  --  Routine to kill a PSB given its address

;KILPSB is called to clean-up after known components which seem to have
;	disappeared behind QUASAR's back.  It releases any job interlocks
;	held by that program and deletes the PSB entry.
;
;Call:	S1/  address of PSB


KILPSB:	$SAVE	H			;SAVE H
	$SAVE	AP			;AND AP
	PUSHJ	P,.SAVE3		;SAVE P1 AND P2 AND P3
	DOSCHD				;FORCE ANOTHER SCHEDULING PASS
	MOVE	P2,S1			;COPY THE ARG OVER TO P2
	LOAD	P1,HDROBJ##+.QHLNK,QH.PTF ;POINT TO THE FIRST OBJ

KILP.1:	JUMPE	P1,KILP.6		;NO MORE OBJECTS, WE ARE DONE
	MOVE	S1,PSBPID(P2)		;GET THE PID
	CAME	S1,OBJPID(P1)		;OBJECT HELD BY PSB IN QUESTION?
	JRST	KILP.5			;NO, LOOP FOR NEXT OBJECT
	ZERO	OBJPID(P1)		;YES, CLEAR THE INTERLOCK WORD

	MOVX	S1,%GENRC		;GET GENERIC ATTRIBUTES
	MOVE	S2,OBJSCH(P1)		;GET THE SCHEDULER FLAG BITS
	TXZE	S2,OBSATR		;WERE ATTRIBUTES SET BY THE PROCESSOR ?
	STORE	S1,OBJDAT(P1),RO.ATR	;YES,,RESET THEM
	MOVEM	S2,OBJSCH(P1)		;   AND SAVE THE FLAG BITS
	TXZN	S2,OBSSIP+OBSIGN	;SETUP-IN-PROGRESS OR IGNORE SET ??
	JRST	KILP.2			;NO,,TRY SOMETHING ELSE
	MOVEM	S2,OBJSCH(P1)		;SAVE THE FLAG BITS
	JRST	KILP.5			;AND LOOP FOR NEXT OBJECT

KILP.2:	TXZN	S2,OBSSUP		;WAS OBJECT SETUP ???
	JRST	KILP.5			;NO,,GET NEXT OBJECT
	MOVEM	S2,OBJSCH(P1)		;SAVE THE NEW FLAG BITS

	;Here check to see if it was an IBM remote

	MOVE	S1,OBJNOD(P1)		;GET THIS OBJECTS NODE 
	PUSHJ	P,N$NODE##		;GET ITS DATA BASE ENTRY
	LOAD	TF,NETSTS(S2),NETIBM	;IS THIS AN IBM REMOTE STATION ???
	JUMPE	TF,KIL.2A		;NO,,SKIP THIS
	MOVE	S1,S2			;PASS THE NODE DB ADDRESS IN S1
	MOVE	S2,P1			;PASS THE OBJECT ADDRESS IN S2
	PUSHJ	P,N$NOFF##		;PERFORM NODE OFFLINE PROCESSING

KIL.2A:	LOAD	S1,OBJSCH(P1),OBSFRR	;GET THE FREE RUNNING BIT.
	JUMPN	S1,KILP.7		;IF OBJ IS FREE RUNNING,,RLSE INT-LCKS
	LOAD	S1,OBJSCH(P1),OBSBUS	;IS IT BUSY?
	JUMPE	S1,KILP.5		;NO, ON TO THE NEXT OBJECT

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	MOVEI	H,HDRUSE##		;LOAD USE QUEUE HEADER
	LOAD	AP,.QHLNK(H),QH.PTF	;POINT TO FIRST ENTRY

KILP.3:	SKIPN	AP			;ANY LEFT?
	$STOP(IJM,Interlocked Job Missing)
	CAMN	P1,.QEOBJ(AP)		;IS THIS THE JOB?
	JRST	KILP.4			;YES, GO FREE IT UP
	LOAD	AP,.QELNK(AP),QE.PTN	;NO, GET POINTER TO NEXT
	JRST	KILP.3			;AND LOOP

KILP.4:	MOVE	S1,OBJITN(P1)		;GET OBJECT ITN
	CAME	S1,.QEITN(AP)		;CONSISTENCY CHECK
	$STOP(IJW,Interlocked Job Wrong)
	LOAD	S1,.QEROB+.ROBTY(AP)	;GET REQUESTED OBJECT TYPE
	PUSHJ	P,A$OB2Q		;GET THE QUEUE HEADER ADDRES
	PUSH	P,S1			;SAVE QUEUE HEADER ADDRESS
	LOAD	S1,.QHPAG(S1),QH.SCH	;GET ADR OF SCHED VECTOR
	PUSHJ	P,SCHRJI(S1)		;RELEASE THE INTERLOCK
	POP	P,S1			;GET QUEUE HEADER ADR BACK
	PUSHJ	P,M$MOVE##		;MOVE IT

KILP.5:	LOAD	P1,.QELNK(P1),QE.PTN	;POINT TO NEXT OBJECT
	JRST	KILP.1			;AND LOOP

KILP.6:	$LOG(<Process ^W/PSBNAM(P2)/ Deleted From QUASAR>,<Process PID is ^O/PSBPID(P2)/, Process Object Type is ^O/PSBOBJ(P2),HELOBJ/(^1/PSBOBJ(P2),HELOBJ/)>,,<$WTFLG(WT.SJI)>)
	MOVEI	H,HDRPSB##		;POINT TO PSB QUEUE HEADER
	MOVE	AP,P2			;GET ADDRESS OF PSB
	PJRST	M$RFRE##		;AND RETURN TO FREE SPACE

	;Here for 'Free Running' Processors

KILP.7:	LOAD	S2,OBJSCH(P1),OBSQUH	;GET THE QUEUE HEADER ADDRESS
	LOAD	S2,.QHPAG(S2),QH.SCH	;GET THE ADDR OF SCHED VECTOR
	MOVE	S1,P1			;PUT THE OBJ ADDRESS INTO S1.
	PUSHJ	P,SCHRJI(S2)		;RELEASE DEVICE INTERLOCKS
	JRST	KILP.5			;GO GET THE NEXT OBJ.
	SUBTTL	GETOBJ  --  Find or create an OBJ queue entry

;GETOBJ WILL LOOK FOR THE SPECIFIED OBJECT AND IF NOT FOUND, IT
;	WILL CREATE THE OBJ ENTRY AND FILL IN THE OBJECT BLOCK IN
;	IT
;
;CALL:	S1/ POINTER TO AN OBJECT BLOCK
;
;T RET:	S1/ POINTER TO AN OBJ QUEUE ENTRY

GETOBJ:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	MOVE	P1,S1			;SAVE THE ARGUMENT
	MOVE	S1,OBJ.ND(P1)		;GET THE NODE NAME/NUMBER
	PUSHJ	P,N$NODE##		;PUT IT INTO OUR DATA BASE
	SKIPE	S1			;DON'T STORE A ZERO
	MOVEM	S1,OBJ.ND(P1)		;STORE NODE NUMBER
	MOVE	P2,S2			;SAVE THE NODE DATA BASE ENTRY ADDRESS
	MOVE	S1,P1			;GET THE OBJECT ADDRESS IN S1
	PUSHJ	P,A$FOBJ		;FIND THE OBJECT
	JUMPT	.RETT			;RETURN IF YOU DID
	PUSHJ	P,CHKOBJ		;GO VALIDATE THE OBJ BLK.
	JUMPF	.RETF			;NO GOOD,,JUST RETURN

	;HERE IF WE HAVE TO CREATE AN OBJECT QUEUE ENTRY

GETO.0:	$SAVE	H			;SAVE AC H
	$SAVE	AP			;AND AP
	MOVX	S1,NETSHT		;GET THE NETWORK SHUTDOWN BIT
	ANDCAM	S1,NETSTS(P2)		;AND CLEAR IT (JUST IN CASE IT WAS ON)
	MOVEI	H,HDROBJ##		;LOAD ADR OF OBJ HEADER
	PUSHJ	P,M$GFRE##		;GET A FREE CELL
	MOVE	S1,P1			;POINT TO SOURCE OBJECT
	MOVEI	S2,OBJTYP(AP)		;POINT TO DESTINATION OBJECT
	PUSHJ	P,A$CPOB		;COPY THE OBJECT BLOCK
	MOVE	S1,OBJTYP(AP)		;GET THE OBJECT TYPE
	PUSHJ	P,A$OB2Q		;CONVERT IT TO A QUEUE HEADER
	JUMPF	BADMSG			;NOT THERE,,ORION ERROR !!!
	STORE	S1,OBJSCH(AP),OBSQUH	;STORE QUEUE HEADER ADDRESS
	LOAD	S1,.QHTYP(S1)		;GET THE QUEUE TYPE.
	TXC	S1,.QHFRR		;COMPILMENT FREE RUNNING BITS
	MOVX	S2,OBSFRR		;GET SCHEDULING FREE RUNNING BITS
	TXNN	S1,QH.TYP		;IS THIS A FREE RUNNING OBJECT ???
	IORM	S2,OBJSCH(AP)		;YES,,LITE FREE RUNNING BIT
	MOVX	S2,OBSINV		;GET INVISIBLE BIT
	TXNE	S1,QH.INV		;IS THIS OBJECT INVISIBLE ???
	IORM	S2,OBJSCH(AP)		;YES,,LITE THE INVISIBLE BIT
	TXNE	S1,QH.OAV		;OBJECT ALWAYS VISIBLE?
	ANDCAM	S2,OBJSCH(AP)		;THEN IGNORE QH.INV SETTING
	MOVSI	S1,-NOBJS		;AOBJN PTR TO OBJTAB
	MOVE	S2,OBJTYP(AP)		;AND THE OBJECT TYPE

	CAME	S2,OBJTAB(S1)		;FIND THE OBJECT
	AOBJN	S1,.-1			;THIS MUST WORK SINCE A$OB2Q DID

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	HRRZS	S1			;GET OBJECT NUMBER
	IMULI	S1,OBPRSZ		;MULTIPLY BY PARAMS/OBJ
	ADDI	S1,PRMTAB		;POINT TO INITIAL PARAMETERS
	MOVSS	S1			;PUT SOURCE IN LEFT HALF
	HRRI	S1,OBJPRM(AP)		;PLACE TO BLT THEM
	BLT	S1,OBJPRM+OBPRSZ-1(AP)	;AND MOVE THEM
	MOVX	S1,%GENRC		;GET 'GENRIC' ATTRIBUTES
	STORE	S1,OBJDAT(AP),RO.ATR	;AND STORE THEM
	MOVX	S1,%NSTRT		;GET 'NOT STARTED'
	MOVEM	S1,OBJSTS(AP)		;SET IT

	LOAD	E,.QHLNK(H),QH.PTF	;GET POINTER TO FIRST OBJECT

GETO.1:	JUMPE	E,GETO.4		;LINK AT END IF NONE LEFT
	MOVE	S1,OBJTYP(AP)		;GET OBJECT TYPE OF NEW ONE?
	CAMN	S1,OBJTYP(E)		;SAME?
	JRST	GETO.2			;YUP, CONTINUE ON
	LOAD	E,.QELNK(E),QE.PTN	;GET NEXT
	JRST	GETO.1			;AND LOOP

GETO.2:	MOVE	S1,OBJNOD(AP)		;GET THE NODE
	CAMG	S1,OBJNOD(E)		;SEARCH FOR FIRST ONE BIGGER
	JRST	GETO.3			;GOT IT
	LOAD	E,.QELNK(E),QE.PTN	;GET POINTER TO NEXT
	JUMPE	E,GETO.4		;END, JUST LINK IT IN
	MOVE	S1,OBJTYP(AP)		;GET THE OBJECT TYPE
	CAME	S1,OBJTYP(E)		;STILL IN THE SAME TYPE?
	JRST	GETO.4			;NO, JUST LINK IT
	JRST	GETO.2			;YES, KEEP LOOKING

GETO.3:	MOVE	S1,OBJNOD(AP)		;GET NODE OF NEW ONE
	CAME	S1,OBJNOD(E)		;SAME AS ENTRY IN LIST?
	JRST	GETO.4			;NO, JUST LINK IT IN
	MOVE	S1,OBJUNI(AP)		;GET THE UNIT NUMBER
	CAMG	S1,OBJUNI(E)		;SEARCH FOR A BIGGER ONE
	JRST	GETO.4			;GOT IT, LINK IT
	LOAD	E,.QELNK(E),QE.PTN	;GET NEXT
	JUMPE	E,GETO.4		;END, LINK IT IN
	MOVE	S1,OBJTYP(AP)		;GET THE OBJECT TYPE
	CAMN	S1,OBJTYP(E)		;STILL THE SAME?
	JRST	GETO.3			;NO, LOOP

GETO.4:	PUSHJ	P,M$LINK##		;LINK IN THE ENTRY
	MOVE	S1,AP			;POINT THE ANSWER TO IT
	$RETT				;AND RETURN
	SUBTTL	CHKOBJ - ROUTINE TO VALIDATE OBJECT BLOCK REQUESTS.

CHKOBJ:	LOAD	S1,OBJ.TY(P1)		;GET THE OBJECT TYPE.
	LOAD	S2,NETSTS(P2),NT.MOD	;GET THE MODE OF THE NODE
	CAXN	S2,DF.EMU		;IS IT EMULATION ???
	CAXN	S1,.OTBAT		;AND IS THE OBJECT TYPE BATCH ???
	SKIPA				;NOT EMULATION or EMULATION+BATCH !!!
	JRST	CHKO.3			;EMULATION BUT NOT BATCH,,ERROR
	JUMPLE	S1,.RETT		;FUNNY OBJ,, RETURN OK.
	CAIN	S1,.OTBAT		;IS IT A BATCH OBJECT BLOCK ???
	JRST	CHKO.1			;YES,,GO PROCESS IT.
	MOVEI	S2,10			;ASSUME NORMAL DEVICE LIMITATIONS
	CAIN	S1,.OTNQC		;NET QUE CTL?
	MOVEI	S2,1000			;DIFFERENT LIMIT
	LOAD	S1,OBJ.UN(P1)		;GET THE UNIT NUMBER
	CAIGE	S1,(S2)			;MORE THAN MAX?
	$RETT				;NO,,THEN RETURN TRUE.
	$ACK	(<Invalid unit number specified>,,0(P1),.MSCOD(M)) ;TELL OPR
	$RETF				;RETURN FALSE.

CHKO.1:	LOAD	S1,OBJ.UN(P1)		;GET THE UNIT NUMBER.
	CAIGE	S1,INPMAX		;MORE THAN INPMAX STREAMS?
	JRST	CHKO.2			;NO
	$ACK	(<Invalid stream number specified>,,0(P1),.MSCOD(M)) ;TELL OPR
	$RETF				;AND RETURN

CHKO.2:	SOSL	G$NBAT##		;SUBTRACT 1 FROM MAX BATCH COUNT.
	$RETT				;OK,,RETURN.
	$ACK	(<Batch stream maximum exceeded>,,0(P1),.MSCOD(M)) ;TELL OPR
	SETZM	G$NBAT##		;RESET THE COUNT TO 0.
	$RETF				;RETURN.

CHKO.3:	$ACK	(<Device invalid for Emulation>,,0(P1),.MSCOD(M)) ;TELL OPR
	$RETF

	SUBTTL	FNDDEV - CHECK FOR ANY DEVICE STARTED FOR THE SPECIFIED NODE

	;CALL:	S1/ The Node DB Entry Address for the Node we are looking for
	;
	;RET:	True - If we find a device started for the specified node
	;      False - If there are no devices started for the node


FNDDEV:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,S1			;SAVE THE NETWORK NODE DB ADDRESS IN P1
	LOAD	S2,HDROBJ+.QHLNK,QH.PTF	;GET PTR TO FIRST OBJ QUEUE ENTRY
	SKIPA				;SKIP FIRST TIME THROUGH
FNDD.0:	LOAD	S2,.QELNK(S2),QE.PTN	;GET THE NEXT OBJ ENTRY ADDRESS
	JUMPE	S2,.RETF		;NO MORE,,RETURN FALSE
	MOVE	S1,OBJNOD(S2)		;GET THE OBJECTS NODE NAME
	CAME	S1,NETNAM(P1)		;DO
	CAMN	S1,NETNBR(P1)		;  WE
	$RETT				;    MATCH ???  YES - RETURN TRUE
	JRST	FNDD.0			;NO,,CHECK NEXT OBJECT

	SUBTTL	A$FNDB - ROUTINE TO FIND ANY BLOCK IN AN IPCF MESSAGE

	;CALL:	M/ THE MESSAGE ADDRESS
	;	S1/ THE TYPE OF BLOCK WE WANT
	;
	;RET:	S1/ THE BLOCK ADDRESS (OR FALSE IF NOT FOUND)


	INTERN	A$FNDB			;MAKE IT GLOBAL



A$FNDB:	PUSHJ	P,.SAVE2		;SAVE P1
	LOAD	P1,.OARGC(M)		;GET THE MESSAGE ARGUMENT COUNT
	MOVE	P2,S1			;SAVE THE BLOCK TYPE
	MOVEI	S1,.OHDRS(M)		;POINT TO THE FIRST BLOCK
	LOAD	TF,.MSTYP(M),MS.CNT	;GET THE MESSAGE LENGTH
	CAXLE	TF,PAGSIZ		;CAN'T BE GREATER THEN A PAGE
	$RETF				;ELSE THATS AN ERROR
	ADD	TF,M			;POINT TO THE END OF THE MESSAGE

FNDB.1:	LOAD	S2,ARG.HD(S1),AR.TYP	;GET THIS BLOCK TYPE
	CAMN	S2,P2			;IS IT THE BLOCK HE WANTS ???
	JRST	FNDB.2			;YES,,HE WINS BIG !!!
	LOAD	S2,ARG.HD(S1),AR.LEN	;NO,,GET THIS BLOCKS LENGTH
	ADD	S1,S2			;POINT TO THE NEXT BLOCK
	CAIG	TF,0(S1)		;ARE WE STILL IN THE MESSAGE ???
	$retf				;NO,,RETURN BLOCK NOT FOUND
	SOJG	P1,FNDB.1		;CONTINUE TILL DONE
	$RETF				;NOT FOUND

FNDB.2:	MOVEI	S1,ARG.DA(S1)		;POINT TO THE OBJECT BLOCK
	$RETT				;AND RETURN


	SUBTTL	GENRDB - ROUTINE TO CREATE AN RDB FOR HOLD/RELEASE/SET JOB PRIO

	;CALL:	M/	HOLD/RELEASE/SET JOB PRIO MESSAGE ADDRESS
	;	S1/	OUTPUT RDB ADDRESS
	;
	;RET:	ALWAYS TRUE

GENRDB:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	P1,S1			;SAVE THE RDB ADDRESS
	SETZM	TMPMSG			;ZAP THE FIRST WORD
	MOVE	S1,[TMPMSG,,TMPMSG+1]	;GET SOURCE,,DESTINATION
	BLT	S1,TMPMSG+MOD.SZ+3-1	;ZERO THE TEMP OPR MSG
	MOVE	S1,.MSCOD(M)		;GET THE OPR ACK CODE
	MOVEM	S1,TMPMSG+.MSCOD	;SAVE IT IN THE TEMP MSG
	MOVEI	S1,NBLKS-1		;GET THE BLOCK COUNT
	SETZM	RDBPRM(S1)		;ZERO THE RDB PARM BLOCK
	SOJGE	S1,.-1			;CONTINUE TILL DONE

GENR.1:	PUSHJ	P,A$GBLK		;GET THE FIRST/NEXT MESSAGE BLOCK
	JUMPF	GENR.3			;NO MORE,,BUILD THE RDB
	MOVSI	S1,-NBLKS		;CREATE AOBJN AC
	LOAD	S2,0(T3)		;GET THE MESSAGE ARGUMENT
	CAIN	T1,.CMUSR		;IS THIS THE USER ENTRY ???
	MOVE	S2,T3			;YES,,GET ITS ADDRESS
GENR.2:	CAME	T1,DSPRDB(S1)		;DO BLOCK TYPES MATCH ???
	AOBJN	S1,GENR.2		;NO,,IGNORE IT AND LOOP BACK
	STORE	S2,RDBPRM(S1)		;YES,,SAVE THE ARGUMENT
	JRST	GENR.1			;AND GO PROCESS ANOTHER BLOCK

GENR.3:	LOAD	S1,RDBPRM		;GET THE QUEUE TYPE
	MOVEM	S1,TMPMSG+MSHSIZ	;SAVE IT IN THE MSG
	MOVE	S1,RDBPRM+2		;GET THE USERS ENTRY ADDRESS
	MOVE	S2,P1			;GET THE OUTPUT ADDRESS
	PUSHJ	P,I$MUSR##		;MOVE THE USER INFO
	MOVE	S1,RDBPRM+1		;GET THE REQUEST ID NUMBER
	MOVEM	S1,.RDBRQ(P1)		;SAVE IT
	MOVE	S1,RDBPRM+3		;GET THE .ORNOD BLOCK NODE SPECIFICATION
	MOVEM	S1,G$RMTE##		;SAVE IT FOR THE QUEUE SEARCH
	$RETT				;RETURN


DSPRDB:	0,,.ORTYP
	0,,.ORREQ
	0,,.CMUSR
	0,,.ORNOD

	NBLKS==.-DSPRDB

RDBPRM:	BLOCK	NBLKS+1		;SAVE AREA FOR MSG RDB PARAMETERS

	SUBTTL	PRMTAB - OBJECT INITIAL PARAMETERS TABLE.


DEFINE	X(OBJ,QUE,PARM),<
	ZZZ==0				;;INITIAL PARAMETER COUNTER
	IRP	PARM,<
	EXP	PARM			;;GENERATE A WORD
	ZZZ==ZZZ+1			;;COUNT ANOTHER WORD
	IFE ZZZ-OBPRSZ,<STOPI>		;;STOP IF WE'VE GOT ENOUGH
	>  ;;END IRP PARM
	BLOCK	OBPRSZ-ZZZ		;;EXTEND BLOCK TO FULL SIZE
>  ;END DEFINE X

PRMTAB:	MAPOBJ				;GENERATE THE TABLE
	SUBTTL	ORANGE  --  Handle a range of objects

;ORANGE IS CALLED AT THE START OF PROCESSING A COMMAND FROM ORION
;	WHICH MIGHT CONTAIN A RANGE OF OBJECTS.  ORANGE ACTS AS A
;	CO-ROUTINE SO THAT EACH OBJECT IN THE RANGE WILL CAUSE
;	CONTROL TO BE TRANSFERED TO THE LOCATION AFTER THE CALL
;	TO ORANGE.  THE FLOW OF THE CALLING ROUTINE IS AS FOLLOWS:

;MESSAGE-FROM-ORION:
;	LOAD S1 WITH ADR OF OBJECT BLOCK IN MESSAGE
;	CALL ORANGE
;
;	ALL CODE FROM HERE TO THE RETURN IS EXECUTED ONCE FOR EACH
;	OBJECT SPECIFIED IN THE RANGE.
;END-OF-ROUTINE

;CALL:	S1/ ADDRESS OF OBJECT BLOCK (MAY OR MAY NOT CONTAIN RANGE)
;
;T RET:	S1/ ADDRESS OF OBJECT BLOCK FOR A SINGLE OBJECT

ORANGE:	HLRZ	S2,OBJ.UN(S1)		;GET THE UPPER LIMIT
	JUMPE	S2,.RETT		;NO RANGE, JUST RETURN
	MOVEM	S2,ORAN.B		;STORE UPPER LIMIT
	HRRZ	S2,OBJ.UN(S1)		;GET LOWER LIMIT
	MOVEM	S2,ORAN.A		;STORE IT AWAY
	MOVE	S2,OBJ.TY(S1)		;GET OBJECT TYPE
	MOVEM	S2,ORAN.C		;STORE IT
	MOVE	S2,OBJ.ND(S1)		;GET NODE
	MOVEM	S2,ORAN.D		;STORE IT
	POP	P,ORAN.E		;GET CALLING ADDRESS

ORAN.1:	MOVEI	S1,ORAN.F		;GET ADDRESS OF RETURN BLOCK
	MOVE	S2,ORAN.C		;GET OBJECT TYPE
	MOVEM	S2,OBJ.TY(S1)		;STORE IT
	MOVE	S2,ORAN.D		;GET NODE
	MOVEM	S2,OBJ.ND(S1)		;STORE IT
	MOVE	S2,ORAN.A		;GET NEXT UNIT NUMBER
	MOVEM	S2,OBJ.UN(S1)		;STORE IT
	PUSHJ	P,@ORAN.E		;CALL THE CALLER
	AOS	S1,ORAN.A		;INCREMENT FOR NEXT ONE
	CAMG	S1,ORAN.B		;ALL DONE?
	JRST	ORAN.1			;NO, LOOP
	$RETT				;YES, RETURN

ORAN.A:	BLOCK	1			;LOWER LIMIT (INCREMENTED)
ORAN.B:	BLOCK	1			;UPPER LIMIT
ORAN.C:	BLOCK	1			;OBJECT TYPE
ORAN.D:	BLOCK	1			;NODE NAME
ORAN.E:	BLOCK	1			;CALLERS LOCATION
ORAN.F:	BLOCK	3			;OBJECT BLOCK TO RETURN TO USER
	END