Google
 

Trailing-Edge - PDP-10 Archives - BB-L014Z-BM_1990 - galsrc/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
	SUBTTL	Preliminaries

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975, 1988.
;	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 THAT IS NOT SUPPLIED BY DIGITAL.


	SEARCH	QSRMAC,GLXMAC		;PARAMETER FILE

	PROLOGUE(QSRADM)		;GENERATE NECESSARY SYMBOLS

	SEARCH	ORNMAC			;NEED ORION INTERFACE

	ADMMAN==:50			;Maintenance edit number
	ADMDEV==:43			;Development edit number
	VERSIN (ADM)			;Generate edit number

	QSRED1==:GMCEDT+OMCEDT+QMCEDT+ADMEDT ;Sub total versions due to macro
	Subttl	Table of Contents

;		     Table of Contents for QSRADM
;
;				  Section		      Page
;
;
;    1. Revision history . . . . . . . . . . . . . . . . . . .   4
;    2. Module Storage and Constants . . . . . . . . . . . . .   5
;    3. OBJECT TABLE AND MISC STORAGE  . . . . . . . . . . . .   6
;    4. Operator Messages  . . . . . . . . . . . . . . . . . .   7
;    5. Initialization Entry . . . . . . . . . . . . . . . . .   8
;    6. A$NPID - Obtain NEBULA's PID . . . . . . . . . . . . .   9
;    7. Administrative Message Handlers  . . . . . . . . . . .  10
;    8. HELLO
;        8.1    Function 1 . . . . . . . . . . . . . . . . . .  11
;    9. COUNT
;        9.1    Function 20  . . . . . . . . . . . . . . . . .  13
;   10. A$AGE
;       10.1    Routine to compare two times in internal forma  14
;   11. A$AFT
;       11.1    Routine to modify an internal time . . . . . .  15
;   12. I$WHEEL
;       12.1    Determine whether sender of current message is  16
;   13. A$OSTA / A$ISTA
;       13.1    Startup an object  . . . . . . . . . . . . . .  17
;   14. A$STND - START NODE MESSAGE PROCESSOR  . . . . . . . .  18
;   15. A$OSHT
;       15.1    Shutdown an object . . . . . . . . . . . . . .  19
;   16. SHUTNODE - ROUTINE TO SHUTDOWN AN ENTIRE NODE  . . . .  20
;   17. A$OSET
;       17.1    Set parameters for an object . . . . . . . . .  21
;   18. GETNOB
;       18.1    Get NOB entry in the SNA workstation object li  23
;   19. NETSET - 'SET NODE' PROCESSING ROUTINE . . . . . . . .  24
;   20. A$MODIFY - ROUTINE TO SET THE JOBS PRIORTY . . . . . .  26
;   21. A$ENABLE - ROUTINE TO ENABLE QUEUE ENTRY CREATE'S  . .  27
;   22. A$ELPR - Enable Specific LPT objects to process LOG/SP  28
;   23. A$ELPT - Enable a specific LPT object to process LOG/S  29
;   24. A$EUNP - ENABLE UNPRIV'D USERS REMOTE INFO OUTPUT DISP  30
;   25. A$OREQ - Operator REQUEUE Request  . . . . . . . . . .  31
;   26. COMMMM - OPERATOR REQUEST COMMON PROCESSING ROUTINE. .  32
;   27. OPERATOR COMMAND PROCESSING ROUTINES.  . . . . . . . .  33
;   28. A$OSTO - STOP OPERATOR MESSAGE PROCESSOR . . . . . . .  34
;   29. A$OREL, A$OHLD - RELEASE/HOLD OPERATOR MESSAGES. . . .  35
;   30. A$ODEL - ROUTINE TO REMOVE JOBS FROM THE SYSTEM QUEUES  36
;   31. A$ORTE - ROUTINE TO PROCESS OPERATOR ROUTE COMMAND.  .  37
;   32. A$DEFINE - Routine to process the 'DEFINE' network com  38
;   33. A$DN60 - ROUTINE TO SEND A OPERATOR RESPONSE TO LPTSPL  41
;   34. A$NEXT - NEXT COMMAND PROCESSOR  . . . . . . . . . . .  42
;   35. SNDOAC
;       35.1    Send an Operator Action Message  . . . . . . .  43
;   36. Global Routines  . . . . . . . . . . . . . . . . . . .  44
	Subttl	Table of Contents (page 2)

;		     Table of Contents for QSRADM
;
;				  Section		      Page
;
;
;   37. A$KLPD
;       37.1    Routine to kill a PSB given its PID  . . . . .  45
;   38. A$FPSB
;       38.1    Subroutine to find a PSB . . . . . . . . . . .  46
;   39. A$GPSB - ROUTINE TO FIND A PSB IN THE PSB CHAIN  . . .  47
;   40. A$FRMC - Send a forms change request . . . . . . . . .  48
;   41. A$CPOB
;       41.1    Copy an object block . . . . . . . . . . . . .  49
;   42. A$CNAM - COPY OVER A LPT NAME  . . . . . . . . . . . .  50
;   43. A$FREQ - ROUTINE TO FIND A REQUEST IN ANY QUEUE VIA RE  51
;   44. A$OB2Q
;       44.1    Convert object type to queue header  . . . . .  52
;   45. A$OBST
;       45.1    Update Object Status . . . . . . . . . . . . .  53
;   46. A$STATUS - UPDATE THE DEVICE STATUS  . . . . . . . . .  54
;   47. A$GBLK - ROUTINE TO BREAK DOWN IPCF MESSAGES . . . . .  55
;   48. Utility Routines . . . . . . . . . . . . . . . . . . .  56
;   49. GETPSB
;       49.1    Routine to get a PSB . . . . . . . . . . . . .  57
;   50. KILPSB
;       50.1    Routine to kill a PSB given its address  . . .  58
;   51. GETOBJ
;       51.1    Find or create an OBJ queue entry  . . . . . .  60
;   52. CMPNOD - COMPARE TWO OBJECT NODES  . . . . . . . . . .  62
;   53. CMPNAM - COMPARE TWO NAMES OF LPT OBJECTS  . . . . . .  63
;   54. CHKOBJ - ROUTINE TO VALIDATE OBJECT BLOCK REQUESTS.  .  64
;   55. A$FOBJ
;       55.1    Find an entry in the object queue  . . . . . .  65
;   56. CHRNME
;       56.1    Compare two names  . . . . . . . . . . . . . .  66
;   57. FNDDEV - CHECK FOR ANY DEVICE STARTED FOR THE SPECIFIE  67
;   58. CHLPTY - CHECK FOR A REMOTE PRINTER TYPE . . . . . . .  68
;   59. A$FNDB - ROUTINE TO FIND ANY BLOCK IN AN IPCF MESSAGE   69
;   60. GENRDB - ROUTINE TO CREATE AN RDB FOR HOLD/RELEASE/SET  70
;   61. PRMTAB - OBJECT INITIAL PARAMETERS TABLE.  . . . . . .  71
;   62. ORANGE
;       62.1    Handle a range of objects  . . . . . . . . . .  72
SUBTTL	Revision history

COMMENT \

*****  Release 4.2 -- begin maintenance edits  *****

2	4.2.1613	17-Apr-85
	Lite the OBSIBM bit in the scheduling word of an object if the object
is part of an IBM node.

*****  Release 5.0 -- begin development edits  *****

10	5.1003		7-Jan-83
	Move to new development area.  Add version vector.  Clean up
edit organization.  Update TOC.

11	5.1001		25-Feb-83
	Set S1 to a legit value before jumping to SNDOPR in A$DN60.

12	5.1137		20-Apr-84
	Subtotal QUASAR edit number as QSRED1.

13	5.1162		21-Sep-84
	Add support for SNA Workstations.

14	5.1160		26-Sept-84
	In routine CHKO.1, change the CAIGE to CAIG so that it will check the
highest number of batch stream on a system.

15	5.1172		22-Oct-84
	When a node is defined, always call N$NNET to purge any existing entry.

16	5.1182		30-Nov-84
	In A$HELLO first determine if a PSB is restarting before checking if it
is MOUNTR. Also, upon MOUNTR restart delete only tape mount requests, keep the
structure mount requests.

*****  Release 5 -- begin maintenance edits  *****

20	Increment maintenance edit level for GALAXY 5.

21	Do not update the status of an object after a SET command has been
processed. 

*****  Release 6.0 -- begin development edits  *****

30	6.1026		19-Oct-87
	Add support to the ABORT, CONTINUE, REQUEUE, SET PRINTER and START
commands for remote printers.

31	6.1042		29-Oct-87
	Add support for the NEXT command for remote printers. Correct all
calls to A$FOBJ.

32	6.1072		16-Nov-87
	Unpon receiving the START command, check for the 
TERMINAL-CHARACTERISTIC name and store it in OBJTCR.

33	6.1072		18-Nov-87
	In routine OSTA.0, if there is no device switch go check for TTY
CHARACTERISTIC switch.

34	6.1097		22-Nov-87
	Use the $QACK and $QWTO macros for sending .OMACK and .OMWTO messages.

35	6.1175		7-Feb-88
	Add routine A$NPID to obtain NEBULA's PID for suport of INFORMATION
OUTPUT/DESTINATION and CANCEL PRINT /DESTINATION.

36	6.1176		8-Feb-88
	When starting a TTY printer on TTYx:, make sure TTYx: is not already
started for another unit.

37	6.1177		11-Feb-88
	Add support for specifying that batch log files and spooled files
be scheduled on specified local printers.

40	6.1182		16-Feb-88
	Add routines A$EUNP and A$DUNP in support of the  ENABLE/DISABLE
UNPRIVILEGED-USER-ENTIRE-REMOTE-OUTPUT-DISPLAY commands.

41	6.1188		19-Feb-88
	If a SHUTDOWN message specifies a node not known to QUASAR, cause
routine A$OSHT to send to ORION the "device unknown" message rather than
the "ORION error" message.

42	6.1211		3-Mar-88
	Check for LAT printers, in addition to local printers, when processing
a SET FORMS message.

43	6.1225		8-Mar-88
	Update copyright notice.

*****  Release 6.0 -- begin maintenance edits  *****

44	6.1281		26-Sep-89
	Do not START or SET a remote printer object if its target node is
the local node. In the case of a cluster printer this will prevent print
requests from being endlessly scheduled.

45	6.1289		29-Nov-89
	Define location G$NULA as external. This is used in the $Qxxx
macros. Change routine A$OSHT to ACK a remote operator if the object
is not busy. 

46	6.1306		31-Jan-90
	/USER and /OWNER blocks' argument values have been changed from
specifying user public structure numbers to user public structure names
in support of the /CLUSTER-NODE switch in which the remote node has a
different public structure than the node in which the command was issued.

47	6.1312		17-Feb-90
	Implement support for the /CLUSTER-NODE: switch for the commands
ENABLE/DISABLE LOGFILES-TO-SPECIFIC-PRINTERS, PRINT-LOGFILES, QUEUE-REQUESTS
and UNPRIVILEGED-USER-ENTIRE-REMOTE-OUTPUT-DISPLAY.

