Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-09 - decus/20-181/rmtspl.mac
There are no other files named rmtspl.mac in the archive.
TITLE	RMTSPL	Network spool listener 
SUBTTL	Scott McClure/ESI 	20-AUG-84

	SEARCH	GLXMAC			    ;Get Galaxy symbols
IFE DEBUG,<				    ;[5]
	PROLOG	(RMTSPL)
>
IFN DEBUG,<				    ;[5]
	PROLOG	(TSTSPL)
>

	SEARCH	QSRMAC			    ;Get quasars symbols

COMMENT $

Abstract:	RMTSPL (REMote SPooLer) is the passive portion of a
	two part system designed to make up for a deficiency in
	DECNET.  When both RMTSPL and RMTQUE (on another DEC20) are
	running it is possible to print from one to the other.  RMTSPL
	awakes upon a connect inturrept from RMTQUE and accepts a
	master queue entry message, a file and an end of file message.
	Acknowledging each of these, it modifies the queue entry to
	come from a generic area (PS:<REMOTE>) and user (REMOTE) and
	sends the otherwise unaltered queue entry to QUASAR.  The file
	is always delete when printed.  If there is any non fatal
	problem in recieving the file, a NAK is sent and RMTQUE will
	simply try again on its next pass.

Limitations:	See RMTQUE.MAC
$

;VERSION AND EDIT INFORMATION

	SPLMAJ==1			    ;MAJOR VERSION
	SPLMIN==0			    ;MINOR VERSION
	SPLEDT==7			    ;EDIT LEVEL
	SPLWHO==2			    ;WHO DID LAST EDIT 2-CUST

;ENTRY VECTOR DEFINITION

SPLVEC:	JRST	RMTSPL			    ;ENTER HERE
	JRST	RMTSPL			    ;REENTER SAME
SPLVER:	BYTE	(3)SPLWHO(9)SPLMAJ(6)SPLMIN(18)SPLEDT
	EVECL==.-SPLVEC

;DEBUG SWITCH[5]
	DEBUG==0
SUBTTL	Table of contents

;			TABLE OF CONTENTS FORM RMTSPL
;
;		SECTION						PAGE
;		-------						----
;	1.  Table of contents...................................   2	
;	2.  Revision History....................................   3
;	3.  Accumulators and Constants..........................   4
;	4.  Local macros........................................   5
;	5.  Quasar argument blocks..............................   6
;	6.  Main entry point and initialization.................   7
;	7.  SERVER Listening loop...............................   8
;	8.  ACPDAT Accept data from logical link................   9
;	9.  QEPAGE Process queue entry page to make it local....  10
;      10.  QEFILN Build new queue entry file name..............  11
;      11.  SNDIQE Send IPCF Queue Entry Message To QUASAR......  12
;      12.  GLLINK Get the logical link for the server..........  13
;      13.  LLWCON Routine to wait for link connection..........  14
;      14.  LLCLOS Routine to close or abort a logical link.....  15
;      15.  LLCHK  Check status of logical link.................  16
;      16.  OPNOUT Open the output file.........................  17
;      17.  FINOUT Finish off the output file...................  17
;      18.  RELJFN Quicky routine to release all non-open JFNS..  18
;      19.  CPYSTR Quicky routine to copy asciz text............  18
;      20.  SNDINT Send interrupt message to caller.............  19
;      21.  ENABLE/DISABL Routine to set or clear capabilities for server 19
;      22.  PSIINI Software interrupt system initialization.....  20
;      23.  Interrupt service routines..........................  20
;      24.  CDNACK Acknowledge CONNECT/DISCONNECT message.......  21
;      25.  Table of NSP disconnect reasons.....................  22
;      26.  Literals............................................  23
;      27.  Interrupt tables....................................  24
;      28.  IMPURE Storage......................................  25
SUBTTL	Revision History

COMMENT $

EDIT	DATE		WHO		WHY
====	========	===		===============================
1	08/20/84	SDM		First installed in development area.
2	08/29/84	SDM		Release output jfn if we still have
					it after closing the link.
3	08/29/84	SDM		If file not found by sender, it will
					indicate with -1 in file size.  If
					so, just release - don't close.  Go
					ahead and queue and let LPTSPL tell
					user the file is missing.
4	05/06/85	DLP		Change file eof protocol to get the
					# of pages, # bytes and byte size from
					the buffer area. Use # bytes and byte
					size to update the FDB. This will
					prevent file from ending in nulls and
					will prevent 6.0 LPTSPL from sending
					an OPR message for non-printable chars.
5	05/06/85	DLP		Add a debug switch to allow test a test
					version to run independently of the
					production version. TSTSPL will be
					the server for TSTQUE.
6	06/04/85	DLP		Implement multiple file tranfer
					according to # files in queue entry
7	06/11/85	DLP		The network connection gets stuck in
					aborted status. Fix LLCHK to return
					the aborted flag in S1 so it can be
					tested for and the link closed. in
					LISTE3.
$
SUBTTL	Accumulators and Constants


; ACCUMULATOR DEFINITIONS


	P5==13				    ;EXTRA PERMANENT AC
	M==14				    ;IPCF message address
	J==15				    ;JOB CONTEXT ADDRESS

;Constants

	XP	PDLEN,^D200		    ;Size of the stack
	XP	FILNML,20		    ;Maximum size of a file name
	XP	CHKLEN,.CKAUD+1		    ;Length of CHKAC arg block
	XP	TRNSIZ,1100		    ;SIZE OF TRANSFER BUFFER
	XP	RECCNT,4404		    ;NUMBER OF BYTES TO RECEIVE
					    ;4400 FOR DATA, 4 FOR HEADER
	XP	OWNPNT,[ASCIZ/REMOTE/]	    ;OWNER OF NEW REQUEST

