Google
 

Trailing-Edge - PDP-10 Archives - bb-d868c-bm_tops20_v4_2020_distr - language-sources/glxint.mac
There are 37 other files named glxint.mac in the archive. Click here to see a list.
TITLE	GLXINT - Operating system interface for GALAXY
SUBTTL	Irwin L. Goverman/ILG	/PJT/MLB/DC	3-Jul-79

;
;
;                COPYRIGHT (c) 1975,1976,1977,1978,1979
;                    DIGITAL EQUIPMENT CORPORATION
;
;     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==47			;EDIT NUMBER
SUBTTL Table of Contents

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

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

	ENTRY	I%INI1			;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%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	I%INT1,2		;LEVEL 1 INTERRUPT ENTRY
	$DATA	I%INT2,2		;LEVEL 2 INTERRUPT
	$DATA	I%INT3,2		;LEVEL 3 INTERRUPT

	DEFINE X(LVL)<

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

	DOLEV				;;EXPAND FOR EACH VALID LEVEL

	$GDATA	MYJOB			;MY JOB NUMBER
	$DATA	AWOKEN			;USED FOR SLEEP/WAKE CODE
	$GDATA	BASINT			;BASE OF INTERRUPT SYSTEM
	$GDATA	INTRPC			;INTERRUPT PC ADDRESS
	$GDATA	IIB,IB.SZ		;FULL SIZED IB
	$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.

	$GDATA	D%END,0			;Last adrs in library data space
SUBTTL I%INI1 - Continue Library Initialization

;Called from I%INIT to initialize this module and the rest of the library

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

IFE GLXPURE,<
I%INIT::HRLI	S2,%%.GLX		;For low-seg library, initialize here
>
I%INI1:	PUSHJ	P,.SAVE2##		;SAVE TWO REGISTERS
	DMOVE	P1,S1			;SAVE IB LENGTH AND LOCATION
	PUSHJ	P,CREDAT		;CREATE THE DATA PAGES

DEFINE	DEFAULTS <
	LSTOF.

XX	IB.PRG,FWMASK,'NONAME'	;;PROGRAM NAME
XX	IB.OUT,FWMASK,T%TTY	;;$TEXT OUTPUT ROUTINE
;;XX	IB.IPC,IP.PSI,0		;;IPCF PSI FLAG
;;XX	IB.IPC,IP.JWP,0		;;IPCF JOB WIDE PID FLAG
XX	IB.FLG,IP.STP,0		;;ORION GETS STOP CODES FLAG
;;XX	IB.IPC,IP.SPB,0		;;ACCEPT PRIV OF SENDER FLAG
;;XX	IB.IPC,IP.RSE,0		;;RETURN SEND ERROR FLAG
;;XX	IB.IPC,IP.CHN,0		;;IPCF CHANNEL OR OFFSET
;;XX	IB.IPC,IP.SPI,0		;;SYSTEM WIDE COMPONENT FIELD
;;XX	IB.IPP,IP.MNP,0		;;MAXIMUM NUMBER OF PIDS
;;XX	IB.IPP,IP.SQT,0		;;SEND QUOTA
;;XX	IB.IPP,IP.RQT,0		;;RECIEVE QUOTA
;;XX	IB.PID,FWMASK,0		;;REQUESTED PID
;;XX	IB.VER,FWMASK,0		;;PROGRAM VERSION NUMBER
XX	IB.INT,FWMASK,0		;;INTERRUPT VECTORS
XX	IB.FLG,IT.OCT,0		;;OPEN TERMINAL FOR S%CMND
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
	HLRZ	S2,P2			;GET %%.GLX SUPPLIED BY I%INIT
	CAIE	S2,%%.GLX		;CHECK MAJOR CHANGE LEVEL
	  JRST	[MOVEI	S1,[ASCIZ/? This program is incompatible with GLXLIB and must be recompiled.
/]
		PUSHJ P,K%SOUT		;DUMP IT OUT
		PUSHJ P,I%EXIT]		;STOP THE PROCESS
	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
	DMOVE	S1,INT.D		;POINT TO FULL IB
	PUSHJ	P,M%INIT##		;INITIALIZE THE MEMORY SYSTEM
	PUSHJ	P,SETPFH##		;Setup the fault handler (-10 only)
	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,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,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,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,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
	$RETT				;RETURN TO CALLER

INT.D:	EXP	IB.SZ,IIB		;Common args for the initializers
SUBTTL CREDAT - Create data pages for OTS

