Google
 

Trailing-Edge - PDP-10 Archives - BB-L014Z-BM_1990 - galsrc/opr.mac
There are 37 other files named opr.mac in the archive. Click here to see a list.
	TITLE	OPR -- Parser Routines for ORION
	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	GLXMAC

	.directive flblst
	PROLOG	(OPR)
	SEARCH	ORNMAC
	SUBTTL	Edit vector and Version numbers

OPRVEC:	BLDVEC	(GLXMAC,GMC,L)
	BLDVEC	(ORNMAC,OMC,L)
	BLDVEC	(OPR,OPR,L)
	BLDVEC	(OPRPAR,PAR)
	BLDVEC	(OPRCMD,CMD)
	DEFINE X(A,B,C,D),<BLDVEC (C,A)> ;Want application versions
	TABAPL				;  added to vector

;Version numbers

	OPRMAN==:6012			;Maintenance edit number
	OPRDEV==:6010			;Development edit number
	VERSIN (OPR)			;Generate edit number

	OPRWHO==0
	OPRVER==6
	OPRMIN==0

	EXTERNAL CMDEDT,PAREDT
;**;[6012]At EXTERNAL CMDEDT:+1L add 2 lines  PMM  6/3/90
	MAXAKA==500			;[6012]Maximum number of alias names
	EXTERNAL AKATBL,AKASIX,AKAASC	;[6012]Alias keyword table addresses
	OPRVRS==<VRSN.(OPR)>+GMCEDT+OMCEDT+CMDEDT+PAREDT

	.JBVER==137

	LOC	.JBVER
	EXP	OPRVRS
	RELOC

ENTVEC:	JRST	OPR			;MAIN ENTRY POINT
	JRST	OPRRMT			;REMOTE	OPR ENTRY
	EXP	OPRVRS			;VERSION
	Subttl	Table of Contents

;		     Table of Contents for OPR
;
;				  Section		      Page
;
;
;    1. Edit vector and Version numbers  . . . . . . . . . . .   2
;    2. Revision history . . . . . . . . . . . . . . . . . . .   4
;    3. Special accumulator assignments  . . . . . . . . . . .   5
;    4. OPR impure data  . . . . . . . . . . . . . . . . . . .   6
;    5. Interrupt vector definitions . . . . . . . . . . . . .   7
;    6. Table building data base . . . . . . . . . . . . . . .   9
;    7. OPR Initialization
;        7.1    Main Entry . . . . . . . . . . . . . . . . . .  10
;        7.2    TBLINI - Initialize command tables . . . . . .  11
;    8. CCLOOK CCL entry file lookup (TOPS10)  . . . . . . . .  12
;    9. MAIN Main processing loop  . . . . . . . . . . . . . .  13
;   10. ROUTIM Routine called by timer . . . . . . . . . . . .  14
;   11. SETIME Routine to set timer intervals  . . . . . . . .  15
;   12. TAKEND Process end of TAKE command . . . . . . . . . .  16
;   13. DSPCMD Display TAKE commands if desired  . . . . . . .  17
;   14. PRCMSG Process IPCF messages . . . . . . . . . . . . .  18
;   15. ACKOPR Display a GALAXY text message . . . . . . . . .  19
;   16. DSPOPD Process DISPLAY message from ORION  . . . . . .  20
;   17. SHWDSP Process DISPLAY message from ORION  . . . . . .  21
;   18. TABSET Setup tables for parser call  . . . . . . . . .  22
;   19. Software interrupt system routines . . . . . . . . . .  23
;   20. Command and application action routines  . . . . . . .  24
;   21. ENTER and RETURN command tables  . . . . . . . . . . .  25
;   22. Control-Z and EXIT command tables and action routines   26
;   23. TAKOPR Process a take command  . . . . . . . . . . . .  27
;   24. WAIOPR Process a wait command  . . . . . . . . . . . .  28
;   25. SETRTN and SETTRM Process SET TERMINAL command . . . .  29
;   26. ESCAPE Sequence Table for Operator Terminals . . . . .  30
;   27. SHWDAY Process SHOW DAYTIME command  . . . . . . . . .  33
;   28. OPRRMT Entry and initialization for REMOTE OPR . . . .  34
;   29. WAITCN Wait for output link connect  . . . . . . . . .  35
;   30. REMSET Setup OPR links . . . . . . . . . . . . . . . .  36
;   31. SETOUT Setup output of data  . . . . . . . . . . . . .  37
;   32. INPINT Input over link interrupt . . . . . . . . . . .  38
;   33. INPDAT Input the data from link  . . . . . . . . . . .  39
;   34. CONNEC Process connect message . . . . . . . . . . . .  40
;   35. TXTLIN Check if multiple line input allowed  . . . . .  41
;   36. SETFAL Send a setup failure for OPR errors . . . . . .  42
;   37. PUSHRT Process the PUSH command (TOPS20) . . . . . . .  43
;   38. TERMFK Process fork termination interrupt  . . . . . .  44
;   39. OPRSON OPR signon to ORION . . . . . . . . . . . . . .  45
;   40. OPRRST OPR reply to setup  . . . . . . . . . . . . . .  46
;   41. SETREP Setup reply message . . . . . . . . . . . . . .  47
;   42. SETMES Setup message reply . . . . . . . . . . . . . .  48
;   43. TABCHK Routine to check out syntax tables  . . . . . .  49
;   44. GETLOC Get OPR location  . . . . . . . . . . . . . . .  50
SUBTTL	Revision history

COMMENT \

145	4.2.1528	9-Nov-82
	Fix copyright.

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

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

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

161	5.1006		13-Jan-83
	MACRO has a problem with resolving polish expressions in certain
orders.  Move definition of ENTVEC until after definition of OPRVRS to
resolve conflict.

162	5.1007		14-Jan-83
	On a PUSH, get the EXEC from "DEFAULT-EXEC:".

163	5.1009		1-Feb-83
	Only set up the command tables once, in TBLINI.

164	5.1041		3-Oct-83
	Really only set up command tables once.  Remove TBLINF flag out of the
area that gets reinitialized on an EXIT/CONTINUE combination.

165	5.1046		21-Oct-83
	Change version from 4 to 5.

166	5.1053		7-Nov-83
	Add application edit numbers to edit vector.  Also requires a
change to NCPTAB.

167	5.1184		3-Dec-84
	Change the definition of the macro "X" to include four arguments -
used in conjunction with LCPTAB support.

170	5.1214		7-May-85	QAR 838246
	In routine OPR, clear TAKFLG in case we are restarting due to a TAKE
command failure.

*****  Release 5.0 -- begin maintenance edits  *****

175	Increment maintenance edit level for GALAXY 5.

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

6000	6.1015		13-Oct-87
	Change the local node name holder HOSTNM to global G$NODE in support
of ensuring that the node specified in remote printing commands is not the
local node. (The name must be changed since it is used in OPRCMD and OPRCMD
is also linked with ORION.)

6001	6.1034		23-Oct-87
	Add a new prompt for SEMI-OPR>.  Create a new routine, OPRCHK, to
see whether the user is SEMI-OPR or OPR.  This routine doesn't care if the
user has no privileges because ORION will catch this case.  OPRCHK will
set OPRTYP based on the OPR.  OPRTYP=1 means OPR. OPRTYP=-1 means SEMI-OPR.
Initialize the command paser and command tables based on OPRTYP.

6002	6.1113		2-Dec-87
	In routine TBLINI:, don't add application table if it is a SEMI-OPR.

6003	6.1134		8-Dec-87
	Change OPR's major version number from 5 to 6.

6004	6.1138		13-Dec-87
	Fix several bugs in the display of messages that originated remotely.

6005	6.1183		16-Feb-88
	Include the Cluster GALAXY option value in the HELLO message to ORION.

6006	6.1196		27-Feb-88
	Include block type .ORRFG to be a valid block type for .OMDSP and 
.OMACS messages.

6007	6.1212		3-Mar-88
	Include the complete OPR version number in the HELLO message to ORION.

6010	6.1225		8-Mar-88
	Update copyright notice.

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

6011	6.1292		16-Dec-89
	Change routine ACKOPR to handle MT.TXT with more than one text
block.

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

\   ;End of Revision History
SUBTTL	Special accumulator assignments

	FLAG==14			;FLAG AC FOR OPR
	  O.ACKP==1B0			;ACK MESSAGE BEING PROCESSED
	  O.LAST==1B1			;LAST LINE OF MESSAGE
	  O.ERRP==1B2			;ERROR PROCESSING OF MESSAGE
	  O.DSPM==1B3			;DISPLAY MESSAGE SENT
	  O.CCL==1B4			;CCL ENTRY
	MD==15				;MESSAGE FOR DISPLAY ADDRESS
	M==16

TOPS10 <
    CNFTBL==11				;CONFIGURATION TABLE
	DEVOPR==13			;NAME OF CURRENT OPERATOR
> ;End TOPS10


	XP	PDLEN,^D200		;SIZE OF OUR STACK
SUBTTL	OPR impure data

	$DATA	PDL,PDLEN

OPRDAT:	$DATA	DEFTAB,1			;ADDRESS OF TABLES BEING USED
	$DATA	HDRTAB,1			;MAIN TABLE SETTING
	$DATA	HDRPMT,10			;PROMPT FOR APPLICATION 

	$DATA	CMDDAT,1			;COMND DATA COLLECTED IN PARSE
	$DATA	ENTCOD,1			;CODE OF THE TABLE TYPE
	$DATA	TABCOD,1			;CODE FOR APPLICATION TYPE
	$DATA	MYNODE,1			;NODE OF THIS OPR
	$DATA	SAVACS,^D20			;Where save regs during ROUTIM
	$DATA	REMMSG,1			;[6004]REMOTE MESSAGE FLAG

;STORAGE FOR PARSER TO EVENT PROCESSOR COMMUNICATION

	$DATA	PARBLK,PAR.SZ			;SPACE FOR PARSER CALL ARGUMENTS
;STORAGE FOR DISPLAY PROCESSING

	$DATA	DSPPTR,1			;DESTINATION DISPLAY POINTER
	$DATA	SRCPTR,1			;SOURCE POINTER
	$DATA	DSPFLG,1			;DISPLAY BLOCK FLAGS	
	$DATA	TEMOUT,^D20			;LEAVE ROOM FOR A LINE
	$DATA	REMOPR,1			;REMOTE OPERATOR IN USE FLAG
	$DATA	REMACC,1			;REMOTE ACCESS (NSP ON -20)
	$DATA	TEMPTR,1			;TEMPORARY POINTER FOR TEXT
	$GDATA	G$NODE,1			;[6000]HOST NAME FOR OPR
	$DATA	ERRCOD,1			;ERROR CODE FOR OPR ERRORS
	$DATA	INTDSP,1			;INTERRUPT DISPLAY FLAG
	$DATA	MSGCNT,1			;COUNT OF IPCF MESSAGES ON WAKEUP
	$DATA	TAKFLG,1			;TAKE COMMAND FLAG
	$DATA	ARG1,1			;ARGUMENT FOR ERROR PROCESSING

TOPS20	<
	$DATA	DCNDAT,5			;BLOCK FOR TASK CONNECT NAME
	$DATA	INPJFN,1			;LINK INPUT JFN
	$DATA	OUTJFN,1			;LINK OUTPUT JFN
	$DATA	BUFADR,1			;BUFFER ADDRESS FOR OUTPUT
	$DATA	OUTPTR,1			;POINTER FOR OUTPUT TO LINK
	$DATA	OUTCNT,1			;COUNT FOR OUTPUT TO LINK
	$DATA	INPDON,1			;INPUT DONE ON LINK
	$DATA	OUTCON,1			;OUTPUT CONNECT LINK
	$DATA	OUTACT,1			;OUTPUT LINK ACTIVE
	$DATA	NETBUF,1			;ADDRESS OF NETWORK BUFFER
	$DATA	FRKRUN,1			;FORK RUNNING (-1 IF RUNNING)
	$DATA	FRKJFN,1			;JFN FOR EXEC
	$DATA	FRKHND,1			;HANDLE FOR FORK
	$DATA	TRPCHN,1			;TRAP CHANNELS FOR CONTL-C
	$DATA	SAVTWD,2			;SAVE TERMINAL WORD
	$DATA	SAVMOD,1			;SAVE MODE WORD
	$DATA	OPRTYP,1			;[6001]OPR TYPE

	$DATA	LEV1PC,1
	$DATA	LEV2PC,1
	$DATA	LEV3PC,1
;**;[6012]At $DATA LEV3PC:+1L add 2 lines   PMM  6/3/90
	$GDATA	G$PID				;[6012]OPR's PID
	$DATA	REMUPD				;[6012]UPDAKA remote/local flag
> ;End TOPS20

	$DATA	DATEND,0			;END OF THE DATA AREA

	DATASZ==DATEND-OPRDAT		;SIZE OF DATA AREA
SUBTTL	Interrupt vector definitions

	XP	TIMCHN,2		;CHANNEL FOR TIMER INTERRUPTS
	XP	IPCLEV,1		;IPCF INTERRUPT LEVEL (MUST BE 1)
	XP	DETLEV,1		;Detach/attach interrupt level


TOPS20	<

LEVTAB:	EXP	LEV1PC
	EXP	LEV2PC
	EXP	LEV3PC

CHNTAB:	$BUILD	^D36
	$SET(1,,<IPCLEV,,INT>)
	$SET(.ICIFT,,<IPCLEV,,TERMFK>)
	$EOB
> ;End TOPS20

TOPS10	<
INTVEC:
IPCINT:	$BUILD	.PSVIS+1
	$SET(.PSVNP,,INT)		;IPCF interrupt block
	$EOB

DETINT:	$BUILD	.PSVIS+1
	$SET	(.PSVNP,,DET)		;Detached interrupt block
	$EOB

TIMBLK:	$BUILD .TIDAT
	$SET(.TIMPC,,ROUTIM)		;Routine called by timer
	$EOB