;Interrupt channel assignments

	XP	.ICIPC,0		    ;IPCF channel
	XP	.ICDAV,1		    ;Data available
	XP	.ICCDN,2		    ;Connect/Disconnect
	XP	.ICINA,3		    ;Interrupt message


;INTERRUPT MESSAGE NUMBERS

;OUTGOING - STORE IN FIRST 8 BITS

	.QEREC==FLD(1,7B7)		    ;SAY WE SAY SAW QE
	.FIREC==FLD(2,77B7)		    ;OR A FILE
	.FINAK==FLD(3,77B7)		    ;NEG ACK - SOMETHING WRONG
	.MESOF==MASKB(0,7)		    ;TURN THEM ALL OFF

;INCOMING - ALREADY UNLOADED

	.NOFIL==FLD(177777,777777B35)	    ;FILE NOT FOUND BY QUEUE
SUBTTL	Local macros

DEFINE TXT(TEXT) <POINT 7,[ASCIZ\TEXT\]>

DEFINE	$FATAL	(MSG,ITXT,%L1) <
	HRRZ	P1,(P)
	SUBI	P1,2
	$CALL	[$TEXT (,<?^W/.SPRGM## /^A>)
		 $TEXT (,<^Q/ %L1/ITXT ^A>)
		 $TEXT (,<at ^O/P1/>)
		 HALTF%
		 PJRST .-1
	%L1:!	 TXT<MSG>]
	SUPPRESS %L1
> ;End of $FATAL
SUBTTL	Quasar argument blocks

SPLIB:	$BUILD	(IB.SZ)
	  $SET	(IB.PRG,,%%.MOD)	    ;Program name is RMTSPL
	  $SET	(IB.OUT,,T%TTY)		    ;Default output routine
	  $SET	(IB.INT,,<LEVTAB,,CHNTAB>)  ;Point to PSI stuff
	  $SET	(IB.PIB,,SPLPIB)	    ;Point to IPCF stuff
	$EOB

SPLPIB:	$BUILD	(PB.MXS)		    ;Pid info
	  $SET	(PB.HDR,PB.LEN,PB.MXS)	    ;Length
	  $SET	(PB.INT,IP.CHN,.ICIPC)	    ;IPCF channel
	  $SET	(PB.FLG,IP.PSI,1)	    ;Use PSI for IPCF
	  $SET	(PB.SYS,IP.MNP,1)	    ;Number of pids required
	  $SET	(PB.NAM,,<POINT 7,SRVOBJ>)
	$EOB

SPLSAB:	$BUILD	(SAB.SZ)		    ;IPCF SEND ARG BLOCK
	  $SET	(SAB.LN,,1000)		    ;PAGE-MODE SEND
	  $SET	(SAB.SI,SI.FLG,1)	    ;USE SI.IDX
	  $SET	(SAB.SI,SI.IDX,SP.QSR)	    ;USE QUASAR INDEX
	$EOB
SUBTTL	Main entry point and initialization

RMTSPL:	RESET				    ;Clean up from last start
	MOVE 	P,[IOWD PDLEN,PDL]	    ;SET UP STACK
	SETZM	DATORG			    ;Clear impure storage
	MOVE	S1,[DATORG,,DATORG+1]
	BLT	S1,DATEND-1
	HRROI	S1,SRVTSK		    ;Point to my object name
IFE DEBUG,<MOVX	S2,TXT(RMTSPL)>		    ;[5]
IFN DEBUG,<MOVX	S2,TXT(TSTSPL)>		    ;[5]
	$CALL	CPYSTR			    ;Store the name
	MOVEI	S1,IB.SZ
	MOVEI	S2,SPLIB		    ;POINT TO IB
	$CALL	I%INIT			    ;GET THE LIBRARY
	HRROI	S1,[ASCIZ/DCN:/]
	STDEV%
	 ERCAL	[$FATAL (No network support)]
	$CALL	PSIINI			    ;INITIALIZE PSI SYSTEM
	MOVEI	S1,.NDGLN		    ;GET LOCAL NODE NAME
	MOVEI	S2,T1			    ;T1 IS ARG BLOCK
	MOVE	T1,[POINT 7, LOCNOD]	    ;POINT TO NAME STORAGE
	MOVE	T2,T1			    ;COPY POINTER
	NODE%				    ;GET IT!
	 ERCAL	DIE			    ;OR DIE - NEED IT TOO.
	MOVE	T1,T2			    ;RESTORE POINTER
	MOVE	T2,[POINT 6, LOCNOD]	    ;AND MAKE A SIXBIT COPY
RMTSP1:	ILDB	S1,T1			    ;GET CHAR
	CAIG	S1,0			    ;DONE?
	JRST	RMTSP2			    ;CLEAN UP
	SUBI	S1,40			    ;MAKE IT SIXBIT
	IDPB	S1,T2			    ;STORE IT AWAY
	JRST	RMTSP1			    ;DO SOME MORE
RMTSP2:	IDPB	S1,T2			    ;STORE THE ZERO
	$CALL	M%GPAG			    ;NOW GET TRANSLATE BUFFER
	MOVEM	S1,TRNADR		    ;AND SAVE THAT
					    ;FALL ON THROUGH
SUBTTL	SERVER Listening loop


LISTEN:	MOVEI	S1,SRVSIZ		    ;Get size of server data
	MOVEI	S2,SRVBEG		    ;Get start of area to clear
	$CALL	.ZCHNK			    ;Clear it
	$CALL	GLLINK			    ;Open link
	JUMPF	LISTE5			    ;Close our end on failure
	TXNE	T1,MO%WFC		    ;WAITING FOR CONN?
	$CALL	LLWCON			    ;YES, GO WAIT IT OUT.
LISTE1:	$CALL	RELJFN			    ;Release unopen JFNS
	MOVEI	T1,5			    ;RETRY TIMES
	MOVE	S1,LLJFN		    ;GET LINK JFN
	SIBE%				    ;AND CHECK IT FOR DATA
	$CALL	ACPDAT			    ;ACCEPT DATA FROM LINK
	JUMPF	LISTE3			    ;Check link status on failure
LISTE2:	MOVEI	S1,^D20			    ;Wait twenty seconds
	$CALL	I%SLP
LISTE3:	$CALL	LLCHK			    ;CHECK LINK STATUS
	SKIPE	MSGFLG			    ;Message available?
	JUMPT	LISTE1			    ;Yes..go process it
	TXNN	S1,MO%SYN!MO%ABT	    ;Disconnected or aborted?
	TXNN	S1,MO%CON		    ; and still connected?
	JRST	LISTE5			    ;No..close our end
	TXNE	S1,MO%EOM		    ;Have a message available?
	JRST	LISTE1			    ;Yes..process it
	SOJG	T1,LISTE2		    ;No..try again
LISTE5:	$CALL	LLCLOS			    ;AND GO CLOSE IT
	SKIPE	OUTJFN			    ;IF I STILL HAVE JFN[2]
	$CALL	CLSJFN			    ;ABORT THE JFN[2]
	SETZM	OUTJFN			    ;CLEAR IT REGARDLESS[2]
	JRST	LISTEN			    ;Wait for new connection
SUBTTL	ACPDAT	Accept data from logical link

;Once a connection is made this becomes the main dispatching routine.
;It calls other routines based on the function code passed from
;RMTQUE.


ACPDAT:	$SAVE	<T1>			    ;SAVE FOR LISTEN
	MOVE	S2,TRNADR		    ;GET OF TRANSFER PAGE
	MOVEI	S1,1000			    ;CLEAR SINGLE PAGE
	$CALL	.ZCHNK			    ;CLEAR THIS AREA
	MOVEI	S1,TRNSIZ+1		    ;NEXT, SIZE OF TRANS AREA
	MOVEI	S2,MSGWRD		    ;STARTS WITH HEADER WORD
	$CALL	.ZCHNK			    ;ZERO THIS TOO.
	MOVE	S1,LLJFN		    ;GET INBOUND JFN
	MOVE	S2,[POINT 8,TRNBUF]	    ;POINTER TO MESSAGE AREA
	MOVEM	S2,TRNPNT		    ;STORE FOR GETBCT
	MOVE	S2,[POINT 8,MSGWRD]	    ;NOW POINT TO START OF BUFFER
	MOVNI	T1,RECCNT		    ;MAX COUNT TO RECEIVE
	SINR%				    ;GET IT
	 ERCAL	DIE			    ;FATAL OUT ON SINR ERROR
	MOVE	P1,TRNADR		    ;LOOK AT CLEAR PAGE
	HRLI	P1,-1000		    ;COUNT OUT A PAGE
ACPDA1:	MOVEI	S2,^D36			    ;WANT TO MAKE IT 36 BIT
	$CALL	GETBCT			    ;GET A BYTE (WORD)
	MOVEM	S1,0(P1)		    ;PUT IT AWAY
	AOBJN	P1,ACPDA1		    ;DO THE PAGE
ACPDA2:	MOVE	T1,[POINT 8,MSGWRD]	    ;READ HEADER WORD
	ILDB	S1,T1			    ;GET A BYTE
	CAILE	S1,DISTLN		    ;IS IT IN THE TABLE?
	SETZM	S1			    ;NO, SET TO UNKNOWN
	$CALL	@DSPTBL(S1)		    ;DISPATCH OFF OF IT
	$RET				    ;AND RETURN


DSPTBL:	EXP	MESERR			    ;0 UNKNOWN MESSAGE
	EXP	QEPAGE			    ;1 PROCESS A QUEUE ENTRY
	EXP	DATPAG			    ;2 READ A DATA PAGE
	EXP	EOFPAG			    ;3 DO THE EOF PROCESS
DISTLN==.-DSPTBL			    ;DISPATCH TABLE LENGTH

MESERR:	SETOM	RECERR			    ;SET THE ERROR FLAG
	$RET				    ;AND RETURN
SUBTTL	QEPAGE	Process queue entry page to make it local

;HERE TO MAKE QUEUE FROM REMOTE FIT ON LOCAL MACHINE


QEPAGE:	$CALL	M%GPAG			    ;GET PAGE FOR 
	MOVEM	S1,MQADDR		    ;THE MASTER QUEUE ENTRY
	HRLZ	S1,TRNADR		    ;POINT TO NEW QE DESTINATION[6]
	HRR	S1,MQADDR		    ;POINT TO CURRENT QE ADDRESS[6]
	MOVE	S2,MQADDR		    ;SET UP THE[6]
	ADDI	S2,777			    ;PAGE LENGTH[6]
	BLT	S1,0(S2)		    ;MOVE QE TO NEW HOME[6]
	MOVE	J,MQADDR		    ;POINT TO QE PAGE[6]
	MOVEI	S1,.QOCRE		    ;THIS IS A CREATE MESSAGE
	STORE	S1,.MSTYP(J),MS.TYP	    ;STORE IN QUEUE ENTRY
	MOVEI	S1,EQNMSZ		    ;OWNER BLOCK SIZE
	MOVEI	S2,.EQOWN(J)		    ;POINT TO OWNER BLOCK
	$CALL	.ZCHNK			    ;AND CLEAR IT
	MOVEI	S1,12			    ;12 WORDS IN CONN DIR
	MOVEI	S2,.EQCON(J)		    ;POINT TO THEM
	$CALL	.ZCHNK			    ;AND CLEAR THEM
	LOAD	T1,.EQSPC(J),EQ.NUM	    ;GET # OF FILES[6]
	MOVEM	T1,FILES		    ;SAVE IT[6]
	LOAD	T2,.EQLEN(J),EQ.LOH	    ;GET HEADER LENGTH
	ADD	T2,J			    ;POINT TO FIRST FP
	MOVEM	T2,FPPNT		    ;SAVE THE POINTER[6]
QENODE:	LOAD	S1,LOCNOD		    ;GET MY NODE NAME
	STORE	S1,.EQROB+.ROBND(J)	    ;MAKE IT /DEST:NODE
QEOWN:	MOVE	S1,[POINT 7,.EQOWN(J)]	    ;POINT TO EQ OWNER AREA
	MOVX	S2,TXT(REMOTE)		    ;AND OWNER
	$CALL	CPYSTR			    ;MOVE IT IN
QECONN:	MOVE	S1,[POINT 7,.EQCON(J)]	    ;POINT TO CONNECTED DIR AREA
	MOVX	S2,TXT(PS:<REMOTE>)	    ;GET NEW CONNECTED DIR
	$CALL	CPYSTR			    ;PUT IT AWAY
	$CALL	QEFILN			    ;BUILD NEW FILE NAME
	MOVX	T1,.QEREC		    ;SAY WE RECEIVED QE[6]
	MOVEM	T1,INTMSG		    ;PUT IN MESSAGE AREA[6]
	MOVE	T1,[POINT 8,INTMSG]	    ;SET UP FOR INT MESSAGE[6]
	$CALL	SNDINT			    ;SEND INTERRUPT MESSAGE[6]
	$RET
SUBTTL	QEFILN	Build new queue entry file name

;	ACCEPTS FPPNT/ pointer to current file parameter (FP)
;	called from QEPAGE for first file, from EOFPAG for multiple files

QEFILN:	MOVE	T2,FPPNT		    ;GET FP POINTER[6]
	LOAD	S1,.FPINF(T2)		    ;GET FILE PARAMETER INFO[6]
	TXO	S1,FP.DEL		    ;SET DELETE BIT ON[6]
	STORE	S1,.FPINF(T2)		    ;PUT IT AWAY[6]
	LOAD	S1,.FPLEN(T2),FP.LEN	    ;GET FP LENGTH[6]
	ADD	T2,S1			    ;POINT TO FD[6]
	MOVEI	S1,FDXSIZ		    ;GET SIZE OF FD SPEC
	MOVEI	S2,NEWFIL		    ;POINT TO IT
	$CALL	.ZCHNK			    ;AND CLEAR IT OUT
	MOVX	S2,TXT(PS:<REMOTE>)	    ;BEGINNING OF NEW SPEC
	HRROI	S1,NEWFIL		    ;NEW SPEC AREA
	MOVEI	T1,^D11			    ;SEND JUST BEGINNING
	SOUT%
	MOVEM	S1,T1			    ;SAVE UPDATED POINTER
	MOVE	S1,[POINT 7,.FDSTG(T2)]	    ;POINT TO FILE SPEC
QEFIL1:	ILDB	S2,S1			    ;GET BYTE
	CAIE	S2,">"			    ;LOOK FOR END OF DIR
	JRST	QEFIL1			    ;GO BACK UNTIL IT'S THERE
	SETZM	T3			    ;NO DOT SEEN YET
QEFIL2:	ILDB	S2,S1			    ;GET NEXT BYTE
	CAIN	S2,"."			    ;DELIMITER?
	JRST  [	SKIPE	T3		    ;FIRST?
		JRST	QEFIL3		    ;NO, DONE HERE
		SETOM	T3		    ;SAY WE'VE SEEN ONE
		JRST	.+1	]	    ;AND CONTINUE
	IDPB	S2,T1			    ;NO, SAVE IT
	JRST	QEFIL2			    ;GET SOME MORE
QEFIL3:	$CALL	OPNOUT			    ;OPEN THE OUTPUT FILE
	LOAD	S1,.FDLEN(T2),FD.LEN	    ;REAL SIZE OF THE FILE SPEC[6]
	SOS	S1			    ;LESS 1 WORD[6]
	MOVEI	S2,.FDSTG(T2)		    ;POINT TO QE FILE SPEC
	$CALL	.ZCHNK			    ;CLEAR IT OUT
	HRROI	S1,.FDSTG(T2)		    ;SEND NEW SPEC THERE
	MOVE	S2,OUTJFN		    ;GET THE JFN
	MOVX	T1,<JS%DEV+JS%DIR+JS%NAM+JS%TYP+JS%GEN+JS%PAF> ;JFNS FLAGS
	JFNS%				    ;GET THE FILESPEC
	 ERCAL	DIE			    ;OH DEAR...
	LOAD	S1,.FDLEN(T2),FD.LEN	    ;GET FD LENGTH[6]
	ADD	T2,S1			    ;POINT TO NEXT FP[6]
	MOVEM	T2,FPPNT		    ;SAVE UPDATED POINTER[6]
	$RETT				    ;DONE
SUBTTL	DATPAG	Read and process a data page


DATPAG:	MOVSI	S1,.FHSLF		    ;WRITE OUT FROM SELF
	MOVE	S2,TRNADR		    ;POINT TO PAGE INCOMING PAGE
	ADR2PG	S2			    ;MAKE IT PAGE # FOR PMAP
	HRR	S1,S2			    ;PUT IN PMAP POINTER
	MOVS	S2,OUTJFN		    ;GET OUTPUT JFN
	HRR	S2,PAGCNT		    ;AND THE PAGE COUNTER
	MOVX	T1,<PM%CNT+PM%RD+PM%WR+PM%CPY>     ;FLAGS
	HRRI	T1,1			    ;MOVE ONE PAGE
	PMAP%				    ;MAP IT OUT
	 ERCAL	DIE			    ;NO GO.
	AOS	PAGCNT			    ;ADD ONE TO PAGE COUNT
	$RETT				    ;DONE
SUBTTL	EOFPAG	End of file process driver

;HERE TO CHECK THAT WE RECEIVED ALL OF FILE AND, IF SO, ACKNOWLEDGE THAT


EOFPAG:	MOVE	P1,TRNADR		    ;GET ADDRESS[4]
	MOVE	S1,0(P1)		    ;GET # PAGES IN FILE[4]
	CAIN	S1,.NOFIL		    ;DID SENDER NOT FIND FILE?
	SETOM	S1			    ;NO, HE SENT US -1
	CAMLE	S1,PAGCNT		    ;READ IT ALL?
	SETOM	RECERR			    ;NO, SET RECIEVE ERROR
	MOVEM	S1,FILSIZ		    ;SAVE IN EITHER CASE
	$CALL	FINOUT			    ;FINISH OUTPUT FILE
	 JUMPF	EOFREC			    ;DON'T QUEUE IF NOT COMPLETE[6]
	SOSE	FILES			    ;MORE FILES?[6]
	$CALL	QEFILN			    ;SETUP NEXT FILESPEC[6]
	SKIPN	FILES			    ;DON'T QUEUE IT[6]
	$CALL	SNDIQE			    ;SEND ICPF QUEUE ENTRY MESSAGE
EOFREC:	MOVX	T1,.FIREC		    ;SAY WE ARE FINISHED WITH FILE
	SKIPE	RECERR			    ;RECEIVE OK?
	MOVX	T1,.FINAK		    ;NO, TELL SENDER.
	MOVEM	T1,INTMSG		    ;PUT IN MESSAGE AREA
	MOVE	T1,[POINT 8,INTMSG]	    ;SET UP FOR INT MESSAGE
	$CALL	SNDINT			    ;SEND INTERRUPT MESSAGE
	$RETT				    ;ALL DONE HERE
SUBTTL	GETBCT	Routine to return bitstream from DECNET message

;Accepts	S2/ Bytesize (1-36)

;Returns TRUE	S1/ Byte right justified

GETBCT:	SETZ	T4,			;Clear result
	MOVE	T3,[POINT 8,T4,35]	;Get pointer to result
	SKIPN	T1,BITCNT		;Residual bit count?
	JRST	GETBC1			;no..start at byte boundry
	HLLZ	T2,BCTADJ		;Get pointer adjustment
	ADD	T2,TRNPNT		;Get pointer to bits
	LDB	T4,T2			;Put them in answer
	DPB	T1,[POINT 6,T3,5]	;Pos = Bitcount
	SUB	S2,T1			;Get remaining bits
	JUMPLE	S2,GETBC4		;None left to get
GETBC1:	IDIVI	S2,^D8			;Get S2 bytcnt T1 Bitcnt
	JUMPE	S2,GETBC3		;Any full bytes to do?
GETBC2:	ILDB	S1,TRNPNT		;Yes..Get a byte
	DPB	S1,T3			;Store in result
	ADD	T3,[100000,,0]		;Say we stored 8 bits
	SOJG	S2,GETBC2		;Get next full byte
GETBC3:	JUMPE	T1,GETBC4		;Any residual bits?
	ILDB	S1,TRNPNT		;Yes..get them
	DPB	T1,[POINT 6,T3,11]	;Size = Bitcount
	DPB	S1,T3			;Store the odd bytes
	HRRE	S2,BCTADJ		;Get residual bitcnt
GETBC4:	MOVNM	S2,BITCNT		;Store it
	MOVE	S1,T4			;Get the result
	$RETT

BCTADJ:	037400,,-4			;Pointer adjust,,-bitcount
SUBTTL	SNDIQE - Send IPCF Queue Entry Message To QUASAR

SNDIQE:	MOVE	T1,MQADDR		    ;GET QE PAGE ADDRESS
	MOVEM	T1,SPLSAB+SAB.MS	    ;STORE IN ARG BLOCK
	MOVEI	S1,SAB.SZ		    ;LENGTH OF ARG BLOCK
	MOVEI	S2,SPLSAB		    ;GIVE C%SEND THE ARG	
	$CALL	C%SEND			    ;SEND OFF TO QUASAR
	 JUMPF	[$FATAL	( Can't send to QUASAR - ,^E/[-1]/)]
	$CALL	C%BRCV			    ;WAIT FOR RESPONSE
	$RET
SUBTTL	GLLINK	Get the logical link for the server

GLLINK:	$CALL	ENABLE			    ;Need to be a wheel for this
IFE DEBUG,<
	HRROI	S2,[ASCII/SRV:.RMTSPL/]	    ;Server object[5]
>
IFN DEBUG,<
	HRROI	S2,[ASCII/SRV:.TSTSPL/]	    ;Test server[5]
>
	MOVX	S1,GJ%NEW+GJ%SHT	    ;Me only, short form
	GTJFN%				    ;Get the jfn
	 ERCAL	[$FATAL (Can't get JFN for logical link - ,^E/[-2]/)]
	MOVEM	S1,LLJFN		    ;Save for later
	MOVE	S2,[FLD(^D8,OF%BSZ)+OF%RD+OF%WR]
	OPENF%				    ;Open this link
	 ERJMP	GLINK1			    ;Close and die
	MOVE	S1,LLJFN		    ;Enable channels
	MOVEI	S2,.MOACN		    ;for DECNET interrupts
	MOVX	T1,<FLD(1,MO%DAV)+FLD(2,MO%CDN)+FLD(3,MO%INA)>
	MTOPR%				    ;Lite interrupts
	 ERJMP	GLINK1			    ;Die nicly
	MOVEI	S2,.MORLS		    ;CHECK THE STATUS
	MTOPR%
	 ERJMP	GLINK1			    ;OOPS...
	MOVEM	T1,LLSTAT		    ;SAVE CURRENT STATUS
	$RETT				    ;All ok

GLINK1:	MOVE	S1,LLJFN		    ;Get handle
	TXO	S1,CZ%ABT		    ;ABORT
	CLOSF%
	 ERJMP	.+1			    ;So?
	$FATAL (  Can't open logical link - ,^E/[-2]/)
SUBTTL	LLWCON	Routine to wait for link connection

;RETURN TRUE	S1/ LINK STATUS FROM MTOPR

LLWCON:	MOVEI	T4,^D30			;Wait for 30 CCTIME intervals
LLWC1:	$CALL	LLCHK			;CHECK LL STATUS
	 JUMPF	LLWC2			;Find out why we aborted
	TXNE	S1,MO%CON		;LINK CONNECTED?
	$RETT				;Yes..give good return
	TXNE	S1,MO%SYN		;LINK CLOSED OUT BY OTHER END?
	 JRST	LLWC2			;Yes..Find out why
	TDZ	S1,S1			;Sleep for ever
	$CALL	I%SLP			;AND SNOOZE
	JRST	LLWC1			;TRY AGAIN

;HERE WHEN LINK IS ABORTED
LLWC2:	SKIPE	LLJFN			;Still have a JFN?
	$CALL	DIABT			;Yes..respond to abort
	HRRZ	S1,LLSTAT		;Get last status
	CAIE	S1,.DCX34		;Was it bad password?
	CAIN	S1,.DCX36		;Or bad account?
	$CALL	[$FATAL	(Remote node refused connection - ,^T/LLDISC/)]
	$CALL	[$FATAL	(Logical link was aborted during initial connection - ,^T/LLDISC/)]
SUBTTL	LLCLOS	Routine to close or abort a logical link


LLCLOS:	SKIPN	LLJFN			    ;Is link open?
	$CALL	[$FATAL	(Logical link is not open in LLCLOS)]
	HRLI	S2,0			    ;No errors
	HRRI	S2,.MOCLZ		    ;Get the close function
	MOVE	S1,LLJFN		    ;Get the JFN
	MTOPR%
	 ERJMP	LLCLS3			    ;Abort if MTOPR fails
	TLNN	S2,-1			    ;Did we abort link?
	JRST	LLCLS4			    ;NO
LLCLS3:	MOVE	S1,LLJFN		    ;GET THE JFN
	TXO	S1,CZ%ABT		    ;Set bit for close
	CLOSF%				    ;and be sure.
	 ERCAL	[$FATAL (Can't abort close logical link in LLCLOS - ,^E/[-2]/)]
	SETZM	LLJFN			    ;clear the JFN
	$RETT				    ;done.
LLCLS4:	MOVE	S1,LLJFN		    ;Pick up JFN
	CLOSF%
	 JRST LLCLS3			    ;keep trying
	SETZM	LLJFN			    ;Clear JFN word
	$RETT
SUBTTL	LLCHK	Check status of logical link


LLCHK:	$SAVE	<T1>
	SETZM	MSGFLG			    ;CLEAR MESSAGE FLAG
	MOVE	S1,LLJFN		    ;GET JFN
	MOVEI	S2,.MORLS		    ;GOING TO GET NET STATUS
	MOVE	T1,LLSTAT		    ;RETURN LAST STATUS ON FAIL
	MTOPR%
	 ERJMP	[TXO	T1,MO%ABT	    ;SAY ABORT STATUS
		 JRST	LLCHK1]		    ;BACK IN LINE
	MOVEM	T1,LLSTAT		    ;SAVE CURRENT STATUS
	SIBE%				    ;ANYTHING WAITING?
	SETOM	MSGFLG			    ;YES, REMEMBER THAT.
LLCHK1:	MOVE	S1,T1			    ;MOVE STATUS TO S1[7]
	TXNE	T1,MO%ABT		    ;ABORT?[7]
	 $RETF				    ;YES, FALSE RETURN
	$RETT				    ;IS OK.
SUBTTL	OPNOUT	Open the output file

OPNOUT:	HRROI	S2,NEWFIL		    ;HAVE A SPEC SO...
	MOVX	S1,GJ%FOU+GJ%SHT	    ;NEXT GEN AND SHORT FORM
	GTJFN%				    ;GET IT
	 ERCAL	DIE			    ;OOPS!
	MOVEM	S1,OUTJFN		    ;SAVE THE JFN
	MOVX	S2,<FLD(7,OF%BSZ)+OF%WR>    ;OPEN IT
	OPENF%
	 ERCAL	DIE
	SETZM	PAGCNT			    ;START THE PAGE COUNTER
	$RETT				    ;GO BACK

SUBTTL	FINOUT - FINISH OFF THE OUTPUT FILE

FINOUT:	MOVE	S1,OUTJFN		    ;GET THE JFN
	SKIPGE	FILSIZ			    ;DID SENDER FIND FILE?[3]
	TXOA	S1,CO%NRJ+CZ%NUD+CZ%ABT     ;NO, DON'T PUT INTO DIR[3]
	TXO	S1,CO%NRJ		    ;KEEP THE JFN
	CLOSF%				    ;CLOSE IT UP
	 ERCAL	DIE
	SKIPGE	FILSIZ			    ;TEST FILE SIZE AGAIN[3]
	JRST	FINEND			    ;TOO SMALL, DON'T MESS WITH FDB[3]
	MOVE	P1,TRNADR		    ;GET ADDRESS[4]
	AOS	P1			    ;SECOND WORD[4]
	MOVE	T1,0(P1)		    ;GET # BYTES IN FILE[4]
	MOVX	S1,<FLD(.FBSIZ,CF%DSP)>	    ;POINT TO BYTE SIZE OF FDB
	HRR	S1,OUTJFN		    ;GET JFN AGAIN
	SETOM	S2			    ;CHANGE IT ALL
	CHFDB%				    ;DO IT
	 ERCAL	DIE
	AOS	P1			    ;THIRD WORD[4]
	MOVE	S1,0(P1)		    ;GET BYTE SIZE[4]
	LSH	S1,6			    ;MAKE B6-B11 IN LEFT[4]
	HRLZ	T1,S1			    ;MAKE B6-B11 IN RIGHT[4]
	MOVSI	S1,.FBBYV		    ;NOW THE BYTE SIZE
	HRR	S1,OUTJFN		    ;THE JFN - AGAIN
	MOVX	S2,FB%BSZ		    ;BYTE SIZE AREA
	CHFDB%				    ;CHANGE IT AGAIN
	 ERCAL	DIE
FINEND:	HRRZ	S1,OUTJFN		    ;ONCE MORE...
	RLJFN%				    ;RELEASE JFN
	 ERCAL	DIE
	SETZM	OUTJFN			    ;CLEAR THE JFN
	SKIPE	RECERR			    ;ANY ERROR TO NOW?
	 $RETF				    ;YES, RET FALSE
	$RETT				    ;NO, ALL OK
SUBTTL	RELJFN	Quicky routine to release all non-open JFNS

;ACCEPTS	NO ARGUMENTS
;RETURNS	TRUE ALWAYS

CLSJFN::SKIPA	S1,[EXP CZ%ABT!.FHSLF]	    ;ABORT ALL FILE OPERATIONS
RELJFN::MOVX	S1,CZ%NCL!.FHSLF	    ;RELEASE ALL NON-OPEN JFNS
	CLZFF
	 ERJMP	.+1			    ;Ignore any errors
	$RETT				    ;RETURN

SUBTTL	CPYSTR	Quicky routine to copy asciz text

;ACCEPTS	S1/ DESTINATION POINTER
;		S2/ SOURCE POINTER

CPYSTR:	SETZ	T1,			    ;Terminate on Null
	SOUT%
	$RET
SUBTTL	SNDINT	Send interrupt message to caller

;ACCEPTS - T1/MESSAGE NUMBER RIGHT JUSTIFIED IN FIRST 8 BITS
;	      WITH ANY ADDITIONAL DATA IN NEXT 3 BYTES

SNDINT:	MOVEI	T2,4			    ;ONLY ONE WORD ALWAYS
	MOVE	S1,LLJFN		    ;THE NETWORK LINE
	MOVEI	S2,.MOSIM		    ;SENDING A MESSAGE
	MTOPR%				    ;SEND IT
	 ERCAL	DIE			    ;MUST GO
	$RETT


SUBTTL	ENABLE/DISABL Routine to set or clear capabilities for server 
	
ENABLE:	SKIPE	T1,CAPIBL		    ;Already on?
	$RET				    ;Yup, ok
	MOVEI	S1,.FHSLF		    ;Get me
	RPCAP%				    ;and what I can do
	TXON	T1,SC%OPR+SC%WHL	    ;Enable operator and/or wheel
	EPCAP%				    ;if not already
	MOVEM	T1,CAPIBL		    ;Save
	$RET				    ;Ok, done

DISABL:	SKIPN	T1,CAPIBL		    ;Are we already disabled?
	$RET				    ;Yes, just return
	MOVEI	S1,.FHSLF		    ;Get my for handle
	SETO	S2,
	TXZ	T1,SC%OPR+SC%WHL	    ;Clear operator and wheel
	EPCAP%
	SETZM	CAPIBL			    ;Say no longer enabled
	$RET

	
SUBTTL	PSIINI	Software interrupt system initialization

PSIINI:	MOVEI	S1,.FHSLF		    ;Initialize for me
	MOVE	S2,[LEVTAB,,CHNTAB]	    ;Point to tables
	SIR%
	MOVX	S2,1B<.ICIPC>!1B<.ICCDN>!1B<.ICDAV>!1B<.ICINA>!1B<.ICIFT>
	AIC%				    ;Turn on selected channels
	EIR%				    ;Enable requests
	$RETT

SUBTTL	Interrupt service routines

INTPSI:	$BGINT	1
	$CALL	C%INTR			    ;Flag the message
	$DEBRK

INTCDN:	$BGINT	1
	$CALL	CDNACK			    ;ACK CONNECT/DISCONNECT
	$DEBRK

INTDAV:	$BGINT	1
	$DEBRK

INTINA:	$BGINT	1
	MOVE	S1,LLJFN		    ;GET JFN OF CURRENT REMOTE NODE
	MOVEI	S2,.MORIM		    ;READ INTERRUPT MESSAGE
	MOVE	T1,[POINT 8,MESAGE]	    ;STORE MESSAGE HERE
	MTOPR%				    ;GET IT
	 ERCAL	DIE			    ;OH NO...
	$DEBRK
SUBTTL	CDNACK	Acknowledge CONNECT/DISCONNECT message

CDNACK:	$CALL	LLCHK			    ;CHECK STATUS
	MOVE	S1,LLJFN		    ;GET JFN BACK
	MOVEI	S2,.MOCC		    ;ACCEPT THE CONNECTION
	SETZB	T1,T2			    ;NO OPTIONAL DATA
	MTOPR%
	 ERJMP	.+1			    ;IGNORE ERRORS
	$CALL	LLCHK			    ;CHECK STATUS AGAIN
	$RETT				    ;RETURN WITH MESFLG FULL

;Here to respond to DI and store reason for disconnect

DIABT:	SKIPN	S1,LLJFN		    ;Have a JFN?
	JRST	DIAB1			    ;No..just store status
	MOVX	S2,.MORDA		    ;Yes..read optional data
	HRROI	T1,LLDISC		    ;Save disconnect cause
	MTOPR%
	 ERJMP	DIAB1			    ;Oops..just store staus
	JUMPE	T2,DIAB1		    ;No data..just store status
	SETZ	S2,			    ;Get a null
	IDPB	S2,T1			    ;Terminate with a null
	CAIL	T2,7			    ;At least 7 characters?
	JRST	DIAB2			    ;yes..Ignore status

DIAB1:	HRROI	S1,LLDISC		    ;Point to disconnect cause
	HRRZ	S2,LLSTAT		    ;Get last known status
	SETZ	T1,			    ;SET FOR SOUT
	CAILE	S2,DSCMAX		    ;KNOW THIS REASON?
	JRST	DIAB2			    ;NO, SKIP IT
	HRRO	S2,DSCTBL(S2)		    ;GET REASON TEXT
	SOUT%				    ;STORE IN LLDISC
DIAB2:	PJRST	LLCLOS			    ;Close the link
SUBTTL	Table	of NSP disconnect reasons

DEFINE DISCR <
	ER	(0,No error)
	ER	(1,Resource allocation failure)
	ER	(2,Target node does not exist)
	ER	(3,Node shutting down)
	ER	(4,Target task does not exist)
	ER	(5,Invalid name field)
	ER	(6,Target task queue overflow)
	ER	(7,Unspecified error condition)
	ER	(8,Third party aborted the logical link)
	ER	(9,<User abort (asynchronous disconnect)>)
	ER	(24,Flow control failure)
	ER	(32,Too many connections to node)
	ER	(33,Too many connections to target task)
	ER	(34,Access not permitted)
	ER	(35,Logical link Services mismatch)
	ER	(36,Invalid account)
	ER	(37,Segment size too small)
	ER	(38,<User aborted, timed out, or canceled link>)
	ER	(39,No path to target node)
	ER	(40,Flow control violation)
	ER	(41,No current link to target node)
	ER	(42,Confirmation of Disconnect Initiate)
	ER	(43,Image data field too long)
>					    ;END DISCR DEFINITION


DEFINE ER (VALUE,TXT) <
	.DCX'VALUE==^D'VALUE
	IFDEF %%CUR,<%%DIF==^D'VALUE-%%CUR-1>
	IFNDEF %%CUR,<
		%%CUR==0
		%%DIF==^D'VALUE>
	IFG %%DIF,<REPEAT %%DIF,<[ASCIZ\Unknown\]>>
	[ASCIZ\TXT\]
	%%CUR==^D'VALUE
>					    ;END OF ER DEFINITION

DSCTBL:	DISCR				    ;GENERATE TABLE OF REASONS
	DSCMAX==.-DSCTBL-1
	PURGE	%%CUR,%%DIF


DIE:	$FATAL ( Unknown error - ,^E/[-2]/)	    ;LAST TOPS-20
SUBTTL	Literals

;Dump the literals

	LSTOF.
	LIT
	LSTON.
SUBTTL	Interrupt tables

LEVTAB:	LEV1PC
	EXP  0
	EXP  0

;INTERRUPT CHANNELS


CHNTAB:
ICHPSI:	1,,INTPSI			    ;PSI interrupts
ICHDAV:	1,,INTDAV			    ;Data available
ICHCDN:	1,,INTCDN			    ;Connect/Disconnect
ICHINA:	1,,INTINA			    ;Interrupt message
ICHRST:	BLOCK CHNTAB+^D36-.		    ;Rest of channels
SUBTTL	IMPURE	Storage

$DATA	DATEND,0			    ;START OF MY AREA
$DATA	STREAM				    ;My stream number
$DATA	SPLPID				    ;Fal's pid
$DATA	MESSAG				    ;Address of latest IPCF message
$DATA	SLPTIM				    ;Max time to sleep in main loop
$DATA	LOCNOD				    ;MY NODE NAME
$DATA	LLJFN				    ;JFN of server object
$DATA	CAPIBL				    ;Our capabilities are enabled
$DATA	MSGFLG				    ;MESSAGE FLAG - DATA AVAIL
$DATA	LLDISC,20			    ;Disconnect cause stored here
$DATA	LLSTAT				    ;STATUS OF SAME
$DATA	TRNPNT				    ;POINT TO TRANSFER AREA
$DATA	MSGWRD				    ;HEADER MESSAGE WORD
$DATA	TRNBUF,TRNSIZ			    ;ADDRESS OF INPUT BUFFER
$DATA	TRNCNT				    ;COUNT OF BYTES IN INPUT BUFFER
$DATA	TRNPAG				    ;Page number of translated buffer
$DATA	TRNADR				    ;ADDRESS OF TRANSLATED BUFFER
$DATA	BITCNT				    ;COUNT BITS LEFT OVER
$DATA	MQADDR				    ;PAGE FOR QUEUE ENTRY
$DATA	NEWFIL,FDXSIZ			    ;NEW (OUTPUT) FILE NAME AREA
$DATA	OUTJFN				    ;JFN OF OUTPUT FILE
$DATA	FILSIZ				    ;SIZE OF FILE ACCORDING TO OTHER
$DATA	PAGCNT				    ;COUNT OF PAGES MOVED
$DATA	INTMSG				    ;MESSAGE BUFFER
$DATA	MESAGE				    ;INCOMING MESSAGE AREA
$DATA	RECERR				    ;ERROR IN RECEIPT OF FILE
$DATA	DATORG,0			    ;Start of area to clear
$DATA	FILES				    ;# OF FILES TO RECEIVE[6]
$DATA	FPPNT				    ;FILE PARAMETER POINTER[6]

;Interrupt PC locations

$GDATA	LEV1PC				    ;RETURN PC FOR INTERRUPT LEVEL 1

$DATA	PDL,PDLEN			    ;PUSH DOWN POINTER

$DATA	SRVTSK,5			    ;Requested task name
$DATA	SRVOBJ,5			    ;Requested object name

$DATA	SRVBEG,0			    ;Start of area to clear for SRV
$DATA	SRVFIL,FILNML			    ;Remote file spec
$DATA	DIRBLK,.CDDAC+1			    ;Size of directory storage
	SRVSIZ==.-SRVBEG

$DATA	REMSWS				    ;Remote file switches

$DATA	SNDSAB,SAB.SZ

;IPCF message area

$DATA	MSGHDR,MSHSIZ			    ;Message header area
$DATA	MSGARF				    ;Message argument flags
$DATA	MSGARC				    ;Message argument count
$DATA	MSGARH				    ;Message argument header
$DATA	ERRTXT,^D30			    ;Room to store error text

	END	<EVECL,,SPLVEC>