Google
 

Trailing-Edge - PDP-10 Archives - bb-bt99l-bb - glxint.x18
There is 1 other file named glxint.x18 in the archive. Click here to see a list.
TITLE	GLXINT - Operating system interface for GALAXY
SUBTTL	Irwin L. Goverman/ILG	/PJT/MLB/DC/DPM	1-Jan-82

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


;This module provides commonly used routines that are dependent
;	upon the operating system.

	SEARCH GLXMAC			;GET NECESSARY SYMBOLS
	PROLOG(GLXINT,INT)		;GENERATE PROLOG CODE
	SEARCH	ORNMAC			;GET WTO SYMBOLS


	INTEDT==115			;EDIT NUMBER
SUBTTL Table of Contents

;               TABLE OF CONTENTS FOR GLXINT
;
;
;                        SECTION                                   PAGE
;    1. Table of Contents.........................................   3
;    2. Revision History..........................................   4
;    3. Entry Points Found in GLXINT..............................   5
;    4. Local Definitions.........................................   6
;    5. Module Storage............................................   7
;    6. I%INI1 - Continue Library Initialization..................   8
;    7. CREDAT - Create data pages for OTS........................  10
;    8. SETTRP - Setup for APR Trapping...........................  11
;    9. IINIT - Initialize the interrupt system data base.........  12
;   10. I%IOFF-I%ION - Turn interrupt system off and on...........  13
;   11. Processor for each interrupt level........................  14
;   12. I%EXIT - Exit from the program............................  15
;   13. I%NOW  - Get time of day..................................  15
;   14. I%SLP  - Dismiss the program for a while..................  16
;   15. I%TIMR  Timer queue manipulation routines.................  17
;   16. I%HOST  --      Get Host Name/Number of Central Site......  21
;   17. GETLOC  --      GET CENTRAL SITE LOCATION.................  21
;   18. I%JINF  --      Canonical Job Information.................  22
;   19. I%JINF ROUTINES FOR THE -10...............................  23
;   20. I%JINF SPECIAL ROUTINES FOR THE -20.......................  24
;   21. I%WTO   - ACK, WTO, WTOR MSG PROCESSOR....................  25
;   22. WTPACD, WTOOCD ACTION ROUTINES............................  27
;   23. MORE WTO ACTION ROUTINES..................................  27
SUBTTL Revision History

COMMENT \

Edit	  GCO	Reason
----    ------- -------------------------------------------------------
0001		Create GLXINT module
0002	G011	Add I%IWTO routine to SETUP WTO message
		Add I%SWTO routine to SEND WTO message
		Add I%SOPR routine to SEND TO ORION
		Add I%WTO routine to PUT TEXT IN MESSAGE
0003	G016	On the -10 add APRENB trapping for PDL-OV, ILL-MEM-REF,
0004	G023	Fix WTO Routines to use new messages
		and NON-EX-MEM.
0005	G029	Zero the Library data pages to make Library restartable
0006	G032	SUPPLEMENT THE WTO PROCESSORS WITH A ROUTINE TO PROCESS
		ACK, WTO, AND WTOR MESSAGES.
0007	G036	Have APR trap set pc into AC 0 for now
0010	G049	Fix I%SOPR
0011		Add Defaulting for IB and change Calling of I%INI1
		to keep the Pid pure in callers address space
0012		Support Multiple interrupt levels on the 20
0013		Handle send errors for I%SOPR if user doesn't want
		send errors returned.
		Make I%EXIT do a reset if not debugging
0014		Add I%HOST and correct I%EXIT to be the same in all
		cases(i.e debugging and real)
0015		Add I%JINF call to Library with defined functions in GLXMAC
0016		Convert Module to use I%JINF where possible
0017		Fix $ACK message to lite the WT.SJI bit to suppress
		Job info on Display
0020		Rework I%%WTI to handle blocks
		Rename to I%%WTO, remove old I%%WTO, I%%WTI code.
0021		Remove I%IWTO,I%SWTO,I%WTO, Rename I%%WTO to I%WTO
0022		Rework of IB, PIB.
0023		Add global routine to get program version #
0024		Add action routines for WTO blocks NOD, JOB
		Make APT $STOP print out error PC
0025		Restore S1, S2, TF on return from WTO
0026		FIX GJBLOC TO NOT CLOBBER T4. INSTEAD USE TF
0027		CHANGE NAME OF WT.JOB ACTION ROUTINE TO WTPJBN
0030		Change WT.MIN, WT.MAX to WO.MIN, WO.MAX
0031		Load real WT.JOB in WTPJBN routine
0032		ADD IB.PRG INTO IB DEFAULTS
0033		Add Support for -20 Panic Channels if using Interrupt system
		and Channels are not enabled.
0034		Change SAVE to $SAVE
0035		Add WTO support code for Application Code Block and Object Type
		Block
0036		Make all calls to I%WTO send a packet if its feasible.
0037		Fix WTO routines so args in S1,S2 work
0040		Fix 0037 so it BLTs a whole object block
0041		Remove setting for WT.SJI if ACK code specified
0042		Fix WTO range check stopcode to dump offending addrs
0043		Move PFH into library
0044		Change the %FATAL for the Version SKEW between GLXINI and GLXLIB
0045		Add WTO support for .MSFLG
0046		Change $FATAL for incompatible Library and I%EXIT to just
		text to be dumped by the K%SOUT routine. This covers the
		case of the library not being initialized.
0047		Change the error message for incompatible library and GLXINI.
0050		Change WTO block handlers to accept (and pass) args in TF

0051		Change I%EXIT to logout job if not logged in

0052		Add I%TIMR routine to handle timer events
0053		Add check to execute a timer event if caller
		requests it.
0054		Fix a bug in I%TIMR when called from I%SLP
0055		Add routine to I%JINF to return jobs physical location
0056		Fix JI.LOC in I%JINF to return sixbit node name
0057		Define CNVNOD routine to do sixbit to octal conversions
		for TOPS10 node numbers
0060		Fix a bug in CNVNOD so that we work in monitors without network
		support
0061		Remove the CREDAT section so the individual modules can zero
		their own $DATA space.  Instead, we zero out our own $DATA space
		just like any other module.  Also remove D%END.
0062		On TOPS-10, APR traps trash AC 'TF'. Preserve it.
0063		[QAR 10-04626] Fix I%TIMR so that the PC word is
		compared correctly for .TIMBF function
0064		Detach from FRCLIN if IB.DET tells us to.
0065		Change I%SLP to use two TOPS10 hiber bits and to save
		all AC's as documented.
0066		I%NOW didn't return the correct local time. Do it right.

0067		Make GLXLIB run execute-only.
		 1) Add new routine CREDAT to create the library's data
		    pages (if they don't already exist).
		 2) Add new entry point I%APRT for APR traps. Note that
		    this MUST be set up by GLXINI prior to calling I%INI1.

0070		Restructure GLXLIB
		 1) Define I%INIT in GLXINT. Note that it's also defined in
		    GLXINI, but since you don't link both, it doesn't matter.
		 2) Remove definition for I%INI1 since it is no longer needed.
		 3) Once again, set up the APR trap here. Remove I%APRT since
		    it is no longer needed.
		 4) Add routine EXOCHK to check for execute-only operation and
		    set global flag EXOFLG. Currently, the only place this is
		    checked is in the memory manager/page fault handler.
		 5) Move data page creation out of here and into GLXOTS. It's
		    not needed if the library is linked with the user program.
		 6) Move the compatibility check out of here and into GLXOTS.
		    Anyone who links the library in with their program should
		    never have to worry about version skews.
		 7) Take call to SETPFH out of here and make it part of the
		    memory manager initialization code.

0071		Missing PORTAL in I%TIMR when GLXLIB calls the user.

0072		Add new bit IB.NPF to the IB to disable GLXPFH.

0073		Move linked list initialization above IPCF initialization

0074		Remove EXOFLG crock. Force PFHRET always.

0075		Set up temporary 1 word PDL when PDL overflow trap occurs.

0076		Fix up PDL overflow traps on the -20.

0077		Turn off WATCH when we detach from FRCLIN.

0100		Do not do the GETTAB for the WATCH bits, just clear all

0101		Remove stopcode in I%ION/I%IOFF and return CEI error instead
		CEI = Can't enable/disable interrupt system

0102		Add routine I%RLIM to reset VRT and PHY core limits. Have
		I%EXIT call I%RLIM for free.

0103		Make I%NOW always return the correct time on both
		systems. (GMT)
0104		Move the call to GLXINI (.INIT) to before call to GLXMEM
		(M%INIT) in case M%INIT wants to stopcode before the
		stopcode processor has been inited.

0105		Remove I%RLIM as it won't be needed with the new PFH.
0106		????
0107	10215	Allow sleeping on line completion, not just character
		input. (TOPS10 only)
		21-May-85 /NT
0110	10298	Allow sleeping on all HIBER conditions for the -10.
		07-Oct-85 /RCB
0111	10380	Return GLXLIB version number from I%INIT.
		21-Feb-86 /CJA
0112	10462	Change $STOP to STOPCD.
		14-Nov-86 /BAH
0113	10515	Add I%CJOB and I%KJOB routines
		25-Jun-87 /LWS
0114	10545	Add dependency checking in I%CJOB. Add MONDAT routine
		to GETTAB %CNVER, %CNSTS and %CNST2. Teach I%KJOB
		to RUN appropriate program to logout.
0115	10553	I%KJOB tries to right in a literal string in the high seg.

