Google
 

Trailing-Edge - PDP-10 Archives - BB-H138D-BM - 5-1-sources/netsrv.mac
There are 2 other files named netsrv.mac in the archive. Click here to see a list.
; UPD ID= 7, SNARK:<5.ARPA-UTILITIES>NETSRV.MAC.5,  24-Jan-82 15:47:03 by PAETZOLD
;Add SECURE-TELNET server for 2244
; UPD ID= 1, SNARK:<5.ARPA-UTILITIES>NETSRV.MAC.3,   9-Aug-81 20:28:03 by PAETZOLD
;Dont increment return PC in WAITGO

;This software is furnished under a license and may only be used
; or copied in accordance with the terms of such license

;Copyright (C) 1980, 1981, 1982 by,
;Digital Equipment Corporation, Maynard Massachusets
TITLE NETSRV - TOPS-20AN ARPANET ICP Logger/Server  - KWPaetzold

COMMENT \

	This is the NEW and IMPROVED TOPS-20AN ARPANET Logger/Server.
This program replaces NETSER and FTSCTL.  The program is designed to
run as a SUBJOB and NOT a subfork of SYSJOB.  The program communicates
over .PRIIN and .PRIOU.  Commands to change the state of this program
may be entered via the ^ESPEAK mechanism.  See NETSRV.MEM.

	The program currently supports the following servers:

		o  New Telnet
		o  Old Telnet
		o  FTP
		o  SYSTAT
		o  NETSTAT
		o  Date and Time
		o  TTYTST

N.B.

	NETSRV uses absolute assembly techniques.  They are used so
that regions of the code (eg. pure) can be easily write protected to
assist with debuging and reliability goals.  NETSRV uses its own 
MACREL routines.  If MACREL routines are changed then the routines
internal to NETSRV must be changed also.

\
	SUBTTL UNV and assembly control symbols

	SEARCH MONSYM,MACSYM	; get UNV files we need
				; we use our own MACREL routines

	DEFINE SYM(A,B),<A=B>
	DEFINE SYMS(A,B),<A==B>
	DEFINE DSYM(A,B),<IFNDEF A,<A=B>>
	DEFINE DSYMS(A,B),<IFNDEF A,<A==B>>

	IFNDEF DEBUG,<DEBUG==0>	; debug code included if non-zero
	IFE DEBUG,<SALL>	; turn off MACRO listings
	IFE DEBUG,<.DIRECTIVE FLBLST> ; turn off extended ASCIZ listings
	DSYMS DBGTST,0		; use local command files if on

	DSYMS FT.FNG,0		; include FINGER if on (not supported)
	DSYMS FT.SCR,0		; include SECURE TELNET if on (unsupported)

				; version information
	DSYMS VWHO,0		; who last hacked (0=DEC development)
	DSYMS VMAJOR,^D5	; major version number
	DSYMS VMINOR,^D0	; minor version number
	DSYMS VEDIT,^D1		; edit number
	VERSIO==:<VWHO>B2!<VMAJOR>B11!<VMINOR>B17!<VEDIT>B35
	SUBTTL AC names

				; AC names (ACs 10-11 are free)
	SYM F,0			; flags
	SYM T1,1		; \
	SYM T2,2		;  \
	SYM T3,3		;   > temporary ACs for JSYS's
	SYM T4,4		;  /
	SYM T5,5		; /
	SYM P1,6		; general purpose AC
	SYM P2,7		; general purpose ditto
	SYM NX,12		; temporary AC for my macros
	SYM FP,13		; file byte pointer
	SYM FX,14		; fork index
	SYM CX,16		; temp AC for MACSYM (very, very temporary)
	SYM P,17		; PDL stack pointer

				; alternative names for ACs
	SYMS AC0,0
	SYMS AC1,1
	SYMS AC2,2
	SYMS AC3,3
	SYMS AC4,4
	SYMS AC5,5
	SYMS AC6,6
	SYMS AC7,7
	SYMS AC10,10
	SYMS AC11,11
	SYMS AC12,12
	SYMS AC13,13
	SYMS AC14,14
	SYMS AC15,15
	SYMS AC16,16
	SYMS AC17,17
	SUBTTL OPDEFS and macro macros

	DEFINE JSYSF,<ERCAL .JSYSF>
	DEFINE RETSKP,<JRST RSKP>
	DEFINE NOERR,<ERJMP .+1>
	DEFINE NOOP,<JFCL>
	DEFINE OKINT,<CALL .OKINT>
	DEFINE NOINT,<CALL .NOINT>

	XLISTS==0

	DEFINE XLIST%,<
	XLISTS==XLISTS+1
	IFE DEBUG,<IFE <XLISTS-1>,<XLIST>>>

	DEFINE LIST%,<
	XLISTS==XLISTS-1
	IFE DEBUG,<IFE <XLISTS>,<LIST>>>
	SUBTTL Flags and flag control macros

				; flag defs for AC F
	SYMS F%RFC,1B0		; RFC received (forks only)
	SYMS F%ICP,1B1		; ICP socket open (forks only)
	SYMS F%RCV,1B2		; receive socket open (forks only)
	SYMS F%SND,1B3		; send socket open (forks only)
	SYMS F%OLD,1B4		; old TELNET protocol flag bit (forks only)
	SYMS F%PRV,1B5		; CRJOB%'d job is to be WHEEL (forks only)
	SYMS F%SRV,1B6		; this is a server (forks only)
	SYMS F%REF,1B7		; REFUSE command flag (mother only)
	SYMS F%TAK,1B8		; TAKE command (or mode) in effect
	SYMS F%ONC,1B9		; once only code done flag
	SYMS F%FLW,1B10		; WAIT command was done in take file

				; Flag defs for word GLOBAL
	SYMS GF%MSG,1B0		; type out login message
	SYMS GF%NET,1B1		; ARPANET is up flag
	SYMS GF%WDN,1B2		; ARPANET was down flag
	SYMS GF%LOG,1B3		; logging is active

	SYMS AT%NTP,1B2		; new protocol flag for ATNVT%
	SYMS .ALMXP,777777	; alarm expired
	SYMS .BADOK,777776	; bad okint/noint
	SUBTTL Flag control macros

	DEFINE MKGX(NAME,NORMAL),<
	DEFINE NAME(FLG),<
	XLIST%
	MOVE NX,GLOBAL
	LIST%
	NORMAL NX,FLG>>

	DEFINE MKGXM(NAME,NORMAL),<
	DEFINE NAME(FLG),<
	XLIST%
	MOVE NX,GLOBAL
	LIST%
	NORMAL NX,FLG
	XLIST%
	MOVEM NX,GLOBAL
	LIST%>>

				; global flag testing macros
	MKGXM GXO,TXO		; set flag
	MKGXM GXZ,TXZ		; reset flag
	MKGX GXNE,TXNE		; test flag off
	MKGX GXNN,TXNN		; test flag on
	SUBTTL Parameters

	DSYMS FT.FST,-1		; fast mode (we run in queue zero)
	DSYMS PDLSIZ,100	; main stack size
	DSYMS FPDLSZ,100	; fork PDL stack size
	DSYMS MSGSIZ,^D1000	; max number of chars in login file
	DSYMS TIMRFC,^D15000	; time to wait for matching RFC
	DSYMS TIMALL,^D15000	; time to wait for allocation
	DSYMS TIMOPN,^D15000	; time to wait for data connections to open
IFN FT.FNG,<DSYMS TIMFNG,^D15000> ; time to wait for FINGER command to come back
	DSYMS TIMNVT,^D30000	; time to wait for ATNVT% to return
	DSYMS TIMCRJ,^D30000	; time to wait for CRJOB% to return
	DSYMS TIMATC,^D30000	; time to wait for ATACH% to return
	DSYMS TIMCHK,^D30000	; time interval for asynchronous process
	DSYMS TIMSHT,^D5000	; short wait interval
	DSYMS ERRMAX,12		; maximum fatal error count
	DSYMS NTSTSO,1		; EVEC offset for NETSTAT
	DSYMS BUFSIZ,^D5000	; log file buffer size in characters
	DSYMS ERRSIZ,^D500	; log file error buffer in characters
	DSYMS TXTSIZ,^D200	; text buffer size
	DSYMS DDTADR,770000	; DDT starting address
	SYM MAXPAG,777		; largest page number
	DSYMS ATMSIZ,^D100	; atom buffer size
	DSYMS HSTNMS,^D13	; size of host name field
	DSYMS MINSKT,1000	; Minimum relative socket we will use
	DSYMS MAXSKT,77776	; Maximum relative socket we will use
	SUBTTL TTY I/O macros

	DEFINE TYPEC(CHR),<
	XLIST%
	MOVEI T1,CHR
	LIST%
	PBOUT%>

	DEFINE TYPE(STR),<
	XLIST%
	HRROI T1,[ASCIZ\
STR\]
	LIST%
	PSOUT%>

	DEFINE ETYPE(STR),<
	XLIST%
	HRROI T1,[ASCIZ\STR\]
	LIST%
	ESOUT%>

	DEFINE TYPEN(STR),<
	XLIST%
	HRROI T1,[ASCIZ\STR\]
	LIST%
	PSOUT%>

	DEFINE TYPEA(ADR),<
	XLIST%
	HRRO T1,ADR
	LIST%
	PSOUT%>

	DEFINE NUMO(ADR,RDX,SIZ),<
	XLIST%
	MOVE T2,ADR
	MOVEI T1,.PRIOU
	MOVX T3,<NO%LFL!<SIZ>B17!<RDX>B35>
	LIST%
	NOUT%
	XLIST%
	 JSYSF
	LIST%>
	SUBTTL BUFFER I/O macros

	DEFINE FNUMO(ADR,RDX,SIZ),<
	XLIST%
	MOVE T2,ADR
	MOVX T3,<<SIZ>B17!<RDX>B35>
	LIST%
	CALL .FNUMO>

	DEFINE FTYPE(STR),<
	XLIST%
	HRROI T2,[ASCIZ\
STR\]
	LIST%
	CALL .FTYPE>

	DEFINE FTYPEN(STR),<
	XLIST%
	HRROI T2,[ASCIZ\STR\]
	LIST%
	CALL .FTYPE>

	DEFINE FTYPEA(ADR),<
	XLIST%
	HRRO T2,ADR
	LIST%
	CALL .FTYPE>

	DEFINE FTYPEC(CHR),<
	XLIST%
	MOVX T2,CHR
	LIST%
	CALL .FTYPC>
	SUBTTL Alarm and lock control macros

	DEFINE ALARM(TIME,ADDR,STRING),<
	XLIST%
	MOVEI T1,TIME
	MOVEI T2,ADDR
	HRROI T3,[ASCIZ\STRING\]
	LIST%
	CALL ALARMS>

	DEFINE CANCEL,<CALL ALARMC>

	DEFINE LOCK(ADR),<
	XLIST%
	MOVEI NX,ADR
	LIST%
	CALL .LOCK>

	DEFINE UNLOCK(ADR),<
	XLIST%
	MOVEI NX,ADR
	LIST%
	CALL .UNLOC>
	SUBTTL COMND% JSYS macros

	DEFINE CMD(NAME,DSP,FLAGS),<
	IFB <DSP>,<
	[CM%FW!FLAGS
	ASCIZ\NAME\],,.'NAME>
	IFNB <DSP>,<
	[CM%FW!FLAGS
	ASCIZ\NAME\],,DSP>>

	DEFINE DOCMD(FNC,DATA),<
	XLIST%
	MOVX T1,<<FNC>B8>
	IFB <DATA>,<SETZ T2,>
	IFNB <DATA>,<MOVX T2,<DATA>>
	LIST%
	CALL .DOCMD>

	DEFINE DOCMD2(FNC,DATA),<
	XLIST%
	MOVX T1,<<FNC>B8>
	IFB <DATA>,<SETZ T2,>
	IFNB <DATA>,<MOVX T2,<DATA>>
	LIST%
	CALL .DOCM2>

	DEFINE NOISE(STR),<DOCMD .CMNOI,<-1,,[ASCIZ\STR\]>>
	DEFINE CNFIRM,<DOCMD .CMCFM>
	SUBTTL Server definitions

	COMMENT \

	The MKFORK macro defines characteristics for ALL the servers
NETSRV knows about.  The macro does different things in pass 1 and
pass 2.

	HANDLE is the symbol (for the offset into tables) that the
	 server will be known by.

	DSP is the dispatch address to start the server.

	NAME is the ascii text name that will be used to identify the
	 server in the log file and status command.

	ICP is the default icp socket for this server.  No other server
	 is allowed to use this socket.

	SUBSYS is the ascii test name of a subsystem to run in the
	 job created by the server.

\

	DEFINE MKFORK(HANDLE,DSP,NAME,ICP,SUBSYS),<
	XLIST%
	IF1 <NFORKS==NFORKS+1>
	IF2 <
	IFN DEBUG,<IF1,<PRINTX  NETSRV .... name , default socket ICP>>
	HANDLE==FINDEX
	LOC FRKDSP+FINDEX
	EXP DSP
	LOC FPDLP+FINDEX
	IOWD FPDLSZ,FPDL+<FINDEX*FPDLSZ>
	LOC FLVTAB+FINDEX
	EXP FPCTAB+<3*FINDEX>
	LOC FPCTAB+<3*FINDEX>
	EXP FINTPC+0+<3*FINDEX>
	EXP FINTPC+1+<3*FINDEX>
	EXP FINTPC+2+<3*FINDEX>
	LOC FRKNAM+FINDEX
	-1,,[ASCIZ\NAME\]
	LOC FRKDEF+FINDEX
	EXP ICP
	LOC FRKSUB+FINDEX
	-1,,[ASCIZ\SUBSYS\]
	FINDEX==FINDEX+1>
	LIST%>

	IF1 <NFORKS==0>
	FINDEX==0

	MKFORK SRV.OT,OTELNT,<Old Telnet   >,1
	MKFORK SRV.FT,FTP   ,<FTP          >,3,<SYSTEM:FTPSER.EXE>
	MKFORK SRV.SY,SYSTAT,<SYSTAT       >,13
	MKFORK SRV.DT,DATIME,<Date/Time    >,15
	MKFORK SRV.NE,NETSTA,<Netstatus    >,17,<SYS:NETSTAT.EXE>
	MKFORK SRV.TT,TTYTST,<Terminal Test>,23
	MKFORK SRV.NT,TELNET,<Telnet       >,27