;All library modules allocate memory storage via the $DATA and $GDATA
;	macros. These macros assign blocks of storage in the DATA PSECT.
;	One the -10, those pages are allocated in a segment of memory
;	which looks like 'low-segment' code, even though it is in high memory.
;	On the -10, we have to MERGE in the rest of the EXE file
;	and thus create the DATA space, unless these pages
;	already exist. GLXINI does this for us, since it
;	knows exactly where the high segment came from.
;	On both systems, all the DATA space is zeroed, whether
;	the pages were created or existed because of a restart
;	Note that GLXINT must be loaded last to insure that it
;	has knowledge of all the locations used by members of the OTS.
;	For a low-segment loadable library, $DATA space is non-contiguous
;	and must be zeroed piece by piece.

;CALL IS:	No arguments
;TRUE RETURN:	Always


CREDAT:
IFN GLXPURE,<
	DMOVE	S1,[EXP D%END-D%BEG##,D%BEG##]	;Aim at the block
	$CALL	.ZCHNK			;Clear out the data space, and return
	$RETT
>;END IFN GLXPURE

IFE GLXPURE,<
	PUSH	P,P1			;Preserve a reg
	MOVSI	P1,-CRELEN		;MAke AOBJN ptr to data table
CRED.0:	HLRZ	S1,CRED.T(P1)		;Get length of entry
	JUMPE	S1,CRED.1		;None for this module, try next
	HRRZ	S2,CRED.T(P1)		;Get addr of block
	$CALL	.ZCHNK			;Clear out this module's storage
CRED.1:	AOBJN	P1,CRED.0		;Try next module
	POP	P,P1			;Get back the work reg
	$RETT

DEFINE	GLX(MOD,EDT,LOD,GCO,WHO,DATE,NOTE)<
IFDIF <MOD><MAC>,<
IFDIF <MOD><INI>,<
	GLOB	(MOD'%DL)		;Globalize $DATA length
	GLOB	(MOD'%D)		;Globalize $DATA start adr
	XWD	MOD'%DL,MOD'%D		;Length,,adr
>
>
>;END DEFINE GLX

CRED.T:
	MODULES				;Build all the $DATA zeroing code
	CRELEN==.-CRED.T		;Length of table

>;END IFE GLXPURE
SUBTTL	SETTRP - Setup for APR Trapping

SETTRP:

TOPS10 <
	MOVEI	S1,TRPADR		;GET TRAP ROUTINE 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 AN APR TRAP
TOPS10 <
TRPADR:	MOVE	TF,.JBCNI		;GET APR CONI AT TRAP
	TXNE	TF,<1B19>		;Was it PDL OVF?
	$STOP(PDL,<Pushdown list overflow^I/TRPPC/>)
	$STOP(APT,<Illegal memory reference^I/TRPPC/>)
TRPPC:	ITEXT	(< at PC ^O/.JBTPC,RHMASK/>)
>;END TOPS10 CONDITIONAL

TOPS20	<
TRPPDL:	$BGINT	1			;SETUP INTERRUPT LEVEL
	PUSHJ	P,TRPSET		;SETUP TRAP
	$STOP(PDL,Pushdown List Overflow^I/TRPPC/)
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,[XWD IINI.1,I%INT1]	;PREPARE THE INTERRUPT ROUTINES
	BLT	S1,I%INT1+SZ.INB-1	;FOR LATER USE
	MOVE	S1,IB.INT(S2)		;GET THE BASE OF THE INTERRUPT SYSTEM
	MOVEM	S1,BASINT		;STORE FOR LATER
	JUMPE	S1,IINI.2		;IF NO INTERRUPT SYSTEM, DO SOMETHING ELSE
	PUSHJ	P,SETINT		;SET IT UP FOR USER
	SKIPT				;DID IT WORK OK?
	$STOP(CSI,Cannot set up interrupt system)
	JRST	IINI.3			;SETUP APR TRAPS AND RETURN

IINI.1:
	DEFINE X(LVL)<
	Z				;JSR PC STORAGE FOR LEVEL
	JRST	INTC.'LVL		;PROCESSING DISPATH FOR LEVEL
> ;END OF PER LEVEL DEFINITION

	DOLEV (3)			;FORCE HEADER FOR THREE POSSIBLE LEVELS

	SZ.INB==.-IINI.1		;SIZE OF BLOCK

IINI.2:	MOVE	S1,[PUSHJ P,S..NIS]	;NO INTERRUPT SYSTEM,SO SAY SO
	DEFINE	X(LVL),<MOVEM S1,1+I%INT'LVL> ;STORE IN EACH PLACE APPLICABLE
	DOLEV
	JRST	IINI.3			;SETUP APR TRAPS AND RETURN

$STOP(NIS,No interrupt system set up)
IINI.3:	PJRST	SETTRP			;SETUP APRS AND RETURN
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
	  $STOP(CCI,Cannot change interrupt state)
	$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
	  ERCAL	S..CCI			;IF CANNOT DO IT
	$RETT

I%IOFF:	SKIPN	BASINT			;SKIP IF WE ARE DOING INTERRUPTS
	$RETT				;AND RETURN
	MOVX	S1,.FHSLF		;FOR MYSELF
	DIR				;DISABLE INTERRUPTS
	  ERJMP .+2
	$RETT				;RETURN AFTER CHANGE
	  $STOP(CCI,Cannot change interrupt state)

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

INTC.'LVL:

IFGE INT.LV-LVL,<
	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	@I%INT'LVL		;;AND CONTINUE

DBRK'LVL:				;;HERE WHEN INTERRUPT IS OVER
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:	RESET				;NO -- DO A RESET
	$HALT				;STOP THE PROCESS
	MOVEI	S1,[ASCIZ/? Can't continue
/]
	PUSHJ 	P,K%SOUT		;DUMP THE MESSAGE
	JRST	I%EXIT			;LOOP BACK




SUBTTL I%NOW  - Get time of day

;CALL IS:	No arguments
;
;TRUE RETURN:	S1/ Time and date in UDT format


TOPS10 <

I%NOW:	MOVX	S1,%CNDTM		;GET TIME AND DATE FROM
	GETTAB	S1,			;THE MONITOR
	  $STOP(DTU,Date/Time unavailable)
	$RETT				;RETURN S1/HAS UDT

> ;END TOPS10 CONDITIONAL

TOPS20 <

I%NOW:	GTAD				;GET DATE AND TIME
	$RETT				;AND RETURN THEM

> ;END TOPS20 CONDITIONAL
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.

;CALL IS:	S1/ Number of seconds to sleep, or 0 for infinite sleep
;
;TRUE RETURN:	Always


I%SLP:	SKIPGE	S1			;IF A NEGATIVE NUMBER,
	MOVEI	S1,1			;SLEEP FOR A SECOND
	CAILE	S1,^D60			;IF MORE THAN A MINUTE
	MOVEI	S1,^D60			;SLEEP FOR A MINUTE
	IMULI	S1,^D1000		;CONVERT SECONDS TO MILLISECONDS

TOPS10 <
	HIBER	S1,			;DO HIBERNATE FOR SLEEPING
	  $STOP(HUF,HIBER UUO failed)
	$RETT				;RETURN AFTER SLEEPING
> ;END TOPS10 CONDITIONAL

TOPS20 <
SLP0:	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
	$RETT				;RETURN TO CALLER
> ;END TOPS20 CONDITIONAL
	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 (-10) OR ZERO (-20)
	;
	SUBTTL	GETLOC	--	GET CENTRAL SITE LOCATION

I%HOST:
IFN	FTUUOS,<
	MOVEI	S2,.GTLOC		;GET LOCATION OF JOB 0
	GETTAB	S2,			;...
	  JRST	HOST.2			;SETUP DEFAULT AND RETURN
HOST.1:	PUSHJ	P,.SAVE3		;GET THREE ACS
	MOVSI	P1,.NDRNN		;NODE NUMBER TO NAME CONVERSION
	HRRI	P1,P2			;ADDRESS BLOCK IN P2
	HRRZI	P2,2			;2 ARGS SPECIFIED..LENGTH
	MOVE	P3,S2			;NODE NUMBER TO CONVERT,,RIGHT HALF
	NODE.	P1,			;ISSUE NODE UUO
	  JRST	HOST.2			;TAKE DEFAULTS
	MOVE	S1,P1			;PUT NAME IN S1
	$RETT				;RETURN TRUE
HOST.2:	MOVE	S1,[SIXBIT/LOCAL/]	;GET THE DEFAULT NAME
	SETZ	S2,			;DEFAULT NUMBER
	$RETT				;RETURN S1,,NODE NAME
>;END FTUUOS

IFN	FTJSYS,<
	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
	DMOVE	T1,[ASCIZ/LOCAL/]	;SETUP DEFAULT NAME
	NODE				;GET THE LOCAL NODE NAME
	 ERJMP	.+1			;PROCESS DEFAULT
	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
	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	JINF.1			;FUNCTION CODE DO THE WORK
	HRRZS	S2			;GET ROUTINE ADDRESS
	PJRST	(S2)			;PROCESS THE FUNCTION
JINF.1:
TOPS10<
	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<
	$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


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

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
	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
	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
	$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	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	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	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
	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
	MOVE	S2,@THSPRM		;Get job # or SIXBIT node name
	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:	MOVEI	S1,PAGSIZ		;GET SIZE OF MESSAGE
	MOVEM	S1,WTOSAB+SAB.LN	;SAVE IN LENGTH WORD OF WTOSAB
	SETZM	STF			;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	STF			;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 STF		;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