50	6.1318		3-Jun-90
	Add support for alias printing.

\   ;End of Revision History
	SUBTTL	Module Storage and Constants
	
	INTERNAL CHRNME,CHLPTY				;[30]
	EXTERNAL G$REMN,G$NEBF				;[34] 
;**;[50]At EXTERNAL G$REMN:+1L add 1 line   PMM   6/3/90
	EXTERNAL RTEQUE					;[50]
;**;[45]At EXTERN G$REMN add 1 line  JCR  11/29/89
	EXTERN	G$NULA			;[45]Required by the $Qxxx macros

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

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

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

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

;**;[50]At TMPMSG:+1L add 1 line   PMM   6/3/90
ALIHED: BLOCK   1		;[50]Printer alias header flag (-1=Yes, 0=No)
	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	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$OSTO			;[30]STOP AN OBJECT
	INTERN	A$OCON			;CONTINUE AN OBJECT
	INTERN	A$OSHC			;SHOW CONTROL FILE (EXAMINE)
	INTERN	A$OREQ			;REQUEUE A JOB
	INTERN	A$OABT			;[30]ABORT 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$ELPR			;[37]ENABLE SPECIFIC LOG/SPOOL LPT MSG
	INTERN	A$DLPR			;[37]DISABLE SPECIFIC LOG/SPOOL LPT MSG
	INTERN	A$ELPT			;[37]ENABLE A LPT FOR LOG/SPOOL MSG
	INTERN	A$DLPT			;[37]DISABLE A LPT FOR LOG/SPOOL MSG
	INTERN	A$EUNP			;[40]ENA UNPRIV USERS REMOTE INFO OUT
	INTERN	A$DUNP			;[40]DIS UNPRIV USERS REMOTE INFO OUT
	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
;**;[50]At INTERN A$ISTA:+L add 2 lines  PMM  6/3/90
	INTERN	A$ONEW			;[50]Process NEW ALIAS Message
	INTERN	A$RHEL			;[50]Process HELLO Message from ORION
	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 
	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 A$NPID - Obtain NEBULA's PID

A$NPID:	MOVEI	S1,SP.NEB		;[35]PICK UP NEBULA'S IPCF INDEX
	$CALL	C%RPRM			;[35]PICK UP NEBULA'S PID
	$RETIF				;[35]INDICATE IF NEBULA IS NOT RUNNING
	MOVEM	S1,G$NEBP##		;[35]SAVE NEBULA'S PID
	$RET				;[35]RETURN TO THE CALLER
	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,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
	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
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 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

	;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
	LOAD	P1,HDRPSB##+.QHLNK,QH.PTF ;GET THE FIRST PROCESSOR BLOCK
HELL.A:	JUMPE	P1,.RETT		;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

	;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....
	MOVE	S1,HEL.OB(M)		;Get the object type
	CAIN	S1,.OTMNT		;For mountable devices?
	PUSHJ	P,I$MID##		;Yes, delete the tape requests
	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,A$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
	PG2ADR	S1			;MAKE AN ADDRESS
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE IT IN THE SAB
	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
	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	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::	$SAVE	<T1>		;SAVE T1
	CAMGE	S1,S2		;ORDERING CHECK
	 EXCH	S1,S2		;WANT THE LARGEST IN S1
	SUB	S1,S2		;SUBTRACT THEM
	HLRZ	T1,S1		; Get the days difference
	HRRZS	S1		; Seperate the difference in fraction
	IMULX	S1,<^D1000.>	; Shift it over for greater accuracy
	IDIVX	S1,<^D3034.>	; Divide by the magic factor
	IMULX	T1,<^D<24*3600>>  ; Calculate the seconds between the days
	ADD	S1,T1		; Calculate the total number of seconds
	$RET			; 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.
;  P2 is used to contain the /DEVICE: name, so be careful in using ACs.

A$OSTA:	$SAVE	<P1,P2>			;[36] Save P1, and P2
	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.3			;Yes, error, go tell the operator

;[36]Check to see if the object has a/DEVICE:x (Physical Device Name)

	SETZ	P2,			;[36] Clear device name
	MOVX	S1,.CMDEV		;[36] Want a device block
	PUSHJ	P,A$FNDB		;[36] See if there is one
	JUMPF	OSTA.0			;[36] No
	HRLI	S1,(POINT 7,0)		;[36] Byte pointer to the ASCIZ string
	PUSHJ	P,S%SIXB		;[36] Convert it to SIXBIT
	PUSHJ	P,A$FTTY		;[36] See if device name already exists
	JUMPF	OSTA.5			;[36] Yes, we have an error 
	MOVEM	S2,P2			;[36] Save device name
;**;[44]At OSTA.0:+0L replace 1 line with 3 lines  JCR  9/26/89

OSTA.0:	$CALL	CHVLPT			;[44]Check for legal remote printer
	JUMPF	.RETT			;[44]Quit now if illegal
	MOVE	S1,OBJ.TY(P1)		;[44]Pick up the LPT type word
	$CALL	CHLPTY			;[30]CHECK FOR A REMOTE PRINTER
	MOVE	S1,P1			;[30]PICK UP THE OBJECT BLOCK ADDRESS
;**;[50]At OSTA.0:+4L add 5 lines  PMM  6/3/90
	LOAD	T1,-1(S1),AR.LEN	;[50]Get length of object block
	SETZM	ALIHED			;[50]Indicate no alias
	CAIN	T1,AKBSIZ		;[50]Large enough to contain alias?
	SETOM	ALIHED			;[50]Indicate alias name present
	JUMPF	A$OSS1			;[50]No, indicate not a remote printer
	MOVE	S2,P1			;[30]PICK UP THE OBJECT BLOCK ADDRESS
	ADDI	S2,OBJ.SZ		;[30]POINT TO THE NAME BLOCK
	JRST	A$OSS2			;[30]JOIN THE COMMON CODE

A$ISTA:	$SAVE	P1
A$OSS1:	SETZ	S2,			;[30]INDICATE NO NAME BLOCK
A$OSS2:	PUSHJ	P,GETOBJ		;[30]GET THE OBJECT EQ OR CREATE ONE
	JUMPF	.RETT			;NO GOOD,,RETURN.
;**;[50]At A$OSS2:+2L add 4 lines   PMM   6/3/90
	SKIPN	ALIHED			;[50]Is there an alias name?
	JRST	A$OSS3			;[50]No, no need to copy it
	MOVE	T1,OBJ.AK(P1)		;[50]Get the alias name
	MOVEM	T1,OBJAKA(S1)		;[50]Save in object block
A$OSS3:	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
	SKIPN	P2			;[36] Do we have a device name?
	JRST	OSTA.4			;[36]No, skip /DEVICE:x stuff
	MOVEM	P2,OBJPRM+.OOTAP(P1) 	;[36] SAVE THE DEVICE NAME FOR LATER
	MOVX	S1,OBSSPL		;[36] Get spool to tape function
	IORM	S1,OBJSCH(P1)		;[36] Lite it in the scheduling vector

OSTA.4:	$QACK	(Startup Scheduled,,OBJTYP(P1),.MSCOD(M)) ;[36]
	MOVE	S1,P1			;GET THE OBJECT ADDRESS BACK
	PUSHJ	P,A$OBST		;SETUP THE OBJECT STATUS.
	DOSCHD				;FORCE A SCHEDULING PASS
	MOVEI	S1,.OTLPT		;[37]PICK UP THE LPT OBJECT TYPE
	CAME	S1,OBJTYP(P1)		;[37]IS THIS A LOCAL LPT?
	JRST	OSTA4A			;[37]NO, PREPARE TO CHECK FOR TTY: LPT
	MOVEI	S1,OBJTYP(P1)		;[37]PICK UP OBJECT DESCRIPTOR ADDRESS
	$CALL	FNDRTE##		;[37]CHECK FOR A ROUTE TABLE ENTRY
	JUMPF	OSTA4A			;[37]IF NONE, CHECK FOR A TTY: LPT
	LOAD	S1,RLSFG1(S1),OB2LOG	;[37]PICK UP LOG/SPOOL BIT VALUE
	STORE	S1,OBJSC2(P1),OB2LOG	;[37]SAVE IN THE LPT OBJECT

OSTA4A:	LOAD	S1,OBJTYP(P1),RHMASK	;[37]GET THE OBJECT TYPE
	CAIE	S1,.OTLPT		;IS IT THE LINE PRINTER ???
	$RETT				;[36] No,,just return

;Check to see if Printer has a terminal characteristic

	MOVX	S1,.ORTCR		;[36] Want TTY CHARACT
	PUSHJ	P,A$FNDB		;SEE IF THERE IS ONE
	JUMPF	.RETT			;[32]NOT YET
	MOVE	S2,(S1)			;[32]GET THE TTY CHARACT
	MOVEM	S2,OBJTCR(P1)		;[32]SAVE IT
	$RETT				;AND RETURN

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

OSTA.2:	$QACK	(Already Started,,OBJTYP(P1),.MSCOD(M))
	$RETT

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

;[36] Only place were OSTA.5 is called after is when A$FTTY returns FALSE
;P1 contains the address of the object block we are trying to start
;S1 contains contains the object queue entry that has the same TTY:.
;S2 contains the TTYxxx:

OSTA.5:	$QACK	(<^W/S2/: is already started as printer ^D/OBJUNI(S1)/>,,0(P1),.MSCOD(M))
	$RETT

;Check whether the printer that is being started has the same TTY number as
;an existing printer object.  
;
;Accepts S2/TTYxxx
;Returns S2/TTYxxx  S1/object entry address
;	 true if no object found
;	 false if there is already an existing printer object with same TTY
;(note:preserves S2)

A$FTTY:	LOAD	S1,HDROBJ##+.QHLNK,QH.PTF ;[36] Get the first object entry
	SKIPA				;[36] Skip the first time through

FTTY.1:	LOAD	S1,.QELNK(S1),QE.PTN	;[36] Get the next object entry address
	JUMPE	S1,.RETT		;[36] If no entries or end, return true
	CAME	S2,OBJPRM+.OOTAP(S1)	;[36] Do TTY match?
	JRST	FTTY.1			;[36] No,,try next object
	$RETF				;[36] Found one, false return
	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$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.

	LOAD	S1,NETSTS(S2),NETSNA	;Is it an SNA Node
	JUMPN	S1,STND.2		; Yes, go start it up
	LOAD	S1,NETSTS(S2),NETIBM	;GET IBM STATUS
	LOAD	S2,NETSTS(S2),NT.MOD	;GET THE MODE
	JUMPE	S1,STND.A		;IS IT AN IBM REMOTE
	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
					;  node this way
STND.A:	PUSH	P,S1			;Save S1 for a min.
	MOVX	S1,.OTRDR		;GET CARD READER OBJECT TYPE
	MOVEM	S1,.OHDRS+ARG.DA+OBJ.TY(M) ;SAVE IT IN THE OBJECT BLOCK
	MOVEI	S1,.OHDRS+ARG.DA(M)	;Get the start of the object block
	PUSHJ	P,A$ISTA		;START A CARD READER FOR THE NODE
	POP	P,S1			;Get back IBMness
	SKIPE	S1			;Is it?
	JRST	STND.0			;Yes, do not start up a printer
	MOVX	S1,.OTLPT		;GET LINE PRINTER OBJECT TYPE
	MOVEM	S1,.OHDRS+ARG.DA+OBJ.TY(M) ;SAVE AS NEW OBJECT TYPE
	MOVEI	S1,.OHDRS+ARG.DA(M)	;Get the start of the object block
	PUSHJ	P,A$ISTA		;AND START THE LINE PRINTER
