;-*-MIDAS-*-
.symtab 7123.,7321.
TITLE NAME PROGRAM

f=0	;flags
a=1
b=2
c=3
d=4
e=5
t=6
tt=7

l=10
u1=11	; UUO ac
u2=12	; UUO ac
u3=13	; UUO ac
u=14	;user index into sys core
i=15	;random index into sys core
x=16
p=17	;pdl ptr


dkic==1

ntsicp==2	;icp channel, server side.
ntsi==3		;net in, server side.
ntso==4		;net out ch no., same as tyoc.

tyoc==4		;terminal ouput channel
tyic==5		;tty input (solely to interrupt on)
%tyob==1_tyoc	;interrupt mask bits.
%tyib==1_tyic

ls1c==6		;channel for keeping LSR1 open so we can map in pages.

plic==7		;ch no. for reading plans.
nticp==10	;user side icp channel
ntic==12	;user side net in.
ntoc==13	;user side net out.

usrich==11	;usr job input channel

ubpfj==10	;mode bit for USR open to prevent reowning

icpsoc==117	;socket to connect to for icp.

ifndef maxkbd,maxkbd==100	;maximum # of keyboards
mapmsk==574377776000		;$<mapmsk>t; in ddt types out 10-11 interface map entry

ifndef maxtty,maxtty==100.	;max # tty's we can handle.
ifndef nontty,nontty==120.	;plus this many non-tty entries (i.e. Lisp machines)

define type str
	typz [asciz/str/]
termin

DEFINE SYSCAL A,B
	.CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
TERMIN
CIMM==1000,,0
CRET==2000,,0
CERR==3000,,0
CTL== 4000,,0
CTLI==5000,,0

DEFINE PUSHAE AC,LIST
IRP LOC,,[LIST]
PUSH AC,LOC
TERMIN
TERMIN

DEFINE POPAE AC,LIST
IRP LOC,,[LIST]
POP AC,LOC
TERMIN
TERMIN

DEFINE ASCSTR STR
.LENGTH 
STR

440700,,[ASCIZ 
STR
]!TERMIN

DEFINE MDBPT AC,FOO
ADD AC,[70000,,0]	;increase p
CAIG AC,0		;skip,
 SUB AC,[430000,,1]	;unless went off edge, in which case reset.
TERMIN

;random byte pointers

$opcod==331100	;op code in instruction
$acfld==270400	;accumulator field
$xfld==220400	;idx field

$ercod==220600	;error code for .status

$rchost==001100	;host no. taken from .rchst


;flag bits in LH of F
%svrmod==400000		;program is server.
%chasrv==200000		;program is a chaosnet server to boot
%chausr==100000		;talking to a chaosnet host
%netusr==20000		;include all users from network in listing
%astflg==10000		;all logged in users should be printed.
%astlsp==4000		;all users on included lisp machines should be printed.
%nottv==400		;set if this tty is not a tv
%uname==100		;while uname is being read
%nignr==40		;tmp flag used in jcl parsing
%rqmod==20		;handling request for info from network
%supd==10		;supdup trying to find out its terminal ID
%rcrs==4		;set if we've printed "[uname jname]" for this user
%tcpsrv==2		;program is a tcp server to boot

%DM==4			;set when on MIT-DMS (only during startup)

;flag bits in RH
%getus==400000		;set when local site appears in JCL
%getnt==200000		;set when foreign site appears in JCL
%nojcl==100000		;set when no JCL to be read
%astf1== 40000		;flag seeing if any name found in JCL.
			;Prevents %astflg from being set by default.
%quot==  20000		;flag saying name being matched should be exact.
%alllm==10000		;include ALL lisp machines, not just those for this ITS.

%jobnof== 4000		;include job no. in listing
%abbrev== 2000		;omit full name field on listing
%whois==  1000		;all info available on specified users.
%nelsp==   400		;show associated lispms
%ctlq==    200		;used by ^Q quoting hack.
%qtmod==   100		;used in parsing JCL item within quotes.
%getsw==    40		;set when switches appear in JCL.
%when==     20		;only interested in login/logout times.
%usetcp==   10		;should use tcp when opening a connection

;the memory map for this crock

;  Pages		Area
; 0 - purpgb			impure variables
; purpgb - purpge		the program (pure)
; ttpage			the TTLOC data file (2 pages)
; ls2org - ?			the LSR data (pure), followed by the HOSTS1 data (pure)
; hiporg - hiporg+itspgs-1	absolute its pages

 ;note, 300000 is not enough to get all user variables on mc
itspgs==400000/2000	;# its pages
hiporg==200		;page # of origin of high ITS pages

;; Definitions for purifying and relocating variables into
;; impure low core.  BVAR and EVAR should bracket each group of
;; variables, which by definition are impure.
;; PURPGB specifies page # beginning pure code; PURPGE is the
;; first page after pure code and is determined at end of assembly.

purpgb==4	;start pure code on 4th page.
%%pbeg==2000*purpgb

define bvar
ife %%vpar,.err BVAR inside BVAR!
%%vpar==0
%%vsav==.
loc %%vend
termin

define evar
ifn %%vpar,.err EVAR without BVAR!
%%vpar==1
%%vend==.
ifle %%pbeg-%%vend,.err Impure overflow!
loc %%vsav
termin

%%vpar==1		;initialize B/EVAR macros.
%%vend==100		;start impure here.
%%vsav==%%pbeg		;start pure here.
;;;;;;;;;;;;;;;;;;;;;;;;;;;

loc 41
		pushj p,uuoh
loc 42
		-lintblk,,tsint
loc %%vsav

BVAR
pat: patch":	block 100
EVAR

popaj1:	aos -1(p)
popaj:	pop p,a
apopj:	popj p,

crlf:	asciz /
/
BVAR
ownhst:	0		; # of our own site
	0		; it can have two numbers on two networks (rather a kludge this)
hstcur:	0		; # of host currently hacking (JCHIT checks this)
hstic:	0		; # of "sticky" host at any given time
option:	0		;holds job's .OPTION variable
tcmxh:	0		;line length of our tty.
lxunm:	0		; holds user's xuname (good for debugging)
lxjnm:	0		; xjname.  Note also DMPUNM/JNM.
nlstty:	0		;number of last sty-type tty (plus one).
nl11ty:	0		;number of last tv tty (plus one).
beglen:	0		;# of chars taken up by all but the "console location" field
done:	0		;byte pointer to point in jcl to continue from, or zero
usetcp:	0
usencp:	0
debug:	-1		;non-zero means don't dump self out
			;(so as not to clobber old version)	
sysid:	0		;holds current ITS version syms are good for

EVAR		; Following stuff is pure.
dmpunm:	0		; holds XUNAME of user who dumped this pure image
dmpjnm:	0		; xjname thereof.

define syms list
	irps foo,,[list]
	squoze 0,foo
foo:	0
termin
0
termin

;constant syms (not addrs)
cnstb:	syms [nct:nfstty:nsttys:nf11ty:n11tys:lublk:]

	;400000(u)
usrxtb:	syms [uname:xuname:usysnm:jname:ttytbl:tt11p:utmptr:suppro:]

	;400000(i)	;FOO! Some of these shouldn't be indexed by anything
ixtb:	syms [ttysts:stysts:ttytyp:ttitm:time:shutdn:sysdbg:] 

evaler:	move  d,@(p)	;get addr to be iored into what eval gives
	aos (p)		;increment to get next arg
	move c,@(p)	;get addr of sym table
evalup:	move b,(c)	;get squoze for sym
	jumpe b,popj1	;thru
	.eval b,	;get addr for it
	 tdza b,b	;undefined make it all zero
	  ior b,d	;otherwise ior addr into it
	movem b,1(c)	;store in right place
	addi c,2	;increment index
	jrst evalup	;back for all
popj1:	aos (p)
	popj p,

;Request various of NETWRK's routines.
$$HST3==1			; Use HOSTS3 now.
$$ARPA==1			;Hack the ARPAnet
$$TCP==1
$$CHAOS==1			;Hack the CHAOSnet
$$ALLNET==1			;Lookup routines will handle any host
$$SYMLOOK==1
$$HOSTNM==1
$$HSTSIX==1
$$HSTMAP==1			
$$OWNHST==1
$$CONNECT==1
$$ICP==1
$$SERVE==1
$$ANALYZ==1

.INSRT SYSTEM;CHSDEF
.INSRT SYSENG;NETWRK

putchr:	.iot tyoc,t
	popj p,

;get routines for searching INQUIR;LSR1 >
$$HSNM==1
.insrt syseng;lsrtns

;Network-number info
;NW%CHS==:7	;Chaos net
;NW%ARP==:12	;Arpa net
;NW%DLN==:26	;Dial net (not supported by these routines)
;NW$BYT==:331000	;Byte pointer to network number

init:	tlne f,%svrmod+%supd	;server shouldn't print anything
	 jrst init1
	movei a,[asciz /Initializing--
/]
	skipn debug	;different msgs depending on whether dumping
	  movei a,[asciz /New sys, must initialize--
Take paws off keys and wait
/]
	iot tyoc,(a)
	;first, unpurify so that won't get PURPG errors in various places.
init1:	move a,[<purpgb-purpge>,,purpgb]
	move b,[%cbndr+%cbndw+%cbprv]	;new bits.
	pushj p,corcpy		;bleah. go copy core by hand since %CBCPY loses.
	setz a,
	move b,[-itspgs,,hiporg]   ;AOBJN args to CORBLK must be writable!
	syscal corblk,[
		[200000,,0]
		[-1]
		b
		[400000]
		a]
	 jsr error
	pushj p,evaler
	 400000(u)
	  usrxtb
	pushj p,evaler
	 400000(i)
	  ixtb
	pushj p,evaler
	 0
	  cnstb

	move a,nfstty	;want # of last sty
	add a,nsttys
	movem a,nlstty	;store it (note symbol not an its one)
	move a,nf11ty	;ditto for pdp11 tv's
	add a,n11tys
	movem a,nl11ty	;store (note symbol not an its one)
	move a,nct
	caile a,maxtty
	 jsr error
	pushj p,gttys
	.rsysi a,	;get sys. version of these syms
	movem a,sysid
	move a,lxunm
	movem a,dmpunm	; save dumper's uname
	move a,lxjnm
	movem a,dmpjnm	; and jname, in pure core yet.
	tlne f,%svrmod+%supd	;server?
	 popj p,		;yes, don't dump, don't print anything.
	move a,[-<purpge-purpgb>,,purpgb]
; purify code.
	syscal corblk,[cimm %cbndr	;make read-only
		cimm -1 ? a		;into self, as specified by AOBJN
		cimm -1]		;from self.
	 jsr error

; Now we must flush the TTLOC data and substitute a fresh all-zero page
; in case the database is missing at time of initialization.
; Due to the ITS core allocator lossage that doesn't guarentee fresh pages
; when there's a page already there, we must delete the page first.

	syscal corblk,[cimm 0 ? cimm %jself ? cimm ttpage]
	  jsr error
	syscal corblk,[cimm %cbndr\%cbndw ? cimm %jself ? cimm ttpage
			    cimm %jsnew]
	  jsr error

	syscal corblk,[cimm 0 ? cimm %jself ? cimm ttpage+1]
	  jsr error
	syscal corblk,[cimm %cbndr\%cbndw ? cimm %jself ? cimm ttpage+1
			    cimm %jsnew]
	  jsr error

	skipe debug		;debugging?
	 jrst initdn		;yes, don't dump
	.suset [.roption,,a]
	tlnn a,optddt		;don't valret unless there is a ddt!
	 jrst initdn
	.value [asciz /:pdump sys;dsk:ts name
p/]

initdn:	iot tyoc,[asciz /Init done
/]
	popj p,

	;simulate existence of %CBCPY.
corcpy:	syscal corblk,[cimm %cbndr+%cbndw ? cimm -1 ? cimm usrpag ? cimm %jsnew]
	 jsr error
	hrlz c,a
	lsh c,10.	;get addr in LH
	hrri c,usrfil
	blt c,usrfil+1777	;copy page by hand.
	hrrz c,a
	syscal corblk,[B ? cimm -1 ? C	;replace page with copied page.
		cimm -1 ? cimm usrpag]
	 jsr error
	syscal corblk,[cimm 0 ? cimm -1 ? cimm usrpag] ;flush scratch page.
	 jsr error
	aobjn a,corcpy	;repeat as necessary.
	popj p,


