Google
 

Trailing-Edge - PDP-10 Archives - BB-4172G-BM - language-sources/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
;                    DIGITAL EQUIPMENT CORPORATION
;
;     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

	SUBTTL	Module Storage and Constants


MSGPDB:	BLOCK	IPCHSZ			;PDB FOR SENDING MESSAGES

MSGBLK:	BLOCK	MOD.SZ+5		;HOLD/RELEASE/MODIFY MSG BLOCK

;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


	DEFINE	VDFALT(AC,LOCN,FIELD,DEFALT,%DUMMY),<
		SKIPA
		XLIST
		JRST	%DUMMY
		LOAD	(AC,LOCN,FIELD)
		JUMPN	AC,%DUMMY
		MOVX	AC,DEFALT
		STORE	(AC,LOCN,FIELD)
	%DUMMY:
		LIST >
	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.

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


	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
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
	MOVX	S1,SP.OPR		;GET ORION'S PID INDEX
	PUSHJ	P,C%RPRM		;GET ORION'S PID
	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 
	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$HELLO:
	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,I$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
	MOVE	S1,HEL.OB(M)		;GET THE FIRST OBJECT TYPE
	CAIN	S1,.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
	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
	$LOG(<Process ^W/PSBNAM(P1)/ signon to QUASAR>,<Process PID is ^O/PSBPID(P1)/, Process Object Type is ^O/PSBOBJ(P1)/>,,<$WTFLG(WT.SJI)>)
	$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.....
SUBTTL	COUNT  --  Function 20

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

A$COUNT:
	PUSHJ	P,I$WHEEL		;IS USER A WHEEL?
	JUMPF	E$IPE##			;NO, INSUFFICIENT PRIVS
	LOAD	S1,G$NOW##		;GET NOW
	STORE	S1,G$ITEM##+$$NOW	;SAVE IT

	$COUNT	(MCAN)			;NUMBER OF COUNTANSWER MESSAGES
	PUSHJ	P,M%ACQP		;GET A PAGE
	HRRM	S1,MSGPDB+.IPCFP	;STORE FOR SEND
	PG2ADR	S1			;MAKE AN ADDRESS
	MOVSI	S2,CAN.SZ		;GET LEN,,0
	HRRI	S2,.QOCAN		;GET LEN,,FUNCTION
	STORE	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.BL+NITEMS(S1)	;BLT THE MESSAGE
	MOVEI	S1,PAGSIZ		;PUT IN PAGE LENGTH
	HRLM	S1,MSGPDB+.IPCFP	;STORE IN THE PDB
	MOVEI	AP,MSGPDB		;POINT TO THE PDB
	MOVX	S1,IP.CFV		;GET PAGE MODE BIT
	MOVEM	S1,.IPCFL(AP)		;STORE IN PDB
	MOVE	S1,G$SND##		;GET PID OF SENDER
	MOVEM	S1,.IPCFR(AP)		;SAVE AS RECEVIER
	PJRST	C$SEND##		;SEND IT
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$ENABLE		;ENABLE MESSAGE
	INTERN	A$DISABLE		;DISABLE MESSAGE
	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
	SUBTTL	A$OSTA  --  Startup an object

A$OSTA:	MOVEI	S1,.OROBJ		;GET THE OBJECC 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

	PUSHJ	P,GETOBJ		;GET THE OBJECT
	JUMPF	.RETT			;NO GOOD,,RETURN.
	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,S1			;SAVE THE OBJECT ADDRESS
	MOVX	S1,OBSSTA		;GET STARTED BIT...
	TDNE	S1,OBJSCH(P1)		;ARE WE ALREADY STARTED ?
	JRST	OSTA.1			;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
	CAIE	S1,.OTLPT		;IS IT THE LINE PRINTER ???
	$RETT				;NO,,JUST RETURN

	;Check to see if Printer has a Physical Device Name

OSTA.0:	MOVX	S1,.CMDEV		;WANT A DEVICE BLOCK
	PUSHJ	P,A$FNDB		;SEE IF THERE IS ONE
	JUMPF	.RETT			;NO,,JUST RETURN
	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
	$RETT				;AND RETURN