IFN FT.FNG,<MKFORK SRV.FN,FINGER,<Finger       >,117>
IFN FT.SCR,<MKFORK SRV.ST,SECURE,<Secure Telnet>,341,<SYSTEM:TNCODE.EXE>>

	SYMS MAXFRK,<NFORKS-1>	; Maximum fork number
	SUBTTL Impure data storage 

	LOC 200			; absolute assembly beginning at 200

MPDL:	BLOCK PDLSIZ		; main PDL stack

; All locations between BEGONC and ENDONC are zeroed on startup

	BEGONC=.		; begining of once only zero area
SOCKET:	Z			; local socket number storage
SKTLCK:	BLOCK 2			; socket lock
FILOCK:	BLOCK 2			; log file buffer lock
ERRCNT:	Z			; error count
DBUGSW:	Z			; super debugging mode if non-zero
ERRACS:	BLOCK 20		; error AC save block
GLOBAL:	Z			; global flag storage
FRKICP:	BLOCK NFORKS		; ICP socket number to use
FRKRUN:	BLOCK NFORKS		; fork was running if non-zero
FRKCNT:	BLOCK NFORKS		; fork contact count
FRKERS:	BLOCK NFORKS		; fork error count
MSGLOG:	BLOCK <MSGSIZ/5>+1	; login message storage
LOGFIL:	BLOCK <^D100/5>+1	; log file name storage
	ENDONC=.-1		; end of once only zero code
	SUBTTL Impure data storage zeroed on restarts

; All locations between ZERBEG and ZEREND are zeroed on all restarts
;  including error restarts

	ZERBEG=.		; beginning of locations to zero
TAKJFN:	Z			; TAKE file JFN storage
BUFPTR:	Z			; buffer pointer
ERRPTR:	Z			; pointer for error bufffer
MPC1:	Z			; mother interrupt PC storage
MPC2:	Z
MPC3:	Z
FRKACS:	BLOCK 20		; fork ACs block
FPDL:	BLOCK FPDLSZ*NFORKS	; fork PDL stacks
FRKID:	BLOCK NFORKS		; fork handle table
RCVJFN:	BLOCK NFORKS		; receive JFN storage
SNDJFN:	BLOCK NFORKS		; send JFN storage
ICPJFN:	BLOCK NFORKS		; ICP JFN storage
F4NHST:	BLOCK NFORKS		; foreign host storage
F4NSKT:	BLOCK NFORKS		; foreign socket storage
LCLSKT:	BLOCK NFORKS		; local socket storage
LCLSKR:	BLOCK NFORKS		; job relative socket
FINTPC:	BLOCK <3*NFORKS>	; fork interrupt PC storage
FRKERR:	BLOCK NFORKS		; fork error PC storage
FRKINC:	BLOCK NFORKS		; NOINT count for forks
NVTDES:	BLOCK NFORKS		; NVT designator from ATNVT%
ALRMPC:	BLOCK NFORKS		; alarm new PC storage
ALRMST:	BLOCK NFORKS		; alarm string pointer storage
FRKJOB:	BLOCK NFORKS		; job number created storage
	CSBSIZ==.CMGJB+1	; CSB size
CSB:	BLOCK CSBSIZ		; COMND% state block
CFB:	BLOCK .CMBRK+1		; COMND% function block
CMDTXT:	BLOCK <TXTSIZ/5>+1	; COMND% text buffer
CMDATM:	BLOCK <ATMSIZ/5>+1	; COMND% atom buffer
CMDGTF:	BLOCK .GJATR+1		; COMND% GTJFN% block
BUFFER:	BLOCK <BUFSIZ/5>+1	; log file buffer
ERRBUF:	BLOCK <ERRSIZ/5>+1	; log file error buffer
	ZEREND=.-1		; end of locations to zero
	SUBTTL MACRO SUPPORT ROUTINES

	LOC <.!777>+1		; move to a new page for pure code
	PURE==.			; first location of pure code

.FNUMO:				; support routine to FNUMO macro
	MOVE T1,FP		; get the buffer pointer
	NOUT%			; output the number
	 JSYSF			; handle errors
	MOVE FP,T1		; update the buffer pointer
	RET			; return to caller

.FTYPE:				; support routine for FTYPE and FTYPEN
	MOVE T1,FP		; get the buffer pointer
	SETZB T3,T4		; no fancy limits
	SOUT%			; string output
	 JSYSF			; handle errors
	MOVE FP,T1		; update the buffer pointer
	RET			; return to caller

.FTYPC:				; support routine for FTYPEC macro
	MOVE T1,FP		; get the buffer pointer
	BOUT%			; output the byte
	 JSYSF			; handle errors
	MOVE FP,T1		; update the buffer pointer
	RET			; return to caller
	SUBTTL Mainline

EVEC:				; entry vector
	JRST NETSRV		; start
	JRST NTSRV2		; reenter NOT same as start
	EXP VERSIO		; version information
	EVECL==.-EVEC		; length of entry vector

NETSRV:				; and let us begin
	MOVE P,[IOWD PDLSIZ,MPDL] ; get a stack pointer
	RESET%			; reset the world
	SKIPA T1,[PURE]		; get address of first pure location
NTSRV0:				; touchy/feely loop for pure pages
	 ADDI T1,1000		; increment page number
	SKIP (T1)		; touch the page
	CAIGE T1,<PUREND&777000> ; have we touched the last page?
	 JRST NTSRV0		; no, go touch some more
				; when here all pure pages exist
	MOVE T1,[.FHSLF,,<PURE/1000>] ; my process,,first pure page
	MOVX T2,<PA%RD!PA%EX>	; read/execute access only
NTSRV1:				; page access loop address
	SPACS%			; so we can't get zapped by buggy code
	 JSYSF			; trap errors
	CAME T1,[.FHSLF,,<PUREND/1000>] ; at last pure page?
	 AOJA T1,NTSRV1		; no, loop for next page
	SETZ F,			; reset flags
	MOVX T1,<BEGONC,,BEGONC+1> ; get BLT AC
	SETZM BEGONC		; zero first location
	BLT T1,ENDONC		; zero once only zero code
	MOVEI T1,MINSKT		; get the initial socket we will use
	MOVEM T1,SOCKET		; and save it
NTSRV2:				; reenter/restart address
	RESET%			; clean up fork polution
	MOVX T1,SIXBIT/NETSRV/	; set our name in case CSAVE'd
	SETNM%
	CALL CHKARP		; make sure we are an arpanet site
	CALL MAKPRV		; give us privs
	MOVX T1,<ZERBEG,,ZERBEG+1> ; get BLT AC
	SETZM ZERBEG		; zero first location
	BLT T1,ZEREND		; zero the zeroable area
	CALL INILOK		; initialize all locks
	CALL PSINIT		; initialize interrupt service
	CALL SCHEDT		; schedule a timer interrupt
	TXNE F,F%ONC		; once only?
	 CALL RSTART		; no so restart all servers
				; here to do commands
	MOVX T1,<CSBV,,CSB>	; get BLT AC
	BLT T1,CSB+CSBSIZ-1	; init whole COMND% state block
	IFN DBGTST,<		; only if a a debug test version
	TXNE F,F%ONC		; once only?
	 JRST GETCMD		; no
>				; end of IFN DBGTST
	IFE DBGTST,<		; only if not a debug test version
	TXOE F,F%ONC		; once only?
	 JRST GETCMD		; no
	MOVX T1,RC%EMO		; lookup OPERATOR's user number
	HRROI T2,[ASCIZ/OPERATOR/]
	RCUSR%
	MOVE P1,T3		; save resulting user number
	GJINF%			; get user number, etc.
	CAME T1,P1		; are we OPERATOR?
	 JRST GETCMD		; no, got to top level right away
	TXZ F,F%ONC		; yes, not quite done with once only
>				; end of IFE DBGTST
	MOVX T1,<GJ%SHT!GJ%OLD>	; get GTJFN% flags
	HRROI T2,CMDFIL		; get pointer to command file name
	GTJFN%			; get a JFN on the command file
	 ERJMP [TYPE <%NETSRV startup command file not found>
		JRST GETCMD]	; go get commands
	MOVEM T1,TAKJFN		; save the JFN
	MOVX T2,<7B5!OF%RD>	; get OPENF% flags
	OPENF%			; open up the file for I/O
	 ERJMP [MOVE T1,TAKJFN	; get the JFN
		RLJFN%		; release the JFN
		 JSYSF		; trap errors
		TYPE <%NETSRV startup command file OPENF% failure - >
		JRST CMDER2]	; output error message and continue
	TXO F,F%TAK		; set TAKE mode flag
	HRL T1,TAKJFN		; get the JFN
	HRRI T1,.NULIO		; output to bit bucket
	MOVEM T1,CSB+.CMIOJ	; save JFNs
GETCMD:				; all commands start here
	DOCMD .CMINI		; init COMND% state block
	SETZM CMDGTF		; clear COMND% GTJFN% block
	MOVE T1,[CMDGTF,,CMDGTF+1]
	BLT T1,CMDGTF+.GJATR	; zak!
RPARSE:				; reparse dispatch address
	MOVE P,[IOWD PDLSIZ,MPDL] ; get a new stack
	DOCMD .CMKEY,PCMDS	; get the initial keyword
	HRRZ T2,0(T2)		; get dispatch address
	CALL (T2)		; dispatch to command routine
	JRST GETCMD		; when done get another command
	SUBTTL Routine dealings with privs

NOPRIV:				; here when we are not holy
	TYPE <%Can not run ARPANET server without privs>
	HALTF%			; stop
	JRST .-1		; trap continues

MAKPRV:				; routine to give us privs
	MOVEI T1,.FHSLF		; this fork
	RPCAP%			; get our privs
	 JSYSF
	TXNN T2,<SC%WHL!SC%OPR>	; are we holy?
	 JRST NOPRIV		; no
	SETO T3,		; set all privs
	EPCAP%			; give us all possible privs
	 JSYSF
	RET			; return to caller
	SUBTTL Routine dealing with ARPANET status and availability

CHKARP:				; check to make sure we are arpanet
	MOVEI T1,.GTHSZ		; host information function
	GTHST%			; get information on this host
	 ERJMP NOARPA		; scream on errors
	JUMPLE T4,NOARPA	; if not an ARPANET host die...
	RET			; here if we are an ARPA site
NOARPA:				; here when not an ARPA system
	TYPE <%Can not run ARPANET server on non-ARPANET system>
	HALTF%			; STOP
	JRST .-1		; I do not think it magically appeared

NETCHK:				; routine to see if the network is up
	MOVEI T1,.NETRDY	; point to IMP status word
	GETAB%			; get IMP state
	 JSYSF
	JUMPGE T1,NETCH2	; is it down or going down?
	MOVX T1,<1,,.NETRDY>	; get network state word
	GETAB%			; get the network state
	 JSYSF
	JUMPGE T1,NETCH2	; is network down?
	GXO GF%NET		; net is up so set the flag
	RET			; return to caller
NETCH2:				; here when network or IMP is down
	GXZ GF%NET		; reset the flag
	RET			; return to caller
	SUBTTL COMND% JSYS support routines

.DOCMD:				; routine to process COMND% jsys stuff
	MOVEM T1,CFB+.CMFNP	; save function code
	MOVEM T2,CFB+.CMDAT	; save data
	MOVEI T1,CSB		; get COMND% state block address
	MOVEI T2,CFB		; get COMND% function block address
	COMND%			; do the COMND% jsys
	 JSYSF			; handle errors
	TXNE T1,CM%NOP		; error occur?
	 CALL CMDERR		; yes so handle it
	RET			; return to caller

.DOCM2:				; routine for COMND% jsys without error checks
	MOVEM T1,CFB+.CMFNP	; save fnc code
	MOVEM T2,CFB+.CMDAT	; save data
	MOVEI T1,CSB		; get data address's
	MOVEI T2,CFB
	COMND%			; do the JSYS
	 JSYSF
	RET			; return to caller

CMDERR:				; here on COMND% jsys errors
	ETYPE <>		; position TTY, clear buffer, output "?"
CMDER2:	MOVEI T1,.PRIOU		; output to TTY
	MOVX T2,<.FHSLF,,-1>	; flag my last error
	SETZB T3,T4
	ERSTR%			; output error string
	 NOERR
	 NOERR
	JRST GETCMD		; go get another command
	SUBTTL Interrupt support routines

PSINIT:				; routine to initialize interrupt service
	MOVEI T1,.FHSLF		; this fork
	MOVX T2,<LEVTAB,,CHNTAB> ; interrupt system tables address
	SIR%			; set up interrupt system
	 JSYSF			; handle errors
	MOVX T2,CHNMSK		; get active channels mask
	AIC%			; activate interrupt channels
	 JSYSF
	EIR%			; enable interrupt requests
	 JSYSF
	MOVX T1,<.TICCN,,TTYINT> ; TTY interrupt channel
	ATI%			; activate TTY interrupts
	 JSYSF
	RET			; return to caller
	SUBTTL PUSH command

.PUSH:				; push to a higher EXEC command
	NOISE <TO AN EXEC>
	CNFIRM
	STKVAR <PSHJFN,PSHFRK>
	MOVX T1,<GJ%SHT!GJ%OLD>	; GTJFN% bits
	HRROI T2,[ASCIZ/SYSTEM:EXEC.EXE/] ; file name
	GTJFN%			; get a JFN on the EXEC
	 JSYSF
	MOVEM T1,PSHJFN		; save the JFN
	MOVX T1,<CR%CAP>	; give fork privs
	CFORK%			; make a fork
	 JSYSF			; trap errors
	MOVEM T1,PSHFRK		; save the fork handle
	HRLS T1			; put fork id in correct place
	HRR T1,PSHJFN		; get the JFN
	GET%			; load the file into the fork
	 JSYSF			; trap errors
	MOVE T1,PSHFRK		; get fork handle
	SETZ T2,		; entry vector offset zero
	SFRKV%			; start the fork up
	 JSYSF			; trap errors
	MOVE T1,PSHFRK		; get fork handle
	WFORK%			; wait for the fork to stop
	 JSYSF			; trap errors
	MOVE T1,PSHFRK		; get fork handle
	KFORK%			; kill the fork
	 JSYSF			; trap errors
	RET			; return for another command
	SUBTTL QUIT, EXIT, DDT, and RESTART commands

.QUIT:				; QUIT command
	NOISE <WITHOUT CLEANING UP>
	CNFIRM
	HALTF%			; stop
	RET			; return for another command

.DDT:				; DDT command
	NOISE <MODE IN MOTHER FORK>
	CNFIRM
	MOVE T1,[.FHSLF,,<DDTADR/1000>]; see if a page of DDT exists
	RPACS%			; get page accessability
	 JSYSF
	TXNN T2,PA%PEX		; does page exist?
	 JRST .DDT1		; no, must load DDT
	MOVE T1,DDTADR		; get DDT start location
	CAMN T1,[JRST DDTADR+2] ; look like a DDT?
	 JRST .DDT2		; yes, enter it
