Trailing-Edge
-
PDP-10 Archives
-
BB-LW55A-BM_1988
-
galaxy-sources/lisspl.mac
There are 11 other files named lisspl.mac 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==:0 ;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.
\ ;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
$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