Google
 

Trailing-Edge - PDP-10 Archives - bb-kl11f-bm_tops20_v7_0_atpch1_19 - autopatch/lisspl.x19
There is 1 other file named lisspl.x19 in the archive. Click here to see a list.
	TITLE LISSPL

	SUBTTL STORAGE ALLOCATION AND DEFINITIONS

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

	SEARCH	LISMAC			;CHECK LISSPL'S LIBRARY
	SEARCH	GLXMAC			;CHECK GALAXY LIBRARY
	SEARCH	QSRMAC			;CHECK QUASAR'S LIBRARY
	SEARCH	ORNMAC			;CHECK ORION'S LIBRARY
	SEARCH	GALCNF			;GET CONFIGURATION DATA
	SALL				;CLEAN LISTINGS

	PROLOG (LISSPL)			;GENERATE THE NECESSARY GALAXY SYMBOLS
LISVEC:	BLDVEC	(LISMAC,NMC,L)
	BLDVEC	(LISSPL,LIS,L)
	BLDVEC	(GLXMAC,GMC,L)
	BLDVEC	(ORNMAC,OMC,L)
	BLDVEC	(QSRMAC,QMC,L)

	LISMAN==:6007			;MAINTENANCE EDIT NUMBER
	LISDEV==:6006			;DEVELOPMENT EDIT NUMBER
	VERSIN (LIS)			;GENERATE EDIT NUMBER



	LISWHO==0
	LISVER==6			;MAJOR VERSION NUMBER
	LISMIN==0			;MINOR VERSION NUMBER

	LISVRS==<VRSN.(LIS)>+NMCEDT+GMCEDT+OMCEDT+QMCEDT

	LOC	137
	EXP	LISVRS
	RELOC	
	Subttl	Table of Contents

;		     Table of Contents for LISSPL
;
;				  Section		      Page
;
;
;    1. Revision history . . . . . . . . . . . . . . . . . . .   5
;    2. LISSPL STARTUP AND SCHEDULER . . . . . . . . . . . . .   7
;    3. LISENV - CHECK THE LISSPL ENVIRONMENT  . . . . . . . .   8
;    4. LSINIT - GET NODE NAME, NODE NUMBER, AND SIZE OF LISSP   9
;    5. INTINI - INTERRUPT INITIALIZATION AND HANDLERS . . . .  10
;    6. LISSPL INTERRUPT HANDLERS  . . . . . . . . . . . . . .  11
;    7. NBSCS - TOPOLOGY CHANGE DECTECTED INTERRUPT HANDLER  .  12
;    8. TABINT - INITIALIZE THE TABLES . . . . . . . . . . . .  13
;    9. SRTLIS - START UP THE LISTENERS  . . . . . . . . . . .  14
;   10. STLIS - START UP THE LISTENER  . . . . . . . . . . . .  15
;   11. BLDSRV - BUILD THE SRV: DEVICE NAME  . . . . . . . . .  16
;   12. CLUSTER TOPOLOGY CHANGE DETECTED . . . . . . . . . . .  17
;   13. RESTAR - PROCESS CRASHED INFERIOR FORKS  . . . . . . .  18
;   14. CHKQUE - IPCF MESSAGE PROCESSING . . . . . . . . . . .  19
;   15. RELEAS - RELEASE MESSAGE PROCESSING  . . . . . . . . .  20
;   16. SRHSEN - SEARCH FOR A NODE'S SENDER TABLE ENTRY  . . .  21
;   17. CHKLEN - CHECK THE VALIDITY OF AN IPCF MESSAGE . . . .  22
;   18. QUEMSG - SEND OR QUEUE A MESSAGE . . . . . . . . . . .  23
;   19. SNDMSG - SEND MESSAGES TO AVAILABLE SENDERS  . . . . .  24
;   20. SENMSG - NOTIFY A SENDER OF A MESSAGE AVAILABLE  . . .  25
;   21. GETMSG - PICK UP A MESSAGE FROM A LISTENER . . . . . .  26
;   22. PROMSG - PROCESS DECNET LISTENER MESSAGES DISPATCHER .  27
;   23. NEXTJB - SEND A NEXTJOB MESSAGE FROM A REMOTE NODE TO   28
;   24. RESLIS - RESTART A LISTENER THAT HAS CRASHED . . . . .  29
;   25. DELSEN - KILL AND DELETE A SENDER THAT HAS CRASHED . .  30
;   26. KILSEN - KILL A SENDER THAT HAS CRASHED  . . . . . . .  31
;   27. INFSTS - DETERMINE THE STATUS OF AN INFERIOR FORK  . .  32
;   28. STSEN - START UP A SENDER  . . . . . . . . . . . . . .  33
;   29. BLDDCN - BUILD THE DCN: DEVICE NAME  . . . . . . . . .  34
;   30. SNDQSR - SEND AN IPCF MESSAGE TO QUASAR  . . . . . . .  35
;   31. ADDMQE - ADD A MESSAGE TO A SENDER'S MESSAGE QUEUE . .  36
;   32. RELMQE - RETURN A MESSAGE QUEUE ENTRY TO MEMORY MANAGE  37
;   33. BLDMQE - BUILD A MESSAGE QUEUE ENTRY . . . . . . . . .  38
;   34. LISTEN - MESSAGE SERVER FOR A REMOTE NODE  . . . . . .  39
;   35. LISSET - INITIALIZE THE LISTENER'S GLXLIB AND CAPABILI  40
;   36. LOPLNK - OPEN A DECNET SRV: DEVICE . . . . . . . . . .  41
;   37. LISINT - SET UP THE LISTENER'S INTERRUPT SYSTEM  . . .  42
;   38. ACCEPT - VALIDATE A DECNET CONNECTION REQUEST  . . . .  43
;   39. MSGFSN - DECNET MESSAGE FROM SENDER IS AVAILABLE . . .  44
;   40. CHKRM - CHECK IF ENOUGH ROOM TO ADD AN FP/FD PAIR  . .  45
;   41. SENNXJ - SEND OR QUEUE AN INTERMEDIATE NEXTJOB MESSAGE  46
;   42. CHKACC - CHECK IF SYSTEM HAS ACCESS TO FILE  . . . . .  47
;   43. NOTFRK - NOTIFY TOP FORK OF MESSAGE FROM A LISTENER  .  48
;   44. MSGTTF - TOP FORK READY FOR A MESSAGE FROM A LISTENER   49
;   45. XFRTOP - MOVE MESSAGE FROM MESSAGE QUEUE TO MESSAGE BU  50
;   46. XFRMSG - TRANSFER IPCF MESSAGE FROM ONE BUFFER TO ANOT  51
;   47. INTMSG - PROCESS AN INTERRUPT MESSAGE FROM THE SENDER   52
	Subttl	Table of Contents (page 2)

;		     Table of Contents for LISSPL
;
;				  Section		      Page
;
;
;   48. CHKLST - CHECK LINK STATUS . . . . . . . . . . . . . .  53
;   49. ADDLME - ADD A LISTENER MESSAGE QUEUE ENTRY  . . . . .  54
;   50. LISCHK - LISTENER CHECKSUM MESSAGE . . . . . . . . . .  55
;   51. SNDACK - SEND A SUCCESS ACK TO THE SENDER  . . . . . .  56
;   52. LCKLNK - CHECK THE STATUS OF THE LISTENER'S LINK . . .  57
;   53. INLCRH - ROUTINE TO INDICATE LISTENER CONTROLLED CRASH  58
;   54. LABLNK - ABORT THE LISTENER'S DECNET LINK  . . . . . .  59
;   55. SENDER - MESSAGE ROUTER TO A REMOTE NODE . . . . . . .  60
;   56. SENSET - INITIALIZE THE SENDER'S GLXLIB AND CAPABILITI  61
;   57. SENINT - SET UP THE SENDER'S INTERRUPT SYSTEM  . . . .  62
;   58. SOPLNK - OBTAIN A CONNECTION TO THE LISTENER . . . . .  63
;   59. SGTLNK - OBTAIN DECNET JFN AND OPEN IT . . . . . . . .  64
;   60. SCKLNK - CHECK THE STATUS OF THE SENDER'S LINK . . . .  65
;   61. FNDCER - DETERMINE THE DECNET CONNECTION ERROR . . . .  66
;   62. MSGTLI - SEND A MESSAGE TO THE LISTENER  . . . . . . .  67
;   63. CHKSUM - CHECKSUM DECNET MESSAGES  . . . . . . . . . .  68
;   64. MSGFLI - PICKUP ACK MESSAGE FROM THE LISTENER  . . . .  69
;   65. SSNDMG - SEND A MESSAGE TO A LISTENER  . . . . . . . .  70
;   66. PROTIM - DECNET INACTIVITY TIMER PROCESSOR . . . . . .  71
;   67. CASTIM - CLEAR AND RESET THE DECNET INACTIVITY TIMER .  72
;   68. CLRTIM - CLEAR THE DECNET INACTIVITY TIMER . . . . . .  73
;   69. SABLNK - ABORT THE SENDER'S DECNET LINK  . . . . . . .  74
;   70. INSCRH - ROUTINE TO INDICATE SENDER CONTROLLED CRASH .  75
;   71. LISDDT - ROUTINE TO LOAD DDT IF DEBUGGING  . . . . . .  76
;   72. GETPAG - GET A PAGE FOR OUTGOING IPCF MESSAGE  . . . .  77
;   73. COMMON STOPCODES . . . . . . . . . . . . . . . . . . .  78
	SUBTTL	Revision history

COMMENT \

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

6000	6.1065		Nov-9-87
	Create LISSPL as Cluster LPTSPL's listener

6001	6.1118		Dec-5-87
	If a listener detects that the DECnet link is no longer connected,
then in addition to aborting and re-opening the link, cause it also to
clear and re-setup the interrupt system.

6002	6.1128		Dec-7-87
	Expand on edit 6001 to include all cases where a listener detects that