.DDT1:	MOVX T1,<GJ%OLD!GJ%SHT>	; no, get a JFN on DDT
	HRROI T2,[ASCIZ/SYS:UDDT.EXE/]
	GTJFN%
	 JSYSF			; DDT not available
	HRLI T1,.FHSLF		; this fork
	GET%			; load DDT in
	 JSYSF
	DMOVE T1,.JBSYM##	; get symbol table pointers
	DMOVEM T1,@DDTADR+1	; and shove them into DDT
	MOVEI T1,.FHSLF		; damn GET% sets the EVEC to be DDT, so
	MOVE T2,[EVECL,,EVEC]	;  we'll set it back!
	SEVEC%
	 JSYSF
.DDT2:	TYPEN <[Type R$G to return to NETSRV]>
	TYPE <>
	CALLRET DDTADR

.RESTA:				; RESTART command
	NOISE <NETSRV>
	CNFIRM
	JRST NTSRV2		; go restart us

.EXIT:				; EXIT command
	NOISE <FROM NETSRV AFTER CLEANING UP>
	CNFIRM
	CALL .STOPR		; kill all forks
	CALL DMPFIL		; empty all buffers
	HALTF%			; stop
	RET			; on CONTINUE return
	SUBTTL STOP, HELP and WAIT commands

.STOP:				; STOP command
	NOISE <ALL SERVERS>
	CNFIRM
.STOPR:				; stop routine
	SETZ FX,		; reset fork index
.STOP2:				; fork killing loop
	SKIPE FRKID(FX)		; does this fork exist?
	 SKIPN FRKRUN(FX)	; is this fork active?
	  SKIPA			; fork does not exist
	   CALL KILFRK		; yes so kill it
	SETZM FRKRUN(FX)	; reset run flag in case we didn't KILFRK
	CAIGE FX,MAXFRK		; all forks scanned?
	 AOJA FX,.STOP2		; no so keep going
	RET			; yes so return

.WAIT:				; WAIT command
	NOISE <FOREVER OR UNTIL INTERRUPT CHARACTER>
	CNFIRM
	TXNN F,F%TAK		; Take command in effect?
	 JRST .WAIT2		; no so do it
	TXO F,F%FLW		; yes so set wait command in file flag
	RET			; get another command
.WAIT2:				; here to really do the wait command
	WAIT%			; wait forever
	 JSYSF
	JRST GETCMD		; go get another command ... stack 
				; messed up from taknd

.HELP:				; help command
	NOISE <WITH NETSRV COMMANDS>
	CNFIRM
	STKVAR <HLPJFN>	
	MOVX T1,<GJ%SHT!GJ%OLD>	; file must exist
	HRROI T2,[ASCIZ/HLP:NETSRV.HLP/] ; help file name
	GTJFN			; get a jfn for the help file
	 ERCAL CMDERR		; handle error like a command error
	MOVEM T1,HLPJFN		; save the jfn
	MOVX T2,<7B5!OF%RD>	; 7 bit ascii readin mode
	OPENF			; open up the file
	 ERJMP [MOVE T1,HLPJFN	; get the jfn
		RLJFN		; release it
		 JSYSF		; handle this error
		CALL CMDERR]	; handle this like a command error
.HELP2:				; this is the help file read loop
	MOVE T1,HLPJFN		; get the jfn
	BIN			; read a byte
	 ERJMP .HELP3		; assume EOF on error
	MOVE T1,T2		; put byte for pbout to find
	PBOUT			; output the byte
	JRST .HELP2		; loop until EOF
.HELP3:				; here on error from bin assume eof
	MOVE T1,HLPJFN		; get the jfn
	CLOSF%			; close the jfn
	 JSYSF
	RET			; go get another command
	SUBTTL TAKE command and support routines

.TAKE:				; TAKE command
	TXNE F,F%TAK		; already in TAKE command?
	 JRST .TAKER		; yes so bitch and scream
	NOISE <COMMANDS FROM FILE>
	MOVEI T1,CSB		; get COMND% state block address
	IFE DBGTST,<MOVEI T2,[FLDDB. .CMIFI,,,,<SYSTEM:NETSRV.RUN>]>
	IFN DBGTST,<MOVEI T2,[FLDDB. .CMIFI,,,,<NETSRV.DEBUG>]>
	COMND%			; do the COMND% jsys
	 JSYSF			; handle errors
	TXNE T1,CM%NOP		; error occur?
	 CALL CMDERR		; yes so handle it
	MOVEM T2,TAKJFN		; save the TAKE file JFN
	DOCMD2 .CMCFM		; confirm
	TXNE T1,CM%NOP		; error?
	 JRST [	MOVE T1,TAKJFN	; yes ... get the JFN
		RLJFN%		; release it
		 JSYSF
		CALLRET CMDERR]	; go handle the error
	MOVE T1,TAKJFN		; get the JFN back
	MOVX T2,<7B5!OF%RD>	; read access
	OPENF%			; open up the input file
	 JSYSF			; handle errors
	HRLS T1			; get the JFN in left half
	HRRI T1,.NULIO		; output to bit bucket
	MOVEM T1,CSB+.CMIOJ	; save new JFNs
	TXO F,F%TAK		; and set TAKE flag
	RET			; and start getting commands
.TAKND:				; here on take file EOF
	MOVX T1,<.PRIIN,,.PRIOU> ; get primaries back
	MOVEM T1,CSB+.CMIOJ	; save them in proper place
	MOVE T1,TAKJFN		; get the JFN
	CLOSF%			; and close it
	 JSYSF			; trap errors
	TXZ F,F%TAK		; reset TAKE flag
	TXO F,F%ONC		; set once only done flag
	TXZE F,F%FLW		; was a wait command done?
	 JRST .WAIT2		; yes so do it now
	JRST GETCMD		; go get another command
.TAKER:				; here to prevent recursive takes
	TYPE <%TAKE command already in progress>
	RET
	SUBTTL RECEIVE and REFUSE commands

.REFUS:
	TXOA F,F%REF		; set REFUSE flag
.RECEI:				; RECEIVE command
	 TXZ F,F%REF		; reset REFUSE flag
	STKVAR <SRVCOD,SRVSKT,<SKTBUF,3>>
	SETZM SRVSKT		; reset the server socket storage
				; at this time ARPANET is only legal network
	NOISE <NETWORK>
	MOVEI T1,CSB		; get comnd state block address
	MOVEI T2,[<.CMKEY>B8!CM%DPP
		  EXP NCMDS
		  Z
		  -1,,[ASCIZ/ARPANET/]]
	COMND%			; parse the network name
	 JSYSF
	TXNE T1,CM%NOP		; errors?
	 CALL CMDERR		; yes so handle it
	NOISE <ICP CONNECTIONS FOR>
	DOCMD .CMKEY,SCMDS	; get connection type
	HRRZ T2,0(T2)		; get the server code
	MOVEM T2,SRVCOD		; save the server code
	TXNE F,F%REF		; REFUSE command?
	 JRST RECEV2		; yes so force confirm
	NOISE <ON SOCKET>
	MOVE FX,SRVCOD		; server code
	HRROI T1,SKTBUF		; where socket default text goes
	MOVE T2,FRKDEF(FX)	; get the default socket
	MOVEI T3,^D8		; octal radix
	NOUT%			; set up default string
	 JSYSF
	MOVEI T1,CSB		; get data address's
	MOVEI T2,[<.CMNUM>B8!CM%SDH!CM%HPP!CM%DPP
		  ^D8		; octal radix
		  -1,,[ASCIZ/octal socket number/]
		 POINT 7,SKTBUF]; default socket number
	COMND%			; do the JSYS
	 JSYSF
	TXNE T1,CM%NOP		; error occur?
	 CALL CMDERR		; yes so handle it
	TLNN T2,740000		; disallow invalid bits
	 TRNN T2,1		; must be hetersocketual (Anita Bryant feature)
	  JRST BADSKT		; user's socket violates laws of god and ARPA
	SETZ FX,		; reset fork index for socket scan
RECEV1:				; socket scan loop
	CAME FX,SRVCOD		; is this our fork?
	 CAME T2,FRKDEF(FX)	; no .... does fork have right to socket?
	  SKIPA			; no right or it is our fork
	   JRST BADSK2		; bad bad .... predefined socket
	CAME FX,SRVCOD		; our fork?
	 CAME T2,FRKICP(FX)	; socket allready taken?
	  SKIPA			; no
	   JRST BADSK2		; socket allready in use
	CAIGE FX,MAXFRK		; all forks scanned?
	 AOJA FX,RECEV1		; no so keep going
				; when we get to here socket is legal 
	MOVEM T2,SRVSKT		; save the server socket
RECEV2:				; here when confirm is needed
	CNFIRM			; confirm the command
RECEV3:
	MOVE FX,SRVCOD		; get the server code
	MOVE T1,SRVSKT		; get the server socket
	TXNN F,F%REF		; REFUSE command?
	 MOVEM T1,FRKICP(FX)	; no so save it
	TXNN F,F%REF		; if not a refuse command
	 CALL GOFORK		; startup the fork
	MOVE T1,FRKICP(FX)	; get the socket
	TXNE F,F%REF		; refuse command?
	 MOVEM T1,SRVSKT	; yes so save the socket for logging
	TXNE F,F%REF		; if a refuse command
	 CALL KILFRK		; kill the fork
	GXNN GF%LOG		; are we logging?
	 JRST RECEV4		; no so just return
	CALL LOKFIL		; yes so lock down the file
	CALL TSTAMP		; get a time stamp
	MOVE T1,FP		; get the buffer pointer
	HRROI T2,[ASCIZ/Receive/] ; assume RECEIVE command
	SETZB T3,T4
	TXNE F,F%REF		; REFUSE?
	 HRROI T2,[ASCIZ/Refuse /] ; yes
	SOUT%			; output the command type
	 JSYSF
	MOVE FP,T1		; update buffer pointer AC
	FTYPEN < ICP's for >
	FTYPEA FRKNAM(FX)
	FTYPEN < on socket >
	FNUMO SRVSKT,10,0	; output socket number
	CALL ULKFIL		; unlock the file
RECEV4:
	TXNE F,F%REF		; refuse command?
	 SETZM FRKICP(FX)	; yes so reset its icp socket
	RET			; return for another command

TTYPOS:				; routine to position tty
	MOVEI T1,.PRIOU		; tty
	DOBE%			; wait until it stops
	MOVEI T1,.PRIOU		; TTY output device
	RFPOS%			; read position
	 JSYSF
	HRRZS T2		; zero left half
	JUMPE T2,R		; TTY at zero?
	TYPE <>			; no, do a CRLF if needed
	RET			; return to caller

BADSKT:				; here when Anita doesn't like the socket
	ETYPE <Invalid socket number .... not a send socket or invalid>
	JRST GETCMD		; go get another command

BADSK2:				; here when socket is already in use
	ETYPE <Invalid socket number .... socket predefined or in use>
	JRST GETCMD		; get another command
	SUBTTL STATUS command

.STATU:
	NOISE <OF NETWORK SERVERS>
	CNFIRM
	TYPE < Server Name    ICP socket  Errors  Contacts       PC>
	TYPE < ---------------------------------------------------->
	SETZ FX,		; reset fork index
STATU1:				; fork status loop
	SKIPN FRKRUN(FX)	; is fork running?
	 JRST STATU2		; no so try the next one
	TYPE < >		; do a CRLF
	TYPEA FRKNAM(FX)	; type out fork name
	TYPEC " "		; do a space
	SKIPN T2,FRKICP(FX)	; get the ICP socket
	 MOVE T2,FRKDEF(FX)	; if zero get the default
	NUMO T2,10,13		; output ICP socket
	TYPEC " "
	NUMO FRKERS(FX),12,6	; output error count
	TYPEN <.  >		; do a space
	NUMO FRKCNT(FX),12,7	; output number of contacts
	TYPEC "."
	SKIPE FRKRUN(FX)	; fork active?
	 SKIPN FRKID(FX)	; fork exist?
	  JRST STATU2		; no
	HRROI T1,[ASCIZ/   /]	; delimit PC from rest
	PSOUT%
	MOVE T1,FRKID(FX)	; yes so get fork handle
	RFSTS%			; read fork status
	 JSYSF			; handle errors
	HRRZ P2,T2		; zero the left half
	MOVEI FP,.PRIOU		; output PC to terminal
	CALL PCPNT
STATU2:
	CAIGE FX,MAXFRK		; all forks dumped?
	 AOJA FX,STATU1		; no so continue
	TYPE <>
	GXNN GF%MSG		; do we have a message?
	 JRST STATU3		; no
	TYPE < Telnet login message>
	TYPE < -------------------->
	TYPE <>
	HRROI T1,MSGLOG		; get pointer to string
	PSOUT%			; and output it
	 JSYSF			; trap errors
STATU3:
	GXNN GF%LOG		; do we have a log file?
	 JRST STATU4		; no
	TYPE <>
	TYPE < Log file name>
	TYPE < ------------->
	TYPE < >
	HRROI T1,LOGFIL		; get string pointer
	PSOUT%			; output the file name
	 JSYSF			; trap errors
STATU4:
	TYPE <>
	TYPE <>
	RET			; return to caller
	SUBTTL OPEN command

.LOG:				; LOG file is command
	STKVAR <OPNJFN>
	NOISE <TO FILE>
	JRST .OPEN1		; and join OPEN code
	
.OPEN:				; OPEN up log file command
	STKVAR <OPNJFN>
	NOISE <AND START LOGGING TO FILE>
.OPEN1:	MOVEI T1,CSB		; get COMND% state block address
	MOVEI T2,[FLDDB. .CMFIL,,,,<SYSTEM:ARPANET-SERVER.LOG>]
	COMND%			; do the COMND% jsys
	 JSYSF			; handle errors
	TXNE T1,CM%NOP		; error occur?
	 CALL CMDERR		; yes so handle it
	MOVEM T2,OPNJFN
	DOCMD2 .CMCFM		; confirm
	TXNE T1,CM%NOP		; errors?
	 JRST [	MOVE T1,OPNJFN
		CALL .OPEN2
		CALLRET CMDERR]
	CALL DMPFIL		; empty buffers
	GXZ GF%LOG		; turn off logging
	HRROI T1,LOGFIL		; get output pointer
	MOVE T2,OPNJFN		; get the JFN
	SETZB T3,T4		; no special options
	JFNS%			; get the file name
	 JSYSF
	GXO GF%LOG		; set logging enabled flag
	CALL INIFIL		; initialize file stuff
	MOVE T1,OPNJFN		; get the JFN