OSTA.1:	$ACK	(Already Started,,OBJTYP(P1),.MSCOD(M))
	$RETT
	SUBTTL	A$STND - START NODE MESSAGE PROCESSOR

A$STND:	$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$NODE	 	;FIND THE NODE IN OUR DATA BASE
	LOAD	S1,NETSTS(S2),NETIBM	;GET IBM STATUS
	LOAD	S2,NETSTS(S2),NT.MOD	;GET THE MODE
	SKIPE	S1			;IS IT AN IBM REMOTE
	CAXE	S2,DF.EMU		;IN EMULATION MODE ???
	SKIPA				;NO,,START PRINTER AND READER
	JRST	STND.1			;YES,,START A BATCH STREAM
	MOVX	S1,.OTLPT		;GET LINE PRINTER OBJECT TYPE
	MOVEM	S1,.OHDRS+ARG.DA+OBJ.TY(M) ;SAVE IT IN THE OBJECT BLOCK
	PUSHJ	P,A$OSTA		;AND START THE LINE PRINTER
	MOVX	S1,.OTRDR		;GET CARD READER OBJECT TYPE
	MOVEM	S1,.OHDRS+ARG.DA+OBJ.TY(M) ;SAVE AS NEW OBJECT TYPE
	PUSHJ	P,A$OSTA		;START A CARD READER FOR THE NODE
	SETOM	.MSCOD(M)		;CLEAR COMMON ACK CODE
	$RETT				;AND RETURN

STND.1:	MOVX	S1,.OTBAT		;GET BATCH STREAM OBJECT TYPE
	MOVEM	S1,.OHDRS+ARG.DA+OBJ.TY(M) ;SAVE AS THE OBJECT TYPE
	PUSHJ	P,A$OSTA		;START A BATCH STREAM FOR THE NODE
	SETOM	.MSCOD(M)		;CLEAR COMMON ACK CODE
	$RETT				;AND RETURN
	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

	PUSHJ	P,A$FOBJ		;FIND IT IN OUR DATA BASE
	JUMPF	A$SH.1			;CANT FIND IT,,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))
	TXNE	S1,OBSFRR		;IS THIS A FREE RUNNING DEVICE ??
	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 THE OBJECT DOWN
	$RETT				;AND RETURN

A$SH.1:	$ACK	(Device Unknown,,0(P1),.MSCOD(M))
	$RETT
	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
	PUSHJ	P,N$NODE##		;FIND IT IN OUR DATA BASE
	DMOVE	P1,S1			;GET NODE NAME (P1), ADDRESS (P2)
	PUSHJ	P,N$LOCL##		;IS THIS THE CENTRAL SITE ???
	JUMPT	SHUT.4			;YES,,CANT DO IT !!!
	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.1:	JUMPE	P2,SHUT.5			;NO MORE,,WE ARE DONE
	CAME	P1,OBJNOD(P2)		;ARE WE SHUTING DOWN THIS OBJECT ???
	JRST	SHUT.2			;NO,,TRY THE NEXT ONE
	LOAD	S1,OBJSCH(P2)		;GET THE SCHEDULING BITS
	TXNN	S1,OBSSUP		;IS THE OBJECT SETUP ???
	JRST	SHUT.3			;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 !!
	TXNE	S1,OBSFRR		;IS THIS A FREE RUNNING OBJECT ???
	TXZ	S1,OBSBUS		;YES,,TURN OFF THE 'BUSY' BITS
	STORE	S1,OBJSCH(P2)		;RESTORE THE SCHEDULING BITS
	DOSCHD				;FORCE A SCHEDULING PASS
	AOS	.OARGC(M)		;BUMP SHUTDOWN COUNT BY 1

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

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

SHUT.4:	$ACK	(<Host Node Shutdown is Illegal>,,,.MSCOD(M))
	$RETT				;RETURN

