Google
 

Trailing-Edge - PDP-10 Archives - BB-H138D-BM - galaxy-sources/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	Murry Berkowitz/PJT	1-Jan-82


;
ASCIZ /
         COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION
	   1975,1976,1977,1978,1979,1980,1981,1982
/
;
;     THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED
;     AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
;     AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS
;     SOFTWARE  OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
;     OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON.  NO  TITLE  TO
;     AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
;     THE INFORMATION  IN  THIS  SOFTWARE  IS  SUBJECT  TO  CHANGE
;     WITHOUT  NOTICE  AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
;     BY DIGITAL EQUIPMENT CORPORATION.
;
;     DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
;     OF  ITS  SOFTWARE  ON  EQUIPMENT  WHICH  IS  NOT SUPPLIED BY
;     DIGITAL.

	SEARCH	GLXMAC

	.directive flblst
	PROLOG	(OPR)
	SEARCH	ORNMAC

	EXTERNAL PAREDT,CMDEDT



	OPRWHO==0
	OPRVER==4
	OPRMIN==0
	OPREDT==145

	%%.OPV==<VRSN.(OPR)>+CMDEDT+PAREDT

	.JBVER==137

	LOC	.JBVER
	EXP	%%.OPV
	RELOC

ENTVEC:	JRST	OPR			;MAIN ENTRY POINT
	JRST	OPRRMT			;REMOTE	OPR ENTRY
	EXP	%%.OPV			;VERSION
SUBTTL	Table of Contents

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

COMMENT \

Edit	Module	When		Change

1	OPR	31-May-77	First Development version on SYS (TOPS20)

2	OPR	1-Jun-77	Add code to handle WRITE-TO-OPR messages.

3	OPR	5-Jun-77	Add code to handle JFN's properly and
				to fill in defaults.

4	OPR	7-Jun-77	Convert to new initialization to use
				new GLXLIB.
5	OPR	14-Jun-77	Change .CMNUM and .CMNUX to save full words
				rather than half words
6	OPR	17-Jun-77	Implement TAKE Command.

7	OPR	24-Jun-77	Change to use GALAXY TEXT message for acknowledgement

10	OPR	27-Jun-77	Fix SAVFIL to correctly save an FD.

11	OPR	30-Jun-77	Add PR.INF to save radix on number type fields

12	OPR	12-July-77	Clean up error handling

13	OPR	12-July-77	Make WTO with no object type work

14	OPR	26-Aug-77	Don't include generation number in filespec
				for output

15	OPR	20-Sept-77	Make this be version 2

16	OPR	22-July-77	Add interrupt system for TOPS10

17	OPR	8-August-77	Convert to use GLXSCN on both TOPS10 and
				TOPS20

20	OPR	19-August-77	Make SAVTOK work correctly

21	OPR	19-August-77	Make all negative numbers illegal

22	OPR	19-August-77	Remove Edit 15 which was a Release 3 only hack
23	OPR	19-August-77	Fix ill mem ref as a result of undefined
				results in S2 from COMND

24	OPR	21-September-77	Complete changes to usd GLXSCN

25	OPR	22-September-77	Make TAKE command work on TOPS10

26	OPR	26-Sep-77	Don't reset INCMIN until entire command has
				been processed.

27	OPR	11-Oct-77	Add SET TERMINAL command. Also add global
				flag NOSND to indicate no message should be
				sent to ORION for this command

30	OPR	19-Oct-77	Add SET TERMINAL MESSAGES and 
				SET TERMINAL NODE commands.

31	OPR	21-Oct-77	Fix race in message processing- don't
				change pc if we are already processing messages
32	OPR	10-Nov-77	Add file spec defaults for TOPS-10

33	OPR	11-Nov-77	Add neww terminal types Keypad VT52 and VT50

34	OPR	11-Nov-77	Add new Operator Display Message to allow
				multiple WTO's in one display message

35	OPR	13-Nov-77	Make DSPOPR routine process
				multiple WTO's in one display message
36	OPR	18-Nov-77	Add code for multiple line RESPOND

37	OPR	18-Nov-77	Add code for SHOW DAYTIME