.OPEN2:				; now release the JFN
	RLJFN%			; release the JFN
	 JSYSF
	RET			; return to caller
	SUBTTL LOAD command

.LOAD:				; LOAD message file command
	STKVAR <LDDJFN>
	NOISE <LOGIN MESSAGE FROM FILE>
	MOVEI T1,CSB		; get COMND% state block address
	MOVEI T2,[FLDDB. .CMIFI,,,,<SYSTEM:ARPANET-LOGIN-MESSAGE.TXT>]
	COMND%			; do the COMND% jsys
	 JSYSF			; handle errors
	TXNE T1,CM%NOP		; error occur?
	 CALL CMDERR		; yes so handle it
	MOVEM T2,LDDJFN
	DOCMD2 .CMCFM		; confirm
	TXNE T1,CM%NOP		; command error?
	 JRST [	MOVE T1,LDDJFN
		RLJFN%
		 JSYSF
		CALLRET CMDERR]
	MOVE T1,LDDJFN		; get the JFN
	CALLRET LOADMS		; load up the file
				; return to caller
	SUBTTL CLOSE and UNLOAD commands

.CLOSE:				; CLOSE log file command
	NOISE <LOG FILE AND STOP LOGGING>
	CNFIRM
	CALL DMPFIL		; empty buffers
	GXZ GF%LOG		; reset the flag
	RET			; return to caller
.UNLOA:				; unload message command
	NOISE <LOGIN MESSAGE>
	CNFIRM
	GXZ GF%MSG		; reset the message flag
	RET			; return to caller
	SUBTTL TTY and IPCF interrupt routines

.IPCF:
	DEBRK%

.TTYIO:				; TTY interrupt handler
	CALL TTYIOR		; call the worker routine
	DEBRK%			; dismiss the interrupt

TTYIOR:				; worker routine
	CALL SAVACS		; save interrupt ACs
	MOVE T1,@LEVTAB+TTYLVL-1 ; get old PC
	MOVX T2,<WAIT%>		; get code for a WAIT% JSYS
	CAME T2,-1(T1)		; was user in a WAIT% JSYS?
	 RET			; no so just dismiss
	TXO T1,PC%USR		; make it a user mode PC
	ADDI T1,1		; and bump the PC
	MOVEM T1,@LEVTAB+TTYLVL-1 ; save the new PC
	RET			; return to caller
	SUBTTL Asynchronous clock interrupt handler 

.CLOCK:				; here on the interrupt
	CALL CLOCKR		; call worker routine
	DEBRK%			; dismiss the interrupt
	
CLOCKR:				; clock worker routine
	CALL SAVACS		; save user ACs
	CALL NETCHK		; see if the network is still alive
	GXNE GF%WDN		; was network down before?
	 JRST CLOCK3		; yes
	GXNE GF%NET		; is network down now?
	 JRST CLOCK2		; no it is and was up
				; here when network is newly down
	CALL NETLOG		; log network status change
	GXO GF%WDN		; set the was down flag
	SETZ FX,		; reset the flag
CLOCK1:				; this is the killing loop
	SKIPE FRKRUN(FX)	; was this fork running?
	 CALL SUSFRK		; yes so suspend it
	CAIGE FX,MAXFRK		; all forks checked?
	 AOJA FX,CLOCK1		; no so keep checking
	JRST CLOCK2		; and continue with main flow
CLOCK3:				; here when net was down
	GXNN GF%NET		; is net now up?
	 JRST CLOCK2		; no so there is nothing we can do
	CALL NETLOG		; log network status change if needed
	GXZ GF%WDN		; reset the was down flag
	SETZ FX,		; reset fork index
CLOCK4:				; this is the loop for restarting
	SKIPE FRKRUN(FX)	; was this fork running?
	 CALL STRFRK		; yes so restart it
	CAIGE FX,MAXFRK		; all forks checked?
	 AOJA FX,CLOCK4		; no so keep going
				; fall through to main flow
CLOCK2:				; now schedule the next interrupt
	CALL DMPFIL		; empty log file buffers
	CALL DEADR1		; check for any dead forks
	CALLRET SCHEDT		; schedule the timer interrupt and return

SCHEDT:				; routine to schedule asych interrupts
	MOVX T1,<.FHSLF,,.TIMEL> ; elapsed time interrupt for me
	MOVEI T2,TIMCHK		; get time interval
	MOVEI T3,CLOCK		; get interrupt channel
	TIMER%			; set the time to go off
	 JSYSF			; trap errors
	RET			; return to caller
	SUBTTL Dead fork interrupt handler

.DEAD:				; interrupt service routine
	CALL DEADR		; call the worker routine
	DEBRK%			; dismiss and go home

DEADR:				; worker routine
	CALL SAVACS		; save interrupt ACs
DEADR1:				; alternate entry point from .clock
	CALL NETCHK		; get network status
	GXNN GF%NET		; is net up?
	 RET			; no so just return and dismiss
				; now check for dead forks
	SETZ FX,		; reset fork index
DEADR2:				; fork scanning loop
	SKIPN FRKRUN(FX)	; is this fork active?
	 JRST DEADR3		; no
	HRRZ T1,FRKERR(FX)	; get the fork error PC/flag
	CAIN T1,.ALMXP		; alarm expire?
	 JRST DEADR4		; yes
	SKIPN T1,FRKID(FX)	; does this fork really exist?
	 JRST DEADR3		; no so ignore it
	RFSTS%			; get fork status
	 JSYSF			; trap errors
	SKIPN FRKERR(FX)	; did the fork give an error PC
	 MOVEM T2,FRKERR(FX)	; no so use the one RFSTS% gave us
	LDB T1,[POINT 17,T1,17]	; get the status code
	CAIE T1,.RFHLT		; did the fork HALTF%
	 CAIN T1,.RFFPT		; or was it stopped?
	  CAIA			; it was stopped
	   JRST DEADR3		; try next fork
	MOVE T1,FRKID(FX)	; get fork handle
	GETER%			; get last error
	 JSYSF			; trap errors
	HRRZS T2		; zero left half
	CAIN T2,OPNX9		; simult. access error?
	 JRST DEADR7		; yes so just go restart
	CAIE T2,ATNX6		; receive connection refused?
	 CAIN T2,ATNX12		; or send connection refused?
	  JRST DEADR7		; yes so just go restart
DEADR4:				; here when we have the culprit
	SKIPN FP,ERRPTR		; get the error buffer pointer
	 MOVE FP,BF1PTR		; not set up yet
	GXNN GF%LOG		; are we logging?
	 JRST DEADR7		; no, skip this stuff
	CALL TSTAMP		; do a time stamp
	FTYPEN <*** Problem with server for >
	FTYPEA FRKNAM(FX)	; type out fork name
	CALL TSTAMP		; another time stamp
	MOVE T2,FRKERR(FX)	; get error code
	CAIN T2,.ALMXP		; alarm expire?
	 JRST [	FTYPEN <*** Alarm expired while waiting for > ; yes
		FTYPEA ALRMST(FX) ; type out alarm string
		JRST DEADR6]	; continue the fork
	CAIN T2,.BADOK		; bad noint/okint?
	 JRST [	FTYPEN <*** Bad OKINT or NOINT> ; yes
		JRST DEADR6]	; go restart the fork
	FTYPEN <*** Fork halted at PC >
	MOVE P2,FRKERR(FX)	; type out error PC
	CALL PCPNT
	CALL TSTAMP		; another time stamp
	FTYPEN <*** Error:  >
	MOVE T1,FP		; get byte pointer
	HRLO T2,FRKID(FX)	; get fork handle
	SETZB T3,T4
	ERSTR%			; type out the error string
	 NOERR
	 NOERR
	MOVE FP,T1		; update FP so error string goes in
DEADR6:				; now output more error information
	CALL TSTAMP		; output the time stamp
	FTYPEN <*** Error Environment Information, 4N Host: > ; prompt 
	FNUMO F4NHST(FX),10,^D12 ; output the host number
	FTYPEN <, 4N Socket: >	; prompt for socket number
	FNUMO F4NSKT(FX),10,^D12 ; output the socket number
	CALL TSTAMP		; new line with time stamp
	FTYPEN <*** Local Socket Absolute: >
	FNUMO LCLSKT(FX),10,^D12 ; output absolute socket
	FTYPEN <, Local Socket Relative: >
	FNUMO LCLSKR(FX),10,^D12 ; output relative socket
	MOVEM FP,ERRPTR		; save the new error pointer
	SKIPGE FILOCK		; can we seize the file lock?
	 CALL DMPFIL		; yes, dump the error to log file
				; fall through to continue fork
DEADR7:				; here also when we did not log
	SKIPE T1,FRKJOB(FX)	; did it create a subjob
	 LGOUT%			; yes so kill the subjob
	SETZM FRKERR(FX)	; reset the error PC/flag
	MOVE T1,FRKID(FX)	; get the fork handle
	MOVEI T2,FRKRST		; get the fork restart address
	SFORK%			; restart the fork
	 JSYSF			; trap errors
	AOS FRKERS(FX)		; bump fork error count
DEADR3:				; here when fork is ok or have restarted it
	CAIGE FX,MAXFRK		; all forks checked?
	 AOJA FX,DEADR2		; no so keep going
	RET			; try next fork
	SUBTTL PC print routine

;  Clever symbol table lookup routine.  For details, read "Introduction to
; DECsystem-20 Assembly Language Programming", by Ralph Gorin, published by
; Digital Press.  Called with PC in P2, designator in FP

PCPNT:
	SETZB T3,P1		; no current program name or best symbol
	MOVE T4,.JBSYM##	; symbol table pointer left by LINK
	HLRO T1,T4
	SUB T4,T1		; -count,,ending address +1
SYMLUP:
	LDB T1,[400400,,-2(T4)]	; symbol type
	JUMPE T1,NXTSYM		; program names are uninteresting
	CAILE T1,2		; 0=prog name, 1=global, 2=local
	 JRST NXTSYM		; none of the kind we want
	MOVE T1,-1(T4)		; value of the symbol
	CAMN T1,P2		; exact match?
	 JRST [	MOVE P1,T4	; yes, select it
		JRST FNDSYM]
	CAML T1,P2		; smaller than value sought?
	 JRST NXTSYM		; too large
	SKIPE T2,P1		; get best one so far if there is one
	 CAML T1,-1(T2)		; compare to previous best
	  MOVE P1,T4		; current symbol is best match so far
NXTSYM:
	ADD T4,[2000000-2]	; add 2 in the left, sub 2 in the right
	JUMPL T4,SYMLUP		; loop unless control count is exhausted
	SKIPN T4,P1		; did we find anything helpful?
	 JRST PCPNT1
FNDSYM:
	MOVE T1,P2		; desired value
	SUB T1,-1(T4)		; less symbol's value = offset
	CAIL T1,200		; is offset small enough?
	 JRST PCPNT1		; no, not a good enough match
	MOVE T4,P1		; get the symbol's address
	MOVE T1,-2(T4)		; symbol name
	TLZ T1,740000		; clear flags
	CALL R50DOP		; print symbol name
	SUB P2,-1(T4)		; value less this symbol's value
	JUMPE P2,R		; if no offset, don't print "+0"
	MOVE T1,FP
	MOVEI T2,"+"		; add + to the output line
	BOUT%
	CAIA
PCPNT1:
	 MOVE T1,FP		; set up designator
	MOVE T2,P2		; here if PC must be in octal
	MOVEI T3,^D8
	NOUT%
	 JSYSF
	MOVE FP,T1
	RET

; Convert a 32-bit quantity in A from squoze to ASCII

R50DOP:
	IDIVI T1,50		; divide by 50
	PUSH P,T2		; save remainder, a character
	SKIPE T1		; if A is now zero, unwind the stack
	 CALL R50DOP		; call self again, reduce A
	POP P,T1		; get character
	ADJBP T1,[350700,,[ASCII/ 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.$%/]]
	LDB T2,T1		; convert squoze code to ASCII
	MOVE T1,FP		; get designator
	BOUT%
	MOVE FP,T1		; update designator
	RET
	SUBTTL Error handlers

.JSYSF:				; routine to handle errors
	TXNN F,F%SRV		; are we a server?
	 JRST JSYSF2		; no so go to other error routine
	MOVEM T1,FRKERR(FX)	; save T1
	HRRZ T1,0(P)		; get error PC
	SUBI T1,2		; point at losing instruction
	EXCH T1,FRKERR(FX)	; save the error PC
	HALTF%			; stop .... let mother restart us
	JRST .-1		; this should never happen

JSYSF2:				; routine to handle errors in bottom level
	MOVEM AC17,ERRACS+AC17	; save AC 17
	HRRZI AC17,ERRACS	; get BLT AC
	BLT AC17,ERRACS+AC16	; save ACs 0-16
	MOVE AC17,ERRACS+AC17	; get AC17 back again
	MOVEI T1,.FHSLF		; this fork
	GETER%			; get my last error
	 NOERR
	HRRZS T2		; zero left half
	TXNE F,F%TAK		; are we doing a TAKE command?
	 CAIE T2,IOX4		; yes ... end of input file?
	  SKIPA			; not in TAKE mode or not EOF
	   JRST .TAKND		; yes so go handle it
				; now handle error message etc...
	ETYPE <NETSRV - Fatal JSYS error in main fork at PC >
	MOVEI FP,.PRIOU		; output to TTY
	HRRZ P2,0(P)		; get the error PC
	CALL PCPNT
	ETYPE <NETSRV - Error string .... >
	MOVEI T1,.PRIOU		; output to TTY
	MOVX T2,<.FHSLF,,-1>	; this fork's last error
	SETZB T3,T4
	ERSTR%			; output the error string
	 NOERR
	 NOERR
	SKIPE DDTADR		; DDT present?
	 SKIPN DBUGSW		; debugging mode?
	  SKIPA			; no and/or no
	   JRST DDTADR		; yes and yes so go to DDT
	ETYPE <NETSRV - Attempting to restart .... if possible>
	AOS T1,ERRCNT		; bump the error count
	CAIG T1,ERRMAX		; have we exceeded error max?
	 JRST NTSRV2		; no so restart
	ETYPE <NETSRV - ERRMAX exceeded .... can not restart>
	HALTF%			; stop
	JRST .-1		; no continues
	SUBTTL Routine to log network status changes