STND.0:	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
	MOVEI	S1,.OHDRS+ARG.DA(M)	;Get the start of the object block
	PUSHJ	P,A$ISTA		;START A BATCH STREAM FOR THE NODE
	SETOM	.MSCOD(M)		;CLEAR COMMON ACK CODE
	$RETT				;AND RETURN

; Here to start up an SNA type node,  S2 contains pointer to node entry
;

STND.2:	MOVE	P1,S2			;Save pointer to node entry
	MOVX	S1,.OTBAT		;GET BATCH STREAM OBJECT TYPE
	MOVEM	S1,.OHDRS+ARG.DA+OBJ.TY(M) ;SAVE AS THE OBJECT TYPE
	MOVEI	S1,1			; Unit 1 is main batch stream
	MOVEM	S1,.OHDRS+ARG.DA+OBJ.UN(M) ;SAVE AS THE OBJECT Unit
	MOVEI	S1,.OHDRS+ARG.DA(M)	;Get the start of the object block
	PUSHJ	P,A$OSTA		;START A BATCH STREAM FOR THE NODE

	MOVE	S1,NETNOB(P1)		; Link List Index for Objects
	$CALL	L%FIRST			; Get first object
	SKIPA
STND.3:	$CALL	L%NEXT			; Get next object
	 JUMPF	STND.4			; All done
	MOVE	S1,NOBTYP(S2)		; Get type
	MOVEM	S1,.OHDRS+ARG.DA+OBJ.TY(M) ;SAVE AS THE OBJECT TYPE
	MOVE	S1,NOBUNI(S2)		; Get Unit
	MOVEM	S1,.OHDRS+ARG.DA+OBJ.UN(M) ;SAVE AS THE OBJECT Unit
	PUSHJ	P,A$OSTA		; Start the object
	MOVE	S1,NETNOB(P1)		; Link List Index for Objects
	JRST	STND.3			; Loop for all objects

STND.4:	SETOM	.MSCOD(M)		;CLEAR COMMON ACK CODE
	$RETT				;AND RETURN