the DECnet link is no longer connected. Also, clear and reset the interrupt
system out of interrupt context to prevent NIP ("no interrupt in progress)
crashes.

6003	6.1215		Mar-4-88
	In a private GALAXY, use the first six characters of the user's name
rather than LISSPL and LPTSPL as part of the SRV: and DCN: names.

6004	6.1220		Mar-6-88
	Fix bugs discovered while testing inaccessible files.

6005	6.1225		8-Mar-88
	Update copyright notice.

6006	6.1254		12-May-88
	Correct the spelling of LISSPL in the LISSPL sender DECnet connection
failure message.

6007	6.1261		14-Jun-88
	In routine LISSET: ignore increment structure check so that we can
access files on REGULATE structures without have to mount it.
\	;End of revision history
;SYMBOL DEFINITONS

PDSIZ==^D200				;SIZE OF THE PUSH DOWN STACK
MAXNOD==7				;MAXIMUM NUMBER OF REMOTE NODES
DBSIZ==2				;SIZE OF SENDER/LISTENER DATA BASE
M==13					;INCOMING IPCF MESSAGE ADDRESS
MO==14					;OUTGOING IPCF MESSAGE
LIS==15					;LISTENER DATA BASE ADDRESS
SEN==16					;SENDER DATA BASE ADDRESS
INFBSZ==6				;INFO% JSYS BLOCK SIZE
SCSCN==3				;SCS% CHANNEL NUMBER
SCSLEN==1+.SQDTA+SQ%CDT			;SIZE OF SCS% EVENT BLOCK
TIMITL==3*^D60*^D30			;DECNET INACTIVIY TIME LIMIT
MAXCRH==^D10				;MAXIMUM TIMES AN INFERIOR FORK CAN 
                                        ;CRASH
;RANDOM STORAGE AREA

PDL:	BLOCK PDSIZ			;PUSH DOWN STACK
NODNAM:	BLOCK 1				;THE LOCAL NODE NAME (SIXBIT)
NODNUM: BLOCK 1				;THE LOCAL NODE NUMBER
NUMSEN:	BLOCK 1				;NUMBER OF SENDERS
ACTLIS: BLOCK 1				;NUMBER OF ACTIVE LISTENERS
RENNUM: BLOCK 1				;NUMBER OF REMOTE NODES IN THE CLUSTER
NBSCHD:	BLOCK 1				;LISSPL SCHEDULING FLAG
LISSIZ: BLOCK 1				;THE NUMBER OF PAGES IN LISSPL
SCHTIM: BLOCK 1				;TIME OF THE LAST SCHEDULING PASS
MSGTIM:	BLOCK 1				;TIME A IPCF MESSAGE WAS PICKED UP
G$SND:	BLOCK 1				;PID OF IPCF MESSAGE SENDER
SAB:	BLOCK SAB.SZ			;IPCF SENDER ADDRESS BLOCK
SCSBLK:	EXP   2				;SCS% INTERRUPT ENABLED BLOCK SIZE
	XWD   .SIPAN,SCSCN		;ASSOCIATE SCS EVENTS WITH CHAN SCSCN
SCSEBK:	BLOCK SCSLEN			;SCS% EVENT BLOCK
NODDAT: BLOCK 1				;NODE NAME PASSED AS OPTIONAL DATA

INTVEC==:LEVTAB,,CHNTAB

IB:	$BUILD	IB.SZ			;
	  $SET	(IB.PRG,,%%.MOD)	;PROGRAM 'LISSPL'
	  $SET  (IB.FLG,IP.STP,1)	;STOPCODES TO ORION
	  $SET	(IB.PIB,,PIB)		;SET UP PIB ADDRESS
	  $SET	(IB.INT,,INTVEC)	;SETUP INTERRUPT VECTOR ADDRESS
	$EOB				;


PIB:	$BUILD	PB.MNS			;
	  $SET	(PB.HDR,PB.LEN,PB.MNS)	;PIB LENGTH,,0
	  $SET	(PB.FLG,IP.PSI,1)	;PSI ON
	  $SET	(PB.FLG,IP.RSE,1)	;RETURN ON SEND ERROR
	  $SET	(PB.FLG,IP.SPB,1)	;SEE IF IPCF SENDER WAS PRIVILEGED
	  $SET	(PB.FLG,IP.JWP,1)	;JOB-WIDE PID
	  $SET	(PB.INT,IP.CHN,2)	;IPCF INTERRUPT CHANNEL
	  $SET	(PB.SYS,IP.BQT,-1)	;MAXIMUM SEND/RECEIVE IPCF QUOTA
	  $SET	(PB.SYS,IP.MNP,MAXNOD+NUMLIS+1)	;NUMBER OF PIDS
	$EOB				;


LEVTAB:	EXP	LEV1PC			;INTRPT LEVEL 1 PC ADDRESS
	EXP	LEV2PC			;INTRPT LEVEL 2 PC ADDRESS
	EXP	LEV3PC			;INTRPT LEVEL 3 PC ADDRESS

CHNTAB:	XWD	1,LISMSG		;LISTENER HAS A MESSAGE
	XWD	1,SNDREA		;SENDER IS READY FOR A MESSAGE
	XWD	1,NBIPCF		;IPCF HAS A MESSAGE
	XWD	1,NBSCS			;SCS DETECTED A CLUSTER TOPOLOGY CHANGE
	BLOCK	^D32			;INFERIOR FORK TERMINATED ON CHANNEL 19
					;ALL OTHER CHANNELS 0

LEV1PC:	BLOCK	1			;LEVEL 1 INTERRUPT PC
LEV2PC:	BLOCK	1			;LEVEL 2 INTERRUPT PC
LEV3PC:	BLOCK	1			;LEVEL 3 INTERRUPT PC

;RESIDENT JOB DATA BASE

SREADY:	BLOCK 1				;SENDER IS AVAILABLE FLAG
LREADY:	BLOCK 1				;LISTENER HAS MESSAGE FLAG
TRMFRK: BLOCK 1				;AN INFERIOR FORK HAS TERMINATED
SCSFLG: BLOCK 1				;A CLUSTER TOPOLOGY CHANGE DETECTED
ASZNAM:	BLOCK 1+<MAXNOD+1>+2*<MAXNOD+1>	;ASCIZ NODE NAMES FROM CNFIG% .CFCND
SWINFO:	BLOCK .CFILN			;STATIC SOFTWARE INFORMATION
INFBLK: BLOCK INFBSZ			;INFO% SOFTWARE INFORMATION BLOCK
.STZER:					;START OF INIT TO ZERO
LISTAB:	BLOCK NUMLIS*.LTSIZ		;LISTENER TABLE
SENTAB:	BLOCK MAXNOD*.STSIZ		;SENDER TABLE
NODTAB:	BLOCK MAXNOD			;NODE NAME TABLE
.SZZER==.-.STZER			;SIZE OF INIT TO ZERO
	SUBTTL	LISSPL STARTUP AND SCHEDULER

LISSPL:	RESET%				;THE USUAL
	MOVE	P,[IOWD PDSIZ,PDL]	;SET UP THE STACK.
	MOVEI	S1,IB.SZ		;GET THE INITIALIZATION BLOCK SIZE.
	MOVEI	S2,IB			;ADDRESS OF THE INITIALIZATION BLOCK
	$CALL	I%INIT			;SET UP GLXLIB
	$CALL	LISENV			;CHECK THE LISSPL ENVIRONMENT
	$CALL	LSINIT			;GO SETUP CONSTANTS AND CAPABILITIES
	$CALL	INTINI			;SET UP THE INTERRUPT SYSTEM.
	$CALL	TABINT			;INITIALIZE THE TABLES
	$CALL	SRTLIS			;START UP THE LISTENERS
MAIN:	$CALL	I%NOW			;GET THE DATE/TIME
	MOVEM	S1,SCHTIM		;SAVE AS THE TIME OF SCHEDULING PASS
	SETZM	NBSCHD			;SLEEP AFTER THIS PASS

	SKIPE	SCSFLG			;CLUSTER TOPOLOGY CHANGE OCCURRED?
	$CALL	TOPCHN			;YES, UPDATE THE NODE DATA BASE

	SKIPE	TRMFRK			;HAS A SENDER OR LISTENER CRASHED?
	$CALL	RESTAR			;YES, FIND OUT WHICH ONE

	$CALL	CHKQUE			;CHECK FOR IPCF MESSAGES

	SKIPE	SREADY			;IS A SENDER AVAILABLE?
	$CALL	SNDMSG			;YES, FIND OUT WHICH SENDER 

	SKIPE	LREADY			;DOES A LISTENER HAVE A MESSAGE?
	$CALL	GETMSG			;YES, PICK IT UP

	SKIPE	NBSCHD			;TIME FOR ANOTHER SCHEDULING PASS?
	JRST	MAIN			;YES, GO CHECK AGAIN

	SETZ	S1,			;SLEEP UNTIL INTERRUPTED
	$CALL	I%SLP			;DON'T WAKE UP UNTIL INTERRUPTED
	JRST	MAIN			;GO PROCESS THE INTERRUPT
	SUBTTL	LISENV - CHECK THE LISSPL ENVIRONMENT

;LISENV is called during LISSPL startup to determine if the local node
;has DECnet enabled. If DECnet is not enabled, then LISENV halts.
;
;Call is: No arguments
;Returns: Only if DECnet is enabled for this node
;Crashes: If cannot obtain the static software information or DECnet is
;         not enabled.

LISENV:	$SAVE	<T1,T2>			;CONFG% JSYS CHANGES THESE AC
	MOVEI	S2,SWINFO		;PICK UP ARGUMENT BLOCK ADDRESS
	MOVEI	S1,.CFILN		;PICK UP THE LENGTH OF THE ARG BLOCK
	MOVEM	S1,.CFLEN(S2)		;PLACE IT IN THE ARGUMENT BLOCK
	MOVEI	S1,.CFINF		;PICK UP THE FUNCTION
	CNFIG%				;GET THE SOFTWARE INFORMATION
	 ERJMP	LISEN1			;ON AN ERROR, CRASH

	MOVEI	S1,SWINFO		;PICK UP ARGUMENT BLOCK ADDRESS
	MOVE	S2,.CFISO(S1)		;PICK UP THE STATIC SOFTWARE OPTIONS
	TLNN	S2,(CF%DCN)		;IS DECNET INSTALLED?
	$STOP	(DNI, DECNET NOT INSTALLED)	;NO, TERMINATE NOW
	$RET				;LISSPL IS IN THE CORRECT ENVIRONMENT

LISEN1:	$STOP	(COS, CAN'T OBTAIN STATIC SOFTWARE INFORMATION)
	SUBTTL	LSINIT - GET NODE NAME, NODE NUMBER, AND SIZE OF LISSPL

;LSINIT is called during LISSPL startup. This routine determines the
;name and cluster node number of this node (the local node). 
;In addition, the size of LISSPL (in pages) is also determined,
;which is used when mapping a sender or listener.
;
;Call is: No arguments
;Returns: Node name and number, LISSPL size determined and saved

;PICK UP THE NODE NAME AND NUMBER OF THE LOCAL NODE

LSINIT:	$CALL 	I%HOST			;GET OUR HOST NAME
	MOVEM	S1,NODNAM		;SAVE THE SIXBIT NODE NAME
	MOVEM	S2,NODNUM		;SAVE THE NODE NUMBER

;PICK UP AND SAVE THE NUMBER OF PAGES LISSPL'S CODE TAKES UP

	SKIPE	DEBUGW			;DEBUGGING?
	SKIPN	116			;AND ARE SYMBOLS DEFINED?
	JRST	LSIN.1			;IF NO TO EITHER, SKIP THE FOLLOWING
	HLRO	S1,116			;GET AOBJN LENGTH
	MOVMS	S1			;GET ABSOLUTE VALUE
	HRRZ	S2,116			;GET SYMBOL TABLE START ADDRESS
	ADDI	S1,-1(S2)		;CALCULATE THE SYMBOL TABLE LENGTH
	SKIPA				;SKIP OVER NORMAL CALCULATIONS
LSIN.1:	HLRZ	S1,.JBSA##		;GET THE PROGRAM END ADDRESS
	ADDI	S1,PAGSIZ-1		;ROUND IT OFF
	ADR2PG	S1			;MAKE IT A PAGE NUMBER
	MOVEM	S1,LISSIZ		;SAVE IT
	$RET				;RETURN TO STARTUP
	SUBTTL INTINI -	INTERRUPT INITIALIZATION AND HANDLERS

;INTINI is called during LISSPL startup. This routine activates
;the interrupt channels:
;
;0  - A listener has a message
;1  - A sender is ready to send a message
;2  - IPCF has one or more messages available
;3  - SCS% detected a cluster topology change
;19 - (channel .IPIFT) One or more senders and/or listeners have crashed
;
;Call is: No arguments
;Returns: The interrupt system has been setup successfully
;Crashes: Cannot activate the interrupt system or cannot enable
;         SCS% event interrupts

INTINI:	$SAVE	<T1,T2>			;CHANGED BY SCS% JSYS
	MOVE	S1,[1,,ENDFRK]		;SET UP INFERIOR FORK TERM PARMS
	MOVEM	S1,CHNTAB+.ICIFT	;IN THE CHANNEL TABLE
	MOVEI	S1,.FHSLF		;GET MY HANDLE
	MOVX	S2,17B3+1B19		;GET CHANNELS 0-4 AND 19
	AIC%				;ACTIVATE THEM
	 ERJMP	S..CSI			;THIS SHOULD NEVER HAPPEN
	$CALL	I%ION			;ENABLE THE INTERRUPTS
	JUMPF	S..CSI			;THIS SHOULD NEVER HAPPEN

;TELL SCS% TO INTERRUPT US FOR EVENTS

	MOVEI	S1,.SSAIC		;ADD INTERRUPT CHANNEL FOR SCA EVENTS
	MOVEI	S2,SCSBLK		;POINT TO THE BLOCK
	SCS%				;INFORM SCS%
	 ERJMP	S..CSI			;THIS SHOULD NOT HAPPEN

	$RET				;RETURN
	SUBTTL	LISSPL INTERRUPT HANDLERS

;LISMSG - Listener has a message interrupt handler. This routine sets flag
;         word LREADY which indicates that a listener has a message to
;         deliver to LISSPL's top fork.
;
;SNDREA - Sender is free to deliver a message interrupt handler. This routine
;         sets flag word SREADY which indicates that a sender is free to
;         deliver a message.
;
;NBIPCF - IPCF interrupt handler. This routine sets flag word MSGFLG
;         which indicates that there are one or more IPCF messages available.
;
;ENDFRK - Inferior fork crashed interrupt handler. This routine sets flag
;         word TRMFRK which indicates that a sender or listener has crashed.
;
;NBSCS  - Topology change detected interrupt handler. This routine sets
;         flag word SCSFLG which indicates that a cluster topology change
;         has occurred.  

LISMSG:	$BGINT	1,			;INITIALIZE INTERRUPT LEVEL
	SETOM	LREADY			;A LISTENER HAS A MESSAGE
	$DEBRK				;AND LEAVE INTERRUPT LEVEL

SNDREA: $BGINT	1,			;INITIALIZE INTERRUPT LEVEL
	SETOM	SREADY			;A SENDER IS READY FOR A MESSAGE
	$DEBRK				;AND LEAVE INTERRUPT LEVEL

NBIPCF:	$BGINT	1,			;INITIALIZE INTERRUPT LEVEL
	$CALL	C%INTR			;FLAG THE IPCF INTERRUPT
	$DEBRK				;AND LEAVE INTERRUPT LEVEL

ENDFRK:	$BGINT	1,			;INTIALIZE INTERRUPT LEVEL
	SETOM	TRMFRK			;A LISTENER OR SENDER HAS CRASHED
	$DEBRK				;AND LEAVE INTERRUPT LEVEL
	SUBTTL NBSCS - TOPOLOGY CHANGE DECTECTED INTERRUPT HANDLER

;NBSCS processes interrupts that occur as a consequence of a cluster
;topology change. Flag word SCSFLG is set to -1 to indicate that a
;node has left the cluster.
;
;DEBRKs with word SCSFLG set to -1 if a node has left the cluster
;Crashes: If the SCS% JSYS returns an error other than "event queue empty"

NBSCS:	$BGINT	1,			;INITIALIZE INTERRUPT LEVEL

;PICK UP THE NEXT EVENT FROM THE EVENT QUEUE

NBSC2:	MOVEI	S1,SCSLEN		;LENGTH OF THE ARGUMENT BLOCK
	MOVEM	S1,SCSEBK+.SQLEN	;PLACE IN THE ARGUMENT BLOCK
	SETOM	SCSEBK+.SQCID		;GET THE NEXT EVENT

	MOVEI	S1,.SSEVT		;RETRIEVE NEXT ENTRY FROM EVENT QUEUE
	MOVEI	S2,SCSEBK		;ADDRESS OF THE ARGUMENT BLOCK
	SCS%				;PICK UP THE NEXT EVENT QUEUE ENTRY
	 ERJMP	NBSC4			;CHECK IF THE EVENT QUEUE IS NOW EMPTY

;CHECK THE TYPE OF EVENT THAT HAS OCCURRED

	MOVE	S1,SCSEBK+.SQEVT	;PICK UP THE EVENT CODE
	CAIN	S1,.SENCO		;HAS A NODE COME ONLINE?
	JRST	NBSC2			;YES, DON'T CARE ABOUT THIS EVENT
	CAIE	S1,.SEPBC		;HAS A NODE GONE OFFLINE?
	JRST	NBSC2			;NO, DON'T CARE ABOUT THIS EVENT

;INDICATE THAT A NODE HAS LEFT THE CLUSTER

NBSC3:	SETOM	SCSFLG			;A CLUSTER TOPOLOGY CHANGE OCCURRED
	JRST	NBSC2			;CHECK FOR ANOTHER EVENT QUEUE ENTRY

;THE SCS% JSYS RETURNED AN ERROR. CHECK IF THE EVENT QUEUE IS EMPTY.
;IF SO, RETURN. ON OTHER ERRORS, CRASH. THIS IS BECAUSE IT CANNOT JUST BE
;ASSUMED THAT A TOPOLOGY CHANGE HAS OCCURRED, SINCE IF THE ROUTINE EXITS ON
;THIS ASSUMPTION AND THERE ARE MORE EVENTS IN THE EVENT QUEUE, THEN LISSPL
;WILL NOT BE INTERRUPTED AGAIN IF A CLUSTER TOPOLOGY CHANGE OCCURS.

NBSC4:	MOVEI	S1,.FHSLF		;GET LATEST ERROR OF LISSPL
	GETER%				;PICK UP THE ERROR
	 ERJMP	S..SIF			;FATAL ERROR IN SCS% INTERRUPT HANDLER
	HRRZS	S2			;ISOLATE THE ERROR CODE
	CAIN	S2,SCSQIE		;EVENT QUEUE EMPTY?
	$DEBRK
	JRST	S..SIF			;FATAL ERROR IN SCS% INTERRUPT HANDLER
	SUBTTL	TABINT - INITIALIZE THE TABLES

;TABINT is called during LISSPL startup to initialize the listener, sender
;and node tables. The tables are initialized by zeroing all their entries.
;
;Call is: No arguments
;Returns: The tables have been initialized

TABINT:	MOVEI	S1,.SZZER		;SIZE OF REGION TO BE ZEROED
	MOVEI	S2,.STZER		;START OF REGION TO BE ZEROED
	$CALL	.ZCHNK			;ZERO THE TABLES
	SETZM	NUMSEN			;NO SENDERS AT THIS POINT
	$RET				;RETURN TO LISSPL STARTUP
	SUBTTL	SRTLIS - START UP THE LISTENERS 

;SRTLIS is called during LISSPL startup. SRTLIS starts up NUMLIS listeners.
;Call is: No arguments
;Returns: The listeners have been started
;Crashes: A listener cannot be started

SRTLIS:	$SAVE	<P1,P2>			;SAVE THESE AC

	MOVEI	P1,LISTAB		;PICK UP LISTENER TABLE ADDRESS
	MOVEI	P2,NUMLIS		;PICK UP NUMBER OF LISTENERS TO START
	MOVEM	P2,ACTLIS		;SAVE AS ACTIVE NUMBER OF LISTENERS
SRTLI1:	MOVE	S1,P1			;PICK UP THIS LISTENER'S ENTRY ADDRESS
	$CALL	STLIS			;START THIS LISTENER
	ADDI	P1,.LTSIZ		;ADR OF THE NEXT LISTENER TABLE ENTRY
	SOJG	P2,SRTLI1		;START UP THE NEXT LISTENER
	$RET				;RETURN TO LISSPL STARTUP
	SUBTTL	STLIS - START UP THE LISTENER

;STLIS is called to start up a listener. 
;This routine is called at LISSPL startup and also when a listener has
;crashed.
;
;Note: The listener block pages are obtained via the GLXMEM routine M%AQNP.
;M%AQNP zeros out the pages it returns. This implies the following:
;
;	SETZM	.LSLNK(LIS)		;ZERO OUT THE DECNET STATUS LINK
;	SETZM	.LSAVA(LIS)		;THE TOP FORK IS BUSY
;	SETZM	.LSHWD(LIS)		;THE LISTENER'S MESSAGE QUEUE IS EMPTY
;
;Call is: S1/Listener table entry address for this listener
;Returns: A listener is successfully started. 
;Crashes: If the listener cannot be started (i.e., a CFORK%, SFORK% or
;         PMAP% error has occurred).

STLIS:	$SAVE	<P1,T1,T2>			;SAVE THESE AC

;OBTAIN AND INITIALIZE THE LISTENER DATA BASE

	MOVE	P1,S1			;SAVE THE LISTENER TABLE ENTRY ADDRESS
	MOVEI	S1,DBSIZ		;SIZE OF THE LISTENER BLOCK IN PAGES
	$CALL	M%AQNP			;GET THE LISTENER BLOCK PAGES
	PG2ADR	S1			;CHANGE PAGE NUMBER TO ADDRESS
	MOVEM	S1,.LTADR(P1)		;SAVE ADDRESS IN THE LISTENER BLOCK
	MOVE	LIS,S1			;PLACE ADR IN LISTENER BLOCK DB POINTER
	ADDI	S1,PAGSIZ		;POINT TO THE MESSAGE BUFFER ADDRESS
	MOVEM	S1,.LSMSG(LIS)		;SAVE THE MESSAGE BUFFER ADDRESS
	MOVEM	P1,.LSLTA(LIS)		;SAVE THE LISTENER TABLE ENTRY ADDRESS
	$CALL	BLDSRV			;BUILD THE DECNET SRV: DEVICE NAME

;SETUP THE CONTEXT OF THE LISTENER

	MOVEI	S1,.LSPDL-1(LIS)	;SET UP THE LISTENER CONTEXT
	HRLI	S1,-PDSIZ		;STACK POINTER
	PUSH	S1,[EXP LISTEN]		;START THE LISTENER HERE
	MOVEM	S1,.LSACS+P(LIS)	;PLACE IN THE DATABASE
	MOVEM	LIS,.LSACS+LIS(LIS)	;SAVE THE ADDRESS OF THE DB
	SETOM	.LSAVA(LIS)		;INDICATE TOP FORK READY FOR MESSAGES

;START UP THE LISTENER. FIRST CREATE THE LISTENER AS AN INFERIOR FORK
;WITH THE SAME CAPABILIIES AS THE TOP FORK.

	MOVX	S1,<CR%CAP+CR%ACS>	;SUPERIOR CAPABILITIES AND AC'S
	MOVEI	S2,.LSACS(LIS)		;AC LOAD BUFFER
	CFORK%				;CREATE A LISTENER
	 ERJMP	STLIS2			;CRASH ON AN ERROR

;MAP LISSPL'S PAGES INTO THE LISTENER

	MOVEM	S1,.LSHND(LIS)		;SAVE THE LISTENER'S HANDLE
	HRLZ	S2,S1			;GET THE LISTENER'S HANDLE
	MOVSI	S1,.FHSLF		;GET THE TOP FORK'S HANDLE
	MOVE	T1,LISSIZ		;GET THE LENGTH IN PAGES
	HRLI	T1,(PM%RWX!PM%CNT)	;COUNT+READ+EXECUTE
	PMAP%				;MAP THE PAGES
	 ERJMP	STLIS3			;CRASH ON AN ERROR

;MAP THE LISTENER BLOCK PAGES INTO THE LISTENER

	MOVE	S1,LIS			;GET THE LISTENER'S BLOCK ADDRESS
	ADR2PG	S1			;CONVERT IT TO A PAGE NUMBER
	MOVE	S2,S1			;SAVE IT IN S2
	HRLI	S1,.FHSLF		;GET THE TOP FORK'S HANDLE
	HRL	S2,.LSHND(LIS)		;GET THE LISTENER'S HANDLE
	MOVEI	T1,DBSIZ		;GET THE PAGE COUNT
	HRLI	T1,(PM%RWX!PM%CNT)	;R,W,E + COUNT
	PMAP%				;MAP THE DATA BASE
	 ERJMP	STLIS3			;CRASH ON AN ERROR

;START THE LISTENER

	MOVE	S1,.LSHND(LIS)		;GET THE LISTENER'S HANDLE
	MOVEI	S2,LISTEN		;GET THE START ADDRESS
	SFORK%				;START THE LISTENER
	 ERJMP	STLIS4			;ON ERROR, PROCESS IT
	$RET				;AND RETURN

STLIS2:	$STOP	(CCL,CAN'T CREATE A LISTENER FORK)

STLIS3:	$STOP	(CML,CAN'T MAP A LISTENER)
	
STLIS4:	$STOP	(CSL, CAN'T START A LISTENER)
	SUBTTL	BLDSRV - BUILD THE SRV: DEVICE NAME

;BLDSRV builds the listener's DECnet SRV: device name and places it in the
;listener block. It also builds the name of the sender that will attempt
;to establish a DECnet connection with the listener. The sender name is
;used by the listener as part of validating a link request.
;
;Call is: LIS/Address of the listener block
;Returns: The SRV: device name and the sender name have been built and
;         placed in the listener block

BLDSRV:	SKIPE	DEBUGW				;[6003]DEBUGGING?
	JRST	BLDS.1				;[6003]YES, BUILD DIFFERENTLY
	$TEXT	(<-1,,.LSSRV(LIS)>,<SRV:TASK.^N/NODNAM/$LISSPL$LS^0>)
	$TEXT	(<-1,,.LSSNE(LIS)>,<^N/NODNAM/$LPTSPL$SN^0>) ;SENDER NAME
	$RET					;RETURN TO THE CALLER

BLDS.1:	$SAVE	<T1,T2>				;[6003]SAVE THESE AC
	GJINF%					;[6003]PICK UP THE USER'S NUMBER
	MOVE	S2,S1				;[6003]SAVE NUMBER WHERE EXPECTED
	MOVEI	S1,.LSDBW(LIS)			;[6003]WHERE TO PLACE USER NAME
	HRLI	S1,(POINT 7)			;[6003]MAKE INTO A POINTER
	DIRST%					;[6003]PICK UP THE USER NAME
	 JRST	S..COD				;[6003]CRASH ON AN ERROR
	MOVEI	S1,.LSDBW(LIS)			;[6003]PICK UP USER NAME ADDRESS
	HRLI	S1,(POINT 7,)			;[6003]MAKE INTO A POINTER
	SETZ	T1,				;[6003]NUMBER OF CHAR IN NAME
BLDS.2:	ILDB	S2,S1				;[6003]PICK UP THE NEXT CHARACTER
	SKIPN	S2				;[6003]IS THIS THE LAST ONE?
	JRST	BLDS.3				;[6003]YES, BUILD THE DEVICE NAME
	AOS	T1				;[6003]INCREMENT THE CHAR COUNT
	CAIG	T1,^D6				;[6003]MAXIMUM COUNT?
	JRST	BLDS.2				;[6003]NO, GET THE NEXT CHAR
	SETZ	S2,				;[6003]PICK UP A NULL
	DPB	S2,S1				;[6003]PLACE IN USER NAME

BLDS.3:	MOVEI	S1,.LSDBW(LIS)			;[6003]ADDRESS OF THE USER NAME
	$TEXT	(<-1,,.LSSRV(LIS)>,<SRV:TASK.^N/NODNAM/$^T/0(S1)/$LS^0>)
	$TEXT	(<-1,,.LSSNE(LIS)>,<^N/NODNAM/$^T/0(S1)/$SN^0>) ;SENDER NAME
	$RET					;[6003]RETURN TO THE CALLER
	SUBTTL	CLUSTER TOPOLOGY CHANGE DETECTED

;TOPCHN is called as a result of the SCS interrupt handler
;detecting that the cluster topology has changed. This routine interrupts
;the listeners in order for them to check if their DECnet links are still
;connected. This is necessary since if a node that a listener has a connection
;to crashes, the listener is not interrupted. (The listener is also not
;interrupted when the node comes back up.)
;
;Call is: No arguments
;Returns: Updated node table and the listeners have been interrupted
;Crashes: If a listener cannot be interrupted

TOPCHN: $SAVE	<T1,T2,T3,T4>		;SAVE THESE AC

;FIRST READ IN THE LATEST TOPOLOGY OF THE CLUSTER

	SETZM	SCSFLG			;RESET THE SCS% INTERRUPT FLAG
	SETOM	NBSCHD			;FORCE A SCHEDULING PASS

;INTERRUPT THE LISTENERS TO INDICATE THAT THEY SHOULD CHECK THE STATUS OF
;THEIR DECNET LINKS

	MOVEI	T3,LISTAB		;PICK UP ADDRESS OF THE LISTENER TABLE
	MOVEI	T4,NUMLIS		;PICK UP THE NUMBER OF LISTENERS
TOPCH1:	MOVE	S1,.LTSTA(T3)		;PICK UP THE LISTENER'S STATUS WORD
	TXNE	S1,LT%NRS		;CAN THIS LISTENER BE RESTARTED?
	JRST	TOPCH2			;NO, CHECK THE NEXT LISTENER
	MOVE	S1,.LTADR(T3)		;PICK UP ADDRESS OF LISTENER BLOCK
	MOVE	S1,.LSHND(S1)		;PICK UP THE LISTENER'S FORK HANDLE
	MOVX	S2,<1B4>		;INDICATE LISTENER CHECK LINK STATUS
	IIC%				;INTERUPT THIS LISTENER
	 ERJMP	S..UII			;CRASH ON AN ERROR
TOPCH2:	ADDI	T3,.LTSIZ		;POINT TO THE NEXT LISTENER ENTRY
	SOJG	T4,TOPCH1		;INTERRUPT THE NEXT LISTENER
	$RET				;AND RETURN TO THE CALLER
	SUBTTL	RESTAR - PROCESS CRASHED INFERIOR FORKS

;RESTAR is called by the scheduler when it detects that an inferior fork
;has crashed. It determines which fork has crashed. If the crashed fork
;has crashed MAXCRH times, then the fork is not restarted and ORION is
;informed. If there are no more active listeners left, then LISSPL crashes.
;If the crashed fork is a sender and there are no messages for the sender,
;then the sender is not restarted. However, if the sender does have one
;or messages in its message queue, then these messages are kept for the
;restarted sender.
;
;Call is: No arguments
;Returns: Senders and listeners have been updated
;Crashes: If a sender or a listener could not be restarted

RESTAR:	$SAVE	<P1,P2,P3>		;SAVE THESE AC
	SETZM	TRMFRK			;CLEAR THE INFERIOR FORK CRASHED FLAG
	SETOM	NBSCHD			;FORCE ANOTHER SCHEDULING PASS
	MOVEI	P1,LISTAB		;PICK UP THE LISTENER TABLE ADDRESS
	MOVEI	P2,NUMLIS		;PICK UP NUMBER OF LISTENERS

;CHECK IF THE LISTENER CAN BE RESTARTED. IF IT CAN, CHECK IF IT HAS HAD
;A CONTROLLED CRASH OR AN UNCONTROLLED CRASH.

RESTA1:	MOVE	S1,.LTSTA(P1)		;PICK UP THE STATUS WORD
	TXNE	S1,LT%NRS		;CAN THIS LISTENER BE RESTARTED?
	JRST	RESTA4			;NO, GO CHECK THE NEXT LISTENER
	TXNE	S1,LT%LFC		;DID LISTENER HAVE CONTROLLED CRASH?
	JRST	RESTA2			;YES, CHECK IF CRASHED MAX TIMES
	MOVE	LIS,.LTADR(P1)		;PICK UP LISTENER BLOCK ADDRESS
	MOVE	S1,.LSHND(LIS)		;PICK UP THE LISTENER'S HANDLE	
	$CALL	INFSTS			;CHECK IF IT HAS CRASHED
	JUMPT	RESTA4			;THIS LISTENER DID NOT CRASH

;THE LISTENER HAS CRASHED. CHECK IF IT HAS CRASHED THE MAXIMUM TIMES. IF SO,
;THEN DON'T RESTART.

RESTA2:	AOS	S1,.LTCRT(P1)		;INCREMENT TIMES IT HAS CRASHED
	CAIG	S1,MAXCRH		;HAS IT CRASHED THE MAX TIMES?
	JRST	RESTA3			;NO, GO RESTART IT
	MOVX	S1,LT%NRS		;PICK UP DON'T RESTART FLAG
	IORM	S1,.LTSTA(P1)		;INDICATE IN THE STATUS BLOCK
	MOVE	S1,.LTADR(P1)		;PICK UP ADDRESS OF LISTENER BLOCK
	SETOM	.LSAVA(S1)		;INDICATE DON'T ATTEMPT MSG PICK UP
	SOSE	S1,ACTLIS		;DECREMENT THE NUMBER ACTIVE LISTENERS
	JRST	RESTA4			;GO CHECK THE NEXT LISTENER
	$STOP	(NAL,NO ACTIVE LISTENERS)
RESTA3:	MOVE	S1,P1			;PICK UP THE LISTENER TABLE ENTRY ADR
	$CALL	RESLIS			;RESTART THE LISTENER
RESTA4:	ADDI	P1,.LTSIZ		;POINT TO THE NEXT LISTENER TABLE ENTRY
	SOJG	P2,RESTA1		;GO CHECK THE NEXT LISTENER

;CHECK FOR ANY SENDERS THAT MAY HAVE CRASHED. CHECK IF A CRASHED SENDER HAS HAD
;A CONTROLLED CRASH OR AN UNCONTROLLED CRASH.

	MOVE	P3,NUMSEN		;PICK UP THE NUMBER OF SENDERS
	JUMPE	P3,RESTA9		;QUIT IF THERE ARE NO SENDERS
	MOVEI	P1,SENTAB		;PICK UP THE SENDER TABLE ADDRESS
	MOVEI	P2,MAXNOD		;PICK UP THE MAX NUMBER OF ENTRIES
RESTA5:	SKIPN	.STNOD(P1)		;IS THIS ENTRY IN USE?
	JRST	RESTA8			;NO, GO CHECK THE NEXT ENTRY
	MOVE	S1,.STSTS(P1)		;PICK UP THE STATUS WORD
	TXNE	S1,ST%SFC		;DID SENDER HAVE CONTROLLED CRASH?
	JRST	RESTA6			;YES, KILL THIS SENDER
	MOVE	SEN,.STADR(P1)		;PICK UP SENDER BLOCK ADDRESS
	MOVE	S1,.SNHND(SEN)		;PICK UP THE SENDER'S HANDLE	
	$CALL	INFSTS			;CHECK IF IT HAS CRASHED
	JUMPT	RESTA8			;THIS SENDER DID NOT CRASH

;THE SENDER HAS CRASHED. CHECK IF IT HAS CRASHED THE MAXIMUM TIMES. IF SO,
;THEN DON'T RESTART.

RESTA6:	MOVE	S1,P1			;PICK UP THE SENDER TABLE ENTRY ADDRESS
	$CALL	DELSEN			;YES, KILL AND DELETE THIS SENDER
RESTA8:	ADDI	P1,.STSIZ		;POINT TO THE NEXT SENDER TABLE ENTRY
	SOJG	P2,RESTA5		;GO CHECK THE NEXT SENDER
RESTA9:	$RET				;RETURN TO THE CALLER
	SUBTTL	CHKQUE - IPCF MESSAGE PROCESSING

;CHKQUE is called by the scheduler to pick up the IPCF message or messages
;that have arrived from QUASAR. Only messages sent directly from QUASAR are
;accepted. Any messages with an unknown message code are ignored.
;
;Call is: No arguments
;Returns: All the messages have processed from the IPCF message queue

CHKQUE:	$CALL	C%RECV			;CHECK IF THERE IS A MESSAGE
	$RETIF				;RETURN IF THERE ARE NO MESSAGES
	$SAVE	<P1,P2>			;SAVE THESE AC
	MOVE	P1,S1			;SAVE ADDRESS OF THE MDB
	$CALL	I%NOW			;PICK UP TIME OF IPCG MSG RECEPTION
	MOVEM	S1,MSGTIM		;SAVE IT
	JRST	CHKQU3			;JOIN COMMON CODE
CHKQU2:	$CALL	C%RECV			;CHECK IF THERE IS A MESSAGE
	$RETIF				;RETURN,,NOTHING THERE.
	MOVE	P1,S1			;SAVE THE ADDRESS OF THE MDB


;MAKE SURE THE MESSAGE IS FROM QUASAR

CHKQU3:	LOAD	S2,MDB.SI(P1)		;GET SPECIAL INDEX WORD
	TXNN	S2,SI.FLG		;IS THERE AN INDEX THERE?
	JRST	CHKQU6			;NO, IGNORE THIS MESSAGE
	ANDX	S2,SI.IDX		;AND OUT THE INDEX BIT
	CAIE	S2,SP.QSR		;IS THE MESSAGE FROM QUASAR?
	JRST	CHKQU6			;NO, DISCARD IT
	LOAD	M,MDB.MS(P1),MD.ADR	;GET THE MESSAGE ADDRESS
	LOAD	S2,.MSTYP(M),MS.TYP	;GET THE MESSAGE TYPE
	MOVSI	S1,-LMSGT		;MAKE AOBJN POINTER FOR MSG TYPES

;CHECK IF THE MESSAGE TYPE IS KNOWN TO LISSPL

CHKQU4:	HRRZ	P2,MSGTAB(S1)		;GET A MESSAGE TYPE
	CAMN	S2,P2			;DO THE MESSAGE TYPES MATCH?
	JRST	CHKQU5			;YES, GO PROCESS THE MESSAGE
	AOBJN	S1,CHKQU4		;NO, CHECK THE NEXT MESSAGE TYPE
	JRST	CHKQU6			;UNKNOWN MESSAGE TYPE, DISCARD IT

;A KNOWN MESSAGE HAS BEEN RECEIVED

CHKQU5:	MOVE	S2,MDB.SP(P1)		;PICK UP THE SENDER'S PID
	MOVEM	S2,G$SND		;SAVE IT IN CASE OF AN ERROR
	HLRZ	P2,MSGTAB(S1)		;PICK UP THE PROCESSING ROUTINE ADR
	$CALL	@P2	 		;DISPATCH TO THE MESSAGE PROCESSOR.

;A MESSAGE NOT FROM QUASAR HAS BEEN RECEIVED, OR AN UNKNOWN MESSAGE HAS
;BEEN RECEIVED, OR A KNOWN MESSAGE HAS JUST BEEN PROCESSED.

CHKQU6:	$CALL	C%REL			;RELEASE THE MESSAGE
	JRST	CHKQU2			;CHECK FOR ANY MORE MESSAGES

MSGTAB:	XWD	RELEAS,.QOREL		;RELEASE MESSAGE
	LMSGT==.-MSGTAB
	SUBTTL	RELEAS - RELEASE MESSAGE PROCESSING

;RELEAS processes the RELEASE message sent by QUASAR. RELEAS validates that
;the message has the correct syntax. It then determines if a sender exists
;for the node the message is to be forwarded to. If a sender does exist,
;then the message is either queued in the sender's message queue or placed
;in the sender's message buffer.
;If a sender does not exist, then a sender is started and the message is placed
;in the sender's message queue.
;
;Call is: M/Address of the IPCF message
;Returns: The message has been sent or queued
;Crashes: The message has an invalid syntax or the sender could not be started

RELEAS:	$SAVE	<P1>			;SAVE THIS AC

;VALIDATE THE SYNTAX OF THE MESSAGE

	$CALL	CHKLEN			;CHECK FOR A VALID LENGTH
	JUMPF	S..IFM			;ILLEGALLY FORMATTED MESSAGE

;DETERMINE WHICH NODE TO SEND THE MESSAGE TO AND CHECK IF A SENDER FOR THAT
;NODE ALREADY EXISTS

	MOVE	S1,REL.NN(M)		;PICK UP THE NODE NAME
	MOVE	P1,S1			;SAVE NODE NAME FOR LATER
	$CALL	SRHSEN			;CHECK FOR IT IN THE SENDER TABLE
	JUMPF	RELEA1			;NO SUCH NODE, START A SENDER FOR IT
	$CALL	QUEMSG			;SEND OR QUEUE THE MESSAGE
	$RET				;RETURN TO THE IPCF MESSAGE DISPATCHER

;THERE IS NO SENDER FOR THE NODE THE MESSAGE IS TO BE SENT TO. START A SENDER
;FOR THIS NODE AND PLACE THE MESSAGE IN ITS MESSAGE QUEUE.

RELEA1:	AOS	S1,NUMSEN		;INCREMENT THE NUMBER OF SENDERS
	CAILE	S1,MAXNOD		;MORE THAN THE SUPPORTED NUMBER?
	JRST	S..CTL			;YES, CRASH IN THIS CASE
	MOVEM	P1,.STNOD(S2)		;PLACE NODE NAME IN SENDER TABLE ENTRY
	MOVE	S1,S2			;PICK UP THE SENDER TABLE ENTRY ADDRESS
	MOVE	P1,S2			;SAVE SENDER TABLE ENTRY ADR FOR LATER
	SETZ	S2,			;NO MESSAGE QUEUE AT THIS POINT
	$CALL	STSEN			;START UP THE SENDER
	MOVE	S2,P1			;PICK UP THE SENDER TABLE ENTRY
	$CALL	QUEMSG			;SEND OR QUEUE THE MESSAGE
RELEA2:	$RET				;RETURN TO THE IPCF MESSAGE DISPATCHER
					
	SUBTTL	SRHSEN - SEARCH FOR A NODE'S SENDER TABLE ENTRY

;SRHSEN is called to find a node's sender table entry. If the node
;does not have an entry in the sender table, then the address of a 
;free entry in the sender table is returned.
;
;Call is:       S1/SIXBIT node name
;Returns true:  S2/The node's sender table entry address
;Returns false: S2/A free sender table entry address

SRHSEN:

;CHECK IF ANY ENTRIES ARE IN USE. IF NOT, THEN RETURN THE FIRST ONE AS
;FREE
	MOVEI	S2,SENTAB		;PICK UP SENDER TABLE ADDRESS
	SKIPG	NUMSEN			;ANY ENTRIES IN USE?
	$RETF				;NO, RETURN THE FIRST ENTRY AS FREE

	$SAVE	<P1,P2>			;SAVE THESE AC
	MOVEI	P1,MAXNOD		;PICK UP NUMBER OF ENTRIES IN TABLE
SRHSE1:	SKIPN	.STNOD(S2)		;IS THIS ENTRY IN USE?
	MOVE	P2,S2			;NO, REMEMBER AS A FREE ENTRY
	CAMN	S1,.STNOD(S2)		;IS THIS THE TABLE ENTRY?
	$RETT				;YES, INDICATE SUCCESS
	ADDI	S2,.STSIZ		;NO, POINT TO THE NEXT ENTRY
	SOJG	P1,SRHSE1		;CHECK THE NEXT ENTRY, IF ANY LEFT
	MOVE	S2,P2			;RETURN AN ADDRESS OF A FREE ENTRY
	$RETF				;INDICATE ENTRY NOT FOUND
	SUBTTL	CHKLEN - CHECK THE VALIDITY OF AN IPCF MESSAGE

;CHKLEN is called as part of validating the syntax of an IPCF message.
;This routine checks if the size of an IPCF message, as indicated in the
;message length field of the IPCF message, is positive and less than or
;equal to a page.
;
;Call is:       M/Address of the IPCF message
;Returns true:  The indicated message length is valid
;               S1/The indicated length of the message
;Returns false: The indicated message length is invalid
;               S1/The indicated length of the message

CHKLEN:	LOAD	S1,.MSTYP(M),MS.CNT		;PICK UP THE LENGTH OF MSG
	SKIPG	S1				;POSITIVE LENGTH SPECIFIED?
	$RETF					;INVALID MSG LENGTH SPECIFIED
	CAILE	S1,PAGSIZ			;NOT OVER A PAGE?
	$RETF					;INVALID MSG LENGTH SPECIFIED
	$RETT					;VALID MESSAGE SIZE SPECIFIED
	SUBTTL	QUEMSG - SEND OR QUEUE A MESSAGE

;QUEMSG is called to place a processed IPCF message on the message queue
;of the sender of the node that the message is to be sent to. If the sender
;is available to send a message, then the first message on the sender's
;message queue is placed in the sender's message buffer and the sender is
;interrupted to inform it that a message is available to send.
;However, if the sender that is to send the message has an empty message
;queue and if it is available to send a message, then the message is not
;placed on that sender's message queue but rather is placed in its message
;buffer. The sender is then interrupted to inform it that there is a 
;message available for it to send.
;
;Call is: S2/SENTAB entry address of the sender
;         M/ Address of the processed IPCF message
;
;Returns: The message has been queued or sent

QUEMSG:

;CHECK IF THE SENDER IS AVAILABLE TO SEND A MESSAGE. IF IT IS NOT, THEN
;PLACE THE MESSAGE ON THE SENDER'S MESSAGE QUEUE. IF THE SENDER IS
;AVAILABLE TO SEND A MESSAGE, THEN CHECK IF ITS MESSAGE QUEUE IS EMPTY.
;IF ITS MESSAGE QUEUE IS EMPTY, THEN PLACE THE MESSAGE IN THE SENDER'S
;MESSAGE BUFFER AND INTERRUPT THE SENDER.

	MOVE	SEN,.STADR(S2)		;PICK UP THE SENDER BLOCK ADDRESS
	SKIPE	.SNHWD(SEN)		;IS THE MESSAGE QUEUE EMPTY?
	JRST	QUEMS1			;NO, PLACE MSG ON THE MESSAGE QUEUE
	SKIPL	.SNFRE(SEN)		;YES, IS SENDER AVAILABLE TO SEND?
	JRST	QUEMS1			;NO, PLACE MSG ON THE MESSAGE QUEUE

;SENDER IS AVAILABLE AND ITS MESSAGE QUEUE IS EMPTY.

	MOVE	S1,M			;PICK UP THE MESSAGE ADDRESS
	MOVE	S2,.SNMSG(SEN)		;PICK UP SENDER'S MESSAGE BUFFER ADR
	$CALL	XFRMSG			;TRANSFER MESSAGE TO MESSAGE BUFFER
	$CALL	SENMS5			;INFORM THE SENDER OF THE MESSAGE
	JRST	QUEMS2			;GO RETURN

;THE MESSAGE QUEUE IS NOT EMPTY OR THE SENDER IS NOT AVAILABLE TO SEND
;A MESSAGE. BUILD A MESSAGE QUEUE ENTRY AND ADD IT TO THE MESSAGE QUEUE.

QUEMS1:	$CALL	BLDMQE			;BUILD THE MESSAGE QUEUE ENTRY
	$CALL	ADDMQE			;LINK IN THE MESSAGE QUEUE ENTRY

;CHECK IF THE SENDER IS AVAILABLE TO SEND A MESSAGE. IF IT IS, THEN TRANSFER
;THE FIRST MESSAGE OF THE MESSAGE QUEUE TO THE SENDER'S MESSAGE BUFFER
;AND INFORM THE SENDER THAT IT HAS A MESSAGE AVAILABLE TO SEND

	SKIPGE	.SNFRE(SEN)		;IS THE SENDER AVAILABLE TO SEND
	$CALL	SENMSG			;YES, MOVE A MSG AND TELL THE SENDER
QUEMS2:	$RET				;RETURN TO THE IPCF DISPATCHER
	SUBTTL	SNDMSG - SEND MESSAGES TO AVAILABLE SENDERS

;SNDMSG is called during LISSPL's scheduling pass if a sender has indicated
;that it  is available  to send a  message.  This routine checks for
;senders that are available to send DECnet messages to their listeners.
;If a sender is available, then a check is made to determine if the sender's
;message queue has a message. If there is a message, then the message is
;moved from the message queue to the sender's message buffer and the sender
;is notified that there is a message available for it to send.
;
;Call is: No arguments
;Returns: After all the senders have been notified of any available
;         messages

SNDMSG:	$SAVE	<P1,P2>			;SAVE THESE AC
	SETZM	SREADY			;RESET MESSAGE AVAILABLE FLAG
	SETOM	NBSCHD			;FORCE A SCHEDULING PASS

;SET UP THE SENDER TABLE SEARCH FOR ELIGIBLE SENDERS TO SEND A MESSAGE

	MOVEI	P1,SENTAB		;PICK UP THE SENDER TABLE ADDRESS
	MOVEI	P2,MAXNOD		;PICK UP MAX # OF SENDER TABLE ENTRIES

;CHECK IF A NODE IS AVAILABLE TO RECEIVE MESSAGES, THEN IF A SENDER IS
;AVAILABLE TO SEND A MESSAGE AND THEN IF THERE ARE ANY MESSAGES TO SEND

SNDMS2:	SKIPN	.STNOD(P1)		;DOES THIS ENTRY CORRESPOND TO A SENDER?
	JRST	SNDMS3			;NO, CHECK THE NEXT SENDER

	MOVE	SEN,.STADR(P1)		;PICK UP THE SENDER BLOCK ADDRESS
	SKIPL	.SNFRE(SEN)		;THIS SENDER AVAILABLE TO SEND A MSG?
	JRST	SNDMS3			;NO, CHECK THE NEXT SENDER

	SKIPE	.SNHWD(SEN)		;ANY MESSAGES FOR THIS SENDER?
	$CALL	SENMSG			;YES, NOTIFY THE SENDER

;CHECK FOR ANY MORE SENDERS THAT ARE AVAILABLE TO SEND A MESSAGE

SNDMS3:	ADDI	P1,.STSIZ		;POINT TO THE NEXT NODE TABLE ENTRY
	SOJG	P2,SNDMS2		;GO CHECK THE NEXT NODE
	$RET				;RETURN TO THE CALLER
	SUBTTL	SENMSG - NOTIFY A SENDER OF A MESSAGE AVAILABLE

;SENMSG is called when a sender is available to send a message and there
;is a message in its message queue. The message is transferred from the
;message queue to the sender's message buffer and the sender is interrupted.
;
;Call is:  SEN/Address of the sender block
;Returns:  Message is placed in the sender's message buffer and the sender
;          is interrupted
;Crashes:  If the sender cannot be interrupted

SENMSG:	$SAVE	<P1>			;SAVE THIS AC

;TRANSFER THE MESSAGE FROM THE SENDER'S MESSAGE QUEUE TO THE SENDER'S
;MESSAGE BUFFER

	MOVE	P1,.SNHWD(SEN)		;PICK UP MESSAGE QUEUE HEADER WORD
	MOVE	S1,.MQMAD(P1)		;PICK UP ADDRESS OF THE MESSAGE
	MOVE	S2,.SNMSG(SEN)		;PICK UP ADDRESS OF THE MESSAGE BUFFER
	$CALL	XFRMSG			;MOVE THE MESSAGE TO THE MESSAGE BUFFER

;DELETE THE MESSAGE ENTRY FROM THE MESSAGE QUEUE

	MOVE	S1,.MQBLK(P1)		;PICK UP THE ADDRESS OF THE NEXT MQE
	JUMPG	S1,SENMS2		;IS THIS THE LAST MESSAGE IN THE QUEUE?
	SETZM	.SNHWD(SEN)		;YES, ZERO THE LINK LIST HEADER WORD
	SETZM	.SNTWD(SEN)		;AND ZERO THE LINK LIST TRAILER WORD
	SKIPA				;RETURN THE MESSAGE QE MEMORY
SENMS2:	MOVEM	S1,.SNHWD(SEN)		;PLACE NEW FIRST ENTRY IN L.L. HDR WORD

;RETURN THE MESSAGE QUEUE ENTRY MEMORY TO THE MEMORY MANAGER

SENMS3:	MOVE	S1,P1			;PICK UP MESSAGE QUEUE ENTRY ADDRESS
	$CALL	RELMQE			;AND RETURN THE MEQ TO THE MEMORY MGER

;INTERRUPT THE SENDER TO INDICATE THAT A MESSAGE IS AVAILABLE IN ITS MESSAGE
;BUFFER.
;
;SENMS5 IS AN ENTRY POINT WHEN PROCESSING AN IPCF MESSAGE THAT CAN BE SENT
;DIRECTLY TO THE SENDER WITHOUT THE NEED TO PLACE THE MESSAGE ON THE SENDER'S
;MESSAGE QUEUE. (I.E., AN IPCF MESSAGE HAS BEEN RECEIVED, THE SENDER'S
;MESSAGE QUEUE IS EMPTY, AND THE SENDER IS AVAILABLE TO SEND A MESSAGE.)

SENMS5:	SETZM	.SNFRE(SEN)		;INDICATE THAT THIS SENDER IS NOW BUSY
	MOVE	S1,.SNHND(SEN)		;PICK UP THE SENDER'S HANDLE
	MOVX	S2,<1B0>		;PICK UP CHANNEL TO INTERRUPT SENDER ON
	IIC%				;INTERRUPT SENDER THAT MSG IS AVAILABLE
	 ERJMP	S..UII			;CRASH ON AN ERROR
	$RET				;RETURN TO THE CALLER
	SUBTTL	GETMSG - PICK UP A MESSAGE FROM A LISTENER

;GETMSG is called by the scheduler as a result of a listener interrupting
;the top fork to indicate that it has a message from a remote node available
;to be picked up and acted upon by the top fork.
;
;Call is: No arguments
;Returns: The message has been picked up from listener and processed

GETMSG:	$SAVE	<P1,P2>			;SAVE THESE AC
	SETOM	NBSCHD			;FORCE ANOTHER SCHEDULING PASS
	SETZM	LREADY			;ZERO OUT THE MESSAGE AVAILABLE FLAG

;SET UP THE LISTENER TABLE TO SEARCH FOR LISTENERS WHICH HAVE A MESSAGE

	MOVEI	P1,LISTAB		;PICK UP THE LISTENER TABLE ADDRESS
	MOVEI	P2,NUMLIS		;PICK UP # OF LISTENER TABLE ENTRIES

;CHECK IF THE LISTENER HAS A MESSAGE TO BE PICKED UP.

GETMS2:	MOVE	LIS,.LTADR(P1)		;PICK UP THE LISTENER BLOCK ADDRESS
	SKIPE	.LSAVA(LIS)		;DOES THIS LISTENER HAVE A MESSAGE?
	JRST	GETMS3			;NO, CHECK THE NEXT LISTENER

;THE LISTENER HAS A MESSAGE TO BE PICKED UP. PICK UP THE MESSAGE AND PROCESS IT

	$CALL	PROMSG			;PICK UP AND PROCESS THE MESSAGE

;INTERRUPT THE LISTENER TO INDICATE THAT ITS MESSAGE HAS BEEN PICKED UP,
;PROCESSED AND THAT THE TOP FORK IS AVAILABE TO PROCESS ANOTHER MESSAGE.

	MOVE	S1,.LSHND(LIS)		;GET THE LISTENER'S FORK
	MOVX	S2,<1B2>		;WANT CHANNEL 2
	SETOM	.LSAVA(LIS)		;MESSAGE HAS BEEN PICKED UP
	IIC%				;INDICATE TO LISTENER TOP FORK AVAILABLE
	 ERJMP	S..UII			;CRASH IF CAN'T INTERRUPT LISTENER

;CHECK FOR ANY MORE LISTENERS THAT MAY HAVE A MESSAGE AVAILABLE

GETMS3:	ADDI	P1,.LTSIZ		;POINT TO THE NEXT LISTENER TABLE ENTRY
	SOJG	P2,GETMS2		;GO CHECK THE NEXT LISTENER
	$RET				;FINISHED WITH THE LISTENERS
	SUBTTL	PROMSG - PROCESS DECNET LISTENER MESSAGES DISPATCHER

;PROMSG is called from GETMSG to process a message that a listener has
;available. PROMSG dispatches to the appropriate message handler to
;process the message.
;
;Call is: LIS/Listener block address
;Returns: The message has been processed.

PROMSG:	$SAVE	<P1>			;SAVE THIS AC

;DETERMINE WHICH NODE SENT THE MESSAGE AND SAVE THE NAME. SET UP TO 
;SEARCH THE MESSAGE DISPATCH TABLE.

	MOVE	S1,.LSNME(LIS)		;PICK UP THE NODE NAME
	MOVEM	S1,G$SND		;SAVE SO KNOW WHERE MESSAGE IS FROM

	MOVE	M,.LSMSG(LIS)		;PICK UP THE MESSAGE ADDRESS
	LOAD	S2,.MSTYP(M),MS.TYP	;GET THE MESSAGE TYPE
	MOVSI	S1,-NLMGT		;MAKE AOBJN POINTER FOR MSG TYPES

;PICK UP THE MESSAGE PROCESSING DISPATCH ADDRESS

PROMS2:	HRRZ	P1,LMGTAB(S1)		;GET A MESSAGE TYPE
	CAMN	S2,P1			;DO THE MESSAGE TYPES MATCH?
	JRST	PROMS3			;YES, GO PROCESS THE MESSAGE
	AOBJN	S1,PROMS2		;NO, CHECK THE NEXT MESSAGE TYPE
	JRST	PROMS4			;UNKNOWN MESSAGE TYPE, TELL ORION

;A KNOWN MESSAGE HAS BEEN RECEIVED, PROCESS IT

PROMS3:	HLRZ	P1,LMGTAB(S1)		;PICK UP THE PROCESSING ROUTINE ADR
	$CALL	@P1	 		;DISPATCH THE MESSAGE PROCESSOR.
	$RET

;AN UNKNOWN MESSAGE TYPE HAS BEEN RECEIVED. INFORM ORION

PROMS4:	$LOG(<LISSPL received unknown message>,<Listener to node ^N/G$SND/ has received an unknown message type>)

	$RET				;RETURN TO THE CALLER

LMGTAB:	XWD	NEXTJB,.QONEX		;NEXTJOB MESSAGE

	NLMGT==.-LMGTAB
	SUBTTL	NEXTJB - SEND A NEXTJOB MESSAGE FROM A REMOTE NODE TO QUASAR

;NEXTJB sends NEXTJOB messages from a remote node to QUASAR. NEXTJB
;transfers the message from the listener's message buffer to an IPCF
;page and sends the message to QUASAR.
;
;Call is: M/Address of the NEXTJOB message to be sent to QUASAR
;Returns: The NEXTJOB message was sent successfully
;Crashes: The NEXTJOB message could not be sent to QUASAR

NEXTJB:

;SEND THE MESSAGE TO QUASAR

	MOVE	S1,PIB+PB.PID		;PICK UP LISSPL'S PID
	MOVEM	S1,.EQPID(M)		;PLACE IN THE MESSAGE
	MOVE	S1,M			;ADDRESS OF THE IPCF MESSAGE
	MOVEI	S2,PAGSIZ		;LENGTH OF THE IPCF MESSAGE
	$CALL	SNDQSR			;SEND THE MESSAGE TO ORION
	$RETIT				;THE MESSAGE WAS SENT
	$STOP(QSF, Send to QUASAR failed)
	SUBTTL	RESLIS - RESTART A LISTENER THAT HAS CRASHED

;RESLIS is called to restart a listener that has crashed.
;
;Call is: S1/LISTENER table entry address of the listener
;Returns: The listener has been restarted
;Crashes: The listener could not be restarted

RESLIS:	$SAVE	<P1>			;SAVE THIS AC

;KILL THE LISTENER

	MOVE	P1,S1			;SAVE THE LISTENER TABLE ENTRY ADR
	MOVE	LIS,.LTADR(P1)		;PICK UP ADDRESS OF THE LISTENER BLOCK
	MOVE	S1,.LSHND(LIS)		;PICK UP THE LISTENER'S HANDLE
	KFORK%				;KILL THE LISTENER
	 ERJMP	.+1			;HANDLE NO LONGER VALID, IGNORE

;RETURN THE LISTENER BLOCK PAGES

	ADR2PG	LIS			;CHANGE PAGE ADDRESS TO PAGE NUMBER
	MOVE	S2,LIS			;PLACE PAGE NUMBER WHERE EXPECTED
	MOVEI	S1,DBSIZ		;NUMBER OF PAGES TO RELEASE
	$CALL	M%RLNP			;RELEASE THE PAGES

;RESET THE LISTENER TABLE ENTRY AND START THE LISTENER

	MOVEI	S1,.LTSIZ		;PICK UP THE ENTRY SIZE
	MOVE	S2,P1			;PICK UP THE LISTENER TABLE ENTRY
	$CALL	.ZCHNK			;INITIALIZE THE ENTRY
	MOVE	S1,P1			;PICK UP THE LISTENER TABLE ENTRY
	$CALL	STLIS			;START THE LISTENER
	$RET				;RETURN TO THE CALLER
	SUBTTL	DELSEN - KILL AND DELETE A SENDER THAT HAS CRASHED

;DELSEN is called to kill and delete a sender that has crashed the
;maximum amount of times. The sender is not restarted.
;
;Call is: S1/SENDER table entry address of the sender
;Returns: The sender has been killed and deleted
;Crashes: The sender could not be killed and deleted

DELSEN:	$SAVE	<P1>			;SAVE THIS AC
	$CALL	KILSEN			;KILL THE SENDER
	SOS	NUMSEN			;DECREMENT THE NUMBER OF SENDERS
	MOVE	P1,S2			;PICK UP THE MQ LINK LIST HEADER WORD
DELSE1:	SKIPN	S1,P1			;PICK UP THE NEXT MESSAGE QE ADDRESS
	$RET				;RETURN, IF THERE ARE NO MORE
	MOVE	P1,.MQBLK(S1)		;PICK UP THE NEXT MESSAGE QE ADDRESS
	$CALL	RELMQE			;RETURN THE MEMORY OF THE MEQ
	JRST	DELSE1			;GO RETURN THE NEXT MESSAGE QE
	SUBTTL	KILSEN - KILL A SENDER THAT HAS CRASHED

;KILSEN is called to kill a sender that has crashed.
;
;Call is: S1/SENDER table entry address of the sender
;Returns: The sender has been killed
;         S2/MQ link list header word
;Crashes: The sender could not be restarted

KILSEN:	$SAVE	<P1,P2>			;SAVE THESE AC

;SAVE THE MESSAGE QUEUE HEADER WORD

	MOVE	P1,S1			;SAVE THE SENDER TABLE ENTRY ADDRESS
	MOVE	SEN,.STADR(P1)		;PICK UP THE SENDER BLOCK ADDRESS
	MOVE	P2,.SNHWD(SEN)		;SAVE THE MESSAGE QUEUE HEADER WORD

;KILL THE SENDER

	MOVE	S1,.LSHND(SEN)		;PICK UP THE SENDER'S HANDLE
	KFORK%				;KILL THE SENDER
	 ERJMP	.+1			;HANDLE NO LONGER VALID, IGNORE

;RETURN THE SENDER BLOCK PAGES

	ADR2PG	SEN			;CHANGE PAGE ADDRESS TO PAGE NUMBER
	MOVE	S2,SEN			;PLACE PAGE NUMBER WHERE EXPECTED
	MOVEI	S1,DBSIZ		;NUMBER OF PAGES TO RELEASE
	$CALL	M%RLNP			;RELEASE THE PAGES

;INITIALIZE THE SENDER TABLE ENTRY

	MOVEI	S1,.STSIZ		;PICK UP THE ENTRY SIZE
	MOVE	S2,P1			;PICK UP THE SENDER TABLE ENTRY
	$CALL	.ZCHNK			;INITIALIZE THE ENTRY

	MOVE	S2,P2			;RETURN WITH MQ LINK LIST HEADER WORD
	$RET				;RETURN TO THE CALLER
	SUBTTL	INFSTS - DETERMINE THE STATUS OF AN INFERIOR FORK

;INFSTS determines the status of an inferior fork
;
;Call is:       S1/Fork handle
;Returns true:  The fork is not halted or dismissed
;Returns false: The fork is halted or dismissed

INFSTS:	$SAVE	<T1,T2>			;RFSTS% JSYS CHANGES THESE AC
	RFSTS%				;GET THE STATUS OF THIS LISTENER
	 ERJMP	INFST2			;INVALID HANDLE, ASSUME FORK IS GONE
	TXZ	S1,RF%FRZ		;CLEAR THE FROZEN FORK BIT
	HLRZS	S1			;PLACE STATUS CODE IN RIGHT HALF
	CAIE	S1,.RFHLT		;IS THIS FORK HALTED?
	CAIN	S1,.RFFPT		;NO, IS THIS FORK DISMISSED?
INFST2:	$RETF				;YES, FORK IS HALTED OR DISMISSED
	$RETT				;FORK IS NOT HALTED OR DISMISSED
	SUBTTL	STSEN - START UP A SENDER

;STSEN  is called to start up a sender. This routine is called when a
;message is received from QUASAR to be forwarded to a node in the cluster
;for which no sender has been started for. This routine is also called when
;a sender has crashed and is being restarted.
;
;Note: The sender block pages are obtained via the GLXMEM routine M%AQNP.
;M%AQNP zeros out the pages it returns. This implies the following:
;
;	SETZM	.SNLNK(SEN)		;ZERO OUT THE DECNET STATUS LINK
;	SETZM	.SNFRE(SEN)		;SENDER NOT READY TO PICK UP A MESSAGE
;
;Call is: S1/Address of the sender table entry for this sender
;Returns: The sender has been sucessfully started
;Crashes: The sender cannot be started (i.e., a CFORK%, SFORK% or
;         PMAP% error has occurred)

;FIRST OBTAIN AND INITIALIZE THE SENDER DATA BASE

STSEN:	$SAVE	<T1,T2,T3> 		;SAVE THESE AC
	MOVE	T3,S1			;SAVE THE SENDER TABLE ENTRY ADDRESS
	MOVEI	S1,DBSIZ		;SIZE OF THE SENDER BLOCK IN PAGES
	$CALL	M%AQNP			;GET THE SENDER BLOCK PAGES
	PG2ADR	S1			;CHANGE PAGE NUMBER TO ADDRESS
	MOVE	SEN,S1			;PLACE ADR IN SENDER BLOCK DB POINTER
	MOVEM	S1,.STADR(T3)		;SAVE ADR IN THE SENDER TABLE ENTRY
	ADDI	S1,PAGSIZ		;POINT TO THE MESSAGE BUFFER ADDRESS
	MOVEM	S1,.SNMSG(SEN)		;SAVE THE MESSAGE BUFFER ADDRESS
	MOVEM	T3,.SNSTA(SEN)		;SAVE THE SENDER TABLE ENTRY ADDRESS
	MOVE	S1,.STNOD(T3)		;PICK UP THE REMOTE NODE NAME
	MOVEM	S1,.SNNME(SEN)		;PLACE IN THE SENDER BLOCK
	$CALL	BLDDCN			;BUILD THE DECNET DCN: DEVICE NAME

;SET UP THE CONTEXT OF THE SENDER

	MOVEI	S1,.SNPDL-1(SEN)	;SET UP THE SENDER CONTEXT
	HRLI	S1,-PDSIZ		;STACK POINTER
	PUSH	S1,[EXP SENDER]		;START THE SENDER HERE
	MOVEM	S1,.SNREG+P(SEN)	;PLACE IN THE DATA BASE
	MOVEM	SEN,.SNREG+SEN(SEN)	;SAVE THE ADDRESS OF THE DB

;START UP THE SENDER. FIRST CREATE THE SENDER AS AN INFERIOR FORK
;WITH THE SAME CAPABILITIES AS THE TOP FORK.

	MOVX	S1,<CR%CAP+CR%ACS>	;SUPERIOR CAPS AND AC'S
	MOVEI	S2,.SNREG(SEN)		;AC LOAD BUFFER
	CFORK%				;CREATE A SENDER
	 ERJMP	STSEN2			;CRASH ON AN ERROR

;MAP LISSPL'S PAGES INTO THE SENDER

	MOVEM	S1,.SNHND(SEN)		;SAVE THE SENDER'S HANDLE
	MOVSI	S1,.FHSLF		;GET LISSPL'S HANDLE
	HRLZ	S2,.SNHND(SEN)		;GET THE SENDER'S HANDLE
	HRR	T1,LISSIZ		;GET THE LENGTH IN PAGES
	HRLI	T1,(PM%RWX!PM%CNT)	;COUNT+READ+EXECUTE
	PMAP%				;MAP THE PAGES
	 ERJMP	STSEN3			;CRASH ON AN ERROR

;MAP THE SENDER BLOCK INTO THE SENDER

	MOVE	S1,SEN			;GET THE SENDER BLOCK ADDRESS
	ADR2PG	S1			;CONVERT IT TO A PAGE NUMBER
	MOVE	S2,S1			;SAVE IT IN S2
	HRLI	S1,.FHSLF		;GET THE TOP FORK'S HANDLE
	HRL	S2,.SNHND(SEN)		;GET THE SENDER'S HANDLE
	HRRI	T1,DBSIZ		;GET THE PAGE COUNT
	HRLI	T1,(PM%RWX!PM%CNT)	;R,W,E + COUNT
	PMAP%				;MAP THE DATA BASE
	 ERJMP	STSEN3			;CRASH ON AN ERROR 

;START THE SENDER

	MOVE	S1,.SNHND(SEN)		;GET THE SENDER'S HANDLE
	MOVEI	S2,SENDER		;GET THE START ADDRESS
	SFORK%				;START THE SENDER
	 ERJMP	STSEN4			;CRASH ON AN ERROR
	$RET				;AND RETURN


STSEN2:	$STOP	(CCS,CAN'T CREATE A SENDER)

STSEN3:	$STOP	(CPS,CAN'T PMAP A SENDER)

STSEN4:	$STOP	(CSS, CAN'T START A SENDER)
	SUBTTL	BLDDCN - BUILD THE DCN: DEVICE NAME

;BLDDCN builds the DECnet DCN: device name that the sender will use
;in opening its DECnet link. The format of the DCN: device name is:
;DCN:RNODE-TASK-RNODE$LPTSPL$LS.RNODE$LISSPL$SN;BDATA:NNNNN;
;USERID:RNODE$LISSPL$SN
;
;where RNODE is the remote node name
;      NNNNN comes from the listener's node name and is used by the listener
;            in accepting a connection
;
;Call is: SEN/Address of the sender block
;Returns: The DCN: device name has been built and placed in the sender
;         block

BLDDCN:	$SAVE	<P1,P2,P3,P4>		;SAVE THESE AC

;BUILD THE OPTIONAL DATA FIELD, USING THE SIXBIT REMOTE NODE NAME AS
;THE STARTING VALUE. CREATE 12 OCTAL CHARACTERS AND CONVERT THEM TO ASCII. 

	MOVE	S2,.SNNME(SEN)		;PICK UP THE REMOTE SIXBIT NODE NAME
	ROT	S2,3			;ROTATE BY HALF A CHARACTER
	MOVE	P1,[POINT 7,S1,35]	;POINTER TO BYTE TO PICK UP
	MOVE	P2,[POINT 7,NODDAT]	;POINTER TO WHERE BYTE IS TO BE PUT
	SETZ	S1,			;CLEAR RECEIVING WORD OF OCTAL VALUE
	MOVEI	P3,^D36/3		;NUMBER OF OCTAL CHARACTERS

BLDDC2:	LSHC	S1,3			;MOVE NEXT OCTAL VALUE OVER
	ADDI	S1,60			;MAKE IT ASCII
	LDB	P4,P1			;PICK UP ASCII VALUE
	IDPB	P4,P2			;PLACE IN ASCII STRING
	SETZ	S1,			;PREPARE FOR NEXT OCTAL VALUE
	SOJN	P3,BLDDC2		;PICK UP NEXT OCTAL VALUE
	IDPB	S1,P2			;MAKE INTO AN ASCIZ STRING

;BUILD THE DECNET DCN: DEVICE NAME

	SKIPE	DEBUGW			;[6003]DEBUGGING?
	JRST	BLDDC6			;[6003]YES, DO DIFFERENTLY

	$TEXT(<-1,,.SNDCN(SEN)>,<DCN:^I/@BLDDC3/^I/@BLDDC4/^I/@BLDDC5/>)

	$RET				;RETURN TO THE CALLER

BLDDC3: [ITEXT(<^N/.SNNME(SEN)/-TASK-^N/.SNNME(SEN)/$LPTSPL$LS.>)] ;LISTENER NAME
BLDDC4:	[ITEXT(<^N/.SNNME(SEN)/$LISSPL$SN;BDATA:^T/NODDAT/;>)] ;THE SENDER NAME
BLDDC5: [ITEXT(<USERID:^N/.SNNME(SEN)/$LISSPL$SN>)]	      ;USERID

BLDDC6:	GJINF%					;[6003]PICK UP THE USER'S NUMBER
	MOVE	S2,S1				;[6003]SAVE NUMBER WHERE EXPECTED
	MOVEI	S1,.SNDBW(SEN)			;[6003]WHERE TO PLACE USER NAME
	HRLI	S1,(POINT 7)			;[6003]MAKE INTO A POINTER
	DIRST%					;[6003]PICK UP THE USER NAME
	 JRST	S..COD				;[6003]CRASH ON AN ERROR
	MOVEI	S1,.SNDBW(SEN)			;[6003]PICK UP USER NAME ADDRESS
	HRLI	S1,(POINT 7,)			;[6003]MAKE INTO A POINTER
	SETZ	T1,				;[6003]NUMBER OF CHAR IN NAME
BLDDC7:	ILDB	S2,S1				;[6003]PICK UP THE NEXT CHARACTER
	SKIPN	S2				;[6003]IS THIS THE LAST ONE?
	JRST	BLDDC8				;[6003]YES, BUILD THE DEVICE NAME
	AOS	T1				;[6003]INCREMENT THE CHAR COUNT
	CAIG	T1,^D6				;[6003]MAXIMUM COUNT?
	JRST	BLDDC7				;[6003]NO, GET THE NEXT CHAR
	SETZ	S2,				;[6003]PICK UP A NULL
	DPB	S2,S1				;[6003]PLACE IN USER NAME

BLDDC8:	MOVEI	S1,.SNDBW(SEN)			;[6003]ADDRESS OF THE USER NAME
	$TEXT(<-1,,.SNDCN(SEN)>,<DCN:^I/@BLDDC9/^I/@BLDD10/^I/@BLDD11/^0>)
	$RET				;RETURN TO THE CALLER

BLDDC9: [ITEXT(<^N/.SNNME(SEN)/-TASK-^N/.SNNME(SEN)/$^T/0(S1)/$LS.>)]  ;[6003]LISTENER NAME
BLDD10:	[ITEXT(<^N/.SNNME(SEN)/$^T/0(S1)/$SN;BDATA:^T/NODDAT/>)]       ;[6003]SENDER NAME
BLDD11:	[ITEXT(<;USERID:^N/.SNNME(SEN)/$^T/0(S1)/$SN>)]		  ;[6003]
	SUBTTL SNDQSR - SEND AN IPCF MESSAGE TO QUASAR

;SNDQSR sends an IPCF message to QUASAR
;
;Call is:       S1/The message address
;	        S2/The message length
;Returns true:  The message was sent successfully
;Returns false: The message was not successfully sent

SNDQSR:	MOVEM	S1,SAB+SAB.MS		;SAVE THE MESSAGE ADDRESS
	MOVEM	S2,SAB+SAB.LN		;SAVE THE MESSAGE LENGTH
	MOVX	S1,SP.QSR		;THEN GET QUASAR'S FLAG
	TXO	S1,SI.FLG		;SET SPECIAL INDEX FLAG
	STORE	S1,SAB+SAB.SI		;AND STORE IT
	SETZM	SAB+SAB.PD		;CLEAR THE PID WORD
	MOVEI	S1,SAB.SZ		;LOAD THE SIZE
	TXO	S1,PT.KEE		;KEEP THE PAGE AFTER THE SEND
	MOVEI	S2,SAB			;AND THE ADDRESS
	$CALL	C%SEND			;SEND THE MESSAGE
	$RET				;PRESERVE THE TRUE/FALSE INDICATOR
	SUBTTL	ADDMQE - ADD A MESSAGE TO A SENDER'S MESSAGE QUEUE

;ADDMQE adds a message queue entry to a sender's message queue
;
;Call is:      SEN/Address of the sender block
;              S1/ Address of message queue entry link list word for
;                 this sender's node
;Returns: Message queue entry added to end of this node's message queue

ADDMQE:	SKIPG	S2,.SNTWD(SEN)		;ANY MESSAGES IN ITS MESSAGE QUEUE?
	JRST	ADDMQ2			;NO, ADD AS THE FIRST MSG QUEUE ENTRY
	MOVEM	S1,.MQBLK(S2)		;PLACE NEW ADR OF LAST QE IN L.L. WORD
	SKIPA				;GO UPDATE THE TRAILER WORD
ADDMQ2:	MOVEM	S1,.SNHWD(SEN)		;UPDATE THE LINK LIST HEADER WORD
	MOVEM	S1,.SNTWD(SEN)		;UPDATE THE LINK LIST TRAILER WORD
	$RET				;AND RETURN TO THE CALLER
	SUBTTL	RELMQE - RETURN A MESSAGE QUEUE ENTRY TO MEMORY MANAGER

;RELMQE returns the memory used by a message queue entry and its
;corresponding message to the memory manager. 
;(Note: If the sum of the memory required by the message queue entry
;and the message is greater than a page, then in general, the message 
;memory location is not contiguous with the message queue entry,
;otherwise they are contiguous.)
;
;Call is: S1/Address of the message queue entry header
;Returns: The message queue entry has been returned to the memory manager

RELMQE:	$SAVE	<P1>			;SAVE THIS AC
	MOVE	P1,S1			;PICK UP ADDRESS OF THE MQE

;DETERMINE IF THE MESSAGE LOCATION IS CONTIGUOUS OR NOT WITH THE END OF THE
;MESSAGE QUEUE ENTRY. IF IT IS NOT CONTIGUOUS, THEN RETURN THE MEMORY OF THE
;MESSAGE SEPARATELY TO THE MEMORY MANAGER.

	SKIPL	S1,.MQMAD(P1)		;DOES THE MESSAGE OCCUPY A PAGE?
	JRST	RELMQ2			;NO, RETURN MQE AND MSG TOGETHER
	HRRZS	S1			;YES, ISOLATE THE MESSAGE ADDRESS
	$CALL	M%RPAG			;RETURN THE PAGE TO THE MEMORY MANAGER

;RETURN THE MESSAGE QUEUE ENTRY (AND MESSAGE, IF NOT A PAGE) TO THE 
;MEMORY MANAGER

RELMQ2:	LOAD	S1,.MQMEM(P1),MQ.LEN	;PICK UP MEMORY BLOCK SIZE
	LOAD	S2,.MQMEM(P1),MQ.ADR	;PICK UP MEMORY BLOCK ADDRESS
	$CALL	M%RMEM			;RETURN THE MEMORY TO MEMORY MANAGER
	$RET				;RETURN TO THE CALLER
	SUBTTL	BLDMQE - BUILD A MESSAGE QUEUE ENTRY

;BLDMQE builds a message queue entry. If the sum of the lengths of the message
;queue header and the message is less than or equal to a page, then the start
;of the message is contiguous with the end of the message queue header.
;Otherwise, the message is placed in a separate page that, in general, will
;not be contiguous with the end of the message queue header.
;
;Note: It is assumed in building the link list word that this message queue
;      entry will be placed on the end of the message queue (i.e., the link
;      list word .MQBLK is zeroed).
;
;Call is:  M/Address of the IPCF message
;Returns:  The message queue entry is built
;          S1/ Address of the message queue entry

BLDMQE:	$SAVE	<P1,P2>			;SAVE THESE AC

;DETERMINE IF THE SUM OF THE MQE AND THE IPCF MESSAGE LENGTHS FITS IN A PAGE

	LOAD	S1,.MSTYP(M),MS.CNT	;PICK UP SIZE OF THE IPCF MESSAGE
	ADDI	S1,.MQISZ		;ADD IN MESSAGE QUEUE ENTRY HEADER SIZE
	CAILE	S1,PAGSIZ		;TOTAL LENGTH FITS IN A PAGE?
	JRST	BLDMQ2			;NO, GET A PAGE FOR THE MESSAGE

;PREPARE THE MESSAGE QUEUE ENTRY HEADER CONTIGUOUS WITH THE MESSAGE

	$CALL	M%GMEM			;PICK UP THE MEMORY BLOCK
	MOVE	P1,S2			;PICK UP THE MQE ADDRESS
	ADDI	P1,.MQISZ		;ADD MEQ LENGTH TO GET MESSAGE ADDRESS
	JRST	BLDMQ3			;JOIN COMMON CODE

;PREPARE THE MQE SEPARATE FROM THE MESSAGE

BLDMQ2:	$CALL	M%GPAG			;GET A PAGE OF MEMORY
	MOVE	P1,S1			;PICK UP MESSAGE ADDRESS
	TXO	P1,MQ%PAG		;INDICATE MESSAGE IS A PAGE
	MOVEI	S1,.MQISZ		;PICK UP SIZE OF THE MQE HEADER
	$CALL	M%GMEM			;PICK UP MEMORY FOR THE MQE

;BUILD THE MESSAGE QUEUE HEADER

BLDMQ3:	MOVEM	P1,.MQMAD(S2)		;PLACE MSG ADDRESS IN MSG QUEUE HEADER
	STORE	S1,.MQMEM(S2),MQ.LEN	;SAVE GLXMEM LENGTH IN MSG QUEUE HEADER
	STORE	S2,.MQMEM(S2),MQ.ADR 	;SAVE GLXMEM ADDRESS IN MSG QUEUE HDR

;MOVE THE MESSAGE FROM THE IPCF BUFFER TO THE MESSAGE QUEUE BUFFER

	MOVE	P2,S2			;REMEMBER MQE ADDRESS FOR RETURN
	MOVE	S1,M			;ADDRESS OF THE IPCF MESSAGE
	HRRZ	S2,P1			;ADDRESS OF THE MSG IN MQE
	$CALL	XFRMSG			;MOVE THE MESSAGE
	MOVE	S1,P2			;RETURN THE MQE ADDRESS
	$RET				;RETURN TO THE CALLER
	SUBTTL	LISTEN - MESSAGE SERVER FOR A REMOTE NODE

;LISTEN exists as an inferior fork in LISSPL. NUMLIS listeners are started 
;by LISSPL as part of its startup. A listener picks up NEXTJOB messages
;from a remote Cluster LPTSPL.
;A listener communicates with the top fork through software interrupts,
;the listener block and the listener table.

;INITIALIZATION BLOCK AND PID BLOCK

LIB:	$BUILD	IB.SZ
	  $SET	(IB.PRG,,%%.MOD)	;PROGRAM 'LISSPL'
	  $SET  (IB.FLG,IP.STP,1)	;STOPCODES TO ORION
	  $SET	(IB.PIB,,0)		;SET UP PIB ADDRESS
	$EOB				;

LPIB:	$BUILD	PB.MNS			;
	  $SET	(PB.HDR,PB.LEN,PB.MNS)	;PIB LENGTH,,0
	  $SET	(PB.FLG,IP.RSE,1)	;RETURN ON SEND ERROR
	  $SET	(PB.SYS,IP.BQT,-1)	;MAXIMUM SEND/RECEIVE IPCF QUOTA
	  $SET	(PB.SYS,IP.MNP,^D1)	;NUMBER OF PIDS
	$EOB				;

LISCHN:	XWD	1,ACCEPT		;A DECNET CONNECTION REQUEST OCCURRED
	XWD	1,MSGFSN		;MESSAGE FROM A SENDER IS AVAILABLE
	XWD	1,MSGTTF		;TOP FORK READY TO PROCESS A MESSAGE
	XWD	1,INTMSG		;INTERRUPT MESSAGE FROM THE SENDER
	XWD	1,CHKLST		;CHECK THE LINK STATUS
	BLOCK	^D31			;THESE CHANNELS ARE NOT USED

;SET UP GLXLIB, ENABLE CAPABILITIES, AND SET UP INTERRUPT SYSTEM

LISTEN:	SKIPE	DEBUGW			;DEBUGGING?
	$CALL	LISDDT			;YES, SET UP FOR DEBUGGING

	$CALL	LISSET			;SET UP GLXLIB, CAPS AND MESSAGE PAGES
	$CALL	LOPLNK			;OPEN A SRV: DEVICE
	$CALL	LISINT			;SET UP THE INTERRUPT SYSTEM

;WAIT FOR A CONNECTION REQUEST, FOR INCOMING DECNET MESSAGES AND FOR
;REQUESTS FROM THE TOP FORK FOR A MESSAGE.

LISTE2:	SETZ	S1,			;INDEFINITE TIME TO WAIT
	$CALL	I%SLP			;WAIT% UNTIL NEEDED
	JRST	LISTE2			;WAIT% FOR THE NEXT EVENT
LISTE3:	MOVE	P,.LSACS+P(LIS)		;PICK UP THE NEW STACK POINTER
	$CALL	LOPLNK			;[6001]RE-OPEN THE LINK
	$CALL	LISINT			;[6001]RE-INITIALIZE INTERRUPT SYSTEM
	JRST	LISTE2			;WAIT% FOR THE NEXT EVENT
	SUBTTL	LISSET - INITIALIZE THE LISTENER'S GLXLIB AND CAPABILITIES

;LISSET is called by the listener at listener startup. This routine sets up
;GLXLIB, the listener's capabilities, disables the listener from receiving
;any IPCF messages and allocates pages for receiving the NEXTJOB and TRANSFER
;FILE RESPONSE messages from Cluster LPTSPL as well as a page for the modified
;NEXTJOB message.
;
;Call is: LIS/Address of the listener block
;Returns: GLXLIB setup and capabilities enabled
;Crashes: Unable to set up capabilities

LISSET:	$SAVE	<T1,T2>			;SAVE THESE AC, DESTROYED BY JSYS

;SET UP THE GLXLIB INITIALIZATION BLOCK IN THE LISTENER BLOCK

	MOVSI	S1,LIB			;PICK UP ADDRESS OF THE IB BLOCK
	HRRI	S1,.LSIBK(LIS)		;ADDRESS OF WHERE TO PLACE THE IB BLOCK
	MOVEI	S2,.LSIBK+IB.SZ(LIS)	;END ADDRESS + 1
	BLT	S1,-1(S2)		;MOVE THE IB BLOCK TO LISTENER BLOCK
	MOVEI	S1,.LSPIB(LIS)		;PICK UP THE PIB BLOCK ADDRESS
	MOVEM	S1,.LSIBK+IB.PIB(LIS)	;PLACE IN THE IB BLOCK

	MOVSI	S1,.LSLEV(LIS)		;ADDRESS OF THE INTERRUPT LEVEL TABLE
	HRRI	S1,LISCHN		;ADDRESS OF THE CHANNEL TABLE
	MOVEM	S1,.LSIBK+IB.INT(LIS)	;PLACE IN THE INITIALIZATION BLOCK

;SET UP THE PID BLOCK AND THE INTERRUPT LEVEL TABLE IN THE LISTENER BLOCK

	MOVSI	S1,LPIB			;PICK UP ADDRESS OF THE PID BLOCK
	HRRI	S1,.LSPIB(LIS)		;DESTINATION IS IN THE LISTENER BLOCK
	MOVEI	S2,.LSPIB+PB.MNS(LIS)	;END ADDRESS + 1
	BLT	S1,-1(S2)		;MOVE PID TABLE TO LISTENER BLOCK

	MOVEI	S1,.LSLEV(LIS)		;PICK UP ADR OF INTERRUPT LEVEL TABLE
	MOVEI	S2,.LS1PC(LIS)		;PICK UP ADR OF FIRST PC WORD
	MOVEM	S2,0(S1)		;PLACE PC ADR IN INTERRUPT LEVEL TABLE
	AOS	S1			;POINT TO NEXT INTERRUPT TABLE ENTRY
	AOS	S2			;POINT TO NEXT PC WORD
	MOVEM	S2,0(S1)		;PLACE PC ADR IN INTERRUPT LEVEL TABLE
	AOS	S1			;POINT TO NEXT INTERRUPT TABLE ENTRY
	AOS	S2			;POINT TO NEXT PC WORD
	MOVEM	S2,0(S1)		;PLACE PC ADR IN INTERRUPT LEVEL TABLE

;SET UP GLXLIB

	MOVEI	S1,IB.SZ		;PICK UP SIZE OF THE INITIALIZATION BLK
	MOVEI	S2,.LSIBK(LIS)		;PICK UP ADR OF THE INITIALIZATION BLK
	$CALL	I%INIT			;INITIALIZE GLXLIB

;ENABLE THE LISTENER'S CAPABILITIES TO BE THOSE OF THE TOP FORK AND GIVE IT
;THE CAPABILITY TO INTERRUPT THE TOP FORK.

	MOVX	S1,.FHSLF		;PICK UP THE LISTENER'S HANDLE
	RPCAP%	
	 ERJMP	[$CALL INLCRH		  ;INDICATE A CONTROLLED CRASH
		 $STOP(LCC,Listener can't obtain capabilities) ]
	TXO	S2,SC%SUP		;CAPABILITY TO INTERRUPT TOP FORK
	MOVE	T1,S2			;ENABLE ALL CAPABILITIES
	MOVEI	S1,.FHSLF		;PICK UP THE LISTENER'S HANDLE
	EPCAP%				;ENABLE THE CAPABILITIES
	 ERJMP	[$CALL INLCRH		  ;INDICATE A CONTROLLED CRASH
		 $STOP(LCE,Listener can't enable capabilities) ]

;DISABLE RECEIVING IPCF MESSAGES

	MOVEI	S1,.MUDIS		;DISABLE RECEIVING IPCF MESSAGES
	MOVEM	S1,.LSMUT(LIS)		;PLACE IN THE ARGUMENT BLOCK
	MOVE	S1,.LSPIB+PB.PID(LIS)	;PICK UP LISTENER'S PID
	MOVEM	S1,.LSMUT+1(LIS)	;PLACE IN THE ARGUMENT BLOCK
	MOVEI	S1,2			;PICK UP SIZE OF ARGUMENT BLOCK
	MOVEI	S2,.LSMUT(LIS)		;PICK ADDRESS OF THE ARGUMENT BLOCK
	MUTIL%				;DISABLE RECEIVING IPCF MESSAGES
	 ERJMP	.+1			;SHOULDN'T HAPPEN, BUT DON'T CARE


;PICK UP PAGES FOR THE NEXTJOB, MODIFIED NEXTJOB AND TRANSFER FILE RESPONSE
;MESSAGES.

	MOVEI	S1,3			;NUMBER OF PAGES NEEDED
	$CALL	M%AQNP			;PICK UP THE PAGES
	PG2ADR	S1			;CONVERT PAGE NUMBER TO PAGE ADDRESS
	MOVEM	S1,.LSNXJ(LIS)		;THE NEXTJOB MESSAGE ADDRESS
	ADDI	S1,PAGSIZ		;ADDRESS OF THE NEXT PAGE
	MOVEM	S1,.LSMOD(LIS)		;THE MODIFIED NEXTJOB MESSAGE ADDRESS
	ADDI	S1,PAGSIZ		;ADDRESS OF THE NEXT PAGE
	MOVEM	S1,.LSXRM(LIS)		;THE TRANSFER FILE RESPONSE MESSAGE
;**;[6007]At LISSET:+62L add 3 lines JYCW 6/14/88
	MOVEI	S1,.MSIIC		;[6007]Get MSTR function
	MSTR				;[6007]t ignore increment count
	 ERJMP	.+1			;[6007]Should not fail

	$RET				;RETURN TO STARTUP
	SUBTTL	LOPLNK - OPEN A DECNET SRV: DEVICE

;LOPLNK is called during the listener's initialization to open a SRV:
;device.
;
;Call is: LIS/Address of the listener block
;Returns: The SRV: device has been open
;Crashes: Unable to obtain a JFN or open the SRV: device

LOPLNK:	$SAVE	<T1,T2>			;SAVE THESE AC

;PICK UP THE SRV: JFN AND OPEN THE SRV: DEVICE

	MOVX S1,GJ%SHT			;SHORT JFN
	HRROI	S2,.LSSRV(LIS)		;POINT TO THE DEVICE NAME
	GTJFN%
	 ERJMP	LOPLN3			;CRASH IF CAN'T GET JFN
	HRRZS	S1			;ISOLATE THE JFN
	MOVEM S1,.LSJFN(LIS)		;SAVE THE JFN FOR LATER
	MOVX S2,<FLD(^D36,OF%BSZ)+OF%WR+OF%RD> ;OPEN FOR READ AND WRITE
	OPENF%
	 ERJMP	LOPLN3			;CRASH IF CAN'T OPEN THE DEVICE
	$RET				;RETURN TO THE CALLER

LOPLN3:	$CALL	INLCRH			;INDICATE A CONTROLLED CRASH
	$STOP	(LOD, LISTENER CAN'T OPEN DECNET DEVICE)
	SUBTTL	LISINT - SET UP THE LISTENER'S INTERRUPT SYSTEM

;LISINT is called by the listener during listener startup. LISINT sets up
;the listener's interrupt system.
;
;Call is: LIS/Address of the listener block
;Returns: The interrupt system has been set up
;Crashes: The interrupt system could not be set up


LISINT:	$SAVE	<T1,T2>			;SAVE THESE AC
	MOVEI	S1,.FHSLF		;PICK UP THE LISTENER'S HANDLE
	SETO	S2,			;INDICATE DISABLE ALL 36 CHANNELS
	DIC%				;DISABLE THE CHANNELS
	 ERJMP	.+1			;SHOULDN'T HAPPEN, BUT IGNORE
	CIS%				;CLEAR THE INTERRUPT SYSTEM
	 ERJMP	.+1			;SHOULDN'T HAPPEN, BUT IGNORE
	MOVEI	S1,.FHSLF		;PICK UP THE LISTENER'S HANDLE
	HRLI	S2,.LSLEV(LIS)		;PICK UP INTERRUPT LEVEL TABLE ADDRESS
	HRRI	S2,LISCHN		;PICK UP CHANNEL TABLE ADDRESS
	SIR%				;SET UP THE INTERRUPT TABLE ADDRESSES
	 ERJMP	LISIN2			;CRASH IF CAN'T SET UP 
	MOVEI	S1,.FHSLF		;PICK UP THE LISTENER'S HANDLE
	EIR%				;ENABLE THE INTERRUPT SYSTEM
	 ERJMP	LISIN2			;CRASH IF CAN'T ENABLE INTERRUPT SYSTEM
	MOVEI	S1,.FHSLF		;PICK UP THE LISTENER'S HANDLE
	MOVX	S2,1B0+1B1+1B2+1B3+1B4	;PICK UP CHANNELS TO ACTIVATE
	AIC%				;ACTIVATE THE CHANNELS
	 ERJMP	LISIN2			;CRASH IF CAN'T ACTIVATE THE CHANNELS

	MOVE	S1,.LSJFN(LIS)		;PICK UP THE SRV: DEVICE JFN
	MOVX	S2,.MOACN		;PICK UP THE ENABLE INTERRUPTS CODE
	MOVX	T1,<FLD(0,MO%CDN)+FLD(1,MO%DAV)+FLD(3,MO%INA)> ;ENABLE CHANNELS
	MTOPR%				;ENABLE THE DECNET INTERRUPT CHANNELS
	 ERJMP	LISIN2			;CRASH IF CAN'T ENABLE THESE CHANNELS
	$RET				;RETURN TO LISTENER STARTUP

LISIN2:	$CALL	INLCRH			;INDICATE CONTROLLED CRASH
	JRST	S..CSI			;CANNOT SET UP THE INTERRUPT SYSTEM
	SUBTTL	ACCEPT - VALIDATE A DECNET CONNECTION REQUEST

;ACCEPT is the listener's interrupt handler for DECnet connection requests.
;ACCEPT validates a sender's request for a DECnet connection. The following
;two checks are made:
;1. The sender's name must be in the form expected by the listener.
;   The expected form is:
;   LNODE$LPTSPL$SN
;   where LNODE is the local node name
;2. The optional data (BDATA) field must contain the value that results from
;   the following algorithm:
;   a. The listener's node name expressed in SIXBIT is rotated left by 3 bits
;   b. This value is then converted into 4 octal 8 bit bytes
;If the sender fails to pass these two checks, then the sender's DECnet
;connection request is rejected with reason "Reject or disconnect by
;object" (error .DCX0). ORION is informed of the rejection and
;bit LT%HNL (HELLO message received from a non-LPTSPL) is set in the listener's
;status word.
;If the sender passes the two checks, then its connection request is 
;accepted.
;
;Call is: LIS/Address of the listener block
;Returns: The connecton request has been accepted or rejected
;Crashes: Cannot obtain the information to validate the connection request
;         or cannot interrupt the top fork

ACCEPT:	$BGINT	1,
	
;CHECK IF THE SENDER'S NAME IS VALID

	MOVE	S1,.LSJFN(LIS)		;PICK UP THE SRV: DEVICE JFN
	MOVEI	S2,.MORUS		;WANT THE SENDER'S USER NAME
	HRROI	T1,.LSUSR(LIS)		;WHERE TO PLACE THE USER NAME
	MTOPR%				;PICK UP THE USER NAME
	 ERJMP	ACCEP4			;ABORT AND RE-OPEN LINK ON AN ERROR
	
	HRROI	S1,.LSSNE(LIS)		;POINT TO THE EXPECTED SENDER'S NAME
	HRROI	S2,.LSUSR(LIS)		;POINT TO THE SENDER'S NAME
	$CALL	S%SCMP			;COMPARE THE TWO NAMES
	SKIPE	S1			;ARE THE NAMES THE SAME?
	JRST	ACCEP3			;NO, SO REJECT THIS REQUEST

;CHECK THE OCTAL DATA FIELD

repeat 0,<
	MOVE	S1,.LSJFN(LIS)		;PICK UP THE SRV: DEVICE JFN
	MOVEI	S2,.MORDA		;WANT THE OCTAL DATA FIELD
	HRROI	T1,.LSOPT(LIS)		;WHERE TO PLACE THE OCTAL DATA
	MTOPR%				;PCIK UP THE OCTAL DATA
	 ERJMP	ACCEP4			;ABORT AND RE-OPEN LINK ON AN ERROR

	MOVE	S2,NODNAM		;PICK UP THE LOCAL SIXBIT NODE NAME
	ROT	S2,3			;ROTATE BY 3
	MOVE	T1,[POINT 8,T3]		;WHERE TO PLACE OCTAL VALUE
	SETZ	T3,			;INITIALIZE OCTAL VALUE TO ZERO
	MOVEI	T2,4			;PICK UP NUMBER OF BYTES TO BUILD

ACCEP2:	LSHC	S1,^D9			;PICK UP THE NEXT BYTE
	IDPB	S1,T1			;STORE AS AN EIGHT BIT BYTE
	SOJN	T2,ACCEP2		;PICK UP THE NEXT BYTE

	CAME	T3,.LSOPT(LIS)		;SAME OCTAL VALUE AS THE SENDER'S?
	JRST	ACCEP3			;NO, SO REJECT THIS REQUEST
>;end of temp repeat 0

;THE SENDER HAS PASSED THE VALIDITY CHECKS. PICK UP THE NODE NAME AND
;PLACE IN THE LISTENER BLOCK.  ACCEPT THE DECNET CONNECTION REQUEST.

	MOVE	S1,.LSJFN(LIS)		;PICK UP THE SRV: DEVICE JFN
	MOVEI	S2,.MORHN		;WANT THE SENDER'S NODE NAME
	HRROI	T1,.LSANN(LIS)		;WHERE TO PLACE THE NODE NAME
	MTOPR%				;PICK UP THE SENDER'S NODE NAME
	 ERJMP	ACCEP4			;ABORT AND RE-OPEN LINK ON AN ERROR
	
	HRROI	S1,.LSANN(LIS)		;PICK UP THE SENDER'S NODE NAME
	$CALL	S%SIXB			;CHANGE IT TO SIXBIT
	MOVEM	S2,.LSNME(LIS)		;SAVE THE SIXBIT NODE NAME

	MOVE	S1,.LSJFN(LIS)		;PICK UP SRV: DEVICE JFN
	MOVEI	S2,.MOCC		;THE CONNECTION WILL BE ACCEPTED
	SETZB	T1,T2			;NO OPTIONAL DATA
	MTOPR%				;ACCEPT THE CONNECTION
	 ERJMP	ACCEP4			;ABORT AND RE-OPEN LINK ON AN ERROR

	JRST	ACCEP5			;GO RETURN TO THE PREVIOUS CONTEXT

;THE SENDER'S DECNET CONNECTION REQUEST HAS BEEN DENIED. REJECT THE 
;CONNECTION, INDICATE THAT THE CONNECTION HAS BEEN REJECTED IN THE LISTENER'S
;STATUS WORD IN THE LISTENER TABLE ENTRY AND INFORM ORION OF THE REJECTION.

ACCEP3:	MOVE	S1,.LSLTA(LIS)		;PICK UP LISTENER TABLE ENTRY ADDRESS
	MOVX	S2,LT%HNL		;INDICATE CONNECTION FAILURE
	IORM	S2,.LTSTA(S1)		;PLACE IN THE STATUS WORD

	MOVE	S1,.LSJFN(LIS)		;PICK UP THE SRV: DEVICE JFN
	MOVEI	S2,.MOCLZ		;WILL REJECT THIS REQUEST
	SETZB	T1,T2			;NO OPTIONAL DATA
	MTOPR%				;REJECT THE REQUEST
	 ERJMP	ACCEP4			;CRASH ON AN ERROR
	$LOG	(<DECnet connection rejected>,<DECnet connection from node ^N/.LSNME(LIS)/ rejected>)
	JRST	ACCEP5			;GO RETURN TO PREVIOUS CONTEXT

;A FATAL ERROR HAS BEEN ENCOUNTERED. ABORT AND RE-OPEN THE LINK

ACCEP4:	$CALL	LABLNK			;ABORT THE LINK
	MOVEI	S1,.LSPDL(LIS)		;[6002]SET UP THE LISTENER CONTEXT
	HRLI	S1,-<PDSIZ-1>		;[6002]STACK POINTER
	MOVEM	S1,.LSACS+P(LIS)	;[6002]SAVE AS THE NEW STACK POINTER
	MOVEI	S1,LISTE3		;[6002]WHERE TO RESUME EXECUTION FROM	
	TXO	S1,1B5			;[6002]
	MOVEM	S1,.LS1PC(LIS)		;[6002]STORE AS THE NEW PC

ACCEP5:	$DEBRK				;RETURN TO THE PREVIOUS CONTEXT
	SUBTTL	MSGFSN - DECNET MESSAGE FROM SENDER IS AVAILABLE

;MSGFSN is the interrupt handler for processing the NEXTJOB message from
;Cluster LPTSPL's sender. After processing of the NEXTJOB message has 
;been completed, MSGFSN checks if the top fork is busy or not. If the
;top fork is not busy and the listener message queue is empty, then the
;NEXTJOB message is transferred to the listener message buffer and the
;top fork is notified. If the top fork is not busy and the listener message
;queue is not empty, then the message is placed on the end of the queue.
;The first message in the listener message queue is transferred to the
;listener message buffer and the top fork is notified. If the top fork is
;busy, then the message is placed on the message queue.
;
;Call is: LIS/Address of the listener block
;Returns: The message has been processed
;Crashes: The link status cannot be obtained, the message cannot be picked
;up, or the top fork cannot be notified

MSGFSN:	$BGINT	1,			;SAVE PREVIOUS CONTEXT

;DETERMINE IF THERE IS A MESSAGE OR NOT

	SKIPG	S1,.LSJFN(LIS)		;PICK UP THE DECNET DCN: DEVICE JFN
	JRST	MSGF18			;TREAT AS SPURIOUS
	SIBE%				;DETERMINE IS THERE IS A MESSAGE
	JRST	MSGFS1			;THERE IS A MESSAGE, PICK IT UP
	$CALL	LCKLNK			;CHECK THE LINK STATUS
	JUMPT	MSGF18			;CONNECTED, TREAT AS SPURIOUS
	JRST	MSGF17			;RE-ATTEMPT TO OPEN THE LINK

;PICK UP THE MESSAGE

MSGFS1:	MOVE	S2,.LSNXJ(LIS)		;ASSUME IT'S A NEXTJOB MESSAGE
	SKIPGE	P1,.LSSTE(LIS)		;IS IT?
	MOVE	S2,.LSXRM(LIS)		;NO, PICK UP XFER FILE RESPONSE MSG ADR
	HRLI	S2,(POINT 36)		;MAKE INTO A POINTER
	MOVE	S1,.LSJFN(LIS)		;PICK UP THE DECNET DCN: DEVICE JFN
	MOVNI	T1,PAGSIZ		;ASSUME THE MAXIMUM PAGE SIZE
	SINR%				;PICK UP THE MESSAGE
	 ERJMP	MSGF16			;CHECK FOR FATAL ERROR OR NOT
	TXNE	P1,LS%XMR		;WAITING FOR A NEXTJOB MESSAGE?
	JRST	MSGFS7			;NO, TRANSFER FILE RESPONSE MESSAGE

;A NEXTJOB MESSAGE HAS BEEN RECEIVED. DETERMINE IF CHECKSUMMING IS TO BE
;DONE. IF SO, THEN DO IT.

REPEAT 0,<
	MOVE	S1,.LSNXJ(LIS)		;PICK UP THE MESSAGE'S ADDRESS
	MOVE	S2,.MSCHS(S1)		;PICK UP THE MESSAGE'S CHECKSUM
	MOVEM	S2,.LSRCS(LIS)		;SAVED, DESTROYED BY LISCHK
	$CALL	LISCHK			;DO THE CHECKSUM OR NOT, AS INDICATED
	JUMPF	MSGF14			;CHECKSUM NOT AGREE, SEND FAIL ACK
>
;SET UP FOR THE PROCESSING OF THE NEXTJOB MESSAGE

MSGFS2:	MOVE	P1,.LSNXJ(LIS)		;PICK UP THE NEXTJOB MESSAGE ADDRESS
	LOAD	P2,.EQSEQ(P1),EQ.IAS	;PICK UP INVALID ACCOUNT STRING BIT
	JUMPN	P2,MSGF4A		;IF INVALID DON'T CHECK IF ACCESSIBLE
	LOAD	P2,.EQLEN(P1),EQ.LOH	;PICK UP THE EQ HEADER
	ADD	P2,P1			;POINT TO THE FIRST FP
	MOVEI	P3,.LSFXM(LIS)		;PICK UP TRANSFER FILE MSG ADDRESS
	MOVEI	P4,.OHDRS+.TFHSZ(P3)	;POINT TO THE FIRST RELATIVE FP BLOCK
	MOVEI	S1,<.OHDRS+.TFHSZ+^D70> ;PICK UP ITS LENGTH
	MOVE	S2,P3			;PICK UP TRANSFER FILE MESSAGE ADDRESS
	$CALL	.ZCHNK			;INITIALIZE THE TRANSFER FILE MSG
	LOAD	T1,.EQSPC(P1),EQ.NUM	;PICK UP NUMBER OF FILES IN EQ
	SETZ	T2,			;RELATIVE FP BLOCK NUMBER

;CHECK EACH FILE IN THE NEXTJOB MESSAGE AS TO WHETHER IT IS ACCESSIBLE
;TO THIS SYSTEM OR NOT. IF ONE OR MORE FILES ARE NOT ACCESSIBLE TO THIS
;SYSTEM, THEN A TRANSFER FILE MESSAGE WILL BE SENT TO THE SENDER. THE
;TRANSFER FILE MESSAGE INDICATES THE RELATIVE FP POSITION OF EACH FILE
;IN THE NEXTJOB MESSAGE THAT THE SENDER MUST COPY INTO A DIRECTORY SHARED
;BETWEEN THE LOCAL AND REMOTE SYSTEMS.

MSGFS3:	AOS	T2			;THE CURRENT RELATIVE FP BLOCK 
	MOVE	S1,P2			;PICK UP THE CURENT FP BLOCK ADDRESS
	$CALL	CHKACC			;CHECK IF THIS FILE IS ACCESSIBLE
	JUMPT	MSGFS4			;THE FILE IS ACCESSIBLE
	AOS	.OHDRS+.TFNUM(P3)	;INCREMENT NUMBER OF INACCESSIBLE FILES
	MOVEM	T2,.TFFPP(P4)		;PLACE RELATIVE FP BLOCK NUMBER IN MSG
	ADDI	P4,.TFFPS		;POINT TO NEXT RELATIVE FP BLOCK

MSGFS4:	LOAD	S1,.FPLEN(P2),FP.LEN	;PICK UP THE FP BLOCK LENGTH
	ADD	P2,S1			;POINT TO ITS FD BLOCK
	LOAD	S1,.FDLEN(P2),FD.LEN	;PICK UP THE FD BLOCK LENGTH
	ADD	P2,S1			;POINT TO THE NEXT FP BLOCK
	SOJG	T1,MSGFS3		;CHECK THE NEXT FILE IN THE NEXTJOB MSG

;IF ALL FILES ARE ACCESSIBLE, THEN SEND AN ACK TO CLUSTER LPTSPL.
;IF ONE OR MORE FILES ARE NOT ACCESSIBLE, THEN SEND THE TRANSFER FILE
;MESSAGE TO CLUSTER LPTSPL.

	SKIPE	T1,.OHDRS+.TFNUM(P3)	;ANY FILES INACCESSIBLE?
	JRST	MSGF4B			;YES, SEND A TRANSFER FILE MESSAGE
MSGF4A:	$CALL	SNDACK			;NO, SEND AN ACK
	JUMPF	MSGF16			;CHECK FOR A FATAL ERROR
	MOVE	S1,.LSNXJ(LIS)		;PICK UP NEXTJOB MESSAGE ADDRESS
	JRST	MSGF13			;ATTEMPT TO NOTIFY THE TOP FORK
MSGF4B:	IMULI	T1,.TFFPS		;CALCULATE THE TOTAL SIZE OF FP BLOCKS
	ADDI	T1,.OHDRS+.TFHSZ	;INCLUDE THE HEADER AND # FILES BLOCK
	STORE	T1,.MSTYP(P3),MS.CNT	;PLACE IN THE TRANSFER FILE MESSAGE

REPEAT 0,<
;CHECKSUM IF NECESSARY

	SKIPN	CHECKS			;CHECKSUMMING ENABLED LOCALLY?
	JRST	MSGFS5			;NO, GO SEND THE MESSAGE
	SKIPN	.LSRCS(LIS)		;CHECKSUMMING ENABLED REMOTELY?
	JRST	MSGFS5			;NO, GO SEND THE MESSAGE
	$CALL	CHKSUM			;CHECKSUM THE MESSAGE
>
;SEND THE MESSAGE TO CLUSTER LPTSPL

MSGFS5:	MOVX	S1,LS%XMR		;TRANSFER FILE RESPONSE MESSAGE STATE
	MOVEM	S1,.LSSTE(LIS)		;SAVE THE LISTENER STATE
MSGFS6:	MOVE	S1,.LSJFN(LIS)		;PICK UP THE SRV: DEVICE JFN
	MOVEI	S2,.LSFXM(LIS)		;[6004]PICK UP TRANSFER FILE MSG ADDRESS
	HRLI	S2,(POINT 36)		;MAKE INTO A POINTER
	MOVNS	T1			;MAKE IT NEGATIVE
	SOUTR%				;SEND THE MESSAGE
	 ERJMP	MSGF16			;ABORT THE LINK AND RE-OPEN IT
                                        ;IF NOT A FATAL ERROR (LREOPN)
	JRST	MSGF18			;RETURN TO THE PREVIOUS STATE
	
;THE MESSAGE IS A TRANSFER FILE RESPONSE MESSAGE

MSGFS7:
REPEAT 0,<
	MOVE	P2,.LSXRM(LIS)		;PICK UP THE ADDRESS OF THE MESSAGE
	MOVE	S1,P2			;PLACE WHERE LISCHK EXPECTS IT
	$CALL	LISCHK			;DO THE CHECKSUM OR NOT, AS INDICATED
	JUMPF	MSGF14			;CHECKSUMS DO NOT AGREE, SEND FAIL ACK
>
	MOVE	P1,.LSNXJ(LIS)		;PICK UP THE NEXTJOB MESSAGE ADDRESS
	MOVE	P2,.LSXRM(LIS)		;[6004]PICK UP THE XFER FILE RSP MSG ADR
	MOVE	P3,.LSMOD(LIS)		;PICK UP THE MODIFIED NEXTJOB MSG ADR

;MOVE THE EQ FROM THE NEXTJOB MESSAGE TO THE MODIFIED NEXTJOB MESSAGE

	MOVE	S1,P3			;WHERE TO PLACE THE EQ
	HRL	S1,P1			;SOURCE,,DESTINATION
	LOAD	P4,.EQLEN(P1),EQ.LOH	;PICK UP SIZE OF THE EQ
	MOVE	S2,P4			;PLACE SIZE HERE ALSO
	ADD	S2,P3			;DESTINATION ADDRESS + 1
	BLT	S1,-1(S2)		;TRANSFER THE EQ

;POINT TO THE FIRST FP OF THE NEXTJOB AND MODIFIED NEXTJOB MESSAGES

	ADD	P1,P4			;FIRST FP OF THE NEXTJOB MESSAGE
	ADD	P3,P4			;FIRST FP OF THE MOD NEXTJOB MSG
	MOVE	T3,.OHDRS+.TSNUM(P2)	;[6004]NUMBER OF RELATIVE FP BLOCKS
	MOVEI	S1,<.OHDRS+.TSHSZ-.TSSIZ>(P2) ;[6004]POINT BEFORE FIRST REL FP
	MOVE	S2,T3			;[6004]PICK UP THE # OF RELATIVE FP BLKS
	IMULI	S2,.TSSIZ		;[6004]FIND THEIR SIZE
	ADD	S1,S2			;[6004]ADDRESS OF LAST FP BLOCK
	MOVE	S1,.TFFPP(S1)		;[6004]PICK UP THE LAST RELATIVE FP #
	MOVEM	S1,.LSLRB(LIS)		;[6004]SAVE FOR LATER

	ADDI	P2,.OHDRS+.TSHSZ	;[6004]POINT TO FIRST RELATIVE FP BLOCK
	MOVEI	T2,1			;CURRENT FP BLOCK
	SETZ	T1,			;NUMBER OF FILES IN MOD NEXTJOB MSG

;POSITION TO THE FIRST FP BLOCK OF THE NEXTJOB MESSAGE AS INDICATED BY
;THE RELATIVE FP BLOCK IN THE TRANSFER FILE RESPONSE MESSAGE

MSGFS8:	MOVE	S1,.TSFPP(P2)		;PICK UP THE FP BLOCK POSITION
	SUB	S1,T2			;NUMBER OF FP BLOCKS TO GO THROUGH
	JUMPE	S1,MSGF10		;ALREADY POSITIONED

;TRANSFER THE UNWANTED FP/FD BLOCKS TO THE MODIFIED NEXTJOB MESSAGE.
;MAKE SURE THERE IS ENOUGH ROOM IN THE MODIFIED NEXTJOB MESSAGE.

MSGFS9:	MOVE	T2,S1			;[6004]PICK UP THE FP BLOCK POSITION
	$CALL	CHKRM			;FIRST ENSURE THERE IS ENOUGH ROOM
	SKIPT				;SKIP IF THERE IS ENOUGH ROOM
	$CALL	SENNXJ			;FINISH MSG AND SEND OR QUEUE 

;MOVE THE FP/FD PAIR TO THE MODIFIED NEXTJOB MESSAGE

	MOVE	S2,P3			;CURRENT END OF MODIFIED NEXTJOB MSG
	HRL	S2,P1			;SOURCE,,DESTINATION
	MOVE	S1,T4			;[6004]PICK UP FP/FD SIZE
	ADD	S1,P3			;[6004]END OF DESTINATION + 1
	BLT	S2,-1(S1)		;[6004]COPY THE FP/FD OVER

	ADD	P1,T4			;POINT TO THE NEXT FP/FD PAIR
	ADD	P3,T4			;POINT TO THE NEXT FP/FD PAIR
	AOS	T1			;INCREMENT THE NUMBER OF FILES
	SOJG	T2,MSGFS9		;[6004]TRANSFER THE NEXT FP/FD PAIR

;POINTING AT THE FP OF THE FILE THAT IS INACCESSIBLE TO THIS SYSTEM.
;FIRST MAKE SURE THERE IS ROOM IN THE MODIFIED NEXTJOB MESSAGE TO
;CONTAIN THE FILE'S FP/FD PAIR.

MSGF10:	$CALL	CHKRM			;FIRST ENSURE THERE IS ENOUGH ROOM
	SKIPT				;SKIP IF THERE IS ENOUGH ROOM
	$CALL	SENNXJ			;FINISH MSG AND SEND OR QUEUE 

;CHECK IF THE ORIGINATING NODE NO LONGER HAS ACCESS TO THE FILE. IF
;IT DOES NOT, THEN NEITHER DOES THIS NODE.

	SKIPN	T2,.TSTFN(P2)		;IS THE NODE ACCESSIBLE?
	JRST	MSGF11			;NO, INDICATE IN MOD NXTJOB MSG

;MODIFY THE FP OF THIS FILE TO INDICATE THAT THERE IS A TEMPORARY FILE
;ASSOCIATED WITH THIS FILE.

	MOVE	S1,P3			;PICK UP DESTINATION ADDRESS
	HRL	S1,P1			;SOURCE,,DESTINATION
	LOAD	S2,.FPLEN(P1),FP.LEN	;PICK UP THE FP LENGTH
	PUSH	P,S2			;SAVE THIS LENGTH FOR LATER
	ADD	S2,P3			;END OF DESTINATION + 1
	BLT	S1,-1(S2)		;COPY THE FP OVER
	POP	P,S2			;RESTORE LENGTH OF THE FP
	AOS	S2			;INCREMENT FP SIZE FOR .FPTEM
	STORE	S2,.FPLEN(P3),FP.LEN	;STORE NEW FP SIZE IN THE FP
	AOS	P4			;INCLUDE IN TOTAL MOD NEXTJOB MSG SIZE
	MOVX	S1,FP.CPY		;PICK UP TEMPORARY FILE BIT
	IORM	S1,.FPINF(P3)		;INDICATE TEMPORARY FILE IN THE FP
	MOVEM	T2,.FPTEM(P3)		;PLACE TEMP FILE NAME IN FP

;MOVE THE FD OVER TO THE MODIFIED NEXTJOB MESSAGE

	ADD	P3,S2			;POINT TO THE MOD NEXTJOB MSG FD
	ADDI	P1,-1(S2)		;POINT TO THE NEXTJOB MESSAGE FD
	LOAD	S2,.FDLEN(P1),FD.LEN	;PICK UP THE NEXTJOB FD LENGTH
	MOVE	T4,S2			;SAVE FOR LATER
	MOVE	S1,P3			;PICK UP DESTINATION ADDRESS
	HRL	S1,P1			;SOURCE,,DESTINATION
	ADD	S2,P3			;END OF DESTINATION + 1
	BLT	S1,-1(S2)		;COPY THE FD OVER
	ADD	P1,T4			;POINT TO THE NEXT FP/FD PAIR
	ADD	P3,T4			;POINT TO THE NEXT FP/FD PAIR
	JRST	MSGF12			;CHECK THE NEXT RELATIVE FP

;THE FILE IS NO LONGER ACCESSIBLE ON THE ORIGINATING SYSTEM
;COPY THE FP/FD PAIR OVER TO THE MODIFIED NEXTJOB MESSAGE AND INDICATE
;IN THE FP THAT THE USER DOES NOT HAVE ACCESS TO THIS FILE.

MSGF11:	MOVE	S2,P3			;CURRENT END OF MODIFIED NEXTJOB MSG
	HRL	S2,P1			;SOURCE,,DESTINATION
	MOVE	T2,T4			;SAVE THE FP/FD LENGTH
	ADD	T2,P3			;END OF DESTINATION + 1
	BLT	S2,-1(T2)		;COPY THE FP/FD OVER
	
	MOVX	S1,FP.NRA		;USER DOES NOT HAVE ACCESS TO FILE
	IORM	S1,.FPINF(P3)		;INDICATE IN THE FILE'S FP
	MOVX	S1,FP.DEL		;USER CAN'T DELETE THIS FILE
	ANDCAM	S1,.FPINF(P3)		;INDICATE IN THE FILE'S FP
	ADD	P1,T4			;POINT TO THE NEXT FP/FD PAIR
	ADD	P3,T4			;POINT TO THE NEXT FP/FD PAIR

;PREPARE TO PROCESS THE NEXT RELATIVE FP BLOCK FROM THE TRANSFER FILE
;RESPONSE MESSAGE

MSGF12:	AOS	T1			;NUMBER OF FILES IN MOD NEXTJOB MSG
	MOVE	T2,.TSFPP(P2)		;[6004]FP BLOCK NUMBER JUST PROCESSED
	AOS	T2			;CURRENT FP BLOCK IN NEXTJOB MSG
	ADDI	P2,.TSSIZ		;POINT TO NEXT RELATIVE FP BLOCK
	SOJG	T3,MSGFS8		;GO PROCESS THE NEXT RELATIVE FP BLOCK

;FINISH BUILDING THE MESSAGE

	MOVE	S2,.LSLRB(LIS)		;[6004]PICK UP THE NUMBER OF TEMP FILES
	MOVE	S1,.LSNXJ(LIS)		;[6004]PICK UP NEXTJOB MSG ADDRESS
	LOAD	S1,.EQSPC(S1),EQ.NUM	;[6004]PICK UP THE TOTAL NUMBER OF FILES
	SUB	S1,S2			;[6004]SUB THE LAST TEMP FILE POSITION
	SKIPE	S1			;[6004]ANY REMAINING FP/FD TO TRANSFER?
	$CALL	TRNREM			;[6004]YES, TRANSFER THE REMAINING FP/FD
	MOVE	S1,.LSMOD(LIS)		;PICK UP MODIFIED NEXTJOB MESSAGE ADR
	STORE	P4,.MSTYP(S1),MS.CNT	;STORE THE MESSAGE LENGTH
	STORE	T1,.EQSPC(S1),EQ.NUM	;STORE NUMBER OF FILE NAMES IN MESSAGE
	$CALL	SNDACK			;SEND A SUCCESS ACK TO THE SENDER
	JUMPF	MSGF16			;CHECK THE LINK STATUS ON AN ERROR
	MOVE	S1,.LSMOD(LIS)		;PICK UP MODIFIED NEXTJOB MESSAGE ADR
MSGF13:	$CALL	NOTFRK			;NOTIFY THE TOP FORK OF ANY MESSAGES
	SETZM	.LSSTE(LIS)		;[6004]RESET THE LISTENER'S STATE
	JRST	MSGF18			;GO RETURN TO THE PREVIOUS CONTEXT

;CHECKSUMS DO NOT AGREE. TELL THE SENDER TO RESEND THE MESSAGE

REPEAT 0,<
MSGF14:	$CALL	ACKFAI			;SEND A FAIL ACK MESSAGE TO THE SENDER
	JUMPF	MSGF16			;CHECK IF A FATAL ERROR OCCURRED
	JRST	MSGF18			;GO RETURN TO THE PREVIOUS CONTEXT
>

;A SOUTR OR SINR FAILED. CHECK IF THE LINK IS STILL CONNECTED. IF IT IS,
;THEN CONSIDER THE ERROR TO BE FATAL. IF THE LINK IS NO LONGER CONNECTED,
;THEN RESET THE STATE AND ATTEMPT TO RE-OPEN THE LINK.

MSGF16:	$CALL	LCKLNK			;CHECK THE STATUS OF THE LINK
	JUMPT	MSGF19			;LINK IS STILL OPEN, FATAL ERROR

MSGF17:	SETZM	.LSSTE(LIS)		;RESET THE LISTENER'S STATE
	MOVEI	S1,.LSPDL(LIS)		;[6001]SET UP THE LISTENER CONTEXT
	HRLI	S1,-<PDSIZ-1>		;[6001]STACK POINTER
	MOVEM	S1,.LSACS+P(LIS)	;[6001]SAVE AS THE NEW STACK POINTER
	MOVEI	S1,LISTE3		;[6001]WHERE TO RESUME EXECUTION FROM	
	TXO	S1,1B5			;[6001]
	MOVEM	S1,.LS1PC(LIS)		;[6001]STORE AS THE NEW PC

MSGF18:	$DEBRK				;RETURN TO THE PREVIOUS CONTEXT

;A FATAL ERROR HAS OCCURRED, CRASH

MSGF19:	$CALL	INLCRH			;INDICATE A CONTROLLED CRASH
	JRST	S..IFE
	SUBTTL	CHKRM - CHECK IF ENOUGH ROOM TO ADD AN FP/FD PAIR

;CHKRM is called to determine if there is enough room to add another FP/FD
;pair to a modified NEXTJOB message.
;
;Call is:       P1/Address of an FP in the NEXTJOB message 
;               P4/Current length of the modified NEXTJOB message
;Returns true:  There is enough space remaining in the modified NEXTJOB message
;               to add the FP/FD pair
;               T4/Length of the FP/FD pair
;               P4/Length of the message with the FP/FD pair included
;Returns false: There is not enough space remaining in the modified NEXTJOB
;               message to add the FP/FD pair

CHKRM:	LOAD	S2,.FPLEN(P1),FP.LEN	;PICK UP THE FP BLOCK LENGTH
	MOVE	T4,S2			;REMEMBER THE LENGTH
	ADD	S2,P1			;POINT TO THE FD BLOCK
	LOAD	S2,.FDLEN(S2),FD.LEN	;PICK UP THE FD BLOCK LENGTH
	ADD	T4,S2			;ADD TO THE FP LENGTH
	MOVE	S2,T4			;SAVE THE FP/FD LENGTH
	ADD	S2,P4			;ADD IN THE CURRENT MOD NEX MSG LENGTH
	CAIL	S2,PAGSIZ		;[6004]IS THERE ENOUGH ROOM LEFT?
	$RETF				;NO, INDICATE TO THE CALLER
	ADD	P4,T4			;ADD FP/FD LENGTH TO TOTAL MSG LENGTH
	$RETT				;INDICATE TO THE CALLER
	SUBTTL	SENNXJ - SEND OR QUEUE AN INTERMEDIATE NEXTJOB MESSAGE

;SENNXJ is called if, when building a modified NEXTJOB message, it is
;detected that there is not enough room left to add the next FP/FD
;pair. SENNXJ finishes the header of the message, either passes the
;message to the top fork or queues it on the listener's message 
;queue and then sets up the next modified NEXTJOB message to complete
;the processing of the NEXTJOB message.
;
;Call is: LIS/Address of the listener block
;         T1/The number of files in the modified NEXTJOB message
;         P4/The length of the message
;Returns: P4/Length of the next modified NEXTJOB message
;         P3/Address of the next modified NEXTJOB message's first FP
;         T1/Number of files in the next modified NEXTJOB message (which
;            is zero at this point)
;         The modified NEXTJOB message has been completed and either
;         passed to the top fork or queued on the listener's message queue

SENNXJ:	MOVE	S1,.LSMOD(LIS)		;PICK UP ADR OF MODIFIED NEXTJOB MSG
	STORE	P4,.MSTYP(S1),MS.CNT	;STORE THE LENGTH OF THE MESSAGE
	STORE	T1,.EQSPC(S1),EQ.NUM	;STORE THE NUMBER OF FILES IN THE MSG
	$CALL	NOTFRK			;QUEUE OR PASS THE MESSAGE TO TOP FORK

;SET UP THE NEXT MODIFIED NEXTJOB MESSAGE - ITS EQ, LENGTH AND NUMBER OF FILES

	MOVE	P3,.LSMOD(LIS)		;PICK UP ADR OF MODIFIED NEXTJOB MSG
	MOVE	S1,P3			;MAKE IT THE DESTINATION OF A BLT
	MOVE	S2,.LSNXJ(LIS)		;[6004]PICK UP NEXTJOB MESSAGE ADDRESS
	HRL	S1,S2			;[6004]SOURCE,,DESTINATION ADDRESSES
	LOAD	S2,.EQLEN(S2),EQ.LOH	;PICK UP THE EQ LENGTH
	MOVE	P4,S2			;SAVE FOR THE RETURN
	ADD	S2,P3			;END OF DESTINATION + 1
	BLT	S1,-1(S2)		;COPY OVER THE EQ TO MOD NEXTJOB MSG
	ADD	P3,P4			;POINT TO THE FIRST FP
	ADD	P4,T4			;[6004]ADD IN THE FP/FD LENGTH
	SETZ	T1,			;NO FILES IN MOD NEXTJOB MESSAGE YET
	$RET				;RETURN TO THE CALLER
	SUBTTL	CHKACC - CHECK IF SYSTEM HAS ACCESS TO FILE

;CHKACC is called to determine if the local system has access to a
;file specified in a NEXTJOB message that came from a remote system.
;This is done by attempting to open the file with READ access.
;
;Call is:       S1/Address of the FP block of the file
;Returns true:  The local system has access to the file
;Returns false: The local system does not have access to the file

CHKACC:	PUSH	P,S1			;SAVE THE FP ADDRESS
	MOVEI	S1,FOB.SZ		;PICK UP SIZE OF FOB
	MOVEI	S2,.LSFOB(LIS)		;PICK UP ADDRESS OF FOB
	$CALL	.ZCHNK			;ZERO THE FOB
	POP	P,S1			;RESTORE THE FP ADDRESS
	LOAD	S2,.FPLEN(S1),FP.LEN	;GET THE FP LENGTH
	ADD	S2,S1			;GET THE FD ADDRESS
	STORE	S2,.LSFOB+FOB.FD(LIS)	;SAVE IN THE FOB
	MOVEI	S2,^D36			;OPEN AS 36 BIT BYTS
	STORE	S2,.LSFOB+FOB.CW(LIS),FB.BSZ  ;AND SAVE THE BYTE SIZE
	MOVEI	S1,FOB.SZ		;GET FOB SIZE
	MOVEI	S2,.LSFOB(LIS)		;AND ADDRESS
	$CALL	F%IOPN			;OPEN THE FILE
	$RETIF				;NO ACCESS TO THIS FILE
	$CALL	F%REL			;CLOSE THE FILE
	$RETT				;AND RETURN
	SUBTTL	NOTFRK - NOTIFY TOP FORK OF MESSAGE FROM A LISTENER

;NOTFRK is called after a listener has finished processing a message
;from a sender. NOTFRK checks if the top fork is ready for a message.
;If it is, then a message is placed in the listener's message buffer
;and the top fork is interrupted. Otherwise, the message is placed on
;the listener's message queue.
;
;Call is: LIS/Address of the listener block
;          S1/Address of the message
;Returns: The top fork has been informed that there is a message available
;         or the message has been queued on the listener's message queue

NOTFRK:	$SAVE	<P1>			;SAVE THIS AC
	SKIPL	.LSAVA(LIS)		;IS THE TOP FORK AVAILABLE?
	JRST	NOTFR2			;NO, PLACE THE MSG ON THE MESSAGE QUEUE
	SKIPN	P1,.LSHWD(LIS)		;IS THE MESSAGE QUEUE EMPTY?
	JRST	NOTFR1			;YES, PLACE IN MESSAGE BLOCK AND SEND
	MOVE	M,S1			;PLACE MESSAGE ADDRESS WHERE EXPECTED
	$CALL	BLDMQE			;BUILD A MESSAGE QUEUE ENTRY
	$CALL	ADDLME			;LINK IN THE MESSAGE QUEUE ENTRY
	MOVE	S1,.MQMAD(P1)		;PICK UP FIRST MESSAGE QUEUE ENTRY ADR
	$CALL	XFRTOP			;PLACE MSG IN BUFFER AND INFORM TOP FORK
	MOVE	S1,.MQBLK(P1)		;PICK UP ADDRESS OF NEXT MESSAGE QE
	MOVEM	S1,.LSHWD(LIS)		;UPDATE THE MESSAGE QUEUE HEADER WORD
	MOVE	S1,P1			;PICK UP ADDRESS OF MESSAGE QUEUE ENTRY
	$CALL	RELMQE			;RETURN ITS MEMORY
	$RET				;RETURN TO THE CALLER
NOTFR1:	$CALL	XFRTOP			;PLACE MSG IN BUFFER AND INFORM TOP FORK
	$RET				;RETURN TO THE CALLER

NOTFR2:	MOVE	M,S1			;[6004]PLACE MSG ADDRESS WHERE EXPECTED
	$CALL	BLDMQE			;BUILD THE MESSAGE QUEUE ENTRY
	$CALL	ADDLME			;PLACE ON THE MESSAGE QUEUE
	$RET				;RETURN TO THE CALLER
	SUBTTL	TRNREM - TRANSFER THE REST OF THE NEXTJOB MESSAGE

;[6004]TRNREM is called as part of building a modified NEXTJOB message when 
;[6004]it is detected that there are remaining FD/FP pairs in the original 
;[6004]NEXTJOB message following the last temporary file FD/FP. TRNREM
;[6004]transfers the remaining FD/FP blocks from the NEXTJOB message to the
;[6004] modified NEXTJOB message.
;[6004]
;[6004]Call is: S1/Number of FP/FD blocks in the NEXTJOB message that need 
;[6004]            to be transferred
;[6004]	        T1/Number of files in the modified NEXTJOB message
;[6004]         P1/Address of the first FP/FD block in the NEXTJOB message
;[6004]            to be transferred
;[6004]         P3/Address of the next FP/FD block in the modified NEXTJOB
;[6004]            message
;[6004]	  P4/The length of the modified NEXTJOB message
;[6004]Returns: The remaining FP/FD blocks in the NEXTJOB message have been 
;[6004]         transferred to the modified NEXTJOB message

TRNREM:	ADD	T1,S1			;[6004]NUMBER OF FILES IN MOD NXTJOB MSG
	MOVE	T2,S1			;[6004]NUMBER OF FP/FD PAIRS TO TRANSFER

;[6004]PICK UP THE CURRENT FP/FD LENGTH AND UPDATE THE TOTAL MESSAGE LENGTH

TRNR.1:	LOAD	S2,.FPLEN(P1),FP.LEN	;[6004]PICK UP THE FP BLOCK LENGTH
	MOVE	T4,S2			;[6004]REMEMBER THE LENGTH
	ADD	S2,P1			;[6004]POINT TO THE FD BLOCK
	LOAD	S2,.FDLEN(S2),FD.LEN	;[6004]PICK UP THE FD BLOCK LENGTH
	ADD	T4,S2			;[6004]GET THE FP/FD LENGTH
	ADD	P4,T4			;[6004]ADD PF/FD LENGTH TO TOTAL MSG LENGTH

;[6004]MOVE THE FP/FD PAIRS FROM THE NEXTJOB MESSAGE TO THE MODIFIED NEXTJOB MESSAGE

	MOVE	S2,P3			;[6004]CURRENT END OF MODIFIED NEXTJOB MSG
	HRL	S2,P1			;[6004]SOURCE,,DESTINATION
	MOVE	S1,T4			;[6004]PICK UP FP/FD SIZE
	ADD	S1,P3			;[6004]END OF DESTINATION + 1
	BLT	S2,-1(S1)		;[6004]COPY THE FP/FD OVER

	ADD	P1,T4			;[6004]POINT TO THE NEXT FP/FD PAIR
	ADD	P3,T4			;[6004]POINT TO THE NEXT FP/FD PAIR
	SOJG	T2,TRNR.1		;[6004]TRANSFER THE NEXT FP/FD PAIR
	$RET				;[6004]RETURN TO THE CALLER
	SUBTTL	MSGTTF - TOP FORK READY FOR A MESSAGE FROM A LISTENER

;MSGTTF is the interrupt handler used when the top fork is free to process
;another message from the listener. MSGTTF first checks if the top fork
;is busy. (This can happen if a "DECnet message from the sender" interrupt
;happens to occur between the time the top fork has set its free to process
;a message flag (.LSAVA) and the time it interrupts the listener on this
;channel. The interrupt routine MSGFSN, in this case, detects that the top
;fork is not busy. MSGFSN then places a message in the message buffer, changes
;the state of the top fork to busy and interrupts the top fork.)
;If the top fork is not busy, then MSGTTF checks if the listener message
;queue is empty. If it is, then it quits, otherwise, it moves a message
;from the message queue to the listener message buffer and interrupts the
;top fork.
;
;Call is: LIS/Address of the listener block
;Returns: A message, if there is one and if the top fork is not busy,
;         has been placed in the message buffer and the top fork has
;         been notified of the message
;Crashes: The top fork cannot be interrupted

MSGTTF:	$BGINT	1,			;SAVE THE CONTEXT
	SKIPL	.LSAVA(LIS)		;IS THE TOP FORK BUSY?
	$DEBRK				;YES, SO QUIT NOW
	SKIPN	P1,.LSHWD(LIS)		;NO, IS MESSAGE QUEUE EMPTY?
	$DEBRK				;YES, SO QUIT NOW
	MOVE	S1,.MQMAD(P1)		;PICK UP THE MESSAGE ADDRESS
	$CALL	XFRTOP			;GIVE A MESSAGE TO THE TOP FORK
	MOVE	S1,.MQBLK(P1)		;PICK UP THE NEXT MESSAGE QE ADDRESS
	JUMPG	S1,MSGTT1		;IS THE MESSAGE QUEUE NOW EMPTY?
	SETZM	.LSHWD(LIS)		;YES, ZERO OUT THE HEADER WORD
	SETZM	.LSTWD(LIS)		;AND THE TRAILER WORD
	SKIPA				;SKIP UPDATING THE HEADER WORD
MSGTT1:	MOVEM	S1,.LSHWD(LIS)		;UPDATE THE MESSAGE QUEUE HEADER WORD
	MOVE	S1,P1			;PICK UP MESSAGE QUEUE ENTRY ADDRESS
	$CALL	RELMQE			;RELEASE THE MESSAGE QUEUE ENTRY
	$DEBRK				;RETURN TO THE PREVIOUS CONTEXT
	SUBTTL	XFRTOP - MOVE MESSAGE FROM MESSAGE QUEUE TO MESSAGE BUFFER

;XFRTOP is called to transfer a message from the listener's message queue
;or message page to its message buffer and then to interrupt the top fork
;that there is a message available for it to process. The message is then
;deleted from the message queue.
;
;Call is: LIS/Address of the listener block
;         S1/Address of the message
;Returns: A message has been placed in the listener buffer and the top
;         fork has been notified
;Crashes: Unable to interrupt the top fork

;MOVE THE MESSAGE FROM THE MESSAGE QUEUE TO THE MESSAGE BUFFER

XFRTOP:	MOVE	S2,.LSMSG(LIS)		;PICK UP ADDRESS OF THE MESSAGE BUFFER
	$CALL	XFRMSG			;MOVE THE MESSAGE TO MESSAGE BUFFER

;INTERRUPT THE TOP FORK TO INDICATE THAT A MESSAGE IS AVAILABLE

	MOVEI	S1,.FHSUP		;PICK UP THE TOP FORK'S HANDLE
	MOVX	S2,<1B0>		;INTERRUPT IT ON THIS CHANNEL
	SETZM	.LSAVA(LIS)		;TOP FORK IS NOW BUSY
	IIC%				;INTERRUPT THE TOP FORK
	 ERJMP	[$CALL INLCRH		  ;INDICATE A CONTROLLED CRASH
		 JRST S..LCI ]		  ;CANNOT INTERRUPT THE TOP FORK

	$RET				;RETURN TO THE CALLER
	SUBTTL	XFRMSG - TRANSFER IPCF MESSAGE FROM ONE BUFFER TO ANOTHER

;This routine transfers an IPCF message from one buffer to another
;
;Call is: S1/ Address where the IPCF message is currently located
;         S2/ Address where the IPCF message is to be moved to
;Returns: Message has been transferred

XFRMSG:	HRL	S2,S1			;SOURCE,,DESTINATION
	LOAD	S1,.MSTYP(S1),MS.CNT	;PICK UP THE MESSAGE LENGTH
	ADD	S1,S2			;SIZE OF THE BLT + 1
	BLT	S2,-1(S1)		;TRANSFER THE MESSAGE
	$RET				;AND RETURN TO THE CALLER
	SUBTTL	INTMSG - PROCESS AN INTERRUPT MESSAGE FROM THE SENDER

;INTMSG is the DECnet interrupt message handler. The LPTSPL sender
;sends an interrupt message when a print request has been aborted, cancelled
;or requeued. The receipt of an interrupt message indicates to the listener
;to quit processing the current print request.
;
;Call is: Invoked by the interrupt system
;DEBRKs:  The listener's state has been reset

INTMSG:	$BGINT	1,			;SAVE THE PREVIOUS CONTEXT
	SETZM	.LSSTE(LIS)		;RESET THE STATE
	MOVE	S1,.LSJFN(LIS)		;PICK UP THE SRV: DEVICE JFN
	MOVX	S2,.MORIM		;PICK UP FUNCTION CODE
	MOVEI	T1,P1			;ADDRESS OF THE INTERRUPT MESSAGE
	HRLI	T1,(POINT 8)		;MAKE IT INTO A POINTER
	MTOPR%				;PICK UP THE INTERRUPT MESSAGE
	 ERJMP	INTMS2

	MOVE	S1,.LSJFN(LIS)		;PICK UP THE SRV: DEVICE JFN
	MOVX	S2,.MOSIM		;PICK UP FUNCTION CODE
	MOVEI	T1,P1			;ADDRESS OF THE INTERRUPT MESSAGE
	HRLI	T1,(POINT 8)		;MAKE IT INTO A POINTER
	MOVEI	T2,1			;PICK UP INTERRUPT MESSAGE LENGTH
	MTOPR%				;SEND RESPONSE TO INTERRUPT MESSAGE
	 ERJMP	INTMS2
	JRST	INTMS3			;GO RETURN TO PREVIOUS CONTEXT

INTMS2:	$CALL	LCKLNK			;CHECK THE STATUS OF THE LINK
	JUMPT	S..IFE			;DECNET I/O FATAL ERROR DETECTED
	MOVEI	S1,.LSPDL(LIS)		;[6002]SET UP THE LISTENER CONTEXT
	HRLI	S1,-<PDSIZ-1>		;[6002]STACK POINTER
	MOVEM	S1,.LSACS+P(LIS)	;[6002]SAVE AS THE NEW STACK POINTER
	MOVEI	S1,LISTE3		;[6002]WHERE TO RESUME EXECUTION FROM	
	TXO	S1,1B5			;[6002]
	MOVEM	S1,.LS1PC(LIS)		;[6002]STORE AS THE NEW PC

INTMS3:	$DEBRK				;RETURN TO THE PREVIOUS CONTEXT
	SUBTTL	CHKLST - CHECK LINK STATUS

;CHKLST is invoked by the top fork when it has detected that a node has
;left the cluster. This is necessary since if a node that a listener
;has a DECnet connection to crashes, the listener is not interrupted.
;(The listener is also not interrupted if the node should rejoin the
;cluster.) Since the listener is not interrupted and the link is no longer
;connected, no sender will now be able to communicate with the listener.
;CHKLST checks if its link is still connected. If it is not, then it resets
;the state of the listener and re-attempts to open the link.
;
;Call is: Invoked by the top fork
;DEBRKs:  The link status has been checked and the link re-opened if it was
;         no longer connected

CHKLST:	$BGINT	1,			;SAVE THE PREVIOUS CONTEXT
	$CALL	LCKLNK			;CHECK THE LINK STATUS
	JUMPT	CHKLS2			;THE LINK IS STILL CONNECTED SO RETURN
	SETZM	.LSSTE(LIS)		;RESET THE LISTENER'S STATE
	MOVEI	S1,.LSPDL(LIS)		;[6002]SET UP THE LISTENER CONTEXT
	HRLI	S1,-<PDSIZ-1>		;[6002]STACK POINTER
	MOVEM	S1,.LSACS+P(LIS)	;[6002]SAVE AS THE NEW STACK POINTER
	MOVEI	S1,LISTE3		;[6002]WHERE TO RESUME EXECUTION FROM	
	TXO	S1,1B5			;[6002]
	MOVEM	S1,.LS1PC(LIS)		;[6002]STORE AS THE NEW PC

CHKLS2:	$DEBRK				;RETURN TO THE PREVIOUS CONTEXT
	SUBTTL	ADDLME - ADD A LISTENER MESSAGE QUEUE ENTRY

;ADDLME is called to add a message to the listener's message queue. The
;message queue is a link list of the messages that need to be picked up
;by the top fork. The link list word is the checksum word (.MSCHS) since
;this word is no longer needed for checksum verification.
;
;Call is: LIS/Address of the listener block
;         S1/Address of the message queue entry
;Returns: The message has been added to the listener's message queue
;         S1/Address of the message page

;ADD THE MESSAGE TO THE LISTENER'S MESSAGE QUEUE

ADDLME:	SKIPG	S2,.LSTWD(LIS)		;IS THE MESSAGE QUEUE EMTPY?
	JRST	ADDLM2			;YES, ADD AS THE FIRST ENTRY
	MOVEM	S1,.MQBLK(S2)		;UPDATE CURRENT LAST MQ ENTRY
	SKIPA				;UPDATE THE TRAILER WORD
ADDLM2:	MOVEM	S1,.LSHWD(LIS)		;PLACE ADDRESS IN HEADER WORD
	MOVEM	S1,.LSTWD(LIS)		;PLACE ADDRESS IN TRAILER WORD
	$RET				;RETURN TO THE CALLER

REPEAT 0,<
	SUBTTL	LISCHK - LISTENER CHECKSUM MESSAGE

;LISCHK is called when the listener has picked up a message. If checksumming
;is enabled on the sender's node and the listener's node, then a checksum of
;the message is performed. If checksumming is disabled, either on the
;sender's node or the listener's node, then a checksum is not performed.
;
;Call is:       S1/Address of the message
;Returns true:  The checksums match or checksumming is not enabled
;Returns false: The checksums do not match
;Crashes:       Could not send the failure ACK

LISCHK:	$SAVE	<P1>			;SAVE THIS AC
	SKIPN	CHECKS			;CHECKSUMMING ENABLED ON LOCAL NODE?
	JRST	LISCH2			;NO, RETURN SUCCESS
	SKIPN	P1,.MSCHS(S1)		;YES, CHECKSUMMING ENABLED REMOTELY?
	JRST	LISCH2			;NO, RETURN SUCCESS
	SETZM	.MSCHS(S1)		;ZERO OUT THE CHECKSUM WORD
	$CALL	CHKSUM			;CALCULATE THE CHECKSUM
	CAME	P1,S1			;DO THE CHECKSUMS AGREE?
	$RETF				;NO, INDICATE TO THE CALLER
LISCH2:	$RETT				;INDICATE MESSAGE IS VALID
>
	SUBTTL	SNDACK - SEND A SUCCESS ACK TO THE SENDER

;SNDACK is called to send an ACK message to the sender upon completion
;of processing the NEXTJOB message.
;has a length of two.
;
;Call is        LIS/Address of the listener block
;Returns true:  The ACK message was sent
;Returns false: The ACK message could not be sent

SNDACK:	$SAVE	<T1,T2>			;SAVE THESE AC
	MOVE	S1,.LSJFN(LIS)		;PICK UP SRV: DEVICE JFN
	MOVEI	S2,T1			;ADDRESS OF THE MESSAGE
	HRLI	S2,(POINT 36,)		;MAKE IT INTO A POINTER
	SETO	T1,			;NEGATIVE LENGTH OF THE ACK MESSAGE
	SOUTR%				;SEND THE MESSAGE TO THE SENDER
	 ERJMP	.RETF			;INDICATE THE MESSAGE COULD NOT BE SENT
	$RETT				;RETURN TO THE CALLER
					
	SUBTTL	LCKLNK - CHECK THE STATUS OF THE LISTENER'S LINK

;LCKLNK is called to check the status of the listener's DECnet link to
;the sender. If there is no connection, then the DECnet link is
;closed and the DECnet JFN released
;
;Call is:       LIS/Address of the listener block
;Returns true:  The DECnet link is connected 
;Returns false: The DECnet link has been aborted
;Crashes:       Unable obtain the link status

LCKLNK:	$SAVE	<T1,T2>			;SAVE THESE AC, DESTROYED BY JSYS

;OBTAIN THE DECNET LINK STATUS.

	SKIPG	S1,.LSJFN(LIS)		;PICK UP THE DECNET JFN
	$RETF				;NO JFN, NO LINK
	MOVEI	S2,.MORLS		;WANT THE STATUS OF THE LINK
	MTOPR%				;OBTAIN THE STATUS OF THE LINK
	 ERJMP	LCKLN1			;ABORT THE LINK ON A FAILURE
	MOVEM	T1,.LSLNK(LIS)		;SAVE THE LINK STATUS IN LISTENER BLOCK

;DETERMINE IF THE LINK IS CONNECTED. IF IT IS NOT, THEN CLOSE AND RELEASE
;THE JFN.

	TXNE	T1,MO%CON		;IS THE LINK CONNECTED?
	$RETT				;YES, RETURN TRUE
LCKLN1:	$CALL	LABLNK			;CLOSE AND RELEASE THE JFN
	$RETF				;INDICATE DON'T HAVE A LINK
	SUBTTL	INLCRH - ROUTINE TO INDICATE LISTENER CONTROLLED CRASH

;INLCRH is called by the listener when it has detected a fatal error.
;INLCRH indicates in the listener's listener table entry's status
;word that the listener was aware it was going to crash. A RESET% is
;also performed to break the DECnet link.
;
;Call is: LIS/Address of the listener block
;Returns: Bit LT%LFC is set in the node entry's listener status word

;SET THE CONTROLLED LISTENER CRASH BIT IN THE NODE TABLE'S LISTENER STATUS WORD

INLCRH:	DMOVEM	S1,.LSERR(LIS)		;SAVE THE CONTEXT OF S1 AND S2
	MOVE	S1,.LSLTA(LIS)		;PICK UP THE LISTENER TABLE ENTRY
	MOVX	S2,LT%LFC		;PICK UP LISTENER FORK CRASHED BIT
	IORM	S2,.LTSTA(S1)		;INDICATE THAT THE LISTENER HAS CRASHED
	RESET%				;BREAK THE DECNET LINK
	DMOVE	S1,.LSERR(LIS)		;RESTORE CONTEXT OF S1 AND S2
	$RET				;RETURN TO THE CALLER
	SUBTTL	LABLNK - ABORT THE LISTENER'S DECNET LINK

;LABLNK is called to abort the listener's DECnet link by closing the
;DECnet link with ABORT and releasing its JFN if necessary.
;
;Call is: LIS/Address of the listener block
;Returns: The listener's DECnet link has been aborted

LABLNK:	$SAVE	<T1,T2>			;SAVE THESE AC, DESTROYED BY JSYS
	MOVE	S1,.LSJFN(LIS)		;PICK UP THE DECNET JFN
	TXO	S1,CZ%ABT		;CLOSE WITH ABORT
	CLOSF%				;CLOSE THE DECNET LINK
	 ERJMP	LABLN2			;SHOULDN'T HAPPEN
	JRST	LABLN3			;GO RETURN
LABLN2:	MOVE	S1,.LSJFN(LIS)		;PICK UP THE DECNET JFN AGAIN
	RLJFN%				;RELEASE THE JFN
	 ERJMP	.+1			;SHOULDN'T HAPPEN
LABLN3:	SETZM	.LSJFN(LIS)		;INDICATE NO LONGER HAVE A JFN
	$RET				;INDICATE DON'T HAVE A LINK
	SUBTTL	SENDER - MESSAGE ROUTER TO A REMOTE NODE

;SENDER exists as an inferior fork in LISSPL. A sender is started 
;whenever a message is received by QUASAR that is to be forwarded to
;a remote node in the cluster for which there is no current sender
;sending messages to it.
;A sender communicates with the top fork through software interrupts,
;the sender block and the sender table

;SYMBOL DEFINITIONS

MINTIM==5				;MIN TIME BETWEEN CONNECTION ATTEMPTS
MAXTIM==5*^D60				;MAX TIME BETWEEN CONNECTION ATTEMPTS

;INITIALIZATION BLOCK AND PID BLOCK

SIB:	$BUILD	IB.SZ			;
	  $SET	(IB.PRG,,%%.MOD)	;PROGRAM 'LISSPL'
	  $SET  (IB.FLG,IP.STP,1)	;STOPCODES TO ORION
	  $SET	(IB.PIB,,0)		;SET UP PIB ADDRESS
	$EOB				;

SPIB:	$BUILD	PB.MNS			;
	  $SET	(PB.HDR,PB.LEN,PB.MNS)	;PIB LENGTH,,0
	  $SET	(PB.FLG,IP.RSE,1)	;RETURN ON SEND ERROR
	  $SET	(PB.SYS,IP.BQT,-1)	;MAXIMUM SEND/RECEIVE IPCF QUOTA
	  $SET	(PB.SYS,IP.MNP,^D1)	;NUMBER OF PIDS
	$EOB				;

SNDCHN:	XWD	1,MSGTLI		;MESSAGE AVAILABLE TO SEND TO LISTENER
	XWD	1,MSGFLI		;ACK MESSAGE FROM LISTENER
	BLOCK	^D34			;NO OTHER CHANNELS IN USE

;SENDER STARTUP CONSISTS OF SETTING UP GLXLIB AND CAPABILITIES, THE
;INTERRUPT SYSTEM AND CONNECTING TO THE REMOTE NODE'S LISTENER.

SENDER:	SKIPE	DEBUGW			;DEBUGGING?
	$CALL	LISDDT			;YES, SET UP FOR DEGGBUGGING

	$CALL	SENSET			;SET UP GLXLIB AND CAPABILITIES
	$CALL	SENINT			;SET UP THE INTERRUPT SYSTEM
	$CALL	SOPLNK			;OPEN A CONNECTION TO THE LISTENER

;INFORM THE TOP FORK THAT READY TO SEND ANY MESSAGES TO THE LISTENER

	MOVEI	S1,.FHSUP		;PICK UP TOP FORK'S HANDLE
	MOVX	S2,<1B1>		;CHANNEL TO INTERRUPT TOP FORK ON
	SETOM	.SNFRE(SEN)		;INDICATE THAT SENDER IS AVAILABLE
	IIC%				;INTERRUPT THE TOP FORK
	 ERJMP	[$CALL INSCRH		  ;INDICATE A CONTROLLED CRASH
		 JRST S..SCI ]		  ;CAN'T INTERRUPT THE TOP FORK

SENDE2:	SETZ	S1,			;SLEEP UNTIL INTERRUPTED
	$CALL	I%SLP			;WAIT%

;AFTER EVERY INTERRUPT, SENDER IS FORCED OUT OF I%SLP. IF THE LINK'S
;CONNECTION IS BROKEN WHILE THE SENDER IS IN AN INTERRUPT, IT WILL NOT
;BE INTERRUPTED TO BE INFORMED OF THIS WHEN IT DEBRKS FROM THE INTERRUPT.
;IF SENDER IS NOT WAITING FOR AN ACK, THEN NOTHING NEEDS TO BE DONE.
;HOWEVER, IF SENDER IS WAITING FOR AN ACK, IT WILL NEVER RECEIVE IT.
;THEREFORE, IF THE SENDER IS WAITING FOR AN ACK, THEN CHECK THE LINK
;STATUS. IF THE LINK IS NO LONGER CONNECTED, THEN INDICATE TO THE TOP
;FORK THAT IT IS FREE TO PROCESS ANOTHER MESSAGE.

	SKIPGE	.SNFRE(SEN)		;WAITING FOR AN ACK FROM LISTENER?
	JRST	SENDE2			;NO, WAIT FOR TOP FORK SEND REQUEST
	$CALL	SCKLNK			;YES, CHECK THE LINK STATUS
	JUMPT	SENDE2			;LINK IS STILL CONNECTED, WAIT FOR ACK
	$CALL	SABLNK			;RELEASE THE DCN: DECNET JFN
	$CALL	CLRTIM			;CLEAR THE DECNET INACTIVITY TIMER
	MOVEI	S1,.FHSUP		;PICK UP TOP FORK'S HANDLE
	MOVX	S2,<1B1>		;CHANNEL TO INTERRUPT TOP FORK ON
	SETOM	.SNFRE(SEN)		;INDICATE THAT SENDER IS AVAILABLE
	IIC%				;INTERRUPT THE TOP FORK
	 ERJMP	[$CALL INSCRH		  ;INDICATE A CONTROLLED CRASH
		 JRST S..SCI ]		  ;CAN'T INTERRUPT THE TOP FORK
	JRST	SENDE2			;WAIT FOR SOMETHING ELSE TO DO
	SUBTTL	SENSET - INITIALIZE THE SENDER'S GLXLIB AND CAPABILITIES

;SENSET is called by the sender at sender startup. This routine sets up
;GLXLIB, the sender's capabilities and disables the sender from receiving
;any IPCF messages.
;
;Call is: SEN/Address of the sender block
;Returns: GLXLIB setup and capabilities enabled
;Crashes: Unable to set up capabilities

SENSET:	$SAVE	<T1,T2>			;SAVE THESE AC, DESTROYED BY JSYS

;SET UP THE GLXLIB INITIALIZATION BLOCK IN THE SENDER BLOCK

	MOVSI	S1,SIB			;PICK UP ADDRESS OF THE IB BLOCK
	HRRI	S1,.SNIBK(SEN)		;ADDRESS OF WHERE TO PLACE THE IB BLOCK
	MOVEI	S2,.SNIBK+IB.SZ(SEN)	;END ADDRESS + 1
	BLT	S1,-1(S2)		;MOVE THE IB BLOCK TO SENDER BLOCK
	MOVEI	S1,.SNPIB(SEN)		;PICK UP PIB BLOCK ADDRESS
	MOVEM	S1,.SNIBK+IB.PIB(SEN)	;PLACE IN THE IB BLOCK

	MOVSI	S1,.SNLEV(SEN)		;ADDRESS OF THE INTERRUPT LEVEL TABLE
	HRRI	S1,SNDCHN		;ADDRESS OF THE CHANNEL TABLE
	MOVEM	S1,.SNIBK+IB.INT(SEN)	;PLACE IN THE INITIALIZATION BLOCK

;SET UP THE PID BLOCK AND THE INTERRUPT LEVEL TABLE IN THE SENDER BLOCK

	MOVSI	S1,SPIB			;PICK UP ADDRESS OF THE PID BLOCK
	HRRI	S1,.SNPIB(SEN)		;DESTINATION IS IN THE SENDER BLOCK
	MOVEI	S2,.SNPIB+PB.MNS(SEN)	;END ADDRESS + 1
	BLT	S1,-1(S2)		;MOVE PID TABLE TO SENDER BLOCK

	MOVEI	S1,.SNLEV(SEN)		;PICK UP ADR OF INTERRUPT LEVEL TABLE
	MOVEI	S2,.SN1PC(SEN)		;PICK UP ADR OF FIRST PC WORD
	MOVEM	S2,0(S1)		;PLACE PC ADR IN INTERRUPT LEVEL TABLE
	AOS	S1			;POINT TO NEXT INTERRRUPT TABLE ENTRY
	AOS	S2			;POINT TO NEXT PC WORD
	MOVEM	S2,0(S1)		;PLACE PC ADR IN INTERRUPT LEVEL TABLE
	AOS	S1			;POINT TO NEXT INTERRRUPT TABLE ENTRY
	AOS	S2			;POINT TO NEXT PC WORD
	MOVEM	S2,0(S1)		;PLACE PC ADR IN INTERRUPT LEVEL TABLE

;SET UP GLXLIB

	MOVEI	S1,IB.SZ		;PICK UP SIZE OF THE INITIALIZATION BLK
	MOVEI	S2,.SNIBK(SEN)		;PICK UP ADR OF THE INITIALIZATION BLK
	$CALL	I%INIT			;INITIALIZE GLXLIB


;ENABLE THE SENDER'S CAPABILITIES TO BE THOSE OF THE TOP FORK AND GIVE IT
;THE CAPABILITY TO INTERRUPT THE TOP FORK.

	MOVX	S1,.FHSLF		;PICK UP THE SENDER'S HANDLE
	RPCAP%	
	 ERJMP	[$CALL INSCRH		  ;INDICATE A CONTROLLED CRASH
		 $STOP(SCC,Sender can't obtain capabilities) ]
	TXO	S2,SC%SUP		;CAPABILITY TO INTERRUPT TOP FORK
	MOVE	T1,S2			;ENABLE ALL CAPABILITIES
	MOVEI	S1,.FHSLF		;PICK UP THE SENDER'S HANDLE
	EPCAP%				;ENABLE THE CAPABILITIES
	 ERJMP	[$CALL INSCRH		  ;INDICATE A CONTROLLED CRASH
		 $STOP(SCE,Sender can't enable capabilities) ]

;DISABLE RECEIVING IPCF MESSAGES

	MOVEI	S1,.MUDIS		;DISABLE RECEIVING IPCF MESSAGES
	MOVEM	S1,.SNMUT(SEN)		;PLACE IN THE ARGUMENT BLOCK
	MOVE	S1,.SNPIB+PB.PID(SEN)	;PICK UP SENDER'S PID
	MOVEM	S1,.SNMUT+1(SEN)	;PLACE IN THE ARGUMENT BLOCK
	MOVEI	S1,2			;PICK UP SIZE OF ARGUMENT BLOCK
	MOVEI	S2,.SNMUT(SEN)		;PICK ADDRESS OF THE ARGUMENT BLOCK
	MUTIL%				;DISABLE RECEIVING IPCF MESSAGES
	 ERJMP	.+1			;SHOULDN'T HAPPEN, BUT DON'T CARE
	$RET				;RETURN TO STARTUP
	SUBTTL	SENINT - SET UP THE SENDER'S INTERRUPT SYSTEM

;SENINT is called by the sender during sender startup. SENINT sets up
;the sender's interrupt system.
;
;Call is: SEN/Address of the sender block
;Returns: The interrupt system has been set up
;Crashes: The interrupt system could not be set up


SENINT:	$SAVE	<T1,T2>			;SAVE THESE AC, DESTROYED BY JSYS

;FIRST DISABLE AND THEN CLEAR THE INTERRUPT SYSTEM

	MOVEI	S1,.FHSLF		;PICK UP THE SENDER'S HANDLE
	SETO	S2,			;INDICATE DISABLE ALL 36 CHANNELS
	DIC%				;DISABLE THE CHANNELS
	 ERJMP	.+1			;SHOULDN'T HAPPEN, BUT IGNORE
	CIS%				;CLEAR THE INTERRUPT SYSTEM
	 ERJMP	.+1			;SHOULDN'T HAPPEN, BUT IGNORE
	MOVEI	S1,.FHSLF		;PICK UP THE SENDER'S HANDLE
	HRLI	S2,.SNLEV(SEN)		;PICK UP INTERRUPT LEVEL TABLE ADDRESS
	HRRI	S2,SNDCHN		;PICK UP CHANNEL TABLE ADDRESS
	SIR%				;SET UP THE INTERRUPT TABLE ADDRESSES
	 ERJMP	SENIN2			;CRASH IF CAN'T SET UP 
	MOVEI	S1,.FHSLF		;PICK UP THE SENDER'S HANDLE
	EIR%				;ENABLE THE INTERRUPT SYSTEM
	 ERJMP	SENIN2			;CRASH IF CAN'T ENABLE INTERRUPT SYSTEM
	MOVEI	S1,.FHSLF		;PICK UP THE SENDER'S HANDLE
	MOVX	S2,1B0+1B1		;PICK UP CHANNELS TO ACTIVATE
	AIC%				;ACTIVATE THE CHANNELS
	 ERJMP	SENIN2			;CRASH IF CAN'T ACTIVATE THE CHANNELS
	$RET				;RETURN TO SENDER STARTUP

SENIN2:	$CALL	INSCRH			;INDICATE A CONTROLLED CRASH
	JRST	S..CSI			;CANNOT SET UP INTERRUPT SYSTEM
	SUBTTL	SOPLNK - OBTAIN A CONNECTION TO THE LISTENER

;SOPLNK is called during the sender's startup to open a DECnet connection
;to the remote node's listener. If a connection cannot be obtained, then
;SOPLNK will re-attempt to open the connection after a specified amount
;of time. Initially, the time between retries is MINTIM seconds. If
;after MAXTIM seconds a connection is still not obtained, then SOPLNK
;informs ORION. The time between retries is increased by MINTIM seconds
;and a connection is again attempted. This will continue until either
;a connection is obtained or until the time between retries is MAXTIM
;seconds. At this point, SOPLNK attempts to obtain a connection every
;MAXTIM seconds.
;
;Call is: SEN/Address of the sender block
;Returns: Only if the connection has been obtained
;Crashes: Unable to obtain a DECnet JFN or open the DECnet link

SOPLNK:	$SAVE	<T1,T2,T3,T4>		;SAVE THESE AC

;INITIALIZE THE ATTEMPT TO OBTAIN A DECNET CONNECTION TO THE LISTENER

	MOVEI	T3,MINTIM		;PICK UP INITIAL TIME BETWEEN RETRIES
	SETZ	T4,			;NUMBER OF ATTEMPTS TO OBTAIN THE LINK

;ATTEMPT TO OBTAIN THE DECNET CONNECTION. 

SOPLN2:	SKIPN	.SNJFN(SEN)		;CURRENTLY HAVE A DECNET JFN?
	$CALL	SGTLNK			;NO, OBTAIN ONE AND OPENF

;CHECK THE STATUS OF THE LINK. IF THERE IS A CONNECTION, THEN ENABLE
;FOR DATA AVAILABLE INTERRUPTS.

	$CALL	SCKLNK			;CHECK THE LINK STATUS
	JUMPF	SOPLN3			;DON'T HAVE A CONNECTION
	MOVE	S1,.SNJFN(SEN)		;PICK UP THE DECNET JFN
	MOVEI	S2,.MOACN		;PICK UP ACTIVATE FUNCTION
	MOVX	T1,<FLD(1,MO%DAV)+FLD(.MONCI,MO%CDN)+FLD(.MONCI,MO%INA)>
	MTOPR%				;ENABLE FOR DATA AVAILABLE INTERRUPTS
	 ERJMP	[ $CALL INSCRH		   ;INDICATE CONTROLLED CRASH
		  JRST S..CSI ]		   ;CAN'T ENABLE INTERRUPT SYSTEM
	$CALL	SETIM			;SET THE DECNET INACTIVITY TIMER
	$RET				;RETURN TO SENDER STARTUP

;UNABLE TO OBTAIN THE CONNECTION. DETERMINE IF THE RETRY SHOULD BE INCREASED.

SOPLN3:	AOS	T1,T4			;INCREMENT # TRIES AT THIS TIME INTERVAL
	IMUL	T1,T3			;TIME BEEN TRYING AT THIS TIME INTERVAL
	CAIGE	T1,MAXTIM		;TIME TO INCREMENT THE TIME INTERVAL?
	JRST	SOPLN6			;NO, DISMISS AND TRY AGAIN

;INCREMENT THE TIME BETWEEN RETRIES AND REPORT THE CONNECTION FAILURE.

	$CALL	FNDCER			;GET THE CONNECTION ERROR

	$LOG	(<Sender connection failure>,<^I/@SOPLN7/^M^J^I/@SOPLN8/>)

;CALCULATE THE NEW TIME INTERVAL BETWEEN CONNECTION ATTEMPTS. THE MAXIMUM
;TIME BETWEEN RETRIES IS MAXTIM SECONDS.

	ADDI	T3,MINTIM		;INCREMENT THE RETRY INTERVAL
	CAILE	T3,MAXTIM		;TIME INTERVAL AT A MAXIMUM?
	MOVEI	T3,MAXTIM		;YES, SET TO MAXIMUM

;DISMISS UNTIL INDICATED

	SETZ	T4,			;NUMBER OF ATTEMPTS AT THIS INTERVAL
SOPLN6:	MOVE	S1,T3			;PICK UP TIME TO DISMISS
	$CALL	I%SLP			;DISMISS OR WAIT% AS INDICATED
	JRST	SOPLN2			;ATTEMPT THE CONNECTION AGAIN

SOPLN7:	[ITEXT(<LISSPL Sender to node ^N/.SNNME(SEN)/ has not been able to obtain a DECnet connection>)] ;[6006]
SOPLN8:	[ITEXT(<Reason for failure: ^T/0(S1)/>)]
	SUBTTL	SGTLNK - OBTAIN DECNET JFN AND OPEN IT

;SGTLNK is called by routine SOPLNK to obtain a DECnet JFN to the remote
;node's listener and to open the connection
;
;Call is: SEN/Address of the sender block
;Returns: The JFN has been obtained and opened

SGTLNK:	$SAVE	<T1,T2>			;SAVE THESE AC, DESTROYED BY JSYS

;GET THE JFN AND OPEN IT

	MOVX	S1,GJ%SHT		;SHORT JFN
	HRROI	S2,.SNDCN(SEN)		;PICK UP DECNET DCN: DEVICE NAME
	GTJFN%				;PICK UP THE JFN
	 ERJMP	SGTLN2			;CRASH IF CAN'T GET JFN
	HRRZS	S1			;ISOLATE THE JFN
	MOVEM	S1,.SNJFN(SEN)		;SAVE THE JFN IN SENDER BLOCK

	MOVX	S2,<FLD(^D36,OF%BSZ)+OF%WR+OF%RD> ;OPEN FOR READ AND WRITE
	OPENF%				;OPEN THE JFN
	 ERJMP	SGTLN2			;CRASH IF CAN'T OPEN JFN
	$RET				;RETURN ON SUCCESS

SGTLN2:	$CALL	INSCRH			;INDICATE A CONTROLLED CRASH
	$STOP	(SOD, SENDER CAN'T OPEN DECNET DEVICE)
	SUBTTL	SCKLNK - CHECK THE STATUS OF THE SENDER'S LINK

;SCKLNK is called to check the status of the sender's DECnet link to
;the listener. If there is no connection, then the DECnet link is
;closed and the DECnet JFN released
;
;Call is:       SEN/Address of the sender block
;Returns true:  The DECnet link is connected 
;Returns false: The DECnet link is waiting for a connection or there is
;               no connection
;Crashes:       Unable to obtain the link status

SCKLNK:	$SAVE	<T1,T2>			;SAVE THESE AC, DESTROYED BY JSYS

;OBTAIN THE DECNET LINK STATUS.

	SKIPG	S1,.SNJFN(SEN)		;PICK UP THE DECNET JFN
	$RETF				;NO JFN, NO LINK
	MOVEI	S2,.MORLS		;WANT THE STATUS OF THE LINK
	MTOPR%				;OBTAIN THE STATUS OF THE LINK
	 ERJMP	SCKLN1			;ABORT THE LINK ON A FAILURE
	MOVEM	T1,.SNLNK(SEN)		;SAVE THE LINK STATUS IN SENDER BLOCK

;DETERMINE IF THE LINK IS CONNECTED. IF IT IS NOT, THEN CLOSE AND RELEASE
;THE JFN.

	TXNE	T1,MO%CON		;IS THE LINK CONNECTED?
	$RETT				;YES, RETURN TRUE
	TXNE	T1,MO%WCC		;WAITING FOR A LINK?
	$RETF				;YES, DON'T RELEASE THE JFN
SCKLN1:	$CALL	SABLNK			;CLOSE AND RELEASE THE JFN
	$RETF				;INDICATE DON'T HAVE A LINK
	SUBTTL	FNDCER - DETERMINE THE DECNET CONNECTION ERROR

;FNDCER is called when a sender has not been able to make a DECnet
;connection to its listener. FNDCER finds the error text using
;the error code returned by the .MORLS function.
;
;Call is:       SEN/Address of the sender block
;Returns true:  A known error occurred
;               S1/Address of the error string
;Returns false: An unknown error occurred
;               S1/Address of unknown error string

FNDCER:	$SAVE	<P1>			;SAVE THIS AC

;PICK UP THE ERROR STRING USING THE ERROR CODE RETURNED BY .MORLS

	HRRZ	S1,.SNLNK(SEN)		;PICK UP THE ERROR CODE
	MOVSI	S2,-DNELEN		;PICK UP NEGATIVE LENGTH OF TABLE
FNDCE2:	HLRZ	P1,DNERR(S2)		;PICK UP THE ERROR CODE
	CAME	S1,P1			;IS THIS THE ERROR?
	AOBJN	S2,FNDCE2		;NO, CHECK THE NEXT ENTRY
	SKIPL	S2			;WAS THE ENTRY FOUND?
	JRST	FNDCE3			;NO, MAKE UNKNOWN ERROR
	HRRZ	S1,DNERR(S2)		;PICK UP ADDRESS OF ERROR TEXT
	$RETT				;INDICATE A KNOWN ERROR
FNDCE3:	MOVEI	S1,[ASCIZ/Unknown DECnet error/] ;PICK UP ERROR ADDRESS
	$RETF				;INDICATE AN UNKNOWN ERROR
DNERR:

;THE DECNET DISCONNECT CODES.

	.DCX0,,[ASCIZ/Reject or disconnect by object/]
	.DCX1,,[ASCIZ/Resource allocation failure/]
	.DCX2,,[ASCIZ/Destination node does not exist/]
	.DCX3,,[ASCIZ/Remote node shutting down/]
	.DCX4,,[ASCIZ/Destination process does not exist/]
	.DCX5,,[ASCIZ/Invalid process name field/]
	.DCX6,,[ASCIZ/Object is busy/]
	.DCX7,,[ASCIZ/Unspecified error/]
	.DCX8,,[ASCIZ/Third party aborted link/]
	.DCX9,,[ASCIZ/User abort (asynchronous disconnect)/]
	.DCX10,,[ASCIZ/Invalid node name/]
	.DCX11,,[ASCIZ/Local node shut down/]
	.DCX21,,[ASCIZ/Connect initiate with illegal destination address/]
	.DCX22,,[ASCIZ/Connect confirm with illegal destination address/]
	.DCX23,,[ASCIZ/Connect initiate or connect confirm with zero source address/]
	.DCX24,,[ASCIZ/Flow control violation/]
	.DCX32,,[ASCIZ/Too many connections to node/]
	.DCX33,,[ASCIZ/Too many connections to destination process/]
	.DCX34,,[ASCIZ/Access not permitted/]
	.DCX35,,[ASCIZ/Logical link services mismatch/]
	.DCX36,,[ASCIZ/Invalid account/]
	.DCX37,,[ASCIZ/Segment size too small/]
	.DCX38,,[ASCIZ/No response from destination, process aborted/]
	.DCX39,,[ASCIZ/No path to destination node/]
	.DCX40,,[ASCIZ/Link aborted due to data loss/]
	.DCX41,,[ASCIZ/Destination process does not exist/]
	.DCX42,,[ASCIZ/Confirmation of disconnect initiate/]
	.DCX43,,[ASCIZ/Image data field too long/]

DNELEN==.-DNERR			;LENGTH OF ERROR TABLE
	SUBTTL	MSGTLI - SEND A MESSAGE TO THE LISTENER

;MSGTLI is the interrupt handler for sending a message to a listener.
;MSGTLI first checks that the link is still connected. If it is, then
;MSGTLI sends the message to the listener.
;
;Call is: SEN/Address of the sender block
;Returns: The message has been sent to the listener

MSGTLI:	$BGINT	1,			;SAVE THE CONTEXT

;CHECK THE LINK STATUS, IF THE LINK IF STILL CONNECTED, THEN SEND THE
;MESSAGE. IF THE LINK IS NO LONGER CONNECTED, THEN RE-OPEN THE LINK AND
;SEND THE MESSAGE.

	SKIPG	.SNMSG(SEN)		;IS THERE A DCN: DECNET JFN?
	$CALL	SOPLNK			;NO, RE-OPEN THE LINK
REPEAT 0,<
	MOVE	S1,.SNMSG(SEN)		;PICK UP THE MESSAGE ADDRESS
	SETZM	.MSCHS(S1)		;ASSUME CHECKSUMMING NOT ENABLED
	SKIPE	CHECKS			;IS CHECKSUMMING ENABLED?
	$CALL	CHKSUM			;YES, CHECKSUM THE MESSAGE
>
MSGTL2:	$CALL	SSNDMG			;SEND THE MESSAGE
	JUMPF	MSGTL3			;COULD NOT SEND THE MESSAGE

	$DEBRK				;RETURN TO PREVIOUS CONTEXT

;MESSAGE WAS NOT SENT. CHECK THE STATUS OF THE LINK. IF THE LINK IS STILL
;CONNECTED, THEN CONSIDER THE ERROR TO BE FATAL, ELSE RE-ATTEMPT TO OPEN
;THE LINK

MSGTL3:	$CALL	SCKLNK			;CHECK THE STATUS OF THE LINK
	JUMPT	MSGTL4			;LINK IS CONNECTED, FATAL ERROR
	$CALL	SOPLNK			;RE-CONNECT THE LINK
	JRST	MSGTL2			;RE-SEND THE MESSAGE
MSGTL4:	$CALL	INSCRH			;INDICATE CRASH IN NODE STATUS WORD 	
	JRST	S..IFE			;SENDER LOST ITS LINK

REPEAT 0,<
	SUBTTL	CHKSUM - CHECKSUM DECNET MESSAGES

;CHKSUM checksums messages that the sender sends to the listener.
;The checksum is stored in the checksum word. The listener, upon
;receipt of the message, also checksums it. If the checksums do
;not agree, then the listener sends a failure ACK back to the sender.
;If the checksums agree, then the sender will send a success ACK  to
;the sender.
;If the sender's node does not have checksumming enabled, then the
;sender sends a zero as the checksum value. The listener, in this
;case, always returns a success ACK.
;If the listener's node does not have checksumming enabled, then it
;always sends a success ACK back.
;(Note: 1. If the calculated checksum equals zero, then CHKSUM changes
;          it to -1.)
;       2. The checksum word .MSCHS is always zeroed before the checksum
;          calculation is done.
;
;Call is: S1/Address of the message
;Returns: The checksum has been calculated and placed in the message
;         checksum word (.MSCHS).
;         S1/Contains the checksum

CHKSUM:	$SAVE	<P1>			;SAVE THIS AC

;INITIALIZE THE CHECKSUM PARAMETERS

	LOAD	S2,.MSTYP(S1),MS.CNT	;PICK UP LENGTH OF THE MESSAGE
	MOVSS	S2			;PLACE LENGTH FOR AOBJN
	MOVNS	S2			;MAKE THE COUNTER
	HRR	S2,S1			;COMPLETE THE AOBJN COUNTER
	SETZ	P1,			;SET CHECKSUM TO ZERO
	JCRY0	.+1			;CLEAR THE CARRY 0 BIT

;COMPUTE THE CHECKSUM

COMCH1:	ADD	P1,0(S2)		;ADD THE NEXT MESSAGE WORD TO CHECKSUM
	JCRY0	[AOJA P1,.+1]		;ADD ONE IF CARRY 0 BIT IS SET
	AOBJN	S2,COMCH1		;GO ADD IN THE NEXT MESSAGE WORD

;IF CHECKSUM IS 0, THEN MAKE -1

	SKIPN	P1			;IF CHECKSUM NOT 0, THEN FINISHED
	SETO	P1,			;MAKE THE CHECKSUM -1
	MOVEM	P1,.MSCHS(S1)		;PLACE CHECKSUM IN THE MESSAGE
	MOVE	S1,P1			;PLACE CHECKSUM IN RETURN AC
	$RET				;RETURN TO THE CALLER
>
	SUBTTL	MSGFLI - PICKUP ACK MESSAGE FROM THE LISTENER

;MSGFLI is the interrupt handler for ACK messages from the listener.
;
;Call is: SEN/Address of the sender block
;Returns: The ACK message has been processed

MSGFLI:	$BGINT	1,			;SAVE THE CONTEXT

;CHECK IF AN ACK MESSAGE IS AVAILABLE OR IF THIS IS JUST A SPURIOUS INTERRUPT.

	MOVE	S1,.SNJFN(SEN)		;PICK UP THE DECNET JFN
	SIBE%				;IS THERE AN ACK MESSAGE?
	JRST	MSGFL1			;YES, PICK IT UP
	$CALL	SCKLNK			;NO, CHECK THE LINK STATUS
	JUMPT	MSGFL4			;STILL CONNECTED, SO SPURIOUS
	$CALL	CLRTIM			;CLEAR THE TIMER
	JRST	MSGFL3			;LOST THE LINK, INFORM TOP FORK READY

;PICK UP THE ACK MESSAGE

MSGFL1:	MOVE	S1,.SNJFN(SEN)		;PICK UP THE DECNET JFN
	MOVE	S2,.SNMSG(SEN)		;PICK UP ADDRESS OF MESSAGE
	HRLI	S2,(POINT 36,)		;MAKE INTO A POINTER
	MOVNI	T1,PAGSIZ		;PICK UP SIZE OF MESSAGE
	SINR%				;PICK UP THE ACK MESSAGE
	 ERJMP	MSGFL2			;ON AN ERROR, ABORT THE LINK
	$CALL	CASTIM			;CLEAR AND SET THE TIMER
	JRST	MSGFL3			;INFORM TOP FORK FREE TO SEND

MSGFL2:	$CALL	CLRTIM			;CLEAR THE TIMER
	$CALL	SABLNK			;ABORT THE LINK

MSGFL3:	MOVEI	S1,.FHSUP		;PICK UP TOP FORK'S HANDLE
	MOVX	S2,<1B1>		;CHANNEL TO INTERRUPT TOP FORK ON
	SETOM	.SNFRE(SEN)		;INDICATE THAT SENDER IS AVAILABLE
	IIC%				;INTERRUPT THE TOP FORK
	 ERJMP	[$CALL INSCRH		  ;INDICATE A CONTROLLED CRASH
		 JRST S..SCI ]		  ;CAN'T INTERRUPT THE TOP FORK
MSGFL4:	$DEBRK				;RETURN TO THE PREVIOUS CONTEXT
	SUBTTL	SSNDMG - SEND A MESSAGE TO A LISTENER

;SSNDMG is called to send a message to the listener. It sets up the SOUTR%
;call and sends the message.
;Call is:       SEN/Address of the sender block
;Returns true:  The message was sent to the listener
;Returns false: The message could not be sent to the listener

SSNDMG:	$SAVE	<T1,T2>			;SAVE THESE AC, DESTROYED BY JSYS

;SET UP THE AC TO THE SOUTR% JSYS.

	MOVE	S1,.SNJFN(SEN)		;PICK UP THE DECNET JFN
	MOVE	S2,.SNMSG(SEN)		;PICK UP THE ADDRESS OF THE MESSAGE
	HRLI	S2,(POINT 36,)		;MAKE IT INTO A POINTER
	LOAD	T1,.MSTYP(S2),MS.CNT	;PICK UP THE LENGTH OF THE MESSAGE

;SEND THE MESSAGE

SSNDM2:	MOVNS	T1			;MAKE THE MESSAGE LENGTH NEGATIVE
	SOUTR%				;SEND THE MESSAGE
	 ERJMP	.RETF			;INDICATE COULD NOT SEND THE MESSAGE
	$RETT				;INDICATE MESSAGE WAS SENT
	SUBTTL	PROTIM - DECNET INACTIVITY TIMER PROCESSOR

;PROTIM is the "interrupt handler" for the DECnet inactivity timer.
;PROTIM is invoked when the DECnet inactivity timer goes off. 
;PROTIM aborts the DECnet link if there is no active request.
;
;CALL is: No arguments
;Returns: The DECnet link has been aborted

PROTIM:	SKIPN	.SNFRE(SEN)		;IS A MESSAGE BEING PROCESSED?
	$RET				;YES, DON'T ABORT THE LINK
	$CALL	SABLNK			;ABORT THE LINK
	$RET				;RETURN TO I%SLP
	SUBTTL	CASTIM - CLEAR AND RESET THE DECNET INACTIVITY TIMER

;CASTIM is called to clear and reset the DECnet inactivity timer. After
;a RELEASE message has been sent to Cluster LPTSPL, the timer is cleared
;and reset. If no other RELEASE messages are received before the timer
;goes off, then the link is aborted.
;
;Call is: SEN/Address of the sender block
;Returns: The DECnet inactivity timer has been cleared and reset

CASTIM:	$CALL	CLRTIM			;CLEAR THE TIMER
SETIM:	$CALL	I%NOW			;PICK UP THE CURRENT TIME
	SKIPN	DEBUGW			;[6004]DEBUGGING?
	ADDI	S1,TIMITL		;[6004]NO, TIME THE TIMER WILL GO OFF
	SKIPE	DEBUGW			;[6004]DEBUGGING?
	ADDI	S1,777777		;[6004]YES, INCREASE THE TIMER VALUE
	MOVEM	S1,.TITIM+.SNTET(SEN)	;PLACE IN THE TIME EVENT BLOCK
	MOVEI	S1,.TIMDT		;PICK UP THE TIMER FUNCTION
	MOVEM	S1,.TIFNC+.SNTET(SEN)	;PLACE IN THE TIME EVENT BLOCK
	MOVEI	S1,PROTIM		;PICK UP THE TIMER PROCESSING ROUTINE
	MOVEM	S1,.TIMPC+.SNTET(SEN)	;PLACE IN THE TIME EVENT BLOCK
	MOVEI	S1,.TIMPC+1		;PICK UP LENGTH OF TIME EVENT BLOCK
	MOVEI	S2,.SNTET(SEN)		;PICK UP ADDRESS OF TIME EVENT BLOCK
	$CALL	I%TIMR			;SET THE TIMER
	$RET				;RETURN TO THE CALLER
	SUBTTL	CLRTIM - CLEAR THE DECNET INACTIVITY TIMER

;CLRTIM is called to clear the DECnet inactivity timer.
;
;Call is: SEN/Address of the sender block
;Returns: The DECnet inactivity timer has been cleared

CLRTIM:	MOVEI	S1,.TIMDD		;PICK UP THE FUNCTION
	MOVEM	S1,.TIFNC+.SNTET(SEN)	;PLACE IN THE TIME EVENT BLOCK
	MOVEI	S1,.TITIM+1		;PICK UP LENGTH OF TIME EVENT BLOCK
	MOVEI	S2,.SNTET(SEN)		;PICK UP ADDRESS OF TIME EVENT BLOCK
	$CALL	I%TIMR			;CLEAR THE TIMER
	$RET				;RETURN TO THE CALLER
	SUBTTL	SABLNK - ABORT THE SENDER'S DECNET LINK

;SABLNK is called to abort the sender's DECnet link by closing the DECnet link
;with ABORT and releasing its JFN if necessary.
;
;Call is: SEN/Address of the sender block
;Returns: The sender's DECnet link has been aborted

SABLNK:	$SAVE	<T1,T2>			;SAVE THESE AC, DESTROYED BY JSYS
	MOVE	S1,.SNJFN(SEN)		;PICK UP THE DECNET JFN
	TXO	S1,CZ%ABT		;CLOSE WITH ABORT
	CLOSF%				;CLOSE THE DECNET LINK
	 ERJMP	SABLN2			;SHOULDN'T HAPPEN
	JRST	SABLN3			;GO RETURN
SABLN2:	MOVE	S1,.SNJFN(SEN)		;PICK UP THE DECNET JFN AGAIN
	RLJFN%				;RELEASE THE JFN
	 ERJMP	.+1			;SHOULDN'T HAPPEN
SABLN3:	SETZM	.SNJFN(SEN)		;INDICATE NO LONGER HAVE A JFN
	$RET				;INDICATE DON'T HAVE A LINK
	SUBTTL	INSCRH - ROUTINE TO INDICATE SENDER CONTROLLED CRASH

;INSCRH is called by the sender when it has detected a fatal error.
;INSCRH indicates in the sender's sender table entry's status word
;that the sender was aware it was going to crash. A RESET% is
;also performed to break the DECnet link.
;
;Call is: SEN/Address of the sender block
;Returns: Bit ST%SFC is set in the sender's sender table entry's status word

;SET THE CONTROLLED SENDER CRASH BIT IN THE NODE TABLE'S SENDER STATUS WORD

INSCRH:	DMOVEM	S1,.SNERR(SEN)		;SAVE THE CONTEXT OF S1 AND S2
	MOVE	S1,.SNSTA(SEN)		;PICK UP THE NODE TABLE ENTRY
	MOVX	S2,ST%SFC		;PICK UP SENDER FORK CRASHED BIT
	IORM	S2,.STSTS(S1)		;INDICATE THAT THE SENDER HAS CRASHED
	RESET%				;BREAK THE DECNET LINK
	DMOVE	S1,.SNERR(SEN)		;RESTORE CONTEXT OF S1 AND S2
	$RET				;RETURN TO THE CALLER
					
	SUBTTL	LISDDT - ROUTINE TO LOAD DDT IF DEBUGGING

;LISDDT is called if LISSPL is running in a DEBUG environment.
;LISDDT maps in and starts DDT
;
;Call is: No arguments
;Returns: DDT has been loaded
;Crashes: If unable to load DDT


LISDDT:	$SAVE	<T1,T2>			;SAVE THESE AC, DESTROYED BY JSYS
	MOVX	S1,GJ%OLD+GJ%SHT	;OLD FILE+SHORT JFN
	HRROI	S2,[ASCIZ/SYS:SDDT.EXE/] ;POINT TO DDT
	GTJFN%				;GET DDT'S JFN
	 ERJMP	LISDD2			;CRASH IF CAN'T GET DDT'S JFN
	HRLI	S1,.FHSLF		;PICK UP HANDLE
	GET%				;LOAD DDT
	 ERJMP	LISDD2			;CRASH IF CAN'T LOAD DDT
	MOVE	S1,116			;GET CONTENTS OF .JBSYM
	HRRZ	S2,770001		;GET ADDRESS OF WHERE TO PUT IT
	MOVEM	S1,0(S2)		;POINT DDT AT LISSPL'S SYMBOL TABLE
	JRST	770000			;AND ENTER DDT
GO:	$RET				;RETURN

LISDD2:	$STOP	(DDE, DDT ERROR)	;CRASH, IF CAN'T GET DDT
	SUBTTL	GETPAG - GET A PAGE FOR OUTGOING IPCF MESSAGE

;GETPAG obtains a page from the memory manager to be used to build an
;outgoing IPCF message.
;
;Call is: No arguments
;Returns: MO/ Address of the page for the outgoing IPCF message

GETPAG:	$CALL	M%GPAG			;PICK UP THE PAGE
	MOVE	MO,S1			;PLACE THE ADDRESS IN MO
	$RET				;RETURN TO THE CALLER

	SUBTTL	RELPAG - RELEASE OUTGOING IPCF PAGE

;This routine releases a page back to the memory manager in the event
;that the IPCF send of a message failed.
;
;Call is: MO/ Address of outgoing IPCF message page
;Returns: The page has been returned to the memory manager

RELPAG:	MOVE	S1,MO			;PICK UP THE MESSAGE ADDRESS
	$CALL	M%RPAG			;RELEASE THE PAGE
	SETZ	MO,			;TO AVOID CONFUSION
	$RET				;RETURN TO THE CALLER
	SUBTTL	COMMON STOPCODES

;These STOPCODES are called from more than one location in LISSPL's 
;top fork.

	$STOP	(CTL, CLUSTER TOO LARGE)
	$STOP	(CSI, CAN'T SETUP INTERRUPT SYSTEM)
	$STOP	(SIF, SCS% INTERRUPT HANDLER ENCOUNTERED FATAL ERROR)
	$STOP	(SCI, SENDER CAN'T INTERRUPT THE TOP FORK)
	$STOP	(LCI, LISTENER CAN'T INTERRUPT THE TOP FORK)
	$STOP	(COL, CAN'T OBTAIN THE LINK STATUS) 
	$STOP	(LUP, LISTENER UNABLE TO PICK UP DECNET MESSAGE)
	$STOP	(IFE, DECNET I/O FATAL ERROR)
	$STOP	(IFM, ILLEGALLY FORMATTED MESSAGE)
	$STOP	(COD, CAN'T SETUP DEBUGGING DECNET DEVICE NAME)	;[6003]

;AN INFERIOR FORK WAS NOT INTERRUPTED. THIS CAN ONLY HAPPEN IF THE
;PROCESS HANDLE IS INVALID (ERROR FRKHX1). THIS IN TURN CAN ONLY HAPPEN
;IF THE INFERIOR FORK WAS KILLED (KFORK%) OR THE SENDER BLOCK OR LISTENER
;BLOCK HAS BEEN CORRUPTED. BOTH OF THESE POSSIBILITIES IMPLY THAT LISSPL
;IS IN AN INCONSISTENT STATE AND SHOULD THEREFORE BE CRASHED.

	$STOP	(UII, UNABLE TO INTERRUPT AN INFERIOR FORK)

	END LISSPL