NETLOG:				; routine to log network status change
	GXNN GF%LOG		; are we logging?
	 RET			; no so just return
	CALL LOKFIL		; get file buffer
	CALL TSTAMP		; do a time stamp
	FTYPEN <ARPANET Status Change.  IMP is >
	MOVEI T1,.NETRDY	; get GETAB% AC
	GETAB%			; get IMP state
	 JSYSF
	HRROI T2,[ASCIZ/Up/]	; assume up
	SKIPL T1		; is IMP up?
	 HRROI T2,[ASCIZ/Down/]	; no
	FTYPEA T2		; type out IMP status
	FTYPEN <, ARPANET is >
	MOVX T1,<1,,.NETRDY>	; get GETAB% AC
	GETAB%			; get network status
	 JSYSF
	HRROI T2,[ASCIZ/Up/]	; assume up
	SKIPL T2		; is network up?
	 HRROI T2,[ASCIZ/Down/]	; no
	FTYPEA T2		; output network status
	FTYPEC "."		; output a dot
	CALLRET ULKFIL		; unlock file buffer
	SUBTTL Routines to stop and kill server forks

SUSFRK:				; routine to reset a fork
	MOVE T1,FRKID(FX)	; get the fork handle
	HFORK%			; stop the fork
	 JSYSF
	MOVE T1,FRKID(FX)	; get the fork handle
	KFORK%			; kill the fork
	 JSYSF
	SETZM FRKID(FX)		; zero out its fork handle
	CALLRET FIXLOK		; fix any broken locks

KILFRK:				; routine to totally kill a fork
	SKIPN FRKRUN(FX)	; fork running?
	 JRST KILFR2		; no
	SETZM FRKRUN(FX)	; reset its running flag
	SETZM FRKICP(FX)	; clear its socket
	SKIPE FRKID(FX)		; does this fork exist for real?
	 CALLRET SUSFRK		; kill the actual fork
				; return to caller
KILFR2:				; here when fork wasn't running
	ETYPE <>
	TYPEA FRKNAM(FX)	; type out server name
	TYPEN <was not running>
	RET			; return to caller
	SUBTTL Routine to build and start server forks

STRFRK:				; routine to start a fork
	SETZM FRKERR(FX)	; reset error PC/flag area
	MOVX T1,<FRKACS,,FRKACS+1> ; get BLT AC
	SETZM FRKACS		; zero AC zero
	BLT T1,FRKACS+17	; zero all ACs
	MOVEM FX,FRKACS+FX	; save the fork index where fork can find it
	MOVX T1,<CR%CAP!CR%ACS>	; get flags for CFORK%
	MOVEI T2,FRKACS		; get address of ACs
	CFORK%			; create and start the fork
	 JSYSF			; handle errors
	MOVEM T1,FRKID(FX)	; save the fork handle
	SETZ P1,		; reset page index
STRFR2:				; page access settting loop
	MOVE T1,P1		; get the page number
	HRLI T1,.FHSLF		; this fork
	RMAP%			; read page access
	 JSYSF			; trap any errors
	TXNN T2,RM%PEX		; does page exist?
	 JRST STRFR3		; no
	MOVE T3,T2		; get access bits
	TXZ T3,<617377,,777777>	; turn off unwanted bits
	MOVE T1,P1		; get page number
	MOVE T2,P1		; for destination also
	HRLI T1,.FHSLF		; this fork
	HRL T2,FRKID(FX)	; new fork handle
	PMAP%			; map the page
	 JSYSF			; trap errors
STRFR3:				; here to incrment page number
	CAIGE P1,MAXPAG		; at last page?
	 AOJA P1,STRFR2		; no so keep going
				; now all pages are mapped
	SETOM FRKRUN(FX)	; set the fork active flag
	MOVE T1,FRKID(FX)	; get fork handle
	MOVEI T2,FRKSTR		; get fork start address
	SFORK%			; start the fork
	 JSYSF			; trap errors
	RET			; return to caller

FRKRST:				; server fork restart point
	MOVX T1,TIMSHT		; wait a second before restarting
	DISMS%
FRKSTR:				; server fork start point
	MOVX F,F%SRV		; make sure all flags clear
	SETOM FRKRUN(FX)	; and this fork flagged as running
	SETZM FRKINC(FX)	; and okint/noint count set right
	SETZM FRKERR(FX)	; reset fork error flag
	JRST @FRKDSP(FX)	; restart fork

GOFORK:				; routine to start a new fork
	SKIPE FRKRUN(FX)	; is this fork running?
	 JRST GOFRK2		; yes
	CALLRET STRFRK		; no so start the fork
				; return to caller
GOFRK2:				; here when fork is already running
	ETYPE <>
	TYPEA FRKNAM(FX)	; type out fork name
	TYPEN < already running>
	RET			; return to caller

RSTART:				; routine to restart forks
	SETZ FX,		; reset fork index
RSTAR2:				; fork scanning loop
	SKIPE FRKRUN(FX)	; fork active?
	 CALL STRFRK		; yes so restart it
	CAIGE FX,MAXFRK		; all forks checked?
	 AOJA FX,RSTAR2		; no so keep going
	RET			; return to caller
	SUBTTL LOCK/UNLOCK and NOINT/OKINT support routines

.LOCK:				; routine to wait for lock in NX
	AOSN (NX)		; lock?
	 JRST .LOCK3		; yes
	MOVEI T1,TIMSHT		; short wait
	DISMS%			; snooze
	 NOERR
	JRST .LOCK		; try again
.LOCK3:				; here when we locked it
	MOVEM FX,1(NX)		; mark that we locked it
	RET			; return to caller

.UNLOC:				; unlocking routine
				; lock adr is in NX
	SETOM 1(NX)		; reset the who word
	SETOM 0(NX)		; reset the lock itself
	RET			; return to caller

.NOINT:				; support routine for noint
	SKIPG FRKINC(FX)	; allready done?
	 AOSA FRKINC(FX)	; yes so bump it again
	  SKIPA			; always skip
	   RET			; all done so return
	SKIPE FRKINC(FX)	; is it zero?
	 JRST .NOIN2		; no
	MOVEI T1,.FHSLF		; this fork
	DIR			; disable interrupt requests
	 JSYSF
	AOS FRKINC(FX)		; bump counter
	RET			; return to caller
.NOIN2:				; here on badness
	MOVEM T1,FRKERR(FX)	; save T1
	MOVEI T1,.BADOK		; bad okint/noint code
	EXCH T1,FRKERR(FX)	; save error code and restore T1
	HALTF			; on badness just die
	JRST .-1		; should never happen

.OKINT:				; support for okint macro
	SOSE FRKINC(FX)		; decrement the count
	 JRST .OKIN2		; not zero
	MOVEI T1,.FHSLF		; this fork
	EIR			; enable interrupt requests
	 JSYSF
	RET			; return to caller
.OKIN2:				; not zero after decrement when here
	SKIPL FRKINC(FX)	; negative?
	 RET			; no so just return
	MOVEM T1,FRKERR(FX)	; save T1
	MOVEI T1,.BADOK		; get error code
	EXCH T1,FRKERR(FX)	; save error code and restore T1
	HALTF			; on badness stop
	JRST .-1
	SUBTTL LOCK maintainence routines

FIXLOK:				; routine to fix all locks
	CAME FX,SKTLCK+1	; did this fork have socket lock?
	 JRST FIXLK2		; no
	SETOM SKTLCK+1		; yes so reset the lock
	SETOM SKTLCK+0
FIXLK2:
	CAME FX,FILOCK+1	; did this fork have file lock?
	 JRST FIXLK3		; no
	SETOM FILOCK+1		; yes so reset the lock
	SETOM FILOCK+0
FIXLK3:
	RET			; return to caller

INILOK:				; routine to initialize locks
	SETOM SKTLCK
	SETOM SKTLCK+1
	SETOM FILOCK
	SETOM FILOCK+1
	RET			; return to caller
	SUBTTL File and socket LOCK/UNLOCK routines

ASNSKT:				; assign socket routine
	LOCK SKTLCK		; lock down sockets
	MOVE T1,SOCKET		; get the socket number
	CAIGE T1,MAXSKT		; is it past allowable sockets?
	 JRST ASNSK2		; no
	MOVEI T1,MINSKT		; yes so get initial socket again
	MOVEM T1,SOCKET		; and save it
ASNSK2:				; here to bump count for new socket
	MOVEM T1,LCLSKR(FX)	; save the relative socket number
	AOS SOCKET		; bump the count
	AOS SOCKET		; again
	UNLOCK SKTLCK		; unlock the lock
	RET			; return to caller

LOKFIL:				; routine to lock down the file buffer
	LOCK FILOCK		; get the lock
	SKIPN FP,BUFPTR		; get the buffer pointer
	 MOVE FP,BUFONE		; not set up yet
	RET			; return to caller

ULKFIL:				; routine to unlock down file buffer
	MOVEM FP,BUFPTR		; save the buffer pointer
	HRRZS FP		; get rid of left half
	SUBI FP,BUFFER		; compute amount of used space
	CAIL FP,<BUFSIZ/5>-^D20	; within 100 chars of end of buffer?
	 JRST DMPFI0		; yes - dump out buffer
	UNLOCK FILOCK		; unlock it
	RET			; return to caller

TSTAMP:				; time stamp routine
	FTYPE <>		; do a CRLF
	MOVE T1,FP
	SETO T2,		; current date/time
	MOVX T3,<OT%SLA>	; flags for ODTIM%
	ODTIM%			; output date/time
	 JSYSF			; trap errors
	MOVE FP,T1		; update pointer AC
	FTYPEC " "		; do a space
	RET			; return to caller
	SUBTTL Log file initializing routine

INIFIL:				; routine to initialize log file
	GXNN GF%LOG		; are we logging?
	 RET			; no so just return
	CALL LOKFIL		; get buffer pointer
	CALL TSTAMP		; do a time stamp
	FTYPEN <NETSRV Version >
	MOVEI T2,VMAJOR		; get major version number
	FNUMO T2,10,0		; output major version number
	MOVEI T2,VMINOR		; get minor version number
	JUMPE T2,INIFI2		; if zero ignore
	FTYPEC "."		; do a dot
	MOVEI T2,VMINOR		; get minor version number again
	FNUMO T2,10,0		; output minor version number
INIFI2:
	MOVEI T2,VEDIT		; get edit number
	JUMPE T2,INIFI3		; if zero ignore
	FTYPEC "("		; open paren
	MOVEI T2,VEDIT		; get edit number again
	FNUMO T2,10,0		; output edit number
	FTYPEC ")"		; close paren
INIFI3:
	MOVEI T2,VWHO		; get who code
	JUMPE T2,INIFI4		; if zero ignore
	FTYPEC "-"		; do a dash
	MOVEI T2,VWHO		; get who code again
	FNUMO T2,10,0		; output who code
INIFI4:
	FTYPEN < Initialized>
	CALL ULKFIL		; unlock the file
	CALL NETLOG		; log network state
	CALLRET DMPFIL		; dump out the buffer
	SUBTTL Log file buffer emptying routine

DMPFIL:				; routine to empty file buffer
	STKVAR <DMPJFN>		; storage
	GXNN GF%LOG		; are we logging?
	 RET			; no so just return
	CALL LOKFIL		; lock down the file
	MOVE T1,BUFONE		; get initial buffer pointer
	SKIPE T2,ERRPTR		; and error pointer if any
	 CAMN T2,BF1PTR		; has error buffer moved?
	  CAME T1,FP		; or buffer pointer?
	   SKIPA		; yes
	    JRST DMPFI4		; no so just unlock and return
DMPFI0:				; here to write out the buffer
	MOVX T1,<GJ%SHT!<777776>B35> ; get bits for GTJFN%
	HRROI T2,LOGFIL		; get log file name string
	GTJFN%			; get a JFN on the file
	 JSYSF			; handle errors
	MOVEM T1,DMPJFN		; save the JFN
	MOVX T2,<7B5!OF%APP!OF%THW> ; get OPENF% bits
	OPENF%			; open up the file for I/O
	 ERJMP [CAIE T1,OPNX9	; simult. access error?
		 CALL .JSYSF	; no so handle error
		MOVE T1,DMPJFN	; get the JFN
		RLJFN%		; release the jfn
		 JSYSF
		JRST DMPFI4]	; return to caller
				; now see if it is regular buffer
	MOVE T2,BUFONE		; get initial pointer
	CAMN T2,FP		; has pointer changed?
	 JRST DMPFI2		; no
	SETZB T3,T4		; get a null byte
	IDPB T3,FP		; append a null byte
	SOUT%			; output the string
	 JSYSF			; handle errors
	MOVE FP,BUFONE		; get new buffer pointer
DMPFI2:				; now check the error buffer
	SKIPE T2,ERRPTR		; get error pointer
	 CAMN T2,BF1PTR		; has pointer changed?
	  JRST DMPFI3		; no or not set up
	MOVE T2,BF1PTR		; start of buffer
	SETZB T3,T4		; get null byte
	IDPB T3,ERRPTR		; append the null byte
	SOUT%			; output the buffer
	 JSYSF			; trap any errors
	MOVE T2,BF1PTR		; get initial byte pointer
	MOVEM T2,ERRPTR		; save new error pointer
DMPFI3:				; may fall through
	CLOSF%			; close the log file
	 JSYSF			; trap errors
DMPFI4:				; unlock and return
	CALLRET ULKFIL		; unlock the file lock
				; return to caller
	SUBTTL DOICP - Routine to do a network ICP

	COMMENT \

	This routine performs the ICP functions for all the servers
in NETSRV.  All arguments are from tables indexed by the fork number
(in FX).  Timeouts are set at strategic locations throughout the ICP
process so that problems can be detected and corrected quickly.

	The following timeouts are defined:

	o Timeout waiting for ICP socket connection to open after
	  we sent our RFC.

	o Timeout waiting for the allocation to be received from
	  the user host.

	o Timeout waiting for the data connections to open.

\

DOICP:				; routine to do the ICP work
	STKVAR <<NCPBLK,.NCFSK-.NCFHS+1>>
	SETZM ICPJFN(FX)	; reset JFNs and flags
	SETZM RCVJFN(FX)
	SETZM SNDJFN(FX)
	TXZ F,<F%ICP!F%RFC!F%SND!F%RCV>
				; now get handle on the socket
	MOVE T1,FRKICP(FX)	; get ICP socket
	SETZB T2,T3		; listen mode
	CALL NETABS		; get a handle on the socket
	MOVEM T1,ICPJFN(FX)	; save the JFN
	MOVEI T2,40		; 32 bit size
	SETO T3,		; male (send) socket
	MOVEI T4,ICPINT		; ICP interrupt socket
	CALL NETOPN		; open the socket