SHUT.5:	SKIPN	.OARGC(M)		;DID WE SHUTDOWN ANY OBJECTS ???
	$ACK	(<Nothing Started for 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.
	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

	;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.


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

		NSETS==.-SETTBL
	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
	PUSHJ	P,N$NODE##		;FIND/ADD IT TO OUR DATA BASE
	MOVE	P1,S2			;SAVE THE DATA BASE ENTRY ADDRESS

	;A Little Preliminary Checking is in Order !!!

	LOAD	S1,NETSTS(P1),NETIBM	;GET THE IBM REMOTE STATUS BITS
	JUMPE	S1,NETS.2		;NOT IBM,,CAN'T DO THIS !!!
	LOAD	S1,NETSTS(P1),NETONL	;GET THE NODE ONLINE BIT
	JUMPN	S1,NETS.3		;CAN'T SET PARMS FOR ONLINE NODES
	MOVE	S1,P1			;PASS THE NODE DB ADDRESS IN S1
	PUSHJ	P,FNDDEV		;CHECK FOR DEVS STARTED FOR THIS NODE
	JUMPT	NETS.4			;FOUND ONE,,THATS AN ERROR

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 ^T/NETASC(P1)/ Ignored>,<Node ^T/NETASC(P1)/ is Not Defined as an IBM Remote>,,.MSCOD(M))
	$RETT