\  ;END OF REVISION HISTORY
SUBTTL	Entry Points Found in GLXINT

	ENTRY	I%INIT			;INITIALIZE THE MODULE
	ENTRY	I%NOW			;GET TIME OF DAY
	ENTRY	I%EXIT			;EXIT FROM PROGRAM
	ENTRY	I%ION			;INTERRUPTS ON
	ENTRY	I%IOFF			;INTERRUPTS OFF
	ENTRY	I%SLP			;SLEEP FOR A WHILE
	ENTRY	I%TIMR			;CREATE OR CHECK FOR TIMER ENTRY
	ENTRY	I%INT1			;CREATE ALL ENTRIES
	ENTRY	I%INT2			;FOR INTERRUPT LEVELS
	ENTRY	I%INT3			;
	ENTRY	I%SOPR			;SEND TO OPR ROUTINE.
	ENTRY	I%WTO			;ACK, WTO, WTOR MSG PROCESSOR
	ENTRY	I%HOST			;GET HOST NAME/NUMBER
	ENTRY	I%JINF			;CANONICAL JOB INFO BLOCK
	ENTRY	I%CJOB			;CREATE A GALAXY JOB
	ENTRY	I%KJOB			;LOGOUT ONESELF
SUBTTL Local Definitions

;Since the number of levels of interrupt differs from system to system,
; all code that deals with interrupt levels is under the DOLEV macro.
; To use this macro, define X(LVL) to generate the proper code for one
; level, using LVL as the suffix.  Then the invokation of DOLEV will
; create redundant code for each level wanted (INT.LV defined in GLXMAC).
; (INT.LV and INT.MX defined in GLXMAC)

	DEFINE DOLEV (LVLS<INT.LV>)<
	LSTOF.
	ZZ==1			;;START AT LEVEL 1
	REPEAT LVLS,<
	   X(\ZZ)	;;EXPAND DEFINED CODE FOR EACH LEVEL
	   ZZ==ZZ+1	;;STEP TO NEXT LEVEL
	   >
	LSTON.
> ;END OF DOLEV DEFINITION
SUBTTL Module Storage

	EXT	RSEFLG			;RETURN SEND ERROR FLAG

	$DATA	INTBEG,0		;START OF ZEROABLE $DATA SPACE

	DEFINE X(LVL)<

	$DATA	LEVPL'LVL,IPL.SZ	;;PUSHDOWN LIST FOR EACH LEVEL
	$DATA	SAVAC'LVL,20		;;AC SAVE AREA FOR EACH LEVEL
	$DATA	INTPC'LVL,1		;;INTERRUPT PROCESSOR PC
> ;END OF PER LEVEL DEFINITIONS

	DOLEV				;;EXPAND FOR EACH VALID LEVEL

	$GDATA	TRPPDP,3		;SAVED PUSH DOWN POINTER AND PDL
	$GDATA	MYJOB			;MY JOB NUMBER
	$GDATA	LOGTIM			;Jobs logged in time
	$DATA	TIMLST			;TIMER LIST
	$DATA	TIMWAK			;NEXT WAKEUP TIME
	$DATA	TIMPC			;TIME DISPATCH PC
	$DATA	AWOKEN			;USED FOR SLEEP/WAKE CODE
	$GDATA	BASINT			;BASE OF INTERRUPT SYSTEM
	$GDATA	INTRPC			;INTERRUPT PC ADDRESS
	$DATA	PRMADR			;WTO PARM ADDRESS
	$DATA	RETADR			;Holds return PC
	$DATA	THSPRM			;Address of current WTO parameter
	$DATA	S1%S2,2			;WTO SAVE AREA FOR S1, S2.
	$DATA	WTOBLT			;OBJECT BLK END ADDRESS FOR WTO BLT
	$DATA	STF			;Save for TF during WTO
	$DATA	MSGADR			;WTO MESSAGE ADDRESS.
	$DATA	BYTPTR			;WTO MSG BYTE PTR.
	$DATA	BYTCNT			;WTO MSG BYTE COUNT.
	$DATA	WTOSAB,SAB.SZ		;WTO SAB BLOCK.
TOPS10 <
	$DATA	FRCTXT,<<3+2+3+1+3+1+2+2+6+2+1+4>/5> ;TEXT TO TYPE TO FRCLIN
					;"LOG<CRLF>SET HPQ XX<CRLF>
					; <PRGNAM><CRLF><NULL>"
	ND	TRMSIZ,3
	$DATA	TRMBLK,TRMSIZ		;TRMOP. BLOCK USED BY I%CJOB
	$DATA	RUNBLK,6		;RUN UUO ARG BLOCK
	$DATA	SAVEP			;SAVE P DURING RUN UUO
>
	$DATA	INTEND,0		;END OF ZEROABLE $DATA SPACE
TOPS10 <
	$GDATA	MONVER			;MONITOR VERSION (TOPS-10)
	$GDATA	STATE1			;1ST STATES WORD
	$GDATA	STATE2			;2ND STATES WORD
>
	$GDATA	IIB,IB.SZ		;FULL SIZED IB

	$GDATA	D%END,0			;Last location in the data pages
SUBTTL I%INIT - Continue Library Initialization


;CALL IS:	S1/ LENGTH OF THE USER SUPPLIED IB
;		S2/ USER SUPPLIED IB ADDRESS
;
;TRUE RETURN:	ALWAYS

I%INIT:	PUSHJ	P,.SAVE2##		;SAVE TWO REGISTERS
	DMOVE	P1,S1			;SAVE IB LENGTH AND LOCATION
	MOVE	S1,[INTBEG,,INTBEG+1]	;BLT PTR TO ZEROABLE $DATA SPACE
	SETZM	S1,INTBEG		;FIRST LOCATION
	BLT	S1,INTEND-1		;BLT THE REST

DEFINE	DEFAULTS <
	LSTOF.

XX	IB.PRG,FWMASK,'NONAME'	;;PROGRAM NAME
XX	IB.OUT,FWMASK,T%TTY	;;$TEXT OUTPUT ROUTINE
XX	IB.FLG,IP.STP,0		;;ORION GETS STOP CODES FLAG
XX	IB.INT,FWMASK,0		;;INTERRUPT VECTORS
XX	IB.FLG,IT.OCT,0		;;OPEN TERMINAL FOR S%CMND
XX	IB.FLG,IB.DPM,0		;;USE JOB NUMBER AS PID
XX	IB.FLG,IB.NPF,0		;;DON'T SET UP GLXPFH
XX	IB.ERR,FWMASK,0		;;USER $TEXT ERROR EXIT ROUTINE
XX	IB.PIB,FWMASK,0		;;PID block address
	LSTON.
>

DEFINE XX (LOC,MSK,DEF,%L1) <

	CAIG	P1,LOC		;;SUPPLIED BY USER?
	  JRST	%L1		;;NO -- SUPPLY OUR DEFAULT
	LOAD	S1,LOC'(P2),MSK	;;YES -- GET WHAT THE SUPPLIED
	SKIPN	S1		;;NULL FIELD?
%L1:	MOVX	S1,DEF		;;YES -- SUPPLY OUR DEFAULT
	STORE	S1,IIB+LOC,MSK	;;STORE IN PERSONAL IB

	SUPPRESS %L1

> ;END SETDEF

	DEFAULTS			;SET INTERNAL DEFAULTS
	SETOM	S1			;SET FOR MY JOB
	MOVX	S2,JI.JNO		;GET THE JOB NUMBER
	PUSHJ	P,I%JINF		;GET THE DATA IN S2
	MOVEM	S2,MYJOB		;SAVE MY JOB NUMBER
TOPS10<
	MOVX	S2,JI.JLT		;GET LOGGED IN TIME
	$CALL	I%JINF
	SKIPF
	MOVEM	S2,LOGTIM
	PUSHJ	P,MONDAT		;GO GET SOME MONITOR DATA
	DMOVE	S1,INT.D		;Point to full IB
	PUSHJ	P,DETACH		;Try to detach from FRCLIN
> ;END TOPS10
	DMOVE	S1,INT.D		;POINT TO FULL IB
	PUSHJ	P,.INIT##		;INITIALIZE THE COMMON MODULE
	DMOVE	S1,INT.D		;POINT TO FULL IB
	PUSHJ	P,M%INIT##		;INITIALIZE THE MEMORY SYSTEM
	DMOVE	S1,INT.D		;POINT TO FULL IB
	PUSHJ	P,T%INIT##		;INITIALIZE THE TEXT MODULE
	DMOVE	S1,INT.D		;POINT TO FULL IB
	PUSHJ	P,IINIT			;INITIALIZE THE INTERRUPT SYSTEM
	DMOVE	S1,INT.D		;POINT TO FULL IB
	PUSHJ	P,L%INIT##		;INITIALIZE THE LINKED LIST MODULE
	DMOVE	S1,INT.D		;POINT TO FULL IB
	PUSHJ	P,K%INIT##		;INITIALIZE THE TERMINAL KEYBOARD MODULE
	DMOVE	S1,INT.D		;POINT TO FULL IB
	PUSHJ	P,C%INIT##		;INITIALIZE THE COMMUNICATIONS MODULE
	DMOVE	S1,INT.D		;POINT TO FULL IB
	PUSHJ	P,F%INIT##		;INITIALIZE THE FILE MODULE
	DMOVE	S1,INT.D		;POINT TO FULL IB
	PUSHJ	P,S%INIT##		;INIT THE COMMAND SCANNER
	MOVX	S1,<SI.FLG+SP.OPR>	;SEND TO SPECIAL PID ...OPR
	MOVEM	S1,WTOSAB+SAB.SI	;SAVE IN WTOSAB
	SETZM	WTOSAB+SAB.PD		;CLEAR PID WORD
	MOVE	S1,[GLXVRS]		;GET GLXLIB VERSION FOR USER
	$RETT				;RETURN TO CALLER

INT.D:	EXP	IB.SZ,IIB		;Common args for the initializers
SUBTTL	Get Some Montior Info


; GETTAB monitor version and both states words.
; Call: PUSHJ	P,MONDAT