DOICP0:				; RFC wait loop
	CALL ICPCHK		; check ICP socket status
	TXNE F,F%ICP		; did ICP socket get open via race?
	 JRST DOICP3		; yes (bizzare)
	TXNE F,F%RFC		; RFC received?
	 JRST DOICP1		; yes
	WAIT%			; no so wait for status change
ICPWAT:				; symbol for status command to find
	JRST DOICP0		; wakeup .... go see if RFC received
DOICP1:
	ALARM TIMRFC,EXPIRE,<matching RFC after accept sent>
	CALL ICPCHK		; check ICP socket status
DOICP2:				; ICP socket open wait loop
	TXNE F,F%ICP		; ICP socket open
	 JRST DOICP3		; yes
	WAIT%			; wait for status change
	JRST DOICP2		; try again
DOICP3:				; here when ICP socket open
	CANCEL			; cancel the pending alarm
	MOVEI T1,.GTNJF		; return JFN status
	MOVE T2,ICPJFN(FX)	; get the JFN
	MOVEI T3,NCPBLK		; return data area
	MOVX T4,<-<.NCFSK-.NCFHS+1>,,.NCFHS> ; # of cells returned, first cell
	GTNCP%			; get the status
	 JSYSF
	MOVE T1,NCPBLK		; host number
	MOVEM T1,F4NHST(FX)	; save host number
	MOVE T1,<.NCFSK-.NCFHS>+NCPBLK ; foreign socket number
	MOVEM T1,F4NSKT(FX)	; save the socket number
	MOVE T1,ICPJFN(FX)	; get the JFN
	CALL NETOFF		; turn of interrupts
	CALL ASNSKT		; get us a socket to use
	MOVE T1,LCLSKR(FX)	; get our rcv socket (his send)
	MOVE T2,F4NHST(FX)	; get host number
	MOVE T3,F4NSKT(FX)	; get his socket number
	ADDI T3,3		; make it his send
	CALL NETJFN		; get a JFN on socket
	MOVEM T1,RCVJFN(FX)	; save the JFN
	MOVE T1,LCLSKR(FX)	; get local socket
	ADDI T1,1		; make it our send socket 
	MOVE T2,F4NHST(FX)	; get host number
	MOVE T3,F4NSKT(FX)	; get his socket number
	ADDI T3,2		; make it his rcv
	CALL NETJFN		; get the JFN
	MOVEM T1,SNDJFN(FX)	; save the JFN
	ALARM TIMALL,EXPIRE,<allocation to be received>
	MOVE T1,RCVJFN(FX)	; get our rcv socket JFN
	CVSKT%			; convert to absolute socket numbers
	 JSYSF			; trap errors
	MOVEM T2,LCLSKT(FX)	; save the absolute socket number
	MOVE T1,ICPJFN(FX)	; get the JFN
	BOUT%			; output the byte
	 JSYSF
	CANCEL			; cancel the pending alarm
	MOVE T1,ICPJFN(FX)	; get the JFN again
	CLOSF%			; close the socket
	 JSYSF
	NOINT			; no interrupts
	MOVE T1,RCVJFN(FX)	; get the receive socket JFN
	MOVEI T2,^D8		; 8-bit bytes
	SETZ T3,		; female socket
	MOVEI T4,SKTINT		; get int channel
	CALL NETOPN		; open the socket
	MOVE T1,SNDJFN(FX)	; get the send socket JFN
	MOVEI T2,^D8		; 8-bit bytes
	SETO T3,		; male socket
	MOVEI T4,SKTINT		; interrupt channel
	CALL NETOPN		; open the socket
	OKINT			; allow interrupts
	ALARM TIMOPN,EXPIRE,<data connections to open>
DOICP4:				; data socket wait loop
	CALL RCVCHK		; check receive status
	CALL SNDCHK		; check send status
	TXNE F,F%RCV		; receive open?
	 TXNN F,F%SND		; send open?
	  SKIPA			; no
	   JRST DOICP5		; yes
	WAIT%			; wait for the status change
	JRST DOICP4		; try again
DOICP5:				; here when all sockets open
	CANCEL			; cancel the pending alarm
	MOVE T1,RCVJFN(FX)	; get the receiving JFN
	CALL NETOFF		; dont let it bother us anymore
	MOVE T1,SNDJFN(FX)	; get the sending JFN
	CALLRET NETOFF		; don't let it bother us anymore either
	SUBTTL NETJFN - Routine to get a network JFN

	COMMENT \

	T1/  local socket number
	T2/  foreign host number
	T3/  foreign socket number

	CALL NETJFN ; for relative socket
	CALL NETABS ; for absolute socket

	T1/  JFN assigned

\

NETJFN:				; job relative entry point
	TDZA T4,T4		; reset flag
NETABS:				; absolute socket entry point
	 SETO T4,		; set flag
	STKVAR <NTJLCL,NTJHST,NTJSKT,NTJFLG,<NTJBUF,20>>
	MOVEM T1,NTJLCL		; save local socket number
	MOVEM T2,NTJHST		; save 4n host number
	MOVEM T3,NTJSKT		; save 4n socket number
	MOVEM T4,NTJFLG		; save the flag word
	HRROI T1,NTJBUF		; get buffer pointer
	HRROI T2,[ASCIZ/NET:/]	; get device
	SETZB T3,T4	
	SOUT%			; output device name string
	 JSYSF
	MOVE T2,NTJLCL		; get local socket number
	MOVEI T3,^D8		; in base 8
	NOUT%			; output local socket number
	 JSYSF
	SKIPN NTJFLG		; absolute mode?
	 JRST NETJF3		; no
	MOVEI T2,"V"-100	; get a control V
	IDPB T2,T1		; and output it
	MOVEI T2,"#"		; get absolute socket symbol
	IDPB T2,T1		; and output it
NETJF3:
	SKIPN NTJSKT		; listen mode?
	 JRST NETJF4		; yes
	MOVEI T2,"."		; get a dot
	IDPB T2,T1		; separate local side from foreign side
	MOVE T2,NTJHST		; get 4n host number
	MOVEI T3,^D8		; in base 8
	NOUT%			; output host number
	 JSYSF
	MOVEI T2,"-"		; get a delimetor
	IDPB T2,T1		; say we are now doing socket number
	MOVE T2,NTJSKT		; get the socket number
	MOVEI T3,^D8		; is base 8
	NOUT%			; output socket number
	 JSYSF
NETJF4:
	SETZ T2,		; get a null
	IDPB T2,T1		; append a null
	MOVX T1,<GJ%SHT>	; GTJFN% flags
	HRROI T2,NTJBUF		; get pointer to name
	GTJFN%			; get a JFN 
	 JSYSF
	RET			; return to caller
	SUBTTL NETOPN - Routine to open a network JFN

	COMMENT \

	T1/  JFN
	T2/  byte size
	T3/  sex
	T4/  interrupt channel

\

NETOPN:
	STKVAR <NTOJFN,NTOSIZ,NTOSEX,NTOINT>
	MOVEM T1,NTOJFN		; save the JFN
	MOVEM T2,NTOSIZ		; save the byte size
	MOVEM T3,NTOSEX		; save the sex
	MOVEM T4,NTOINT		; save the interrupt channel
	SETZ T2,		; zero the OPENF% flag word
	MOVE T3,NTOSIZ		; get the byte size
	DPB T3,[POINT 6,T2,5]	; deposit byte size
	MOVEI T3,6		; immediate return mode
	DPB T3,[POINT 4,T2,9]	; deposit mode
	SKIPE NTOSEX		; male mode?
	 TXOA T2,OF%WR		; yes so set write flag
	  TXO T2,OF%RD		; otherwise set read flag
	MOVE T1,NTOJFN		; get the JFN
	OPENF%			; send out an OPN
	 JSYSF
	MOVE T1,NTOJFN		; get the JFN
	MOVEI T2,.MOAIN		; assign interrupt channels function
	MOVX T3,<770000,,0>	; get interrupt channel word
	MOVE T4,NTOINT		; get interrupt channel
	DPB T4,[POINT 6,T3,17]	; deposit interrupt channel
	MTOPR%			; assign interrupts
	 JSYSF
	RET			; return to caller
	SUBTTL Socket status change interrupt handlers

.ICPSK:				; ICP socket status change
	CALL ICPSKR		; call worker routine
	DEBRK%			; dismiss

.SKTSK:				; data socket status change
	CALL SKTSKR		; call worker routine
	DEBRK%

ICPSKR:				; worker routine for ICP interrupts
	CALL SAVACS		; save interrupt ACs
	CALL ICPCHK		; check out the ICP socket
	CALLRET WAITGO		; return from wait condition and dismiss

SKTSKR:				; worker routine for data status interrupts
	CALL SAVACS		; save interrupt ACs
	CALL RCVCHK		; get the status of receive socket
	CALL SNDCHK		; check send socket status
	CALLRET WAITGO		; return from wait condition if needed
	SUBTTL Socket status change support routines

WAITGO:				; routine to cause return from WAIT%
				; by incrementing PC and setting user mode
	MOVE T3,FLVTAB(FX)	; get LEVTAB address
	MOVE T3,<STSINT-1>(T3)	; get PC storage address
	MOVE T1,(T3)		; get the actual PC
	MOVX T2,<WAIT%>		; get the code for a WAIT%
	CAME T2,-1(T1)		; was it a WAIT%?
	 RET			; no so return to user
	TXO T1,PC%USR		; turn on user mode flag
	MOVEM T1,(T3)		; set the new PC
	RET			; return to caller

NETOFF:				; routine to disable network interrupts
	MOVEI T2,.MOAIN		; get MTOPR% finction code
	MOVX T3,<770077,,0>	; get interrupt chaannel word
	MTOPR%			; disable interrupts
	 JSYSF			; handle errors
	RET			; return to caller

SAVACS:				; routine to save AC0-AC16 for interrupts
	ADJSP P,16		; claim words for ACs 1-16 on the stack
	MOVEM AC16,0(P)		; save AC16
	MOVEI AC16,-15(P)	; get right half of BLT AC
	HRLI AC16,AC1		; get left half of BLT AC
	BLT AC16,-1(P)		; save ACs 1-15 on stack
	CALL @-16(P)		; co-routine back to caller
				; POPJ will return to here
	 SKIPA			; non-skip return
	  AOS -17(P)		; skip return
	HRRI AC16,AC1		; get right half of BLT AC
	HRLI AC16,-15(P)	; get left half of BLT AC
	BLT AC16,AC16		; restore ACs 1-16
	ADJSP P,-17		; discard saved ACs and first return
	RET			; return to caller
	SUBTTL Socket status routines

SKTSTS:				; routine to get socket status code
	GDSTS%			; get status
	 JSYSF
	LDB T1,[POINT 4,T2,3]	; get status code
	RET			; return to caller

RCVCHK:				; routine to check receive socket status
	MOVE T1,RCVJFN(FX)	; get the JFN
	CALL SKTSTS		; get status
	CAIN T1,.NSOPN		; open?
	 TXO F,F%RCV		; yes so set flag
	RET			; return to caller

SNDCHK:				; routine to check send socket status
	MOVE T1,SNDJFN(FX)	; get JFN
	CALL SKTSTS		; get status
	CAIN T1,.NSOPN		; open?
	 TXO F,F%SND		; yes so set flag
	RET			; return to caller

ICPCHK:				; routine to check ICP socket status
	MOVE T1,ICPJFN(FX)	; get the JFN
	CALL SKTSTS		; get status code
	CAIE T1,.NSOPN		; open?
	 JRST ICPCH2		; no
	TXO F,F%ICP		; yes so set flag
	RET			; return to caller
ICPCH2:				; see if its a RFC received
	CAIE T1,.NSRCR		; RFC received?
	 RET			; no so just return
	TXO F,F%RFC		; yes so set flag
				; unlike multics we accept all connections
	MOVE T1,ICPJFN(FX)	; get the JFN
	MOVEI T2,.MOACP		; accept connection function
	MTOPR%			; send out matching RFC
	 JSYSF
	RET			; return to caller
	SUBTTL Alarm macro support routines

ALARMS:				; routine to set an alarm
				; T1 / time
				; T2 / new address after alarm
				; T3/  string of alarm reason
	MOVEM T3,ALRMST(FX)	; save the string pointer
	MOVEM T2,ALRMPC(FX)	; save the new PC
	MOVE T2,T1		; get the time to interrupt
	MOVEI T3,FALARM		; get the interrupt channel number
	MOVX T1,<.FHSLF,,.TIMEL> ; elapsed time interrupt
	TIMER%			; set the timer
	 JSYSF			; handle errors
	RET			; return to caller

ALARMC:				; routine to cancel all alarms
	MOVX T1,<.FHSLF,,.TIMAL> ; get data for timer
	TIMER%			; cancel all timer requests for us
	 JSYSF
	RET			; return to caller
	SUBTTL Alarm interrupt handler and support routines

.ALARM:				; alarm interrupt handler
	CALL ALARMR		; call worker routine
	DEBRK%			; dismiss interrupt to a new PC

ALARMR:				; worker routine for alarms
	CALL SAVACS		; save interrupt ACs
	MOVE T1,FLVTAB(FX)	; get LEVTAB address
	MOVE T1,<ALMINT-1>(T1)	; get the PC address
	MOVE T2,ALRMPC(FX)	; get the alarm expired new PC
	TXO T2,PC%USR		; turn on user mode flag
	MOVEM T2,(T1)		; and save new PC
	RET			; dismiss interrupt

EXPIRE:				; here to handle expired alarm
	MOVEM T1,FRKERR(FX)	; save T1
	MOVEI T1,.ALMXP		; get alarm expired code
	EXCH T1,FRKERR(FX)	; save code and restore T1
	HALTF%			; stop and let mother fix us
	JRST .-1		; this should never happen
	SUBTTL TELNET servers

OTELNT:				; old TELNET server
	TXO F,F%OLD		; set flag for old protocol TELNET
TELNET:				; new TELNET server (and common code for 
				; old TELNET)
	MOVE P,FPDLP(FX)	; get a stack pointer
	CALL SETUP		; setup initial stuff
TELNE2:				; this is the loop
	MOVE P,FPDLP(FX)	; get a stack pointer
	CALL CLNJFN		; clean up any old JFNs
	CALL DOICP		; do the ICP
	CALL DONVT		; get a new NVT
	 JRST TELNE3		; sockets got closed so just log it
	CALL DOMSG		; type message if needed
	CALL DOCCC		; do a Control C for the user
TELNE3:
	CALL DOLOG		; log this if needed
	AOS FRKCNT(FX)		; bump contact count
	JRST TELNE2		; and loop forever

	IFN FT.SCR,<		; only if SECURE TELNET