TRMBLK:	$BUILD	3			;TRMOP block
	$SET (0,,.TOTYP)		;Type to the terminal
	$SET (1,,-1)			;Myself
	$EOB

	ND	WAKSEC,^D93		;Set magical default sleep time
> ;End TOPS10
;IB FOR LOCAL OPR INITIALIZATION

SUBTTL	Initialization blocks

IPBBLK:	$BUILD	IB.SZ
	$SET(IB.PRG,,%%.MOD)		;PROGRAM NAME
	$SET(IB.OUT,,T%TTY)		;TERMINAL AS DEFAULT TEXT OUTPUT
	$SET(IB.FLG,IT.OCT,1)		;OPEN COMMAND TERMINAL
	$SET(IB.FLG,IP.STP,1)		;STOPCODES TO ORION
TOPS20<	$SET(IB.INT,,<LEVTAB,,CHNTAB>)>
TOPS10<	$SET(IB.INT,,INTVEC)>
	$SET(IB.PIB,,PIBBLK)		;ADDRESS OF PID BLOCK
	$EOB


;IB FOR REMOTE OPR INITIALIZATION

TOPS20	<
IPBRMT:	$BUILD	IB.SZ
	$SET(IB.PRG,,%%.MOD)		;PROGRAM NAME
	$SET(IB.OUT,,OUTRTN)		;DEFAULT $TEXT OUTPUT ROUTINE
	$SET(IB.FLG,IP.STP,1)		;STOPCODES TO ORION
	$SET(IB.INT,,<LEVTAB,,CHNTAB>)	;INTERRUPT SYSTEM ADDRESS
	$SET(IB.PIB,,PIBBLK)		;ADDRESS OF PID BLOCK
	$EOB
> ;End TOPS20


;IPCF PID DECLARATION BLOCK

PIBBLK:	$BUILD	PB.MNS			;SIZE OF PID BLOCK
	$SET(PB.HDR,PB.LEN,PB.MNS)	;BLOCK LENGTH
	$SET(PB.FLG,IP.PSI,1)		;CONNECT PID TO PSI
TOPS20<	$SET(PB.INT,IP.CHN,1)>		;CHANNEL FOR IPCF
TOPS10<	$SET(PB.INT,IP.CHN,<IPCINT-INTVEC>)> ;OFFSET FOR IPCF BLOCK
	$EOB
SUBTTL	Table building data base

TABNUM:	EXP	NUMAPL+1		;NUMBER OF TABLES INCLUDED

	DEFINE	X(A,B,C,D),<EXP	C	;SET UP ADDRESS OF EACH ENTRY
	EXTERNAL C			;SET UP AS EXTERNAL
	.REQUIRE C>

SEMTAB: EXP	OPRSCM##		;[6001]SEMI-OPR TABLES

SYNTAB:	EXP	OPRCMD##		;MAIN OPR TABLES
	TABAPL				;ADDRESS OF APPLICATION TABLES

TABINI:	$INIT(MANTAB)			;INIT FUNCTION FOR TABLES

MANTAB:	$KEYDSP(APLALT,<$ACTION(CMDACT)>) ;KEYWORD TABLE BLOCK