STAERR:	MOVE	TF,NETCOL(S1)		;GET THE NODE NAME
	LOAD	S2,NETPTL(S1),NT.PRT	;GET THE PORT NUMBER
	LOAD	S1,NETPTL(S1),NT.LIN	;GET THE LINE NUMBER
	$QACK	(Illegal Start Command,<Port ^O/S2//Line ^O/S1/ already started as node ^N/TF/>,,.MSCOD(M))
	$RETT				;RETURN

STAE.2:	MOVE	S1,.OHDRS+ARG.DA+OBJ.ND(M) ;Get the node name back
	$QACK	(<Illegal to start termination node ^N/S1/>,<Only defined prototype nodes may be started>,,.MSCOD(M))
	$RETT
	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	DEVUNK			;[41]If not there, then unknown device
	LOAD	S1,NETSTS(S2),NETIBM	;Get the IBM status
	SKIPE	S1			;Is it IBM object?
	JRST	A$SH.3			;Yes, not allowed

	MOVE	S1,OBJ.TY(P1)		;[30]PICK UP THE LPT TYPE WORD
	$CALL	CHLPTY			;[30]CHECK IF OBJECT IS A REMOTE LPT
	SETZ	S2,			;[30]ASSUME NO NAME BLOCK
	SKIPF				;[30]SKIP IF NOT A REMOTE LPT
	MOVEI	S2,OBJ.SZ(P1)		;[30]PICK UP NAME BLOCK ADDRESS
A$OSH1:	MOVE	S1,P1			;[30]PICK UP OBJECT 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.
;**;[45]At A$OSH1:+7L replace 8 lines with 12 lines  JCR  11/29/89
	LOAD	S2,S1,OBSBUS		;[45]Save a copy of the busy bit
	TXO	S1,OBSSEJ		;[45]Set "shutdown at end of job" bit
	TXNE	S1,OBSFRR		;[45]Is this a free running device?
	TXZ	S1,OBSBUS		;[45]Yes, clear the busy bit
	MOVEM	S1,OBJSCH(P1)		;[45]Save the scheduling bits
	DOSCHD				;[45]Force a scheduling pass
	JUMPE	S2,A$OSH2		;[45]Is the object busy?
	$QACK	(Shutdown at EOJ Scheduled,,OBJTYP(P1),.MSCOD(M)) ;[45]Yes
	$RETT				;[45]Return to the caller
A$OSH2:	SKIPE	G$NEBF			;[45]Message originate remotely?
	$QACK	(Shutdown Pending,,OBJTYP(P1),.MSCOD(M)) ;[45]Yes
	$RETT				;[45]Return to the caller

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

A$SH.3:	$QACK	(<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.A:	PUSHJ	P,N$GNOD##		;FIND IT IN OUR DATA BASE
	DMOVE	P1,S1			;COPY NODE NAME & ADDRESS
	JUMPF	SHUT.5			;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
	CAME	P1,NETLOC(P2)		;Skip this if proto is same as actual
	CAIE	S1,DF.PRO		;Is it proto mode?
	JRST	SHUT.0			;No, continue on
	LOAD	S1,NETSTS(P2),NETPRO	;Get proto online flag
	SKIPN	S1			;Is it online prototype?
	JRST	SHUT.0			;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.A			;Go shut the actual node

SHUT.0:	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.4		;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.2			;INVISIBLE OR WRONG NODE,,TRY NEXT
	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 ???
	$QACK	(<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 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.1			;AND CONTINUE

SHUT.4:	SKIPN	.OARGC(M)		;DID WE SHUTDOWN ANY OBJECTS ???
SHUT.5:	$QACK	(<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
;**;[44]At OSET.2:+5L add two lines  JCR  9/26/89
	$CALL	CHVLPT			;[44]Check for valid remote printer
	JUMPF	.RETT			;[44]Return if invalid
	MOVE	S1,OBJ.TY(P1)		;[30]PICK UP THE OBJECT TYPE
	$CALL	CHLPTY			;[30]CHECK FOR A REMOTE LPT
;**;[50]At OSET:+9L add 4 lines  PMM  6/3/90
	LOAD	T1,-1(P1),AR.LEN	;[50]Get length of object block
	SETZM	ALIHED			;[50]Indicate no alias
	CAIN	T1,AKBSIZ		;[50]Large enough to contain alias?
	SETOM	ALIHED			;[50]Indicate alias name present
	JUMPF	OSET.3			;[30]No, DON'T PICK UP NAME ADR
	MOVE	S2,P1			;[30]Yes, PICK UP OBJECT BLOCK ADDRESS
	ADDI	S2,OBJ.SZ		;[30]POINT TO THE NAME BLOCK
	SKIPA				;[30]DON'T RESET ADDRESS
OSET.3:	SETZ	S2,			;[30]INDICATE NO NAME BLOCK
	MOVE	S1,P1			;[30]PICK UP THE OBJECT BLOCK ADDRESS
	PUSHJ	P,GETOBJ		;FIND/CREATE THE OBJ BLK.
	JUMPF	.RETT			;NO GOOD,,RETURN
;**;[50]At OSET.3:+3L add 4 lines   PMM   6/3/90
	SKIPN	ALIHED			;[50]Is there an alias name?
	JRST	OSET.4			;[50]No, no need to copy it
	MOVE	T1,OBJ.AK(P1)		;[50]Get the alias name
	MOVEM	T1,OBJAKA(S1)		;[50]Save in object block
OSET.4:	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)		;[42]PICK UP THE OBJECT TYPE
	CAMN	S2,[.OTLPT]		;[42]A LOCAL PRINTER?
	SKIPA				;[42]YES, SET FORMS CHANGE STATUS
	CAMN	S2,[.LALPT!.OTLPT]	;[42]A LAT PRINTER?
	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

	;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:	$QACK	(Set Accepted,,OBJTYP(P1),.MSCOD(M))
;**;[21]Delete 2 lines at SETMSG:+1L  JCR  5/8/86
	DOSCHD				;FORCE A SCHEDULING PASS
	$RETT				;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:	$QACK	(Attribute may not be changed,,OBJTYP(P1),.MSCOD(M))
	$RETF

SETDST:	$SAVE	<P2>			; Save P2
	MOVE	S1,OBJNOD(P1)		; Get node name
	$CALL	N$NODE##		; Get the node DB entry
	MOVE	P2,S2			; Keep it
	LOAD	S1,NETSTS(P2),NETSNA	; Is this an SNA Workstation?
	 JUMPE	S1,SETE.2		;  No, return error
        LOAD	S1,OBJSCH(P1)		; Get scheduler flags
	TXNE	S1,OBSSUP!OBSSIP	; Error if setup started
	 JRST	SETE.1
	MOVE	S1,NETNOB(P2)		; Get list index
	$CALL	GETNOB			; Get NOB entry for this object
	 JUMPF	SETE.3			; Return failure
	MOVE	S2,NETNOB(P2)		; Get list index, again
	MOVE	P2,S1			; P2 points to NOB

	MOVE	T1,P3			; Address of destination string
	HRLI	T1,(POINT 7)		; Make a pointer
SETD.1:	ILDB	T2,T1			; Get a char
	 JUMPE	T2,[MOVE  S1,S2		; If null,
		    $CALL L%DENT	;  delete this entry
		    JRST SETMSG]	; Finish up
	CAIN	T2," "			; If blank,
	 JRST	SETD.1			;  keep looking

	MOVEI	S1,DSTSIZ		; Size of "destination field"
	MOVEI	S2,NOBDST(P2)		; Its address
	$CALL	.ZCHNK			; Clear it
	LOAD	S1,ARG.HD-ARG.DA(P3),AR.LEN	; Get length
	CAILE	S1,DSTSIZ		; Make sure
	JRST	SETE.4			;  we have enough room
	HRLZ	S2,P3			; Source
	HRRI	S2,NOBDST(P2)		; source,,destination
	ADDI	S1,NOBDST-2(P2)		; Last address
	BLT	S2,(S1)			; Move it

SETD.2:	PUSHJ	P,A$GBLK		; Get next message block
	 JUMPF	SETMSG			; None, all done
	MOVEI	S1,1			; Get a 1
	CAIN	T1,.STSPL		; /SPOOL ?
	 JRST	[STORE	S1,NOBFLG(P2),NOBSPL	; Yes, set the flag
		 JRST	SETD.2]
	CAIE	T1,.STNTL		; /NOTRANSLATE ?
	 JRST	BADMSG			;  No, error
	STORE	S1,NOBFLG(P2),NOBNTL	; Set the flag
	JRST	SETD.2

SETE.1:	$QACK	(<Set ignored>,<Object already started>,OBJTYP(P1),.MSCOD(M))
	$RETF

SETE.2:	$QACK	(<Set ignored>,<Node must be an SNA Workstation>,OBJTYP(P1),.MSCOD(M))
	$RETF

SETE.3:	$QACK	(<Set ignored>,<Could not create object block>,OBJTYP(P1),.MSCOD(M))
	$RETF

SETE.4:	$QACK	(<Set ignored>,<Destination string too long>,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
	.STDST,,SETDST			;SET DESTINATION

		NSETS==.-SETTBL
	SUBTTL	GETNOB  --  Get NOB entry in the SNA workstation object list

	;CALL:	S1/ NOB List Index
	;	P1/ The address of object queue entry for object
	;
	;RET:	S1/ The address of the NOB entry or false

FNDNOB::
	SKIPA	S2,[1]			;INDICATE "FIND"
GETNOB:	SETZ	S2,			;INDICATE "GET"
	PUSHJ	P,.SAVET		;SAVE THE 'T' ACS
	PUSH	P,S1			;KEEP INDEX
	PUSH	P,S2			;KEEP ENTRY FLAG
	MOVE	T1,OBJTYP(P1)		;GET THE MODEL OBJECT TYPE
	MOVE	T2,OBJUNI(P1)		;GET THE MODEL OBJECT UNIT
	MOVE	T3,OBJNOD(P1)		;GET THE MODEL OBJECT NODE
	$CALL	L%FIRST			;GET FIRST ENTRY
	SKIPA
GETN.1:	$CALL	L%NEXT			;GET NEXT ENTRY
	 JUMPF	GETN.2			;NO MORE ENTRIES
	MOVE	T4,S2			;ADDRESS OF NOB
	CAMN	T1,NOBTYP(T4)		;DO OBJECT TYPES MATCH ???
	CAME	T2,NOBUNI(T4)		;DO OBJECT UNITS MATCH ???
	JRST	GETN.1			;NO TO EITHER,,TRY NEXT OBJECT
	MOVE	S1,T3			;GET THE MODEL OBJECT NODE NAME/NUMBER
	MOVE	S2,NOBNOD(T4)		;GET THE SOURCE OBJECT NODE NAME/NUMBER
	PUSHJ	P,N$MTCH##		;DO THEY MATCH ???
	JUMPF	GETN.1			;NO,,TRY NEXT OBJECT IN THE QUEUE
	ADJSP	P,-2			;ADJUST STACK
	MOVE	S1,T4			;GET THE NOB ENTRY ADDRESS
	$RETT				;AND RETURN
;
; Could not find the entry so here to create a new entry
;

GETN.2:	POP	P,S2			;ENTRY FLAG
	POP	P,S1			;LIST INDEX
	JUMPN	S2,.RETF		;QUIT NOW, IF ONLY LOOKING
	MOVEI	S2,NOBSIZ		;ENTRY SIZE
	$CALL	L%CENT			;CREATE AN ENTRY
	 JUMPF	.RETF			;PASS ON FAILURE
	MOVEM	T1,NOBTYP(S2)		;SAVE TYPE
	MOVEM	T2,NOBUNI(S2)		;SAVE UNIT
	MOVEM	T3,NOBNOD(S2)		;SAVE NODE
	MOVE	S1,S2			;GET THE NOB ENTRY ADDRESS
	$RETT				;AND RETURN
	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
	SETZ	S2,			;Say we want online check
	$CALL	N$CKND##		;Check out the node
	JUMPF	NETS.3			;Failed, online
	JUMPE	S2,NETS.2		;Not found, not defined
	MOVE	P1,S2			;SAVE THE DATA BASE ENTRY ADDRESS
	LOAD	S2,NETSTS(P1),NETSNA	; Is this an SNA node
	JUMPN	S2,NETS.5		;  Yes, go do it
	SETO	S2,			;Say we want online check
	$CALL	N$CKND##		;Check out the node
	JUMPF	NETS.3			;Failed, either online or
					;  objects started
	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

	MOVSI	S1,-NETS		; Get negative # of SET commands.
NETS.0:	HLRZ	S2,NETTBL(S1)		; Pick up a SET command type.
	CAMN	S2,T1			; Do we match ???
	JRST	[MOVEI	S1,[ITEXT(Parameter invalid for IBM remote)] ; Yes
		 MOVE	S2,P1		; Get address of node database
		 JRST	NETS.3]		; Go report error
	AOBJN	S1,NETS.0		; Bump to next tbl entry and continue.

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

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

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

NETS.4:	$QACK	(<Set for Node ^T/NETASC(P1)/ Ignored>,<It is a termination but not a prototype node>,,.MSCOD(M))
	$RETT

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

NETS.5:					; Here to set SNA attributes
	PUSHJ	P,A$GBLK		; Go get a block
	JUMPF	BADMSG			; No more, return through 'BADMSG'
	CAIN	T1,.ORNOD		; Is this the node block (already done)
	JRST	NETS.5			; Yes, try the next one
	MOVSI	S1,-NETS		; Get negative # of SET commands.
NETS.6:	HLRZ	S2,NETTBL(S1)		; Pick up a SET command type.
	CAMN	S2,T1			; Do we match ???
	JRST	NETS.7			;  Yes, Go process it
	AOBJN	S1,NETS.6		; Bump to next tbl entry and continue.
	MOVEI	S1,[ITEXT(Parameter invalid for SNA-Workstation)] ; No match
	MOVE	S2,P1			;Get address of node database
	JRST	NETS.3			; Go report error

NETS.7:	HRRZ	S2,NETTBL(S1)		; Get the NAB offset
	LOAD	S1,NETNAB(P1),NA.ADR	; Get address of Node Attribute Block
	ADD	S1,S2			; Add in appropriate offset
	HRL	S1,T3			; Get source address
	ADDI	T2,-2(S1)		; Determine last destination address
	BLT	S1,(T2)			; Move value to Node Attribute Block
	$QACK	(<Set for Node ^T/NETASC(P1)/ Accepted>,,,.MSCOD(M))
	$RETT				;RETURN

NETTBL:	.STDAT,,NABDAT			; LOGON DATA
	.STLOM,,NABLOM			; LOGON MODE
	.STPLU,,NABPLU			; APPLICATION
	.STCIR,,NABCIR			; CIRCUIT
	.STCHS,,NABCHS			; CHARACTER SET TRANSLATION FILE

NETS==.-NETTBL
>
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 ???
	$QACK	(<No Requests Modified>,,,.MSCOD(M))
	CAIN	S1,1			;JUST 1 JOB ???
	$QACK	(<1 Request Modified>,,,.MSCOD(M))
	CAILE	S1,1			;MORE THEN 1 JOB ???
	$QACK	(<^D/S1/ 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
;**;[47]At A$ENABLE:+1L change 1 line  JCR  2/17/90
	  $QACK   (System Queue's Entry Processing Enabled,,,.MSCOD(M));[47]
	  $RETT				;RETURN



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

A$DISABLE: SETOM  G$QUEUE##		;DISABLE PROCESSING FOR CREATE MESSAGES
;**;[47]At A$DISABLE:+1L change 1 line  JCR  2/17/90
	   $QACK   (System Queue's Entry Processing Disabled,,,.MSCOD(M));[47]
	   $RETT			;RETURN
	SUBTTL	A$ELPR - Enable Specific LPT objects to process LOG/SPOOL req

A$ELPR:	SETOM	G$LOGF##		;[37]INDICATE SPECIFIC LOG/SPOOL ENA
	DOSCHD				;[37]FORCE A SCHEDULING PASS
;**;[47]At A$ELPR:+2L change 1 line  JCR  2/17/90
	$QACK	(Printers for log/spool files enabled,,,.MSCOD(M));[47]
	$RETT				;[37]RETURN TO THE CALLER

A$DLPR:	SETZM	G$LOGF##		;[37]INDICATE SPECIFIC LOG/SPOOL DIS
	DOSCHD				;[37]FORCE A SCHEDULING PASS
;**;[47]At A$DLPR:+2L change 1 line  JCR  2/17/90
	$QACK	(Printers for log/spool files disabled,,,.MSCOD(M));[47]
	$RETT				;[37]RETURN TO THE CALLER
	SUBTTL	A$ELPT - Enable a specific LPT object to process LOG/SPOOL

A$ELPT:	SETOM	G$EDFG##		;[37]INDICATE ENABLE
	SKIPA				;[37]DON'T RESET THE FLAG
A$DLPT:	SETZM	G$EDFG##		;[37]INDICATE DISABLE
;**;[47]At A$DLPT:+1L replace 6 lines with 1 line  JCR  2/17/90
	$SAVE	<P1,P2>			;[47]Save these AC
	MOVEI	S1,.OROBJ		;[37]WANT TO FIND THE OBJECT BLOCK
	$CALL	A$FNDB			;[37]FIND THE OBJECT BLOCK
	JUMPF	BADMSG			;[37]QUIT IF CAN'T FIND IT
	$CALL	ORANGE			;[37]CHECK FOR A RANGE
	MOVE	P1,S1			;[37]SAVE THE OBJECT BLOCK DATA FIELD
	SETZ	S2,			;[37]INDICATE NO LPT NAME BLOCK
;**;[47]At A$DLPT:+9L add 1 line  JCR  2/17/90
	SETZ	P2,			;[47]Indicate no object, route table 
	$CALL	A$FOBJ			;[37]FIND THE LPT OBJECT QUEUE ENTRY
	JUMPF	AELP.2			;[37]NO LPT OBJECT, CHECK ROUTE TABLE
	MOVE	P2,S1			;[37]INDICATE LPT OBJECT FOUND

	MOVE	S2,G$EDFG##		;[37]PICK UP THE ENA/DIS FLAG VALUE
	STORE	S2,OBJSC2(S1),OB2LOG	;[37]SAVE IN THE LPT OBJECT ENTRY

AELP.2:	MOVEI	S1,OBJ.TY(P1)		;[37]PICK UP OBJECT BLOCK ADDRESS
	$CALL	FNDRTE##		;[37]CHECK IF IT IS IN THE ROUTE TBL
	JUMPF	AELP.3			;[37]IF NOT, SEND A RESPONSE TO ORION
	MOVE	S2,G$EDFG##		;[37]PICK UP THE ENA/DIS FLAG VALUE
	MOVEM	S2,RLSFG1(S1)		;[37]SAVE IN THE ROUTE TABLE ENTRY
	MOVE	P2,S1			;[37]INDICATE ROUTE TABLE ENTRY FOUND

AELP.3:	SKIPE	P2			;[37]OBJECT/ROUTE ENTRY FOUND?
	JRST	AELP.4			;[37]YES, INFORM THE OPERATOR
;**;[47]At AELP.3:+2L change 1 line  JCR  2/17/90
	$QACK	(Printer not known,,OBJ.TY(P1),.MSCOD(M)) ;[47]
	$RETT				;[37]RETURN TO THE CALLER
;**;[47]At AELP.4:+0L replace 7 lines with 12 lines  JCR 2/17/90
AELP.4:	SKIPE	G$LOGF##		;[47]Specific LOG/SPOOL enabled?
	JRST	AELP.5			;[47]Yes, proceed processing
	$QACK	(Printers for log/spool files not enabled,-- command ignored --,OBJ.TY(P1),.MSCOD(M));[47]
	$RETT				;[47]Return to the caller

AELP.5:	MOVE	S1,G$EDFG##		;[47]Pick up ENABLE/DISABLE flag
	JUMPE	S1,AELP.6		;[47]If disable, indicate so
	$QACK	(Enabled for log/spool files,,OBJ.TY(P1),.MSCOD(M)) ;[47]
	DOSCHD				;[47]Yes, force a scheduling pass
	$RETT				;[47]Return to the caller
AELP.6:	$QACK	(Disabled for log/spool files,,OBJ.TY(P1),.MSCOD(M)) ;[47]
	$RETT				;[47]Return to the caller
	SUBTTL	A$EUNP - ENABLE UNPRIV'D USERS REMOTE INFO OUTPUT DISPLAY

A$EUNP:	SETOM	G$RPRV##		;[40]ENA UNPRIV USER REMOTE INFO OUT
;**;[47]At A$EUNP:+1L change 1 line  JCR  2/17/90
	$QACK	(Unpriv'd users enabled to see entire remote output queues,,,.MSCOD(M));[47]
	$RETT				;[40]RETURN


	SUBTTL	A$DUNP - DISABLE UNPRIV'D USERS REMOTE INFO OUTPUT DISPLAY

A$DUNP: SETZM	G$RPRV##		;[40]DIS UNPRIV USER REMOTE INFO OUT
;**;[47]At A$DUNP:+1L change 1 line  JCR  2/17/90
	$QACK	(Unpriv'd users disabled from seeing entire remote output queues,,,.MSCOD(M));[47]
	$RETT				;[40]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
	MOVE	S1,OBJ.TY(P1)		;[30]PICK UP THE OBJECT TYPE WORD
	$CALL	CHLPTY			;[30]CHECK FOR A REMOTE PRINTER
	SETZ	S2,			;[30]ASSUME NOT A REMOTE PRINTER
	SKIPF				;[30]SKIP IF NOT A REMOTE PRINTER
	MOVEI	S2,OBJ.SZ(P1)		;[30]PICK UP THE NAME BLOCK ADDRESS
A$RQ.1:	MOVE	S1,P1			;[31]PICK UP THE OBJECT BLOCK ADDRESS
	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
	TXNE	S1,OBSSNA		;IS THIS AN SNA WORKSTATION DEVICE ???
	JRST	OREQ.3			;YES,,JUST SEND THE MESSAGE
	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:	$QACK	(Not Active,,OBJTYP(P1),.MSCOD(M))
	$RETT

A$RQ.3:	$QACK	(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
	MOVE	S1,OBJ.TY(P1)		;[30]PICK UP THE LPT TYPE WORD
	$CALL	CHLPTY			;[30]CHECK FOR A REMOTE PRINTER
	SETZ	S2,			;[30]ASSUME NOT A REMOTE PRINTER
	SKIPF				;[30]SKIP IF NOT A REMOTE PRINTER
	MOVEI	S2,OBJ.SZ(P1)		;[30]PICK UP THE OBJECT BLOCK ADDRESS

A$CO.1:	MOVE	S1,P1			;[31]PICK UP THE OBJECT BLOCK ADDRESS
	PUSHJ	P,A$FOBJ		;[30]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		;PICK UP BUSY 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
	$QACK	(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:	$QACK	(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$OABT:	PJRST	A$OREQ			;[30]PROCESS THE ABORT 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
	SETZ	S2,			;[31]THERE IS NO NAME BLOCK
	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
	TXNE	S2,NETSNA		; Is this node an SNA Workstation?
	JRST	OSND.1			;  Yes, go take care of it
	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 !!!
OSND.1:	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 !!
	$QACK	(<Not Active>,,OBJTYP(S1),.MSCOD(M))
	$RETT				;JUST RETURN

A$OSHC:	PJRST	A$COMM			;PROCESS THE SHOW CONTROL FILE COMMAND.
	SUBTTL	A$OSTO - STOP OPERATOR MESSAGE PROCESSOR

A$OSTO:	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
	MOVE	S1,OBJ.TY(P1)		;[30]PICK UP THE LPT TYPE WORD
	$CALL	CHLPTY			;[30]CHECK FOR A REMOTE PRINTER
	SETZ	S2,			;[30]ASSUME NOT A REMOTE PRINTER
	SKIPF				;[30]SKIP IF NOT A REMOTE PRINTER
	MOVEI	S2,OBJ.SZ(P1)		;[30]PICK UP THE OBJECT BLOCK ADDRESS

A$OS.1:	MOVE	S1,P1			;[31]PICK UP THE OBJECT BLOCK ADDRESS
	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	OSTO.1			;NO,,SKIP THIS
	LOAD	S1,OBJSCH(P1),OBSBUS	;IS THE DEVICE ACTIVE ???
	JUMPE	S1,OSTO.2		;NO,,JUST ACK AND RETURN
	MOVE	S1,P1			;GET THE OBJECT ADDRESS IN S1
	PUSHJ	P,SNDOAC		;SEND THE REQUEST OFF
	MOVE	S1,P1			;GET THE OBJECT ADDRESS IN S1
	PUSHJ	P,A$OBST		;UPDATE THE STATUS
	$RETT				;AND RETURN

OSTO.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 ???
OSTO.2:	MOVEI	S2,[ASCIZ/Stopped/]	;NO,,JUST SAY STOPPED
	$QACK	(^T/0(S2)/,,OBJTYP(P1),.MSCOD(M))  ;ACK THE OPR
	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	S2,[ASCIZ/ Held/]	;ASSUME HOLD MESSAGE.
	SKIPE	P1			;CHECK FLAGS,,IF 0 WE WERE RIGHT
	MOVEI	S2,[ASCIZ/ Released/]	;ELSE MAKE IT RELEASE.
	SKIPG	S1			;MORE THEN 0 JOBS ???
	$QACK	(<No jobs^T/0(S2)/>,,,.MSCOD(M))
	CAIN	S1,1			;IS THERE ONLY 1 JOB ???
	$QACK	(<1 Job^T/0(S2)/>,,,.MSCOD(M))
	CAILE	S1,1			;MORE THEN 1 JOB ???
	$QACK	(<^D/S1/ Jobs^T/0(S2)/>,,,.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 !!!
	$QACK	(<No Jobs Canceled>,,,.MSCOD(M))
	CAIN	S1,1			;1 JOB KILLED !!!
	$QACK	(<1 Job Canceled>,,,.MSCOD(M))
	CAILE	S1,1			;MORE THE 1 JOB !!!
	$QACK	(<^D/S1/ Jobs 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,<
	$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

;  Add the node to the data base, purging any existing entry

	MOVE	S1,P1			;Get the node name
	PUSHJ	P,N$NNET##		;Add the node
	MOVE	P2,S2			;Remember the entry

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

DEFI.1:	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
	MOVEI	S1,DEFD60		;Try for DN60 type node
	CAXN	S2,DF.SNA		;Is it SNA workstation
	MOVEI	S1,DEFSNA		;Yes, set for that
	$CALL	(S1)			;Go do right kind of initialization

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

DEFBD1:	$QACK(< Define for node ^N/P1/ ignored >,<^I/0(S1)/>,,.MSCOD(M))
	$RETT
DEFD60:					; Here for DN60 type initialization
	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
	$RET
DEFSNA:					; Here for SNA type initialization
	MOVEI	S1,1			; Get a 1
	STORE	S1,NETSTS(P2),NETSNA	; Lite the SNA node bit
	LOAD	S1,DEF.GW(P3)		; Get the Gateway Name
	STORE	S1,NETGWY(P2)		; Store in Node database
	HRLI	S1,DEF.AN(P3)		; Get start of access name
	HRRI	S1,NETACC(P2)		;  and destination
	BLT	S1,NETACC+2(P2)		; Copy to Node database
	MOVEI	S1,NABSIZ		; Get size of Node Attribute Block
	PUSHJ	P,M%GMEM		; Go get the memory
	JUMPF	[MOVEI S1,[ITEXT(<No memory to create Node Attribute Block>)]
		 JRST  DEFBD1]		; Fail
	STORE	S1,NETNAB(P2),NA.LEN	; Save length
	STORE	S2,NETNAB(P2),NA.ADR	;  and address
	PUSHJ	P,L%CLST		; Create a linked list for objects
	MOVEM	S1,NETNOB(P2)		; Save index
	$RET
>
IFE FTDN60,<
NODN60:	$QACK	(< 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
	SETZ	S2,			;[31]NO NAME 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:	$QWTO(<No Operator Console for IBM Remote ^N/.MSCOD(M)/>,,,<$WTFLG(WT.SJI)>)
	MOVEI	S1,G$MSG		;Get the obj. blk. address for coverage
					;  Not actually used in SNDOPR but
					;  this prevents ILM
	PJRST	SNDOPR			;RETURN THE MSG TO ORION AND RETURN
>
IFE FTDN60,<JRST NODN60 >		;SHOULD NOT HAPPEN
;**;[50]After routine A$DN60 add routines A$ONEW, DELOLD, CMPBLK and
;**;[50]A$NEXT  PMM  6/3/90
	SUBTTL	A$ONEW - Routine to Process the NEW ALIAS Message

;[50]A$ONEW processes the NEW ALIAS Message from ORION. 
;[50]
;[50]Call is:      M/The NEW ALIAS message address
;[50]Returns true: Always

A$ONEW::SKIPE	S2,.OHDRS+ARG.DA(M)	;[50]Get the SIXBIT alias 
	$CALL	DELOLD			;[50]Not null, delete alias from 
					;[50] object queue and routing table

	SKIPN	S2,.OHDRS+ARG.HD+.AKASZ(M)  ;[50]Get object block header
	$RETT				;[50]Return if null
	MOVEI	S1,.OHDRS+ARG.DA+.AKASZ(M)  ;[50]Get address of object block
	$CALL	ADDNEW			;[50]Add its new alias to object 
					;[50] queue and routing table
	$RETT				;[50]Return to the caller
	SUBTTL	DELOLD - Delete An Alias Name

;[50]DELOLD searches the object queue and routing for the alias name.
;[50]If the alias name is found, it is deleted.
;[50]Call is:	    S2/SIXBIT alias name to be deleted from object queue and 
;[50]		    routing table
;[50]Returns true: Always

DELOLD:	$SAVE	<T1,T2,T3,T4,P1>	;[50]Save these ACs
	MOVE	P1,S2			;[50]Preserve the alias name

;[50]First Search object queue for alias name

	LOAD	T1,HDROBJ##+.QHLNK,QH.PTF  ;[50]Get first entry 
	SKIPA				;[50]Skip the first time through

DELO.1:	LOAD	T1,.QELNK(T1),QE.PTN	;[50]Get the first entry address
	JUMPE	T1,DELO.2		;[50]If no more entries, 
					;[50]search routing table
	CAME	P1,OBJALI(T1)		;[50]Do alias names match?
	JRST	DELO.1			;[50]No, try next entry
	SETZM	OBJALI(T1)		;[50]Delete alias name

;[50]Search Routing Table for alias name

DELO.2:	MOVE 	S1,RTEQUE		;[50]Get Route Queue ID
	$CALL	L%FIRST			;[50]Get first entry
	JRST	DELO.4			;[50]Process first entry, if any

DELO.3:	MOVE	S1,RTEQUE		;[50]Get Route Queue ID
	$CALL	L%NEXT			;[50]Get next entry
DELO.4:	JUMPF	.RETT			;[50]Return if no more entries
	MOVE	T1,S2			;[50]Save entry address
	CAMN	P1,OBJ.AK(T1)		;[50]Do alias names match?
	SETZM	OBJ.AK(T1)		;[50]Yes, delete entry's alias name
	CAMN	P1,OBJ.AK+RTEOB2(T1)	;[50]Check dest object block's alias
	SETZM	OBJ.AK+RTEOB2(T1)	;[50]They match, delete its alias
	JRST	DELO.3			;[50]Process next entry
	SUBTTL	ADDNEW - Update An Alias Name

;[50]ADDNEW searches the object queue and the routing table for
;[50]the printer object block.  If the object is found, its old alias is
;[50]replaced with the new alias.
;[50]
;[50]Call is:	    S1/Address of printer object block with new alias
;[50]Returns true: Always

ADDNEW:	$SAVE	<P1>			;[50]Save this AC
	MOVE	P1,S1			;[50]Save object block address 
	SKIPE	S2,OBJ.QN(P1)		;[50]Get header of queue name
	MOVEI	S2,OBJ.QN(P1)		;[50]Remote printer
	$CALL	A$FOBJ			;[50]Is object block in object queue?
	JUMPF	ADDN.1			;[50]No, search routing table
	MOVE	S2,OBJ.AK(P1)		;[50]Get new alias
	MOVEM	S2,OBJALI(S1)		;[50]Put in object queue entry

;[50]Search routing table for printer object block

ADDN.1:	MOVE	S1,RTEQUE		;[50]Get Route Queue ID
	$CALL	L%FIRST			;[50]Get first entry
	JRST	ADDN.3			;[50]Process the first entry

ADDN.2:	MOVE	S1,RTEQUE		;[50]Get Route Queue ID
	$CALL	L%NEXT			;[50]Get next entry
ADDN.3:	$RETIF				;[50]Return if no more entries
	MOVE	T1,S2			;[50]Save entry address
	MOVE	S1,P1			;[50]Get model object block
	MOVEI	S2,RTEOB1(T1)		;[50]Get source object block
	$CALL	CMPBLK			;[50]Do printer specifications match?
	JUMPF	ADDN.4			;[50]No, search for destination block
	MOVE	S1,OBJ.AK(P1)		;[50]Get model object alias name
	MOVEM	S1,RTEOB1+OBJ.AK(T1)	;[50]Make it source alias name

ADDN.4:	MOVE	S1,P1			;[50]Get model object block
	MOVEI	S2,RTEOB2(T1)		;[50]Get dest object block
	$CALL	CMPBLK			;[50]Do printer specifications match?
	JUMPF	ADDN.2			;[50]No, test next routing table entry
	MOVE	S1,OBJ.AK(P1)		;[50]Get model object alias name
	MOVEM	S1,RTEOB2+OBJ.AK(T1)	;[50]Make it source alias name
	JRST	ADDN.2			;[50]Test next routing table entry
	SUBTTL	CMPBLK - Compare Two Object blocks

;[50]Routine CMPBLK compares two object blocks .
;[50]
;[50]Call is:	    S1/Address of first object block
;[50]		    S2/Address of second object block
;[50]Returns True: Signifies that object blocks match
;[50]Return False: Signifies that object blocks differ

CMPBLK:	$SAVE	<P1,P2>			;[50]Save these ACs
	MOVE	P1,S1			;[50]Preserve address of object block
	MOVE	P2,S2			;[50]Preserve address of object block
	MOVE	S1,OBJ.TY(P1)		;[50]Get object type
	CAME	S1,OBJ.TY(P2)		;[50]Do object types match?
	$RETF				;[50]No return false
	MOVE	S1,OBJ.UN(P1)		;[50]Get unit type
	CAME	S1,OBJ.UN(P2)		;[50]Do unit types match?
	$RETF				;[50]No return false

	MOVE	S1,OBJ.ND(P1)		;[50]Get object's node name/number
	CAME	S1,OBJ.ND(P2)		;[50]Does node name/number match?
	$RETF				;[50]No, return

	MOVEI	S1,OBJ.QN(P1)		;[50]Get object's name block address
	MOVEI	S2,OBJ.QN(P2)		;[50]Get other's name block address

	$CALL	CHRNME			;[50]Do the names match?
	$RET				;[50]Preserve the T/F Indicator
	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
	MOVE	S1,OBJ.TY(S1)		;[31] PICK UP THE OBJECT TYPE
	$CALL	CHLPTY			;[31] IS IT A REMOTE LPT?
	SETZ	S2,			;[31] ASSUME THERE IS NO NAME BLOCK
	SKIPF				;[31] SKIP IF THERE IS NOT ONE
	MOVEI	S2,OBJ.SZ(P1)		;[31] PICK UP THE NAME BLOCK
	MOVE	S1,P1			;[31] PICK UP THE OBJECT BLOCK ADDRESS
	PUSHJ	P,A$FOBJ		;[NXT] FIND THE OBJECT BLOCK
	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] DO THE OBJECTS MATCH?
	JRST	NEXT.3			;[31] NO, CHECK FOR A LPT OBJECT
	PUSHJ	P,Q$CDEP##		;[NXT] MAKE SURE NO DEPENDIENCIES
	JUMPF	NEXT.5			;[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
	$QACK	(<NEXT request #^D/S1/ scheduled>,,OBJTYP(P1),.MSCOD(M))
	$RETT				;[NXT] RETURN

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

NEXT.3:	LOAD	S2,OBJTYP(P1),AR.TYP	;[31] PICK UP THE OBJECT'S OBJECT TYPE
	CAIE	S2,.OTLPT		;[31] IS IT A LPT OBJECT?
	JRST	NEXT.4			;[31] NO, INDICATE ILLEGAL DEVICE
	TXNE	S1,.UNLPT		;[31] UNKNOWN LPT TYPE QE?
	JRST	NEXT.5			;[31] YES, INDICATE NOT SCHEDULABLE
NEXT.4:	$QACK	(<Illegal device specified for NEXT request #^D/.QERID(AP)/>,,,.MSCOD(M))
	$RETT				;[NXT] RETURN

NEXT.5:	$QACK	(<NEXT request #^D/.QERID(AP)/ is not schedulable>,,,.MSCOD(M))
	$RETT				;[NXT] RETURN
	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$FOBJ			;FIND AN OBJECT
	INTERN	A$CPOB			;COPY OVER AN OBJECT BLOCK
	INTERN	A$CNAM			;[30]COPY OVER A LPT NAME
	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
	INTERN	A$NPID			;[35]PICK UP NEBULA'S PID
	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
	HRRZS	S1			;[31]ISOLATE THE OBJECT TYPE CODE
	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$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,OBSSTP		;Get the stopped 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$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$CNAM - COPY OVER A LPT NAME

;**;[30]A$CNAM IS PART OF THIS EDIT
;A$CNAM is called to copy a LPT name from one location to another
;
;Call is: S1/Source LPT name block
;         S2/Destination LPT name block

A$CNAM:	MOVSS	S1			;SOURCE,,0
	HRR	S1,S2			;SOURCE,,DESTINATION
	ADDI	S2,LPTNLN		;[31]ADD IN THE LENGTH OF THE BLOCK
	BLT	S1,-1(S2)		;[31]COPY IT OVER
	$RET				;RETURN TO THE CALLER
	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
	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,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,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
	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,A$WHEEL		;MAKE SURE MSG HAS PRIVS
	JUMPF	E$SNY##			;NO,,TOUGH BREAKEEE
	MOVEI	S1,STU.RB(M)		;GET THE OBJECT BLOCK ADDRESS
	$CALL	.SAVE1		        ;[31]SAVE THIS AC
	SETZ	S2,			;[31]ASSUME NO NAME BLOCK
	MOVE	P1,OBJ.TY(S1)		;[31]PICK UP THE OBJECT TYPE WORD
	TXNE	P1,.DQLPT!.LALPT	;[31]IS THIS A REMOTE LPT?
	MOVEI	S2,STU.RB+OBJ.SZ(M)	;[31]YES, PICK UP THE NAME BLOCK ADR
	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	;YES,,GET 'STOPPED' STATUS
		 ANDCAM S2,OBJSCH(S1)	;CLEAR IT
		 PJRST  A$OBST ]	;GO UPDATE THE STATUS
	STORE	P1,OBJSTS(S1)		;NO,,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	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),AR.TYP ;[31]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/ ADDRESS TO AN OBJECT BLOCK
;	S2/ ADDRESS OF REMOTE LPT NAME BLOCK OR 0
;T RET:	S1/ ADDRESS TO AN OBJ QUEUE ENTRY

GETOBJ:	$SAVE	<P1,P2,P3>		;[30]SAVE THESE AC
	MOVE	P1,S1			;SAVE THE ARGUMENT
	MOVE	P3,S2			;[30]SAVE NAME BLOCK ADDRESS
	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
	MOVE	S2,P3			;[30]PICK UP NAME BLOCK ADDRESS
	PUSHJ	P,A$FOBJ		;FIND THE OBJECT QUEUE ENTRY
	JUMPT	.POPJ			;[30]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

	$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,OBJ.TY(P1)		;[30]PICK UP LPT TYPE WORD
	$CALL	CHLPTY			;[30]CHECK FOR A REMOTE PRINTER
	JUMPF	GETO.0			;[30]No, SKIP THE FOLLOWING 
	MOVEI	S1,OBJ.SZ(P1)		;[30]Yes, ADDRESS OF THE NAME BLOCK
	MOVEI	S2,OBJNAM(AP)		;[30]WHERE TO MOVE NAME BLOCK TO
	$CALL	A$CNAM			;[30]COPY OVER THE NAME BLOCK
GETO.0:	LOAD	S1,OBJTYP(AP),AR.TYP	;[31]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
	MOVX	S2,OBSIBM		;Get the IBM object bit
	LOAD	S1,NETSTS(P2),NETIBM	;Get the IBM node bit
	SKIPE	S1			;Is this an IBM node
	IORM	S2,OBJSCH(AP)		;Yes, lite the IBM object bit
	JUMPE	S1,GETO.A		;Continue if an IBM object
	MOVX	S2,OBSSNA		;GET SNA BIT
	LOAD	S1,NETSTS(P2),NETSNA	;IS THIS SNA WORKSTATION
	JUMPN	S1,[MOVE  S1,OBJTYP(AP)	;YES, GET OBJECT TYPE
		    CAIE  S1,.OTBAT	;IS IT BATCH
		    IORM  S2,OBJSCH(AP)	;NO,,LITE THE SNA BIT
		    JRST  .+1]		;CONTINUE ON

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

GETO.A:	MOVSI	S1,-NOBJS		;AOBJN ptr to OBJTAB
	LOAD	S2,OBJTYP(AP),RHMASK	;[30]AND THE OBJECT TYPE
	CAME	S2,OBJTAB(S1)		;FIND THE OBJECT
	AOBJN	S1,.-1			;THIS MUST WORK SINCE A$OB2Q DID

	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
	LOAD	P1,OBJTYP(AP),RHMASK	;[30]PICK UP THE OBJECT TYPE
GETO.1:	JUMPE	E,GETO11		;[30]LINK AT END IF NONE LEFT
	LOAD	S1,OBJTYP(E),RHMASK	;[30]GET OBJECT TYPE OF NEW ONE
	CAMN	P1,S1			;[30]ARE THEY THE SAME?
	JRST	GETO.2			;[30]YES, CONTINUE ON
	LOAD	E,.QELNK(E),QE.PTN	;;[30]GET THE NEXT OBJECT QE
	JRST	GETO.1			;AND LOOP

GETO.2:	CAIE	S1,.OTLPT		;[30]IS THIS A LPT OBJECT
	JRST	GETO.9			;[30]NO, CHECK FOR THE SAME NODE

	HLLZ	P2,OBJTYP(AP)		;[30]PICK UP THE TYPE OF LPT
	ROT	P2,PRIVAL		;[30]TRANSLATE TO PRIORITY VALUE
GETO.3:	HLLZ	P3,OBJTYP(E)		;[30]PICK UP THE TYPE OF LPT
	ROT	P3,PRIVAL		;[30]TRANSLATE TO PRIORITY VALUE
	CAMGE	P2,P3			;[30]IS NEW OBJECT OF HIGHER PRIORITY?
	JRST	GETO11			;[30]YES, GO LINK IN HERE
	CAMG	P2,P3			;[30]IS NEW OBJECT OF HIGHER PRIORITY?
	JRST	GETO.4			;[30]LPT OBJECTS OF SAME PRIORITY
	LOAD	E,.QELNK(E),QE.PTN	;[30]PICK UP THE NEXT OBJECT
	JUMPE	E,GETO11		;[30]IS NO MORE, THEN LINK IN
	LOAD	P3,OBJTYP(E),RHMASK	;[30]PICK UP THIS OBJECT'S TYPE
	CAME	S1,P3			;[30]STILL A LPT OBJECT?
	JRST	GETO11			;[30]NO, GO LINK IN HERE
	JRST	GETO.3			;[30]CHECK THE TYPE OF LPT 

;THE OBJECTS ARE BOTH LPTS OF THE SAME TYPE

GETO.4:	SKIPN	P2			;[30]IS THIS A LOCAL LPT?
	JRST	GETO.9			;[30]YES, TREAT AS OTHER OBJECTS
	CAIN	P2,.CLPRI		;[30]IS THIS A CLUSTER LPT?
	JRST	GETO.9			;[30]YES, TREAT AS OTHER OBJECTS
	CAIE	P2,.DQPRI		;[30]IS THIS A DQS LPT?
	JRST	GETO.5			;[30]NO, CHECK FOR A LAT LPT

;BOTH ARE DQS LPTS. IF THE NODE NAMES ARE THE SAME, THEN CHECK ON VMS
;QUEUE NAMES

	$CALL	CMPNOD			;[30]CHECK OUT THE NODE NAMES
	JUMPF	GETO11			;[30]LINK IN IF NODE NAME HIGHEST
	MOVE	S1,OBJNOD(AP)		;[30]PICK UP NEW OBJECT'S NODE NAME
	CAME	S1,OBJNOD(E)		;[30]ARE THEY THE SAME?
	JRST	GETO11			;[30]NO, LINK IN HERE
	$CALL	CMPNAM 			;[30]SEARCH FOR SMALLEST Q.N.
	JRST	GETO11			;[30]GO LINK IN HERE

;BOTH ARE LAT LPTS. IF THE NODE NAMES ARE THE SAME, THEN CHECK IF BOTH
;ARE PORTS OR SERVICES

GETO.5:	CAIN	P2,.LAPRI		;[30]IS THIS A LAT LPT?
	JRST	GETO.6			;[30]YES, GO CHECK NODE NAME
	$QACK	(<Invalid printer type specified>,,OBJTYP(AP),.MSCOD(M))
	$RETF				;[30]INDICATE ERROR
GETO.6:	LOAD	S1,OBJNAM(AP),AR.TYP	;[30]PICK UP THE NAME TYPE
	LOAD	S2,OBJNAM(E),AR.TYP	;[30]PICK UP THE NAME TYPE	
	CAMN	S1,S2			;[30]ARE THEY THE SAME?
	JRST	GETO.7			;[30]YES, CHECK THE NODE NAMES
	CAIN	S1,.KYPOR		;[30]PORT NAME SPECIFIED?
	JRST	GETO11			;[30]YES, GO LINK IN HERE
	MOVE	S1,OBJTYP(AP)		;[30]PICK UP OBJECT TYPE

GETO6A:	LOAD	E,.QELNK(E),QE.PTN	;[30]PICK UP THE NEXT OBJECT
	JUMPE	E,GETO11		;[30]LINK IN HERE IF NO MORE QE
	CAME	S1,OBJTYP(E)		;[30]STILL SAME TYPE?
	JRST	GETO11			;[30]LINK IN HERE
	LOAD	S2,OBJNAM(E),AR.TYP	;[30]PICK UP THE NAME TYPE
	CAIE	S2,.KYSER		;[30]A SERVER NAME?
	JRST	GETO6A			;[30]NO, PICK UP THE NEXT ENTRY

GETO.7:	$CALL	CMPNOD			;[30]CHECK OUT THE NODE NAMES
	JUMPF	GETO11			;[30]LINK IN IF NODE NAME HIGHEST
	CAME	S1,OBJNOD(E)		;[30]ARE THEY THE SAME?
	JRST	GETO11			;[30]NO, LINK IN HERE

;LAT PRINTERS WITH SAME TYPE (PORT AND PORT, OR SERVICE AND SERVICE)

GETO.8:	$CALL	CMPNAM			;[30]COMPARE THE NAMES
	JRST	GETO11			;[30]GO LINK IN HERE

;A NON-LPT OBJECT OR A LOCAL OR CLUSTER LPTSPL

GETO.9:	$CALL	CMPNOD			;[30]CHECK THE NODE NAMES
	JUMPF	GETO11			;[30]IF GREATEST, LINK IN HERE
GETO10:	MOVE	S1,OBJNOD(AP)		;GET NODE OF NEW ONE
	CAME	S1,OBJNOD(E)		;SAME AS ENTRY IN LIST?
	JRST	GETO11			;[30]NO, JUST LINK IT IN
	MOVE	S1,OBJUNI(AP)		;GET THE UNIT NUMBER
	CAMG	S1,OBJUNI(E)		;SEARCH FOR A BIGGER ONE
	JRST	GETO11			;[30]GOT IT, LINK IT
	LOAD	E,.QELNK(E),QE.PTN	;GET NEXT
	JUMPE	E,GETO11		;[30]END, LINK IT IN
	MOVE	S1,OBJTYP(AP)		;GET THE OBJECT TYPE
	CAMN	S1,OBJTYP(E)		;STILL THE SAME?
	JRST	GETO10			;[30]YES, LOOP

GETO11:	PUSHJ	P,M$LINK##		;[30]LINK IN THE ENTRY
	MOVE	S1,AP			;POINT THE ANSWER TO IT
	$RETT				;AND RETURN

;**;[50]At GETO11:+2L add routine A$RHEL

A$RHEL::$SAVE	<T1>			;[50]Save this AC

;[50]First delete all alias names in object queue

	LOAD	T1,HDROBJ##+.QHLNK,QH.PTF  ;[50]Get first entry 
	SKIPA				;[50]Skip the first time through

RHEL.1:	LOAD	T1,.QELNK(T1),QE.PTN	;[50]Get the first entry address
	JUMPE	T1,RHEL.2		;[50]If no more entries, 
					;[50]Flush routing table
	SETZM 	OBJALI(T1)		;[50]Flush alias name
	JRST	RHEL.1			;[50]Get next entry

;[50]Flush all alias names in Routing Table

RHEL.2:	MOVE 	S1,RTEQUE		;[50]Get Route Queue ID
	$CALL	L%FIRST			;[50]Get first entry
	JRST	RHEL.4			;[50]Process first entry

RHEL.3:	MOVE	S1,RTEQUE		;[50]Get Route Queue ID
	$CALL	L%NEXT			;[50]Get next entry
RHEL.4:	$RETIF				;[50]Return if no more entries
	SETZM	OBJ.AK(S2)		;[50]Flush source alias name
	SETZM	OBJ.AK+RTEOB2(S2)	;[50]Flush destination alias name
	JRST	RHEL.3			;[50]Process next entry
	SUBTTL	CMPNOD - COMPARE TWO OBJECT NODES

;**;[30]CMPNOD IS A PART OF THIS EDIT
;CMPNOD is called as part of linking in a new object into the object queue.
;
;Call is:       AP/ Address of the object to be linked in
;               E/ Address of current object in object queue being looked at
;Returns true:  S1/Node name of object to be linked in
;               The object to be linked in has a node name less or equal to
;               last object compared in the object queue
;Returns false: The object has the largest node name and should be linked
;               in at the current location in the object queue

CMPNOD:	MOVE	S1,OBJNOD(AP)		;PICK UP NODE NAME OF NEW OBJECT
	CAMG	S1,OBJNOD(E)		;GREATER THAN THE CURRENT NODE NAME?
	$RETT				;NO, RETURN NOW
	LOAD	E,.QELNK(E),QE.PTN	;GET THE NEXT OJBECT 
	JUMPE	E,.RETF			;NO MORE, INDICATE LINK IN HERE
	MOVE	S1,OBJTYP(AP)		;PICK UP THE OBJECT TYPE
	CAME	S1,OBJTYP(E)		;STILL THE SAME OBJECT TYPE?
	$RETF				;NO, INDICATE LINK IN HERE
	JRST	CMPNOD			;CHECK THIS ENTRY
	SUBTTL	CMPNAM - COMPARE TWO NAMES OF LPT OBJECTS

;**;[30]CMPNAM IS A PART OF THIS EDIT
;CMPNAM is called as part of linking in a new DQS or LAT object into the
;object queue. It determines where the object is to be linked in.
;
;Call is:       AP/ Address of the object to be linked in
;               E/ Address of current object in object queue being looked at
;Returns:       The location in the object queue where the object is to be
;               linked in at.

CMPNAM:	MOVEI	S1,OBJNAM(AP)		;PICK UP NAME BLOCK ADDRESS
	MOVEI	S2,OBJNAM(E)		;PICK UP NAME BLOCK ADDRESS
	$CALL	CHRNME			;COMPARE THE NAMES
	TXNN	S1,SC%GTR		;NAME GREATER?
	$RET				;NO, GO LINK IN HERE
	LOAD	E,.QELNK(E),QE.PTN	;PICK UP THE NEXT OBJECT
	JUMPE	E,.POPJ			;LINK IN HERE IF NO MORE QE
	MOVE	S1,OBJTYP(AP)		;PICK UP THE OBJECT TYPE
	CAMN	S1,OBJTYP(E)		;STILL THE SAME TYPE?
	JRST	CMPNAM			;YES, CHECK THIS OBJECT
	$RET				;LINK IN HERE
	SUBTTL	CHKOBJ - ROUTINE TO VALIDATE OBJECT BLOCK REQUESTS.

CHKOBJ:	LOAD	S1,OBJ.TY(P1),RHMASK	;[30]GET THE OBJECT TYPE.
	LOAD	S2,NETSTS(P2),NETSNA	;IS THIS AN SNA-WORKSTATION?
	JUMPN	S2,CHKO.4		;YES, GO PROCESS IT
	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.
	LOAD	S1,OBJ.UN(P1)		;GET THE UNIT NUMBER.
	CAIGE	S1,SPLMAX		;TOO MANY UNITS?
	$RETT				;NO,,THEN RETURN TRUE.
	$QACK	(<Invalid unit number specified>,,0(P1),.MSCOD(M)) ;TELL OPR
	$RETF				;RETURN FALSE.

CHKO.1:	LOAD	S1,OBJ.UN(P1)		;GET THE UNIT NUMBER.
	CAIG	S1,INPMAX		;MORE THAN INPMAX STREAMS?
	JRST	CHKO.2			;NO
	$QACK	(<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.
	$QACK	(<Batch stream maximum exceeded>,,0(P1),.MSCOD(M)) ;TELL OPR
	SETZM	G$NBAT##		;RESET THE COUNT TO 0.
	$RETF				;RETURN.

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

CHKO.4:	CAIE	S1,.OTBAT		;IS IT BATCH OBJECT
	CAIN	S1,.OTLPT		;OR PRINTER
	JRST	CHKO.5			; YES
	CAIE	S1,.OTCDP		;OR CARD-PUNCH
	CAIN	S1,.OTRDR		;OR READER
	JRST	CHKO.5			; YES
	$QACK	(<Ignored>,<Device invalid for SNA-Workstation>,0(P1),.MSCOD(M))
	$RETF

CHKO.5:	LOAD	S1,OBJ.UN(P1)		;GET THE UNIT NUMBER.
	CAIL	S1,1
	CAILE	S1,7			;UNIT IN RANGE?
	SKIPA
	$RETT				;NO,,THEN RETURN TRUE.
	$QACK 	(<Ignored>,<Invalid unit for SNA-Workstation>,0(P1),.MSCOD(M)) ;TELL OPR
	$RETF				;RETURN FALSE.
	SUBTTL	A$FOBJ  --  Find an entry in the object queue

;CALL:	S1/ An Object Block Address
;       S2/ Address of the name block if doing remote printing processing
;	S2/ 0 if not doing remote printing processing
;
;RET:	S1/ The address of the object queue entry or false

A$FOBJ:	$SAVE	<T1,T2,T3,T4,P1>	;[30]SAVE THESE AC
	MOVE	P1,S2			;[30]SAVE THE POSSIBLE NAME ADDRESS
	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

	SKIPG	P1			;[30]A REMOTE PRINTER BLOCK?
	JRST	FOBJ.2			;[30]NO, SO HAVE THE OBJECT QE
	MOVEI	S1,0(P1)		;[30]PICK UP NAME BLOCK ADDRESS
	MOVEI	S2,OBJNAM(T4)		;[30]PICK UP NAME BLOCK ADDRESS
	$CALL	CHRNME			;[30]COMPARE THE NAMES
	JUMPF	FOBJ.1			;[30]IF THE SAME, CHECK NEXT OBJECT
FOBJ.2:	MOVE	S1,T4			;[30]GET THE OBJECT QE ADDRESS
	$RETT				;AND RETURN
	SUBTTL	CHRNME  --  Compare two names

;**;[30]Routine CHRNME is a part of this edit.
;CHRNME is called to compare DQS VMS queue names, LAT PORT names, LAT SERVICE
;names, or LAT SERVER names.
;
;Call is:       S1/Address of name block to compare
;               S2/Address of name block to compare
;Returns true:  The names are the same and of the same type
;Returns false: The names are different or not of the same type
;In both cases: S1/Flags from the compare

CHRNME:	$SAVE	<P1,P2>			;SAVE THESE AC
	DMOVE	P1,S1			;SAVE THE ADDRESSES
	LOAD	S1,ARG.HD(P1),AR.TYP	;PICK UP THE NAME TYPE
	LOAD	S2,ARG.HD(P2),AR.TYP	;PICK UP THE NAME TYPE
	CAME	S1,S2			;ARE THEY THE SAME?
	$RETF				;NO, INDICATE TO THE CALLER

	HRROI	S1,ARG.DA(P1)		;POINT TO THE NAME
	HRROI	S2,ARG.DA(P2)		;POINT TO THE NAME
	$CALL	S%SCMP			;COMPARE THE NAMES
	TXNE	S1,SC%LSS!SC%SUB!SC%GTR	;ARE THEY THE SAME?
	$RETF				;NO, INDICATE TO THE CALLER
	$RETT				;YES, INDICATE TO THE CALLER
	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	CHLPTY - CHECK FOR A REMOTE PRINTER TYPE

;**;[30]CHKLPTY IS A PART OF THIS EDIT
;CHLPTY is called to determine if an object is a remote printer object
;
;Call is:       S1/OBJECT type word
;Returns true:  The object is a remote printer
;Returns false: The object is not a remote printer
;(Note: S1 is preserved)

CHLPTY:	TXNN	S1,.DQLPT		;IS THIS A DQS PRINTER?
	TXNE	S1,.LALPT		;NO, IS IT A LAT PRINTER?
	$RETT				;INDICATE OBJECT IS A REMOTE PRINTER
	$RETF				;INDICATE OBJECT IS NOT A REM PRINTER
;**;[44]At CHLPTY:+4L add routine CHVLPT  JCR  9/26/89
	SUBTTL	CHVLPT - Check for a Valid Remote Printer Node Name

;[44]CHKLOC is called to determine if an object descriptor refers to a remote
;[44]printer object. If it does, then a check is made to determine if the 
;[44]node specified in the descriptor is the same as the local node. If this
;[44]is the case, then an error message is sent to ORION.
;[44]
;[44]Call is:       P1/Address of the object descriptor
;[44]Returns true:  The object descriptor does not refer to a remote printer
;[44]               object or it does but the node specified is not the
;[44]               local node
;[44]Returns false: The object descriptor refers to a remote printer object
;[44]               that specifies the local node

CHVLPT:	MOVE	S1,OBJ.TY(P1)		;[44]Pick up the object type
	TXNN	S1,.CLLPT!.DQLPT!.LALPT	;[44]Is it a remote printer?
	$RETT				;[44]No, return success
	MOVE	S1,OBJ.ND(P1)		;[44]Pick up the node name
	CAME	S1,G$LNAM##		;[44]Same as the local node name?
	$RETT				;[44]No, return success
	$QACK	(Illegal to specify local node name,,OBJ.TY(P1),.MSCOD(M));[44]
	$RETF				;[44]Indicate illegal specification 
	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
;**;[46]At GENR.3:+2L replace 2 lines with 3 lines  JCR  1/31/90
	MOVSS	S1			;[46]Source
	HRRI	S1,.RDBOW(P1)		;[46]Source,,Destination
	BLT	S1,.RDBOW+EQNMSZ-1(P1)	;[46]Copy to Request Descriptor Block
	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
;**;[50]At ORANGE:+9L replace 1 line with 49 lines  PMM  6/3/90
	HRRZ	S2,ORAN.C		;[50]Pick up the object type
	CAIE	S2,.OTLPT		;[50]Is it a LPT?
	JRST	ORAN.7			;[50]No, so skip alias processing
	SETZM	ORAN.G			;[50]Assume there are no aliases
ORAN.1:	LOAD	T2,-1(S1),AR.LEN	;[50]Get length of this argument
	SKIPN	T2			;[50]Is this really a length?
	JRST	ORAN.2			;[50]No, skip alias processing
	MOVE	T1,S1			;[50]Get address of argument data
	SOS	T1			;[50]Get address of argument header
	ADD	T1,T2			;[50]Get address of next argument
	LOAD	T2,ARG.HD(T1),AR.TYP	;[50]Get type of next argument
	CAIE	T2,.AKANM		;[50]Is it an alias block?
	JRST	ORAN.1			;[50]No, check for next argument
	MOVEM	T1,ORAN.G		;[50]Save alias block address
;Initialize object block
	SETZM	ORAN.F			;[50]Get address of object block
	HRLI	T1,ORAN.F		;[50]Get source address
	HRRI	T1,ORAN.F+1		;[50]Get second word
	BLT	T1,ORAN.F+AKBSIZ-1	;[50]Clear the entire object block

ORAN.2:	MOVEI	T1,.OROBJ		;[50]Get object type header
	HRLI	T1,OBJ.SZ+1		;[50]Get object block size
	MOVEM	T1,ORAN.F		;[50]Save as object block header

ORAN.4:	SKIPE	ORAN.G			;[50]Skip if no aliases	
	AOS	ORAN.G			;[50]Increment alias pointer
	MOVEI	S1,ORAN.F		;[50]Get address of return block
	MOVE	S2,ORAN.C		;[50]Get object type
	MOVEM	S2,OBJTPE(S1)		;[50]Store it
	MOVE	S2,ORAN.D		;[50]Get node
	MOVEM	S2,OBJNOD(S1)		;[50]Store it
	MOVE	S2,ORAN.A		;[50]Get next unit number
	MOVEM	S2,OBJUNI(S1)		;[50]Store it
	SETZM	OBJAKA(S1)		;[50]Assume no aliases
	SKIPG	ORAN.G			;[50]Are there any aliases?
	JRST	ORAN.5			;[50]No
	MOVE	S2,ORAN.G		;[50]Get address of alias name
	MOVE	T1,(S2)			;[50]Get alias name
	SKIPN	T1			;[50]Is this really an alias?
	JRST	ORAN.5			;[50]No, skip this processing
	MOVEM	T1,OBJAKA(S1)		;[50]Store it 
	HRLI	T1,AKBSIZ		;[50]Get object block size
	MOVEM	T1,(S1)			;[50]Store in object block
ORAN.5:	AOS	S1			;[50]Point at unit type
ORAN.6:	PUSHJ	P,@ORAN.E		;[50]Call the caller
	AOS	S1,ORAN.A		;[50]Increment for next one
	CAMG	S1,ORAN.B		;[50]All done?
	JRST	ORAN.4			;[50]No, loop
	$RETT				;[50]Yes, return

ORAN.7:	MOVEI	S1,ORAN.F		;[50]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?
;**;[50]At ORAN.7:+10L change 1 line  PMM  6/3/90
	JRST	ORAN.7			;[50]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
;**;[50]At ORAN.F:+0L replace one line with two lines  PMM  6/3/90
ORAN.F:	BLOCK	AKBSIZ			;[50]Object block to return to user
ORAN.G:	BLOCK	1			;[50]Address of current alias
	END