NETS.3:	SKIPA	S1,[EXP [ASCIZ/Can't SET a Node Which is Online/] ]
NETS.4:	MOVEI	S1,[ASCIZ/Can't SET a Node Which Has Devices Started/]
	$ACK	(<Set for Node ^T/NETASC(P1)/ Ignored>,<^T/0(S1)/>,,.MSCOD(M))
	$RETT
>
IFE FTDN60,<JRST NODN60 >		;JUST ACK AND RETURN
	SUBTTL	A$MODIFY - ROUTINE TO SET THE JOBS PRIORTY

A$MODIFY:
	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
	PUSH	P,0(S1)			;SAVE THE NEW PRIORITY
MODI.2:	MOVEI	S1,MSGBLK+MOD.RQ	;GET THE MESSAGE RDB ADDRESS
	PUSHJ	P,GENRDB		;GO GENERATE IT
	POP	P,MSGBLK+MOD.SZ+2	;STORE PRTY IN THE MESSAGE
	MOVX	S1,MOD.SZ+3		;GET THE MESSAGE LENGTH
	STORE	S1,MSGBLK+.MSTYP,MS.CNT	;AND SAVE IT
	MOVX	S1,.QOMOD		;GET THE MESSAGE TYPE
	STORE	S1,MSGBLK+.MSTYP,MS.TYP	;AND SAVE IT
	SETOM	MSGBLK+MOD.SZ+1		;NO /AFTER PARAMETER
	MOVEI	S1,3			;GET THE MAJOR BLOCK LENGTH
	MOVEM	S1,MSGBLK+MOD.SZ	;AND SAVE IT
	SETZM	G$ACK##			;WE DONT WANT AN ACK.
	SETOM	G$QOPR##		;THIS IS AN OPERATOR REQUEST
	PUSH	P,M			;SAVE THE OLD MESSAGE ADDRESS
	MOVEI	M,MSGBLK		;GET THE NEW MESSAGE ADDRESS

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

	MOVE	T1,S1			;GET THE NUMBER OF JOB AFFECTED
	POP	P,M			;RESTORE THE OLD MESSAGE ADDRESS
	SETZM	G$QOPR##		;RESET THE OPERATOR INDICATOR
	SETZM	G$RMTE##		;ZERO THE NODE WE USED (SET BY GENRDB)
	SKIPG	T1			;MORE THEN 0 JOBS ???
	$ACK	(<No Requests Modified>,,,.MSCOD(M))
	CAIN	T1,1			;JUST 1 JOB ???
	$ACK	(<1 Request Modified>,,,.MSCOD(M))
	CAILE	T1,1			;MORE THEN 1 JOB ???
	$ACK	(<^D/T1/ Requests Modified>,,,.MSCOD(M))
	$RETT				;AND RETURN
	SUBTTL	A$ENABLE - ROUTINE TO ENABLE QUEUE ENTRY CREATE'S

A$ENABLE: SETZM	  G$QUEUE##		;ENABLE PROCESSING FOR CREATE MESSAGES
	  $ACK   (System Queue's Entry Processing Enabled,,,.MSCOD(M))
	  $RETT				;RETURN



	SUBTTL	A$DISABLE - ROUTINE TO DISABLE QUEUE ENTRY CREATE'S

A$DISABLE: SETOM  G$QUEUE##		;DISABLE PROCESSING FOR CREATE MESSAGES
	   $ACK   (System Queue's Entry Processing Disabled,,,.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	A$RQ.1			;DONE IF NOT THERE
	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.
	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.1:	$ACK	(Device Unknown,,0(P1),.MSCOD(M))
	$RETT

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

A$RQ.3:	$ACK	(Request Id Invalid,,OBJTYP(P1),.MSCOD(M))
	$RETT
	SUBTTL 	A$COMM - OPERATOR REQUEST COMMON PROCESSING ROUTINE.

A$COMM:	PUSHJ	P,.SAVE1		;SAVE P1 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	A$CO.1			;NOT THERE,,RETURN.
	MOVE	P1,S1			;SAVE THE OBJECT QUEUE ENTRY ADDRESS
	MOVX	S1,OBSBUS		;PICK UP BUSY BIT.
	TDNN	S1,OBJSCH(P1)		;IS THE DEVICE BUSY ???.
	JRST	A$CO.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		;RESET THE OBJECT STATUS.
	$RETT				;RETURN...


A$CO.1:	$ACK	(Device Unknown,,0(P1),.MSCOD(M))
	$RETT

A$CO.2:	MOVX	S1,OBSSTP		;GET THE 'STOPPED BY OPERATOR' BIT
	LOAD	S2,.MSTYP(M),MS.TYP	;GET THE MESSAGE TYPE
	CAIE	S2,.OMPAU		;IS IT 'STOP'
	JRST	A$CO.3			;NO,,TRY 'CONTINUE'
	IORM	S1,OBJSCH(P1)		;YES,,TURN ON STOP BIT
	$ACK	(Stopped,,OBJTYP(P1),.MSCOD(M)) ;TELL THE OPERATOR
	MOVE	S1,P1			;GET THE OBJECT ADDRESS
	PUSHJ	P,A$OBST		;UPDATE THE OBJECT STATUS
	$RETT				;AND RETURN

A$CO.3:	CAIE	S2,.OMCON		;IS THE MESSAGE 'CONTINUE' ???
	JRST	A$CO.4			;NO,,JUST ACK AND LEAVE
	ANDCAM	S1,OBJSCH(P1)		;TURN OFF THE 'STOP' BIT
	$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

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



A$OPAU:	PJRST	A$COMM			;PROCESS THE STOP COMMAND.

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:	STKVAR	<OBJADR>		;ALLOCATE SOME SPACE ON THE STACK
	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
	MOVEM	S1,OBJADR		;SAVE THE ADDRESS FOR A MINUTE
	PUSHJ	P,A$FOBJ		;FIND THE OBJECT IN OUR OBJECT QUEUE
	JUMPF	OSND.1			;NOT,THERE,,JUST RETURN
	MOVEM	S1,OBJADR		;SAVE THE ADDRESS FOR A MINUTE
	MOVE	S1,OBJNOD(S1)		;GET THE NODE FOR THIS OBJECT
	PUSHJ	P,N$NODE##		;FIND IT IN OUT DATA BASE
	MOVE	S1,OBJADR		;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

OSND.1:	MOVE	S1,OBJADR		;GET THE OBJECT ADDRESS IN S1
	$ACK	(<Device Unknown>,,0(S1),.MSCOD(M)) ;ACK THE OPR
	$RETT				;ANOTHER ERROR,,JUST RETURN

A$OSHC:	PJRST	A$COMM			;PROCESS THE SHOW CONTROL FILE COMMAND.
	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.
	PUSH	P,S1			;SAVE THE ENTRY TYPE
	MOVEI	S1,MSGBLK+HBO.RQ	;GET THE MESSAGE RDB ADDRESS
	PUSHJ	P,GENRDB		;GO CREATE THE MESSAGE RDB

	POP	P,MSGBLK+HBO.FL		;SAVE THE TYPE FLAGS (GENERATED ABOVE)
	MOVX	S1,HBO.SZ		;GET THE MESSAGE LENGTH
	STORE	S1,MSGBLK+.MSTYP,MS.CNT	;AND SAVE IT
	MOVX	S1,.QOHBO		;GET THE MESSAGE TYPE
	STORE	S1,MSGBLK+.MSTYP,MS.TYP	;AND SAVE IT
	SETZM	G$ACK##			;INDICATE NO ACK.
	SETOM	G$QOPR##		;SHOW THAT MSG IS FROM THE OPERATOR.
	PUSH	P,M			;SAVE M (OLD MSG ADDRESS)
	MOVEI	M,MSGBLK		;POINT TO OUR NEW MESSAGE

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

	MOVE	T1,S1			;GET THE # OF JOBS AFFECTED
	POP	P,M			;RESTORE M (OLD MSG ADDRESS)
	SETZM	G$QOPR##		;TURN OFF THE QUEUE SEARCH FLAG.
	SETZM	G$RMTE##		;ZERO THE NODE WE USED (SET BY GENRDB)
	MOVEI	S1,[ASCIZ/ Held/]	;ASSUME HOLD MESSAGE.
	SKIPE	MSGBLK+HBO.FL		;CHECK MSG FLAGS,,IF 0 WE WERE RIGHT.
	MOVEI	S1,[ASCIZ/ Released/]	;ELSE MAKE IT RELEASE.
	SKIPG	T1			;MORE THEN 0 JOBS ???
	$ACK	(<No jobs^T/0(S1)/>,,,.MSCOD(M))
	CAIN	T1,1			;IS THERE ONLY 1 JOB ???
	$ACK	(<1 Job^T/0(S1)/>,,,.MSCOD(M))
	CAILE	T1,1			;MORE THEN 1 JOB ???
	$ACK	(<^D/T1/ Jobs^T/0(S1)/>,,,.MSCOD(M))
	SKIPE	MSGBLK+HBO.FL		;IS THIS A RELEASE MESSAGE ???
	DOSCHD				;YES,,FORCE A SCHEDULING PASS
	$RETT				;AND RETURN.
	SUBTTL	A$ODEL - ROUTINE TO REMOVE JOBS FROM THE SYSTEM QUEUES


A$ODEL:	MOVEI	S1,MSGBLK+KIL.RQ	;NO,,GET THE FAKE KILL MSG RDB ADDR
	PUSHJ	P,GENRDB		;GO CREATE THE RDB FOR THE MSG
	MOVX	S1,KIL.SZ		;GET THE MESSAGE SIZE
	STORE	S1,MSGBLK+.MSTYP,MS.CNT	;SAVE IT
	MOVX	S1,.QOKIL		;GET THE MESSAGE TYPE
	STORE	S1,MSGBLK+.MSTYP,MS.TYP	;SAVE IT
	SETZM	MSGBLK+.MSFLG		;NO FLAGS
	SETZM	MSGBLK+.MSCOD		;NO ACK CODE
	SETZM	G$ACK##			;NO ACK (PERIOD)
	SETOM	G$QOPR##		;THIS IS AN OPERATOR REQUEST
	PUSH	P,M			;SAVE THE OPR MSG ADDRESS
	MOVEI	M,MSGBLK		;GET OUT FAKE KILL MSG ADDRESS

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

	MOVE	T1,S1			;GET # OF JOBS AFFECTED
	POP	P,M			;RESTORE OLD MSG ADDRESS
	SETZM	G$QOPR##		;CLEAR OPR FLAG
	SETZM	G$RMTE##		;ZERO THE NODE WE USED (SET BY GENRDB)
	SKIPG	T1			;NO JOBS KILLED !!!
	$ACK	(<No Jobs Canceled>,,,.MSCOD(M))
	CAIN	T1,1			;1 JOB KILLED !!!
	$ACK	(<1 Job Canceled>,,,.MSCOD(M))
	CAILE	T1,1			;MORE THE 1 JOB !!!
	$ACK	(<^D/T1/ Jobs Canceled>,,,.MSCOD(M))
	$RETT				;RETURN,,WE'RE DONE
	SUBTTL	A$ORTE - ROUTINE TO PROCESS OPERATOR ROUTE COMMAND.


A$ORTE:	PUSHJ	P,I$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
	LOAD	S2,.DNODE-1(S1)			;GET THE DESTINATION NODE NBR.
	LOAD	S1,.SNODE-1(S1)			;GET THE SOURCE NODE NUMBER.

	PUSHJ	P,N$NRTE##			;GO ROUTE THE NODE

	DOSCHD					;FORCE A SCHEDULING PASS
	$RETT					;AND RETURN
	SUBTTL	A$DEFINE - ROUTINE TO PROCESS THE 'DEFINE' NETWORK COMMAND

	;CALL:	M/ The message address
	;
	;RET:	TRUE ALWAYS

A$DEFINE:
IFN FTDN60,<
	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	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
	PUSHJ	P,N$NODE##		;FIND/ADD IT TO OUR DATA BASE
	MOVE	P1,S2			;SAVE THE DATA BASE ENTRY ADDRESS
	LOAD	S1,NETSTS(P1),NETONL	;GET THE NODE ONLINE BIT
	JUMPN	S1,DEFI.2		;IF ONLINE,,CAN'T DEFINE THE NODE

	;Check to make sure there are no devices started for the node to be
	;defined

	MOVE	S1,P1			;PASS THE NODE DB ADDRESS IN S1
	PUSHJ	P,FNDDEV		;CHECK FOR DEVS STARTED FOR THIS NODE
	JUMPT	DEFI.3			;FOUND ONE,,THATS AN ERROR

	;Here if All's OK, Find the DEFINE Msg Block

DEFI.1:	MOVX	S1,.DFBLK		;GET THE DEFINE BLOCK TYPE
	PUSHJ	P,A$FNDB		;GO FIND IT
	JUMPF	BADMSG			;NOT THERE,,ORION ERROR
	MOVEI	S1,-1(S1)		;MAKE SURE WE ARE POINTING AT BLK HEADER
	MOVE	S2,DEF.TY(S1)		;GET THE TYPE OF NODE
	STORE	S2,NETSTS(P1),NT.TYP	;SAVE IT IN OUR DATA BASE
	MOVE	S2,DEF.MD(S1)		;GET THE NODE MODE
	STORE	S2,NETSTS(P1),NT.MOD	;SAVE IT IN OUR DATA BASE
	MOVE	S2,DEF.PT(S1)		;GET THE PORT NUMBER
	STORE	S2,NETPTL(P1),NT.PRT	;SAVE THE PORT NUMBER
	MOVE	S2,DEF.LN(S1)		;GET THE LINE NUMBER
	STORE	S2,NETPTL(P1),NT.LIN	;SAVE THE LINE NUMBER

	LOAD	S2,NETSTS(P1),NT.TYP	     ;GET THE REMOTE TYPE
	CAXN	S2,DF.378		     ;IS IT 3780 ???
	VDFALT	S1,NETBPM(P1),FWMASK,^D512   ;YES,,DEFAULT BYTES-PER-MSG TO 512
	CAXE	S2,DF.378		     ;IS IT 2780 OR HASP ???
	VDFALT	S1,NETBPM(P1),FWMASK,^D400   ;YES,,DEFAULT BYTES-PER-MSG TO 400
	CAXN	S2,DF.278		     ;IS IT 2780 ???
	VDFALT	S1,NETRPM(P1),FWMASK,7	     ;YES,,DEFAULT RCRDS-PER-MSG TO 7
	LOAD	S2,NETSTS(P1),NT.MOD	     ;GET THE REMOTE MODE
	CAXN	S2,DF.TRM		     ;IS IT TERMINATION MODE ???
	VDFALT	S1,NETSTS(P1),NT.TOU,ST.PRI  ;YES,,DEFAULT PROTOCOL TO PRIMARY

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

	CAXN	S2,DF.EMU		     ;IS IT EMULATION MODE ???
	VDFALT	S1,NETSTS(P1),NT.TOU,ST.SEC  ;YES,,DEFAULT PROTOCOL TO SECONDARY
	VDFALT	S1,NETSTS(P1),NT.DTR,ST.ON   ;DEFAULT DTR IS ON
	VDFALT	S1,NETSTS(P1),NT.TRA,ST.OFF   ;DEFAULT TRANSPARENCY IS OFF
	VDFALT	S1,NETCSD(P1),FWMASK,3	     ;DEFAULT CLEAR-TO-SEND DELAY TO 3
	VDFALT	S1,NETSWL(P1),FWMASK,^D64    ;DEFAULT SILO WARNING LEVEL TO 64
	MOVE	S1,G$NOW##		     ;GET THE UDT FOR PORT/LINE HANDLE
	MOVEM	S1,NETIDN(P1)		     ;SAVE IT IN THE DATA BASE
	MOVEI	S1,1			     ;GET A 1
	STORE	S1,NETSTS(P1),NETIBM	     ;LITE THE IBM NODE BIT
	STORE	S1,NETSTS(P1),NETSGN	     ;ALSO LITE 'SIGNON REQUIRED' BIT
	$ACK	(<Define for Node ^T/NETASC(P1)/ Accepted>,,,.MSCOD(M))
	$RETT				;AND RETURN

DEFI.2:	SKIPA	S1,[EXP [ASCIZ/Can't DEFINE a Node Which is Online/] ]
DEFI.3:	MOVEI	S1,[ASCIZ/Can't DEFINE a Node Which Has Devices Started/]
	$ACK(<Define for Node ^T/NETASC(P1)/ Ignored>,<^T/0(S1)/>,,.MSCOD(M))
	$RETT
>
IFE FTDN60,<
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,MSGBLK+OBJ.TY	;SAVE IT IN OBJECT BLOCK
	SETZM	MSGBLK+OBJ.UN		;WANT UNIT 0
	MOVE	S1,.MSCOD(M)		;GET THE NODE NAME
	MOVEM	S1,MSGBLK+OBJ.ND	;SAVE IT IN OBJECT BLOCK
	MOVEI	S1,MSGBLK		;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 '^W/.MSCOD(M)/'>,,,<$WTFLG(WT.SJI)>)
	PJRST	SNDOPR			;RETURN THE MSG TO ORION AND RETURN
>
IFE FTDN60,<JRST NODN60 >		;SHOULD NOT HAPPEN
	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.
	PUSH	P,S1			;SAVE THE ADDRESS.
	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.
	POP	P,S1			;RESTORE S1.
	MOVEI	AP,MSGPDB		;LOAD PDB ADDRESS
	ADR2PG	S1			;GET PAGE NUMBER
	HRLI	S1,PAGSIZ		;GET PAGE SIZE
	MOVEM	S1,.IPCFP(AP)		;STORE IT
	MOVX	S1,IP.CFV		;PAGE MODE BIT
	MOVEM	S1,.IPCFL(AP)		;STORE IT
	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,.IPCFR(AP)		;SET RECEIVERS PID
	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$FOBJ			;FIND AN OBJECT
	INTERN	A$CPOB			;COPY OVER AN OBJECT BLOCK
	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$FOBJ  --  Find an entry in the object queue

;WITH S1 POINTING TO AN OJBECT BLOCK, FIND A MATCHING ENTRY IN THE
;	OBJECT QUEUE. 
;

A$FOBJ:	MOVE	T1,S1			;SAVE POSITION OF BLOCK
	MOVEI	S1,HDROBJ##		;GET HEAD OF THE QUEUE
	LOAD	S1,.QHLNK(S1),QH.PTF	;GET POINTER TO FIRST

FOBJ.1:	JUMPE	S1,.RETF		;IF NO ENTRIES OR END, RETURN
	MOVE	T2,S1			;GET POSITION INTO PLACE
	MOVE	T3,T1			;GET START OF MODEL
	MOVEI	T4,OBJNOD-OBJTYP+1	;GET NUMBER OF WORDS TO CHECK

FOBJ.2:	MOVE	S2,0(T3)		;GET A MODEL WORD
	CAME	S2,OBJTYP(T2)		;A MATCH?
	JRST	[ LOAD S1,.QELNK(S1),QE.PTN ;NO GET POINTER TO NEXT CELL
		  JRST FOBJ.1 ]		;AND STEP TO IT
	SOJE	T4,.RETT		;IF ALL WORDS CHECKED, WE FOUND IT
	ADDI	T3,1			;UPDATE MODEL POINTER
	AOJA	T2,FOBJ.2		;AND CHECK NEXT WORD PAIR
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
	MOVE	P1,OBJ.TY(S1)		;GET OBJECT TYPE
	MOVEM	P1,OBJ.TY(S2)		;STORE IT
	MOVE	P1,OBJ.UN(S1)		;GET UNIT NUMBER
	MOVEM	P1,OBJ.UN(S2)		;STORE IT
	MOVE	P1,OBJ.ND(S1)		;GET NODE NAME
	MOVEM	P1,OBJ.ND(S2)		;STORE IT
	$RETT				;AND RETURN
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,OB2Q.3(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

OB2Q.3:	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
	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
	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 !!!!
	TXNE	S2,OBSSEJ		;IS IT SHUT DOWN AT END OF JOB ???
	MOVX	S1,%SHUTD		;YES,,GET 'SHUTTING DOWN' CODE
	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,I$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 !!
	PUSHJ	P,.SAVE1		;SO FAR, SO GOOD, SO SAVE P1
	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	A$OBST			;YES,,SET IT VIA A$OBST AND RETURN
	STORE	P1,OBJSTS(S1)		;HE WINS,,SAVE THE NEW DEVICE STATUS
	$RETT				;AND 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	T1,ARG.HD(S1),AR.TYP	;GET THE BLOCK TYPE
	LOAD	T2,ARG.HD(S1),AR.LEN	;GET THE BLOCK 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
	ZERO	OBJTIM(P1)		;AND CLEAR TIMER WORD

	LOAD	S1,OBJSCH(P1),OBSSIP	;GET SETUP-IN-PROGRESS BIT
	SKIPN	S1			;IF SET,,SKIP NEXT LOAD.
	LOAD	S1,OBJSCH(P1),OBSIGN	;GET THE IGNORE BIT.
	JUMPE	S1,KILP.2		;JUMP IF NOT SIP OR IGNORE
	MOVX	S1,OBSSIP+OBSIGN	;GET SIP AND IGNORE BITS.
	ANDCAM	S1,OBJSCH(P1)		;TURN THEM OFF.
	JRST	KILP.5			;AND LOOP FOR NEXT OBJECT

KILP.2:	LOAD	S1,OBJSCH(P1),OBSSUP	;GET OBJECT-SETUP BIT
	JUMPE	S1,KILP.5		;NO,,GET NEXT OBJECT.
	ZERO	OBJSCH(P1),OBSSUP	;CLEAR THE FLAG

	;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),OBSBUS	;IS IT BUSY?
	JUMPE	S1,KILP.5		;NO, ON TO THE NEXT OBJECT
	LOAD	S1,OBJSCH(P1),OBSFRR	;GET THE FREE RUNNING BIT.
	JUMPN	S1,KILP.7		;IF OBJ IS FREE RUNNING,,RLSE INT-LCKS
	MOVEI	H,HDRUSE##		;LOAD USE QUEUE HEADER
	LOAD	AP,.QHLNK(H),QH.PTF	;POINT TO FIRST ENTRY

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

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)/>,,<$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

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
	MOVEM	S1,OBJ.ND(P1)		;SYSTEM'IZE IT (NBR ON -10, NAME ON -20)
	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
	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

	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.2			;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.
	LOAD	S1,OBJ.UN(P1)		;GET THE UNIT NUMBER.
	CAIGE	S1,10			;MORE THEN 7 UNITS ???
	$RETT				;NO,,THEN RETURN TRUE.
	$ACK	(Invalid Unit Number Specified,,0(P1),.MSCOD(M)) ;TELL THE OPR
	$RETF				;RETURN FALSE.

CHKO.1:	SOSL	G$NBAT##		;SUBTRACT 1 FROM MAX BATCH COUNT.
	$RETT				;OK,,RETURN.
	$ACK	(Batch Stream Maximum Exceeded,,0(P1),.MSCOD(M))
	SETZM	G$NBAT##		;RESET THE COUNT TO 0.
	$RETF				;RETURN.

CHKO.2:	$ACK	(Device Invalid for Emulation,,0(P1),.MSCOD(M))
	$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 OUTPUT ADDRESS
	SETZM	MSGBLK			;ZERO THE FIRST MESSAGE BLOCK WORD
	MOVE	S1,[MSGBLK,,MSGBLK+1]	;CREATE BLT AC
	BLT	S1,MSGBLK+MOD.SZ+3	;ZERO THE REST OF THE MESSAGE BLOCK
	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
	STORE	S1,MSGBLK+MSHSIZ	;SAVE IT IN THE MESSAGE BLOCK
	LOAD	S1,RDBPRM+2		;GET THE USERS ENTRY ADDRESS
	LOAD	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