40	OPR	23-Nov-77	Change BLDCOM to use symbols for COMMAND message

41	OPR	2-Dec-77	Add code for multiple line SEND and multiple
				line explanation for CANCEL

42	OPR	6-Dec-77	Add code to include text of command in COMMAND
				message.

43	OPR	4-Jan-78	Support switch delete code in OPRTAB

44	OPR	17-Jan-78	Make sure all text is passed in message

45	OPR	2-Feb-78	Add new Display,WTO,WTOR,Ack message 
				processing

46	OPR	10-Feb-78	Add FLAG AC and fix up WTO,WTOR,ACK

47	OPR	18-April-78	Remove the Parser from OPR and make OPRPAR

50	OPR	12-June-78	Remove the display routines and use K%SOUT

51	OPR	20-June-78	Fix OPR Interrupt code with K%TPOS and 
				S%EXIT

52	OPR	28-Jun-78	Move DSPTAK, OPRTAK, and PRMTSZ to 
				OPRPAR

53	OPR	15-Jul-78	Remove all .REQUIRE Statements so they
				may be moved to OPR.CMD
54	OPR	20-July-78	Fix OPRSON to display errors and exit

55	OPR	1-Aug-78	Add Counter to cleanup Core in OPR since
				Page Fault Handler might take to long
56	OPR	2-Aug-78	Remove the "CURRENT DATE AND TIME"
				text from SHWDAY.
57	OPR	3-Aug-78	Eliminate the text "ERROR:" from all
				error messages and replace it with
				"<CRLF>?". The effected label is MAIN.6.
60	OPR	16-Aug-78	Add support for NCP and correct ADJBP 
61	OPR	31-Aug-78	Add SHOW Message display for QUASAR
62	OPR	5-Sept-78	Add EXIT command
63	OPR	8-Sept-78	Add P.ENDT for end of Take File
				Also have PARSER CLOSE UNUSED JFNS ON -20
64	OPR	12-Sept-78	Move TXTINP and GETTXT to OPRPAR
65	OPR	29-Sept-78	Remove MSGCNT for releasing up Memory since
				Library will take care of it.
66	OPR	23-Oct-78	Add TABAPL macro to get Application names
				and symbols
67	OPR	9-Nov-78	Have EXIT use I%EXIT to terminate
70	OPR	30-Nov-78	Add new  form of OPR hello message to ORION
71	OPR	4-Dec-78	Have EXIT use $HALT to enable Continue to work
72	OPR	19-Dec-78	Add DN200 code and OPRRMT as reenter address
73	OPR	21-Dec-78	Change to let superior IIC on Data Interrupts 
				for DN200
74	OPR	2-Jan-79	Add Link Status Checks for DN200 Input 
				to check for more data
75	OPR	5-Jan-79	Convert KEYTAB to ORNDSP Macro to be compatible
				with standard PARUNV
76	OPR	5-Jan-79	Add TXTLIN to OPR to check if Multiple Line
				Input allowed before calling TXTINP
77	OPR	8-Jan-79	Convert to new GLXLIB and $STOP taking ITEXT
100	OPR	10-Jan-79	Add OP.RMT to flags word for Remote Operator
				on the -20.
				AND GET CURRENT LOCATION ON THE -20 BEFORE HELLO
101	OPR	18-Jan-79	Add OPR HELP Command Action Support and create
				NOPROC to mark no processing in the message
102	OPR	24-Jan-79	Add null to text from Network after SINR
103	OPR	26-JAN-79	CONVERT TO .REQUIRE FOR APPLICATION TABLES
104	OPR	23-Feb-79	Add Timer Trap for OPR wakeup as well as
				P$INIT support. Use P$INTR at INT:
105	OPR	27-Feb-79	Support to output Prompt if displayed something
				on interrupt breakout
				Also Send Message to ORION on Take End
106	OPR	5-Mar-79	Add P$NPRO to set no Processing in Parser Return
				Flags
				Add PUSH Command Support
107	OPR	15-Mar-79	Clear Interrupt System on -20 to Remove IPCF
				Interrupt from SIGNON Dialog
110	OPR	6-Apr-79	Add TAKOPR routine to check if TAKE commands
				are allowed, also clear OPRs Data base on start
