Trailing-Edge
-
PDP-10 Archives
-
tops20tools_v6_9-jan-86_dumper
-
tools/tell10/dotell.mac
There are 4 other files named dotell.mac in the archive. Click here to see a list.
SEARCH MACROS,ACTSYM
$TITLE DOTELL,<DECnet TELL Command Processor>,MAIN,600000
SUBTTL L.E.Snyder 16-Dec-1983
;
; This program is a passive DECnet task (object 198) that waits
; for a connect from somewhere. It uses the connect block data to
; log in a subjob, then reads a line of data from the DECnet connection
; and sends it to the subjob for execution, returning all output from
; the subjob to the network link.
;
TELVER== 000000,,000004 ;(4)
LOC 137
EXP TELVER
RELOC
EXTERN FAO,PAGFND,SETBUF
COMMENT &
Edit history
[1] 29-Dec-83 Initial version. Most preliminary bug fixes made
within the first month or so are included in this.
[2] 07-Mar-84 Correct some timing problems that occurred when the
state of the DECnet link changed while base level
was executing its loop. If the link disappeared, it
was possible for an NSP. UUO to that link to fail if
it was executed before loop level detected the change
in the state of the link. Make NSP. UUO read and write
failures abort the link (TLDUMP).
[3] 24-May-84 Instead of issuing any needed passive connect
after doing all the loop stuff, check first thing
after a wake and issue the request immediately.
[4] 27-May-84 There is still a window where no passive connect
has been issued, so keep two outstanding at all times.
This shrinks the window to almost nothing.
& ; End comment
SUBTTL Internal Equivalences
;
; Memory allocation for DOTELL.....
;
; Addresses Size/K Purpose
; 000000-377777 128 Impure data storage (not all used)
; 400000-477777 32 Pages for Subjob Data Pages
; (created as needed)
; 600000-677777 32 Pure code
;
IFNDEF FTDBUG,<FTDBUG==0> ;For debugging code
STKSIZ== 500 ;Size of the PDL
PAGSIZ== 1000 ;Size of a page (fixed, obviously)
SDPBEG== 400 ;First page for Subjob Data Pages
SDPMAX== ^D64 ;Limited to number of extended I/O chns
; Note that we have address space
; available for a total of 128 SDP's
TELOBJ== ^D198 ;Object type
LGNWAT== ^D60*^D60*^D3 ;Number of jiffies to wait for login
; Give it three minutes for slow systems
MAXTIM== ^D1*^D60*^D60 ;Jiffies to wait for job
; If we can't do it in one minute, it's
; too involved to do with TELL!
MAXMIC== ^D10*^D60*^D60 ;We'll wait 10 minutes for MIC jobs
; since they can do lots of things...
CMDWAT== ^D60*^D3 ;Wait 3 seconds after LOGIN completes
; before checking on him
ACTSLP== ^D1000*5 ;Five second sleeps when active
; since sometimes we miss a WAKE
; on PTY activity for some reason...
USRCHN== 1 ;I/O Channel for USERS.TXT
USRWAT== ^D30*^D60*^D60 ;Time to wait between USERS.TXT reads
; We will update it every 30 minutes
CR== 15 ;ASCII value of a carriage return
LF== 12 ;ASCII value of a line feed
TAB== 11 ;ASCII value of a TAB
CWOUTS== 2 ;Keep this many passive connects issued
;
; Format of a Subjob Data Page (SDP)
;
PHASE 0
SD.STS: BLOCK 1 ;Status of this network/PTY pair
SS.ACT==1B0 ;Link is active (we have received
; a connect from a remote process
; and are doing something with the PTY)
;NOTE - we do not flag that a passive
;connect is outstanding, since the very
;presence of this SDP attests to that.
SS.LGN==1B1 ;We are in the process of logging in
SS.OUT==1B2 ;Output should now go out to the network
SS.CHG==1B3 ;The DECnet state has changed
SS.PAR==1B4 ;Partial buffer output
SS.ABO==1B5 ;We are aborting a link
SS.BLK==1B6 ;A blank line was sent last
SS.INT==1B7 ;We are processing internal commands
SS.STA==77B35 ;Current state of link
SD.LNK: BLOCK 1 ;Pointer to next SDP
SD.TIM: BLOCK 1 ;For timing operations
SD.PPN: BLOCK 1 ;Remember PPN here
SD.PTR: BLOCK 1 ;Pointer for output data
SD.CTR: BLOCK 1 ;Counter for output data
SD.CHR: BLOCK 1 ;Hold character here
SD.FLP: BLOCK .FONBF+1 ;Block for FILOP OPEN of PTY
;(Later converted to OUT argument)
SD.IBF: BLOCK .BFCTR+1 ;Input buffer ring header for PTY
SD.OBF: BLOCK .BFCTR+1 ;Output buffer ring header for PTY
SD.NSP: BLOCK .NSAA3+1 ;Arg block for NSP. UUO
SD.CBK: BLOCK .NSCUD+1 ;Connect block for DECnet
SD.CND: BLOCK 1+<6/4>+1 ;String block for node name
SD.CDD: BLOCK .NSDPN+1 ;Process pointer for destination
SD.CUS: BLOCK 1+<^D39/4>+1 ;String block for user ID
SD.CPW: BLOCK 1+<^D39/4>+1 ;Ditto for password
SD.CAC: BLOCK 1+<^D39/4>+1 ;Ditto for Account string
SD.CUD: BLOCK 1+<^D16/4>+1 ;Ditto for user data
PAGBFS==PAGSIZ-. ;Rest of page is buffers....
NSPBFS==<PAGBFS/2> ;Half of that is for DECnet...
PTYBFS==<<PAGBFS/2>/2> ;Half of other half is for PTY
SD.NBF: BLOCK NSPBFS ;Half is for DECnet...
SD.IPT: BLOCK PTYBFS ;Half of other half is PTY input
SD.OPT: BLOCK PTYBFS ;Other half of this half is for PTY output
DEPHASE ;Back to wherever...
;
; The macro to tell the operator when something has gone wrong
;
DEFINE TELOPR (STRING),<
PUSHJ SP,@[OPRTYP ;Go here
[ASCIZ ~STRING~]];String is here
>;End TELOPR
SUBTTL Low Segment Stuff
RELOCL ;Go to low seg
LOWBEG==.
STACK: BLOCK STKSIZ ;The stack
FIRST: BLOCK 1 ;Address of first SDP
CONTOT: BLOCK 1 ;Count of connects so far
MYJOB: BLOCK 1 ;My job number
VECTOR: BLOCK .PSVIS+1 ;Vector block
QUEBLK: BLOCK 12 ;Block for QUEUE UUO
RSPBLK: BLOCK 20 ;Response block
TRMBLK: BLOCK 3 ;For TRMOPs
OPRLIN==TRMBLK+1
CURSDP: BLOCK 1 ;Current SDP
USRBUF: BLOCK 1 ;Address of where USERS.TXT stuff is kept
USRSIZ: BLOCK 1 ;Size of USERS.TXT file
USRTIM: BLOCK 1 ;System uptime in jiffies when USERS.TXT
; was last read...
STRDTM: BLOCK <^D18/5>+1 ;ASCII date/time of startup
LOWEND==.-1
SUBTTL Back To High Segment
RELOCH
;
; Prototype QUEUE block for password validation
;
PROQUE:
QF.RSP!.QUMAE ;Function, we want response
0 ;Reserved
20,,RSPBLK ;Size and address of response block
QA.IMM!1B17!.QBAFN ;Want to talk to ACTDAE
UGACC$ ;Tell that to the system
QA.IMM!1B17!.UGTYP ;We want verification
UG.VER ;Tell that to the system
QA.IMM!1B17!.UGPPN ;Now for PPN
QPPNOF==.-PROQUE
0 ;PPN goes here
QA.IMM!1B17!.UGPSW ;For password
QPSWOF==.-PROQUE
0 ;Password goes here
QUELEN==.-PROQUE
;
; Table of month names
;
DEFINE M(STRING),<
POINT 7,[ASCIZ ~STRING~]
>;End define M
MONTAB:
M <-Jan->
M <-Feb->
M <-Mar->
M <-Apr->
M <-May->
M <-Jun->
M <-Jul->
M <-Aug->
M <-Sep->
M <-Oct->
M <-Nov->
M <-Dec->
SUBTTL Here For Character Output from FAO
ENTRY PUTCHR
;
; The Formatted Ascii Output routines (FAO) call PUTCHR to
; actually put the translated character to wherever it should
; go, be that the terminal or elsewhere. Our version of PUTCHR
; will merely type the character on the controlling terminal if
; the location CURSDP is zero. If CURSDP is non-zero, it is assumed
; to be the address of an SDP that has a PTY open and ready to go,
; and PUTCHR will send the character down to the PTY, not to the
; controlling terminal.
;
$ENTRY PUTCHR,<%GARB,%CHAR>
MOVE T1,@%CHAR ;Get character from FAO
SKIPN R7,CURSDP ;Get current SDP address, if any
JRST [OUTCHR T1 ;No SDP, just type it
$RETRN] ;And return
PUSHJ SP,PTYOUT ;Output it to PTY
$RETRN ;All done!
SUBTTL Startup Code
START:
JFCL ;CCL entry is meaningless
RESET ;Clear the world
MOVE SP,[IOWD STKSIZ,STACK] ;Set up the PDL
MOVE PF,SP ;Set up previous frame pointer
MOVE CF,SP ;Set up current frame pointer
MOVE CG,SP ;Set up current global pointer
PUSH SP,[SIXBIT /.MAIN./] ;Remember name of this
$CALL DOTELL ;Call the main routine
MONRT. ;Stop nice
EXIT ;Then for real
SUBTTL DOTELL - The Main Code
$ENTRY DOTELL
;
; First, clear out the low seg stuff
;
SETZM LOWBEG ;Clear out low segment
MOVE T1,[LOWBEG,,LOWBEG+1] ;...
BLT T1,LOWEND-1 ;Bye bye data!
;
; Now fix up an ASCIZ string of when we started
;
TIMER R1, ;Get time of day
DATE R7, ;Get date
IDIVI R1,^D60 ;Make into seconds
IDIVI R1,^D60 ;Make into minutes, remainder is seconds
MOVE R3,R2 ;Copy seconds into R3
IDIVI R1,^D60 ;R1 is hours, R2 mins, R3 secs
MOVE R6,[POINT 7,STRDTM] ;Make pointer to date/time string
PUSHJ SP,DECTWO ;Put in hours
MOVEI T1,":" ;Get a colon
IDPB T1,R6 ;Store
MOVE R1,R2 ;Get minutes
PUSHJ SP,DECTWO ;Store
MOVEI T1,":"
IDPB T1,R6 ;Store a colon
MOVE R1,R3 ;Get seconds
PUSHJ SP,DECTWO ;Store
MOVEI T1," " ;Get a space
IDPB T1,R6 ;Store
MOVE R1,R7 ;Get date
IDIVI R1,^D31 ;Divide by days per month
MOVEI R4,1(R2) ;Get date
IDIVI R1,^D12 ;Divide by months per year
MOVEI R3,^D64(R1) ;Store year here
MOVE R1,R4 ;Get date
PUSHJ SP,DECTWO ;Store
MOVE R2,MONTAB(R2) ;Get month name
MONCOP:
ILDB T1,R2 ;Get a byte
JUMPE T1,MONDON ;Done
IDPB T1,R6
JRST MONCOP ;Do for all
MONDON:
MOVE R1,R3 ;Get year
PUSHJ SP,DECTWO ;Store
MOVEI T1,0 ;End with a null
IDPB T1,R6 ;...
;
; Now set up USERS.TXT...
;
$CALL SETUSR ;Read in USERS.TXT
;
; Now set up the PSI system
;
MOVEI T1,VECTOR ;Get address of vector block
PIINI. T1, ;And do it
JRST PIIFLD ;Very fatal - no such animal!
MOVEI T1,NSPINT ;Get address of interrupt routine
MOVEM T1,.PSVNP+VECTOR ;Store here
MOVX R1,.PCNSP ;Get reason code
SETZB R2,R3 ;Nothing here
MOVX T1,PS.FON+PS.FAC+R1 ;Set up for the call
PISYS. T1, ;Do it
JRST PSYFLD ;Hiss
PJOB T1, ;Get my job number
MOVEM T1,MYJOB ;Store for later...
IFE FTDBUG,< ;If not debugging, use OPR for messages and detach
MOVX T1,%CNOPR ;Get name of OPR terminal
GETTAB T1, ;...
$ERROR ;Cannot happen
IONDX. T1, ;Get this
$ERROR ;Also can't happen
MOVEM T1,OPRLIN ;Remember here for messages to OPR
OUTSTR [ASCIZ /
[DTLDET - DOTELL detaching]
./]
HRROI T1,0 ;Bye bye
ATTACH T1, ;...
OUTSTR [ASCIZ /
?DTLCDT - Could not DETACH from terminal
/]
>;End IFE FTDBUG
IFN FTDBUG,< ;If debugging, use my terminal for msgs and don't detach
SETO T1, ;Get my line
TRMNO. T1, ;...
$ERROR ;Can't happen
MOVEM T1,OPRLIN ;Store
OUTSTR [ASCIZ /
[DOTELL initialized]
/]
TELOPR <Test of error reporting code>
>;End IFN FTDBUG
SUBTTL The Main Loop...
;
; In this loop we scan through the SDP's, looking for something to
; do. When done, we HIBER, waiting for a WAKE, either from an NSP
; interrupt or PTY activity.
;
; We are looking for a state change on a line. If the DECnet state
; has changed, we dispatch to the correct routine to handle it. If
; the state hasn't changed and we are active, check to see if the PTY
; has typed something to be sent over the network, or see if it's time
; to log the subjob off and close down the connection.
;
; Since the activities performed in this loop can cause the link which
; was previous idle, waiting for a connect, to go active, we also check
; for and remember if there is a link in CW state. If there is no connect
; wait outstanding after we have been through the loop we create a new
; SDP and issue a passive connect request.
;
;[3] Since any activities done in this loop cannot cause an active
; link to go idle, let's check RIGHT NOW and issue a passive request
; so the window when we don't have one issued is as small as
; possible...
;
TLLOOP:
SETZ R6, ;Clear a counter
SKIPN R7,FIRST ;Get address of first SDP, if any
JRST NEWONE ;None, go make one
TLLCHI:
LDB T1,[POINT 6,SD.STS(R7),35];Get state of the link
CAIN T1,.NSSCW ;In connect wait state?
ADDI R6,1 ;Yes, count it
SKIPE R7,SD.LNK(R7) ;Get next SDP addr, if any
JRST TLLCHI ;Got one, go on
CAIGE R6,CWOUTS ;Do we have enough issued?
JRST NEWONE ;No, go do it
SETZ R6, ;We'll set this to # idle links
SKIPN R7,FIRST ;Get address of first SDP
JRST NEWONE ;None, so this is first time through
; Go create an SDP and enter passive
TLOOP1:
MOVX T1,SS.CHG ;Get the "state has changed" bit...
TDNN T1,SD.STS(R7) ;Has the state changed?
; (Interrupt level sets this bit)
JRST TLCPTY ;No, check out PTY activity
ANDCAM T1,SD.STS(R7) ;Clear the bit...
LDB T1,[POINT 6,SD.STS(R7),35];Get state of the link
IFN FTDBUG,<
MOVE R5,T1 ;Copy the state code
$CALL FAO,<<[ASCIZ "!/[State for SDP !O changed to !O]!/"]>,R7,R5>
MOVE T1,R5 ;Get state back
>;End IFN FTDBUG
CAIN T1,.NSSCW ;Still connect wait?
JRST TLCPTY ;Yes, ignore the interrupt
CAIN T1,.NSSCR ;Have we received a connect request?
JRST TLCONN ;Yes, go process...
CAIN T1,.NSSRN ;Do we have a running link now?
JRST TLLRUN ;Yes, go handle that
CAIN T1,.NSSDS ;Have we sent a disconnect?
JRST TLNEXT ;Yes, ignore it, wait for confirm
CAIN T1,.NSSDC ;Disconnect confirmed?
JRST TLDISC ;Yes, clean up the mess
;
; If any other state, we are confused, give up
;
JRST TLDUMP ;Kill the whole thing
;
; We come here from lotsa places - here we pick next SDP, if any
; and do it all again.
;
TLNEXT:
LDB T1,[POINT 6,SD.STS(R7),35];Get state of this link
CAIN T1,.NSSCW ;Connect wait?
ADDI R6,1 ;Yes, remember that
SKIPE R7,SD.LNK(R7) ;Get next one...
JRST TLOOP1 ;And go on
CAIL R6,CWOUTS ;Do we have enough idle links?
JRST TLHIBR ;Yes, go to sleep
;
; Here when we don't have enough passive connects request outstanding.
; We will always keep CWOUTS out there, so we should always be ready
; to talk to a remote system.
;
NEWONE:
MOVEI R1,SDPBEG ;Get first page for SDP's
MOVEI R2,SDPBEG+SDPMAX-1 ;Get last valid page for them
$CALL PAGFND,<R1,R2,<[1]>,R7> ;Get a page of memory for SDP
JUMPN RS,[TELOPR <%DTLSLE - No SDP's left>
JRST TLHIBR] ;Go and sleep
;
; Now we have the page, set everything up
;
LSH R7,^D9 ;Convert into an address
IFN FTDBUG,<
$CALL FAO,<<[ASCIZ "!/[New SDP created at !O]!/"]>,R7>
>;End IFN FTDBUG
;
; Set up arg block for NSP. UUO
;
MOVEI T1,SD.CBK(R7) ;Get address of connect block
MOVEM T1,SD.NSP+.NSAA1(R7) ;Place here
MOVE T1,[.NSFEP,,.NSAA1+1] ;Get function,,length
MOVEM T1,SD.NSP+.NSAFN(R7) ;Store here
;
; Set up the connect block
;
MOVEI T1,.NSCUD+1 ;Get size of a connect block
MOVEM T1,SD.CBK+.NSCNL(R7) ;Store in connect block
MOVEI T1,SD.CND(R7) ;Get address of node name block
MOVEM T1,SD.CBK+.NSCND(R7) ;Store in connect block
SETZM SD.CBK+.NSCSD(R7) ;No need for source process block
MOVEI T1,SD.CDD(R7) ;Get address of destination process blk
MOVEM T1,SD.CBK+.NSCDD(R7) ;Store in connect block
MOVEI T1,SD.CUS(R7) ;Get user ID block address
MOVEM T1,SD.CBK+.NSCUS(R7) ;Store in connect block
MOVEI T1,SD.CPW(R7) ;Get address of password block
MOVEM T1,SD.CBK+.NSCPW(R7) ;Store in connect block
MOVEI T1,SD.CAC(R7) ;Get address of account block
MOVEM T1,SD.CBK+.NSCAC(R7) ;Store in connect block
MOVEI T1,SD.CUD(R7) ;Get user data address
MOVEM T1,SD.CBK+.NSCUD(R7) ;Store in connect block
;
; Set up sizes of string blocks
;
MOVEI T1,1+<6/4>+1 ;Get size of string block for node name
MOVEM T1,SD.CND(R7) ;Store here
MOVEI T1,1+<^D39/4>+1 ;Max bytes for three fields
MOVEM T1,SD.CUS(R7) ;Store in user ID field
MOVEM T1,SD.CPW(R7) ;Password field
MOVEM T1,SD.CAC(R7) ;And account string field
MOVEI T1,1+<^D16/4>+1 ;Max bytes for user data
MOVEM T1,SD.CUD(R7) ;Store in string
;
; Now the destination process block (which is us)
;
MOVEI T1,.NSDPN+1 ;Size of the block
MOVEM T1,SD.CDD+.NSDFL(R7) ;Store in process block
MOVEI T1,0 ;Format type of 0 (no mnemonic defined!)
MOVEM T1,SD.CDD+.NSDFM(R7) ;Store in block
MOVEI T1,TELOBJ ;Get object type
MOVEM T1,SD.CDD+.NSDOB(R7) ;Store in object type field
SETZM SD.CDD+.NSDPP(R7) ;Make sure PPN field is clear
SETZM SD.CDD+.NSDPN(R7) ;And process name, too
;
; Now do the enter passive
;
MOVEI T1,SD.NSP(R7) ;Get address of the block for the UUO
NSP. T1, ; ++ ENTER PASSIVE
JSP T2,NSPFLD ;Failed!
SKIPN R5,FIRST ;Get first one (if any)
JRST [MOVEM R7,FIRST ;No first, so this isi t!
JRST TLHIB0] ;And go on
TLFNDL:
MOVE R4,R5 ;Copy address
SKIPE R5,SD.LNK(R5) ;Get next one (if any)
JRST TLFNDL ;There is, move along
MOVEM R7,SD.LNK(R4) ;Store it for later reference
TLHIB0:
MOVE T1,[.NSFPI,,.NSAA1+1] ;Get function code, length
MOVEM T1,SD.NSP+.NSAFN(R7) ;Store in arg block
MOVEI T1,-1 ;Set all reason bits
MOVEM T1,SD.NSP+.NSAA1(R7) ;Store
MOVEI T1,SD.NSP(R7) ;Get address of block
NSP. T1, ; ++ SET PSI REASON MASK
JSP T2,NSPFLD ;Whoa!
TLHIBR:
SETZ T1, ;Assume infinite hiber...
SKIPN R7,FIRST ;Get first SDP address..
JRST TLHIB2 ;None go to sleep
MOVX T2,SS.ACT ;Get active bit
TLHIB1:
TDNE T2,SD.STS(R7) ;Is this one active?
JRST [MOVX T1,ACTSLP ;Yes, get sleep time for active
JRST TLHIB2] ;And go on
SKIPE R7,SD.LNK(R7) ;Get next one, if any
JRST TLHIB1 ;Loop on
TLHIB2:
TXO T1,HB.RPT!HB.RWJ ;Wake on PTY activity, only me
HIBER T1, ;Snxxkxx
$ERROR ;Horrible!
$CALL SETUSR ;Reread USERS.TXT if necessary
JRST TLLOOP ;Do it all again!
TLCPTY:
MOVX T1,SS.ACT ;Get active bit
TDNN T1,SD.STS(R7) ;Is this link active?
JRST TLNEXT ;No, go on
LDB T1,[POINT 6,SD.STS(R7),35];Get state of link
CAIE T1,.NSSDS ;Disconnect sent?
CAIN T1,.NSSDC ;Or confirmed?
JRST TLNEXT ;Yes, forget it
HLRZ T1,SD.FLP+.FOFNC(R7) ;Get channel number for PTY
ANDI T1,777 ;Make reasonable!
JOBSTS T1, ;Check it out
JRST TLGONE ;Job has disappeared
MOVX T2,SS.LGN ;Are we logging in?
TDNN T2,SD.STS(R7) ;???
JRST NOTLGI ;No, go on
TXNE T1,JB.ULI ;Is job logged in?
JRST TLCPLI ;Yes, go on
MOVE T2,SD.TIM(R7) ;Get time LOGIN started...
MOVX T1,%CVUPT ;Get uptime
GETTAB T1, ;...
$ERROR ;Cannot happen
SUB T1,T2 ;Get difference
CAML T1,[LGNWAT] ;Have we waited long enough?
JRST TLDUMP ;Yes, dump it
PUSHJ SP,CLRPTI ;Clear input buffer
JRST TLNEXT ;And go on
TLCPLI:
TXNE T1,JB.UDI ;Waiting for something?
JRST TLCPMN ;Yes, go on
PUSHJ SP,CLRPTI ;Clear input buffer
JRST TLNEXT ;And go on
TLCPMN:
MOVEI T1,"C"-100 ;Get a control-C
PUSHJ SP,PTYOUT ;Output some
PUSHJ SP,PTYOUT ; to force the job
; PUSHJ SP,PTYOUT ; to monitor level
PUSHJ SP,PTYFLS ;Flush it
MOVX T1,SS.LGN ;Get logging in bit
ANDCAM T1,SD.STS(R7) ;Clear it
MOVX T1,SS.OUT ;Get output bit
IORM T1,SD.STS(R7) ;And set it
;
; We are now logged in and ready...
; Read the data from the remote node and shoot it down to the PTY
;
IFN FTDBUG,<
$CALL FAO,<<[ASCIZ "!/[Subjob for SDP !O now logged in]!/"]>,R7>
>;End IFN FTDBUG
DOREAD:
MOVE T1,[.NSFDR,,.NSAA2+1] ;Set up function,,length
MOVEM T1,SD.NSP+.NSAFN(R7) ;Put it in NSP block
MOVEI T1,<NSPBFS*5> ;Get max bytes we can handle
MOVEM T1,SD.NSP+.NSAA1(R7) ;Store in NSP block
MOVEI T1,SD.NBF(R7) ;Get buffer address
HRLI T1,(POINT 7,0) ;Convert into ASCII pointer
MOVEM T1,SD.NSP+.NSAA2(R7) ;Store in block
MOVEI T1,SD.NSP(R7) ;Get address of block
NSP. T1, ; ++ RECEIVE NORMAL DATA
JRST TLDUMP ;Oops, link disappeared!
MOVEI R1,<NSPBFS*5> ;Get bytes in buffer
SUB R1,SD.NSP+.NSAA1(R7) ;Minues bytes left....
JUMPE R1,NOBYTE ;None, check this out!
MOVEI R2,SD.NBF(R7) ;Get address of buffer
HRLI R2,(POINT 7,0) ;Make into a pointer
SETZB R4,R5 ;Clear some flags
SNDCHR:
ILDB T1,R2 ;Get a byte
JUMPE T1,SNDCHR ;Ignore nulls
CAIN T1," " ;Space?
JUMPE R5,SNDCH1 ;Still leading spaces...
SETO R5, ;Non-space seen
CAIGE T1," "
SETO R4, ;Flag control char seen
PUSHJ SP,PTYOUT ;Output it
SNDCH1:
SOJG R1,SNDCHR ;Loop for all
JUMPN R4,NOBYTE ;OK, go on
MOVEI T1,CR ;Get a CR
PUSHJ SP,PTYOUT ;Output it
MOVEI T1,LF ;and a line feed
PUSHJ SP,PTYOUT ;output it
PUSHJ SP,PTYFLS ;Flush it
NOBYTE:
MOVE T1,SD.NSP+.NSAFN(R7) ;Get flags word
TXNN T1,NS.EOM ;End of message?
JRST DOREAD ;No, go on
MOVX T1,%CVUPT ;Get uptime
GETTAB T1, ;...
$ERROR ;No can happen
MOVEM T1,SD.TIM(R7) ;Store as time we waited for output
MOVEI T1,SD.NBF(R7) ;Get buffer address
HRLI T1,(POINT 7,0) ;Make into byte pointer
MOVEM T1,SD.PTR(R7) ;Store
MOVEI T1,NSPBFS*5 ;Get number of bytes allowed
MOVEM T1,SD.CTR(R7) ;Store
JRST TLNEXT ;And move along, move along
NOTLGI:
PUSH SP,T1 ;Preserve JOBSTS info
PUSHJ SP,PTYCPY ;Copy stuff into output buffer
JRST TLDUMP ;Oops, link disappeared!
MOVX T1,%CVUPT ;Get uptime
GETTAB T1, ;...
$ERROR ;Can't happen
SUB T1,SD.TIM(R7) ;Count how long since LOGIN completed
CAIG T1,CMDWAT ;Long enough to start checking on him?
JRST [POP SP,T1 ;Restore this
JRST TLNEXT] ;And go on
POP SP,T1 ;Get these bits back
TXNN T1,JB.UML ;At monitor level?
JRST TLTIME ;No, see if we've done enough!
;
; Job is at monitor, check MIC status
;
LDB R2,[POINT 9,T1,35] ;Get job number
TRMNO. R2, ;Get TTY UDX for that job
JRST TLDONE ;OK, kill it
MOVX R1,.TOGMS ;Get MIC status word
MOVE T2,[2,,R1] ;Set it up
TRMOP. T2, ;Get it
JRST TLDONE ;Not under MIC control - go on
; JRST TLTIME ;MIC owns us - wait a while
TLTIME:
MOVX T2,%CVUPT ;Reget uptime
GETTAB T2, ;...
$ERROR ;No can happen
SUB T2,SD.TIM(R7) ;How long since LOGIN completed?
CAIGE T2,MAXTIM ;Too much time?
JRST TLNEXT ;No, go on
LDB R2,[POINT 9,T1,35] ;Get job number
TRMNO. R2, ;Get its UDX
JRST TLDONE ;None, skip it
MOVX R1,.TOGMS ;Get MIC status
MOVE T2,[2,,R1] ;Prepare for UUO
TRMOP. T2, ;Get MIC status...
JRST TLDONE ;MIC doesn't own us - quit now
MOVX T2,%CVUPT ;Reget uptime counter
GETTAB T2, ;...
$ERROR ;Impossible!
SUB T2,SD.TIM(R7) ;Compute jiffies since LOGIN completed..
CAIGE T2,MAXMIC ;Max time for MIC jobs up?
JRST TLNEXT ;No, let 'er run
TLDONE:
HLRZ T1,SD.FLP+.FOFNC(R7) ;Get channel
ANDI T1,777 ;Make reasonable
JOBSTS T1, ;Check it out
SETZ T1, ;Clear on error
MOVX T2,SS.PAR ;Get partial buffer to go bit
TDNN T2,SD.STS(R7) ;If there is still some stuff...
TXNE T1,JB.UOA ; or if the PTY still has output...
CAIA ; move along and continue outputting
JRST TLABOR ;Otherwise, stop all this stuff
PUSHJ SP,PTYCPY ;Just in case there's any left
JRST TLDUMP ;Oops, link went away!
JRST TLNEXT ;And go on
TLABOR:
MOVX T1,SS.ACT ;Get active bit
TDNN T1,SD.STS(R7) ;Quitting before we started?
JRST TLDISC ;Yes, punt the whole thing
PUSHJ SP,CLRPTI ;Flush this stuff
MOVEI T1,"C"-100 ;Get a control-C
PUSHJ SP,PTYOUT ;Output one
PUSHJ SP,PTYOUT ;..,.two
PUSHJ SP,PTYOUT ;...and three for safety
PUSHJ SP,PTYFLS ;Flush it
MOVEM R7,CURSDP
$CALL FAO,<<[ASCIZ "K/N!/"]>>
SETZM CURSDP
PUSHJ SP,PTYFLS ;Flush that
KNWAIT:
HLRZ T1,SD.FLP+.FOFNC(R7) ;Get channel...
JOBSTS T1, ;Get its status
JRST TLGONE ;Job has gone away
TXNN T1,JB.ULI ;Is job still logged in?
JRST TLGONE ;Not logged in, went bye bye
MOVEI T1,1 ;Wait a second
SLEEP T1, ;...
JRST KNWAIT ;Loop on
TLGONE:
MOVX T1,SS.ACT!SS.OUT ;Get active and output bits
ANDCAM T1,SD.STS(R7) ;Clear 'em so we don't try again
MOVEI T1,.FOCLS ;Get close function
HRRM T1,SD.FLP+.FOFNC(R7) ;Store
MOVEI T1,SD.FLP(R7) ;Get address of block
HRLI T1,1 ;Just one word
FILOP. T1, ;Do it!
JFCL ;Ho hum
MOVEI T1,.FOREL ;Get RELEASE function
HRRM T1,SD.FLP+.FOFNC(R7) ;Store here
MOVEI T1,SD.FLP(R7) ;Get address of block
HRLI T1,1 ;Size of it
FILOP. T1, ;Do it
$ERROR ;This MUST work!
MOVX T1,SS.ABO ;Did we abort this guy?
TDNE T1,SD.STS(R7) ;???
JRST TLDISC ;Yes, skip this
TLLFIN:
MOVE T1,[.NSFSD,,.NSACH+1] ;Get function,,length
MOVEM T1,SD.NSP+.NSAFN(R7) ;Store in NSP. block
MOVEI T1,SD.NSP(R7) ;Get address of block
NSP. T1, ; ++ SYNCHRONOUS DISCONNECT
JRST TLDUMP ;Oops, failed, abort if possible
IFN FTDBUG,<
$CALL FAO,<<[ASCIZ "!/[Subjob for SDP !O logged out]!/"]>,R7>
>;End IFN FTDBUG
JRST TLNEXT ;Wait for next one
SUBTTL TLCONN - Here When Connect Is Received
;
; Here when he receive a connect request. Get the user ID and
; password from the connect data and verify them by calling
; the accounting daemon. If they're OK, accept the connect.
; If not, reject it.
;
TLCONN:
MOVE T1,[.NSFRI,,.NSAA1+1] ;Get function,,size
MOVEM T1,SD.NSP+.NSAFN(R7) ;Put it in NSP block
MOVEI T1,SD.CBK(R7) ;Get address of connect block
MOVEM T1,SD.NSP+.NSAA1(R7) ;Store
MOVEI T1,SD.NSP(R7) ;Get address of block
NSP. T1, ; ++ READ CONNECT DATA
JRST TLDUMP ;Failed, link must have disappeared
HLRZ R3,SD.CUS(R7) ;Get length of User-ID
JUMPE R3,TLCREJ ;Boo, reject it!
MOVE T1,[PROQUE,,QUEBLK] ;Set up prototype block
BLT T1,QUEBLK+QUELEN-1 ;Copy it
MOVEI R2,SD.CUS+1(R7) ;Point to the data
HRLI R2,(POINT 8,0) ;Make into a pointer
$CALL CHKINT,<R2,R3> ;See if special user name
JUMPE RS,[ SETZ R6, ;No PPN
MOVX T1,SS.INT;Get special interal bit
IORM T1,SD.STS(R7);Set it
JRST TLCN5A] ;And go on
$CALL CHKUSR,<R2,R3,R6> ;See if it's in USERS.TXT
JUMPE RS,TLCN5A ;It is, use THAT PPN
SETZB R5,R6 ;Put current number in R5, PPN in R6
TLCON2:
SOJL R3,TLCON5 ;Done here
ILDB T1,R2 ;Get a byte
ANDI T1,177 ;Just seven bits
CAIN T1,"[" ;Open bracket?
JRST TLCON2 ;Yes, ignore it
CAIE T1,"," ;Comma?
CAIN T1,"/" ;Or slash?
JRST TLCON4 ;Yes, go on
CAIL T1,"0" ;Legal octal digit?
CAILE T1,"7" ;???
JRST TLCREJ ;Reject the connect
SUBI T1,"0" ;Make binary
IMULI R5,10 ;Up this
ADD R5,T1 ;Get this
JRST TLCON2 ;Go on
TLCON4:
HRLZ R6,R5 ;Copy Proj number
SETZ R5, ;And get ready for programmer
TLCN4A:
SOJL R3,TLCON5 ;Done
ILDB T1,R2 ;Get a byte
ANDI T1,177 ;Getjust seven bits
CAIN T1,"]" ;End?
JRST TLCON5 ;Yes
CAIL T1,"0" ;Legal
CAILE T1,"7" ;???
JRST TLCON5 ;Yes, end it
SUBI T1,"0" ;make binary
IMULI R5,10 ;Times radix
ADD R5,T1 ;Getthis
JRST TLCN4A ;and go on
TLCON5:
HRR R6,R5 ;Get programmer
TLCN5A:
MOVEM R6,QUEBLK+QPPNOF ;Store
MOVEM R6,SD.PPN(R7) ;Save here, too
SETZ R6, ;Clear this
MOVE R5,[POINT 6,R6] ;Point to it
HLRZ R3,SD.CPW(R7) ;Get length of password string
MOVEI R2,SD.CPW+1(R7) ;Point to the data
HRLI R2,(POINT 8,0) ;Make into byte pointer
TLCON6:
SOJL R3,TLCON7 ;Done here
ILDB T1,R2 ;Get a byte
ANDI T1,177 ;Make seven bits
CAIL T1,"a" ;Upper case?
SUBI T1,40 ;No, make it
SUBI T1,40 ;make sixbit
TRNN R6,77 ;Don't overfill
IDPB T1,R5 ;Store
JRST TLCON6 ;Loop on
TLCON7:
MOVX T1,SS.INT ;Get interal bit
TDNN T1,SD.STS(R7) ;Set?
JRST TLCN7A ;No, go on
CAME R6,[SIXBIT /INTERN/] ;Correct password?
JRST TLCREJ ;No, forget it
JRST SKPQUU ;Go on, forget verification
TLCN7A:
PUSHJ SP,ENCODE ;Encode that password
MOVEM R6,QUEBLK+QPSWOF ;Store
CAMN R6,[430101,,063361] ;Special bizarre value?
JRST SKPQUU ;Yes, skip this part
MOVE T1,[QUELEN,,QUEBLK] ;Get length,,blck address
QUEUE. T1, ;Find out if all is well
JRST TLCREJ ;Nope, reject the request
SKPQUU:
IFN FTDBUG,<
$CALL FAO,<<[ASCIZ "!/[Connect for SDP !O accepted]!/"]>,R7>
>;End IFN FTDBUG
;
; Here we have verified the user-ID and password, accept the
; connect request
;
MOVE T1,[.NSFAC,,.NSACH+1] ;Function,,length
MOVEM T1,SD.NSP+.NSAFN(R7) ;Store it
MOVEI T1,SD.NSP(R7) ;Get address of block
NSP. T1, ; ++ ACCEPT CONNECT
JRST TLDUMP ;Oops, done already!
JRST TLNEXT ;Go process the next one
TLCREJ:
IFN FTDBUG,<
$CALL FAO,<<[ASCIZ "!/[Connect for SDP !O rejected]!/"]>,R7>
>;End IFN FTDBUG
MOVE T1,[.NSFRJ,,.NSACH+1] ;Function,,length
MOVEM T1,SD.NSP+.NSAFN(R7) ;Store
MOVEI T1,SD.NSP(R7) ;Get address of block
NSP. T1, ; ++ REJECT CONNECT
JRST TLDUMP ;Oops, gone already!
;
; At this point, our channel is closed, etc., so just toss this
; guy out and let somebody else take over.
;
TLDISC:
IFN FTDBUG,<
$CALL FAO,<<[ASCIZ "!/[Deleting SDP at !O]!/"]>,R7>
>;End IFN FTDBUG
MOVE T1,[.NSFRL,,.NSACH+1] ;Set up to release channel
MOVEM T1,SD.NSP+.NSAFN(R7) ;Put int block
MOVEI T1,SD.NSP(R7) ;Get address of block
NSP. T1, ; ++ RELEASE CHANNEL
JFCL ;Ignore errors
SKIPN R4,FIRST ;Get first SDP
$ERROR ;Gotta have one!
CAME R4,R7 ;Are we the first one?
JRST TLCRJ1 ;No, go on
MOVE R4,SD.LNK(R7) ;Get the next one
MOVEM R4,FIRST ;Save as the first one
JRST TLCRJ2 ;And delete this guy
TLCRJ1:
SKIPN SD.LNK(R4) ;At end of list?
$ERROR ;Yes, cannot be!
CAME R7,SD.LNK(R4) ;Is this us?
JRST [MOVE R4,SD.LNK(R4) ;No, so get next one
JRST TLCRJ1] ;And go on
MOVE R5,SD.LNK(R7) ;Get next one after us
MOVEM R5,SD.LNK(R4) ;And make it next one after previous
TLCRJ2:
LSH R7,-^D9 ;Convert into page address
MOVEI R6,1 ;just one arg
MOVE T1,[.PAGCD,,R6] ;Point at it
TXO R7,PA.GAF ;Set bit to zap it!
PAGE. T1, ;Zap it
PUSHJ SP,PAGFLD ;Failed!
MOVE R7,R4 ;Copy previous address to get next one
SKIPN FIRST ;Did we delete the one and only?
JRST NEWONE ;Yes, build a new one
JRST TLNEXT ;Do the next one
SUBTTL TLLRUN - Here When We Enter RUN State
;
; Here when we enter the RUNNING state. We will now LOGIN a
; subjob for this link and wait for it before sending the data
; from the network link.
;
TLLRUN:
MOVX T1,SS.ACT ;Get active bit
TDNE T1,SD.STS(R7) ;Set?
JRST TLNEXT ;Yes, forget this!
MOVX T1,SS.INT ;Processing internal commands?
TDNN T1,SD.STS(R7) ;???
JRST TLLRNX ;No, go on
$CALL TLLINT,<R7> ;Yes, go process commands
JRST TLLFIN ;All done here!
TLLRNX:
AOS CONTOT ;Count this one
IFN FTDBUG,<
$CALL FAO,<<[ASCIZ "!/[Link established, logging in job for SDP !O]!/"]>,R7>
>;End IFN FTDBUG
MOVX T1,FO.ASC!.FOSAU ;Get mode
MOVEM T1,SD.FLP+.FOFNC(R7) ;Store in FILOP block
MOVX T1,.IOASC ;Get mode
MOVEM T1,SD.FLP+.FOIOS(R7) ;Store
MOVSI T1,'PTY' ;Get device name
MOVEM T1,SD.FLP+.FODEV(R7) ;Store
HRLI T1,SD.OBF(R7) ;Get output buffer address
HRRI T1,SD.IBF(R7) ;Get same for input
MOVEM T1,SD.FLP+.FOBRH(R7) ;Store
SETZM SD.FLP+.FONBF(R7) ;Defaults here
MOVEI T1,SD.FLP(R7) ;Get address of arg block
HRLI T1,.FONBF+1 ;Get size of it
FILOP. T1, ;OPEN it
JRST PTYOPF ;Oops!
MOVEI R1,SD.FLP+.FOIOS(R7) ;Get address of "open" block
MOVEI R2,SD.OPT(R7) ;Get address of output buffer
HRLI R2,PTYBFS ;GEt size of it in LH
MOVEI R3,SD.IPT(R7) ;Get input buffer address
HRLI R3,PTYBFS ;Get size
$CALL SETBUF,<@R1,R2,R3> ;Set up buffer rings
SKIPE RS ;OK?
$ERROR ;Whoa!
MOVEM R7,CURSDP ;Save this
HLRZ R1,SD.PPN(R7) ;Get project number
HRRZ R2,SD.PPN(R7) ;And programmer number
$CALL FAO,<<[ASCIZ "LOGIN !O,!O!/"]>,R1,R2>
SETZM CURSDP
PUSHJ SP,PTYFLS ;Flush it out
MOVX T1,SS.ACT!SS.LGN ;Remember active and logging in
IORM T1,SD.STS(R7) ;...
MOVX T1,%CVUPT ;Get uptime
GETTAB T1, ;...
$ERROR ;Can't happen
MOVEM T1,SD.TIM(R7) ;Store for later
JRST TLNEXT ;And go on
SUBTTL TLDUMP - Here To Abort A Link
;
; Here when we are confused. Either we have detected a link state
; that we don't know how to deal with or an NSP. UUO to read or
; write data to the network failed, implying that the link has gone
; sour on us.
;
TLDUMP:
IFN FTDBUG,<
$CALL FAO,<<[ASCIZ "!/[Aborting link for SDP !O]!/"]>,R7>
>;End IFN FTDBUG
MOVE T1,[.NSFAB,,.NSACH+1] ;Set up to abort the link
MOVEM T1,SD.NSP+.NSAFN(R7) ;Remember this
MOVEI T1,SD.NSP(R7) ;Get address of it
NSP. T1, ; ++ ABORT LINK
JFCL ;No message, since link is probably
; already gone...
MOVX T1,SS.ABO ;Flag we aborted the link
IORM T1,SD.STS(R7) ;...
JRST TLABOR ;Go and end it all
SUBTTL TLLINT - Here to process internal info messages
$ENTRY TLLINT,<%SDP>
MOVE R7,@%SDP ;Get SDP address
MOVEI R2,SD.NBF(R7) ;Get address of network buffer
HRLI R2,(POINT 7,0) ;Make into a byte pointer
MOVEI T1,<NSPBFS*5> ;Get max chars to store
MOVEM T1,SD.CTR(R7) ;Store
MOVE R1,[POINT 7,[ASCIZ /
DOTELL has processed /]]
PUSHJ SP,TLLINX ;Output the string
SKIPN R3,CONTOT ;Get total number of connections
JRST [MOVEI T1,"0" ;Say zero
PUSHJ SP,TLLCHR ;Output it
JRST TLLIN3] ;All done
SETZ R5, ;Clear this register
TLLIN1:
JUMPLE R3,TLLIN2 ;Done here
IDIVI R3,^D10 ;Divide by radix
ADDI R4,"0" ;Make remainder an ASCII digit
PUSH SP,R4 ;And save it
AOJA R5,TLLIN1 ;Loop for all
TLLIN2:
SOJL R5,TLLIN3 ;Done here
POP SP,T1 ;Get the digit back
PUSHJ SP,TLLCHR ;Output it
JRST TLLIN2 ;Go on
TLLIN3:
MOVE R1,[POINT 7,[ASCIZ / connect/]]
PUSHJ SP,TLLINX ;output that
MOVEI T1,"s" ;Get plural ending
MOVE T2,CONTOT ;Get totals
CAIE T2,1 ;just one?
PUSHJ SP,TLLCHR ;No, output it
MOVE R1,[POINT 7,[ASCIZ / since startup at /]]
PUSHJ SP,TLLINX ;Output it
MOVE R1,[POINT 7,STRDTM] ;Now output startup date and time
PUSHJ SP,TLLINX ;Do it
TLLINS:
PUSHJ SP,NSPFLS ;Output it
JRST TLLIND ;Oops! The link disappeared
SKIPA ;Can't send it, wait
JRST TLLIND ;Done
MOVEI T1,1
SLEEP T1,
JRST TLLINS ;Loop on
TLLIND:
$RETRN ;All is well, return
TLLINX:
ILDB T1,R1 ;Get a byte
JUMPE T1,[POPJ SP,] ;Return on null
PUSHJ SP,TLLCHR ;output it
JRST TLLINX ;And loop on
TLLCHR:
SOSL SD.CTR(R7) ;Count this character
IDPB T1,R2 ;Store
POPJ SP, ;Return
SUBTTL CHKINT - Here to check for special internal name
$ENTRY CHKINT,<%PTR,%SIZE>
MOVE R1,@%PTR ;Get pointer
MOVE R2,@%SIZE ;Get size
CAIE R2,^D10 ;Correct number of bytes?
JRST CHKINE ;No, error
MOVE R3,[POINT 7,[ASCIZ /*INTERNAL*/]];Special name is this
CHKIN0:
ILDB T2,R3 ;Get a byte
JUMPE T2,CHKIN1 ;A match!
ILDB T1,R1 ;Geta byte
CAIL T1,141 ;OK?
SUBI T1,40 ;No make upper case
CAMN T1,T2 ;Same?
JRST CHKIN0 ;No, go on
CHKINE:
$RETRN <[-1]> ;Done, no match
CHKIN1:
$RETRN ;Done, we have a match
SUBTTL SETUSR and CHKUSR - Here For USERS.TXT Stuff
;
; These routines allow a user on the DEC-10 to give a name to his
; PPN on the -10 for compatibility with other systems that used
; named directories. The name to PPN translation is stored in a file
; called SYS:USERS.TXT[1,4]. We will reread this file about every half
; hour to catch any updates to that file.
;
; Here to read SYS:USERS.TXT into core.
;
$ENTRY SETUSR
SKIPN USRTIM ;First time around?
JRST SETUS1 ;Yes, go read the file
MOVX T1,%CVUPT ;Get uptime
GETTAB T1, ;...
$ERROR ;must be there!
SUB T1,USRTIM ;Get difference
CAIGE T1,USRWAT ;Have we exceeded wait time?
$RETRN ;No, just return
SETUS1:
MOVX R1,.IODMP ;Get dump mode
MOVSI R2,'SYS' ;Get device name
SETZ R3, ;Nothing here
OPEN USRCHN,R1 ;OPEN the device
JRST SETUER ;OPEN failed, forget it
MOVE R1,['USERS '] ;Get file name
MOVSI R2,'TXT' ;...
SETZB R3,R4 ;Defaults here
LOOKUP USRCHN,R1 ;Find the file
JRST SETUER ;Can't get it, forget it
HLRE R5,R4 ;Get length of file in words
JUMPL R5,SETUS2 ;Negative, number of words
IMULI R5,200 ;It was blocks, make it words
SKIPA ;And don't negate
SETUS2:
MOVMS R5 ;Make positive
SKIPN R6,USRBUF ;Get previous address, if any
HRRZ R6,.JBFF ;If none, get this
MOVEM R6,USRBUF ;Store as address
MOVEM R5,USRSIZ ;Remember this
ADD R6,R5 ;Get top address needed
CAMG R6,.JBREL ;Do we have the room?
JRST SETUS3 ;Yes, just move along
CORE R6, ;Get it
JRST SETUER ;Can't do it, go on
SETUS3:
MOVE R6,USRBUF ;Get address of buffer
SUBI R6,1 ;Less one
MOVN T1,R5 ;Get -length
HRL R6,T1 ;Get here
SETZ R7, ;End ths list here
IN USRCHN,R6 ;Read in the file
SKIPA ;OK?
JRST SETUER ;No, forget it
MOVX T1,%CVUPT ;Get current time
GETTAB T1, ;...
$ERROR ;no can hjappen
MOVEM T1,USRTIM ;Save
CLOSE USRCHN, ;End nice
RELEAS USRCHN, ;...
$RETRN ;All done!
SETUER:
MOVEI T1,USRCHN ;Get channel
RESDV. T1, ;Clear it
JFCL ;Forget that
SKIPE T1,USRBUF ;Get this
HRRM T1,.JBFF ;Reset this
SETZM USRBUF ;No file
SETZM USRSIZ ;No size
$RETRN ;All done
;
; Here to see if user ID is something we can convert into a PPN
;
$ENTRY CHKUSR,<%PTR,%LEN,%PPN>
SKIPN R1,USRBUF ;Get address of where stuff is
JRST CHKERT ;No stuff, return non-zeo RS
HRLI R1,(POINT 7,0) ;Make pointer to data
MOVE R7,USRSIZ ;Get size in words
IMULI R7,5 ;Get size in bytes
CHKUS1:
SETZB R5,R6 ;Put number in R5, PPN in R6
CHKUS2:
SOJL R7,CHKERT ;EOF, done
ILDB T1,R1 ;Get a byte
CAIE T1,"[" ;Start of PPN?
JRST CHKUS2 ;No find it
CHKUS3:
SOJL R7,CHKERT ;Done here
ILDB T1,R1 ;Get another byte
CAIL T1,"0" ;Legal number?
CAILE T1,"7" ;???
JRST CHKUS4 ;No, check it out
IMULI R5,10 ;Multiply by radix
SUBI T1,"0" ;Make binary
ADD R5,T1 ;Get it
JRST CHKUS3 ;And go on
CHKUS4:
JUMPN R6,CHKUS5 ;last number here
CAIE T1,"," ;Comma?
JRST CHKEOL ;No, kill this line and start again
HRLZ R6,R5 ;Copy this number
SETZ R5, ;and get another number
JRST CHKUS3 ;And get next one
CHKUS5:
HRR R6,R5 ;Get RH of PPN
CHKU5A:
SOJL R7,CHKERT ;Done at EOF
ILDB T1,R1 ;Get a byte
CAIN T1,LF ;Line feed?
JRST CHKUS1 ;Yes, start all over
CAIE T1,"," ;Comma?
JRST CHKU5A ;No, find it
MOVE R2,@%PTR ;Get pointer to data
MOVE R3,@%LEN ;And length of string
CHKUS6:
SOJL R7,CHKERT ;Done here
ILDB T1,R1 ;Get byte from file
CAIN T1,CR ;CR?
JRST CHKUS6 ;Yes, ignore
CAIN T1,LF ;LF?
SETZ T1, ;Yes, assume end of line
SOJL R3,CHKUS7 ;Done here
JUMPE T1,CHKUS1 ;Oops, too long!
ILDB T2,R2 ;And one from user
ANDI T1,177 ;Make seven bits
ANDI T2,177 ;...
CAIL T1,"a" ;Lower case?
SUBI T1,40 ;Yes, make upper
CAIL T2,"a" ;Same for other one
SUBI T2,40 ;...
CAMN T1,T2 ;Same?
JRST CHKUS6 ;Yes, all done!
CHKEOL:
SOJL R7,CHKERT ;Done here
ILDB T1,R1 ;Get a byte
CAIE T1,LF ;LF?
JRST CHKEOL ;no, find one
JRST CHKUS1 ;and go on
CHKUS7:
MOVEM R6,@%PPN ;Store PPN
$RETRN ;Return with zero RS
CHKERT:
SETO RS, ;Flag error
$RETRN <RS> ;Return with it
SUBTTL NSPINT - Here On NSP Interrupt
;
; Here when the system interrupts us to let us know that something
; on a DECnet channel has changed. We determine which SDP this
; interrupt is meant for by comparing the channel number on the
; status word of the interrupt with the channel number in each
; SDP. We always update the entire status word (.NSACH) for this
; link, plus set a flag in the status word if the link state has
; changed so top level knows to do something.
;
NSPINT:
PUSH SP,R1 ;Save some ACs
PUSH SP,R2 ;...
PUSH SP,R3 ;...
PUSH SP,R4 ;...
HRRZ R4,VECTOR+.PSVIS ;Get channel number
MOVE R1,FIRST ;Get address of first SDP
NSPIN1:
HRRZ R2,SD.NSP+.NSACH(R1) ;Get channel for this guy
CAMN R2,R4 ;OK?
JRST NSPIN2 ;Yes, so go handle it
SKIPN R1,SD.LNK(R1) ;Still more?
JRST NSPINE ;No, just return
JRST NSPIN1 ;Loop on
NSPIN2:
LDB R3,[POINT 6,SD.STS(R1),35];Get the state we knew before
HLLZ R2,VECTOR+.PSVIS ;Get status of channel
HLLM R2,SD.NSP+.NSACH(R1) ;Store new state
LDB R2,[POINT 6,VECTOR+.PSVIS,17];Get state
IFN FTDBUG,<
PUSH SP,CURSDP ;Save this...
SETZM CURSDP ;...
$CALL FAO,<<[ASCIZ "!/[Interrupt for SDP !O shows state of !O]!/"]>,R1,R2>
POP SP,CURSDP ;Restore that
>;End IFN FTDBUG
CAMN R2,R3 ;Same?
JRST NSPINW ;Yes, just wake me up
MOVX R3,SS.CHG ;Get changed bit
IORM R3,SD.STS(R1) ;Flag as changed
DPB R2,[POINT 6,SD.STS(R1),35];And store new "last" state
NSPINW:
MOVE R2,MYJOB ;Get my job number
WAKE R2, ;Wake me up
JFCL ;Ho hum
NSPINE:
POP SP,R4 ;Restore registers
POP SP,R3 ;...
POP SP,R2 ;...
POP SP,R1 ;...
DEBRK. ;Goodbye
JFCL ;WhaAAAA?
$ERROR ;Can never happen
SUBTTL PTYCPY - Here To Output Stuff
;
; Subroutine PTYCPY
;
; This routine takes output from the PTY and sends it through
; the DECnet link.
;
; Input arguments:
;
; R7 = Address of SDP
;
; Output arguments:
;
; None
;
; Errors:
;
; Skip return - All available PTY output has been sent or network
; can't hold any more.
;
; Non-skip return - Link has disappeared (NSP. to output data failed).
;
PTYCPY:
MOVX T2,SS.PAR ;Partial buffer left to output?
TDNN T2,SD.STS(R7) ;???
JRST PTYCP0 ;no, go on
PUSHJ SP,NSPFLS ;OK?
POPJ SP, ;Link gone, no skip return
JRST PTYPJ1 ;Can't do I/O, skip return
MOVX T2,SS.PAR ;Reget partial buffer bit
TDNE T2,SD.STS(R7) ;Did we clear it?
JRST PTYPJ1 ;No, wait some more
PTYCP0:
MOVX T1,NS.NDR ;Ready to go?
TDNN T1,SD.NSP+.NSACH(R7) ;???
JRST PTYPJ1 ;No, forget it
SKIPE T1,SD.CHR(R7) ;Any hold character?
JRST [SETZM SD.CHR(R7) ;Yes, clear it out
JRST PTYCPZ] ;And go on
PUSHJ SP,PTYCHR ;Get a character from PTY
JRST PTYPJ1 ;All done
JUMPE T1,PTYCPY ;Ignore nulls
PTYCPZ:
CAIE T1,CR ;Don't send these
CAIN T1,LF ;...
JRST PTYCPX ;...
SOSG SD.CTR(R7) ;Room for it?
JRST FLSBUF ;Flush it out
PTYCPA:
IDPB T1,SD.PTR(R7) ;Store the byte
PTYCPX:
CAIE T1,TAB ;Ignore tab's
CAIN T1,CR ;Ignore CR's
JRST PTYCPY ;Just go on
CAIL T1,40 ;Less than a space
JRST PTYCPY ;No, keep on going
PUSHJ SP,NSPFLS ;Flush buffer
POPJ SP, ;Oops, just return - link gone
JRST PTYPJ1 ;No data can be moved, skip return
JRST PTYCPY ;And keep going
FLSBUF:
PUSHJ SP,NSPFLS ;output it
POPJ SP, ;Woops! Link is gone, just return
JRST FLSBF1 ;Failed, cannot output buffer
MOVX T2,SS.PAR ;Get partial bit
TDNN T2,SD.STS(R7) ;Is it set?
JRST PTYCPA ;No, go on
FLSBF1:
MOVEM T1,SD.CHR(R7) ;Save for later...
PTYPJ1:
AOS (SP) ;Skip return
POPJ SP, ;Return
;
; Subroutine NSPFLS - Send current DECnet buffer out on the network
;
; Input arguments:
;
; R7 = Address of SDP for this link
;
; Output arguments:
;
; None
;
; Errors:
;
; Double skip - All is well, the data was sent, ready for more.
;
; Single skip - Network not ready for any more data.
;
; No skip - Link disappeared - NSP. UUO failed.
;
NSPFLS:
PUSH SP,T1 ;Save T1
MOVX T1,NS.NDR ;Get normal data may be sent bit
TDNN T1,SD.NSP+.NSACH(R7) ;Is it set?
JRST [POP SP,T1 ;Restore T1
AOS (SP) ;Skip one
POPJ SP,] ;And return
MOVX T1,SS.PAR ;doing a partial buffer?
TDNE T1,SD.STS(R7) ;???
JRST NSPFL0 ;Yes, skip this
MOVEI T1,SD.NBF(R7) ;Get address of buffer
HRLI T1,(POINT 7,0) ;Make into pointer
MOVEM T1,SD.NSP+.NSAA2(R7) ;Store
MOVEI T1,<NSPBFS*5> ;Get max chars
SUB T1,SD.CTR(R7) ;Get how many we store
MOVEM T1,SD.NSP+.NSAA1(R7) ;Store
JUMPE T1,[ MOVX T2,SS.BLK ;Get blank line bit
TDNE T2,SD.STS(R7) ;Was last line blank?
JRST NSPFL3 ;Yes, forget it
IORM T2,SD.STS(R7) ;Remember that this line's blank
JRST NSPFL0] ;And go on
MOVX T2,SS.BLK ;Get blank line bit
ANDCAM T2,SD.STS(R7) ;Clear it, since this line's not blank
CAIE T1,1 ;Did we have just one char?
JRST NSPFL0 ;No, go on
MOVE T1,SD.NSP+.NSAA2(R7) ;Get pointer
ILDB T1,T1 ;Get a byte
CAIN T1,"." ;Was it a dot EOL?
JRST NSPFL3 ;Yes, ignore it
NSPFL0:
MOVE T1,[.NSFDS,,.NSAA2+1] ;Set up control stuff
TXO T1,NS.EOM ;A whole message here
MOVEM T1,SD.NSP+.NSAFN(R7) ;Store
IFN FTDBUG,<
SKIPG .JBCST ;Want to see it?
JRST NSPFL1 ;No
MOVE T2,SD.NSP+.NSAA2(R7) ;Get byte pointer
MOVE T1,SD.NSP+.NSAA1(R7) ;Get count
NSPDSX:
ILDB R0,T2 ;Get it
OUTCHR R0 ;Type it
SOJG T1,NSPDSX ;Loop on
OUTSTR [ASCIZ /
/]
NSPFL1:
>;End IFN FTDBUG
MOVEI T1,SD.NSP(R7) ;Get address of block
NSP. T1, ; ++ SEND NORMAL DATA
JRST [POP SP,T1 ;Restore T1
POPJ SP,] ;And no skip return at all
SKIPE SD.NSP+.NSAA1(R7) ;Did we output it all?
JRST NSPFL2 ;No, go handle that
NSPFL3:
MOVEI T1,SD.NBF(R7) ;Get buffer address
HRLI T1,(POINT 7,0) ;Make into a pointer
MOVEM T1,SD.PTR(R7) ;Store
MOVEI T1,NSPBFS*5 ;Get max chars
MOVEM T1,SD.CTR(R7) ;Store it
MOVX T1,SS.PAR ;Get partial buffer to output bit
ANDCAM T1,SD.STS(R7) ;and flag all is well
POP SP,T1 ;Restore T1
AOS (SP) ;And skip
AOS (SP) ;Skip TWICE
POPJ SP, ;and return
NSPFL2:
MOVX T1,SS.PAR ;Get partial buffer left bit
IORM T1,SD.STS(R7) ;Set it, so we will output this first
POP SP,T1 ;Restore T1
AOS (SP) ;Skip return
AOS (SP) ;Skip twice
POPJ SP, ;and return
SUBTTL Small PTY Routines
;
; PTYOUT - Routine to send a character to the PTY
;
; Input arguments:
;
; R7 = address of current SDP
;
; T1 = character to output
;
; Output arguments:
;
; None
;
; Errors:
;
; Fatal TELOPR if two FILOP. OUTs fail to PTY (via PTYFLS).
;
PTYOUT:
SOSG SD.OBF+.BFCTR(R7) ;Room?
PUSHJ SP,PTYFLS ;No, flush buffer
IDPB T1,SD.OBF+.BFPTR(R7) ;Store the byte
IFN FTDBUG,<
SKIPL .JBCST ;Anything there?
POPJ SP, ;Return
PUSH SP,T1 ;Save REAL character...
CAIN T1,33 ;ALT?
MOVEI T1,"$" ;Yes, output this
CAIE T1,CR
CAIN T1,LF
SKIPA
CAIL T1," " ;Control range?
JRST [OUTCHR T1 ;no, just type it
POP SP,T1 ;Restore this
POPJ SP,] ;And return
OUTCHR ["^"] ;First this...
ADDI T1,100 ;Make into a real character
OUTCHR T1 ;Output it
POP SP,T1 ;Restore this
>;End IFN FTDBUG
POPJ SP, ;and return
;
; Subroutine PTYFLS - Flush current PTY buffer
;
; Input arguments:
;
; R7 = current SDP address
;
; Output arguments:
;
; None
;
; Errors:
;
; Fatal TELOPR if two outs to PTY fail.
;
PTYFLS:
PUSH SP,T1 ;Save the character
PUSH SP,T2 ;Save this one, too
SETZ T2, ;Clear this register
PTYFL0:
MOVEI T1,.FOOUT ;Get function
HRRM T1,SD.FLP+.FOFNC(R7) ;Set the function
MOVEI T1,SD.FLP(R7) ;Get address
HRLI T1,1 ;Get length
FILOP. T1, ;Output it
JRST [JUMPN T2,FLPERR ;Report error second time around
SETO T2, ;Flag that we've been here
PUSHJ SP,CLRPTI ;Clear all input....
JRST PTYFL0] ;And try it again
POP SP,T2 ;Restore this AC
POP SP,T1 ;Get character back
POPJ SP, ;Return
FLPERR:
MOVEI T1,5 ;Do it five times
FLPER1:
TELOPR <Output to PTY failed - call systems group>
MOVEI T2,3
SLEEP T2, ;Wait three seconds
SOJG T1,FLPER1 ;Tell operator again and again
MONRT. ;Stop...
POP SP,T2 ;Restore ACs
POP SP,T1 ;...
JRST PTYFLS ;And try again
;
; Subroutine PTYCHR - Get a character from PTY
;
; Input arguments:
;
; R7 = current SDP address
;
; Output arguments:
;
; T1 = Character received from PTY
;
; Errors:
;
; Skip return - got a good character in T1
;
; Non-skip return - No more characters out there
;
PTYCHR:
SOSGE SD.IBF+.BFCTR(R7) ;Any characters?
JRST CLRPT1 ;No, make sure
ILDB T1,SD.IBF+.BFPTR(R7) ;Pretend we got it
AOS (SP) ;Skip return
SKIPL .JBCST ;Special flag on?
POPJ SP, ;...
PUSH SP,T1 ;Save T1
CAIN T1,33 ;Alt?
MOVEI T1,"$" ;Yes, make dollar sign
CAIE T1,CR
CAIN T1,LF
SKIPA
CAIL T1," " ;OK?
JRST [OUTCHR T1 ;Yes, type it
POP SP,T1 ;Get it back
POPJ SP,] ;And return
OUTCHR ["^"] ;Make control
ADDI T1,100 ;Make a printing char
OUTCHR T1 ;Type it
POP SP,T1 ;Restore this
POPJ SP, ;return
CLRPT1:
PUSH SP,T1 ;Save an AC
MOVEI T1,.FOINP ;Get IN function
HRRM T1,SD.FLP(R7) ;Remember in FILOP. BLOCK
MOVEI T1,SD.FLP(R7) ;Get address of it
HRLI T1,1 ;Just one word
FILOP. T1, ;Do it
JRST [POP SP,T1 ;Restore T1
POPJ SP,] ;And return
POP SP,T1 ;Restore T1
SKIPE SD.IBF+.BFCTR(R7) ;Anything there?
JRST PTYCHR ;Yes, go handle it
POPJ SP, ;no, return
;
; Subroutine CLRPTI - Clear out PTY input buffer
;
; Input arguments:
;
; R7 = current SDP address
;
; Output arguments:
;
; None
;
; Errors:
;
; None
;
CLRPTI:
PUSH SP,T1 ;Save T1
PUSHJ SP,PTYCHR ;Get a character
JRST [POP SP,T1 ;Restore T1
POPJ SP,] ;Return
JRST CLRPTI+1 ;Loop on
;
; Subroutine ENCODE - Subroutine to encode DEC-10 password
;
; Input arguments:
;
; R6 = Sixbit password to be encoded
;
; Output arguments:
;
; R6 = Encoded password
;
; Errors:
;
; None
;
ENCODE:
PUSH SP,R1 ;Save some ACs
PUSH SP,R2 ;...
PUSH SP,R3 ;...
PUSH SP,R4 ;...
MOVE R2,R6 ;Copy the password
MOVE R1,R2 ;...
HRRZ R4,SD.PPN(R7) ;Get RH of PPN
IDIVI R2,(R4) ;Divide into password
MOVM R3,R3 ;Get abs(remainder)
MOVE R4,R3 ;Copy for a loop counter
FOO: MUL R1,R1 ;Square the password
ROTC R1,^D18 ;Get middle 36 bits of result
JUMPN R1,.+2 ;make sure non-zero
MOVE R1,R2 ;If zero, pick up password again
SOJG R4,FOO ;Do this a random number of times
XOR R1,R6 ;munge it still more
IDIVI R3,^D35 ;Divide loop counter
ROT R1,1(R4) ;Rotate R1 by remainder
MOVEM R1,R6 ;remember it
POP SP,R4 ;Restore ACs
POP SP,R3 ;...
POP SP,R2 ;...
POP SP,R1 ;...
POPJ SP, ;Return
SUBTTL Here For Store Date Integers
DECTWO:
PUSH SP,R1 ;Store these
PUSH SP,R2 ;...
IDIVI R1,^D10 ;Get low order digit into R2
ADDI R2,60 ;Make ASCII
ADDI R1,60
IDPB R1,R6 ;Store high order
IDPB R2,R6 ;Then low order
POP SP,R2
POP SP,R1
POPJ SP, ;Return
SUBTTL Here on Errors
NSPFLD:
TELOPR <NSP. UUO failed>
EXIT
PAGFLD:
TELOPR <PAGE. UUO failed>
EXIT
PIIFLD:
TELOPR <PIINI. UUO failed>
EXIT
PSYFLD:
TELOPR <PISYS. UUO failed>
EXIT
PTYOPF:
TELOPR <PTY OPEN failed>
EXIT
SUBTTL TELOPR - Here To Send a Line to the Operator
;
; Subroutine OPRTYP - come here from TELOPR macro
;
; Input arguments:
;
; (SP) = address of location +1 of address of literal block, the
; second word of which is the address of an ASCIZ string.
;
; Output arguments:
;
; None
;
; Errors:
;
; None
;
OPRTYP:
PUSH SP,R1 ;Save Some regs
PUSH SP,R2 ;...
HRRZ R1,-2(SP) ;Get return address
SUBI R1,1 ;Back up
HRRZ R1,(R1) ;Get address of literal
MOVE R1,1(R1) ;Get address of ASCIZ string
MOVX R2,.TOOUS ;Get code to output an ASCIZ string
MOVEM R2,TRMBLK ;Store
MOVEI R2,TOPSTR ;Get addressof first part
MOVEM R2,TRMBLK+2 ;Store
MOVE R2,[3,,TRMBLK] ;Set up the call
TRMOP. R2, ;Do it
JFCL ;Oh well
MOVEM R1,TRMBLK+2 ;Store this one
MOVE R2,[3,,TRMBLK] ;Do it again
TRMOP. R2, ;...
JFCL ;Forget errors
POP SP,R2 ;Restore these
POP SP,R1 ;...
POPJ SP, ;Bye
TOPSTR:
BYTE (7) 7,7,7,7,7
ASCIZ /?Error from DOTELL - /
END START