TOPS10 <
MONDAT:	MOVX	S1,%CNDAE		;GET MONITOR MAJOR VERSION
	GETTAB	S1,
	  SETZ	S1,
	MOVEM	S1,MONVER		;SAVE FOR EVERYONE TO USE
	MOVX	S1,%CNSTS		;GET 1ST STATES WORDS
	GETTAB	S1,
	  SETZ	S1,
	MOVEM	S1,STATE1		;STORE AWAY
	MOVX	S1,%CNST2		;GET 2ND STATES WORD
	GETTAB	S1,
	  SETZ	S1,
	MOVEM	S1,STATE2
	POPJ	P,
>
SUBTTL Detach from FRCLIN


; Detach the program if we're running on FRCLIN (no-op for TOPS-20).
; Call:	PUSHJ	P,DETACH
;
DETACH:
TOPS10<	MOVNI	S1,1			;-1 means us
	GETLCH	S1			;Get our line characteristics
	ANDX	S1,UX.UNT		;Keep just the unit number
	MOVX	S2,%CNFLN		;GETTAB to return FRCLIN TTY number
	GETTAB	S2,			;Get it
	  $RETF				;Can't - just return
	CAME	S1,S2			;Are we running on FRCLIN ?
	$RETT				;No - return
	HRLZS	S1			;Setup line#,,0 for detach
	ATTACH	S1,			;Detach from FRCLIN
	 $RETF				;Oh well...
	MOVSI	S1,.STWTC		;GET FUNCTION CODE TO SET WATCH
	SETUUO	S1,			;SET WATCH NONE
	  JFCL				;HOPE NOTHING TYPES OUT
>					;End of TOPS-10 conditional

	$RETT				;Return
SUBTTL	SETTRP - Setup for APR Trapping

SETTRP:

TOPS10 <
	MOVEI	S1,TRPADR		;GET APR TRAP ADDRESS
	MOVEM	S1,.JBAPR##		;STORE IT
	MOVX	S1,AP.POV+AP.ILM+AP.NXM	;GET TRAP TYPES
	APRENB	S1,			;ENABLE THEM
	$RETT				;RETURN
>  ;END TOPS10 CONDITIONAL

TOPS20	<
	SKIPN	S1,BASINT		;INTERRUPT SYSTEM PRESENT
	$RETT				;NO..IGNORE SETUP
	HRRZ	S1,S1			;GET CHANNEL TABLE ADDRESS
	MOVE	S2,[1,,TRPPDL]		;TRAP ADDRESS FOR INTERRUPTS
	SKIPN	.ICPOV(S1)		;PDL OVERFLOW SETUP?
	MOVEM	S2,.ICPOV(S1)		;SAVE TRAP ADDRESS
	MOVE	S2,[1,,TRPIIT]		;TRAP ADDRESS FOR INTERRUPTS
	SKIPN	.ICILI(S1)		;ILLEGAL INSTRUCTION?
	MOVEM	S2,.ICILI(S1)		;SAVE TRAP ADDRESS
	MOVE	S2,[1,,TRPIMR]		;TRAP ADDRESS FOR INTERRUPTS
	SKIPN	.ICIRD(S1)		;ILLEGAL MEMORY READ?
	MOVEM	S2,.ICIRD(S1)		;SAVE TRAP ADDRESS
	MOVE	S2,[1,,TRPIMW]		;TRAP ADDRESS FOR INTERRUPTS
	SKIPN	.ICIWR(S1)		;ILLEGAL MEMORY WRITE?
	MOVEM	S2,.ICIWR(S1)		;SAVE TRAP ADDRESS
	MOVEI	S1,.FHSLF		;GET MY PROCESS HANDLE
	MOVX	S2,<1B<.ICPOV>!1B<.ICILI>!1B<.ICIRD>!1B<.ICIWR>>
	AIC				;ACTIVATE THE CHANNELS
	ERJMP SETT.E			;ERROR
	HLRZ	S1,BASINT		;GET LEVEL TABLE
	MOVE	S1,(S1)			;GET ADDRESS OF LEVEL PC SAVE
	MOVEM	S1,INTRPC		;SAVE INTRPC
	$RETT				;RETURN
SETT.E:	STOPCD	(CSP,HALT,,<Cannot Activate Panic Channels>)
>;END TOPS20
; Here on TOPS-10 APR traps
;
TOPS10 <
TRPADR:	PORTAL	.+1			;Allow execute-only operation
	EXCH	TF,.JBCNI		;Get APR CONI at trap, save TF
	TXNE	TF,AP.POV		;PDL overflow ?
	JRST	TRPPDL			;Yes
	TXNE	TF,AP.ILM		;Ill mem ref ?
	JRST	TRPILM			;Yes
	TXNE	TF,AP.NXM		;Non-existant memory ?
	JRST	TRPNXM			;Yes
	EXCH	TF,.JBCNI		;Restore JOBDAT location and TF
	STOPCD	(APT,HALT,,<Unknown APR trap at PC in .JBTPC, APR CONI in .JBCNI>)

TRPPDL:	EXCH	TF,.JBCNI		;Restore JOBDAT location and TF
	MOVEM	P,TRPPDP		;STORE PUSH DOWN POINTER
	MOVE	P,[IOWD 2,TRPPDP+1]	;SET UP TEMPORARY PDL
	STOPCD	(PDL,HALT,,<Pushdown list overflow at PC in .JBTPC>)
	MOVE	P,TRPPDP		;RELOAD USER'S PDL POINTER
	POPJ	P,			;THE FOOL IS TRYING TO CONTINUE

TRPILM:	EXCH	TF,.JBCNI		;Restore JOBDAT location and TF
	STOPCD	(ILM,HALT,,<Illegal memory reference at PC in .JBTPC>)

TRPNXM:	EXCH	TF,.JBCNI		;Restore JOBDAT location and TF
	STOPCD	(NXM,HALT,,<Non-existant memory at PC in .JBTPC>)

>;END TOPS10 CONDITIONAL

TOPS20	<
TRPPDL:	MOVEM	P,TRPPDP		;STORE PUSH DOWN POINTER
	MOVE	P,[IOWD 2,TRPPDP+1]	;SET UP TEMPORARY PDL
	STOPCD	(PDL,HALT,,<Pushdown list overflow>)
	MOVE	P,TRPPDP		;RELOAD USER'S PDL POINTER
	POPJ	P,			;RETURN?
TRPIIT:	$BGINT	1			;SETUP ILLEGAL INSTRUCTION
	PUSHJ	P,TRPSET		;SETUP TRAP
	MOVE	P,SAVAC1+17		;GET ORIGINAL STACK BACK
	STOPCD	(IST,HALT,,<Illegal Instruction Trap at PC in INTRPC, Stack in SAVAC1+17>)
TRPIMR:	$BGINT	1			;SETUP ILLEGAL MEMORY READ
	PUSHJ	P,TRPSET		;SETUP TRAP
	MOVE	P,SAVAC1+17		;GET ORIGINAL STACK BACK
	STOPCD	(IMR,HALT,,<Illegal Memory Read at PC in INTRPC, Stack in SAVAC1+17>)
TRPIMW:	$BGINT	1			;SETUP ILLEGAL MEMORY WRITE
	PUSHJ	P,TRPSET		;SETUP TRAP
	MOVE	P,SAVAC1+17		;GET ORIGINAL STACK BACK
	STOPCD	(IMW,HALT,,<Illegal Memory Write at PC in INTRPC, Stack in SAVAC1+17>)

TRPSET:	PUSH	P,S1			;SAVE S1
	MOVE	S1,@INTRPC		;GET THE PC
	MOVEM	S1,INTRPC		;SAVE THE PC
	POP	P,S1			;RESTORE S1
	POPJ	P,			;RETURN
>;END TOPS20
SUBTTL IINIT - Initialize the interrupt system data base

;Information in the IB must be remembered for operation of the interrupt
;	system. Also, since the entries to the interrupt level setup routines
;	are in impure storage, they must be set up.

; CALL IS:	S1/	Size of the IB
;		S2/	Address of the IB
;
; TRUE RETURN:	Always

IINIT:	SETOM	AWOKEN			;ALWAYS PRETEND SOMETHING HAPPENED
	MOVE	S1,IB.INT(S2)		;GET THE BASE OF THE INTERRUPT SYSTEM
	MOVEM	S1,BASINT		;STORE FOR LATER
	JUMPE	S1,SETTRP		;IF NO INTERRUPT SYSTEM,FINISH UP
	PUSHJ	P,SETINT		;SET IT UP FOR USER
	JUMPT	SETTRP			;SET APR TRAPS AND RETURN IF OK
	STOPCD	(CSI,HALT,,<Cannot set up interrupt system>)
SUBTTL I%IOFF-I%ION - Turn interrupt system off and on

;When interrupts can not be accepted, they can be switched on
; and off via these routines.

;CALL IS:	NO ARGUMENTS
;TRUE RETURN:	ALWAYS

TOPS10 <
I%ION:	SKIPA	S1,[PS.FON]		;FLAG TO TURN ON SYSTEM
I%IOFF:	MOVX	S1,PS.FOF		;FLAG TO TURN OFF SYSTEM
	SKIPN	BASINT			;DID USER ENABLE INTERRUPTS?
	$RETT				;NO, JUST RETURN
	PISYS.	S1,			;ALTER THE STATE
	  $RETE(CEI)			;Failed,,return
	$RETT				;AND RETURN

SETINT:	PIINI.	S1,			;HERE TO SET UP VECTOR
	  $RETF				;FALSE IF CANNOT SET IT UP
	$RETT				;OTHERWISE, ALL IS OK
> ;END TOPS10 CONDITIONAL

TOPS20 <
I%ION:	SKIPN	BASINT			;SKIP IF USER ENABLED INTERRUPTS
	$RETT				;AND RETURN
	MOVX	S1,.FHSLF		;FOR MYSELF
	EIR				;TURN ON INTERRUPTS
	  ERJMP	[$RETE(CEI)]		;Failed,,return
	$RETT