111	OPR	8-Apr-79	Check ENTER Command for Remote Operators
				Pitch Short NSP Messages (less than or equal to
				2)
				These were just cr,lf
112	OPR	19-Apr-79	Remove terminal type keys.  Parse directly into
				ORNMAC .TTxxx codes suitable for K%STYP.
				OPRCMD
113	OPR	15-May-79	Add MSGCNT to keep track if there were any 
				messages received
114	OPR	30-May-79	Add WAIT command to Application alternate Tables
115	OPR	4-Jun-79	Change SETFAL to add a null to the end of the
				message instead of ^A.
116	OPR	21-Jun-79	Remove the CMDBLK as External reference and use
				PRT.CF for the field.
117	OPR	6-Jul-79	Make the WAIT command invisible
120	OPR	11-Jul-79	Trap Error on EPCAP for the PUSH command incase
				ACJ won't allow it.
121	OPR	25-Jul-79	Fix the -20 DN200 OPR to check for MO%CON to
				insure that the link is still around
122	OPR	30-Aug-79	Add new KEYTAB entries for the -10
123	OPR	28-Oct-79	Add code to do an Auto take of
				SYS:OPRnn.CMD or TTYnnn.CMD on CCL
				entry
124	OPRCMD	17-MAR-80	Change ROUTE command tables for DEVICE routing.
125	OPR	14-May-80	Edit to change mixed messages to first word
				mixed case and the rest lower
126	OPR	15-May-80	Change BLOCK assignments to $DATA
127	OPR	 1-Aug-80	Add support for Control-Z (TOPS-10 style
				exits.
130	OPR	7-Oct-80	QAR # 10-04645  Fix OPR to wake up for
				IPCF message typeout.  Added routines
				SETIME, CLTIME and ROUTIM.

131	OPR	17-Dec-80	Increase size of PDL to avoid stopcodes
				in P$HELP.
132	OPR	10-Jan-81	Fix bug in PRCMSG which caused ILM stopcodes
133	OPR	26-Jan-81	Add another escape table (VT1TAB) to handle
				VT100 escape sequences.
134	4/2/81  Add detached job trapping.  Tell ORION to forget about
	the operator.  Add routine DET.
135	4/7/81  Make detached job trapping under TOPS10 conditionals.
136	5/5/81  Add routine EXIT to temporarily solve the problem with
	routine I%EXIT smashing output buffers.  Make all calls to I%EXIT
	call EXIT instead.
	Make ROUTIM save and restore AC's
137	9/21/81  Make the wait command in the application tables visible.
140	9/23/81  Clear output suppress before next output @SETOUT.
141	9/28/81  Allow ^Z exit when application code is turned on.
142	11/11/81 Fix a Typo in an AOS S1,1 instruction.
143	12/14/81 Reset core limits on exit.
144	 1/ 8/82 Remove call to I%RLIM. Don't need it anymore.
145	11/9/82  Fix copyright.  GCO 4.2.1528
\
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

;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
	$DATA	HOSTNM,1			;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	LEV1PC,1
	$DATA	LEV2PC,1
	$DATA	LEV3PC,1

> ;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),<EXP	C	;SET UP ADDRESS OF EACH ENTRY
	EXTERNAL C			;SET UP AS EXTERNAL
	.REQUIRE C>

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) >	;ORANGE TOADS DON'T UNDERSTAND THIS
	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

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

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

KEYAP1:	$STAB				;START TABLE OF NAMES
	TABAPL				;EXPAND APPLICATION ENTRIES
	$ETAB
SUBTTL	OPR	Main entry and initialization

OPR:	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,HOSTNM		;SAVE HOST NAME
	$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
	JRST	MAIN			;START PROCESSING AT MAIN
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
MAIN.S:	$CALL	I%SOPR			;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




CMDPMT:	ITEXT	(<^M^J^T/@PARBLK+PAR.PM/>)
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
	$CALL	VALMSG			;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
	JRST	PRCM.0			;LOOP BACK FOR MORE MESSAGES