SECURE:				; secure telnet server
	MOVE P,FPDLP(FX)	; get a stack pointer
	TXO F,F%PRV		; we need privs
	CALL SETUP		; setup initial stuff
SECUR2:				; this is the loop
	MOVE P,FPDLP(FX)	; get a new stack pointer
	CALL CLNJFN		; clean up any old jfns
	CALL DOICP		; do the ICP
	CALL DOJOB		; get a job running the cusp
	 NOOP
SECUR3:
	CALL DOLOG		; log this connections
	AOS FRKCNT(FX)		; bump contact count
	JRST SECUR2		; and loop forever

>				; end of IFN FT.SCR
	SUBTTL FTP Server

FTP:	 TXO F,F%PRV		; server for FTP
	TXO F,F%OLD		; set the old TELNET flag and server flag
	MOVE P,FPDLP(FX)	; get a stack pointer
	CALL SETUP		; setup initial stuff
FTP2:				; this is the loop of the FTP server
	MOVE P,FPDLP(FX)	; get a stack pointer
	CALL CLNJFN		; clean up old cretinous JFNs
	CALL DOICP		; do the ICP
	CALL DOJOB		; get a job running FTPSER
	 NOOP			; ignore error return
	CALL DOLOG		; log this if needed
	AOS FRKCNT(FX)		; bump contact count
	JRST FTP2		; and loop forever
	SUBTTL FINGER server

IFN FT.FNG,<			; Only if FINGER on

FINGER:				; FINGER server
	TXO F,F%OLD		; we are an old server
	MOVE P,FPDLP(FX)	; get stack pointer
	CALL SETUP		; set up interrupt system etc...
	STKVAR <FINGFH,<FNGBUF,^D21>>
FINGE2:				; loop of the server
	MOVE P,FPDLP(FX)	; get stack pointer
	CALL CLNJFN		; clean up JFNs
	CALL DOICP		; do the ICP
	SETZM NVTDES(FX)	; reset the NVT designator for logger
	MOVX T1,<GJ%OLD!GJ%SHT>	; try to get FINGER
	HRROI T2,[ASCIZ/SYS:FINGER.EXE/]
	GTJFN%			; get JFN on FINGER
	 JSYSF
	MOVEM T1,FINGFH		; save JFN
	MOVX T1,CR%CAP		; make an inferior fork
	CFORK%
	 JSYSF
	EXCH T1,FINGFH		; save fork handle, get JFN
	HRL T1,FINGFH		; stuff the fork
	GET%
	 JSYSF
	ALARM TIMFNG,EXPIRE,<FINGER command from user>
	MOVE T1,RCVJFN(FX)	; get command from FINGER user
	DMOVE T3,[POINT 7,1+FNGBUF ; into FINGER buffer (limit 94 chars)
		  ASCII/FING /]
	MOVEM T4,FNGBUF		; set up FING command in buffer first
	MOVEI T4,<5*^D20>-1
FINGE1:	BIN%			; get character from user process
	 JSYSF
	IDPB T2,T3		; save in buffer
	CAIE T2,.CHLFD		; terminating LF?
	 SOJG T4,FINGE1
	SETZ T2,		; tie off line
	IDPB T2,T3
	CANCEL			; cancel the FINGER alarm
	HRROI T1,FNGBUF		; set buffer up with FINGER command
	RSCAN%
	 JSYSF
	MOVE T1,FINGFH		; get the fork handle back
	HRRO T2,SNDJFN(FX)	; output JFN for FINGER in RH
	SPJFN%
	 JSYSF
	SETZ T2,		; position 0 of entry vector
	SFRKV%			; start it
	 JSYSF
	WFORK%			; wait for it to terminate
	 JSYSF
	KFORK%			; finally kill the fork
	 JSYSF
	MOVX T1,SIXBIT/NETSRV/	; set our name in case FINGER clobbered it
	SETNM%
	CALL SNDCLS		; close the connections
	CALL DOLOG
	AOS FRKCNT(FX)		; bump contact count
	JRST FINGE2		; and loop
>				; end of IFN FT.FNG
	SUBTTL SYSTAT server

SYSTAT:				; SYSTAT server
	TXO F,F%OLD		; we are an old server
	MOVE P,FPDLP(FX)	; get stack pointer
	CALL SETUP		; set up interrupt system etc...
	STKVAR <TMPJFN,EXECFH>
SYSTA2:				; loop of the server
	MOVE P,FPDLP(FX)	; get stack pointer
	CALL CLNJFN		; clean up JFNs
	CALL DOICP		; do the ICP
	SETZM NVTDES(FX)	; reset the NVT designator for logger
	MOVX T1,<GJ%SHT!GJ%TMP>	; create a command file for inferior EXEC
	HRROI T2,[ASCIZ/SYSTEM:NETSRV-SYSTAT.TMP/]
	GTJFN%			; get a JFN on the file
	 JSYSF
	MOVEM T1,TMPJFN		; save JFN for later
	MOVX T2,<7B5!OF%WR>	; open the file for write
	OPENF%
	 JSYSF
	HRROI T2,[ASCIZ/SYSTAT
POP
/]
	SETZB T3,T4
	SOUT%
	HRLI T1,(CO%NRJ)	; don't release the JFN
	CLOSF%
	 JSYSF
	MOVX T1,<GJ%OLD!GJ%SHT>	; try to get an EXEC
	HRROI T2,[ASCIZ/SYSTEM:EXEC.EXE/]
	GTJFN%			; get JFN on the EXEC
	 JSYSF
	MOVEM T1,EXECFH		; save JFN
	MOVX T1,CR%CAP		; make an inferior fork
	CFORK%
	 JSYSF
	EXCH T1,EXECFH		; save fork handle, get JFN
	HRL T1,EXECFH		; stuff the fork
	GET%
	 JSYSF
	MOVE T1,TMPJFN		; get JFN of file we just made back
	MOVX T2,<7B5!OF%RD>	; open the file for read now
	OPENF%
	 JSYSF
	MOVE T1,EXECFH		; get the fork handle back
	HRL T2,TMPJFN		; command file for EXEC in LH
	HRR T2,SNDJFN(FX)	; output JFN for EXEC in RH
	SPJFN%
	 JSYSF
	SETZ T2,		; position 0 of entry vector
	SFRKV%			; start it
	 JSYSF
	WFORK%			; wait for it to terminate
	 JSYSF
	KFORK%			; finally kill the fork
	 JSYSF
	MOVE T1,TMPJFN		; get back file JFN
	HRLI T1,(CO%NRJ)	; don't release the JFN
	CLOSF%
	 JSYSF
	HRLI T1,(DF%EXP)	; delete and expunge the file
	DELF%			; defenestration!
	 JSYSF
	MOVE T1,SNDJFN(FX)	; get the sending JFN
	HRROI T2,[ASCIZ/
/]				; get a CRLF
	SETZB T3,T4
	SOUT%			; out the CRLF
	 JSYSF
	CALL SNDCLS		; close the connections
	CALL DOLOG
	AOS FRKCNT(FX)		; bump contact count
	JRST SYSTA2		; and loop
	SUBTTL Date/time server

DATIME:				; Date/Time server
	TXO F,F%OLD		; we are an old server
	MOVE P,FPDLP(FX)	; get stack pointer
	CALL SETUP		; set up interrupt system etc...
DATIM2:				; loop of the server
	MOVE P,FPDLP(FX)	; get stack pointer
	CALL CLNJFN		; clean up JFNs
	CALL DOICP		; do the ICP
	SETZM NVTDES(FX)	; reset the NVT designator for logger
	MOVE T1,SNDJFN(FX)	; get the sending JFN
	SETO T2,		; the current date/time
	MOVX T3,<OT%DAY!OT%FDY!OT%FMN!OT%4YR!OT%DAM!OT%SPA!OT%12H!OT%TMZ!OT%SCL>
	ODTIM%			; output date/time
	 JSYSF
	HRROI T2,[ASCIZ/
/]				; get a CRLF
	SETZB T3,T4
	SOUT%			; out the CRLF
	 JSYSF
	CALL SNDCLS		; close the connections
	CALL DOLOG
	AOS FRKCNT(FX)		; bump contact count
	JRST DATIM2		; and loop
	SUBTTL NETSTAT server

NETSTA:				; server for NETSTAT
	TXO F,F%OLD		; set old protocol and server flag
	MOVE P,FPDLP(FX)	; get a stack pointer
	CALL SETUP		; set up PSI etc...
NETST2:				; main loop for the server
	MOVE P,FPDLP(FX)	; get a stack pointer
	CALL CLNJFN		; get rid of old JFNs etc...
	CALL DOICP		; do the ICP
	CALL DOJOBN		; get NETSTAT.EXE in a job our special way
	 NOOP			; ignore error return
	CALL DOLOG		; log this if needed
	AOS FRKCNT(FX)		; bump contact count
	JRST NETST2		; go back and do it again
	SUBTTL TTYTST server

TTYTST:				; TTY test server
	TXO F,F%OLD		; we are an old server
	MOVE P,FPDLP(FX)	; get PDL pointer
	CALL SETUP		; setup the PSI system etc...
TTYTS2:				; TTYTST server loop
	MOVE P,FPDLP(FX)	; get PDL pointer
	CALL CLNJFN		; clean up old JFNs
	CALL DOICP		; do the ICP
	SETZM NVTDES(FX)	; we have no NVT
	MOVE T1,SNDJFN(FX)	; get the send JFN
	HRROI T2,TTYTXT		; get the TTYTST text message
	SETZB T3,T4
	SOUT%			; output the test message
	 JSYSF			; handle errors
	CALL SNDCLS		; close the connections
	CALL DOLOG		; log it if needed
	AOS FRKCNT(FX)		; bump contact count
	JRST TTYTS2		; and loop forever
	SUBTTL Support routines for NVT's

	COMMENT \

	The ATNVT% Jsys has only a finite time to return.  If it
exceeds its time a timeout will occur and the created job will be 
killed.

\

DONVT:				; get an NVT
				; non-skip return if sockets got closed
				; if flag F%OLD is then use old TELNET
	CALL RCVCHK		; check status of receive socket
	CAIE T1,.NSOPN		; is it open?
	 CAIN T1,.NSRCS		; RFC sent?
	  SKIPA			; RFCS or OPND so skip
	   JRST DONVT2		; no
	CALL SNDCHK		; check status of send socket
	CAIE T1,.NSOPN		; is it open?
	 CAIN T1,.NSRCS		; RFC sent status?
	  SKIPA			; RFCS or OPND so skip
	   JRST DONVT2		; no
	ALARM TIMNVT,EXPIRE,<return from ATNVT% JSYS>
	MOVE T1,RCVJFN(FX)	; get receive JFN
	MOVE T2,SNDJFN(FX)	; get the send JFN
	TXNN F,F%OLD		; old or new protocol?
	 TXO T1,AT%NTP		; new so set the option
	ATNVT%			; attach NVT
	 JSYSF			; trap errors (this jsys screws up a lot)
	MOVEM T1,NVTDES(FX)	; save the NVT designator
	RFMOD%			; get file mode word
	 JSYSF
	TXO T2,TT%LCA		; set lower case exists flag
	STPAR%			; set the parameter
	 JSYSF
	MOVE T1,NVTDES(FX)	; get the NVT device deignator
	MOVEI T2,.MOSLW		; set TTY line width function
	SETZ T3,		; new width is zero
	MTOPR%			; set the line width
	 JSYSF
	CANCEL			; cancel pending alarm
	RETSKP			; return to caller
DONVT2:				; here when the sockets got closed
	CALL SNDCLS		; close out the connections
	RET			; return with non-skip return

DOCCC:				; routine to do the Control-C's to the NVT
	MOVE T1,NVTDES(FX)	; get the designator
	MOVEI T2,"C"-100	; get Control-C
	STI%			; simulate terminal input
	 JSYSF			; trap errors
	RET			; return to caller

DOMSG:				; routine to type the actual message
	GXNN GF%MSG		; are we typing messages?
	 RET			; no so just return
	MOVE T1,NVTDES(FX)	; get device designator for the NVT
	HRROI T2,MSGLOG		; get a pointer to the message
	SETZB T3,T4
	SOUT%			; output the string
	 JSYSF
	RET			; return to caller
	SUBTTL Routines to clean up resources and connections

CLNJFN:				; close and release all JFNs
	SETO T1,		; all
	CLOSF%			; close all JFNs
	 JSYSF			; errors should not happen
	SETO T1,		; all
	RLJFN%			; release all JFNs
	 JSYSF			; should not be any errors
	RET			; return to caller

SNDCLS:				; routine to close network connections
	MOVE T1,RCVJFN(FX)	; get receive JFN
	CLOSF%			; close it
	 JSYSF
	MOVE T1,SNDJFN(FX)	; get the send JFN
	CLOSF%			; close it
	 JSYSF
	RET			; return to caller
	SUBTTL SETUP - Routine to initialize each server

SETUP:				; routine to setup initial stuff
	RESET%			; reset the world
	CANCEL			; reset all pending alarms
	IFN FT.FST,<		; only if we need fast mode
	MOVEI T1,.FHSLF		; this fork
	MOVEI T2,1		; we want queue zero only
	SPRIW%			; set JOBBIT priority word
	 JSYSF			; trap errors
>				; end of IFN FT.FST
	SETZM FRKJOB(FX)	; reset job number flag
				; now enable the interrupt system
	MOVEI T1,.FHSLF		; this fork
	HRL T2,FLVTAB(FX)	; get the LEVTAB address
	HRRI T2,CHNFRK		; get the channel address
	SIR%			; setup interrupt tables
	 JSYSF			; if errors we are really messed up
	MOVX T2,FRKMSK		; get active channel mask
	AIC%			; activate interrupt channels
	 JSYSF			; trap errors
	EIR%			; enable interrupt requests
	 JSYSF			; trap errors
	RET			; return to caller
	SUBTTL DOJOB - Routine to startup a subsystem in a new job

	COMMENT \

	The CRJOB jsys has only a finite time to return.  If it
times out then the connections will be closed.  The ATACH Jsys
may also time out.

\