APLALT:	$STAB
TOPS10<	ORNDSP(,\"32,CTZ,CM%INV) >	;Control Z exit
	ORNDSP(ENTFDB,ENTER,ENT)	;ENTER COMMAND FDB
	ORNDSP(EXTFDB,EXIT,EXT)		;EXIT COMMAND
TOPS20<	ORNDSP(PUSFDB##,<PUSH>,PUS)>	;PUSH COMMAND
	ORNDSP(RETFDB,RETURN,RTN)	;RETURN FDB
	ORNDSP(TAKOPR,TAKE,TAK)		;TAKE FDB
	ORNDSP(WAIFDB##,WAIT,WAI)	;WAIT COMMAND
	$ETAB

OPRPMT: [ASCIZ /OPR>/]			;DEFAULT STARTING PROMPT
SEMPMT:	[ASCIZ /SEMI-OPR>/]		;[6001]PROMPT FOR SEMI-OPR

APLTAB:	$KEYDSP(KEYAP1,<$ACTION(APLACT)>) ;MAIN APPL. TABLE

	DEFINE	X(A,B,C,D),<ORNDSP(,<A>,<B>)>

KEYAP1:	$STAB				;START TABLE OF NAMES
	TABAPL				;EXPAND APPLICATION ENTRIES
	$ETAB
SUBTTL	OPR Initialization -- Main Entry

OPR:	SETZM	TAKFLG			;Clear TAKE command flag
	TDZA	FLAG,FLAG		;CLEAR THE FLAGS
	MOVX	FLAG,O.CCL		;UNLESS CCL START
	RESET				;RESET THE UNIVERSE
	MOVE	P,[IOWD PDLEN,PDL]	;SET UP STACK
	MOVX	S1,IB.SZ		;GET THE LENGTH
	MOVEI	S2,IPBBLK		;AND THE ADDRESS OF THE ARGS
	$CALL	I%INIT			;INITIALIZE THE WORLD
	MOVEI	S1,DATASZ		;GET THE SIZE OF THE DATA
	MOVEI	S2,OPRDAT		;START OF THE IMPURE DATA
	$CALL	.ZCHNK			;CLEAR THE DATA AREA
	$CALL	GETLOC			;GET OPRS LOCATION
	SETOM	HDRTAB			;INIT TO USE MAIN TABLES AND PROMPT
	MOVE	S1,[IPCLEV,,TIMCHN]	;GET LEVEL NUMBER AND TIMER CHANNEL
	MOVE	S2,IPBBLK+IB.INT	;GET INTERRUPT DATA BASE INFO
	$CALL	P$INIT##		;INIT THE PARSER
	$CALL	I%HOST			;GET HOST NAME
	MOVEM	S1,G$NODE		;[6000]SAVE HOST NAME
	$CALL	OPRCHK			;[6001]SEMI OR FULL OPR
	$CALL	TABCHK			;CHECK THE TABLES
	$CALL	OPRSON			;OPR SIGNON TO ORION
	SETOM	INTDSP			;INIT INTERRUPT DISPLAY FLAG
TOPS20	<
	HRRZI	S1,.MSIIC		;BYPASS MOUNT COUNTS
	MSTR				;DO THE FUNCTION
	ERJMP	.+1			;IGNORE THE ERROR
	MOVEI	S1,.FHSLF		;GET MY HANDLE
	MOVX	S2,1B<.ICIFT>		;INFERIOR TERMINATIONS
	AIC				;ACTIVATE THE CHANNEL
> ;End TOPS20

TOPS10 <
	MOVX	T1,.PCDAT		;Interrupt function
	MOVSI	T2,DETINT-INTVEC	;Where the vector block is
	MOVSI	T3,DETLEV		;Set detach level
	MOVX	S1,PS.FAC+T1		;Add address of arg. block to function
	PISYS.	S1,			;Enable interrupts on detach
	  JFCL				;Don't really care if it fails
> ;End of TOPS10

	$CALL	I%ION			;TURN ON INTERRUPTS
	TXZE	FLAG,O.CCL		;CCL ENTRY?
	$CALL	CCLOOK			;YES, LOOKUP ATO FILE
TOPS10<
	MOVEI	S1,[ASCIZ//]		;Get a control R
	MOVEM	S1,TRMBLK+2		;Save it
> ;End of TOPS10
	$CALL	TBLINI			;Set up command tables
	JRST	MAIN			;START PROCESSING AT MAIN
SUBTTL	OPR Initialization -- TBLINI - Initialize command tables

;  This routine links in the application tables if needed.

TBLINI:	SKIPE	TBLINF			;Have we done this before?
	$RET				;Yes, quit now

	HLRZ	S2,KEYAP1		;Get application keyword table
	JUMPE	S2,TBLIN3		;No alternatives, skip the rest
	SKIPG	OPRTYP			;[6002]Skip if SEMI-OPR?
	JRST	TBLIN3			;[6002]SEMI-OPR has no application 	
	MOVE	S1,SYNTAB		;Get address of main tables
	MOVE	S2,TAB.KY(S1)		;Get main keyword table address
	AOS	S2			;Position to FDB

TBLIN1:	LOAD	S1,.CMFNP(S2),CM%LST	;Get address
	JUMPE	S1,TBLIN2		;Finished the search
	MOVE	S2,S1			;Remember this address
	JRST	TBLIN1			;Go try again

;  S2 contains the address of the place to store the application keyword table

TBLIN2:	MOVEI	S1,APLTAB+1		;Get address of application FDB
	STORE	S1,.CMFNP(S2),CM%LST	;Save as alternate

;  Here to set the flag to not do this again.  Either have linked in table
;  or don't need to.

TBLIN3:	SETOM	TBLINF			;Don't do this again
	$RET				;Done

TBLINF:	DEC	0			;Table initialization flag
					;Initialize to zero
SUBTTL	CCLOOK	CCL entry file lookup (TOPS10)

TOPS10 <
CCLOOK:	STKVAR	<<CCLFD,.FDPPN+1>>	;GET SOME SPACE FOR AN FD
	MOVSI	T1,.FDPPN+1		;INIT THE FD HEADER
	MOVEM	T1,CCLFD
	MOVSI	T1,'SYS'		;LOAD INPUT DEVICE
	GETLIN	T2,			;LOAD TTY NAME
	MOVE	T3,[DEVOPR,,CNFTBL]	;GET THE NAME OF OPR
	GETTAB	T3,			; FROM THE MONITOR
	  JRST	LOCAL			;SHOULD NEVER HAPPEN
	CAMN	T2,T3			;ARE WE DEVOPR?
	MOVSI	T2,'OPR'		;YES--USE OPR.CMD
	MOVE	T3,T2			;COPY TTY NAME
	WHERE	T3,			;GET OUR STATION NUMBER
	  JRST	LOCAL			;DO NOT KNOW
	MOVE	T4,[SIXBIT /OPR0/]	;GET THE STATION NUMBER
	WHERE	T4,			; OF THE CENTRAL SITE
	  JRST	LOCAL			;ONLY REMOTE STATIONS
	CAMN	T3,T4			;ARE WE AT LOCAL STATION?
	JRST	LOCAL			;YES--USE OPR OR TTY
	LSHC	T3,-6			;SHIFT I OCTIT INTO T4
	LSH	T3,3			;SHIFT IN 3 ZEROS
	LSHC	T3,3			;GENERATE SIXBIT
	LSH	T3,3
	LSHC	T3,3
	ADDI	T3,202020		; ..
	TRNN	T3,570000		;TRIM OFF LEADING ZEROS
	LSH	T3,6
	TRNN	T3,570000		;LEADING ZERO
	LSH	T3,6			;YES--TRIM IT OFF
	HRLI	T3,'OPR'		;PREFIX WITH OPR
	MOVE	T4,T3			;COPY NAME OF OPR
	DEVNAM	T4,			;GET NAME OF OPR'S TTY
	  JRST	LOCAL			;SO CLOSE
	CAMN	T2,T4			;ARE WE OPRNN?
	JRST	[MOVE T2,T3		;YES, USE OPRNN NOT TTY115
		JRST LOCAL]		;AND GO FIND THE ATO FILE
	MOVE	T3,T2			;COPY "TTYXXX"
	GTNTN.	T3,			;CONVERT TO NODE AND LINE NUMBERS
	  JRST	LOCAL			;WHOOPS
	MOVEI	T4,2			;DO THIS TWICE
	ROT	T3,^D9			;GET RID OF HIGH BITS
	MOVEI	S1,3			;DO THIS THRICE
	LSH	T2,3			;MAKE SOME ROOM
	LSHC	T2,3			;BRING IN A DIGIT
	SOJG	S1,.-2			;FOR THREE DIGITS
	SOJG	T4,.-5			;FOR BOTH HALVES
	TDO	T2,[SIXBIT/000000/]	;MAKE SIXBIT OUT OF IT
LOCAL:	MOVSI	T3,'CMD'		;LOAD EXTENSION
	MOVEM	T1,.FDSTR+CCLFD		;SAVE THE STRUCTURE
	MOVEM	T2,.FDNAM+CCLFD		;SAVE THE NAME
	MOVEM	T3,.FDEXT+CCLFD		;SAVE THE EXTENTION
	SETZB	T4,.FDPPN+CCLFD		;NO PPN
	MOVEI	S1,CCLFD		;POINT TO THE FD
	SETZM	S2			;NO LOGGING FD
	$CALL	P$TAKE##		;SETUP TO TAKE FILE
	 $RETIF				;IGNORE FAILURES
	SETOM	S2			;GET EXACT FD
	$CALL	F%FD
	$TEXT	(,<[Processing ^F/(S1)/]>)
	$RETT
> ;End TOPS10

TOPS20 <
CCLOOK:	$RETT				;NO CCL ENTRY ON TOPS20
> ;End TOPS20
SUBTTL	MAIN	Main processing loop

MAIN:	$CALL	PRCMSG			;PROCESS ANY MESSAGES
TOPS20	<
	SKIPE	FRKRUN			;FORK RUNNING WITH EXEC
	JRST	MAIN.7			;YES GO TO SLEEP
	SKIPN	REMACC			;REMOTE OPR?
	JRST	MAIN.1			;NO..IGNORE REMOTE CHECKS
	SKIPE	OUTCON			;OUTPUT CONNECTED?
	$CALL	CONNEC			;CHECK OUT CONNECT
	SKIPN	INPDON			;INPUT DONE...READ THE DATA
	JRST	MAIN.7			;GO TO SLEEP
	$CALL	INPDAT			;INPUT THE DATA
	JUMPF	MAIN.7			;FAIL..GO TO SLEEP
> ;End TOPS20
MAIN.1:	$CALL	TABSET			;SETUP THE PARSER BLOCK
MAIN.2:
TOPS10<	$CALL	SETIME>			;Set up pseudo timer interrupt
	DMOVE	S1,P1			;GET THE PARSER ARGUMENTS
	$CALL	PARSER##		;CALL THE PARSER
	MOVE	P3,S2			;SAVE THE ADDRESS OF BLOCK
TOPS10<	JUMPF	[$CALL	CLTIME		;Clear timer
		JRST	MAIN.5]		;COMMAND ERROR ON PARSER
	$CALL	CLTIME			;Clear timer
> ; End of TOPS10
TOPS20<	JUMPF	MAIN.5>			;Command error on parser
	$CALL	DSPCMD			;DISPLAY COMMAND IF NEEDED
	MOVE	T1,PRT.CM(P3)		;ADDRESS OF COMMAND MESSAGE
	MOVE	T2,MYNODE		;GET MYNODE FOR MESSAGE
	MOVEM	T2,COM.SN(T1)		;SAVE IN THE MESSAGE
	SKIPE	T2,TABCOD		;WAS THERE A TABLE CODE
	MOVEM	T2,COM.TY(T1)		;SAVE AS TYPE FOR APPLICATION
MAIN.3:	MOVE	S1,T1			;MESSAGE TO SEND

;**;[6012]At MAIN.3:+1L replace 1 line with 20 lines  PMM  6/3/90

;[6012]Check to see if the message is an OPR>DEFINE ALIAS message (.OMRDA).
;[6012]If it is, it must be handled specially to avoid race conditions.

MAIN.S:	MOVE	T1,.OHDRS+ARG.SZ*2+ARG.DA(S1)	;[6012]Point at first keyword
	CAIE	T1,.KYDEF		;[6012]Is it the define keyword?
	JRST	MAIN.G			;[6012]No, process as usual
	MOVE	T1,.OHDRS+ARG.SZ*3+ARG.DA(S1)	;[6012]Point at next keyword
	CAIE	T1,.KYAKA		;[6012]Is it the alias keyword?
	JRST	MAIN.G			;[6012]No, proceed as usual
	MOVE	T1,S1			;[6012]Save page address
	$CALL	I%IOFF			;[6012]Shutoff interrupts
	MOVE	S1,T1			;[6012]Restore message address
	$CALL	I%SOPR			;[6012]Send to ORION
MAI.S1:	$CALL	C%BRCV			;[6012]Set up blocking IPCF receive
	JUMPF	MAI.S1			;[6012]Shouldn't happen
	$CALL	CHKMSG			;[6012]Process UPDAKA if .OMRDA
					;[6012]message with this OPR's PID
	JUMPF	MAI.S2			;[6012]No, process message
	$CALL	I%ION			;[6012]Yes, turn on interrupts
	$CALL	C%REL			;[6012]Release the message
	JRST	MAIN			;[6012]Go back to MAIN processing loop

MAI.S2:	$CALL	PRCDSP			;[6012]Process the message
	JRST 	MAI.S1			;[6012]Set up a block receive

MAIN.G:	$CALL	I%SOPR			;[6012]Send to ORION
	JUMPT	MAIN			;O.K. JUST  RESTART
	$TEXT	(,<Send to ORION failed>)
	$CALL	EXIT			;HALT THE PROGRAM
MAIN.4:	MOVE	S1,T1			;PUT PAGE ADDRESS IN S1
	$CALL	M%RPAG			;RETURN THE PAGE
	JRST	MAIN			;CHECK MESSAGES AND COMND
MAIN.5:	MOVE	T1,PRT.FL(P3)		;GET RETURNED FLAGS
	TXNE	T1,P.INTE		;INTERRUPT BREAK OUT
	   JRST	[AOS	INTDSP		;SET FLAG FOR DISPLAY
		JRST	MAIN]		;AND CHECK FOR MESSAGES
	TXNE	T1,P.ENDT		;END OF TAKE FILE
	   JRST	[$CALL	TAKEND		;END THE TAKE COMMAND
		 JRST	MAIN.S]		;SEND THE MESSAGE AND CONTINUE
	$CALL	CHKDSP			;CHECK TO DISPLAY
	JUMPF	MAIN.6			;NO..DON'T
	$CALL	SETOUT			;SETUP FOR OUTPUT
	$TEXT	(,<^I/CMDPMT/^T/@PRT.MS(P3)/^A>)
	SKIPA				;ALREADY SETUP
MAIN.6:	$CALL	SETOUT			;SETUP THE OUTPUT
	MOVX	S1,CM%ESC		;GET THE ESCAPE FLAG
	SKIPN	REMACC			;REMOTE OPR?? ALWAYS CR,LF
	TDNE	S1,PRT.CF(P3)		;WAS LAST CHARACTER AN ESCAPE?
	$TEXT	(,<>)			;CR,LF OUTPUT
	$TEXT	(,<? ^T/@PRT.EM(P3)/>) ;OUTPUT THE ERROR MESSAGE..NOT TAKE
	$CALL	SNDOUT			;SEND THE OUTPUT
	JRST	MAIN			;TRY AGAIN
MAIN.7:	SETZ	S1,			;CLEAR S1 FOR SLEEP
	$CALL	I%SLP			;GO TO SLEEP
	SETOM	INTDSP			;SET DISPLAY FLAG FORCE .CMINI
	JRST	MAIN			;GET DATA

;**;[6012]At MAIN.7:+3L add routine CHKMSG  PMM  6/3/90
SUBTTL	CHKMSG	Check For Response to the DEFINE ALIAS Command

;[6012]Routine CHKMSG determines if an incoming message is a response to
;[6012]its DEFINE ALIAS command.  If it is a reponse, it processes the response.
;[6012]
;[6012]Call is:       S1/Message Descriptor Block address
;[6012]Returns true:  The received IPCF message is in response to its DEFINE
;[6012]               ALIAS command.
;[6012]Returns false: The IPCF message is not in response to its DEFINE ALIAS
;[6012]               command.

CHKMSG:	LOAD	M,MDB.MS(S1),MD.ADR	;[6012]Get message address
	LOAD	S2,.MSTYP(M),MS.TYP	;[6012]Get message type
	CAIE	S2,.OMRDA		;[6012]RESPONSE TO DEFINE ALIAS message?
	JRST	CHKM.1			;[6012]No, check for text messages
	MOVE	S2,.MSCOD(M)		;[6012]Get PID of OPR it is ACKing
	CAME	S2,G$PID		;[6012]Is it my PID?
	$RETF				;[6012]No, return false
	$CALL	UPDAKA			;[6012]Update alias keyword table
	$RETT				;[6012]Indicate success

CHKM.1: CAIE	S2,MT.TXT		;[6012]Is it a text message?
	$RETF				;[6012]No, return false

	LOAD	S2,.MSFLG(M),MS.TYP	;[6012]Get message flag
	CAIE	S2,'AKI'		;[6012]Is it the E$AKI response?
	CAIN	S2,'AKM'		;[6012]...or the E$AKM response?
	SKIPA				;[6012]Yes to either...
	$RETF				;[6012]No, return false
	$CALL	ACKOPR			;[6012]Process the response
	$RETT				;[6012]Indicate success

CMDPMT:	ITEXT	(<^M^J^T/@PARBLK+PAR.PM/>) ;[6012]
TOPS10<	SUBTTL	ROUTIM	Routine called by timer

;  This routine has one purpose in life.  When called by timer, it
;  attempts to output any existing IPCF messages, resets the timer,
;  and forces a ^R into the terminal's input buffer.  This should
;  hopefully return the line to the state where it was interrupted.

ROUTIM:	MOVEM	0,SAVACS		;Save AC0
	MOVEI	0,SAVACS+1		;Place to put AC1
	HRLI	0,1			;Setup BLT pointer
	BLT	0,SAVACS+17		;Save the AC's

	$CALL	PRCMSG			;Go process any IPCF messages
	$CALL	SETIME			;Reset the timer
	SKIPN	MSGCNT			;Any messages?
	JRST	ROUT.1			;No - don't need ^R

;Now want to force ^R into the input buffer

	MOVE	S1,[XWD 3,TRMBLK]	;Set up for uuo
	TRMOP.	S1,			;Force the ^R
	 JFCL				;User can still run, just isn't pretty
ROUT.1:	MOVSI	16,SAVACS		;Setup pointer
	BLT	16,16			;Don't need to restore PDL
	$RET				;Return to wherever
	SUBTTL	SETIME	Routine to set timer intervals

SETIME:	$CALL	I%NOW			;Get current time
	ADDI	S1,WAKSEC*3		;Add # of wakeup seconds
	STORE	S1,TIMBLK+.TITIM	;Save time to wakeup
	MOVEI	S1,.TIMDT		;Timer function
	STORE	S1,TIMBLK+.TIFNC,TI.FNC	;Set it
	MOVEI	S1,.TIDAT		;Length of argument block
	MOVEI	S2,TIMBLK		;Address of argument block
	$CALL	I%TIMR			;Set it
	$RETIT
	$STOP (CST,<Can't set timer for parsing>)

;The purpose of CLTIME is to clear the timer interrupt set
;previously by SETIME

CLTIME:	MOVEI	S1,.TIMDD		;Removal timer function
	STORE	S1,TIMBLK+.TIFNC,TI.FNC	;Set it
	MOVEI	S1,.TIDAT		;Length of argument block
	MOVEI	S2,TIMBLK		;Address of argument block
	$CALL	I%TIMR			;Set it
	$RETIT
	$STOP (CUT,<Can't unset timer after parsing>)
> ; End of TOPS10
SUBTTL	TAKEND	Process end of TAKE command

;THIS ROUTINE WILL TELL ORION THAT THE TAKE FILE IS FINISHED SO
;THAT INCASE THERE IS A SEND ERROR TO COMPONENT THE FILE CAN
;BE ABORTED


;RETURN	S1/ MESSAGE ADDRESS FOR ORION


TAKEND:	SETZM	TAKFLG			;CLEAR TAKE FLAG
	$CALL	M%GPAG			;GET A PAGE OF MEMORY
	MOVX	S2,.OMTKE		;GET TAKE END CODE
	STORE	S2,.MSTYP(S1),MS.TYP	;SAVE THE TYPE
	MOVEI	S2,.OHDRS		;MINIMUM SIZE BLOCK
	STORE	S2,.MSTYP(S1),MS.CNT	;SAVE THE LENGTH
	$RETT				;RETURN
SUBTTL	DSPCMD	Display TAKE commands if desired

;THIS ROUTINE WILL CHECK THE DISPLAY SETTINGS FROM THE TAKE AND
;FROM THE TAKE DEFAULT DISPLAY AND DISPLAY COMMANDS IF SET
DSPCMD:	$CALL	CHKDSP			;CHECK IF NEED TO DISPLAY
	JUMPF	.RETT			;RETURN O.K.
	MOVE	T1,PRT.CM(P3)		;ADDRESS OF MESSAGE
	$CALL	SETOUT			;SETUP FOR OUTPUT
	MOVE	T2,COM.CM(T1)		;GET TEXT OFFSET
	ADDI	T2,1(T1)		;POINT TO START OF STRING
	$TEXT	(,<^I/CMDPMT/^T/(T2)/^A>) ;OUTPUT THE COMMAND
	$CALL	SNDOUT			;SEND THE OUTPUT
	$RET				;RETURN


CHKDSP:	MOVE	T1,PRT.FL(P3)		;GET FLAG WORD
	TXNE	T1,P.TAKE		;TAKE COMMAND ITSELF
	JRST	CHKD.1			;YES..SET FLAG AND RETURN FALSE
	TXC	T1,P.CTAK!P.ERRO	;FROM TAKE AND AN ERROR
	TXCN	T1,P.CTAK!P.ERRO	;BOTH WERE SET
	$RETT				;YES..DISPLAY THE TEXT
	TXNN	T1,P.DSPT		;DISPLAY TAKE COMMAND
	$RETF				;RETURN FALSE
	$RETT				;O.K. RETURN TRUE
CHKD.1:	SETOM	TAKFLG			;IN TAKE COMMAND
	$RETF				;RETURN FALSE
SUBTTL	PRCMSG	Process IPCF messages

PRCMSG:	SETZM	MSGCNT			;CLEAR THE COUNT
PRCM.0:	$CALL	C%RECV			;GO RECEIVE A MESSAGE
	$RETIF				;NO MORE MESSAGES, RETURN
;**;[6012]At PRCM.0:+1L replace 2 lines with 4 lines  PMM 6/3/90
	$CALL	PRCDSP			;[6012]Validate, process and release
	JRST	PRCM.0			;[6012]Loop back for more messages

PRCDSP:	$CALL	VALMSG			;[6012]Validate the message
	JUMPF	PRCM.1			;NO GOOD..PITCH THE MESSAGE
	LOAD	M,MDB.MS(S1),MD.ADR	;GET MESSAGE ADR.
	$CALL	DSPRTN			;FIND PROCESSING ROUTINE
					;RETURN S1 WITH ADDRESS
	JUMPF	PRCM.1			;FALSE RETURN..IGNORE PROCESSING
	$CALL	(S1)			;OTHERWISE, CALL THE ROUTINE
	AOS	MSGCNT			;BUMP THE MESSAGE COUNT
PRCM.1:	$CALL	C%REL			;FOR NOW IF WE FAIL TO FIND
;**;[6012]At PRCM.1:+1L change 1 line  PMM  6/3/90
	$RET				;[6012]Return

DSPTAB:	.OMDSP,,DSPOPD
	.OMWTR,,WTRDSP
	.OMACS,,SHWDSP
;**;[6012]At DSPTAB:+2L add 1 line  PMM  6/3/90
	.OMRDA,,UPDAKB			;[6012]Update alias keyword table
	MT.TXT,,ACKOPR
	DSPLEN==.-DSPTAB



DSPRTN:	LOAD	S2,.MSTYP(M),MS.TYP	;GET MESSAGE TYPE
	MOVSI	T1,-DSPLEN		;LENGTH OF DISPATCH TABLE
DSPR.1:	HLRZ	S1,DSPTAB(T1)		;GET TYPE FROM TABLE
	CAIN	S2,(S1)			;MATCH??
	JRST	DSPR.2			;YES..SETUP S1 AND EXIT
	AOBJN	T1,DSPR.1		;TRY NEXT ONE
	$RETF				;FALSE RETURN
DSPR.2:	HRRZ	S1,DSPTAB(T1)		;GET PROCESSING ADDRESS
	$RETT				;RETURN TRUE


SUBTTL	VALMSG	Validate a message from ORION

;THIS ROUTINE WILL MAKE SURE THE MESSAGE RECEIVED IS FROM ORION.
;IF NOT, THE ROUTINE WILL RETURN FALSE

VALMSG:	LOAD	T1,MDB.SI(S1)		;SYSTEM PID INDEX WORD
	TXZN	T1,SI.FLG		;FROM A SYSTEM PID
	$RETF				;NO..RETURN FALSE
	CAIE	T1,SP.OPR		;FROM ORION
	$RETF				;NO..RETURN FALSE
	$RETT				;YES..O.K. SO FAR
SUBTTL	ACKOPR	Display a GALAXY text message

ACKOPR:	LOAD	S1,.MSFLG(M)		;GET THE FLAGS
	TXNE	S1,MF.NOM		;IS THIS A NULL ACK?
	$RET				;YES, JUST RETURN NOW
	SKIPG	T1,.OARGC(M)		;VALID ARGUMENT COUNT
	$RETF				;NO JUST RETURN

	LOAD	T3,.MSFLG(M),MF.NEB	;[6004]REMOTE MESSAGE FLAG
	LOAD	T1,ARG.HD+.OHDRS(M),AR.TYP ;[6004]GET ARGUMENT TYPE
	CAIN	T1,.CMTXT		;[6004]IS IT TEXT?
	JRST	ACKO.1			;[6004]YES, PICK UP THE MESSAGE
	SKIPN	T3			;[6004]FROM A REMOTE ORION?
	$RETF				;[6004]NO, RETURN
	CAIE	T1,.ORDSP		;[6004]IS IT A DISPLAY BLOCK?
	$RETF				;[6004]NO, RETURN NOW
	MOVEI	S1,.OHDRS(M)		;[6004]POINT TO THE DISPLAY BLOCK
	LOAD	S2,ARG.HD(S1),AR.LEN	;[6004]PICK UP ITS LENGTH
	ADD	S1,S2			;[6004]POINT TO THE NEXT BLOCK
	LOAD	T1,ARG.HD(S1),AR.TYP	;[6004]PICK UP ITS TYPE
	CAIE	T1,.ORDSP		;[6004]IS IT A TEXT BLOCK?
	$RETF				;[6004]NO, RETURN NOW
	LOAD	T1,ARG.HD(S1),AR.LEN	;[6004]PICK UP ITS LENGTH
	ADDI	T1,.OHDRS(S2)		;[6004]ADD IN THE HEADER AND DISPLAY BLK
	LOAD	T2,.MSTYP(M),MS.CNT	;[6004]GET THE MESSAGE LENGTH
	CAMLE	T1,T2			;[6004]MESSAGE IN BOUNDS?
	$RETF				;[6004]NO, RETURN NOW
	PUSH	P,S1			;[6004]SAVE THE TEXT BLOCK ADDRESS
	$CALL	SETOUT			;[6004]SETUP FOR OUTPUT
	POP	P,S1			;[6004]RESTORE THE TEXT BLOCK ADDRESS
	MOVEI	T1,.OHDRS(M)		;[6004]PICK UP ADDRESS OF DISPLAY BLOCK
	$TEXT	(,<
^C/ARG.DA(T1)/ ^T/ARG.DA+1(T1)/>)	;[6004]OUTPUT TEXT
	$TEXT	(,<^C/ARG.DA(S1)/	--^T/ARG.DA+1(S1)/-->)	;[6004]
	PJRST	SNDOUT			;[6004]SEND OUTPUT AND RETURN

;**;[6011]At ACKO.1:+0L replace 10 lines with 14 lines  JCR  12/16/89
ACKO.1:	$CALL	SETOUT			;[6011]Setup for output
	MOVEI	T1,.OHDRS(M)		;[6011]Address of current block
	$TEXT	(,<
^C/[-1]/	--^T/ARG.DA(T1)/-->)	;[6011]Output the text
ACKO.2:	SOSG	.OARGC(M)		;[6011]Any more text blocks?
	JRST	ACKO.3			;[6011]No, check for OPR not set up
	LOAD	S1,ARG.HD(T1),AR.LEN	;[6011]Pick up the current block length
	ADD	T1,S1			;[6011]Address of the next block
	LOAD	S1,ARG.HD(T1),AR.TYP	;[6011]Pick up the next block type
	CAIE	S1,.CMTXT		;[6011]Is it A text block?
	JRST	ACKO.2			;[6011]No, check for another block
	$TEXT	(,<		  ^T/ARG.DA(T1)/>) ;[6011]Output the text
	JRST	ACKO.2			;[6011]Check for another block
ACKO.3:	HRRZ	S1,.MSFLG(M)		;[6011]Get error code
	CAIE	S1,'ONS'		;OPR NOT SETUP
	PJRST	SNDOUT			;SEND OUTPUT AND RETURN
TOPS20	<
	SKIPE	REMOPR			;REMOTE OPERATOR?
	$CALL	EXIT			;TERMINATE
> ;End TOPS20
	$TEXT	(,<	..OPR restarting..>)	;INFORM THE OPERATOR
	JRST	OPR			;RESTART THE WORLD
SUBTTL	DSPOPD	Process DISPLAY message from ORION

WTRDSP:	SETOM	T3			;SET WTOR FLAG
	SKIPA				;SKIP OVER DISPLAY ENTRY
DSPOPD:	SETZM	T3			;NO WTOR FLAG
	SKIPN	T1,.OARGC(M)		;GET ARGUMENT COUNT
	$STOP(IAC,Argument count ^O/T1/ not valid in display message)
	MOVEI	T2,.OHDRS+ARG.HD(M)	;ADDRESS OF FIRST ARGUMENT
	$CALL	SETOUT			;SETUP FOR OUTPUT
DSPO.1:	LOAD	S1,ARG.HD(T2),AR.TYP	;GET THE TYPE FIELD
	CAIE	S1,.ORDSP		;IS IT DISPLAY
	JRST	DSPO.3			;NO CHECK FOR TEXT
	$TEXT	(,<^M^J^C/ARG.DA(T2)/ ^A>)
	MOVEI	S1,ARG.DA+1(T2)		;ADDRESS OF THE TEXT
DSPO.2:	$CALL	DSPMSG			;OUTPUT THE TEXT
DSPO2A:	LOAD	S2,ARG.HD(T2),AR.LEN	;[6006]GET LENGTH OF BLOCK
	ADD	T2,S2			;BUMP TO NEXT BLOCK
	SOJG	T1,DSPO.1		;GET NEXT BLOCK
	SKIPE	T3			;WAS IT A WTOR?
	$TEXT(,<^A>)			;RING THE BELLS
	PJRST	SNDOUT			;SEND THE OUTPUT AND RETURN
DSPO.3:	CAIE	S1,.CMTXT		;WAS IT JUST TEXT
	JRST	DSPO.4			;[6006]CHECK FOR A REMOTE FLAGS BLOCK
	MOVEI	S1,ARG.DA(T2)		;ADDRESS OF TEXT
	JRST	DSPO.2			;OUTPUT THE TEXT
DSPO.4:	CAIN	S1,.ORRFG		;[6006]A REMOTE FLAGS BLOCK?
	JRST	DSPO2A			;[6006]YES, GET THE NEXT BLOCK
	$STOP(IDM,Message argument type ^O/S1/ not valid for display messages) 
DSPMSG:	
TOPS20	<
	SKIPE	REMACC			;REMOTE OPR
	PJRST	DSPM.1			;OUTPUT THE DATA
> ;End TOPS20
	PJRST	K%SOUT			;NO..SOUT IT

TOPS20	<
DSPM.1:	$TEXT	(,<^T/(S1)/^A>)		;DUMP THE DATA
	$RETT				;RETURN
> ;End TOPS20
SUBTTL	SHWDSP	Process DISPLAY message from ORION

SHWDSP:	SKIPN	T1,.OARGC(M)		;GET ARGUMENT COUNT
	JRST	S..IAC			;INVALID COUNT
	MOVEI	T2,.OHDRS+ARG.HD(M)	;ADDRESS OF FIRST ARGUMENT
	SETOM	REMMSG			;[6004]ASSUME FROM A REMOTE NODE
	LOAD	S1,.MSFLG(M),MF.NEB	;[6004]PICK NEBULA BIT
	SKIPN	S1			;[6004]IS THE MSG FROM A REMOTE NODE?
	SETZM	REMMSG			;[6004]NO, INDICATE SO
SHWD.1:	LOAD	S1,ARG.HD(T2),AR.TYP	;GET THE TYPE FIELD
	CAIE	S1,.ORDSP		;IS IT DISPLAY?
	JRST	SHWD.5			;[6004]NO, CHECK FOR TEXT
	$CALL	SETOUT			;SETUP FOR OUTPUT
	AOSE	REMMSG			;[6004]FIRST DISPLAY BLOCK?
	JRST	SHWD.2			;[6004]NO, INCLUDE TAB AND DASHES
	$TEXT	(,<^M^J^C/ARG.DA(T2)/^T/ARG.DA+1(T2)/^A>) ;[6004]
	JRST	SHWD.4			;[6004]GO GET THE NEXT BLOCK
SHWD.2:	$TEXT	(,<^M^J^C/ARG.DA(T2)/		--^T/ARG.DA+1(T2)/-->)
	SKIPA				;GET NEXT ARGUMENT
SHWD.3:	$CALL	DSPMSG			;[6004]OUTPUT THE TEXT
SHWD.4:	LOAD	S2,ARG.HD(T2),AR.LEN	;[6004]GET LENGTH OF BLOCK
	ADD	T2,S2			;BUMP TO NEXT BLOCK
	SOJG	T1,SHWD.1		;GET NEXT BLOCK
	PJRST	SNDOUT			;SEND THE OUTPUT
SHWD.5:	CAIE	S1,.CMTXT		;[6004]WAS IT JUST TEXT?
	JRST	SHWD.6			;[6006]NO, CHECK FOR REMOTE FLAGS BLOCK
	MOVEI	S1,ARG.DA(T2)		;ADDRESS OF TEXT
	JRST	SHWD.3			;[6004]OUTPUT THE TEXT
SHWD.6:	CAIN	S1,.ORRFG		;[6006]A REMOTE FLAGS BLOCK?
	JRST	SHWD.4			;[6006]YES, IGNORE THIS BLOCK
	JRST	S..IDM			;[6006]INVALID DISPLAY MESSAGE TYPE

;**;[6012]At SHWD.6:+2L add routines UPDAKA and SIXSEV  PMM  6/3/90
SUBTTL	UPDAKA	Update the Alias Keyword Table

;[6012]UPDAKA replaces the Alias keyword table with the alias names contained
;[6012]]in the .AKBLK alias list block.
;[6012]Call is:	    M/Contains the address of the RESPONSE to DEFINE ALIAS
;[6012]message.
;[6012]
;[6012]Returns true: Always

UPDAKA:	SETZM	REMUPD			;[6012]Indicate local node
	SKIPA				;[6012]Don't reset the flag
UPDAKB:	SETOM	REMUPD			;[6012]Indicate remote node
	$SAVE	<P1,P2,P3>		;[6012]SAVE these ACs
	MOVE	S1,.OARGC(M)		;[6012]Get argument count 
	SKIPN	S1			;[6012]Is this a Null response?
	$RETT				;[6012]Yes, indicate so
	MOVEI 	P1,.OHDRS+ARG.HD(M)	;[6012]Address of first argument block
	HLRZ	S2,(P1)			;[6012]Get alias block length
	MOVE	P2,S2			;[6012]Preserve it
	MOVE	T1,AKATBL		;[6012]Get alias keyword table header
	MOVEI	T1,MAXAKA		;[6012]Get maximum # of aliases
	MOVEM	T1,AKATBL		;[6012]Place back in table header
	SOS	P2			;[6012]Get actual # of aliases
	SKIPN	P2			;[6012]Any aliases in block?
	$RET				;[6012]No, finished

;[6012]Add SIXBIT alias names to table AKASIX

	AOS	P1			;[6012]Point at first alias
	MOVEI	S2,AKASIX		;[6012]Get destination address
	HRLI	S1,(P1)			;[6012]Source address
	HRRI	S1,(S2)			;[6012]Source,,destination
	ADD	S2,P2			;[6012]Calculate last...
	SOS	S2			;[6012]...destination address
	BLT	S1,(S2)			;[6012]Move the object block 

;[6012]Change SIXBIT alias names to ASCIZ, store in table AKAASC and add
;[6012]TBLUK% style entry to AKATBL

	SETZB	P3,P4			;[6012]Initialize counters
UPDA.2:	MOVEI	T1,AKASIX(P4)		;[6012]Get address of SIXBIT alias
	HRLI	T2,(POINT 7,)		;[6012]Get pointer to ASCIZ address
	HRRI	T2,AKAASC(P3)		;[6012]Get ASCIZ address	
	$CALL	SIXSEV			;[6012]Convert SIXBIT alias to ASCIZ
	MOVEI	S1,AKATBL		;[6012]Get address of header word
	HRLI	S2,AKAASC(P3)		;[6012]Get address of ASCIZ entry
	HRRI	S2,AKASIX(P4)		;[6012]ASCIZ address,,SIXBIT address
	TBADD%				;[6012]Add to alias keyword table
	 ERJMP	.+1			;[6012]Ignore errors, should not occur
	AOS	P4			;[6012]Increment alias counter
	ADDI	P3,2			;[6012]Increment ASCIZ index by two
	SOJG	P2,UPDA.2		;[6012]Loop back if more aliases
	SKIPN	REMUPD			;[6012]From a remote node?
	$RETT				;[6012]No, return now
	$CALL	SETOUT			;[6012]Setup the terminal
	LOAD	P3,.OHDRS(M),AR.LEN	;[6012]Get length of alias block
	ADDI	P3,.OHDRS(M)		;[6012]Get address of node name block
	SETZM	INTDSP			;[6012]Indicate a msg has been displayed
	GTAD%				;[6012]Get system time
	LOAD	S2,.MSFLG(M),MF.NEB	;[6012]Pick up the remote origin bit
	JUMPE	S2,UPDA.3		;[6012]Don't include header if local
	$TEXT	(,<^M^J^C/S1/  Processed request in behalf of ^W/ARG.DA(11)/::>) ;[6012]
	$TEXT (,<^C/S1/		-- Alias Keyword Table updated -->)	;[6012]
	$RETT				;[6012]No more aliases, return
UPDA.3:	$TEXT (,<^M^J^C/S1/	-- Alias Keyword Table updated -->)	;[6012]
	$RETT
SUBTTL SIXSEV -  Convert SIXBIT to ASCIZ

;[6012]Call is:      T1/Address of word containing SIXBIT characters
;[6012]              T2/Pointer to words for storing ASCIZ string (2 words)
;[6012]
;[6012]Returns true: Always

SIXSEV:	$CALL 	.SAVET		;[6012]Save T ACs
	HRLI T1,(POINT 6)	;[6012]Set up byte pointer for sixbit word
	MOVEI T4,6		;[6012]Maximum of 6 characters

;[6012]Loop over characters

SIXS.1:	ILDB T3,T1		;[6012]Get character
	JUMPE T3,SIXS.2		;[6012]If zero, then end of string
	ADDI T3,40		;[6012]Make 7-bit
	IDPB T3,T2		;[6012]Store word
	SOJG T4,SIXS.1		;[6012]Jump if more characters
SIXS.2:	ADDI T4,4		;[6012]Zero out rest of word(s)
	SETZ T3,		;[6012]Clear AC
	IDPB T3,T2		;[6012]Deposit zero
	SOJG T4,.-1		;[6012]Jump back if more characters
	$RETT
SUBTTL	TABSET	Setup tables for parser call

;THIS ROUTINE WILL SET UP THE DEFAULT TABLES AND THE DEFAULT
;PROMPT
;AND RETURN ARGUMENTS IN P1 AND P2

TABSET:
TOPS20	<
	SKIPE	REMOPR			;REMOTE OPERATOR
	PJRST	TABS.3			;YES..SETUP FOR REMOTE OPERATOR
> ;End TOPS20
	SKIPE	HDRTAB			;USING THE HEAD TABLES(OPR TABLES)
	JRST	TABS.1			;YES..SET UP PARSER ARGUMENTS
	MOVE	S1,ENTCOD		;APPLICATION TYPE
	MOVEM	S1,TABCOD		;SAVE THE VALUE FOR MESSAGES
	MOVE	S1,DEFTAB		;GET THE DEFAULT TABLES FOR CALL
	AOS	S1			;POSITION OVER THE HEADER
	STORE	S1,.CMFNP+MANTAB+1,CM%LST	;SAVE AS ALTERNATE TO MAIN TABLE
	MOVEI	S1,TABINI		;ADDRESS OF MAIN TABLE INIT
	MOVEM	S1,PARBLK+PAR.TB	;SAVE IN PARSER CALL BLOCK
	MOVEI	S1,HDRPMT		;GET DEFAULT PROMPT
TABS.0:	MOVEM	S1,PARBLK+PAR.PM	;SAVE THE PROMPT IN BLOCK
	MOVEI	P1,PAR.PM+1		;SIZE OF THE BLOCK
	MOVEI	P2,PARBLK		;PARSER BLOCK
	SKIPN	TAKFLG			;IN A TAKE FILE
	SKIPG	INTDSP			;ANY MESSAGES DISPLAYED
	$RETT				;RETURN
	SKIPG	MSGCNT			;ANY MESSGES PROCESSED
	$RETT				;NO.. FORCE OUT THE PROMPT
	MOVE	S1,PARBLK+PAR.TB	;GET TABLE ADDRESS
	$CALL	P$PNXT##		;GET THE NEXT PDB
	MOVEM	S1,PARBLK+PAR.TB	;SAVE TABLE ADDRESS
	SETZM	INTDSP			;CLEAR THE FLAG
	$RETT				;RETURN
TABS.1:	SETZM	TABCOD			;CLEAR FIELD FOR MAIN TABLES
	MOVE	S1,SYNTAB		;ADDRESS OF MAIN TABLES
	SKIPG	OPRTYP			;[6001]SEMI-OPR?
	MOVE	S1,SEMTAB		;[6001]YES
	MOVE	T1,TAB.IN(S1)		;ADDRESS OF .CMINI FOR TABLES
	STORE	T1,PARBLK+PAR.TB	;SAVE THE TABLE ADDRESS
TABS.2:	MOVE	S1,OPRPMT		;[6001]GET OPR PROMPT
	SKIPG	OPRTYP			;[6001]WHEEL OR OPERATOR?
	MOVE	S1,SEMPMT		;[6001]NO, USE SEMI-OPR PROMPT
	JRST	TABS.0			;[6001]FINISH AND RETURN
TOPS20	<
TABS.3:	MOVE	S1,SYNTAB		;ADDRESS OF MAIN TABLES
	MOVE	T1,TAB.IN(S1)		;ADDRESS OF .CMINI FOR TABLES
	STORE	T1,PARBLK+PAR.TB	;SAVE THE TABLE ADDRESS
	MOVE	S1,OPRPMT		;GET THE OPR PROMPT
	MOVEM	S1,PARBLK+PAR.PM	;SAVE THE PROMPT
	MOVSI	S1,(POINT NETBSZ,)	;NETBSZ BIT BYTES
	HRR	S1,NETBUF		;GET DATA ADDRESS
	MOVEM	S1,PARBLK+PAR.SR	;SAVE SOURCE POINTER
	MOVEI	P1,PAR.SZ		;SIZE OF THE BLOCK
	SKIPN	REMACC			;REMOTE ACCESS LINK?
	MOVEI	P1,PAR.PM+1		;NO..USE MINIMUM SIZE BLOCK
	MOVEI	P2,PARBLK		;ADDRESS OF PARSER BLOCK
	$RETT				;RETURN
> ;End TOPS20
SUBTTL	Software interrupt system routines

;ROUTINE CALLED ON AN INTERRUPT

INT:	$BGINT	IPCLEV			;BEGIN AN INTERRUPT
	$CALL	P$INTR##		;PARSER INTERRUPT SUPPORT
	$CALL	C%INTR			; FLAG RECEIPT OF IPCF INTERRUPT
	$DEBRK				; EITHER RETURN TO SEQUENCE
					; OR CHANGE PC AND HANDLE THE INTERRUPT

TOPS10<
DET:	$BGINT	DETLEV			;Begin processing attach/det interrupts
	MOVE	S1,DETINT+.PSVIS	;Get status word
	CAME	S1,[-1]			;Attach?
	$DEBRK				;Yes, dismiss the interrupt
	JRST	EXTACT			;Finish all at interrupt level
> ; End of TOPS10
SUBTTL	Command and application action routines

;THESE ROUTINES WILL BE GIVEN CONTROL ON A KEYWORD
;FROM THE MAIN COMMAND TABLES (CMDACT) AS WELL AS  FROM AN
;APPLICATION KEYWORD TYPED WHILE USING THE MAIN TABLES.

CMDACT:: SETZM	TABCOD			;CLEAR THE CODE TYPE FOR THESE
					;ENTRIES
	MOVE	T1,CR.SAV(S2)		;GET THE ADDRESS OF SAVED ELEMENT
	MOVE	T1,ARG.DA(T1)		;GET THE VALUE
	MOVEM	T1,CMDCOD##		;SAVE THE COMMAND CODE
	CAXN	T1,.KYCTZ		;Control-Z exit ?
	PJRST	EXTACT			;Yes - say good-bye to ORION
	$RETT				;RETURN TRUE



APLACT:	MOVE	T1,CR.SAV(S2)		;GET THE ADDRESS OF SAVED ELEMENT
	MOVE	T1,ARG.DA(T1)		;GET THE VALUE
	MOVEM	T1,TABCOD		;SAVE THE CODE
	MOVE	T2,ARGFRE##		;GET LAST ARGUMENT POINTER ADDRESS
	SUBI	T2,2			;BACK OVER APPLICATION NAME..REMOVE
	MOVEM	T2,ARGFRE##		;RESTORE POINTER 
	$RETT				;RETURN
SUBTTL	ENTER and RETURN command tables

	INTERNAL	ENTFDB
ENTFDB:	$NOISE(ENT010,<command subset>,<$PREFILL(ENTCHK)>)

ENT010:	$KEYDSP(ENTTAB,<$ACTION(ENTRTN)>)

	DEFINE	X(A,B,C,D),<ORNDSP(ENT020,<A>,<B>)>
;TABLE MUST BE IN DSPTAB FORMAT ****


ENTTAB:	$STAB
	TABAPL				;EXPAND APPLICATION TABLES
	$ETAB

ENT020:	$CRLF(<$ACTION(ENTER)>)


ENTCHK:	SKIPN	REMOPR			;IS IT A REMOTE OPERATOR
	$RETT				;NO..ASSUME O.K.
	MOVEI	S2,[ASCIZ/ENTER command not allowed for remote operators/]
	$RETF				;RETURN FALSE
ENTRTN:	MOVE	T1,CR.RES(S2)		;GET THE RESULT
	MOVEM	T1,CMDDAT		;SAVE THE DATA
	$RETT				;RETURN TRUE

ENTER:	MOVE	T1,CMDDAT		;GET THE DATA WORD
	HLRZ	T2,(T1)			;GET POINTER TO THE STRING
	$TEXT	(<-1,,HDRPMT>,<^T/(T2)/^7/[76]/^0>)
	SETZM	HDRTAB			;IN APPLICATION MODE
	HRRZ	T2,(T1)			;GET ADDRESS OF CODE WORD
	HLRZ	T2,(T2)			;GET THE SYMBOL VALUE
	MOVEM	T2,ENTCOD		;SAVE THE CODE
	MOVE	T3,T2			;PLACE IN T3
	ANDI	T3,77			;GET THE TABLE INDEX FROM CODE
	MOVE	T3,SYNTAB(T3)		;ADDRESS OF THE TABLES
	MOVE	T4,TAB.KY(T3)		;GET MAIN KEYWORD TABLE
	MOVEM	T4,DEFTAB		;SAVE AS DEFAULT TABLES
	PJRST	P$NPRO##		;NO PROCESSING REQUIRED


RETFDB:	$NOISE(RET010,<to operator command level>)

RET010:	$CRLF(<$ACTION(RETURN)>)

RETURN:	SKIPE	HDRTAB			;SHOULD BE IN APPLICATION TABLES
	$RETF				;ERROR..RETURN FALSE TO ABORT
	SETOM	HDRTAB			;SET FOR MAIN TABLES
	SETZM	TABCOD			;CLEAR CODE FOR APPLICATION
	PJRST	P$NPRO##		;NO PROCESSING REQUIRED
SUBTTL	Control-Z and EXIT command tables and action routines

EXTFDB:: $NOISE(EXT010,<to monitor level>)

EXT010:	$CRLF(<$ACTION(EXTACT)>)


; Action routine called by CMDACT on a ^Z command and by the parser
; on an EXIT command.
;
EXTACT:	MOVX	S1,E.EXIT		;EXIT COMMAND ISSUED
	MOVEM	S1,ERRCOD		;SAVE THE CODE
	$CALL	SETFAL			;SEND THE SHUTDOWN MESSAGE AND HALT
	JRST	OPR			;RESTART THE JOB
SUBTTL	TAKOPR	Process a take command

;THIS ROUTINE WILL CHECK TAKE AUTHORIZATION BEFORE
;PROCEEDING WITH THE PARSE

TAKOPR:: $CRLF(<$PREFILL(TAKO.1),$ALTERNATE(TAKFDB##)>)

TAKO.1:	SKIPN	REMOPR			;REMOTE OPR?
	JRST	TAKO.2			;NO..MODIFY THE PDB
	MOVEI	S2,[ASCIZ/TAKE command not allowed for remote operators/]
	$RETF				;RETURN FALSE
TAKO.2:	MOVEI	S1,TAKFDB##		;GET THE TAKE ADDRESS
	AOS	S1			;BUMP OVER THE HEADER
	STORE	S1,CR.PDB(S2),RHMASK	;SAVE  NEW PDB TO USE
	$RETT				;RETURN
SUBTTL	WAIOPR	Process a wait command

;THIS ROUTINE WILL CHECK WAIT AUTHORIZATION BEFORE
;PROCEEDING WITH THE PARSE

WAIOPR:: $CRLF(<$PREFILL(WAIO.1),$ALTERNATE(WAIFDB##)>)

WAIO.1:	SKIPN	REMOPR			;REMOTE OPR?
	JRST	WAIO.2			;NO..MODIFY THE PDB
	MOVEI	S2,[ASCIZ/WAIT command not allowed for remote operators/]
	$RETF				;RETURN FALSE
WAIO.2:	MOVEI	S1,WAIFDB##		;GET THE WAIT ADDRESS
	AOS	S1			;BUMP TO PDB
	STORE	S1,CR.PDB(S2),RHMASK	;SAVE  NEW PDB TO USE
	$RETT				;RETURN
SUBTTL	SETRTN and SETTRM	Process SET TERMINAL command
;THESE ROUTINES WILL SETUP THE TERMINAL DATA AND
;ON THE CONFIRM  SETTRM WILL PROCESS THE DATA

SETRTN:: MOVE	T1,CR.SAV(S2)		;GET THE ADDRESS OF SAVED ELEMENT
	MOVE	T1,ARG.DA(T1)		;GET THE VALUE
	MOVEM	T1,CMDDAT		;SAVE THE COMMAND DATA
	$RETT				;RETURN TRUE

SETTRM:: MOVE	S1,CMDDAT		;GET THE DATA WORD
	CAIN	S1,.KYKPD		;WAS IT TO SET KEYPAD
	PJRST	SETKPD			;YES..SETUP KEYPAD MODE
	CAIN	S1,.KYNKP		;WAS IT NOKEYPAD
	PJRST	SETNKP			;YES..SETUP NOKEYPAD MODE
	$CALL	K%STYP			;SET THE TERMINAL TYPE
	JUMPF	SETT.3			;GIVE ERROR IF BAD TTY TYPE

SETRET:	PJRST	P$NPRO##		;NO PROCESSING REQUIRED
SETT.3:	MOVEI	S2,[ASCIZ/Terminal type setup failed/]
	$RETF				;RETURN FALSE TO ABORT
SETT.4:	MOVEI	S2,[ASCIZ/Terminal keypad function setup failure/]
	$RETF				;RETURN FALSE TO ABORT

;HERE ON SET TERMINAL KEYPAD
SETKPD: MOVEI	S1,ESCTAB		;GET ADDRESS OF ESCAPE TABLE
	$CALL	K%SUET			;SET TABLE ADDRESS
	JUMPF	SETT.4			;COULD NOT DO..ERROR
	PJRST	SETRET			;SET RETURN

;HERE ON SET TERMINAL NOKEYPAD
SETNKP:: MOVEI	S1,0			;CLEAR TABLE ADDRESS
	$CALL	K%SUET			;DO IT
	JUMPF	SETT.4			;COULD NOT DO..ERROR
	PJRST	SETRET			;SET RETURN
SUBTTL	ESCAPE Sequence Table for Operator Terminals

TOPS10	<
ESCTAB:
REPEAT 33,<				;CODES 0 THRU 32
	XLIST
	EXP	0
	LIST
>  ;END REPEAT 33

	POINT 7,[BYTE (7) .CHESC,0]	;MAKE ESC, ESC = ESC

REPEAT 43,<				;CODES 34 THRU 76
	XLIST
	EXP	0
	LIST
>  ;END REPEAT 43

	EXP	ESCTAB			;? TAKES US TO NEXT TABLE (THIS ONE)
	EXP	0			;CODE 100
	EXP	0			;A
	EXP	0			;B
	POINT 7,[BYTE (7) .CHCNU,0]	;C IS CONTROL U
	POINT 7,[BYTE (7) "P","R","I","N","T","E","R",.CHESC]

REPEAT 10,<				;E THRU L
	XLIST
	EXP	0
	LIST
>  ;END REPEAT 10

	POINT 7,[ASCIZ/?/]		;M
	EXP	0			;N
	EXP	VT1TAB			;O

REPEAT 13,<				;P THRU Z
	XLIST
	EXP	0
	LIST
>  ;END REPEAT 13
REPEAT 6,<				;CODES 133 THRU 140
	XLIST
	EXP	0
	LIST
>  ;END REPEAT 6

REPEAT 15,<				;LCA THRU LCM
	XLIST
	EXP 	0
	LIST
>  ;END REPEAT 15

	EXP	0			;LCN
	EXP	0			;LCO
	POINT 7,[BYTE (7) .CHESC,0]	;LCP IS RECOGNIZE CHARACTER
	POINT 7,[ASCIZ /SHOW STATUS
/]					;LCQ
	POINT 7,[ASCIZ/SHOW QUEUES
/]					;
	POINT 7,[ASCIZ/SHOW PARAMETERS
/]					;
	POINT 7,[ASCIZ/SHOW MESSAGES
/]					;
	POINT 7,[ASCIZ/SHOW ROUTE-TABLE
/]					;LCU
	POINT 7,[BYTE (7) .CHCNW,0]	;LCV IS DELETE FIELD
	POINT 8,[BYTE (8) 233,310,233,312,.CHCNR,0] ;HOME ERASE EOS CONTL-R
	POINT 7,[ASCIZ/SHOW OPERATORS
/]					;LCX
	POINT 7,[ASCIZ/SHOW QUEUE MOUNT-REQUESTS
/];					;LCY
	EXP	0			;LCZ

REPEAT 5,<				;CODES 173 THRU 177
	XLIST
	EXP	0
	LIST
>  ;END REPEAT 5

VT1TAB:
REPEAT 33,<				;CODES 0 THRU 32
	XLIST
	EXP	0
	LIST
>  ;END REPEAT 33

	POINT 7,[BYTE (7) .CHESC,0]	;MAKE ESC, ESC = ESC

REPEAT 43,<				;CODES 34 THRU 76
	XLIST
	EXP	0
	LIST
>  ;END REPEAT 43

	EXP	ESCTAB			;? TAKES US TO NEXT TABLE (THIS ONE)
	EXP	0			;CODE 100
	EXP	0			;A
	EXP	0			;B
	POINT 7,[BYTE (7) .CHCNU,0]	;C IS CONTROL U
	POINT 7,[BYTE (7) "P","R","I","N","T","E","R",.CHESC]

REPEAT 10,<				;E THRU L
	XLIST
	EXP	0
	LIST
>  ;END REPEAT 10

	POINT 7,[ASCIZ/?/]		;M
	EXP	0			;N
	EXP	VT1TAB			;O

REPEAT 13,<				;P THRU Z
	XLIST
	EXP	0
	LIST
>  ;END REPEAT 13
REPEAT 6,<				;CODES 133 THRU 140
	XLIST
	EXP	0
	LIST
>  ;END REPEAT 6

REPEAT 15,<				;LCA THRU LCM
	XLIST
	EXP 	0
	LIST
>  ;END REPEAT 15

	EXP	0			;LCN
	EXP	0			;LCO
	POINT 7,[BYTE (7) .CHESC,0]	;LCP IS RECOGNIZE CHARACTER
	POINT 7,[ASCIZ /SHOW STATUS
/]					;LCQ
	POINT 7,[ASCIZ/SHOW QUEUES
/]					;
	POINT 7,[ASCIZ/SHOW PARAMETERS
/]					;
	POINT 7,[ASCIZ/SHOW MESSAGES
/]					;
	POINT 7,[ASCIZ/SHOW ROUTE-TABLE
/]					;LCU
	POINT 7,[BYTE (7) .CHCNW,0]	;LCV IS DELETE FIELD
	POINT 8,[BYTE (8) 233,333,310,233,333,260,312,.CHCNR,0 ]
					;LCW IS HOME ERASE EOS CTL-R
	POINT 7,[ASCIZ/SHOW OPERATORS
/]					;LCX
	POINT 7,[ASCIZ/SHOW QUEUE MOUNT-REQUESTS
/];					;LCY
	EXP	0			;LCZ

REPEAT 5,<				;CODES 173 THRU 177
	XLIST
	EXP	0
	LIST
>  ;END REPEAT 5


> ;End TOPS10
TOPS20	<
	$DATA	ESCTAB,1			;NULL ESCAPE TABLE
> ;End TOPS20
SUBTTL	SHWDAY	Process SHOW DAYTIME command

SHWDAY:: $CALL	SETOUT			;SETUP THE OUTPUT
	$TEXT	(,<^H/[-1]/>)
	$CALL	SNDOUT			;SEND THE OUTPUT
	PJRST	P$NPRO##		;NO PROCESSING REQUIRED
SUBTTL	OPRRMT	Entry and initialization for REMOTE OPR

TOPS10	<
OPRRMT:	JRST	OPR			;ASSUME START 
> ;End TOPS10

TOPS20	<
OPRRMT:	RESET				;RESET THE UNIVERSE
	MOVEM	T1,INPJFN		;INPUT JFN FOR LINK
	MOVEM	T2,MYNODE		;MY NODE
	MOVE	P,[IOWD PDLEN,PDL]	;SET UP STACK
	MOVX	S1,IB.SZ		;GET THE LENGTH
	MOVEI	S2,IPBRMT		;AND THE ADDRESS OF THE ARGS
	$CALL	I%INIT			;INITIALIZE THE WORLD
	SETOM	HDRTAB			;INIT TO USE MAIN TABLES AND PROMPT
	SETZB	S1,S2			;CLEAR S1 AND S2.. NO ARGUMENTS
	$CALL	P$INIT##		;CALL THE PARSER
	$CALL	I%HOST			;GET HOST NAME
	MOVEM	S1,G$NODE		;[6000]SAVE HOST NAME
	$CALL	TABCHK			;CHECK THE TABLES
	SETOM	REMOPR			;REMOTE OPERATOR FLAG
	$CALL	OPRSON			;OPR SIGNON TO ORION
	MOVE	S1,[IPCLEV,,IPCRMT]	;REMOTE IPCF INTERRUPT ROUTINE
	MOVEM	S1,CHNTAB+1		;SAVE IN CHANNEL TABLE
	$CALL	I%ION			;TURN ON INTERRUPTS
	$CALL	REMSET			;SETUP OPR LINKS
	$CALL	WAITCN			;WAIT FOR THE CONNECT
	PJRST	MAIN			;PROCESS NORMALLY
					;DELETE ENTRY IN TABLES ***
> ;End TOPS20
SUBTTL	WAITCN	Wait for output link connect

;THIS ROUTINE WILL WAIT FOR THE CONNECT ON THE OUTPUT LINK 
;BEFORE INITIALIZING THE PROCESS

TOPS20	<

WAITCN:	SKIPE	OUTCON			;OUTPUT CONNECTED
	JRST	WAIT.1			;PROCESS CONNECT AND RETURN
	MOVEI	S1,5			;WAIT FOR 5 SECONDS
	$CALL	I%SLP			;SLEEP FOR A BIT
	JRST	WAITCN			;WAIT FOR THE CONNECTION
WAIT.1:	PJRST 	CONNEC			;DO CONNECT AND RETURN

> ;End TOPS20
SUBTTL	REMSET	Setup OPR links

;THIS ROUTINE WILL SETUP ALL LINKS AND INTERRUPTS FOR THE REMOTE
;OPERATOR

TOPS20	<
REMSET:	SETOM	REMACC			;SET AS REMOTE ACCESS
	$TEXT	(<-1,,DCNDAT>,<DCN:^N/MYNODE/-^D/[DCNTSK]/^0>)
	MOVX	S1,GJ%SHT		;SHOT JFN
	HRROI	S2,DCNDAT		;GET DATA
	GTJFN				;OPEN THE FILE
	  PJRST	REMS.1			;OPEN FAILED
	MOVEM	S1,OUTJFN		;SAVE OUTPUT JFN
	MOVE	S2,[FLD(NETBSZ,OF%BSZ)+OF%RD+OF%WR]
	OPENF				;OPEN THE LINK
	  PJRST	REMS.1			;OPEN FAILED
	MOVE	S1,OUTJFN		;GET THE JFN
	MOVEI	S2,.MOACN		;ACTIVATE CHANNEL
	MOVX	T2,OUTCHN		;OUTPUT CHANNEL
	SETZM	T1			;CLEAR T1
	STORE	T2,T1,MO%CDN		;CONNECT INTERRUPTS
	MTOPR				;DO THE FUNCTION
	ERJMP	REMS.2			;HALT IF FAILS
	MOVE	S1,[IPCLEV,,OUTINT]	;INTERRUPT ENTRY IN CHNTAB
	MOVEM	S1,CHNTAB+OUTCHN	;SAVE IN CHANNEL TABLE
;edit 73
;	MOVE	S1,INPJFN		;GET THE INPUT CHANNEL JFN
;	MOVEI	S2,.MOACN		;ACTIVATE CHANNEL
;	MOVX	T2,INPCHN		;OUTPUT CHANNEL NUMBER
;	SETZM	T1			;CLEAR T1
;	STORE	T2,T1,MO%DAV		;SAVE FOR DATA INTERRUPTS
;	MTOPR				;ACTIVATE THE CHANNEL
;	ERJMP	[HALTF]			;FAIL ..ABORT
	MOVE	S1,[IPCLEV,,INPINT]	;INPUT DATA INTERRUPT
	MOVEM	S1,CHNTAB+INPCHN	;SAVE IN CHANNEL TABLE
	MOVE	S1,INPJFN		;GET THE INPUT JFN
	MOVX	S2,.MOCC		;ACCEPT THE CONNECT
	SETZM	T1			;CLEAR OTHER FLAGS
	MTOPR				;CONFIRM THE CONNECT
	ERJMP	REMS.3			;ERROR..ABORT
	MOVX	S1,.FHSLF		;GET MY HANDLE
	MOVX	S2,<1B<OUTCHN>!1B<INPCHN>>;ACTIVATE THE CHANNELS
	AIC				;TURN ON CHANNELS
	MOVEI	S1,<<OUTSIZ/<^D36/NETBSZ>>+1>;NUMBER OF WORDS NEEDED
	MOVE	T1,S1			;SAVE THE VALUE
	$CALL	M%GMEM			;GET THE MEMORY
	MOVEM	S2,BUFADR		;SAVE THE BUFFER ADDRESS
	MOVE	S1,T1			;GET SIZE OF BUFFER
	$CALL	M%GMEM			;GET INPUT BUFFER
	MOVEM	S2,NETBUF		;NETWORK BUFFER
;***WAIT FOR CONNECT ON OUTPUT LINK
	$RET				;RETURN
REMS.1:	MOVX	S1,E.OPNF		;OPEN FAILURE
	MOVEM	S1,ERRCOD		;SAVE THE CODE
	PJRST	SETFAL			;SETUP FAILURE RETURN WITH ERROR
REMS.2:	MOVX	S1,E.CONF		;CONNECT FAILURE
	MOVEM	S1,ERRCOD		;SAVE THE CODE
	PJRST	SETFAL			;SETUP FAILURE ABORT 
REMS.3:	MOVX	S1,E.ACFL		;ACCEPT CONNECT FAILED
	MOVEM	S1,ERRCOD		;SAVE THE CODE
	PJRST	SETFAL			;ABORT AND SEND FAILURE
> ;End TOPS20
SUBTTL	SETOUT	Setup output of data

;  This routine is called (it appears) before every output.  For local
;operators it clears the output suppress bit if on.  For remote nodes
;it will set up the appropriate headers.

TOPS20	<

SETOUT:: SKIPN	REMACC			;REMOTE OPERATOR?
	JRST	SETO.1			;No, go do the suppress check
	$CALL	SETPTR			;SETUP THE POINTER
	MOVX	S2,1			;COMPLETE RESPONSE CODE
	IDPB	S2,S1			;SAVE THE BYTE
	MOVEM	S1,OUTPTR		;SAVE THE POINTER
	$TEXT	(,<^M^J^N/G$NODE/::^A>)	;[6000]OPR HEADER LINE
	$RET				;RETURN

SETO.1:	MOVX	S1,.PRIOU		;Local so lets clear ^O
	DOBE				;Wait till done with previous
	RFMOD				;Get mode word
	TXZE	S2,TT%OSP		;Turn echo back on (if off)
	SFMOD				;Set mode word if needed
	$RET				;Return
> ;End TOPS20
TOPS10	<
SETOUT:: $RET				;RETURN
> ;End TOPS10

SUBTTL	SNDOUT	Send output over the link

;THIS ROUTINE WILL OUTPUT THE DATA IN THE BUFFER

TOPS20	<
SNDOUT:: SETZM	INTDSP			;CLEAR  OUTPUT DISPLAY FLAG
	SKIPN	REMACC			;REMOTE OPR?
	$RETT				;NO..RETURN
	MOVX	S1,0			;GET A NULL
	IDPB	S1,OUTPTR		;END WITH A NULL
	MOVE	S1,OUTJFN		;OUTPUT JFN
	MOVSI	S2,(POINT NETBSZ,)	;NETBSZ BIT BYTES
	HRR	S2,BUFADR		;BUFFER ADDRESS
	SETZ	T1,			;OUTPUT TILL A NULL
	SOUTR				;SEND THE DATA
	ERJMP	SNDO.1			;ERROR...
	$RET				;RETURN
SNDO.1:	MOVX	S1,E.OUTF		;OUTPUT FAILED
	MOVEM	S1,ERRCOD		;SAVE THE CODE
	PJRST	SETFAL			;SETUP FAILURE..ABORT WITH ERROR
					;STOP THE PROCESS
> ;End TOPS20

TOPS10	<
SNDOUT:: SETZM	INTDSP			;CLEAR  OUTPUT DISPLAY FLAG
	$RETT				;RETURN
> ;End TOPS10
SUBTTL	OUTRTN	Output routine for links

;THIS IS THE TEXT DEFAULT OUTPUT ROUTINE AND WILL SETUP DATA FOR THE 
;LINKS

TOPS20	<
OUTRTN:	SOSG	OUTCNT			;ROOM LEFT
	JRST	OUTR.1			;NO..SEND AND MAKE ROOM
	IDPB	S1,OUTPTR		;SAVE THE BYTE
	$RETT				;RETURN TRUE
OUTR.1:	PUSH	P,S1			;SAVE THE BYTE
	$CALL	SETPTR			;SETUP THE POINTER
	MOVX	S2,2			;RESERVE THE CTY..LONG MESSAGE
	IDPB	S2,S1			;SAVE BYTE AS FIRST ONE
	$CALL	SNDOUT			;SEND THE OUTPUT
	$CALL	SETPTR			;RESET THE POINTERS
	MOVX	S2,3			;RELEASE AFTER THIS MESSAGE
	IDPB	S2,S1			;SAVE THE BYTE
	MOVEM	S1,OUTPTR		;SAVE THE POINTER
	POP	P,S1			;RESTORE THE VALUE
	JRST	OUTRTN			;SAVE THE CHARACTER NOW
SUBTTL	SETPTR	Setup pointers for output

;THIS ROUTINE WILL SETUP THE POINTERS AND RETURN WITH S1 CONTAINING
;THE NEW BYTE POINTER

SETPTR:	MOVEI	S1,OUTSIZ-1		;GET OUTPUT SIZE AND LEAVE ROOM FOR NULL
	MOVEM	S1,OUTCNT		;SAVE THE COUNT
	MOVSI	S1,(POINT NETBSZ,)	;SETUP FOR NETBSZ BIT BYTES
	HRR	S1,BUFADR		;GET BUFFER ADDRESS
	$RET				;RETURN S1 BYTE POINTER
> ;End TOPS20
SUBTTL	INPINT	Input over link interrupt

;THIS ROUTINE WILL FLAG THAT INPUT IS READY OVER THE LINK
TOPS20	<

INPINT:	$BGINT	IPCLEV			;SETUP AT SAME LEVEL
	SETOM	INPDON			;SET INPUT DONE
	$DEBRK				;RETURN


SUBTTL	OUTINT	Output link connected

;THIS ROUTINE WILL FLAG A CONNECT INTERRUPT ON OUTPUT LINK

OUTINT:	$BGINT	IPCLEV			;SETUP THE LEVEL
	SETOM	OUTCON			;OUTPUT CONNECTED
	$DEBRK				;RETURN

SUBTTL	IPCRMT	IPCF interrupt routine for remote OPR

;THIS ROUTINE WILL FLAG IPCF INTERRUPTS ON THE -20 WHEN RUNNING
;AS A REMOTE OPR

IPCRMT:	$BGINT	IPCLEV			;SETUP THE LEVEL
	$CALL	C%INTR			;FLAG THE INTERRUPT
	$DEBRK				;RETURN
SUBTTL	INPDAT	Input the data from link

;THIS ROUTINE WILL READ DATA FROM THE LINK

INPDAT:	SKIPN	INPDON			;GET DATA
	$RETF				;RETURN FALSE
	SETZ	S1,			;CLEAR VALUE
	EXCH	S1,INPDON		;RESET THE FLAG
	MOVE	S1,INPJFN		;GET THE INPUT JFN
	MOVSI	S2,(POINT NETBSZ,)	;NETBSZ BIT BYTES
	HRR	S2,NETBUF		;NETWORK DATA
	MOVNI	T1,OUTSIZ		;GET THE OUTPUT SIZE
	SINR				;READ THE DATA
	  ERJMP	INPD.1			;ERROR..EXIT
	HRRZ	T3,T1			;SAVE THE NEW COUNT
	SETZ	S1,			;CLEAR S1 
	IDPB	S1,S2			;SAVE A NULL ON THE END
	MOVE	S1,INPJFN		;GET THE JFN
	MOVEI	S2,.MORLS		;READ THE LINK STATUS
	SETZ	T1,			;CLEAR FOR STATUS
	MTOPR				;GET THE STATUS
	ERJMP	INPD.1			;ERROR..ABORT
	TXNN	T1,MO%CON		;CHECK IF STILL CONNECTED?
	PJRST	INPD.1			;NO.. ABORT THE PROCESS
	TXNE	T1,MO%EOM		;DATA AVAILABLE
	SETOM	INPDON			;SET THE FLAG
	SUBI	T3,-OUTSIZ		;GET NUMBER OF CHARACTERS READ
	CAIG	T3,2			;GREATER THAN MINIMUM MESSAGE
	$RETF				;NO..RETURN FALSE
	$RETT				;RETURN TRUE
INPD.1:	MOVX	S1,E.INPF		;INPUT FAILED
	MOVEM	S1,ERRCOD		;SAVE THE CODE
	PJRST	SETFAL			;SEND SETUP FAILURE
SUBTTL	CONNEC	Process connect message

;THIS ROUTINE WILL PROCESS THE CONNECT MESSAGE FOR THE OUTPUT
;LINK

CONNEC:	SKIPN	OUTCON			;OUTPUT CONNECT
	$RETT				;NO..RETURN
	SETZ	S1,			;CLEAR FLAG
	EXCH	S1,OUTCON		;CLEAR FLAG
	MOVE	S1,OUTJFN		;GET OUTPUT JFN
	MOVEI	S2,.MORLS		;READ LINK STATUS
	MTOPR				;GET THE STATUS
	  ERJMP CONN.1			;ERROR..HALT
	TXNN	T1,MO%WCC!MO%CON	;CONNECT MADE
	  JRST CONN.2			;BAD CONNECT DATA
	SETOM	OUTACT			;SET FLAG
	$RETT				;RETURN
CONN.1:	MOVX	S1,E.STSF		;STATUS OF SERVER FAILED
	MOVEM	S1,ERRCOD		;SAVE THE CODE
	PJRST	SETFAL			;SETUP FAILURE..ABORT WITH ERROR
CONN.2:	MOVEM	T1,ARG1			;SAVE THE ARGUMENT
	MOVX	S1,E.INVC		;INVALID CONNECT DATA
	MOVEM	S1,ERRCOD		;SAVE THE CODE
	PJRST	SETFAL			;SETUP FAILURE..ABORT WITH ERROR
> ;End TOPS20
SUBTTL	TXTLIN	Check if multiple line input allowed

;THIS ROUTINE WILL CHECK IF USER IS REMOTE OPERATOR ON THE -20
;AND IF SO NOT ALLOW MULTIPLE LINE INPUT

TXTLIN:: SKIPN	REMOPR			;ARE WE A REMOTE OPERATOR
	PJRST	TXTINP##		;NO..GO GET THE TEXT
TOPS20	<
	MOVEI	S2,[ASCIZ/Multiple line text not allowed for remote operators/]
	$RETF
> ;End TOPS20
TOPS10	<
	$RETT				;RETURN O.K.
> ;End TOPS10
SUBTTL	SETFAL	Send a setup failure for OPR errors

;THIS ROUTINE WILL SEND A SETUP FAILURE TO SHUTDOWN AN OPR
;ON AN ERROR

SETFAL:	$CALL	SETMES			;SETUP MESSAGE
	MOVX	S1,.ORFAL		;SETUP FAILURE
	STORE	S1,ARG.HD+.OHDRS(M),AR.TYP	;SAVE IN MESSAGE
	MOVEI	T1,.OHDRS+ARG.DA(M)	;POINT TO NEXT ARGUMENT
	MOVX	S1,.CMTXT		;TEXT ARGUMENT
	STORE	S1,ARG.HD(T1),AR.TYP	;SAVE THE TYPE
	MOVEI	S1,ARG.DA(T1)		;ADDRESS TO STORE DATA
	HRLI	S1,(POINT 7,0)		;MAKE BYTE POINTER
	MOVEM	S1,TEMPTR		;SAVE THE POINTER
	MOVE	S1,ERRCOD		;GET ERROR CODE
	CAILE	S1,E.MAXE		;WITHIN BOUNDS
	$STOP(IEC,Invalid error code for failure)
	$TEXT	(SETTXT,<^I/@OPRTXT(S1)/>^0);SAVE THE TEXT
	HRRZ	S1,TEMPTR		;GET THE POINTER
	AOS	S1			;BUMP THE LENGTH
	ANDI	S1,777			;GET LENGTH OF BLOCK
	STORE	S1,.MSTYP(M),MS.CNT	;SAVE MESSAGE SIZE
	SUBI	S1,.OHDRS+1		;GET LENGTH OF TEXT
	STORE	S1,ARG.HD(T1),AR.LEN	;SAVE THE LENGTH
	AOS	.OARGC(M)		;BUMP ARGUMENT COUNT
	MOVE	S1,M			;ADDRESS OF MESSAGE
	$CALL	I%SOPR			;SEND THE MESSAGE
	$HALT				;HALT THE OPR
	$RETT				;RETURN
SETTXT:	IDPB	S1,TEMPTR		;SAVE THE DATA
	$RETT				;RETURN


	DEFINE	X(A,B),<
	EXP	[ITEXT B]
> ;End X
OPRTXT:	ERROPR				;ERROR CODES FOR OPR
SUBTTL	PUSHRT	Process the PUSH command (TOPS20)

TOPS20	<

PUSHRT:: SKIPE	REMOPR			;REMOTE OPERATOR?
	  JRST	NOREMT			;NO REMOTE PUSHS ALLOWED
	$CALL	P$NPRO##		;NO PROCESSING REQUIRED
	SKIPE	S1,FRKHND		;ALREADY HAVE A FORK WITH EXEC
	JRST	PUSH.1			;GO TO PUSH RETURN
	MOVX	S1,GJ%SHT!GJ%OLD	;SHORT FORM, OLD FILE
	HRROI	S2,[ASCIZ/DEFAULT-EXEC:/]
	GTJFN
	   JRST	NOEXEC			;NO EXEC
	MOVEM	S1,FRKJFN		;SAVE FORK JFN
	MOVX	S1,CR%CAP		;GIVE FORK CAPABILITIES
	CFORK				;CREATE THE FORK
	  JRST NOFORK
	MOVEM	S1,FRKHND		;SAVE FORK HANDLE
	HRLZS	S1			;PLACE IN LEFT HALF
	HRR	S1,FRKJFN		;JFN IN THE FIGHT HALF
	GET				;NOW GET THE EXEC INTO THE LOWER FORK
	MOVEI	S1,.FHSLF		;DONT ALLOW LOWER FORK TO LOG OUT
	RPCAP				;GET CAPABILITIES OF INFERIOR
	TXZ	S2,SC%LOG		;DO NOT ALLOW LOGOUT
	SETZ	T1,			;NO PRIVILEGES ENABLED
	MOVE	S1,FRKHND		;GET THE FORK HANDLE
	EPCAP				;SET ITS CAPABILITIES
	  ERJMP NOCAP			;TRAP THE ERROR
	MOVEI	S1,.FHJOB		;GET THE JOB HANDLE
	TXO	S1,RT%DIM		;GET DEFERRED ALSO
	RTIW				;READ TERMINAL INTERRUPT CHARACTERS
	DMOVEM	S2,SAVTWD		;SAVE TERMINAL WORDS
	MOVEI	S1,.PRIIN		;PRIMARY INPUT JFN
	RFMOD				;GET THE MODE
	MOVEM	S2,SAVMOD		;SAVE THE MODE
	MOVE	S1,FRKHND		;GET THE FORK HANDLE
PUSH.1:	SETZ	S2,			;USE PRIMARY START ADDRESS
	SFRKV				;START THE EXEC
	SETOM	FRKRUN			;SETOM FORK RUN
	$RETT				;RETURN

NOEXEC:	MOVEI	S2,[ASCIZ/Unable to find DEFAULT-EXEC: for PUSH command/]
	$RETF				;RETURN FALSE
NOFORK:	MOVEI	S2,[ASCIZ/Unable to create fork for PUSH command/]
	$RETF				;RETURN FALSE
NOREMT:	MOVEI	S2,[ASCIZ/PUSH command not allowed for remote operators/]
	$RETF				;RETURN FALSE
NOCAP:	MOVE	S1,FRKHND		;GET THE FORK HANDLE
	KFORK				;KILL THE PROCESS
	ERJMP	.+1			;IGNORE THE ERROR
	SETZM	FRKHND			;CLEAR THE FORK HANDLE
	MOVEI	S2,[ASCIZ/Unable to enable forks capabilities for PUSH command/]
	$RETF				;RETURN FALSE
> ;End TOPS20
SUBTTL	TERMFK	Process fork termination interrupt

TOPS20	<

TERMFK:	$BGINT	1			;INIT INTERRUPT LEVEL
	SKIPN	FRKRUN			;WERE WE RUNNING
	$DEBRK				;IGNORE IT
;	$STOP(FTE,Fork termination error .. fork was not running)
	SETZM	FRKRUN			;CLEAR THE RUNNING FORK FLAG
	MOVX	S1,.PRIIN		;GET PRIMARY INPUT
	MOVE	S2,SAVMOD		;GET THE MODE
	SFMOD				;SET OLD MODE BACK
	MOVX	S1,ST%DIM		;SET ALL WORDS
	HRRI	S1,.FHJOB		;FOR THE JOB
	DMOVE	S2,SAVTWD		;GET TERMINAL WORDS
	STIW				;SET THE WORDS
	ERJMP	.+1			;IGNORE THE ERROR..
	$DEBRK				;DEBRK THE INTERRUPT

> ;End TOPS20
SUBTTL	OPRSON	OPR signon to ORION

;THIS ROUTINE WILL SEND THE OPR HELLO MESSAGE TO ORION AND
;THEN WAIT FOR THE ORION SETUP. THE ORION SETUP WILL BE FOLLOWED
;BY A SETUP REPLY AND THE OPR WILL BE READY FOR COMMANDS.

OPRSON:	$CALL	M%GPAG			;GET A PAGE FOR THE HELLO
	MOVE	M,S1			;SAVE ADDRESS IN M
	MOVX	S1,.OMOHL		;OPR HELLO MESSAGE
	STORE	S1,.MSTYP(M),MS.TYP	;SAVE THE TYPE
	MOVX	S1,OPH.SZ+.OHDRS	;SIZE OF THE MESSAGE
	STORE	S1,.MSTYP(M),MS.CNT	;SAVE THE SIZE
	AOS	.OARGC(M)		;BUMP COUNT TO 1
	MOVX	S1,.OPHEL		;OPR HELLO BLOCK
	STORE	S1,ARG.HD+.OHDRS(M),AR.TYP ;SAVE THE TYPE
	MOVX	S1,OPH.SZ		;SIZE OF ARGUMENT BLOCK
	STORE	S1,ARG.HD+.OHDRS(M),AR.LEN ;SAVE THE LENGTH
	MOVE	S1,MYNODE		;GET CURRENT LOCATION
	STORE	S1,OPH.ND+.OHDRS(M)	;SAVE THE NODE
	MOVX	S1,OMCEDT		;ORNMAC VERSION NUMBER
	STORE	S1,OPH.OV+.OHDRS(M)	;SAVE IN BLOCK
	MOVE	S1,[BYTE (3)OPRWHO(9)OPRVER(6)OPRMIN(18)OPREDT] ;[6007]
	STORE	S1,OPH.VN+.OHDRS(M)	;SAVE IN BLOCK
	MOVEI	S1,C.GALA		;[6005]PICK UP CLUSTER GALAXY OPTION VALUE
	STORE	S1,OPH.CG+.OHDRS(M)	;[6005]PLACE IN THE MESSAGE
TOPS20	<
	MOVX	S1,OP.RMT		;GET REMOTE OPERATOR FLAG
	SKIPE	REMOPR			;ARE WE A REMOTE OPERATOR
	IORM	S1,.OFLAG(M)		;YES..TURN ON THE FLAG
> ;End TOPS20
	MOVE	S1,M			;PLACE MESSAGE ADDRESS IN S1
	$CALL	I%SOPR			;SEND THE MESSAGE TO ORION
	SKIPT				;CONTINUE IF SEND O.K.
	$STOP(OSF,ORION send failed)	;CAN'T INITIATE DIALOG
OPRS.1:	$CALL	C%BRCV			;BLOCKING RECEIVE THE MESSAGE
	$CALL	VALMSG			;VALIDATE THE MESSAGE
	JUMPT	OPRS.3			;O.K. CONTINUE ON
OPRS.2:	$CALL	C%REL			;NO GOOD..TRY AGAIN
	JRST 	OPRS.1			;WAIT FOR ANOTHER MESSAGE
OPRS.3:	LOAD	M,MDB.MS(S1),MD.ADR	;ADDRESS OF RECEIVED MESSAGE
	LOAD	T1,.MSTYP(M),MS.TYP	;GET THE MESSAGE TYPE
	CAIE	T1,.OMOST		;OPERATOR SETUP MESSAGE
	JRST	OPRS.4			;NO..TRY TEXT COULD BE ERROR
	$CALL	OPRRST			;OPR REPLY TO SETUP
	SKIPT				;O.K...PROCEED
	$STOP(SFO,Setup failure by OPR)
	PJRST	C%REL			;RELEASE THE PAGE AND RETURN
OPRS.4:	CAIE	T1,MT.TXT		;ERROR TEXT MESSAGE
	JRST	OPRS.2			;NO..TRY AGAIN
	$CALL	ACKOPR			;PROCESS AS ACK OPR
	$CALL	EXIT			;EXIT TO COMMAND LEVEL
SUBTTL	OPRRST	OPR reply to setup 

;THIS ROUTINE WILL PROCESS THE SETUP AND SEND THE
;APPROPRIATE REPLY TO ORION.


OPRRST:	SKIPE	.OARGC(M)		;ANY ARGUMENTS SPECIFIED
	JRST	OPRR.1			;YES PROCESS THE MESSAGE
;**;[6012]Replace 2 lines with 7 lines at OPRRST:+2L   PMM 6/3/90
	$STOP(IVO,Inconsistent versions of OPR and ORION)	;[6012]Old ORION
OPRR.1:	MOVE	S2,.IPCFR(S1)		;[6012]Get OPR's PID
	MOVEM	S2,G$PID		;[6012]Save in global storage
	$CALL	UPDAKA			;[6012]Update the alias keyword table 
	$CALL	SETREP			;[6012]Send SETUP REPLY to ORION
	$RETT				;[6012]Everything is okay
SUBTTL	SETREP	Setup reply message

;THIS ROUTINE WILL SEND A SETUP REPLY TO ORION SAYING THAT ALL
;IS O.K.

SETREP:	$CALL	SETMES			;SETUP THE MESSAGE
	MOVE	S1,M			;ADDRESS OF THE MESSAGE
	$CALL	I%SOPR			;SEND TO ORION
	$RETIT				;ALL O.K.
	$STOP(SDF,Setup dialog failed)
SUBTTL	SETMES	Setup message reply

SETMES:	$CALL	M%GPAG			;GET A PAGE OF MEMORY
	MOVE	M,S1			;SAVE THE ADDRESS IN M
	MOVX	S1,.OMOSR		;SETUP REPLY CODE
	STORE	S1,.MSTYP(M),MS.TYP	;SAVE THE TYPE
	MOVX	S1,1			;LENGTH OF THE ARGUMENT
	STORE	S1,ARG.HD+.OHDRS(M),AR.LEN	;SAVE LENGTH
	MOVX	S1,.ORSUC		;GET SUCCESS CODE
	STORE	S1,ARG.HD+.OHDRS(M),AR.TYP	;SAVE THE TYPE
	MOVX	S1,.OHDRS+1		;SIZE OF THE MESSAGE
	STORE	S1,.MSTYP(M),MS.CNT	;SAVE THE COUNT
	MOVE	S1,M			;PUT ADDRESS IN S1
	AOS	.OARGC(M)		;BUMP ARGUMENT COUNT
	$RET				;RETURN
SUBTTL	TABCHK	Routine to check out syntax tables

;THIS ROUTINE WILL CHECK OUT THE ENTRY BLOCK SETUP BY 
;EACH TABLE FOR THE PROPER LENGTH AND NON-ZERO ENTRIES

TABCHK:	MOVEI	T3,SYNTAB		;ADDRESS OF TABLE OF TABLES
	SKIPG	OPRTYP			;[6001]SEMI-OPR?
	MOVEI	T3,SEMTAB		;[6001]YES
	MOVE	T4,T3			;[6001]SAVE ADDRESS OF TABLE
	MOVE	T1,(T3)			;GET THE FIRST TABLE
	SKIPN	T2,TABNUM		;NON-ZERO NUMBER OF ENTRIES
	$STOP(ZTS,Zero tables setup for OPR)
	JRST	TABC.1			;SKIP BUMPING TO NEXT TABLE
TABC.0:	ADDI	T3,1			;BUMP TO NEXT ENTRY
	SKIPN	T1,(T3)			;BUMP TO NEXT TABLE ADDRESS
	$STOP(MST,Missing syntax table)
TABC.1:	LOAD	S1,TAB.HD(T1),TB.LEN	;LENGTH OF BLOCK
	CAIGE	S1,TAB.SZ-1		;GREATER OR EQUAL TO LENGTH
	$STOP(WLT,Wrong length table entry block)
	SKIPE	TAB.IN(T1)		;ZERO INIT TABLE
	SKIPN	TAB.KY(T1)		;OR ZERO KEYWORD TABLE
	$STOP(ZTE,Zero entry in syntax table entry block)
	SOJG	T2,TABC.0		;CHECK OUT ALL TABLES
	MOVE	S1,T4			;[6002]GET ADDRESS OF OPR TABLE BACK
	MOVE	S2,TAB.KY(S1)		;ADDRESS OF MAIN KEYWORD TABLE
	MOVEM	S2,DEFTAB		;SAVE AS DEFAULT TABLES

TABC.2:	MOVSI	S2,-<NUMAPL>		;GET NUMBER OF ENTRIES
TABC.3:	SKIPN	T1,SYNTAB+1(S2)		;GET THE TABLE ENTRY
	JRST	TABC.4			;SKIP IT TRY NEXT
	MOVE	T2,TAB.KY(T1)		;GET THE KEYWORD TABLE
	HRRZ	T3,KEYAP1+1(S2)		;ADDRESS OF SYMBOL AND NEXT
	HRRM	T2,(T3)			;SETUP TABLE POINTER
TABC.4:	AOBJN	S2,TABC.3		;CHECK FOR MORE
	$RET				;RETURN
SUBTTL	GETLOC	Get OPR location

;THIS ROUTINE WILL DETERMINE THE JOBS LOCATION AND STORE THE
;VALUE IN MYNODE.

GETLOC:	SETOM	S1			;GET MY LOCATION
	MOVX	S2,JI.LOC		;GET THE JOBS LOCATION
	$CALL	I%JINF			;GET THE LOCATION
	SKIPT				;SKIP IF O.K.
	SETZ	S2,			;MAKE 0 FOR NOW
	MOVEM	S2,MYNODE		;SAVE AS MYNODE
	$RETT				;RETURN

;[6001]
;OPRCHK - SETS OPRTYP TO SEMI-OPR OR OPR.  CALL AT STARTUP ONLY.
;ACCEPTS NOTHING
;RETURNS OPRTYP SET.
;0=NO OPR  1=OPR  -1=SEMI-OPR

OPRCHK:	SETZM	OPRTYP			;0=NO OPR TYPE YET
	MOVEI	S1,.FHSLF		;SELF
	RPCAP				;READ CAPS
	 ERJMP .+1			;SHOULD NOT FAILED
	TXNN	T1,SC%WHL!SC%OPR	;WHEEL OR OPERATOR?
	JRST	OPRCH1			;NO, ARE WE SEMI-OPR?
	AOS	OPRTYP			;1=WHEEL
	$RETT

OPRCH1:	TXNE	T1,SC%SEM		;SEMI-OPR?
	SETOM	OPRTYP			;-1=SEMI-OPR
	$RETT				;

SUBTTL	EXIT	Temp routine to perform exit

;  The purpose of this routine is to avoid the problem of exiting
;  while output is pending on the 20.  The problem is I%EXIT performs
;  a RESET immediately.  This causes any pending output to the terminal
;  to be flushed.  As a result, an error message that tells the user
;  why he can't run OPR gets clobbered.

EXIT:
TOPS20<
	MOVEI	S1,.PRIOU		;Get the TTY output designator
	DOBE				;Wait till done
	  JFCL				;Don't care about errors
> ; End of TOPS20

	$CALL	I%EXIT			;Now go and exit
					;And never return

TOPS10 <END	OPR>			;ALLOW FOR CCL START AT OPR
TOPS20 <END	<3,,ENTVEC>>		;USE ENTRY VECTOR FOR TOPS20