DSPTAB:	.OMDSP,,DSPOPD
	.OMWTR,,WTRDSP
	.OMACS,,SHWDSP
	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	T1,ARG.HD+.OHDRS(M),AR.TYP	;GET ARGUMENT TYPE
	CAIE	T1,.CMTXT		;IS IT TEXT
	$RETF				;NO...RETURN
	LOAD	T1,ARG.HD+.OHDRS(M),AR.LEN	;GET THE LENGTH CODE
	ADDI	T1,.OHDRS		;LENGTH OF MESSAGE
	LOAD	T2,.MSTYP(M),MS.CNT	;GET MESSAGE LENGTH
	CAMLE	T1,T2			;MESSAGE IN BOUNDS
	$RETF				;NO..IGNORE MESSAGE
	MOVEI	T1,ARG.DA+.OHDRS(M)	;ADDRESS OF DATA
	$CALL	SETOUT			;SETUP FOR OUTPUT
	$TEXT	(,<
^C/[-1]/	--^T/(T1)/-->)		;OUTPUT TEXT
	HRRZ	S1,.MSFLG(M)		;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
	LOAD	S2,ARG.HD(T2),AR.LEN	;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
	$STOP(IDM,Message argument type ^O/S1/ not valid for display messages)
	MOVEI	S1,ARG.DA(T2)		;ADDRESS OF TEXT
	JRST	DSPO.2			;OUTPUT THE TEXT
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
SHWD.1:	LOAD	S1,ARG.HD(T2),AR.TYP	;GET THE TYPE FIELD
	CAIE	S1,.ORDSP		;IS IT DISPLAY
	JRST	SHWD.3			;NO CHECK FOR TEXT
	$CALL	SETOUT			;SETUP FOR OUTPUT
	$TEXT	(,<^M^J^C/ARG.DA(T2)/		--^T/ARG.DA+1(T2)/-->)
	SKIPA				;GET NEXT ARGUMENT
SHWD.2:	$CALL	DSPMSG			;OUTPUT THE TEXT
	LOAD	S2,ARG.HD(T2),AR.LEN	;GET LENGTH OF BLOCK
	ADD	T2,S2			;BUMP TO NEXT BLOCK
	SOJG	T1,SHWD.1		;GET NEXT BLOCK
	PJRST	SNDOUT			;SEND THE OUTPUT
SHWD.3:	CAIE	S1,.CMTXT		;WAS IT JUST TEXT
	JRST	S..IDM			;INVALID DISPLAY MESSAGE TYPE
	MOVEI	S1,ARG.DA(T2)		;ADDRESS OF TEXT
	JRST	SHWD.2			;OUTPUT THE TEXT
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
	MOVE	T1,TAB.IN(S1)		;ADDRESS OF .CMINI FOR TABLES
	STORE	T1,PARBLK+PAR.TB	;SAVE THE TABLE ADDRESS
	HLRZ	T2,KEYAP1		;APPLICATION KEYWORD TABLE
	SKIPN	T2			;ANY ENTRIES IN TABLE
	JRST	TABS.2			;NO..DON'T SET UP ALTERNATE
	MOVE	T3,TAB.KY(S1)		;GET MAIN KEYWORD TABLE
	MOVEI	T2,APLTAB		;ADDRESS OF THE TABLE PDB
	AOS	T2			;POSITION TO THE DATA
	STORE	T2,.CMFNP+1(T3),CM%LST	;SAVE AS ALTERNATE TABLE
TABS.2:	MOVE	S1,OPRPMT		;ADDRESS OF THE PROMPT
	JRST	TABS.0			;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),<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,HOSTNM		;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/HOSTNM/::^A>)	;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/SYSTEM:EXEC.EXE/]
	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 SYSTEM:EXEC.EXE 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,%%.OPR		;ORNMAC VERSION NUMBER
	STORE	S1,OPH.OV+.OHDRS(M)	;SAVE IN BLOCK
	MOVX	S1,%%.OPV		;OPRS VERSION NUMBER
	STORE	S1,OPH.VN+.OHDRS(M)	;SAVE IN BLOCK
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
	PJRST	SETREP			;SEND SETUP REPLY AND RETURN
OPRR.1:	$RETF				;****NOT SUPPORTED YET
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
	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,SYNTAB		;ADDRESS OF MAIN OPR TABLES
	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

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