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>