I%IOFF:	SKIPN	BASINT			;SKIP IF WE ARE DOING INTERRUPTS
	$RETT				;AND RETURN
	MOVX	S1,.FHSLF		;FOR MYSELF
	DIR				;DISABLE INTERRUPTS
	  ERJMP	[$RETE(CEI)]		;Failed,,return
	$RETT				;RETURN AFTER CHANGE

SETINT:	MOVE	S2,S1			;GET LEVTAB,,CHNTAB OF CALLER
	MOVX	S1,.FHSLF		;AND FOR MYSELF,
	SIR				;ESTABLISH THE INTERRUPT SYSTEM
	  ERJMP	.RETF			;IF IT FAILS, SAY SO
	$RETT				;OTHERWISE, TAKE GOOD RETURN
> ;END TOPS20 CONDITIONAL
SUBTTL Processor for each interrupt level

;Each level of interrupt starts off with a $BGINT instruction
;which does a JSR to the appropriate I%INTx routine.  These in turn
;call the continuation routines which set the DEBRK code as a co-routine.
;When interrupt processing is done for this level, a $DEBRK is done
;which does the proper post interrupt processing.

	DEFINE X(LVL)<

I%INT'LVL:

IFGE INT.LV-LVL,<
	POP	P,INTPC'LVL		;;SAVE INTERRUPT PROCESSOR PC
	MOVEM	0,SAVAC'LVL		;;SAVE AC 0 AWAY
	MOVE	0,[XWD 1,1+SAVAC'LVL]	;;BLT POINTER TO SAVE THE ACS
	BLT	0,17+SAVAC'LVL		;;SAVE ALL ACS
	MOVE	17,[IOWD IPL.SZ,LEVPL'LVL] ;;SET UP INTERRUPT LEVEL PDL
	PUSH	P,[Z DBRK'LVL]		;;SET UP CO-ROUTINE RETURN
	JRST	@INTPC'LVL		;;AND CONTINUE

DBRK'LVL:				;;HERE WHEN INTERRUPT IS OVER
	PORTAL	.+1			;;CLEAR PUBLIC
TOPS20 <				;;WAKE UP CODE FOR TOPS-20
	SETOM	AWOKEN			;;WE HAVE A WAKE UP COMING
	MOVEI	T1,SLP1			;;LABEL FOR FORCED WAKE UP
	HLRZ	S2,BASINT		;;GET LEVTAB'S ADDRESS
	ADDI	S2,LVL-1		;;GET OFFSET TO THIS LEVEL'S POINTER
	HRRZ	S2,0(S2)		;;GET WHERE PC IS STORED
	HRRZ	S1,0(S2)		;;GET PC INTERRUPTED FROM
	CAIL	S1,SLP0			;;INSIDE SLEEP CODE BLOCK?
	CAILE	S1,SLP1			;;
	SKIPA				;;NO, NO NEED TO ALTER PC
	HRRM	T1,0(S2)		;;ELSE STORE NEW PC TO FORCE WAKE-UP
> ;END TOPS20 CONDITIONAL
	MOVE	17,[XWD SAVAC'LVL,0]	;;RESTORE THE ACS
	BLT	17,17			;;OF PREVIOUS CONTEXT
TOPS20 <
	DEBRK				;;DISMISS THE INTERRUPT
	  ERCAL	S..NIP			;;IF DEBRK FAILS
> ;END TOPS20 CONDITIONAL
TOPS10 <
	DEBRK.				;;DISMISS THE INTERRUPT
	  PUSHJ	P,S..DUF		;IF UUO FAILS
	  PUSHJ	P,S..NIP		;IF NONE IN PROGRESS
> ;END TOPS10 CONDITIONAL
> ;END IFGE INT.LV-LVL

IFL INT.LV-LVL,<
	STOPCD	(IN'LVL,HALT,,<Level LVL interrupts not supported>)
> ;END IFL INT.LV-LVL
> ;END OF X DEFINITION

	DOLEV (INT.MX)			;EXPAND CODE OR STOP CODE FOR ALL LEVELS

	STOPCD	(NIP,HALT,,<No interrupt is in progress>) ;COMMON STOP CODES
	STOPCD	(DUF,HALT,,<DEBRK UUO failed>)
SUBTTL I%EXIT - Exit from the program

;This routine provides a non-continuable exit from the calling
;	program.

;CALL IS:	No argument
;
;NO RETURN IS PROVIDED


I%EXIT:
TOPS10 <
	PJOB	S1,		;Get my job number
	MOVN	S1,S1
	JOBSTS	S1,
	 TDZA	S1,S1
	TXNE	S1,JB.ULI	;Am I logged in?
	JRST	IEXIT		;Yes..then just exit
	MOVEI	S1,[ASCIZ/.KJOB
./]
	$CALL	K%SOUT
	LOGOUT
>

IEXIT:	RESET
	$HALT				;STOP THE PROCESS
	MOVEI	S1,[ASCIZ/? Can't continue
/]
	PUSHJ 	P,K%SOUT		;DUMP THE MESSAGE
	JRST	IEXIT			;LOOP BACK
SUBTTL I%NOW  - Get time of day


; Return local date/time in Smithsonian Universal date/time format
; CALL IS:	No arguments
;
; TRUE RETURN:	S1/ Greenwich time and date in UDT format
;
I%NOW:
TOPS10	<				;TOPS-10 ONLY
	MOVX	S1,%CNDTM		;GET UNIVERSAL DATE/TIME (GMT)
	GETTAB	S1,			;THE MONITOR
	STOPCD	(DTU,HALT,,<Date/Time unavailable>)
>					;END OF TOPS-10 CONDITIONAL

TOPS20	<				;TOPS-20 ONLY
	GTAD				;GET DATE AND TIME
>					;END OF TOPS-20 CONDITIONAL

	$RETT				;RETURN WITH UDT IN S1
SUBTTL I%SLP  - Dismiss the program for a while

;When programs need to suspend operation for a time or want to block
; indefinitely, they should use the I%SLP routine.
;	Any interrupts will cause the end of sleeping, as will certain
;	spurious conditions.  Programs using I%SLP should not depend
;	on premature wake-up not happening.

;  An additional reason for waking on the 10 may be wakeup codes accepted
;  HIBER.  Specifically, HIBER will wakeup on terminal character input and
;  on PTY input.  This is specifically needed on the 10 to permit interrupting
;  the user on tty input to allow ipcf messages to be processed.

;CALL IS:	S1/ flags ,, Number of seconds to sleep, or 0 for infinite
;
;TRUE RETURN:	Always
;		S1/ Number of seconds till next timer wakeup time
;		All other AC's are preserved

I%SLP:	$SAVE	S2			;Save S2
	HRRZ	S2,S1			;Get only the time to sleep
TOPS10<	TDZ	S1,[HB.SEC!<0,,-1>]>	;Keep only useful flag bits
TOPS20<	SETZM	S1 >			;Currently no flags on TOPS20
	IMULI	S2,^D1000		;Set to milliseconds
	SKIPN	TIMWAK			;Timer event waiting?
	JRST	SLP0			;No - go to sleep

	$SAVE	<T1,T2,T3,T4>		;Save some more AC's
	MOVE	T1,S1			;Save the flags
	MOVE	T2,S2			;Save the current time to sleep
	$CALL	I%NOW			;Get the current time
	CAML	S1,TIMWAK		;Time for a wakeup?
	JRST	SLPDSP			;Yes .. Go check requests
	MOVE	T3,TIMWAK		;Get the wakeup time
	SUB	T3,S1			;Make it time till wakeup
	IMULI	T3,^D333		;Convert to milliseconds
	SKIPE	S2,T2			;Fetch old sleep time and skip if 0
	CAML	S2,T3			;Sleep wakeup before timer wakeup?
	MOVE	S2,T3			;No - get timer wakeup
	MOVE	S1,T1			;Restore the flags

SLP0:	CAILE	S2,^D60*^D1000		;Don't sleep for more than 60 seconds
	MOVEI	S2,^D60*^D1000		;Nice try
	HRR	S1,S2			;Set up for monitor call

TOPS10 <
	HIBER	S1,			;DO HIBERNATE FOR SLEEPING
	 JFCL
> ;END TOPS10 CONDITIONAL

TOPS20 <
	SKIPE	AWOKEN			;SEE IF A WAKE UP HAS OCCURRED
	JRST	SLP1			;YES, DON'T SLEEP AT ALL
	SKIPN	S1			;TIMED SLEEP?
	WAIT				;NO, SLEEP INDEFINITELY
	DISMS				;ELSE SLEEP FOR SPECIFIED SECONDS
	 JFCL				;USE A LOCATION
SLP1:	SETZM	AWOKEN			;CLEAR "NEED WAKE UP" FLAG
> ;END TOPS20 CONDITIONAL

SLPDSP:	SKIPG	TIMPC			;Want to execute routine?
	JRST	SLPRET			;No..just return
	MOVEI	S1,0			;Yes..get the entry
	$CALL	I%TIMR			;Is it time?
	 JUMPF	SLPRET			;No..just return
	CAILE	S1,.TIMPC		;Simple safety check
	$CALL	@.TIMPC(S2)		;Call the routine
	  PORTAL SLPDSP			;Ignore skip returns
	PORTAL	SLPDSP			;Process all expired entries
SLPRET:	MOVE	S1,TIMWAK		;Return next wakeup time
	$RETT
SUBTTL	I%TIMR	Timer queue manipulation routines

;This routine is called to add an entry to the timer event queue
;and to return expired events from the queue.

;To add an entry to the timer queue:

;ACCEPTS	S1/ Length of entry to be added to queue
;		S2/ Address of entry to be added to queue

;RETURNS TRUE	Entry has been added to the timer queue

;	 FALSE	ERIFN$	Invalid function was requested
;		ERARG$	Invalid argument was specified
;		ERTME$	Requested time has already expired



;To get and delete an expired entry from the timer queue:

;ACCEPTS	S1/ Zero

;RETURNS TRUE	S1/ Length of entry which has expired
;		S2/ Address of the entry

;	 FALSE	ERTMN$	No timer events have expired


I%TIMR:	$SAVE	<P1,P2,P3,P4>		;Save some acs
	DMOVE	P1,S1			;Save calling arguments
	SKIPN	S1,TIMLST		;Get the timer list
	$CALL	L%CLST			;No list..go get one
	MOVEM	S1,TIMLST		;Remember we have it
	MOVE	S2,TIMWAK		;Get wakeup time
	CAMN	P1,[-1]			;Just want the list number?
	$RETT				;Yes..return it
	$CALL	L%FIRST			;Position to first entry
	 JUMPF	TIMR.1			;No entries..proceed
	SKIPGE	.TIPSI(S2)		;Marked for deletion?
	$CALL	L%DENT			;Yes..get rid of it
TIMR.1:	JUMPE	P1,TIMCHK		;Want to check the queue?
	CAIGE	P1,1			;At least one word?
	 $RETE	(ARG)			;No..return the error
	LOAD	S1,.TIFNC(P2),TI.FNC	;Get the requested function
	CAIL	S1,.TIMRT		;Within range?
	CAILE	S1,.TIMAL
	 $RETE	(IFN)			;No..invalid function
	PJRST	@TIMTBL(S1)		;Yes..do the function

TIMTBL:	PJRST	TIMRT			;Interrupt after runtime
	PJRST	TIMEL			;Add entry after n milliseconds
	PJRST	TIMDT			;Add an entry at specific UDT
	PJRST	TIMDD			;Delete entries at specific UDT
	PJRST	TIMBF			;Delete entries before spec UDT
	PJRST	TIMAL			;Delete all entries

TIMCHK:	MOVE	S1,TIMLST		;Yes..get the list index
	$CALL	L%FIRST			;Get the first entry
	 JUMPF	TIMCH3			;Oops..kill the list and return
	MOVE	P2,S2			;Remember the address
	SKIPN	TIMWAK			;Any wakeup time set?
	JRST	TIMCH4			;No..return nothing to do
	$CALL	I%NOW			;Yes..get the current time
	CAMGE	S1,TIMWAK		;First entry expired?
	JRST	TIMCH4			;Nothing to do..just return
	SETOM	.TIPSI(P2)		;Mark entry for deletion
	MOVE	S1,TIMLST		;Get list index
	$CALL	L%SIZE			;Get the size of this entry
	MOVE	P1,S2			;Remember entry size
	SETZM	TIMWAK			;Clear wakeup time
	SETZM	TIMPC			;Clear dispatch flag
	MOVE	S1,TIMLST		;Get the list index
	$CALL	L%NEXT			;Get the next entry
	JUMPF	.+5
	MOVE	S1,.TITIM(S2)		;Set new wake time
	MOVEM	S1,TIMWAK
	SKIPLE	S1,.TIMPC(S2)		;Set new PC word
	MOVEM	S1,TIMPC
	MOVE	S1,P1			;Return size of entry
	MOVE	S2,P2			; and address of entry
	$RETT

TIMCH3:	SETZM	TIMWAK			;Clear wakeup time
	SETZM	TIMPC			; and PC word
TIMCH4:	$RETE(TMN)			;Nothing to do
;These routines will add an entry to the timer queue

;TIMEL	Add an entry to expire after N milliseconds

TIMEL:	CAIGE	P1,.TITIM+1		;Argument list large enough?
	 $RETE(ARG)
	MOVE	S1,.TITIM(P2)		;Get number of milliseconds
	IDIVI	S1,^D333		;Convert to 1/3 seconds
	MOVE	P3,S1			;Remember this
	$CALL	I%NOW			;Get current date and time
	ADD	P3,S1			;UDT now in P3
	JRST	TIMDTE			;Fall into common code


;TIMDT	Add an entry to expire at a specific UDT

TIMDT:	CAIGE	P1,.TITIM+1		;Argument list large enough?
	 $RETE(ARG)			;No..return the error
	MOVE	P3,.TITIM(P2)		;Get requested UDT
TIMDTE:	MOVE	S1,TIMLST		;Get the list index
	$CALL	L%FIRST			;Position to first entry
	 JUMPF	TIMD4			;None there..go create one
TIMD1:	CAMLE	P3,.TITIM(S2)		;Right position for this entry?
	JRST	TIMD3			;No..check the next
	CAMN	P3,.TITIM(S2)		;Is it identical?
	CAIE	P1,.TIMPC+1		;Have a PC word and no data?
	JRST	TIMD2			;No..go create entry
	MOVE	P4,.TIMPC(P2)		;Yes..get PC word
	CAME	P4,.TIMPC(S2)		;Don't make duplicate entry
	JRST	TIMD3			;Put this one at the end
	 $RETE(TMA)			;Entry already exists
TIMD2:	MOVE	S2,P1			;Get size of entry
	$CALL	L%CBFR			;Create the entry
	JRST	TIMD5			;Finish up

TIMD3:	$CALL	L%NEXT			;No..Get the next entry
	JUMPT	TIMD1
TIMD4:	MOVE	S1,TIMLST		;Put entry at end of list
	MOVE	S2,P1			;Get required size of entry
	$CALL	L%CENT			;Create it
TIMD5:	ADDI	P1,-1(S2)		;Get destination address
	HRL	P2,S2			;Make BLT pointer
	MOVS	P2,P2
	BLT	P2,0(P1)		;Copy arguments
	MOVEM	P3,.TITIM(S2)		;Save expiration UDT
TIMD6:	$SAVE	<S1,S2>			;Save for return
	PJRST	TIMDTX			;Set wakup time and exit
;TIMRT	Request an interrupt after N milliseconds of runtime

TIMRT:	$RETE(IFN)			;Runtime is unsupported


;TIMBF	Deletes all entries before specific UDT
;TIMDD	Deletes all entries for a specific UDT

TIMBF:	SKIPA	P4,[CAMG P3,.TITIM(S2)]	;Delete before time
TIMDD:	MOVE	P4,[CAME P3,.TITIM(S2)]	;Delete specific time
	CAIGE	P1,.TITIM+1		;Must have time word
	 $RETE(ARG)			;Return the error
	MOVE	S1,TIMLST		;Get the list index
	MOVE	P3,.TITIM(P2)		;Get requested time
	$CALL	L%FIRST			;Get the first entry
	JUMPF	TIMALX			;Reset the flags
TIMDD1:	XCT	P4			;Want to delete this request?
	JRST	TIMDD3			;No..check the next
	CAIG	P1,.TIMPC		;Have a PC word?
	JRST	TIMDD2			;No..delete the entry
	MOVE	S2,.TIMPC(S2)		;[63] Yes..get the word
	CAMN	S2,.TIMPC(P2)		;They must match
TIMDD2:	$CALL	L%DENT			;Yes..zap it
TIMDD3:	$CALL	L%NEXT			;Check the next
	JUMPT	TIMDD1			;Back to check the next
					;Set wakeup time and return

;TIMDTX	Sets wakup time and returns

TIMDTX:	MOVE	S1,TIMLST
	$CALL	L%FIRST			;Position to first entry
	JUMPF	TIMALX			;None..reset the flags
	MOVE	S1,.TITIM(S2)		;Set the wakeup time
	MOVEM	S1,TIMWAK
	SETZM	TIMPC			;Clear dispatch flag
	SKIPLE	S1,.TIMPC(S2)		;Want to execute this request
	MOVEM	S1,TIMPC		;Yes..remember this
	$RETT


;TIMAL	Kill all entries in the timer queue

TIMAL:	MOVE	S1,TIMLST		;Get the list address
	$CALL	L%FIRST
	SKIPF
	$CALL	L%DENT			;Else delete all entries
	JUMPT	.-1
TIMALX:	SETZM	TIMWAK			;Clear wakeup time
	SETZM	TIMPC			;Clear dispatch flag
	$RETT

SUBTTL	I%HOST	--	Get Host Name/Number of Central Site

	;THIS ROUTINE WILL RETURN THE NODE NAME AND NUMBER (-10 ONLY)
	;FOR THE CENTRAL SITE.
	;
	;CALL:	NO ARGUMENTS
	;
	;RETURN:	S1/	HOST NAME IN SIXBIT
	;		S2/	HOST NUMBER
	;

IFN	FTUUOS,<
I%HOST:	MOVEI	S2,.GTLOC		;GET LOCATION OF JOB 0
	GETTAB	S2,			;...
	 JRST	NOHOST			;No network if this fails
	MOVE	S1,S2			;Copy node numer
	$CALL	CNVNOD			;Convert S1 to node name
	JUMPF	NOHOST			;Use local defaults
	$RETT

CNVNOD:: $SAVE	<T1,T2,T3,T4>		;Convert S1 to its compliment
	MOVE	T1,[.NDRNN,,T2]		;Function is convert name/num
	MOVEI	T2,2			;2 Args specified
	MOVE	T3,S1			;Put the node number in T3
	NODE.	T1,			;Get the sixbit
	SKIPA				;Failed,,look into the error
	JRST	[MOVE S1,T1		;Win,,get answer in S1
		 $RETT  ]		;Return
	CAMN	T1,[.NDRNN,,T2]		;Are networks supported ???
	SKIPE	S1			;No,,is the node number 0 ??
	$RETE(NSN)			;Network support or non zero node number
	MOVE	S1,['LOCAL ']		;Use local as default
	$RETT  				;return
>;END FTUUOS

IFN	FTJSYS,<
I%HOST:	PUSHJ	P,.SAVET		;SAVE THE T REGS
	MOVX	S1,.NDGLN		;GET LOCAL NODE NAME JSYS CODE
	MOVEI	S2,TF			;GET ARGUMENT BLOCK ADDRESS
	HRROI	TF,T1			;MAKE BYTE POINTER TO T1
	NODE				;GET THE LOCAL NODE NAME
	 ERJMP	NOHOST			;NO NETWORKS
	MOVE	T3,[POINT 7,T1]		;GET POINTER TO NODE NAME
	MOVE	T4,[POINT 6,S1]		;GET OUTPUT POINTER
	SETZ	S1,			;SET OUTPUT BUFFER TO NULLS
HOST.1:	ILDB	S2,T3			;GET AN INPUT BYTE
	JUMPE	S2,HOST.2		;NULL,,GO FINISH UP
	SUBI	S2,40			;MAKE IT SIXBIT
	IDPB	S2,T4			;SAVE IT
	JRST	HOST.1			;AND GO PROCESS ANOTHER
HOST.2:	SETZ	S2,			;0 FOR NODE NUMBER
	$RETT				;AND RETURN
>;END FTJSYS

NOHOST:	MOVE	S1,['LOCAL ']		;Use local as default
	SETZ	S2,
	$RETT
SUBTTL	I%JINF	--	Canonical Job Information

;This Call is designed to provide a system independent way of getting Job
;information.
;
;	CALL :	S1/	JOB NUMBER OR -1 FOR CURRENT JOB
;		S2/	FUNCTION CODE
;
;
;	RETURN TRUE:	S1/	JOB NUMBER PRESERVED FROM CALL
;			S2/	RETURNED VALUE FOR FUNCTION

;	RETURN FALSE:	S1/	ERROR CODE
;
;	DEFINED ERROR CODES
;
;	ERUJI$		-  UNDEFINED JOB INFO FUNCTION
;	ERIJN$		-  INVALID JOB NUMBER

I%JINF:	CAIL	S2,JI.MIN		;CHECK FUNCTION RANGE
	CAILE	S2,JI.MAX		;WITHIN BOUNDS
	  $RETE(UJI)			;UNDEFINED JOB INFO FUNCTION
	MOVE	S2,JINFTB-1(S2)		;GET THE DATA
	SKIPL	S2			;FUNCTION CODE OR ROUTINE
	JRST	GJBGTB			;FUNCTION CODE DO THE WORK
	HRRZS	S2			;GET ROUTINE ADDRESS
	PJRST	(S2)			;PROCESS THE FUNCTION
TOPS10<
GJBGTB:	HRL	S2,S1			;PLACE JOB NUMBER IN LEFT HALF
	GETTAB	S2,			;GET THE INFO
	  $RETE(IJN)			;INVALID JOB NUMBER
	$RETT				;RETURN TRUE
>;END TOPS10

TOPS20<
GJBGTB:	$SAVE	T1			;SAVE T1
	MOVE	T1,S2			;GET THE FUNCTION CODE
	MOVSI	S2,-1			;1 WORD TO RETURN
	HRRI	S2,T1			;RESULT IN T1
	GETJI				;GET THE INFO
	  $RETE(IJN)			;INVALID JOB NUMBER
	MOVE	S2,T1			;GET RETURNED DATA
	$RETT				;RETURN TRUE
>;END TOPS20


	;JOB INFO FUNCTION DISPATCH TABLE

DEFINE	X(A,B,C),<
	JI.'A==JI.'A		;GET SYMBOLS
TOPS10<C>
TOPS20<B>
>;END X

JINFTB:	JBTAB			;EXPAND THE TABLE


SUBTTL	I%JINF ROUTINES FOR THE -10

TOPS10<
	;GET THE PATH DIRECTORY
GJBPTH:	PUSHJ	P,.SAVET		;SAVE THE T REGS
	MOVS	T1,S1			;PUT JOB NUMBER IN T1
	HRRI	T1,.PTFRD		;READ DIRECTORY PATH
	MOVSI	S2,3			;LENGTH OF BLOCK
	HRRI	S2,T1			;ADDRESS OF BLOCK
	PATH.	S2,			;DO THE FUNCTION
	  $RETE(IJN)			;INVALID JOB NUMBER
	MOVE	S2,T3			;GET THE PPN
	$RETT				;RETURN TRUE

	;GET THE CONTROLLING JOB NUMBER

GJBCJB:	MOVE	S2,S1			;GET JOB NUMBER
	CTLJOB	S2,			;GET CONTROLLING JOB
	  $RETE(IJN)			;INVALID JOB NUMBER
	$RETT				;CONTROLLING JOB OR -1 IF NOT CONTROLLED


	;GET THE JOB NUMBER OF MY JOB

GJBJNO:	SKIPL	S2,S1			;CHECK IF FOR ME
	   $RETE(IJN)			;INVALID JOB NUMBER
	PJOB	S2,			;GET THE JOB NUMBER
	$RETT				;RETURN TRUE

GJBTLC:	$SAVE	<T1>			;SAVE AN AC
	MOVE	T1,S1			;SAVE THE JOB NUMBER
	SETZM	S2			;RETURN A ZERO FOR EARLY FAILURE
	TRMNO.	S1,			;GET THIS JOB'S TERMINAL #
	 $RETE(TLU)			;ERROR IF NO TERMINAL
	GTNTN.	S1,			;FIND OUT WHERE THAT TTY LIVES
	 $RETE(TLU)			;ERROR IF NO NODE,,TERMINAL
	HLRZS	S1			;GET JUST THE TERM #
	$CALL	CNVNOD			;Convert S1 to sixbit
	 $RETIF				;Return any failures
	MOVE	S2,S1			;Return node name in S2
	MOVE	S1,T1			;Return Job number in S1
	$RETT

	;GET THE JOBS TERMINAL NUMBER

GJBTTY:	MOVE	S2,S1			;SAVE THE JOB NUMBER
	TRMNO.	S2,			;GET THE TERMINAL NUMBER
	  JRST	GJBT.1			;ERROR..CHECK FOR DETACHED
	TRZ	S2,.UXTRM		;MAKE TERMINAL NUMBER
	$RETT				;RETURN TRUE
GJBT.1:	MOVN	S2,S1			;GET NEGATIEV JOB NUMBER IN S1
	JOBSTS	S2,			;DO JOBSTS UUO
	  $RETE(IJN)			;INVALID JOB NUMBER
	TXNN	S2,JB.UJA		;JOB NUMBER ASSIGNED
	  $RETE(IJN)			;INVALID JOB NUMBER
	SETOM	S2			;-1  IF DETACHED
	$RETT				;RETURN

GJBVER::MOVE	S1,.JBVER		;Yes, get our version
	$RETT				;Done

GJBRTM:	SKIPGE	S1			;Want our job (-1)?
	SETZ	S1,			;Yes, adjust to RUNTIm UUO convetion
	MOVE	S2,S1			;SAVE THE NUMBER AND GET VALUE IN S2
	RUNTIM	S2,			;Ask the monitor
	$RETT				;Give it to user
GJBLOC:	MOVEI	S2,.GTLOC		;Function is get my location
	$CALL	GJBGTB			;Do the GETTAB
	 $RETIF				;Return any failure
	EXCH	S1,S2			;Put number in S1
	$CALL	CNVNOD			;Convert to sixbit
	 $RETIF				;Return any failure
	EXCH	S1,S2			;Else return sixbit in S2
	$RETT				;With job number in S1
SUBTTL	I%CJOB	CREATE A GALAXY JOB / WAIT FOR PID TO APPEAR

;I%CJOB will create a job on FRCLIN (it better detach) and/or
;wait for a <SYSTEM>PID to appear (SP.xxx).
;
;	Call:	S1/	address of CJB (See GLXMAC)
;
;	Return:	TRUE	if PID comes into existense - S1 contains PID
;		    	or program started and pid index is zero
;		FALSE	if timeout reached - ERTOF$ or ERTOP$
;		    	or FRCLIN TRMOP.'s fail - ERUSE$
;		    	or invalid arguments - ERARG$

I%CJOB::$SAVE	<T1,T2>			;SAVE SOME ACS
	MOVE	T1,S1			;COPY ADDRESS OF CJB
	MOVE	T2,CJB.NM(T1)		;GET PROGRAM NAME
	LOAD	S1,CJB.TP(T1),CJ.SPI	;GET SPECIAL PID INDEX
	JUMPN	T2,CJOB.0		;JUMP IF PROGRAM TO FIRE UP
	SKIPN	S1			;NO NAME, HOW ABOUT A PID INDEX?
	$RETE	(ARG)			;NEITHER, NOTHING WE CAN DO

CJOB.0:	LOAD	S2,CJB.TP(T1),CJ.TIM	;GET SECONDS TO WAIT
	JUMPN	T2,CJOB.1		;JUMP IF WE HAVE A PROGRAM NAME

;We just want to wait for PID to show up

	PUSHJ	P,CJWPID		;GO WAIT FOR PID TO EMERGE
	$RET				;RETURN WHATEVER

;Here when we have a system program to fire up via FRCLIN

CJOB.1:	LOAD	S1,CJB.FL(T1),CJ.DEP	;GET FLAGS
	JUMPE	S1,CJOB.2		;NO, PHEW
	MOVX	T2,CJ.D60		;NO WAY TO CHECK FOR DN60 (YET)
	PUSHJ	P,I%HOST		;GET NODE NAME
	MOVE	S2,[SIXBIT |LOCAL|]	;GET CROCKY NODE NAME GIVEN WHEN NO ANF
	CAME	S2,S1			;NODE NAME 'LOCAL'?
	TXO	T2,CJ.ANF		;NO, WE HAVE ANF-10
	MOVX	S2,ST%D36!ST%END	;GET DECNET STATE BITS
	TDNE	S2,STATE2 		;LIT IN 2ND STATES WORD?
	TXO	T2,CJ.DCN		;WE HAVE DECNET
	TDNN	T2,CJB.FL(T1)		;DO WE HAVE THE REQUIRED STUFF?
	$RETE	(DNP)			;NO RETURN ERROR CODE

CJOB.2:	MOVE	T2,CJB.NM(T1)		;GET PROGRAM NAME
	LOAD	TF,CJB.FL(T1),CJ.HPQ	;GET HPQ TO START JOB IN
	JUMPN	TF,CJOB.3
	$TEXT	(<-1,,FRCTXT>,<LOG^M^J^W/T2/^M^J^0>) ;LOGIN STRING
	TRNA
CJOB.3:	$TEXT	(<-1,,FRCTXT>,<LOG^M^JSET HPQ ^D/TF/^M^J^W/T2/^M^J^0>) ;LOGIN STRING
	MOVX	S1,%CNFLN		;GET LINE NUMBER OF FRCLIN
	GETTAB	S1,
	  $RETE	(USE)			;NO LUCK
	TXO	S1,.UXTRM		;MAKE IT INTO A UDX
	MOVEM	S1,TRMBLK+.TOUDX	;PUT IN TRMOP. BLOCK
	MOVEI	S1,FRCTXT		;GET ADDR OF ASCIZ LOGIN TEXT
	MOVEM	S1,TRMBLK+.TOAR2	;STORE IT
	MOVX	S1,.TOTTC		;LOAD AND STORE TRMOP. FUNC
	MOVEM	S1,TRMBLK+.TOFNC
	LOAD	S2,CJB.TP(T1),CJ.TIM	;GET SECONDS TO WAIT
CJOB.4:	MOVE	S1,[XWD 2,TRMBLK]	;SETUP TRMOP. AC
	TRMOP.	S1,			;FRCLIN BUSY?
	  $RETE	(USE)			;WE'LL NEVER KNOW
	JUMPE	S1,CJOB.5		;NO INPUT CHARS, GUESS NOT
	SOJL	S2,[$RETE(TOF)]		;RETURN FALSE IF NO MORE WAITING
	MOVEI	S1,1			;SLEEP FOR A SECOND
	$CALL	I%SLP
	JRST	CJOB.4			;TRY AGAIN

;Here to send string down FRCLIN, it should be free

CJOB.5:	MOVX	S1,.TOTYP		;GET TRMOP. FUNCTION
	MOVEM	S1,TRMBLK+.TOFNC	;STORE IT IN TRMOP. BLOCK
	MOVE	S1,[XWD 3,TRMBLK]	;SETUP TRMOP. AC
	TRMOP.	S1,			;TYPE LOGIN STRING TO FRCLIN
	  $RETE	(USE)			;WE TRIED
	LOAD	S1,CJB.TP(T1),CJ.SPI	;GET PID INDEX IN T2 NOW
	JUMPE	S1,.RETT		;DONE IF NO PID INDEX
	PUSHJ	P,CJWPID		;ELSE WAIT FOR PID TO EMERGE
	$RET				;RETURN WHATEVER
SUBTTL	CJWPID	WAIT FOR SYSTEM PID

;This routine is called be I%CJOB in order to wait for the specified
;system pid to come into being.
;
;	Call:	S1/	System PID index (SP.xxx)
;		S2/	Time to wait (seconds)
;
;	Return:	TRUE	S1 contains PID
;		FALSE	if timeout - ERTOP$
;			or invalid index - ERARG$

CJWPID:	$SAVE	<T1,T2>			;SAVE A COUPLE ACS
	DMOVE	T1,S1			;COPY ARGS
CJWP.0:	$CALL	C%RPRM			;ASK FOR PID
	$RETIT				;RETURN IF WE GOT IT
	CAXN	S1,ERARG$		;BAD INDEX?
	$RET				;YES, RETURN
	SOJL	T2,[$RETE(TOP)]		;RETURN FALSE IF TIRED OF WAITING
	MOVEI	S1,1			;ELSE SLEEP FOR A SECOND
	$CALL	I%SLP
	MOVE	S1,T1			;GET INDEX AGAIN
	JRST	CJWP.0			;AND GO ASK FOR PID
SUBTTL	I%KJOB ROUTINE TO LOGOUT

;This routine will do a RUN UUO and run LOGOUT for the caller
;
;	Call:	No args
;	Return: FALSE if RUN UUO failed
;		S1/ RUN UUO error code

I%KJOB::MOVE	S2,[SIXBIT \LOGIN\]	;ASSUME 704 OR GREATER
	MOVEI	S1,703			;GET MONITOR VERSION TO CHECK AGAINST
	HRRZ	TF,MONVER		;GET BINARY MAJOR VERSION
	CAML	S1,TF			;703 OR BEFORE?
	MOVE	S2,[SIXBIT \LOGOUT\]	;YES
	SETZM	RUNBLK			;ZERO TO BE SAFE
	MOVE	S1,[RUNBLK,,RUNBLK+1]
	BLT	S1,RUNBLK+6-1
	MOVSI	S1,'SYS'		;GET DEVICE
	MOVEM	S1,RUNBLK		;SAVE DEVICE
	MOVEM	S2,RUNBLK+1		;SAVE PROGRAM NAME
	MOVEM	P,SAVEP			;SAVE P FOR RETURN IF NEEDED
	MOVEI	S1,RUNBLK		;GET RUN UUO ARG BLOCK ADDR
	RUN	S1,UU.PHY		;LOG US OUT
	MOVE	P,SAVEP			;GET STACK BACK
	$RETE	(USE)
> ;End TOPS10
SUBTTL	I%JINF SPECIAL ROUTINES FOR THE -20

TOPS20<
GJBLOC:
	PUSHJ	P,.SAVET		;SAVE THE ACS
	HRRI	T1,.JILLO		;GET THE FUNCTION CODE
	MOVSI	S2,-1			;1 WORD TO RETURN
	HRRI	S2,T2			;RESULT IN T2
	HRROI	T2,T3			;POINTER TO T3
	GETJI				;GET THE INFO
	  $RETE(IJN)			;INVALID JOB NUMBER
	MOVE	T1,[POINT 7,T3]		;SETUP INPUT POINTER
	MOVE	TF,[POINT 6,S2]		;GET OUTPUT POINTER
	SETZ	S2,			;SET OUTPUT BUFFER TO NULLS
GJBL.1:	ILDB	T2,T1			;GET AN INPUT BYTE
	JUMPE	T2,.RETT		;NULL,,GO FINISH UP
	SUBI	T2,40			;MAKE IT SIXBIT
	IDPB	T2,TF			;SAVE IT
	JRST	GJBL.1			;AND GO PROCESS ANOTHER

GJBTLC:	$SAVE	<S1>
	$CALL	I%HOST
	MOVE	S2,S1			;ONLY KNOW ABOUT OUR HOST FOR NOW
	$RETT


GJBVER:: MOVX	S1,.FHSLF		;Yes, aim at my process
	GEVEC				;Get my entry info
	HLRZ	S1,S2			;Get length
	CAIN	S1,(JRST)		;Is it an old entry vector (JRST start)
	JRST	[MOVE	S1,137		;Yes, get version ala TOPS-10
		$RETT]			;Give that to user
	CAIGE	S1,2			;Does it contain a version?
	TDZA	S1,S1			;No, return 0
	MOVE	S1,2(S2)		;Yes, get it
	$RETT				;Done
>;END TOPS20
SUBTTL	I%WTO	- ACK, WTO, WTOR MSG PROCESSOR

	;THIS ROUTINE WILL GET A PAGE FROM THE MEMORY MANAGER, SET IT UP
	;AS AN ACK, WTO OR WTOR MESSAGE AND THEN CALL $TEXT TO CREATE
	;THE MESSAGE BODY.



I%WTO:	PUSH	P,(P)			;Copy return PC
	POP	P,RETADR		;And save for final POPJ
	POP	P,PRMADR		;GET THE PARM ADDRESS.
	DMOVEM	S1,S1%S2		;SAVE THE TRASH AC'S.
	MOVEM	TF,STF			;SAVE TF ACROSS WTO
	PUSHJ	P,M%GPAG		;GET A PAGE FOR IPCF.
	MOVEM	S1,WTOSAB+SAB.MS	;SAVE THE PAGE ADDRESS.
	MOVEI	S2,.OHDRS		;GET OFFSET TO MSG BLOCKS.
	STORE	S2,.MSTYP(S1),MS.CNT	;SAVE IT IN THE MSG.
	ADDI	S2,ARG.HD(S1)		;Get addr of first free in msg
	MOVEM	S2,MSGADR		;Save for building

DEFINE NXTWTO(HERE),<
IFNB <HERE>,<NXTWT:>	;;If this is a definition, just define return loc
IFB  <HERE>,<JRST NXTWT>;;Else just return
>;END DEFINE NXTWTO
	NXTWTO(HERE)			;Define the loop location for the action routines
	AOS	S1,PRMADR		;BUMP OVER THE 'JRST'
					;Get addr of this entry
	SKIPN	S1,(S1)			;End of list?
	JRST	IWTOFN			;Yes, all done
	MOVEM	S1,THSPRM		;Save arg for computing effective addr
	DMOVE	S1,S1%S2		;Get back to user context
	MOVE	TF,STF			;And get caller's TF
	MOVEI	S1,@THSPRM		;Get addr from block
	EXCH	S1,THSPRM		;Save for action routine
	LDB	S1,[POINT 9,S1,8]	;Get op-code field
	CAIL	S1,WO.MIN		;Is it ..
	CAILE	S1,WO.MAX		; .. in range?
	STOPCD	(WFO,HALT,,<WTO Function in S1 out of range at address PRMADR>)
	JRST	@WTDSP-WO.MIN(S1)	;In range, do the work, and return via
					;NXTWTO  We'd like to do a PUSHJ here,
					;but that would destroy the user's
					;stack context

WTDSP:	DEFINE	.EAWTO(SUF,CODE),<$SET(WO.'SUF'-WO.MIN,,WTP'SUF')>
	$BUILD	WO.MAX-WO.MIN+1
	ALLWTO
	$EOB

;Here when all thru processing the user blocks
IWTOFN:	PUSHJ	P,I%WT.3		;Send the message to OPR
	PUSH	P,RETADR		;Fix up stack for user again
	DMOVE	S1,S1%S2		;Get back the users scratch regs
	MOVE	TF,STF			;Get back caller's TF
	POPJ	P,			;Go back to call + 1

;Action routines for each of the op-code types in the WTO macro
;Action routine for setting the message type
WTPMTY:	MOVE	S1,WTOSAB+SAB.MS	;Get address of message
	MOVE	S2,THSPRM		;Get addr of parameter (immediate argument)
	STORE	S2,.MSTYP(S1),MS.TYP	;Fill in message type
	NXTWTO				;Try for next parameter

;Action routine for building the message type line
WTPTYP:	MOVEI	S1,.WTTYP		;Get code for type block
	JRST	IWTX.1			;And do the $TEXT

;Action routine for building the text block
WTPTXT:	MOVEI	S1,.WTTXT		;Get code for text block
IWTX.1:	MOVE	S2,MSGADR		;Get addr of message
	STORE	S1,ARG.HD(S2),AR.TYP	;Save the block type
	ADD	S2,[POINT 7,ARG.DA]	;CREATE A BYTE PTR TO THE DATA AREA.
	MOVEM	S2,BYTPTR		;AND SAVE IT.
	SETZM	BYTCNT			;Clear the # bytes put into message
	DMOVE	S1,S1%S2		;Get back to caller's context
	MOVE	TF,STF			;And get caller's TF
	$TEXT	(IWTODP,<^I/@THSPRM/^0>) ;Fill in the text
	MOVE	S1,BYTCNT		;Get # chars moved
	IDIVI	S1,5			;Convert to words
	SKIPE	S2			;Any remainder?
	AOS	S1			;Yes, take another word
	ADDI	S1,ARG.DA		;Account for arg header block
					;Fall thru to add variable block

;Here to add a block whose length is in S1 to the message
IWTO.A:	MOVE	S2,MSGADR		;Get back start of arg block
	STORE	S1,ARG.HD(S2),AR.LEN	;Set length of block
	ADDM	S1,MSGADR		;Next block goes farther down
	MOVE	S2,WTOSAB+SAB.MS	;Get addr of entire message
	AOS	.OARGC(S2)		;Indicate another arg block is here
	PUSH	P,T1			;Save a reg for a second
	LOAD	T1,.MSTYP(S2),MS.CNT	;Get old length of message
	ADDI	T1,(S1)			;Account for this block
	STORE	T1,.MSTYP(S2),MS.CNT	;Update message length
	POP	P,T1			;Restore scratch reg
	NXTWTO				;Continue scanning the WTO blocks

;Action routine for setting the header flags .MSFLG
WTPMFL:	DMOVE	S1,S1%S2		;Get back to caller's context
	MOVE	TF,STF			;And get caller's TF
	MOVE	S1,@THSPRM		;Get arg word passed
WTPMF1:	MOVE	S2,WTOSAB+SAB.MS	;And aim at message again
	IORM	S1,.MSFLG(S2)		;Store the flags
	NXTWTO				;Continue


;Action routine for setting the message flags
WTPFLG:	DMOVE	S1,S1%S2		;Get back to caller's context
	MOVE	TF,STF			;And get caller's TF
	MOVE	S1,@THSPRM		;Get arg word passed
WTPFL1:	MOVE	S2,WTOSAB+SAB.MS	;And aim at message again
	IORM	S1,.OFLAG(S2)		;Store the flags
	NXTWTO				;Continue

;Action routine for filling in the ack code
WTPACK:	DMOVE	S1,S1%S2		;Get back to caller's context
	MOVE	TF,STF			;And get caller's TF
	MOVE	S1,@THSPRM		;Get the users ack code
	MOVE	S2,WTOSAB+SAB.MS	;Aim at message again
	STORE	S1,.MSCOD(S2)		;Stuff it in
	NXTWTO				;Continue

;Action routine for adding the Object block
WTPOBJ:	DMOVE	S1,S1%S2		;Get back to caller's context
	MOVE	TF,STF			;And get caller's TF
	HRLI	TF,@THSPRM		;Get start adrs of users obj block
	MOVE	S1,MSGADR		;Get start of next block
	MOVX	S2,.WTOBJ		;Get block type
	STORE	S2,ARG.HD(S1),AR.TYP	;Save in block header
	MOVEI	S1,ARG.DA(S1)		;Point to the block data
	HRR	TF,S1			;Set dest. for BLT to data area
	ADDI	S1,OBJ.SZ-1		;Compute terminating adrs for BLT
	HRRZM	S1,WTOBLT		;Save in memory (not in an AC)
	DMOVE	S1,S1%S2		;Get back to caller's context
	BLT	TF,@WTOBLT		;Move in the Obj block
	MOVEI	S1,OBJ.SZ+ARG.DA	;Get size of space added
	PJRST	IWTO.A			;Update the message

;	IWTODP	- $TEXT ACTION ROUTINE TO BUILD THE ACK, WTO, & WTOR.

	;THIS ROUTINE IS THE ACTION ROUTINE FOR $TEXT. IT BUILDS THE
	;MESSAGE BLOCKS.

IWTODP:	IDPB	S1,BYTPTR		;SAVE THE BYTE IN THE MSG.
	AOS	BYTCNT			;BUMP BYTE COUNT
	$RETT				;RETURN QUICK !!
SUBTTL	WTPACD, WTOOCD ACTION ROUTINES

WTPOCD:	SKIPA	S2,[EXP .WTOCD]		;OBJECT TYPE BLOCK
WTPACD:	MOVEI	S2,.WTACD		;APPLICATION CODE BLOCK
	JRST	WTPN.1			;USE THE COMMON ROUTINE


SUBTTL	MORE WTO ACTION ROUTINES

WTPJBN:	SKIPA	S2,[EXP .WTJOB]		;Get block type - JOB
WTPNOD:	MOVX	S2,.WTDES		;Get block type - DEST NODE
WTPN.1:	MOVE	S1,MSGADR		;Get first free in message
	STORE	S2,ARG.HD(S1),AR.TYP	;Save either block type
	DMOVE	S1,S1%S2		;Get back to caller's context
	MOVE	TF,STF			;Get back reg 0, too.
	MOVE	S2,@THSPRM		;Get job # or SIXBIT node name
	MOVE	S1,MSGADR		;Get first free in message
	STORE	S2,ARG.DA(S1)		;Save in block
	MOVEI	S1,ARG.DA+1		;Get length of block (Hdr + 1 data)
	PJRST	IWTO.A			;Update message length, arg counts
I%SOPR:	MOVEM	S1,WTOSAB+SAB.MS	;SAVE THE PAGE ADDRESS IN THE SAB.

I%WT.3:	STKVAR	<<PAGEF>>		;PAGE/PACKET WTO FLAG
	MOVEI	S1,PAGSIZ		;GET SIZE OF MESSAGE
	MOVEM	S1,WTOSAB+SAB.LN	;SAVE IN LENGTH WORD OF WTOSAB
	SETZM	PAGEF			;CLEAR PACKET MODE FLAG WORD
	PUSHJ	P,C%MAXP		;GET MAXIMUM SHORT PACKET SIZE
	MOVE	S2,WTOSAB+SAB.MS	;GET THE MESSAGE ADDRESS
	LOAD	S2,.MSTYP(S2),MS.CNT	;GET THE MESSAGE LENGTH
	CAMLE	S2,S1			;CAN WE SEND IT AS A PACKET ???
	JRST	I%WT.4			;NO,,SEND IT AS A PAGE
	MOVEM	S2,WTOSAB+SAB.LN	;YES,,SAVE THE MSG LENGTH IN THE SAB
	SETOM	PAGEF			;SET THE PACKET MODE IPCF FLAG

I%WT.4:	MOVEI	S1,SAB.SZ		;PICK UP THE SAB SIZE.
	MOVEI	S2,WTOSAB		;PICK UP THE SAB ADDRESS.
	PUSHJ	P,C%SEND		;SEND THE WTO.

	JUMPT	[SKIPN PAGEF		;MSG WAS SENT OK,,WAS IT A PACKET ??
		 $RETT			;NO,,THEN JUST RETURN
		 MOVE  S1,WTOSAB+SAB.MS	;YES,,GET THE MESSAGE ADDRESS
		 PJRST M%RPAG  ]	;RETURN THE PAGE AND EXIT

	SKIPE	RSEFLG			;SEND FAILED,,DO WE RETURN ??
	JRST	[MOVE  S1,WTOSAB+SAB.MS	;YES,,GET THE MESSAGE ADDRESS
		 PUSHJ P,M%RPAG		;RETURN THE PAGE
		 $RETF   ]		;AND RETURN

	CAIE	S1,ERRQF$		;NO -- IS IT RECIEVE OR
	CAIN	S1,ERSQF$		;   SEND QUOTA ERROR ???
	 JRST	I%WT.4			;YES -- RETRY
	CAIE	S1,ERNSP$		;IS IT NO SUCH PID
	CAIN	S1,ERSLE$		;OR SYSTEM LIMITS EXCEEDED?
	 JRST	I%WT.4			;YES -- RETRY
	$FATAL	(Send to ORION failed)	;DIE !!


INT%L:					;LABEL THE LITERAL POOL.
	LSTOF.
	LIT
	LSTON.
	CEND=:.-1			;LABEL LAST OTS LOCATION


	END