DOJOB:				; routine to get a job
	STKVAR <<CRJARG,.CJSLO+1>>
	HRLI T1,CRJARG
	HLRS T1			; get the right half
	ADDI T1,1		; bump the right half
	MOVEI T2,.CJSLO+CRJARG	; get last adr to zero
	SETZM CRJARG		; zero the first location
	BLT T1,(T2)		; zero the CRJOB% arg block
	MOVE T1,FRKSUB(FX)	; get subsystem name pointer
	MOVEM T1,.CJFIL+CRJARG	; save the file name pointer
	MOVEI T1,.NULIO		; get TTY designator
	MOVEM T1,.CJTTY+CRJARG	; new job is detached
	ALARM TIMCRJ,EXPIRE,<CRJOB% JSYS return>
	MOVX T1,<CJ%FIL!CJ%WTA>	; wait until attached before starting
	TXNE F,F%PRV		; should server run privileged?
	 TXO T1,CJ%CAP		; yes, give it my capabilities
	MOVEI T2,CRJARG		; get address of argument block
DOJOB2:				; alternate entry point
	CRJOB%			; create the job
	 JSYSF			; trap errors
	MOVEM T1,FRKJOB(FX)	; save the job number
	CANCEL			; cancel pending alarm
	CALL DONVT		; now get an NVT
	 JRST DOJOB3		; if connections got closed handle it
	ALARM TIMATC,EXPIRE,<ATACH% JSYS return>
	MOVE T1,FRKJOB(FX)	; get the job number back
	TXO T1,<AT%TRM>		; attach jsys flags
	SETZB T2,T3
	MOVE T4,NVTDES(FX)	; get the TTY number to use
	ATACH%			; put the job where it belongs
	 JSYSF			; handle errors
	CANCEL			; cancel pending alarm
	SETZM FRKJOB(FX)	; zero out job indicator
	RETSKP			; return to caller
DOJOB3:				; here if connections got closed
	MOVE T1,FRKJOB(FX)	; get the job we made
	LGOUT%			; kill it
	 JSYSF			; handle errors
	RET			; return at error return
	SUBTTL DOJOBN - Routine to start up NETSTAT.EXE

DOJOBN:				; routine to CRJOB% NETSTAT.EXE the correct way
	STKVAR <<DJNARG,.CJSLO+1>,<DJNACS,20>>
	HRLI T1,DJNARG		; get half of BLT AC
	HLRS T1			; get the other half
	ADDI T1,1		; increment right half
	MOVEI T2,.CJSLO+DJNARG	; get last adr to zero
	SETZM DJNARG		; zero the first location
	BLT T1,(T2)		; zero the entire argument block
	HRLI T1,DJNACS		; get half of another BLT AC
	HLRS T1			; get the other half
	ADDI T1,1		; increment right half adr
	MOVEI T2,AC17+DJNACS	; get last adr to zero
	SETZM DJNACS		; zero the first location
	BLT T1,(T2)		; zero entire AC block
	MOVE T1,FRKSUB(FX)	; get subsystem pointer
	MOVEM T1,.CJFIL+DJNARG	; put it in proper place
	MOVEI T1,.NULIO		; initial TTY in none
	MOVEM T1,.CJTTY+DJNARG	; put it in proper place
	MOVEI T1,NTSTSO		; get the NETSTAT evec offset
	MOVEM T1,.CJSFV+DJNARG	; put it in proper place
	SETOM AC0+DJNACS	; insert AC arguments
	SETOM AC1+DJNACS
	MOVEI T1,DJNACS		; get address of ACs
	MOVEM T1,.CJACS+DJNARG	; put address of AC block in correct place
	ALARM TIMCRJ,EXPIRE,<CRJOB% jsys return for DOJOBN>
	MOVX T1,<CJ%FIL!CJ%WTA!CJ%ACS> ; get flags for CRJOB%
	MOVEI T2,DJNARG		; get address of arg block
	CALLRET DOJOB2		; use common code for actual CRJOB%
	SUBTTL Routine to load message file

LOADMS:				; routine to load the message
	STKVAR <LODJFN>		; JFN storage
	MOVEM T1,LODJFN		; save the JFN
	GXZ GF%MSG		; turn off the flag
	MOVX T2,<7B5!OF%RD!OF%THW> ; we want to read the file
	OPENF%			; open up the file for reading
	 JSYSF			; handle the error
	MOVE T5,[POINT 7,MSGLOG] ; get pointer to message buffer
	MOVEI T4,MSGSIZ		; get number of chars that will fit in buffer
LOADM2:				; load file loop
	MOVE T1,LODJFN		; get the JFN
	BIN%			; read in a byte
	 ERJMP LOADM3		; on error assume EOF
	SOJLE T4,LOADM3		; make sure we dont overflow
	IDPB T2,T5		; deposit the byte
	JRST LOADM2		; loop until EOF
LOADM3:				; here on EOF or overflow
	SETZ T2,		; get a null byte
	IDPB T2,T5		; deposit it
				; close the file since we no longer need it
	CLOSF%			; close the file and release JFN
	 JSYSF
	GXO GF%MSG		; turn flag back on
LOADM6:
	RET			; return to caller
	SUBTTL Routine to log server activity

DOLOG:				; routine to log server activity
	GXNN GF%LOG		; are we logging?
	 RET			; no so just return
	STKVAR <<DLGHST,20>>	; get local storage
	CALL LOKFIL		; lock down the buffer
	CALL TSTAMP		; output time stamp
	FTYPEA FRKNAM(FX)	; output fork name
	FTYPEN < Host: >
	MOVEI T1,.GTHNS		; host name string function
	HRROI T2,DLGHST		; output host name to local buffer
	MOVE T3,F4NHST(FX)	; get the host number
	GTHST%			; output the host name
	 ERJMP DOLOG5		; if error handle it
	MOVEI T1,HSTNMS		; get host size
	MOVE T2,[POINT 7,DLGHST] ; get byte pointer to name
DOLOG2:				; output loop for host name
	ILDB T3,T2		; get a byte
	JUMPE T3,DOLOG3		; if null get do padding
	 IDPB T3,FP		; deposit the byte into the buffer
	SOJG T1,DOLOG2		; keep looping until max size or null
DOLOG3:				; here on null or max size
	JUMPLE T1,DOLOG6	; if padding done get out of loop
	MOVEI T3," "		; get an ascii space
	IDPB T3,FP		; output the padding character
	SOJA T1,DOLOG3		; and do all padding
DOLOG5:				; here when GTHST gave us an error
	FNUMO F4NHST(FX),10,HSTNMS ; output host number in octal
DOLOG6:				; may fall through from above
	FTYPEN <, 4n socket: >
	FNUMO F4NSKT(FX),10,13	; output socket number
	FTYPEN <, Lcl socket:  >
	FNUMO LCLSKT(FX),10,13	; output local socket number
	SKIPN NVTDES(FX)	; get the NVT designator
	 JRST DOLOG7		; no NVT if zero
	FTYPEN <, TTY:  >
	MOVE T2,NVTDES(FX)	; get the NVT designator
	TXZ T2,.TTDES		; turn off TTY designator bit
	FNUMO T2,10,3		; output TTY number
DOLOG7:
	CALLRET ULKFIL		; unlock file lock
				; return to caller
	SUBTTL Entry and exit routine for stack variable facility

.STKST:
	ADD P,0(AC16)		; bump stack for variables used
	JUMPGE P,STKSOV		; test for stack overflow
STKSE1:
	PUSH P,0(AC16)		; save block size for return
	CALL 1(AC16)		; continue routine, exit to .+1
.STKRT:
	 JRST [	POP P,AC16	; recover count
		SUB P,AC16	; adjust stack to remove block
		RET]		; do non-skip return
	POP P,AC16		; skip return comes here, recover count
	SUB P,AC16		; adjust stack to remove block
RSKP:	AOS (P)			; now do skip return
R:	RET			; normal return

STKSOV:
	SUB P,0(AC16)		; stack overflow, undo add
	HLL AC16,0(AC16)	; setup to do multiple push, get count
STKSO1:
	PUSH P,[0]		; do one push at a time, get regular
	SUB AC16,[1,,0]		;  action on overflow
	TLNE AC16,777777	; count down to 0?
	 JRST STKSO1		; no, keep pushing
	JRST STKSE1
	SUBTTL Pure data storage

BUFONE:	POINT 7,BUFFER		; initial buffer pointer
BF1PTR:	POINT 7,ERRBUF		; initial pointer for error buffer

LEVTAB:	EXP MPC1		; interrupt PC storage address for mother
	EXP MPC2
	EXP MPC3

TTYTXT:				; TTYTST text
	ASCIZ\
ABCDEFGHIJKLMNOPQRSTUVWXYZ
abcdefghijklmnopqrstuvwxyz
0123456789 

This system is running the TOPS-20AN operating system offered by
Digital Equipment Corporation.

\

IFE DBGTST,<
CMDFIL: ASCIZ/SYSTEM:NETSRV.RUN/
>;IFE DBGTST
IFN DBGTST,<
CMDFIL: ASCIZ/NETSRV.DEBUG/
>;IFN DBGTST

				; pure data defined by MKFORK macro
FPDLP:	BLOCK NFORKS		; fork PDL stack pointers
FLVTAB:	BLOCK NFORKS		; fork LEVTAB pointers
FPCTAB:	BLOCK NFORKS*3		; fork PC storage pointer
FRKNAM:	BLOCK NFORKS		; fork name strings
FRKSUB:	BLOCK NFORKS		; fork subsystem name
FRKDSP:	BLOCK NFORKS		; fork dispatch address's
FRKDEF:	BLOCK NFORKS		; forks default ICP socket
	SUBTTL Software Interrupt Definitions

; Software interrupt stuff for server forks

	DEFINE DEFCHN(NAME,CHANNEL,LEVEL,DISPATCH),<
	FRKMSK==FRKMSK!1B<CHANNEL>
	NAME==CHANNEL
	LOC CHNFRK+CHANNEL
	XWD LEVEL,DISPATCH
	LOC FRKND2>
	FRKMSK==0		; initialize used channels mask
CHNFRK:	BLOCK ^D36		; fork interrupt channel table
	FRKND2==.	

				; fork interrupt level assignments
	SYMS STSINT,3		; status interrupt level
	SYMS ALMINT,2		; alarm expired interrupt level

				; Fork interrupt channel assignments
	DEFCHN FALARM,0,ALMINT,.ALARM ; alarm expired interrupt
	DEFCHN ICPINT,1,STSINT,.ICPSK ; ICP socket status change
	DEFCHN SKTINT,2,STSINT,.SKTSK ; data socket status change

; Software interrupt stuff for mother fork

	DEFINE DEFCHN(NAME,CHANNEL,LEVEL,DISPATCH),<
	NAME==CHANNEL
	CHNMSK==CHNMSK!1B<CHANNEL>
	LOC CHNTAB+CHANNEL
	XWD LEVEL,DISPATCH
	LOC FRKND3>
	CHNMSK==0		; init used channels mask for mother
CHNTAB:	BLOCK ^D36		; mother interrupt channel table
	FRKND3==.

				; mother interrupt level assignmnets
	SYMS ASYNCH,2		; asynchrous interrupt channel level
	SYMS DEDINT,1		; fork dies interrupt channel level
	SYMS TTYLVL,3		; TTY interrupt level

				; mother interrupt channel assignments
	DEFCHN CLOCK,0,ASYNCH,.CLOCK ; periodic clock interrupt
	DEFCHN TTYINT,2,TTYLVL,.TTYIO ; TTY interrupt character
	DEFCHN DEAD,.ICIFT,DEDINT,.DEAD ; fork died interrupt
	SUBTTL COMND% JSYS command tables

CSBV:				; virgin COMND% state block
	EXP RPARSE		; reparse dispatch address
	.PRIIN,,.PRIOU		; input and output JFNs
	-1,,[ASCIZ/NETSRV>/]	; prompt
	-1,,CMDTXT		; text buffer
	-1,,CMDTXT		; text buffer
	EXP TXTSIZ		; text buffer size
	Z			; count of unparsed characters
	-1,,CMDATM		; atom buffer
	EXP ATMSIZ		; atom buffer size
	EXP CMDGTF		; COMND% GTJFN% block
IFN CSBSIZ-<.-CSBV>,<PRINTX ?CSB and CSBV disagree>

PCMDS:	NPCMDS,,NPCMDS		; primary command table
	CMD CLOSE,		; CLOSE log file
	CMD DDT,,CM%INV		; transfer control to UDDT
	CMD EXIT,		; EXIT after cleaning up command
	CMD HELP,		; type out help text
	CMD LOAD,		; LOAD message file
	CMD OPEN,		; OPEN log file
	CMD PUSH,,CM%INV	; PUSH to an EXEC
	CMD QUIT,,CM%INV	; return to EXEC now
	CMD RECEIVE,		; start a server
	CMD REFUSE,		; stop or don't start a server
	CMD RESTART,,CM%INV	; RESTART NETSRV
	CMD S,SYMN1,CM%ABR!CM%INV ; abrev. for status
SYMN1:	CMD STATUS,		; give a STATUS report
	CMD STOP,		; STOP all servers command
	CMD TAKE,		; TAKE commands from file command
	CMD UNLOAD,		; UNLOAD message file
	CMD WAIT,		; WAIT forever command
	NPCMDS==.-PCMDS-1

SCMDS:	NSCMDS,,NSCMDS		; server names command table
	CMD DAYTIME,SRV.DT	; daytime server
	CMD F,SYMN3,CM%ABR!CM%INV ; abrev. for ftp
IFN FT.FNG,<			; only if we support finger
	CMD FINGER,SRV.FN	; FINGER server
>				; end of IFN FT.FNG
SYMN3:	CMD FTP,SRV.FT		; FTP
	CMD NETSTAT,SRV.NE	; NETSTAT server
	CMD OLD-TELNET,SRV.OT	; old TELNET
IFN FT.SCR,<			; only if we support secure telnet
	CMD SECURE-TELNET,SRV.ST ;secure TELNET
>				; end of IFN FT.SCR
	CMD SYSTAT,SRV.SY	; SYSTAT
	CMD T,SYMN2,CM%ABR!CM%INV ; abriev. for telnet
SYMN2:	CMD TELNET,SRV.NT	; TELNET
	CMD TTYTST,SRV.TT	; terminal test
	NSCMDS==.-SCMDS-1

NCMDS:	NNCMDS,,NNCMDS		; network names command table
	CMD ARPANET,^D10	; ARPANET network
	NNCMDS==.-NCMDS-1
	SUBTTL Other randomness

	IFE DEBUG,<XLIST>	; LIT follows
...LIT:	LIT			; as you wish
	IFE DEBUG,<LIST>	; end of LIT
	PUREND==<.-1>!777	; end of pure storage

	IFE DEBUG,<XLIST>	; repeat for symbol table follows
	REPEAT <PUREND-<.-1>>,<0> ; make sure patch area/symbol table
				;  starts on next page
	IFE DEBUG,<LIST>	; end of repeat

	END <EVECL,,EVEC>	; That's all folks