Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	TITLE	GLXINT - Operating system interface for GALAXY
	SUBTTL	Preliminaries

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

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

	INTMAN==:0			;Maintenance edit number
	INTDEV==:133			;Development edit number
	VERSIN (INT)			;Generate edit number

	Subttl	Table of Contents

;		     Table of Contents for GLXINT
;
;				  Section		      Page
;
;
;    1. Revision History . . . . . . . . . . . . . . . . . . .   3
;    2. Entry Points Found in GLXINT . . . . . . . . . . . . .   4
;    3. Local Definitions  . . . . . . . . . . . . . . . . . .   5
;    4. Module Storage . . . . . . . . . . . . . . . . . . . .   6
;    5. I%INIT - Continue Library Initialization . . . . . . .   7
;    6. Detach from FRCLIN . . . . . . . . . . . . . . . . . .   9
;    7. SETTRP - Setup for APR Trapping  . . . . . . . . . . .  10
;    8. IINIT - Initialize the interrupt system data base  . .  12
;    9. I%IOFF-I%ION - Turn interrupt system off and on  . . .  13
;   10. Processor for each interrupt level . . . . . . . . . .  14
;   11. I%EXIT - Exit from the program . . . . . . . . . . . .  15
;   12. I%NOW - Get time of day  . . . . . . . . . . . . . . .  16
;   13. I%SLP - Dismiss the program for a while  . . . . . . .  17
;   14. I%TIMR Timer queue manipulation routines . . . . . . .  18
;   15. I%HOST - Get Host Name/Number of Central Site  . . . .  22
;   16. I%JINF - Canonical Job Information . . . . . . . . . .  23
;   17. I%JINF ROUTINES FOR THE -10  . . . . . . . . . . . . .  24
;   18. I%JINF SPECIAL ROUTINES FOR THE -20  . . . . . . . . .  25
;   19. WTPACD, WTOOCD ACTION ROUTINES . . . . . . . . . . . .  28

SUBTTL Revision History

COMMENT \

105		Remove I%RLIM as it won't be needed with the new PFH.

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

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

110	5.1002		28-Dec-82
	Move to new development area.  Clean up edit organization.

111	5.1063		30-Nov-83
	Rearrange default table for the IB.  Add default for new bit IB.SYS.
	Based on IB.SYS and DB.SYS in debug word, set/don't set process as 
	system process in the initialization code.

112	5.1074		31-Jan-84
	Return with S1 containing the version of the library.

113	5.1094		13-Feb-84
	Correct edit 112 so that S1 contains the version of the library and not
the contents of the memory location whose value equals that of the 
version number.

114	5.1133		9-APR-84
	Define GLXVRS as external.

115	5.1148		21-Jun-84
	Fix bug in testing code which accidently causes private world processes
to hog too much of the system.

116	5.1200		6-Feb-85
	Set bit IB.NAC to zero which causes GTJFNs to be called without setting
bit GJ%ACC.

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

120	Increment maintenance edit level for version 5 of GALAXY.

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

130	6.1021		19-Oct-87
	Change routine WTPOBJ to process remote LPT name blocks as part of
its processing of object blocks.

131	6.1096		21-Nov-87
	Add routine WTPNHD which processes the remote node name block for
the $QACK and $QWTO macros.

132	6.1108		1-Dec-87
	Change WTPNHD to correctly store the message length.

133	6.1225		8-Mar-88
	Update copyright notice.

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

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.
	$DATA	INTEND,0		;END OF ZEROABLE $DATA SPACE
	$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
;		S1/ VERSION OF THE LIBRARY

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.OUT,FWMASK,T%TTY	;;$TEXT OUTPUT ROUTINE
XX	IB.FLG,IT.OCT,0		;;OPEN TERMINAL FOR S%CMND
XX	IB.FLG,IP.STP,0		;;ORION GETS STOP CODES FLAG
XX	IB.FLG,IB.DPM,0		;;USE JOB NUMBER AS PID
XX	IB.FLG,IB.NPF,0		;;DON'T SET UP GLXPFH
XX	IB.FLG,IB.SYS,0		;;Don't set up as a system process
XX	IB.FLG,IB.NAC,0		;;Don't normally restrict access to JFNs
XX	IB.INT,FWMASK,0		;;INTERRUPT VECTORS
XX	IB.PIB,FWMASK,0		;;PID block address
XX	IB.ERR,FWMASK,0		;;USER $TEXT ERROR EXIT ROUTINE
XX	IB.PRG,FWMASK,'NONAME'	;;PROGRAM NAME
	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
	DMOVE	S1,INT.D		;Point to full IB
	PUSHJ	P,DETACH		;Try to detach from FRCLIN