BVAR
errcod:	0
error:	0		; JSR here when fatal error happens.
	skipe debug
	 .value
	tlne f,%svrmod
	 jsr exit	;if server, just die for now.  Perhaps later report it.

	; We're going to dump.  Save some info.
	movem a,asave		; save ac (don't smash pdl)
	.suset [.rbchn,,bchn]
	hrlz a,bchn
	add a,[.rios,,ios]
	.suset a
	move a,asave
	.value [asciz 
: Urk! AAAAAAIIIIIEEEEeeeeeeeeee... 
:SL SYS;TS NAME
:PDUMP CRASH;NAME >
:BUG NAME A NAME crash was just dumped to CRASH;NAME > !!
: Sorry about that.  If you have any idea why this crash 
happened or how to reproduce it, please do another :bug name
and tell us...

]
	jsr exit		;if continued, die outright.

asave:	0	; temp 
bchn:	0
ios:	0



exit:	0
	tlne f,%tcpsrv
	 jrst exit1
	tlne f,%chasrv
	 syscal force,[cimm ntso]
	 jrst exit2
	syscal pktiot,[cimm ntso ? cimm [%coeof_28.]]	;send eof
	 jrst exit2
exit1:	syscal finish,[cimm ntso]	;and wait for all data to get through
	 skipa			;dont need to close if other side did
exit2:	.close tyoc,	;in case it was translated, close it before .value.
	skipe debug
	 .value
	.logout		;logout will close network connections if any.
	.break 16,344000
EVAR

go:	setz f,		;initialize flags
	move p,pdl		;initialize pdl
	.suset [.roption,,a]
	tlo a,optint
	.suset [.soption,,a]
	movem a,option		;save
	move a,[-3,,[.smask,,[%piioc+%pimpv+%pipdl]
		.rxjname,,lxjnm
		.rxuname,,lxunm]]
	.suset a
	move b,lxjnm
	camn b,[sixbit /WHEN/]
	 tro f,%when
	came b,[sixbit /WHOARE/]
	 camn b,[sixbit /WHOIS/]
	  tro f,%whois
	camn b,[sixbit /SUPNAM/]
	 tlo f,%supd
go1a:	syscal sstatu,[repeat 5,[ ? cret a ] ? cret a]
	 jsr error
	came a,mname		;same sys as initialized before?
	 setzm sysid		;no, then assure we will init
	movem a,mname
	camn a,[sixbit/DM/]
	 tlo f,%dm		;we're on DM. (In the Twilight Zone...)
	move a,[netwrk"nw%chs]	;Get Chaosnet address of own site
	pushj p,netwrk"ownhst
	 seto a,
	movem a,ownhst
	move a,[netwrk"nw%arp]	;Get Arpanet address of own site
	pushj p,netwrk"ownhst
	 seto a,
	movem a,ownhst+1
	skipge ownhst		;Make sure if any network address, ownhst is one
	 movem a,ownhst		;It must also be the one preferred by HSTLOOK, which is Chaos currently.
	.suset [.runame,,a]
	hlros a
	aojn a,goa
	.suset [.rjname,,a]
	came a,[sixbit /rfc117/]
	 camn a,[sixbit /netrfc/]
	  jrst server
	camn a,[sixbit /tcp/]
	 jrst tcpsrv
	camn a,[sixbit /chaos/]	;chaosnet NAME
	 jrst chasrv
	jrst goa	;jname is not NETRFC or RFC117 so is normal NAME

tcpsrv:	tlo f,%tcpsrv		;we happen to be a TCP server
server:	tlo f,%svrmod		;we are in server mode.
	trz f,%when\%whois	;turn off other modes set by random xjname
	tlz f,%supd
	tlne f,%dm		;if on dm, then dedemonize us.
	 syscal stdmst,[['rfc105] ? [-1]]
	  jfcl
	movei a,ntsicp		;1st channel of three (icp, in, out).
	movei b,icpsoc		;socket # to listen on.
	move c,[.uai,,.uao]	;input mode,,output mode
	pushj p,[tlne f,%tcpsrv
		  jrst tcplsn
		 jrst netwrk"arpsrv]	;listen for and accept a connection.
	 jsr error

;set up 'terminal' parameters for server
servr2:	tlo f,%nottv
	movei a,1000		;linel for server
	movem a,tcmxh
	jrst goc

chasrv:	tlo f,%svrmod\%chasrv	;we are in server mode.
	trz f,%when\%whois	;turn off other modes set by random xjname
	tlz f,%supd
	movei a,ntsi		;input channel
	movei b,0		;any host
	movei c,[asciz /NAME/]	;contact name
	movei d,5		;window size
	pushj p,netwrk"chalsn
	 jsr error
	jrst servr2

goa:	tlne f,%supd
	 jrst goc
	tlz f,%svrmod	;we are not server.
	.open tyoc,[.uao,,'tty]	;char unit out, disp. mode
	 jsr error
	syscal ttyget,[cimm tyoc ? cret a ? cret b ? cret c]
	 jrst [	movei a,100000	;"TTY:" isn't a terminal?  It must have been translated.
		movem a,tcmxh	;That's OK.
		tlo f,%nottv
		jrst goc]
	.open tyic,[.uai,,'tty]	;Don't try to open tty input unless it's really a tty.
	 jsr error
	tlz c,%tsmor	;do more processing
	tlo b,030000	;make ^G,^S interrupt.
	syscal ttyset,[cimm tyoc
		 a ? b ? c]
	 jsr error
	syscal cnsget,[cimm tyoc ? cret b ? cret tcmxh
		CRET A ? CRET A ? CRET A]
	 jsr error
	.suset [.simsk2,,[%tyib+%tyob]]	;enable tty interrupts
	tlO f,%nottv	;assume not a tv
	trnE a,%tp11t
	 tlZ f,%nottv	;IF ON A TV, CLEAR FLAG.
goc:	.rsysi a,	;get version number of i.t.s.
	came a,sysid	;skip if same as the one syms were int'ld with
	 pushj p,init	;else must re-initialize
	syscal open,[%climm,,plic ? [sixbit /DSK/] ? [sixbit /TTLOC/]
	             [sixbit /DATA/] ? [sixbit /SYSBIN/]]
	  jrst gocx		   ;  Punt, we've got a page there already
	syscal corblk,[%climm,,%cbndr\%cbndw ? %climm,,%jself ? %climm,,ttpage
			%climm,,plic ? %climm,,0]
	  jrst gocx		   ;  Punt, we've got a page there already
	syscal corblk,[ %climm,,%cbndr\%cbndw ? %climm,,%jself
			%climm,,ttpage+1 ? %climm,,plic ? %climm,,1]
	  jfcl			   ;  Punt, we've got a page there already
gocx:	.close plic,
	pushj p,ls2map	; map data in and anything else necessary

;drops through

;drops in.
	move a,[hjtab,,hjtab+1]
	setzm hjtab
	blt a,hjtab+nnhsts-1	;clear out table of hosts to hack.
	trz f,%getus+%getnt	;clear both flags for local & net
	tlne f,%supd
	 jrst supd0

;get our JCL from superior, or from net connection (if net server).
	tlne f,%chasrv		;chaosnet server?
	 jrst jclcha
	tlnn f,%svrmod
	 jrst jclgt4
	move a,[440700,,jclbuf]	;Get it from net connection.
	movsi c,-jclbln		; length of JCL buffer in chars
jclgt2:	.iot ntsi,b
	idpb b,a
	caie b,^M		;read till get a ^M from foreign site
	 aobjn c,jclgt2		;or until count out.
jclgt3:	hrrzm c,jclcnt		;store cnt
	jrst jclgt8

;get our JCL from the chaosnet RFC.
jclcha:	ldb c,[netwrk"pktbuf+$cpknb]	;get byte count
	move d,[441000,,netwrk"pktbuf+%cpkdt]
jclch1:	sojle c,jclgt3		;nothing but contact name, store zero count
	ildb b,d		;get character
	caie b,40		;until space
	 jrst jclch1
	caile c,jclbln		;maximum length of jcl
	 movei c,jclbln		;just truncate i guess
	movem c,jclcnt
	move a,[440700,,jclbuf]
jclch2:	ildb b,d
	idpb b,a
	sojg c,jclch2
	jrst jclgt8

jclgt4:	move a,option		;Get JCL from superior.
	tlnn a,optcmd
	 jrst jclgt6
	.break 12,[..RJCL,,jclbuf]
	setz c,
	move b,[440700,,jclbuf]
jclgt5:	addi c,1
	ildb a,b
	jumpn a,jclgt5		;count chars in JCL (assume ASCIZ - really need some
	subi c,1
	movem c,jclcnt		;way of asking superior for count!)
jclgt8:	pushj p,jcla		;chomp JCL to find what hosts to hack.
	skipe hjtab
	 jrst ljcl		;if found at least one, go do them.
	trne f,%getnt		;if only unknown hosts seen
	 jsr exit
	trnn f,%getsw		;found none. skip if found switches, however.
jclgt6:	 tro f,%nojcl		;else there was no JCL to speak of.
	tro f,%getus		;No JCL or just switches => do all users, like "*".
	move a,ownhst
	movem a,hjtab
	jrst ljcl

;get necessary information to grok own teletype
;for a SUPNAM job run as an inferior by a SUPDUP user program.
supd0:	movei a,usrpag
	movem a,ffpag
	lsh a,10.
	movem a,ffloc
	pushj p,usrini
	.suset [.rcnsl,,i]
	move x,usrloc
	movei u,0		;don't try to record user info
	pushj p,gotone		;gobble info about our own tty
	 jfcl
	movei a,u%unam(x)	;get address that UNAME goes in
	hrli a,.runame		;must have the UNAME to prevent TTCHK from
	.suset a		;clearing
	caml i,nfstty		;determine type of tty
	 caml i,nlstty
	  caia
	   jrst supd3		;do sty hair
	caml i,nf11ty
	 caml i,nl11ty
	  jrst supd1		;vanilla
	syscal tvwher,[cimm 400000(i) ? cret a]	;tv
	 jsr error
	cail a,0
	 cail a,maxkbd
	  jsr error
	movei b,(i)		   ;get TTY # in B
	push p,a
	pushj p,ttchk		   ;get Byte Pointer to TTLOC info if any
	  caia			   ;  No TTLOC info
	    jrst [ pop p,a
		   jrst supd2]	   ;    It's there, use it
	pop p,a
	move a,kbddoc(a)
supd2:	move f,['TERMID]
	.break 16,105

supd1:	movei b,(i)		   ;get TTY # in B
	pushj p,ttchk		   ;get Byte Pointer to TTLOC info if any
	  move a,ttydoc(i)
	    jrst supd2		   ;    It's there, use it

supd3:	move e,[440700,,supdid]	;byte pointer for hstout to store cruft
	movei i,39.		;# characters
	movem i,tcmxh
	setzm beglen
	pushj p,hstout		;hope this guy's typeout gets intercepted
	setz x,
	idpb x,e
	move a,[440700,,supdid]
	jrst supd2

;If the local host is among the hosts to be processed,
;extract all JCL entries which apply to it, then process them all.
ljcl:	trne f,%getnt		;were any foreign sites specified?
	 trne f,%getus		;If foreign sites spec'd and local not spec'd,
	  caia
	   jrst fjcl		;don't do local site at all.
	move b,ownhst
	movem b,hstcur		;set self up as current host.
	trne f,%getnt		;will we be doing any foreign sites later?
	 jrst [	typi "[
		pushj p,netwrk"hstsrc
		 .lose
		typz (a)	;yes, so type out name in regular fashion.
		typi "]
		typz crlf
		jrst .+1]
	pushj p,usrini		; initialize usr-info blocks.
	trne f,%nojcl
	 jrst lclall		;if no JCL, do speedy "*".
	pushj p,jclbeg		;set up for munching in

	; routine gobbles all items and stores in tables
	trz f,%astf1		;clear flag to see if we should *.
	setzm nspecs		;clear index for ptr storage
ljcl10:	pushj p,jchitm		;get a JCL item for specified host. (us)
	 jrst ljcl20		;EOF, all done with name collection
	skipn a,itsw		;switch spec?
	 jrst ljcl15		;no, skip switch search

	;handle switches.
	cail a,"a
	 caile a,"z
	  caia
	   subi a,40		;make uppercase
	movsi c,-njcsws
ljcl12:	hlrz b,jcswtb(c)
	cain a,(b)		;char matches switch in table?
	 jrst [	hrrz b,jcswtb(c)
		tro f,(b)	;set flag in RH
		jrst ljcl10]
	aobjn c,ljcl12
	jrst ljcl10		;ignore unknown switches

jcswtb:	"A,,%abbrev		;don't print full name
	"J,,%jobno		;include job no.
	"W,,%whois		;print complete info about user.
	"T,,%when		;ugly switch choice, oh well.
	"L,,%nelsp		;/L look on associated Lisp machines too

commen ~
There is now way this flag can be set in the manner intended.
:f /i@dm passes it on to DM, and :f @dm/i throws it away (I think)
If somebody can make it work, then they should probably rename it
to "N,,%usencp and fix the various places that use it.  -dcp 2/6/83
	"I,,%usetcp		;try to use old NCP on arpanet
end commen ~
njcsws==.-jcswtb

	;handle names.
ljcl15:	skipn b,itcnt		;ignore null names.
	 jrst ljcl10
	tro f,%astf1		;indicate a name was given.
	movei a,itcnt
	ustrn a,[ascstr [,]]	;name of "," comes from a null name, as in :NAME ,@MC
	 caia
	ustrn a,[ascstr [*]]	;* special -- like /m alone
	 jrst [	tlo f,%astflg ? tro f,%nelsp ? jrst ljcl10]
	ustrn a,[ascstr [*NET]]	;special name?
	 jrst [	tlo f,%netusr ? jrst ljcl10]	;set flag, don't store.
	; By the looks of this this never worked -- Gumby
;	ustrn a,[ascstr [*LISPM]]	;special name?
;	 jrst [	tro f,%alllm ? jrst ljcl10]	;set flag, don't store.
	pushj p,namsto		;store name in various places
	jrst ljcl10		;back for another name

ljcl20:	skipe a,nsktty
	 jrst [	imul a,[-1,,0]
		hrri a,sektty
		movem a,whotty
		jrst .+1]
	skipe a,nskunm
	 jrst [	imul a,[-1,,0]
		hrri a,sekunm
		movem a,who
		jrst .+1]
	skipe a,nskfnm
	 jrst [	imul a,[-1,,0]
		hrri a,sekfnm
		movem a,whofnm
		jrst .+1]
	trnn f,%astf1		;if name-found flag not set,
lclall:	 tlo f,%astflg		;turn on "*" action...
	movei b,49.
	trne f,%abbrev
	 movei b,25.
	trne f,%jobnof
	 addi b,3
	movem b,beglen		;Compute truncation point.
	move x,usrloc		;Initial index into table of users to print.
	setzm tlusers		;Zero users to print so far.
	trne f,%nelsp		;Ask lisp machines for status, as appropriate.
	 pushj p,lmfing
	tdne f,[%astflg+%netusr+%astlsp,,]
	 pushj p,star		;If "*", gobble data on all logged in users.
	skipn whofnm
	 skipe who
	  pushj p,whofnd	;Now find all users specified by uname or full name.
	skipe b,whotty
	 pushj p,whoft		;Find all terminals specified by number.
	pushj p,putout		;Output all the users in the tables.
	trnn f,%getnt		;if there was no foreign site spec,
	 jsr exit		;die peacefully.

;else drop thru to net hacking routines.

;Having processed the local host if appropriate,
;we now loop over all the foreign hosts to be processes
;and for each one, extract the JCL data for it and send to server there.
fjcl:	movsi c,-nnhsts
fjcl51:	skipn a,hjtab(c)	;get a site
	 jrst fjcl54		; Null, ignore and get another.
	setzm hjtab(c)		;aha, found one. clear from table.
	came a,ownhst		;ignore if self
	 camn a,ownhst+1
	  jrst fjcl54
	movem p,savpdl		; Found valid site.  Save stuff in case IOC rcvd.
	movem c,savc
	movei b,fjcl53		; and set up return loc for IOC.
	movem b,neterr
	jrst fjcl55		; and go hack site!

fjcl53:	move p,savpdl		; Return here from net stuff if hit an IOC.
	move c,savc		; restore accs.
fjcl54:	aobjn c,fjcl51		; normal return comes here.
	jsr exit		;die, none left to hack.

fjcl55:	movem a,hstcur		;store # as current host.
	typz crlf		;split off from previous output.
	typi "[
	push p,b
	move b,a
	pushj p,netwrk"hstsrc
	 jrst [	move a,hstcur
		pushj p,typehn
		jrst fjcl56 ]
	typz (a)		;type official name of site.
fjcl56:	pop p,b
	typi "]
	typz crlf

	;attempt to setup appropriate stuff for contact name or line to server

;;; I guess these "Resting In Pieces"s will not be going off anymore...
;;; Also, they will need to be changed when those IMP slots are reused.
;;;  -- CSTACY 10 December 1983
; I learned the hard way that CStacy had left this timebomb in here 5 years
; later. -Alan 1988
; 	move a,hstcur
; 	came a,[1200400006]	;AI, R.I.P.
; 	 camn a,[1200200006]	;DMS, R.I.P.
; 	  jrst [ type [Requiescat in pace.]
;  		typz crlf
; 		type [May we please have a moment of silence ...]
; 		typz crlf	;most network programs do readline
; 		syscal finish,[cimm tyoc]	;force it out before sleep
; 		  jfcl
; 		movei a,30.*5.	;5 second homage
; 		.sleep a,
; 		type [  Thank you.]
; 		typz crlf
; 		jrst fjcl]	;go do rest of sites
	move a,hstcur
	move t,[440700,,connam]
	movem t,cnnptr		;initialize pointer to contact name
	setzm cnncnt		;and byte count
;	ldb t,[330600,,a]	;get network number
	netwrk"getnet t,a		; Get network number
	came t,[netwrk"nw%chs]
	 jrst fjcl49		;arpanet or something
	movei t,[asciz /NAME /]
	pushj p,cnnstr
	tloa f,%chausr
fjcl49:	 tlz f,%chausr		;assume not chaosnet
	trne f,%whois		;special addition.. if WHOIS, make sure that
	 pushj p,[movei t,[asciz \/W \]	;switch gets sent!
		  jrst cnnstr]
	trne f,%when
	 pushj p,[movei t,[asciz \/T \]	;ditto for WHEN-style.
		  jrst cnnstr]
	trz f,%astf1		;clear flg for "*"
	pushj p,jclbeg		;initialize
	caia
fjcl59:	 move p,pdl		;restore PDL if necessary (IOC err return)
fjcl60:	pushj p,jchitm		;get item
	 jrst fjcl70		;no more
	skipe itsw
	 jrst [	movei tt,"/	;switch?
		pushj p,cnnbyt
		move tt,itsw
		pushj p,cnnbyt
		movei tt,40
		pushj p,cnnbyt
		jrst fjcl60]
	skipn c,itcnt
	 jrst fjcl60		;if null name, means "@<site>" was given. ignore for now
	troe f,%astf1		;indicate some name was given.
	 pushj p,[movei tt,",	;if flag already set, separate name with comma
		  jrst cnnbyt]
	move b,itptr
	skipe itquot
	 pushj p,[movei tt,""	;if quoted, give first quotemark.
		  jrst cnnbyt]
	addm c,cnncnt
fjcl63:	ildb a,b
	idpb a,cnnptr
	sojg c,fjcl63
	skipe itquot
	 pushj p,[movei tt,""	;if quoted, give second quotemark.
		  jrst cnnbyt]
	skipe itpmat
	 pushj p,[movei tt,"-	;if wants partial match, give trailing dash.
		  jrst cnnbyt]
	jrst fjcl60

	;done with names if any...
fjcl70:	pushj p,hicp		;try to perform ICP.
	 jrst fjcl		;failed. routine prints message, here just go back.
	tlne f,%chausr
	 jrst fjcl72
	movei t,[.byte 7 ? ^M ? ^J]	;for the arpanet, output everything now
	pushj p,cnnstr
	move t,[440700,,connam]
	move tt,cnncnt
	syscal siot,[cimm ntoc ? t ? tt]
	 jsr error
	syscal force,[cimm ntoc]	;make sure output gets sent
	 jsr error
fjcl72:	pushj p,netin		;go copy net input to TTY
	jrst fjcl		;when done, go back for more sites.

	;initialize for a pass through JCL
jclbeg:	push p,a
	move a,ownhst		; initial "sticky site" is local.
	movem a,hstic
	move d,jclcnt		;count of chars in JCL buffer
	move e,[440700,,jclbuf]	;ptr to jcl buffer
	pop p,a
	popj p,

BVAR
itcnt:	0	;cnt of chars in name of item
itptr:	0	;ptr to name of item
itbrk:	0	;char which broke scan
ithst:	0	;either site # of item, or bp to 36-bit site #'s, terminated by zero.
itmhst:	0	;non-zero for multiple-hosts flag
itsw:	0	;if non-z, item was switch, holds switch char.
itquot:	0	;if non-z, item was given inside quote-marks, wants exact match.
itpmat:	0	;if non-z, item wants to be partially matched.
itbarf:	0	;if non-z, complain if unknown host enountered.
EVAR

	; JCITM - get an item. returns in itcnt, itptr, ithst, itbrk.
	; D has char cnt of string, E ptr to.
	;itsw has switch char if a switch, else zero.

jcitm:	pushj p,spfl		;flush spaces
	jumpe d,apopj		;EOF?
	pushae p,[a,b,c]
	movem e,itptr		;save ptr
jcitm0:	move c,e
	ildb a,c		;check 1st char
	setzm itsw
	cain a,"/
	 jrst [	sojle d,jcitm9	;switch. munch it.
		ildb a,c
		movem a,itsw	;store switch char
		move e,c	;update ptr
		soja d,jcitm8]	;and return successfully
	pushj p,jcwd		;get a word. returns brk char in A, cnt in itcnt
	movem b,itcnt		;store cnt of word found
	setzm itquot
	setzm itpmat
	trne f,%qtmod		;was it within quotemarks?
	 jrst [	setom itquot	;set flag if so.
		setzm itpmat	;and don't allow partial match.
		ibp itptr	;and point to char after ".
		jrst jcitm3]

	; Check for need to do partial matching
	jumple b,jcitm3		; obviously none if nothing collected.
	pushae p,[a,e]
	mdbpt e,		;decrement ptr to get last char in wd.
	ldb a,e
	cain a,"-		; is it "partial-match" terminator?
	 jrst [	setom itpmat	; if so, set flag for it.
		sos itcnt	; and take dash off end.
		jrst jcitm2]
	cain a,".		; check for "..."; possible?
	 caige b,4		; if so, make sure have enough.
	  jrst jcitm2		; nope to either
repeat 2,[mdbpt e,
	ldb a,e
	caie a,".		; check first
	 jrst jcitm2
]
	subi b,3
	setom itpmat		; won, say partial matching.
	movem b,itcnt		; store proper count (minus "...")
jcitm2:	popae p,[e,a]

jcitm3:	caie a,"%		; either "%" or
	 cain a,"@		; "@" indicates a site.
	  jrst jcitm5		;broken by site specification! go parse it.
	pushj p,jcitm7		;broken by / => back up over it.
	jumpe b,[jumpl a,jcitm9 ;else if nothing in word, it might be EOF,
		caie a,",	;else ignore it unless terminated by a comma
		 jrst jcitm0
		aos itcnt	;in which case return "," as the name
		jrst .+1]
	movem a,itbrk		;save brk char
jcitm4:	move b,hstic		;no host spec, so
	movem b,ithst		;assign sticky one.
	setzm itmhst
	skipge b
	 setom itmhst		;BP's are negative => multiple hosts
	jrst jcitm8		;jump to switch-checker return.

	;parse host spec that follows.
jcitm5:	move c,e		;save ptr
	pushj p,jcwd		;get next word.
	movem a,itbrk		;save brkchar whatever it is.
	jumpe b,jcitm4		;if no host spec, assign sticky.
	movei a,b		;insert addr of host "string" descriptor
	ustrn a,[ascstr [*ITS]]	;skip if strings not equal
	 caia
	ustrn a,[ascstr [ITS]]
	 jrst [	pushj p,itsnms
		jrst jcitm6]
	ustrn a,[ascstr [*LISPM]]
	 jrst [	movei a,hslm
		jrst jcitm6]
	ustrn a,[ascstr [LISPM]]
	 jrst [	movei a,hslm
		jrst jcitm6]
	ustrn a,[ascstr [*MIT]]
	 jrst [ movei a,hsmit
		jrst jcitm6]
	ustrn a,[ascstr [*CHAOS]]
	 jrst [ movei a,hschs
		jrst jcitm6]
	ustrn a,[ascstr [*VMS]]
	 jrst [ movei a,hsvms
		jrst jcitm6]
	ustrn a,[ascstr [*APIARY]]
	 jrst [ movei a,hsapes
		jrst jcitm6]
	ustrn a,[ascstr [*ROBOTS]]
	 jrst [ movei a,hsbots
		jrst jcitm6]
	ustrn a,[ascstr [*TWENEX]]
	 jrst [ movei a,hstnx
		jrst jcitm6]
	ustrn a,[ascstr [TWENEX]]
	 jrst [ movei a,hstnx
		jrst jcitm6]
	ustrn a,[ascstr [*]]
	 jrst [	movei a,hsall
		jrst jcitm6]
	pushj p,hanlyz		;analyze name, return host # in A
	 movei a,0		;if error, use patently false site.
	caia
jcitm6:	 hrli a,444400		; 36-bit bytes
	movem a,ithst		;store as host for this item
	setzm itmhst
	skipge a		;Skip if network number
	 setom itmhst		;BP's are negative, say multiple hosts
	skipn itcnt		;if no name for item,
	 movem a,hstic		;set as new sticky site.
	move a,itbrk
	pushj p,jcitm7		;if broken by /, back up over it.
jcitm8:	aos -3(p)		;skip on return...
jcitm9:	popae p,[c,b,a]
	popj p,

jcitm7:	caie a,"/		;if breaking char was JCL switch,
	 popj p,
	mdbpt e,		;then back pointer up.
	addi d,1
	popj p,


	; JCHITM - like JCITM, but returns only those items with host as
	;specified in HSTCUR.
jchitm:	push p,a
jchit2:	setzm itbarf		;Do not complain about unknown hosts
	pushj p,jcitm		;get an item
	 jrst popaj		;no more
	skipe itsw
	 jrst popaj1
	move a,ithst
	skipn itmhst		;Skip if not a single host
	 jrst [	came a,hstcur
		 jrst jchit2	;wrong site, get another item.
		jrst popaj1]	;aha, found one!
	push p,b
jchit5:	ildb b,a
	jumpe b,[pop p,b
		jrst jchit2]	;jump if end of string
	pushj p,hstlook		;convert what's in b to host number.
	camn b,ownhst+1		;this mostly all works the wrong way
	 move b,ownhst		;take the host that hstcur will prefer
	came b,hstcur
	 jrst jchit5
	pop p,b
	jrst popaj1		;match...

;Convert host name in B to host number in B.
;Host name can be a 1-word asciz string, or address of asciz string.
;Does not print anything if host is unknown.

hstlook:
	push p,a
	push p,e		;hstlook clobbers E
	push p,b
	movei a,(p)		;B may contain host name in asciz,
	tlnn b,-1		;or if lh is 0, it is address of asciz string.
	 move a,b
	pushj p,netwrk"hstlook	;convert to host number.
	 setz a,
	move b,a		;return that in B.
	sub p,[1,,1]
	pop p,e
	pop p,a
	popj p,

;auxiliary routines for JCITM.

	; spfl - flush spaces from JCL string
spfl:	push p,a
	push p,b
	jrst spfl3
spfl2:	move b,e
	ildb a,e
	cain a,40
spfl3:	 sojge d,spfl2
	jumpl d,spfl4
	addi d,1
	move e,b
spfl4:	pop p,b
	pop p,a
	popj p,

	; jcwd - updates D, E, 1 past break char, leaves brkchar in A, cnt in B
	; item beginning with quote gets scanned up to next quote, and next char
	; is the "break" char.
jcwd:	setz b,		;clear cnt
	trz f,%ctlq+%qtmod
	sojl d,[seto a, ? popj p,]	;before checking 1st char, make sure it's there
	ildb a,e		;get 1st char to check for quoting.
	caie a,""
	 jrst jcwd2		;if not quotemark, go into loop.
	tro f,%qtmod		;if a quotemark, set mode!
jcwd1:	sojl d,[seto a, ? popj p,]	;if EOF, brkchar is -1
	ildb a,e
jcwd2:	trze f,%ctlq	;if single-char quoting,
	 aoja b,jcwd1	;don't check for anything.
	trne f,%qtmod	;are we in string quote mode?
	 jrst [	caie a,""	;yes, is this char terminator of string?
		 aoja b,jcwd1	;no, keep going.
		sojl d,[seto a, ? popj p,]	;yes, is terminator. stop if EOF
		ildb a,e	;get next char as brkchar.
		popj p,]
	cain a,^Q	;if quote char,
	 tro f,%ctlq	;set flag.
	caie a,",	;if standard item breaker,
	 caig a,40	;or a space or ctl char,
	  popj p,	;break.
	caie a,"/	;other break chars...
	 cain a,"@
	  popj p,
	cain a,"%
	 popj p,
	aoja b,jcwd1

	; JCLA - analyze JCL to accumulate all site #'s we will have to
	;scan specifically for.

jcla:	pushae p,[a,b,c,d,e]
	move a,[hjtab,,hjtab+1]
	setzm hjtab
	blt a,hjtab+nnhsts-1	; clear host-has-JCL indicator table
	trz f,%getus+%getnt
	pushj p,jclbeg		;set up JCITM.
jcla10:	setom itbarf		;complain about unknown hosts
	pushj p,jcitm		;get an item
	 jrst jcla50		;EOF, no more items.
	skipe itsw
	 jrst [	tro f,%getsw ? jrst jcla10]
	move c,ithst
	move a,c
	skipn itmhst		;Skip if only one
	 jrst jcla16
jcla15:	ildb b,c
	jumpe b,jcla10		;no more hosts, stop
	pushj p,hstlook
	move a,b
jcla16:	came a,ownhst
	 camn a,ownhst+1
	 troa f,%getus
	 tro f,%getnt
	movsi b,-nnhsts
jcla20:	skipn hjtab(b)
	 jrst [	movem a,hjtab(b)
		skipe itmhst
		 jrst jcla15
		jrst jcla10]
	camn a,hjtab(b)		;compare hst # with those already listed
	 jrst [	skipe itmhst
		 jrst jcla15
		jrst jcla10]
	aobjn b,jcla20
	jsr error

jcla50:	popae p,[e,d,c,b,a]
	popj p,



	;stores item name in appropriate locations in appropriate forms.
namsto:	pushae p,[a,b,c]
	move c,nspecs
	cail c,maxspc
;	 jsr error
	 jrst namst9	; ignore until get error macro/uuo
	lsh c,1
	move a,itcnt
	move b,itptr
	skipn itquot		;if was quoted,
	 skipn itpmat		;or if partial match not requested,
	  tlo a,400000		;set sign bit as flag in cnt word.
	movem a,namtab(c)
	movem b,namtab+1(c)
	hrrzs a
	caile a,6
	 jrst namst6		;too long to be uname or Tnn.
	movei a,itcnt
	pushj p,ncvt6		;convert string into 6bit
	push p,a		; save 6bit
	skipe itquot		;if name was quoted, never convert to TTY #.
	 jrst namst3
	tlc a,(sixbit /T0 /)
	tdne a,[777000,,-1]	;test for Tn
	 jrst namst3		;nope, uname.
	tlnn a,77		; see if anything in 2nd digit pos.
	 jrst [	lsh a,-30	; no, just get single digit.
		jrst namst2]
	tlc a,'0
	tlne a,70		; make sure char in 3rd pos is digit.
	 jrst namst3		; nope
	lshc a,-30
	lsh b,3
	lshc a,3
namst2:	aos b,nsktty
	caile b,maxent
	 jsr error
	movem a,sektty-1(b)	;say type is TTY.
	pop p,a
	jrst namst8

namst3:	pop p,a
	aos b,nskunm
	caile b,maxent
	 jsr error
	movem a,sekunm-1(b)
	skipe itpmat		; was partial match requested?
	 hrros pmatnm-1(b)	; Set LH to -1 if so.

namst6:	movei a,namtab(c)
	aos b,nskfnm
	caile b,maxent
	 jsr error
	movem a,sekfnm-1(b)
	skipe itpmat		; partial match requested?
	 hllos pmatnm-1(b)	; set RH to -1 if so.
namst8:	aos nspecs
namst9:	popae p,[c,b,a]
	popj p,

BVAR
ifndef maxspc,maxspc==30
nspecs:	0		;# of specs stored in namtab
namtab:	block maxspc*2

ifndef maxent,maxent==30	;max # entries for any one type
nsktty:	0		;cnt of ttys to look for
sektty:	block maxent	;holds # of tty
nskunm:	0		;unames
sekunm:	block maxent	;holds 6bit of uname
nskfnm:	0		;full names
sekfnm:	block maxent	;holds ptr to namtab descriptor

pmatnm:	block maxent	; LH has uname switch, RH has full name switch for corresponding
			; entries in SEKUNM and SEKFNM.  If switch is -1, partial
			; matches should be found.  Otherwise, only exact matches.
EVAR

ncvt6:	pushae p,[b,c,d,e]
	move c,(a)
	move d,1(a)
	setz a,
	move e,[440600,,a]
	jrst ncvt63
ncvt62:	ildb b,d
	cail b,"a
	 caile b,"z
	  caia
	   subi b,40
	subi b,40
	idpb b,e
ncvt63:	sojge c,ncvt62
	popae p,[e,d,c,b]
	popj p,

;Get data from Lisp machines.  We use a Chaosnet simple-transaction with contact
;name FINGER.  The first line of the response is the user ID, the second is
;the console location, the third is the idle time (as a string).

;Look through the host table to find all the Lisp machines,
;or all Lisp machines associated with the machine we are on.
;Contact them eight at a time using all 16 I/O channels.
lmfing:	pushae p,[a,b,c,d,e,t,tt]
	.iopush ntsi,
	.iopush tyoc,
	.iopush tyic,
	.iopush ls1c,
	.suset [.rmsk2,,tt]
	push p,tt
	movei c,177777		;Enable all I/O interrupts
	movem c,lmintb
	.suset [.smsk2,,c]
	setz c,			;C has index into LMADRS.
ife 1,[				;now we have reagan this works differently...
	trne f,%alllm
	 jrst [	movei b,hslm	;Find the table of all lisp machines, or
		jrst lmfin2]
	]
	setz a,			;find the table of lisp machines
lmfin1:	hllz b,hs10lm(a)	;associated with this machine.
	jumpe b,lmfinx
	came b,mname
	 aoja a,lmfin1
	hrrz b,hs10lm(a)	;B gets address of that table.
lmfin2:	move a,b		;Each word of table is an ASCIZ string.  Get address.
	skipn (a)
	 jrst lmfin3
	move a,(a)
	hrli a,440700
	push p,b
	push p,c
	pushj p,netwrk"hstlook	;Look it up as a host name.
	 setz a,
	pop p,c
	pop p,b
	skipn a			;If we found one,
	 aoja b,lmfin2
	movem a,lmadrs(c)	;store it in LMADRS.
	addi c,1
	caile c,nontty		;Complain if LMADRS gets full.
	 jsr error
	aoja b,lmfin2

lmfin3:	setzm nextlm
	.rdtime t,		;Get starting time.  Use at most 30 seconds for whole thing.
	addi t,30.*30.
	movem t,chstim'		;Time to stop
	;Now start 8 RFC's
	movei a,16
lmstr4:	pushj p,lmrfc		;Ask eight lisp machines, to start with.
	subi a,2
	jumpge a,lmstr4
	;Collect results
lmstr6:	movei a,16		;Scan all the channels
lmstr7:	.suset [.sdf2,,[0]]	;Enable for state-change interrupts
	setzm lmintf		;Flag set if chsin1 didn't get latest poop
	pushj p,chsin1		;chsin1 processes any replies,
				;and when one lispm replies,
				;it reuses the channels to ask another one.
	subi a,2
	jumpge a,lmstr7
	movsi a,-8		;See if any channels still active
	skipge chsidx(a)
	 aobjn a,.-1
	jumpge a,lmstr9
	.rdtime t,		;Yes, timed-out anyway?
	caml t,chstim
	 jrst lmstr9
	movei t,30.		;No, delay momentarily and try again
	skipn lmintf
lmintw:	 .sleep t,
	jrst lmstr6

lmstr9:	movsi a,-20		;Close channels and return
lmstr8:	.call [ setz ? sixbit/close/ ? setzi (a) ]
	 jfcl
	aobjn a,lmstr8
lmfinx:	setzm lmintb
	.suset [.saifpir,,[177777]]
	.suset [.sdf2,,[0]]
	pop p,tt
	.suset [.smsk2,,tt]
	.iopop ls1c,
	.iopop tyic,
	.iopop tyoc,
	.iopop ntsi,
	popae p,[tt,t,e,d,c,b,a]
	popj p,

;Enter an RFC to next Lisp machine on channel in A.
;Uses AC's a,b,t,tt
lmrfc:	move t,a		;mark channel free
	lsh t,-1
	setom chsidx(t)
	move tt,nextlm		;Find next machine
	caige tt,nontty
	 skipn b,lmadrs(tt)
	  popj p,
	aos nextlm
	movem tt,chsidx(t)
	.rdtime tt,
	movem tt,chsstm(t)
	dpb b,[$cpkda+lmpkt]	;send RFC to this guy
	movei tt,%corfc
	dpb tt,[$cpkop+lmpkt]
	movei tt,.length/FINGER/
	dpb tt,[$cpknb+lmpkt]
	move tt,[.byte 8 ? "F ? "I ? "N ? "G]
	movem tt,%cpkdt+lmpkt
	move tt,[.byte 8 ? "E ? "R]
	movem tt,%cpkdt+1+lmpkt
	.call [ setz ? 'CHAOSO ? movei (a) ? setzi 1(a) ]
	 jrst [	setom chsidx(t) ? popj p, ]	;probably device full
	.call [ setz ? 'PKTIOT ? movei 1(a) ? setzi lmpkt ]
	 jsr error
	popj p,			;pick up answer later

;Call here to check status of channel-pair in a
chsin1:	;set c to index into lisp-machine tables
	move tt,a
	lsh tt,-1
	skipge c,chsidx(tt)
	 popj p,		;channel not in use
	.call [ setz ? 'WHYINT ? movei (a) ? movem b ? movem b ? setzm b ]
	 jsr error
	hlrzs b			;number of input packets
	jumpe b,chsin9		;none yet
	.call [ setz ? 'PKTIOT ? movei (a) ? setzi lmpkt ]	;Get the packet
	 jsr error
	ldb tt,[$cpkop+lmpkt]
	caie tt,%coans
	 jrst lmrfc		;Some lossage, ignore this machine
	;First line is UNAME in ascii
	move b,[440800,,%cpkdt+lmpkt]
	movei d,0
	move tt,[440600,,d]
chsin2:	ildb t,b
	cain t,215
 	 jrst chsin3
	caige t,140
	 subi t,40
	tlne tt,770000
	 idpb t,tt
	jrst chsin2

chsin3:	jumpe d,lmrfc		;Ignore if no one logged in there
	movem d,lmunam(c)
	;Second line is console location in ascii
	move e,lmdoc(c)
	movei d,10*5-1		;max characters
chsin4:	ildb t,b
	cain t,215
	 jrst chsin5
	idpb t,e
	sojg d,chsin4
	ildb t,b
	caie t,215
	 jrst .-2
chsin5:	;Third line is idle time as a string
	movei e,lmidle(c)
	hrli e,440700
	movei d,4
chsin6:	ildb t,b
	cain t,215
	 jrst chsin7
	idpb t,e
	sojg d,chsin6
chsin7:	jrst lmrfc		;find another guy

chsin9:	.rdtime t,
	sub t,chsstm(tt)
	caige t,4*30.
	 popj p,
	jrst lmrfc		;timed out, give up on this guy

;This routine adds lisp machine whose index is in i to user tables
lmadd:	move t,lmunam(i)
	movem t,u%unam(x)
	movem t,u%xunm(x)
	move a,lmadrs(i)
	pushj p,netwrk"hstsix
	 jsr error
	movem a,u%jnam(x)
	movei t,maxtty(i)
	movsm t,u%tty(x)	;fake tty#
	movei tt,%ulgin
	iorm tt,u%flgs(x)	;indicate this entry is logged in.
	pushj p,addus4		;make this entry real
	popj p,

;This is the basic unit of processing for local users.
;We have a large set of parallel tables, all indexed by rh(x).
;Each new user recorded gets an entry in those tables, and TLUSERS is incremented.
;Eventually, all the users in the tables are printed out.

;Record user in rh(u) with tty in rh(i) in table slot in rh(x).
;It is the caller's responsibility to increment x and tlusers.
gotone:	hrrz a,i		;get tty #
	setzm u%svrj(x)		;will be zero if not net user
	setzm u%tty(x)		;also make sure of this
	caml a,nfstty		;is it a psuedo?
	 caml a,nlstty
	  jrst gotdat		;no, we have all info in u

	;hack psuedo-tty...
	sub a,nfstty		;tis a sty...find sty #
	exch i,a		;use i for sty index temporarily
	push p,u
	move u,@stysts		;get sty info (i.e. who has this sty open)
	exch a,i		;restore i
	move b,@uname		;get uname and
	movem b,u%aux1(x)
	move a,@jname		;jname of controlling procedure.
	movem a,u%aux2(x)
	movem u,u%svrj(x)
	push p,i
	movei i,-1		;if job isn't a server, i will have -1.
	jumpe u,[setzm u%aux1(x)	;if no job at all, reset vars
		setzm u%aux2(x)
		setzm u%svrj(x)
		aoja i,gotsvx]		;and indicate non-server.
	skipl @suppro		;to be a server, must be top-level
	 jrst gotsvx
	came a,['stelnt] 	;and jname must be stelnt, netrfc, telser, or rfc<nnn>
	 camn a,['netrfc]	; (eventually check here for jname of CHAOS
	  jrst gotsv1		; and do right things etc)
	hlrz b,a
	caie b,'rfc
	 camn a,['telser]
	  jrst gotsv1
	jrst gotsvx

	;hack network server - simply make i not be -1
gotsv1:	movei i,1		;rh(u%tty) = 1 => network server
gotsvx:	hrrm i,u%tty(x) 	;i has 0 for no sty, -1 for non-net sty, 1 for net-sty
	pop p,i			;restore i (tty #)
	pop p,u			;restore u

gotdat:	hrlm i,u%tty(x)		;record info in tables
	move a,@utmptr
	move a,400000(a)
	hrrm a,u%jtm(x)
	skipa a,u		;find idx no of top level job
gotda1:	 move u,b
	skipl b,@suppro
	 jrst gotda1		;loop till find -1, which means job is top level
	hrlm u,u%jtm(x)
	move b,@uname		;get UNAME and XUNAME from top level job.
	movem b,u%unam(x)
	move b,@xuname
	movem b,u%xunm(x)

	move u,a		;restore stored idx no
	move a,@jname
	movem a,u%jnam(x)
	movei a,%ulgin
	iorm a,u%flgs(x)	;indicate this entry is logged in.
	popj p,

;Put all users now logged in in the tables to be listed.
;This is done by looping over all terminal numbers.
;Also handle request for all users coming in over the net.
;The flags %astflg and %netusr are used to distinguish these two cases.
star:	pushae p,[a,b,c,d,e,i]
	hrlz i,nct		;length of its tty tables (# of ttys)
	movn i,i		;as aobjn.

star1:	move u,@ttysts		;get status wd for this tty
	tlnn u,%tscns		;being used as a console?
	 jrst star2		;no, disregard
	hrrz u,u		;flush lh
	cain u,-1		;check for no user(just in case)
	 jrst star2		;hmm, nope.
	jumpe u,star2		;don't mention system job.
	pushj p,gotone		;got a user! record him.
	tlne f,%astflg		;user wants all logged in users if set
	 jrst star4
	tlne f,%netusr		;if user wants all people logged in thru net... 
	 skipn u%svrj(x)
	  jrst star2
star4:	pushj p,addus4		;Officially add this user to the table.
star2:	aobjn i,star1		;tty not being used, keep looking
	tlnn f,%astflg\%astlsp	;If we want all users, show all lisp machine users.
	 jrst star3
	;add any Lisp machines
	movei i,nontty-1
star5:	skipe lmunam(i)
	 pushj p,lmadd
	sojge i,star5
star3:	popae p,[i,e,d,c,b,a]
	popj p,

;look through the user file for all users whose
; (1) uname matches JCL unames
; (2) Full name matches JCL fullnames.
; if in WHEN, make entry even if not found in user file.

whofnd:	pushae p,[a,b,c,d,e]
	skipn e,who		;get AOBJN for uname matching.
	 jrst whof50		;no unames to find, do fullnames.
whof10:	move b,(e)
	pushj p,useek1		;look for uname in INQUIR data base.
	jumpn b,whof17
	movei b,1
	syscal open,[[.uai,,dkic] ? ['dsk,,]
		[sixbit /.file./]	; See if directory exists
		[sixbit /(dir)/]
		(e)]
	 seto b,
	.close dkic,
whof17:	move a,(e)		;Add user.  B is positive if user has dir or has inquir entry.
	pushj p,addusr
	aobjn e,whof10

whof50:	skipn e,whofnm
	 jrst whof95		;no fullname requests? return.
whof54:	move a,(e)		;get slot entry - ptr to descriptor
	move b,1(a)		;get b.p. to next fullname
	hrrz d,(a)		;and # characters in it.
	move c,strfre		;copy to strstg, so we can make it asciz and word aligned.
whof55:	ildb a,b
	cail a,"a		;also convert it all to upper case, as lsrlnm requires.
	 caile a,"z
	  caia
	   subi a,40
	idpb a,c
	sojg d,whof55
	setz a,			;not only make it asciz, but pad with 0's at least to
   repeat 5,idpb a,c		;a word boundary.
	movei a,ls1c		;look this last name up in LSR1
	move b,strfre
	pushj p,[ skipl @(e)
		   jrst lsrtns"lsrlnp	;either as a prefix
		  jrst lsrtns"lsrlnm]	;or for an exact match
	 jrst whof57
whof56:	push p,b		;and b gets aobjn -> range of LASTNAME table words.
	hrrz b,(b)		;for each one, get the file address of corresponding entry,
	movei a,ls1c
	pushj p,lsrtns"lsrget	;get the entry in core,
	 jsr error
	hrli b,440700		;extract the uname from the entry, convert to 6bit in a.
	aos b
	move c,[440600,,a]
	setz a,
whof58:	ildb d,b
	jumpe d,whof59
	subi d,40
	tlne c,770000
	 idpb d,c
	jrst whof58

whof59:	movei b,1
	pushj p,addusr		;and add the user to usrtab.
whof60:	pop p,b
	aobjn b,whof56
whof57:	aobjn e,whof54		;check each last name specified in the jcl.
whof95:	popae p,[e,d,c,b,a]
	popj p,

;Add the user whose uname is in A (as sixbit) to the table.
;If the user is logged in, all ttys he is on are added.
;Otherwise, an entry is added for him with no tty.
;An entry with a tty is redundant only if that tty is already mentioned.
;An entry with no tty is redundant if that uname is already mentioned.
;B is >0 if the user has an inquir entry or a file directory.
;If B is negative, the user should not be added if not logged in, unless this is :WHEN.
addusr:	hrlz i,nct		;length of its tty tables (# of ttys)
	movn i,i		;as aobjn.
	push p,tluser
addus1:	move u,@ttysts		;get status wd for this tty
	tlnn u,%tscns		;being used as a console?
	 jrst addus2		;no, disregard
	hrrz u,u		;flush lh
	cain u,-1		;Detect case of idle tty.
	 jrst addus2
	came a,@xuname		;See if this tty's uname or xuname matches desired one.
	 camn a,@uname
	  caia
	   jrst addus2
	pushj p,ttyexs		;Found a tty with the desired user.  If not mentioned already,
	 caia
	  pushj p,addus3		;make an entry for this tty.
addus2:	aobjn i,addus1
	;Also try adding from Lisp machines
	movei i,nontty-1
addul1:	camn a,lmunam(i)
	 pushj p,addul2
	sojge i,addul1
	pop p,c
	camn c,tluser		;If no tty has this user,
	 pushj p,unmexs		;and there's no entry of any sort for him,
	  popj p,
	trnn f,%when		;and either he is a known user or this is :WHEN,
	 jumpl b,cpopj
	movem a,u%unam(x)	;add him as not logged in.
	movem a,u%xunm(x)
	setom u%tty(x)		;indicate not logged in.
	movem b,u%fdir(x)	;Remember whether he has a directory.
	jrst addus4

addul2:	addi i,maxtty
	pushj p,ttyexs
	 jrst [ subi i,maxtty ? popj p, ]
	subi i,maxtty
	push p,a
	pushj p,lmadd
	pop p,a
	popj p,

addus3:	pushae p,[a,b,c,d,e]
	pushj p,gotone
	popae p,[e,d,c,b,a]
addus4:	aos tluser		;Bump free pointer to tables;  maybe get more core.
	addi x,ul
	caml x,usrend
	 pushj p,usrinc
	popj p,

;TTYEXS - skip if there is no entry in the table yet for the tty in rh(I).

ttyexs:	push p,x
	push p,a
	movn x,tluser
	jumpe x,ttyex5		;if nothing in tables yet, skip.
	hrlzs x
	add x,usrloc
ttyex2:	hlrz a,u%tty(x)
	cain a,(i)
	 jrst popaxj		;Found the tty.  Don't skip.
	addi x,ul-1
	aobjn x,ttyex2
ttyex5:	aos -2(p)		;didn't find, skip on return.
popaxj:	pop p,a
	pop p,x
	popj p,

; UNMEXS - takes uname in A, skips if not entered in USRTAB table.
;Doesn't skip if uname matches either a uname or xuname entry.

unmexs:	push p,x
	movn x,tluser
	jumpe x,unmex5		;if nothing in tables yet, skip.
	hrlzs x
	add x,usrloc
unmex2:	came a,u%unam(x)
	 camn a,u%xunm(x)
	  jrst [pop p,x ? popj p,]	;found him, return without skipping.
	addi x,ul-1
	aobjn x,unmex2
unmex5:	pop p,x
	aos (p)		;didn't find, skip on return.
	popj p,


;Given in B an aobjn -> a table of tty numbers,
;make sure there is an entry in the table of users for each of those ttys.
whoft:	move i,(b)
	pushj p,whoft0
	aobjn b,whoft
	popj p,

;Make an entry in the table for the tty whose number is in I,
;whether the tty is in use or not.  If not, give user as "Nobody".
;We check to see that the tty is not already in the table.
whoft0:	move c,usrloc
	jrst whoft3

whoft1:	hlrz d,u%tty(c)
	camn d,i		;Check each entry we have.
	 popj p,		;If we have one for this tty already,
	addi c,ul		;don't make another one.
whoft3:	camge c,x		;No entry for this tty yet => make one.
	 jrst whoft1
	move u,@ttysts		;get status wd for this tty
	tlnn u,%tscns		;being used as a console?
	 jrst whoft4		;no, say "Nobody".
	hrrz u,u		;flush lh
	caie u,-1		;Detect case of idle tty.
	 jrst addus3		;Otherwise, make entry saying who is on the tty.
whoft4:	hrlzm i,u%tty(x)
	move d,['nobody]	;supply "nobody" as the user.
	movem d,u%unam(x)
	movem d,u%xunm(x)
	setzm u%jnam(x)
	jrst addus4

;Print out all the users added to the table by STAR, WHOFND, WHOFT, etc.
putout:	pushae p,[d,e]
putou9:	movn x,tluser
	hrlzs x
	add x,usrloc
putou2:	setz i,			;sys variables cretinously indexed by I...
	skipge @sysdbg		;see if sys being debugged...
	 jrst [	iot tyoc,[asciz /SYSTEM BEING DEBUGGED
/]
		jrst .+1]
	move d,@shutdn		;get system var saying if and when sys is scheduled to die.
	jumpe d,putou3		;not scheduled to go down.
	sub d,@time
	idivi d,30.		;it is; d gets # seconds till then.
	.rlpdt a,		;get # seconds from start of year to now.
	add a,d			;get # seconds from start of year till sys goes down.
	idivi a,24.*60.*60.	;remainder is # seconds since midnight.
	move d,b			;d has time for system to go down.
	iot tyoc,[asciz /ITS GOING DOWN AT /]
	pushj p,tmhms		;print time system will go down.
	typz crlf
	.open dkic,[.bai,,'sys
		     sixbit /down/
		     sixbit /mail/]
	 jrst putou4
putou5:	move d,[-10,,dwnml]
	.iot dkic,d
	setzm (d)		;ensure asciz string
	movei a,dwnml
	iot tyoc,(a)
	jumpge d,putou5
putou4:	typz crlf
putou3:	jumpl x,ptohed		;possibility of no users...
	trne f,%whois+%when
	 jrst [	iot tyoc,[asciz /Not found.
/]
		jrst finish]
	iot tyoc,[asciz /No users
/]
	jrst finish

ptohed:	tlne f,%astflg+%netusr
	 skipn tlusers		;For * and *NET we want a header,
	  jrst ptohd2		;provided there's at least one user.
	movei a,[asciz /-User-    --Full name--         /]
	trnn f,%abbrev		;omit full name for abbreviated listing
	 jrst ptohd1
	movei a,[asciz /-User-/]
ptohd1:	iot tyoc,(a)
	trne f,%jobnof		;make room for job number if we are printing it.
	 iot tyoc,[asciz /Job/]
	iot tyoc,[asciz / Jobnam Idle TTY -Console location-
/]
ptohd2::

;print out next line, about the next user.
ptolup:	skipl a,u%tty(x)	;see if this entry is logged in.
	 jrst ptolu1
	camn x,usrloc		;If not logged in, but previous entry was logged in,
	 jrst ptolu1
	skipge a,u%tty-ul(x)
	 jrst ptolu1
	tlne f,%astflg+%netusr	;and we had a * or *NET, then separate that from the rest
	 typz crlf		;of the stuff (which begins now) with a blank line.
ptolu1:	pushj p,unmout	;print info about user (eg his name)
	push p,b	;also, entry for user left in B.
	skipge u%tty(x)
	 jrst ptocn7
	.iot tyoc,[40]	;Here for a logged in user.  one space
	pushj p,jnmout	;just job name for now
	pushj p,ttyout	;info about tty
	setz a,
	jrst ptocn6

;Here for a not-logged-in user.
ptocn7:	pushj p,lgotim		;try to find his last logout time (ptr left in A)
;*** Note, the code here inside the literal causes a bug when doing :when moon
;*** if moon5 has an inquir entry but no directory and no logout times entry.
;*** Not clear to me how to fix this.
	jumpe a,[skiple u%fdir(x)	; if no logout time, see if has fdir
		  jumpe b,ptol50	; if has fdir and no LSR entry, avoid
		 move a,[440700,,[asciz / Not logged in./]]
		 jrst .+2]		; this message.  Skip over "last l.."
	type [ Last logout ]
	pushj p,otypc

	pushae p,[c,d]

	move a,u%xunm(x)
	setz c,
	movei d,plic
	pushj p,lsrtns"lsrhsn	   ;look up the HSNAME
	  jrst [popae p,[d,c]	   ;  Punt
	        jrst ptol5x]
	move a,d
	popae p,[d,c]
	syscal open,[[.uai,,plic] ? ['dsk,,]
		u%xunm(x) ? [sixbit /plan/] ? a]
	 caia
	  jrst [ movei a,1
		 jrst ptocn6]		; found plan file!
ptol5x:	setz a,
	skiple u%fdir(x)	; If entry-less and has file dir,
	 jumpe b,ptol50		; don't barf about plan file.
	type [  No plan.]
ptol50:
ptocn6:	pop p,b
	trnn f,%whois	; Is this a whois?
	 jrst ptol75	; nope, skip detailed info.
	jumpn b,[pushj p,lsrout	; Output LSR stuff if user has inquir entry
		jrst ptol75]
	skipg u%fdir(x)	; no inquir entry, has file dir?
	 jrst ptol75	; sigh, nope.
	syscal open,[[.uai,,dkic] ? ['dsk,,]
		[sixbit /-read-/] ? [sixbit /-this-/] ? u%xunm(x)]
	 jrst [	syscal open,[[.uai,,dkic] ? ['dsk,,]
			[sixbit /!read!/] ? [sixbit /!this!/] ? u%xunm(x)]
		 jrst ptol75
		jrst .+1]
	type [
  Note:
]
	pushj p,typdki	; type out file

ptol75:	jumpe a,ptocn9	; jump if no plan.
	.iopush plic,	; transfer channel to DKIC
	.iopop dkic,
	type [  Plan:
]
	pushj p,typdki	; type it out

ptocn9:	typz crlf	; new line
ptocnt:	addi x,ul-1	;bump index
	aobjn x,ptolup

	;now we are finished printing out all the users
finish:	popae p,[e,d]
	popj p,

	; Type out one page of stuff from DKIC channel,
	; indenting as per INDENL.
	; Makes sure CRLF was last thing output.
typdki:	push p,a
	push p,b
typdk1:	tdca b,b
typdk2:	 seto b,
	.iot dkic,a
typdk3:	jumpl a,typdk5
	caie a,^C
	 cain a,^L
	  jrst typdk5
	jumpe b,[caie a,^M
		 typz indenl
		jrst .+1]
	.iot tyoc,a
	caie a,^M
	 jrst typdk2
	.iot dkic,a		; CR seen, needs checkout.
	caie a,^J
	 jrst [	tlne f,%svrmod	; Bare CR
		 .iot tyoc,[^@]	; needs NULL for telnet ptcl
		jrst typdk3]
	.iot tyoc,a
	jrst typdk1

typdk5:	caie b,		; make sure CRLF is last thing.
	 typz crlf
	.close dkic,
	pop p,b
	pop p,a
	popj p,


indenl:	asciz /   /	; Spaces to indent for whois lines.

	;Hack the printout of random LSR stuff about this user.
lsrout:	push p,b	; shouldn't clobber acs.
	pushj p,lsrfnd	;find pointers to all LSR info about this entry
	typz crlf

	; First line
	skipn lsr+LSRTNS"I$nick		;nickname exists?
	 skipe lsr+LSRTNS"I$neta	; or net addr?
	  jrst lsro1
	skipn lsr+lsrtns"i$proj		; or project?
	 skipe lsr+lsrtns"i$supr	; or supervisor?
	  jrst lsro1
	jrst lsro2		; bah, try second line.

	; Type "(nickname) [netaddr] hacking <proj> for <superv>"
lsro1:	typz indenl		; indentation for lsr stuff
	skipe lsr+LSRTNS"I$nick	; nickname?
	 jrst [	TYPE [(]
		7TYP 1,lsr+LSRTNS"I$NICK
		TYPE [)]
		jrst .+1]
	skipe lsr+lsrtns"i$neta	; Net addr?
	 jrst [	skipe lsr+lsrtns"i$nick
		 .iot tyoc,[40]
		.iot tyoc,["[]
		7typ 1,lsr+lsrtns"i$neta
		.iot tyoc,["]]
		jrst .+1]
	SKIPN LSR+LSRTNS"I$PROJ		; Either proj or superv?
	 skipe lsr+lsrtns"i$supr
	  jrst [skipn lsr+lsrtns"i$nick
		 skipe lsr+lsrtns"i$neta
		  type [ ]		; space if anything preceding.
		type [Hacking ]
		skipe lsr+lsrtns"i$proj
		 7TYP 1,LSR+LSRTNS"I$PROJ
		SKIPN LSR+LSRTNS"I$SUPR
		 jrst .+1
		skipe lsr+lsrtns"i$proj	; if no proj, "Hacking for ..."
		 type [ ]
		type [for ]
		7TYP 1,LSR+LSRTNS"I$SUPR
		jrst .+1]
	typz crlf

	; Second line: "<bday>; <offa>; <offt>; Home Phone <homt>"
lsro2:	SKIPN LSR+LSRTNS"I$BRTH		; Anything that can go on line?
	 SKIPE LSR+LSRTNS"I$MITA
	  JRST lsro21
	SKIPN LSR+LSRTNS"I$MITT
	 SKIPE LSR+LSRTNS"I$HOMT
	  JRST lsro21
	jrst lsro3		; Nothing to go on line.
lsro21:	typz indenl		;THERE IS ONE; START A LINE FOR THEM.
	SETZ B,
	SKIPE LSR+LSRTNS"I$BRTH
	 JRST [	type [Birthday ]
		7TYP 1,LSR+LSRTNS"I$BRTH
		aoja b,.+1]
	SKIPE LSR+LSRTNS"I$MITA		;IF THERE'S AN MIT ADDRESS,
	 JRST [	caie b,
		 type [;  ]
		7TYP 1,LSR+LSRTNS"I$MITA		;PRINT IT.
		aoja b,.+1]
	SKIPE LSR+LSRTNS"I$MITT		;IS THERE AN MIT TEL #?
	 JRST [	skipe b
		 SKIPN LSR+LSRTNS"I$MITA
		  caia
		   type [; ]	;SPECIAL CASE: BIRTHDAY AND MIT TEL BUT NO MIT ADR.
		skipe b
		 type [ ]
		7TYP 1,LSR+LSRTNS"I$MITT
		aoja b,.+1]
	SKIPE LSR+LSRTNS"I$HOMT
	 JRST [	SKIPE B
		 type [;  ]
		type [Home Phone ]
		7TYP 1,LSR+LSRTNS"I$HOMT
		jrst .+1]
	typz crlf

	; Third line: "<homa>"
lsro3:	SKIPE LSR+LSRTNS"I$HOMA
	 JRST [	typz indenl
		7TYP 4,LSR+LSRTNS"I$HOMA
		typz crlf
		jrst .+1]
	; Fourth line(s): "<rem>"
	SKIPE LSR+LSRTNS"I$REM
	 JRST [	typz crlf
		typz indenl
		7TYP 5,LSR+LSRTNS"I$REM	;handle remarks as ASCIZ.
		typz crlf
		jrst .+1]
	pop p,b
	popj p,

	;initialize user-info blocks. LS2MAP must have been called!!
usrini:	push p,ffloc
	pop p,usrloc	;initialize USRLOC and drop thru.

	; called when index into usr-info area is .GE. C(USREND).
usrinc:	pushae p,[a,b]
	syscal corblk,[cimm %cbndr+%cbndw
		cimm -1 ? ffpag ? cimm %jsnew]	;get fresh new page
	 jsr error
	aos a,ffpag	;increment
	lsh a,10.
	movem a,ffloc
	sub a,usrloc	;find # wds in usr-info area now
	idivi a,ul	;find # blocks possible.
	imuli a,ul	;find limiting address in terms of block boundaries
	add a,usrloc	;make absolute
	movem a,usrend	;and store.
	popae p,[b,a]
	popj p,

;Connect to the host whose number is in HSTCUR.  Skip if successful.
;If fail, don't skip, but print an error message.
hicp:	pushae p,[a,b,c,d,e]
	tlne f,%chausr
	 jrst hicpc
	movei a,nticp
	move b,hstcur
	movei c,icpsoc
	move d,[.uai,,.uao]
	pushj p,[tro f,%usetcp	;see comment about /i switch
		 trnn f,%usetcp
		  jrst netwrk"arpicp	;"
		 movei a,ntic
		 jrst tcpicp]
hicp1:	 pushj p,netwrk"analyz	;Always skips
	  aos -5(p)
	popae p,[e,d,c,b,a]
	popj p,

hicpc:	movei tt,0		;make sure asciz
	idpb tt,cnnptr
	movei a,ntic
	move b,hstcur
	movei c,connam
	movei d,5
	push p,[hicp1]
	jrst netwrk"chacon

netin:	pushae p,[a,c]
	setz c,		;clear cnt of chars on line
netin1:	.iot ntic,a	;read a name listing and print it
	JUMPE A,NETIN1	;IGNORE NULLS.
	camn a,[-1,,3]	;eof character
	 jrst netin9	;done...
	tlne f,%chausr
	 jrst [	caie a,215	;convert newline to crlf
		 jrst .+1
		seto c,
		.iot tyoc,[^M]
		movei a,^J
		jrst .+1]
	andi a,177	;For chaosnet, map 211 into tab (and so forth)
	cain a,^I	;handle tabs in count
	 jrst [	addi c,10
		andi c,777770
		jrst netin2]
	cain a,^M
	 seto c,	;CR, clear cnt (-1 because AOS'd later)
	;; The following added by CBF 22Jul84 to handle Unix style newlines
	cain a,^J       ; An LF?  Perhaps this is a losing Unix newline char?
	   jrst [ caig c,0	; are we in a column > 0?
		   jrst .+1	; No, we're not
		  .iot tyoc,[^M] ; Yes, we are, force a CR
		  setz c,	; clear column cnt
		  jrst .+1]
	caie a,^J	;lf doesn't increment count
	 aos c

	;; this should check to see if the tty has %tosai!
	caige a,40		;is it control character?
	 cain a,^M		;but not CR
	  skipa			;then it'll print like ^A
	   aos c		;so worry about it

netin2:	trnn f,%whois
	 camg c,tcmxh	; If not doing WHOIS, don't print beyond linel,
			; truncate instead.  (On 10/8/88 I changed the
			; CAMGE that used to be here to a CAMG because if
			; you have 79 available columns it is OK to print
			; in column 79.  Perhaps this will uncover some
			; other fencepost error that this has been hiding.
			; If you find that error, don't just put the CAMGE
			; back, fix that other error! -Alan)
	  .iot tyoc,a
	jrst netin1	;get another char

netin9:	.close ntic,	;close net chans when done
	.close ntoc,
	popae p,[c,a]
	popj p,

cnnbyt:	idpb tt,cnnptr
	aos cnncnt
	popj p,

cnnstr:	hrli t,440700
cnnst1:	ildb tt,t
	jumpe tt,cpopj
	pushj p,cnnbyt
	jrst cnnst1

;output the uname and full name of the user in x.
;return in b a pointer to his lsr1 entry in core (or 0 if none).

unmout:	move a,u%unam(x)	;get uname
	pushj p,wtype6	;type out the sixbit
	pushj p,useek	;look for this uname in dir, return group designation
			;char in A, entry in B, b.p. in C to fullname. D is relation char.
	trne f,%abbrev	;no name if abbreviated
	 popj p,
	.iot tyoc,[40]
	push p,b	;save table entry
	jumpn b,unmou5	; normal printout if entry found.
	skipge b,u%fdir(x)	; no entry, has file directory?
	 jrst unmou5		; Nope.
	jumpe b,[syscal open,[[.bai,,dkic] ? ['dsk,,]
			[sixbit /.file./]	; see if has file dir
			[sixbit /(dir)/]
			u%xunm(x)]
		 skipa b,[-1]	; nope, switch set neg
		  movei b,1	; yep, set pos.
		movem b,u%fdir(x)
		jumpl b,unmou5	; now can make definite jump
		jrst .+1]	; has file dir! continue
	move c,[440700,,[asciz /--> File Directory Only! /]]
	movei b,25.
	jrst unmou7		; skip over group-char print
unmou5:	caig a,40		;space or control characters
	 movei a,"-		;print as "-"
	;; suppress printing of "A" on AI unless it's AX
	push p,b
	move b,mname
	sub b,[sixbit/AI/]
	jumpn b,unmou6
	caie a,"A
	 jrst unmou6
	caie d,"X
	 movei a,40
unmou6:	pop p,b
	.iot tyoc,a
	caie d,0
	  caie d,"X
	    movei d,40
	.iot tyoc,d		;print relation if it is X.
	.iot tyoc,[40]
	movei b,22.
unmou7:	setz d,
	pushj p,typcnt	;type out info about user
	pop p,b		;return.
	popj p,

;look for uname indexed by X and return byte pointer in C to fullname string.
;A will have the "group designation char" if there is one.
;B gets the core address of the entry, which will be valid only until the next useek.
;If the user has no entry, B gets 0.
;D gets "relation" character.
useek:	move b,u%xunm(x)	;b gets xuname, or ______ for non-logged-in users.
	hlre c,b
	aosn c
	 seto b,
useek1:	movei a,ls1c		;a gets channel LSR1 is open on.
	pushj p,lsrtns"lsrunm	;search LSR1 for the uname.
	 jrst usearl		;not found => return standard stuff.
	movei a,lsrtns"i$name
	pushj p,lsrtns"lsritm	;get pointer to full name item.
	 jrst usearl		;every entry ought to have one.
	push p,b
	move b,strfre		;permute into lastname last order,
	move c,b		;copying into strstg.
	pushj p,lsrtns"lsrnam
	 jsr error
	move b,(p)
	movei a,lsrtns"i$grp	;now get the "Group" item,
	pushj p,lsrtns"lsritm
	 setz a,
	ildb a,a			;and extract its 1st character.
;The below can't (?) happen.
;	cain a,^M
;	 setz a,		;for a null entry return 0.
	push p,a
	movei a,lsrtns"i$rel	;relation in D.
	pushj p,lsrtns"lsritm
	  setz a,
	ildb a,a
	move d,a
	pop p,a
	pop p,b
	popj p,

;here if user has no entry or entry has no fullname.
usearl:	setzb a,b
	move c,[440700,,[asciz /      ???/]]
	popj p,

typcon:	.iot tyoc,a
typcnt:	sojl b,[popj p,]	;this routine takes pointer in c,limit in b.
	ildb a,c	;get char
	cail a,40	;control chr is delimiter
	 jrst typcon
padlup:	.iot tyoc,[40]	;output blanks up to limit
	sojl b,[popj p,]
	jrst padlup

otypc:	push p,b
otypc1:	ildb b,a
	caige b,40
	 jrst [pop p,b ? popj p,]
	.iot tyoc,b
	jrst otypc1

jnmout:	trnn f,%jobnof
	 jrst jnmou1
	hlrz a,u%jtm(x)
	idiv a,lublk
	pushj p,octtyp
	.iot tyoc,[40]
jnmou1:	move a,u%jnam(x)
	jrst wtype6	;type out 6bit name of job

;print out all info about tty - how long idle, what tty number, and where it is.
ttyout:	.iot tyoc,[40]
	hlrz i,u%tty(x)		;see if lisp machine
	caige i,maxtty
	 jrst ttyoun
	subi i,maxtty		;lm tables index
	movei c,lmidle(i)	;yes, idle time is in ascii
	hrli c,440700		;count chars, wants to fit in 4-column field
	movei a,4
ttyol1:	ildb b,c
	skipe b
	 soja a,ttyol1
	jumpe a,ttyol3
ttyol2:	.iot tyoc,[40]		;put leading spaces
	sojg a,ttyol2
ttyol3:	movei a,lmidle(i)
	pushj p,typ7ta
	movei a,5
ttyol4:	.iot tyoc,[40]
	sojg a,ttyol4
	hlrz b,u%tty(x)
	move a,lmdoc-maxtty(b)	;Console location
	jrst type7u

ttyoun:	setz i,		;get current time in 30'ths
	move a,@time
	hlrz i,u%tty(x)
	sub a,@ttitm	;- time of last input on this tty.
	idivi a,30.*60.	;get time in minutes tty has been idle.
	jumpe a,[iot tyoc,[asciz /    /]
		jrst ttyou1]	;it's been a very short time
	caige a,60.
	 jrst [	.iot tyoc,[40]
		.iot tyoc,[40]
		pushj p,dectyp	;< 1 hr - say how many minutes
		jrst ttyou1]
	idivi a,60.
	cail a,10.
	 jrst [	iot tyoc,[asciz /*:**/]
		jrst ttyou1]	;a very long time.
	addi a,"0
	.iot tyoc,a
	.iot tyoc,[":]
	idivi b,10.
	addi b,"0
	addi c,"0
	.iot tyoc,b
	.iot tyoc,c
ttyou1:	hrrz a,u%jtm(x)
	 jumpn a,[.iot tyoc,[40]
		jrst ttyou2]
	.iot tyoc,[".]
ttyou2:	hlrz b,u%tty(x) ;get tty number.
	.iot tyoc,["T]
	ldb a,[030300,,b]
	addi a,"0
	.iot tyoc,a	;and print it as "T" followed by 2 digits.
	ldb a,[000300,,b]
	addi a,"0
	.iot tyoc,a
	.iot tyoc,[40]

ttyprt:	move i,tcmxh		;keep track of where we are on the line
	sub i,beglen		;I <- # of characters left on line
	tlz f,%rcrs		;This isn't recursive yet!

ttypr0:	caml b,nfstty	;a sty?
	 caml b,nlstty
	  caia		;no! skip.
	   jrst hstout	;yes! assumption is net caller.
	caml b,nf11ty	;a pdp11 tv?
	 caml b,nl11ty
	  jrst nrmtty	;nope, 'normal' tty.
	jrst tv



;here if its a tv

tv:	push p,b		   ;save the TTY number
	pushj p,ttchk		   ;Is the TTYLOC info?
	  caia			   ;  No, check the TVKBD info
	    jrst [ push p,a	;Save the byte pointer for a bit
		   ildb b,a	;get a char
		   cain b,33	;magic escape?  If so, recover TTY no and
		     jrst [ pop p,b ? pop p,b ? jrst type7u]	;type rest
		   pop p,a	;Otherwise just use the whole string
		   pop p,b	;Recover the TTY number
		   jrst type7u]	;Type it
	pop p,b			   ;recover the TTY number
	syscal tvwher,[cimm 400000(b) ? cret a]	 ;have tty no, get kbd no.
	 jsr error
	cain a,377
	 jrst [	type [ Not connected]
		popj p, ]
	cail a,0
	 cail a,maxkbd
	  jrst [type [?? TV-11 garbaged!]
		popj p,]
	push p,a		;save for later
	tlne f,%nottv		;are we on a tv?
	 jrst tv1		;no, skip lengthy tv info
	pushj p,octhak
	ior a,['kbd00]
	lsh a,6
	pushj p,wtype6
	subi i,6		   ;account for 6 characters typed
tv1:	pop p,b			;kbd again
	move a,kbddoc(b)
	pushj p,type7v		;output appropriate stuff
	popj p,

;;; This looks in the SYSBIN;TTLOC DATA file (which was mapped in at the
;;; start) and if there is an entry for that user on that terminal, it
;;; uses the entry instead of the entry from SYSENG;TTYTYP (FILE)
;;; (which was gobbled at initialization time).
;;; The format of the TTLOC DATA file is:
;;; For each TTY, there is a block of 21 words, the first word is
;;; the UNAME of the person on the line, and the rest is an ASCIZ string.
;;; If the UNAME doesn't correspond to who's on the line now,
;;; the entry is cleared and ignored.

;;; B is the TTY number

ttchk:	push p,b		;save the real B for later
	imuli b,ttsize		;get offset in TTLOC table
	addi b,ttloc		;make absolute
	move a,u%unam(x)	;get the UNAME that's on this TTY
	skipe 1(b)		;if there's no data in the entry
	  came a,(b)		;  Or there's a new person there
	    jrst ttchk0		;    Clear out the entry
	movei a,1(b)		;yes, return ptr to the ASCIZ string
	hrli a,440700		;make it a Byte Pointer
	pop p,b			;restore the real TTY #
	aos (p)			;skip return
	popj p,

;; note:  The UNAME may be inconsistant if this is a recursive TTYPRT
ttchk0:	tlnn f,%rcrs		;Unless this is an recursive TTYPRT
	  setzm (b)		;  clear out the entry
	pop p,b			;Nope, get back the real B
	popj p,


;here for ordinary vegetable patch tty

nrmtty:	pushj p,ttchk		;check the TTLOC database for interesting info
	  jrst nrmtt0
	push p,a		;remember our TTYLOC
	ildb a,a		;Look at the first character
	cain a,33		;for a magic escape
	  jrst nrmttx		;  in which case, do as he says
	syscal TTYVAR,[ %climm,,%jsnum(b) ? %climm,,'TYP ? %clout,,a]
	  jsr error
	trne a,%tydil\%tyrlm	;Is this a dialup or ROLM?
	  tlne f,%rcrs		;  and not the recursive printing for a STY?
	    caia
	      jrst [ trnn a,%tyrlm
		       skipa a,[[asciz /Dialup: /]]
			 movei a,[asciz /ROLM: /]  ;Tell about it
		     pushj p,type7v
		     jrst .+1]
	pop p,a			;recall our TTYLOC
	jrst type7u		;type it out

nrmttx:	pop p,a			;recover the byte pointer
	ibp a			;and throw away the first character [the escape]
	jrst type7u		;type out the rest of the TTYLOC

nrmtt0:	move a,ttydoc(b)	;No TTYLOC info, use the default
	jrst type7u
constants

hstout:	hlrz b,u%tty(x)		;Get the TTY number
	pushj p,ttchk		;check for TTLOC info
	  seto a,		;  remember that there wasn't any
	hrrz b,u%tty(x)		;See if network tty
	cain b,-1		;check for non-net sty
	  came a,[-1]		;  With no TTLOC info
	    caia
	      jrst styout	;harumph...go hack it
	push p,a		;remember our info for later
	syscal open,[	[ubpfj+.bii,,usrich]
			[sixbit/usr/]
			u%aux1(x)
			u%aux2(x) ] ;open up the server
	 jrst hstou0		;gone
	syscal usrmem,[%climm,,usrich ? %climm,,100 ? %clout,,a]
	 jrst hstou0
	came a,['TERMID]	;Does server have info for us?
	 jrst hstou0		;apparently not
	movei a,101
	move b,[-ltlinf,,telinf]	;get cruft
hstou2:	syscal usrmem,[%climm,,usrich ? a ? %clout,,(b)]
	 jrst hstou0		;Branch off if job goes away or something
	aos a
	aobjn b,hstou2

;; 3 cases:   (1) We have a console ID from TTLOC.
;; 		  Print the canonicalized host-name which we were given, a
;;		  colon, and the console ID.  If it's a TIP, print the port #.
;;	      (2) We have a console ID from TELSER.  Print it.
;;	      (3) We have no console ID, print Net site and the host name.
;;		  In this case we print the port number for TIP's

	move a,(p)		;get the TTYLOC info
	camn a,[-1]		;if there's no TTYLOC info
	  skipe termid		;  and if TELSER doesn't know where this TTY is
	    caia
	      jrst hstou3	;    Then we go print the host full name
	camn a,[-1]		;No TTYLOC info?
	  jrst hstoyz		;  Don't MPV looking at its first char!
	ildb b,a		;check the first character
	cain b,33		;magic escape?
	  jrst [ pop p,b	;  yes, discard saved byte pointer
		 pushj p,type7u	;  and use the incremented one, discarding escape
		 jrst hstou5]	;  on with the shoe.
hstoyz:	pushj p,prthsc		;Print abbreviated host name and optional TIP port number
	move a,hstat		;Examine host type.
	cain a,ts%min		;If this is a MINITS host.
	 jrst hstoy0		;don't print ": " since we didn't print host
	movei a,[asciz/: /]
	pushj p,type7v
hstoy0:	pop p,a			;recover our special info
	camn a,[-1]		;unless there's none
	  movei a,termid	;  in which case we hack the TELSER info
	pushj p,type7v		;Type terminal name
	jrst hstou4

;Print host name and TIP number

;This entry used when putting host name before a colon.  Try to abbreviate it.
;Specifically, change MIT-x to x, LISP-MACHINE-x to LMx, SU-AI to SAIL.
;We also check for MINITS consoles, and use the sixbit name for them.
;We could change PLASMA to nothing at all (not even colon) but I don't really
;think that's so great (Moon).

prthsc:	push p,b
	move b,hstat		;Examine host type.
	cain b,ts%min		;If this is a MINITS host.
	 jrst [	;6typ hstsix	;Print out its sixbit name.
		pop p,b
		jrst prths1 ]
prthc0:	move a,[440700,,hstnam]	;Scan name supplied by TELNET server.
	irpc ch,,[MIT-]
	 ildb b,a
	 caie b,"ch
	  jrst prthc2
	 termin
	push p,a		;Remember where short "host name" began.
	ildb b,a
	jumpe b,prthc1
	caie b,".
	 jrst .-3
	mdbpt a,		;Godamn domain names!
	setz b,			;Dike out the domain part!
	idpb b,a
prthc1:	pop p,a			;Recover the "host name".
	pop p,b
	pushj p,type7u		;MIT- host, just show part after MIT-
	jrst prths1		;and before the .ARPA.

prthc2:	move b,hstnam
	camn b,[ascii/SU-AI/]
	 jrst [	movei a,[asciz/SAIL/]
		pop p,b
		jrst prths0 ]
	push p,c
	push p,d
	move a,[440700,,hstnam]
	move b,[440700,,[asciz/LISPM-/]]
prthc3:	ildb c,b
	jumpe c,[typi "L
		 typi "M
		 subi i,2
		 pop p,d
		 pop p,c
		 pop p,b
		 pushj p,type7u
		 jrst prths1 ]
	ildb d,a
	camn c,d
	 jrst prthc3
	jrst domstp		;strip .ARPA and .EDU

prthst:	push p,b
	push p,c
	push p,d
	;; Strip .ARPA, .EDU, etc from host name
domstp:	move b,[440700,,hstnam]
	push p,b		;save it too
domlop:	ildb c,b
domlo1:	jumpe c,domeos		;null?  Oh well.
	caie c,".		;starts domain?
	  jrst domlop		;nope; keep looking
	movem b,(p)		;save this byte ptr
	ildb c,b		;get domain name
	cain c,"A		;.ARPA or .AI.MIT.EDU ?
	 jrst domaxx
	cain c,"E		;.EDU?
	 jrst domedu
	cain c,"L		;.LCS.EDU ?
	 jrst domlcs
	cain c,"M		;.MIT.EDU?
	 jrst dommit
	jrst domlo1

domaxx:	ildb c,b		;Check for "i.mit.edu" or "rpa"
	cain c,"I
	 jrst domitx
	caie c,"R
	 jrst domlo1
	ildb c,b
	caie c,"P
	 jrst domlo1
	ildb c,b
	caie c,"A
	 jrst domlo1
	jrst dommsk		;was ".arpa"; mask domain

domlcs: ildb c,b		;check for "cs.mit.edu"
	caie c,"C
	 jrst domlo1
	ildb c,b
	caie c,"S
	 jrst domlo1
domitx:	ildb c,b		;check for ".mit.edu"
	caie c,".
	 jrst domlo1
	ildb c,b
	caie c,"M
	 jrst domlo1
dommit: ildb c,b		;check for "it.edu"
	caie c,"I
	 jrst domlo1
	ildb c,b
	caie c,"T
	 jrst domlo1
	ildb c,b
	caie c,".
	 jrst c,domlo1
	ildb c,b
	caie c,"E
         jrst c,domlo1
domedu:	ildb c,b		;check for "du"
	caie c,"D
	 jrst domlo1
	ildb c,b
	caie c,"U
	 jrst domlo1
dommsk:	setz a,
	dpb a,(p)		;mask out from "." on.

domeos: pop p,a			;restore stack ptr
	pop p,d
	pop p,c
	pop p,b
	movei a,hstnam
prths0:	pushj p,type7v		;type host name gotten out of server
prths1:	skipn a,tipnum
	 popj p,		;Not a TIP
	subi i,2		;Port number is at least a # and a digit
	cail a,10		;Subtract additional 1 for each of up to 3 octal digits
	 subi i,1
	cail a,100
	 subi i,1
	jumple i,cpopj		;And exit if no room on line
	typi "#			;port # prefix
	jrst octtyo

;Print net site mumble mumble
hstou3:	pop p,a			;Flush special TTLOC info
	movei a,[asciz /Net site /]
	cail i,36		;If not much room left, don't say "Net Site".
	 pushj p,type7v
	pushj p,prthst
hstou4:
;	ldb a,[nw$byt,,fhost]
	netwrk"getnet a,fhost		;For Public Relations, if was via Chaos net,
	camn a,[netwrk"nw%chs]		; say so
	 caig i,8		; but only if there is room on the line
	  jrst hstou5
	move a,hstat		;since we're not printing MINITS hosts any more
	cain a,ts%min		;and people understand chaosnet now
	 jrst hstou5		;flush this message too.
	movei a,[asciz/ (Chaos)/]
	pushj p,type7v
hstou5:	.close usrich,
	;caig i,7		;have room for job no.?
	 popj p,		;no, don't print anything
	;move a,[440700,,[asciz /, job /]]
	;pushj p,type7t
	;hrrz a,u%svrj(x)
	;idiv a,lublk
	;jrst octtyo

styprt:	tlne f,%supd		;Don't include the sty stuff in SUPDUP's info
	  popj p,
	tlnn f,%rcrs		;Note that any more will be recursive
	  jrst [ move a,u%unam(x)  ;  first time...remember our UNAME for later
		 movem a,ttyunm
		 jrst stypr0]
	move a,u%aux1(x)	;get uname of controlling process
	camn a,ttyunm		;Is this the same UNAME as the last one
	  tlon f,%rcrs		;  and this is recursive
	    caia		;    no.
	      popj p,		;      yes.  Don't print recursive frobs
stypr0:	tlo f,%rcrs
	typi "[
	sos i			;count the [
	move a,u%aux1(x)	;Check the controler's UNAME
	came a,u%aux2(x)	;If UNAME=JNAME, probably CRTSTY demon
	  camn a,ttyunm		;Is the uname the same as for the controllee?
	    jrst stypr5		;  Yes, don't print it
	ldb a,[360600,,a]	;check the first char of the name
	cain a,16		;is it "."?  Maybe .FOO, a CRTSTY for FOO?
	  jrst [ ldb a,[003600,,u%aux1(x)]  ;Try it without the .
		 lsh a,6
		 camn a,ttyunm	;  Does it match?
		   jrst stypr5	;    yes, don't print the UNAME now either
		 jrst .+1]	;  no match, so print the frob
	move a,u%aux1(x)
	movem a,ttyunm		;Don't type this one again
	pushj p,atype6		;out it go
	typi 40
	sos i			;count the space
stypr5:	move a,u%aux2(x)	;get JNAME of controlling process
	pushj p,atype6
	movei a,[asciz /] /]
	jrst type7v		;  This is the first level

;Here if couldn't get info from server job, treat as non-network STY
hstou0:	.close usrich,
	pop p,a			;balance the stack, we're punting this info
;This is a non-network sty
styout:	move a,u%aux2(x)	;check for daemon
	camn a,['hactrn]	;only if it is a hactrn
	 jrst styou1
styou2:	skipn u%aux1(x)		;make sure something there.
	 jrst [	type [ STY not in use]
		popj p,]	;not really there...
	
	syscal OPEN,[ %clbit,,.uii\10 ? %climm,,usrich ? [sixbit /USR/]
		      u%aux1(x) ? u%aux2(x)]
	  jrst styou4
	push p,c
	move a,[-4,,[ sixbit /CNSL/ ? movem b
		       sixbit /UNAME/ ? movem c]]
	syscal USRVAR,[%climm,,usrich ? a]
	  jrst styou6
	jumpl b,styou6		;If sty owner doesn't have a TTY, just tell who
	push p,c		;remember our new UNAME
	push p,b		;remember owner's TTY number
	pushj p,styprt		;print the caller info
	push p,i		;remember where we are on the line
	move i,-1(p)		;GOTONE takes TTY # in I
	setz u,			;don't bother looking up his name etc.
	hrlm i,u%tty(x)		;remember our new TTY number
	pushj p,gotone		;Clobber our entry with sty owner's info
	  jfcl
	pop p,i			;recover where we are on the line
	pop p,b
	pop p,u%unam(x)		;salt away our new UNAME
	pop p,c
	jrst ttypr0		;and print the owner's TTYLOC

styou6:	.close usrich,
	pop p,c
	jrst styou4		;  if so, just do the U=xxx J=xxx hack

styou5:	pop p,i			;recover where we are on the line
	pop p,b
styou4:	typi "U
	typi "=
	move a,u%aux1(x)	;get uname of controlling proc
	pushj p,wtype6		;out it go
	typi 40			;with a spacer
	typi "J
	typi "=
	move a,u%aux2(x)	;and then the jname
	pushj p,wtype6
	popj p,

styou1:	tlne f,%supd
	 jrst styou2
	push p,x		;check if daemon is listed in LSR1
	addi x,u%aux1-u%xunm
	pushj p,useek
	pop p,x
	jumpe b,styou2		;if not found, it is no demon.
	jumple i,cpopj		;if no more room, type nothing
styou3:	ildb a,c
	caige a,40
	 popj p,
	typi (a)
	sojg i,styou3
	popj p,

;2 position octal or decimal print of number in a.  Leading zero replaced with space.
octtyp:	idivi a,10
	caia
dectyp:	idivi a,10.
	addi a,"0
	cain a,"0
	 movei a,40
	typi (a)
	addi b,"0
	typi (b)
	popj p,

;Type 3 digits of octal, without zero suppression.
octt3:	idivi a,10
	hrlm b,(p)
	pushj p,octt2
	jrst octt1

;Type 2 digits of octal, without zero suppression.
octt2:	idivi a,10
	typi "0(a)
	typi "0(b)
	popj p,

;Type as many digits as needed to print number in a in octal.
octtyo:	idivi a,10
	hrlm b,(p)
	skipe a
	 pushj p,octtyo
octt1:	hlrz b,(p)
	typi "0(b)
	popj p,

;Type as many digits as needed to print number in a in decimal.
dectyo:	idivi a,10.
	hrlm b,(p)
	skipe a
	 pushj p,dectyo
dect1:	hlrz b,(p)
	typi "0(b)
	popj p,

; Type HOSTS3 format host number in A in decimal octet format.
typehn:	push p,a
	push p,b
	ldb a,[400400,,-1(p)]
	jumpe a,typhn1
	pushj p,dectyo
	typi ":
typhn1:	ldb a,[301000,,-1(p)]
	pushj p,dectyo
	typi ".
	ldb a,[201000,,-1(p)]
	pushj p,dectyo
	typi ".
	ldb a,[101000,,-1(p)]
	pushj p,dectyo
	typi ".
	ldb a,[001000,,-1(p)]
	pushj p,dectyo
	pop p,b
	pop p,a
	popj p,

;print asciz string <- b.p. in a, printing no more than <tcmxh>-beglen chars.
type7v:	hrli a,440700
	jrst type7u

typ7ta:	hrli a,440700
type7t:	move i,tcmxh
	sub i,beglen
type7u:	push p,b
	jumple i,type7x		;in case ever get called after end of line
type7l:	ildb b,a
	jumpe b,type7x
	typi (b)
	;; allow extra character for control-chars (should this check %TOSAI?)
	cail b,40
	 cain b,177		;but check for rubout
	  sos i
	sojg i,type7l
type7x:	pop p,b
	popj p,

;Map in the inquir data base (INQUIR;LSR1 >) and the host names data base (SYSBIN;HOSTS2 >).

LS2MAP:	PUSH P,A
	PUSH P,B
	MOVEI A,LS1C		;we keep LSR1 open on this channel.
	MOVE B,[USRPAG-177,,USRPAG]	;this block of pages is available for use.
	PUSHJ P,LSRTNS"LSRMAP	;map in the index tables & allocate space for 2 data pgs
	 JSR ERROR
	HRRZ A,B
	MOVEI B,DKIC
	PUSHJ P,NETWRK"HSTMAP	;Map in the HOSTS2 file.
	 JSR ERROR
	MOVEM A,FFPAG		;save # of first page free after HOSTS1 data.
	CAILE A,200-1		;if outrageous figure,
	 JSR ERROR		;die.  later perhaps shout for help.
	LSH A,10.
	MOVEM A,FFLOC		;store addr of first free core (where USRTAB will start).
	POP P,B
	POP P,A
	POPJ P,

BVAR
FFPAG:	0	; # of page first free after HOSTS2 and USRTAB.  used for growing USRTAB.
FFLOC:	0	; corresponding addr.
EVAR

; LSRFND - given in B the addr of the LSR1 entry of a luser,
; snarfs into the table LSR the byte-pointers to the various items,
; so that LSR+n contains the pointer to item n.
NITMS==20.			;This is the length of LSR and the number of items we can know.

LSRFND:	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	HRLI B,440700		;TURN ADDR INTO B.P.
	AOS B
	MOVE C,[LSR,,LSR+1]
	SETZM LSR		;CLEAR ALL ENTRIES OF LSR TABLE.
	BLT C,LSR+NITMS-1
	MOVSI C,-NITMS
LSRFN1:	MOVE A,B
	IBP A			;IF NEXT CHAR IS IN A WORD
	HRRZ D,(A)		;WHOSE LOW BIT IS SET, WE HAVE RUN OUT OF ITEMS IN
	CAIN D,-1		;THIS ENTRY, SO GIVE UP LEAVING REST OF LSR ZEROED.
	 JRST LSRFN9
	LDB A,A			;LOOK AT 1ST CHAR OF NEXT ITEM.
	SKIPE A			;IF IT'S NOT ^@, ITEM ISN'T NULL,
	 MOVEM B,LSR(C)		;SO REMEMBER IT IN THE LSR TABLE.
	ILDB A,B
	JUMPN A,.-1		;NOW SKIP THE ITEM.
	AOBJN C,LSRFN1		;DO THIS FOR EACH ITEM PRESENT, UP TO LIMIT WE CAN HANDLE.
LSRFN9:	POP P,D
	POP P,C
	POP P,B
	POP P,A
	POPJ P,

BVAR
LSR:	BLOCK NITMS
EVAR

	; Read CHANNA;LOGOUT TIMES file into core, if not on DM,
	;and find last logout time for user in u%xunm(X).
	; (leaves byte ptr in A, 0 if not found)
BVAR
lgonm1:	0	;these hold ASCII of name to look for.
lgonm2:	0
EVAR

lgotim:	skipn a,lgotry		;should we?
	 popj p,		;if 0, don't try, return zero.
	skipn lgoptr		;if not in core yet,
	 jrst [	pushj p,lgoget		;get the file.
		 jrst [	setz a,		;if failed to get it,
			setzm lgotry	;return 0 and don't try again.
			popj p,]
		jrst .+1]
	push p,b		;protect against ULSEEK.
	push p,c
	move b,[440600,,u%xunm(x)]
	move c,[440700,,lgonm1]
	setzm lgonm1
	setzm lgonm2
lgotm2:	ildb a,b		; get 6bit
	addi a,40
	idpb a,c
	tlne b,770000		;last char hacked?
	 jrst lgotm2

	move c,lgoptr		;get aobjn
	move a,lgonm1
lgotm5:	camn a,(c)		;first 5 chars equal?
	 jrst [	move b,1(c)	;get next wd for 6th char
		and b,[774000,,0] ;mask out 1st char
		came b,lgonm2	;matches 6th char of uname?
		 jrst .+1	;nope
		jrst lgotm7]	;aha, finally found it!
	addi c,4		;add 5 to index each pass (25. chars/entry)
	aobjn c,lgotm5
	setz a,			;didn't find at all.
	jrst popcbj

lgotm7:	movei a,1(c)		;must form bp to char after uname.
	hrli a,350700		; (pts to 2nd char)
popcbj:	pop p,c
	pop p,b
	popj p,
	
lgoget:	syscal open,[[.bii,,dkic] ? ['dsk,,]
		['logout] ? [sixbit /times/] ? ['channa]]
	 popj p,		;fail.
	push p,a
	syscal fillen,[cimm dkic ? cret a]
	 jsr error
	movem a,lgolen
	addi a,1777
	trz a,1777
	addm a,ffloc
	lsh a,-10.
	movns a
	hrlzs a
	hrr a,ffpag
	syscal corblk,[	movei %cbprv		; read-only
		movei -1 ? a ? cimm dkic]
	 jsr error
	.close dkic,
	push p,b
	move a,lgolen
	idivi a,5.	;calculate # entries (25. chars = 5 wds per entry)
			;ignore any remainder.
;	jumpn b,[tlne f,%svrmod	;jump if lossage (file not right length)
;		  jrst popbaj	;if server, don't complain.
;	.value [asciz /:mail bug-name,bug-dragon LOGOUT TIMES has garbage!p/]
;		jrst popbaj]
	movns a
	hrlzs a
	move b,ffpag
	lsh b,10.
	hrr a,b
	movem a,lgoptr	;set up ptr to file
	pop p,b
	pop p,a
	aos (p)		;won.
	popj p,

wtype6:	push p,a	;type 6 columns of sixbit
	push p,b
	movem a,t6
	move b,[440600,,t6]
wtyp6a:	ildb a,b
	typi 40(a)
	tlne b,770000
	 jrst wtyp6a
	pop p,b
	pop p,a
	popj p,

atype6:	push p,a		;save the universe frob bashage
	push p,b
	move b,a		;get the word where we can LSHC it
atyp6a:	setz a,			;clear out gubbish
	lshc a,6		;get the first char
	typi 40(a)		;type it as ascii
	sos i			;keep count of the characters we type
	jumpn b,atyp6a		;if there's more, type it
	pop p,b
	pop p,a
	popj p,

type6:	hrli a,440600	;byte pointer to 6bit chars
	movem a,t6	;pointer like for type7
shvout:	ildb a,t6	;get char
	cain a,'%	;'%' is delimiter
	 popj p,		;return when thru
	addi a,40	;convert 6bit to ascii
	.iot tyoc,a
	jrst shvout

octhak:	movei b,0
	lshc a,-3	;uses b reg also
	lsh a,3		;effect of lsh's is to separate the octal digits by 3
	lshc a,3.	;and align them on right
	popj p,

tmhms:	movei c,0
	jrst tmp3

tmpt:	movei c,0
	jumpe d,cpopj
	camge d,tmt1(c)
	aoja c,.-1
tmp3:	idiv d,tmt1(c)
	addi d,"0
	.iot tyoc,d
	move d,e
	trnn c,1
	aoja c,tmp3
	cail c,5
	popj p,
	.iot tyoc,[":]
	aoja c,tmp3

tmt1:	36000.
	3600.
	600.
	60.
	10.
	1

gttys:	syscal open,[[.bai,,dkic] ? ['dsk,,]
		['ttytyp] ? [sixbit />/] ? ['syseng]]
	 jsr error
	syscal fillen,[cimm dkic ? cret a]
	 jsr error
	addi a,1		;so that can be sure of zero word.
	movei a,1777(a)
	lsh a,-10.		;get # pages needed for file.
	movns a
	hrlzs a
	hrri a,usrpag		;set up page AOBJN
	movem a,tyfpgs		;save so can free pages later.
	syscal corblk,[cimm %cbndr+%cbndw+%cbcpy
		cimm -1 ? A ? cimm dkic]	;slurp up.
	 jsr error
	.close dkic,
	move a,[440700,,usrfil]
gttys0:	ildb b,a
gttys1:	caie b,0
	 cain b,^C	;at eof?
	  jsr error	;yes! no entry in ttytyp for this machine!
	caie b,";	;maybe we've found an entry.
	 jrst gttys0
	ildb b,a
	caie b,";	;an entry has three semicolons, a space, and a machine name.
	 jrst gttys1
	ildb b,a
	caie b,";
	 jrst gttys1
	ildb b,a
	caie b,40
	 jrst gttys1
	move d,mname	;found the semi's and space; now see if machine name is ours.
gttys2:	ildb b,a
	caie b,40
	 cain b,^M
	  jrst gttys3
	andi b,77
	xori b,40
	rot d,6
	xori d,(b)
	trnn d,77
	 jrst gttys2
	ldb b,a
	jrst gttys1

gttys3:	jumpn d,gttys1
	;found entry for our site!
	;now find the individual strings in the ttytyp file entry,
	;copy them as asciz strings into TTYFIL, and put b.p.'s
	;to them in the ttydoc table.
	setzm ttydoc
	move c,[ttydoc,,ttydoc+1]
	blt c,ttydoc+maxtty-1	;clear out TTYDOC table.
	move c,[-maxtty,,ttydoc]
	move d,[440700,,ttyfil]
gttys4:	ildb b,a
	caie b,0	;eof => no more strings.
	 cain b,^C
	  jrst gttys5
	caie b,";
	 jrst gttys4	;find next documentation string.
	ildb b,a
	cain b,";	;2 semi's in a row => start of next entry
	 jrst gttys5	;meaning end of this one.
	caie b,"T	;comment doesn't start with "Tnm " => ignore it.
	 jrst gttys4
	ildb b,a
	cail b,"0
	 caile b,"9
	  jrst gttys4
	ildb b,a	;don't bother testing the 3rd char for digithood,
	ildb b,a
	caie b,40	;but check 4th for blankness.
	 jrst gttys4
	movem d,(c)	;remember the byte pointer to the string.
gttys7:	ildb b,a	;copy into TTYFIL.
	cain b,^M
	 setz b,	;make ASCIZ when done.
	idpb b,d
	jumpn b,gttys7
	jrst gttys8

gttys6: ildb b,a	;find the end of this string,
	caie b,^M
	 jrst gttys6
gttys8:	aobjn c,gttys4
	jsr error	;too many tty's in ttytyp?!?

gttys5:	movei a,1(d)	;check terminating address
	cail a,usrfil	;to make sure nothing will be clobbered.
	 jsr error	;ugh, TTY data too large!  Must allocate more in assembly.
	move a,tyfpgs
	syscal corblk,[	cimm 0 ? cimm -1 ? A ? cimm -1]	;free up pages.
	 jsr error
	popj p,

define dismis (addr)
.call [setz ? 'dismis ? ctli (setz)
ifse [addr][][ setz p]
ifsn [addr][][ p
	ifn <@>&<addr>, setzi addr
	.else		setz addr
	]
]
termin

BVAR

tsint:	setz p		;our pdl ptr. 4.9 bit means save .jpc, .suuoh, lspcl
	
	;special block for lmfing
	0
lmintb:	0
	-1 ? -1
	lmintr

	;simple typein interrupt
	0 ? %tyib
	-1 ? -1
	inttyi

	;tty output interrupt for **MORE**.
	0 ? %tyob
	-1 ? -1
	inttyo

	;for IOC errors, particularly on net.
	%piioc ? 0
	-1 ? -1		;defer wds.  defer everything in the world.
	intioc		;pc to start this group at

	; For nasty conditions
	%pipdl+%pimpv ? 0	; PDL OV and MPV
	-1 ? -1
	intftl		; fatal interrupt
lintblk=.-tsint

neterr:	0		;loc to return to if IOC error occurs on net.
savpdl:	0		; place to save P
savc:	0		; place to save C (see MAIN50)
jpcsav:	0		; save JPC if fatal interrupt.
EVAR

;Interrupt when anything happens on Chaosnet channels
lmintr:	setom lmintf
	push p,tt
	movei tt,177777		;Defer any further interrupts
	iorm tt,-5(p)		;(This is the saved DF2 word)
	hrrz tt,-4(p)		;PC interrupted out of
	cain tt,lmintw
	 aos -4(p)		;Unsleep
	pop p,tt
	dismis

intftl:	.suset [.rjpc,,jpcsav]	; save loc for debugging.
	jsr error

intioc:	tlne f,%svrmod
	 jsr error
	push p,a
	.suset [.rbchn,,a]
	cain a,nticp		;must be net channel.
	 jrst intio3
	caie a,ntic
	 cain a,ntoc
	  jrst intio3
	jsr error
intio3:	pushae p,[t,tt]
	pushj p,netwrk"analyz	;print out error msg
	 jsr error
	popae p,[tt,t,a]
	skipn neterr
	 jsr error
	dismis @neterr		;return to net err location. (indirect!)

inttyi:	push p,a
	movei a,tyic
	.ityic a,
	 jrst intyi3	;no int. char, ignore.
	caie a,^G
	 cain a,^S
	  jrst [syscal ttyfls,[cimm tyic ? ctli 1]	; Flush input up to int char
		 .lose %lssys
		.reset tyoc,		; and halt output
		jsr exit] 		; and quit.
intyi3:	pop p,a
	dismis		;else ignore it.

inttyo:	pushae p,[a,u1,u2]
	syscal whyint,[cimm tyoc ? cret a ? cret u1]
	 jsr error
	cain a,%wytyo
	 skipl u1
	  jrst intyo4		;ignore int if not a **MORE** int.
	type [--MORE--]
	syscal finish,[cimm tyoc ? cerr errcod]
	 jfcl
	syscal iot,[cimm tyic ? cret a ? ctli %tiact+%tipek+%tiint]
	 jsr error
	cain a,40		;space to continue?
	 jrst intyo3
	type [Flushed]
	jsr exit		;nope, kill it without resetting buffer.

intyo3:	syscal iot,[cimm tyic ? cret a ? ctli %tiact+%tiint]	;aha, space. flush it.
	 jsr error
	.iot tyoc,[^M]
	.iot tyoc,[^J]		;go to top of screen easily
intyo4:	popae p,[u2,u1,a]
	dismis

uuoh:	ldb u1,[$opcode,,40]
	caie u1,0
	 caile u1,nuuo
	  jsr error
	jrst @uuotab-1(u1)


define uuodef name,handlr
if1 [
ifndef nuuo,nuuo==0
nuuo==nuuo+1
name!nuuo_27.
]
	handlr
termin

uuotab:
	uuodef iot=,u.iot
	uuodef netblk=,u.ntb
	uuodef typi=,u.typi
	uuodef typc=,u.typc
	uuodef typz=,u.typz
	uuodef 7typ=,u.7typ
	uuodef ustrn=,u.ustr
	uuodef 6typ=,u.6typ

;6TYP option,E - typeout sixbit in E
;If option is 0, hack truncation using line length in I
;If option is 1, don't hack truncation

u.6typ: move u1,40
	ldb u3,[270400,,u1]	;Get option.
	hrrz u1,u1		;Get address of sixbit string.
	hrli u1,440600		;Make into sixbit Bp.
6typ1:	ildb u2,u1		;Get a character.
	jumpe u2,cpopj		;If zero, all done.
	addi u2,40		;ASCIIfy.
	cain u3,0
	 jrst [	jumple i,6typ2	;Truncate if no more room.
		soja i,.+1 ]
	.iot tyoc,u2		;Type it out.
	tlne u1,770000		;If end of word, all done.
	 jrst 6typ1		;Else keep going.
6typ2:	popj p,

;Type Immediate.
u.typi:	hrrz u1,40
	tlne f,%chasrv
	 pushj p,lmccnv		;convert character to lispm character set
	tlnn f,%supd
	 .iot tyoc,u1
	tlne f,%supd
	 idpb u1,e
	popj p,

;Compare two strings with uppercase force and skip if not equal 
u.ustr:	pushae p,[a,b]
	move u3,40
	ldb u1,[$acfld,,u3]
	move u1,(u1)		;get pointer to one string
	move u2,(u1)		;get cnt
	came u2,(u3)		;compare counts
	 jrst ustr9		;fail instantly if counts unequal.
	jumpe u2,ustr8		;win instantly if both zero
	move u1,1(u1)		;and byte ptrs
	move u3,1(u3)		;and for other string
ustr2:	ildb a,u1
	ildb b,u3
	caie a,(b)
	 jrst [	cail a,"a
		 caile a,"z
		   caia
		    subi a,40
		cail b,"a
		 caile b,"z
		   caia
		    subi b,40
		caie a,(b)
		 jrst ustr9	;unequal even with uppercase.
		jrst .+1]	;equal, saved.
	sojg u2,ustr2
	jrst ustr8
ustr9:	aos -2(p)		;match failed, skip on return.
ustr8:	popae p,[b,a]
	popj p,


u.iot:	ldb u1,[$acfld,,40]	;block mode output
	movem u1,pch
	hrrz u1,40
	hrli u1,440700	;set up byte pointer (addr in a as arg.)
	movem u1,t7	;store so don't need extra acc
	push p,[.]	;loop if lmccnv finds ^J
u.i1:	ildb u1,t7	;get char
	jumpe u1,pop1j	;stop when zero char reached (^@)
	cain u1,^C
	 jrst pop1j
	tlne f,%chasrv
	 pushj p,lmccnv
	syscal iot,[pch ? u1]
	 jsr error
	jrst u.i1

;Wait for net channel to change state
u.ntb:	movei u1,20.*30.
	movem u1,timout'	;set up max time to wait
	move u1,@40
	ldb u2,[$acfld,,40]
	syscal netblk,[u2 ? u1 ? timout ? cret u2]
	 jrst ntb3
	hrrz u1,40
	move u1,1(u1)	;pick up second work of arg
ntb1:	camn u2,(u1)	;is current state on list?
	 jrst ntb2
	aobjn u1,ntb1
	caia
ntb2:	aos (p)
ntb3:	popj p,

;Type out asciz string at E
u.typz:	move u2,40
	hrli u2,440700
	push p,[.]		; loop if lmccnv finds ^J
	jrst u.tyz3

u.tyz2:	tlne f,%chasrv
	 pushj p,lmccnv
	tlnn f,%supd
	 .iot tyoc,u1
	tlne f,%supd
	 idpb u1,e
u.tyz3:	ildb u1,u2
	jumpn u1,u.tyz2
pop1j:	pop p,(p)
	popj p,

;Type out string at E terminated by ctl char
u.typc:	move u2,40
	hrli u2,440700
	jrst u.tyc3

u.tyc2:	tlne f,%chasrv
	 pushj p,lmccnv		; can't get ^J
	tlnn f,%supd
	 .iot tyoc,u1
	tlne f,%supd
	 idpb u1,e
u.tyc3:	ildb u1,u2
	cail u1,40
	 jrst u.tyc2
	popj p,

lmccnv:	cain u1,^J
	 jrst pop1j
	caie u1,^M
	 cain u1,^I
	  tro u1,200
	popj p,

; 7TYP <TYPE>,[<STRING B.P.>] OUTPUTS AN ASCIZ STRING TO TTY.
;<TYPE> IS AS FOLLOWS:
; 0 => STRAIGHT ASCIZ.
; 1 => TERMINATE BEFORE A CR (PRINT ONLY 1 LINE).
; 2 => PRINT ONLY 1 WORD.
; 3 => PRINT ONLY 1 WORD.
; 4 => REPLACE EVERY CRLF BY A SEMICOLON-SPACE.
; 5 => ONE TAB IN FRONT OF EVERY LINE BUT THE FIRST.
;	DON'T OUTPUT TRAILING CRLF.

U.7TYP:	PUSH P,A
	MOVE A,40
	TRNN A,-1
	JRST POPAJ
	PUSH P,B
	PUSH P,C
	LDB C,[270400,,A]
	MOVE A,(A)
7TYP1:	ILDB B,A
	JUMPE B,PPCBAJ
	
	CAIN B,^M
	JRST @7DABLE(C)
7TYP4:	CAIN B,^C
	JRST 7TYP1
7TYPIT:	.IOT tyoc,B
	TLNN A,760000
	CAIE C,2
	JRST 7TYP1
PPCBAJ:	POP P,C
POPBAJ:	POP P,B
	POP P,A
CPOPJ:	POPJ P,

7DABLE:	7TYPIT		;DISPATCH TABLE BASED ON AC FIELD - WHAT TO DO FOR CR?
	PPCBAJ
	7TYPIT
	7TYPIT
	7TYP6
	7TYP5

7TYP6:	.IOT tyoc,[";]
	.IOT tyoc,[40]
	ILDB B,A	;PASS THE LF.
	JRST 7TYP1

7TYP5:	ILDB B,A
	CAIE B,^J
	 CAIN B,^M
	  JRST 7TYP5
	JUMPE B,PPCBAJ
	tlne f,%chasrv
	 jrst [.iot tyoc,[215]
	       jrst .+3]
	.IOT tyoc,[^M]
	.IOT tyoc,[^J]
	pushae p,[a,b]
	skipa b,[440700,,indenl]
7typ54:	 .iot tyoc,a
	ildb a,b
	jumpn a,7typ54
	popae p,[b,a]
	JRST 7TYP4



nnhsts==100	;Number of hosts we can accept in our JCL.

BVAR

hjtab:	block nnhsts
EVAR
define tvkbd num,name/
	loc kbddoc+num
ifse [name],	440700,,[asciz /???/]
ifsn [name],	440700,,[asciz /name/]
termin

ttydoc:	block maxtty

kbddoc:

.insrt sysen2;tvkbd rooms

loc kbddoc+maxkbd

;Given A -> <string count> ? <bp to string>,
;we look the string up as a host name.
;If found, we return the host number in A and skip.
;Otherwise we clobber A and don't skip.

HANLYZ:	PUSHAE P,[B,C,D,E,T,TT]
	MOVE D,(A)
	MOVE B,1(A)
	MOVE C,[440700,,HANLST]
	JUMPE D,HANLY1
HANLY0:	ILDB T,B
	IDPB T,C
	SOJG D,HANLY0
HANLY1:	IDPB D,C
	MOVEI A,HANLST
	PUSHJ P,NETWRK"HSTLOOK
	 JRST [	SKIPN ITBARF
		 JRST HANLY9
		TYPZ CRLF
		TYPI "[
		TYPZ (A)
		TYPZ [ASCIZ " is an unknown host]"]
		TYPZ CRLF
		TYPZ CRLF
		JRST HANLY9 ]
	AOS -6(P)
HANLY9:	POPAE P,[TT,T,E,D,C,B]
	POPJ P,

;;; tcp support routines

tcplsn:	syscal tcpopn,[movei 1(a) ? movei 2(a)
		b ? [-1]	;local, foreign
		[-1]]
	  popj p,		;failure return
	movei b,3.*30.		;3 seconds for a listen (expect immediate
	syscal netblk,[movei 1(a) ? movei %nslsn ? b ? movem c ? movem b]
	  popj p,		;another failure
	tlz c,-1
	caie c,%nsrfc		;maybe still in rfc
	 jrst tcpls2		;nope
	movei b,30.*30.		;30 seconds for a full connection
	syscal netblk,[movei 1(a) ? movei %nsrfc ? b ? movem c ? movem b]
	  popj p,		;another failure
tcpls2:	jumple b,cpopj
	tlz c,-1
	caie c,%nsopn		;open, or
	 cain c,%nsinp		;open with input
	  jrst popj1		;success
	cain c,%nscli		;also closed with input
	 jrst popj1
	popj p,

tcpicp:	pushj p,netwrk"tcpcon
	 popj p,
	jrst popj1


; Routine to get table of known ITS machines from the system.
itsnms:	push p,b
	move t,[-<mxitss+1>,,hsits]	; Ask for 1 more than we have room for.
	move tt,[sixbit /ITSNMS/]
	.getsys t,
	 jfcl
	skipl t
	 .lose			; Wow!  We're rolling in ITS machines!
	setzi a,
itsnm1:	skipn tt,hsits(a)
	 jrst itsnmx
	move b,a
	lsh b,1
	add b,[440700,,itsnmz]	
	hrrzm b,hsits(a)
itsnm2:	setzi t,0
	lshc t,6
	movei t,"A-'A(t)
	idpb t,b
	jumpn tt,itsnm2
	idpb tt,b
	aoja a,itsnm1

itsnmx:	movei a,hsits
	pop p,b
	popj p,

; Having these hosts wired into the NAME program like this is a loss.
; There should be a database somewhere that this can be read from.

; The tables are in reverse order; the machines listed first are going
; to be displayed last.  Maybe this is a bug.  Also, there should be
; a way to make it list the idle lisp machines too (some switch to check
; to avoid the null-uname check..)

BVAR

hsits:	irps x,,[AI,MX,MC]
	sixbit /x/
	termin
repeat 9, 0
mxitss==:.-hsits
	0

itsnmz:	block 2*mxitss		; ASCIZ strings for above

EVAR

;Match name of ITS system to list of names of lisp machines
;that should be considered automatically with that ITS system.
hs10lm:	sixbit /mc/+hslmmc
	0

	;Lisp machines associated with MC.
hslmmc:	irps x,,sinatra bing avatar merlin lm20 lm19 mit-pi lm9 lm16 lm12 starling gstaad sancho
	  [asciz/x/]
	termin
	0

	; List of all Lisp machines.
; Now reagan has the all-lispm finger server, *lispm = Reagan
hslm:	[asciz /reagan/]
	0
commen ~
	irps x,,lm15 lm27 sinatra bing mit-merlin lm22 mit-pi jimi janis buddy moon morrison elvis lennon
	 [asciz /x/]
	termin
	irps x,,ap1 ap2 ap3 ap4 ap5 ap6 ap7 ap8 ap9 ap10
	 [asciz /x/]
	termin
	irps x,,rb1 rb2 rb3 rb4
	 [asciz /x/]
	termin
	irps x,,mickey minnie boo-boo yogi mit-cherry mit-flame mit-live-oak
	 [asciz /x/]
	termin
	irps x,,tweety-pie mit-panda mit-koala mit-polar mit-grizzly
	 [asciz /x/]
	termin
	irps x,,starling gstaad lm12 lm9 lm16
	 [asciz /x/]
	termin
	irps x,,cadr-test lm1 lm2 lm3 lm4 lm5 lm6 lm7 lm8 lm11 lm18 lm19 lm20 lm21 lm23 lm24 lm25 lm26 lm28 lm29 lm30 lm31 lm32
	 [asciz /x/]
	termin
	irps x,,lm13 lm14 lm17
	 [asciz /x/]
	termin
end reaganomics flame
~
	;List of NE43 VMS sites (*VMS).
hsvms:	irps x,,pig corwin oberon vulcan golem
	 [asciz /x/]
	termin
	0

	;MIT Twenex sites
hstnx:	irps x,,xx oz speech ee
	 [asciz /x/]
	termin
	0

	;List of Apiary machines.
hsapes:	irps x,,ap1 ap2 ap3 ap4 ap5 ap6 ap7 ap8 ap9 ap10
	 [asciz /x/]
	termin
	0

	;List of Robotics machines.
hsbots:	irps x,,vulcan golem lm5 lm25 rb1 rb2 rb3 rb4
	 [asciz /x/]
	termin
	0

	; List of a few MIT sites known to have NAME/FINGER servers.
hsmit:	irps x,,mc oz xx multics mit-vx corwin oberon vulcan pig eecs speech htvax htjr math dspg syl cipg
	 [asciz /x/]
	termin
	0


hschs:	irps x,mc oz xx scrc-tenex mit-vx corwin oberon marie vulcan pig eecs speech htvax htjr dspg syl cipg
	 [asciz /x/]
	termin
	irps x,,scrc-yukon scrc-riverside pointer bassett beagle retriever spaniel terrier
	 [asciz /x/]
	termin
	0

	; List of SCRC hosts that have NAME/FINGER servers
hsscrc:	irps x,,scrc-tenex scrc-afghan scrc-assabet scrc-basset scrc-beagle scrc-blackstone scrc-borzoi scrc-boxer scrc-bulldog scrc-charles scrc-collie scrc-connecticut scrc-dachshund scrc-dalmatian scrc-euphrates scrc-housatonic scrc-husky scrc-menotomy scrc-merrimack scrc-muddy scrc-mystic scrc-neponset scrc-pointer scrc-retriever scrc-samoyed scrc-schnauzer scrc-setter scrc-shepherd scrc-spaniel scrc-susquehanna scrc-terrier
	 [asciz /x/]
	termin
	0

	; List of all sites known to have NAME/FINGER servers
	; Tries to have the most interresting hosts first
	; because they are contacted in the order listed here.
hsall:	irps x,,mc oz xx vx multics ee
	 [asciz /x/]
	termin
	irps x,,sri-nic su-score sail su-sierra sumex su-isl s1-a cmua cmub cmuc cmud
	 [asciz /x/]
	termin
	irps x,,cit-20 lbl-unix ll-11 ll-asg ll-xn office-1 rand-ai rutgers sci-ics sdac-unix usc-eclb-ipi usc-isib usc-isid usc-isif utah-20 wharton-10 harv-10
	 [asciz /x/]
	termin
	0



BVAR

ttyunm:	0	;UNAME of person on this TTY, before any recursive TTYPRT's
		;For sake of not printing UNAME's of UNAME-JNAME pairs
;variables set according to jcl received by "name".
who:	0	;nonzero => it is aobjn to a block of unames for particular
		;users.  only those users are described. if a user is not
		;logged in, his uname and full name are printed anyway.
whotty:	0	;nonzero => it is a aobjn ptr to the numbers of the ttys
		;which the user has requested a description of.
whofnm:	0	;similar, for fnam table
mname:	0	;sixbit name of running machine
	0	;needed by kills2


versio:	.fnam2		;version # of program.
pdl:	-60,,.
	block 60	;push down list
jclcnt:	0		;cnt of chars in jcl buffer
jclbln==150.		;max # chars allowed in JCL buffer
jclbuf:	block <jclbln/5>+1	;we tell ddt to store jcl line here.
jclx:	ascii /
/		;ddt will stop when it finds a nonzero word.
				; parser will stop when it finds ^M.

hanlst:	block 10	;temp. storage for asciz string to give to hstlook.

cnnptr:	0		;byte pointer to line being built up to send
cnncnt:	0		;byte count of "
connam:	block 20	;string itself

seknam:	block 6		;name to look up. chr per word
dwnml:	block 10	;read sys:down mail into this block if nec.
	0		;fence for type7
supdid:	block 8		;buffer for sending terminal ID to SUPDUP
	0
pch:	0		;temp storage for iot
t7:	0		;holds b.p. in type7
t6:	0		;holds b.p. in type6
tyfpgs:	0		;holds page AOBJN for freeing core used in TTYTYP munching.
lgoptr:	0		;byte ptr to logout times file
lgolen:	0		; length of file in core
lgotry:	-1		; if 0, don't hack LOGOUT TIMES.

strstl==20		;fullnames copied to here when we permute them.
strfre:	440700,,strstg
strstg:	block strstl	;storage used for consing up permuted fullnames.

usrloc:	0	;holds location of usr tables.
usrend:	0	;address beyond which no integral usr block exists.
tluser:	0	;total # of users about which info is stored.

;The following is copied from location 101 in a TELSER
telinf::
termid:	block 8		;if non-zero, an asciz terminal name
hstnam:	block 8		;if non-zero, the name of the host in asciz
tipnum:	0		;if non-zero, port number on tip
fhost:	0		;foreign host connected to
hstsix:	0		;sixbit name of host
funame:	0		;sixbit name of user at foreign site
hstat:	0		;Type of host (TAC, MINITS, USER, SERVER.)
TS%SRV==0		;Server host.
TS%USR==1		;User host only.
TS%TIP==2		;Unknown hosts are treated like TIPs.
TS%MIN==3		;MINITS terminal concentrator.
   ;end of stuff looked at by NAME.
ltlinf==.-telinf

;Table of Lisp machines.
lmadrs:	block nontty		;Chaos net address, 0 if table entry not used
lmunam:	block nontty		;Sixbit uname
lmidle:	block nontty		;Ascii idle-time
lmdoc:	repeat nontty, 440700,,lmdcfl+<.rpcnt*10> ;Address of console-location documentation
lmdcfl:	block 10*nontty		;Console-location documentation stored here
nextlm:	0			;Index of next machine to be connected to
lmintf:	0			;Interrupt-occurred flag
chsidx:	repeat 10,-1		;-1 not in use, else index in lmadrs of guy connected to
chsstm:	block 10		;time transaction started
.vector lmpkt(%cpmxw)

	; User-info block, one per each user reported.  Blocks stored
	;dynamically in core above LSR file.
u%unam==0	; UNAME of toplevel job in TTY's tree.
u%xunm==1	; XUNAME of same.
u%jnam==3	; JNAME of job with TTY.

u%tty== 4	; -1 user not logged in,
		; else LH = TTY #, rh=0 no sty, -1 non-net sty, 1 net sty
u%svrj==5	; Job # of server associated with STY, if any.
u%jtm== 6	; JTMU variable for job with TTY. (ascii of idle time for nontty tty)
u%aux1==7	; If STY and belongs to non-network job, this is UNAME of that job.
u%aux2==10	; and this is the JNAME.
u%flgs==11	; Random flags associated with this entry.
	%ulgin==1	;indicates logged in.
u%fdir==12	; tristate switch - file directory exists for XUNAME?
		; -1 => No, +1 => Yes.
		; > +1 => This xuname has an inquir entry, may or may not have a dir.
		;  (the way things are done, it will never matter).
		; 0 => don't know (only allowed for users with tty's,
		;   with whom it usually won't matter).
ul==13	; length of a user-info block.

	variables
EVAR

ttyfil:	block 300	;holds strings for TTY documentation.  Should be last
			;thing before USRFIL, but still in pure core.
	constants
ttsize=21
purpge==<.+1777>/2000
ttpage==<.+1777>/2000
ttloc==ttpage*2000		   ;Location of TTY location data
loc ttloc			   ;be sure to allocate a page there
0

usrpag==ttpage+2
usrfil==usrpag*2000
ls2org==usrfil
end go