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:) 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) DEFINE $FATAL (MSG,ITXT,%L1) < HRRZ P1,(P) SUBI P1,2 $CALL [$TEXT (,) $TEXT (,<^Q/ %L1/ITXT ^A>) $TEXT (,) HALTF% PJRST .-1 %L1:! TXT] 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,,) ;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,,) $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, ;[5] IFN DEBUG, ;[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 ;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:) ;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:) ;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, ;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, ;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, 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 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, ;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, ;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,) 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,) 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,> [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