> ;END TOPS10

;  Here to decide if to set system process

	LOAD	S1,IIB+IB.FLG,IB.SYS	;Get the bit to indicate system process
	JUMPE	S1,INIT.2		;If not set, nothing else to do
	SKIPN	DEBUGW			;Are we debugging?
	JRST	INIT.1			;No, go set system process
	LOAD	S1,DEBUGW,DB.SYS	;Get the system process override bit
	JUMPE	S1,INIT.2		;If not set, do not set sys. proc.

;  Here to set system process

INIT.1:	SETZ	S2,			;Clear "priority word"
	TXO	S2,JP%SYS		;Set system process bit
	MOVEI	S1,.FHSLF		;For ourselves
	SPRIW				;And do it
	  ERCAL	[$WARN (<Failed to set as a system process>)
		$RET]

INIT.2:	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,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,K%INIT##		;INITIALIZE THE TERMINAL KEYBOARD 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]		;RETURN WITH LIBRARY VERSION
	$RETT				;RETURN TO CALLER

INT.D:	EXP	IB.SZ,IIB		;Common args for the initializers

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:	$STOP(CSP,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
	$STOP	(APT,<Unknown APR trap^I/TRPPC/ APR CONI = ^O12R0/.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
	$STOP	(PDL,<Pushdown list overflow^I/TRPPC/>)
	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
	$STOP	(ILM,<Illegal memory reference^I/TRPPC/>)

TRPNXM:	EXCH	TF,.JBCNI		;Restore JOBDAT location and TF
	$STOP	(NXM,<Non-existant memory^I/TRPPC/>)

TRPPC:	ITEXT	(< at PC ^O/.JBTPC,RHMASK/>)
>;END TOPS10 CONDITIONAL

TOPS20	<
TRPPDL:	MOVEM	P,TRPPDP		;STORE PUSH DOWN POINTER
	MOVE	P,[IOWD 2,TRPPDP+1]	;SET UP TEMPORARY PDL
	$STOP	(PDL,<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
	$STOP(IST,Illegal Instruction Trap^I/TRPPC/)
TRPIMR:	$BGINT	1			;SETUP ILLEGAL MEMORY READ
	PUSHJ	P,TRPSET		;SETUP TRAP
	MOVE	P,SAVAC1+17		;GET ORIGINAL STACK BACK
	$STOP(IMR,Illegal Memory Read^I/TRPPC/)	
TRPIMW:	$BGINT	1			;SETUP ILLEGAL MEMORY WRITE
	PUSHJ	P,TRPSET		;SETUP TRAP
	MOVE	P,SAVAC1+17		;GET ORIGINAL STACK BACK
	$STOP(IMW,Illegal Memory Write^I/TRPPC/)	
TRPPC:	ITEXT	(< at PC ^O/INTRPC,RHMASK/ Stack ^O/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
	$STOP(CSI,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,<
	$STOP(IN'LVL,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

	$STOP(NIP,No interrupt is in progress) ;COMMON STOP CODES
	$STOP(DUF,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
	  $STOP(DTU,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<	ANDX	S1,<HB.RPT+HB.RTC> >	;Use only bits allowed
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


> ;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?
	$STOP	(WFO,<WTO Function ^O/S1/ Out of range at address ^O/PRMADR,RHMASK/>)
	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 remote node name block

WTPNHD:	MOVE	S1,@THSPRM		;[131]Pick up node name
	MOVE	S2,MSGADR		;[131]Pick up the block address
	MOVEM	S1,ARG.DA(S2)		;[131]Store the node name
	MOVEI	S1,2			;[131]Pick up the block length
	ADDM	S1,MSGADR		;[131]Point to the next block
	MOVSS	S1			;[131]Move block length to LH
	PUSH	P,S1			;[131]Save for total message length
	HRRI	S1,.WTNHD		;[131]Pick up the block type
	MOVEM	S1,ARG.HD(S2)		;[131]Store in the message
	MOVE	S2,WTOSAB+SAB.MS	;[131]Pick up the message address
	AOS	.OARGC(S2)		;[131]Increment the argument count
	POP	P,S1			;[131]Pick up the block length
	ADDM	S1,.MSTYP(S2)		;[132]Add to message length
	NXTWTO				;[131]Continue scanning the WTO blocks

;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
	HRRZ	S2,THSPRM		;[6000]Pick up block address
	MOVE	TF,OBJ.TY(S2)		;[6000]Pick up object type
	TXNN	TF,.DQLPT		;[6000]Is this a DQS LPT?
	TXNE	TF,.LALPT		;[6000]No, is it a LAT LPT?
	SKIPA				;[6000]Yes, update the block code
	PJRST	IWTO.A			;[6000]No, Update the message

WTPO.1:	$CALL	FINOBB			;[6000]Finish building object block
	ADDI	S2,OBJ.SZ		;[6000]Point to the name block
	MOVE	S1,MSGADR		;[6000]Point to current message block
	MOVE	TF,S1			;[6000]Save as destination address
	HRLI	TF,ARG.HD(S2)		;[6000]Pick up the source address
	LOAD	S2,ARG.HD(S2),AR.LEN	;[6000]Pick up the block length
	ADD	S1,S2			;[6000]Add to start of destination adr
	BLT	TF,-1(S1)		;[6000]Copy over block
	$CALL	CHNTYP			;[6000]Change to WTO block code
	MOVE	S1,S2			;[6000]Pick up block length
	PJRST	IWTO.A			;[6000]Finish up the message

FINOBB:	PUSH	P,T1			;[6000]Save a reg for a second
	MOVE	T1,MSGADR		;[6000]Get back start of arg block
	STORE	S1,ARG.HD(T1),AR.LEN	;[6000]Set length of block
	ADDM	S1,MSGADR		;[6000]Next block goes farther down
	MOVE	T1,WTOSAB+SAB.MS	;[6000]Get addr of entire message
	AOS	.OARGC(T1)		;[6000]Indicate another arg block is here
	LOAD	TF,.MSTYP(T1),MS.CNT	;[6000]Get old length of message
	ADDI	TF,(S1)			;[6000]Account for this block
	STORE	TF,.MSTYP(T1),MS.CNT	;[6000]Update message length
	POP	P,T1			;[6000]Restore scratch reg
	$RET

CHNTYP:	$SAVE	<P1>			;[6000]Save this AC
	HRRZ	S1,THSPRM		;[6000]Pick up object block address
	MOVE	P1,OBJ.TY(S1)		;[6000]Pick up object type
	TXNE	P1,.DQLPT		;[6000]Is this a DQS LPT?
	JRST	CHNT.1			;[6000]Yes, go pick up its code
	MOVEI	P1,OBJ.SZ(S1)		;[6000]Point to name block
	LOAD	P1,ARG.HD(P1),AR.TYP	;[6000]Pick up the type of name
	MOVEI	S1,.WTPOR		;[6000]Assume it is a PORT 
	CAIE	P1,.KYPOR		;[6000]Is it?
	MOVEI	S1,.WTSER		;[6000]No, it is a SERVICE name
	SKIPA				;[6000]Skip over the DQS code
CHNT.1:	MOVEI	S1,.WTDQS		;[6000]Pick up the DQS code
	MOVE	P1,MSGADR		;[6000]Pick up address of block to change
	STORE	S1,ARG.HD(P1),AR.TYP	;[6000]Update its WTO block code
	$RET				;[6000]Return

;	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
	MOVE	S1,WTOSAB+SAB.MS	;GET THE MESSAGE ADDRESS
	LOAD	S1,.MSTYP(S1),MS.CNT	;GET THE MESSAGE LENGTH
	CAMLE	S1,MAXPAK##		;CAN WE SEND IT AS A PACKET ???
	JRST	I%WT.4			;NO,,SEND IT AS A PAGE
	MOVEM	S1,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